compose-where 1.0

Compose-where.red

Red [
  title: "Compose-where"
  Description: "A dialected compose with filtering and auto composition"
]

compose-where: func [
	"Compose where groups match using CMP/GROUP/(code). Use CMPO for ONLY"
	series [block!] "The block to compose"
	/group "Specify a group to compose"
	grp [word! block!] "The group(s) to compose"
	/deep "Compose paren in deep blocks"
	;/level LV
	/repeat "Compose again the result of composing a paren, until no paren in result"
	/local
	code
	mode
	subseries
	path-group
	groups
	compose-result
] [

	groups: append copy [] grp
	
	parse series [
		any [
			
			ahead path! change into [
				['CMP (mode: 'CMP) | 'CMPO (mode: 'CMPO)] 
				set PATH-GROUP word!
				if (

					either group [find groups path-group] [true] 
				) 
					set code paren! end
			] (
				compose-result: none
				
				case [
					MODE = 'CMP [
						compose-result: compose reduce [code]
					] 
					MODE = 'CMPO [
						compose-result: compose/only reduce [code]]
				]

				either repeat [compose-where/:deep/:repeat/:group compose-result grp] [compose-result] 
			)  
		| 
			ahead block! if (deep) set subseries block! (compose-where/:deep/:repeat/:group subseries grp)  		
		|	
			any-type! 
		| 		
			skip
		] 
		
		end 			
	] 
	series
]



;---- Test Code

vid-block: [
	CMP/A/(b1-proto)   
	CMP/A/(b2-proto) 
]

b1-proto: [b1: button 100x40 "B1 TEXT" CMP/A/(compo-block-b1)]
b2-proto: [b2: Button 100x40 "B2 TEXT" CMP/A/(compo-block-b2)]
with-b1: [extra: 'b2]
with-b2: [extra: 'b1 CMP/C/([text: "B2 Other Text"])] 
compo-block-b1: [on-click [print select get (face/extra) 'text] with CMPO/B/(with-b1)]
compo-block-b2: [on-click [Print select get (face/extra) 'text] with CMPO/A/(with-b2) ]


probe vid-block
vid-block: compose-where/repeat/group vid-block 'A
new-line find vid-block quote b1: on
new-line find vid-block quote b2: on 
probe vid-block
probe vid-block: compose-where/deep/group vid-block 'B
probe vid-block: compose-where/deep/group vid-block 'C
view vid-block

;----- Result:

[
    CMP/A/(b1-proto) 
    CMP/A/(b2-proto)
]
[
    b1: button 100x40 "B1 TEXT" on-click [print select get (face/extra) 'text] with CMPO/B/(with-b1) 
    b2: Button 100x40 "B2 TEXT" on-click [Print select get (face/extra) 'text] with [extra: 'b1 CMP/C/([text: "B2 Other Text"])]
]
[
    b1: button 100x40 "B1 TEXT" on-click [print select get (face/extra) 'text] with [extra: 'b2] 
    b2: Button 100x40 "B2 TEXT" on-click [Print select get (face/extra) 'text] with [extra: 'b1 CMP/C/([text: "B2 Other Text"])]
]
[
    b1: button 100x40 "B1 TEXT" on-click [print select get (face/extra) 'text] with [extra: 'b2] 
    b2: Button 100x40 "B2 TEXT" on-click [Print select get (face/extra) 'text] with [extra: 'b1 text: "B2 Other Text"]
]