-
Notifications
You must be signed in to change notification settings - Fork 1
/
tpmg
executable file
·1484 lines (1420 loc) · 43.1 KB
/
tpmg
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
#!/usr/bin/env tclsh
package require Tk
# force utf-8 encoding (freewrap workaround)
if {[encoding system] ne "utf-8"} {encoding system "utf-8"}
################################################################################
# VARIABLES
#
namespace eval tpmg {
variable version {0.7.3}
variable script {}
variable return {}
variable response {}
variable ok {___tpmgOK___}
variable cancel {___tpmgCancel___}
variable error {___tpmgError___}
# variables to use as globals
variable text {}
variable password {}
variable value 0
# array for List dialog
array set list {}
# array for Calendar dialog
array set date {
format {%a %d %b %Y}
days {Sun Mon Tue Wed Thu Fri Sat}
months {0 January February March April May \
June July August September October November December
}
}
set now [clock scan now]
set date(year) [clock format $now -format "%Y"]
set date(month) [clock format $now -format "%m"]
set date(day) [clock format $now -format "%d"]
# namespace and variables for the help system
namespace eval help {
variable Basic {
usage: tpmg <options> <details>
basic options:
dialog windows:
--calendar display Calendar dialog
--color display Color Select dialog
--directory display Directory Select dialog
--entry display Entry dialog
--filesave display File Save dialog
--fileselect display File Select dialog
--information display Information dialog
--list display List dialog
--notification display Notification popup
--password display Password dialog
--progress display Progress dialog
--scale display Scale dialog
--text display Text dialog
help:
--help this help
--help all print options for all available dialogs
--help <dialog> print all available options for <dialog>
other:
--version print version information
}
variable Calendar {
Display a date selection dialog.
Date format can be customized with "--format" option.
Format options are almost the same with "date" utility from "coreutils".
See "man n clock" (tcl) or "man 1 date" (coreutils) for details.
options for Calendar dialog:
--title="string" set window title [default: "Select Date"]
--format="string" date format [default: "%a %d %b %Y"]
--day="integer" set initial day [default: current day]
--month="integer" set initial month [default: current month]
--year="integer" set initial year [default: current year]
--help this help
returns: selected date on 'OK', 1 on 'Cancel', 255 on error
example: tpmg --calendar --title="Select a date" --format="%d%m%y" --day="18" --month="3" --year="1986"
}
variable Color {
Display a color selection dialog. Appearance depends on platform.
options for Color Select dialog:
--title="string" set window title [default: "Select a Color"]
--color="#hexcolor" set initial color [default: "#d9d9d9"]
--help this help
returns: color hex code on 'OK', 1 on 'Cancel', 255 on error
example: tpmg --color --title="Choose Color" --color="#eed421"
}
variable Directory {
Display a directory selection dialog. Appearance depends on platform.
options for Directory Select dialog:
--title="string" set window title [default: "Select a Directory"]
--exist directory must exist
--help this help
returns: directory path on 'OK', 1 on 'Cancel', 255 on error
example: tpmg --directory --title="Select a Directory" --exist
}
variable Entry {
Display any number of entry dialogs. Default is one.
Configuration is done through "--text" option, with comma separated label texts.
options for Entry dialog:
--title="string" set window title [default: "Enter Text"]
--text="csv" set label text [default: "Enter text below:"]
--default="csv" set initial text
--help this help
returns: entries' list on 'OK', 1 on 'Cancel', 255 on error
example: tpmg --entry --title="Personal Information" --text="First name:,Last name:,email:" --default=",,email@example.com"
}
variable FileSave {
Display a file save dialog. Appearance depends on platform.
options for File Save dialog:
--title="string" set window title [default: "Save File"]
--ext="csv" set filetype filter [default: show all]
--file="filepath" set initial file
--noconfirm do not confirm on overwrite [default: confirm]
--help this help
returns: file path on 'Save', 1 on 'Cancel', 255 on error
example: tpmg --filesave --title="Save File" --file="~/myfile.txt" --noconfirm
}
variable FileSelect {
Display a file selection dialog. Appearance depends on platform.
options for Files Select dialog:
--title="string" set window title [default: "Select Files"]
--ext="csv" set filetype filter [default: show all]
--single single selection
--help this help
returns: file path on 'Open', 1 on 'Cancel', 255 on error
on multiple selection, returns list
example: tpmg --fileselect --title="Select a File" --ext="*.txt,*" --single
}
variable Information {
Display an information dialog.
Supports icons for info, error, question and warning.
Can have a combination of buttons, as okcancel, yesno, retrycancel, etc.
Main message is bold and equals to the first non-option string.
All other strings are message details, with every string represent a line.
options for Information dialog:
--title="string" set window title
--icon="info|error|question|warning"
icon to use in dialog [default: "info"]
--button="ok|okcancel|yesno|yesnocancel|retrycancel|abortretryignore"
buttons to use in dialog [default: "ok"]
"first string" main message (bold)
"other" "strings" message details (every string in a new line)
--help this help
returns: the button name (ok, cancel, yes, no, abort, retry, ignore)
example: tpmg --information --title="Are you sure?" --icon="question" --button="yesnocancel" "All data will be wiped!" "This action cannot be undone." "Proceed?"
}
variable List {
Display an option list with radio buttons, combobox, check buttons or menu items.
Default type is check buttons.
Configuration is done through "--options" option, with comma separated list.
"Default" option set preselected option in a radio/combobox/menu list, or set "true" values in the check list.
options for List dialog:
--title="string" set window title [default: "Set Options"]
--text="string" set label text [default: "Set options below:"]
--type="radio|combo|menu|check"
set list type [default: "check"]
--options="csv" set options list
--default="radio:string|combo:string|menu:string|check:csv"
radio: default radio value
combo: default radio value
menu : default menu option
check: set <option> "true"
--anchor="w|e|c" placement in window [default: "w"]
--edit can edit combobox [default: read only]
--help this help
returns:
radio: selected option on 'OK', 1 on 'Cancel', 255 on error
combo: selected option on 'OK', 1 on 'Cancel', 255 on error
menu : clicked item on "Enter" key, 1 on 'Cancel', 255 on error
check: true/false list on 'OK', 1 on 'Cancel', 255 on error
example: tpmg --list --title="Select filetype" --text="Select filetype:" --type="radio" --options="Text File,RTF Document,Word Document" --default="Text File" --anchor="w"
}
variable Notification {
Display a notification popup.
Does not need a running notification daemon.
Notification popup will close when clicked, or after "delay" seconds.
options for Notification popup:
--title="string" set window title [default: "tpmg Notification"]
--delay="integer" set delay (seconds) [default: 5]
--geometry="{width}x{height}±X±Y" [default: upper right]
width : popup width in pixels
height: popup height in pixels
X : popup X position on screen
Y : popup Y position on screen
"width"x"height" or "±X±Y" can be omitted.
--icon="one of: info,error,question,warning"
set popup icon [default: no icon]
--background="#hexcolor" set background color [default: "orange"]
--foreground="#hexcolor" set foreground color [default: "black"]
"other" "strings" text to show (every string in a new line)
--help this help
returns: 0 after close, 255 on error
example: tpmg --notification --title="Notify Sith Lord" --delay="10" --geometry="200x50+0+0" --icon="error" --background="#f8a300" --foreground="#000000" "System failure" "Cannot execute order 66"
}
variable Password {
Display a classic username/password dialog.
Username entry can be omitted.
Password entry hides text with asterisks.
options for Password dialog:
--title="string" set window title [default: "Login As"]
--nousername hide "Username" entry
--help this help
returns: username and password list on 'OK', 1 on 'Cancel', 255 on error
--nousername: returns only password on 'OK'
example: tpmg --password --title="Welcome $USER" --nousername
}
variable Progress {
Display a progress bar dialog.
Progress dialog reads data from stdin line by line.
Lines must be prefixed with "tpmg:", or are ignored.
If text is a number, the progress bar advances to that number.
Else, it updates the label text.
options for Progress dialog:
--title="string" set window title [default: "Show Progress"]
--text="string" set label text
--color="#hexcolor" set progress bar color [default: Tk default]
--pulse pulsating progress bar
--auto close window on completion
--max="integer" set max bar value [default: "100"]
--value="integer" set initial bar value [default: "0"]
--help this help
returns: 0 on 'OK', 1 on 'Cancel', 255 on error
bugs: wrong behavior on pulsating progress bar (not critical)
example:
#!/usr/bin/env sh
(
echo "tpmg:Starting jobs..."; sleep 1
echo "tpmg:30"; echo "tpmg:Setting variables..."; sleep 1
echo "tpmg:70"; echo "tpmg:Clearing cache..."; sleep 1
echo "This line will be ignored"; sleep 1
echo "tpmg:100"; echo "tpmg:Done."
) | tpmg --progress --color="#948b84" --auto
}
variable Scale {
Display a scale dialog.
Min, max and current value can be configured.
options for Scale dialog:
--title="string" set window title [default: "Adjust Value"]
--text="string" set label text [default: "Adjust value below:"]
--min="integer" set min value [default: "0"]
--max="integer" set max value [default: "100"]
--value="integer" set initial value [default: "0"]
--step="integer" set step size [default: "1"]
--help this help
returns: scale value on 'OK', 1 on 'Cancel', 255 on error
example: tpmg --scale --title="Adjust Transparency" --text="Choose window transparency:" --min="0" --max="100" --value="20"
}
variable Text {
Display a text information dialog.
Text can be from file, from command line in the form of every string is a new line and from standard input.
In case of multiple inputs, will concatenate the text, with file->string->stdin hierarchy.
options for Text dialog:
--title="string" set window title [default: "Show Text"]
--file="filepath" file to show
--edit can edit text [default: cannot edit]
--font="{font name} size bold|italic|underline|overstrike"
font to use [default: "TkFixedFont"]
"other" "non option" "strings"
text body (every string in a new line)
--help this help
returns: 0 on 'OK', 1 on 'Cancel', 255 on error
example: tpmg --text --title="README" --file="~/README.txt" --edit --font="{DejaVu Sans Mono} 12 bold"
}
# end of namespace tpmg::help
}
#end of namespace tpmg
}
################################################################################
# CALENDAR DIALOG
#
# most of calendar code is taken from:
# http://tcltk.free.fr/source/date.tcl
# reference:
# https://wiki.tcl-lang.org/page/An+i15d+date+chooser
# credits to Richard Suchenwirth
#
# calendar initialization
proc tpmg::calendarInit {} {
tk::canvas .calendar -bg white -width 200 -height 180
.calendar bind day <1> {
set item [%W find withtag current]
set tpmg::date(day) [%W itemcget $item -text]
tpmg::calendarDraw
}
tpmg::Button .calendar 20 30 < {tpmg::calendarAdjust -1 0}
tpmg::Button .calendar 100 30 > {tpmg::calendarAdjust 1 0}
tpmg::Button .calendar 120 30 < {tpmg::calendarAdjust 0 -1}
tpmg::Button .calendar 170 30 > {tpmg::calendarAdjust 0 1}
tpmg::calendarDraw
}
# adjust month/year values
proc tpmg::calendarAdjust {dmonth dyear} {
incr tpmg::date(year) $dyear
incr tpmg::date(month) $dmonth
if {$tpmg::date(month) > 12} {
set tpmg::date(month) 1
incr tpmg::date(year)
}
if {$tpmg::date(month) < 1} {
set tpmg::date(month) 12
incr tpmg::date(year) -1
}
set dmax [tpmg::calendarDays $tpmg::date(month) $tpmg::date(year)]
if {$dmax < $tpmg::date(day)} {
set tpmg::date(day) $dmax
}
tpmg::calendarDraw
}
# draw calendar
proc tpmg::calendarDraw {} {
foreach tag {title otherday day} {
.calendar delete $tag
}
set x0 20; set x $x0; set y 50
set dx 25; set dy 20
set xmax [expr {${x0} + ${dx} * 6}]
set date0 [clock scan ${tpmg::date(month)}/${tpmg::date(day)}/${tpmg::date(year)}]
set tpmg::date(date) [clock format $date0 -format $tpmg::date(format)]
set tmonth [lindex $tpmg::date(months) $tpmg::date(month)]
set tyear $tpmg::date(year)
.calendar create text [expr {($xmax + $dx) / 2}] 10 \
-text $tpmg::date(date) -fill black -tag title
.calendar create text 60 30 -text $tmonth -fill blue -tag title
.calendar create text 145 30 -text $tyear -fill blue -tag title
foreach i $tpmg::date(days) {
.calendar create text $x $y -text $i -fill blue -tag title
incr x $dx
}
set first ${tpmg::date(month)}/1/${tpmg::date(year)}
set weekday [clock format [clock scan $first] -format %w]
set x [expr {$x0 + $weekday * $dx}]
set x1 $x; set offset 0
incr y $dy
while {$weekday} {
set t [clock scan "$first [incr offset] days ago"]
scan [clock format $t -format "%d"] %d day
.calendar create text [incr x1 -$dx] $y -text $day \
-fill grey -tag otherday
incr weekday -1
}
set dmax [tpmg::calendarDays $tpmg::date(month) $tpmg::date(year)]
for {set d 1} {$d <= $dmax} {incr d} {
set id [.calendar create text $x $y -text $d -tag day]
if {$d == $tpmg::date(day)} {
eval .calendar create rect [.calendar bbox $id] \
-fill orange -outline orange -tag day
}
.calendar raise $id
if {[incr x $dx] > $xmax} {set x $x0; incr y $dy}
}
if {$x != $x0} {
for {set d 1} {$x <= $xmax} {incr d; incr x $dx} {
.calendar create text $x $y -text $d -fill grey -tag otherday
}
}
}
# calculate days
proc tpmg::calendarDays {month year} {
if {$month == 12} {set month 0; incr year}
clock format [clock scan "[incr month]/1/${year} 1 day ago"] -format %d
}
# '<' '>' buttons
proc tpmg::Button {w x y text command} {
set txt [$w create text $x $y -text " $text "]
set btn [eval $w create rect [$w bbox $txt] -fill white -outline white]
$w raise $txt
foreach i [list $txt $btn] {
$w bind $i <1> $command
}
}
# main calendar dialog
proc tpmg::Calendar {args} {
set title "Select Date"
foreach option $args {
switch -glob -- $option {
--title=* {
set title [string range $option 8 end]
}
--format=* {
set tpmg::date(format) [string range $option 9 end]
}
--day=* {
for {set i 1} {$i <= 31} {incr i} {
lappend valid $i
}
set day [string range $option 6 end]
if {$day ni $valid} {
puts stderr "not a valid day: $day"
puts stderr "use one of: $valid"
return $tpmg::error
}
set tpmg::date(day) $day
}
--month=* {
for {set i 1} {$i <= 12} {incr i} {
lappend valid $i
}
set month [string range $option 8 end]
if {$month ni $valid} {
puts stderr "not a valid month: $month"
puts stderr "use one of: $valid"
return $tpmg::error
}
set tpmg::date(month) $month
}
--year=* {
set year [string range $option 7 end]
if {![string is integer $year]} {
puts stderr "not a year: $year"
return $tpmg::error
}
set tpmg::date(year) $year
}
--help {
tpmg::Help "calendar"
exit 0
}
default {
puts stderr "unknown option: $option"
tpmg::Help "calendar" stderr
return $tpmg::error
}
}
}
tpmg::calendarInit
ttk::frame .buttons
ttk::button .ok -text "OK" -command {
set tpmg::response $tpmg::date(date)
}
ttk::button .cancel -text "Cancel" -command {
set tpmg::response $tpmg::cancel
}
bind all <Return> {.ok invoke}
bind all <Escape> {.cancel invoke}
pack .ok .cancel -in .buttons -padx 10 -pady 5 -side left
pack .calendar -fill both -expand true
pack .buttons
wm title . $title
wm resizable . 0 0
focus .ok
vwait tpmg::response
return $tpmg::response
}
################################################################################
# COLOR DIALOG
#
proc tpmg::Color {args} {
set title "Select a Color"
set color "#d9d9d9"
foreach option $args {
switch -glob -- $option {
--title=* {
set title [string range $option 8 end]
}
--color=* {
set color [string range $option 8 end]
}
--help {
tpmg::Help "color"
exit 0
}
default {
puts stderr "unknown option: $option"
tpmg::Help "color" stderr
return $tpmg::error
}
}
}
wm withdraw .
if {[catch {set response \
[tk_chooseColor -title $title -initialcolor $color]} msg]} {
puts stderr $msg
return $tpmg::error
}
if {$response eq ""} {return $tpmg::cancel}
return $response
}
################################################################################
# DIRECTORY DIALOG
#
proc tpmg::Directory {args} {
set title "Select a Directory"
set exist "false"
foreach option $args {
switch -glob -- $option {
--title=* {
set title [string range $option 8 end]
}
--exist {
set exist "true"
}
--help {
tpmg::Help "directory"
exit 0
}
default {
puts stderr "unknown option: $option"
tpmg::Help "directory" stderr
return $tpmg::error
}
}
}
wm withdraw .
set response [file nativename [tk_chooseDirectory -title $title \
-mustexist $exist]]
if {$response eq ""} {return $tpmg::cancel}
return $response
}
################################################################################
# ENTRY DIALOG
#
proc tpmg::Entry {args} {
set title "Enter Text"
set text [list "Enter text below:"]
set default ""
foreach option $args {
switch -glob -- $option {
--title=* {
set title [string range $option 8 end]
}
--text=* {
set text [split [string range $option 7 end] ","]
set tpmg::value [llength $text]
}
--default=* {
set default [split [string range $option 10 end] ","]
}
--help {
tpmg::Help "entry"
exit 0
}
default {
puts stderr "unknown option: $option"
tpmg::Help "entry" stderr
return $tpmg::error
}
}
}
if {$text eq ""} {
puts stderr "no entries defined"
tpmg::Help "entry" stderr
return $tpmg::error
}
set i 0
foreach item $text {
set tpmg::list($i) ""
set entry [string cat "." $i]
set frame [string cat $entry "frame"]
ttk::labelframe $frame -relief flat -text $item
ttk::entry $entry -textvariable tpmg::list($i)
if {$default ne ""} {
set tpmg::list($i) [lindex $default $i]
}
pack $entry -in $frame
pack $frame -pady 5
incr i
}
ttk::button .ok -text "OK" -command {
for {set i 0} {$i <= $tpmg::value} {incr i} {
lappend tpmg::response $tpmg::list($i)
}
}
ttk::button .cancel -text "Cancel" -command {
set tpmg::response $tpmg::cancel
}
pack .ok .cancel -padx 10 -pady 5 -side left
bind all <Return> {.ok invoke}
bind all <Escape> {.cancel invoke}
wm title . $title
wm resizable . 0 0
# focus first entry
focus .0
vwait tpmg::response
return $tpmg::response
}
################################################################################
# FILESAVE DIALOG
#
proc tpmg::FileSave {args} {
set title "Save File"
set filetypes ""
set file ""
set confirm "true"
foreach option $args {
switch -glob -- $option {
--title=* {
set title [string range $option 8 end]
}
--ext=* {
set extlist [split [string range $option 6 end] ","]
foreach ext $extlist {
lappend filetypes [list [string toupper $ext] $ext]
}
}
--file=* {
set file [file nativename [string range $option 7 end]]
}
--noconfirm {
set confirm "false"
}
--help {
tpmg::Help "filesave"
exit 0
}
default {
puts stderr "unknown option: $option"
tpmg::Help "filesave" stderr
return $tpmg::error
}
}
}
wm withdraw .
set response [file nativename [tk_getSaveFile -title $title \
-filetypes $filetypes -confirmoverwrite $confirm -initialfile $file]]
if {$response eq ""} {return $tpmg::cancel}
return $response
}
################################################################################
# FILESELECT DIALOG
#
proc tpmg::FileSelect {args} {
set title "Select Files"
set filetypes ""
set single "true"
foreach option $args {
switch -glob -- $option {
--title=* {
set title [string range $option 8 end]
}
--ext=* {
set extlist [split [string range $option 6 end] ","]
foreach ext $extlist {
lappend filetypes [list [string toupper $ext] $ext]
}
}
--single {
set single "false"
}
--help {
tpmg::Help "fileselect"
exit 0
}
default {
puts stderr "unknown option: $option"
tpmg::Help "fileselect" stderr
return $tpmg::error
}
}
}
wm withdraw .
set response [file nativename [tk_getOpenFile -title $title \
-filetypes $filetypes -multiple $single]]
if {$response eq ""} {return $tpmg::cancel}
return $response
}
################################################################################
# INFORMATION DIALOG
#
proc tpmg::Information {args} {
set default ""
set icon "info"
set type "ok"
set title ""
set message ""
set detail [list]
foreach option $args {
switch -glob -- $option {
--title=* {
set title [string range $option 8 end]
}
--icon=* {
set valid [list error info question warning]
set icon [string range $option 7 end]
if {$icon ni $valid} {
puts stderr "unknown --icon option: $icon"
puts stderr "use one of: $valid"
return $tpmg::error
}
}
--button=* {
set valid [list ok okcancel yesno yesnocancel retrycancel abortretrycancel]
set type [string range $option 9 end]
if {$type ni $valid} {
puts stderr "unknown --button option: ${type}"
puts stderr "use one of: $valid"
return $tpmg::error
}
}
--help {
tpmg::Help "information"
exit 0
}
default {
if {$message eq ""} {
set message $option
} else {
lappend detail $option
}
}
}
}
# define default button (on Enter/Return)
switch -- [string index $type 0] {
o {set default "ok"}
y {set default "yes"}
r {set default "retry"}
a {set default "retry"}
}
# every string in details is a line
if {$detail ne ""} {
set detail [join $detail "\n"]
}
set cmd [list tk_messageBox]
foreach config [list title icon type default message detail] {
lappend cmd [string cat "-" $config] [subst $[subst $config]]
}
wm withdraw .
if {[catch {set response [{*}$cmd]} msg]} {
puts stderr $msg
return $tpmg::error
} else {
return $response
}
}
################################################################################
# LIST DIALOG
#
proc tpmg::List {args} {
set title "Set Options"
set text "Set options below:"
set type "check"
set options ""
set anchor "w"
set default ""
set state "readonly"
foreach option $args {
switch -glob -- $option {
--title=* {
set title [string range $option 8 end]
}
--text=* {
set text [string range $option 7 end]
}
--type=* {
set valid [list radio combo check menu]
set type [string range $option 7 end]
if {$type ni $valid} {
puts stderr "unknown --type option: $type"
puts stderr "use one of: $valid"
return $tpmg::error
}
}
--options=* {
set options [split [string range $option 10 end] ","]
set tpmg::value [llength $options]
}
--anchor=* {
set valid [list w e c]
set anchor [string range $option 9 end]
if {$anchor ni $valid} {
puts stderr "unknown --anchor option: $anchor"
puts stderr "use one of: $valid"
return $tpmg::error
}
}
--default=* {
set default [split [string range $option 10 end] ","]
}
--edit {
set state "normal"
}
--help {
tpmg::Help "list"
exit 0
}
default {
puts stderr "unknown option: $option"
tpmg::Help "list" stderr
return $tpmg::error
}
}
}
if {$options eq ""} {
puts stderr "no options defined"
tpmg::Help "list" stderr
return $tpmg::error
}
ttk::labelframe .list -relief flat -text $text
switch -- $type {
radio {
set tpmg::list(radio) [join $default]
set i 0
foreach item $options {
set litem [string cat "." $i]
ttk::radiobutton $litem -text $item -value $item \
-variable tpmg::list(radio)
pack $litem -in .list -anchor $anchor
incr i
}
ttk::button .ok -text "OK" -command {
lappend tpmg::response $tpmg::list(radio)
}
}
combo {
set tpmg::list(options) $options
set tpmg::list(combo) [join $default]
ttk::combobox .combo -state $state \
-values $tpmg::list(options) \
-textvariable tpmg::list(combo)
pack .combo -in .list -anchor $anchor
ttk::button .ok -text "OK" -command {
lappend tpmg::response $tpmg::list(combo)
}
}
menu {
set i 0
foreach item $options {
set tpmg::list($i) $item
set btn [string cat "." $i]
ttk::button $btn -style Toolbutton -text $item -command [list \
lappend tpmg::response $tpmg::list($i)
]
if {$item in $default} {
ttk::button .ok -text "OK" -command [list \
lappend tpmg::response $tpmg::list($i)
]
bind all <Return> {.ok invoke}
}
pack $btn -in .list -padx 5 -pady 1 -anchor $anchor
incr i
}
}
default {
set i 0
foreach item $options {
set litem [string cat "." $i]
if {$item in $default} {
set tpmg::list($i) "true"
} else {
set tpmg::list($i) "false"
}
ttk::checkbutton $litem -text $item \
-onvalue "true" -offvalue "false" \
-variable tpmg::list($i)
pack $litem -in .list -anchor $anchor
incr i
}
ttk::button .ok -text "OK" -command {
for {set i 0} {$i <= $tpmg::value} {incr i} {
lappend tpmg::response $tpmg::list($i)
}
}
}
}
ttk::button .cancel -text "Cancel" -command {
set tpmg::response $tpmg::cancel
}
pack .list -padx 5 -pady 5
if {$type ne "menu"} {
pack .ok .cancel -padx 10 -pady 5 -side left
bind all <Return> {.ok invoke}
focus .ok
}
bind all <Escape> {.cancel invoke}
wm title . $title
wm resizable . 0 0
vwait tpmg::response
return $tpmg::response
}
################################################################################
# NOTIFICATION POPUP
#
proc tpmg::Notification {args} {
set title "tpmg Notification"
set delay 5
set geometry "180x50+[expr {[winfo screenwidth .] - 180}]+0"
set icon ""
set bg "yellow"
set fg "black"
set text ""
foreach option $args {
switch -glob -- $option {
--title=* {
set title [string range $option 8 end]
}
--delay=* {
set delay [string range $option 8 end]
if {![string is integer $delay]} {
puts stderr "not an integer: $delay"
return $tpmg::error
}
}
--geometry=* {
set geometry [string range $option 11 end]
}
--icon=* {
set valid [list info error question warning]
set icon [string range $option 7 end]
if {$icon ni $valid} {
puts stderr "not a valid icon: $icon"
puts stderr "use one of: $valid"
return $tpmg::error
}
}
--background=* {
set bg [string range $option 13 end]
}
--foreground=* {
set fg [string range $option 13 end]
}
--help {
tpmg::Help "notification"
exit 0
}
default {
append text $option "\n"
}
}
}
if {[set text [string range $text 0 end-1]] eq ""} {
return $tpmg::error
}
tk::label .label -background $bg -foreground $fg -text $text
if {$icon ne ""} {
tk::label .icon -background $bg -foreground $fg -bitmap $icon
pack .icon .label -padx 0 -pady 0 -fill both -expand true -side left
} else {
pack .label -padx 0 -pady 0 -fill both -expand true
}
bind all <ButtonPress-1> {set tpmg::response $tpmg::ok}
wm title . $title
wm attributes . -topmost true
wm attributes . -type notification
wm overrideredirect . true
wm geometry . $geometry
wm resizable . 0 0
after [expr {$delay * 1000}] {set tpmg::response $tpmg::ok}
vwait tpmg::response
return $tpmg::response
}
################################################################################
# PASSWORD DIALOG
#
proc tpmg::Password {args} {
set title "Login As"
set username "true"
foreach option $args {