Study of syntax highlighting

syntax.rtd

Red [
	Author: "Toomas Vooglaid"
	Date: 2019-01-14
	Purpose: {Study of syntax highlighting}
]
skp: charset " ^/^-[]()/"
initial-size: 800x800
addr: func [s1 s2 style] bind [keep as-pair i: index? s1 (index? s2) - i keep style] :collect
rule: [any [s:
	skp
|	#";" [if (s2: find s newline) | (s2: tail s)] (addr s s2 reduce ['italic beige - 50]) :s2
|	(el: load/next s 's2)(
		case [
			string? el 		[addr s s2 gray]
			any-string? el 	[addr s s2 orange]
			word? el 		[case [
				any-function? get/any el [addr s s2 brick]; reduce ['bold blue]]
				immediate? get/any el [addr s s2 leaf]
			]]
			path? el 		[if any-function? get/any el/1 [addr s s2 brick]];reduce ['bold blue]]]
			any-word? el 	[addr s s2 navy]
			any-path? el 	[addr s s2 water]
			number? el 		[addr s s2 mint]
			scalar? el 		[addr s s2 teal]
			immediate? el 	[addr s s2 leaf]
		]
	) :s2
]]
filter: func [series _end][
	collect [foreach file series [if find/match skip tail file -4 _end [keep file]]]
]
box-rule: bind [
	any [
		p: 178.34.34 (;'bold (
			addr: back p 
			keep reduce ['box caret-to-offset rt addr/1/1 
				(caret-to-offset rt pos: addr/1/1 + addr/1/2) + as-pair 0 -2 + rich-text/line-height? rt pos
			]
		)
	| skip
	]
] :collect
scroll: func [pos][
	rt/offset: layer/offset: as-pair 0 pos - 1 * negate rich-text/line-height? rt 1
]
system/view/auto-sync?: off
view/options [
	backdrop white
	files: drop-list 200 with [data: read %.] 
	on-change [
		rt/offset: 0x0
		rt/text: read pick face/data face/selected
		show rt
		rt/size/y: second size-text rt
		scr/max-size: rich-text/line-count? rt
		scr/position: 1
		scr/page: 1
		scr/page-size: bs/size/y / rich-text/line-height? rt 1
		clear rt/data 
		collect/into [parse rt/text rule] rt/data
		clear at layer/draw 5
		collect/into [parse rt/data box-rule] layer/draw
		show [bs layer]
	]
	button "Dir..." [
		files/data: filter read change-dir request-dir/dir normalize-dir %. ".red"
		clear rt/data clear rt/text
	] button [probe rich-text/line-height? rt 1]
	return bs: base white with [
		size: initial-size - 15x0
		pane: append [] layout/only [
			origin 0x0 
			rt: rich-text "" with [
				size: initial-size - 15x0
				data: []
			]
		]
		flags: 'scrollable
	]
	on-created [
		put get-scroller face 'horizontal 'visible? no
		scr: get-scroller face 'vertical
	]
	on-scroll [
		;print [ event/type event/key event/picked event/flags ]
		;foreach attr exclude words-of scr [parent window][print [attr ":" get attr]]
		;foreach attr exclude system/catalog/accessors/event! [face parent window][print [attr ":" attempt [get/any event/:attr]]]
		unless event/key = 'end [
			scroll scr/position: min max 1 switch event/key [
				track [event/picked]
				up left [scr/position - 1]
				page-up page-left [scr/position - scr/page-size]
				down right [scr/position + 1]
				page-down page-right [scr/position + scr/page-size]
			] scr/max-size
		]
		show face
	]
	at 10x47 layer: box with [size: initial-size - 15x0] 
	draw [pen off fill-pen 0.0.0.254]
	on-over [
		either event/away? [
			tip/visible?: no
		][
			str: find/reverse/tail at rt/text offset-to-caret rt event/offset skp
			wrd: to-word copy/part str find str skp
			tip/text: help-string :wrd
			tip/size/y: 20 + second size-text tip
			tip/offset: min 
				max 0x0 event/offset + as-pair 30 0 - (tip/size/y / 2)
				layer/size - tip/size
			tip/visible?: yes
		]
		show tip
	]
	at 0x0 tip: box "" 350x100 linen hidden
][offset: 10x30]

First steps. Unfortunately works somewhat for first file only. I don't see the source of the problem yet.