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

fix for syntax coloring (4.2.1.4)

Browse Source 
svn: r15608
This commit is contained in:
Matthew Flatt 2009-07-28 18:30:21 +00:00
parent 1ba7cf0926
commit d48332ed26
4 changed files with 45 additions and 24 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

40
collects/framework/private/color.ss
View File

@ -104,6 +104,7 @@ added get-regions
invalid-tokens ; = (new token-tree%)
;; The position right before the ainvalid-tokens tree
invalid-tokens-start ; = +inf.0
invalid-tokens-mode
;; The position right before the next token to be read
current-pos
;; Thread a mode through lexing, and remember the mode
@ -126,6 +127,7 @@ added get-regions
#t
(new token-tree%)
+inf.0
#f
start
#f
(new paren-tree% (matches pairs))))
@ -264,9 +266,11 @@ added get-regions
(< invalid-tokens-start
(lexer-state-current-pos ls)))
(send invalid-tokens search-min!)
(let ((length (send invalid-tokens get-root-length)))
(let ((length (send invalid-tokens get-root-length))
(mode (data-lexer-mode (send invalid-tokens get-root-data))))
(send invalid-tokens remove-root!)
(set-lexer-state-invalid-tokens-start! ls (+ invalid-tokens-start length)))
(set-lexer-state-invalid-tokens-start! ls (+ invalid-tokens-start length))
(set-lexer-state-invalid-tokens-mode! ls mode))
(sync-invalid ls))))
(define/private (re-tokenize ls in in-start-pos in-lexer-mode enable-suspend)
@ -303,7 +307,9 @@ added get-regions
(cond
((and (not (send (lexer-state-invalid-tokens ls) is-empty?))
(= (lexer-state-invalid-tokens-start ls)
(lexer-state-current-pos ls)))
(lexer-state-current-pos ls))
(equal? new-lexer-mode
(lexer-state-invalid-tokens-mode ls)))
(send (lexer-state-invalid-tokens ls) search-max!)
(send (lexer-state-parens ls) merge-tree
(send (lexer-state-invalid-tokens ls) get-root-end-position))
@ -320,8 +326,8 @@ added get-regions
(sync-invalid ls))
(cond
((lexer-state-up-to-date? ls)
(let-values (((orig-token-start orig-token-end valid-tree invalid-tree)
(send (lexer-state-tokens ls) split (- edit-start-pos (lexer-state-start-pos ls)))))
(let-values (((orig-token-start orig-token-end valid-tree invalid-tree orig-data)
(send (lexer-state-tokens ls) split/data (- edit-start-pos (lexer-state-start-pos ls)))))
(send (lexer-state-parens ls) split-tree orig-token-start)
(set-lexer-state-invalid-tokens! ls invalid-tree)
(set-lexer-state-tokens! ls valid-tree)
@ -330,6 +336,7 @@ added get-regions
(if (send (lexer-state-invalid-tokens ls) is-empty?)
+inf.0
(+ (lexer-state-start-pos ls) orig-token-end change-length)))
(set-lexer-state-invalid-tokens-mode! ls (and orig-data (data-lexer-mode orig-data)))
(let ([start (+ (lexer-state-start-pos ls) orig-token-start)])
(set-lexer-state-current-pos! ls start)
(set-lexer-state-current-lexer-mode! ls
@ -341,31 +348,34 @@ added get-regions
(set-lexer-state-up-to-date?! ls #f)
(queue-callback (λ () (colorer-callback)) #f)))
((>= edit-start-pos (lexer-state-invalid-tokens-start ls))
(let-values (((tok-start tok-end valid-tree invalid-tree)
(send (lexer-state-invalid-tokens ls) split
(let-values (((tok-start tok-end valid-tree invalid-tree orig-data)
(send (lexer-state-invalid-tokens ls) split/data
(- edit-start-pos (lexer-state-start-pos ls)))))
(set-lexer-state-invalid-tokens! ls invalid-tree)
(set-lexer-state-invalid-tokens-start!
ls
(+ (lexer-state-invalid-tokens-start ls) tok-end change-length))))
(+ (lexer-state-invalid-tokens-start ls) tok-end change-length))
(set-lexer-state-invalid-tokens-mode! ls (and orig-data (data-lexer-mode orig-data)))))
((> edit-start-pos (lexer-state-current-pos ls))
(set-lexer-state-invalid-tokens-start!
ls
(+ change-length (lexer-state-invalid-tokens-start ls))))
(else
(let-values (((tok-start tok-end valid-tree invalid-tree)
(send (lexer-state-tokens ls) split
(let-values (((tok-start tok-end valid-tree invalid-tree data)
(send (lexer-state-tokens ls) split/data
(- edit-start-pos (lexer-state-start-pos ls)))))
(send (lexer-state-parens ls) truncate tok-start)
(set-lexer-state-tokens! ls valid-tree)
(set-lexer-state-invalid-tokens-start! ls (+ change-length (lexer-state-invalid-tokens-start ls)))
(let ([start (+ (lexer-state-start-pos ls) tok-start)])
(set-lexer-state-current-pos! ls start)
(if (= start (lexer-state-start-pos ls))
#f
(begin
(send valid-tree search-max!)
(data-lexer-mode (send valid-tree get-root-data)))))))))
(set-lexer-state-current-lexer-mode!
ls
(if (= start (lexer-state-start-pos ls))
#f
(begin
(send valid-tree search-max!)
(data-lexer-mode (send valid-tree get-root-data))))))))))
(define/private (do-insert/delete edit-start-pos change-length)
(unless (or stopped? force-stop?)

9
collects/syntax-color/module-lexer.ss
View File

@ -34,11 +34,16 @@
v)))
scheme-lexer)))]
[(eq? 'fail get-info)
(copy-port in (open-output-nowhere))
(let*-values ([(end-line end-col end-pos) (port-next-location in)])
(values #f 'error #f start-pos end-pos
(lambda (in)
(values #f 'eof #f end-pos end-pos))))]
(let-values ([(line col pos) (port-next-location in)])
(if (eof-object? (peek-byte in))
(values #f 'eof #f pos pos)
(begin
(copy-port in (open-output-nowhere))
(let-values ([(end-line end-col end-pos) (port-next-location in)])
(values #f 'other #f pos end-pos))))))))]
[else
;; Start over using the Scheme lexer
(module-lexer in scheme-lexer)])))]

16
collects/syntax-color/token-tree.ss
View File

@ -257,14 +257,15 @@
;; pos is on a token boundary, 2 tokens will be dropped.
;; In this case, the start will be for the first dropped
;; token and the stop will be for the second.
(define/public (split pos)
(define/public (split/data pos)
(search! pos)
(let ((t1 (new token-tree%))
(t2 (new token-tree%)))
(cond
(root
(let ((second-start (get-root-start-position))
(second-stop (get-root-end-position)))
(second-stop (get-root-end-position))
(data (node-token-data root)))
(send t1 set-root (node-left root))
(send t2 set-root (node-right root))
(set! root #f)
@ -273,10 +274,15 @@
(send t1 search-max!)
(let ((first-start (send t1 get-root-start-position)))
(send t1 remove-root!)
(values first-start second-stop t1 t2)))
(values first-start second-stop t1 t2 data)))
(else
(values second-start second-stop t1 t2)))))
(else (values 0 0 t1 t2)))))
(values second-start second-stop t1 t2 data)))))
(else (values 0 0 t1 t2 #f)))))
(define/public (split pos)
(let-values ([(orig-token-start orig-token-end valid-tree invalid-tree orig-data)
(split/data pos)])
(values orig-token-start orig-token-end valid-tree invalid-tree)))
;; (define/public (split)
;; (let ((t1 (new token-tree%))

4
src/mzscheme/src/schvers.h
View File

@ -13,12 +13,12 @@
consistently.)
*/
#define MZSCHEME_VERSION "4.2.1.3"
#define MZSCHEME_VERSION "4.2.1.4"
#define MZSCHEME_VERSION_X 4
#define MZSCHEME_VERSION_Y 2
#define MZSCHEME_VERSION_Z 1
#define MZSCHEME_VERSION_W 3
#define MZSCHEME_VERSION_W 4
#define MZSCHEME_VERSION_MAJOR ((MZSCHEME_VERSION_X * 100) + MZSCHEME_VERSION_Y)
#define MZSCHEME_VERSION_MINOR ((MZSCHEME_VERSION_Z * 1000) + MZSCHEME_VERSION_W)