-
Notifications
You must be signed in to change notification settings - Fork 1
/
Copy pathrebolide.r
7254 lines (6592 loc) · 285 KB
/
rebolide.r
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
REBOL [
TITLE: "Rebolide"
date: 05/09/2012
credits: { Carl sassenrath, "Shadwolf", Steeve, Maxim, Coccinelle, Cyphre, Graham, Nick Antonaccio, Semseddin Moldibi, Zoltan Eros, R. v.d.Zee}
purpose: { Colored IDE for rebol in rebol, for beginners that helps learning Rebol.
I suggest you to put this script in a separete folder.}
version: 6.4.52
File: %rebolide.r
Author: "Massimiliano Vessi"
email: [email protected]
Library: [ level: 'intermediate
platform: 'all
type: [tool demo ide]
domain: [all]
tested-under: [view 2.7.7.3.1 Windows Linux ]
support: [email protected]
license: 'gpl
see-also: none ]
]
make-dir %local/ ;make-dir tests if exists a directory and if not exists it creates it
change-dir %local
req_files: [ %scroll-panel.r %simple-tooltip-style.r %lucon.ttf %resize-vid.r ] ;requested files
foreach item req_files [
if not exists? item [ request-download/to to-url join http://www.maxvessi.net/rebsite/ item item ]
]
do %scroll-panel.r
do %simple-tooltip-style.r
do %resize-vid.r
;this is useful if you are on linux
my-font: "Lucida Console"
if system/version/4 = 4 [my-font: to-local-file clean-path %./lucon.ttf ] ;Linux case
;***********************************************
; utility functions to lad and save user preferences
;saving preferences
sav-pref: func [][
pref/bg_color: b1/color
pref/txt_color: b2/color
save %pref.dat pref
]
;loading preferences
load-pref: func [][
if exists? %pref.dat [pref: do load %pref.dat ]
]
;see if there is a pref.dat file to use in order to load user preferences
either exists? %pref.dat [
load-pref
][
pref: make object! [
bg_color: 0.0.0
txt_color: 255.255.255
]
]
;end of utility functions
;**************************************************
;NOW SKIP TO THE CODE AT LINE 248. The folowing lines are just compressed scripts for tab panel and menu bar
;***********************************
; LOAD MENU WIDGET Cyphre(TM)
do load decompress #{
789CB51B6B73DAB8F67B7E85BA3B770237430CE4D12EDD6EC6109A92266D499A
B629E3CE1810C6606C6A9BE074BBFFFD9E23C9B66CCB84A477C384C8B2747474
5E3A0FE5EF5118D516D45DB5C8C29C53E20D6774143E23839D6F357B615A3468
119F8E5723CABABED55EE260329C5B646D875342C71665FD8E678EC9F1E1EF7F
DB9FDAEFAFD6F5B76796A7C3CFBBEB9B69F7C68256BB87CFD71DFD161F3EFFF0
8EBE6047FB6CDCFE78D3D5F58BB3F7930FE1D5CE7C0DBD9DF6ECFAF5F93B787D
7CDED775AB77A9EB1F5C0D5EE8C7F07AFC11BEDE2F11ECB103E35F37F7BE7CFF
EADE20C09DE6DCE9F63F5D1DBA67172F34ED85A6FFB8D1FB7A27B27A33FFD38B
BDABAFE7DF17E1B43B5B4DA7B06AD7BABE3A773AEFDAD7FE7BC07074D5DDB1E7
776BC4D25B2EDB00BBFBEE1656F7ACC08AACAF67572BBDD9A6BDC6E7B6ADEB6F
BAD6FCC5E91B5B3F8F2EBFF6FBD142BFA6D6E71D58EDEAF8C7CDF2EB25ECA0D3
D1DFBEE95E754EEFDF74FA7AB7FBEEA67376DFD1BF9FDDF6FBFA69FBEEF6D68F
AE7A17BADEEB0DDB9DE69DFEFEEDCE17EB6BEFB6F7767D7EEE0125EF69AF1FE8
EDB61E5993FAE5349AF5828B4B86E17A31E97FBC9E863F7AFACDFBFACCBA38EF
996DA0FBCE6D70F5E58D7DE67EE94CFBFDD7A3D3C6C58B8B2BFDB2DB7D7D7C7A
AD03B5FBB7FAC5DC72BF1EDE6B07EDBECE5873F3E9FDD5DBA3CE6DAFF7EA1F89
D9A3291DCD413CFCF9969CD6D9578F73FAB47BFAFCF8E2DFE1F44D3DE6F4F97C
4FDFEBAE7AB0F41A609DBE99CED7FDB6A5B7EDFECAB4AE0F7B20017A74DBB7EC
B707CF3F009C7EFFEDF4F38ED75D74901A97D7AF7FD43B9FDAC8ACB3CBCE9ED5
EDB65FB70F6F75ABDFEF358EEE74EB3540EEEA7BF3E0CB878F079ED6EE3292ED
E46966C06F10DE3BF60FAA2DCC20A4BED01BAE6313131489290EEFFD561B798E
E7B788EBB954F44C3C3714DA88CD64643276E898A379D2E94D26018509F5A89E
F4055373ECAD33500DF117155640C7A6043D009C5BA41135F2EB359E37F71BC7
2FF61B4707DF6A39706BCF1F838948A18CCDD0240397AE356CC18E6D3F08894B
A39098BE15A42D2399623ACBA92981F856C3E9ACB7305F1A04066A42827BA0F1
421BAE6C678C2B52F22769366AE7A65B6BD6EB8719A839C8CDA323522324E9C9
8C34A4A70C62793C8C1C41BC498617410838B5083029E5376C8A711824A236C9
304960164F9E50EAC492004D69333EE5DC9AACDC11190019E069CF90374B41C8
40F896A6ED9F90898603C84034B4A895B4C81E9F0C2D79CFF1D078603C4C1E13
4CBD35991428912388EDDA612B2BC42D62BAF764C0C48B6D3F850A2C75BD90F0
57032180CD83E3FDE6C1C17EB3719C8E5C9A2E6037F2960029ED659445B5497B
3C9F9A2350389B0C0DC2C553DA84ED06D40F4968DA0E419082DCE688E6642704
D6B7889DE9E3CA243130A337857E3835F93BE9503DFC63BF513FDE6FFCF13C47
098EBB1B1666ACA73688393302C5D1B1B8A0DD301DDB725B64D7A193303B7269
FAA618894D80E99BCB13344F4E003E806F5B364C6C46F5EC342E1087D1214883
45C35AC84408D7B271C5CCD8D82C813E64FAB9551812FCC9625F2AEC02E01DF5
5381378967E44730E9311D986A82D4C2C628500F39A9312DCCF571F55300E1B6
5A0315A321CC4184156354C0346F19DA9E1B2858BF6152B85872ABA10629E858
59DBAE202AE873153850A9470DF25FA19F553065F5E870DB353927033AF2DC31
0940EE4FD4AB732563D695D9AB7887822E894CEE7285CDC2803EB28BD231D1D8
41B6CB0D7D7610EB33B6C55B9C29654CE1164931B130B6B8E244136ABBB4C1DB
9968A9B292E2527C47B91992B62AA6E4ACA51A0DEA5AA6456531A70A090DC083
008B661674842998B776952FF2241547139A5BC50B0500159756CB92B5401555
3AA81E0C16C99BE715945963DB1DD3088413FEAA5E8324536722AC066F0F5468
E2671BAD8E1905F82C574B0D740EC8A9996BF35E2956ADD2D342FE240AFECBBA
2C84447DEAC89FB2132823289B7549880C3B53F2C63D4356738426A1852702B0
2B4B27D079F6B67476A981798C7979BC71119C2E5A41C4A7743CC8346C50B89C
77365D935D90135CA9A63CB232847CE078933F78368E1C2FA0357A077B41FF9A
3D96EF84CF015FC61ED393C47C2003180483B75FF1270D1F1E82B5F4BD110D82
9AB70A1128C74405F90138F8B3721D00C59578B080839C84F68212148D3B5471
D198D37BC2AC5730F23DC7A93936F84302E5F07E097230454C986A3E843EFEB0
990F8C7B900CDEB236A6211D852DE0E153362F1C71C11B92CE7E5004721018F9
64B128210DF723C980A3B8C51AC6D698288542DAD2368BFD0243CADF95BD3118
D56ADC8E174EDFF8B336EDB0FCDC509E9ACC53564E508129F6E57BB2CFF293DC
16A74888274623AAC3895129F1C6C12456AB85D0EC5BEDE543364F0C38AED7A3
669A504093A5F1A093B0539687E5B17DE6FD6C621232C47F172B27B485E5636D
49DA26B643333665E8CC334A0516973957D04F1A393165ECE087184B49719460
A4927859B40C96AA81AF8470311AEC7510FAECAF961E7C136F38C3497C804FC3
95EFB22DB3C050E107A003844A9E49E70C672067312A22E152879F887D8B7E1E
69C638705459582D7248299ECC0B49CEEFF8EC640F041E44EF24CE56404BF42D
CD702A3A97A2C55D23DE74BC91E9B0E65D92E0F55760C4590BED329F0381E842
38D7E355DC0A5643DE630727AC319ACE79C35E58ECEFD0F44547B8607FC1F2B3
BF3402591CF377AE07E6920F172C8D43C9241309188340C95CC1E76C5200D8C0
3616B305741942DC847004B605C76BE0C1793440C0102F7B2EA960536BE0C304
1CB49F04BD4614C2219066FE8C543818EC010055783FB79706093D42DD315F98
E076EC30E16192DB40DA275282BB0CB2181B29E15BE4203A48C99BA65114C1F0
D843E72476C2B82E9818976C769D779937B28B001F31CBC41457925254052DBF
860E07F92884A84C3D2E982AF7BCE03C6F4CC0629E2A3172D4013700F52A753B
8DE4D478446E67DBAC4E2E7768A4CA9718F0ACDDFFEDF237C277AE2529B08CD0
81AEC7B2561766881D29A9962BD4834AF95DAE278951455A0C7641D1CDA14349
0535BE45427F45AB06A3D380E5F976E1B4421B205E8136EDD6E21E768E560D31
1CB50C8C0419B0D2D33318892704FE45FC9FC5C376C180900A5A91643536335C
A0D5B45DEB191FF73BEB46B75274C7F3C144910A33300900AEFB0916C21211BE
6134093F992D90314DED81412AD2A1C3625926B43CAB08946F908A8864719DAA
34384E59A1809C24CBB22E84CF90348C814853E26C8E471604235AE674147C67
843C89896A89A3125A598783BD0A3D5EF293B5466887E553EA92547738DC1683
4B2713748F4129C08B4A8A08E09B3051355E368E23396F9BF568004D9040ED1E
629383FC0EA4CC2CB7EC04F896D169F2127A588D0A9F732E15FAC580557C1CC9
9B15B86379536BBC64E2CEAB214390217349FE634D2216E2EF2F5D2B373BDEEE
C85B2CC117073F3B0AC1E813166B8283432A65468347A8CDA323A3CA13DCE835
958E96B2E3D5BCB7581EDE97E606D4E97289090119A439DB20DCCE218599A886
1B3807E4D7F27975C2EB8A63EAD80BB057BE9A710058BD6DA91EB5EDEE13574B
AA6E091396E6A9C18F06A7B774DF19F73B9F9FE1C6281F156448554A146EB213
B2E06306B6A047B19F5724C2450E4975E2DDF73CF42A73DA90398B44A089669C
0C061299659283319226955720BC7C098208F649B3B5E653EA12982B83238599
1730331008E51444442251B31819C11191A90E31A9111A1D47EA92C92C0820D3
796D4CE9920CC6BEB9164715BA4360E2175695D4F741C3F7EB464E81F2A0C462
780A2AC2EF0C6C0CF184B16A9680572C80BE65410FCAB51A04741C0903B14C82
03C1D6C79666088F20C88C848B25FE7AF815E0976D902C150B68C3A0B2F89A1F
6A35FA7D653A2719416AC822AACC673C2ABFFFA40C7F31CA57E6FCE532154FBE
A36A663CDB3809FA0A5E025BD4099AF2792D3EAD300742928A0A12F4CFD2AA73
EE4D5C3F75B96CB08045890FC12F803303ADCB5BD9FCCE2B0E78F8E1F484235A
257FBE2249975B65647193DD6FCCAC7307AE74048421C9415D0107074C638DF9
C2E2C89D79109E0C7621F0406292DD4CEE1A3D6003F1C97B5CD98F4F594ED30C
057166A52319756AA5D4512D414A324A55456745D127EC4CD6A1243CBC050AB3
9D95E4FF4AD3829BC98E32A3F1B43F999448221B97C4C9998D0D54BD6011D5DD
6A188AF594F42A2D5DA1D92AABA115B44E594C2D8CDA504A2D8C55153F846F28
46F3334B7889E8472A0AADEA19B19F5A26CF42602A251B65374614EF44910B5E
436CC7E3F624F89732B0E08F6385AB4AFE22F50D69676081642294B44410F994
60414C3DB55993463063A95C406B8AE23BDBF231D90CC756C249A8B261726C60
6D7ECBA9049B8D3B4DB8868800B2B68CB91DF3ED2FF2105F1E5824DE285BA526
AF524B567900403AA7C5FD8274261279E3EC8DE51625F03DEE76D41E02BCF12D
1792ADF6C7252E4563C3E027D432CAB7AF7205124A3C412CCB5040B5E47BE492
C4BF379A3C38DB376A7A2AFD4F117C99E319A1378781E7AC42CAE4E0D1A4FE05
8A72992B5FF297CE8F47B24B5C87C983528EDED2C9D85CB7FA3F5E6099C49536
F022CA2E9EB03B26E25E49DEE530480A41EDBCB15B1D83CDA3B62FD32519371E
3DE7E6C57724A452D79DE9AC681C28452C32F5E154264A874DE5A2257EADCAB3
D9E0EA32D7B6D4DB85D80FFDDDE28D8D2D02CE38B0F35CE75E89166C92DF81D6
3077A118C0D3CF6C448953C4CA354A09CEE5A6B39F48DC39DDDD63E96783D1BB
126189870B2344A31313738CD047067B301206D57082610CA04FE970E3E72789
5AB9B21082C0B250E90CAC16A9B550949054CAA85415520119C92F14D7DAD574
5CC48A9248E12F887D2E1988B9F6C7E602C14AF9E1681516135F49EA2BAE0FA6
9FF20CE813EFB666925752112549812B2EDC6E4838F2DC5C116F6EEB9B8AD414
922E5FBC493FE2F0B96FF174791EF55C82262DC6AA39086B15B0CE7172B3FD79
98ABA6EFC3E153CE52F67E6BA696D239CEDD0DF87AF5FDE7F00B1FE27BEC5CF8
A3C0E64285E25FA474194DE3320FC6DFAEA1222DB7A18CBE3CA9A04CCCB14A13
D697E25889D79AF68863825F961FAD28A8F0407412B00B0149448A28629A9B9D
1808B25E128C4A858A5D9E5E4DF5261B84A605906DEEB6F0DB9095B20CAEB44C
55B67D80774148784D32D7C9CA5DB93E5E8FCC750A4615FA45ED30D39B629231
F0F11E25C3CEBBC41D92F412C30EBBE4C13204995B1EE9058FF45E867C3323BD
1921DFCDE0D1C84E725067FE312577BBE0A1A23262A03552BB943AED99FFA7B0
852B5B6902F7D81278B735E3D8DAB21F2B7BEF7238920BA3EEF3C3EFE597B082
ACA8316A33B194FC0F4EDCEB9C891B73123B8BC7D62C1358A4898F38807E8040
79F1CE5F8A5253AAD26477BA18373653EE49BB44B5891369E93EE37F084A7659
93B0D222BC8C7CA8DC1378B5CCE66E41B81A99A54D01B8042696F69F80E28B52
24C4202067732BD6487628BE646727D7B20587528E714B85025B2DAAB6505CE9
F69674D5077ACCF13873A72BBDFD1697FB714A72A52D003F4943CBA2C141A2A1
B30D5E5D6C99F9D04301C9244363202209FC77431B040804940CD96F930C307B
8BB782C12732E21B663C8F5D82914872B36B38325AB011E325D6BFBD0989FF97
78E79FFF0120649CE6573C0000
}
; END of ctx-menu
;area-tc is the main and most imortant face of all script
area-tc: context [ ;** global context
; this set colors for every type
colors: [
char! 0.180.40
date! 0.120.150
decimal! 0.120.150
email! 0.200.40
file! 0.200.40
integer! 0.120.150
issue! 0.180.40
money! 0.120.150
pair! 0.120.150
string! 0.180.40
tag! 0.180.40
time! 0.120.150
tuple! 0.150.150
url! 250.120.40
refinement! 160.120.40
comment! 255.150.0
datatype! 225.0.200
function! 0.255.255
native! 255.255.0
action! 0.255.255
error! 255.0.0
multi! 0.180.40
free-text! 0.0.200
]
insert tail colors compose [ block! (pref/txt_color) default! (pref/txt_color) ]
multi-chars: complement charset "^^}^/^-" ;** to detect end of rebol strings
save-color: color: start: end: out-style: x: str: type: f: value: multi: grow?: none
;** markers used in replacement of the draw comman PUSH. Much easy to track them.
expand: ;** marker for info messages (like errors)
hilight: 'push ;** marker for hilight background
no-edit: edit: 'aliased
edit-mode: none
abs-x: 0
;** rule to output draw dialect
;gen-draw: to-block end
gen-draw: [end: (
str: copy/part start end
unless tail? str [
color: any [
select colors type
color
select colors 'default!
0.0.0 ; this is the deafult color if the others are none
]
either save-color <> color [
insert out-style reduce [
'pen color 'text 'edit (as-pair x * f/x + f/xy/x + f/origine-x 5 ) str
]
loop 6 [out-style: next out-style] ;since we inserted 5 items, this weay we go toinsertion point
][
insert tail pick out-style -1 str
]
if type = 'error! [
out-style: insert/only insert out-style 'expand
reduce ['pen red 'text 'vectorial as-pair x * f/x + f/origine-x 5 + f/y reform [value/id value/arg1]]
]
x: x + length? str
save-color: color
if type = 'error! [grow?: true]
]
)]
tab1: next tab2: next tab3: next tab4: " "
what: none
gen-tab: [(
what: pick [tab4 tab3 tab2 tab1] x // 4 + 1 ;** align tabs
out-style: insert insert insert out-style
[text edit] as-pair x * f/x + f/xy/x + f/origine-x 5 what
x: x + length? get what
save-color: none
)]
spaces: exclude charset [#"^(1)" - #" "] charset "^/^-" ;** treat like space "] <- for my broken editor, that mess "
braquets: charset "[]()"
;** rule to detect rebol values (uses load/next)
;** (heavy, because we handle errors too)
rebol-value: [skip (
error? set/any [value end] try [load/next start]
either error? :value [
value: disarm :value
either value/arg2/1 = #"{" [
end: any [find start newline tail start]
type: 'multi!
multi: case [
multi < 2 [3]
multi = 2 [4]
'else [multi]
]
][
end: skip start length? value/arg2
type: 'error!
]
][
case [
path? :value [value: first :value]
all [word? :value value? :value][value: get value]
any-string? :value [
if find/part start newline end [
end: find/part start newline end
multi: case [
multi < 2 [3]
multi = 2 [4]
'else [multi]
]
type: 'multi!
]
]
]
type: type?/word :value
color: none
]
) :end
]
no-tabs: complement charset "^/^-"
gen-to-end: [any [some no-tabs | end: tab :end gen-draw some [tab gen-tab] start:] gen-draw]
any-char: complement charset " ^-"
set 'colorize func [
face line out
/local check-multi check-free-text orig lvl-start lvl val cont pline pos
][
color: save-color: grow?: none
f: face
x: 0
orig: out-style: out
;** multi = -1, free text before REBOL header
;** multi = 0, code not parsed
;** multi = 1, normal code
;** multi = 2, end of multi-line string
;** multi = 3, begin of multi-line string
;** multi = 4, full multi-line string
lvl: lvl-start
multi: case [
head? line [-1]
2 < val: first pline: pick line -1 [4]
val = -1 [-1]
'else [1]
]
lvl: lvl-start: either pline [pline/3/2][1]
line: line/1
check-multi: either multi = 4 [none][[end skip]]
check-free-text: [(cont: either multi = -1 [none][[end skip]]) cont]
;**all [char? line/2 print line]
parse/all line/2 [
start:
check-free-text "rebol" any #" " #"[" (multi: 1) end skip
| check-free-text (type: 'free-text!) gen-to-end
| opt [
check-multi start: some [
some multi-chars
| #"^^" [skip | end]
| end: tab :end (type: 'multi!) gen-draw some [tab gen-tab] start:
| #"}" (multi: 2) break ;** end of multi-line
| break ;** newline
]
(type: 'multi!) gen-draw
]
any [
start: [newline | end] break
| some spaces (type: 'blank!) gen-draw
| tab gen-tab
| [#"[" | #"("] (type: 'block! lvl: lvl + 1) gen-draw
| [#"]" | #")"] (type: 'block! lvl: lvl - 1) gen-draw
| #";"(type: 'comment!) gen-to-end
| rebol-value gen-draw
]
]
line/1: multi
line/3: as-pair lvl-start lvl
f/h-scroller/max-x: max f/h-scroller/max-x x * f/x + f/origine-x + (f/x * 10)
f/cursor/len: x
case [
empty? orig [ ;** if the text contains no chars, add a dummy line
append orig compose [text edit (as-pair f/origine-x + f/xy/x 5) (copy "")]
]
not same? back start find/reverse start any-char [
insert insert insert tail orig
[pen blue text no-edit]
as-pair x * f/x + f/origine-x + f/xy/x 5
"°"
]
]
grow? ;** notices if it's a simple line or a double-size line
]
;** cut text into lines
set 'build-data func [
text f /local out
][
out: f/data
clear out
parse/all text [any [pos: (out: insert/only out reduce [0 pos 0x0] ) thru newline]]
f/origine-x: f/x * (1 + length? to string! length? head out)
recycle
out: head out
]
]
;** boxline: [pen red fill-pen red box 0x1 32x18]
;** debug: display where show occurs
;show: func [f][print either in f 'cursor ['area-tc]['cursor-only] system/words/show f]
;** markers used in replacement of the draw comman PUSH. Much easy to track them with parse.
expand: ;** marker for info messages (like errors)
hilight: 'push ;** marker for hilight background
no-edit: ;** marker for text no editable
edit: 'aliased
render-text: func [
f inc
/stay
/local pos char color draw-txt
prev-col draw-sblk nb line data n decal
][
;start: now/precise
prev-col: none
case [
stay [
inc: inc - 1
data: skip f/data inc
]
inc < 0 [
inc: negate min abs inc ((index? f/data) - 1)
data: f/data: skip f/data inc
]
inc > 0 [
inc: min max 0 ((length? f/data) - f/nb-lines) inc
data: f/data: skip f/data inc
]
'else [data: f/data]
]
draw-txt: any [find f/effect/draw 'push tail f/effect/draw]
case [
stay [
draw-txt: clear skip draw-txt max 0 inc * 4
nb: min f/nb-lines f/nb-lines - inc
]
empty? draw-txt [
nb: f/nb-lines
]
inc > 0 [
remove/part draw-txt 4 * inc
draw-txt: tail draw-txt
nb: min f/nb-lines inc
data: skip data either f/nb-lines > inc [f/nb-lines - inc][0]
;** A FAIRE, si inc dépasse le nombre de lignes affichées,
;** parser les lignes skipées (non affichées)
;** pour détecter les strings multi-ligne
]
inc < 0 [
clear skip draw-txt max 0 4 * (f/nb-lines + inc)
nb: min f/nb-lines abs inc
]
'else [return true]
]
nb: min nb length? data
n: 1
decal: as-pair 0 f/y
while [n <= nb][
line: at data n
draw-txt: insert draw-txt 'push
draw-sblk: insert insert insert make block! 50
[hilight none pen 128.128.128 text no-edit] as-pair f/xy/x 5
reverse copy/part reverse head insert change clear "" " " (n - 1 + index? data) (f/origine-x - f/x / f/x)
if colorize f line draw-sblk [
decal: as-pair 0 2 * f/y
]
draw-txt: insert insert insert/only draw-txt head draw-sblk 'translate decal
decal: as-pair 0 f/y
n: n + 1
]
set-y f 5 ;** recalc all y offset of texts (which can be absolute only)
unless f/cursor/selection? [show f]
;** probe difference now/precise start
]
set-y: func [f y /local blk pair line idx gb lgb chg-y][
blk: f/effect/draw
blk: find f/effect/draw 'push
lgb: index? f/data
gb: f/cursor/global-idx
idx: 2
f/cursor/show?: false
chg-y: [thru 'text ['edit | 'no-edit] pair: pair! (pair/1/y: y)]
foreach [cmd value] blk [
switch cmd [
translate [y: y + value/y]
push [
if gb = lgb [
f/cursor/xy/y: y
f/cursor/data: at blk idx
f/cursor/show?: true
]
parse value [
any chg-y
any [thru 'push into [any chg-y to end break]]
]
lgb: lgb + 1
]
]
idx: idx + 2
]
]
move-x: func [f x /local blk pair chg-x][
blk: f/effect/draw
blk: find f/effect/draw 'push
chg-x: [thru 'text ['edit | 'no-edit] pair: pair! (pair/1/x: x + pair/1/x)]
foreach [cmd value] blk [
switch cmd [
translate [x: x + value/x]
push [
parse value [
any chg-x
any [thru 'push into [any chg-x to end break]]
]
]
]
]
f/cursor/xy/x: f/cursor/xy/x + x
]
;** return the inner face matching the point
map-inner: func [face point /local pane][
unless pane: face/pane [return face]
unless block? pane [pane: to block! pane]
foreach face pane [
if within? point face/offset face/size [return map-inner face point - face/offset]
]
face
]
get*: func [v][do back change/only [none] v] ;** if v is a word, get value in the world
any-char: complement space: charset " ^-"
context [
origin: off-mem: save-size: 0x0
drag: track: false
;** find a free place in the whole area to display the info box
find-free-places: func [
f
/local data end x len l-len r-pos stack-l stack-r
][
stack-l: clear []
stack-r: clear []
data: f/data
loop len: f/nb-lines [
line: data/1/2
end: any [find line newline tail line]
;** length of the left free zone
pos: any [find/part line space end line]
l-len: -1 + index? pos
;** start of the rigth free zone
pos: ant [find/reverse end any-char end]
r-start: index? pos
stack-l: insert stack-l l-len
stack-r: insert stack-r r-len
data: next data
]
x: maximum-of stack-l
loop len [
stack-l: next stack-l
]
]
insert-event-func func [face event /local tmp][
;print [event/type event/key]
switch event/type [
time none ;** a lot of time events are sent, check it first
key [ ;** key handler for faces without text and caret (actually only for areat-tc)
if event/1 = 'time [return event] ;** FUUUUUCK, why we receive that crap event here ???
if all [
tmp: system/view/focal-face
in tmp 'style
tmp/style = 'area-tc
][
tmp/feel/engage tmp 'key event
]
]
move [
either drag [
tmp: track/offset
drag/feel/drag drag event/offset - origin
origin: origin + track/offset - tmp ;** correct the origin, if the tracked face has moved
return false ;** disable move event
][off-mem: event/offset ] ;** for mouse wheel motion
]
resize [
tmp: negate saved-size - saved-size: face/pane/1/size
;faces inside tab-panel must be resized before the tab-panel is resized and redrawn in the loop below --cyphre
panels: reduce [core_sp vid_sp draw_sp yv_sp]
foreach item panels [
item/resize/y (item/size/y + tmp/y)
]
foreach fa face/pane/1/pane [
if in fa/feel 'resize [fa/feel/resize fa tmp]
]
]
down [
face: map-inner event/face event/offset
if in face 'var [ ;ATTENTION the following commands must be applied only to t (areta-tc) and his v and h scrollers
if any [face/var = 't
face/var = 'v-scroller
face/var = 'h-scroller
][
if in face/feel 'drag [
;** the draging face which contains the pointer may be different from the draged (track) face
drag: face
origin: event/offset
track: drag/feel/drag/track drag event/offset
]
]]
]
up [drag: false]
scroll-line [
face: event/face
face: map-inner event/face off-mem
if in face/feel 'scrollwheel [
face/feel/scrollwheel face event off-mem - win-offset? face
]
]
active [saved-size: face/pane/1/size]
];[print [event/type event/offset]]
event
]
]
;scroller function
scroll-panel-vert: func [pnl bar][
pnl/pane/offset/y: negate bar/data * (max 0 pnl/pane/size/y - pnl/size/y) show pnl
]
key-to-insert: make bitset! #{
01000000FFFFFFFFFFFFFFFFFFFFFF7FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
}
stylize/master [
; list of function widget
func-view: box with [
edge: [ size: 1x1 color: 'black]
;offset: 0x0
;delay: 0
current-line: 1
tmp-data: []
pane: []
;effect: make effect [ draw: []]
create-list-data: func [f /local n nblines line dt rule ] [
n: 1 nblines: length? f/data
clear self/tmp-data
dt: head f/data
while [ n <= nblines ] [
line: second dt/:n
; on ne prend que du debut de la ligne jusqu'au premier newline
;ou jusqu'a la fin du buffer.
line: copy/part line any [ find line newline tail line ]
; example donné par Steeve
; parse t [ some [ copy str thru ":" "func" (print str) | thru newline ]]
rule: [
some [
"set" "'" copy tmpstr thru " " [ "func" | "function" ]
(unless find tmpstr ";" [ insert/only tail self/tmp-data compose [(tmpstr) (n)]])
| copy tmpstr
thru ": " [ "func" | "function" | "make function!" | " does" | "use" ]
( unless find tmpstr ";" [ insert/only tail self/tmp-data compose [(tmpstr) (n)]] )
| thru end
]
]
parse line rule
n: n + 1
]
;probe self/tmp-data
]
feel: make feel [
resize: func [f size+][
probe "resize event de la liste /My Funcs/ "
f/size/y: f/size/y + size+/y - 5
]
detect: func [face event] [
switch event/type [
scroll-line [
scrl/data: either event/offset/y > 0 [min 1 scrl/data + .05] [max 0 sscrl/data - .05]
scroll-panel-vert bx1 scrl show scrl
]
]
event
]
]
render-list: func [ /local dt n nblines line ind lay ] [
dt: head self/tmp-data
n: 1
nblines: length? self/tmp-data
lay: make block! [ origin 0x0 space 0x0 backdrop white]
;self/data: make block! []
while [ n <= nblines ][
insert tail lay compose/deep [ text (first dt/:n) [ t/goto-line (second dt/:n) ]]
n: n + 1
]
;probe lay ; halt
bx1/pane: layout/offset lay 0x0
; support du scroller attention mode boucherie
scrl/data: 0
scrl/redrag bx1/size/y / bx1/pane/size/y
show self
]
draw-list: func [ f ] [
;1) construit la liste interne des données [ "toto" 6 "titi" 14 etc.. nom-function indice_ligne]
;2) dessine a l'écran les entrée que l'on peut affiché uniquement
create-list-data f
render-list
recycle
]
append init [
insert self/pane layout/offset compose [
origin 0x0 space 0x0 across
bx1: box white (as-pair self/size/x - 15 self/size/y )
scrl: scroller (as-pair 15 self/size/y) [ scroll-panel-vert bx1 scrl ]
] 0x0
bx1/pane: make block! []
]
]
; arec text color
area-tc: box with [
style: 'area-tc
rate: 1
text: none
para: make para [origin: 0x0 margin: 0x0]
delay: 0
ask: 'recycle ;** command to delay
color: pref/bg_color
x: 8 ;** current x size oh 1 char
y: 18 ; ** current y size of a line
origine-x: 3 * x ;** stock la position a la quelle le texte démarre apres le rendu des numéro de ligne
data: []
fnt-sz: 14
font-obj: make face/font compose [ name: (my-font) style: none offset: 0x0 size: 14 align: 'left valign: 'top ]
nb-lines: 0
xy: 0x0 ;** scroll offset
move-offset: 0x0
effect: [draw [pen none font font-obj line-width 0 translate xy]]
open-file: func [ file [file! none!] /local ][
if any [file file: first request-file][
;** data: build-data detab/size read file 4 self
data: build-data read file self
render-text/stay t 1
feel/inc-font-size self 0 ; on replace le curseur apres chargement du fichier
;l/draw-list self
]
]
new-file: func [][
file-name: %temp.txt
tmp: "Rebol []"
loop 30 [append tmp newline]
write file-name tmp
data: build-data (read file-name) self
render-text/stay self 1
feel/inc-font-size self 0
]
write-file: func [/local str-tmp n line nbline dt] [
dt: head data
str-tmp: copy ""
n: 1
nbline: length? dt
while [n <= nbline ] [
line: second dt/:n ; on transfert le pointeur vers le document dans data vers un autre pointeur
append str-tmp copy/part line any [ find line newline tail line] ;on copy jusqu'a newline ou jusqu'a la fin
append str-tmp newline
n: n + 1
]
write file-name str-tmp
]
save-file: func [/local dt ] [
dt: head data
if 0 <> length? dt [
either none? file-name [ ; data is full but we don't have a file-name
if file-name: request-file/save/title "Save as..." "save"
[
if block? file [file: first file]
write-file ]
] [
; data is full and we have a file name
write-file
]
]
]
run_scr: func [] [
save-file
;call/console rejoin [ pref/consol_path file-name ]
launch clean-path file-name ;clean-path is requested by Linux
]
search: func [ f-what [string!] /local dt n nline line str-tmp move-to current-line ][
current-line: index? data
str-tmp: ""
n: 1
dt: head data
nline: length? dt
while [ n <= nline ] [
line: second dt/:n
str-tmp: copy/part line any [ find line newline tail line ]
if find str-tmp f-what [
either current-line < ( n - 1 ) [
move-to: n - 1
;current-line: n - 1
render-text self current-line
][
move-to: n - ( current-line + 1 )
;current-line: n
render-text self move-to
]
break
]
;probe n render-text self (n - 1) break ]
n: n + 1
]
]
search-next: func [ f-what [string!] /local str-tmp dt n nline line move-to current-line] [
; l'idée c'est de se servir de la position ligne courante
;
current-line: index? data
n: current-line + 1
dt: head data
nline: length? dt
while [ n <= nline ][
line: second dt/:n
str-tmp: copy/part line any [ find line newline tail line ]
if find str-tmp f-what [
;probe str-tmp
move-to: n - current-line
;current-line: n
render-text self move-to
;probe reduce [n current-line move-to ]
break
]
n: n + 1
]
]
search-prev: func [ f-what [string!] /local str-tmp dt n nline line move-to current-line ][
current-line: index? data
nline: 1
dt: head data
n: current-line - 1
while [ n >= nline ][
line: second dt/:n
str-tmp: copy/part line any [ find line newline tail line ]
if find str-tmp f-what [
;probe str-tmp- 1
move-to: n - current-line
;current-line: n
render-text self move-to
;probe reduce [n current-line move-to ]
break
]
n: n - 1
]
]
goto-line: func [ line-gt /local move-to current-line][
current-line: index? data
either line-gt > current-line [
move-to: line-gt - current-line
current-line: line-gt
][
move-to: negate current-line - line-gt
current-line: line-gt
]
;probe move-to
render-text self move-to
show self
]
v-scroller: make face [
offset: 0x0 size: 13x0 color: none edge: none
var: 'v-scroller
size-box: 0x0
para: none
effect: [draw [pen sky line-width 2 fill-pen none box 0x0 size-box 2]]
feel: make feel [
redraw: func [f a /local p l][
if all ['show = a p: f/parent-face 0 < l: length? head p/data][
f/size/y: max 25 p/nb-lines / l * p/size/y
either (l - p/nb-lines) = 0 [ ;This is to avoid a strange bug of divide by zero
f/offset/y: (index? p/data) / 1 * (p/size/y - f/size/y)
] [f/offset/y: (index? p/data) / (l - p/nb-lines) * (p/size/y - f/size/y)]
f/size-box: f/size - 2x2
]
]
drag: func [f offset /track /local coeff][
f/parent-face/delay: 3 ;** don't perturb the scroll please
if track [return f]
if 1 <= abs coeff: offset/y / (f/size/y / f/parent-face/nb-lines) [
render-text f/parent-face to integer! coeff
if f/parent-face/cursor/selection? [
f/parent-face/feel/expand-selector f/parent-face/cursor
show f/parent-face
]
]
]
engage: func [f a e][false] ;** don't send events to the area
]
]
h-scroller: make face [
offset: 0x0 size: 0x13 color: none edge: none
var: 'h-scroller
size-box: 0x0
text: none
edge: none
font: make font [align: 'right size: 10 style: 'bold color: red]
para: make para [origin: 0x0]
max-x: 1
effect: [draw [pen sky line-width 2 fill-pen none box 0x0 size-box 2]]
feel: make feel [
redraw: func [f a /local parent][
if 'show = a [
f/show?: if f/max-x > f/parent-face/size/x [
parent: f/parent-face
f/offset/x: to integer! negate parent/xy/x / f/max-x * parent/size/x
f/size/x: to integer! (parent/size/x ** 2) / f/max-x
f/size-box: f/size - 2x2
true
]
]
]
drag: func [scroller offset /track /local parent save-x decal x][
f: scroller/parent-face
f/delay: 3 ;** don't perturb the scroll please
if track [return scroller]
if f/x <= abs offset/x [
offset/x: to integer! offset/x + 4 / f/x * f/x
save-x: f/xy/x
x: f/xy/x: min 0 max
f/size/x - scroller/max-x
f/xy/x - offset/x
;** change change skip tail boxline -2
;** as-pair negate x 1 as-pair 32 - x 18
if 0 <> decal: x - save-x [move-x f decal]
show f
]
]
engage: func [f a e][false] ;** don't send events to the area
]
]