397 |
(if (isatty? (current-output-port)) |
(if (isatty? (current-output-port)) |
398 |
(display (string-append level ": " msg "\n"))))) |
(display (string-append level ": " msg "\n"))))) |
399 |
|
|
400 |
|
(define (guimb?) |
401 |
|
(catch #t |
402 |
|
(lambda () |
403 |
|
(let ((v current-mailbox)) |
404 |
|
v)) |
405 |
|
(lambda args #f))) |
406 |
|
|
407 |
;;; Sieve-main |
;;; Sieve-main |
408 |
|
(define sieve-mailbox #f) |
409 |
(define sieve-current-message #f) |
(define sieve-current-message #f) |
410 |
(define (sieve-main) |
|
411 |
|
(define (sieve-run) |
412 |
(if (not sieve-my-email) |
(if (not sieve-my-email) |
413 |
(set! sieve-my-email (mu-username->email))) |
(set! sieve-my-email (mu-username->email))) |
414 |
(let ((count (mu-mailbox-messages-count current-mailbox))) |
; (DEBUG 1 "Mailbox: " sieve-mailbox) |
415 |
|
(let ((count (mu-mailbox-messages-count sieve-mailbox))) |
416 |
(do ((n 1 (1+ n))) |
(do ((n 1 (1+ n))) |
417 |
((> n count) #f) |
((> n count) #f) |
418 |
(set! sieve-current-message |
(set! sieve-current-message |
419 |
(mu-mailbox-get-message current-mailbox n)) |
(mu-mailbox-get-message sieve-mailbox n)) |
420 |
(catch 'sieve-stop |
(catch 'sieve-stop |
421 |
sieve-process-message |
sieve-process-message |
422 |
(lambda args |
(lambda args |
423 |
#f))) |
#f))) |
424 |
(sieve-close-mailboxes))) |
(sieve-close-mailboxes))) |
425 |
|
|
426 |
|
(define (sieve-command-line) |
427 |
|
(catch #t |
428 |
|
(lambda () |
429 |
|
(let ((args sieve-script-args)) |
430 |
|
(append (list "<temp-file>") args))) |
431 |
|
(lambda args (command-line)))) |
432 |
|
|
433 |
|
(define (sieve-main) |
434 |
|
(cond |
435 |
|
((not (guimb?)) |
436 |
|
; (DEBUG 1 "Loading mailutils") |
437 |
|
(set! %load-path (append %load-path (list sieve-libdir))) |
438 |
|
(use-modules (mailutils)) |
439 |
|
(let* ((cl (sieve-command-line)) |
440 |
|
(name (if (and (not (null? (cdr cl))) |
441 |
|
(string? (cadr cl))) |
442 |
|
(cadr cl) |
443 |
|
(string-append mu-path-maildir "/" |
444 |
|
(passwd:name (mu-getpwuid (getuid))))))) |
445 |
|
; (DEBUG 2 "mailbox name " name) |
446 |
|
(set! sieve-mailbox (mu-mailbox-open name "rw")) |
447 |
|
(sieve-run) |
448 |
|
(mu-mailbox-expunge sieve-mailbox) |
449 |
|
(mu-mailbox-close sieve-mailbox))) |
450 |
|
(else |
451 |
|
; (DEBUG 1 "Using current-mailbox") |
452 |
|
(set! sieve-mailbox current-mailbox) |
453 |
|
(sieve-run)))) |
454 |
|
|