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

removed use of regular regexps (they were just there as a 'performance improvement') and improved regexp for email addresses a little so it doesn't match ,@

Browse Source 
svn: r4442
This commit is contained in:
Robby Findler 2006-09-26 21:53:49 +00:00
parent 4b5146ca5b
commit 1c9cc76add
1 changed files with 9 additions and 25 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

34
collects/help/servlets/private/read-lines.ss
View File

@ -38,14 +38,10 @@
`(,ln "") `(,ln "")
`(,(spacify ln) (BR)))) lines))))) `(,(spacify ln) (BR)))) lines)))))
(define eoregexp (define eoregexp-str "($|\\s|(\\.(\\s|$))|>)")
"($|\\s|(\\.(\\s|$))|>)") (define url-regexp-base (string-append "://([^\\s]*)" eoregexp-str))
(define trailing-regexp (define trailing-regexp (pregexp "[\\s>)(\"]"))
(pregexp "[\\s>)(\"]"))
(define url-regexp-base
(string-append "://([^\\s]*)" eoregexp))
(define (make-url-regexp ty) (define (make-url-regexp ty)
(pregexp (pregexp
@ -54,17 +50,14 @@
url-regexp-base))) url-regexp-base)))
(define http-regexp (make-url-regexp "http")) (define http-regexp (make-url-regexp "http"))
(define cheap-http-regexp (regexp "http://")) (define (http-format url) `(A ((HREF ,url)) ,url))
(define (http-format url)
`(A ((HREF ,url)) ,url))
(define ftp-regexp (make-url-regexp "ftp")) (define ftp-regexp (make-url-regexp "ftp"))
(define cheap-ftp-regexp (regexp "ftp://"))
(define ftp-format http-format) (define ftp-format http-format)
(define email-regexp (define email-regexp
(let ([chars "[^\\s)(<>\"']"]) (let ([chars "[^\\s)(<>\"']"]
(pregexp (string-append chars "+" "@" chars "{3,}")))) [no-comma-chars "[^\\s)(<>\"',]"])
(define cheap-email-regexp (regexp "@")) (pregexp (string-append no-comma-chars chars "*" "@" chars "{3,}"))))
(define (email-format addr) (define (email-format addr)
`(A ((HREF ,(string-append "mailto:" addr))) ,addr)) `(A ((HREF ,(string-append "mailto:" addr))) ,addr))
@ -86,27 +79,18 @@
(let regexp-loop ([regexps (list http-regexp (let regexp-loop ([regexps (list http-regexp
ftp-regexp ftp-regexp
email-regexp)] email-regexp)]
[cheap-regexps
(list cheap-http-regexp
cheap-ftp-regexp
cheap-email-regexp)]
[formats (list http-format [formats (list http-format
ftp-format ftp-format
email-format)]) email-format)])
(if (null? regexps) (if (null? regexps)
(values #f #f) (values #f #f)
(let* ([curr-regexp (car regexps)] (let* ([curr-regexp (car regexps)]
[curr-cheap-regexp (car cheap-regexps)]
[curr-formatter (car formats)] [curr-formatter (car formats)]
[match-indices [match-indices
(and (regexp-match-positions (pregexp-match-positions curr-regexp built-line)])
curr-cheap-regexp built-line)
(pregexp-match-positions
curr-regexp built-line))])
(if match-indices (if match-indices
(values match-indices curr-formatter) (values match-indices curr-formatter)
(regexp-loop (cdr regexps) (cdr cheap-regexps) (regexp-loop (cdr regexps) (cdr formats))))))])
(cdr formats))))))])
(if raw-indices (if raw-indices
(let* ([indices (car raw-indices)] (let* ([indices (car raw-indices)]
[string-start (car indices)] [string-start (car indices)]