changed Scribble coloring for better tabbing

svn: r15612
This commit is contained in:
Matthew Flatt 2009-07-28 21:11:51 +00:00
parent 3c4bdf86fe
commit c1f5e3abb4
2 changed files with 28 additions and 6 deletions

View File

@ -15,7 +15,7 @@
(make-text #rx"^@" (make-text #rx"^@"
#f #f
#f #f
#rx".*?(?:(?=@)|$)" #rx".*?(?:(?=[@\r\n])|$)"
#f #f
#f)))]) #f)))])
(let-values ([(line col pos) (port-next-location in)] (let-values ([(line col pos) (port-next-location in)]
@ -38,7 +38,7 @@
mode))) mode)))
;; Line comment: ;; Line comment:
(begin (begin
(regexp-match #rx"\r\n|\r|\n" in) (regexp-match? #rx".*?(?=[\r\n])" in)
(let-values ([(end-line end-col end-pos) (port-next-location in)]) (let-values ([(end-line end-col end-pos) (port-next-location in)])
(comment-k "@;" (comment-k "@;"
'comment 'comment
@ -96,8 +96,18 @@
pos pos
end-pos end-pos
(cons (car mode) mode)))] (cons (car mode) mode)))]
[(regexp-try-match #px"^(?:[\r\n])\\s*" in)
;; Treat a newline and leading whitespace in text mode as whitespace
;; instead of as a string:
(let-values ([(end-line end-col end-pos) (port-next-location in)])
(values " "
'white-space
#f
pos
end-pos
mode))]
[else [else
;; Read string up to @ or } ;; Read string up to @, }, or newline
(regexp-match? (text-string-rx l) in) (regexp-match? (text-string-rx l) in)
(let-values ([(end-line end-col end-pos) (port-next-location in)]) (let-values ([(end-line end-col end-pos) (port-next-location in)])
(values 'string (values 'string
@ -220,7 +230,7 @@
re-opener re-opener
#"[@{])|(?=" #"[@{])|(?="
closer closer
#")|$)")) #")|(?=[\r\n])|$)"))
#f #f
#f) #f)
(cdr mode))))))] (cdr mode))))))]
@ -234,7 +244,7 @@
(cons (make-text #rx"^@" (cons (make-text #rx"^@"
#rx"^}" #rx"^}"
#rx"^{" #rx"^{"
#rx".*?(?:(?=[@{}])|$)" #rx".*?(?:(?=[@{}\r\n])|$)"
'|{| '|{|
'|}|) '|}|)
(cdr mode))))] (cdr mode))))]

View File

@ -187,7 +187,8 @@
(1 other))) (1 other)))
(test "@; 1" '((4 comment))) (test "@; 1" '((4 comment)))
(test "@; 1\nv" '((5 comment) (test "@; 1\nv" '((4 comment)
(1 white-space)
(1 string))) (1 string)))
(test "@;{1}v" '((2 comment) (test "@;{1}v" '((2 comment)
(1 other) (1 other)
@ -199,3 +200,14 @@
(5 string) (5 string)
(2 other) (2 other)
(1 string))) (1 string)))
(test "a\n b" '((1 string)
(3 white-space)
(1 string)))
(test "@item{A\nB}" '((1 other)
(4 symbol)
(1 other)
(1 string)
(1 white-space)
(1 string)
(1 other)))