« back to all changes in this revision
Viewing changes to wl/wl-action.el
- browse files at revision 4
- compare with another revision
- download diff
- download tarball
- view history from revision 4
- Committer: Bazaar Package Importer
- Author(s): Tatsuya Kinoshita
- Date: 2007-01-02 21:08:54 UTC
- mfrom: (3.1.3 edgy)
- Revision ID: james.westby@ubuntu.com-20070102210854-nw929130dlxgi6q3
Tags: 2.14.0-4
elmo/elmo-imap4.el: Fix "IMAP error: No `OK' response from server",
patch from upstream CVS version. (closes: #405284)
patch from upstream CVS version. (closes: #405284)
- files added:
- debian/watch
- files removed:
- elmo/elmo-mark.el
- files modified:
- ChangeLog
added
removed
wl/wl-action.el
1
;;; wl-action.el --- Mark and actions in the Summary mode for Wanderlust.
2
3
;; Copyright (C) 2003 Yuuichi Teranishi <teranisi@gohome.org>
4
5
;; Author: Yuuichi Teranishi <teranisi@gohome.org>
6
;; Keywords: mail, net news
7
8
;; This file is part of Wanderlust (Yet Another Message Interface on Emacsen).
9
10
;; This program is free software; you can redistribute it and/or modify
11
;; it under the terms of the GNU General Public License as published by
12
;; the Free Software Foundation; either version 2, or (at your option)
13
;; any later version.
14
;;
15
;; This program is distributed in the hope that it will be useful,
16
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
17
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18
;; GNU General Public License for more details.
19
;;
20
;; You should have received a copy of the GNU General Public License
21
;; along with GNU Emacs; see the file COPYING. If not, write to the
22
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
23
;; Boston, MA 02111-1307, USA.
24
;;
25
26
;;; Commentary:
27
;;
28
29
;;; Code:
30
;;
31
32
(require 'wl-summary)
33
34
(eval-when-compile
35
(defalias-maybe 'wl-summary-target-mark 'ignore)
36
(defalias-maybe 'wl-summary-target-mark-region 'ignore))
37
38
(defsubst wl-summary-action-mark (action)
39
(nth 0 action))
40
(defsubst wl-summary-action-symbol (action)
41
(nth 1 action))
42
(defsubst wl-summary-action-argument-function (action)
43
(nth 2 action))
44
(defsubst wl-summary-action-set-function (action)
45
(nth 3 action))
46
(defsubst wl-summary-action-exec-function (action)
47
(nth 4 action))
48
(defsubst wl-summary-action-face (action)
49
(nth 5 action))
50
(defsubst wl-summary-action-docstring (action)
51
(concat (nth 6 action)
52
"\nThis function is defined by `wl-summary-define-mark-action'."))
53
54
;; Set mark
55
(defun wl-summary-set-mark (&optional set-mark number interactive data)
56
(interactive)
57
"Set temporary mark SET-MARK on the message with NUMBER.
58
NUMBER is the message number to set the mark on.
59
INTERACTIVE is set as t if it have to run interactively.
60
DATA is passed to the set-action function of the action as an argument.
61
Return number if put mark succeed"
62
(let* ((set-mark (or set-mark
63
(completing-read "Mark: " wl-summary-mark-action-list)))
64
(current (wl-summary-message-number))
65
(action (assoc set-mark wl-summary-mark-action-list))
66
visible mark cur-mark)
67
(when (zerop (elmo-folder-length wl-summary-buffer-elmo-folder))
68
(error "Set mark failed"))
69
(prog1
70
(save-excursion
71
;; Put mark
72
(if number
73
;; Jump to message if cursor is not on the message.
74
(when (and (setq visible (wl-summary-message-visible-p number))
75
(not (eq number current)))
76
(wl-summary-jump-to-msg number))
77
(setq visible t
78
number current))
79
(setq cur-mark (nth 1 (wl-summary-registered-temp-mark number)))
80
(unless number
81
(error "No message"))
82
(if (wl-summary-reserve-temp-mark-p cur-mark)
83
(when interactive
84
(error "Already marked as `%s'" cur-mark))
85
(when (and interactive
86
(null data)
87
(wl-summary-action-argument-function action))
88
(setq data (funcall (wl-summary-action-argument-function action)
89
(wl-summary-action-symbol action)
90
number)))
91
;; Unset the current mark.
92
(wl-summary-unset-mark number)
93
;; Set action.
94
(funcall (wl-summary-action-set-function action)
95
number
96
(wl-summary-action-mark action)
97
data)
98
(when visible
99
(wl-summary-put-temp-mark set-mark)
100
(when wl-summary-highlight
101
(wl-highlight-summary-current-line))
102
(when data
103
(wl-summary-print-argument number data)))
104
(set-buffer-modified-p nil)
105
;; Return value.
106
number))
107
;; Move the cursor.
108
(if (or interactive (interactive-p))
109
(if (eq wl-summary-move-direction-downward nil)
110
(wl-summary-prev)
111
(wl-summary-next))))))
112
113
(defun wl-summary-register-target-mark (number mark data)
114
(or (memq number wl-summary-buffer-target-mark-list)
115
(setq wl-summary-buffer-target-mark-list
116
(cons number wl-summary-buffer-target-mark-list))))
117
118
(defun wl-summary-unregister-target-mark (number)
119
(setq wl-summary-buffer-target-mark-list
120
(delq number wl-summary-buffer-target-mark-list)))
121
122
(defun wl-summary-have-target-mark-p (number)
123
(memq number wl-summary-buffer-target-mark-list))
124
125
(defun wl-summary-target-mark-set-action (action)
126
(unless (eq (wl-summary-action-symbol action) 'target-mark)
127
(unless wl-summary-buffer-target-mark-list (error "no target"))
128
(save-excursion
129
(goto-char (point-min))
130
(let ((numlist wl-summary-buffer-number-list)
131
number mlist data)
132
;; use firstly marked message.
133
(when (wl-summary-action-argument-function action)
134
(while numlist
135
(if (memq (car numlist) wl-summary-buffer-target-mark-list)
136
(setq number (car numlist)
137
numlist nil))
138
(setq numlist (cdr numlist)))
139
(wl-summary-jump-to-msg number)
140
(setq data (funcall (wl-summary-action-argument-function action)
141
(wl-summary-action-symbol action) number)))
142
(while (not (eobp))
143
(when (string= (wl-summary-temp-mark) "*")
144
(let (wl-summary-buffer-disp-msg)
145
(when (setq number (wl-summary-message-number))
146
(wl-summary-set-mark (wl-summary-action-mark action)
147
nil nil data)
148
(setq wl-summary-buffer-target-mark-list
149
(delq number wl-summary-buffer-target-mark-list)))))
150
(forward-line 1))
151
(setq mlist wl-summary-buffer-target-mark-list)
152
(while mlist
153
(wl-summary-register-temp-mark (car mlist)
154
(wl-summary-action-mark action) data)
155
(setq wl-summary-buffer-target-mark-list
156
(delq (car mlist) wl-summary-buffer-target-mark-list))
157
(setq mlist (cdr mlist)))))))
158
159
;; wl-summary-buffer-temp-mark-list specification
160
;; ((1 "D" nil)(2 "o" "+fuga")(3 "O" "+hoge"))
161
(defun wl-summary-register-temp-mark (number mark mark-info)
162
(let ((elem (assq number wl-summary-buffer-temp-mark-list)))
163
(setq wl-summary-buffer-temp-mark-list
164
(delq elem wl-summary-buffer-temp-mark-list)))
165
(setq wl-summary-buffer-temp-mark-list
166
(cons (list number mark mark-info) wl-summary-buffer-temp-mark-list)))
167
168
(defun wl-summary-unregister-temp-mark (number)
169
(let ((elem (assq number wl-summary-buffer-temp-mark-list)))
170
(setq wl-summary-buffer-temp-mark-list
171
(delq elem wl-summary-buffer-temp-mark-list))))
172
173
(defun wl-summary-registered-temp-mark (number)
174
(and wl-summary-buffer-temp-mark-list
175
(assq number wl-summary-buffer-temp-mark-list)))
176
177
(defun wl-summary-collect-temp-mark (mark &optional begin end)
178
(if (or begin end)
179
(save-excursion
180
(save-restriction
181
(let (mark-list)
182
(narrow-to-region (or begin (point-min))(or end (point-max)))
183
(goto-char (point-min))
184
;; for thread...
185
(if (eq wl-summary-buffer-view 'thread)
186
(let (number entity mark-info)
187
(while (not (eobp))
188
(setq number (wl-summary-message-number)
189
entity (wl-thread-get-entity number)
190
mark-info (wl-summary-registered-temp-mark number))
191
;; toplevel message mark.
192
(when (string= (nth 1 mark-info) mark)
193
(setq mark-list (cons mark-info mark-list)))
194
;; When thread is closed...children should also be checked.
195
(unless (wl-thread-entity-get-opened entity)
196
(dolist (msg (wl-thread-get-children-msgs number))
197
(setq mark-info (wl-summary-registered-temp-mark
198
msg))
199
(when (string= (nth 1 mark-info) mark)
200
(setq mark-list (cons mark-info mark-list)))))
201
(forward-line 1)))
202
(let (number mark-info)
203
(while (not (eobp))
204
(setq number (wl-summary-message-number)
205
mark-info (wl-summary-registered-temp-mark number))
206
(when (string= (nth 1 mark-info) mark)
207
(setq mark-list (cons mark-info mark-list)))
208
(forward-line 1))))
209
mark-list)))
210
(let (mark-list)
211
(dolist (mark-info wl-summary-buffer-temp-mark-list)
212
(when (string= (nth 1 mark-info) mark)
213
(setq mark-list (cons mark-info mark-list))))
214
mark-list)))
215
216
;; Unset mark
217
(defun wl-summary-unset-mark (&optional number interactive force)
218
"Unset temporary mark of the message with NUMBER.
219
NUMBER is the message number to unset the mark.
220
If not specified, the message on the cursor position is treated.
221
Optional INTERACTIVE is non-nil when it should be called interactively.
222
If optional FORCE is non-nil, remove scored mark too.
223
Return number if put mark succeed"
224
(interactive)
225
(save-excursion
226
(beginning-of-line)
227
(let ((buffer-read-only nil)
228
visible mark action)
229
(if number
230
;; Jump to message
231
(when (and (setq visible (wl-summary-message-visible-p number))
232
(not (eq number (wl-summary-message-number))))
233
(wl-summary-jump-to-msg number))
234
(setq visible t
235
number (wl-summary-message-number)))
236
(setq mark (wl-summary-temp-mark))
237
;; Remove from temporal mark structure.
238
(wl-summary-unregister-target-mark number)
239
(wl-summary-unregister-temp-mark number)
240
;; Delete mark on buffer.
241
(when visible
242
(unless (string= mark " ")
243
(wl-summary-put-temp-mark
244
(or (unless force (wl-summary-get-score-mark number))
245
" "))
246
(setq action (assoc mark wl-summary-mark-action-list))
247
(when wl-summary-highlight
248
(wl-highlight-summary-current-line))
249
(when (wl-summary-action-argument-function action)
250
(wl-summary-remove-argument)))
251
(set-buffer-modified-p nil))))
252
;; Move the cursor.
253
;; (if (or interactive (interactive-p))
254
;; (if (eq wl-summary-move-direction-downward nil)
255
;; (wl-summary-prev)
256
;; (wl-summary-next))))
257
)
258
259
(defun wl-summary-make-destination-numbers-list (mark-list)
260
(let (dest-numbers dest-number)
261
(dolist (elem mark-list)
262
(setq dest-number (assoc (nth 2 elem) dest-numbers))
263
(if dest-number
264
(unless (memq (car elem) (cdr dest-number))
265
(nconc dest-number (list (car elem))))
266
(setq dest-numbers (nconc dest-numbers
267
(list
268
(list (nth 2 elem)
269
(car elem)))))))
270
dest-numbers))
271
272
(defun wl-summary-move-mark-list-messages (mark-list folder-name message)
273
(if (null mark-list)
274
(message "No marks")
275
(save-excursion
276
(let ((start (point))
277
(refiles (mapcar 'car mark-list))
278
(refile-failures 0)
279
refile-len
280
dst-msgs ; loop counter
281
result)
282
;; begin refile...
283
(setq refile-len (length refiles))
284
(goto-char start) ; avoid moving cursor to
285
; the bottom line.
286
(message message)
287
(when (> refile-len elmo-display-progress-threshold)
288
(elmo-progress-set 'elmo-folder-move-messages
289
refile-len message))
290
(setq result nil)
291
(condition-case nil
292
(setq result (elmo-folder-move-messages
293
wl-summary-buffer-elmo-folder
294
refiles
295
(if (eq folder-name 'null)
296
'null
297
(wl-folder-get-elmo-folder folder-name))))
298
(error nil))
299
(when result ; succeeded.
300
;; update buffer.
301
(wl-summary-delete-messages-on-buffer refiles)
302
;; update wl-summary-buffer-temp-mark-list.
303
(dolist (mark-info mark-list)
304
(setq wl-summary-buffer-temp-mark-list
305
(delq mark-info wl-summary-buffer-temp-mark-list))))
306
(elmo-progress-clear 'elmo-folder-move-messages)
307
(message (concat message "done"))
308
(wl-summary-set-message-modified)
309
;; Return the operation failed message numbers.
310
(if result
311
0
312
(length refiles))))))
313
314
(defun wl-summary-get-refile-destination-subr (action number learn)
315
(let* ((number (or number (wl-summary-message-number)))
316
(msgid (and number
317
(elmo-message-field wl-summary-buffer-elmo-folder
318
number 'message-id)))
319
(entity (and number
320
(elmo-message-entity wl-summary-buffer-elmo-folder
321
number)))
322
folder cur-mark tmp-folder)
323
(catch 'done
324
(when (null entity)
325
(message "Cannot decide destination.")
326
(throw 'done nil))
327
(when (null number)
328
(message "No message.")
329
(throw 'done nil))
330
(setq folder (wl-summary-read-folder
331
(or (wl-refile-guess entity) wl-trash-folder)
332
(format "for %s " action)))
333
;; Cache folder hack by okada@opaopa.org
334
(when (and (eq (elmo-folder-type-internal
335
(wl-folder-get-elmo-folder
336
(wl-folder-get-realname folder))) 'cache)
337
(not (string= folder
338
(setq tmp-folder
339
(concat "'cache/"
340
(elmo-cache-get-path-subr
341
(elmo-msgid-to-cache msgid)))))))
342
(setq folder tmp-folder)
343
(message "Force refile to %s." folder))
344
(if (string= folder (wl-summary-buffer-folder-name))
345
(error "Same folder"))
346
(if (or (not (elmo-folder-writable-p (wl-folder-get-elmo-folder folder)))
347
(string= folder wl-queue-folder)
348
(string= folder wl-draft-folder))
349
(error "Don't set as target: %s" folder))
350
;; learn for refile.
351
(when learn
352
(wl-refile-learn entity folder))
353
folder)))
354
355
;;; Actions
356
(defun wl-summary-define-mark-action ()
357
(interactive)
358
(dolist (action wl-summary-mark-action-list)
359
(fset (intern (format "wl-summary-%s" (wl-summary-action-symbol action)))
360
`(lambda (&optional number data)
361
,(wl-summary-action-docstring action)
362
(interactive)
363
(wl-summary-set-mark ,(wl-summary-action-mark action)
364
number (interactive-p) data)))
365
(fset (intern (format "wl-summary-%s-region"
366
(wl-summary-action-symbol action)))
367
`(lambda (beg end)
368
,(wl-summary-action-docstring action)
369
(interactive "r")
370
(save-excursion
371
(goto-char beg)
372
(wl-summary-mark-region-subr
373
(quote ,(intern (format "wl-summary-%s"
374
(wl-summary-action-symbol action))))
375
beg end
376
(if (quote ,(wl-summary-action-argument-function action))
377
(funcall (function
378
,(wl-summary-action-argument-function action))
379
(quote ,(wl-summary-action-symbol action))
380
(wl-summary-message-number)))))))
381
(fset (intern (format "wl-summary-target-mark-%s"
382
(wl-summary-action-symbol action)))
383
`(lambda ()
384
,(wl-summary-action-docstring action)
385
(interactive)
386
(wl-summary-target-mark-set-action (quote ,action))))
387
(fset (intern (format "wl-thread-%s"
388
(wl-summary-action-symbol action)))
389
`(lambda (arg)
390
,(wl-summary-action-docstring action)
391
(interactive "P")
392
(wl-thread-call-region-func
393
(quote ,(intern (format "wl-summary-%s-region"
394
(wl-summary-action-symbol action))))
395
arg)
396
(if arg
397
(wl-summary-goto-top-of-current-thread))
398
(if (not wl-summary-move-direction-downward)
399
(wl-summary-prev)
400
(wl-thread-goto-bottom-of-sub-thread)
401
(if wl-summary-buffer-disp-msg
402
(wl-summary-redisplay)))))))
403
404
(defun wl-summary-get-dispose-folder (folder)
405
(if (string= folder wl-trash-folder)
406
'null
407
(let* ((type (or (wl-get-assoc-list-value wl-dispose-folder-alist folder)
408
'trash)))
409
(cond ((stringp type)
410
type)
411
((or (equal type 'remove) (equal type 'null))
412
'null)
413
(t;; (equal type 'trash)
414
(let ((trash-folder (wl-folder-get-elmo-folder wl-trash-folder)))
415
(unless (elmo-folder-exists-p trash-folder)
416
(if (y-or-n-p
417
(format "Trash Folder %s does not exist, create it? "
418
wl-trash-folder))
419
(elmo-folder-create trash-folder)
420
(error "Trash Folder is not created"))))
421
wl-trash-folder)))))
422
423
;; Dispose action.
424
(defun wl-summary-exec-action-dispose (mark-list)
425
(wl-summary-move-mark-list-messages mark-list
426
(wl-summary-get-dispose-folder
427
(wl-summary-buffer-folder-name))
428
"Disposing messages..."))
429
430
;; Delete action.
431
(defun wl-summary-exec-action-delete (mark-list)
432
(wl-summary-move-mark-list-messages mark-list
433
'null
434
"Deleting messages..."))
435
436
;; Refile action
437
(defun wl-summary-set-action-refile (number mark data)
438
(when (null data)
439
(error "Destination folder is empty"))
440
(wl-summary-register-temp-mark number mark data)
441
(setq wl-summary-buffer-prev-refile-destination data))
442
443
(defun wl-summary-get-refile-destination (action number)
444
"Decide refile destination."
445
(wl-summary-get-refile-destination-subr action number t))
446
447
(defun wl-summary-exec-action-refile (mark-list)
448
(save-excursion
449
(let ((start (point))
450
(failures 0)
451
(refile-len (length mark-list))
452
dst-msgs ; loop counter
453
result)
454
;; begin refile...
455
(setq dst-msgs
456
(wl-summary-make-destination-numbers-list mark-list))
457
(goto-char start) ; avoid moving cursor to the bottom line.
458
(when (> refile-len elmo-display-progress-threshold)
459
(elmo-progress-set 'elmo-folder-move-messages
460
refile-len "Refiling messages..."))
461
(while dst-msgs
462
(setq result nil)
463
(condition-case nil
464
(setq result (elmo-folder-move-messages
465
wl-summary-buffer-elmo-folder
466
(cdr (car dst-msgs))
467
(wl-folder-get-elmo-folder (car (car dst-msgs)))))
468
(error nil))
469
(if result ; succeeded.
470
(progn
471
;; update buffer.
472
(wl-summary-delete-messages-on-buffer (cdr (car dst-msgs)))
473
(setq wl-summary-buffer-temp-mark-list
474
(wl-delete-associations
475
(cdr (car dst-msgs))
476
wl-summary-buffer-temp-mark-list)))
477
(setq failures
478
(+ failures (length (cdr (car dst-msgs))))))
479
(setq dst-msgs (cdr dst-msgs)))
480
(elmo-progress-clear 'elmo-folder-move-messages)
481
(if (<= failures 0)
482
(message "Refiling messages...done"))
483
failures)))
484
485
;; Copy action
486
(defun wl-summary-get-copy-destination (action number)
487
(wl-summary-get-refile-destination-subr action number nil))
488
489
(defun wl-summary-exec-action-copy (mark-list)
490
(save-excursion
491
(let ((start (point))
492
(failures 0)
493
(refile-len (length mark-list))
494
dst-msgs ; loop counter
495
result)
496
;; begin refile...
497
(setq dst-msgs
498
(wl-summary-make-destination-numbers-list mark-list))
499
(goto-char start) ; avoid moving cursor to the bottom line.
500
(when (> refile-len elmo-display-progress-threshold)
501
(elmo-progress-set 'elmo-folder-move-messages
502
refile-len "Copying messages..."))
503
(while dst-msgs
504
(setq result nil)
505
(condition-case nil
506
(setq result (elmo-folder-move-messages
507
wl-summary-buffer-elmo-folder
508
(cdr (car dst-msgs))
509
(wl-folder-get-elmo-folder (car (car dst-msgs)))
510
'no-delete))
511
(error nil))
512
(if result ; succeeded.
513
(progn
514
;; update buffer.
515
(wl-summary-delete-copy-marks-on-buffer (cdr (car dst-msgs)))
516
(setq wl-summary-buffer-temp-mark-list
517
(wl-delete-associations
518
(cdr (car dst-msgs))
519
wl-summary-buffer-temp-mark-list)))
520
(setq failures
521
(+ failures (length (cdr (car dst-msgs))))))
522
(setq dst-msgs (cdr dst-msgs)))
523
(elmo-progress-clear 'elmo-folder-move-messages)
524
(if (<= failures 0)
525
(message "Copying messages...done"))
526
failures)))
527
528
;; Prefetch.
529
(defun wl-summary-exec-action-prefetch (mark-list)
530
(save-excursion
531
(let* ((count 0)
532
(length (length mark-list))
533
(mark-list-copy (copy-sequence mark-list))
534
(pos (point))
535
(failures 0))
536
(dolist (mark-info mark-list-copy)
537
(message "Prefetching...(%d/%d)"
538
(setq count (+ 1 count)) length)
539
(if (wl-summary-prefetch-msg (car mark-info))
540
(progn
541
(wl-summary-unset-mark (car mark-info))
542
(sit-for 0))
543
(incf failures)))
544
(message "Prefetching...done")
545
0)))
546
547
;; Resend.
548
(defun wl-summary-get-resend-address (action number)
549
"Decide resend address."
550
(wl-address-read-from-minibuffer "Resend message to: "))
551
552
(defun wl-summary-exec-action-resend (mark-list)
553
(let ((failure 0))
554
(dolist (mark-info mark-list)
555
(if (condition-case nil
556
(progn
557
(wl-summary-exec-action-resend-subr (car mark-info)
558
(nth 2 mark-info))
559
t)
560
(error))
561
(wl-summary-unmark (car mark-info))
562
(incf failure)))
563
failure))
564
565
(defun wl-summary-exec-action-resend-subr (number address)
566
"Resend the message with NUMBER to ADDRESS."
567
(message "Resending message to %s..." address)
568
(let ((folder wl-summary-buffer-elmo-folder))
569
(save-excursion
570
;; We first set up a normal mail buffer.
571
(set-buffer (get-buffer-create " *wl-draft-resend*"))
572
(set-buffer-multibyte nil)
573
(erase-buffer)
574
(setq wl-sent-message-via nil)
575
;; Insert our usual headers.
576
(wl-draft-insert-from-field)
577
(wl-draft-insert-date-field)
578
(insert "To: " address "\n")
579
(goto-char (point-min))
580
;; Rename them all to "Resent-*".
581
(while (re-search-forward "^[A-Za-z]" nil t)
582
(forward-char -1)
583
(insert "Resent-"))
584
(widen)
585
(forward-line)
586
(delete-region (point) (point-max))
587
(let ((beg (point)))
588
;; Insert the message to be resent.
589
(insert
590
;; elmo-message-fetch is erase current buffer before fetch message
591
(elmo-message-fetch-string folder number
592
(if wl-summary-resend-use-cache
593
(elmo-make-fetch-strategy
594
'entire 'maybe nil
595
(elmo-file-cache-get-path
596
(elmo-message-field
597
folder number 'message-id)))
598
(elmo-make-fetch-strategy 'entire))
599
'unread))
600
(goto-char (point-min))
601
(search-forward "\n\n")
602
(forward-char -1)
603
(save-restriction
604
(narrow-to-region beg (point))
605
(wl-draft-delete-fields wl-ignored-resent-headers)
606
(goto-char (point-max)))
607
(insert mail-header-separator)
608
;; Rename all old ("Previous-")Resent headers.
609
(while (re-search-backward "^\\(Previous-\\)*Resent-" beg t)
610
(beginning-of-line)
611
(insert "Previous-"))
612
;; Quote any "From " lines at the beginning.
613
(goto-char beg)
614
(when (looking-at "From ")
615
(replace-match "X-From-Line: ")))
616
(run-hooks 'wl-summary-resend-hook)
617
;; Send it.
618
(wl-draft-dispatch-message)
619
(kill-buffer (current-buffer)))
620
(message "Resending message to %s...done" address)))
621
622
;;;
623
(defun wl-summary-remove-argument ()
624
(save-excursion
625
(let ((inhibit-read-only t)
626
(buffer-read-only nil)
627
(buf (current-buffer))
628
sol eol rs re)
629
(beginning-of-line)
630
(setq sol (point))
631
(search-forward "\r")
632
(forward-char -1)
633
(setq eol (point))
634
(setq rs (next-single-property-change sol 'wl-summary-action-argument
635
buf eol))
636
(setq re (next-single-property-change rs 'wl-summary-action-argument
637
buf eol))
638
(put-text-property rs re 'wl-summary-action-argument nil)
639
(put-text-property rs re 'invisible nil)
640
(goto-char re)
641
(delete-char (- eol re)))))
642
643
(defun wl-summary-collect-numbers-region (begin end)
644
"Return a list of message number in the region specified by BEGIN and END."
645
(save-excursion
646
(save-restriction
647
(let (numbers)
648
(wl-summary-narrow-to-region (or begin (point-min))(or end (point-max)))
649
(goto-char (point-min))
650
;; for thread...
651
(if (eq wl-summary-buffer-view 'thread)
652
(let (number entity)
653
(while (not (eobp))
654
(setq numbers (cons (wl-summary-message-number) numbers)
655
entity (wl-thread-get-entity number))
656
;; When thread is closed...children should also be checked.
657
(unless (wl-thread-entity-get-opened entity)
658
(dolist (msg (wl-thread-get-children-msgs number))
659
(setq numbers (cons msg numbers))))
660
(forward-line 1)))
661
(let (number)
662
(while (not (eobp))
663
(setq numbers (cons (wl-summary-message-number) numbers))
664
(forward-line 1))))
665
(nreverse (delq nil numbers))))))
666
667
(defun wl-summary-exec (&optional numbers)
668
(interactive)
669
(let ((failures 0)
670
collected pair action modified)
671
(dolist (action wl-summary-mark-action-list)
672
(setq collected (cons (cons
673
(wl-summary-action-mark action)
674
nil) collected)))
675
(dolist (mark-info wl-summary-buffer-temp-mark-list)
676
(setq pair
677
(when (or (null numbers)
678
(memq (nth 0 mark-info) numbers))
679
(assoc (nth 1 mark-info) collected)))
680
(if pair
681
(setcdr pair (cons mark-info (cdr pair)))))
682
;; collected is a pair of
683
;; mark-string and a list of mark-info
684
(dolist (pair collected)
685
(setq action (assoc (car pair) wl-summary-mark-action-list))
686
(when (and (cdr pair) (wl-summary-action-exec-function action))
687
(setq modified t)
688
(setq failures (+ failures (funcall
689
(wl-summary-action-exec-function action)
690
(cdr pair))))))
691
(when modified
692
(wl-summary-set-message-modified))
693
(run-hooks 'wl-summary-exec-hook)
694
;; message buffer is not up-to-date
695
(unless (and wl-message-buffer
696
(eq (wl-summary-message-number)
697
(with-current-buffer wl-message-buffer
698
wl-message-buffer-cur-number)))
699
(wl-summary-toggle-disp-msg 'off)
700
(setq wl-message-buffer nil))
701
(set-buffer-modified-p nil)
702
(when (> failures 0)
703
(message "%d execution(s) were failed" failures))))
704
705
(defun wl-summary-exec-region (beg end)
706
(interactive "r")
707
(wl-summary-exec
708
(wl-summary-collect-numbers-region beg end)))
709
710
(defun wl-summary-read-folder (default &optional purpose ignore-error
711
no-create init)
712
(let ((fld (completing-read
713
(format "Folder name %s(%s): " (or purpose "")
714
default)
715
'wl-folder-complete-folder
716
nil nil (or init wl-default-spec)
717
'wl-read-folder-history)))
718
(if (or (string= fld wl-default-spec)
719
(string= fld ""))
720
(setq fld default))
721
(setq fld (elmo-string (wl-folder-get-realname fld)))
722
(if (string-match "\n" fld)
723
(error "Not supported folder name: %s" fld))
724
(unless no-create
725
(if ignore-error
726
(condition-case nil
727
(wl-folder-confirm-existence
728
(wl-folder-get-elmo-folder
729
fld))
730
(error))
731
(wl-folder-confirm-existence (wl-folder-get-elmo-folder
732
fld))))
733
fld))
734
735
(defun wl-summary-print-argument (msg-num folder)
736
"Print action argument on line."
737
(when folder
738
(wl-summary-remove-argument)
739
(save-excursion
740
(let ((inhibit-read-only t)
741
(folder (copy-sequence folder))
742
(buffer-read-only nil)
743
len rs re c)
744
(setq len (string-width folder))
745
(if (< len 1) ()
746
;;(end-of-line)
747
(beginning-of-line)
748
(search-forward "\r")
749
(forward-char -1)
750
(setq re (point))
751
(let ((width (cond (wl-summary-width
752
(1- wl-summary-width))
753
(wl-summary-print-argument-within-window
754
(1- (window-width)))))
755
(c (current-column))
756
(padding 0))
757
(if (and width (> (+ c len) width))
758
(progn
759
(move-to-column width)
760
(setq c (current-column))
761
(while (> (+ c len) width)
762
(forward-char -1)
763
(setq c (current-column)))
764
(when (< (+ c len) width)
765
(setq folder (concat " " folder)))
766
(setq rs (point))
767
(put-text-property rs re 'invisible t))
768
(when (and width
769
(> (setq padding (- width len c)) 0))
770
(setq folder (concat (make-string padding ?\ )
771
folder)))
772
(setq rs (1- re))))
773
(put-text-property rs re 'wl-summary-action-argument t)
774
(goto-char re)
775
(wl-highlight-action-argument-string folder)
776
(insert folder)
777
(set-buffer-modified-p nil))))))
778
779
(defsubst wl-summary-reserve-temp-mark-p (mark)
780
"Return t if temporal MARK should be reserved."
781
(member mark wl-summary-reserve-mark-list))
782
783
;; Refile prev destination
784
(defun wl-summary-refile-prev-destination ()
785
"Refile message to previously refiled destination."
786
(interactive)
787
(funcall (symbol-function 'wl-summary-refile)
788
(wl-summary-message-number)
789
wl-summary-buffer-prev-refile-destination)
790
(if (and (interactive-p)
791
(eq wl-summary-move-direction-downward nil))
792
(wl-summary-prev)
793
(wl-summary-next)))
794
795
(defun wl-summary-refile-prev-destination-region (beg end)
796
"Refile messages in the region to previously refiled destination."
797
(interactive "r")
798
(wl-summary-mark-region-subr 'wl-summary-refile
799
beg end
800
wl-summary-buffer-prev-refile-destination))
801
802
(defun wl-thread-refile-prev-destination (arg)
803
"Refile messages in the thread to previously refiled destination."
804
(interactive "P")
805
(wl-thread-call-region-func
806
'wl-summary-refile-prev-destination-region
807
arg))
808
809
(defun wl-summary-target-mark-refile-prev-destination ()
810
"Refile messages with target mark to previously refiled destination."
811
(interactive)
812
(let ((elem wl-summary-mark-action-list)
813
action)
814
(while elem
815
(when (eq (wl-summary-action-symbol (car elem)) 'refile)
816
(setq action (car elem))
817
(setq elem nil))
818
(setq elem (cdr elem)))
819
(wl-summary-target-mark-set-action
820
(list
821
(car action)
822
'refile-prev-destination
823
(lambda (&rest args) wl-summary-buffer-prev-refile-destination)
824
(nth 2 action)
825
(nth 3 action)
826
(nth 4 action)
827
(nth 6 action)))))
828
829
(defsubst wl-summary-no-auto-refile-message-p (number)
830
(member (wl-summary-message-mark wl-summary-buffer-elmo-folder number)
831
wl-summary-auto-refile-skip-marks))
832
833
(defvar wl-auto-refile-guess-functions
834
'(wl-refile-guess-by-rule)
835
"*List of functions which is used for guessing refile destination folder.")
836
837
(defun wl-summary-auto-refile (&optional open-all)
838
"Set refile mark automatically according to 'wl-refile-guess-by-rule'."
839
(interactive "P")
840
(message "Marking...")
841
(save-excursion
842
(if (and (eq wl-summary-buffer-view 'thread)
843
open-all)
844
(wl-thread-open-all))
845
(let* ((spec (wl-summary-buffer-folder-name))
846
checked-dsts
847
(count 0)
848
number dst thr-entity)
849
(goto-line 1)
850
(while (not (eobp))
851
(setq number (wl-summary-message-number))
852
(dolist (number (cons number
853
(and (eq wl-summary-buffer-view 'thread)
854
;; process invisible children.
855
(not (wl-thread-entity-get-opened
856
(setq thr-entity
857
(wl-thread-get-entity number))))
858
(wl-thread-entity-get-descendant
859
thr-entity))))
860
(when (and (not (wl-summary-no-auto-refile-message-p
861
number))
862
(setq dst
863
(wl-folder-get-realname
864
(wl-refile-guess
865
(elmo-message-entity wl-summary-buffer-elmo-folder
866
number)
867
wl-auto-refile-guess-functions)))
868
(not (equal dst spec))
869
(let ((pair (assoc dst checked-dsts))
870
ret)
871
(if pair
872
(cdr pair)
873
(setq ret
874
(condition-case nil
875
(progn
876
(wl-folder-confirm-existence
877
(wl-folder-get-elmo-folder dst))
878
t)
879
(error)))
880
(setq checked-dsts (cons (cons dst ret) checked-dsts))
881
ret)))
882
(if (funcall (symbol-function 'wl-summary-refile) number dst)
883
(incf count))
884
(message "Marking...%d message(s)." count)))
885
(forward-line))
886
(if (eq count 0)
887
(message "No message was marked.")
888
(message "Marked %d message(s)." count)))))
889
890
(defun wl-summary-unmark (&optional number)
891
"Unmark marks (temporary, refile, copy, delete)of current line.
892
If optional argument NUMBER is specified, unmark message specified by NUMBER."
893
(interactive)
894
(wl-summary-unset-mark number (interactive-p)))
895
896
(defun wl-summary-unmark-region (beg end)
897
(interactive "r")
898
(save-excursion
899
(save-restriction
900
(wl-summary-narrow-to-region beg end)
901
(goto-char (point-min))
902
(if (eq wl-summary-buffer-view 'thread)
903
(progn
904
(while (not (eobp))
905
(let* ((number (wl-summary-message-number))
906
(entity (wl-thread-get-entity number)))
907
(if (wl-thread-entity-get-opened entity)
908
;; opened...unmark line.
909
(wl-summary-unmark)
910
;; closed
911
(wl-summary-delete-marks-on-buffer
912
(wl-thread-get-children-msgs number))))
913
(forward-line 1)))
914
(while (not (eobp))
915
(wl-summary-unmark)
916
(forward-line 1))))))
917
918
(defun wl-summary-mark-region-subr (function beg end data)
919
(save-excursion
920
(save-restriction
921
(wl-summary-narrow-to-region beg end)
922
(goto-char (point-min))
923
(if (eq wl-summary-buffer-view 'thread)
924
(progn
925
(while (not (eobp))
926
(let* ((number (wl-summary-message-number))
927
(entity (wl-thread-get-entity number))
928
(wl-summary-move-direction-downward t)
929
children)
930
(if (wl-thread-entity-get-opened entity)
931
;; opened...delete line.
932
(funcall function nil data)
933
;; closed
934
(setq children (wl-thread-get-children-msgs number))
935
(while children
936
(funcall function (pop children) data)))
937
(forward-line 1))))
938
(while (not (eobp))
939
(funcall function nil data)
940
(forward-line 1))))))
941
942
(defun wl-summary-target-mark-all ()
943
(interactive)
944
(wl-summary-target-mark-region (point-min) (point-max)))
945
946
(defun wl-summary-delete-all-mark (mark)
947
(goto-char (point-min))
948
(while (not (eobp))
949
(when (string= (wl-summary-temp-mark) mark)
950
(wl-summary-unmark))
951
(forward-line 1))
952
(if (string= mark "*")
953
(setq wl-summary-buffer-target-mark-list nil)
954
(let (deleted)
955
(dolist (mark-info wl-summary-buffer-temp-mark-list)
956
(when (string= (nth 1 mark-info) mark)
957
(setq deleted (cons mark-info deleted))))
958
(dolist (delete deleted)
959
(setq wl-summary-buffer-temp-mark-list
960
(delq delete wl-summary-buffer-temp-mark-list))))))
961
962
(defun wl-summary-unmark-all ()
963
"Unmark all according to what you input."
964
(interactive)
965
(let ((unmarks (string-to-char-list (read-from-minibuffer "Unmark: ")))
966
cur-mark)
967
(save-excursion
968
(while unmarks
969
(setq cur-mark (char-to-string (car unmarks)))
970
(wl-summary-delete-all-mark cur-mark)
971
(setq unmarks (cdr unmarks))))))
972
973
(defun wl-summary-target-mark-thread ()
974
(interactive)
975
(wl-thread-call-region-func 'wl-summary-target-mark-region t))
976
977
(require 'product)
978
(product-provide (provide 'wl-action) (require 'wl-version))
979
980
;;; wl-action.el ends here
Loggerhead is a web-based interface for Breezy
Version: 2.0.1