-
Notifications
You must be signed in to change notification settings - Fork 1
/
Copy pathobbit.tcl
executable file
·2320 lines (2034 loc) · 80.6 KB
/
obbit.tcl
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
# _______________________________________________________________________ #
#
# This script contains a bunch of oo::classes. A bit of it.
#
# The ObjectProperty class allows to mix-in into
# an object the getter and setter of properties.
#
# The ObjectTheming class allows to change the ttk widgets' style.
#
# _______________________________________________________________________ #
namespace eval ::apave {
# ________________________ apave's global variables _________________________ #
variable FGMAIN #000000 ;# base fg/bg
variable BGMAIN #d9d9d9
variable FGMAIN2 #000000 ;# field fg/bg
variable BGMAIN2 #ffffff
variable FONTMAIN [font actual TkDefaultFont]
variable FONTMAINBOLD [list {*}$::apave::FONTMAIN -weight bold]
# - common options/constants of apave utils
variable _PU_opts; array set _PU_opts [list -NONE =NONE=]
variable _AP_Properties; array set _AP_Properties [list]
set _PU_opts(_ERROR_) {}
set _PU_opts(_EOL_) {}
set _PU_opts(_LOGFILE) {}
set _PU_opts(_MODALWIN_) [list]
# - main color scheme data
variable _C_
array set _C_ [list]
# - localized messages
variable _MC_
array set _MC_ [list]
namespace eval ::tk { ; # just to get localized messages
foreach m {&Abort &Cancel &Copy Cu&t &Delete E&xit &Filter &Ignore &No \
OK Open P&aste &Quit &Retry &Save {Save As} &Yes Close {To clipboard} \
Zoom Size} {
set m2 [string map {& {}} $m]
set ::apave::_MC_($m2) [string map {& {}} [msgcat::mc $m]]
}
}
# ________________________ CS - color schemes _________________________ #
## ________________________ CS variables _________________________ ##
variable _CS_
array set _CS_ [list]
# - current color scheme data
set _CS_(initall) 1
set _CS_(initWM) 1
set _CS_(isActive) 1
set _CS_(!FG) #000000
set _CS_(!BG) #b7b7b7 ;#a8bcd2 #c3c3c3 #9cb0c6 #4a6984
set _CS_(expo,tfg1) "-"
set _CS_(defFont) [font actual TkDefaultFont -family]
set _CS_(textFont) [font actual TkFixedFont -family]
set _CS_(smallFont) [font actual TkSmallCaptionFont]
set _CS_(fs) [font actual TkDefaultFont -size]
set _CS_(untouch) [list]
set _CS_(NONCS) -2
set _CS_(MINCS) -1
set _CS_(old) -3
set _CS_(TONED) [list -2 no]
set _CS_(HUE) 0
set _CS_(LABELBORDER) 0
set _CS_(CURSORWIDTH) 2
## ________________________ CS list _________________________ ##
# Colors for <MildDark CS> : 1. meanings 2. code names
# <CS> itemfg mainfg itembg mainbg itemsHL actbg actfg cursor greyed hot \
emfg embg - menubg winfg winbg itemHL2 tabHL chkHL #005...reserved... #007
# <CS> clrtitf clrinaf clrtitb clrinab clrhelp clractb clractf clrcurs clrgrey clrhotk \
fI bI --12-- bM fW bW itemHL2 tabHL chkHL #005...reserved... #007
set ::apave::_CS_(ALL) {
{{ 0: AwLight} "#141414" #151616 #dfdfde #d1d1d0 #28578a #85b4e7 #000 #444 grey #4776a9 #000 #97c6f9 - #bebebd #000 #FBFB96 #cacaca #a20000 #76b2f1 #005 #006 #007}
{{ 1: AzureLight} "#050b0d" #050b0d #ffffff #e1e1e1 #00516b #a2f2ff #000 #444 grey #007f99 #000 #92e2ef - #cccccc #000 #FBFB95 #e2e2e0 #ad0000 #76b2f1 #005 #006 #007}
{{ 2: ForestLight} "#050b0d" #050b0d #ffffff #e1e1e1 #1d5d1d #A8CCA8 #000 #185818 grey #328457 #000 #b6cbb6 - #cccccc #000 #FBFB95 #e2e2e0 #ad0000 #76b2f1 #005 #006 #007}
{{ 3: SunValleyLight} "#050b0d" #050b0d #ffffff #e1e1e1 #1056af #74c9ff #000 #444 grey #1574cd #000 #84d9ff - #cccccc #000 #FBFB95 #e2e2e0 #950000 #76b2f1 #005 #006 #007}
{{ 4: LightBrown} "#00002f" #00001a #f6f4f2 #f6f4f2 #7b3e30 #edc89b #000 #682800 grey #d59e6d #000000 #deb98c - #dfdddb #000 #FBFB95 #e3e2e0 #a30000 #900000 #005 #006 #007}
{{ 5: Grey1} "#050b0d" #050b0d #F8F8F8 #dadad8 #933232 #b8b8b8 #000 #444 grey #843e3e #000 #AFAFAF - #caccd0 #000 #FBFB95 #e0e0d8 #a20000 #76b2f1 #005 #006 #007}
{{ 6: Grey2} "#050b0d" #050b0d #f4f4f4 #F8F8F8 #5c1616 #c8c8c8 #000 #444 grey #933232 #000 #c1c1c1 - #e7e7e7 #000 #FBFB95 #e5e5e5 #a20000 #76b2f1 #005 #006 #007}
{{ 7: Rosy} "#2B122A" #000000 #FFFFFF #F6E6E9 #712371 #d0b8d3 #000 #630063 grey #954799 #000 #ceb6d1 - #e3d3d6 #000 #FBFB95 #e5e3e1 #a20000 #76b2f1 #005 #006 #007}
{{ 8: Clay} "#000000" #000000 #fdf4ed #e6dbd4 #6e300d #bcaea2 #000 #444 grey #813b3b #000 #c6b4ac - #d5c9c1 #000 #FBFB95 #e1dfde #a20000 #76b2f1 #005 #006 #007}
{{ 9: Dawn} "#08085D" #030358 #FFFFFF #e4fafa #794545 #a3dce5 #000 #195999 grey #ae4d4d #000 #99d2db - #d3e9e9 #000 #FBFB96 #dbe9ed #a20000 #76b2f1 #005 #006 #007}
{{10: Sky} "#102433" #0A1D33 #d0fdff #bdf6ff #713d3d #95ced7 #000 #195999 grey #a94848 #000 #9ad3dc - #b1eaf3 #000 #FBFB95 #c0e9ef #a20000 #76b2f1 #005 #006 #007}
{{11: Florid} "#000000" #004000 #e4fce4 #fff #8b4545 #93e493 #0F2D0F #185818 grey #9a481a #004000 #a7f8a7 - #d8e7d8 #000 #FBFB96 #d7e6d7 #a20000 #76b2f1 #005 #006 #007}
{{12: LightGreen} "#122B05" #091900 #edffed #DEF8DE #764242 #A8CCA8 #000 #185818 grey #a34242 #000 #A8CCA8 - #cde7cd #000 #FBFB96 #dee9de #a20000 #76b2f1 #005 #006 #007}
{{13: InverseGreen} "#122B05" #091900 #e5ffe1 #d7f1d7 #6d3939 #a7cba7 #000 #185818 grey #a94848 #000 #afd3af - #c9e3c9 #000 #FBFB96 #d6e8d5 #a20000 #76b2f1 #005 #006 #007}
{{14: GreenPeace} "#001000" #001000 #e1ffdd #cfe4cf #733f3f #a5c3a1 #000 #185818 grey #af4e4e #000 #9cb694 - #c1dbc1 #000 #FBFB96 #d2e1d2 #a20000 #76b2f1 #005 #006 #007}
{{15: African} "#000000" #000000 #ffffff #ffffe7 #8a4444 #ffd797 #000 #682800 #7e7e7e #a44a2d #000 #f7bf91 - #e7e7cf #000 #fbfb74 #ededd5 #a20000 #76b2f1 #005 #006 #007}
{{16: African1} "#000000" #000000 #ffffff #ebebd3 #8a4444 #ebc383 #000 #682800 #7e7e7e #9d4326 #000 #f7bf91 - #dbdbc3 #000 #fbfb74 #ededd5 #a20000 #76b2f1 #005 #006 #007}
{{17: African2} "#000000" #000000 #f7f7dc #dedbb4 #8e4848 #f2b482 #000 #682800 grey #9f4528 #000 #e6ae80 - #ccc9a2 #000 #fbfb74 #e7e7cb #a20000 #76b2f1 #005 #006 #007}
{{18: African3} "#000000" #000000 #e2deb5 #ccc9a6 #813b3b #e1a97b #000 #682800 grey #a44a2d #000 #e6ae80 - #bbb895 #000 #fbfb74 #c9c9b0 #c10000 #76b2f1 #005 #006 #007}
{{19: Notebook} "#000000" #000000 #e9e1c8 #d2ccb8 #692323 #d59d6f #000 #682800 #7e7e7e #92381b #000 #c09c77 - #dbd5c1 #000 #eded89 #dad2b9 #a20000 #76b2f1 #005 #006 #007}
{{20: Notebook1} "#000000" #000000 #dad2b9 #bfb9a5 #692323 #d59d6f #000 #682800 #707070 #92381b #000 #ba9671 - #c5bfab #000 #eded89 #ccc4ab #a20000 #76b2f1 #005 #006 #007}
{{21: Notebook2} "#000000" #000000 #d1c9b0 #b1ab97 #692323 #d59d6f #000 #682800 #606060 #92381b #000 #c38b5d - #bdb7a3 #000 #e3e37f #c1b9a0 #980000 #76b2f1 #005 #006 #007}
{{22: Notebook3} "#000000" #000000 #c2baa1 #a6a08c #793333 #cb9365 #000 #682800 #505050 #973d20 #000 #d59d6f - #b3ad99 #000 #dada76 #b2aa91 #7b1010 #76b2f1 #005 #006 #007}
{{23: Dusk} "#ececec" #ececec #1a1f21 #262b2d #90afca #4a6984 #FFF #f4f49f #585d5f #7897b2 #fff #41607b - #363b3d #000 #9d9d60 #23282a #ffc341 #8cabc6 #005 #006 #007}
{{24: SunValleyDeep} "#dfdfdf" #dddddd #131313 #323232 #aae2ff #2a627f #FFF #f4f49f #6f6f6f #7db5d2 #fff #245c79 - #3e3e3e #000 #9d9d60 #2a2a2a #efaf6f #4273eb #005 #006 #007}
{{25: AwDark} "#F0E8E8" #E7E7E7 #1f2223 #232829 #77b3f2 #215d9c #fff #f4f49f grey #5793d2 #fff #0d4988 - #313637 #000 #9d9d60 #292e2f #ffc341 #76b2f1 #005 #006 #007}
{{26: AzureDark} "#ececec" #c7c7c7 #272727 #393939 #56d5ff #0a89c1 #FFF #f4f49f grey #36b5ed #ffffff #0069a1 - #4a4a4a #000 #aaaa6d #383838 #ffc341 #76b2f1 #005 #006 #007}
{{27: ForestDark} "#ececec" #c7c7c7 #272727 #393939 #a3cda3 #217346 #FFF #42ff42 grey #84ae84 #fff #247649 - #4a4a4a #000 #aaaa6d #383838 #efaf6f #99dd99 #005 #006 #007}
{{28: SunValleyDark} "#ececec" #c7c7c7 #272727 #323232 #aae2ff #2a627f #fff #f4f49f grey #7cb4d1 #fff #245c79 - #444444 #000 #aaaa6d #343434 #ffc341 #76b2f1 #005 #006 #007}
{{29: DarkBrown} "#e0e0e0" #e0e0e0 #171717 #232323 #de9e5e #6d4d29 #fff #f4f49f #616161 #aa7d3d #dfdfdf #62421e - #303030 #000 #9d9d60 #292929 #ffc341 #76b2f1 #005 #006 #007}
{{30: Dark1} "#E0D9D9" #C4C4C4 #212121 #292929 #de9e5e #6c6c6c #fff #f4f49f #606060 #ba8d4d #000 #767676 - #363636 #000 #9d9d60 #292929 #ffc341 #76b2f1 #005 #006 #007}
{{31: Dark2} "#bebebe" #bebebe #1f1f1f #262626 #de9e5e #6b6b6b #fff #f4f49f #616161 #b28545 #000 #767676 - #323232 #000 #9d9d60 #262626 #ffc341 #76b2f1 #005 #006 #007}
{{32: Oscuro} "#f1f1f1" #ffffff #314242 #3e5959 #f1b479 #6c8787 #fff #42ff42 #afafaf #d3a051 #fff #5b7676 - #4d6868 #000 #aaaa6d #425353 #ffc341 #94e2b8 #005 #006 #007}
{{33: Oscuro1} "#e3e3e3" #f7f7f7 #233434 #304b4b #e3a66b #5e7979 #fff #42ff42 #a1a1a1 #d6a354 #fff #4e6969 - #3f5a5a #000 #aaaa6d #344545 #ffcb8b #86d4aa #005 #006 #007}
{{34: Oscuro2} "#d5d5d5" #f1f1f1 #152626 #223d3d #d5985d #506b6b #fff #42ff42 #939393 #c69344 #fff #435e5e - #314c4c #000 #9d9d60 #263737 #ffc585 #78c69c #005 #006 #007}
{{35: Oscuro3} "#c7c7c7" #eaeaea #071818 #142f2f #dfa267 #425d5d #fff #42ff42 #858585 #ba8738 #fff #324d4d - #233e3e #000 #9d9d60 #182929 #e9ae6e #6ab88e #005 #006 #007}
{{36: MildDark} "#d2d2d2" #ffffff #223142 #2D435B #3ddbdb #517997 #fff #00ffff grey #18b6b6 #fff #3e6684 - #3a5068 #000 #aaaa6d #324152 #ffc341 #76b2f1 #005 #006 #007}
{{37: MildDark1} "#c8c8c8" #f7f7f7 #1a2937 #24384f #3cdada #466e8c #fff #00ffff #757575 #19b7b7 #fff #3a6280 - #31455c #000 #aaaa6d #2b3a48 #f1b171 #76b2f1 #005 #006 #007}
{{38: MildDark2} "#e2e2e2" #f1f1f1 #0e1d2c #1B3048 #3edddd #426a88 #fff #00ffff #6c6c6c #0ba9a9 #fff #355d7b - #2a3f57 #000 #9d9d60 #1d2c3b #f4b474 #76b2f1 #005 #006 #007}
{{39: MildDark3} "#dbdbdb" #eaeaea #000c1b #031830 #35d4d4 #375f7d #fff #00ffff #6c6c6c #019f9f #fff #2f5775 - #162b43 #000 #9d9d60 #0a1f37 #e5a565 #76b2f1 #005 #006 #007}
{{40: Inkpot} "#d3d3ff" #AFC2FF #16161f #1E1E27 #e39f51 #525293 #fff #f4f49f #6e6e6e #b57535 #fff #4d4d8e - #292936 #000 #9d9d60 #202029 #e7b070 #7a7abb #005 #006 #007}
{{41: Quiverly} "#cdd8d8" #cdd8d8 #2b303b #333946 #69daff #2a627f #fff #f4f49f #757575 #46b7ee #fff #306885 - #414650 #000 #aaaa6d #323742 #ffc341 #76b2f1 #005 #006 #007}
{{42: Monokai} "#f8f8f2" #f8f8f2 #353630 #4e5044 #ffbb6d #707070 #fff #f4f49f #9a9a9a #db9e63 #000 #777777 - #46473d #000 #b7b77a #3c3d37 #ffc888 #cd994b #005 #006 #007}
{{43: TKE Default} "#dbdbdb" #dbdbdb #000000 #282828 #d3a85a #0a0acc #fff #f4f49f #6a6a6a #c58545 #fff #0000d3 - #383838 #000 #9d9d60 #1b1c1c #e5a565 #76b2f1 #005 #006 #007}
{{44: Magenta} "#E8E8E8" #F0E8E8 #381e44 #4A2A4A #ffbb6d #846484 #fff #f4f49f grey #d6995e #000 #ad8dad - #573757 #000 #9d9d60 #42284e #ffc888 #ffafff #005 #006 #007}
{{45: Red} "#ffffff" #e9e9e6 #340202 #440702 #ffbb6d #b05e5e #fff #f4f49f #828282 #ce9156 #000 #ba6868 - #521514 #000 #9d9d60 #461414 #ffcf8f #ff9a9a #005 #006 #007}
{{46: Chocolate} "#d6d1ab" #d6d1ab #251919 #402020 #ebb474 #664D4D #fff #f4f49f #828282 #c08040 #fff #583f3f - #432a2a #000 #aaaa6d #2d2121 #eeb777 #cf9292 #005 #006 #007}
{{47: Desert} "#ffffff" #ffffff #47382d #5a4b40 #ffbb6d #85766b #fff #f4f49f #a2a2a2 #d4975c #fff #7f7065 - #695a4f #000 #aaaa6d #503f34 #ffc341 #ead79b #005 #006 #007}
}
set ::apave::_CS_(STDCS) [expr {[llength $::apave::_CS_(ALL)] - 1}]
}
# _____________________________ Common procs ________________________________ #
proc ::apave::mc {msg} {
# Gets a localized version of a message.
# msg - the message
variable _MC_
if {[info exists _MC_($msg)]} {return $_MC_($msg)}
return $msg
}
## ________________________ Inits _________________________ ##
proc ::apave::initWM {args} {
# Initializes Tcl/Tk session. Used to be called at the beginning of it.
# args - options ("name value" pairs)
# If args eq "?", return a flag "need to call initWM"
if {$args eq {?}} {return $::apave::_CS_(initWM)}
if {!$::apave::_CS_(initWM)} return
::apave::withdraw .
::apave::place . 0 0 center
lassign [parseOptions $args -cursorwidth $::apave::cursorwidth -theme default \
-buttonwidth -8 -buttonborder 1 -labelborder 0 -padding 1 -cs -2 -isbaltip yes] \
cursorwidth theme butwidth butborder labborder padding cs ::apave::ISBALTIP
initBaltip
if {$theme eq {}} {set theme default}
if {$cs<-2 || $cs>47} {set cs -2}
set ::apave::_CS_(initWM) 0
set ::apave::_CS_(CURSORWIDTH) $cursorwidth
set ::apave::_CS_(LABELBORDER) $labborder
# for default theme: only most common settings
set tfg1 $::apave::_CS_(!FG)
set tbg1 $::apave::_CS_(!BG)
if {$theme ne {} && [catch {ttk::style theme use $theme}]} {
catch {ttk::style theme use default}
}
ttk::style map . \
-selectforeground [list !focus $tfg1 {focus active} $tfg1] \
-selectbackground [list !focus $tbg1 {focus active} $tbg1]
ttk::style configure . -selectforeground $tfg1 -selectbackground $tbg1
# configure separate widget types
ttk::style configure TButton -anchor center -width $butwidth \
-relief raised -borderwidth $butborder -padding $padding
ttk::style configure TMenubutton -width 0 -padding 0
# TLabel's standard style saved for occasional uses
initStyle TLabelSTD TLabel -anchor w
# ... TLabel new style
ttk::style configure TLabel -borderwidth $labborder -padding $padding
# ... Treeview colors
set twfg [ttk::style map Treeview -foreground]
set twfg [putOption selected $tfg1 {*}$twfg]
set twbg [ttk::style map Treeview -background]
set twbg [putOption selected $tbg1 {*}$twbg]
ttk::style map Treeview -foreground $twfg
ttk::style map Treeview -background $twbg
# ... TCombobox colors
ttk::style map TCombobox -fieldforeground [list {active focus} $tfg1 readonly $tfg1 disabled grey]
ttk::style map TCombobox -fieldbackground [list {active focus} $tbg1 {readonly focus} $tbg1 {readonly !focus} white]
initStyles
initPOP .
if {$cs!=-2} {obj csSet $cs}
}
#_______________________
proc ::apave::endWM {args} {
# Finishes the window management by apave, closing and clearing all.
# args - if any set, means "ask if apave's WM is finished"
if {[llength $args]} {return [info exists ::apave::_CS_(endWM)]}
set ::apave::_CS_(endWM) yes
}
#_______________________
proc ::apave::initPOP {w} {
# Initializes system popup menu (if possible) to call it in a window.
# w - window's name
bind $w <KeyPress> {
if {"%K" eq "Menu"} {
if {[winfo exists [set w [focus]]]} {
event generate $w <Button-3> -rootx [winfo pointerx .] \
-rooty [winfo pointery .]
}
}
}
}
#_______________________
proc ::apave::ttkToolbutton {} {
# Initializes Toolbutton's style, depending on CS.
# Creates also btt / brt / blt widget types to be paved,
# with images top / right / left accordingly.
lassign [obj csGet] fg1 - bg1
ttk::style map Toolbutton {*}[dict replace [ttk::style map Toolbutton] \
-foreground "pressed $fg1 active $fg1" -background "pressed $bg1 active $bg1"]
defaultAttrs btt {} {-style Toolbutton -compound top -takefocus 0} ttk::button
defaultAttrs brt {} {-style Toolbutton -compound right -takefocus 0} ttk::button
defaultAttrs blt {} {-style Toolbutton -compound left -takefocus 0} ttk::button
}
#_______________________
proc ::apave::initStyle {wt wbase args} {
# Initializes a style for a widget type, e.g. button's.
# wt - target widget type
# wbase - base widget type
# args - options of the style
ttk::style configure $wt {*}[ttk::style configure $wbase]
ttk::style configure $wt {*}$args
ttk::style map $wt {*}[ttk::style map $wbase]
ttk::style layout $wt [ttk::style layout $wbase]
}
#_______________________
proc ::apave::initStyles {} {
# Initializes miscellaneous styles, e.g. button's.
obj create_Fonts
initStyle TButtonWest TButton -anchor w -font $::apave::FONTMAIN
initStyle TButtonBold TButton -font $::apave::FONTMAINBOLD
initStyle TButtonWestBold TButton -anchor w -font $::apave::FONTMAINBOLD
initStyle TButtonWestHL TButton -anchor w -foreground [lindex [obj csGet] 4]
initStyle TMenuButtonWest TMenubutton -anchor w -font $::apave::FONTMAIN -relief raised
initStyle TreeNoHL Treeview -borderwidth 0
lassign [obj csGet] - - - - thlp tbgS tfgS - - bclr
ttk::style map TreeNoHL {*}[ttk::style map Treeview] \
-foreground [list {selected focus} $tfgS {selected !focus} $tfgS] \
-background [list {selected focus} $tbgS {selected !focus} $tbgS]
}
#_______________________
proc ::apave::initStylesFS {args} {
# Initializes miscellaneous styles, e.g. button's.
# args - font options ("name value" pairs)
::apave::obj create_Fonts
set font "$::apave::FONTMAIN $args"
set fontB "$::apave::FONTMAINBOLD $args"
initStyle TLabelFS TLabel -font $font
initStyle TCheckbuttonFS TCheckbutton -font $font
initStyle TComboboxFS TCombobox -font $font
initStyle TRadiobuttonFS TRadiobutton -font $font
initStyle TButtonWestFS TButton -anchor w -font $font
initStyle TButtonBoldFS TButton -font $fontB
initStyle TButtonWestBoldFS TButton -anchor w -font $fontB
}
#_______________________
proc ::apave::InitAwThemesPath {libdir} {
# Initializes the path to awthemes package.
# libdir - root directory of themes (where 'theme' subdirectory is)
global auto_path
set awpath [file join $libdir theme awthemes-10.4.0]
if {[lindex $auto_path 0] ne $awpath} {
set auto_path [linsert $auto_path 0 $awpath]
}
}
#_______________________
proc ::apave::InitTheme {intheme libdir} {
# Initializes app's theme.
# intheme - name of the theme
# libdir - root directory of themes (where 'theme' subdirectory is)
# Returns a list of theme name and label's border (for status bar).
# The returned values are used in ::apave::initWM procedure.
set theme {}
switch -glob -- $intheme {
azure* - sun-valley* {
set i [string last - $intheme]
set name [string range $intheme 0 $i-1]
set type [string range $intheme $i+1 end]
catch {source [file join $libdir theme $name $name.tcl]}
catch {
set_theme $type
set theme $intheme
}
set lbd 0
}
forest* {
set i [string last - $intheme]
set name [string range $intheme 0 $i-1]
set type [string range $intheme $i+1 end]
catch {
source [file join $libdir theme $name $intheme.tcl]
set theme $intheme
}
set lbd 0
}
awdark - awlight {
catch {package forget ttk::theme::$intheme}
catch {namespace delete ttk::theme::$intheme}
catch {package forget awthemes}
catch {namespace delete awthemes}
InitAwThemesPath $libdir
package require awthemes
package require ttk::theme::$intheme
set theme $intheme
set lbd 1
}
plastik - lightbrown - darkbrown {
set path [file join $libdir theme $intheme]
source [file join $path $intheme.tcl]
set theme $intheme
set lbd 1
}
default {
set theme $intheme
set lbd 1
}
}
list $theme $lbd
}
#_______________________
proc ::apave::iconifyOption {args} {
# Gets/sets "-iconify" option.
# args - if contains no arguments, gets "-iconify" option; otherwise sets it
# Option values mean:
# none - do nothing: no withdraw/deiconify
# Linux - do withdraw/deiconify for Linux
# Windows - do withdraw/deiconify for Windows
# default - do withdraw/deiconify depending on the platform
# See also: withdraw, deiconify
if {[llength $args]} {
set iconify [::apave::obj setShowOption -iconify $args]
} else {
set iconify [::apave::obj getShowOption -iconify]
}
return $iconify
}
#_______________________
proc ::apave::withdraw {w} {
# Does 'withdraw' for a window.
# w - the window's path
# See also: iconifyOption
switch -- [iconifyOption] {
none { ; # no withdraw/deiconify actions
}
Linux { ; # do it for Linux
wm withdraw $w
}
Windows { ; # do it for Windows
wm withdraw $w
wm attributes $w -alpha 0.0
}
default { ; # do it depending on the platform
wm withdraw $w
if {[::iswindows]} {
wm attributes $w -alpha 0.0
}
}
}
}
#_______________________
proc ::apave::deiconify {w} {
# Does 'deiconify' for a window.
# w - the window's path
# See also: iconifyOption
switch -- [iconifyOption] {
none { ; # no withdraw/deiconify actions
}
Linux { ; # do it for Linux
catch {wm deiconify $w ; raise $w}
}
Windows { ; # do it for Windows
if {[wm attributes $w -alpha] < 0.1} {wm attributes $w -alpha 1.0}
catch {wm deiconify $w ; raise $w}
}
default { ; # do it depending on the platform
if {[::iswindows]} {
if {[wm attributes $w -alpha] < 0.1} {wm attributes $w -alpha 1.0}
}
catch {wm deiconify $w ; raise $w}
}
}
}
#_______________________
proc ::apave::cs_Active {{flag ""}} {
# Gets/sets "is changing CS possible" flag for a whole application.
if {[string is boolean -strict $flag]} {
set ::apave::_CS_(isActive) $flag
}
return $::apave::_CS_(isActive)
}
## ________________________ Property _________________________ ##
proc ::apave::setProperty {name args} {
# Sets a property's value as "application-wide".
# name - name of property
# args - value of property
# If *args* is omitted, the method returns a property's value.
# If *args* is set, the method sets a property's value as $args.
variable _AP_Properties
switch -exact [llength $args] {
0 {return [getProperty $name]}
1 {return [set _AP_Properties($name) [lindex $args 0]]}
}
puts -nonewline stderr \
"Wrong # args: should be \"::apave::setProperty propertyname ?value?\""
return -code error
}
#_______________________
proc ::apave::getProperty {name {defvalue ""}} {
# Gets a property's value as "application-wide".
# name - name of property
# defvalue - default value
# If the property had been set, the method returns its value.
# Otherwise, the method returns the default value (`$defvalue`).
variable _AP_Properties
if {[info exists _AP_Properties($name)]} {
return $_AP_Properties($name)
}
return $defvalue
}
## ________________________ CS procs _________________________ ##
proc ::apave::cs_Non {} {
# Gets non-existent CS index
return -3
}
#_______________________
proc ::apave::cs_Min {} {
# Gets a minimum index of available color schemes
return $::apave::_CS_(MINCS)
}
proc ::apave::cs_Max {} {
# Gets a maximum index of available color schemes
expr {[llength $::apave::_CS_(ALL)] - 1}
}
proc ::apave::cs_MaxBasic {} {
# Gets a maximum index of basic color schemes
return $::apave::_CS_(STDCS)
}
## ________________________ Opfions _________________________ ##
proc ::apave::parseOptionsFile {strict inpargs args} {
# Parses argument list containing options and (possibly) a file name.
# strict - if 0, 'args' options will be only counted for,
# other options are skipped
# strict - if 1, only 'args' options are allowed,
# all the rest of inpargs to be a file name
# - if 2, the 'args' options replace the
# appropriate options of 'inpargs'
# inpargs - list of options, values and a file name
# args - list of default options
#
# The inpargs list contains:
# - option names beginning with "-"
# - option values following their names (may be missing)
# - "--" denoting the end of options
# - file name following the options (may be missing)
#
# The *args* parameter contains the pairs:
# - option name (e.g., "-dir")
# - option default value
#
# If the *args* option value is equal to =NONE=, the *inpargs* option
# is considered to be a single option without a value and,
# if present in inpargs, its value is returned as "yes".
#
# If any option of *inpargs* is absent in *args* and strict==1,
# the rest of *inpargs* is considered to be a file name.
#
# The proc returns a list of two items:
# - an option list got from args/inpargs according to 'strict'
# - a file name from inpargs or {} if absent
#
# Examples see in tests/obbit.test.
variable _PU_opts
set actopts true
array set argarray "$args yes yes" ;# maybe, tail option without value
if {$strict==2} {
set retlist $inpargs
} else {
set retlist $args
}
set retfile {}
for {set i 0} {$i < [llength $inpargs]} {incr i} {
set parg [lindex $inpargs $i]
if {$actopts} {
if {$parg eq "--"} {
set actopts false
} elseif {[catch {set defval $argarray($parg)}]} {
if {$strict==1} {
set actopts false
append retfile $parg " "
} else {
incr i
}
} else {
if {$strict==2} {
if {$defval == $_PU_opts(-NONE)} {
set defval yes
}
incr i
} else {
if {$defval == $_PU_opts(-NONE)} {
set defval yes
} else {
set defval [lindex $inpargs [incr i]]
}
}
set ai [lsearch -exact $retlist $parg]
incr ai
set retlist [lreplace $retlist $ai $ai $defval]
}
} else {
append retfile $parg " "
}
}
list $retlist [string trimright $retfile]
}
#_______________________
proc ::apave::parseOptions {opts args} {
# Parses argument list containing options.
# opts - list of options and values
# args - list of "option / default value" pairs
# It's the same as parseOptionsFile, excluding the file name stuff.
# Returns a list of options' values, according to args.
# See also: parseOptionsFile
lassign [::apave::parseOptionsFile 0 $opts {*}$args] tmp
foreach {nam val} $tmp {
lappend retlist $val
}
return $retlist
}
#_______________________
proc ::apave::extractOptions {optsVar args} {
# Gets options' values and removes the options from the input list.
# optsVar - variable name for the list of options and values
# args - list of "option / default value" pairs
# Returns a list of options' values, according to args.
# See also: parseOptions
upvar 1 $optsVar opts
set retlist [::apave::parseOptions $opts {*}$args]
foreach {o v} $args {
set opts [::apave::removeOptions $opts $o]
}
return $retlist
}
#_______________________
proc ::apave::getOption {optname args} {
# Extracts one option from an option list.
# optname - option name
# args - option list
# Returns an option value or "".
# Example:
# set options [list -name some -value "any value" -tip "some tip"]
# set optvalue [::apave::getOption -tip {*}$options]
set optvalue [lindex [::apave::parseOptions $args $optname ""] 0]
return $optvalue
}
#_______________________
proc ::apave::putOption {optname optvalue args} {
# Replaces or adds one option to an option list.
# optname - option name
# optvalue - option value
# args - option list
# Returns an updated option list.
set optlist {}
set doadd true
foreach {a v} $args {
if {$a eq $optname} {
set v $optvalue
set doadd false
}
lappend optlist $a $v
}
if {$doadd} {lappend optlist $optname $optvalue}
return $optlist
}
#_______________________
proc ::apave::removeOptions {opts args} {
# Removes some options from a list of options.
# opts - list of options and values
# args - list of option names to remove
# The `opts` may contain "key value" pairs and "alone" options
# without values.
# To remove "key value" pairs, `key` should be an exact name.
# To remove an "alone" option, `key` should be a glob pattern with `*`.
foreach key $args {
while {[incr maxi]<99} {
if {[set i [lsearch -exact $opts $key]]>-1} {
catch {
# remove a pair "option value"
set opts [lreplace $opts $i $i]
set opts [lreplace $opts $i $i]
}
} elseif {[string first * $key]>=0 && \
[set i [lsearch -glob $opts $key]]>-1} {
# remove an option only
set opts [lreplace $opts $i $i]
} else {
break
}
}
}
return $opts
}
## ________________________ Text file _________________________ ##
proc ::apave::error {{fileName ""}} {
# Gets the error's message at reading/writing.
# fileName - if set, return a full error messageat opening file
variable _PU_opts
if {$fileName eq ""} {
return $_PU_opts(_ERROR_)
}
return "Error of access to\n\"$fileName\"\n\n$_PU_opts(_ERROR_)"
}
#_______________________
proc ::apave::textsplit {textcont} {
# Splits a text's contents by EOLs. Those inventors of EOLs...
# textcont - text's contents
split [string map [list \r\n \n \r \n] $textcont] \n
}
#_______________________
proc ::apave::textEOL {{EOL "-"}} {
# Gets/sets End-of-Line for text reqding/writing.
# EOL - LF, CR, CRLF or {}
# If EOL omitted or equals to {} or "-", return the current EOL.
# If EOL equals to "translation", return -translation option or {}.
variable _PU_opts
if {$EOL eq "-"} {return $_PU_opts(_EOL_)}
if {$EOL eq "translation"} {
if {$_PU_opts(_EOL_) eq ""} {return ""}
return "-translation $_PU_opts(_EOL_)"
}
set _PU_opts(_EOL_) [string trim [string tolower $EOL]]
}
#_______________________
proc ::apave::textChanConfigure {channel {coding {}} {eol {}}} {
# Configures a channel for text file.
# channel - the channel
# coding - if set, defines encoding of the file
# eol - if set, defines EOL of the file
if {$coding eq {}} {
chan configure $channel -encoding utf-8
} else {
chan configure $channel -encoding $coding
}
if {$eol eq {}} {
chan configure $channel {*}[::apave::textEOL translation]
} else {
chan configure $channel -translation $eol
}
}
#_______________________
proc ::apave::logName {fname} {
# Sets a log file's name.
# fname - file name
# If fname is {}, disables logging.
variable _PU_opts;
set _PU_opts(_LOGFILE) [file normalize $fname]
}
#_______________________
proc ::apave::logMessage {msg {lev 16}} {
# Logs messages to a log file.
# msg - the message
# lev - maximum level for [info level] to introspect calls
# A log file's name is set by _PU_opts(_LOGFILE). If it's blank,
# no logging is made.
variable _PU_opts;
if {$_PU_opts(_LOGFILE) eq {}} return
set chan [open $_PU_opts(_LOGFILE) a]
set dt [clock format [clock seconds] -format {%d%b'%y %T}]
set msg "$dt $msg"
for {set i $lev} {$i>0} {incr i -1} {
catch {
lassign [info level -$i] p1 p2
if {$p1 eq {my}} {append p1 " $p2"}
append msg " / $p1"
}
}
puts $chan $msg
close $chan
if {[incr _PU_opts(_LOGNN)]==1} {puts $_PU_opts(_LOGFILE):}
puts $_PU_opts(_LOGNN):\ $msg
}
#_______________________
proc ::apave::readTextFile {fname {varName ""} {doErr 0} args} {
# Reads a text file.
# fname - file name
# varName - variable name for file content or ""
# doErr - if 'true', exit at errors with error message
# Returns file contents or "".
variable _PU_opts
if {$varName ne {}} {upvar $varName fvar}
if {[catch {set chan [open $fname]} _PU_opts(_ERROR_)]} {
if {$doErr} {error [::apave::error $fname]}
set fvar {}
} else {
set enc [::apave::getOption -encoding {*}$args]
set eol [string tolower [::apave::getOption -translation {*}$args]]
if {$eol eq {}} {set eol auto} ;# let EOL be autodetected by default
::apave::textChanConfigure $chan $enc $eol
set fvar [read $chan]
close $chan
logMessage "read $fname"
}
return $fvar
}
#_______________________
proc ::apave::writeTextFile {fname {varName ""} {doErr 0} {doSave 1} args} {
# Writes to a text file.
# fname - file name
# varName - variable name for file content or ""
# doErr - if 'true', exit at errors with error message
# doSave - if 'true', saves an empty file, else deletes it
# Returns "yes" if the file was saved successfully.
variable _PU_opts
if {$varName ne {}} {
upvar $varName contents
} else {
set contents {}
}
set res yes
if {!$doSave && [string trim $contents] eq {}} {
if {[catch {file delete $fname} _PU_opts(_ERROR_)]} {
set res no
} else {
logMessage "delete $fname"
}
} elseif {[catch {set chan [open $fname w]} _PU_opts(_ERROR_)]} {
set res no
} else {
set enc [::apave::getOption -encoding {*}$args]
set eol [string tolower [::apave::getOption -translation {*}$args]]
::apave::textChanConfigure $chan $enc $eol
puts -nonewline $chan $contents
close $chan
logMessage "write $fname"
}
if {!$res && $doErr} {error [::apave::error $fname]}
return $res
}
#_______________________
proc ::apave::undoIn {wtxt} {
# Enters a block of undo/redo for a text widget.
# wtxt - text widget's path
# Run before massive changes of the text, to have Undo/Redo done at one blow.
# See also: undoOut
$wtxt configure -autoseparators no
$wtxt edit separator
}
#_______________________
proc ::apave::undoOut {wtxt} {
# Exits a block of undo/redo for a text widget.
# wtxt - text widget's path
# Run after massive changes of the text, to have Undo/Redo done at one blow.
# See also: undoIn
$wtxt edit separator
$wtxt configure -autoseparators yes
}
## ________________________ Binds _________________________ ##
proc ::apave::bindToEvent {w event args} {
# Binds an event on a widget to a command.
# w - the widget's path
# event - the event
# args - the command
::baltip::my::BindToEvent $w $event {*}$args
}
#_______________________
proc ::apave::bindTextagToEvent {w tag event args} {
# Binds an event on a text tag to a command.
# w - the widget's path
# tag - the tag
# event - the event
# args - the command
::baltip::my::BindTextagToEvent $w $tag $event {*}$args
}
#_______________________
proc ::apave::bindCantagToEvent {w tag event args} {
# Binds an event on a canvas tag to a command.
# w - the widget's path
# tag - the tag
# event - the event
# args - the command
::baltip::my::BindCantagToEvent $w $tag $event {*}$args
}
## ________________________ Helpers _________________________ ##
proc ::apave::InfoWindow {{val ""} {w .} {modal no} {var ""} {regist no}} {
# Registers/unregisters windows. Also sets/gets 'count of open modal windows'.
# val - current number of open modal windows
# w - root window's path
# modal - yes, if the window is modal
# var - variable's name for tkwait
# regist - yes or no for registering/unregistering
# See also: APaveBase::showWindow
variable _PU_opts
if {$modal || $regist} {
set info [list $w $var $modal]
set i [lsearch -exact $_PU_opts(_MODALWIN_) $info]
catch {set _PU_opts(_MODALWIN_) [lreplace $_PU_opts(_MODALWIN_) $i $i]}
if {$regist} {
lappend _PU_opts(_MODALWIN_) $info
}
set res [IntStatus . MODALS $val]
} else {
set res [IntStatus . MODALS]
}
return $res
}
#_______________________
proc ::apave::InfoFind {w modal} {
# Searches data of a window in a list of registered windows.
# w - root window's path
# modal - yes, if the window is modal
# Returns: the window's path or "" if not found.
# See also: InfoWindow
variable _PU_opts
foreach winfo [lrange $_PU_opts(_MODALWIN_) 1 end] { ;# skip 1st window
incr i
lassign $winfo w1 var1 modal1
if {[winfo exists $w1]} {
if {$w eq $w1 && ($modal && $modal1 || !$modal && !$modal1)} {
return $w1
}
} else {
catch {set _PU_opts(_MODALWIN_) [lreplace $_PU_opts(_MODALWIN_) $i $i]}
}
}
return {}
}
#_______________________
proc ::apave::TreSelect {w idx} {
# Selects a treeview item.
# w - treeview's path
# idx - item index
set items [$w children {}]
catch {
set it [lindex $items $idx]
$w see $it
$w focus $it
$w selection set $it ;# generates <<TreeviewSelect>>
}
}
#_______________________
proc ::apave::LbxSelect {w idx} {
# Selects a listbox item.
# w - listbox's path
# idx - item index
$w activate $idx
$w see $idx