Mold the System object

mold-red.red

Red [Needs:	 'View]
system/script/header: make system/standard/header [ ;@@ workaround for #4992
	;system/script/title: ;@@ workaround for #4992 (to be used only in "main" script)
	title: "Mold the System object"
	author: "Marco Antoniazzi"
	History: [
		0.1.0 [18-08-2013 "Done"]
		0.2.0 [16-04-2016 "Fixed unset values"]
		0.3.0 [23-08-2018 "Added 3 dots ..."]
		0.4.0 [26-08-2018 "Added checks actions"]
		0.5.0 [16-05-2020 "Fixed throw(s) by adding <none>. Added undirize. Added history."]
		0.6.0 [19-05-2020 "Red version"]
		0.6.1 [24-05-2020 "Fixed Red version function molding"]
		0.6.2 [11-07-2020 "Fixed init history"]
		0.7.1 [17-07-2022 "Fixed initial tries, added buttons"]
		0.7.2 [26-07-2022 "Use padding and a monospace font"]
		0.7.3 [11-08-2022 "Use compose/deep/only to let have more depth"]
		0.7.4 [15-08-2022 "Renamed help to help-doc to avoid overwriting existing function"]
		0.7.5 [25-09-2022 "Minor aesthetic changes"]
		0.7.6 [26-09-2022 "Changed resizing from global handler to win actor, changed history navigation method"]
		0.7.7 [05-11-2022 "Fixed initial `none` error on some Red versions"]
		0.7.8 [10-12-2022 "Changed resizing from win actor to reactions, removed `compose`"]
		0.7.9 [15-01-2023 "Fixed resizing with updated size"]
		0.7.10 [28-01-2023 "Fixed header initialization (workaround)"]
		0.7.11 [28-12-2023 "Updated to new point2D! View"]
		0.7.12 [23-03-2024 "Transformed into a Mini_edit_do module"]
	]
	Note: {Needs Red 0.6.4 built 09-Aug-2023 or later}

	help: {Instructions:
	"<-" go back in history
	"->" advance in history
	"^^" go up one level
	"/|:|" add selected set-word! to path
	"show" show current path
	}
]

; import
	; this is used for Mini_edit_do.red
	if system/script/args <> "" [
		do system/script/args
		system/script/header/type: type
	]
;
use: func [words [block!] body [block!]][body: has words body body]
could_be: func [:path [set-path!] value][
	if :value [set/any path :value]
]

;focus: func [face [object!]][face/selected: as-pair 1 length? face/text set-focus face]
focus: func [face [object!]][face/selected: 1x1 + length? face/text set-focus face]

mold_obj: func [
	obj [string!] dest [object!]
	/local tried word line result value
	][
	catch [
		if empty? obj [throw none]
		while [#"/" = last obj] [remove back tail obj] ; undirize
		tried: attempt [load obj]
		if error? try [set/any 'obj get/any :tried] [result: "unknown" throw none]
		if not object? :obj [result: mold :obj throw none]
		result: copy "make object! [^/"
		line: copy ""
		foreach word words-of obj [
			line: rejoin [tab pad rejoin [word ":"] 17 tab]
			append line either value? in obj word [
				switch/default word: type?/word value: get in obj word [
					native! op! action! routine! [head remove back tail form word]
					function! [rejoin ["make function! [[...] [...]]"]]
					object! [either check-ob/data [mold value]["make object! [...]"]]
					block! hash! map! vector! [either any [check-bl/data empty? value] [mold value][rejoin ["make " word " [...]"]]]
					word! [mold to lit-word! mold value]
				][mold value]
			][
				"unset!"
			]	
			append line newline
			append result line
		]
		append result "]"
	]
	focus field-name
	dest/text: result
]

history: copy ["system"]
up: [
	history: back history
	could_be field-name/text: copy pick history 1
	mold_obj field-name/text area-obj
]
down: [
	unless tail? next history [history: next history]
	could_be field-name/text: copy pick history 1
	mold_obj field-name/text area-obj
]

sp: 4x4
win: layout [
	title "Mold the System object"
	origin sp space sp 
	below
	check-bl: check "Show blocks, hashes, maps, vectors" off [mold_obj field-name/text area-obj]
	check-ob: check "Show objects" off [mold_obj field-name/text area-obj]
	across
	button "<-" 24 [do up]
	button "->" 24 [do down]
	button "^^" 24 [
		use [path] [
			path: to-block attempt [load field-name/text]
			if (length? path) > 1 [
				field-name/text: mold to-path head remove back tail path
				do-actor field-name none 'enter
			]
		]
	]
	button "/|:|" 40 [
		use [selection] [
			if area-obj/selected [
				selection: copy/part at area-obj/text area-obj/selected/1 area-obj/selected/2 - area-obj/selected/1 + 1
				if set-word? selection: attempt [load selection] [
					field-name/text: append append field-name/text "/" form selection
					do-actor field-name none 'enter
				]
			]
		]
	]
	button "show" 40 [mold_obj field-name/text area-obj]
	field-name: field "system" with [size/x: 400 - (24 * 3) - (40 * 2) - (sp/1 + 2 * 5)] ; FIXME: why + 2 ?!
		on-key [
			case [
				event/key = 'up [do up]
				event/key = 'down [do down]
			]
		]
		[ ; action function
			mold_obj face/text area-obj
			use [code][
				code: copy face/text
				clear next history
				if (last history) <> code [history: back insert tail history code]
			]
		]
	return
	at as-point2D sp/1 + 400 - 24 sp/2
	button-?: button "?" 24 bold font-color blue [area-obj/text: system/script/header/help]
		
	area-obj: area 400x400 font-name system/view/fonts/fixed
]

mold_obj field-name/text area-obj

if system/script/header/type <> "module" [ ; were we started directly?

react compose [
	button-?/offset/x: win/size/x - (win/size/x - button-?/offset/x)
	field-name/size/x: to-integer win/size/x - (win/size/x - field-name/size/x)
	area-obj/size:     win/size   - (win/size   - area-obj/size)
	;if not system/view/auto-sync? [show win]
]

view/flags win 'resize
]; if ourselves

win/pane ; returned from script