Skip to content

Commit 1d84adb

Browse files
rfindlerrfindler
committed
adjust highlighting to take invisible parens into account
1 parent 3a800c8 commit 1d84adb

File tree

1 file changed

+120
-42
lines changed

1 file changed

+120
-42
lines changed

‎gui-lib/framework/private/color.rkt

+120-42
Original file line numberDiff line numberDiff line change
@@ -10,6 +10,7 @@ added get-regions
1010
(require racket/class
1111
racket/unit
1212
racket/gui/base
13+
racket/match
1314
syntax-color/token-tree
1415
syntax-color/paren-tree
1516
syntax-color/default-lexer
@@ -60,6 +61,17 @@ added get-regions
6061
attribs
6162
(or (hash-ref attribs 'color #f)
6263
(hash-ref attribs 'type 'unknown))))
64+
(define (attribs->invisible attribs)
65+
(cond
66+
[(symbol? attribs)
67+
(values 0 #f)]
68+
[else
69+
(define open-count (hash-ref attribs 'invisible-open-count #f))
70+
(define close-count (hash-ref attribs 'invisible-close-count #f))
71+
(cond
72+
[open-count (values open-count invisible-open)]
73+
[close-count (values close-count invisible-close)]
74+
[else (values 0 #f)])]))
6375
(define (attribs->table attribs)
6476
(if (symbol? attribs)
6577
(hasheq 'type attribs)
@@ -420,7 +432,10 @@ added get-regions
420432
len
421433
(make-data attribs new-lexer-mode backup-delta))
422434
#; (show-tree (lexer-state-tokens ls))
423-
(send (lexer-state-parens ls) add-token paren len)
435+
(define-values (invisible-count invisible-paren)
436+
(attribs->invisible attribs))
437+
(send (lexer-state-parens ls) add-token (or paren invisible-paren) len
438+
#:invisible invisible-count)
424439
(cond
425440
[(and (not (send (lexer-state-invalid-tokens ls) is-empty?))
426441
(= (lexer-state-invalid-tokens-start ls)
@@ -852,52 +867,115 @@ added get-regions
852867
;; This leads to the nice behavior that we don't have to block to
853868
;; highlight parens, and the parens will be highlighted as soon as
854869
;; possible.
855-
(define/private match-parens
856-
(lambda ([just-clear? #f])
857-
;;(printf "(match-parens ~a)\n" just-clear?)
858-
(when (and (not in-match-parens?)
859-
;; Trying to match open parens while the
860-
;; background thread is going slows it down.
861-
;; The random number slows down how often it
862-
;; tries.
863-
(or just-clear?
864-
(andmap lexer-state-up-to-date? lexer-states)
865-
(= 0 (random 5))))
866-
(set! in-match-parens? #t)
867-
(begin-edit-sequence #f #f)
868-
(clear-old-locations)
869-
(set! clear-old-locations void)
870-
(when (and (preferences:get 'framework:highlight-parens)
871-
(not just-clear?)
872-
(not stopped?))
873-
(let* ((here (get-start-position)))
874-
(when (= here (get-end-position))
875-
(let ([ls (find-ls here)])
876-
(when ls
877-
(let-values (((start-f end-f error-f)
878-
(send (lexer-state-parens ls) match-forward
879-
(- here (lexer-state-start-pos ls)))))
880-
(when (and (not (f-match-false-error ls start-f end-f error-f))
881-
start-f end-f)
882-
(if error-f
883-
(highlight ls start-f end-f here (and error-f #t))
884-
(highlight-nested-region ls start-f end-f here))))
885-
(let-values (((start-b end-b error-b)
886-
(send (lexer-state-parens ls) match-backward
887-
(- here (lexer-state-start-pos ls)))))
888-
(when (and start-b end-b)
889-
(if error-b
890-
(highlight ls start-b end-b here (and error-b #t))
891-
(highlight-nested-region ls start-b end-b here)))))))))
892-
(end-edit-sequence)
893-
(set! in-match-parens? #f))))
870+
(define/private (match-parens [just-clear? #f])
871+
;; (printf "(match-parens ~a)\n" just-clear?)
872+
(when (and (not in-match-parens?)
873+
;; Trying to match open parens while the
874+
;; background thread is going slows it down.
875+
;; The random number slows down how often it
876+
;; tries.
877+
(or just-clear?
878+
(andmap lexer-state-up-to-date? lexer-states)
879+
(= 0 (random 5))))
880+
(set! in-match-parens? #t)
881+
(begin-edit-sequence #f #f)
882+
(clear-old-locations)
883+
(set! clear-old-locations void)
884+
(when (and (preferences:get 'framework:highlight-parens)
885+
(not just-clear?)
886+
(not stopped?))
887+
(define caret-pos (get-start-position))
888+
(when (= caret-pos (get-end-position))
889+
(define ls (find-ls caret-pos))
890+
(when ls
891+
(define-values (start-f end-f error-f)
892+
(send (lexer-state-parens ls) match-forward
893+
(- caret-pos (lexer-state-start-pos ls))))
894+
(when (and (not (f-match-false-error ls start-f end-f error-f))
895+
start-f end-f)
896+
(if error-f
897+
(highlight ls start-f end-f caret-pos (and error-f #t))
898+
(highlight-nested-region ls start-f end-f caret-pos)))
899+
(define-values (start-b end-b error-b)
900+
(send (lexer-state-parens ls) match-backward
901+
(- caret-pos (lexer-state-start-pos ls))))
902+
(when (and start-b end-b)
903+
(if error-b
904+
(highlight ls start-b end-b caret-pos (and error-b #t))
905+
(highlight-nested-region ls start-b end-b caret-pos))))))
906+
(end-edit-sequence)
907+
(set! in-match-parens? #f)))
894908

895909
;; highlight-nested-region : lexer-state number number number -> void
896910
;; colors nested regions of parentheses.
897-
(define/private (highlight-nested-region ls orig-start orig-end here)
911+
(define/private (highlight-nested-region ls orig-start orig-end caret-pos)
898912
(define priority (get-parenthesis-priority))
899913
(define paren-colors (get-parenthesis-colors))
900-
(let paren-loop ([start orig-start]
914+
915+
;; this goes over a range at a specific depth, highlighting
916+
;; of the the parens it finds at that depth and calling `single-spot-loop` to go deeper inside
917+
(define (seq-loop start end depth)
918+
(when (< depth (vector-length paren-colors))
919+
(define color (vector-ref paren-colors depth))
920+
(let loop ([start start])
921+
(when (< start end)
922+
(define afterwards (or (single-spot-loop start depth) (+ start 1)))
923+
(loop afterwards)))))
924+
925+
;; single-spot-loop : natural natural -> void
926+
;; loops over the parens that open at `start` and inside
927+
;; the region from `start` to its outermost close paren
928+
;;
929+
;; instead of a more conventional traversal that would go over the
930+
;; parens at the current level and then goes across the positions
931+
;; inside the parens, looking for parens inside, we instead view the
932+
;; parens all starting at `start` as a series of nested parens that
933+
;; might look something like this, where the first three parens are
934+
;; all starting at the same spot.
935+
;; ((( ) ) )
936+
;; 12344433333222221
937+
;; This function loops over those first three parens (via the result
938+
;; of get-spot-parens) and, at each iteration, also considers the region
939+
;; following the close paren out to the enclosing close paren. That is,
940+
;; when we're looking at the paren labelled with a 2 in the diagram
941+
;; above, we'll recur with depth+1 to handle depth 3 (and eventually
942+
;; depth 4) and then use `seq-loop` to go over the region with the 2s
943+
;; underneath it, between the last two parens.
944+
(define (single-spot-loop start depth)
945+
;; the -1 and +1s in the calls to seq-loop should probably be based on the tokenization,
946+
;; as more positions can be skipped in general
947+
(cond
948+
[(send (lexer-state-parens ls) is-open-pos? start #:invisible-ok? #t)
949+
(define invisible-paren-count (send (lexer-state-parens ls) get-invisible-count start))
950+
(define-values (outermost-start outermost-end error-outermost)
951+
(send (lexer-state-parens ls) match-forward start #:invisible invisible-paren-count))
952+
(let loop ([invisible-paren-count invisible-paren-count]
953+
[end-position outermost-end]
954+
[depth depth])
955+
(when (< depth (vector-length paren-colors))
956+
(define color (vector-ref paren-colors depth))
957+
(cond
958+
[(zero? invisible-paren-count)
959+
(when (send (lexer-state-parens ls) is-open-pos? start #:invisible-ok? #f)
960+
(define-values (start-inner end-inner error-inner)
961+
(send (lexer-state-parens ls) match-forward start))
962+
(unless error-inner
963+
(seq-loop (+ start-inner 1) (- end-inner 1) (+ depth 1))
964+
(seq-loop (+ end-inner 1) (- end-position 1) depth)
965+
(highlight ls start-inner end-inner caret-pos color priority)))]
966+
[else
967+
(define-values (start-inner end-inner error-inner)
968+
(send (lexer-state-parens ls) match-forward start #:invisible invisible-paren-count))
969+
(unless error-inner
970+
(seq-loop (+ end-inner 1) (- end-position 1) depth)
971+
(loop (- invisible-paren-count 1) end-inner (+ depth 1))
972+
(highlight ls start-inner end-inner caret-pos color priority))])))
973+
outermost-end]
974+
[else #f]))
975+
976+
(single-spot-loop orig-start 0)
977+
978+
#;(let paren-loop ([start orig-start]
901979
[end orig-end]
902980
[depth 0])
903981
(when (< depth (vector-length paren-colors))

0 commit comments

Comments
 (0)