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 ,@

svn: r4442
This commit is contained in:
Robby Findler 2006-09-26 21:53:49 +00:00
parent 4b5146ca5b
commit 1c9cc76add

View File

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