Source

mew / mew / mew-refile.el

  1
  2
  3
  4
  5
  6
  7
  8
  9
 10
 11
 12
 13
 14
 15
 16
 17
 18
 19
 20
 21
 22
 23
 24
 25
 26
 27
 28
 29
 30
 31
 32
 33
 34
 35
 36
 37
 38
 39
 40
 41
 42
 43
 44
 45
 46
 47
 48
 49
 50
 51
 52
 53
 54
 55
 56
 57
 58
 59
 60
 61
 62
 63
 64
 65
 66
 67
 68
 69
 70
 71
 72
 73
 74
 75
 76
 77
 78
 79
 80
 81
 82
 83
 84
 85
 86
 87
 88
 89
 90
 91
 92
 93
 94
 95
 96
 97
 98
 99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
;;; mew-refile.el --- Refile for Mew

;; Author:  Yoshinari NOMURA <nom@csce.kyushu-u.ac.jp>
;;          Kazu Yamamoto <Kazu@Mew.org>
;; Created: Jun 11, 1994
;; Revised: Aug 30, 1999

;;; Code:

(defconst mew-refile-version "mew-refile.el version 0.76")

(require 'mew)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; Variables
;;;

(defvar mew-refile-msgid-alist nil
  "Alist of message-id and folder pair")
(defvar mew-refile-msgid-file-name ".mew-refile-msgid-alist")
(defvar mew-refile-from-alist nil
  "Alist of From: address and folder pair")
(defvar mew-refile-from-file-name ".mew-refile-from-alist")

(defvar mew-refile-last-folder nil
  "Folder name previously you refiled")

(defvar mew-refile-ctrl-multi t
  "*If *non-nil*, guess functions guess multi folders.")

(defvar mew-refile-guess-alist nil
  "*If non-nil, mew guesses destination folder by using this hint.
The format is like this:

    (setq mew-refile-guess-alist
          '((\"To:\" 
              (\"wide@wide\" . \"+wide/wide\")
              (\"adam\"      . \"+labo/adam\"))
            (\"Newsgroups:\"
              (\"^nifty\\\\.\\\\([^ ]+\\\\)\" . \"+Nifty/\\\\1\"))
            (\"From:\" 
              (\"uucp\" . \"+adm/uucp\")
              (\".*\"   . \"+misc\"))
            ))
")

(defvar mew-refile-guess-key-list mew-destination:-list
  "*A list of field key used by mew-refile-guess-by-folder.")

(defvar mew-refile-guess-control
  '(mew-refile-guess-by-alist
    mew-refile-ctrl-throw
    mew-refile-guess-by-newsgroups
    mew-refile-guess-by-folder
    mew-refile-ctrl-throw
    mew-refile-ctrl-auto-boundary
    mew-refile-guess-by-thread
    mew-refile-ctrl-throw
    mew-refile-guess-by-from-folder
    mew-refile-ctrl-throw
    mew-refile-guess-by-from
    mew-refile-ctrl-throw
    mew-refile-guess-by-default))

(defvar mew-refile-auto-refile-skip-any-mark nil
  "*If *non-nil*, 'mew-summary-auto-refile' doesn't touch
any alredy marked message.")

(defvar mew-refile-auto-refile-confirm nil
  "*If *non-nil*, 'mew-summary-auto-refile' prompts the user for
confirmation before refiling.")

(defvar mew-refile-guess-strip-domainpart t
  "*If *non-nil*, 'mew-refile-guess-by-default' strips domainpart of from")

(defvar mew-refile-guess-from-me-is-special nil
  "*If *non-nil*, 'mew-refile-guess-by-from-*' think the mails from yourself
as special. They use To: or Cc: instead of From:")

;;
;; initialize function
;;
(defun mew-refile-init ()
  ;; load message id alist
  (or mew-refile-msgid-alist
      (setq mew-refile-msgid-alist (mew-lisp-load mew-refile-msgid-file-name)))
  ;; load from alist
  (or mew-refile-from-alist
      (setq mew-refile-from-alist (mew-lisp-load mew-refile-from-file-name))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; Guess functions 
;;;

;; We have two types of functions in mew-refile-guess-control,
;; guess function and ctrl function.
;; guess function must return a folder list or folder string or nil.
;; guess function must not have a string "ctrl" in its symbol name.
;; ctrl function must have a string "ctrl" in its symbol name.

;; dispatcher returns: ((guess1 guess2 ..) info1 info2 ...) multi  guess mode
;;                     ((guess1)           info1 info2 ...) single guess mode
;;            info1:   ('guess-func-name guess1 guess2 ...)
;;
;; that is, 'car' is a list of judged  folders.
;;          'cdr' is a alist of opinions by guess functions.
;;
(defun mew-refile-guess (&optional auto show-all)
  (let ((funcs mew-refile-guess-control) ret guess info stop)
    (catch 'last
      (while funcs
	(cond
	 ;; func is control function
	 ((string-match "ctrl" (symbol-name (car funcs)))
	  (if (setq ret (funcall (car funcs) guess auto))
	      (progn
		(setq stop t)
		(or show-all (throw 'last t)))))
	 ;; func is guess function
	 (t
	  (setq ret (funcall (car funcs)))))
	;; now, ret is the return value from a function.
	;; make sure ret is a list.
	(setq ret (or (and (listp ret) ret) (and ret (list ret))))
	;; shape the guess: (guess1 guess2 ...)
	;;            info: (info1 info2 ...)
	(setq info (nconc info (list (cons (car funcs) ret))))
	(if (not stop) (setq guess (nconc (reverse ret) guess)))
	(setq funcs (cdr funcs))))
    (setq guess (nreverse guess))
    (if mew-refile-ctrl-multi
	(cons (mew-uniq-list guess) info)
      (cons (list (car guess)) info))))


;;
;; guess control functions
;;
(defun mew-refile-ctrl-auto-boundary (guess auto)
  (if auto 'stop))

(defun mew-refile-ctrl-throw (guess auto)
  (if guess 'stop))

;;
;; by alist returns: (guess1 guess2 ...) or nil
;;
(defun mew-refile-guess-by-alist ()
  (mew-refile-guess-by-alist1 mew-refile-guess-alist))

(defun mew-refile-guess-by-alist1 (alist)
  (let (name header sublist key val ent ret)
    (while alist
      (setq name (car (car alist)))
      (setq sublist (cdr (car alist)))
      (cond
       ((eq name t)
	(setq ret (cons sublist ret)))
       ((eq name nil)
	(or ret (setq ret (cons sublist ret))))
       (t
	(setq header (mew-header-get-value name))
	(if header
	    (while sublist
	      (setq key (car (car sublist)))
	      (setq val (cdr (car sublist)))
	      (if (and (stringp key) (string-match key header))
		  (cond
		   ((stringp val)
		    (setq ent (mew-refile-guess-by-alist2 key header val)))
		   ((listp val)
		    (setq ent (mew-refile-guess-by-alist1 val)))))
	      (if ent
		  (if (listp ent)
		      (setq ret (nconc ent ret) ent nil)
		    (setq ret (cons ent ret))))
	      (setq sublist (cdr sublist))))))
      (setq alist (cdr alist)))
    (mew-uniq-list (nreverse ret))))

(defun mew-refile-guess-by-alist2 (regexp field string)
  (let (match-strings match-list)
    (string-match regexp field)
    (setq match-list (cdr (cdr (match-data))))
    (while (car match-list)
      (setq match-strings
	    (cons (substring field
			     (car match-list) (car (cdr match-list)))
		  match-strings))
      (setq match-list (cdr (cdr match-list))))
    (while (string-match "\\\\\\([1-9]\\)" string)
	(setq string
	      (concat (substring string 0 (match-beginning 0))
		      (nth (- (length match-strings)
			      (string-to-int 
			       (substring string
					  (match-beginning 1)
					  (match-end 1))))
			   match-strings)
		      (substring string (match-end 0)))))
    string))

;;
;; by newsgroups returns (guess1 guess2 ...) or nil
;;
(defun mew-refile-guess-by-newsgroups ()
  (let ((newsgroups (mew-addrstr-parse-value-list2 
		     (mew-header-get-value mew-newsgroups:)))
	ent ret)
    (if (not newsgroups)
	()
      (while newsgroups
	(setq ent (mew-assoc-case-equal (car newsgroups) mew-folder-alist 1))
	(if ent (setq ret (cons (nth 0 ent) ret)))
	(setq newsgroups (cdr newsgroups)))
      (mew-uniq-list (nreverse ret)))))

;;
;; by folder returns: (guess1 guess2 ...) or nil
;;
(defun mew-refile-guess-by-folder ()
  (let ((to-cc (mew-header-parse-address-list mew-refile-guess-key-list))
	ent ret ml-name)
    (while to-cc
      (setq ml-name (mew-addrstr-extract-user (or (car to-cc) "")))
      (setq ent (mew-assoc-case-equal ml-name mew-folder-alist 1))
      (if ent (setq ret (cons (nth 0 ent) ret)))
      (setq to-cc (cdr to-cc)))
    (mew-uniq-list (nreverse ret))))

;;
;; by message-thread returns: guess1 or nil
;;
(defun mew-refile-guess-by-thread ()
  (let ((msgid (or (mew-header-get-value mew-references:)
		   (mew-header-get-value mew-in-reply-to:))))
    ;; search for msgid
    (if (and msgid 
	     (string-match "\\(<[^ \t\n]*>\\)[^>]*\0" (concat msgid "\0")))
	(nth 1 (assoc (substring msgid 
				 (match-beginning 1)
				 (match-end 1))
		      mew-refile-msgid-alist)))))

;;
;; by from-{folder,alist} returns: guess1 or (guess1 ...) or nil
;;
(defun mew-refile-guess-by-from-folder (&optional addr)
  (mew-refile-guess-from-dispatch 'mew-refile-guess-by-from-folder-body addr))

(defun mew-refile-guess-by-from (&optional addr)
  (mew-refile-guess-from-dispatch 'mew-refile-guess-by-from-body addr))

(defun mew-refile-guess-by-from-folder-body (&optional addr)
  (let* ((pfix (cond ((equal mew-folders-default-folder "" ) "+")
		     ((equal mew-folders-default-folder nil) "+")
		     ((equal mew-folders-default-folder "+") "+")
		     (t (file-name-as-directory mew-folders-default-folder))))
	 (from (downcase (or addr (mew-header-parse-address mew-from:) "")))
	 (user (mew-addrstr-extract-user from))
	 (pfix-regex (concat "^" (regexp-quote pfix) "\\(.*/\\)?"))
	 (from-regex (concat pfix-regex (regexp-quote from) "/?$"))
	 (user-regex (concat pfix-regex (regexp-quote user) "/?$")))
    (or
     (mew-refile-match-in-list from-regex mew-folder-list)
     (mew-refile-match-in-list user-regex mew-folder-list))))

(defun mew-refile-guess-by-from-body (&optional addr)
  (let ((from   (downcase (or addr (mew-header-parse-address mew-from:) ""))))
    (cdr (assoc from mew-refile-from-alist))))

;;
;; dispatcher to make mew-refile-guess-by-from-* consider
;; mew-refile-guess-from-me-is-special.
;;
(defun mew-refile-guess-from-dispatch (func &optional addr)
  (let ((addr (downcase (or addr (mew-header-parse-address mew-from:) ""))))
    ;; if From: is my address, addr is the list extracted from To:, Cc:
    (if (and mew-refile-guess-from-me-is-special
	     (mew-is-my-address (mew-get-my-address-regex-list) addr))
	(let ((addr (mew-header-parse-address-list mew-refile-guess-key-list))
	      (a nil) (r nil))
	  (while addr
	    (if (setq a (funcall func (car addr)))
		(setq r (cons a r)))
	    (setq addr (cdr addr)))
	  (mew-uniq-list (nreverse r)))
      (funcall func addr))))

;;
;; by default returns: guess1
;;
(defun mew-refile-guess-by-default (&optional addr)
  (mew-refile-guess-from-dispatch 'mew-refile-guess-by-default-body addr))

(defun mew-refile-guess-by-default-body (&optional addr)
  (let* ((pfix (cond ((equal mew-folders-default-folder "" ) "+")
		     ((equal mew-folders-default-folder nil) "+")
		     ((equal mew-folders-default-folder "+") "+")
		     (t (file-name-as-directory mew-folders-default-folder))))
	 (from (downcase (or addr (mew-header-parse-address mew-from:) "")))
	 (user (mew-addrstr-extract-user from)))
    (if mew-refile-guess-strip-domainpart
	(concat pfix user)
      (concat pfix from))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; Learning functions
;;;

;; dispatcher
;;
;; mew-refile-guess-learn (buf result)
;;
;; buf is message buffer.
;;
;; result is ((chosen1 chosen2 ...)
;;           (guess-func-name1 guess1 guess2...)
;;           (guess-func-name2 guess1 guess2...))
;;
;; that is, 'car' is a list of user chosen folders.
;;          'cdr' is a list of opinions by guess functions.
;;
(defun mew-refile-guess-learn (buf result)
  (let ((chosen (car result))  ;; (folder1 folder2 ...)
	(info   (cdr result))) ;; (guess-func-name guess1 guess2...)
    (save-excursion
      (set-buffer buf)
      (if (member 'mew-refile-guess-by-from mew-refile-guess-control)
	  (mew-refile-guess-by-from-learn chosen info))
      (if (member 'mew-refile-guess-by-thread mew-refile-guess-control)
	  (mew-refile-guess-by-thread-learn chosen info)))))
;;
;; learn from msgid
;;
(defun mew-refile-guess-by-thread-learn (chosen info)
  (let* ((msgid  (mew-header-get-value mew-message-id:)) 
	 (folder (car chosen))
	 ;; ohter people's honest opinion and my honest opinion.
	 (oho    info)
	 (mho    (cdr (assoc 'mew-refile-guess-by-thread info))))
    (if (and msgid (string-match "<[^ \n>]*>" msgid))
	(setq msgid (substring msgid (match-beginning 0) (match-end 0))))
    (if (or (not msgid) (not chosen))
	()
      ;; if my opninion was right, I learn it.
      ;; or a folder was not in other people's opinion,
      ;; I accept it.
      (catch 'match
	(while chosen
	  (if (or (member (car chosen) mho)
		  (not (catch 'find
		    (while oho
		      (and (member (car chosen) (car oho)) (throw 'find t))
		      (setq oho (cdr oho))))))
	      (throw 'match (setq folder (car chosen))))
	  (setq chosen (cdr chosen))))
      (setq mew-refile-msgid-alist
	    (cons (list msgid folder "??")
		  (delete (assoc msgid mew-refile-msgid-alist)
			  mew-refile-msgid-alist))))))
;;
;; learn from "From:" field
;;
(defun mew-refile-guess-by-from-learn (chosen info)
  (let* ((from  (downcase (or (mew-header-parse-address mew-from:) "")))
	 (folder nil)
	 ;; 'my honest opinion' guessed by mew-refile-guess-by-from.
	 (mho    (nth 1 (assoc 'mew-refile-guess-by-from       info))))

    (if (or (or (null from) (null chosen)) ;; if from and/or chosen is empty
	    (and mho (member mho chosen))) ;; or my opinion was right,
	()                                 ;; do nothing.

      ;; I decide which folder is most important among the user chosen
      ;; folders. 
      (catch 'match
	(while chosen
	  ;; searching a folder anyone couldn't predict.
	  (if (not (mew-refile-guess-member-p (car chosen) info))
	      (throw 'match (setq folder (car chosen))))
	  (setq chosen (cdr chosen))))

      ;; If candidate was found, I memorize it.
      (if folder
	  (setq mew-refile-from-alist
		(cons (cons from folder)
		      (delete (assoc from mew-refile-from-alist)
			      mew-refile-from-alist)))))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; Backyard functions.
;;;

(defun mew-refile-guess-save ()
  (if (and mew-refile-from-alist
	   (member 'mew-refile-guess-by-from mew-refile-guess-control))
      (mew-lisp-save mew-refile-from-file-name mew-refile-from-alist))
  (if (and mew-refile-msgid-alist
	   (member 'mew-refile-guess-by-thread mew-refile-guess-control))
      (mew-lisp-save mew-refile-msgid-file-name mew-refile-msgid-alist)))

(defun mew-refile-guess-subfolder-p (parent child)
  (string-match 
   (concat  "^" (regexp-quote (file-name-as-directory parent)))
   child))

;;
;; search x in a nested list.
;;
(defun mew-refile-guess-member-p (x lst)
  (catch 'found
    (while lst
      (cond 
       ((listp (car lst))
	(if (mew-refile-guess-member-p x (car lst))
	    (throw 'found t)))
       (t
	(if (equal  x (car lst))
	    (throw 'found t))))
      (setq lst (cdr lst)))))

;;
;; grep with regex in a list of string. (first match)
;;
(defun mew-refile-match-in-list (regex lst)
  (let ((case-fold-search t))
    (catch 'found 
      (while lst
	(if (string-match regex (car lst))
	    (throw 'found (car lst)))
	(setq lst (cdr lst))))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; Summary mode
;;;
(defun mew-refile-set (msg folder)
  (let* ((msg-folders (assoc msg mew-summary-buffer-refile))
	 (folders (cdr msg-folders)))
    (if folders
	(if (not (mew-folder-member folder folders))
	    (setq mew-summary-buffer-refile 
		  (cons (nreverse (cons folder (nreverse (cons msg folders))))
			(delete msg-folders mew-summary-buffer-refile))))
      (setq mew-summary-buffer-refile 
	    (cons (list msg folder) mew-summary-buffer-refile)))))

(defun mew-refile-reset (msg)
  (setq mew-summary-buffer-refile
	(delete (assoc msg mew-summary-buffer-refile)
		mew-summary-buffer-refile)))

;; mew-refile-decide-folders returns: ((input1 input2...) 
;;                                     (guess-func-name1 guess1 guess2...)
;;                                     (guess-func-name2 guess1 guess2...))
;; that is, 'car' is a list of user chosen folders.
;;          'cdr' is a alist of opinions by guess functions.
;; cdr is needed for learning functions.
;;
(defun mew-refile-decide-folders (buf msg mark &optional auto)
  (let (learn-info folders ret)
    (save-excursion
      (set-buffer buf)
      (setq learn-info (mew-refile-guess auto)))
    (setq 
     folders
     (cond
      ;; if auto is set, simply use the guess.
      (auto (car learn-info))
      ;; add new folder 
      ((equal mew-mark-refile mark)
       (mew-input-folders 
	nil (mew-join "," 
		      (cdr (assoc msg mew-summary-buffer-refile)))))
      ;; multi guess
      ((nth 1 (car learn-info))
       (mew-input-folders nil (mew-join "," (car learn-info))))
      ;; single guess
      (t 
       (mew-input-folders (nth 0 (car learn-info))))))
    ;; check folder existence.
    (while folders
      (if (mew-folder-check (car folders))
	  (setq ret (cons (car folders) ret)))
      (setq folders (cdr folders)))
    (cons (nreverse ret) (cdr learn-info)))) ;; return value

(defvar mew-header-reasonable-size 5000)

(defun mew-summary-refile (&optional report)
 "Put the refile mark(default is 'o') on this message. If already
marked with 'o', it prints where this message will be refiled. This
can overlay other marks. When it overlays, the cursor stays on the
message. If it marks newly, displays the next message. If executed
with '\\[universal-argument]', it displays how the refile rules work in Message mode."
 (interactive "P")
 (if report (mew-summary-refile-report) (mew-summary-refile-body)))

(defun mew-summary-refile-body (&optional exp-flds auto)
  (mew-summary-only
   (mew-summary-msg-or-part
    (let (msg folders mark buf learn-info fld)
      (save-excursion
	;; save the cursor position anyway
	(mew-summary-goto-message)
	;; on the message
	(setq fld (mew-summary-folder-name))
	(setq msg (mew-summary-message-number)) ;; msg is never nil
	(setq mark (mew-summary-get-mark))) ;; any mark
      (if exp-flds
	  (setq folders exp-flds)
	;; show message if not displayed
	(if (or auto (null mew-summary-buffer-disp-msg))
	    (save-excursion
	      (mew-set-buffer-tmp)
	      (setq buf (current-buffer))
	      (mew-insert-message fld msg mew-cs-autoconv
				  mew-header-reasonable-size)
	      (goto-char (point-min))
	      (if (and (re-search-forward (concat "^$\\|^" mew-subj:) nil t)
		       (not (looking-at "^$")))
		  (let ((med (point)))
		    (forward-line)
		    (mew-header-goto-next)
		    (mew-header-decode-region 'text med (point)))))
	  (mew-summary-display nil) ;; cursor position is important
	  (setq buf (or (mew-cache-hit (cons (buffer-name) msg))
			(mew-buffer-message)))) ;; for ","
	(setq learn-info (mew-refile-decide-folders buf msg mark auto))
	(setq folders (car learn-info)))
      ;; mark refile
      (if folders
	  (save-excursion
	    (mew-summary-goto-message)
	    (or exp-flds auto (mew-refile-guess-learn buf learn-info))
	    (mew-refile-reset msg)
	    (mapcar (function (lambda (x) (mew-refile-set msg x))) folders)
	    (mew-mark-unmark)
	    (mew-summary-mark-as mew-mark-refile)))
      ;; memorize last-folder
      (setq mew-refile-last-folder folders)
      (if (or mark auto (not folders))
	  () ;; stay here
	(mew-summary-goto-message)
	;; on the message
	(mew-decode-syntax-delete)
	;; for C-x C-x
	(beginning-of-line)
	(let ((zmacs-regions nil))
	  (push-mark (point) t t))
	(mew-summary-display-after mew-summary-mark-direction))
      (set-buffer-modified-p nil)
      folders)))) ;; return value

(defun mew-summary-refile-report ()
  (mew-summary-only
   (mew-summary-msg-or-part
    (let (fld msg guess buf
	      (customize-var '(mew-refile-ctrl-multi
			       mew-refile-guess-key-list
			       mew-refile-guess-strip-domainpart
			       mew-refile-guess-from-me-is-special)))
      (save-excursion
	;; save the cursor position anyway
	(mew-summary-goto-message)
	;; on the message
	(setq fld (mew-summary-folder-name))
	(setq msg (mew-summary-message-number)) ;; msg is never nil
	(mew-set-buffer-tmp)
	(mew-insert-message fld msg mew-cs-autoconv
			    mew-header-reasonable-size)
	(setq guess (mew-refile-guess nil t)))
      (setq buf (buffer-name))
      (mew-window-configure buf 'message)
      (mew-elet
       (mew-erase-buffer)
       (save-excursion
	 ;; report result of guess.
	 (insert (format "** Guess result: %s\n" (car guess)))
	 ;; report status of customize variables.
	 (insert "\n** Current Configurations:\n\n")
	 (while customize-var
	   (insert (format "%-40s:  " (car customize-var)))
	   (insert (format "%s\n"     (eval (car customize-var))))
	   (setq customize-var (cdr customize-var)))
	 (insert "\n** Each function's opinion:\n\n")
	 ;; report how each functions guessed.
	 (setq guess (cdr guess))
	 (while guess
	   (insert (format "%-32s  " (car (car guess))))
	   (insert (format "return: %s\n" (cdr (car guess))))
	   (setq guess (cdr guess)))))
      (mew-message-clear-end-of)
      (set-buffer-modified-p nil)
      (mew-pop-to-buffer buf)))))

(defun mew-summary-refile-again ()
  "Put a refile mark on this message according to the previous 
refile folder."
  (interactive)
  (mew-summary-only
   (mew-summary-refile-body mew-refile-last-folder)))

(defun mew-summary-auto-refile (&optional mew-mark-review-only)
  "Refile each message in the folder automatically. If 
'mew-refile-auto-refile-skip-any-mark' is non-nil,
any previousely marked message will be skipped.
If '\\[universal-argument]' is specified, only messages marked with
'mew-mark-review' will be conserned."
  (interactive "P")
  (mew-summary-only
   (let ((after-change-function nil)  ;; XEmacs - obsolete variable, ignore warnings.
	 (after-change-functions nil)
	 (mew-use-highlight-x-face nil)
	 (lines (count-lines (point-min) (point-max)))
	 (line 1) (mark nil) msg)
     (cond
      (mew-mark-review-only
       (setq msg (format "Refile all messages marked with '%c'? "
			 mew-mark-review)))
      (mew-refile-auto-refile-skip-any-mark
       (setq msg (format "Refile all non-marked messages? ")))
      (t
       (setq msg (format "Refile all messages except those marked with '%c' and '%c'? " mew-mark-refile mew-mark-delete))))
     (if (and mew-refile-auto-refile-confirm (null (yes-or-no-p msg)))
	 (message "Not refiled.")
       (message "Auto refiling ...")
       (save-window-excursion
	 (goto-char (point-min))
	 (while (not (eobp))
	   (setq mark (mew-summary-get-mark))
	   (if mew-mark-review-only 
	       (and (equal mark mew-mark-review)
		    (mew-summary-refile-body nil t))
	     (or (equal mark mew-mark-refile)
		 (equal mark mew-mark-delete)
		 (and mark mew-refile-auto-refile-skip-any-mark)
		 (mew-summary-refile-body nil t)))
	   (forward-line)
	   (if (equal (% (/ (* 100 line) lines) 10) 0)
	       (message "Auto refiling ... %s%%"
			(/ (* 100 line) lines)))
	   (setq line (1+ line)))
	 (message "Auto refiling ... done"))))))

;;
;; "mx" extension
;;
(defun mew-summary-mark-refile ()
  "\\<mew-summary-mode-map>
Put the refile mark onto all messages marked with '*'.
This is very convenient to refile all messages picked by '\\[mew-summary-search-mark]'."
  (interactive)
  (mew-summary-only
   (let ((after-change-function nil) ;; XEmacs - obsolete variable, ignore warnings.
	 (after-change-functions nil)
	 (mew-use-highlight-x-face nil)
	 (last nil)
	 (regex (concat mew-summary-message-regex
			(regexp-quote (char-to-string mew-mark-review)))))
     (message "Mark refiling ...")
     (save-excursion
       (save-window-excursion
	 (goto-char (point-min))
	 (while (re-search-forward regex nil t)
	   (setq last (mew-summary-refile-body last))
	   (forward-line))
	 (message "Mark refiling ... done"))))))

(provide 'mew-refile)

;;; Copyright Notice:

;; Copyright (C) 1994, 1995, 1996, 1997, 1998, 1999 Mew developing team.
;; All rights reserved.

;; Redistribution and use in source and binary forms, with or without
;; modification, are permitted provided that the following conditions
;; are met:
;; 
;; 1. Redistributions of source code must retain the above copyright
;;    notice, this list of conditions and the following disclaimer.
;; 2. Redistributions in binary form must reproduce the above copyright
;;    notice, this list of conditions and the following disclaimer in the
;;    documentation and/or other materials provided with the distribution.
;; 3. Neither the name of the team nor the names of its contributors
;;    may be used to endorse or promote products derived from this software
;;    without specific prior written permission.
;; 
;; THIS SOFTWARE IS PROVIDED BY THE TEAM AND CONTRIBUTORS ``AS IS'' AND
;; ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
;; IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
;; PURPOSE ARE DISCLAIMED.  IN NO EVENT SHALL THE TEAM OR CONTRIBUTORS BE
;; LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
;; CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
;; SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR
;; BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE
;; OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN
;; IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

;;; mew-refile.el ends here