/[mailutils]/mailutils/guimb/scm/sieve-core.scm
ViewVC logotype

Diff of /mailutils/guimb/scm/sieve-core.scm

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.13 by gray, Sun Oct 13 20:31:47 2002 UTC revision 1.14 by gray, Mon Oct 14 17:45:48 2002 UTC
# Line 397  Line 397 
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            

Legend:
Removed from v.1.13  
changed lines
  Added in v.1.14

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26