/[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.6 by gray, Fri Dec 28 22:33:55 2001 UTC revision 1.7 by gray, Thu May 2 12:33:52 2002 UTC
# Line 27  Line 27 
27  ;;; If #f, it will be set by sieve-main  ;;; If #f, it will be set by sieve-main
28  (define sieve-my-email #f)  (define sieve-my-email #f)
29    
30    (define SIEVE-WARNING "Warning")
31    (define SIEVE-ERROR "Error")
32    (define SIEVE-NOTICE "Notice")
33      
34  ;;; List of open mailboxes.  ;;; List of open mailboxes.
35  ;;; Each entry is: (list MAILBOX-NAME OPEN-FLAGS MBOX)  ;;; Each entry is: (list MAILBOX-NAME OPEN-FLAGS MBOX)
36  (define sieve-mailbox-list '())  (define sieve-mailbox-list '())
# Line 227  Line 231 
231                                   ((#:matches)                                   ((#:matches)
232                                    (if (regexp-exec rx addr)                                    (if (regexp-exec rx addr)
233                                        (exit #t))))                                        (exit #t))))
234                                 (runtime-error LOG_NOTICE                                 (runtime-message SIEVE-NOTICE
235                                  "Can't get address parts for message "                                  "Can't get address parts for message "
236                                  sieve-current-message))))))))                                  sieve-current-message))))))))
237               header-fields)))               header-fields)))
# Line 244  Line 248 
248       ((eq? (car comp) #:under)       ((eq? (car comp) #:under)
249        (< size key-size))        (< size key-size))
250       (else       (else
251        (runtime-error LOG_CRIT "test-size: unknown comparator " comp)))))        (runtime-message SIEVE-ERROR  "test-size: unknown comparator " comp)))))
252    
253  (define (test-envelope part-list key-list . opt-args)  (define (test-envelope part-list key-list . opt-args)
254    (let ((comp (find-comp opt-args))    (let ((comp (find-comp opt-args))
# Line 262  Line 266 
266                       (exit #t)))                       (exit #t)))
267                 key-list)))                 key-list)))
268             (else             (else
269              ;; Should we issue a warning?              (runtime-message SIEVE-ERROR
270              ;;(runtime-error LOG_ERR "Envelope part " part " not supported")                               "Envelope part " part " not supported")
271              #f)))              #f)))
272          part-list)          part-list)
273         #f))))         #f))))
# Line 348  Line 352 
352    (sieve-register-test "false" #f '() '())    (sieve-register-test "false" #f '() '())
353    (sieve-register-test "true"  #t '() '())))    (sieve-register-test "true"  #t '() '())))
354    
355  ;;; runtime-error  ;;; runtime-message
356    
357  (define (runtime-error level . text)  (define (runtime-message level . text)
358    (display (string-append "RUNTIME ERROR in " sieve-source ": "))    (let ((msg (apply string-append
359    (for-each                      (map (lambda (x)
360     (lambda (s)                             (format #f "~A" x))
361       (display s))                           (append
362     text)                            (list "(in " sieve-source ") ")
363    (newline))                            text)))))
364        (mu-message-set-header sieve-current-message
365                               (string-append "X-Sieve-" level)
366                               msg)
367           (if (isatty? (current-output-port))
368               (display (string-append level ": " msg "\n")))))
369    
370  ;;; Sieve-main  ;;; Sieve-main
371  (define sieve-current-message #f)  (define sieve-current-message #f)

Legend:
Removed from v.1.6  
changed lines
  Added in v.1.7

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