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))
48 (condition-case nil (require 'ps-print) (error nil))
52 (condition-case () (require 'timer) (error nil))
53 (defalias-maybe 'ps-print-buffer-with-faces 'ignore)
54 (defalias-maybe 'elmo-database-msgid-put 'ignore)
55 (defalias-maybe 'elmo-database-close 'ignore)
56 (defalias-maybe 'elmo-database-msgid-get 'ignore)
57 (defalias-maybe 'run-with-idle-timer 'ignore)
58 (defalias-maybe 'ps-print-preprint 'ignore))
60 (defvar dragdrop-drop-functions)
61 (defvar scrollbar-height)
62 (defvar mail-reply-buffer)
64 (defvar wl-summary-buffer-name "Summary")
65 (defvar wl-summary-mode-map nil)
66 (defvar wl-current-summary-buffer nil)
68 (defvar wl-summary-buffer-elmo-folder nil)
70 (defmacro wl-summary-buffer-folder-name ()
71 (` (and wl-summary-buffer-elmo-folder
72 (elmo-folder-name-internal wl-summary-buffer-elmo-folder))))
74 (defmacro wl-summary-buffer-msgdb ()
75 (` (and wl-summary-buffer-elmo-folder
76 (elmo-folder-msgdb wl-summary-buffer-elmo-folder))))
78 (defvar wl-summary-buffer-folder-indicator nil)
79 (defvar wl-summary-buffer-disp-msg nil)
80 (defvar wl-summary-buffer-disp-folder nil)
81 (defvar wl-summary-buffer-refile-list nil)
82 (defvar wl-summary-buffer-delete-list nil)
83 (defvar wl-summary-buffer-last-displayed-msg nil)
84 (defvar wl-summary-buffer-current-msg nil)
85 (defvar wl-summary-buffer-unread-status " (0 new/0 unread)")
86 (defvar wl-summary-buffer-unread-count 0)
87 (defvar wl-summary-buffer-new-count 0)
88 (defvar wl-summary-buffer-mime-charset nil)
89 (defvar wl-summary-buffer-weekday-name-lang nil)
90 (defvar wl-summary-buffer-thread-indent-set-alist nil)
91 (defvar wl-summary-buffer-view 'thread)
92 (defvar wl-summary-buffer-message-modified nil)
93 (defvar wl-summary-buffer-mark-modified nil)
94 (defvar wl-summary-buffer-thread-modified nil)
95 (defvar wl-summary-buffer-number-column nil)
96 (defvar wl-summary-buffer-persistent nil)
97 (defvar wl-summary-buffer-thread-nodes nil)
98 (defvar wl-summary-buffer-target-mark-list nil)
99 (defvar wl-summary-buffer-copy-list nil)
100 (defvar wl-summary-buffer-prev-refile-destination nil)
101 (defvar wl-summary-buffer-prev-copy-destination nil)
102 (defvar wl-summary-buffer-saved-message nil)
103 (defvar wl-summary-buffer-prev-folder-function nil)
104 (defvar wl-summary-buffer-next-folder-function nil)
105 (defvar wl-summary-buffer-exit-function nil)
106 (defvar wl-summary-buffer-next-message-function nil)
107 (defvar wl-summary-buffer-number-list nil)
108 (defvar wl-summary-buffer-msgdb nil)
109 (defvar wl-summary-buffer-folder-name nil)
110 (defvar wl-summary-buffer-line-formatter nil)
112 (defvar wl-thread-indent-level-internal nil)
113 (defvar wl-thread-have-younger-brother-str-internal nil)
114 (defvar wl-thread-youngest-child-str-internal nil)
115 (defvar wl-thread-vertical-str-internal nil)
116 (defvar wl-thread-horizontal-str-internal nil)
117 (defvar wl-thread-space-str-internal nil)
118 (defvar wl-summary-last-visited-folder nil)
119 (defvar wl-read-folder-hist nil)
120 (defvar wl-summary-scored nil)
121 (defvar wl-crosspost-alist-modified nil)
122 (defvar wl-summary-alike-hashtb nil)
123 (defvar wl-summary-search-buf-name " *wl-search-subject*")
124 (defvar wl-summary-delayed-update nil)
125 (defvar wl-summary-search-buf-folder-name nil)
127 (defvar wl-summary-get-petname-function 'wl-address-get-petname-1)
129 (defconst wl-summary-message-regexp "^ *-?[0-9]+"
130 "Regexp for the message.")
132 (defvar wl-summary-shell-command-last "")
134 (defvar wl-ps-preprint-hook nil)
135 (defvar wl-ps-print-hook nil)
137 (make-variable-buffer-local 'wl-summary-buffer-elmo-folder)
138 (make-variable-buffer-local 'wl-summary-search-buf-folder-name)
139 (make-variable-buffer-local 'wl-summary-buffer-disp-msg)
140 (make-variable-buffer-local 'wl-summary-buffer-disp-folder)
141 (make-variable-buffer-local 'wl-summary-buffer-refile-list)
142 (make-variable-buffer-local 'wl-summary-buffer-copy-list)
143 (make-variable-buffer-local 'wl-summary-buffer-target-mark-list)
144 (make-variable-buffer-local 'wl-summary-buffer-delete-list)
145 (make-variable-buffer-local 'wl-summary-buffer-folder-indicator)
146 (make-variable-buffer-local 'wl-summary-buffer-last-displayed-msg)
147 (make-variable-buffer-local 'wl-summary-buffer-unread-status)
148 (make-variable-buffer-local 'wl-summary-buffer-unread-count)
149 (make-variable-buffer-local 'wl-summary-buffer-new-count)
150 (make-variable-buffer-local 'wl-summary-buffer-mime-charset)
151 (make-variable-buffer-local 'wl-summary-buffer-weekday-name-lang)
152 (make-variable-buffer-local 'wl-summary-buffer-thread-indent-set)
153 (make-variable-buffer-local 'wl-summary-buffer-view)
154 (make-variable-buffer-local 'wl-summary-buffer-message-modified)
155 (make-variable-buffer-local 'wl-summary-buffer-mark-modified)
156 (make-variable-buffer-local 'wl-summary-buffer-thread-modified)
157 (make-variable-buffer-local 'wl-summary-buffer-number-column)
158 (make-variable-buffer-local 'wl-summary-buffer-persistent)
159 (make-variable-buffer-local 'wl-summary-buffer-thread-nodes)
160 (make-variable-buffer-local 'wl-summary-buffer-prev-refile-destination)
161 (make-variable-buffer-local 'wl-summary-buffer-saved-message)
162 (make-variable-buffer-local 'wl-summary-scored)
163 (make-variable-buffer-local 'wl-summary-default-score)
164 (make-variable-buffer-local 'wl-summary-move-direction-downward)
165 (make-variable-buffer-local 'wl-summary-important-above)
166 (make-variable-buffer-local 'wl-summary-target-above)
167 (make-variable-buffer-local 'wl-summary-mark-below)
168 (make-variable-buffer-local 'wl-summary-expunge-below)
169 (make-variable-buffer-local 'wl-thread-indent-level-internal)
170 (make-variable-buffer-local 'wl-thread-have-younger-brother-str-internal)
171 (make-variable-buffer-local 'wl-thread-youngest-child-str-internal)
172 (make-variable-buffer-local 'wl-thread-vertical-str-internal)
173 (make-variable-buffer-local 'wl-thread-horizontal-str-internal)
174 (make-variable-buffer-local 'wl-thread-space-str-internal)
175 (make-variable-buffer-local 'wl-summary-buffer-prev-folder-function)
176 (make-variable-buffer-local 'wl-summary-buffer-next-folder-function)
177 (make-variable-buffer-local 'wl-summary-buffer-exit-function)
178 (make-variable-buffer-local 'wl-summary-buffer-next-message-function)
179 (make-variable-buffer-local 'wl-summary-buffer-number-list)
180 (make-variable-buffer-local 'wl-summary-buffer-msgdb)
181 (make-variable-buffer-local 'wl-summary-buffer-folder-name)
182 (make-variable-buffer-local 'wl-summary-buffer-line-formatter)
185 (defvar wl-thr-indent-string)
186 (defvar wl-thr-children-number)
187 (defvar wl-thr-linked)
188 (defvar wl-message-entity)
189 (defvar wl-parent-message-entity)
191 ;; internal functions (dummy)
192 (unless (fboundp 'wl-summary-append-message-func-internal)
193 (defun wl-summary-append-message-func-internal (entity msgdb update
194 &optional force-insert)))
196 (defmacro wl-summary-sticky-buffer-name (name)
197 (` (concat wl-summary-buffer-name ":" (, name))))
199 (defun wl-summary-default-subject (subject-string)
200 (if (string-match "^[ \t]*\\[[^:]+[,: ][0-9]+\\][ \t]*" subject-string)
201 (substring subject-string (match-end 0))
204 (defun wl-summary-default-from (from)
207 (and (eq major-mode 'wl-summary-mode)
208 (stringp wl-summary-showto-folder-regexp)
209 (string-match wl-summary-showto-folder-regexp
210 (wl-summary-buffer-folder-name))
211 (wl-address-user-mail-address-p from)
213 ((and (setq tos (elmo-msgdb-overview-entity-get-to
215 (not (string= "" tos)))
224 (funcall wl-summary-get-petname-function to)
226 (std11-extract-address-components to))
229 (wl-parse-addresses tos)
231 ((setq ng (elmo-msgdb-overview-entity-get-extra-field
232 wl-message-entity "newsgroups"))
233 (setq retval (concat "Ng:" ng)))))
235 (setq retval (or (funcall wl-summary-get-petname-function from)
236 (car (std11-extract-address-components from))
241 (defun wl-summary-simple-from (string)
243 (or (funcall wl-summary-get-petname-function string)
244 (car (std11-extract-address-components string))
248 (defvar wl-summary-mode-menu-spec
250 ["Read" wl-summary-read t]
251 ["Prev page" wl-summary-prev-page t]
252 ["Next page" wl-summary-next-page t]
253 ["Top" wl-summary-display-top t]
254 ["Bottom" wl-summary-display-bottom t]
255 ["Prev" wl-summary-prev t]
256 ["Next" wl-summary-next t]
257 ["Up" wl-summary-up t]
258 ["Down" wl-summary-down t]
259 ["Parent message" wl-summary-jump-to-parent-message t]
261 ["Sync" wl-summary-sync t]
262 ["Execute" wl-summary-exec t]
263 ["Go to other folder" wl-summary-goto-folder t]
264 ["Pick" wl-summary-pick t]
265 ["Mark as read all" wl-summary-mark-as-read-all t]
266 ["Unmark all" wl-summary-unmark-all t]
267 ["Toggle display message" wl-summary-toggle-disp-msg t]
268 ["Display folder" wl-summary-toggle-disp-folder t]
269 ["Toggle threading" wl-summary-toggle-thread t]
270 ["Stick" wl-summary-stick t]
272 ["By Number" wl-summary-sort-by-number t]
273 ["By Date" wl-summary-sort-by-date t]
274 ["By From" wl-summary-sort-by-from t]
275 ["By Subject" wl-summary-sort-by-subject t])
278 ["Mark as read" wl-summary-mark-as-read t]
279 ["Mark as important" wl-summary-mark-as-important t]
280 ["Mark as unread" wl-summary-mark-as-unread t]
281 ["Set delete mark" wl-summary-delete t]
282 ["Set refile mark" wl-summary-refile t]
283 ["Set copy mark" wl-summary-copy t]
284 ["Prefetch" wl-summary-prefetch t]
285 ["Set target mark" wl-summary-target-mark t]
286 ["Unmark" wl-summary-unmark t]
287 ["Save" wl-summary-save t]
288 ["Cancel posted news" wl-summary-cancel-message t]
289 ["Supersedes message" wl-summary-supersedes-message t]
290 ["Resend bounced mail" wl-summary-resend-bounced-mail t]
291 ["Resend message" wl-summary-resend-message t]
292 ["Enter the message" wl-summary-jump-to-current-message t]
293 ["Pipe message" wl-summary-pipe-message t]
294 ["Print message" wl-summary-print-message t])
296 ["Open or Close" wl-thread-open-close (eq wl-summary-buffer-view 'thread)]
297 ["Open all" wl-thread-open-all (eq wl-summary-buffer-view 'thread)]
298 ["Close all" wl-thread-close-all (eq wl-summary-buffer-view 'thread)]
299 ["Mark as read" wl-thread-mark-as-read (eq wl-summary-buffer-view 'thread)]
300 ["Mark as important" wl-thread-mark-as-important (eq wl-summary-buffer-view 'thread)]
301 ["Mark as unread" wl-thread-mark-as-unread (eq wl-summary-buffer-view 'thread)]
302 ["Set delete mark" wl-thread-delete (eq wl-summary-buffer-view 'thread)]
303 ["Set refile mark" wl-thread-refile (eq wl-summary-buffer-view 'thread)]
304 ["Set copy mark" wl-thread-copy (eq wl-summary-buffer-view 'thread)]
305 ["Prefetch" wl-thread-prefetch (eq wl-summary-buffer-view 'thread)]
306 ["Set target mark" wl-thread-target-mark (eq wl-summary-buffer-view 'thread)]
307 ["Unmark" wl-thread-unmark (eq wl-summary-buffer-view 'thread)]
308 ["Save" wl-thread-save (eq wl-summary-buffer-view 'thread)]
309 ["Execute" wl-thread-exec (eq wl-summary-buffer-view 'thread)])
311 ["Mark as read" wl-summary-mark-as-read-region t]
312 ["Mark as important" wl-summary-mark-as-important-region t]
313 ["Mark as unread" wl-summary-mark-as-unread-region t]
314 ["Set delete mark" wl-summary-delete-region t]
315 ["Set refile mark" wl-summary-refile-region t]
316 ["Set copy mark" wl-summary-copy-region t]
317 ["Prefetch" wl-summary-prefetch-region t]
318 ["Set target mark" wl-summary-target-mark-region t]
319 ["Unmark" wl-summary-unmark-region t]
320 ["Save" wl-summary-save-region t]
321 ["Execute" wl-summary-exec-region t])
323 ["Mark as read" wl-summary-target-mark-mark-as-read t]
324 ["Mark as important" wl-summary-target-mark-mark-as-important t]
325 ["Mark as unread" wl-summary-target-mark-mark-as-unread t]
326 ["Set delete mark" wl-summary-target-mark-delete t]
327 ["Set refile mark" wl-summary-target-mark-refile t]
328 ["Set copy mark" wl-summary-target-mark-copy t]
329 ["Prefetch" wl-summary-target-mark-prefetch t]
330 ["Save" wl-summary-target-mark-save t]
331 ["Reply with citation" wl-summary-target-mark-reply-with-citation t]
332 ["Forward" wl-summary-target-mark-forward t]
333 ["uudecode" wl-summary-target-mark-uudecode t])
335 ["Switch current score file" wl-score-change-score-file t]
336 ["Edit current score file" wl-score-edit-current-scores t]
337 ["Edit score file" wl-score-edit-file t]
338 ["Set mark below" wl-score-set-mark-below t]
339 ["Set expunge below" wl-score-set-expunge-below t]
340 ["Rescore buffer" wl-summary-rescore t]
341 ["Increase score" wl-summary-increase-score t]
342 ["Lower score" wl-summary-lower-score t])
345 ["Write a message" wl-summary-write t]
346 ["Write for current folder" wl-summary-write-current-folder t]
347 ["Reply" wl-summary-reply t]
348 ["Reply with citation" wl-summary-reply-with-citation t]
349 ["Forward" wl-summary-forward t])
351 ["Toggle Plug Status" wl-toggle-plugged t]
352 ["Change Plug Status" wl-plugged-change t]
354 ["Exit Current Folder" wl-summary-exit t]))
357 (defun wl-summary-setup-mouse ()
358 (define-key wl-summary-mode-map 'button4 'wl-summary-prev)
359 (define-key wl-summary-mode-map 'button5 'wl-summary-next)
360 (define-key wl-summary-mode-map [(shift button4)]
362 (define-key wl-summary-mode-map [(shift button5)]
364 (define-key wl-summary-mode-map 'button2 'wl-summary-click))
365 (defun wl-summary-setup-mouse ()
366 (define-key wl-summary-mode-map [mouse-4] 'wl-summary-prev)
367 (define-key wl-summary-mode-map [mouse-5] 'wl-summary-next)
368 (define-key wl-summary-mode-map [S-mouse-4] 'wl-summary-up)
369 (define-key wl-summary-mode-map [S-mouse-5] 'wl-summary-down)
370 (define-key wl-summary-mode-map [mouse-2] 'wl-summary-click)))
372 (if wl-summary-mode-map
374 (setq wl-summary-mode-map (make-sparse-keymap))
375 (define-key wl-summary-mode-map " " 'wl-summary-read)
376 (define-key wl-summary-mode-map "." 'wl-summary-redisplay)
377 (define-key wl-summary-mode-map "<" 'wl-summary-display-top)
378 (define-key wl-summary-mode-map ">" 'wl-summary-display-bottom)
379 (define-key wl-summary-mode-map "\177" 'wl-summary-prev-page)
380 (define-key wl-summary-mode-map [backspace] 'wl-summary-prev-page)
381 (define-key wl-summary-mode-map "\r" 'wl-summary-next-line-content)
382 (define-key wl-summary-mode-map "\C-m" 'wl-summary-next-line-content)
383 (define-key wl-summary-mode-map "/" 'wl-thread-open-close)
384 (define-key wl-summary-mode-map "[" 'wl-thread-open-all)
385 (define-key wl-summary-mode-map "]" 'wl-thread-close-all)
386 (define-key wl-summary-mode-map "-" 'wl-summary-prev-line-content)
387 (define-key wl-summary-mode-map "\e\r" 'wl-summary-prev-line-content)
388 (define-key wl-summary-mode-map "g" 'wl-summary-goto-folder)
389 (define-key wl-summary-mode-map "G" 'wl-summary-goto-folder-sticky)
390 (define-key wl-summary-mode-map "c" 'wl-summary-mark-as-read-all)
391 ; (define-key wl-summary-mode-map "D" 'wl-summary-drop-unsync)
393 (define-key wl-summary-mode-map "a" 'wl-summary-reply)
394 (define-key wl-summary-mode-map "A" 'wl-summary-reply-with-citation)
395 (define-key wl-summary-mode-map "C" 'wl-summary-cancel-message)
396 (define-key wl-summary-mode-map "E" 'wl-summary-reedit)
397 (define-key wl-summary-mode-map "\eE" 'wl-summary-resend-bounced-mail)
398 (define-key wl-summary-mode-map "f" 'wl-summary-forward)
399 (define-key wl-summary-mode-map "$" 'wl-summary-mark-as-important)
400 (define-key wl-summary-mode-map "@" 'wl-summary-edit-addresses)
402 (define-key wl-summary-mode-map "y" 'wl-summary-save)
403 (define-key wl-summary-mode-map "n" 'wl-summary-next)
404 (define-key wl-summary-mode-map "p" 'wl-summary-prev)
405 (define-key wl-summary-mode-map "N" 'wl-summary-down)
406 (define-key wl-summary-mode-map "P" 'wl-summary-up)
407 ;;;(define-key wl-summary-mode-map "w" 'wl-draft)
408 (define-key wl-summary-mode-map "w" 'wl-summary-write)
409 (define-key wl-summary-mode-map "W" 'wl-summary-write-current-folder)
410 ;;;(define-key wl-summary-mode-map "e" 'wl-draft-open-file)
411 (define-key wl-summary-mode-map "e" 'wl-summary-save)
412 (define-key wl-summary-mode-map "\C-c\C-o" 'wl-jump-to-draft-buffer)
413 (define-key wl-summary-mode-map "\C-c\C-a" 'wl-addrmgr)
414 (define-key wl-summary-mode-map "\C-c\C-p" 'wl-summary-previous-buffer)
415 (define-key wl-summary-mode-map "\C-c\C-n" 'wl-summary-next-buffer)
416 (define-key wl-summary-mode-map "H" 'wl-summary-redisplay-all-header)
417 (define-key wl-summary-mode-map "M" 'wl-summary-redisplay-no-mime)
418 (define-key wl-summary-mode-map "B" 'wl-summary-burst)
419 (define-key wl-summary-mode-map "Z" 'wl-status-update)
420 (define-key wl-summary-mode-map "#" 'wl-summary-print-message)
421 (define-key wl-summary-mode-map "|" 'wl-summary-pipe-message)
422 (define-key wl-summary-mode-map "z" 'wl-summary-suspend)
423 (define-key wl-summary-mode-map "q" 'wl-summary-exit)
424 (define-key wl-summary-mode-map "Q" 'wl-summary-force-exit)
426 (define-key wl-summary-mode-map "j" 'wl-summary-jump-to-current-message)
427 (define-key wl-summary-mode-map "J" 'wl-thread-jump-to-msg)
428 (define-key wl-summary-mode-map "I" 'wl-summary-incorporate)
429 (define-key wl-summary-mode-map "\M-j" 'wl-summary-jump-to-msg-by-message-id)
430 (define-key wl-summary-mode-map "^" 'wl-summary-jump-to-parent-message)
431 (define-key wl-summary-mode-map "!" 'wl-summary-mark-as-unread)
433 (define-key wl-summary-mode-map "s" 'wl-summary-sync)
434 (define-key wl-summary-mode-map "S" 'wl-summary-sort)
435 (define-key wl-summary-mode-map "\M-s" 'wl-summary-stick)
436 (define-key wl-summary-mode-map "T" 'wl-summary-toggle-thread)
438 (define-key wl-summary-mode-map "l" 'wl-summary-toggle-disp-folder)
439 (define-key wl-summary-mode-map "v" 'wl-summary-toggle-disp-msg)
440 (define-key wl-summary-mode-map "V" 'wl-summary-virtual)
442 (define-key wl-summary-mode-map "\C-i" 'wl-summary-goto-last-displayed-msg)
443 (define-key wl-summary-mode-map "?" 'wl-summary-pick)
444 (define-key wl-summary-mode-map "\ee" 'wl-summary-expire)
447 (define-key wl-summary-mode-map "\ew" 'wl-summary-save-current-message)
448 (define-key wl-summary-mode-map "\C-y" 'wl-summary-yank-saved-message)
451 (define-key wl-summary-mode-map "R" 'wl-summary-mark-as-read)
452 (define-key wl-summary-mode-map "i" 'wl-summary-prefetch)
453 (define-key wl-summary-mode-map "x" 'wl-summary-exec)
454 (define-key wl-summary-mode-map "*" 'wl-summary-target-mark)
455 (define-key wl-summary-mode-map "o" 'wl-summary-refile)
456 (define-key wl-summary-mode-map "O" 'wl-summary-copy)
457 (define-key wl-summary-mode-map "\M-o" 'wl-summary-refile-prev-destination)
458 ; (define-key wl-summary-mode-map "\M-O" 'wl-summary-copy-prev-destination)
459 (define-key wl-summary-mode-map "\C-o" 'wl-summary-auto-refile)
460 (define-key wl-summary-mode-map "d" 'wl-summary-delete)
461 (define-key wl-summary-mode-map "u" 'wl-summary-unmark)
462 (define-key wl-summary-mode-map "U" 'wl-summary-unmark-all)
465 (define-key wl-summary-mode-map "t" (make-sparse-keymap))
466 (define-key wl-summary-mode-map "tR" 'wl-thread-mark-as-read)
467 (define-key wl-summary-mode-map "ti" 'wl-thread-prefetch)
468 (define-key wl-summary-mode-map "tx" 'wl-thread-exec)
469 (define-key wl-summary-mode-map "t*" 'wl-thread-target-mark)
470 (define-key wl-summary-mode-map "to" 'wl-thread-refile)
471 (define-key wl-summary-mode-map "tO" 'wl-thread-copy)
472 (define-key wl-summary-mode-map "td" 'wl-thread-delete)
473 (define-key wl-summary-mode-map "tu" 'wl-thread-unmark)
474 (define-key wl-summary-mode-map "t!" 'wl-thread-mark-as-unread)
475 (define-key wl-summary-mode-map "t$" 'wl-thread-mark-as-important)
476 (define-key wl-summary-mode-map "ty" 'wl-thread-save)
477 (define-key wl-summary-mode-map "ts" 'wl-thread-set-parent)
479 ;; target-mark commands
480 (define-key wl-summary-mode-map "m" (make-sparse-keymap))
481 (define-key wl-summary-mode-map "mi" 'wl-summary-target-mark-prefetch)
482 (define-key wl-summary-mode-map "mR" 'wl-summary-target-mark-mark-as-read)
483 (define-key wl-summary-mode-map "mo" 'wl-summary-target-mark-refile)
484 (define-key wl-summary-mode-map "mO" 'wl-summary-target-mark-copy)
485 (define-key wl-summary-mode-map "md" 'wl-summary-target-mark-delete)
486 (define-key wl-summary-mode-map "my" 'wl-summary-target-mark-save)
487 (define-key wl-summary-mode-map "m!" 'wl-summary-target-mark-mark-as-unread)
488 (define-key wl-summary-mode-map "m$" 'wl-summary-target-mark-mark-as-important)
489 (define-key wl-summary-mode-map "mu" 'wl-summary-delete-all-temp-marks)
490 (define-key wl-summary-mode-map "mU" 'wl-summary-target-mark-uudecode)
491 (define-key wl-summary-mode-map "ma" 'wl-summary-target-mark-all)
492 (define-key wl-summary-mode-map "mt" 'wl-summary-target-mark-thread)
493 (define-key wl-summary-mode-map "mA" 'wl-summary-target-mark-reply-with-citation)
494 (define-key wl-summary-mode-map "mf" 'wl-summary-target-mark-forward)
495 (define-key wl-summary-mode-map "m?" 'wl-summary-target-mark-pick)
496 (define-key wl-summary-mode-map "m#" 'wl-summary-target-mark-print)
497 (define-key wl-summary-mode-map "m|" 'wl-summary-target-mark-pipe)
500 (define-key wl-summary-mode-map "r" (make-sparse-keymap))
501 (define-key wl-summary-mode-map "rR" 'wl-summary-mark-as-read-region)
502 (define-key wl-summary-mode-map "ri" 'wl-summary-prefetch-region)
503 (define-key wl-summary-mode-map "rx" 'wl-summary-exec-region)
504 (define-key wl-summary-mode-map "mr" 'wl-summary-target-mark-region)
505 (define-key wl-summary-mode-map "r*" 'wl-summary-target-mark-region)
506 (define-key wl-summary-mode-map "ro" 'wl-summary-refile-region)
507 (define-key wl-summary-mode-map "rO" 'wl-summary-copy-region)
508 (define-key wl-summary-mode-map "rd" 'wl-summary-delete-region)
509 (define-key wl-summary-mode-map "ru" 'wl-summary-unmark-region)
510 (define-key wl-summary-mode-map "r!" 'wl-summary-mark-as-unread-region)
511 (define-key wl-summary-mode-map "r$" 'wl-summary-mark-as-important-region)
512 (define-key wl-summary-mode-map "ry" 'wl-summary-save-region)
515 (define-key wl-summary-mode-map "K" 'wl-summary-increase-score)
516 (define-key wl-summary-mode-map "L" 'wl-summary-lower-score)
517 (define-key wl-summary-mode-map "h" (make-sparse-keymap))
518 (define-key wl-summary-mode-map "hR" 'wl-summary-rescore)
519 (define-key wl-summary-mode-map "hc" 'wl-score-change-score-file)
520 (define-key wl-summary-mode-map "he" 'wl-score-edit-current-scores)
521 (define-key wl-summary-mode-map "hf" 'wl-score-edit-file)
522 (define-key wl-summary-mode-map "hF" 'wl-score-flush-cache)
523 (define-key wl-summary-mode-map "hm" 'wl-score-set-mark-below)
524 (define-key wl-summary-mode-map "hx" 'wl-score-set-expunge-below)
526 (define-key wl-summary-mode-map "\M-t" 'wl-toggle-plugged)
527 (define-key wl-summary-mode-map "\C-t" 'wl-plugged-change)
529 (define-key wl-summary-mode-map "\C-x\C-s" 'wl-summary-save-status)
530 (wl-summary-setup-mouse)
534 "Menu used in Summary mode."
535 wl-summary-mode-menu-spec))
537 (defun wl-status-update ()
541 (defun wl-summary-display-top ()
543 (goto-char (point-min))
544 (if wl-summary-buffer-disp-msg
545 (wl-summary-redisplay)))
547 (defun wl-summary-display-bottom ()
549 (goto-char (point-max))
551 (if wl-summary-buffer-disp-msg
552 (wl-summary-redisplay)))
554 (defun wl-summary-count-unread ()
556 (elmo-msgdb-count-marks (wl-summary-buffer-msgdb)
558 (list wl-summary-unread-uncached-mark
559 wl-summary-unread-cached-mark))))
560 (if (eq major-mode 'wl-summary-mode)
561 (setq wl-summary-buffer-new-count (car pair)
562 wl-summary-buffer-unread-count (cdr pair)))
565 (defun wl-summary-message-string (&optional use-cache)
566 "Return full body string of current message.
567 If optional USE-CACHE is non-nil, use cache if exists."
568 (let ((number (wl-summary-message-number))
569 (folder wl-summary-buffer-elmo-folder))
571 (message "No message.")
573 (elmo-message-fetch folder
575 (elmo-make-fetch-strategy
577 use-cache ; use cache
578 nil ; save cache (should `t'?)
581 (elmo-file-cache-get-path
582 (elmo-message-field folder number 'message-id))))
588 (defun wl-summary-reedit (&optional arg)
589 "Re-edit current message.
590 If ARG is non-nil, Supersedes message"
593 (wl-summary-supersedes-message)
594 (if (string= (wl-summary-buffer-folder-name) wl-draft-folder)
595 (if (wl-summary-message-number)
597 (wl-draft-reedit (wl-summary-message-number))
598 (if (wl-message-news-p)
599 (mail-position-on-field "Newsgroups")
600 (mail-position-on-field "To"))
601 (delete-other-windows)))
602 (wl-draft-edit-string (wl-summary-message-string)))))
604 (defun wl-summary-resend-bounced-mail ()
605 "Re-mail the current message.
606 This only makes sense if the current message is a bounce message which
607 contains some mail you have written but has been bounced back to
611 (wl-summary-set-message-buffer-or-redisplay)
612 (set-buffer (wl-message-get-original-buffer))
613 (goto-char (point-min))
614 (let ((case-fold-search nil))
618 (concat "^\\($\\|[Cc]ontent-[Tt]ype:[ \t]+multipart/\\(report\\|mixed\\)\\)") nil t)
620 (re-search-forward "boundary=\"\\([^\"]+\\)\"" nil t))
621 (let ((boundary (buffer-substring (match-beginning 1) (match-end 1)))
624 ((and (setq start (re-search-forward
625 (concat "^--" boundary "\n"
626 "\\([Cc]ontent-[Dd]escription:.*\n\\)?"
627 "[Cc]ontent-[Tt]ype:[ \t]+"
628 "\\(message/rfc822\\|text/rfc822-headers\\)\n"
629 "\\(.+\n\\)*\n") nil t))
631 (concat "\n\\(--" boundary "\\)--\n") nil t))
632 (wl-draft-edit-string (buffer-substring start (match-beginning 1))))
634 (message "Seems no message/rfc822 part.")))))
635 ((let ((case-fold-search t))
636 (re-search-forward wl-rejected-letter-start nil t))
637 (skip-chars-forward " \t\n")
638 (wl-draft-edit-string (buffer-substring (point) (point-max))))
640 (message "Does not appear to be a rejected letter."))))))
642 (defun wl-summary-resend-message (address)
643 "Resend the current message to ADDRESS."
644 (interactive "sResend message to: ")
645 (if (or (null address) (string-match "^[ \t]*$" address))
646 (message "No address specified.")
647 (message "Resending message to %s..." address)
649 (let ((original (wl-summary-get-original-buffer)))
650 ;; We first set up a normal mail buffer.
651 (set-buffer (get-buffer-create " *wl-draft-resend*"))
652 (buffer-disable-undo (current-buffer))
654 (setq wl-sent-message-via nil)
655 ;; Insert our usual headers.
656 (wl-draft-insert-from-field)
657 (wl-draft-insert-date-field)
658 (insert "to: " address "\n")
659 (goto-char (point-min))
660 ;; Rename them all to "Resent-*".
661 (while (re-search-forward "^[A-Za-z]" nil t)
666 (delete-region (point) (point-max))
668 ;; Insert the message to be resent.
669 (insert-buffer-substring original)
670 (goto-char (point-min))
671 (search-forward "\n\n")
674 (narrow-to-region beg (point))
675 (wl-draft-delete-fields wl-ignored-resent-headers)
676 (goto-char (point-max)))
677 (insert mail-header-separator)
678 ;; Rename all old ("Previous-")Resent headers.
679 (while (re-search-backward "^\\(Previous-\\)*Resent-" beg t)
681 (insert "Previous-"))
682 ;; Quote any "From " lines at the beginning.
684 (when (looking-at "From ")
685 (replace-match "X-From-Line: ")))
687 (wl-draft-dispatch-message)
688 (kill-buffer (current-buffer)))
689 (message "Resending message to %s...done" address))))
691 (defun wl-summary-buffer-set-folder (folder)
693 (setq folder (wl-folder-get-elmo-folder folder)))
694 (setq wl-summary-buffer-elmo-folder folder)
695 (setq wl-summary-buffer-folder-indicator
696 (if (memq 'modeline wl-use-folder-petname)
697 (wl-folder-get-petname (elmo-folder-name-internal folder))
698 (elmo-folder-name-internal folder)))
699 (make-local-variable 'wl-message-buffer)
700 (setq wl-summary-buffer-mime-charset (or (wl-get-assoc-list-value
701 wl-folder-mime-charset-alist
702 (elmo-folder-name-internal folder))
704 (setq wl-summary-buffer-weekday-name-lang
705 (or (wl-get-assoc-list-value
706 wl-folder-weekday-name-lang-alist
707 (elmo-folder-name-internal folder))
708 wl-summary-weekday-name-lang))
709 (setq wl-summary-buffer-thread-indent-set
710 (wl-get-assoc-list-value
711 wl-folder-thread-indent-set-alist
712 (elmo-folder-name-internal folder)))
713 (setq wl-summary-buffer-number-column
714 (or (wl-get-assoc-list-value wl-summary-number-column-alist
715 (wl-summary-buffer-folder-name))
716 wl-summary-default-number-column))
717 (wl-line-formatter-setup
718 wl-summary-buffer-line-formatter
719 (or (wl-get-assoc-list-value
720 wl-folder-summary-line-format-alist
721 (elmo-folder-name-internal folder))
722 wl-summary-line-format)
723 wl-summary-line-format-spec-alist)
724 (setq wl-summary-buffer-persistent
725 (wl-folder-persistent-p (elmo-folder-name-internal folder)))
726 (elmo-folder-set-persistent-internal folder wl-summary-buffer-persistent)
727 ;; process duplicates.
728 (elmo-folder-set-process-duplicates-internal
729 folder (cdr (elmo-string-matched-assoc
730 (elmo-folder-name-internal folder)
731 wl-folder-process-duplicates-alist)))
733 wl-thread-indent-level-internal
734 (or (nth 0 wl-summary-buffer-thread-indent-set)
735 wl-thread-indent-level)
736 wl-thread-have-younger-brother-str-internal
737 (or (nth 1 wl-summary-buffer-thread-indent-set)
738 wl-thread-have-younger-brother-str)
739 wl-thread-youngest-child-str-internal
740 (or (nth 2 wl-summary-buffer-thread-indent-set)
741 wl-thread-youngest-child-str)
742 wl-thread-vertical-str-internal
743 (or (nth 3 wl-summary-buffer-thread-indent-set)
744 wl-thread-vertical-str)
745 wl-thread-horizontal-str-internal
746 (or (nth 4 wl-summary-buffer-thread-indent-set)
747 wl-thread-horizontal-str)
748 wl-thread-space-str-internal
749 (or (nth 5 wl-summary-buffer-thread-indent-set)
750 wl-thread-space-str))
751 (setq wl-thread-indent-regexp
753 (regexp-quote wl-thread-have-younger-brother-str-internal) "\\|"
754 (regexp-quote wl-thread-youngest-child-str-internal) "\\|"
755 (regexp-quote wl-thread-vertical-str-internal) "\\|"
756 (regexp-quote wl-thread-horizontal-str-internal) "\\|"
757 (regexp-quote wl-thread-space-str-internal)))
758 (run-hooks 'wl-summary-buffer-set-folder-hook))
760 (defun wl-summary-mode ()
761 "Major mode for reading threaded messages.
762 See Info under Wanderlust for full documentation.
765 \\{wl-summary-mode-map}
767 Entering Folder mode calls the value of `wl-summary-mode-hook'."
769 (unless (interactive-p) (kill-all-local-variables))
770 (setq major-mode 'wl-summary-mode)
771 (setq mode-name "Summary")
772 (use-local-map wl-summary-mode-map)
773 ;;;(setq default-directory (or wl-tmp-dir (expand-file-name "~/")))
774 (setq buffer-read-only t)
775 (setq truncate-lines t)
776 ;;;(make-local-variable 'tab-width)
777 ;;;(setq tab-width 1)
778 (buffer-disable-undo (current-buffer))
779 (wl-mode-line-buffer-identification '("Wanderlust: "
780 wl-summary-buffer-folder-indicator
781 wl-summary-buffer-unread-status))
782 (easy-menu-add wl-summary-mode-menu)
783 (when wl-summary-lazy-highlight
784 (make-local-variable 'window-scroll-functions)
785 (add-hook 'window-scroll-functions 'wl-highlight-summary-window))
786 ;; This hook may contain the function `wl-setup-summary' for reasons
787 ;; of system internal to accord facilities for the Emacs variants.
788 (run-hooks 'wl-summary-mode-hook))
790 (defun wl-summary-overview-entity-compare-by-date (x y)
791 "Compare entity X and Y by date."
794 (timezone-make-date-sortable
795 (elmo-msgdb-overview-entity-get-date x))
796 (timezone-make-date-sortable
797 (elmo-msgdb-overview-entity-get-date y)))
798 (error))) ;; ignore error.
800 (defun wl-summary-overview-entity-compare-by-number (x y)
801 "Compare entity X and Y by number."
803 (elmo-msgdb-overview-entity-get-number x)
804 (elmo-msgdb-overview-entity-get-number y)))
806 (defun wl-summary-overview-entity-compare-by-from (x y)
807 "Compare entity X and Y by from."
809 (wl-address-header-extract-address
810 (or (elmo-msgdb-overview-entity-get-from-no-decode x)
811 wl-summary-no-from-message))
812 (wl-address-header-extract-address
813 (or (elmo-msgdb-overview-entity-get-from-no-decode y)
814 wl-summary-no-from-message))))
816 (defun wl-summary-overview-entity-compare-by-subject (x y)
817 "Compare entity X and Y by subject."
818 (string< (elmo-msgdb-overview-entity-get-subject-no-decode x)
819 (elmo-msgdb-overview-entity-get-subject-no-decode y)))
821 (defun wl-summary-sort-by-date ()
823 (wl-summary-rescan "date"))
824 (defun wl-summary-sort-by-number ()
826 (wl-summary-rescan "number"))
827 (defun wl-summary-sort-by-subject ()
829 (wl-summary-rescan "subject"))
830 (defun wl-summary-sort-by-from ()
832 (wl-summary-rescan "from"))
834 (defun wl-summary-rescan (&optional sort-by)
835 "Rescan current folder without updating."
837 (let* ((cur-buf (current-buffer))
838 (msgdb (wl-summary-buffer-msgdb))
839 (overview (elmo-msgdb-get-overview msgdb))
840 (number-alist (elmo-msgdb-get-number-alist msgdb))
841 (elmo-mime-charset wl-summary-buffer-mime-charset)
845 (inhibit-read-only t)
846 (buffer-read-only nil)
848 (fset 'wl-summary-append-message-func-internal
849 (wl-summary-get-append-message-func))
851 (message "Re-scanning...")
853 (setq num (length overview))
855 (message "Sorting by %s..." sort-by)
858 (intern (format "wl-summary-overview-entity-compare-by-%s"
860 (message "Sorting by %s...done" sort-by)
861 (elmo-msgdb-set-overview (wl-summary-buffer-msgdb)
865 (setq wl-thread-entity-hashtb (elmo-make-hash (* (length overview) 2)))
866 (setq wl-thread-entity-list nil)
867 (setq wl-thread-entities nil)
868 (setq wl-summary-buffer-number-list nil)
869 (setq wl-summary-buffer-target-mark-list nil)
870 (setq wl-summary-buffer-refile-list nil)
871 (setq wl-summary-buffer-delete-list nil)
872 (setq wl-summary-delayed-update nil)
873 (elmo-kill-buffer wl-summary-search-buf-name)
874 (message "Constructing summary structure...")
876 (setq entity (car curp))
877 (wl-summary-append-message-func-internal entity msgdb nil)
878 (setq curp (cdr curp))
879 (when (> num elmo-display-progress-threshold)
881 (if (or (zerop (% i 5)) (= i num))
882 (elmo-display-progress
883 'wl-summary-rescan "Constructing summary structure..."
884 (/ (* i 100) num)))))
885 (when wl-summary-delayed-update
886 (while wl-summary-delayed-update
887 (message "Parent (%d) of message %d is no entity"
888 (caar wl-summary-delayed-update)
889 (elmo-msgdb-overview-entity-get-number
890 (cdar wl-summary-delayed-update)))
891 (wl-summary-append-message-func-internal
892 (cdar wl-summary-delayed-update) msgdb nil t)
893 (setq wl-summary-delayed-update (cdr wl-summary-delayed-update))))
894 (message "Constructing summary structure...done")
896 (if (eq wl-summary-buffer-view 'thread)
898 (message "Inserting thread...")
899 (wl-thread-insert-top)
900 (message "Inserting thread...done"))
901 (wl-summary-make-number-list))
903 (setq wl-summary-scored nil)
904 (wl-summary-score-headers nil msgdb
905 (wl-summary-rescore-msgs number-alist)
907 (when (and wl-summary-scored
908 (setq expunged (wl-summary-score-update-all-lines)))
909 (message "%d message(s) are expunged by scoring." (length expunged))))
910 (wl-summary-set-message-modified)
911 (wl-summary-count-unread)
912 (wl-summary-update-modeline)
913 (goto-char (point-max))
915 (set-buffer-modified-p nil)))
917 (defun wl-summary-next-folder-or-exit (&optional next-entity upward)
921 (wl-summary-toggle-disp-msg 'off)
924 (wl-summary-goto-folder-subr next-entity
930 (wl-folder-set-current-entity-id (wl-folder-get-entity-id next-entity))
931 (if (and (eq retval 'more-next)
932 (memq wl-auto-select-next '(unread skip-no-unread))
933 (memq this-command wl-summary-next-no-unread-command))
936 t (eq wl-auto-select-next 'skip-no-unread))
937 (goto-char (point-max))
940 t (eq wl-auto-select-next 'skip-no-unread))))))
943 (defun wl-summary-entity-info-msg (entity finfo)
946 (elmo-replace-in-string
947 (if (memq 'ask-folder wl-use-folder-petname)
948 (wl-folder-get-petname entity)
951 (if (null (car finfo))
954 " (%d new/%d unread)"
960 (defun wl-summary-set-message-modified ()
961 (elmo-folder-set-message-modified-internal
962 wl-summary-buffer-elmo-folder t)
963 (setq wl-summary-buffer-message-modified t))
964 (defun wl-summary-message-modified-p ()
965 wl-summary-buffer-message-modified)
966 (defun wl-summary-set-mark-modified ()
967 (elmo-folder-set-mark-modified-internal
968 wl-summary-buffer-elmo-folder t)
969 (setq wl-summary-buffer-mark-modified t))
970 (defun wl-summary-mark-modified-p ()
971 wl-summary-buffer-mark-modified)
972 (defun wl-summary-set-thread-modified ()
973 (setq wl-summary-buffer-thread-modified t))
974 (defun wl-summary-thread-modified-p ()
975 wl-summary-buffer-thread-modified)
977 (defsubst wl-summary-cleanup-temp-marks (&optional sticky)
978 (if (or wl-summary-buffer-refile-list
979 wl-summary-buffer-copy-list
980 wl-summary-buffer-delete-list)
981 (if (y-or-n-p "Marks remain to be executed. Execute them? ")
984 (if (or wl-summary-buffer-refile-list
985 wl-summary-buffer-copy-list
986 wl-summary-buffer-delete-list)
987 (error "Some execution was failed")))
990 (wl-summary-delete-all-refile-marks)
991 (wl-summary-delete-all-copy-marks)
992 (wl-summary-delete-all-delete-marks)))
993 (if wl-summary-buffer-target-mark-list
995 (wl-summary-delete-all-target-marks)
996 (setq wl-summary-buffer-target-mark-list nil)))
997 (wl-summary-delete-all-temp-marks-on-buffer sticky)
998 (setq wl-summary-scored nil))
1000 ;; a subroutine for wl-summary-exit/wl-save-status
1001 ;; Note that folder is not commited here.
1002 (defun wl-summary-save-view ()
1003 ;; already in summary buffer.
1004 (when wl-summary-buffer-persistent
1005 ;; save the current summary buffer view.
1006 (if (and wl-summary-cache-use
1007 (or (wl-summary-message-modified-p)
1008 (wl-summary-mark-modified-p)
1009 (wl-summary-thread-modified-p)))
1010 (wl-summary-save-view-cache))))
1012 (defun wl-summary-save-status ()
1013 "Save summary view and msgdb."
1015 (if (interactive-p) (message "Saving summary status..."))
1016 (wl-summary-save-view)
1017 (elmo-folder-commit wl-summary-buffer-elmo-folder)
1018 (elmo-folder-check wl-summary-buffer-elmo-folder)
1019 (if wl-use-scoring (wl-score-save))
1020 (if (interactive-p) (message "Saving summary status...done.")))
1022 (defun wl-summary-force-exit ()
1023 "Exit current summary. Buffer is deleted even the buffer is sticky."
1025 (wl-summary-exit 'force-exit))
1027 (defun wl-summary-exit (&optional force-exit)
1028 "Exit current summary. if FORCE-EXIT, exits even the summary is sticky."
1030 (let ((summary-buf (current-buffer))
1031 (sticky (wl-summary-sticky-p))
1033 message-buf message-win
1034 folder-buf folder-win)
1035 (run-hooks 'wl-summary-exit-pre-hook)
1036 (if wl-summary-buffer-exit-function
1037 (funcall wl-summary-buffer-exit-function)
1038 (if (or force-exit (not sticky))
1039 (wl-summary-cleanup-temp-marks sticky))
1041 ;; save summary status
1043 (wl-summary-save-view)
1044 (if (or force-exit (not sticky))
1045 (elmo-folder-close wl-summary-buffer-elmo-folder)
1046 (elmo-folder-commit wl-summary-buffer-elmo-folder)
1047 (elmo-folder-check wl-summary-buffer-elmo-folder))
1048 (if wl-use-scoring (wl-score-save)))
1049 ;; for sticky summary
1050 (wl-delete-all-overlays)
1051 (setq wl-summary-buffer-disp-msg nil)
1052 (elmo-kill-buffer wl-summary-search-buf-name)
1053 ;; delete message window if displayed.
1054 (if (and wl-message-buffer (get-buffer-window wl-message-buffer))
1055 (delete-window (get-buffer-window wl-message-buffer)))
1056 (if (and wl-summary-use-frame
1057 (> (length (visible-frame-list)) 1))
1059 (if (setq folder-buf (get-buffer wl-folder-buffer-name))
1060 (if wl-summary-use-frame
1062 (save-selected-window
1063 (dolist (frame (visible-frame-list))
1064 (select-frame frame)
1065 (if (get-buffer-window folder-buf)
1066 (setq select-frame frame))))
1068 (select-frame select-frame)
1069 (switch-to-buffer folder-buf)))
1070 (if (setq folder-win (get-buffer-window folder-buf))
1071 ;; folder win is already displayed.
1072 (select-window folder-win)
1073 ;; folder win is not displayed.
1074 (switch-to-buffer folder-buf)))
1075 ;; currently no folder buffer
1077 (and wl-folder-move-cur-folder
1078 wl-folder-buffer-cur-point
1079 (goto-char wl-folder-buffer-cur-point))
1080 (setq wl-folder-buffer-cur-path nil)
1081 (setq wl-folder-buffer-cur-entity-id nil)
1082 (wl-delete-all-overlays)
1083 (if wl-summary-exit-next-move
1084 (wl-folder-next-unsync t)
1085 (beginning-of-line))
1086 (if (setq summary-win (get-buffer-window summary-buf))
1087 (delete-window summary-win))
1091 (set-buffer summary-buf)
1092 (kill-buffer summary-buf)))
1093 (run-hooks 'wl-summary-exit-hook)))))
1095 (defun wl-summary-suspend ()
1098 (wl-folder-suspend))
1100 (defun wl-summary-sync-force-update (&optional unset-cursor no-check)
1102 (wl-summary-sync-update unset-cursor nil no-check))
1104 (defsubst wl-summary-sync-all-init ()
1105 (wl-summary-cleanup-temp-marks)
1107 (wl-summary-set-message-modified)
1108 (wl-summary-set-mark-modified)
1109 (setq wl-thread-entity-hashtb (elmo-make-hash
1110 (* (length (elmo-msgdb-get-number-alist
1111 (wl-summary-buffer-msgdb))) 2)))
1112 (setq wl-thread-entity-list nil)
1113 (setq wl-thread-entities nil)
1114 (setq wl-summary-buffer-number-list nil)
1115 (setq wl-summary-buffer-target-mark-list nil)
1116 (setq wl-summary-buffer-refile-list nil)
1117 (setq wl-summary-buffer-copy-list nil)
1118 (setq wl-summary-buffer-delete-list nil))
1120 (defun wl-summary-sync (&optional unset-cursor force-range)
1122 (let* ((folder wl-summary-buffer-elmo-folder)
1123 (inhibit-read-only t)
1124 (buffer-read-only nil)
1125 (msgdb-dir (elmo-folder-msgdb-path folder))
1126 (range (or force-range (wl-summary-input-range
1127 (elmo-folder-name-internal folder)))))
1128 (cond ((string= range "rescan")
1129 (let ((msg (wl-summary-message-number)))
1131 (and msg (wl-summary-jump-to-msg msg))))
1132 ((string= range "rescan-noscore")
1133 (let ((msg (wl-summary-message-number))
1136 (and msg (wl-summary-jump-to-msg msg))))
1137 ((string= range "cache-status")
1138 (let ((msg (wl-summary-message-number)))
1139 (wl-summary-resume-cache-status)
1140 (and msg (wl-summary-jump-to-msg msg))))
1141 ((or (string-match "last:" range)
1142 (string-match "first:" range))
1143 (wl-summary-goto-folder-subr (concat "/" range "/"
1144 (elmo-folder-name-internal
1146 'force-update nil nil t))
1148 (wl-summary-sync-update unset-cursor
1149 (cond ((string= range "all") 'all)
1150 ((string= range "all-visible")
1151 'visible-only)))))))
1153 (defvar wl-summary-edit-addresses-candidate-fields
1154 ;; First element becomes default.
1155 '("from" "to" "cc"))
1157 (defun wl-summary-edit-addresses-collect-candidate-fields (mime-charset)
1158 (let ((fields wl-summary-edit-addresses-candidate-fields)
1159 body candidates components)
1162 (mapconcat 'identity (elmo-multiple-field-body (car fields))
1164 (setq body (wl-parse-addresses body))
1165 (if body (setq candidates (append candidates body)))
1166 (setq fields (cdr fields)))
1167 (setq candidates (elmo-uniq-list candidates))
1169 (elmo-set-buffer-multibyte default-enable-multibyte-characters)
1172 (setq components (std11-extract-address-components x))
1173 (cons (nth 1 components)
1174 (and (car components)
1175 (eword-decode-string
1176 (decode-mime-charset-string
1181 (defun wl-summary-edit-addresses-subr (the-email name-in-addr)
1182 ;; returns nil if there's no change.
1183 (if (elmo-get-hash-val (downcase the-email) wl-address-petname-hash)
1185 (message "'%s' already exists. (e)dit/(d)elete/(c)ancel?"
1187 (while (not (or (eq (setq char (read-char)) ?\r)
1194 "Please answer `e' or `d' or `c'. (e)dit/(d)elete/(c)ancel?"))
1201 (wl-address-add-or-change
1203 (wl-address-header-extract-realname
1205 (let ((completion-ignore-case t) comp)
1207 (try-completion the-email wl-address-completion-list))
1208 (if (equal comp t) the-email comp))
1209 wl-address-completion-list))))
1213 (if (y-or-n-p (format "Delete '%s'? "
1216 (wl-address-delete the-email)
1223 (wl-address-add-or-change the-email name-in-addr)
1226 (defun wl-summary-edit-addresses (&optional addr-str)
1227 "Edit address book interactively.
1228 Optional argument ADDR-STR is used as a target address if specified."
1229 (interactive (if current-prefix-arg
1230 (list (read-from-minibuffer "Target address: "))))
1231 (if (null (wl-summary-message-number))
1232 (message "No message.")
1234 (let* ((charset wl-summary-buffer-mime-charset)
1236 (with-current-buffer (wl-summary-get-original-buffer)
1237 (wl-summary-edit-addresses-collect-candidate-fields
1239 address pair result)
1241 (setq address addr-str)
1243 (setq address (car (car candidates)))
1246 (format "Target address (%s): " address)
1248 (function (lambda (x) (cons (car x) (car x))))
1250 nil nil nil nil address))))
1252 (setq pair (assoc address candidates))
1254 (setq pair (cons address nil)))
1255 (when (setq result (wl-summary-edit-addresses-subr (car pair) (cdr pair)))
1258 (setq address (assoc (car pair) wl-address-list))
1260 (message "%s, %s, <%s> is %s."
1265 ;;; i'd like to update summary-buffer, but...
1266 ;;; (wl-summary-rescan)
1267 (run-hooks 'wl-summary-edit-addresses-hook))))))
1269 (defun wl-summary-incorporate (&optional arg)
1270 "Check and prefetch all uncached messages.
1271 If ARG is non-nil, checking is omitted."
1275 (wl-summary-sync-force-update)))
1276 (wl-summary-prefetch-region (point-min) (point-max)
1277 wl-summary-incorporate-marks))
1279 (defun wl-summary-prefetch-msg (number &optional arg)
1280 "Returns status-mark. if skipped, returns nil."
1281 ;; prefetching procedure.
1283 (let* ((msgdb (wl-summary-buffer-msgdb))
1284 (number-alist (elmo-msgdb-get-number-alist msgdb))
1285 (message-id (cdr (assq number number-alist)))
1286 (ov (elmo-msgdb-overview-get-entity message-id msgdb))
1288 (size (elmo-msgdb-overview-entity-get-size ov))
1289 (inhibit-read-only t)
1290 (buffer-read-only nil)
1291 (file-cached (elmo-file-cache-exists-p message-id))
1292 (force-read (and size
1293 (or (null wl-prefetch-threshold)
1294 (< size wl-prefetch-threshold))))
1298 (when (and (or arg (not file-cached))
1299 size (not force-read) wl-prefetch-confirm)
1305 "Message from %s has %d bytes. Prefetch it? "
1309 (wl-set-string-width
1311 (funcall wl-summary-from-function
1312 (eword-decode-string
1316 (elmo-msgdb-overview-entity-get-from ov)
1319 (message "")) ; flush.
1320 (setq mark (elmo-msgdb-get-mark msgdb number))
1325 (if (or arg (not file-cached))
1326 (elmo-message-encache
1327 wl-summary-buffer-elmo-folder
1332 wl-summary-unread-uncached-mark)
1333 wl-summary-unread-cached-mark)
1334 ((string= mark wl-summary-new-mark)
1335 (setq wl-summary-buffer-new-count
1336 (- wl-summary-buffer-new-count 1))
1337 (setq wl-summary-buffer-unread-count
1338 (+ wl-summary-buffer-unread-count 1))
1339 wl-summary-unread-cached-mark)
1340 ((string= mark wl-summary-read-uncached-mark)
1343 (elmo-msgdb-set-mark msgdb number new-mark)
1344 (or new-mark (setq new-mark " "))
1345 (wl-summary-set-mark-modified)
1346 (wl-summary-update-modeline)
1347 (wl-folder-update-unread
1348 (wl-summary-buffer-folder-name)
1349 (+ wl-summary-buffer-unread-count
1350 wl-summary-buffer-new-count)))
1353 ;;(defvar wl-summary-message-uncached-marks
1354 ;; (list wl-summary-new-mark
1355 ;; wl-summary-unread-uncached-mark
1356 ;; wl-summary-read-uncached-mark))
1358 (defun wl-summary-prefetch-region (beg end &optional prefetch-marks)
1366 (setq start-pos (point))
1368 (narrow-to-region beg end)
1369 ;; collect prefetch targets.
1370 (message "Collecting marks...")
1371 (goto-char (point-min))
1374 (when (looking-at "^ *\\(-?[0-9]+\\)[^0-9]\\([^0-9]\\)")
1375 (setq mark (wl-match-buffer 2))
1376 (setq msg (string-to-int (wl-match-buffer 1)))
1377 (if (or (and (null prefetch-marks)
1379 (null (elmo-file-cache-exists-p
1381 (elmo-msgdb-get-number-alist
1382 (wl-summary-buffer-msgdb)))))))
1383 (member mark prefetch-marks))
1384 (setq targets (nconc targets (list msg))))
1385 (setq entity (wl-thread-get-entity msg))
1386 (if (or (not (eq wl-summary-buffer-view 'thread))
1387 (wl-thread-entity-get-opened entity))
1388 (); opened. no hidden children.
1389 ;; hidden children!!
1390 (setq targets (nconc
1392 (wl-thread-get-children-msgs-uncached
1393 msg prefetch-marks)))))
1395 (setq length (length targets))
1396 (message "Prefetching...")
1398 (setq mark (if (not (wl-thread-entity-parent-invisible-p
1399 (wl-thread-get-entity (car targets))))
1401 (wl-summary-jump-to-msg (car targets))
1402 (wl-summary-prefetch))
1403 (wl-summary-prefetch-msg (car targets))))
1404 (if (if prefetch-marks
1405 (string= mark wl-summary-unread-cached-mark)
1406 (or (string= mark wl-summary-unread-cached-mark)
1407 (string= mark " ")))
1408 (message "Prefetching... %d/%d message(s)"
1409 (setq count (+ 1 count)) length))
1413 (goto-char start-pos)
1414 (if (pos-visible-in-window-p pos)
1418 (setq targets (cdr targets)))
1419 (message "Prefetched %d/%d message(s)" count length)
1420 (cons count length)))))
1422 (defun wl-summary-prefetch (&optional arg)
1423 "Prefetch current message."
1428 (when (looking-at "^ *\\(-?[0-9]+\\)[^0-9]\\([^0-9]\\)")
1429 (goto-char (match-beginning 2))
1430 (let ((inhibit-read-only t)
1431 (buffer-read-only nil)
1432 (beg (match-beginning 2))
1435 (setq mark (wl-summary-prefetch-msg
1436 (string-to-int (wl-match-buffer 1)) arg))
1438 (delete-region beg end)
1440 (if wl-summary-highlight
1441 (wl-highlight-summary-current-line)))
1442 (set-buffer-modified-p nil)
1445 (defun wl-summary-delete-marks-on-buffer (marks)
1447 (wl-summary-unmark (pop marks))))
1449 (defun wl-summary-delete-copy-marks-on-buffer (copies)
1450 (wl-summary-delete-marks-on-buffer copies))
1452 (defun wl-summary-delete-all-refile-marks ()
1453 (let ((marks wl-summary-buffer-refile-list))
1455 (wl-summary-unmark (car (pop marks))))))
1457 (defun wl-summary-delete-all-copy-marks ()
1458 (let ((marks wl-summary-buffer-copy-list))
1460 (wl-summary-unmark (car (pop marks))))))
1462 (defun wl-summary-delete-all-delete-marks ()
1463 (wl-summary-delete-marks-on-buffer wl-summary-buffer-delete-list))
1465 (defun wl-summary-delete-all-target-marks ()
1466 (wl-summary-delete-marks-on-buffer wl-summary-buffer-target-mark-list))
1468 (defun wl-summary-delete-all-temp-marks-on-buffer (&optional sticky)
1469 ;; for summary view cache saving.
1472 (goto-char (point-min))
1473 (let ((inhibit-read-only t)
1474 (buffer-read-only nil)
1475 (case-fold-search nil)
1476 (regexp (concat wl-summary-message-regexp "\\([^ 0-9]\\)" )))
1477 (while (re-search-forward regexp nil t)
1478 (delete-region (match-beginning 1) (match-end 1))
1480 (if (and sticky wl-summary-highlight)
1481 (wl-highlight-summary-current-line))))))
1483 ;; Does not work correctly...
1484 (defun wl-summary-mark-as-read-region (beg end)
1488 (narrow-to-region beg end)
1490 ;;; (save-excursion (goto-char end)
1491 ;;; (end-of-line) (point)))
1492 (goto-char (point-min))
1493 (if (eq wl-summary-buffer-view 'thread)
1496 (let* ((number (wl-summary-message-number))
1497 (entity (wl-thread-get-entity number))
1499 (if (wl-thread-entity-get-opened entity)
1500 ;; opened...mark line.
1501 ;; Crossposts are not processed
1502 (wl-summary-mark-as-read t)
1504 (wl-summary-mark-as-read t) ; mark itself.
1505 (setq children (wl-thread-get-children-msgs number))
1507 (wl-summary-mark-as-read t nil nil (car children))
1508 (setq children (cdr children))))
1511 (wl-summary-mark-as-read t)
1512 (forward-line 1)))))
1513 (wl-summary-count-unread)
1514 (wl-summary-update-modeline))
1516 (defun wl-summary-mark-as-unread-region (beg end)
1520 (narrow-to-region beg end)
1522 ;;; (save-excursion (goto-char end)
1523 ;;; (end-of-line) (point)))
1524 (goto-char (point-min))
1525 (if (eq wl-summary-buffer-view 'thread)
1528 (let* ((number (wl-summary-message-number))
1529 (entity (wl-thread-get-entity number))
1531 (if (wl-thread-entity-get-opened entity)
1532 ;; opened...mark line.
1533 ;; Crossposts are not processed
1534 (wl-summary-mark-as-unread)
1536 (wl-summary-mark-as-unread) ; mark itself.
1538 (delq number (wl-thread-get-children-msgs number)))
1540 (wl-summary-mark-as-unread (car children))
1541 (setq children (cdr children))))
1544 (wl-summary-mark-as-unread)
1545 (forward-line 1)))))
1546 (wl-summary-count-unread)
1547 (wl-summary-update-modeline))
1549 (defun wl-summary-mark-as-important-region (beg end)
1553 (narrow-to-region beg end);(save-excursion (goto-char end)
1554 ; (end-of-line) (point)))
1555 (goto-char (point-min))
1556 (if (eq wl-summary-buffer-view 'thread)
1559 (let* ((number (wl-summary-message-number))
1560 (entity (wl-thread-get-entity number))
1562 (if (wl-thread-entity-get-opened entity)
1563 ;; opened...mark line.
1564 ;; Crossposts are not processed
1565 (wl-summary-mark-as-important)
1567 (wl-summary-mark-as-important) ; mark itself.
1569 (delq number (wl-thread-get-children-msgs number)))
1571 (wl-thread-msg-mark-as-important (car children))
1572 (setq children (cdr children))))
1575 (wl-summary-mark-as-important)
1576 (forward-line 1)))))
1577 (wl-summary-count-unread)
1578 (wl-summary-update-modeline))
1580 (defun wl-summary-mark-as-read-all ()
1582 (if (or (not (interactive-p))
1583 (y-or-n-p "Mark all messages as read? "))
1584 (let* ((folder wl-summary-buffer-elmo-folder)
1585 (cur-buf (current-buffer))
1586 (msgdb (wl-summary-buffer-msgdb))
1587 (inhibit-read-only t)
1588 (buffer-read-only nil)
1589 (case-fold-search nil)
1591 (message "Setting all msgs as read...")
1592 (elmo-folder-mark-as-read folder
1593 (elmo-folder-list-unreads
1595 (list wl-summary-unread-cached-mark
1596 wl-summary-unread-uncached-mark
1597 wl-summary-new-mark)))
1599 (goto-char (point-min))
1600 (while (re-search-forward "^ *\\(-?[0-9]+\\)[^0-9]\\([^0-9 ]\\)"
1602 (setq msg (string-to-int (wl-match-buffer 1)))
1603 (setq mark (wl-match-buffer 2))
1604 (when (and (not (string= mark wl-summary-important-mark))
1605 (not (string= mark wl-summary-read-uncached-mark)))
1606 (delete-region (match-beginning 2) (match-end 2))
1607 (if (or (not (elmo-message-use-cache-p folder msg))
1608 (string= mark wl-summary-unread-cached-mark))
1611 (elmo-msgdb-set-mark msgdb msg nil))
1612 ;; New mark and unread-uncached mark
1613 (insert wl-summary-read-uncached-mark)
1614 (elmo-msgdb-set-mark
1615 msgdb msg wl-summary-read-uncached-mark))
1616 (if wl-summary-highlight
1617 (wl-highlight-summary-current-line nil nil t)))))
1618 (elmo-folder-replace-marks
1620 (list (cons wl-summary-unread-cached-mark
1622 (cons wl-summary-unread-uncached-mark
1623 wl-summary-read-uncached-mark)
1624 (cons wl-summary-new-mark
1625 wl-summary-read-uncached-mark)))
1626 (wl-summary-set-mark-modified)
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 (number-alist (elmo-msgdb-get-number-alist msgdb))
1643 (case-fold-search nil)
1644 mark number unread new-mark)
1646 (when (looking-at "^ *\\(-?[0-9]+\\)[^0-9]\\([^0-9]\\)")
1648 (setq mark (wl-match-buffer 2))
1650 ((or (string= mark wl-summary-new-mark)
1651 (string= mark wl-summary-unread-uncached-mark)
1652 (string= mark wl-summary-important-mark))
1655 ((string= mark wl-summary-unread-cached-mark)
1656 (setq new-mark wl-summary-unread-uncached-mark))
1658 (setq new-mark wl-summary-read-uncached-mark)))
1660 (setq number (string-to-int (wl-match-buffer 1)))
1661 (delete-region (match-beginning 2) (match-end 2))
1662 (goto-char (match-beginning 2))
1664 (elmo-file-cache-delete
1665 (elmo-file-cache-get-path
1666 (elmo-message-field wl-summary-buffer-elmo-folder
1669 (elmo-msgdb-set-mark msgdb number new-mark)
1670 (wl-summary-set-mark-modified)
1671 (if wl-summary-highlight
1672 (wl-highlight-summary-current-line nil nil t))
1673 (set-buffer-modified-p nil)))))))
1675 (defun wl-summary-resume-cache-status ()
1676 "Resume the cache status of all messages in the current folder."
1678 (let* ((folder wl-summary-buffer-elmo-folder)
1679 (cur-buf (current-buffer))
1680 (msgdb (wl-summary-buffer-msgdb))
1681 (number-alist (elmo-msgdb-get-number-alist msgdb))
1682 (inhibit-read-only t)
1683 (buffer-read-only nil)
1684 (case-fold-search nil)
1685 msg mark msgid set-mark)
1686 (message "Resuming cache status...")
1688 (goto-char (point-min))
1689 (while (re-search-forward "^ *\\(-?[0-9]+\\)[^0-9]\\([^0-9]\\)" nil t)
1690 (setq msg (string-to-int
1691 (wl-match-buffer 1)))
1692 (setq mark (wl-match-buffer 2))
1693 (setq msgid (elmo-msgdb-get-field msgdb msg 'message-id))
1695 (if (elmo-file-cache-exists-p msgid)
1697 (string= mark wl-summary-unread-uncached-mark) ; U -> !
1698 (string= mark wl-summary-new-mark) ; N -> !
1700 (setq set-mark wl-summary-unread-cached-mark)
1701 (if (string= mark wl-summary-read-uncached-mark) ; u -> ' '
1702 (setq set-mark " ")))
1703 (if (string= mark " ")
1704 (setq set-mark wl-summary-read-uncached-mark) ;' ' -> u
1705 (if (string= mark wl-summary-unread-cached-mark)
1706 (setq set-mark wl-summary-unread-uncached-mark) ; ! -> U
1709 (delete-region (match-beginning 2) (match-end 2))
1711 (elmo-msgdb-set-mark msgdb msg
1712 (if (string= set-mark " ") nil set-mark))
1713 (if wl-summary-highlight
1714 (wl-highlight-summary-current-line))))
1715 (wl-summary-set-mark-modified)
1716 (wl-summary-count-unread)
1717 (wl-summary-update-modeline)
1718 (message "Resuming cache status...done")
1719 (set-buffer-modified-p nil))))
1721 (defun wl-summary-delete-messages-on-buffer (msgs &optional deleting-info)
1724 (let ((inhibit-read-only t)
1725 (buffer-read-only nil)
1730 (elmo-kill-buffer wl-summary-search-buf-name)
1732 (if (eq wl-summary-buffer-view 'thread)
1734 ;; don't use wl-append(nconc), because list is broken. ...why?
1737 (wl-thread-delete-message (car msgs))))
1738 (setq update-list (delq (car msgs) update-list)))
1739 (goto-char (point-min))
1740 (if (re-search-forward (format "^ *%d[^0-9]\\([^0-9]\\).*$"
1743 (delete-region (match-beginning 0) (match-end 0))
1744 (delete-char 1) ; delete '\n'
1745 (setq wl-summary-buffer-number-list
1746 (delq (car msgs) wl-summary-buffer-number-list)))))
1747 (when (and deleting-info
1748 (> len elmo-display-progress-threshold))
1750 (if (or (zerop (% i 5)) (= i len))
1751 (elmo-display-progress
1752 'wl-summary-delete-messages-on-buffer deleting-info
1753 (/ (* i 100) len))))
1754 (setq msgs (cdr msgs)))
1755 (when (eq wl-summary-buffer-view 'thread)
1756 (wl-thread-update-line-msgs (elmo-uniq-list update-list)
1757 (unless deleting-info 'no-msg))
1758 (wl-thread-cleanup-symbols msgs2))
1759 (wl-summary-count-unread)
1760 (wl-summary-update-modeline)
1761 (wl-folder-update-unread
1762 (wl-summary-buffer-folder-name)
1763 (+ wl-summary-buffer-unread-count wl-summary-buffer-new-count)))))
1765 (defun wl-summary-replace-status-marks (before after)
1766 "Replace the status marks on buffer."
1769 (goto-char (point-min))
1770 (let ((inhibit-read-only t)
1771 (buffer-read-only nil)
1772 (regexp (concat wl-summary-message-regexp ".\\(\\%s\\)")))
1773 (while (re-search-forward
1774 (format regexp (regexp-quote before)) nil t)
1775 (delete-region (match-beginning 1) (match-end 1))
1777 (if wl-summary-highlight
1778 (wl-highlight-summary-current-line))))))
1780 (defun wl-summary-get-delete-folder (folder)
1781 (if (string= folder wl-trash-folder)
1783 (let* ((type (or (wl-get-assoc-list-value wl-delete-folder-alist folder)
1785 (cond ((stringp type)
1787 ((or (equal type 'remove) (equal type 'null))
1789 (t;; (equal type 'trash)
1790 (let ((trash-folder (wl-folder-get-elmo-folder wl-trash-folder)))
1791 (unless (elmo-folder-exists-p trash-folder)
1793 (format "Trash Folder %s does not exist, create it? "
1795 (elmo-folder-create trash-folder)
1796 (error "Trash Folder is not created"))))
1797 wl-trash-folder)))))
1799 (defun wl-summary-get-append-message-func ()
1800 (if (eq wl-summary-buffer-view 'thread)
1801 'wl-summary-insert-thread-entity
1802 'wl-summary-insert-sequential))
1804 (defun wl-summary-sort ()
1806 (let ((sort-by (let ((input-range-list '("number" "date" "subject" "from"))
1811 (format "Sort by (%s): " default)
1813 (function (lambda (x) (cons x x)))
1818 (if (not (member sort-by '("number" "date" "subject" "from")))
1819 (error "Sort by %s is not implemented" sort-by))
1820 (wl-summary-rescan sort-by)))
1822 (defun wl-summary-sync-marks ()
1823 "Update marks in summary."
1825 (let ((last-progress 0)
1827 unread-marks importants unreads
1828 importants-in-db unreads-in-db diff diffs
1830 ;; synchronize marks.
1831 (when (not (eq (elmo-folder-type-internal
1832 wl-summary-buffer-elmo-folder)
1834 (message "Updating marks...")
1835 (setq unread-marks (list wl-summary-unread-cached-mark
1836 wl-summary-unread-uncached-mark
1837 wl-summary-new-mark)
1838 importants-in-db (elmo-folder-list-messages-mark-match
1839 wl-summary-buffer-elmo-folder
1840 (regexp-quote wl-summary-important-mark))
1841 unreads-in-db (elmo-folder-list-messages-mark-match
1842 wl-summary-buffer-elmo-folder
1843 (wl-regexp-opt unread-marks))
1844 importants (elmo-folder-list-importants
1845 wl-summary-buffer-elmo-folder
1846 wl-summary-important-mark)
1847 unreads (elmo-folder-list-unreads
1848 wl-summary-buffer-elmo-folder
1850 (setq diff (elmo-list-diff importants importants-in-db))
1851 (setq diffs (cadr diff)) ; important-deletes
1852 (setq mes (format "Updated (-%d" (length diffs)))
1854 (wl-summary-mark-as-important (car diffs)
1855 wl-summary-important-mark
1857 (setq diffs (cdr diffs)))
1858 (setq diffs (car diff)) ; important-appends
1859 (setq mes (concat mes (format "/+%d) important," (length diffs))))
1861 (wl-summary-mark-as-important (car diffs) " " 'no-server)
1862 (setq diffs (cdr diffs)))
1863 (setq diff (elmo-list-diff unreads unreads-in-db))
1864 (setq diffs (cadr diff))
1865 (setq mes (concat mes (format "(-%d" (length diffs))))
1867 (wl-summary-mark-as-read t 'no-server nil (car diffs))
1868 (setq diffs (cdr diffs)))
1869 (setq diffs (car diff)) ; unread-appends
1870 (setq mes (concat mes (format "/+%d) unread mark(s)." (length diffs))))
1872 (wl-summary-mark-as-unread (car diffs) 'no-server 'no-modeline)
1873 (setq diffs (cdr diffs)))
1874 (if (interactive-p) (message mes)))))
1876 (defun wl-summary-sync-update (&optional unset-cursor sync-all no-check)
1877 "Update the summary view to the newest folder status."
1879 (let* ((folder wl-summary-buffer-elmo-folder)
1880 (case-fold-search nil)
1881 (elmo-mime-charset wl-summary-buffer-mime-charset)
1882 (inhibit-read-only t)
1883 (buffer-read-only nil)
1885 overview number-alist
1886 curp num i new-msgdb
1887 append-list delete-list crossed
1888 update-thread update-top-list
1889 expunged mes sync-result entity)
1892 (unless wl-summary-buffer-elmo-folder
1893 (error "(Internal error) Folder is not set:%s" (buffer-name
1895 (fset 'wl-summary-append-message-func-internal
1896 (wl-summary-get-append-message-func))
1897 ;; Flush pending append operations (disconnected operation).
1899 ;;(wl-summary-flush-pending-append-operations seen-list))
1900 (goto-char (point-max))
1901 (wl-folder-confirm-existence folder (elmo-folder-plugged-p folder))
1902 (setq sync-result (elmo-folder-synchronize
1905 wl-summary-unread-uncached-mark
1906 wl-summary-unread-cached-mark
1907 wl-summary-read-uncached-mark
1908 wl-summary-important-mark
1910 (setq new-msgdb (nth 0 sync-result))
1911 (setq delete-list (nth 1 sync-result))
1912 (setq crossed (nth 2 sync-result))
1916 (if sync-all (wl-summary-sync-all-init))
1918 ; (elmo-nntp-max-number-precedes-list-active-p))
1919 ;; XXX this does not work correctly in rare case.
1921 ; (wl-summary-delete-canceled-msgs-from-list
1923 ; (wl-summary-buffer-msgdb))))
1925 (wl-summary-delete-messages-on-buffer delete-list "Deleting...")
1926 (message "Deleting...done"))
1928 (wl-summary-replace-status-marks
1930 wl-summary-unread-uncached-mark))
1931 (setq append-list (elmo-msgdb-get-overview new-msgdb))
1932 (setq curp append-list)
1933 (setq num (length curp))
1937 ;; set these value for append-message-func
1938 (setq overview (elmo-msgdb-get-overview
1939 (elmo-folder-msgdb folder)))
1940 (setq number-alist (elmo-msgdb-get-number-alist
1941 (elmo-folder-msgdb folder)))
1943 (setq wl-summary-delayed-update nil)
1944 (elmo-kill-buffer wl-summary-search-buf-name)
1946 (setq entity (car curp))
1947 (when (setq update-thread
1948 (wl-summary-append-message-func-internal
1949 entity (elmo-folder-msgdb folder)
1951 (wl-append update-top-list update-thread))
1952 (if elmo-use-database
1953 (elmo-database-msgid-put
1954 (car entity) (elmo-folder-name-internal folder)
1955 (elmo-msgdb-overview-entity-get-number entity)))
1956 (setq curp (cdr curp))
1957 (when (> num elmo-display-progress-threshold)
1959 (if (or (zerop (% i 5)) (= i num))
1960 (elmo-display-progress
1961 'wl-summary-sync-update "Updating thread..."
1962 (/ (* i 100) num)))))
1963 (when wl-summary-delayed-update
1964 (while wl-summary-delayed-update
1965 (message "Parent (%d) of message %d is no entity"
1966 (caar wl-summary-delayed-update)
1967 (elmo-msgdb-overview-entity-get-number
1968 (cdar wl-summary-delayed-update)))
1969 (when (setq update-thread
1970 (wl-summary-append-message-func-internal
1971 (cdar wl-summary-delayed-update)
1972 (elmo-folder-msgdb folder)
1974 (wl-append update-top-list update-thread))
1975 (setq wl-summary-delayed-update
1976 (cdr wl-summary-delayed-update))))
1977 (when (and (eq wl-summary-buffer-view 'thread)
1979 (wl-thread-update-indent-string-thread
1980 (elmo-uniq-list update-top-list)))
1981 (message "Updating thread...done"))
1982 (unless (eq wl-summary-buffer-view 'thread)
1983 (wl-summary-make-number-list))
1984 (wl-summary-set-message-modified)
1985 (wl-summary-set-mark-modified)
1986 (when (and sync-all (eq wl-summary-buffer-view 'thread))
1987 (elmo-kill-buffer wl-summary-search-buf-name)
1988 (message "Inserting thread...")
1989 (setq wl-thread-entity-cur 0)
1990 (wl-thread-insert-top)
1991 (message "Inserting thread...done"))
1992 (if elmo-use-database
1993 (elmo-database-close))
1994 (run-hooks 'wl-summary-sync-updated-hook)
1996 (if (and (eq (length delete-list) 0)
1999 "No updates for \"%s\"" (elmo-folder-name-internal
2001 (format "Updated (-%d/+%d) message(s)"
2002 (length delete-list) num))))
2003 (setq mes "Quit updating.")))
2004 ;; synchronize marks.
2005 (if (and wl-summary-auto-sync-marks sync-result)
2006 (wl-summary-sync-marks))
2008 (when wl-use-scoring
2009 (setq wl-summary-scored nil)
2010 (wl-summary-score-headers nil (wl-summary-buffer-msgdb)
2012 (wl-summary-rescore-msgs number-alist))
2014 (when (and wl-summary-scored
2015 (setq expunged (wl-summary-score-update-all-lines)))
2016 (setq mes (concat mes
2017 (format " (%d expunged)"
2018 (length expunged))))))
2019 (if (and crossed (> crossed 0))
2023 (format " (%d crosspost)" crossed))
2024 (format "%d crosspost message(s)" crossed)))
2025 (and mes (setq mes (concat mes "."))))
2026 ;; Update Folder mode
2027 (wl-folder-set-folder-updated
2028 (elmo-folder-name-internal folder)
2030 (let ((pair (wl-summary-count-unread)))
2031 (+ (car pair) (cdr pair)))
2032 (elmo-folder-messages folder)))
2033 (wl-summary-update-modeline)
2035 (unless unset-cursor
2036 (goto-char (point-min))
2037 (if (not (wl-summary-cursor-down t))
2039 (goto-char (point-max))
2041 (if (and wl-summary-highlight
2042 (not (get-text-property (point) 'face)))
2046 wl-summary-partial-highlight-above-lines
2047 wl-summary-highlight-partial-threshold)))
2048 (wl-highlight-summary (point) (point-max))))))
2049 (setq wl-summary-buffer-msgdb (elmo-folder-msgdb folder))
2050 (wl-delete-all-overlays)
2051 (set-buffer-modified-p nil)
2052 (if mes (message "%s" mes)))))
2054 (defun wl-summary-set-score-mark (mark)
2057 (let ((inhibit-read-only t)
2058 (buffer-read-only nil)
2061 (when (looking-at "^ *\\(-?[0-9]+\\)\\([^0-9]\\)")
2062 (setq msg-num (string-to-int (wl-match-buffer 1)))
2063 (setq cur-mark (wl-match-buffer 2))
2064 (when (member cur-mark (list " "
2065 wl-summary-score-below-mark
2066 wl-summary-score-over-mark))
2067 (goto-char (match-end 1))
2068 (delete-region (match-beginning 2) (match-end 2))
2070 (if wl-summary-highlight
2071 (wl-highlight-summary-current-line nil nil t))
2072 (set-buffer-modified-p nil))))))
2074 (defun wl-summary-get-score-mark (msg-num)
2075 (let ((score (cdr (assq msg-num wl-summary-scored))))
2077 (cond ((< score wl-summary-default-score)
2079 ((> score wl-summary-default-score)
2082 (defun wl-summary-update-modeline ()
2083 (setq wl-summary-buffer-unread-status
2084 (format " {%s}(%d new/%d unread)"
2085 (if (eq wl-summary-buffer-view 'thread)
2087 wl-summary-buffer-new-count
2088 (+ wl-summary-buffer-new-count
2089 wl-summary-buffer-unread-count))))
2091 (defsubst wl-summary-jump-to-msg (&optional number)
2093 (let ((num (or number
2095 (read-from-minibuffer "Jump to Message(No.): ")))))
2096 (setq num (int-to-string num))
2098 (if (or (re-search-forward (concat "^[ \t]*" num "[^0-9]") nil t)
2099 (re-search-backward (concat "^[ \t]*" num "[^0-9]") nil t))
2100 (progn (beginning-of-line) t)
2103 (defun wl-summary-highlight-msgs (msgs)
2105 (let ((len (length msgs))
2107 (message "Hilighting...")
2110 (if (wl-summary-jump-to-msg (car msgs))
2111 (wl-highlight-summary-current-line))
2112 (setq msgs (cdr msgs))
2113 (when (> len elmo-display-progress-threshold)
2115 (if (or (zerop (% i 5)) (= i len))
2116 (elmo-display-progress
2117 'wl-summary-highlight-msgs "Highlighting..."
2118 (/ (* i 100) len)))))
2119 (message "Highlighting...done"))))
2121 (defun wl-summary-message-number ()
2124 (if (looking-at "^ *\\(-?[0-9]+\\)")
2125 (string-to-int (wl-match-buffer 1))
2128 (defun wl-summary-move (src dsts-msgs)
2129 (let* ((dsts (car dsts-msgs)) ; (+foo +bar)
2130 ;;; (msgs (cdr dsts-msgs)) ; (1 2 3)
2131 ;;; (msgdb (wl-summary-buffer-msgdb))
2135 (setq dsts (cdr dsts)))))
2137 (defun wl-summary-delete-all-msgs ()
2139 (let ((cur-buf (current-buffer))
2140 (dels (elmo-folder-list-messages wl-summary-buffer-elmo-folder)))
2141 (set-buffer cur-buf)
2143 (message "No message to delete.")
2144 (if (y-or-n-p (format "%s has %d message(s). Delete all? "
2145 (wl-summary-buffer-folder-name)
2148 (message "Deleting...")
2149 (elmo-folder-delete-messages
2150 wl-summary-buffer-elmo-folder dels)
2151 (elmo-msgdb-delete-msgs (wl-summary-buffer-msgdb)
2153 ;;; (elmo-msgdb-save (wl-summary-buffer-folder-name) nil)
2154 (wl-summary-set-message-modified)
2155 (wl-summary-set-mark-modified)
2156 (wl-folder-set-folder-updated (wl-summary-buffer-folder-name)
2159 ;;; (setq wl-thread-top-entity '(nil t nil nil))
2160 (setq wl-summary-buffer-unread-count 0)
2161 (setq wl-summary-buffer-new-count 0)
2162 (wl-summary-update-modeline)
2163 (set-buffer cur-buf)
2164 (let ((inhibit-read-only t)
2165 (buffer-read-only nil))
2167 ;;; (if wl-summary-cache-use (wl-summary-save-view-cache))
2168 (message "Deleting...done")
2172 (defun wl-summary-toggle-thread (&optional arg)
2173 "Toggle thread status (T)hread and (S)equential.
2174 If ARG, without confirm."
2177 (y-or-n-p (format "Toggle threading? (y=%s): "
2178 (if (eq wl-summary-buffer-view 'thread)
2179 "\"off\"" "\"on\""))))
2180 (if (eq wl-summary-buffer-view 'thread)
2181 (setq wl-summary-buffer-view 'sequence)
2182 (setq wl-summary-buffer-view 'thread))
2183 (wl-summary-update-modeline)
2184 (force-mode-line-update)
2185 (wl-summary-rescan)))
2187 (defun wl-summary-load-file-object (filename)
2188 "Load lisp object from dir."
2190 (let ((tmp-buffer (get-buffer-create " *wl-summary-load-file-object*"))
2191 insert-file-contents-pre-hook ; To avoid autoconv-xmas...
2192 insert-file-contents-post-hook
2194 (if (not (file-readable-p filename))
2196 (set-buffer tmp-buffer)
2197 (as-binary-input-file (insert-file-contents filename))
2200 (read (current-buffer))
2201 (error (error "Reading failed")))))
2202 (kill-buffer tmp-buffer)
2205 (defun wl-summary-goto-folder (&optional arg)
2207 (wl-summary-goto-folder-subr nil nil nil nil t nil arg))
2209 (defun wl-summary-goto-folder-sticky ()
2211 (wl-summary-goto-folder-subr nil nil nil t t))
2213 (defun wl-summary-goto-last-visited-folder ()
2216 (wl-folder-search-entity-by-name wl-summary-last-visited-folder
2219 (if entity (wl-folder-set-current-entity-id
2220 (wl-folder-get-entity-id entity))))
2221 (wl-summary-goto-folder-subr wl-summary-last-visited-folder nil nil nil t))
2223 (defun wl-summary-sticky-p (&optional folder)
2225 (get-buffer (wl-summary-sticky-buffer-name
2226 (elmo-folder-name-internal folder)))
2227 (not (string= wl-summary-buffer-name (buffer-name)))))
2229 (defun wl-summary-always-sticky-folder-p (folder)
2230 (or (eq t wl-summary-always-sticky-folder-list)
2231 (wl-string-match-member
2232 (elmo-folder-name-internal folder)
2233 wl-summary-always-sticky-folder-list)))
2235 (defun wl-summary-stick (&optional force)
2236 "Make current summary buffer sticky."
2238 (if (wl-summary-sticky-p)
2239 (message "Current summary buffer is already sticky.")
2240 (when (or force (y-or-n-p "Stick current summary buffer? "))
2241 (wl-summary-toggle-disp-msg 'off)
2242 (wl-summary-switch-to-clone-buffer
2243 (wl-summary-sticky-buffer-name
2244 (wl-summary-buffer-folder-name)))
2246 ;;; (rename-buffer (wl-summary-sticky-buffer-name
2247 ;;; (wl-summary-buffer-folder-name))))
2248 (message "Folder `%s' is now sticky." (wl-summary-buffer-folder-name)))))
2250 (defun wl-summary-switch-to-clone-buffer (buffer-name)
2251 (let ((cur-buf (current-buffer))
2252 (msg (wl-summary-message-number))
2253 (buf (get-buffer-create buffer-name))
2254 (folder wl-summary-buffer-elmo-folder)
2256 (append '(wl-summary-buffer-view
2257 wl-summary-buffer-refile-list
2258 wl-summary-buffer-delete-list
2259 wl-summary-buffer-copy-list
2260 wl-summary-buffer-target-mark-list
2261 wl-summary-buffer-elmo-folder
2262 wl-summary-buffer-number-column
2263 wl-summary-buffer-message-modified
2264 wl-summary-buffer-mark-modified
2265 wl-summary-buffer-thread-modified
2266 wl-summary-buffer-number-list
2267 wl-summary-buffer-msgdb
2268 wl-summary-buffer-folder-name
2269 wl-summary-buffer-line-formatter)
2270 (and (eq wl-summary-buffer-view 'thread)
2271 '(wl-thread-entity-hashtb
2273 wl-thread-entity-list))
2276 wl-summary-default-score
2277 wl-summary-important-above
2278 wl-summary-target-above
2279 wl-summary-mark-below
2280 wl-summary-expunge-below))
2281 (and (featurep 'wl-score)
2282 '(wl-current-score-file
2286 (wl-summary-buffer-set-folder folder)
2287 (let ((buffer-read-only nil))
2288 (insert-buffer cur-buf))
2289 (set-buffer-modified-p nil)
2290 (while copy-variables
2291 (set (car copy-variables)
2293 (set-buffer cur-buf)
2294 (symbol-value (car copy-variables))))
2295 (setq copy-variables (cdr copy-variables)))
2296 (switch-to-buffer buf)
2297 (kill-buffer cur-buf)
2298 (wl-summary-count-unread)
2299 (wl-summary-update-modeline)
2301 (if (eq wl-summary-buffer-view 'thread)
2302 (wl-thread-jump-to-msg msg)
2303 (wl-summary-jump-to-msg msg))
2304 (goto-char (point-max))
2305 (beginning-of-line))))
2307 (defun wl-summary-get-buffer (folder)
2309 (get-buffer (wl-summary-sticky-buffer-name folder)))
2310 (get-buffer wl-summary-buffer-name)))
2312 (defun wl-summary-get-buffer-create (name &optional force-sticky)
2315 (wl-summary-sticky-buffer-name name))
2316 (or (get-buffer (wl-summary-sticky-buffer-name name))
2317 (get-buffer-create wl-summary-buffer-name))))
2319 (defun wl-summary-make-number-list ()
2320 (setq wl-summary-buffer-number-list
2322 (lambda (x) (elmo-msgdb-overview-entity-get-number x))
2323 (elmo-msgdb-get-overview (wl-summary-buffer-msgdb)))))
2325 (defun wl-summary-auto-select-msg-p (unread-msg)
2328 (elmo-msgdb-get-mark
2329 (wl-summary-buffer-msgdb)
2331 wl-summary-important-mark))))
2333 (defsubst wl-summary-open-folder (folder)
2335 (let ((elmo-mime-charset wl-summary-buffer-mime-charset))
2337 (elmo-folder-open folder 'load-msgdb)
2338 ;; For compatibility
2339 (setq wl-summary-buffer-msgdb (elmo-folder-msgdb folder))
2340 (setq wl-summary-buffer-folder-name (elmo-folder-name-internal
2343 (defun wl-summary-goto-folder-subr (&optional name scan-type other-window
2344 sticky interactive scoring
2346 "Display target folder on summary."
2348 (let* ((keep-cursor (memq this-command
2349 wl-summary-keep-cursor-command))
2350 (name (or name (wl-summary-read-folder wl-default-folder)))
2351 (cur-fld wl-summary-buffer-elmo-folder)
2352 folder buf mes hilit reuse-buf
2354 (if (string= name "")
2355 (setq name wl-default-folder))
2356 (setq folder (wl-folder-get-elmo-folder name))
2357 (when (and (not (string=
2358 (and cur-fld (elmo-folder-name-internal cur-fld))
2359 (elmo-folder-name-internal folder))) ; folder is moved.
2360 (eq major-mode 'wl-summary-mode)) ; called in summary.
2361 (setq wl-summary-last-visited-folder (wl-summary-buffer-folder-name))
2362 (run-hooks 'wl-summary-exit-pre-hook)
2363 (if (or force-exit (not (wl-summary-sticky-p)))
2364 (wl-summary-cleanup-temp-marks (wl-summary-sticky-p)))
2365 (wl-summary-save-view)
2366 (elmo-folder-commit wl-summary-buffer-elmo-folder)
2367 (if (and (wl-summary-sticky-p) force-exit)
2368 (kill-buffer (current-buffer))))
2369 (setq buf (wl-summary-get-buffer-create (elmo-folder-name-internal folder)
2374 (string= (elmo-folder-name-internal folder)
2375 (wl-summary-buffer-folder-name))))
2379 (switch-to-buffer buf)
2382 (delete-other-windows))
2384 (unless (eq major-mode 'wl-summary-mode)
2386 (wl-summary-buffer-set-folder folder)
2387 (setq wl-summary-buffer-disp-msg nil)
2388 (setq wl-summary-buffer-last-displayed-msg nil)
2389 (setq wl-summary-buffer-current-msg nil)
2390 (let ((case-fold-search nil)
2391 (inhibit-read-only t)
2392 (buffer-read-only nil))
2394 ;; Resume summary view
2395 (if wl-summary-cache-use
2396 (let* ((dir (elmo-folder-msgdb-path folder))
2397 (cache (expand-file-name wl-summary-cache-file dir))
2398 (view (expand-file-name wl-summary-view-file dir)))
2399 (when (file-exists-p cache)
2400 (insert-file-contents-as-binary cache)
2401 (elmo-set-buffer-multibyte
2402 default-enable-multibyte-characters)
2403 (decode-mime-charset-region
2404 (point-min)(point-max)
2405 wl-summary-buffer-mime-charset))
2406 (when (file-exists-p view)
2407 (setq wl-summary-buffer-view
2408 (wl-summary-load-file-object view)))
2409 (wl-thread-resume-entity folder)
2410 (wl-summary-open-folder folder))
2411 (setq wl-summary-buffer-view
2412 (wl-summary-load-file-object
2413 (expand-file-name wl-summary-view-file
2414 (elmo-folder-msgdb-path folder))))
2415 (wl-summary-open-folder folder)
2416 (wl-summary-rescan))
2417 (wl-summary-count-unread)
2418 (wl-summary-update-modeline)))
2419 (unless (eq wl-summary-buffer-view 'thread)
2420 (wl-summary-make-number-list))
2421 (wl-summary-toggle-disp-msg (if wl-summary-buffer-disp-msg 'on 'off))
2422 (unless (and reuse-buf keep-cursor)
2423 ;(setq hilit wl-summary-highlight)
2425 (let ((wl-summary-highlight (if reuse-buf wl-summary-highlight))
2427 (if (or scoring interactive) wl-use-scoring)))
2428 (if (and (not scan-type)
2431 (setq scan-type (wl-summary-get-sync-range folder)))
2434 (wl-summary-sync 'unset-cursor))
2435 ((eq scan-type 'all)
2436 (wl-summary-sync 'unset-cursor "all"))
2437 ((eq scan-type 'no-sync))
2438 ((or (eq scan-type 'force-update)
2439 (eq scan-type 'update))
2440 (setq mes (wl-summary-sync-force-update
2441 'unset-cursor 'no-check)))))
2443 (switch-to-buffer buf)
2445 ;; stick always-sticky-folder
2446 (when (wl-summary-always-sticky-folder-p folder)
2447 (or (wl-summary-sticky-p) (wl-summary-stick t)))
2448 (run-hooks 'wl-summary-prepared-pre-hook)
2449 (set-buffer-modified-p nil)
2450 (goto-char (point-min))
2451 (if (wl-summary-cursor-down t)
2452 (let ((unreadp (wl-summary-next-message
2453 (wl-summary-message-number)
2455 (cond ((and wl-auto-select-first
2456 (wl-summary-auto-select-msg-p unreadp))
2457 ;; wl-auto-select-first is non-nil and
2458 ;; unreadp is non-nil but not important
2459 (setq retval 'disp-msg))
2460 ((and wl-auto-prefetch-first
2461 (wl-summary-auto-select-msg-p unreadp))
2462 ;; wl-auto-select-first is non-nil and
2463 ;; unreadp is non-nil but not important
2464 (setq retval 'prefetch-msg))
2465 ((not (wl-summary-auto-select-msg-p unreadp))
2466 ;; unreadp is nil or important
2467 (setq retval 'more-next))))
2468 (goto-char (point-max))
2469 (if (elmo-folder-plugged-p folder)
2472 (setq retval 'more-next))
2473 ;(setq wl-summary-highlight hilit)
2474 (if (and wl-summary-highlight
2475 (not wl-summary-lazy-highlight)
2477 (if (and wl-summary-highlight-partial-threshold
2478 (> (count-lines (point-min) (point-max))
2479 wl-summary-highlight-partial-threshold))
2484 wl-summary-partial-highlight-above-lines
2485 wl-summary-highlight-partial-threshold)))
2486 (wl-highlight-summary (point) (point-max)))
2487 (wl-highlight-summary (point-min) (point-max))))
2488 (if (eq retval 'disp-msg)
2489 (wl-summary-redisplay))
2490 (if (eq retval 'prefetch-msg)
2491 (wl-message-buffer-prefetch
2493 (wl-summary-message-number)
2494 wl-message-buffer-prefetch-depth
2496 wl-summary-buffer-mime-charset))
2497 (if mes (message "%s" mes))
2498 (if (and interactive wl-summary-recenter)
2499 (recenter (/ (- (window-height) 2) 2))))))
2500 ;; set current entity-id
2501 (if (and (not folder)
2503 (wl-folder-search-entity-by-name (elmo-folder-name-internal
2507 ;; entity-id is unknown.
2508 (wl-folder-set-current-entity-id
2509 (wl-folder-get-entity-id entity)))
2511 (run-hooks 'wl-summary-prepared-hook)
2512 (set-buffer-modified-p nil))
2515 (defun wl-summary-goto-previous-message-beginning ()
2517 (re-search-backward wl-summary-message-regexp nil t)
2518 (beginning-of-line))
2520 (defun wl-summary-goto-top-of-current-thread ()
2521 (wl-summary-jump-to-msg
2522 (wl-thread-entity-get-number
2523 (wl-thread-entity-get-top-entity (wl-thread-get-entity
2524 (wl-summary-message-number))))))
2526 (defun wl-summary-goto-bottom-of-sub-thread (&optional depth)
2528 (let ((depth (or depth
2529 (wl-thread-get-depth-of-current-line))))
2531 (while (and (not (eobp))
2532 (>= (wl-thread-get-depth-of-current-line)
2535 (beginning-of-line)))
2537 (defun wl-summary-insert-line (line)
2538 "Insert LINE in the Summary."
2539 (if wl-use-highlight-mouse-line
2540 ;; remove 'mouse-face of current line.
2542 (save-excursion (beginning-of-line)(point))
2543 (save-excursion (end-of-line)(point))
2546 (if wl-use-highlight-mouse-line
2547 ;; remove 'mouse-face of current line.
2549 (save-excursion (beginning-of-line)(point))
2550 (save-excursion (end-of-line)(point))
2553 (run-hooks 'wl-summary-line-inserted-hook)))
2555 (defun wl-summary-insert-sequential (entity msgdb &rest args)
2556 (let ((inhibit-read-only t)
2558 (goto-char (point-max))
2559 (wl-summary-insert-line
2560 (wl-summary-create-line entity nil nil))))
2562 (defun wl-summary-default-subject-filter (subject)
2563 (let ((case-fold-search t))
2564 (setq subject (elmo-replace-in-string subject "[ \t]*\\(re\\|was\\)[:>]" ""))
2565 (setq subject (elmo-replace-in-string subject "[ \t]" ""))
2566 (elmo-replace-in-string subject "^\\[.*\\]" "")))
2568 (defun wl-summary-subject-equal (subject1 subject2)
2569 (string= (funcall wl-summary-subject-filter-function subject1)
2570 (funcall wl-summary-subject-filter-function subject2)))
2572 (defmacro wl-summary-put-alike (alike)
2573 (` (elmo-set-hash-val (format "#%d" (wl-count-lines))
2575 wl-summary-alike-hashtb)))
2577 (defmacro wl-summary-get-alike ()
2578 (` (elmo-get-hash-val (format "#%d" (wl-count-lines))
2579 wl-summary-alike-hashtb)))
2581 (defun wl-summary-insert-headers (overview func mime-decode)
2582 (let (ov this last alike)
2583 (buffer-disable-undo (current-buffer))
2584 (make-local-variable 'wl-summary-alike-hashtb)
2585 (setq wl-summary-alike-hashtb (elmo-make-hash (* (length overview) 2)))
2587 (elmo-set-buffer-multibyte default-enable-multibyte-characters))
2588 (while (setq ov (pop overview))
2589 (setq this (funcall func ov))
2590 (and this (setq this (std11-unfold-string this)))
2591 (if (equal last this)
2592 (wl-append alike (list ov))
2594 (wl-summary-put-alike alike)
2596 (setq alike (list ov)
2599 (wl-summary-put-alike alike)
2602 (decode-mime-charset-region (point-min) (point-max)
2604 (when (eq mime-decode 'mime)
2605 (eword-decode-region (point-min) (point-max))))
2606 (run-hooks 'wl-summary-insert-headers-hook)))
2608 (defun wl-summary-search-by-subject (entity overview)
2609 (let ((summary-buf (current-buffer))
2610 (buf (get-buffer-create wl-summary-search-buf-name))
2611 (folder-name (wl-summary-buffer-folder-name))
2612 match founds found-entity)
2613 (with-current-buffer buf
2614 (let ((case-fold-search t))
2615 (when (or (not (string= wl-summary-search-buf-folder-name folder-name))
2616 (zerop (buffer-size)))
2617 (setq wl-summary-search-buf-folder-name folder-name)
2618 (wl-summary-insert-headers
2622 (funcall wl-summary-subject-filter-function
2623 (elmo-msgdb-overview-entity-get-subject-no-decode x))))
2625 (setq match (funcall wl-summary-subject-filter-function
2626 (elmo-msgdb-overview-entity-get-subject entity)))
2627 (if (string= match "")
2629 (goto-char (point-min))
2630 (while (and (not founds)
2631 (not (= (point) (point-max)))
2632 (search-forward match nil t))
2633 ;; check exactly match
2636 (match-beginning 0)))
2637 (setq found-entity (wl-summary-get-alike))
2638 (if (and found-entity
2639 ;; Is founded entity myself or children?
2641 (elmo-msgdb-overview-entity-get-id entity)
2642 (elmo-msgdb-overview-entity-get-id
2643 (car found-entity))))
2644 (with-current-buffer summary-buf
2645 (not (wl-thread-descendant-p
2646 (elmo-msgdb-overview-entity-get-number entity)
2647 (elmo-msgdb-overview-entity-get-number
2648 (car found-entity))))))
2649 ;; return matching entity
2650 (setq founds found-entity))))
2654 (defun wl-summary-insert-thread-entity (entity msgdb update
2655 &optional force-insert)
2656 (let* ((overview (elmo-msgdb-get-overview msgdb))
2660 (case-fold-search t)
2661 cur number overview2 cur-entity linked retval delayed-entity
2662 update-list entity-stack)
2664 (setq this-id (elmo-msgdb-overview-entity-get-id entity)
2666 (elmo-msgdb-get-parent-entity entity msgdb)
2667 parent-number (elmo-msgdb-overview-entity-get-number
2669 (setq number (elmo-msgdb-overview-entity-get-number entity))
2670 ;; If thread loop detected, set parent as nil.
2673 (if (eq number (elmo-msgdb-overview-entity-get-number
2675 (elmo-msgdb-get-parent-entity cur msgdb))))
2676 (setq parent-number nil
2678 (if (and parent-number
2679 (not (wl-thread-get-entity parent-number))
2681 ;; parent exists in overview, but not in wl-thread-entities
2683 (wl-append wl-summary-delayed-update
2684 (list (cons parent-number entity)))
2685 (setq entity nil)) ;; exit loop
2686 ;; Search parent by subject.
2687 (when (and (null parent-number)
2688 wl-summary-search-parent-by-subject-regexp
2690 wl-summary-search-parent-by-subject-regexp
2691 (elmo-msgdb-overview-entity-get-subject entity)))
2692 (let ((found (wl-summary-search-by-subject entity overview)))
2694 (not (member found wl-summary-delayed-update)))
2695 (setq parent-entity found)
2697 (elmo-msgdb-overview-entity-get-number parent-entity))
2699 ;; If subject is change, divide thread.
2700 (if (and parent-number
2701 wl-summary-divide-thread-when-subject-changed
2702 (not (wl-summary-subject-equal
2703 (or (elmo-msgdb-overview-entity-get-subject
2705 (or (elmo-msgdb-overview-entity-get-subject
2706 parent-entity) ""))))
2707 (setq parent-number nil))
2709 (wl-thread-insert-message entity
2710 number parent-number update linked))
2712 (wl-append update-list (list retval)))
2713 (setq entity nil) ; exit loop
2714 (while (setq delayed-entity (assq number wl-summary-delayed-update))
2715 (setq wl-summary-delayed-update
2716 (delq delayed-entity wl-summary-delayed-update))
2717 ;; update delayed message
2718 (wl-append entity-stack (list (cdr delayed-entity)))))
2719 (if (and (not entity)
2721 (setq entity (pop entity-stack))))
2724 (defun wl-summary-update-thread (entity
2727 (let* ((this-id (elmo-msgdb-overview-entity-get-id entity))
2728 (overview-entity entity)
2729 (parent-id (elmo-msgdb-overview-entity-get-id parent-entity))
2730 (parent-number (elmo-msgdb-overview-entity-get-number parent-entity))
2731 summary-line msg subject-differ)
2733 ((or (not parent-id)
2734 (string= this-id parent-id))
2735 (goto-char (point-max))
2736 (beginning-of-line))
2737 ;; parent already exists in buffer.
2738 ((wl-summary-jump-to-msg parent-number)
2739 (wl-thread-goto-bottom-of-sub-thread)))
2740 (let ((inhibit-read-only t)
2741 (buffer-read-only nil))
2742 (wl-summary-insert-line
2743 (wl-summary-create-line
2747 (wl-thread-maybe-get-children-num msg)
2748 (wl-thread-make-indent-string thr-entity)
2749 (wl-thread-entity-get-linked thr-entity))))))
2751 (defun wl-summary-mark-as-unread (&optional number
2757 (inhibit-read-only t)
2758 (buffer-read-only nil)
2759 (folder wl-summary-buffer-elmo-folder)
2760 (msgdb (wl-summary-buffer-msgdb))
2761 ;;; (number-alist (elmo-msgdb-get-number-alist msgdb))
2762 new-mark visible mark)
2765 (setq visible (wl-summary-jump-to-msg number))
2766 (unless (setq mark (elmo-msgdb-get-mark msgdb number))
2771 (if (null (wl-summary-message-number))
2772 (message "No message.")
2775 (wl-summary-goto-previous-message-beginning)))
2776 (if (or (and (not visible)
2777 ;; already exists in msgdb.
2778 (assq number (elmo-msgdb-get-number-alist msgdb)))
2780 (format (concat "^ *\\("
2781 (if number (int-to-string number)
2783 "\\)[^0-9]\\(%s\\|%s\\)")
2784 wl-summary-read-uncached-mark
2787 (setq number (or number (string-to-int (wl-match-buffer 1))))
2788 (setq mark (or mark (elmo-match-buffer 2)))
2790 (setq new-mark (if (string= mark
2791 wl-summary-read-uncached-mark)
2792 wl-summary-unread-uncached-mark
2793 (if (elmo-message-use-cache-p folder number)
2794 wl-summary-unread-mark
2795 wl-summary-unread-uncached-mark))))
2797 (unless no-server-update
2799 (unless (elmo-folder-unmark-read folder (list number))
2800 (error "Setting mark failed"))))
2802 (delete-region (match-beginning 2) (match-end 2))
2804 (elmo-msgdb-set-mark msgdb number new-mark)
2805 (unless no-modeline-update
2806 (setq wl-summary-buffer-unread-count
2807 (+ 1 wl-summary-buffer-unread-count))
2808 (wl-summary-update-modeline)
2809 (wl-folder-update-unread
2810 (wl-summary-buffer-folder-name)
2811 (+ wl-summary-buffer-unread-count
2812 wl-summary-buffer-new-count)))
2813 (wl-summary-set-mark-modified)
2814 (if (and visible wl-summary-highlight)
2815 (wl-highlight-summary-current-line))))))
2816 (set-buffer-modified-p nil))
2818 (defun wl-summary-delete (&optional number)
2819 "Mark Delete mark 'D'.
2820 If optional argument NUMBER is specified, mark message specified by NUMBER."
2822 (let* ((buffer-num (wl-summary-message-number))
2823 (msg-num (or number buffer-num))
2826 (when (null msg-num)
2828 (message "No message."))
2830 (when (setq mark (wl-summary-get-mark msg-num))
2831 (when (wl-summary-reserve-temp-mark-p mark)
2833 (error "Already marked as `%s'" mark))
2835 (wl-summary-unmark msg-num))
2836 (if (or (interactive-p)
2837 (eq number buffer-num))
2838 (wl-summary-mark-line "D"))
2839 (setq wl-summary-buffer-delete-list
2840 (cons msg-num wl-summary-buffer-delete-list))
2842 (if (eq wl-summary-move-direction-downward nil)
2847 (defun wl-summary-remove-destination ()
2849 (let ((inhibit-read-only t)
2850 (buffer-read-only nil)
2851 (buf (current-buffer))
2857 (setq rs (next-single-property-change sol 'wl-summary-destination
2859 (setq re (next-single-property-change rs 'wl-summary-destination
2861 (put-text-property rs re 'wl-summary-destination nil)
2862 (put-text-property rs re 'invisible nil)
2864 (delete-char (- eol re)))))
2866 (defun wl-summary-check-mark (msg mark)
2867 (let ((check-func (cond ((string= mark "o")
2868 'wl-summary-msg-marked-as-refiled)
2870 'wl-summary-msg-marked-as-copied)
2872 'wl-summary-msg-marked-as-deleted)
2874 'wl-summary-msg-marked-as-target))))
2876 (funcall check-func msg))))
2878 (defun wl-summary-mark-collect (mark &optional begin end)
2882 (narrow-to-region (or begin (point-min))
2883 (or end (point-max)))
2884 (goto-char (point-min))
2886 (if (eq wl-summary-buffer-view 'thread)
2889 (let* ((number (wl-summary-message-number))
2890 (entity (wl-thread-get-entity number))
2892 ;; opened...only myself is checked.
2893 (if (wl-summary-check-mark number mark)
2894 (wl-append msglist (list number)))
2895 (unless (wl-thread-entity-get-opened entity)
2896 ;; closed...children is also checked.
2897 (if (setq result (wl-thread-get-children-msgs-with-mark
2900 (wl-append msglist result)))
2902 (elmo-uniq-list msglist))
2903 (let* ((case-fold-search nil)
2904 (re (format (concat wl-summary-message-regexp "%s")
2905 (regexp-quote mark))))
2906 (while (re-search-forward re nil t)
2907 (setq msglist (cons (wl-summary-message-number) msglist)))
2908 (nreverse msglist)))))))
2910 (defun wl-summary-exec ()
2912 (wl-summary-exec-subr (mapcar 'car wl-summary-buffer-refile-list)
2913 (reverse wl-summary-buffer-delete-list)
2914 (mapcar 'car wl-summary-buffer-copy-list)))
2916 (defun wl-summary-exec-region (beg end)
2918 (message "Collecting marks ...")
2923 (goto-char (1- end))
2926 (wl-summary-exec-subr (wl-summary-mark-collect "o" beg end)
2927 (wl-summary-mark-collect "D" beg end)
2928 (wl-summary-mark-collect "O" beg end))))
2930 (defun wl-summary-exec-subr (moves dels copies)
2931 (if (not (or moves dels copies))
2932 (message "No marks")
2934 (let ((del-fld (wl-summary-get-delete-folder
2935 (wl-summary-buffer-folder-name)))
2937 (unread-marks (list wl-summary-unread-cached-mark
2938 wl-summary-unread-uncached-mark
2939 wl-summary-new-mark))
2940 (refiles (append moves dels))
2943 (copy-len (length copies))
2945 dst-msgs ; loop counter
2947 (message "Executing ...")
2949 (when (not (assq (car dels) wl-summary-buffer-refile-list))
2950 (wl-append wl-summary-buffer-refile-list
2951 (list (cons (car dels) del-fld)))
2952 (setq wl-summary-buffer-delete-list
2953 (delete (car dels) wl-summary-buffer-delete-list)))
2954 (setq dels (cdr dels)))
2956 (setq refile-len (length refiles))
2958 (wl-inverse-alist refiles wl-summary-buffer-refile-list))
2959 (goto-char start) ; avoid moving cursor to
2961 (when (> refile-len elmo-display-progress-threshold)
2962 (elmo-progress-set 'elmo-folder-move-messages
2963 refile-len "Moving messages..."))
2967 (setq result (elmo-folder-move-messages
2968 wl-summary-buffer-elmo-folder
2969 (cdr (car dst-msgs))
2970 (if (eq 'null (car (car dst-msgs)))
2972 (wl-folder-get-elmo-folder
2973 (car (car dst-msgs))))
2974 (wl-summary-buffer-msgdb)
2975 (not (null (cdr dst-msgs)))
2981 (if result ; succeeded.
2984 (wl-summary-delete-messages-on-buffer (cdr (car dst-msgs)))
2985 ;; update refile-alist.
2986 (setq wl-summary-buffer-refile-list
2987 (wl-delete-associations (cdr (car dst-msgs))
2988 wl-summary-buffer-refile-list)))
2989 (setq refile-failures
2990 (+ refile-failures (length (cdr (car dst-msgs))))))
2991 (setq dst-msgs (cdr dst-msgs)))
2992 (elmo-progress-clear 'elmo-folder-move-messages)
2995 (setq dst-msgs (wl-inverse-alist copies wl-summary-buffer-copy-list))
2996 (when (> copy-len elmo-display-progress-threshold)
2997 (elmo-progress-set 'elmo-folder-move-messages
2998 copy-len "Copying messages..."))
3002 (setq result (elmo-folder-move-messages
3003 wl-summary-buffer-elmo-folder
3004 (cdr (car dst-msgs))
3005 (wl-folder-get-elmo-folder
3006 (car (car dst-msgs)))
3007 (wl-summary-buffer-msgdb)
3008 (not (null (cdr dst-msgs)))
3009 t ; t is no-delete (copy)
3014 (if result ; succeeded.
3017 (wl-summary-delete-copy-marks-on-buffer (cdr (car dst-msgs)))
3018 ;; update copy-alist
3019 (setq wl-summary-buffer-copy-list
3020 (wl-delete-associations (cdr (car dst-msgs))
3021 wl-summary-buffer-copy-list)))
3023 (+ copy-failures (length (cdr (car dst-msgs))))))
3024 (setq dst-msgs (cdr dst-msgs)))
3025 ;; Hide progress bar.
3026 (elmo-progress-clear 'elmo-folder-move-messages)
3028 (wl-summary-folder-info-update)
3029 (wl-summary-set-message-modified)
3030 (wl-summary-set-mark-modified)
3031 (run-hooks 'wl-summary-exec-hook)
3032 (unless (and wl-message-buffer
3033 (eq (wl-summary-message-number)
3034 (with-current-buffer wl-message-buffer
3035 wl-message-buffer-cur-number)))
3036 (wl-summary-toggle-disp-msg 'off))
3037 (set-buffer-modified-p nil)
3038 (message (concat "Executing ... done"
3039 (if (> refile-failures 0)
3040 (format " (%d refiling failed)" refile-failures)
3042 (if (> copy-failures 0)
3043 (format " (%d copying failed)" copy-failures)
3047 (defun wl-summary-read-folder (default &optional purpose ignore-error
3049 (let ((fld (completing-read
3050 (format "Folder name %s(%s): " (or purpose "")
3052 (or wl-folder-completion-function
3053 (if (memq 'read-folder wl-use-folder-petname)
3054 (wl-folder-get-entity-with-petname)
3055 wl-folder-entity-hashtb))
3056 nil nil (or init wl-default-spec)
3057 'wl-read-folder-hist)))
3058 (if (or (string= fld wl-default-spec)
3061 (setq fld (elmo-string (wl-folder-get-realname fld)))
3062 (if (string-match "\n" fld)
3063 (error "Not supported folder name: %s" fld))
3067 (wl-folder-confirm-existence
3068 (wl-folder-get-elmo-folder
3071 (wl-folder-confirm-existence (wl-folder-get-elmo-folder
3075 (defun wl-summary-print-destination (msg-num folder)
3076 "Print refile destination on line."
3077 (wl-summary-remove-destination)
3078 (let ((inhibit-read-only t)
3079 (folder (copy-sequence folder))
3080 (buffer-read-only nil)
3082 (setq len (string-width folder))
3089 (setq c (+ c (char-width (following-char)))))
3090 (and (> c len) (setq folder (concat " " folder)))
3092 (put-text-property rs re 'invisible t)
3093 (put-text-property rs re 'wl-summary-destination t)
3095 (wl-highlight-refile-destination-string folder)
3097 (set-buffer-modified-p nil))))
3099 (defsubst wl-summary-get-mark (number)
3100 "Return a temporal mark of message specified by NUMBER."
3101 (or (and (memq number wl-summary-buffer-delete-list) "D")
3102 (and (assq number wl-summary-buffer-copy-list) "O")
3103 (and (assq number wl-summary-buffer-refile-list) "o")
3104 (and (memq number wl-summary-buffer-target-mark-list) "*")))
3106 (defsubst wl-summary-reserve-temp-mark-p (mark)
3107 "Return t if temporal MARK should be reserved."
3108 (member mark wl-summary-reserve-mark-list))
3110 (defun wl-summary-refile (&optional dst number)
3111 "Put refile mark on current line message.
3112 If optional argument DST is specified, put mark without asking
3114 If optional argument NUMBER is specified, mark message specified by NUMBER.
3116 If folder is read-only, message should be copied.
3117 See `wl-refile-policy-alist' for more details."
3119 (let ((policy (wl-get-assoc-list-value wl-refile-policy-alist
3120 (wl-summary-buffer-folder-name))))
3121 (cond ((eq policy 'copy)
3123 (call-interactively 'wl-summary-copy)
3124 (wl-summary-copy dst number)))
3126 (wl-summary-refile-subr 'refile (interactive-p) dst number)))))
3128 (defun wl-summary-copy (&optional dst number)
3129 "Put copy mark on current line message.
3130 If optional argument DST is specified, put mark without asking
3132 If optional argument NUMBER is specified, mark message specified by NUMBER."
3134 (wl-summary-refile-subr 'copy (interactive-p) dst number))
3136 (defun wl-summary-refile-subr (copy-or-refile interactive &optional dst number)
3137 (let* ((buffer-num (wl-summary-message-number))
3138 (msg-num (or number buffer-num))
3140 (elmo-message-field wl-summary-buffer-elmo-folder
3141 msg-num 'message-id)))
3142 (entity (and msg-num
3143 (elmo-msgdb-overview-get-entity
3144 msg-num (wl-summary-buffer-msgdb))))
3146 (intern (format "wl-summary-buffer-%s-list" copy-or-refile)))
3147 folder mark already tmp-folder)
3152 (message "Cannot refile."))
3154 (when (null msg-num)
3156 (message "No message."))
3158 (when (setq mark (wl-summary-get-mark msg-num))
3159 (when (wl-summary-reserve-temp-mark-p mark)
3161 (error "Already marked as `%s'" mark))
3163 (setq folder (and msg-num
3164 (or dst (wl-summary-read-folder
3165 (or (wl-refile-guess entity) wl-trash-folder)
3166 (format "for %s" copy-or-refile)))))
3167 ;; Cache folder hack by okada@opaopa.org
3168 (if (and (eq (elmo-folder-type-internal
3169 (wl-folder-get-elmo-folder
3170 (wl-folder-get-realname folder))) 'cache)
3171 (not (string= folder
3174 (elmo-cache-get-path-subr
3175 (elmo-msgid-to-cache msgid)))))))
3177 (setq folder tmp-folder)
3178 (message "Force refile to %s." folder)))
3179 (if (string= folder (wl-summary-buffer-folder-name))
3180 (error "Same folder"))
3181 (if (or (not (elmo-folder-writable-p (wl-folder-get-elmo-folder folder)))
3182 (string= folder wl-queue-folder)
3183 (string= folder wl-draft-folder))
3184 (error "Don't %s messages to %s" copy-or-refile folder))
3185 ;; learn for refile.
3186 (if (eq copy-or-refile 'refile)
3187 (wl-refile-learn entity folder))
3188 (wl-summary-unmark msg-num)
3189 (set variable (append
3190 (symbol-value variable)
3191 (list (cons msg-num folder))))
3192 (when (or interactive
3193 (eq number buffer-num))
3194 (wl-summary-mark-line (if (eq copy-or-refile 'refile)
3196 ;; print refile destination
3197 (wl-summary-print-destination msg-num folder))
3199 (if (eq wl-summary-move-direction-downward nil)
3202 (run-hooks (intern (format "wl-summary-%s-hook" copy-or-refile)))
3203 (setq wl-summary-buffer-prev-refile-destination folder)
3206 (defun wl-summary-refile-prev-destination ()
3207 "Refile message to previously refiled destination."
3209 (wl-summary-refile wl-summary-buffer-prev-refile-destination
3210 (wl-summary-message-number))
3211 (if (eq wl-summary-move-direction-downward nil)
3215 (defun wl-summary-copy-prev-destination ()
3216 "Refile message to previously refiled destination."
3218 (wl-summary-copy wl-summary-buffer-prev-copy-destination
3219 (wl-summary-message-number))
3220 (if (eq wl-summary-move-direction-downward nil)
3224 (defsubst wl-summary-no-auto-refile-message-p (msg)
3225 (member (elmo-msgdb-get-mark (wl-summary-buffer-msgdb) msg)
3226 wl-summary-auto-refile-skip-marks))
3228 (defun wl-summary-auto-refile (&optional open-all)
3229 "Set refile mark automatically according to 'wl-refile-guess-by-rule'."
3231 (message "Marking...")
3233 (if (and (eq wl-summary-buffer-view 'thread)
3235 (wl-thread-open-all))
3236 (let* ((spec (wl-summary-buffer-folder-name))
3239 number dst thr-entity)
3242 (setq number (wl-summary-message-number))
3243 (dolist (number (cons number
3244 (and (eq wl-summary-buffer-view 'thread)
3245 ;; process invisible children.
3246 (not (wl-thread-entity-get-opened
3248 (wl-thread-get-entity number))))
3249 (wl-thread-entity-get-descendant
3251 (when (and (not (wl-summary-no-auto-refile-message-p
3254 (wl-folder-get-realname
3255 (wl-refile-guess-by-rule
3256 (elmo-msgdb-overview-get-entity
3257 number (wl-summary-buffer-msgdb)))))
3258 (not (equal dst spec))
3259 (let ((pair (assoc dst checked-dsts))
3266 (wl-folder-confirm-existence
3267 (wl-folder-get-elmo-folder dst))
3270 (setq checked-dsts (cons (cons dst ret) checked-dsts))
3272 (if (wl-summary-refile dst number)
3274 (message "Marking...%d message(s)." count)))
3277 (message "No message was marked.")
3278 (message "Marked %d message(s)." count)))))
3280 (defun wl-summary-unmark (&optional number)
3281 "Unmark marks (temporary, refile, copy, delete)of current line.
3282 If optional argument NUMBER is specified, unmark message specified by NUMBER."
3286 (let ((inhibit-read-only t)
3287 (buffer-read-only nil)
3293 (setq visible (wl-summary-jump-to-msg number))
3295 ;; Delete mark on buffer.
3297 (looking-at "^ *\\(-?[0-9]+\\)\\([^0-9]\\)"))
3298 (goto-char (match-end 2))
3300 (setq number (string-to-int (wl-match-buffer 1))))
3301 (setq cur-mark (wl-match-buffer 2))
3302 (if (string= cur-mark " ")
3304 (delete-region (match-beginning 2) (match-end 2))
3305 (if (setq score-mark (wl-summary-get-score-mark number))
3308 (if (or (string= cur-mark "o")
3309 (string= cur-mark "O"))
3310 (wl-summary-remove-destination))
3311 (if wl-summary-highlight
3312 (wl-highlight-summary-current-line nil nil score-mark))
3313 (set-buffer-modified-p nil))
3314 ;; Remove from temporary mark structure.
3316 (wl-summary-delete-mark number)))))
3318 (defun wl-summary-msg-marked-as-target (msg)
3319 (if (memq msg wl-summary-buffer-target-mark-list)
3322 (defun wl-summary-msg-marked-as-copied (msg)
3323 (assq msg wl-summary-buffer-copy-list))
3325 (defun wl-summary-msg-marked-as-deleted (msg)
3326 (if (memq msg wl-summary-buffer-delete-list)
3329 (defun wl-summary-msg-marked-as-refiled (msg)
3330 (assq msg wl-summary-buffer-refile-list))
3332 (defun wl-summary-target-mark (&optional number)
3333 "Put target mark '*' on current message.
3334 If optional argument NUMBER is specified, mark message specified by NUMBER."
3336 (let* ((buffer-num (wl-summary-message-number))
3337 (msg-num (or number buffer-num))
3340 (when (null msg-num)
3342 (message "No message."))
3344 (when (setq mark (wl-summary-get-mark msg-num))
3345 (when (wl-summary-reserve-temp-mark-p mark)
3347 (error "Already marked as `%s'" mark))
3349 (wl-summary-unmark msg-num))
3350 (if (or (interactive-p)
3351 (eq number buffer-num))
3352 (wl-summary-mark-line "*"))
3353 (setq wl-summary-buffer-target-mark-list
3354 (cons msg-num wl-summary-buffer-target-mark-list))
3356 (if (eq wl-summary-move-direction-downward nil)
3362 (defun wl-summary-refile-region (beg end)
3363 "Put copy mark on messages in the region specified by BEG and END."
3365 (wl-summary-refile-region-subr "refile" beg end))
3367 (defun wl-summary-copy-region (beg end)
3368 "Put copy mark on messages in the region specified by BEG and END."
3370 (wl-summary-refile-region-subr "copy" beg end))
3372 (defun wl-summary-refile-region-subr (copy-or-refile beg end)
3376 ;; guess by first msg
3377 (let* ((msgid (cdr (assq (wl-summary-message-number)
3378 (elmo-msgdb-get-number-alist
3379 (wl-summary-buffer-msgdb)))))
3380 (function (intern (format "wl-summary-%s" copy-or-refile)))
3381 (entity (assoc msgid (elmo-msgdb-get-overview
3382 (wl-summary-buffer-msgdb))))
3385 (setq folder (wl-summary-read-folder (wl-refile-guess entity)
3388 (narrow-to-region beg end)
3389 (if (eq wl-summary-buffer-view 'thread)
3392 (let* ((number (wl-summary-message-number))
3393 (entity (wl-thread-get-entity number))
3395 (if (wl-thread-entity-get-opened entity)
3396 ;; opened...refile line.
3397 (funcall function folder number)
3399 (setq children (wl-thread-get-children-msgs number))
3401 (funcall function folder (pop children))))
3404 (funcall function folder (wl-summary-message-number))
3405 (forward-line 1)))))))
3407 (defun wl-summary-unmark-region (beg end)
3411 (narrow-to-region beg end)
3412 (goto-char (point-min))
3413 (if (eq wl-summary-buffer-view 'thread)
3416 (let* ((number (wl-summary-message-number))
3417 (entity (wl-thread-get-entity number)))
3418 (if (wl-thread-entity-get-opened entity)
3419 ;; opened...unmark line.
3422 (wl-summary-delete-marks-on-buffer
3423 (wl-thread-get-children-msgs number))))
3427 (forward-line 1))))))
3429 (defun wl-summary-mark-region-subr (function beg end)
3432 (narrow-to-region beg end)
3433 (goto-char (point-min))
3434 (if (eq wl-summary-buffer-view 'thread)
3437 (let* ((number (wl-summary-message-number))
3438 (entity (wl-thread-get-entity number))
3439 (wl-summary-move-direction-downward t)
3441 (if (wl-thread-entity-get-opened entity)
3442 ;; opened...delete line.
3443 (funcall function number)
3445 (setq children (wl-thread-get-children-msgs number))
3447 (funcall function (pop children))))
3450 (funcall function (wl-summary-message-number))
3451 (forward-line 1))))))
3453 (defun wl-summary-delete-region (beg end)
3455 (wl-summary-mark-region-subr 'wl-summary-delete beg end))
3457 (defun wl-summary-target-mark-region (beg end)
3459 (wl-summary-mark-region-subr 'wl-summary-target-mark beg end))
3461 (defun wl-summary-target-mark-all ()
3463 (wl-summary-target-mark-region (point-min) (point-max))
3464 (setq wl-summary-buffer-target-mark-list
3466 (elmo-msgdb-get-number-alist (wl-summary-buffer-msgdb)))))
3468 (defun wl-summary-delete-all-mark (mark)
3469 (goto-char (point-min))
3470 (let ((case-fold-search nil))
3471 (while (re-search-forward (format "^ *-?[0-9]+%s"
3472 (regexp-quote mark)) nil t)
3473 (wl-summary-unmark))
3474 (cond ((string= mark "*")
3475 (setq wl-summary-buffer-target-mark-list nil))
3477 (setq wl-summary-buffer-delete-list nil))
3479 (setq wl-summary-buffer-copy-list nil))
3481 (setq wl-summary-buffer-refile-list nil)))))
3483 (defun wl-summary-unmark-all ()
3484 "Unmark all according to what you input."
3486 (let ((unmarks (string-to-char-list (read-from-minibuffer "Unmark: ")))
3490 (setq cur-mark (char-to-string (car unmarks)))
3491 (wl-summary-delete-all-mark cur-mark)
3492 (setq unmarks (cdr unmarks))))))
3494 (defun wl-summary-target-mark-thread ()
3496 (wl-thread-call-region-func 'wl-summary-target-mark-region t))
3498 (defun wl-summary-target-mark-msgs (msgs)
3499 "Return the number of marked messages."
3502 (if (eq wl-summary-buffer-view 'thread)
3503 (wl-thread-jump-to-msg (car msgs))
3504 (wl-summary-jump-to-msg (car msgs)))
3505 (setq num (wl-summary-message-number))
3506 (when (eq num (car msgs))
3507 (wl-summary-target-mark num)
3509 (setq msgs (cdr msgs)))
3512 (defun wl-summary-pick (&optional from-list delete-marks)
3515 (let* ((condition (car (elmo-parse-search-condition
3516 (elmo-read-search-condition
3517 wl-summary-pick-field-default))))
3518 (result (elmo-folder-search wl-summary-buffer-elmo-folder
3523 (let ((mlist wl-summary-buffer-target-mark-list))
3525 (when (wl-summary-jump-to-msg (car mlist))
3526 (wl-summary-unmark))
3527 (setq mlist (cdr mlist)))
3528 (setq wl-summary-buffer-target-mark-list nil)))
3530 (setq num (wl-summary-target-mark-msgs result))
3532 (if (= num (length result))
3533 (message "%d message(s) are picked." num)
3534 (message "%d(%d) message(s) are picked." num
3535 (- (length result) num)))
3536 (message "No message was picked.")))))
3538 (defun wl-summary-unvirtual ()
3539 "Exit from current virtual folder."
3542 (elmo-folder-type-internal wl-summary-buffer-elmo-folder))
3543 (wl-summary-goto-folder-subr
3544 (elmo-folder-name-internal
3545 (elmo-filter-folder-target-internal
3546 wl-summary-buffer-elmo-folder))
3548 (error "This folder is not filtered")))
3550 (defun wl-summary-virtual (&optional arg)
3551 "Goto virtual folder.
3552 If ARG, exit virtual folder."
3555 (wl-summary-unvirtual)
3556 (wl-summary-goto-folder-subr (concat "/"
3557 (elmo-read-search-condition
3558 wl-summary-pick-field-default)
3560 (wl-summary-buffer-folder-name))
3561 'update nil nil t)))
3563 (defun wl-summary-delete-all-temp-marks (&optional no-msg)
3564 "Erase all temp marks from buffer."
3566 (when (or wl-summary-buffer-target-mark-list
3567 wl-summary-buffer-delete-list
3568 wl-summary-buffer-refile-list
3569 wl-summary-buffer-copy-list)
3571 (goto-char (point-min))
3573 (message "Unmarking..."))
3578 (message "Unmarking...done"))
3579 (setq wl-summary-buffer-target-mark-list nil)
3580 (setq wl-summary-buffer-delete-list nil)
3581 (setq wl-summary-buffer-refile-list nil)
3582 (setq wl-summary-buffer-copy-list nil))))
3584 (defun wl-summary-delete-mark (number)
3585 "Delete temporary mark of the message specified by NUMBER."
3587 ((memq number wl-summary-buffer-target-mark-list)
3588 (setq wl-summary-buffer-target-mark-list
3589 (delq number wl-summary-buffer-target-mark-list)))
3590 ((memq number wl-summary-buffer-delete-list)
3591 (setq wl-summary-buffer-delete-list
3592 (delq number wl-summary-buffer-delete-list)))
3596 ((setq pair (assq number wl-summary-buffer-copy-list))
3597 (setq wl-summary-buffer-copy-list
3598 (delq pair wl-summary-buffer-copy-list)))
3599 ((setq pair (assq number wl-summary-buffer-refile-list))
3600 (setq wl-summary-buffer-refile-list
3601 (delq pair wl-summary-buffer-refile-list))))))))
3603 (defun wl-summary-mark-line (mark)
3604 "Put MARK on current line. Return message number."
3607 (let ((inhibit-read-only t)
3608 (buffer-read-only nil)
3611 (when (looking-at "^ *\\(-?[0-9]+\\)\\([^0-9]\\)")
3612 (setq msg-num (string-to-int (wl-match-buffer 1)))
3613 (setq cur-mark (wl-match-buffer 2))
3614 (goto-char (match-end 1))
3615 (delete-region (match-beginning 2) (match-end 2))
3616 ;;; (wl-summary-delete-mark msg-num)
3618 (if wl-summary-highlight
3619 (wl-highlight-summary-current-line nil nil t))
3620 (set-buffer-modified-p nil)
3623 (defun wl-summary-target-mark-delete ()
3626 (goto-char (point-min))
3627 (let ((regexp (concat wl-summary-message-regexp "\\(\\*\\)"))
3629 (while (re-search-forward regexp nil t)
3630 (let (wl-summary-buffer-disp-msg)
3631 (when (setq number (wl-summary-message-number))
3632 (wl-summary-delete number)
3633 (setq wl-summary-buffer-target-mark-list
3634 (delq number wl-summary-buffer-target-mark-list)))))
3635 (setq mlist wl-summary-buffer-target-mark-list)
3637 (wl-append wl-summary-buffer-delete-list (list (car mlist)))
3638 (setq wl-summary-buffer-target-mark-list
3639 (delq (car mlist) wl-summary-buffer-target-mark-list))
3640 (setq mlist (cdr mlist))))))
3642 (defun wl-summary-target-mark-prefetch (&optional ignore-cache)
3645 (let* ((mlist (nreverse wl-summary-buffer-target-mark-list))
3646 (inhibit-read-only t)
3647 (buffer-read-only nil)
3649 (length (length mlist))
3654 (setq new-mark (wl-summary-prefetch-msg (car mlist) ignore-cache))
3657 (message "Prefetching... %d/%d message(s)"
3658 (setq count (+ 1 count)) length)
3659 (when (wl-summary-jump-to-msg (car mlist))
3662 (when (looking-at "^ *-?[0-9]+[^0-9]\\([^0-9]\\)")
3663 (delete-region (match-beginning 1) (match-end 1)))
3664 (goto-char (match-beginning 1))
3666 (if wl-summary-highlight
3667 (wl-highlight-summary-current-line))
3671 (setq skipped (cons (car mlist) skipped)))
3672 (setq mlist (cdr mlist)))
3673 (setq wl-summary-buffer-target-mark-list skipped)
3674 (message "Prefetching... %d/%d message(s)." count length)
3675 (set-buffer-modified-p nil))))
3677 (defun wl-summary-target-mark-refile-subr (copy-or-refile)
3679 (intern (format "wl-summary-buffer-%s-list" copy-or-refile)))
3681 (intern (format "wl-summary-%s" copy-or-refile)))
3682 regexp number msgid entity folder mlist)
3684 (goto-char (point-min))
3685 (setq regexp (concat wl-summary-message-regexp "\\(\\*\\)"))
3686 ;; guess by first mark
3687 (when (re-search-forward regexp nil t)
3688 (setq msgid (cdr (assq (setq number (wl-summary-message-number))
3689 (elmo-msgdb-get-number-alist
3690 (wl-summary-buffer-msgdb))))
3692 (elmo-msgdb-get-overview
3693 (wl-summary-buffer-msgdb))))
3695 (error "Cannot %s" copy-or-refile))
3697 (setq folder (wl-summary-read-folder
3698 (wl-refile-guess entity)
3699 (format "for %s" copy-or-refile)))
3702 (setq wl-summary-buffer-target-mark-list
3703 (delq number wl-summary-buffer-target-mark-list)))
3704 (while (re-search-forward regexp nil t)
3705 (let (wl-summary-buffer-disp-msg)
3706 (when (setq number (wl-summary-message-number))
3707 (funcall function folder number)
3708 (setq wl-summary-buffer-target-mark-list
3709 (delq number wl-summary-buffer-target-mark-list)))))
3710 ;; process invisible messages.
3711 (setq mlist wl-summary-buffer-target-mark-list)
3714 (append (symbol-value variable)
3715 (list (cons (car mlist) folder))))
3716 (setq wl-summary-buffer-target-mark-list
3717 (delq (car mlist) wl-summary-buffer-target-mark-list))
3718 (setq mlist (cdr mlist)))))))
3720 (defun wl-summary-next-buffer ()
3721 "Switch to next summary buffer."
3723 (let ((buffers (sort (wl-collect-summary)
3724 (lambda (buffer1 buffer2)
3725 (string-lessp (buffer-name buffer1)
3726 (buffer-name buffer2))))))
3728 (or (cadr (memq (current-buffer) buffers))
3731 (defun wl-summary-previous-buffer ()
3732 "Switch to previous summary buffer."
3734 (let ((buffers (sort (wl-collect-summary)
3735 (lambda (buffer1 buffer2)
3736 (not (string-lessp (buffer-name buffer1)
3737 (buffer-name buffer2)))))))
3739 (or (cadr (memq (current-buffer) buffers))
3742 (defun wl-summary-target-mark-copy ()
3744 (wl-summary-target-mark-refile-subr "copy"))
3746 (defun wl-summary-target-mark-refile ()
3748 (wl-summary-target-mark-refile-subr "refile"))
3750 (defun wl-summary-target-mark-mark-as-read ()
3753 (goto-char (point-min))
3754 (let ((regexp (concat wl-summary-message-regexp "\\(\\*\\)"))
3755 (inhibit-read-only t)
3756 (buffer-read-only nil)
3758 (while (re-search-forward regexp nil t)
3759 (let (wl-summary-buffer-disp-msg)
3760 ;; delete target-mark from buffer.
3761 (delete-region (match-beginning 1) (match-end 1))
3763 (setq number (wl-summary-mark-as-read t))
3764 (if wl-summary-highlight
3765 (wl-highlight-summary-current-line))
3767 (setq wl-summary-buffer-target-mark-list
3768 (delq number wl-summary-buffer-target-mark-list)))))
3769 (setq mlist wl-summary-buffer-target-mark-list)
3771 (wl-summary-mark-as-read t nil nil (car mlist))
3772 (setq wl-summary-buffer-target-mark-list
3773 (delq (car mlist) wl-summary-buffer-target-mark-list))
3774 (setq mlist (cdr mlist)))
3775 (wl-summary-count-unread)
3776 (wl-summary-update-modeline))))
3778 (defun wl-summary-target-mark-mark-as-unread ()
3781 (goto-char (point-min))
3782 (let ((regexp (concat wl-summary-message-regexp "\\(\\*\\)"))
3783 (inhibit-read-only t)
3784 (buffer-read-only nil)
3786 (while (re-search-forward regexp nil t)
3787 (let (wl-summary-buffer-disp-msg)
3788 ;; delete target-mark from buffer.
3789 (delete-region (match-beginning 1) (match-end 1))
3791 (setq number (wl-summary-mark-as-unread))
3792 (if wl-summary-highlight
3793 (wl-highlight-summary-current-line))
3795 (setq wl-summary-buffer-target-mark-list
3796 (delq number wl-summary-buffer-target-mark-list)))))
3797 (setq mlist wl-summary-buffer-target-mark-list)
3799 (wl-summary-mark-as-unread (car mlist))
3800 ;;; (wl-thread-msg-mark-as-unread (car mlist))
3801 (setq wl-summary-buffer-target-mark-list
3802 (delq (car mlist) wl-summary-buffer-target-mark-list))
3803 (setq mlist (cdr mlist)))
3804 (wl-summary-count-unread)
3805 (wl-summary-update-modeline))))
3807 (defun wl-summary-target-mark-mark-as-important ()
3810 (goto-char (point-min))
3811 (let ((regexp (concat wl-summary-message-regexp "\\(\\*\\)"))
3812 (inhibit-read-only t)
3813 (buffer-read-only nil)
3815 (while (re-search-forward regexp nil t)
3816 (let (wl-summary-buffer-disp-msg)
3817 ;; delete target-mark from buffer.
3818 (delete-region (match-beginning 1) (match-end 1))
3820 (setq number (wl-summary-mark-as-important))
3821 (if wl-summary-highlight
3822 (wl-highlight-summary-current-line))
3824 (setq wl-summary-buffer-target-mark-list
3825 (delq number wl-summary-buffer-target-mark-list)))))
3826 (setq mlist wl-summary-buffer-target-mark-list)
3828 (wl-summary-mark-as-important (car mlist))
3829 (wl-thread-msg-mark-as-important (car mlist))
3830 (setq wl-summary-buffer-target-mark-list
3831 (delq (car mlist) wl-summary-buffer-target-mark-list))
3832 (setq mlist (cdr mlist)))
3833 (wl-summary-count-unread)
3834 (wl-summary-update-modeline))))
3836 (defun wl-summary-target-mark-save ()
3839 (goto-char (point-min))
3841 (wl-read-directory-name "Save to directory: "
3842 wl-temporary-file-directory))
3843 (regexp (concat wl-summary-message-regexp "\\(\\*\\)"))
3845 (if (null (file-exists-p wl-save-dir))
3846 (make-directory wl-save-dir))
3847 (while (re-search-forward regexp nil t)
3848 (let (wl-summary-buffer-disp-msg)
3849 (setq number (wl-summary-save t wl-save-dir))
3852 (setq wl-summary-buffer-target-mark-list
3853 (delq number wl-summary-buffer-target-mark-list))))))))
3855 (defun wl-summary-target-mark-pick ()
3857 (wl-summary-pick wl-summary-buffer-target-mark-list 'delete))
3859 (defun wl-summary-mark-as-read (&optional notcrosses
3860 leave-server-side-mark-untouched
3867 (inhibit-read-only t)
3868 (buffer-read-only nil)
3869 (folder wl-summary-buffer-elmo-folder)
3870 (msgdb (wl-summary-buffer-msgdb))
3871 ;;; (number-alist (elmo-msgdb-get-number-alist msgdb))
3872 (case-fold-search nil)
3873 mark stat visible uncached new-mark marked)
3876 (setq visible (wl-summary-jump-to-msg number))
3877 (setq mark (elmo-msgdb-get-mark msgdb number)))
3881 (if (or (not visible)
3883 (format "^ *\\(-?[0-9]+\\)[^0-9]\\(%s\\|%s\\|%s\\|%s\\).*$"
3884 (regexp-quote wl-summary-read-uncached-mark)
3885 (regexp-quote wl-summary-unread-uncached-mark)
3886 (regexp-quote wl-summary-unread-cached-mark)
3887 (regexp-quote wl-summary-new-mark))))
3889 (setq mark (or mark (wl-match-buffer 2)))
3892 ((string= mark wl-summary-new-mark) ; N
3895 ((string= mark wl-summary-unread-uncached-mark) ; U
3898 ((string= mark wl-summary-unread-cached-mark) ; !
3899 (setq stat 'unread))
3901 ;; no need to mark server.
3902 (setq leave-server-side-mark-untouched t))))
3903 (setq number (or number (string-to-int (wl-match-buffer 1))))
3904 ;; set server side mark...
3905 (setq new-mark (if (and uncached
3906 (if (elmo-message-use-cache-p folder number)
3907 (not (elmo-folder-local-p folder)))
3909 wl-summary-read-uncached-mark
3911 (if (not leave-server-side-mark-untouched)
3913 (setq marked (elmo-folder-mark-as-read
3916 (if (or leave-server-side-mark-untouched
3919 (cond ((eq stat 'unread)
3920 (setq wl-summary-buffer-unread-count
3921 (1- wl-summary-buffer-unread-count)))
3923 (setq wl-summary-buffer-new-count
3924 (1- wl-summary-buffer-new-count))))
3925 (wl-summary-update-modeline)
3926 (wl-folder-update-unread
3927 (wl-summary-buffer-folder-name)
3928 (+ wl-summary-buffer-unread-count
3929 wl-summary-buffer-new-count))
3930 (when (or stat cached)
3932 (goto-char (match-end 2))
3933 (delete-region (match-beginning 2) (match-end 2))
3934 (insert (or new-mark " ")))
3935 (elmo-msgdb-set-mark msgdb number new-mark)
3936 (wl-summary-set-mark-modified))
3937 (if (and visible wl-summary-highlight)
3938 (wl-highlight-summary-current-line nil nil t)))
3939 (if mark (message "Warning: Changing mark failed.")))))
3940 (set-buffer-modified-p nil)
3942 (run-hooks 'wl-summary-unread-message-hook))
3943 number ;return value
3946 (defun wl-summary-mark-as-important (&optional number
3950 (if (eq (elmo-folder-type-internal wl-summary-buffer-elmo-folder)
3952 (error "Cannot process mark in this folder"))
3955 (inhibit-read-only t)
3956 (buffer-read-only nil)
3957 (folder wl-summary-buffer-elmo-folder)
3958 (msgdb (wl-summary-buffer-msgdb))
3959 (number-alist (elmo-msgdb-get-number-alist msgdb))
3963 (setq visible (wl-summary-jump-to-msg number))
3964 (setq mark (or mark (elmo-msgdb-get-mark msgdb number))))
3967 (if (null (setq number (wl-summary-message-number)))
3969 (message "No message.")
3973 (wl-summary-goto-previous-message-beginning)))
3974 (if (or (and (not visible)
3975 (assq number (elmo-msgdb-get-number-alist msgdb)))
3976 (re-search-forward "^ *\\(-?[0-9]+\\)[^0-9]\\([^0-9]\\)" eol t))
3978 (setq number (or number (string-to-int (wl-match-buffer 1))))
3979 (setq mark (or mark (wl-match-buffer 2)))
3980 (setq message-id (elmo-message-field
3981 wl-summary-buffer-elmo-folder
3984 (if (string= mark wl-summary-important-mark)
3988 (unless no-server-update
3989 (elmo-folder-unmark-important folder (list number))
3990 (elmo-msgdb-global-mark-delete message-id))
3991 ;; Remove cache if local folder.
3992 (if (and (elmo-folder-local-p folder)
3994 (elmo-folder-type-internal folder))))
3995 (elmo-file-cache-delete
3996 (elmo-file-cache-get-path message-id))))
3998 (delete-region (match-beginning 2) (match-end 2))
4000 (elmo-msgdb-set-mark msgdb number nil))
4003 (unless no-server-update
4004 (elmo-folder-mark-as-important folder (list number))))
4006 (delete-region (match-beginning 2) (match-end 2))
4007 (insert wl-summary-important-mark))
4008 (elmo-msgdb-set-mark msgdb number
4009 wl-summary-important-mark)
4010 (if (eq (elmo-file-cache-exists-p message-id) 'entire)
4011 (elmo-folder-mark-as-read folder (list number))
4012 ;; Force cache message.
4013 (elmo-message-encache folder number 'read))
4014 (unless no-server-update
4015 (elmo-msgdb-global-mark-set message-id
4016 wl-summary-important-mark)))
4017 (wl-summary-set-mark-modified)))
4018 (if (and visible wl-summary-highlight)
4019 (wl-highlight-summary-current-line nil nil t))))
4020 (set-buffer-modified-p nil)
4024 (defvar wl-summary-line-formatter nil)
4026 (defun wl-summary-line-year ()
4027 (aref wl-datevec 0))
4028 (defun wl-summary-line-month ()
4029 (format "%02d" (aref wl-datevec 1)))
4030 (defun wl-summary-line-day ()
4031 (format "%02d" (aref wl-datevec 2)))
4032 (defun wl-summary-line-day-of-week ()
4034 (elmo-date-get-week (aref wl-datevec 0)
4036 (aref wl-datevec 2))
4038 (defun wl-summary-line-hour ()
4039 (format "%02d" (aref wl-datevec 3)))
4040 (defun wl-summary-line-minute ()
4041 (format "%02d" (aref wl-datevec 4)))
4042 (defun wl-summary-line-open-bracket ()
4043 (if wl-thr-linked "<" "["))
4044 (defun wl-summary-line-close-bracket ()
4045 (if wl-thr-linked ">" "]"))
4046 (defun wl-summary-line-children-number ()
4047 (if wl-thr-children-number
4048 (concat "+" (int-to-string wl-thr-children-number) ":")
4050 (defun wl-summary-line-thread-indent ()
4051 (or wl-thr-indent-string ""))
4053 (defun wl-summary-line-size ()
4054 (let ((size (elmo-msgdb-overview-entity-get-size wl-message-entity)))
4057 ((<= 1 (/ size 1048576))
4058 (format "%.0fM" (/ size 1048576.0)))
4059 ((<= 1 (/ size 1024))
4060 (format "%.0fK" (/ size 1024.0)))
4061 (t (format "%dB" size)))
4064 (defun wl-summary-line-subject ()
4065 (let (no-parent subject parent-raw-subject parent-subject)
4066 (if (string= wl-thr-indent-string "")
4067 (setq no-parent t)) ; no parent
4069 (elmo-delete-char ?\n
4070 (or (elmo-msgdb-overview-entity-get-subject
4072 wl-summary-no-subject-message)))
4073 (setq parent-raw-subject
4074 (elmo-msgdb-overview-entity-get-subject wl-parent-message-entity))
4075 (setq parent-subject
4076 (if parent-raw-subject
4077 (elmo-delete-char ?\n parent-raw-subject)))
4080 (null parent-subject)
4081 (not (wl-summary-subject-equal
4082 subject parent-subject)))
4083 (funcall wl-summary-subject-function subject)
4085 (if (and (not wl-summary-width)
4086 wl-summary-subject-length-limit)
4087 (truncate-string subject
4088 wl-summary-subject-length-limit)
4091 (defun wl-summary-line-from ()
4092 (elmo-delete-char ?\n
4093 (funcall wl-summary-from-function
4094 (elmo-msgdb-overview-entity-get-from
4095 wl-message-entity))))
4097 (defun wl-summary-line-children-and-from ()
4099 (wl-summary-line-children-number) " "
4100 (wl-summary-line-from)))
4102 (defun wl-summary-line-list-count ()
4103 (let ((folder wl-summary-buffer-folder-name)
4104 (sequence) (ml-name) (ml-count) (subject-string))
4105 (setq sequence (elmo-msgdb-overview-entity-get-extra-field
4106 wl-message-entity "x-sequence")
4107 ml-name (or (elmo-msgdb-overview-entity-get-extra-field
4108 wl-message-entity "x-ml-name")
4110 (car (split-string sequence " "))))
4111 ml-count (or (elmo-msgdb-overview-entity-get-extra-field
4112 wl-message-entity "x-mail-count")
4113 (elmo-msgdb-overview-entity-get-extra-field
4114 wl-message-entity "x-ml-count")
4116 (cadr (split-string sequence " "))))
4118 (elmo-delete-char ?\n
4119 (or (elmo-msgdb-overview-entity-get-subject
4121 wl-summary-no-subject-message)))
4123 "^\\s(\\(\\S)+\\)[ :]\\([0-9]+\\)\\s)[ \t]*"
4126 (if (not ml-name) (setq ml-name (match-string 1 subject-string)))
4127 (if (not ml-count) (setq ml-count (match-string 2 subject-string)))))
4129 (if (and ml-name ml-count)
4130 (if (string= folder wl-default-folder)
4131 (format " (%s %05d) "
4132 (car (split-string ml-name " "))
4133 (string-to-int ml-count))
4134 (format " #%05d " (string-to-int ml-count)))
4138 (defun wl-summary-create-line (wl-message-entity
4139 wl-parent-message-entity
4142 wl-thr-children-number
4143 wl-thr-indent-string
4145 "Create a summary line."
4146 (let ((wl-mime-charset wl-summary-buffer-mime-charset)
4147 (elmo-mime-charset wl-summary-buffer-mime-charset)
4148 (elmo-lang wl-summary-buffer-weekday-name-lang)
4149 (wl-datevec (or (ignore-errors (timezone-fix-time
4150 (elmo-msgdb-overview-entity-get-date
4153 wl-summary-fix-timezone))
4155 (entity wl-message-entity) ; backward compatibility.
4157 (if (and wl-thr-indent-string
4158 wl-summary-indent-length-limit
4159 (< wl-summary-indent-length-limit
4160 (string-width wl-thr-indent-string)))
4161 (setq wl-thr-indent-string (wl-set-string-width
4162 wl-summary-indent-length-limit
4163 wl-thr-indent-string)))
4168 (number-to-string wl-summary-buffer-number-column)
4171 (elmo-msgdb-overview-entity-get-number wl-message-entity))
4174 (or (elmo-msgdb-get-mark
4175 (wl-summary-buffer-msgdb)
4176 (elmo-msgdb-overview-entity-get-number
4179 (funcall wl-summary-buffer-line-formatter)))
4180 (if wl-summary-width (setq line
4181 (wl-set-string-width
4182 (- wl-summary-width 1) line)))
4183 (if wl-summary-highlight
4184 (wl-highlight-summary-line-string line
4187 wl-thr-indent-string))
4190 (defsubst wl-summary-proc-wday (wday-str year month mday)
4192 (if (string-match "\\([A-Z][a-z][a-z]\\).*" wday-str)
4193 (wl-match-string 1 wday-str)
4194 (elmo-date-get-week year month mday))))
4196 (defvar wl-summary-move-spec-plugged-alist
4197 (` ((new . ((t . nil)
4198 (p . (, wl-summary-new-mark))
4199 (p . (, (wl-regexp-opt
4200 (list wl-summary-unread-uncached-mark
4201 wl-summary-unread-cached-mark))))
4202 (p . (, (regexp-quote wl-summary-important-mark)))))
4203 (unread . ((t . nil)
4204 (p . (, (wl-regexp-opt
4205 (list wl-summary-new-mark
4206 wl-summary-unread-uncached-mark
4207 wl-summary-unread-cached-mark))))
4208 (p . (, (regexp-quote wl-summary-important-mark))))))))
4210 (defvar wl-summary-move-spec-unplugged-alist
4211 (` ((new . ((t . nil)
4212 (p . (, wl-summary-unread-cached-mark))
4213 (p . (, (regexp-quote wl-summary-important-mark)))))
4214 (unread . ((t . nil)
4215 (p . (, wl-summary-unread-cached-mark))
4216 (p . (, (regexp-quote wl-summary-important-mark))))))))
4218 (defsubst wl-summary-next-message (num direction hereto)
4219 (if wl-summary-buffer-next-message-function
4220 (funcall wl-summary-buffer-next-message-function num direction hereto)
4221 (let ((cur-spec (cdr (assq wl-summary-move-order
4222 (if (elmo-folder-plugged-p
4223 wl-summary-buffer-elmo-folder)
4224 wl-summary-move-spec-plugged-alist
4225 wl-summary-move-spec-unplugged-alist))))
4226 (nums (memq num (if (eq direction 'up)
4227 (reverse wl-summary-buffer-number-list)
4228 wl-summary-buffer-number-list)))
4230 (unless hereto (setq nums (cdr nums)))
4236 (cond ((eq (car (car cur-spec)) 'p)
4237 (if (setq marked-list
4238 (elmo-folder-list-messages-mark-match
4239 wl-summary-buffer-elmo-folder
4240 (cdr (car cur-spec))))
4242 (if (memq (car nums) marked-list)
4243 (throw 'done (car nums)))
4244 (setq nums (cdr nums)))))
4245 ((eq (car (car cur-spec)) 't)
4246 (if wl-summary-buffer-target-mark-list
4248 (if (memq (car nums)
4249 wl-summary-buffer-target-mark-list)
4250 (throw 'done (car nums)))
4251 (setq nums (cdr nums))))))
4252 (setq cur-spec (cdr cur-spec))))
4255 (defsubst wl-summary-cursor-move (direction hereto)
4256 (when (and (eq direction 'up)
4261 (when (setq num (wl-summary-next-message (wl-summary-message-number)
4264 (wl-thread-jump-to-msg num))
4267 ;; Goto unread or important
4268 ;; returns t if next message exists in this folder.
4269 (defun wl-summary-cursor-down (&optional hereto)
4271 (wl-summary-cursor-move 'down hereto))
4273 (defun wl-summary-cursor-up (&optional hereto)
4275 (wl-summary-cursor-move 'up hereto))
4277 (defun wl-summary-save-view-cache ()
4279 (let* ((dir (elmo-folder-msgdb-path wl-summary-buffer-elmo-folder))
4280 (cache (expand-file-name wl-summary-cache-file dir))
4281 (view (expand-file-name wl-summary-view-file dir))
4282 (save-view wl-summary-buffer-view)
4283 (mark-list (copy-sequence wl-summary-buffer-target-mark-list))
4284 (refile-list (copy-sequence wl-summary-buffer-refile-list))
4285 (copy-list (copy-sequence wl-summary-buffer-copy-list))
4286 (delete-list (copy-sequence wl-summary-buffer-delete-list))
4287 (tmp-buffer (get-buffer-create " *wl-summary-save-view-cache*"))
4288 (charset wl-summary-buffer-mime-charset))
4289 (if (file-directory-p dir)
4291 (if (file-exists-p dir)
4292 (error "File %s already exists" dir)
4293 (elmo-make-directory dir)))
4294 (if (eq save-view 'thread)
4295 (wl-thread-save-entity dir))
4298 (when (file-writable-p cache)
4299 (copy-to-buffer tmp-buffer (point-min) (point-max))
4300 (with-current-buffer tmp-buffer
4302 (setq wl-summary-buffer-target-mark-list mark-list
4303 wl-summary-buffer-refile-list refile-list
4304 wl-summary-buffer-copy-list copy-list
4305 wl-summary-buffer-delete-list delete-list)
4306 (wl-summary-delete-all-temp-marks 'no-msg)
4307 (encode-mime-charset-region
4308 (point-min) (point-max) charset)
4309 (write-region-as-binary (point-min)(point-max)
4310 cache nil 'no-msg)))
4311 (when (file-writable-p view) ; 'thread or 'sequence
4313 (set-buffer tmp-buffer)
4315 (prin1 save-view tmp-buffer)
4316 (princ "\n" tmp-buffer)
4317 (write-region (point-min) (point-max) view nil 'no-msg))))
4319 (kill-buffer tmp-buffer)))))
4321 (defsubst wl-summary-get-sync-range (folder)
4323 (elmo-folder-plugged-p folder)
4324 (wl-get-assoc-list-value
4325 wl-folder-sync-range-alist
4326 (elmo-folder-name-internal folder)))
4327 wl-default-sync-range)))
4329 ;; redefined for wl-summary-sync-update
4330 (defun wl-summary-input-range (folder)
4331 "returns update or all or rescan."
4332 ;; for the case when parts are expanded in the bottom of the folder
4333 (let ((input-range-list '("update" "all" "rescan" "first:" "last:"
4335 "no-sync" "rescan-noscore" "all-visible"))
4336 (default (or (wl-get-assoc-list-value
4337 wl-folder-sync-range-alist
4339 wl-default-sync-range))
4342 (completing-read (format "Range (%s): " default)
4344 (function (lambda (x) (cons x x)))
4346 (if (string= range "")
4350 (defun wl-summary-toggle-disp-folder (&optional arg)
4352 (let ((cur-buf (current-buffer))
4353 (summary-win (get-buffer-window (current-buffer)))
4357 (setq wl-summary-buffer-disp-folder t)
4358 ;; hide your folder window
4359 (if (setq fld-buf (get-buffer wl-folder-buffer-name))
4360 (if (setq fld-win (get-buffer-window fld-buf))
4361 (delete-window fld-win))))
4363 (setq wl-summary-buffer-disp-folder nil)
4364 ;; hide your wl-message window!
4365 (when (buffer-live-p wl-message-buffer)
4366 (wl-message-select-buffer wl-message-buffer)
4368 (select-window (get-buffer-window cur-buf))
4369 ;; display wl-folder window!!
4370 (if (setq fld-buf (get-buffer wl-folder-buffer-name))
4371 (if (setq fld-win (get-buffer-window fld-buf))
4372 ;; folder win is already displayed.
4373 (select-window fld-win)
4374 ;; folder win is not displayed.
4375 (switch-to-buffer fld-buf))
4378 ;; temporarily delete summary-win.
4380 (delete-window summary-win))
4381 (split-window-horizontally wl-folder-window-width)
4383 (switch-to-buffer cur-buf))
4385 (if (setq fld-buf (get-buffer wl-folder-buffer-name))
4386 (if (setq fld-win (get-buffer-window fld-buf))
4387 (setq wl-summary-buffer-disp-folder nil)
4388 (setq wl-summary-buffer-disp-folder t)))
4389 (if (not wl-summary-buffer-disp-folder)
4390 ;; hide message window
4391 (let ((mes-win (and wl-message-buffer
4392 (get-buffer-window wl-message-buffer)))
4393 (wl-stay-folder-window t))
4394 (if mes-win (delete-window mes-win))
4395 ;; hide your folder window
4396 (if (setq fld-buf (get-buffer wl-folder-buffer-name))
4397 (if (setq fld-win (get-buffer-window fld-buf))
4399 (delete-window (get-buffer-window cur-buf))
4400 (select-window fld-win)
4401 (switch-to-buffer cur-buf))))
4402 (run-hooks 'wl-summary-toggle-disp-folder-off-hook)
4403 ;; resume message window.
4405 (wl-message-select-buffer wl-message-buffer)
4406 (run-hooks 'wl-summary-toggle-disp-folder-message-resumed-hook)
4407 (select-window (get-buffer-window cur-buf))))
4408 ;; hide message window
4409 (let ((wl-stay-folder-window t)
4410 (mes-win (and wl-message-buffer
4411 (get-buffer-window wl-message-buffer))))
4412 (if mes-win (delete-window mes-win))
4413 (select-window (get-buffer-window cur-buf))
4414 ;; display wl-folder window!!
4415 (if (setq fld-buf (get-buffer wl-folder-buffer-name))
4416 (if (setq fld-win (get-buffer-window fld-buf))
4417 ;; folder win is already displayed.
4418 (select-window fld-win)
4419 ;; folder win is not displayed...occupy all.
4420 (switch-to-buffer fld-buf))
4423 (split-window-horizontally wl-folder-window-width)
4425 (switch-to-buffer cur-buf)
4426 ;; resume message window.
4427 (run-hooks 'wl-summary-toggle-disp-folder-on-hook)
4429 (wl-message-select-buffer wl-message-buffer)
4430 (run-hooks 'wl-summary-toggle-disp-folder-message-resumed-hook)
4431 (select-window (get-buffer-window cur-buf))))))))
4432 (run-hooks 'wl-summary-toggle-disp-folder-hook))
4434 (defun wl-summary-toggle-disp-msg (&optional arg)
4436 (let ((cur-buf (current-buffer))
4441 (setq wl-summary-buffer-disp-msg t)
4443 ;; hide your folder window
4444 (if (and (not wl-stay-folder-window)
4445 (setq fld-buf (get-buffer wl-folder-buffer-name)))
4446 (if (setq fld-win (get-buffer-window fld-buf))
4447 (unless (one-window-p fld-win)
4448 (delete-window fld-win))))))
4450 (wl-delete-all-overlays)
4451 (setq wl-summary-buffer-disp-msg nil)
4453 (when (buffer-live-p wl-message-buffer)
4454 (wl-message-select-buffer wl-message-buffer)
4456 (and (get-buffer-window cur-buf)
4457 (select-window (get-buffer-window cur-buf))))
4458 (run-hooks 'wl-summary-toggle-disp-off-hook)))
4460 (if (and wl-message-buffer
4461 (get-buffer-window wl-message-buffer)) ; already displayed
4462 (setq wl-summary-buffer-disp-msg nil)
4463 (setq wl-summary-buffer-disp-msg t))
4464 (if wl-summary-buffer-disp-msg
4466 (wl-summary-redisplay)
4467 ;;; hide your folder window
4468 ;;; (setq fld-buf (get-buffer wl-folder-buffer-name))
4469 ;;; (if (setq fld-win (get-buffer-window fld-buf))
4470 ;;; (delete-window fld-win)))
4471 (run-hooks 'wl-summary-toggle-disp-on-hook))
4472 (wl-delete-all-overlays)
4474 (wl-message-select-buffer wl-message-buffer)
4476 (select-window (get-buffer-window cur-buf))
4477 (run-hooks 'wl-summary-toggle-disp-off-hook))
4478 ;;; (switch-to-buffer cur-buf)
4481 (defun wl-summary-next-line-content ()
4482 "Show next line of the message."
4484 (let ((cur-buf (current-buffer)))
4485 (wl-summary-toggle-disp-msg 'on)
4486 (when (wl-summary-set-message-buffer-or-redisplay 'ignore-original)
4487 (set-buffer cur-buf)
4488 (wl-message-next-page 1))))
4490 (defun wl-summary-prev-line-content ()
4492 (let ((cur-buf (current-buffer)))
4493 (wl-summary-toggle-disp-msg 'on)
4494 (when (wl-summary-set-message-buffer-or-redisplay 'ignore-original)
4495 (set-buffer cur-buf)
4496 (wl-message-prev-page 1))))
4498 (defun wl-summary-next-page ()
4500 (let ((cur-buf (current-buffer)))
4501 (wl-summary-toggle-disp-msg 'on)
4502 (when (wl-summary-set-message-buffer-or-redisplay 'ignore-original)
4503 (set-buffer cur-buf)
4504 (wl-message-next-page))))
4506 (defun wl-summary-prev-page ()
4508 (let ((cur-buf (current-buffer)))
4509 (wl-summary-toggle-disp-msg 'on)
4510 (when (wl-summary-set-message-buffer-or-redisplay 'ignore-original)
4511 (set-buffer cur-buf)
4512 (wl-message-prev-page))))
4514 (defsubst wl-summary-no-mime-p (folder)
4515 (wl-string-match-member (elmo-folder-name-internal folder)
4516 wl-summary-no-mime-folder-list))
4518 (defun wl-summary-set-message-buffer-or-redisplay (&rest args)
4519 "Set message buffer.
4520 If message is not displayed yet, display it.
4521 Return t if message exists."
4522 (let ((folder wl-summary-buffer-elmo-folder)
4523 (number (wl-summary-message-number))
4524 cur-folder cur-number message-last-pos)
4525 (when (buffer-live-p wl-message-buffer)
4526 (save-window-excursion
4527 (wl-message-select-buffer wl-message-buffer)
4528 (setq cur-folder wl-message-buffer-cur-folder)
4529 (setq cur-number wl-message-buffer-cur-number)))
4530 (if (and (string= (elmo-folder-name-internal folder) (or cur-folder ""))
4531 (eq number (or cur-number 0)))
4533 (set-buffer wl-message-buffer)
4535 (if (wl-summary-no-mime-p folder)
4536 (wl-summary-redisplay-no-mime-internal folder number)
4537 (wl-summary-redisplay-internal folder number))
4538 (when (buffer-live-p wl-message-buffer)
4539 (set-buffer wl-message-buffer))
4542 (defun wl-summary-target-mark-forward (&optional arg)
4544 (let ((mlist (nreverse wl-summary-buffer-target-mark-list))
4545 (summary-buf (current-buffer))
4546 (wl-draft-forward t)
4549 (wl-summary-jump-to-msg (car mlist))
4550 (wl-summary-forward t)
4551 (setq start-point (point))
4552 (setq draft-buf (current-buffer))
4553 (setq mlist (cdr mlist))
4554 (save-window-excursion
4557 (set-buffer summary-buf)
4558 (wl-summary-jump-to-msg (car mlist))
4559 (wl-summary-redisplay)
4560 (set-buffer draft-buf)
4561 (goto-char (point-max))
4562 (wl-draft-insert-message)
4563 (setq mlist (cdr mlist)))
4564 (wl-draft-body-goto-top)
4565 (wl-draft-enclose-digest-region (point) (point-max)))
4566 (goto-char start-point)
4568 (set-buffer summary-buf)
4569 (wl-summary-delete-all-temp-marks)))
4570 (run-hooks 'wl-mail-setup-hook)))
4572 (defun wl-summary-target-mark-reply-with-citation (&optional arg)
4574 (let ((mlist (nreverse wl-summary-buffer-target-mark-list))
4575 (summary-buf (current-buffer))
4576 change-major-mode-hook
4579 (wl-summary-jump-to-msg (car mlist))
4580 (wl-summary-reply arg t)
4581 (goto-char (point-max))
4582 (setq start-point (point-marker))
4583 (setq draft-buf (current-buffer))
4584 (save-window-excursion
4586 (set-buffer summary-buf)
4587 (delete-other-windows)
4588 (wl-summary-jump-to-msg (car mlist))
4589 (wl-summary-redisplay)
4590 (set-buffer draft-buf)
4591 (goto-char (point-max))
4592 (wl-draft-yank-original)
4593 (setq mlist (cdr mlist)))
4594 (goto-char start-point)
4596 (set-buffer summary-buf)
4597 (wl-summary-delete-all-temp-marks)))
4598 (run-hooks 'wl-mail-setup-hook)))
4600 (defun wl-summary-reply-with-citation (&optional arg)
4602 (when (wl-summary-reply arg t)
4603 (goto-char (point-max))
4604 (wl-draft-yank-original)
4605 (run-hooks 'wl-mail-setup-hook)))
4607 (defun wl-summary-jump-to-msg-by-message-id (&optional id)
4609 (let* ((original (wl-summary-message-number))
4610 (msgid (elmo-string (or id (read-from-minibuffer "Message-ID: "))))
4611 (number-alist (elmo-msgdb-get-number-alist (wl-summary-buffer-msgdb)))
4614 (format "No message with id \"%s\" in the folder." msgid)))
4615 (if (setq msg (car (rassoc msgid number-alist)))
4616 ;;; (wl-summary-jump-to-msg-internal
4617 ;;; (wl-summary-buffer-folder-name) msg 'no-sync)
4619 (wl-thread-jump-to-msg msg)
4622 (if (and elmo-use-database
4625 "No message with id \"%s\" in the database." msgid))
4626 (setq otherfld (elmo-database-msgid-get msgid)))
4627 (if (cdr (wl-summary-jump-to-msg-internal
4628 (car otherfld) (nth 1 otherfld) 'no-sync))
4630 ;; Back to original.
4631 (wl-summary-jump-to-msg-internal
4632 (wl-summary-buffer-folder-name) original 'no-sync))
4633 (cond ((eq wl-summary-search-via-nntp 'confirm)
4634 (require 'elmo-nntp)
4635 (message "Search message in nntp server \"%s\" <y/n/s(elect)>?"
4636 elmo-nntp-default-server)
4637 (setq schar (read-char))
4638 (cond ((eq schar ?y)
4639 (wl-summary-jump-to-msg-by-message-id-via-nntp msgid))
4641 (wl-summary-jump-to-msg-by-message-id-via-nntp
4643 (read-from-minibuffer "NNTP Server: ")))
4647 (wl-summary-search-via-nntp
4648 (wl-summary-jump-to-msg-by-message-id-via-nntp msgid))
4653 (defun wl-summary-jump-to-msg-by-message-id-via-nntp (&optional id server-spec)
4655 (let* ((msgid (elmo-string (or id (read-from-minibuffer "Message-ID: "))))
4656 newsgroups folder ret
4657 user server port type spec)
4659 (if (string-match "^-" server-spec)
4660 (setq spec (wl-folder-get-elmo-folder server-spec)
4661 user (elmo-net-folder-user-internal spec)
4662 server (elmo-net-folder-server-internal spec)
4663 port (elmo-net-folder-port-internal spec)
4664 type (elmo-net-folder-stream-type-internal spec))
4665 (setq server server-spec)))
4666 (when (setq ret (elmo-nntp-get-newsgroup-by-msgid
4668 (or server elmo-nntp-default-server)
4669 (or user elmo-nntp-default-user)
4670 (or port elmo-nntp-default-port)
4671 (or type elmo-nntp-default-stream-type)))
4672 (setq newsgroups (elmo-nntp-parse-newsgroups ret))
4673 (setq folder (concat "-" (car newsgroups)
4674 (elmo-nntp-folder-postfix user server port type)))
4677 (if (wl-folder-entity-exists-p (car newsgroups)
4678 wl-folder-newsgroups-hashtb)
4680 (setq folder (concat "-" (car newsgroups)
4681 (elmo-nntp-folder-postfix
4682 user server port type)))))
4683 (setq newsgroups (cdr newsgroups)))))
4685 (wl-summary-jump-to-msg-internal folder nil 'update msgid)
4686 (message "No message id \"%s\" in nntp server \"%s\"."
4687 msgid (or server elmo-nntp-default-server))
4690 (defun wl-summary-jump-to-msg-internal (folder msg scan-type &optional msgid)
4691 (let (wl-auto-select-first entity)
4692 (if (or (string= folder (wl-summary-buffer-folder-name))
4695 "Message was found in the folder \"%s\". Jump to it? "
4699 (wl-summary-goto-folder-subr
4700 folder scan-type nil nil t)
4704 (elmo-msgdb-get-number-alist
4705 (wl-summary-buffer-msgdb))))))
4706 (setq entity (wl-folder-search-entity-by-name folder
4710 (wl-folder-set-current-entity-id
4711 (wl-folder-get-entity-id entity))))
4713 (message "Message was not found currently in this folder.")
4714 (setq msg (and (wl-thread-jump-to-msg msg) msg)))
4715 (cons folder msg)))))
4717 (defun wl-summary-jump-to-parent-message (arg)
4719 (let ((cur-buf (current-buffer))
4720 (number (wl-summary-message-number))
4721 (regexp "\\(<[^<>]*>\\)[ \t]*$")
4723 msg-id msg-num ref-list ref irt)
4725 (message "No message.")
4726 (when (eq wl-summary-buffer-view 'thread)
4727 (cond ((and arg (not (numberp arg)))
4729 (wl-thread-entity-get-number
4730 (wl-thread-entity-get-top-entity
4731 (wl-thread-get-entity number)))))
4732 ((and arg (numberp arg))
4734 (setq msg-num number)
4737 (wl-thread-entity-get-number
4738 (wl-thread-entity-get-parent-entity
4739 (wl-thread-get-entity msg-num))))
4742 (wl-thread-entity-get-number
4743 (wl-thread-entity-get-parent-entity
4744 (wl-thread-get-entity number)))))))
4745 (when (null msg-num)
4746 (wl-summary-set-message-buffer-or-redisplay)
4747 (set-buffer (wl-message-get-original-buffer))
4748 (message "Searching parent message...")
4749 (setq ref (std11-field-body "References")
4750 irt (std11-field-body "In-Reply-To"))
4752 ((and arg (not (numberp arg)) ref (not (string= ref ""))
4753 (string-match regexp ref))
4754 ;; The first message of the thread.
4755 (setq msg-id (wl-match-string 1 ref)))
4756 ;; "In-Reply-To:" has only one msg-id.
4757 ((and (null arg) irt (not (string= irt ""))
4758 (string-match regexp irt))
4759 (setq msg-id (wl-match-string 1 irt)))
4760 ((and (or (null arg) (numberp arg)) ref (not (string= ref ""))
4761 (string-match regexp ref))
4762 ;; "^" searching parent, "C-u 2 ^" looking for grandparent.
4763 (while (string-match regexp ref)
4766 (wl-match-string 1 ref))
4768 (setq ref (substring ref (match-end 0)))
4771 (if (null arg) (nth 0 ref-list) ;; previous
4772 (if (<= arg i) (nth (1- arg) ref-list)
4773 (nth i ref-list)))))))
4774 (set-buffer cur-buf)
4775 (cond ((and (null msg-id) (null msg-num))
4776 (message "No parent message!")
4778 ((and msg-id (wl-summary-jump-to-msg-by-message-id msg-id))
4779 (wl-summary-redisplay)
4780 (message "Searching parent message...done")
4782 ((and msg-num (wl-summary-jump-to-msg msg-num))
4783 (wl-summary-redisplay)
4784 (message "Searching parent message...done")
4787 (message "Parent message was not found.")
4790 (defun wl-summary-reply (&optional arg without-setup-hook)
4791 "Reply to current message. Default is \"wide\" reply.
4792 Reply to author if invoked with ARG."
4794 (let ((folder wl-summary-buffer-elmo-folder)
4795 (number (wl-summary-message-number))
4796 (summary-buf (current-buffer))
4800 (wl-summary-redisplay-internal folder number))
4801 (setq mes-buf wl-message-buffer)
4802 (wl-message-select-buffer wl-message-buffer)
4803 (set-buffer mes-buf)
4804 (goto-char (point-min))
4805 (unless wl-draft-use-frame
4806 (split-window-vertically)
4808 (when (setq mes-buf (wl-message-get-original-buffer))
4809 (wl-draft-reply mes-buf arg summary-buf)
4810 (unless without-setup-hook
4811 (run-hooks 'wl-mail-setup-hook)))
4814 (defun wl-summary-write ()
4815 "Write a new draft from Summary."
4817 (wl-draft (list (cons 'To ""))
4818 nil nil nil nil (wl-summary-buffer-folder-name))
4819 (run-hooks 'wl-mail-setup-hook)
4820 (mail-position-on-field "To"))
4822 (defvar wl-summary-write-current-folder-functions
4823 '(wl-folder-get-newsgroups
4824 wl-folder-guess-mailing-list-by-refile-rule
4825 wl-folder-guess-mailing-list-by-folder-name)
4826 "Newsgroups or Mailing List address guess functions list.
4827 Call from `wl-summary-write-current-folder'.
4828 When guess function return nil, challenge next guess-function.")
4830 (defun wl-summary-write-current-folder (&optional folder)
4831 "Write message to current FOLDER's newsgroup or mailing-list.
4832 Use function list is `wl-summary-write-current-folder-functions'."
4834 ;; default FOLDER is current buffer folder
4835 (setq folder (or folder (wl-summary-buffer-folder-name)))
4836 (let ((func-list wl-summary-write-current-folder-functions)
4837 guess-list guess-func)
4839 (setq guess-list (funcall (car func-list) folder))
4840 (if (null guess-list)
4841 (setq func-list (cdr func-list))
4842 (setq guess-func (car func-list))
4843 (setq func-list nil)))
4844 (if (null guess-func)
4846 (unless (or (stringp (nth 0 guess-list))
4847 (stringp (nth 1 guess-list))
4848 (stringp (nth 2 guess-list)))
4849 (error "Invalid value return guess function `%s'"
4850 (symbol-name guess-func)))
4851 (wl-draft (list (cons 'To (nth 0 guess-list))
4852 (cons 'Cc (nth 1 guess-list))
4853 (cons 'Newsgroups (nth 2 guess-list)))
4854 nil nil nil nil folder)
4855 (run-hooks 'wl-mail-setup-hook)
4856 (mail-position-on-field "Subject"))))
4858 (defun wl-summary-forward (&optional without-setup-hook)
4861 (let ((folder wl-summary-buffer-elmo-folder)
4862 (number (wl-summary-message-number))
4863 (summary-buf (current-buffer))
4864 (wl-draft-forward t)
4868 (message "No message.")
4869 (if (and (elmo-message-use-cache-p folder number)
4870 (eq (elmo-file-cache-status
4871 (elmo-file-cache-get
4872 (elmo-message-field folder number 'message-id)))
4875 (wl-summary-redisplay-internal nil nil 'force-reload)
4876 (wl-summary-redisplay-internal folder number))
4877 (setq mes-buf wl-message-buffer)
4878 (wl-message-select-buffer mes-buf)
4879 (unless wl-draft-use-frame
4880 (split-window-vertically)
4882 ;; get original subject.
4885 (set-buffer summary-buf)
4887 (or (elmo-message-field folder number 'subject) ""))))
4888 (set-buffer mes-buf)
4889 (wl-draft-forward subject summary-buf)
4890 (unless without-setup-hook
4891 (run-hooks 'wl-mail-setup-hook)))))
4893 (defun wl-summary-click (e)
4898 (defun wl-summary-read ()
4899 "Proceed reading message in the summary buffer."
4901 (let ((cur-buf (current-buffer)))
4902 (wl-summary-toggle-disp-msg 'on)
4903 (when (wl-summary-set-message-buffer-or-redisplay 'ignore-original)
4904 (set-buffer cur-buf)
4905 (if (wl-message-next-page)
4906 (wl-summary-down t)))))
4908 (defun wl-summary-prev (&optional interactive)
4911 (if wl-summary-move-direction-toggle
4912 (setq wl-summary-move-direction-downward nil))
4913 (let ((skip-mark-regexp (mapconcat
4915 wl-summary-skip-mark-list ""))
4916 goto-next regex-list regex next-entity finfo)
4918 (if (elmo-folder-plugged-p wl-summary-buffer-elmo-folder)
4919 (setq regex (format "%s[^%s]"
4920 wl-summary-message-regexp
4921 (concat skip-mark-regexp "0-9")))
4922 (setq regex (format "%s[^%s]\\(%s\\|%s\\| \\)"
4923 wl-summary-message-regexp
4924 (concat skip-mark-regexp "0-9")
4925 (regexp-quote wl-summary-unread-cached-mark)
4926 (regexp-quote wl-summary-important-mark))))
4927 (unless (re-search-backward regex nil t)
4932 (if wl-summary-buffer-disp-msg
4933 (wl-summary-redisplay)))
4934 (if (or interactive (interactive-p))
4935 (if wl-summary-buffer-prev-folder-function
4936 (funcall wl-summary-buffer-prev-folder-function)
4937 (when wl-auto-select-next
4938 (setq next-entity (wl-summary-get-prev-folder))
4940 (setq finfo (wl-folder-get-entity-info next-entity))))
4942 '(lambda () (wl-summary-next-folder-or-exit next-entity))
4944 "No more messages. Type SPC to go to %s."
4945 (wl-summary-entity-info-msg next-entity finfo))))))))
4947 (defun wl-summary-next (&optional interactive)
4950 (if wl-summary-move-direction-toggle
4951 (setq wl-summary-move-direction-downward t))
4952 (let ((skip-mark-regexp (mapconcat
4954 wl-summary-skip-mark-list ""))
4955 goto-next regex regex-list next-entity finfo)
4957 (if (elmo-folder-plugged-p wl-summary-buffer-elmo-folder)
4958 (setq regex (format "%s[^%s]"
4959 wl-summary-message-regexp
4960 (concat skip-mark-regexp "0-9")))
4961 (setq regex (format "%s[^%s]\\(%s\\|%s\\| \\)"
4962 wl-summary-message-regexp
4963 (concat skip-mark-regexp "0-9")
4964 (regexp-quote wl-summary-unread-cached-mark)
4965 (regexp-quote wl-summary-important-mark))))
4966 (unless (re-search-forward regex nil t)
4971 (if wl-summary-buffer-disp-msg
4972 (wl-summary-redisplay))
4973 (if (or interactive (interactive-p))
4974 (if wl-summary-buffer-next-folder-function
4975 (funcall wl-summary-buffer-next-folder-function)
4976 (when wl-auto-select-next
4977 (setq next-entity (wl-summary-get-next-folder))
4979 (setq finfo (wl-folder-get-entity-info next-entity))))
4981 '(lambda () (wl-summary-next-folder-or-exit next-entity))
4983 "No more messages. Type SPC to go to %s."
4984 (wl-summary-entity-info-msg next-entity finfo))))))))
4986 (defun wl-summary-up (&optional interactive skip-no-unread)
4989 (if wl-summary-move-direction-toggle
4990 (setq wl-summary-move-direction-downward nil))
4991 (if (wl-summary-cursor-up)
4992 (if wl-summary-buffer-disp-msg
4993 (wl-summary-redisplay))
4996 (if wl-summary-buffer-prev-folder-function
4997 (funcall wl-summary-buffer-prev-folder-function)
4998 (let (next-entity finfo)
4999 (when wl-auto-select-next
5001 (setq next-entity (wl-summary-get-prev-unread-folder))
5003 (setq finfo (wl-folder-get-entity-info next-entity)))))
5004 (if (and skip-no-unread
5005 (eq wl-auto-select-next 'skip-no-unread))
5006 (wl-summary-next-folder-or-exit next-entity t)
5008 '(lambda () (wl-summary-next-folder-or-exit next-entity t))
5010 "No more unread messages. Type SPC to go to %s."
5011 (wl-summary-entity-info-msg next-entity finfo)))))))))
5013 (defun wl-summary-get-prev-folder ()
5014 (let ((folder-buf (get-buffer wl-folder-buffer-name))
5017 (setq cur-id (save-excursion (set-buffer folder-buf)
5018 wl-folder-buffer-cur-entity-id))
5019 (wl-folder-get-prev-folder cur-id))))
5021 (defun wl-summary-get-next-folder ()
5022 (let ((folder-buf (get-buffer wl-folder-buffer-name))
5025 (setq cur-id (save-excursion (set-buffer folder-buf)
5026 wl-folder-buffer-cur-entity-id))
5027 (wl-folder-get-next-folder cur-id))))
5029 (defun wl-summary-get-next-unread-folder ()
5030 (let ((folder-buf (get-buffer wl-folder-buffer-name))
5033 (setq cur-id (save-excursion (set-buffer folder-buf)
5034 wl-folder-buffer-cur-entity-id))
5035 (wl-folder-get-next-folder cur-id 'unread))))
5037 (defun wl-summary-get-prev-unread-folder ()
5038 (let ((folder-buf (get-buffer wl-folder-buffer-name))
5041 (setq cur-id (save-excursion (set-buffer folder-buf)
5042 wl-folder-buffer-cur-entity-id))
5043 (wl-folder-get-prev-folder cur-id 'unread))))
5045 (defun wl-summary-down (&optional interactive skip-no-unread)
5047 (if wl-summary-move-direction-toggle
5048 (setq wl-summary-move-direction-downward t))
5049 (if (wl-summary-cursor-down)
5050 (if wl-summary-buffer-disp-msg
5051 (wl-summary-redisplay))
5054 (if wl-summary-buffer-next-folder-function
5055 (funcall wl-summary-buffer-next-folder-function)
5056 (let (next-entity finfo)
5057 (when wl-auto-select-next
5058 (setq next-entity (wl-summary-get-next-unread-folder)))
5060 (setq finfo (wl-folder-get-entity-info next-entity)))
5061 (if (and skip-no-unread
5062 (eq wl-auto-select-next 'skip-no-unread))
5063 (wl-summary-next-folder-or-exit next-entity)
5065 '(lambda () (wl-summary-next-folder-or-exit next-entity))
5067 "No more unread messages. Type SPC to go to %s."
5068 (wl-summary-entity-info-msg next-entity finfo)))))))))
5070 (defun wl-summary-goto-last-displayed-msg ()
5072 (unless wl-summary-buffer-last-displayed-msg
5073 (setq wl-summary-buffer-last-displayed-msg
5074 wl-summary-buffer-current-msg))
5075 (if wl-summary-buffer-last-displayed-msg
5077 (wl-summary-jump-to-msg wl-summary-buffer-last-displayed-msg)
5078 (if wl-summary-buffer-disp-msg
5079 (wl-summary-redisplay)))
5080 (message "No last message.")))
5082 (defun wl-summary-redisplay (&optional arg)
5085 (wl-summary-no-mime-p wl-summary-buffer-elmo-folder))
5086 (wl-summary-redisplay-no-mime)
5087 (wl-summary-redisplay-internal nil nil arg)))
5089 (defsubst wl-summary-redisplay-internal (&optional folder number force-reload)
5091 (let* ((msgdb (wl-summary-buffer-msgdb))
5092 (folder (or folder wl-summary-buffer-elmo-folder))
5093 (num (or number (wl-summary-message-number)))
5094 (wl-mime-charset wl-summary-buffer-mime-charset)
5095 (default-mime-charset wl-summary-buffer-mime-charset)
5096 fld-buf fld-win thr-entity)
5097 (if (and wl-thread-open-reading-thread
5098 (eq wl-summary-buffer-view 'thread)
5099 (not (wl-thread-entity-get-opened
5100 (setq thr-entity (wl-thread-get-entity
5102 (wl-thread-entity-get-children thr-entity))
5103 (wl-thread-force-open))
5106 (setq wl-summary-buffer-disp-msg t)
5107 (setq wl-summary-buffer-last-displayed-msg
5108 wl-summary-buffer-current-msg)
5109 ;; hide folder window
5110 (if (and (not wl-stay-folder-window)
5111 (setq fld-buf (get-buffer wl-folder-buffer-name)))
5112 (if (setq fld-win (get-buffer-window fld-buf))
5113 (delete-window fld-win)))
5114 (setq wl-current-summary-buffer (current-buffer))
5115 (wl-summary-mark-as-read
5117 ;; not fetched, then change server-mark.
5118 (if (wl-message-redisplay folder num 'mime
5120 (string= (elmo-folder-name-internal
5124 ;; plugged, then leave server-mark.
5127 (elmo-folder-local-p
5128 wl-summary-buffer-elmo-folder))
5129 (elmo-folder-plugged-p
5130 wl-summary-buffer-elmo-folder))
5134 'cached ; cached by reading.
5136 (setq wl-summary-buffer-current-msg num)
5137 (when wl-summary-recenter
5138 (recenter (/ (- (window-height) 2) 2))
5139 (if (not wl-summary-indent-length-limit)
5140 (wl-horizontal-recenter)))
5141 (wl-highlight-summary-displaying)
5142 (wl-message-buffer-prefetch-next folder num
5143 wl-message-buffer-prefetch-depth
5145 wl-summary-buffer-mime-charset)
5146 (run-hooks 'wl-summary-redisplay-hook))
5147 (message "No message to display."))))
5149 (defun wl-summary-redisplay-no-mime (&optional ask-coding)
5150 "Display message without MIME decoding.
5151 If ASK-CODING is non-nil, coding-system for the message is asked."
5153 (let ((elmo-mime-display-as-is-coding-system
5155 (or (read-coding-system "Coding system: ")
5156 elmo-mime-display-as-is-coding-system)
5157 elmo-mime-display-as-is-coding-system)))
5158 (wl-summary-redisplay-no-mime-internal)))
5160 (defun wl-summary-redisplay-no-mime-internal (&optional folder number)
5161 (let* ((fld (or folder wl-summary-buffer-elmo-folder))
5162 (num (or number (wl-summary-message-number)))
5166 (setq wl-summary-buffer-disp-msg t)
5167 (setq wl-summary-buffer-last-displayed-msg
5168 wl-summary-buffer-current-msg)
5169 (setq wl-current-summary-buffer (current-buffer))
5170 (wl-message-redisplay fld num 'as-is
5171 (string= (elmo-folder-name-internal fld)
5173 (wl-summary-mark-as-read nil nil t)
5174 (setq wl-summary-buffer-current-msg num)
5175 (when wl-summary-recenter
5176 (recenter (/ (- (window-height) 2) 2))
5177 (if (not wl-summary-indent-length-limit)
5178 (wl-horizontal-recenter)))
5179 (wl-highlight-summary-displaying)
5180 (run-hooks 'wl-summary-redisplay-hook))
5181 (message "No message to display.")
5182 (wl-ask-folder 'wl-summary-exit
5183 "No more messages. Type SPC to go to folder mode."))))
5185 (defun wl-summary-redisplay-all-header (&optional folder number)
5187 (let* ((fld (or folder wl-summary-buffer-elmo-folder))
5188 (num (or number (wl-summary-message-number)))
5189 (wl-mime-charset wl-summary-buffer-mime-charset)
5190 (default-mime-charset wl-summary-buffer-mime-charset))
5193 (setq wl-summary-buffer-disp-msg t)
5194 (setq wl-summary-buffer-last-displayed-msg
5195 wl-summary-buffer-current-msg)
5196 (setq wl-current-summary-buffer (current-buffer))
5197 (if (wl-message-redisplay fld num 'all-header
5198 (string= (elmo-folder-name-internal fld)
5200 (wl-summary-mark-as-read nil nil t))
5201 (setq wl-summary-buffer-current-msg num)
5202 (when wl-summary-recenter
5203 (recenter (/ (- (window-height) 2) 2))
5204 (if (not wl-summary-indent-length-limit)
5205 (wl-horizontal-recenter)))
5206 (wl-highlight-summary-displaying)
5207 (run-hooks 'wl-summary-redisplay-hook))
5208 (message "No message to display."))))
5210 (defun wl-summary-jump-to-current-message ()
5211 "Jump into Message buffer."
5213 (let (message-buf message-win)
5214 (if (setq message-buf wl-message-buffer)
5215 (if (setq message-win (get-buffer-window message-buf))
5216 (select-window message-win)
5217 (wl-message-select-buffer wl-message-buffer))
5218 (wl-summary-redisplay)
5219 (wl-message-select-buffer wl-message-buffer))))
5221 (defun wl-summary-cancel-message ()
5222 "Cancel an article on news."
5224 (if (null (wl-summary-message-number))
5225 (message "No message.")
5226 (let ((summary-buf (current-buffer))
5228 (wl-summary-set-message-buffer-or-redisplay)
5229 (if (setq message-buf (wl-message-get-original-buffer))
5230 (set-buffer message-buf))
5231 (unless (wl-message-news-p)
5232 (set-buffer summary-buf)
5233 (if (and (eq (elmo-folder-type-internal wl-summary-buffer-elmo-folder)
5235 (y-or-n-p "Cannot get Newsgroups. Fetch again? "))
5237 (wl-summary-redisplay t)
5238 (wl-summary-supersedes-message))
5239 (error "This is not a news article; supersedes is impossible")))
5240 (when (yes-or-no-p "Do you really want to cancel this article? ")
5241 (let (from newsgroups message-id distribution buf)
5243 (setq from (std11-field-body "from")
5244 newsgroups (std11-field-body "newsgroups")
5245 message-id (std11-field-body "message-id")
5246 distribution (std11-field-body "distribution"))
5247 ;; Make sure that this article was written by the user.
5248 (unless (wl-address-user-mail-address-p
5249 (wl-address-header-extract-address
5250 (car (wl-parse-addresses from))))
5251 (error "This article is not yours"))
5252 ;; Make control message.
5253 (setq buf (set-buffer (get-buffer-create " *message cancel*")))
5254 (setq wl-draft-buffer-cur-summary-buffer summary-buf)
5255 (buffer-disable-undo (current-buffer))
5257 (insert "Newsgroups: " newsgroups "\n"
5258 "From: " (wl-address-header-extract-address
5260 "Subject: cmsg cancel " message-id "\n"
5261 "Control: cancel " message-id "\n"
5263 (concat "Distribution: " distribution "\n")
5265 mail-header-separator "\n"
5266 wl-summary-cancel-message)
5267 (message "Canceling your message...")
5268 (wl-draft-raw-send t t) ; kill when done, force-pre-hooks.
5269 (message "Canceling your message...done")))))))
5271 (defun wl-summary-supersedes-message ()
5272 "Supersede current message."
5274 (let ((summary-buf (current-buffer))
5276 (wl-summary-set-message-buffer-or-redisplay)
5277 (if (setq message-buf (wl-message-get-original-buffer))
5278 (set-buffer message-buf))
5279 (unless (wl-message-news-p)
5280 (set-buffer summary-buf)
5281 (if (and (eq (elmo-folder-type-internal wl-summary-buffer-elmo-folder)
5283 (y-or-n-p "Cannot get Newsgroups. Fetch again? "))
5285 (wl-summary-redisplay t)
5286 (wl-summary-supersedes-message))
5287 (error "This is not a news article; supersedes is impossible")))
5289 (setq from (std11-field-body "from"))
5290 ;; Make sure that this article was written by the user.
5291 (unless (wl-address-user-mail-address-p
5292 (wl-address-header-extract-address
5293 (car (wl-parse-addresses from))))
5294 (error "This article is not yours"))
5295 (let* ((message-id (std11-field-body "message-id"))
5296 (followup-to (std11-field-body "followup-to"))
5297 (mail-default-headers
5298 (concat mail-default-headers
5299 "Supersedes: " message-id "\n"
5301 (concat "Followup-To: " followup-to "\n")))))
5302 (if message-buf (set-buffer message-buf))
5303 (wl-draft-edit-string (buffer-substring (point-min) (point-max)))))))
5305 (defun wl-summary-save (&optional arg wl-save-dir)
5306 "Save current message to disk."
5309 (num (wl-summary-message-number)))
5310 (if (null wl-save-dir)
5311 (setq wl-save-dir wl-temporary-file-directory))
5314 (setq filename (expand-file-name
5318 (null (file-exists-p filename))))
5320 (read-file-name "Save to file: " filename)))
5322 (wl-summary-set-message-buffer-or-redisplay)
5323 (set-buffer (wl-message-get-original-buffer))
5324 (if (and (null arg) (file-exists-p filename))
5325 (if (y-or-n-p "File already exists. override it? ")
5326 (write-region (point-min) (point-max) filename))
5327 (write-region (point-min) (point-max) filename)))
5328 (message "No message to save."))
5331 (defun wl-summary-save-region (beg end)
5335 (narrow-to-region beg end)
5336 (goto-char (point-min))
5338 (wl-read-directory-name "Save to directory: "
5339 wl-temporary-file-directory)))
5340 (if (null (file-exists-p wl-save-dir))
5341 (make-directory wl-save-dir))
5342 (if (eq wl-summary-buffer-view 'thread)
5345 (let* ((number (wl-summary-message-number))
5346 (entity (wl-thread-get-entity number)))
5347 (if (wl-thread-entity-get-opened entity)
5348 (wl-summary-save t wl-save-dir)
5350 (wl-summary-save t wl-save-dir))
5353 (wl-summary-save t wl-save-dir)
5354 (forward-line 1)))))))
5356 ;; mew-summary-pipe-message()
5357 (defun wl-summary-pipe-message (prefix command)
5358 "Send this message via pipe."
5359 (interactive (list current-prefix-arg nil))
5360 (if (null (wl-summary-message-number))
5361 (message "No message.")
5362 (setq command (read-string "Shell command on message: "
5363 wl-summary-shell-command-last))
5364 (if (y-or-n-p "Send this message to pipe? ")
5365 (wl-summary-pipe-message-subr prefix command))))
5367 (defun wl-summary-target-mark-pipe (prefix command)
5368 "Send each marked messages via pipe."
5369 (interactive (list current-prefix-arg nil))
5370 (if (null wl-summary-buffer-target-mark-list)
5371 (message "No marked message.")
5372 (setq command (read-string "Shell command on each marked message: "
5373 wl-summary-shell-command-last))
5374 (when (y-or-n-p "Send each marked message to pipe? ")
5375 (while (car wl-summary-buffer-target-mark-list)
5376 (let ((num (car wl-summary-buffer-target-mark-list)))
5377 (wl-thread-jump-to-msg num)
5378 (wl-summary-pipe-message-subr prefix command)
5379 (wl-summary-unmark num))))))
5381 (defun wl-summary-pipe-message-subr (prefix command)
5383 (wl-summary-set-message-buffer-or-redisplay)
5384 (set-buffer (wl-message-get-original-buffer))
5385 (if (string= command "")
5386 (setq command wl-summary-shell-command-last))
5387 (goto-char (point-min)) ; perhaps this line won't be necessary
5389 (search-forward "\n\n"))
5390 (shell-command-on-region (point) (point-max) command nil)
5391 (setq wl-summary-shell-command-last command)))
5393 (defun wl-summary-print-message (&optional arg)
5395 (if (null (wl-summary-message-number))
5396 (message "No message.")
5398 (wl-summary-set-message-buffer-or-redisplay)
5399 (if (or (not (interactive-p))
5400 (y-or-n-p "Print ok? "))
5402 (let ((buffer (generate-new-buffer " *print*")))
5403 (copy-to-buffer buffer (point-min) (point-max))
5405 (funcall wl-print-buffer-function)
5406 (kill-buffer buffer)))
5409 (defun wl-summary-print-message-with-ps-print (&optional filename)
5410 "Print message via ps-print."
5412 (if (null (wl-summary-message-number))
5413 (message "No message.")
5414 (setq filename (ps-print-preprint current-prefix-arg))
5415 (if (or (not (interactive-p))
5416 (y-or-n-p "Print ok? "))
5417 (let ((summary-buffer (current-buffer))
5420 (wl-summary-set-message-buffer-or-redisplay)
5421 ;; (wl-summary-redisplay-internal)
5422 (let* ((buffer (generate-new-buffer " *print*"))
5424 (set-buffer summary-buffer)
5426 (wl-summary-message-number)
5427 (elmo-msgdb-get-number-alist
5428 (wl-summary-buffer-msgdb))))
5429 (elmo-msgdb-get-overview
5430 (wl-summary-buffer-msgdb)))))
5433 (or (elmo-msgdb-overview-entity-get-subject entity)
5437 (or (elmo-msgdb-overview-entity-get-from entity) "")))
5440 (or (elmo-msgdb-overview-entity-get-date entity) ""))))
5441 (run-hooks 'wl-ps-preprint-hook)
5442 (set-buffer wl-message-buffer)
5443 (copy-to-buffer buffer (point-min) (point-max))
5446 (let ((ps-left-header
5447 (list (concat "(" wl-ps-subject ")")
5448 (concat "(" wl-ps-from ")")))
5450 (list "/pagenumberstring load"
5451 (concat "(" wl-ps-date ")"))))
5452 (run-hooks 'wl-ps-print-hook)
5453 (funcall wl-ps-print-buffer-function filename))
5454 (kill-buffer buffer)))))
5457 (if (featurep 'ps-print) ; ps-print is available.
5458 (fset 'wl-summary-print-message 'wl-summary-print-message-with-ps-print))
5460 (defun wl-summary-target-mark-print ()
5462 (if (null wl-summary-buffer-target-mark-list)
5463 (message "No marked message.")
5464 (when (y-or-n-p "Print all marked messages. OK? ")
5465 (while (car wl-summary-buffer-target-mark-list)
5466 (let ((num (car wl-summary-buffer-target-mark-list)))
5467 (wl-thread-jump-to-msg num)
5468 (wl-summary-print-message)
5469 (wl-summary-unmark num))))))
5471 (defun wl-summary-folder-info-update ()
5472 (let ((folder (elmo-string (wl-summary-buffer-folder-name)))
5473 (num-db (elmo-msgdb-get-number-alist
5474 (wl-summary-buffer-msgdb))))
5475 (wl-folder-set-folder-updated folder
5477 (+ wl-summary-buffer-unread-count
5478 wl-summary-buffer-new-count)
5481 (defun wl-summary-get-original-buffer ()
5482 "Get original buffer for the current summary."
5484 (wl-summary-set-message-buffer-or-redisplay)
5485 (wl-message-get-original-buffer)))
5487 (defun wl-summary-pack-number (&optional arg)
5489 (elmo-folder-pack-numbers wl-summary-buffer-elmo-folder)
5490 (let (wl-use-scoring)
5491 (wl-summary-rescan)))
5493 (defun wl-summary-target-mark-uudecode ()
5495 (let ((mlist (reverse wl-summary-buffer-target-mark-list))
5496 (summary-buf (current-buffer))
5497 (tmp-buf (get-buffer-create "*WL UUENCODE*"))
5498 orig-buf i k filename rc errmsg)
5500 (setq k (length mlist))
5501 (set-buffer tmp-buf)
5503 (save-window-excursion
5505 (set-buffer summary-buf)
5506 (wl-summary-jump-to-msg (car mlist))
5507 (wl-summary-redisplay)
5508 (set-buffer (setq orig-buf (wl-summary-get-original-buffer)))
5509 (goto-char (point-min))
5510 (cond ((= i 1) ; first
5511 (if (setq filename (wl-message-uu-substring
5515 (error "Can't find begin line")))
5517 (wl-message-uu-substring orig-buf tmp-buf))
5519 (wl-message-uu-substring orig-buf tmp-buf nil t)))
5521 (setq mlist (cdr mlist)))
5522 (set-buffer tmp-buf)
5523 (message "Exec %s..." wl-prog-uudecode)
5525 (let ((decode-dir wl-temporary-file-directory))
5526 (if (not wl-prog-uudecode-no-stdout-option)
5527 (setq filename (read-file-name "Save to file: "
5529 (elmo-safe-filename filename)
5530 wl-temporary-file-directory)))
5532 (wl-read-directory-name "Save to directory: "
5533 wl-temporary-file-directory))
5534 (setq filename (expand-file-name filename decode-dir)))
5535 (if (file-exists-p filename)
5536 (or (yes-or-no-p (format "File %s exists. Save anyway? "
5539 (elmo-bind-directory
5543 (apply 'call-process-region (point-min) (point-max)
5544 wl-prog-uudecode t (current-buffer) nil
5545 wl-prog-uudecode-arg))))
5546 (when (not (= 0 rc))
5547 (setq errmsg (buffer-substring (point-min)(point-max)))
5548 (error "Uudecode error: %s" errmsg))
5549 (if (not wl-prog-uudecode-no-stdout-option)
5550 (let (file-name-handler-alist) ;; void jka-compr
5551 (as-binary-output-file
5552 (write-region (point-min) (point-max)
5553 filename nil 'no-msg))))
5555 (set-buffer summary-buf)
5556 (wl-summary-delete-all-temp-marks))
5557 (if (file-exists-p filename)
5558 (message "Saved as %s" filename)))
5559 (kill-buffer tmp-buf)))))
5562 ;; (defun wl-summary-drop-unsync ()
5563 ;; "Drop all unsync messages."
5565 ;; (if (elmo-folder-pipe-p (wl-summary-buffer-folder-name))
5566 ;; (error "You cannot drop unsync messages in this folder"))
5567 ;; (if (or (not (interactive-p))
5568 ;; (y-or-n-p "Drop all unsync messages? "))
5569 ;; (let* ((folder-list (elmo-folder-get-primitive-folder-list
5570 ;; (wl-summary-buffer-folder-name)))
5571 ;; (is-multi (elmo-multi-p (wl-summary-buffer-folder-name)))
5575 ;; (message "Dropping...")
5576 ;; (while folder-list
5577 ;; (setq pair (elmo-folder-message-numbers (car folder-list)))
5578 ;; (when is-multi ;; dirty hack...
5580 ;; (setcar pair (+ (* multi-num elmo-multi-divide-number)
5582 ;; (elmo-msgdb-set-number-alist
5583 ;; (wl-summary-buffer-msgdb)
5585 ;; (elmo-msgdb-get-number-alist (wl-summary-buffer-msgdb))
5586 ;; (list (cons (car pair) nil))))
5587 ;; (setq sum (+ sum (cdr pair)))
5588 ;; (setq folder-list (cdr folder-list)))
5589 ;; (wl-summary-set-message-modified)
5590 ;; (wl-folder-set-folder-updated (wl-summary-buffer-folder-name)
5592 ;; (+ wl-summary-buffer-unread-count
5593 ;; wl-summary-buffer-new-count)
5595 ;; (message "Dropping...done"))))
5597 (defun wl-summary-default-get-next-msg (msg)
5598 (or (wl-summary-next-message msg
5599 (if wl-summary-move-direction-downward 'down
5602 (cadr (memq msg (if wl-summary-move-direction-downward
5603 wl-summary-buffer-number-list
5604 (reverse wl-summary-buffer-number-list))))))
5606 (defun wl-summary-save-current-message ()
5607 "Save current message for `wl-summary-yank-saved-message'."
5609 (let ((number (wl-summary-message-number)))
5610 (setq wl-summary-buffer-saved-message number)
5611 (and number (message "No: %s is saved." number))))
5613 (defun wl-summary-yank-saved-message ()
5614 "Set current message as a parent of the saved message."
5616 (if wl-summary-buffer-saved-message
5617 (let ((number (wl-summary-message-number)))
5618 (if (eq wl-summary-buffer-saved-message number)
5619 (message "Cannot set itself as a parent.")
5621 (wl-thread-jump-to-msg wl-summary-buffer-saved-message)
5622 (wl-thread-set-parent number)
5623 (wl-summary-set-thread-modified))
5624 (setq wl-summary-buffer-saved-message nil)))
5625 (message "There's no saved message.")))
5628 (product-provide (provide 'wl-summary) (require 'wl-version))
5630 ;;; wl-summary.el ends here