suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

improved regexp-quote and regexp-replace-quote

Browse Source 
svn: r4932
This commit is contained in:
Eli Barzilay 2006-11-23 05:39:47 +00:00
parent a024df75fb
commit 145cc5be61
1 changed files with 25 additions and 29 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

52
collects/mzlib/string.ss
View File

@ -140,43 +140,39 @@
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Regexp helpers ;; Regexp helpers
(define regexp-quote-chars:s #rx"[][.*?+|(){}\\$^]")
(define regexp-quote-chars:b #rx#"[][.*?+|(){}\\$^]")
(define regexp-quote (define regexp-quote
(opt-lambda (s [case-sens? #t]) (opt-lambda (s [case-sens? #t])
(unless (or (string? s) (let* ([b? (cond [(bytes? s) #t]
(bytes? s)) [(string? s) #f]
(raise-type-error 'regexp-quote "string or byte string" s)) (raise-type-error 'regexp-quote
((if (bytes? s) "string or byte string" s))]
(lambda (l) (list->bytes (map char->integer l))) [s (if b?
list->string) (regexp-replace* regexp-quote-chars:b s #"\\\\&")
(apply (regexp-replace* regexp-quote-chars:s s "\\\\&"))])
append (cond [case-sens? s]
(map [b? (bytes-append #"(?i:" s #")")]
(lambda (c) [else (string-append "(?i:" s ")")]))))
(cond
[(memq c '(#\$ #\| #\\ #\[ #\] #\. #\* #\? #\+ #\( #\) #\^ #\{ #\}))
(list #\\ c)]
[(and (not case-sens?)
(not (char=? (char-upcase c) (char-downcase c))))
(list #\[ (char-upcase c) (char-downcase c) #\])]
[else (list c)]))
(if (bytes? s)
(map integer->char (bytes->list s))
(string->list s)))))))
(define (regexp-replace-quote s) (define (regexp-replace-quote s)
(unless (or (string? s) (let ([b? (cond [(bytes? s) #t]
(bytes? s)) [(string? s) #f]
(raise-type-error 'regexp-replace-quote "string or byte string" s)) (raise-type-error 'regexp-replace-quote
(if (bytes? s) "string or byte string" s))])
(regexp-replace* #rx#"&" (regexp-replace* #rx#"\\\\" s #"\\\\\\\\") #"\\\\&") (if b?
(regexp-replace* #rx"&" (regexp-replace* #rx"\\\\" s "\\\\\\\\") "\\\\&"))) (regexp-replace* #rx#"[&\\]" s #"\\\\&")
(regexp-replace* #rx"[&\\]" s "\\\\&"))))
(define regexp-match/fail-without-reading (define regexp-match/fail-without-reading
(opt-lambda (pattern input-port [start-k 0] [end-k #f] [out #f]) (opt-lambda (pattern input-port [start-k 0] [end-k #f] [out #f])
(unless (input-port? input-port) (unless (input-port? input-port)
(raise-type-error 'regexp-match/fail-without-reading "input port" input-port)) (raise-type-error 'regexp-match/fail-without-reading
"input port" input-port))
(unless (or (not out) (output-port? out)) (unless (or (not out) (output-port? out))
(raise-type-error 'regexp-match/fail-without-reading "output port or #f" out)) (raise-type-error 'regexp-match/fail-without-reading
"output port or #f" out))
(let ([m (regexp-match-peek-positions pattern input-port start-k end-k)]) (let ([m (regexp-match-peek-positions pattern input-port start-k end-k)])
(and m (and m
;; What happens if someone swipes our bytes before we can get them? ;; What happens if someone swipes our bytes before we can get them?