Context Navigation

root/viva-rebol.r

Revision 106, 64.2 KB (checked in by shadwolf, 17 months ago)

This new update solve the rendering font problem experienced
with previous viva-rebol.r release. Forced me to loose alot a time to track down this problem in the end this engine is a retrofit engine based on area-tc Steeve's work version 23.

Copy / paste partially broken...

About window has changed

I integrated all the newer stuff around text searching an document and functions navation in this retrofit engine.

Line
1	REBOL [
2	TITLE: "Viva rebol!"
3	auteurs: "Shadwolf, Steeve"
4	start-date: 07/04/2009
5	release-date: 08/01/2011
6	credits: { Carl sassenrath, Steeve, Maxim, Coccinelle, Cyphre}
7	purpose: { IDE for rebol in rebol }
8	Download: http://my-svn.assembla.com/svn/shadwolforge/
9	Docstrack: { docs, source diff and time tracs available on
10	http://my-trac.assembla.com/shadwolforge/
11	}
12	]
13	;print ""
14
15	; utility functions
16
17	sav-pref: func [][
18	;consol_path: fi/text
19	pref/bg_color: b1/color
20	pref/txt_color: b2/color
21	save %pref.dat pref
22	]
23
24	load-pref: func [][
25	if exists? %pref.dat [pref: do load %pref.dat]
26	]
27
28	either exists? %pref.dat [
29	load-pref
30	][
31	pref: make object! [
32	;consol_path: copy system/options/boot
33	bg_color: 0.0.0
34	txt_color: 255.255.255
35	]
36	]
37
38	; LOAD TAB-panel widget Cyphre (TM)
39	do load decompress #{
40	789CBD586973E2B816FDCEAF50577FE86428C7989824506F2695349DADB37496
41	4E4FA09C2A63CBE0C6D8C4368DC9BCF9EFEF5E495E65B2CCAB9AA4005BBAD2DD
42	8E8EAEF45714AF3CF799AA33338A6948868D47253647CADCF4A9D7238E6951B2
43	74E309EBE05D6648CD1E999953CABB79CFA312384E44E31E6925ED9668A2F698
44	0A517CCC441F1577666297179836890365E4FA66B82236B582D93CA4514476F4
45	8F7F35E8D973D8FF76F8DC69FEB8D56767E387ABBED63D39383B884FC79713EB
46	E4B8D38F2EEF9ED4A3969BCCFBBF76AE7E9E2E4757ABB079D3D28FADC99F8DDB
47	6F0FA77BB3FBF1D3D199F7703C0906B3BEDEBCE99EFE6A1F8EBFF6EFC70F27EE
48	FDF2E2707C39681F5EDF256A337A1ADCEB874FB7CF897DF2E5E2A9D171EFBA4D
49	4775FC78767D6D1E4D6EA6D6F5D765D4D793E3D9E0AC3B4816E777E7CFA74F17
50	9FA7AD9B2FC9F27C104C8F0E7FBA17DD4B6B7BFAE3B6D1FC71393BD8BB9AF447
51	30CF73D3695D7C3B595EDEDE3C58BB5F4EA3CF5DB77564FF79D78CC0BC643038
52	39F8BAFB5DBB3EBF98B9FDD1FDFC9BAD37BE3E07CBF3D3D5C21B3C75CD8BE6F7
53	B3B63538BE9C3E9CF8FABDF7BDD554E943AB75A21FDF6996EA6DDF5F7DFEDE3A
54	38D8D54E0F9AD303F8FBBDF17716F40812DD237AA293ACC90ABC20EC113FF0A9
55	6833C4AF4311003CCDF058C85DA3F4F3A884D40ECD258065E15B64E8109350A3
56	200E30000001B61C750ED8F1630561A38E82D0A6E17E4910B4AA0814953A0EB5
57	004B08872002E0D024A6BECD6CDF7054748428446B6D12E600BE6E94A767ED91
58	AA6D1A85F98D3A6525EF8B1110225553C6A169BBA00780AE9176A7BDC53F3A69
59	EBFA565BDFDE6A6FEFBDC72CA31478235D67754B8C27B0038ABB6996023F4E25
60	E1B1104D9159ADDDDA129F0A0E34AD92F1F5AB5546493A0998F266DC507FCC16
61	7D012744F502CBF448E43965C844403AD60444CA19B383A55F690259CFE955C0
62	55789685D594C55464B91E89A8071926A227620F4E602D229E06D7B769B24F1C
63	F84D65945190B0C1A016463B151DAE039E0D51D6B46237F071587956E335ABD4
64	BA900BD949B064B3A15CA9CFA805B1F1D2425D9300173B7F279F98AE72BCDF11
65	6D474DF78499EBE3982012DFCDCA0C76E0C495A12200E868BA684A1282544A61
66	0593DF902D09409C50D4558FB4DB521777013B5B521F2EB9D4D091675A531908
67	68433DD5F129EAE84EB5299D9321268B0CE7D4271BC5286C82739EA7D4B4839F
68	B820BB408C2DD88535A30AB35A3E0B8305C44AEBEC6D693B5DF874C876755CF9
69	DD581FBF8C97EAE227C7568A1F0063A71AE6F706B166C914FDAEF39720A7831D
70	8CD2351DD8927F8023E1977F5E89C98B4BAF48ED9C373323855B3D12870BDE52
71	A01EA4A31EB1CDD864CF0864781D99D31E31C33058463D22A257D9C83826C0D9
72	8F436C3320313B5B6D0DF6A64E879BB104BD28202C441D64E8D3A5CAB5396E18
73	C5C4876D17348DA3FC2975C90F84E97C54E686637A00AA5C927FBBBECB20375F
74	91D94ABCA5AA33C7E4FD2E2F2AF524470F9205EE3C850D2DA6F348CC3FCCC33F
75	33936C9BCA85EB2386FF7C3B28CF62E4560A0B916786D2BE6B14048B2572FA0A
76	254C757B2D0DC92320DE7213380ACA66C1A2F08398E4CC372CC0464BA5B84340
77	FB0B0C6A668AD050988BA79F238B29C2868A2E16373214E15B4EDC98A6120BE4
78	11C80AF9657A0B1223563C73455C3B210EB32E9ECD59260AD49136959323529B
79	271BE60087F28255184367F378B52FEC2EAC3DD854C016A9192012CCA8C41DA6
80	0F21057C71BBE1812D8B0F063E7237A23874FDF107D6802E0D47B05F4E3F90FF
81	9260F413F8049FC4986C32EEF2279610836C485C042EE0907D3E217CF5C8984F
82	2FF335C8328D4561F80A166BE4A151CD0F62552A65F3A1AF741FECE3B891444A
83	0C04E1AF1158F8E8279F41EAAE752255CA025DA733CB0278B05E234ABC4D2182
84	841D13EA94E5D8038AE0894B9B306A061AC10F194DA2ED25DBDB6FD109168680
85	1AD3F5186F67CB0E57417D6E11DAD80B4A5E9B2EAF61320E2A170B355E426F8F
86	540B2B116DDCAF7161B5B014635C8F4D0AC37C8187418F5AA0BAF41578888843
87	04AB343A6CB1F4C806FE6CCA9E3E2AC5FE9A6E991BDF1F711622B613088F7051
88	41DDE999515C0EE127B45D9A8E510F9258136F24E6A61B6629D4B228BD3C2791
89	AA844DE08768EACEDF502CA4A501E7119C2D63CD824CAA34DFDBCA19CE02C1FA
90	36D83CBF112D81A3729328DA0E948505695828305C4DC81F8443A202A4628899
91	9B69D9C139282DEEE0A83B86A8BC8848D30A8328AA348A81DB499B4473445C95
92	B1983EA2ED26DA2ED910956E7B937814F2149A31253B35D067DB51E54099FE3B
93	FC52EB8DA74511232493093581B2F30305475A9D0AAC364B5250DC626D5B697D
94	6524AF72CAEF2F42B36A9A844501323CD265B23522AF2FBDEAFB9A24416E27FF
95	284BFF384788D37D5EABBE3751B5E156FEFF704B50A8B3EEDF499451A60385E8
96	AD44694B65025FE26B2E205E3EDBD4DFFD08C190724EE2B70FC4618CD324A5D3
97	A438D463C8F7457FF5CA2E3D6AA64F901026A816CB06E9A28FAB6682EBC89785
98	5B722F33BE7A7512A45727B083BFE9EA846354A14F0BD34322C16A1B7FE45A75
99	E2DA9438B51E48875B474D2959EAB20332C26B104715672EDCB91CB0AC7A6355
100	719D252271E33581023FC4A583949BF42AA2974AD4F5BF78DFCA6A222CCA3476
101	67E4517F1C4F8AB42BEE71B212B5519C3FBB421348CB2F8AA1469124D3E9544D
102	45B4AAFC7EB2A24BED6185F6895D3C56EC6681E0D19722F1E2222A0808FD42AE
103	DCDCCE9B5352AD9F242DF8D39BF1F202AF8C29121C96803E1D2343D7788D3775
104	6AB266B86033AC6DD8D628F1617D8E44D4AA550C141EFF917995973065A7A088
105	D1BB50C4D45CE2554CABB36AED18F94E614D8C15A87813FC7A43452753A4D130
106	FEFE1F50628086731B0000
107	}
108
109	; LOAD MENU WIDGET Cyphre(TM)
110	do load decompress #{
111	789CB51B6B73DAB8F67B7E85BA3B770237430CE4D12EDD6EC6109A92266D499A
112	B629E3CE1810C6606C6A9BE074BBFFFD9E23C9B66CCB84A477C384C8B2747474
113	5E3A0FE5EF5118D516D45DB5C8C29C53E20D6774143E23839D6F357B615A3468
114	119F8E5723CABABED55EE260329C5B646D875342C71665FD8E678EC9F1E1EF7F
115	DB9FDAEFAFD6F5B76796A7C3CFBBEB9B69F7C68256BB87CFD71DFD161F3EFFF0
116	8EBE6047FB6CDCFE78D3D5F58BB3F7930FE1D5CE7C0DBD9DF6ECFAF5F93B787D
117	7CDED775AB77A9EB1F5C0D5EE8C7F07AFC11BEDE2F11ECB103E35F37F7BE7CFF
118	EADE20C09DE6DCE9F63F5D1DBA67172F34ED85A6FFB8D1FB7A27B27A33FFD38B
119	BDABAFE7DF17E1B43B5B4DA7B06AD7BABE3A773AEFDAD7FE7BC07074D5DDB1E7
120	776BC4D25B2EDB00BBFBEE1656F7ACC08AACAF67572BBDD9A6BDC6E7B6ADEB6F
121	BAD6FCC5E91B5B3F8F2EBFF6FBD142BFA6D6E71D58EDEAF8C7CDF2EB25ECA0D3
122	D1DFBEE95E754EEFDF74FA7AB7FBEEA67376DFD1BF9FDDF6FBFA69FBEEF6D68F
123	AE7A17BADEEB0DDB9DE69DFEFEEDCE17EB6BEFB6F7767D7EEE0125EF69AF1FE8
124	EDB61E5993FAE5349AF5828B4B86E17A31E97FBC9E863F7AFACDFBFACCBA38EF
125	996DA0FBCE6D70F5E58D7DE67EE94CFBFDD7A3D3C6C58B8B2BFDB2DB7D7D7C7A
126	AD03B5FBB7FAC5DC72BF1EDE6B07EDBECE5873F3E9FDD5DBA3CE6DAFF7EA1F89
127	D9A3291DCD413CFCF9969CD6D9578F73FAB47BFAFCF8E2DFE1F44D3DE6F4F97C
128	4FDFEBAE7AB0F41A609DBE99CED7FDB6A5B7EDFECAB4AE0F7B20017A74DBB7EC
129	B707CF3F009C7EFFEDF4F38ED75D74901A97D7AF7FD43B9FDAC8ACB3CBCE9ED5
130	EDB65FB70F6F75ABDFEF358EEE74EB3540EEEA7BF3E0CB878F079ED6EE3292ED
131	E46966C06F10DE3BF60FAA2DCC20A4BED01BAE6313131489290EEFFD561B798E
132	E7B788EBB954F44C3C3714DA88CD64643276E898A379D2E94D26018509F5A89E
133	F4055373ECAD33500DF117155640C7A6043D009C5BA41135F2EB359E37F71BC7
134	2FF61B4707DF6A39706BCF1F838948A18CCDD0240397AE356CC18E6D3F08894B
135	A39098BE15A42D2399623ACBA92981F856C3E9ACB7305F1A04066A42827BA0F1
136	421BAE6C678C2B52F22769366AE7A65B6BD6EB8719A839C8CDA323522324E9C9
137	8C34A4A70C62793C8C1C41BC498617410838B5083029E5376C8A711824A236C9
138	304960164F9E50EAC492004D69333EE5DC9AACDC11190019E069CF90374B41C8
139	40F896A6ED9F90898603C84034B4A895B4C81E9F0C2D79CFF1D078603C4C1E13
140	4CBD35991428912388EDDA612B2BC42D62BAF764C0C48B6D3F850A2C75BD90F0
141	57032180CD83E3FDE6C1C17EB3719C8E5C9A2E6037F2960029ED659445B5497B
142	3C9F9A2350389B0C0DC2C553DA84ED06D40F4968DA0E419082DCE688E6642704
143	D6B7889DE9E3CA243130A337857E3835F93BE9503DFC63BF513FDE6FFCF13C47
144	098EBB1B1666ACA73688393302C5D1B1B8A0DD301DDB725B64D7A193303B7269
145	FAA618894D80E99BCB13344F4E003E806F5B364C6C46F5EC342E1087D1214883
146	45C35AC84408D7B271C5CCD8D82C813E64FAB9551812FCC9625F2AEC02E01DF5
147	5381378967E44730E9311D986A82D4C2C628500F39A9312DCCF571F55300E1B6
148	5A0315A321CC4184156354C0346F19DA9E1B2858BF6152B85872ABA10629E858
149	59DBAE202AE873153850A9470DF25FA19F553065F5E870DB353927033AF2DC31
150	0940EE4FD4AB732563D695D9AB7887822E894CEE7285CDC2803EB28BD231D1D8
151	41B6CB0D7D7610EB33B6C55B9C29654CE1164931B130B6B8E244136ABBB4C1DB
152	9968A9B292E2527C47B91992B62AA6E4ACA51A0DEA5AA6456531A70A090DC083
153	008B661674842998B776952FF2241547139A5BC50B0500159756CB92B5401555
154	3AA81E0C16C99BE715945963DB1DD3088413FEAA5E8324536722AC066F0F5468
155	E2671BAD8E1905F82C574B0D740EC8A9996BF35E2956ADD2D342FE240AFECBBA
156	2C84447DEAC89FB2132823289B7549880C3B53F2C63D4356738426A1852702B0
157	2B4B27D079F6B67476A981798C7979BC71119C2E5A41C4A7743CC8346C50B89C
158	77365D935D90135CA9A63CB232847CE078933F78368E1C2FA0357A077B41FF9A
159	3D96EF84CF015FC61ED393C47C2003180483B75FF1270D1F1E82B5F4BD110D82
160	9AB70A1128C74405F90138F8B3721D00C59578B080839C84F68212148D3B5471
161	D198D37BC2AC5730F23DC7A93936F84302E5F07E097230454C986A3E843EFEB0
162	990F8C7B900CDEB236A6211D852DE0E153362F1C71C11B92CE7E5004721018F9
163	64B128210DF723C980A3B8C51AC6D698288542DAD2368BFD0243CADF95BD3118
164	D56ADC8E174EDFF8B336EDB0FCDC509E9ACC53564E508129F6E57BB2CFF293DC
165	16A74888274623AAC3895129F1C6C12456AB85D0EC5BEDE543364F0C38AED7A3
166	669A504093A5F1A093B0539687E5B17DE6FD6C621232C47F172B27B485E5636D
167	49DA26B643333665E8CC334A0516973957D04F1A393165ECE087184B49719460
168	A4927859B40C96AA81AF8470311AEC7510FAECAF961E7C136F38C3497C804FC3
169	95EFB22DB3C050E107A003844A9E49E70C672067312A22E152879F887D8B7E1E
170	69C638705459582D7248299ECC0B49CEEFF8EC640F041E44EF24CE56404BF42D
171	CD702A3A97A2C55D23DE74BC91E9B0E65D92E0F55760C4590BED329F0381E842
172	38D7E355DC0A5643DE630727AC319ACE79C35E58ECEFD0F44547B8607FC1F2B3
173	BF3402591CF377AE07E6920F172C8D43C9241309188340C95CC1E76C5200D8C0
174	3616B305741942DC847004B605C76BE0C1793440C0102F7B2EA960536BE0C304
175	1CB49F04BD4614C2219066FE8C543818EC010055783FB79706093D42DD315F98
176	E076EC30E16192DB40DA275282BB0CB2181B29E15BE4203A48C99BA65114C1F0
177	D843E72476C2B82E9818976C769D779937B28B001F31CBC41457925254052DBF
178	860E07F92884A84C3D2E982AF7BCE03C6F4CC0629E2A3172D4013700F52A753B
179	8DE4D478446E67DBAC4E2E7768A4CA9718F0ACDDFFEDF237C277AE2529B08CD0
180	81AEC7B2561766881D29A9962BD4834AF95DAE278951455A0C7641D1CDA14349
181	0535BE45427F45AB06A3D380E5F976E1B4421B205E8136EDD6E21E768E560D31
182	1CB50C8C0419B0D2D33318892704FE45FC9FC5C376C180900A5A91643536335C
183	A0D5B45DEB191FF73BEB46B75274C7F3C144910A33300900AEFB0916C21211BE
184	6134093F992D90314DED81412AD2A1C3625926B43CAB08946F908A8864719DAA
185	34384E59A1809C24CBB22E84CF90348C814853E26C8E471604235AE674147C67
186	843C89896A89A3125A598783BD0A3D5EF293B5466887E553EA92547738DC1683
187	4B2713748F4129C08B4A8A08E09B3051355E368E23396F9BF568004D9040ED1E
188	629383FC0EA4CC2CB7EC04F896D169F2127A588D0A9F732E15FAC580557C1CC9
189	9B15B86379536BBC64E2CEAB214390217349FE634D2216E2EF2F5D2B373BDEEE
190	C85B2CC117073F3B0AC1E813166B8283432A65468347A8CDA323A3CA13DCE835
191	958E96B2E3D5BCB7581EDE97E606D4E97289090119A439DB20DCCE218599A886
192	1B3807E4D7F27975C2EB8A63EAD80BB057BE9A710058BD6DA91EB5EDEE13574B
193	AA6E091396E6A9C18F06A7B774DF19F73B9F9FE1C6281F156448554A146EB213
194	B2E06306B6A047B19F5724C2450E4975E2DDF73CF42A73DA90398B44A089669C
195	0C061299659283319226955720BC7C098208F649B3B5E653EA12982B83238599
196	1730331008E51444442251B31819C11191A90E31A9111A1D47EA92C92C0820D3
197	796D4CE9920CC6BEB9164715BA4360E2175695D4F741C3F7EB464E81F2A0C462
198	780A2AC2EF0C6C0CF184B16A9680572C80BE65410FCAB51A04741C0903B14C82
199	03C1D6C79666088F20C88C848B25FE7AF815E0976D902C150B68C3A0B2F89A1F
200	6A35FA7D653A2719416AC822AACC673C2ABFFFA40C7F31CA57E6FCE532154FBE
201	A36A663CDB3809FA0A5E025BD4099AF2792D3EAD300742928A0A12F4CFD2AA73
202	EE4D5C3F75B96CB08045890FC12F803303ADCB5BD9FCCE2B0E78F8E1F484235A
203	257FBE2249975B65647193DD6FCCAC7307AE74048421C9415D0107074C638DF9
204	C2E2C89D79109E0C7621F0406292DD4CEE1A3D6003F1C97B5CD98F4F594ED30C
205	057166A52319756AA5D4512D414A324A55456745D127EC4CD6A1243CBC050AB3
206	9D95E4FF4AD3829BC98E32A3F1B43F999448221B97C4C9998D0D54BD6011D5DD
207	6A188AF594F42A2D5DA1D92AABA115B44E594C2D8CDA504A2D8C55153F846F28
208	46F3334B7889E8472A0AADEA19B19F5A26CF42602A251B65374614EF44910B5E
209	436CC7E3F624F89732B0E08F6385AB4AFE22F50D69676081642294B44410F994
210	60414C3DB55993463063A95C406B8AE23BDBF231D90CC756C249A8B261726C60
211	6D7ECBA9049B8D3B4DB8868800B2B68CB91DF3ED2FF2105F1E5824DE285BA526
212	AF524B567900403AA7C5FD8274261279E3EC8DE51625F03DEE76D41E02BCF12D
213	1792ADF6C7252E4563C3E027D432CAB7AF7205124A3C412CCB5040B5E47BE492
214	C4BF379A3C38DB376A7A2AFD4F117C99E319A1378781E7AC42CAE4E0D1A4FE05
215	8A72992B5FF297CE8F47B24B5C87C983528EDED2C9D85CB7FA3F5E6099C49536
216	F022CA2E9EB03B26E25E49DEE530480A41EDBCB15B1D83CDA3B62FD32519371E
217	3DE7E6C57724A452D79DE9AC681C28452C32F5E154264A874DE5A2257EADCAB3
218	D9E0EA32D7B6D4DB85D80FFDDDE28D8D2D02CE38B0F35CE75E89166C92DF81D6
219	3077A118C0D3CF6C448953C4CA354A09CEE5A6B39F48DC39DDDD63E96783D1BB
220	126189870B2344A31313738CD047067B301206D57082610CA04FE970E3E72789
221	5AB9B21082C0B250E90CAC16A9B550949054CAA85415520119C92F14D7DAD574
222	5CC48A9248E12F887D2E1988B9F6C7E602C14AF9E1681516135F49EA2BAE0FA6
223	9FF20CE813EFB666925752112549812B2EDC6E4838F2DC5C116F6EEB9B8AD414
224	922E5FBC493FE2F0B96FF174791EF55C82262DC6AA39086B15B0CE7172B3FD79
225	98ABA6EFC3E153CE52F67E6BA696D239CEDD0DF87AF5FDE7F00B1FE27BEC5CF8
226	A3C0E64285E25FA474194DE3320FC6DFAEA1222DB7A18CBE3CA9A04CCCB14A13
227	D697E25889D79AF68863825F961FAD28A8F0407412B00B0149448A28629A9B9D
228	1808B25E128C4A858A5D9E5E4DF5261B84A605906DEEB6F0DB9095B20CAEB44C
229	55B67D80774148784D32D7C9CA5DB93E5E8FCC750A4615FA45ED30D39B629231
230	F0F11E25C3CEBBC41D92F412C30EBBE4C13204995B1EE9058FF45E867C3323BD
231	1921DFCDE0D1C84E725067FE312577BBE0A1A23262A03552BB943AED99FFA7B0
232	852B5B6902F7D81278B735E3D8DAB21F2B7BEF7238920BA3EEF3C3EFE597B082
233	ACA8316A33B194FC0F4EDCEB9C891B73123B8BC7D62C1358A4898F38807E8040
234	79F1CE5F8A5253AAD26477BA18373653EE49BB44B5891369E93EE37F084A7659
235	93B0D222BC8C7CA8DC1378B5CCE66E41B81A99A54D01B8042696F69F80E28B52
236	24C4202067732BD6487628BE646727D7B20587528E714B85025B2DAAB6505CE9
237	F69674D5077ACCF13873A72BBDFD1697FB714A72A52D003F4943CBA2C141A2A1
238	B30D5E5D6C99F9D04301C9244363202209FC77431B040804940CD96F930C307B
239	8BB782C12732E21B663C8F5D82914872B36B38325AB011E325D6BFBD0989FF97
240	78E79FFF0120649CE6573C0000
241	}
242	; END of ctx-menu
243	area-tc: context [ ;** global context
244
245	colors: [
246	char! 0.180.40
247	date! 0.120.150
248	decimal! 0.120.150
249	email! 0.200.40
250	file! 0.200.40
251	integer! 0.120.150
252	issue! 0.180.40
253	money! 0.120.150
254	pair! 0.120.150
255	string! 0.180.40
256	tag! 0.180.40
257	time! 0.120.150
258	tuple! 0.150.150
259	url! 250.120.40
260	refinement! 160.120.40
261	comment! 255.150.0
262	datatype! 225.0.200
263	function! 0.255.255
264	native! 255.255.0
265	action! 0.255.255
266	error! 255.0.0
267	multi! 0.180.40
268	free-text! 0.0.200
269	]
270	insert tail colors compose [ block! (pref/txt_color) default! (pref/txt_color) ]
271	;func-list: make string! 5000
272	;foreach fun bind first system/words system/words [
273	; if all [value? :fun any-function? get :fun][
274	; insert insert tail func-list #" " form fun
275	; ]
276	;]
277	;**print length? func-list
278	multi-chars: complement charset "^^}^/^-" ;** to detect end of rebol strings
279	save-color: color: start: end: out-style: x:
280	str: type: f: value: multi: grow?: none
281
282	;** markers used in replacement of the draw comman PUSH. Much easy to track them.
283	expand: ;** marker for info messages (like errors)
284	hilight: 'push ;** marker for hilight background
285	no-edit: edit: 'aliased
286
287	edit-mode: none
288
289	abs-x: 0
290	;** rule to output draw dialect
291	gen-draw: [end: (
292	str: copy/part start end
293	unless tail? str [
294	color: any [select colors type color select colors 'default! 0.0.0]
295	either save-color <> color [
296	out-style: insert insert insert insert insert out-style
297	'pen color [text edit] as-pair x * f/x + f/xy/x + f/origine-x 5 str
298	][
299	insert tail pick out-style -1 str
300	]
301	if type = 'error! [
302	out-style: insert/only insert out-style 'expand
303	reduce ['pen red 'text 'vectorial as-pair x * f/x + f/origine-x 5 + f/y reform [value/id value/arg1]]
304	]
305	x: x + length? str
306	save-color: color
307	if type = 'error! [grow?: true]
308	]
309	)]
310	tab1: next tab2: next tab3: next tab4: " "
311	what: none
312	gen-tab: [(
313	what: pick [tab4 tab3 tab2 tab1] x // 4 + 1 ;** align tabs
314	out-style: insert insert insert out-style
315	[text edit] as-pair x * f/x + f/xy/x + f/origine-x 5 what
316	x: x + length? get what
317	save-color: none
318	)]
319
320	spaces: exclude charset [#"^(1)" - #" "] charset "^/^-" ;** treat like space
321	braquets: charset "[]()"
322
323	;** rule to detect rebol values (uses load/next)
324	;** (heavy, because we handle errors too)
325	rebol-value: [skip (
326	error? set/any [value end] try [load/next start]
327	either error? :value [
328	value: disarm :value
329	either value/arg2/1 = #"{" [
330	end: any [find start newline tail start]
331	type: 'multi!
332	multi: case [
333	multi < 2 [3]
334	multi = 2 [4]
335	'else [multi]
336	]
337	][
338	end: skip start length? value/arg2
339	type: 'error!
340	]
341	][
342	case [
343	path? :value [value: first :value]
344	all [word? :value value? :value][value: get value]
345	any-string? :value [
346	if find/part start newline end [
347	end: find/part start newline end
348	multi: case [
349	multi < 2 [3]
350	multi = 2 [4]
351	'else [multi]
352	]
353	type: 'multi!
354	]
355	]
356	]
357	type: type?/word :value
358	color: none
359	]
360	) :end
361	]
362
363	no-tabs: complement charset "^/^-"
364	gen-to-end: [any [some no-tabs \| end: tab :end gen-draw some [tab gen-tab] start:] gen-draw]
365	any-char: complement charset " ^-"
366
367	set 'colorize func [
368	face line out
369	/local check-multi check-free-text orig lvl-start lvl val cont pline pos
370	][
371	color: save-color: grow?: none
372	f: face
373	x: 0
374	orig: out-style: out
375
376	;** multi = -1, free text before REBOL header
377	;** multi = 0, code not parsed
378	;** multi = 1, normal code
379	;** multi = 2, end of multi-line string
380	;** multi = 3, begin of multi-line string
381	;** multi = 4, full multi-line string
382
383	lvl: lvl-start
384	multi: case [
385	head? line [-1]
386	2 < val: first pline: pick line -1 [4]
387	val = -1 [-1]
388	'else [1]
389	]
390	lvl: lvl-start: either pline [pline/3/2][1]
391	line: line/1
392
393	check-multi: either multi = 4 [none][[end skip]]
394	check-free-text: [(cont: either multi = -1 [none][[end skip]]) cont]
395
396	;**all [char? line/2 print line]
397	parse/all line/2 [
398	start:
399	check-free-text "rebol" any #" " #"[" (multi: 1) end skip
400	\| check-free-text (type: 'free-text!) gen-to-end
401	\| opt [
402	check-multi start: some [
403	some multi-chars
404	\| #"^^" [skip \| end]
405	\| end: tab :end (type: 'multi!) gen-draw some [tab gen-tab] start:
406	\| #"}" (multi: 2) break ;** end of multi-line
407	\| break ;** newline
408	]
409	(type: 'multi!) gen-draw
410	]
411	any [
412	start: [newline \| end] break
413	\| some spaces (type: 'blank!) gen-draw
414	\| tab gen-tab
415	\| [#"[" \| #"("] (type: 'block! lvl: lvl + 1) gen-draw
416	\| [#"]" \| #")"] (type: 'block! lvl: lvl - 1) gen-draw
417	\| #";"(type: 'comment!) gen-to-end
418	\| rebol-value gen-draw
419	]
420	]
421
422	line/1: multi
423	line/3: as-pair lvl-start lvl
424
425
426	f/h-scroller/max-x: max f/h-scroller/max-x x * f/x + f/origine-x + (f/x * 10)
427	f/cursor/len: x
428
429	case [
430	empty? orig [ ;** if the text contains no chars, add a dummy line
431	append orig compose [text edit (as-pair f/origine-x + f/xy/x 5) (copy "")]
432	]
433	not same? back start find/reverse start any-char [
434	insert insert insert tail orig
435	[pen blue text no-edit]
436	as-pair x * f/x + f/origine-x + f/xy/x 5
437	"�"
438	]
439	]
440	grow? ;** notices if it's a simple line or a double-size line
441	]
442
443	;** cut text into lines
444	set 'build-data func [
445	text f /local out
446	][
447	out: f/data
448	clear out
449	parse/all text [any [pos: (out: insert/only out reduce [0 pos 0x0] ) thru newline]]
450	f/origine-x: f/x * (1 + length? to string! length? head out)
451	recycle
452	out: head out
453	]
454
455	]
456
457	;** boxline: [pen red fill-pen red box 0x1 32x18]
458
459	;** debug: display where show occurs
460	;show: func [f][print either in f 'cursor ['area-tc]['cursor-only] system/words/show f]
461
462	;** markers used in replacement of the draw comman PUSH. Much easy to track them with parse.
463	expand: ;** marker for info messages (like errors)
464	hilight: 'push ;** marker for hilight background
465	no-edit: ;** marker for text no editable
466	edit: 'aliased
467	render-text: func [
468	f inc
469	/stay
470	/local pos char color draw-txt
471	prev-col draw-sblk nb line data n decal
472	][
473	;start: now/precise
474	prev-col: none
475	case [
476	stay [
477	inc: inc - 1
478	data: skip f/data inc
479	]
480	inc < 0 [
481	inc: negate min abs inc ((index? f/data) - 1)
482	data: f/data: skip f/data inc
483	]
484	inc > 0 [
485	inc: min max 0 ((length? f/data) - f/nb-lines) inc
486	data: f/data: skip f/data inc
487	]
488	'else [data: f/data]
489	]
490
491	draw-txt: any [find f/effect/draw 'push tail f/effect/draw]
492
493	case [
494	stay [
495	draw-txt: clear skip draw-txt max 0 inc * 4
496	nb: min f/nb-lines f/nb-lines - inc
497	]
498	empty? draw-txt [
499	nb: f/nb-lines
500	]
501	inc > 0 [
502	remove/part draw-txt 4 * inc
503	draw-txt: tail draw-txt
504	nb: min f/nb-lines inc
505	data: skip data either f/nb-lines > inc [f/nb-lines - inc][0]
506	;** A FAIRE, si inc d�passe le nombre de lignes affich�es,
507	;** parser les lignes skip�es (non affich�es)
508	;** pour d�tecter les strings multi-ligne
509	]
510	inc < 0 [
511	clear skip draw-txt max 0 4 * (f/nb-lines + inc)
512	nb: min f/nb-lines abs inc
513	]
514	'else [return true]
515	]
516	nb: min nb length? data
517	n: 1
518	decal: as-pair 0 f/y
519	while [n <= nb][
520	line: at data n
521	draw-txt: insert draw-txt 'push
522	draw-sblk: insert insert insert make block! 50
523	[hilight none pen 128.128.128 text no-edit] as-pair f/xy/x 5
524	reverse copy/part reverse head insert change clear "" " " (n - 1 + index? data) (f/origine-x - f/x / f/x)
525	if colorize f line draw-sblk [
526	decal: as-pair 0 2 * f/y
527	]
528	draw-txt: insert insert insert/only draw-txt head draw-sblk 'translate decal
529	decal: as-pair 0 f/y
530	n: n + 1
531	]
532
533	set-y f 5 ;** recalc all y offset of texts (which can be absolute only)
534	unless f/cursor/selection? [show f]
535	;** probe difference now/precise start
536	]
537
538	set-y: func [f y /local blk pair line idx gb lgb chg-y][
539	blk: f/effect/draw
540	blk: find f/effect/draw 'push
541	lgb: index? f/data
542	gb: f/cursor/global-idx
543	idx: 2
544	f/cursor/show?: false
545	chg-y: [thru 'text ['edit \| 'no-edit] pair: pair! (pair/1/y: y)]
546	foreach [cmd value] blk [
547	switch cmd [
548	translate [y: y + value/y]
549	push [
550	if gb = lgb [
551	f/cursor/xy/y: y
552	f/cursor/data: at blk idx
553	f/cursor/show?: true
554	]
555	parse value [
556	any chg-y
557	any [thru 'push into [any chg-y to end break]]
558	]
559	lgb: lgb + 1
560	]
561
562	]
563	idx: idx + 2
564	]
565	]
566
567	move-x: func [f x /local blk pair chg-x][
568	blk: f/effect/draw
569	blk: find f/effect/draw 'push
570	chg-x: [thru 'text ['edit \| 'no-edit] pair: pair! (pair/1/x: x + pair/1/x)]
571	foreach [cmd value] blk [
572	switch cmd [
573	translate [x: x + value/x]
574	push [
575	parse value [
576	any chg-x
577	any [thru 'push into [any chg-x to end break]]
578	]
579	]
580	]
581	]
582	f/cursor/xy/x: f/cursor/xy/x + x
583	]
584
585
586	;** return the inner face matching the point
587	map-inner: func [face point /local pane][
588	unless pane: face/pane [return face]
589	unless block? pane [pane: to block! pane]
590	foreach face pane [
591	if within? point face/offset face/size [return map-inner face point - face/offset]
592	]
593	face
594	]
595
596	get: func [v][do back change/only [none] v] ;* if v is a word, get value in the world
597	any-char: complement space: charset " ^-"
598
599	context [
600	origin: off-mem: save-size: 0x0
601	drag: track: false
602
603	;** find a free place in the whole area to display the info box
604	find-free-places: func [
605	f
606	/local data end x len l-len r-pos stack-l stack-r
607	][
608	stack-l: clear []
609	stack-r: clear []
610	data: f/data
611	loop len: f/nb-lines [
612	line: data/1/2
613	end: any [find line newline tail line]
614
615	;** length of the left free zone
616	pos: any [find/part line space end line]
617	l-len: -1 + index? pos
618
619	;** start of the rigth free zone
620	pos: ant [find/reverse end any-char end]
621	r-start: index? pos
622
623	stack-l: insert stack-l l-len
624	stack-r: insert stack-r r-len
625	data: next data
626	]
627	x: maximum-of stack-l
628	loop len [
629
630	stack-l: next stack-l
631	]
632
633	]
634
635	insert-event-func func [face event /local tmp][
636	;print [event/type event/key]
637	switch event/type [
638	time none ;** a lot of time events are sent, check it first
639	key [ ;** key handler for faces without text and caret (actually only for areat-tc)
640	if event/1 = 'time [return event] ;** FUUUUUCK, why we receive that crap event here ???
641	if all [
642	tmp: system/view/focal-face
643	in tmp 'style
644	tmp/style = 'area-tc
645	][
646	tmp/feel/engage tmp 'key event
647	]
648	]
649	move [
650	either drag [
651	tmp: track/offset
652	drag/feel/drag drag event/offset - origin
653	origin: origin + track/offset - tmp ;** correct the origin, if the tracked face has moved
654	return false ;** disable move event
655	][off-mem: event/offset ] ;** for mouse wheel motion
656	]
657	resize [
658	tmp: negate saved-size - saved-size: face/pane/1/size
659	foreach fa face/pane/1/pane [
660	if in fa/feel 'resize [fa/feel/resize fa tmp]
661	]
662	]
663	down [
664	face: map-inner event/face event/offset
665	if in face/feel 'drag [
666	;** the draging face which contains the pointer may be different from the draged (track) face
667	drag: face
668	origin: event/offset
669	track: drag/feel/drag/track drag event/offset
670	]
671	]
672	up [drag: false]
673	scroll-line [
674	face: event/face
675	face: map-inner event/face off-mem
676	if in face/feel 'scrollwheel [
677	face/feel/scrollwheel face event off-mem - win-offset? face
678	]
679	]
680	active [saved-size: face/pane/1/size]
681	];[print [event/type event/offset]]
682	event
683	]
684	]
685
686	;scroller function
687	scroll-panel-vert: func [pnl bar][
688	pnl/pane/offset/y: negate bar/data * (max 0 pnl/pane/size/y - pnl/size/y) show pnl
689	]
690
691	key-to-insert: make bitset! #{
692	01000000FFFFFFFFFFFFFFFFFFFFFF7FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
693	}
694
695	stylize/master [
696	; list of function widget
697	func-view: box with [
698	edge: [ size: 1x1 color: 'black]
699	;offset: 0x0
700	;delay: 0
701	current-line: 1
702	tmp-data: []
703	pane: []
704	;effect: make effect [ draw: []]
705	create-list-data: func [f /local n nblines line dt rule ] [
706	n: 1 nblines: length? f/data
707	clear self/tmp-data
708	dt: head f/data
709	while [ n <= nblines ] [
710	line: second dt/:n
711	; on ne prend que du debut de la ligne jusqu'au premier newline
712	;ou jusqu'a la fin du buffer.
713	line: copy/part line any [ find line newline tail line ]
714	; example donn� par Steeve
715	; parse t [ some [ copy str thru ":" "func" (print str) \| thru newline ]]
716	rule: [
717	some [
718	"set" "'" copy tmpstr thru " " [ "func" \| "function" ]
719	(unless find tmpstr ";" [ insert/only tail self/tmp-data compose [(tmpstr) (n)]])
720	\| copy tmpstr
721	thru ": " [ "func" \| "function" \| "make function!" \| " does" \| "use" ]
722	( unless find tmpstr ";" [ insert/only tail self/tmp-data compose [(tmpstr) (n)]] )
723	\| thru end
724	]
725	]
726	parse line rule
727	n: n + 1
728	]
729	;probe self/tmp-data
730	]
731	feel: make feel [
732	resize: func [f size+][
733	probe "resize event de la liste /My Funcs/ "
734	f/size/y: f/size/y + size+/y - 5
735	]
736	detect: func [face event] [
737	switch event/type [
738	scroll-line [
739	scrl/data: either event/offset/y > 0 [min 1 scrl/data + .05] [max 0 sscrl/data - .05]
740	scroll-panel-vert bx1 scrl show scrl
741	]
742	]
743	event
744	]
745	]
746	render-list: func [ /local dt n nblines line ind lay ] [
747	dt: head self/tmp-data
748	n: 1
749	nblines: length? self/tmp-data
750	lay: make block! [ origin 0x0 space 0x0 backdrop white]
751	;self/data: make block! []
752	while [ n <= nblines ][
753	insert tail lay compose/deep [ text (first dt/:n) [ t/goto-line (second dt/:n) ]]
754	n: n + 1
755	]
756	;probe lay ; halt
757	bx1/pane: layout/offset lay 0x0
758	; support du scroller attention mode boucherie
759	scrl/data: 0
760	scrl/redrag bx1/size/y / bx1/pane/size/y
761	show self
762	]
763
764	draw-list: func [ f ] [
765	;1) construit la liste interne des donn�es [ "toto" 6 "titi" 14 etc.. nom-function indice_ligne]
766	;2) dessine a l'�cran les entr�e que l'on peut affich� uniquement
767	create-list-data f
768	render-list
769	recycle
770	]
771	append init [
772	insert self/pane layout/offset compose [
773	origin 0x0 space 0x0 across
774	bx1: box white (as-pair self/size/x - 15 self/size/y )
775	scrl: scroller (as-pair 15 self/size/y) [ scroll-panel-vert bx1 scrl ]
776	] 0x0
777	bx1/pane: make block! []
778	]
779	]
780
781	; arec text color
782	area-tc: box with [
783	style: 'area-tc
784	rate: 1
785	text: none
786	para: make para [origin: 0x0 margin: 0x0]
787	delay: 0
788	ask: 'recycle ;** command to delay
789	color: pref/bg_color
790	x: 8 ;** current x size oh 1 char
791	y: 18 ; ** current y size of a line
792	origine-x: 3 * x ;** stock la position a la quelle le texte d�marre apres le rendu des num�ro de ligne
793	data: []
794	fnt-sz: 14
795	font-obj: make face/font [ name: "Lucida Console" style: none offset: 0x0 size: 14 align: 'left valign: 'top ]
796	nb-lines: 0
797	xy: 0x0 ;** scroll offset
798	move-offset: 0x0
799	effect: [draw [pen none font font-obj line-width 0 translate xy]]
800	open-file: func [ file [file! none!] /local ][
801	if any [file file: first request-file][
802	;** data: build-data detab/size read file 4 self
803	data: build-data read file self
804	render-text/stay t 1
805	feel/inc-font-size self 0 ; on replace le curseur apres chargement du fichier
806	l/draw-list self
807	]
808	]
809	new-file: func [][
810	file-name: none
811	data: build-data "" self
812	render-text/stay self 1
813	feel/inc-font-size self 0
814	]
815	write-file: func [/local str-tmp n line nbline dt] [
816	dt: head data
817	str-tmp: "" n: 1 nbline: length? dt
818	while [n <= nbline ] [
819	line: second dt/:n ; on transfert le pointeur vers le document dans data vers un autre pointeur
820	append str-tmp copy/part line any [ find line newline tail line] ;on copy jusqu'a newline ou jusqu'a la fin
821	append str-tmp newline
822	n: n + 1
823	]
824	write file-name str-tmp
825	]
826	save-file: func [/local dt ] [
827	dt: head data
828	if 0 <> length? dt [
829	either none? file-name [ ; data is full but we don't have a file-name
830	if file-name: request-file/save/title "Save as..." "save"
831	[
832	if block? file [file: first file]
833	write-file ]
834
835	] [
836	; data is full and we have a file name
837	write-file
838	]
839	]
840	]
841	run_scr: func [] [
842	save-file
843	;call/console rejoin [ pref/consol_path file-name ]
844	launch file-name
845	]
846	search: func [ f-what [string!] /local dt n nline line str-tmp move-to current-line ][
847	current-line: index? data
848	str-tmp: ""
849	n: 1
850	dt: head data
851	nline: length? dt
852	while [ n <= nline ] [
853	line: second dt/:n
854	str-tmp: copy/part line any [ find line newline tail line ]
855	if find str-tmp f-what [
856	either current-line < ( n - 1 ) [
857	move-to: n - 1
858	;current-line: n - 1
859	render-text self current-line
860	][
861	move-to: n - ( current-line + 1 )
862	;current-line: n
863	render-text self move-to
864	]
865	break
866	]
867	;probe n render-text self (n - 1) break ]
868	n: n + 1
869	]
870	]
871	search-next: func [ f-what [string!] /local str-tmp dt n nline line move-to current-line] [
872	; l'id�e c'est de se servir de la position ligne courante
873	;
874	current-line: index? data
875	n: current-line + 1
876	dt: head data
877	nline: length? dt
878	while [ n <= nline ][
879	line: second dt/:n
880	str-tmp: copy/part line any [ find line newline tail line ]
881	if find str-tmp f-what [
882	;probe str-tmp
883	move-to: n - current-line
884	;current-line: n
885	render-text self move-to
886	;probe reduce [n current-line move-to ]
887	break
888	]
889	n: n + 1
890	]
891	]
892	search-prev: func [ f-what [string!] /local str-tmp dt n nline line move-to current-line ][
893	current-line: index? data
894	nline: 1
895	dt: head data
896	n: current-line - 1
897	while [ n >= nline ][
898	line: second dt/:n
899	str-tmp: copy/part line any [ find line newline tail line ]
900	if find str-tmp f-what [
901	;probe str-tmp- 1
902	move-to: n - current-line
903	;current-line: n
904	render-text self move-to
905	;probe reduce [n current-line move-to ]
906	break
907	]
908	n: n - 1
909	]
910	]
911
912
913
914	goto-line: func [ line-gt /local move-to current-line][
915	current-line: index? data
916	either line-gt > current-line [
917	move-to: line-gt - current-line
918	current-line: line-gt
919	][
920	move-to: negate current-line - line-gt
921	current-line: line-gt
922	]
923	;probe move-to
924	render-text self move-to
925	show self
926	]
927
928	v-scroller: make face [
929	offset: 0x0 size: 13x0 color: none edge: none
930	size-box: 0x0
931	para: none
932	effect: [draw [pen sky line-width 2 fill-pen none box 0x0 size-box 2]]
933	feel: make feel [
934	redraw: func [f a /local p l][
935	if all ['show = a p: f/parent-face 0 < l: length? head p/data][
936	f/size/y: max 25 p/nb-lines / l * p/size/y
937	f/offset/y: (index? p/data) / (l - p/nb-lines) * (p/size/y - f/size/y)
938	f/size-box: f/size - 2x2
939	]
940	]
941	drag: func [f offset /track /local coeff][
942	f/parent-face/delay: 3 ;** don't perturb the scroll please
943	if track [return f]
944	if 1 <= abs coeff: offset/y / (f/size/y / f/parent-face/nb-lines) [
945	render-text f/parent-face to integer! coeff
946	if f/parent-face/cursor/selection? [
947	f/parent-face/feel/expand-selector f/parent-face/cursor
948	show f/parent-face
949	]
950	]
951	]
952	engage: func [f a e][false] ;** don't send events to the area
953	]
954	]
955	h-scroller: make face [
956	offset: 0x0 size: 0x13 color: none edge: none
957	size-box: 0x0
958	text: none
959	edge: none
960	font: make font [align: 'right size: 10 style: 'bold color: red]
961	para: make para [origin: 0x0]
962	max-x: 1
963	effect: [draw [pen sky line-width 2 fill-pen none box 0x0 size-box 2]]
964	feel: make feel [
965	redraw: func [f a /local parent][
966	if 'show = a [
967	f/show?: if f/max-x > f/parent-face/size/x [
968	parent: f/parent-face
969	f/offset/x: to integer! negate parent/xy/x / f/max-x * parent/size/x
970	f/size/x: to integer! (parent/size/x ** 2) / f/max-x
971	f/size-box: f/size - 2x2
972	true
973	]
974	]
975	]
976	drag: func [scroller offset /track /local parent save-x decal x][
977	f: scroller/parent-face
978	f/delay: 3 ;** don't perturb the scroll please
979	if track [return scroller]
980	if f/x <= abs offset/x [
981	offset/x: to integer! offset/x + 4 / f/x * f/x
982	save-x: f/xy/x
983	x: f/xy/x: min 0 max
984	f/size/x - scroller/max-x
985	f/xy/x - offset/x
986
987	;** change change skip tail boxline -2
988	;** as-pair negate x 1 as-pair 32 - x 18
989
990	if 0 <> decal: x - save-x [move-x f decal]
991	show f
992	]
993	]
994	engage: func [f a e][false] ;** don't send events to the area
995	]
996	]
997	cursor: make face [
998	offset: 0x5 size: 2x18 para: color: edge: none
999	xy: as-pair origine-x 5
1000	; len et old len ont �t� renom� en col et old-col apparement ... dans les version suivante
1001	sub-string: idx: global-idx: col: old-col: len: old-len:
1002	old-idx: tmp-offset: pos-len: old-pos-len: none
1003	selection?: false
1004	selector-xy: [0x0]
1005	head?: false
1006	data: pos-blk: []
1007	blink-color: red
1008	size-box: 2x16
1009	effect: [draw [pen blink-color fill-pen blink-color box 0x1 size-box]]
1010	feel: make feel [
1011	redraw: func [f a][
1012	if a = 'show [
1013	f/offset: f/xy
1014	if f/selection? [
1015	f/selector-xy/1/x: f/xy/x - f/parent-face/xy/x
1016	]
1017	]
1018	]
1019	engage: func [f a e][] ;** disable events
1020	]
1021	]
1022	feel: make feel [
1023	scrollwheel: func [f event offset] [
1024	f/delay: 3
1025	dir: either event/offset/y > 0 ['down]['up]
1026	switch dir [
1027	down [render-text f 3]
1028	up [render-text f -3]
1029	]
1030	if f/cursor/selection? [expand-selector f/cursor show f]
1031	]
1032	resize: func [f size+][
1033	f/size: f/size + size+
1034	f/nb-lines: to-integer (f/size/y - 10 / f/y)
1035	f/v-scroller/offset: as-pair f/size/x - 13 2
1036	f/h-scroller/offset: as-pair 2 f/size/y - 13
1037	render-text/stay f 1
1038	if f/cursor/selection? [expand-selector f/cursor show f]
1039	]
1040
1041	begin-selection: func [
1042	cursor /local f
1043	][
1044
1045	f: cursor/parent-face
1046	cursor/selection?: true
1047	insert-selector f next cursor/data/1 cursor/xy/x + f/xy/x
1048	cursor/selector-xy: back tail cursor/data/1/2
1049	cursor/old-idx: cursor/global-idx
1050	cursor/old-pos-len: cursor/pos-len
1051	get-col cursor
1052	cursor/old-col: cursor/col
1053	]
1054
1055	drag: func [f offset /track /local cursor][ ;** drag = selection
1056	;** beware, it's the cursor which moves, not the area.
1057	if track [return f/cursor]
1058	unless f/cursor/selection? [begin-selection f/cursor]
1059
1060	;** not enough displacement to move the cursor
1061	if all [f/x > abs offset/x f/y > abs offset/y][exit]
1062
1063	case [
1064	all [positive? offset/y f/cursor/idx = f/nb-lines][render-text f 1] ;** scroll down
1065	all [negative? offset/y f/cursor/idx = 1][render-text f -1] ;** scroll up
1066	]
1067	click f f/cursor/xy + offset
1068	expand-selector f/cursor
1069	show f
1070	]
1071	save-x: 0
1072	detect: func [f e][
1073	;**print remold [e/1 e/2 e/3 e/4 e/5 e/6]
1074	if e/type = 'move [
1075	;** because of the timer, 'move events are received, even if there is no move
1076	if all [find [info-position recycle] f/ask f/move-offset <> e/offset][
1077	f/ask: 'info-position
1078	f/delay: 2
1079	f/move-offset: e/offset
1080	]
1081	return false
1082	]
1083	e
1084	]
1085	engage: func [f a e /local key tmp cursor select?][
1086	;**print remold [a e/type e/key e/1 e/2 e/3 e/4 e/5 e/6]
1087	if a = 'time [
1088	;print [now/time f/ask f/delay]
1089	either find [recycle info-position] f/ask [
1090	f/cursor/blink-color: get first reverse [red none]
1091	show f/cursor
1092	][f/cursor/blink-color: red]
1093	case [
1094	0 > f/delay: f/delay - 1 [
1095	;** if f/ask <> 'show [print ["timer:" now/time f/ask] ]
1096	switch f/ask [
1097	show []
1098	recycle [recycle]
1099	]
1100	f/ask: 'recycle
1101	f/rate: 1 ;** default rate, 1 event per second
1102	f/delay: 5 ;** recycle after 5 secs of inactivity
1103	show f ;** DON't remove the show here (needed to update the face rate)
1104	]
1105	]
1106	return false
1107	]
1108	cursor: f/cursor
1109	select?: cursor/selection?
1110
1111	if f/ask <> 'show [f/ask: 'info-cursor f/delay: 3]
1112	cursor/blink-color: red
1113	unless find [up down] key: e/key [save-x: 0]
1114	if all [e/5 not select? any [word? key key < #" "]][
1115	select?: true
1116	begin-selection cursor
1117	]
1118
1119	switch a [
1120	down [click f e/offset]
1121	key [
1122	;probe key
1123	;** e/6 = true for ctrl
1124	switch/default key[
1125	page-up [render-text f negate f/nb-lines]
1126	page-down [render-text f f/nb-lines]
1127	#"^P" [inc-font-size f 1] ;** increase font size
1128	#"^L" [inc-font-size f -1] ;** decrease font size
1129	#"^B" [bold f]
1130	][
1131	locate-cursor cursor
1132	]
1133	switch/default key [
1134	#"^M" [split-line f]
1135	#"^[" []
1136	#"^~" [ ;** delete
1137	either select? [
1138	do-selection/delete f
1139	][
1140	delete-char cursor
1141	recolorize cursor
1142	show f
1143	]
1144	]
1145	#"^H" [ ;** backtab
1146	either select? [
1147	do-selection/delete f
1148	][
1149	move-cursor/left cursor
1150	delete-char cursor
1151	recolorize cursor
1152	show f
1153	]
1154	]
1155	right [
1156	either e/6 [
1157	right-word cursor
1158	][
1159	move-cursor/right cursor
1160	]
1161	show cursor ]
1162	left [
1163	either e/6 [
1164	left-word cursor
1165	][
1166	move-cursor/left cursor
1167	]
1168	show cursor
1169	]
1170	;page-up [render-text f negate f/nb-lines]
1171	;page-down [render-text f f/nb-lines]
1172	down [down-cursor cursor]
1173	up [up-cursor cursor]
1174	end [
1175	constraint f as-pair 100000 cursor/xy/y
1176	show cursor
1177	]
1178	home [
1179	constraint f as-pair f/origine-x + f/xy/x cursor/xy/y
1180	show cursor
1181	]
1182	#"^S" [ if request "Save file ? " [ f/save-file] ]
1183	#"^O" [ if request "Open a file?" [ f/open-file none]]
1184	#"^N" [ if request "Start a new file?" [f/data: build-data "" f render-text/stay f 1 ]]
1185	;#"^P" [inc-font-size f 1] ;** increase font size
1186	;#"^L" [inc-font-size f -1] ;** decrease font size
1187	#"^C" [do-selection/clip f]
1188	#"^X" [do-selection/clip/delete f]
1189	#"^V" [;** TO-DO insert multi-lines text
1190	insert-char f/cursor tmp: first parse read clipboard:// "^/"
1191	show f
1192	]
1193	#"^F" [ view/new search-win ] ;[t/search f]
1194	#"^G" [ view/new goto-win ]
1195	][
1196	if all [char? key find key-to-insert key ][
1197	if select? [
1198	do-selection/delete f
1199	]
1200	;** insert a char
1201	locate-cursor f/cursor
1202	insert-char f/cursor e/key
1203	recolorize f/cursor
1204	;** auto-scroll horizontaly
1205	if f/x * 10 + cursor/xy/x > f/size/x [
1206	scroll-x f f/x * 10
1207	]
1208	show f
1209	]
1210	]
1211	]
1212	]
1213	if select? [
1214	either any [e/5 e/6 a = 'up] [
1215	expand-selector cursor
1216	][
1217	remove-selector cursor
1218	]
1219	show f
1220	]
1221	]
1222
1223	bold: func [f][
1224	f/font-obj/style: either f/font-obj/style [none]['bold]
1225	inc-font-size f 0
1226	]
1227
1228	split-line: func [f /local tmp str blanks][
1229	insert-char f/cursor "^/"
1230
1231	tmp: at f/data f/cursor/idx
1232	str: tmp/1/2
1233
1234	blanks: copy/part str find str any-char
1235	insert str: find/tail str newline blanks
1236	insert/only next tmp reduce [0 str 0x0]
1237
1238	render-text/stay f f/cursor/idx
1239	replace/all blanks tab " "
1240	f/cursor/xy/x: f/origine-x + f/xy/x + (f/x * length? blanks)
1241	down-cursor f/cursor
1242	save-x: 0
1243	]
1244
1245	inc-font-size: func [f inc /local tmp][
1246	f/font-obj/size: max 10 min 30 f/font-obj/size + inc
1247	f/origine-x: f/origine-x / f/x
1248	f/xy/x: f/xy/x / f/x
1249	;this is didec way used to compute the X size of a char on screen
1250	fa: make face [ font: f/font-obj text: "MM"
1251	size: 100x100 para: make face/para [origin: 0x0 margin: 0x0]
1252	edge: make face/edge [size: 0x0]]
1253	tx-test: fa/text
1254	forall tx-test [
1255	tmp: caret-to-offset fa tx-test
1256	;probe tmp
1257	]
1258	; we use size-tex for Y size of a char on screen
1259	tmp2: size-text fa
1260	;probe tmp2
1261	tmp/y: tmp2/y
1262	;f/x: round to integer! tmp/x / 2
1263	f/x: to integer! tmp/x
1264	f/y: tmp/y + 4 ; make the margin more spaced and easier to read
1265	f/xy/x: f/xy/x * f/x
1266	f/origine-x: f/origine-x * f/x
1267	f/cursor/size/y: f/y
1268	f/cursor/size-box/y: f/y - 2
1269	tmp: f/cursor/xy
1270	resize f 0
1271	click f tmp
1272	]
1273
1274	do-selection: func [
1275	f
1276	/delete /clip
1277	/local cursor data idx old-idx start end str start-col end-col scroll n y
1278	][
1279	cursor: f/cursor
1280	if clip [clip: make string! 256]
1281	idx: cursor/global-idx
1282	old-idx: cursor/old-idx
1283	get-col cursor
1284	either old-idx < idx [
1285	set [start end] reduce [old-idx idx]
1286	set [start-col end-col] reduce [cursor/old-col cursor/col]
1287	either start < index? f/data [
1288	scroll: start - index? f/data
1289	n: -1 + min start to-integer f/nb-lines / 2
1290	scroll: scroll - n
1291	y: n * f/y + 2
1292	][
1293	y: cursor/xy/y +(start - end * f/y)
1294	]
1295	][
1296	set [start end] reduce [idx old-idx]
1297	set [start-col end-col] reduce [cursor/col cursor/old-col]
1298	]
1299	data: at head f/data start
1300	if start = end [
1301	set [start-col end-col] sort reduce [start-col end-col]
1302	]
1303	if delete [
1304	locate-cursor cursor
1305	delete: copy/part data/1/2 start-col - 1
1306	]
1307	loop end - start [
1308	if clip [
1309	append clip append copy/part at data/1/2 start-col
1310	any [find data/1/2 newline tail data/1/2]
1311	newline
1312
1313	]
1314	either delete [remove data][data: next data]
1315	start-col: 1
1316	]
1317
1318	str: data/1/2
1319	case/all [
1320	clip [
1321	append clip copy/part at str start-col at str end-col
1322	write clipboard:// clip
1323	clip: none
1324	]
1325	delete [
1326	data/1/2: delete
1327	case [
1328	scroll [render-text f scroll]
1329	start <> end [render-text/stay f 1]
1330	'else [recolorize cursor]
1331	]
1332	if y [cursor/xy/y: y]
1333	constraint f cursor/xy
1334	append delete copy/part at str end-col any [find str newline tail str]
1335	recolorize cursor
1336	]
1337	]
1338	]
1339	; f
1340	; /delete /clip
1341	; /local cursor data idx old-idx start end str start-len end-len
1342	; ][
1343	; cursor: f/cursor
1344	; if clip [clip: make string! 256]
1345	; idx: cursor/global-idx
1346	; old-idx: cursor/old-idx
1347	; either old-idx <= idx [
1348	; set [start end] reduce [old-idx idx]
1349	; set [start-len end-len] reduce [cursor/old-pos-len cursor/pos-len]
1350	; ][
1351	; set [start end] reduce [idx old-idx]
1352	; set [start-len end-len] reduce [cursor/pos-len cursor/old-pos-len]
1353	; ]
1354	; data: at head f/data start
1355	;
1356	; ;**print [start-len end-len]
1357	;
1358	; if start <> end [
1359	; str: data/1/2
1360	; case [
1361	; clip [append clip append copy/part skip str start-len any [find str newline tail str] newline]
1362	; delete [data/1/2: copy/part str start-len]
1363	; ]
1364	; data: next data
1365	; start-len: 0
1366	; ]
1367	; loop end - start - 1 [
1368	; case [
1369	; clip [
1370	; append clip append
1371	; copy/part data/1/2 any [find data/1/2 newline tail data/1/2]
1372	; newline
1373	; data: next data
1374	; ]
1375	; delete [remove data]
1376	; ]
1377	; ]
1378	; str: data/1/2
1379	; case [
1380	; clip [
1381	; append clip copy/part skip str start-len skip str end-len
1382	; probe clip
1383	; write clipboard:// clip
1384	; clip: none
1385	; ]
1386	; delete [
1387	; data/1/2: str: copy/part str any [find str newline tail str]
1388	; remove/part skip str start-len skip str end-len
1389	; render-text/stay f 1
1390	; ]
1391	; ]
1392	; ]
1393
1394	click: func [f offset][
1395	;** We don't use the focus function to avoid this dummy system caret (whe have our own)
1396	unless same? system/view/focal-face f [
1397	if system/view/focal-face [unfocus]
1398	system/view/focal-face: f
1399	]
1400
1401	constraint f either offset/x - f/xy/x < f/origine-x
1402	[as-pair f/origine-x offset/y][offset]
1403	show f/cursor
1404	]
1405	expand-selector: func [
1406	cursor
1407	/local idx f pos curr-idx add-selector del-selector upd-selector str
1408	x upd-tail upd-head add-tail add-head calc-tail add-middle upd-middle old-idx
1409	][
1410
1411	f: cursor/parent-face
1412	idx: cursor/global-idx
1413	old-idx: cursor/old-idx
1414	curr-idx: index? f/data
1415	del-selector: [change pos none]
1416	calc-tail: [
1417	x: 0
1418	parse pos [some [
1419	thru 'text skip pair! [set str string! \| set str word! (str: get str)]
1420	(x: x + length? str)
1421	]]
1422	x: x + 1 * f/x
1423	]
1424	upd-middle: [cursor/selector-xy: back tail pos/1]
1425	upd-tail: [do calc-tail change back tail pos/1 as-pair x f/y + 7]
1426	upd-head: [change back tail pos/1 as-pair f/origine-x f/y + 7]
1427	add-head: [insert-selector f pos f/origine-x]
1428	add-tail: [do calc-tail insert-selector f pos x]
1429	add-middle: [print "Beginning of the selection lost, TO DO !!!"]
1430
1431	upd-selector: [(
1432	either old-idx < idx [
1433	case [
1434	curr-idx < old-idx del-selector
1435	curr-idx > idx del-selector
1436	curr-idx = idx upd-middle ;** cover until the position of the cursor
1437	'else upd-tail ;** cover the tail of the line
1438	]
1439	][
1440	case [
1441	curr-idx < idx del-selector
1442	curr-idx > old-idx del-selector
1443	curr-idx = idx upd-middle ;** cover until the position of the cursor
1444	'else upd-head ;** cover the head of the line
1445	]
1446	]
1447	curr-idx: curr-idx + 1
1448	)]
1449
1450	add-selector: [(
1451	either old-idx < idx [
1452	case [
1453	curr-idx < old-idx none
1454	curr-idx > idx none
1455	curr-idx = idx [do add-head do upd-middle] ;** cover tail
1456	curr-idx = old-idx [do add-middle 'do upd-tail];** cover middle to tail
1457	'else [do add-head do upd-tail] ;** cover the whole line
1458	]
1459	][
1460	case [
1461	curr-idx < idx none
1462	curr-idx > old-idx none
1463	curr-idx = idx [do add-tail do upd-middle] ;** cover tail
1464	curr-idx = old-idx [do add-middle 'do upd-head];** cover middle to head
1465	'else [do add-tail do upd-head] ;** cover the whole line
1466	]
1467	]
1468	curr-idx: curr-idx + 1
1469	)]
1470
1471	parse f/effect/draw [
1472	any [
1473	thru 'push into ['hilight pos: [block! upd-selector \| add-selector ] to end]
1474	]
1475	]
1476	]
1477	insert-selector: func [f where x][ ;** append an highlight box in the current block at relative x position
1478	change/only where
1479	compose [pen 255.200.10 fill-pen 250.200.10 box (as-pair x 7) (as-pair x f/y + 7)]
1480	]
1481	remove-selector: func [cursor /local f tmp][
1482	cursor/selection?: false
1483	parse cursor/parent-face/effect/draw [
1484	any [thru 'push into ['hilight tmp: (change tmp none) to end]]
1485	]
1486	]
1487	left-word: func [cursor /local f x str blk pos s-blk][
1488	f: cursor/parent-face
1489	str: get-sub-string cursor
1490	blk: skip s-blk: cursor/pos-blk -2
1491
1492	case [
1493	find/reverse blk 'edit none ;** not head of line
1494	not head? str none ;** neither
1495	'else [
1496	cursor/xy/x: 100000
1497	if up-cursor cursor [left-word cursor]
1498	exit
1499	]
1500	]
1501	x: 0
1502	foreach stuff reduce [any-char space][
1503	while [
1504	all [
1505	not find/reverse str stuff
1506	blk
1507	blk: find/reverse blk 'edit
1508	]
1509	][
1510	x: x - 1 + index? str
1511	str: tail get* blk/3
1512	]
1513	x: x - length? str
1514	str: any [find/reverse str stuff str]
1515	x: x + length? str
1516	]
1517	either str/1 = #" " [x: x - 1][x: x + (index? str) - index? head str]
1518	if x = 0 [x: -1 + index? str]
1519	constraint f cursor/xy + as-pair x * negate f/x 0
1520	]
1521
1522	get-sub-string: func [cursor][
1523	at head do back change [none] cursor/sub-string cursor/pos-len
1524	]
1525
1526	right-word: func [cursor /local x str blk pos][
1527	f: cursor/parent-face
1528	blk: s-blk: cursor/pos-blk
1529	str: get-sub-string cursor
1530
1531	case [
1532	find blk 'edit none ;** not tail of line
1533	not tail? str none ;** neither
1534	'else [
1535	cursor/xy/x: f/origine-x + f/xy/x
1536	if down-cursor cursor [right-word cursor]
1537	exit
1538	]
1539	]
1540	x: 0
1541	foreach stuff reduce [space any-char][
1542	while [
1543	all [
1544	not find str stuff
1545	blk
1546	blk: find/tail blk 'edit
1547	]
1548	][
1549	x: x + length? str
1550	str: get* blk/2
1551	]
1552	x: x - index? str
1553	str: any [find str stuff str]
1554	x: x + index? str
1555	]
1556	if str/1 = #" " [x: x + length? str]
1557	if x = 0 [x: length? str]
1558	constraint f cursor/xy + as-pair x * f/x 0
1559	]
1560
1561	scroll-x: func [f x][
1562	f/h-scroller/feel/drag f/h-scroller as-pair x 0
1563	]
1564
1565	locate-cursor: func [cursor /local x idx f][
1566	f: cursor/parent-face
1567	unless cursor/show? [
1568	either (idx: cursor/global-idx) < index? f/data [
1569	render-text f idx - index? f/data
1570	][
1571	render-text f idx - f/nb-lines + 1 - index? f/data
1572	]
1573	]
1574	x: cursor/xy/x
1575	if any [
1576	x > (f/size/x - f/x)
1577	x < f/x
1578	][scroll-x f f/x * 20 + f/xy/x + cursor/xy/x - f/size/x ]
1579	]
1580
1581
1582	move-cursor: func [
1583	cursor
1584	/left /right
1585	/local f pos offset len
1586	][
1587	f: cursor/parent-face
1588	locate-cursor cursor
1589	;** print remold [cursor/pos-len cursor/sub-string]
1590	case [
1591	left [
1592	if len: either string? cursor/sub-string [
1593	either cursor/pos-len = 1 [1][
1594	cursor/pos-len: cursor/pos-len - 1
1595	cursor/sub-string: back cursor/sub-string
1596	cursor/xy/x: cursor/xy/x - f/x
1597	false
1598	]
1599	][
1600	either cursor/pos-len = 1 [1][
1601	cursor/pos-len: 1
1602	cursor/xy/x: cursor/xy/x - (f/x * length? get cursor/sub-string)
1603	false
1604	]
1605	][
1606	either pos: find/tail/reverse skip cursor/pos-blk -2 'edit [
1607	either string? pos/2 [
1608	len: length? pos/2
1609	cursor/sub-string: at pos/2 len
1610	][
1611	cursor/sub-string: pos/2
1612	]
1613	cursor/pos-len: len
1614	cursor/xy/x: pos/1/1 + (len - 1 * f/x)
1615	cursor/pos-blk: skip pos 1
1616	][
1617	if cursor/global-idx > 1 [
1618	cursor/xy/x: 100000
1619	up-cursor cursor
1620	]
1621	]
1622	]
1623	]
1624	right [
1625	if len: either string? cursor/sub-string [
1626	either tail? cursor/sub-string [2][
1627	cursor/pos-len: cursor/pos-len + 1
1628	cursor/sub-string: next cursor/sub-string
1629	cursor/xy/x: cursor/xy/x + f/x
1630	false
1631	]
1632	][
1633	either cursor/pos-len > 1 [2][
1634	cursor/pos-len: index? tail get cursor/sub-string
1635	cursor/xy/x: cursor/xy/x + (f/x * length? get cursor/sub-string)
1636	false
1637	]
1638	][
1639	either pos: find/tail cursor/pos-blk 'edit [
1640	either string? pos/2 [
1641	cursor/sub-string: at pos/2 len
1642	][
1643	len: index? tail get pos/2
1644	cursor/sub-string: pos/2
1645	]
1646	cursor/pos-len: len
1647	cursor/xy/x: pos/1/1 + (len - 1 * f/x)
1648	cursor/pos-blk: skip pos 1
1649	][
1650	if cursor/global-idx < index? back tail f/data [
1651	cursor/xy/x: f/origine-x + f/xy/x
1652	down-cursor cursor
1653	]
1654	]
1655	]
1656	]
1657	]
1658	]
1659	delay-show: func [f][
1660	f/ask: 'show ;** delay the show event, speed issue
1661	f/delay: 1 ; wait 2 checks
1662	f/rate: 10 ; check 10 times per second
1663	]
1664	down-cursor: func [cursor /local p tmp][
1665	p: cursor/parent-face
1666	if cursor/global-idx < index? back tail p/data [
1667	if cursor/idx = p/nb-lines [
1668	delay-show p
1669	render-text p 1
1670	]
1671	tmp: cursor/xy + third cursor/data
1672	if save-x = 0 [save-x: tmp/x]
1673	constraint p as-pair save-x tmp/y
1674	unless p/ask = 'show [show cursor]
1675	true
1676	]
1677	]
1678	up-cursor: func [cursor /local p tmp][
1679	p: cursor/parent-face
1680	if cursor/global-idx > 1 [
1681	if cursor/idx = 1 [
1682	delay-show p
1683	render-text p -1
1684	]
1685	tmp: cursor/xy - pick cursor/data -2
1686	if save-x = 0 [save-x: tmp/x]
1687	constraint p as-pair save-x tmp/y
1688	unless p/ask = 'show [show cursor]
1689	true
1690	]
1691	]
1692
1693	insert-char: func [cursor char /local f text refresh?][
1694	f: cursor/parent-face
1695	if cursor/selection? [
1696	do-selection/delete f
1697	locate-cursor cursor
1698	refresh?: true
1699	]
1700	text: cursor/sub-string
1701	either string? text [
1702	insert text char
1703	][
1704	insert insert
1705	either cursor/pos-len = 1 [cursor/pos-blk][next cursor/pos-blk]
1706	'new
1707	char
1708	]
1709	collect cursor
1710	cursor/xy/x: cursor/xy/x + either char = tab [4 * f/x][f/x * length? form char]
1711
1712	if refresh? [
1713	render-text/stay f 1
1714	constraint f cursor/xy
1715	]
1716
1717	; f: cursor/parent-face
1718	; text: cursor/sub-string
1719	; either string? text [
1720	; insert text char
1721	; ][
1722	; insert insert
1723	; either cursor/pos-len = 1 [cursor/pos-blk][next cursor/pos-blk]
1724	; 'new
1725	; char
1726	; ]
1727	; collect cursor
1728	; cursor/xy/x: cursor/xy/x + either char = tab [4 * f/x][f/x]
1729	; if f/x * 10 + cursor/xy/x > f/size/x [
1730	; scroll-x f f/x * 10
1731	; ]
1732	]
1733
1734	delete-char: func [cursor /local pos f data str1 str2 end][
1735	text: cursor/sub-string
1736	unless either string? text [
1737	unless tail? text [remove text]
1738	][
1739	if cursor/pos-len = 1 [remove back cursor/pos-blk] ;**remove the offset
1740	][
1741	either pos: find/tail cursor/pos-blk 'edit [
1742	either string? pos/2 [
1743	remove pos/2
1744	][
1745	remove pos ;** remove the offset
1746	]
1747	][
1748	regroup-2-lines cursor
1749	exit
1750	]
1751	]
1752
1753	collect cursor
1754	]
1755	get-col: func [cursor /local col pos][
1756	col: 0
1757	pos: cursor/data/1
1758	while [pos: find/tail pos 'edit][
1759	if same? pos: next pos cursor/pos-blk [break]
1760	col: col + either string? pos/1 [length? head pos/1][1]
1761	]
1762	col: col + either string? cursor/sub-string
1763	[cursor/pos-len]
1764	[either cursor/pos-len > 1 [2][1]]
1765	cursor/col: col
1766	]
1767	collect: func [cursor /local full txt pos len][
1768	full: clear {}
1769	len: 0
1770	add-full: [(
1771	len: len + either char? txt [1][length? get* txt]
1772	full: insert full either word? txt [#"^-"][txt]
1773	)]
1774	parse cursor/data/1 [
1775	any [thru 'edit opt [
1776	pair!
1777	opt ['new set txt skip add-full]
1778	set txt skip add-full
1779	opt ['new set txt skip add-full]
1780	]]
1781	]
1782	cursor/old-len: len
1783	poke first at cursor/parent-face/data cursor/idx 2 copy head full
1784	]
1785	regroup-2-lines: func [cursor][
1786	f: cursor/parent-face
1787	data: at head f/data cursor/global-idx
1788	unless tail? next data [
1789	str1: either end: find data/1/2 newline [copy/part data/1/2 end][data/1/2]
1790	str2: either end: find data/2/2 newline [copy/part data/2/2 end][data/2/2]
1791	append str1 str2
1792	poke data/1 2 str1
1793	remove next data
1794	render-text/stay f cursor/idx
1795	]
1796	]
1797
1798	;*** Reconstruct a line (draw block) after an insert
1799	;*** (which contains modified sub-strings)
1800	;* if the line contains a multi-line string, then other lines below
1801	;* may be reconstructed too.
1802	recolorize: func [
1803	cursor
1804	/local line f multi-p multi data pos-head
1805	][
1806	f: cursor/parent-face
1807	data: cursor/data
1808	line: at f/data cursor/idx
1809
1810	change skip data 2
1811	either colorize f line clear find/tail data/1 string!
1812	[as-pair 0 2 * f/y][as-pair 0 f/y]
1813
1814	;** move the cursor, after insertion
1815	;*cursor/xy/x: cursor/xy/x + probe (cursor/len - cursor/old-len f/x)
1816
1817	loop f/nb-lines - cursor/idx [
1818	if tail? next line [break]
1819
1820	multi-p: line/1/1
1821	multi: line/2/1
1822	if any [
1823	all [find [1 2] multi-p find [1 3] multi]
1824	all [find [3 4] multi-p find [2 4] multi]
1825	][break]
1826
1827	data: find/tail data 'push
1828	line: next line
1829	change skip data 2
1830	either colorize f line clear find/tail data/1 string!
1831	[as-pair 0 2 * f/y][as-pair 0 f/y]
1832	]
1833	constraint f cursor/xy
1834	set-y f 5
1835	]
1836
1837	constraint: func [
1838	f offset
1839	/local cursor y blk pair text cont stop idx save-pair
1840	][
1841	y: idx: 0
1842	cont: none
1843	stop: [cont: 'break]
1844	cursor: f/cursor
1845	parse f/effect/draw [
1846	some [
1847	thru 'push blk: block! skip set pair pair!
1848	(idx: idx + 1 if offset/y <= (y + pair/y) stop) cont (y: y + pair/y)
1849	]
1850	:blk into [
1851	(cont: none)
1852	thru 'edit set pair pair! pos-head: text: skip
1853	any [
1854	thru 'edit set save-pair pair!
1855	(if offset/x < save-pair/x stop) cont
1856	text: skip (pair: save-pair)
1857	]
1858	]
1859	]
1860	either string? text/1 [
1861	offset: min length? text/1 to integer! offset/x - pair/x / f/x
1862	cursor/xy: as-pair
1863	offset * f/x + pair/x
1864	y + 7
1865	cursor/sub-string: skip text/1 offset
1866	cursor/pos-len: offset + 1
1867	][
1868	;** special case, for tabulation
1869	cursor/xy: as-pair pair/x y + 7
1870	cursor/sub-string: text/1
1871	cursor/pos-len: either find text 'edit [1][index? tail get text/1]
1872	]
1873	cursor/head?: pos-head
1874	cursor/data: blk
1875	cursor/pos-blk: text
1876	cursor/idx: idx
1877	cursor/global-idx: idx - 1 + index? f/data
1878
1879	case [
1880	cursor/xy/x < 0 [scroll-x f -20 * f/x + cursor/xy/x]
1881	cursor/xy/x > f/size/x [scroll-x f f/x * 20 + f/xy/x + cursor/xy/x - f/size/x]
1882	]
1883	]
1884	]; fin feel
1885	append init [
1886	data: append/only make block! 1000 reduce [0 ""]
1887	v-scroller: make v-scroller []
1888	h-scroller: make h-scroller []
1889	cursor: make cursor []
1890	pane: reduce [cursor v-scroller h-scroller]
1891	edge: make edge []
1892	data: build-data "" self
1893	feel/resize self first reduce [size size: 0]
1894	]
1895	export: context [
1896	font+: func [f][f/feel/inc-font-size f +1]
1897	font-: func [f][f/feel/inc-font-size f -1]
1898	bold: func [f][f/feel/bold f]
1899	]
1900	]; fin feel:
1901	] ;** end of global context
1902
1903
1904	; API layouts
1905
1906	pref_win: layout [
1907	across
1908	;text "Rebol VM path:"
1909	;return
1910	;fi: field 300 pref/consol_path btn "..." [ if none? (fi/text: request-file/title/filter "Choose REBOL VM" "Select" "*.exe" ) [ fi/text: pref/consol_path ] show fi]
1911	return
1912	text "API Colors"
1913	return
1914	text "Background color:" b1: box 20x20 pref/bg_color btn "..." [ if none? b1/color: request-color [b1/color: white ] show b1 ]
1915	return
1916	text "Default text color:" b2: box 20x20 pref/txt_color btn "..." [ if none? b2/color: request-color [ b2/color: black ] show b2]
1917	return tab
1918	btn "Ok" [ sav-pref t/color: pref/bg_color unview/only pref_win render-text/stay t 1 show t]
1919	btn "Cancel" [ unview/only pref_win ]
1920	]
1921
1922	search-win: layout [
1923	across
1924	text "Find what:" return
1925	fi-s: field "" 300 return
1926	tab btn "OK" [ if 0 < length? fi-s/text [ s-text: fi-s/text t/search s-text ] unview/only search-win ]
1927	btn "Cancel" [ unview/only search-win ]
1928	]
1929	s-text: ""
1930
1931	goto-win: layout [
1932	across
1933	text "Enter line number:" return
1934	f-goto: field 100 return
1935	tab btn "OK" [ i-goto: to integer! f-goto/text if i-goto < length? t/data [ t/goto-line i-goto ] unview/only goto-win ]
1936	btn "Cancel" [ unview/only goto-win ]
1937	]
1938
1939	about-win: layout [
1940	below
1941	text font [size: 16 style: 'bold] "Viva-Rebol IDE for REBOL in REBOL"
1942	text ""
1943	text "Web site: "text underline blue "http://my-trac.assembla.com/shadwolforge" [ browse http://my-trac.assembla.com/shadwolforge ]
1944	text "Version note:"
1945	text "This version works on windows XP/Vista/7"
1946	btn "Close" [ unview/only about-win ]
1947	]
1948
1949	;** TEST
1950	do test: does [
1951	unview/all
1952	view/new/options layout [
1953	across space 0x0 origin 0x0
1954	mn: menu with [
1955	size: 720x20 data: compose/deep [
1956	"File" [
1957	"New" # "Ctrl+N" [if request "Start a new file?" [t/new-file]]
1958	"Open" # "Ctrl+O" [t/open-file none ]
1959	"Close" # "Ctrl+W" []
1960	bar
1961	"Save" # "Ctrl+S" [ if request "Save file ? " [ t/save-file]]
1962	bar
1963	"Exit" [quit]
1964	]
1965	"Search" [
1966	"Find..." # "CTRL+F" [ view/new search-win ]
1967	bar
1968	"Find Next" [ if 0 < length? s-text [ t/search-next s-text ]]
1969	"Find Prev" [ if 0 < length? s-text [ t/search-prev s-text ]]
1970	bar
1971	"Go to ..." # "CTRL+G" [ view/new goto-win ]
1972	]
1973
1974	"View" [
1975	"Text Size" sub [
1976	"Text +" [t/export/font+ t]
1977	"Text -" [t/export/font- t]
1978	]
1979	"BOLD/NORMAL" [t/export/bold t]
1980	"Functions" [l/draw-list t]
1981	]
1982	"Script" [
1983	"Run" # "F1" [ if request "Run this Script ?" [ t/run_scr ] ]
1984	]
1985	"Tools" [
1986	"Preferencies" [ view/new pref_win ]
1987	]
1988	"Help" [
1989	"About..." [ view/new about-win ]
1990	]
1991	]
1992	] return
1993	;below across
1994
1995	tab-panel data [
1996	"My Funcs" [ origin 2x2 l: func-view 150x460 ]
1997	"File" [ ]
1998	]
1999	t: area-tc 550x500
2000	][resize]
2001	; if exists? %./viva-rebol.r [ t/open-file %./viva-rebol.r ]
2002	do-events
2003	]
2004
2005
2006
2007
2008

Note: See TracBrowser for help on using the browser.

Download in other formats:

Original Format

Shadwolf's repository

Context Navigation

root/viva-rebol.r

Download in other formats: