/[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.11 by gray, Sun Sep 1 21:59:46 2002 UTC revision 1.12 by gray, Tue Oct 1 13:08:54 2002 UTC
# Line 142  Line 142 
142      #:contains)      #:contains)
143     ((member #:matches opt-args)     ((member #:matches opt-args)
144      #:matches)      #:matches)
145       ((member #:regex opt-args)
146        #:regex)
147     (else     (else
148      #:is)))      #:is)))
149    
# Line 198  Line 200 
200            (set! cl (append (list ch #\\) cl)))            (set! cl (append (list ch #\\) cl)))
201           (else           (else
202            (set! cl (append (list ch) cl))))))))            (set! cl (append (list ch) cl))))))))
                     
 ;;;; Standard tests:  
203    
204    
205    (define (get-regex match key comp)
206      (case match
207        ((#:matches)
208         (make-regexp (sieve-regexp-to-posix key)
209                      (if (eq? comp string-ci=?)
210                          regexp/icase
211                          '())))
212        ((#:regex)
213         (make-regexp key
214                      (if (eq? comp string-ci=?)
215                          regexp/icase
216                          '())))
217        (else
218         #f)))
219    
220    ;;;; Standard tests:
221    
222  (define (test-address header-list key-list . opt-args)  (define (test-address header-list key-list . opt-args)
223    (let ((comp (find-comp opt-args))    (let ((comp (find-comp opt-args))
224          (match (find-match opt-args))          (match (find-match opt-args))
# Line 219  Line 236 
236            (let ((header-fields (mu-message-get-header-fields            (let ((header-fields (mu-message-get-header-fields
237                                  sieve-current-message                                  sieve-current-message
238                                  header-list))                                  header-list))
239                  (rx (if (eq? match #:matches)                  (rx (get-regex match key comp)))
                         (make-regexp (sieve-regexp-to-posix key)  
                                      (if (eq? comp string-ci=?)  
                                          regexp/icase  
                                          '()))  
                         #f)))  
240              (for-each              (for-each
241               (lambda (h)               (lambda (h)
242                 (let ((hdr (cdr h)))                 (let ((hdr (cdr h)))
# Line 247  Line 259 
259                                   ((#:contains)                                   ((#:contains)
260                                    (if (sieve-str-str addr key comp)                                    (if (sieve-str-str addr key comp)
261                                        (exit #t)))                                        (exit #t)))
262                                   ((#:matches)                                   ((#:matches #:regex)
263                                    (if (regexp-exec rx addr)                                    (if (regexp-exec rx addr)
264                                        (exit #t))))                                        (exit #t))))
265                                 (runtime-message SIEVE-NOTICE                                 (runtime-message SIEVE-NOTICE
# Line 311  Line 323 
323            (let ((header-fields (mu-message-get-header-fields            (let ((header-fields (mu-message-get-header-fields
324                                  sieve-current-message                                  sieve-current-message
325                                  header-list))                                  header-list))
326                  (rx (if (eq? match #:matches)                  (rx (get-regex match key comp)))
                         (make-regexp (sieve-regexp-to-posix key)  
                                      (if (eq? comp string-ci=?)  
                                          regexp/icase  
                                          '()))  
                         #f)))  
327              (for-each              (for-each
328               (lambda (h)               (lambda (h)
329                 (let ((hdr (cdr h)))                 (let ((hdr (cdr h)))
# Line 328  Line 335 
335                         ((#:contains)                         ((#:contains)
336                          (if (sieve-str-str hdr key comp)                          (if (sieve-str-str hdr key comp)
337                              (exit #t)))                              (exit #t)))
338                         ((#:matches)                         ((#:matches #:regex)
339                          (if (regexp-exec rx hdr)                          (if (regexp-exec rx hdr)
340                              (exit #t)))))))                              (exit #t)))))))
341               header-fields)))               header-fields)))
# Line 341  Line 348 
348                             (cons "all" #f)))                             (cons "all" #f)))
349  (define match-type   (list (cons "is" #f)  (define match-type   (list (cons "is" #f)
350                             (cons "contains" #f)                             (cons "contains" #f)
351                             (cons "matches" #f)))                             (cons "matches" #f)
352                               (cons "regex" #f)))
353  (define size-comp    (list (cons "under" #f)  (define size-comp    (list (cons "under" #f)
354                             (cons "over" #f)))                             (cons "over" #f)))
355  (define comparator   (list (cons "comparator" 'string)))  (define comparator   (list (cons "comparator" 'string)))

Legend:
Removed from v.1.11  
changed lines
  Added in v.1.12

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