git-gui: use themed tk widgets with Tk 8.5
This patch enables the use of themed Tk widgets with Tk 8.5 and above. These make a significant difference on Windows in making the application appear native. On Windows and MacOSX ttk defaults to the native look as much as possible. On X11 the user may select a theme using the TkTheme XRDB resource class by adding an line to the .Xresources file. The set of installed theme names is available using the Tk command 'ttk::themes'. The default on X11 is similar to the current un-themed style - a kind of thin bordered motif look. A new git config variable 'gui.usettk' may be set to disable this if the user prefers the classic Tk look. Using Tk 8.4 will also avoid the use of themed widgets as these are only available since 8.5. Some support is included for Tk 8.6 features (themed spinbox and native font chooser for MacOSX and Windows). Signed-off-by: Pat Thoyts <patthoyts@users.sourceforge.net> Signed-off-by: Shawn O. Pearce <spearce@spearce.org>
Pat Thoyts committed
Jan 26, 2010 at 00:05 UTC
c80d7be5e1e0d110ea77cd41f658aabe5bcad0d8
26 files changed
+697
-453
git-gui.sh
+102
-56
@@ -677,12 +677,17 @@ if {[is_Windows]} {
677
## config defaults
678
679
set cursor_ptr arrow
680
-font create font_diff -family Courier -size 10
680
font create font_ui
682
-catch {
683
- label .dummy
684
- eval font configure font_ui [font actual [.dummy cget -font]]
685
- destroy .dummy
681
+if {[lsearch -exact [font names] TkDefaultFont] != -1} {
682
+ eval [linsert [font actual TkDefaultFont] 0 font configure font_ui]
683
+ eval [linsert [font actual TkFixedFont] 0 font create font_diff]
684
+} else {
685
+ font create font_diff -family Courier -size 10
686
+ catch {
687
+ label .dummy
688
+ eval font configure font_ui [font actual [.dummy cget -font]]
689
+ destroy .dummy
690
+ }
691
}
692
693
font create font_uiitalic
@@ -697,6 +702,9 @@ foreach class {Button Checkbutton Entry Label
702
}
703
if {![is_MacOSX]} {
704
option add *Menu.font font_ui
705
+ option add *Entry.borderWidth 1 startupFile
706
+ option add *Entry.relief sunken startupFile
707
+ option add *RadioButton.anchor w startupFile
708
}
709
unset class
710
@@ -749,6 +757,18 @@ proc apply_config {} {
757
font configure ${font}bold -weight bold
758
font configure ${font}italic -slant italic
759
}
760
+
761
+ global use_ttk NS
762
+ set use_ttk 0
763
+ set NS {}
764
+ if {$repo_config(gui.usettk)} {
765
+ set use_ttk [package vsatisfies [package provide Tk] 8.5]
766
+ if {$use_ttk} {
767
+ set NS ttk
768
+ bind [winfo class .] <<ThemeChanged>> [list InitTheme]
769
+ pave_toplevel .
770
+ }
771
+ }
772
}
773
774
set default_config(branch.autosetupmerge) true
@@ -775,6 +795,7 @@ set default_config(gui.fontui) [font configure font_ui]
795
set default_config(gui.fontdiff) [font configure font_diff]
796
# TODO: this option should be added to the git-config documentation
797
set default_config(gui.maxfilesdisplayed) 5000
798
+set default_config(gui.usettk) 1
799
set font_descs {
800
{fontui font_ui {mc "Main Font"}}
801
{fontdiff font_diff {mc "Diff/Console Font"}}
@@ -2093,7 +2114,7 @@ proc do_quit {{rc {1}}} {
2114
global ui_comm is_quitting repo_config commit_type
2115
global GITGUI_BCK_exists GITGUI_BCK_i
2116
global ui_comm_spell
2096
- global ret_code
2117
+ global ret_code use_ttk
2118
2119
if {$is_quitting} return
2120
set is_quitting 1
@@ -2151,8 +2172,13 @@ proc do_quit {{rc {1}}} {
2172
}
2173
set cfg_geometry [list]
2174
lappend cfg_geometry [wm geometry .]
2154
- lappend cfg_geometry [lindex [.vpane sash coord 0] 0]
2155
- lappend cfg_geometry [lindex [.vpane.files sash coord 0] 1]
2175
+ if {$use_ttk} {
2176
+ lappend cfg_geometry [.vpane sashpos 0]
2177
+ lappend cfg_geometry [.vpane.files sashpos 0]
2178
+ } else {
2179
+ lappend cfg_geometry [lindex [.vpane sash coord 0] 0]
2180
+ lappend cfg_geometry [lindex [.vpane.files sash coord 0] 1]
2181
+ }
2182
if {[catch {set rc_geometry $repo_config(gui.geometry)}]} {
2183
set rc_geometry {}
2184
}
@@ -2919,14 +2945,13 @@ default {
2945
2946
# -- Branch Control
2947
#
2922
-frame .branch \
2923
- -borderwidth 1 \
2924
- -relief sunken
2925
-label .branch.l1 \
2948
+${NS}::frame .branch
2949
+if {!$use_ttk} {.branch configure -borderwidth 1 -relief sunken}
2950
+${NS}::label .branch.l1 \
2951
-text [mc "Current Branch:"] \
2952
-anchor w \
2953
-justify left
2929
-label .branch.cb \
2954
+${NS}::label .branch.cb \
2955
-textvariable current_branch \
2956
-anchor w \
2957
-justify left
@@ -2936,15 +2961,20 @@ pack .branch -side top -fill x
2961
2962
# -- Main Window Layout
2963
#
2939
-panedwindow .vpane -orient horizontal
2940
-panedwindow .vpane.files -orient vertical
2941
-.vpane add .vpane.files -sticky nsew -height 100 -width 200
2964
+${NS}::panedwindow .vpane -orient horizontal
2965
+${NS}::panedwindow .vpane.files -orient vertical
2966
+if {$use_ttk} {
2967
+ .vpane add .vpane.files
2968
+} else {
2969
+ .vpane add .vpane.files -sticky nsew -height 100 -width 200
2970
+}
2971
pack .vpane -anchor n -side top -fill both -expand 1
2972
2973
# -- Index File List
2974
#
2946
-frame .vpane.files.index -height 100 -width 200
2947
-label .vpane.files.index.title -text [mc "Staged Changes (Will Commit)"] \
2975
+${NS}::frame .vpane.files.index -height 100 -width 200
2976
+tlabel .vpane.files.index.title \
2977
+ -text [mc "Staged Changes (Will Commit)"] \
2978
-background lightgreen -foreground black
2979
text $ui_index -background white -foreground black \
2980
-borderwidth 0 \
@@ -2954,8 +2984,8 @@ text $ui_index -background white -foreground black \
2984
-xscrollcommand {.vpane.files.index.sx set} \
2985
-yscrollcommand {.vpane.files.index.sy set} \
2986
-state disabled
2957
-scrollbar .vpane.files.index.sx -orient h -command [list $ui_index xview]
2958
-scrollbar .vpane.files.index.sy -orient v -command [list $ui_index yview]
2987
+${NS}::scrollbar .vpane.files.index.sx -orient h -command [list $ui_index xview]
2988
+${NS}::scrollbar .vpane.files.index.sy -orient v -command [list $ui_index yview]
2989
pack .vpane.files.index.title -side top -fill x
2990
pack .vpane.files.index.sx -side bottom -fill x
2991
pack .vpane.files.index.sy -side right -fill y
@@ -2963,8 +2993,8 @@ pack $ui_index -side left -fill both -expand 1
2993
2994
# -- Working Directory File List
2995
#
2966
-frame .vpane.files.workdir -height 100 -width 200
2967
-label .vpane.files.workdir.title -text [mc "Unstaged Changes"] \
2996
+${NS}::frame .vpane.files.workdir -height 100 -width 200
2997
+tlabel .vpane.files.workdir.title -text [mc "Unstaged Changes"] \
2998
-background lightsalmon -foreground black
2999
text $ui_workdir -background white -foreground black \
3000
-borderwidth 0 \
@@ -2974,15 +3004,19 @@ text $ui_workdir -background white -foreground black \
3004
-xscrollcommand {.vpane.files.workdir.sx set} \
3005
-yscrollcommand {.vpane.files.workdir.sy set} \
3006
-state disabled
2977
-scrollbar .vpane.files.workdir.sx -orient h -command [list $ui_workdir xview]
2978
-scrollbar .vpane.files.workdir.sy -orient v -command [list $ui_workdir yview]
3007
+${NS}::scrollbar .vpane.files.workdir.sx -orient h -command [list $ui_workdir xview]
3008
+${NS}::scrollbar .vpane.files.workdir.sy -orient v -command [list $ui_workdir yview]
3009
pack .vpane.files.workdir.title -side top -fill x
3010
pack .vpane.files.workdir.sx -side bottom -fill x
3011
pack .vpane.files.workdir.sy -side right -fill y
3012
pack $ui_workdir -side left -fill both -expand 1
3013
2984
-.vpane.files add .vpane.files.workdir -sticky nsew
2985
-.vpane.files add .vpane.files.index -sticky nsew
3014
+.vpane.files add .vpane.files.workdir
3015
+.vpane.files add .vpane.files.index
3016
+if {!$use_ttk} {
3017
+ .vpane.files paneconfigure .vpane.files.workdir -sticky news
3018
+ .vpane.files paneconfigure .vpane.files.index -sticky news
3019
+}
3020
3021
foreach i [list $ui_index $ui_workdir] {
3022
rmsel_tag $i
@@ -2992,68 +3026,69 @@ unset i
3026
3027
# -- Diff and Commit Area
3028
#
2995
-frame .vpane.lower -height 300 -width 400
2996
-frame .vpane.lower.commarea
2997
-frame .vpane.lower.diff -relief sunken -borderwidth 1
3029
+${NS}::frame .vpane.lower -height 300 -width 400
3030
+${NS}::frame .vpane.lower.commarea
3031
+${NS}::frame .vpane.lower.diff -relief sunken -borderwidth 1
3032
pack .vpane.lower.diff -fill both -expand 1
3033
pack .vpane.lower.commarea -side bottom -fill x
3000
-.vpane add .vpane.lower -sticky nsew
3034
+.vpane add .vpane.lower
3035
+if {!$use_ttk} {.vpane paneconfigure .vpane.lower -sticky nsew}
3036
3037
# -- Commit Area Buttons
3038
#
3004
-frame .vpane.lower.commarea.buttons
3005
-label .vpane.lower.commarea.buttons.l -text {} \
3039
+${NS}::frame .vpane.lower.commarea.buttons
3040
+${NS}::label .vpane.lower.commarea.buttons.l -text {} \
3041
-anchor w \
3042
-justify left
3043
pack .vpane.lower.commarea.buttons.l -side top -fill x
3044
pack .vpane.lower.commarea.buttons -side left -fill y
3045
3011
-button .vpane.lower.commarea.buttons.rescan -text [mc Rescan] \
3046
+${NS}::button .vpane.lower.commarea.buttons.rescan -text [mc Rescan] \
3047
-command ui_do_rescan
3048
pack .vpane.lower.commarea.buttons.rescan -side top -fill x
3049
lappend disable_on_lock \
3050
{.vpane.lower.commarea.buttons.rescan conf -state}
3051
3017
-button .vpane.lower.commarea.buttons.incall -text [mc "Stage Changed"] \
3052
+${NS}::button .vpane.lower.commarea.buttons.incall -text [mc "Stage Changed"] \
3053
-command do_add_all
3054
pack .vpane.lower.commarea.buttons.incall -side top -fill x
3055
lappend disable_on_lock \
3056
{.vpane.lower.commarea.buttons.incall conf -state}
3057
3058
if {![is_enabled nocommitmsg]} {
3024
- button .vpane.lower.commarea.buttons.signoff -text [mc "Sign Off"] \
3059
+ ${NS}::button .vpane.lower.commarea.buttons.signoff -text [mc "Sign Off"] \
3060
-command do_signoff
3061
pack .vpane.lower.commarea.buttons.signoff -side top -fill x
3062
}
3063
3029
-button .vpane.lower.commarea.buttons.commit -text [commit_btn_caption] \
3064
+${NS}::button .vpane.lower.commarea.buttons.commit -text [commit_btn_caption] \
3065
-command do_commit
3066
pack .vpane.lower.commarea.buttons.commit -side top -fill x
3067
lappend disable_on_lock \
3068
{.vpane.lower.commarea.buttons.commit conf -state}
3069
3070
if {![is_enabled nocommit]} {
3036
- button .vpane.lower.commarea.buttons.push -text [mc Push] \
3071
+ ${NS}::button .vpane.lower.commarea.buttons.push -text [mc Push] \
3072
-command do_push_anywhere
3073
pack .vpane.lower.commarea.buttons.push -side top -fill x
3074
}
3075
3076
# -- Commit Message Buffer
3077
#
3043
-frame .vpane.lower.commarea.buffer
3044
-frame .vpane.lower.commarea.buffer.header
3078
+${NS}::frame .vpane.lower.commarea.buffer
3079
+${NS}::frame .vpane.lower.commarea.buffer.header
3080
set ui_comm .vpane.lower.commarea.buffer.t
3081
set ui_coml .vpane.lower.commarea.buffer.header.l
3082
3083
if {![is_enabled nocommit]} {
3049
- radiobutton .vpane.lower.commarea.buffer.header.new \
3084
+ ${NS}::radiobutton .vpane.lower.commarea.buffer.header.new \
3085
-text [mc "New Commit"] \
3086
-command do_select_commit_type \
3087
-variable selected_commit_type \
3088
-value new
3089
lappend disable_on_lock \
3090
[list .vpane.lower.commarea.buffer.header.new conf -state]
3056
- radiobutton .vpane.lower.commarea.buffer.header.amend \
3091
+ ${NS}::radiobutton .vpane.lower.commarea.buffer.header.amend \
3092
-text [mc "Amend Last Commit"] \
3093
-command do_select_commit_type \
3094
-variable selected_commit_type \
@@ -3062,7 +3097,7 @@ if {![is_enabled nocommit]} {
3097
[list .vpane.lower.commarea.buffer.header.amend conf -state]
3098
}
3099
3065
-label $ui_coml \
3100
+${NS}::label $ui_coml \
3101
-anchor w \
3102
-justify left
3103
proc trace_commit_type {varname args} {
@@ -3094,7 +3129,7 @@ text $ui_comm -background white -foreground black \
3129
-width $repo_config(gui.commitmsgwidth) -height 9 -wrap none \
3130
-font font_diff \
3131
-yscrollcommand {.vpane.lower.commarea.buffer.sby set}
3097
-scrollbar .vpane.lower.commarea.buffer.sby \
3132
+${NS}::scrollbar .vpane.lower.commarea.buffer.sby \
3133
-command [list $ui_comm yview]
3134
pack .vpane.lower.commarea.buffer.header -side top -fill x
3135
pack .vpane.lower.commarea.buffer.sby -side right -fill y
@@ -3160,19 +3195,19 @@ proc trace_current_diff_path {varname args} {
3195
}
3196
trace add variable current_diff_path write trace_current_diff_path
3197
3163
-frame .vpane.lower.diff.header -background gold
3164
-label .vpane.lower.diff.header.status \
3198
+gold_frame .vpane.lower.diff.header
3199
+tlabel .vpane.lower.diff.header.status \
3200
-background gold \
3201
-foreground black \
3202
-width $max_status_desc \
3203
-anchor w \
3204
-justify left
3170
-label .vpane.lower.diff.header.file \
3205
+tlabel .vpane.lower.diff.header.file \
3206
-background gold \
3207
-foreground black \
3208
-anchor w \
3209
-justify left
3175
-label .vpane.lower.diff.header.path \
3210
+tlabel .vpane.lower.diff.header.path \
3211
-background gold \
3212
-foreground black \
3213
-anchor w \
@@ -3196,7 +3231,7 @@ bind_button3 .vpane.lower.diff.header.path "tk_popup $ctxm %X %Y"
3231
3232
# -- Diff Body
3233
#
3199
-frame .vpane.lower.diff.body
3234
+${NS}::frame .vpane.lower.diff.body
3235
set ui_diff .vpane.lower.diff.body.t
3236
text $ui_diff -background white -foreground black \
3237
-borderwidth 0 \
@@ -3205,9 +3240,9 @@ text $ui_diff -background white -foreground black \
3240
-xscrollcommand {.vpane.lower.diff.body.sbx set} \
3241
-yscrollcommand {.vpane.lower.diff.body.sby set} \
3242
-state disabled
3208
-scrollbar .vpane.lower.diff.body.sbx -orient horizontal \
3243
+${NS}::scrollbar .vpane.lower.diff.body.sbx -orient horizontal \
3244
-command [list $ui_diff xview]
3210
-scrollbar .vpane.lower.diff.body.sby -orient vertical \
3245
+${NS}::scrollbar .vpane.lower.diff.body.sby -orient vertical \
3246
-command [list $ui_diff yview]
3247
pack .vpane.lower.diff.body.sbx -side bottom -fill x
3248
pack .vpane.lower.diff.body.sby -side right -fill y
@@ -3428,12 +3463,17 @@ $main_status show [mc "Initializing..."]
3463
catch {
3464
set gm $repo_config(gui.geometry)
3465
wm geometry . [lindex $gm 0]
3431
-.vpane sash place 0 \
3432
- [lindex $gm 1] \
3433
- [lindex [.vpane sash coord 0] 1]
3434
-.vpane.files sash place 0 \
3435
- [lindex [.vpane.files sash coord 0] 0] \
3436
- [lindex $gm 2]
3466
+if {$use_ttk} {
3467
+ .vpane sashpos 0 [lindex $gm 1]
3468
+ .vpane.files sashpos 0 [lindex $gm 2]
3469
+} else {
3470
+ .vpane sash place 0 \
3471
+ [lindex $gm 1] \
3472
+ [lindex [.vpane sash coord 0] 1]
3473
+ .vpane.files sash place 0 \
3474
+ [lindex [.vpane.files sash coord 0] 0] \
3475
+ [lindex $gm 2]
3476
+}
3477
unset gm
3478
}
3479
@@ -3701,3 +3741,9 @@ if {[is_enabled retcode]} {
3741
if {$picked && [is_config_true gui.autoexplore]} {
3742
do_explore
3743
}
3744
+
3745
+# Local variables:
3746
+# mode: tcl
3747
+# indent-tabs-mode: t
3748
+# tab-width: 4
3749
+# End:
lib/about.tcl
+10
-27
@@ -4,31 +4,26 @@
4
proc do_about {} {
5
global appvers copyright oguilib
6
global tcl_patchLevel tk_patchLevel
7
- global ui_comm_spell
7
+ global ui_comm_spell NS use_ttk
8
9
set w .about_dialog
10
- toplevel $w
10
+ Dialog $w
11
wm geometry $w "+[winfo rootx .]+[winfo rooty .]"
12
13
pack [git_logo $w.git_logo] -side left -fill y -padx 10 -pady 10
14
- label $w.header -text [mc "About %s" [appname]] \
15
- -font font_uibold
14
+ ${NS}::label $w.header -text [mc "About %s" [appname]] \
15
+ -font font_uibold -anchor center
16
pack $w.header -side top -fill x
17
18
- frame $w.buttons
19
- button $w.buttons.close -text {Close} \
18
+ ${NS}::frame $w.buttons
19
+ ${NS}::button $w.buttons.close -text {Close} \
20
-default active \
21
-command [list destroy $w]
22
pack $w.buttons.close -side right
23
pack $w.buttons -side bottom -fill x -pady 10 -padx 10
24
25
- label $w.desc \
26
- -text "[mc "git-gui - a graphical user interface for Git."]\n$copyright" \
27
- -padx 5 -pady 5 \
28
- -justify left \
29
- -anchor w \
30
- -borderwidth 1 \
31
- -relief solid
25
+ paddedlabel $w.desc \
26
+ -text "[mc "git-gui - a graphical user interface for Git."]\n$copyright"
27
pack $w.desc -side top -fill x -padx 5 -pady 5
28
29
set v {}
@@ -52,22 +47,10 @@ proc do_about {} {
47
append d "git exec dir: [gitexec]\n"
48
append d "git-gui lib: $oguilib"
49
55
- label $w.vers \
56
- -text $v \
57
- -padx 5 -pady 5 \
58
- -justify left \
59
- -anchor w \
60
- -borderwidth 1 \
61
- -relief solid
50
+ paddedlabel $w.vers -text $v
51
pack $w.vers -side top -fill x -padx 5 -pady 5
52
64
- label $w.dirs \
65
- -text $d \
66
- -padx 5 -pady 5 \
67
- -justify left \
68
- -anchor w \
69
- -borderwidth 1 \
70
- -relief solid
53
+ paddedlabel $w.dirs -text $d
54
pack $w.dirs -side top -fill x -padx 5 -pady 5
55
56
menu $w.ctxm -tearoff 0
lib/blame.tcl
+11
-11
@@ -61,7 +61,7 @@ field tooltip_timer {} ; # Current timer event for our tooltip
61
field tooltip_commit {} ; # Commit(s) in tooltip
62
63
constructor new {i_commit i_path i_jump} {
64
- global cursor_ptr M1B M1T have_tk85
64
+ global cursor_ptr M1B M1T have_tk85 use_ttk NS
65
variable active_color
66
variable group_colors
67
@@ -73,15 +73,15 @@ constructor new {i_commit i_path i_jump} {
73
74
set font_w [font measure font_diff "0"]
75
76
- frame $w.header -background gold
77
- label $w.header.commit_l \
76
+ gold_frame $w.header
77
+ tlabel $w.header.commit_l \
78
-text [mc "Commit:"] \
79
-background gold \
80
-foreground black \
81
-anchor w \
82
-justify left
83
set w_back $w.header.commit_b
84
- label $w_back \
84
+ tlabel $w_back \
85
-image ::blame::img_back_arrow \
86
-borderwidth 0 \
87
-relief flat \
@@ -94,20 +94,20 @@ constructor new {i_commit i_path i_jump} {
94
[cb _history_menu]
95
}
96
"
97
- label $w.header.commit \
97
+ tlabel $w.header.commit \
98
-textvariable @commit \
99
-background gold \
100
-foreground black \
101
-anchor w \
102
-justify left
103
- label $w.header.path_l \
103
+ tlabel $w.header.path_l \
104
-text [mc "File:"] \
105
-background gold \
106
-foreground black \
107
-anchor w \
108
-justify left
109
set w_path $w.header.path
110
- label $w_path \
110
+ tlabel $w_path \
111
-background gold \
112
-foreground black \
113
-anchor w \
@@ -209,10 +209,10 @@ constructor new {i_commit i_path i_jump} {
209
210
set w_columns [list $w_amov $w_asim $w_line $w_file]
211
212
- scrollbar $w.file_pane.out.sbx \
212
+ ${NS}::scrollbar $w.file_pane.out.sbx \
213
-orient h \
214
-command [list $w_file xview]
215
- scrollbar $w.file_pane.out.sby \
215
+ ${NS}::scrollbar $w.file_pane.out.sby \
216
-orient v \
217
-command [list scrollbar2many $w_columns yview]
218
eval grid $w_columns $w.file_pane.out.sby -sticky nsew
@@ -254,10 +254,10 @@ constructor new {i_commit i_path i_jump} {
254
-background $active_color \
255
-font font_ui
256
$w_cviewer tag raise sel
257
- scrollbar $w.file_pane.cm.sbx \
257
+ ${NS}::scrollbar $w.file_pane.cm.sbx \
258
-orient h \
259
-command [list $w_cviewer xview]
260
- scrollbar $w.file_pane.cm.sby \
260
+ ${NS}::scrollbar $w.file_pane.cm.sby \
261
-orient v \
262
-command [list $w_cviewer yview]
263
pack $w.file_pane.cm.sby -side right -fill y
lib/branch_checkout.tcl
+12
-8
@@ -10,21 +10,24 @@ field opt_fetch 1; # refetch tracking branch if used?
10
field opt_detach 0; # force a detached head case?
11
12
constructor dialog {} {
13
- make_toplevel top w
13
+ global use_ttk NS
14
+ make_dialog top w
15
+ wm withdraw $w
16
wm title $top [append "[appname] ([reponame]): " [mc "Checkout Branch"]]
17
if {$top ne {.}} {
18
wm geometry $top "+[winfo rootx .]+[winfo rooty .]"
19
}
20
19
- label $w.header -text [mc "Checkout Branch"] -font font_uibold
21
+ ${NS}::label $w.header -text [mc "Checkout Branch"] \
22
+ -font font_uibold -anchor center
23
pack $w.header -side top -fill x
24
22
- frame $w.buttons
23
- button $w.buttons.create -text [mc Checkout] \
25
+ ${NS}::frame $w.buttons
26
+ ${NS}::button $w.buttons.create -text [mc Checkout] \
27
-default active \
28
-command [cb _checkout]
29
pack $w.buttons.create -side right
27
- button $w.buttons.cancel -text [mc Cancel] \
30
+ ${NS}::button $w.buttons.cancel -text [mc Cancel] \
31
-command [list destroy $w]
32
pack $w.buttons.cancel -side right -padx 5
33
pack $w.buttons -side bottom -fill x -pady 10 -padx 10
@@ -33,14 +36,14 @@ constructor dialog {} {
36
$w_rev bind_listbox <Double-Button-1> [cb _checkout]
37
pack $w.rev -anchor nw -fill both -expand 1 -pady 5 -padx 5
38
36
- labelframe $w.options -text [mc Options]
39
+ ${NS}::labelframe $w.options -text [mc Options]
40
38
- checkbutton $w.options.fetch \
41
+ ${NS}::checkbutton $w.options.fetch \
42
-text [mc "Fetch Tracking Branch"] \
43
-variable @opt_fetch
44
pack $w.options.fetch -anchor nw
45
43
- checkbutton $w.options.detach \
46
+ ${NS}::checkbutton $w.options.detach \
47
-text [mc "Detach From Local Branch"] \
48
-variable @opt_detach
49
pack $w.options.detach -anchor nw
@@ -50,6 +53,7 @@ constructor dialog {} {
53
bind $w <Visibility> [cb _visible]
54
bind $w <Key-Escape> [list destroy $w]
55
bind $w <Key-Return> [cb _checkout]\;break
56
+ wm deiconify $w
57
tkwait window $w
58
}
59
lib/branch_create.tcl
+23
-22
@@ -16,48 +16,48 @@ field opt_fetch 1; # refetch tracking branch if used?
16
field reset_ok 0; # did the user agree to reset?
17
18
constructor dialog {} {
19
- global repo_config
19
+ global repo_config use_ttk NS
20
21
- make_toplevel top w
21
+ make_dialog top w
22
+ wm withdraw $w
23
wm title $top [append "[appname] ([reponame]): " [mc "Create Branch"]]
24
if {$top ne {.}} {
25
wm geometry $top "+[winfo rootx .]+[winfo rooty .]"
26
}
27
27
- label $w.header -text [mc "Create New Branch"] -font font_uibold
28
+ ${NS}::label $w.header -text [mc "Create New Branch"] \
29
+ -font font_uibold -anchor center
30
pack $w.header -side top -fill x
31
30
- frame $w.buttons
31
- button $w.buttons.create -text [mc Create] \
32
+ ${NS}::frame $w.buttons
33
+ ${NS}::button $w.buttons.create -text [mc Create] \
34
-default active \
35
-command [cb _create]
36
pack $w.buttons.create -side right
35
- button $w.buttons.cancel -text [mc Cancel] \
37
+ ${NS}::button $w.buttons.cancel -text [mc Cancel] \
38
-command [list destroy $w]
39
pack $w.buttons.cancel -side right -padx 5
40
pack $w.buttons -side bottom -fill x -pady 10 -padx 10
41
40
- labelframe $w.desc -text [mc "Branch Name"]
41
- radiobutton $w.desc.name_r \
42
- -anchor w \
42
+ ${NS}::labelframe $w.desc -text [mc "Branch Name"]
43
+ ${NS}::radiobutton $w.desc.name_r \
44
-text [mc "Name:"] \
45
-value user \
46
-variable @name_type
47
+ if {!$use_ttk} {$w.desc.name_r configure -anchor w}
48
set w_name $w.desc.name_t
47
- entry $w_name \
48
- -borderwidth 1 \
49
- -relief sunken \
49
+ ${NS}::entry $w_name \
50
-width 40 \
51
-textvariable @name \
52
-validate key \
53
-validatecommand [cb _validate %d %S]
54
grid $w.desc.name_r $w_name -sticky we -padx {0 5}
55
56
- radiobutton $w.desc.match_r \
57
- -anchor w \
56
+ ${NS}::radiobutton $w.desc.match_r \
57
-text [mc "Match Tracking Branch Name"] \
58
-value match \
59
-variable @name_type
60
+ if {!$use_ttk} {$w.desc.match_r configure -anchor w}
61
grid $w.desc.match_r -sticky we -padx {0 5} -columnspan 2
62
63
grid columnconfigure $w.desc 1 -weight 1
@@ -66,34 +66,34 @@ constructor dialog {} {
66
set w_rev [::choose_rev::new $w.rev [mc "Starting Revision"]]
67
pack $w.rev -anchor nw -fill both -expand 1 -pady 5 -padx 5
68
69
- labelframe $w.options -text [mc Options]
69
+ ${NS}::labelframe $w.options -text [mc Options]
70
71
- frame $w.options.merge
72
- label $w.options.merge.l -text [mc "Update Existing Branch:"]
71
+ ${NS}::frame $w.options.merge
72
+ ${NS}::label $w.options.merge.l -text [mc "Update Existing Branch:"]
73
pack $w.options.merge.l -side left
74
- radiobutton $w.options.merge.no \
74
+ ${NS}::radiobutton $w.options.merge.no \
75
-text [mc No] \
76
-value none \
77
-variable @opt_merge
78
pack $w.options.merge.no -side left
79
- radiobutton $w.options.merge.ff \
79
+ ${NS}::radiobutton $w.options.merge.ff \
80
-text [mc "Fast Forward Only"] \
81
-value ff \
82
-variable @opt_merge
83
pack $w.options.merge.ff -side left
84
- radiobutton $w.options.merge.reset \
84
+ ${NS}::radiobutton $w.options.merge.reset \
85
-text [mc Reset] \
86
-value reset \
87
-variable @opt_merge
88
pack $w.options.merge.reset -side left
89
pack $w.options.merge -anchor nw
90
91
- checkbutton $w.options.fetch \
91
+ ${NS}::checkbutton $w.options.fetch \
92
-text [mc "Fetch Tracking Branch"] \
93
-variable @opt_fetch
94
pack $w.options.fetch -anchor nw
95
96
- checkbutton $w.options.checkout \
96
+ ${NS}::checkbutton $w.options.checkout \
97
-text [mc "Checkout After Creation"] \
98
-variable @opt_checkout
99
pack $w.options.checkout -anchor nw
@@ -109,6 +109,7 @@ constructor dialog {} {
109
bind $w <Visibility> [cb _visible]
110
bind $w <Key-Escape> [list destroy $w]
111
bind $w <Key-Return> [cb _create]\;break
112
+ wm deiconify $w
113
tkwait window $w
114
}
115
lib/branch_delete.tcl
+12
-12
@@ -9,41 +9,40 @@ field w_check ; # revision picker for merge test
9
field w_delete ; # delete button
10
11
constructor dialog {} {
12
- global current_branch
12
+ global current_branch use_ttk NS
13
14
- make_toplevel top w
14
+ make_dialog top w
15
+ wm withdraw $w
16
wm title $top [append "[appname] ([reponame]): " [mc "Delete Branch"]]
17
if {$top ne {.}} {
18
wm geometry $top "+[winfo rootx .]+[winfo rooty .]"
19
}
20
20
- label $w.header -text [mc "Delete Local Branch"] -font font_uibold
21
+ ${NS}::label $w.header -text [mc "Delete Local Branch"] \
22
+ -font font_uibold -anchor center
23
pack $w.header -side top -fill x
24
23
- frame $w.buttons
25
+ ${NS}::frame $w.buttons
26
set w_delete $w.buttons.delete
25
- button $w_delete \
27
+ ${NS}::button $w_delete \
28
-text [mc Delete] \
29
-default active \
30
-state disabled \
31
-command [cb _delete]
32
pack $w_delete -side right
31
- button $w.buttons.cancel \
33
+ ${NS}::button $w.buttons.cancel \
34
-text [mc Cancel] \
35
-command [list destroy $w]
36
pack $w.buttons.cancel -side right -padx 5
37
pack $w.buttons -side bottom -fill x -pady 10 -padx 10
38
37
- labelframe $w.list -text [mc "Local Branches"]
39
+ ${NS}::labelframe $w.list -text [mc "Local Branches"]
40
set w_heads $w.list.l
39
- listbox $w_heads \
41
+ slistbox $w_heads \
42
-height 10 \
43
-width 70 \
44
-selectmode extended \
43
- -exportselection false \
44
- -yscrollcommand [list $w.list.sby set]
45
- scrollbar $w.list.sby -command [list $w.list.l yview]
46
- pack $w.list.sby -side right -fill y
45
+ -exportselection false
46
pack $w.list.l -side left -fill both -expand 1
47
pack $w.list -fill both -expand 1 -pady 5 -padx 5
48
@@ -67,6 +66,7 @@ constructor dialog {} {
66
"
67
bind $w <Key-Escape> [list destroy $w]
68
bind $w <Key-Return> [cb _delete]\;break
69
+ wm deiconify $w
70
tkwait window $w
71
}
72
lib/branch_rename.tcl
+19
-13
@@ -8,9 +8,10 @@ field oldname
8
field newname
9
10
constructor dialog {} {
11
- global current_branch
11
+ global current_branch use_ttk NS
12
13
- make_toplevel top w
13
+ make_dialog top w
14
+ wm withdraw $w
15
wm title $top [append "[appname] ([reponame]): " [mc "Rename Branch"]]
16
if {$top ne {.}} {
17
wm geometry $top "+[winfo rootx .]+[winfo rooty .]"
@@ -19,27 +20,31 @@ constructor dialog {} {
20
set oldname $current_branch
21
set newname [get_config gui.newbranchtemplate]
22
22
- label $w.header -text [mc "Rename Branch"] -font font_uibold
23
+ ${NS}::label $w.header -text [mc "Rename Branch"]\
24
+ -font font_uibold -anchor center
25
pack $w.header -side top -fill x
26
25
- frame $w.buttons
26
- button $w.buttons.rename -text [mc Rename] \
27
+ ${NS}::frame $w.buttons
28
+ ${NS}::button $w.buttons.rename -text [mc Rename] \
29
-default active \
30
-command [cb _rename]
31
pack $w.buttons.rename -side right
30
- button $w.buttons.cancel -text [mc Cancel] \
32
+ ${NS}::button $w.buttons.cancel -text [mc Cancel] \
33
-command [list destroy $w]
34
pack $w.buttons.cancel -side right -padx 5
35
pack $w.buttons -side bottom -fill x -pady 10 -padx 10
36
35
- frame $w.rename
36
- label $w.rename.oldname_l -text [mc "Branch:"]
37
- eval tk_optionMenu $w.rename.oldname_m @oldname [load_all_heads]
37
+ ${NS}::frame $w.rename
38
+ ${NS}::label $w.rename.oldname_l -text [mc "Branch:"]
39
+ if {$use_ttk} {
40
+ ttk::combobox $w.rename.oldname_m -textvariable @oldname \
41
+ -values [load_all_heads] -state readonly
42
+ } else {
43
+ eval tk_optionMenu $w.rename.oldname_m @oldname [load_all_heads]
44
+ }
45
39
- label $w.rename.newname_l -text [mc "New Name:"]
40
- entry $w.rename.newname_t \
41
- -borderwidth 1 \
42
- -relief sunken \
46
+ ${NS}::label $w.rename.newname_l -text [mc "New Name:"]
47
+ ${NS}::entry $w.rename.newname_t \
48
-width 40 \
49
-textvariable @newname \
50
-validate key \
@@ -60,6 +65,7 @@ constructor dialog {} {
65
$w.rename.newname_t icursor end
66
focus $w.rename.newname_t
67
"
68
+ wm deiconify $w
69
tkwait window $w
70
}
71
lib/browser.tcl
+23
-18
@@ -21,23 +21,23 @@ field browser_busy 1
21
field ls_buf {}; # Buffered record output from ls-tree
22
23
constructor new {commit {path {}}} {
24
- global cursor_ptr M1B
25
- make_toplevel top w
24
+ global cursor_ptr M1B use_ttk NS
25
+ make_dialog top w
26
+ wm withdraw $top
27
wm title $top [append "[appname] ([reponame]): " [mc "File Browser"]]
28
29
set browser_commit $commit
30
set browser_path $browser_commit:$path
31
31
- label $w.path \
32
+ ${NS}::label $w.path \
33
-textvariable @browser_path \
34
-anchor w \
35
-justify left \
35
- -borderwidth 1 \
36
- -relief sunken \
36
-font font_uibold
37
+ if {!$use_ttk} { $w.path configure -borderwidth 1 -relief sunken}
38
pack $w.path -anchor w -side top -fill x
39
40
- frame $w.list
40
+ ${NS}::frame $w.list
41
set w_list $w.list.l
42
text $w_list -background white -foreground black \
43
-borderwidth 0 \
@@ -49,19 +49,18 @@ constructor new {commit {path {}}} {
49
-xscrollcommand [list $w.list.sbx set] \
50
-yscrollcommand [list $w.list.sby set]
51
rmsel_tag $w_list
52
- scrollbar $w.list.sbx -orient h -command [list $w_list xview]
53
- scrollbar $w.list.sby -orient v -command [list $w_list yview]
52
+ ${NS}::scrollbar $w.list.sbx -orient h -command [list $w_list xview]
53
+ ${NS}::scrollbar $w.list.sby -orient v -command [list $w_list yview]
54
pack $w.list.sbx -side bottom -fill x
55
pack $w.list.sby -side right -fill y
56
pack $w_list -side left -fill both -expand 1
57
pack $w.list -side top -fill both -expand 1
58
59
- label $w.status \
59
+ ${NS}::label $w.status \
60
-textvariable @browser_status \
61
-anchor w \
62
- -justify left \
63
- -borderwidth 1 \
64
- -relief sunken
62
+ -justify left
63
+ if {!$use_ttk} { $w.status configure -borderwidth 1 -relief sunken}
64
pack $w.status -anchor w -side bottom -fill x
65
66
bind $w_list <Button-1> "[cb _click 0 @%x,%y];break"
@@ -78,6 +77,7 @@ constructor new {commit {path {}}} {
77
bind $w_list <Right> break
78
79
bind $w_list <Visibility> [list focus $w_list]
80
+ wm deiconify $top
81
set w $w_list
82
if {$path ne {}} {
83
_ls $this $browser_commit:$path $path
@@ -263,23 +263,27 @@ field w ; # widget path
263
field w_rev ; # mega-widget to pick the initial revision
264
265
constructor dialog {} {
266
- make_toplevel top w
266
+ global use_ttk NS
267
+ make_dialog top w
268
+ wm withdraw $top
269
wm title $top [append "[appname] ([reponame]): " [mc "Browse Branch Files"]]
270
if {$top ne {.}} {
271
wm geometry $top "+[winfo rootx .]+[winfo rooty .]"
272
+ wm transient $top .
273
}
274
272
- label $w.header \
275
+ ${NS}::label $w.header \
276
-text [mc "Browse Branch Files"] \
274
- -font font_uibold
277
+ -font font_uibold \
278
+ -anchor center
279
pack $w.header -side top -fill x
280
277
- frame $w.buttons
278
- button $w.buttons.browse -text [mc Browse] \
281
+ ${NS}::frame $w.buttons
282
+ ${NS}::button $w.buttons.browse -text [mc Browse] \
283
-default active \
284
-command [cb _open]
285
pack $w.buttons.browse -side right
282
- button $w.buttons.cancel -text [mc Cancel] \
286
+ ${NS}::button $w.buttons.cancel -text [mc Cancel] \
287
-command [list destroy $w]
288
pack $w.buttons.cancel -side right -padx 5
289
pack $w.buttons -side bottom -fill x -pady 10 -padx 10
@@ -291,6 +295,7 @@ constructor dialog {} {
295
bind $w <Visibility> [cb _visible]
296
bind $w <Key-Escape> [list destroy $w]
297
bind $w <Key-Return> [cb _open]\;break
298
+ wm deiconify $top
299
tkwait window $w
300
}
301
lib/choose_font.tcl
+17
-14
@@ -17,6 +17,7 @@ variable all_families [list] ; # All fonts known to Tk
17
18
constructor pick {path title a_family a_size} {
19
variable all_families
20
+ global use_ttk NS
21
22
set v_family $a_family
23
set v_size $a_size
@@ -27,29 +28,30 @@ constructor pick {path title a_family a_size} {
28
set f_family $pv_family
29
set f_size $pv_size
30
30
- make_toplevel top w
31
+ make_dialog top w
32
+ wm withdraw $top
33
wm title $top "[appname] ([reponame]): $title"
34
wm geometry $top "+[winfo rootx $path]+[winfo rooty $path]"
35
34
- label $w.header -text $title -font font_uibold
36
+ ${NS}::label $w.header -text $title -font font_uibold -anchor center
37
pack $w.header -side top -fill x
38
37
- frame $w.buttons
38
- button $w.buttons.select \
39
+ ${NS}::frame $w.buttons
40
+ ${NS}::button $w.buttons.select \
41
-text [mc Select] \
42
-default active \
43
-command [cb _select]
42
- button $w.buttons.cancel \
44
+ ${NS}::button $w.buttons.cancel \
45
-text [mc Cancel] \
46
-command [list destroy $w]
47
pack $w.buttons.select -side right
48
pack $w.buttons.cancel -side right -padx 5
49
pack $w.buttons -side bottom -fill x -pady 10 -padx 10
50
49
- frame $w.inner
51
+ ${NS}::frame $w.inner
52
51
- frame $w.inner.family
52
- label $w.inner.family.l \
53
+ ${NS}::frame $w.inner.family
54
+ ${NS}::label $w.inner.family.l \
55
-text [mc "Font Family"] \
56
-anchor w
57
set w_family $w.inner.family.v
@@ -64,16 +66,16 @@ constructor pick {path title a_family a_size} {
66
-height 10 \
67
-yscrollcommand [list $w.inner.family.sby set]
68
rmsel_tag $w_family
67
- scrollbar $w.inner.family.sby -command [list $w_family yview]
69
+ ${NS}::scrollbar $w.inner.family.sby -command [list $w_family yview]
70
pack $w.inner.family.l -side top -fill x
71
pack $w.inner.family.sby -side right -fill y
72
pack $w_family -fill both -expand 1
73
72
- frame $w.inner.size
73
- label $w.inner.size.l \
74
+ ${NS}::frame $w.inner.size
75
+ ${NS}::label $w.inner.size.l \
76
-text [mc "Font Size"] \
77
-anchor w
76
- spinbox $w.inner.size.v \
78
+ tspinbox $w.inner.size.v \
79
-textvariable @f_size \
80
-from 2 -to 80 -increment 1 \
81
-width 3
@@ -86,8 +88,8 @@ constructor pick {path title a_family a_size} {
88
grid columnconfigure $w.inner 0 -weight 1
89
pack $w.inner -fill both -expand 1 -padx 5 -pady 5
90
89
- frame $w.example
90
- label $w.example.l \
91
+ ${NS}::frame $w.example
92
+ ${NS}::label $w.example.l \
93
-text [mc "Font Example"] \
94
-anchor w
95
set w_example $w.example.t
@@ -129,6 +131,7 @@ constructor pick {path title a_family a_size} {
131
grab $w
132
focus $w
133
"
134
+ wm deiconify $w
135
tkwait window $w
136
}
137
lib/choose_repository.tcl
+44
-50
@@ -22,9 +22,9 @@ field readtree_err ; # Error output from read-tree (if any)
22
field sorted_recent ; # recent repositories (sorted)
23
24
constructor pick {} {
25
- global M1T M1B
25
+ global M1T M1B use_ttk NS
26
27
- make_toplevel top w
27
+ make_dialog top w
28
wm title $top [mc "Git Gui"]
29
30
if {$top eq {.}} {
@@ -71,11 +71,11 @@ constructor pick {} {
71
72
set w_body $w.body
73
set opts $w_body.options
74
- frame $w_body
74
+ ${NS}::frame $w_body
75
text $opts \
76
-cursor $::cursor_ptr \
77
-relief flat \
78
- -background [$w_body cget -background] \
78
+ -background [get_bg_color $w_body] \
79
-wrap none \
80
-spacing1 5 \
81
-width 50 \
@@ -132,15 +132,15 @@ constructor pick {} {
132
-label [mc "Recent Repositories"]
133
}
134
135
- label $w_body.space
136
- label $w_body.recentlabel \
135
+ ${NS}::label $w_body.space
136
+ ${NS}::label $w_body.recentlabel \
137
-anchor w \
138
-text [mc "Open Recent Repository:"]
139
set w_recentlist $w_body.recentlist
140
text $w_recentlist \
141
-cursor $::cursor_ptr \
142
-relief flat \
143
- -background [$w_body.recentlabel cget -background] \
143
+ -background [get_bg_color $w_body.recentlabel] \
144
-wrap none \
145
-width 50 \
146
-height 10
@@ -176,10 +176,10 @@ constructor pick {} {
176
}
177
pack $w_body -fill x -padx 10 -pady 10
178
179
- frame $w.buttons
179
+ ${NS}::frame $w.buttons
180
set w_next $w.buttons.next
181
set w_quit $w.buttons.quit
182
- button $w_quit \
182
+ ${NS}::button $w_quit \
183
-text [mc "Quit"] \
184
-command exit
185
pack $w_quit -side right -padx 5
@@ -203,6 +203,7 @@ constructor pick {} {
203
wm deiconify $top
204
tkwait variable @done
205
206
+ grab release $top
207
if {$top eq {.}} {
208
eval destroy [winfo children $top]
209
}
@@ -284,9 +285,10 @@ method _open_recent_path {p} {
285
}
286
287
method _next {action} {
288
+ global NS
289
destroy $w_body
290
if {![winfo exists $w_next]} {
289
- button $w_next -default active
291
+ ${NS}::button $w_next -default active
292
pack $w_next -side right -padx 5 -before $w_quit
293
}
294
_do_$action $this
@@ -375,26 +377,25 @@ proc _objdir {path} {
377
## Create New Repository
378
379
method _do_new {} {
380
+ global use_ttk NS
381
$w_next conf \
382
-state disabled \
383
-command [cb _do_new2] \
384
-text [mc "Create"]
385
383
- frame $w_body
384
- label $w_body.h \
385
- -font font_uibold \
386
+ ${NS}::frame $w_body
387
+ ${NS}::label $w_body.h \
388
+ -font font_uibold -anchor center \
389
-text [mc "Create New Repository"]
390
pack $w_body.h -side top -fill x -pady 10
391
pack $w_body -fill x -padx 10
392
390
- frame $w_body.where
391
- label $w_body.where.l -text [mc "Directory:"]
392
- entry $w_body.where.t \
393
+ ${NS}::frame $w_body.where
394
+ ${NS}::label $w_body.where.l -text [mc "Directory:"]
395
+ ${NS}::entry $w_body.where.t \
396
-textvariable @local_path \
394
- -borderwidth 1 \
395
- -relief sunken \
397
-width 50
397
- button $w_body.where.b \
398
+ ${NS}::button $w_body.where.b \
399
-text [mc "Browse"] \
400
-command [cb _new_local_path]
401
set w_localpath $w_body.where.t
@@ -460,63 +461,57 @@ proc _new_ok {p} {
461
## Clone Existing Repository
462
463
method _do_clone {} {
464
+ global use_ttk NS
465
$w_next conf \
466
-state disabled \
467
-command [cb _do_clone2] \
468
-text [mc "Clone"]
469
468
- frame $w_body
469
- label $w_body.h \
470
- -font font_uibold \
470
+ ${NS}::frame $w_body
471
+ ${NS}::label $w_body.h \
472
+ -font font_uibold -anchor center \
473
-text [mc "Clone Existing Repository"]
474
pack $w_body.h -side top -fill x -pady 10
475
pack $w_body -fill x -padx 10
476
477
set args $w_body.args
476
- frame $w_body.args
478
+ ${NS}::frame $w_body.args
479
pack $args -fill both
480
479
- label $args.origin_l -text [mc "Source Location:"]
480
- entry $args.origin_t \
481
+ ${NS}::label $args.origin_l -text [mc "Source Location:"]
482
+ ${NS}::entry $args.origin_t \
483
-textvariable @origin_url \
482
- -borderwidth 1 \
483
- -relief sunken \
484
-width 50
485
- button $args.origin_b \
485
+ ${NS}::button $args.origin_b \
486
-text [mc "Browse"] \
487
-command [cb _open_origin]
488
grid $args.origin_l $args.origin_t $args.origin_b -sticky ew
489
490
- label $args.where_l -text [mc "Target Directory:"]
491
- entry $args.where_t \
490
+ ${NS}::label $args.where_l -text [mc "Target Directory:"]
491
+ ${NS}::entry $args.where_t \
492
-textvariable @local_path \
493
- -borderwidth 1 \
494
- -relief sunken \
493
-width 50
496
- button $args.where_b \
494
+ ${NS}::button $args.where_b \
495
-text [mc "Browse"] \
496
-command [cb _new_local_path]
497
grid $args.where_l $args.where_t $args.where_b -sticky ew
498
set w_localpath $args.where_t
499
502
- label $args.type_l -text [mc "Clone Type:"]
503
- frame $args.type_f
500
+ ${NS}::label $args.type_l -text [mc "Clone Type:"]
501
+ ${NS}::frame $args.type_f
502
set w_types [list]
505
- lappend w_types [radiobutton $args.type_f.hardlink \
503
+ lappend w_types [${NS}::radiobutton $args.type_f.hardlink \
504
-state disabled \
507
- -anchor w \
505
-text [mc "Standard (Fast, Semi-Redundant, Hardlinks)"] \
506
-variable @clone_type \
507
-value hardlink]
511
- lappend w_types [radiobutton $args.type_f.full \
508
+ lappend w_types [${NS}::radiobutton $args.type_f.full \
509
-state disabled \
513
- -anchor w \
510
-text [mc "Full Copy (Slower, Redundant Backup)"] \
511
-variable @clone_type \
512
-value full]
517
- lappend w_types [radiobutton $args.type_f.shared \
513
+ lappend w_types [${NS}::radiobutton $args.type_f.shared \
514
-state disabled \
519
- -anchor w \
515
-text [mc "Shared (Fastest, Not Recommended, No Backup)"] \
516
-variable @clone_type \
517
-value shared]
@@ -1005,26 +1000,25 @@ method _postcheckout_wait {fd_ph} {
1000
## Open Existing Repository
1001
1002
method _do_open {} {
1003
+ global NS
1004
$w_next conf \
1005
-state disabled \
1006
-command [cb _do_open2] \
1007
-text [mc "Open"]
1008
1013
- frame $w_body
1014
- label $w_body.h \
1015
- -font font_uibold \
1009
+ ${NS}::frame $w_body
1010
+ ${NS}::label $w_body.h \
1011
+ -font font_uibold -anchor center \
1012
-text [mc "Open Existing Repository"]
1013
pack $w_body.h -side top -fill x -pady 10
1014
pack $w_body -fill x -padx 10
1015
1020
- frame $w_body.where
1021
- label $w_body.where.l -text [mc "Repository:"]
1022
- entry $w_body.where.t \
1016
+ ${NS}::frame $w_body.where
1017
+ ${NS}::label $w_body.where.l -text [mc "Repository:"]
1018
+ ${NS}::entry $w_body.where.t \
1019
-textvariable @local_path \
1024
- -borderwidth 1 \
1025
- -relief sunken \
1020
-width 50
1027
- button $w_body.where.b \
1021
+ ${NS}::button $w_body.where.b \
1022
-text [mc "Browse"] \
1023
-command [cb _open_local_path]
1024
lib/choose_rev.tcl
+28
-23
@@ -10,7 +10,7 @@ field w_list ; # list of currently filtered specs
10
field w_filter ; # filter entry for $w_list
11
12
field c_expr {}; # current revision expression
13
-field filter ; # current filter string
13
+field filter ""; # current filter string
14
field revtype head; # type of revision chosen
15
field cur_specs [list]; # list of specs for $revtype
16
field spec_head ; # list of all head specs
@@ -32,7 +32,7 @@ proc new_unmerged {path {title {}}} {
32
}
33
34
constructor _new {path unmerged_only title} {
35
- global current_branch is_detached
35
+ global current_branch is_detached use_ttk NS
36
37
if {![info exists ::all_remotes]} {
38
load_all_remotes
@@ -41,65 +41,65 @@ constructor _new {path unmerged_only title} {
41
set w $path
42
43
if {$title ne {}} {
44
- labelframe $w -text $title
44
+ ${NS}::labelframe $w -text $title
45
} else {
46
- frame $w
46
+ ${NS}::frame $w
47
}
48
bind $w <Destroy> [cb _delete %W]
49
50
if {$is_detached} {
51
- radiobutton $w.detachedhead_r \
52
- -anchor w \
51
+ ${NS}::radiobutton $w.detachedhead_r \
52
-text [mc "This Detached Checkout"] \
53
-value HEAD \
54
-variable @revtype
55
+ if {!$use_ttk} {$w.detachedhead_r configure -anchor w}
56
grid $w.detachedhead_r -sticky we -padx {0 5} -columnspan 2
57
}
58
59
- radiobutton $w.expr_r \
59
+ ${NS}::radiobutton $w.expr_r \
60
-text [mc "Revision Expression:"] \
61
-value expr \
62
-variable @revtype
63
- entry $w.expr_t \
64
- -borderwidth 1 \
65
- -relief sunken \
63
+ ${NS}::entry $w.expr_t \
64
-width 50 \
65
-textvariable @c_expr \
66
-validate key \
67
-validatecommand [cb _validate %d %S]
68
grid $w.expr_r $w.expr_t -sticky we -padx {0 5}
69
72
- frame $w.types
73
- radiobutton $w.types.head_r \
70
+ ${NS}::frame $w.types
71
+ ${NS}::radiobutton $w.types.head_r \
72
-text [mc "Local Branch"] \
73
-value head \
74
-variable @revtype
75
pack $w.types.head_r -side left
78
- radiobutton $w.types.trck_r \
76
+ ${NS}::radiobutton $w.types.trck_r \
77
-text [mc "Tracking Branch"] \
78
-value trck \
79
-variable @revtype
80
pack $w.types.trck_r -side left
83
- radiobutton $w.types.tag_r \
81
+ ${NS}::radiobutton $w.types.tag_r \
82
-text [mc "Tag"] \
83
-value tag \
84
-variable @revtype
85
pack $w.types.tag_r -side left
86
set w_filter $w.types.filter
89
- entry $w_filter \
90
- -borderwidth 1 \
91
- -relief sunken \
87
+ ${NS}::entry $w_filter \
88
-width 12 \
89
-textvariable @filter \
90
-validate key \
91
-validatecommand [cb _filter %P]
92
pack $w_filter -side right
97
- pack [label $w.types.filter_icon \
93
+ pack [${NS}::label $w.types.filter_icon \
94
-image ::choose_rev::img_find \
95
] -side right
96
grid $w.types -sticky we -padx {0 5} -columnspan 2
97
102
- frame $w.list
98
+ if {$use_ttk} {
99
+ ttk::frame $w.list -style SListbox.TFrame -padding 2
100
+ } else {
101
+ frame $w.list
102
+ }
103
set w_list $w.list.l
104
listbox $w_list \
105
-font font_diff \
@@ -109,6 +109,9 @@ constructor _new {path unmerged_only title} {
109
-exportselection false \
110
-xscrollcommand [cb _sb_set $w.list.sbx h] \
111
-yscrollcommand [cb _sb_set $w.list.sby v]
112
+ if {$use_ttk} {
113
+ $w_list configure -relief flat -highlightthickness 0 -borderwidth 0
114
+ }
115
pack $w_list -fill both -expand 1
116
grid $w.list -sticky nswe -padx {20 5} -columnspan 2
117
bind $w_list <Any-Motion> [cb _show_tooltip @%x,%y]
@@ -235,11 +238,12 @@ constructor _new {path unmerged_only title} {
238
}
239
240
method none {text} {
241
+ global NS use_ttk
242
if {![winfo exists $w.none_r]} {
239
- radiobutton $w.none_r \
240
- -anchor w \
243
+ ${NS}::radiobutton $w.none_r \
244
-value none \
245
-variable @revtype
246
+ if {!$use_ttk} {$w.none_r configure -anchor w}
247
grid $w.none_r -sticky we -padx {0 5} -columnspan 2
248
}
249
$w.none_r configure -text $text
@@ -425,6 +429,7 @@ method _delete {current} {
429
}
430
431
method _sb_set {sb orient first last} {
432
+ global NS
433
set old_focus [focus -lastfor $w]
434
435
if {$first == 0 && $last == 1} {
@@ -440,10 +445,10 @@ method _sb_set {sb orient first last} {
445
446
if {![winfo exists $sb]} {
447
if {$orient eq {h}} {
443
- scrollbar $sb -orient h -command [list $w_list xview]
448
+ ${NS}::scrollbar $sb -orient h -command [list $w_list xview]
449
pack $sb -fill x -side bottom -before $w_list
450
} else {
446
- scrollbar $sb -orient v -command [list $w_list yview]
451
+ ${NS}::scrollbar $sb -orient v -command [list $w_list yview]
452
pack $sb -fill y -side right -before $w_list
453
}
454
if {$old_focus ne {}} {
lib/class.tcl
+7
@@ -134,6 +134,13 @@ proc delete_this {{t {}}} {
134
if {[namespace exists $t]} {namespace delete $t}
135
}
136
137
+proc make_dialog {t w args} {
138
+ upvar $t top $w pfx this this
139
+ global use_ttk
140
+ uplevel [linsert $args 0 make_toplevel $t $w]
141
+ pave_toplevel $pfx
142
+}
143
+
144
proc make_toplevel {t w args} {
145
upvar $t top $w pfx this this
146
lib/console.tcl
+9
-8
@@ -27,20 +27,20 @@ constructor embed {path title} {
27
}
28
29
method _init {} {
30
- global M1B
30
+ global M1B use_ttk NS
31
32
if {$is_toplevel} {
33
- make_toplevel top w -autodelete 0
33
+ make_dialog top w -autodelete 0
34
wm title $top "[appname] ([reponame]): $t_short"
35
} else {
36
- frame $w
36
+ ${NS}::frame $w
37
}
38
39
set console_cr 1.0
40
set w_t $w.m.t
41
42
- frame $w.m
43
- label $w.m.l1 \
42
+ ${NS}::frame $w.m
43
+ ${NS}::label $w.m.l1 \
44
-textvariable @t_long \
45
-anchor w \
46
-justify left \
@@ -78,7 +78,7 @@ method _init {} {
78
"
79
80
if {$is_toplevel} {
81
- button $w.ok -text [mc "Close"] \
81
+ ${NS}::button $w.ok -text [mc "Close"] \
82
-state disabled \
83
-command [list destroy $w]
84
pack $w.ok -side bottom -anchor e -pady 10 -padx 10
@@ -206,13 +206,14 @@ method done {ok} {
206
}
207
208
method _sb_set {sb orient first last} {
209
+ global NS
210
if {![winfo exists $sb]} {
211
if {$first == $last || ($first == 0 && $last == 1)} return
212
if {$orient eq {h}} {
212
- scrollbar $sb -orient h -command [list $w_t xview]
213
+ ${NS}::scrollbar $sb -orient h -command [list $w_t xview]
214
pack $sb -fill x -side bottom -before $w_t
215
} else {
215
- scrollbar $sb -orient v -command [list $w_t yview]
216
+ ${NS}::scrollbar $sb -orient v -command [list $w_t yview]
217
pack $sb -fill y -side right -before $w_t
218
}
219
}
lib/database.tcl
+10
-10
@@ -2,6 +2,7 @@
2
# Copyright (C) 2006, 2007 Shawn Pearce
3
4
proc do_stats {} {
5
+ global use_ttk NS
6
set fd [git_read count-objects -v]
7
while {[gets $fd line] > 0} {
8
if {[regexp {^([^:]+): (\d+)$} $line _ name value]} {
@@ -21,24 +22,22 @@ proc do_stats {} {
22
}
23
24
set w .stats_view
24
- toplevel $w
25
+ Dialog $w
26
+ wm withdraw $w
27
wm geometry $w "+[winfo rootx .]+[winfo rooty .]"
28
27
- label $w.header -text [mc "Database Statistics"]
28
- pack $w.header -side top -fill x
29
-
30
- frame $w.buttons -border 1
31
- button $w.buttons.close -text [mc Close] \
29
+ ${NS}::frame $w.buttons
30
+ ${NS}::button $w.buttons.close -text [mc Close] \
31
-default active \
32
-command [list destroy $w]
34
- button $w.buttons.gc -text [mc "Compress Database"] \
33
+ ${NS}::button $w.buttons.gc -text [mc "Compress Database"] \
34
-default normal \
35
-command "destroy $w;do_gc"
36
pack $w.buttons.close -side right
37
pack $w.buttons.gc -side left
38
pack $w.buttons -side bottom -fill x -pady 10 -padx 10
39
41
- frame $w.stat -borderwidth 1 -relief solid
40
+ ${NS}::labelframe $w.stat -text [mc "Database Statistics"]
41
foreach s {
42
{count {mc "Number of loose objects"}}
43
{size {mc "Disk space used by loose objects"} { KiB}}
@@ -55,8 +54,8 @@ proc do_stats {} {
54
set value "$value[lindex $s 2]"
55
}
56
58
- label $w.stat.l_$name -text "$label:" -anchor w
59
- label $w.stat.v_$name -text $value -anchor w
57
+ ${NS}::label $w.stat.l_$name -text "$label:" -anchor w
58
+ ${NS}::label $w.stat.v_$name -text $value -anchor w
59
grid $w.stat.l_$name $w.stat.v_$name -sticky we -padx {0 5}
60
}
61
pack $w.stat -pady 10 -padx 10
@@ -65,6 +64,7 @@ proc do_stats {} {
64
bind $w <Key-Escape> [list destroy $w]
65
bind $w <Key-Return> [list destroy $w]
66
wm title $w [append "[appname] ([reponame]): " [mc "Database Statistics"]]
67
+ wm deiconify $w
68
tkwait window $w
69
}
70
lib/error.tcl
+9
-6
@@ -71,11 +71,13 @@ proc ask_popup {msg} {
71
}
72
73
proc hook_failed_popup {hook msg {is_fatal 1}} {
74
+ global use_ttk NS
75
set w .hookfail
75
- toplevel $w
76
+ Dialog $w
77
+ wm withdraw $w
78
77
- frame $w.m
78
- label $w.m.l1 -text "$hook hook failed:" \
79
+ ${NS}::frame $w.m
80
+ ${NS}::label $w.m.l1 -text "$hook hook failed:" \
81
-anchor w \
82
-justify left \
83
-font font_uibold
@@ -87,10 +89,10 @@ proc hook_failed_popup {hook msg {is_fatal 1}} {
89
-width 80 -height 10 \
90
-font font_diff \
91
-yscrollcommand [list $w.m.sby set]
90
- scrollbar $w.m.sby -command [list $w.m.t yview]
92
+ ${NS}::scrollbar $w.m.sby -command [list $w.m.t yview]
93
pack $w.m.l1 -side top -fill x
94
if {$is_fatal} {
93
- label $w.m.l2 \
95
+ ${NS}::label $w.m.l2 \
96
-text [mc "You must correct the above errors before committing."] \
97
-anchor w \
98
-justify left \
@@ -104,7 +106,7 @@ proc hook_failed_popup {hook msg {is_fatal 1}} {
106
$w.m.t insert 1.0 $msg
107
$w.m.t conf -state disabled
108
107
- button $w.ok -text OK \
109
+ ${NS}::button $w.ok -text OK \
110
-width 15 \
111
-command "destroy $w"
112
pack $w.ok -side bottom -anchor e -pady 10 -padx 10
@@ -112,5 +114,6 @@ proc hook_failed_popup {hook msg {is_fatal 1}} {
114
bind $w <Visibility> "grab $w; focus $w"
115
bind $w <Key-Return> "destroy $w"
116
wm title $w [strcat "[appname] ([reponame]): " [mc "error"]]
117
+ wm deiconify $w
118
tkwait window $w
119
}
lib/index.tcl
+8
-5
@@ -8,26 +8,28 @@ proc _delete_indexlock {} {
8
}
9
10
proc _close_updateindex {fd after} {
11
+ global use_ttk NS
12
fconfigure $fd -blocking 1
13
if {[catch {close $fd} err]} {
14
set w .indexfried
14
- toplevel $w
15
+ Dialog $w
16
+ wm withdraw $w
17
wm title $w [strcat "[appname] ([reponame]): " [mc "Index Error"]]
18
wm geometry $w "+[winfo rootx .]+[winfo rooty .]"
19
set s [mc "Updating the Git index failed. A rescan will be automatically started to resynchronize git-gui."]
20
text $w.msg -yscrollcommand [list $w.vs set] \
21
-width [string length $s] -relief flat \
22
-borderwidth 0 -highlightthickness 0 \
21
- -background [$w cget -background]
23
+ -background [get_bg_color $w]
24
$w.msg tag configure bold -font font_uibold -justify center
23
- scrollbar $w.vs -command [list $w.msg yview]
25
+ ${NS}::scrollbar $w.vs -command [list $w.msg yview]
26
$w.msg insert end $s bold \n\n$err {}
27
$w.msg configure -state disabled
28
27
- button $w.continue \
29
+ ${NS}::button $w.continue \
30
-text [mc "Continue"] \
31
-command [list destroy $w]
30
- button $w.unlock \
32
+ ${NS}::button $w.unlock \
33
-text [mc "Unlock Index"] \
34
-command "destroy $w; _delete_indexlock"
35
grid $w.msg - $w.vs -sticky news
@@ -40,6 +42,7 @@ proc _close_updateindex {fd after} {
42
grab $w
43
focus %W
44
"
45
+ wm deiconify $w
46
tkwait window $w
47
48
$::main_status stop
lib/merge.tcl
+7
-7
@@ -139,14 +139,14 @@ method _finish {cons ok} {
139
140
constructor dialog {} {
141
global current_branch
142
- global M1B
142
+ global M1B use_ttk NS
143
144
if {![_can_merge $this]} {
145
delete_this
146
return
147
}
148
149
- make_toplevel top w
149
+ make_dialog top w
150
wm title $top [append "[appname] ([reponame]): " [mc "Merge"]]
151
if {$top ne {.}} {
152
wm geometry $top "+[winfo rootx .]+[winfo rooty .]"
@@ -154,21 +154,21 @@ constructor dialog {} {
154
155
set _start [cb _start]
156
157
- label $w.header \
157
+ ${NS}::label $w.header \
158
-text [mc "Merge Into %s" $current_branch] \
159
-font font_uibold
160
pack $w.header -side top -fill x
161
162
- frame $w.buttons
163
- button $w.buttons.visualize \
162
+ ${NS}::frame $w.buttons
163
+ ${NS}::button $w.buttons.visualize \
164
-text [mc Visualize] \
165
-command [cb _visualize]
166
pack $w.buttons.visualize -side left
167
- button $w.buttons.merge \
167
+ ${NS}::button $w.buttons.merge \
168
-text [mc Merge] \
169
-command $_start
170
pack $w.buttons.merge -side right
171
- button $w.buttons.cancel \
171
+ ${NS}::button $w.buttons.cancel \
172
-text [mc "Cancel"] \
173
-command [cb _cancel]
174
pack $w.buttons.cancel -side right -padx 5
lib/option.tcl
+37
-30
@@ -91,7 +91,7 @@ proc save_config {} {
91
proc do_options {} {
92
global repo_config global_config font_descs
93
global repo_config_new global_config_new
94
- global ui_comm_spell
94
+ global ui_comm_spell use_ttk NS
95
96
array unset repo_config_new
97
array unset global_config_new
@@ -110,26 +110,28 @@ proc do_options {} {
110
}
111
112
set w .options_editor
113
- toplevel $w
113
+ Dialog $w
114
+ wm withdraw $w
115
+ wm transient $w [winfo parent $w]
116
wm geometry $w "+[winfo rootx .]+[winfo rooty .]"
117
116
- frame $w.buttons
117
- button $w.buttons.restore -text [mc "Restore Defaults"] \
118
+ ${NS}::frame $w.buttons
119
+ ${NS}::button $w.buttons.restore -text [mc "Restore Defaults"] \
120
-default normal \
121
-command do_restore_defaults
122
pack $w.buttons.restore -side left
121
- button $w.buttons.save -text [mc Save] \
123
+ ${NS}::button $w.buttons.save -text [mc Save] \
124
-default active \
125
-command [list do_save_config $w]
126
pack $w.buttons.save -side right
125
- button $w.buttons.cancel -text [mc "Cancel"] \
127
+ ${NS}::button $w.buttons.cancel -text [mc "Cancel"] \
128
-default normal \
129
-command [list destroy $w]
130
pack $w.buttons.cancel -side right -padx 5
131
pack $w.buttons -side bottom -fill x -pady 10 -padx 10
132
131
- labelframe $w.repo -text [mc "%s Repository" [reponame]]
132
- labelframe $w.global -text [mc "Global (All Repositories)"]
133
+ ${NS}::labelframe $w.repo -text [mc "%s Repository" [reponame]]
134
+ ${NS}::labelframe $w.global -text [mc "Global (All Repositories)"]
135
pack $w.repo -side left -fill both -expand 1 -pady 5 -padx 5
136
pack $w.global -side right -fill both -expand 1 -pady 5 -padx 5
137
@@ -161,7 +163,7 @@ proc do_options {} {
163
foreach f {repo global} {
164
switch -glob -- $type {
165
b {
164
- checkbutton $w.$f.$optid -text $text \
166
+ ${NS}::checkbutton $w.$f.$optid -text $text \
167
-variable ${f}_config_new($name) \
168
-onvalue true \
169
-offvalue false
@@ -169,10 +171,10 @@ proc do_options {} {
171
}
172
i-* {
173
regexp -- {-(\d+)\.\.(\d+)$} $type _junk min max
172
- frame $w.$f.$optid
173
- label $w.$f.$optid.l -text "$text:"
174
+ ${NS}::frame $w.$f.$optid
175
+ ${NS}::label $w.$f.$optid.l -text "$text:"
176
pack $w.$f.$optid.l -side left -anchor w -fill x
175
- spinbox $w.$f.$optid.v \
177
+ tspinbox $w.$f.$optid.v \
178
-textvariable ${f}_config_new($name) \
179
-from $min \
180
-to $max \
@@ -184,11 +186,9 @@ proc do_options {} {
186
}
187
c -
188
t {
187
- frame $w.$f.$optid
188
- label $w.$f.$optid.l -text "$text:"
189
- entry $w.$f.$optid.v \
190
- -borderwidth 1 \
191
- -relief sunken \
189
+ ${NS}::frame $w.$f.$optid
190
+ ${NS}::label $w.$f.$optid.l -text "$text:"
191
+ ${NS}::entry $w.$f.$optid.v \
192
-width 20 \
193
-textvariable ${f}_config_new($name)
194
pack $w.$f.$optid.l -side left -anchor w
@@ -199,7 +199,7 @@ proc do_options {} {
199
menu $w.$f.$optid.m
200
build_encoding_menu $w.$f.$optid.m \
201
[list set ${f}_config_new($name)] 1
202
- button $w.$f.$optid.b \
202
+ ${NS}::button $w.$f.$optid.b \
203
-text [mc "Change"] \
204
-command [list popup_btn_menu \
205
$w.$f.$optid.m $w.$f.$optid.b]
@@ -226,11 +226,17 @@ proc do_options {} {
226
set ${f}_config_new(gui.spellingdictionary) $value
227
}
228
229
- frame $w.$f.$optid
230
- label $w.$f.$optid.l -text [mc "Spelling Dictionary:"]
231
- eval tk_optionMenu $w.$f.$optid.v \
232
- ${f}_config_new(gui.spellingdictionary) \
233
- $all_dicts
229
+ ${NS}::frame $w.$f.$optid
230
+ ${NS}::label $w.$f.$optid.l -text [mc "Spelling Dictionary:"]
231
+ if {$use_ttk} {
232
+ ttk::combobox $w.$f.$optid.v \
233
+ -textvariable ${f}_config_new(gui.spellingdictionary) \
234
+ -values $all_dicts -state readonly
235
+ } else {
236
+ eval tk_optionMenu $w.$f.$optid.v \
237
+ ${f}_config_new(gui.spellingdictionary) \
238
+ $all_dicts
239
+ }
240
pack $w.$f.$optid.l -side left -anchor w -fill x
241
pack $w.$f.$optid.v -side right -anchor e -padx 5
242
pack $w.$f.$optid -side top -anchor w -fill x
@@ -248,20 +254,20 @@ proc do_options {} {
254
set global_config_new(gui.$font^^size) \
255
[font configure $font -size]
256
251
- frame $w.global.$name
252
- label $w.global.$name.l -text "$text:"
253
- button $w.global.$name.b \
257
+ ${NS}::frame $w.global.$name
258
+ ${NS}::label $w.global.$name.l -text "$text:"
259
+ ${NS}::button $w.global.$name.b \
260
-text [mc "Change Font"] \
261
-command [list \
256
- choose_font::pick \
262
+ tchoosefont \
263
$w \
264
[mc "Choose %s" $text] \
265
global_config_new(gui.$font^^family) \
266
global_config_new(gui.$font^^size) \
267
]
262
- label $w.global.$name.f -textvariable global_config_new(gui.$font^^family)
263
- label $w.global.$name.s -textvariable global_config_new(gui.$font^^size)
264
- label $w.global.$name.pt -text [mc "pt."]
268
+ ${NS}::label $w.global.$name.f -textvariable global_config_new(gui.$font^^family)
269
+ ${NS}::label $w.global.$name.s -textvariable global_config_new(gui.$font^^size)
270
+ ${NS}::label $w.global.$name.pt -text [mc "pt."]
271
pack $w.global.$name.l -side left -anchor w
272
pack $w.global.$name.b -side right -anchor e
273
pack $w.global.$name.pt -side right -anchor w
@@ -280,6 +286,7 @@ proc do_options {} {
286
set t [mc "Options"]
287
}
288
wm title $w "[appname] ([reponame]): $t"
289
+ wm deiconify $w
290
tkwait window $w
291
}
292
lib/remote_add.tcl
+18
-19
@@ -13,45 +13,43 @@ field location {}; # location of the remote the user has chosen
13
field opt_action fetch; # action to do after registering the remote locally
14
15
constructor dialog {} {
16
- global repo_config
16
+ global repo_config use_ttk NS
17
18
- make_toplevel top w
18
+ make_dialog top w
19
+ wm withdraw $top
20
wm title $top [append "[appname] ([reponame]): " [mc "Add Remote"]]
21
if {$top ne {.}} {
22
wm geometry $top "+[winfo rootx .]+[winfo rooty .]"
23
}
24
24
- label $w.header -text [mc "Add New Remote"] -font font_uibold
25
+ ${NS}::label $w.header -text [mc "Add New Remote"] \
26
+ -font font_uibold -anchor center
27
pack $w.header -side top -fill x
28
27
- frame $w.buttons
28
- button $w.buttons.create -text [mc Add] \
29
+ ${NS}::frame $w.buttons
30
+ ${NS}::button $w.buttons.create -text [mc Add] \
31
-default active \
32
-command [cb _add]
33
pack $w.buttons.create -side right
32
- button $w.buttons.cancel -text [mc Cancel] \
34
+ ${NS}::button $w.buttons.cancel -text [mc Cancel] \
35
-command [list destroy $w]
36
pack $w.buttons.cancel -side right -padx 5
37
pack $w.buttons -side bottom -fill x -pady 10 -padx 10
38
37
- labelframe $w.desc -text [mc "Remote Details"]
39
+ ${NS}::labelframe $w.desc -text [mc "Remote Details"]
40
39
- label $w.desc.name_l -text [mc "Name:"]
41
+ ${NS}::label $w.desc.name_l -text [mc "Name:"]
42
set w_name $w.desc.name_t
41
- entry $w_name \
42
- -borderwidth 1 \
43
- -relief sunken \
43
+ ${NS}::entry $w_name \
44
-width 40 \
45
-textvariable @name \
46
-validate key \
47
-validatecommand [cb _validate_name %d %S]
48
grid $w.desc.name_l $w_name -sticky we -padx {0 5}
49
50
- label $w.desc.loc_l -text [mc "Location:"]
50
+ ${NS}::label $w.desc.loc_l -text [mc "Location:"]
51
set w_loc $w.desc.loc_t
52
- entry $w_loc \
53
- -borderwidth 1 \
54
- -relief sunken \
52
+ ${NS}::entry $w_loc \
53
-width 40 \
54
-textvariable @location
55
grid $w.desc.loc_l $w_loc -sticky we -padx {0 5}
@@ -59,21 +57,21 @@ constructor dialog {} {
57
grid columnconfigure $w.desc 1 -weight 1
58
pack $w.desc -anchor nw -fill x -pady 5 -padx 5
59
62
- labelframe $w.action -text [mc "Further Action"]
60
+ ${NS}::labelframe $w.action -text [mc "Further Action"]
61
64
- radiobutton $w.action.fetch \
62
+ ${NS}::radiobutton $w.action.fetch \
63
-text [mc "Fetch Immediately"] \
64
-value fetch \
65
-variable @opt_action
66
pack $w.action.fetch -anchor nw
67
70
- radiobutton $w.action.push \
68
+ ${NS}::radiobutton $w.action.push \
69
-text [mc "Initialize Remote Repository and Push"] \
70
-value push \
71
-variable @opt_action
72
pack $w.action.push -anchor nw
73
76
- radiobutton $w.action.none \
74
+ ${NS}::radiobutton $w.action.none \
75
-text [mc "Do Nothing Else Now"] \
76
-value none \
77
-variable @opt_action
@@ -85,6 +83,7 @@ constructor dialog {} {
83
bind $w <Visibility> [cb _visible]
84
bind $w <Key-Escape> [list destroy $w]
85
bind $w <Key-Return> [cb _add]\;break
86
+ wm deiconify $top
87
tkwait window $w
88
}
89
lib/remote_branch_delete.tcl
+26
-25
@@ -23,34 +23,40 @@ field full_cache
23
field cached
24
25
constructor dialog {} {
26
- global all_remotes M1B
26
+ global all_remotes M1B use_ttk NS
27
28
- make_toplevel top w
28
+ make_dialog top w
29
wm title $top [append "[appname] ([reponame]): " [mc "Delete Branch Remotely"]]
30
if {$top ne {.}} {
31
wm geometry $top "+[winfo rootx .]+[winfo rooty .]"
32
}
33
34
- label $w.header -text [mc "Delete Branch Remotely"] -font font_uibold
34
+ ${NS}::label $w.header -text [mc "Delete Branch Remotely"] \
35
+ -font font_uibold -anchor center
36
pack $w.header -side top -fill x
37
37
- frame $w.buttons
38
- button $w.buttons.delete -text [mc Delete] \
38
+ ${NS}::frame $w.buttons
39
+ ${NS}::button $w.buttons.delete -text [mc Delete] \
40
-default active \
41
-command [cb _delete]
42
pack $w.buttons.delete -side right
42
- button $w.buttons.cancel -text [mc "Cancel"] \
43
+ ${NS}::button $w.buttons.cancel -text [mc "Cancel"] \
44
-command [list destroy $w]
45
pack $w.buttons.cancel -side right -padx 5
46
pack $w.buttons -side bottom -fill x -pady 10 -padx 10
47
47
- labelframe $w.dest -text [mc "From Repository"]
48
+ ${NS}::labelframe $w.dest -text [mc "From Repository"]
49
if {$all_remotes ne {}} {
49
- radiobutton $w.dest.remote_r \
50
+ ${NS}::radiobutton $w.dest.remote_r \
51
-text [mc "Remote:"] \
52
-value remote \
53
-variable @urltype
53
- eval tk_optionMenu $w.dest.remote_m @remote $all_remotes
54
+ if {$use_ttk} {
55
+ ttk::combobox $w.dest.remote_m -textvariable @remote \
56
+ -values $all_remotes -state readonly
57
+ } else {
58
+ eval tk_optionMenu $w.dest.remote_m @remote $all_remotes
59
+ }
60
grid $w.dest.remote_r $w.dest.remote_m -sticky w
61
if {[lsearch -sorted -exact $all_remotes origin] != -1} {
62
set remote origin
@@ -62,13 +68,11 @@ constructor dialog {} {
68
} else {
69
set urltype url
70
}
65
- radiobutton $w.dest.url_r \
71
+ ${NS}::radiobutton $w.dest.url_r \
72
-text [mc "Arbitrary Location:"] \
73
-value url \
74
-variable @urltype
69
- entry $w.dest.url_t \
70
- -borderwidth 1 \
71
- -relief sunken \
75
+ ${NS}::entry $w.dest.url_t \
76
-width 50 \
77
-textvariable @url \
78
-validate key \
@@ -81,33 +85,30 @@ constructor dialog {} {
85
grid columnconfigure $w.dest 1 -weight 1
86
pack $w.dest -anchor nw -fill x -pady 5 -padx 5
87
84
- labelframe $w.heads -text [mc "Branches"]
85
- listbox $w.heads.l \
88
+ ${NS}::labelframe $w.heads -text [mc "Branches"]
89
+ slistbox $w.heads.l \
90
-height 10 \
91
-width 70 \
92
-listvariable @head_list \
89
- -selectmode extended \
90
- -yscrollcommand [list $w.heads.sby set]
91
- scrollbar $w.heads.sby -command [list $w.heads.l yview]
93
+ -selectmode extended
94
93
- frame $w.heads.footer
94
- label $w.heads.footer.status \
95
+ ${NS}::frame $w.heads.footer
96
+ ${NS}::label $w.heads.footer.status \
97
-textvariable @status \
98
-anchor w \
99
-justify left
98
- button $w.heads.footer.rescan \
100
+ ${NS}::button $w.heads.footer.rescan \
101
-text [mc "Rescan"] \
102
-command [cb _rescan]
103
pack $w.heads.footer.status -side left -fill x
104
pack $w.heads.footer.rescan -side right
105
106
pack $w.heads.footer -side bottom -fill x
105
- pack $w.heads.sby -side right -fill y
107
pack $w.heads.l -side left -fill both -expand 1
108
pack $w.heads -fill both -expand 1 -pady 5 -padx 5
109
109
- labelframe $w.validate -text [mc "Delete Only If"]
110
- radiobutton $w.validate.head_r \
110
+ ${NS}::labelframe $w.validate -text [mc "Delete Only If"]
111
+ ${NS}::radiobutton $w.validate.head_r \
112
-text [mc "Merged Into:"] \
113
-value head \
114
-variable @checktype
@@ -115,7 +116,7 @@ constructor dialog {} {
116
trace add variable @head_list write [cb _write_head_list]
117
trace add variable @check_head write [cb _write_check_head]
118
grid $w.validate.head_r $w.validate.head_m -sticky w
118
- radiobutton $w.validate.always_r \
119
+ ${NS}::radiobutton $w.validate.always_r \
120
-text [mc "Always (Do not perform merge checks)"] \
121
-value always \
122
-variable @checktype
lib/search.tcl
+6
-5
@@ -14,15 +14,16 @@ field smarktop
14
field smarkbot
15
16
constructor new {i_w i_text args} {
17
+ global use_ttk NS
18
set w $i_w
19
set ctext $i_text
20
20
- frame $w
21
- label $w.l -text [mc Find:]
21
+ ${NS}::frame $w
22
+ ${NS}::label $w.l -text [mc Find:]
23
entry $w.ent -textvariable ${__this}::searchstring -background lightgreen
23
- button $w.bn -text [mc Next] -command [cb find_next]
24
- button $w.bp -text [mc Prev] -command [cb find_prev]
25
- checkbutton $w.cs -text [mc Case-Sensitive] \
24
+ ${NS}::button $w.bn -text [mc Next] -command [cb find_next]
25
+ ${NS}::button $w.bp -text [mc Prev] -command [cb find_prev]
26
+ ${NS}::checkbutton $w.cs -text [mc Case-Sensitive] \
27
-variable ${__this}::casesensitive -command [cb _incrsearch]
28
pack $w.l -side left
29
pack $w.cs -side right
lib/sshkey.tcl
+11
-9
@@ -15,7 +15,7 @@ proc find_ssh_key {} {
15
}
16
17
proc do_ssh_key {} {
18
- global sshkey_title have_tk85 sshkey_fd
18
+ global sshkey_title have_tk85 sshkey_fd use_ttk NS
19
20
set w .sshkey_dialog
21
if {[winfo exists $w]} {
@@ -23,7 +23,7 @@ proc do_ssh_key {} {
23
return
24
}
25
26
- toplevel $w
26
+ Dialog $w
27
wm transient $w .
28
29
set finfo [find_ssh_key]
@@ -35,9 +35,9 @@ proc do_ssh_key {} {
35
set gen_state disabled
36
}
37
38
- frame $w.header -relief flat
39
- label $w.header.lbl -textvariable sshkey_title -anchor w
40
- button $w.header.gen -text [mc "Generate Key"] \
38
+ ${NS}::frame $w.header
39
+ ${NS}::label $w.header.lbl -textvariable sshkey_title -anchor w
40
+ ${NS}::button $w.header.gen -text [mc "Generate Key"] \
41
-command [list make_ssh_key $w] -state $gen_state
42
pack $w.header.lbl -side left -expand 1 -fill x
43
pack $w.header.gen -side right
@@ -46,14 +46,16 @@ proc do_ssh_key {} {
46
text $w.contents -width 60 -height 10 -wrap char -relief sunken
47
pack $w.contents -fill both -expand 1
48
if {$have_tk85} {
49
- $w.contents configure -inactiveselectbackground darkblue
49
+ set clr darkblue
50
+ if {$use_ttk} { set clr [ttk::style lookup . -selectbackground] }
51
+ $w.contents configure -inactiveselectbackground $clr
52
}
53
52
- frame $w.buttons
53
- button $w.buttons.close -text [mc Close] \
54
+ ${NS}::frame $w.buttons
55
+ ${NS}::button $w.buttons.close -text [mc Close] \
56
-default active -command [list destroy $w]
57
pack $w.buttons.close -side right
56
- button $w.buttons.copy -text [mc "Copy To Clipboard"] \
58
+ ${NS}::button $w.buttons.copy -text [mc "Copy To Clipboard"] \
59
-command [list tk_textCopy $w.contents]
60
pack $w.buttons.copy -side left
61
pack $w.buttons -side bottom -fill x -pady 5 -padx 5
lib/status_bar.tcl
+8
-6
@@ -13,14 +13,16 @@ field units {}; # unit of progress
13
field meter {}; # current core git progress meter (if active)
14
15
constructor new {path} {
16
+ global use_ttk NS
17
set w $path
18
set w_l $w.l
19
set w_c $w.c
20
20
- frame $w \
21
- -borderwidth 1 \
22
- -relief sunken
23
- label $w_l \
21
+ ${NS}::frame $w
22
+ if {!$use_ttk} {
23
+ $w configure -borderwidth 1 -relief sunken
24
+ }
25
+ ${NS}::label $w_l \
26
-textvariable @status \
27
-anchor w \
28
-justify left
@@ -41,8 +43,8 @@ constructor two_line {path} {
43
set w_l $w.l
44
set w_c $w.c
45
44
- frame $w
45
- label $w_l \
46
+ ${NS}::frame $w
47
+ ${NS}::label $w_l \
48
-textvariable @status \
49
-anchor w \
50
-justify left
lib/themed.tcl
new
+174
@@ -0,0 +1,174 @@
1
+# Functions for supporting the use of themed Tk widgets in git-gui.
2
+# Copyright (C) 2009 Pat Thoyts <patthoyts@users.sourceforge.net>
3
+
4
+proc InitTheme {} {
5
+ # Create a color label style (bg can be overridden by widget option)
6
+ ttk::style layout Color.TLabel {
7
+ Color.Label.border -sticky news -children {
8
+ Color.label.fill -sticky news -children {
9
+ Color.Label.padding -sticky news -children {
10
+ Color.Label.label -sticky news}}}}
11
+ eval [linsert [ttk::style configure TLabel] 0 \
12
+ ttk::style configure Color.TLabel]
13
+ ttk::style configure Color.TLabel \
14
+ -borderwidth 0 -relief flat -padding 2
15
+ ttk::style map Color.TLabel -background {{} gold}
16
+ # We also need a padded label.
17
+ ttk::style configure Padded.TLabel \
18
+ -padding {5 5} -borderwidth 1 -relief solid
19
+ # We need a gold frame.
20
+ ttk::style layout Gold.TFrame {
21
+ Gold.Frame.border -sticky nswe -children {
22
+ Gold.Frame.fill -sticky nswe}}
23
+ ttk::style configure Gold.TFrame -background gold -relief flat
24
+ # listboxes should have a theme border so embed in ttk::frame
25
+ ttk::style layout SListbox.TFrame {
26
+ SListbox.Frame.Entry.field -sticky news -border true -children {
27
+ SListbox.Frame.padding -sticky news
28
+ }
29
+ }
30
+}
31
+
32
+proc gold_frame {w args} {
33
+ global use_ttk
34
+ if {$use_ttk} {
35
+ eval [linsert $args 0 ttk::frame $w -style Gold.TFrame]
36
+ } else {
37
+ eval [linsert $args 0 frame $w -background gold]
38
+ }
39
+}
40
+
41
+proc tlabel {w args} {
42
+ global use_ttk
43
+ if {$use_ttk} {
44
+ set cmd [list ttk::label $w -style Color.TLabel]
45
+ foreach {k v} $args {
46
+ switch -glob -- $k {
47
+ -activebackground {}
48
+ default { lappend cmd $k $v }
49
+ }
50
+ }
51
+ eval $cmd
52
+ } else {
53
+ eval [linsert $args 0 label $w]
54
+ }
55
+}
56
+
57
+# The padded label gets used in the about class.
58
+proc paddedlabel {w args} {
59
+ global use_ttk
60
+ if {$use_ttk} {
61
+ eval [linsert $args 0 ttk::label $w -style Padded.TLabel]
62
+ } else {
63
+ eval [linsert $args 0 label $w \
64
+ -padx 5 -pady 5 \
65
+ -justify left \
66
+ -anchor w \
67
+ -borderwidth 1 \
68
+ -relief solid]
69
+ }
70
+}
71
+
72
+# Create a toplevel for use as a dialog.
73
+# If available, sets the EWMH dialog hint and if ttk is enabled
74
+# place a themed frame over the surface.
75
+proc Dialog {w args} {
76
+ eval [linsert $args 0 toplevel $w -class Dialog]
77
+ pave_toplevel $w
78
+ return $w
79
+}
80
+
81
+# Tk toplevels are not themed - so pave it over with a themed frame to get
82
+# the base color correct per theme.
83
+proc pave_toplevel {w} {
84
+ global use_ttk
85
+ if {$use_ttk && ![winfo exists $w.!paving]} {
86
+ set paving [ttk::frame $w.!paving]
87
+ place $paving -x 0 -y 0 -relwidth 1 -relheight 1
88
+ lower $paving
89
+ }
90
+}
91
+
92
+# Create a scrolled listbox with appropriate border for the current theme.
93
+# On many themes the border for a scrolled listbox needs to go around the
94
+# listbox and the scrollbar.
95
+proc slistbox {w args} {
96
+ global use_ttk NS
97
+ if {$use_ttk} {
98
+ set f [ttk::frame $w -style SListbox.TFrame -padding 2]
99
+ } else {
100
+ set f [frame $w -relief flat]
101
+ }
102
+ if {[catch {
103
+ if {$use_ttk} {
104
+ eval [linsert $args 0 listbox $f.list -relief flat \
105
+ -highlightthickness 0 -borderwidth 0]
106
+ } else {
107
+ eval [linsert $args 0 listbox $f.list]
108
+ }
109
+ ${NS}::scrollbar $f.vs -command [list $f.list yview]
110
+ $f.list configure -yscrollcommand [list $f.vs set]
111
+ grid $f.list $f.vs -sticky news
112
+ grid rowconfigure $f 0 -weight 1
113
+ grid columnconfigure $f 0 -weight 1
114
+ bind $f.list <<ListboxSelect>> \
115
+ [list event generate $w <<ListboxSelect>>]
116
+ interp hide {} $w
117
+ interp alias {} $w {} $f.list
118
+ } err]} {
119
+ destroy $f
120
+ return -code error $err
121
+ }
122
+ return $w
123
+}
124
+
125
+# fetch the background color from a widget.
126
+proc get_bg_color {w} {
127
+ global use_ttk
128
+ if {$use_ttk} {
129
+ set bg [ttk::style lookup [winfo class $w] -background]
130
+ } else {
131
+ set bg [$w cget -background]
132
+ }
133
+ return $bg
134
+}
135
+
136
+# ttk::spinbox didn't get added until 8.6
137
+proc tspinbox {w args} {
138
+ global use_ttk
139
+ if {$use_ttk && [llength [info commands ttk::spinbox]] > 0} {
140
+ eval [linsert $args 0 ttk::spinbox $w]
141
+ } else {
142
+ eval [linsert $args 0 spinbox $w]
143
+ }
144
+}
145
+
146
+# Tk 8.6 provides a standard font selection dialog. This uses the native
147
+# dialogs on Windows and MacOSX or a standard Tk dialog on X11.
148
+proc tchoosefont {w title familyvar sizevar} {
149
+ if {[package vsatisfies [package provide Tk] 8.6]} {
150
+ upvar #0 $familyvar family
151
+ upvar #0 $sizevar size
152
+ tk fontchooser configure -parent $w -title $title \
153
+ -font [list $family $size] \
154
+ -command [list on_choosefont $familyvar $sizevar]
155
+ tk fontchooser show
156
+ } else {
157
+ choose_font::pick $w $title $familyvar $sizevar
158
+ }
159
+}
160
+
161
+# Called when the Tk 8.6 fontchooser selects a font.
162
+proc on_choosefont {familyvar sizevar font} {
163
+ upvar #0 $familyvar family
164
+ upvar #0 $sizevar size
165
+ set font [font actual $font]
166
+ set family [dict get $font -family]
167
+ set size [dict get $font -size]
168
+}
169
+
170
+# Local variables:
171
+# mode: tcl
172
+# indent-tabs-mode: t
173
+# tab-width: 4
174
+# End:
lib/tools_dlg.tcl
+40
-47
@@ -16,53 +16,50 @@ field ask_branch 0; # ask for a revision
16
field ask_args 0; # ask for additional args
17
18
constructor dialog {} {
19
- global repo_config
19
+ global repo_config use_ttk NS
20
21
- make_toplevel top w
21
+ make_dialog top w
22
wm title $top [append "[appname] ([reponame]): " [mc "Add Tool"]]
23
if {$top ne {.}} {
24
wm geometry $top "+[winfo rootx .]+[winfo rooty .]"
25
wm transient $top .
26
}
27
28
- label $w.header -text [mc "Add New Tool Command"] -font font_uibold
28
+ ${NS}::label $w.header -text [mc "Add New Tool Command"] \
29
+ -font font_uibold -anchor center
30
pack $w.header -side top -fill x
31
31
- frame $w.buttons
32
- checkbutton $w.buttons.global \
32
+ ${NS}::frame $w.buttons
33
+ ${NS}::checkbutton $w.buttons.global \
34
-text [mc "Add globally"] \
35
-variable @add_global
36
pack $w.buttons.global -side left -padx 5
36
- button $w.buttons.create -text [mc Add] \
37
+ ${NS}::button $w.buttons.create -text [mc Add] \
38
-default active \
39
-command [cb _add]
40
pack $w.buttons.create -side right
40
- button $w.buttons.cancel -text [mc Cancel] \
41
+ ${NS}::button $w.buttons.cancel -text [mc Cancel] \
42
-command [list destroy $w]
43
pack $w.buttons.cancel -side right -padx 5
44
pack $w.buttons -side bottom -fill x -pady 10 -padx 10
45
45
- labelframe $w.desc -text [mc "Tool Details"]
46
+ ${NS}::labelframe $w.desc -text [mc "Tool Details"]
47
47
- label $w.desc.name_cmnt -anchor w\
48
+ ${NS}::label $w.desc.name_cmnt -anchor w\
49
-text [mc "Use '/' separators to create a submenu tree:"]
50
grid x $w.desc.name_cmnt -sticky we -padx {0 5} -pady {0 2}
50
- label $w.desc.name_l -text [mc "Name:"]
51
+ ${NS}::label $w.desc.name_l -text [mc "Name:"]
52
set w_name $w.desc.name_t
52
- entry $w_name \
53
- -borderwidth 1 \
54
- -relief sunken \
53
+ ${NS}::entry $w_name \
54
-width 40 \
55
-textvariable @name \
56
-validate key \
57
-validatecommand [cb _validate_name %d %S]
58
grid $w.desc.name_l $w_name -sticky we -padx {0 5}
59
61
- label $w.desc.cmd_l -text [mc "Command:"]
60
+ ${NS}::label $w.desc.cmd_l -text [mc "Command:"]
61
set w_cmd $w.desc.cmd_t
63
- entry $w_cmd \
64
- -borderwidth 1 \
65
- -relief sunken \
62
+ ${NS}::entry $w_cmd \
63
-width 40 \
64
-textvariable @command
65
grid $w.desc.cmd_l $w_cmd -sticky we -padx {0 5} -pady {0 3}
@@ -70,30 +67,30 @@ constructor dialog {} {
67
grid columnconfigure $w.desc 1 -weight 1
68
pack $w.desc -anchor nw -fill x -pady 5 -padx 5
69
73
- checkbutton $w.confirm \
70
+ ${NS}::checkbutton $w.confirm \
71
-text [mc "Show a dialog before running"] \
72
-variable @confirm -command [cb _check_enable_dlg]
73
77
- labelframe $w.dlg -labelwidget $w.confirm
74
+ ${NS}::labelframe $w.dlg -labelwidget $w.confirm
75
79
- checkbutton $w.dlg.askbranch \
76
+ ${NS}::checkbutton $w.dlg.askbranch \
77
-text [mc "Ask the user to select a revision (sets \$REVISION)"] \
78
-variable @ask_branch -state disabled
79
pack $w.dlg.askbranch -anchor w -padx 15
80
84
- checkbutton $w.dlg.askargs \
81
+ ${NS}::checkbutton $w.dlg.askargs \
82
-text [mc "Ask the user for additional arguments (sets \$ARGS)"] \
83
-variable @ask_args -state disabled
84
pack $w.dlg.askargs -anchor w -padx 15
85
86
pack $w.dlg -anchor nw -fill x -pady {0 8} -padx 5
87
91
- checkbutton $w.noconsole \
88
+ ${NS}::checkbutton $w.noconsole \
89
-text [mc "Don't show the command output window"] \
90
-variable @no_console
91
pack $w.noconsole -anchor w -padx 5
92
96
- checkbutton $w.needsfile \
93
+ ${NS}::checkbutton $w.needsfile \
94
-text [mc "Run only if a diff is selected (\$FILENAME not empty)"] \
95
-variable @needs_file
96
pack $w.needsfile -anchor w -padx 5
@@ -182,40 +179,38 @@ field w ; # widget path
179
field w_names ; # name list
180
181
constructor dialog {} {
185
- global repo_config global_config system_config
182
+ global repo_config global_config system_config use_ttk NS
183
184
load_config 1
185
189
- make_toplevel top w
186
+ make_dialog top w
187
wm title $top [append "[appname] ([reponame]): " [mc "Remove Tool"]]
188
if {$top ne {.}} {
189
wm geometry $top "+[winfo rootx .]+[winfo rooty .]"
190
wm transient $top .
191
}
192
196
- label $w.header -text [mc "Remove Tool Commands"] -font font_uibold
193
+ ${NS}::label $w.header -text [mc "Remove Tool Commands"] \
194
+ -font font_uibold -anchor center
195
pack $w.header -side top -fill x
196
199
- frame $w.buttons
200
- button $w.buttons.create -text [mc Remove] \
197
+ ${NS}::frame $w.buttons
198
+ ${NS}::button $w.buttons.create -text [mc Remove] \
199
-default active \
200
-command [cb _remove]
201
pack $w.buttons.create -side right
204
- button $w.buttons.cancel -text [mc Cancel] \
202
+ ${NS}::button $w.buttons.cancel -text [mc Cancel] \
203
-command [list destroy $w]
204
pack $w.buttons.cancel -side right -padx 5
205
pack $w.buttons -side bottom -fill x -pady 10 -padx 10
206
209
- frame $w.list
207
+ ${NS}::frame $w.list
208
set w_names $w.list.l
211
- listbox $w_names \
209
+ slistbox $w_names \
210
-height 10 \
211
-width 30 \
212
-selectmode extended \
215
- -exportselection false \
216
- -yscrollcommand [list $w.list.sby set]
217
- scrollbar $w.list.sby -command [list $w.list.l yview]
218
- pack $w.list.sby -side right -fill y
213
+ -exportselection false
214
pack $w.list.l -side left -fill both -expand 1
215
pack $w.list -fill both -expand 1 -pady 5 -padx 5
216
@@ -232,7 +227,7 @@ constructor dialog {} {
227
}
228
229
if {$local_cnt > 0} {
235
- label $w.colorlbl -foreground blue \
230
+ ${NS}::label $w.colorlbl -foreground blue \
231
-text [mc "(Blue denotes repository-local tools)"]
232
pack $w.colorlbl -fill x -pady 5 -padx 5
233
}
@@ -277,14 +272,14 @@ field is_ok 0; # ok to start
272
field argstr {}; # arguments
273
274
constructor dialog {fullname} {
280
- global M1B
275
+ global M1B use_ttk NS
276
277
set title [get_config "guitool.$fullname.title"]
278
if {$title eq {}} {
279
regsub {/} $fullname { / } title
280
}
281
287
- make_toplevel top w -autodelete 0
282
+ make_dialog top w -autodelete 0
283
wm title $top [append "[appname] ([reponame]): " $title]
284
if {$top ne {.}} {
285
wm geometry $top "+[winfo rootx .]+[winfo rooty .]"
@@ -297,7 +292,7 @@ constructor dialog {fullname} {
292
set prompt [mc "Run Command: %s" $command]
293
}
294
300
- label $w.header -text $prompt -font font_uibold
295
+ ${NS}::label $w.header -text $prompt -font font_uibold -anchor center
296
pack $w.header -side top -fill x
297
298
set argprompt [get_config "guitool.$fullname.argprompt"]
@@ -311,12 +306,10 @@ constructor dialog {fullname} {
306
set argprompt [mc "Arguments"]
307
}
308
314
- labelframe $w.arg -text $argprompt
309
+ ${NS}::labelframe $w.arg -text $argprompt
310
311
set w_args $w.arg.txt
317
- entry $w_args \
318
- -borderwidth 1 \
319
- -relief sunken \
312
+ ${NS}::entry $w_args \
313
-width 40 \
314
-textvariable @argstr
315
pack $w_args -padx 5 -pady 5 -fill both
@@ -337,18 +330,18 @@ constructor dialog {fullname} {
330
pack $w.rev -anchor nw -fill both -expand 1 -pady 5 -padx 5
331
}
332
340
- frame $w.buttons
333
+ ${NS}::frame $w.buttons
334
if {$is_ask_revs} {
342
- button $w.buttons.visualize \
335
+ ${NS}::button $w.buttons.visualize \
336
-text [mc Visualize] \
337
-command [cb _visualize]
338
pack $w.buttons.visualize -side left
339
}
347
- button $w.buttons.ok \
340
+ ${NS}::button $w.buttons.ok \
341
-text [mc OK] \
342
-command [cb _start]
343
pack $w.buttons.ok -side right
351
- button $w.buttons.cancel \
344
+ ${NS}::button $w.buttons.cancel \
345
-text [mc "Cancel"] \
346
-command [cb _cancel]
347
pack $w.buttons.cancel -side right -padx 5
lib/transport.tcl
+26
-22
@@ -91,50 +91,55 @@ trace add variable push_remote write \
91
proc do_push_anywhere {} {
92
global all_remotes current_branch
93
global push_urltype push_remote push_url push_thin push_tags
94
- global push_force
94
+ global push_force use_ttk NS
95
96
set w .push_setup
97
toplevel $w
98
+ wm withdraw $w
99
wm geometry $w "+[winfo rootx .]+[winfo rooty .]"
100
+ pave_toplevel $w
101
100
- label $w.header -text [mc "Push Branches"] -font font_uibold
102
+ ${NS}::label $w.header -text [mc "Push Branches"] \
103
+ -font font_uibold -anchor center
104
pack $w.header -side top -fill x
105
103
- frame $w.buttons
104
- button $w.buttons.create -text [mc Push] \
106
+ ${NS}::frame $w.buttons
107
+ ${NS}::button $w.buttons.create -text [mc Push] \
108
-default active \
109
-command [list start_push_anywhere_action $w]
110
pack $w.buttons.create -side right
108
- button $w.buttons.cancel -text [mc "Cancel"] \
111
+ ${NS}::button $w.buttons.cancel -text [mc "Cancel"] \
112
-default normal \
113
-command [list destroy $w]
114
pack $w.buttons.cancel -side right -padx 5
115
pack $w.buttons -side bottom -fill x -pady 10 -padx 10
116
114
- labelframe $w.source -text [mc "Source Branches"]
115
- listbox $w.source.l \
117
+ ${NS}::labelframe $w.source -text [mc "Source Branches"]
118
+ slistbox $w.source.l \
119
-height 10 \
120
-width 70 \
118
- -selectmode extended \
119
- -yscrollcommand [list $w.source.sby set]
121
+ -selectmode extended
122
foreach h [load_all_heads] {
123
$w.source.l insert end $h
124
if {$h eq $current_branch} {
125
$w.source.l select set end
126
}
127
}
126
- scrollbar $w.source.sby -command [list $w.source.l yview]
127
- pack $w.source.sby -side right -fill y
128
pack $w.source.l -side left -fill both -expand 1
129
pack $w.source -fill both -expand 1 -pady 5 -padx 5
130
131
- labelframe $w.dest -text [mc "Destination Repository"]
131
+ ${NS}::labelframe $w.dest -text [mc "Destination Repository"]
132
if {$all_remotes ne {}} {
133
- radiobutton $w.dest.remote_r \
133
+ ${NS}::radiobutton $w.dest.remote_r \
134
-text [mc "Remote:"] \
135
-value remote \
136
-variable push_urltype
137
- eval tk_optionMenu $w.dest.remote_m push_remote $all_remotes
137
+ if {$use_ttk} {
138
+ ttk::combobox $w.dest.remote_m -textvariable push_remote \
139
+ -values $all_remotes
140
+ } else {
141
+ eval tk_optionMenu $w.dest.remote_m push_remote $all_remotes
142
+ }
143
grid $w.dest.remote_r $w.dest.remote_m -sticky w
144
if {[lsearch -sorted -exact $all_remotes origin] != -1} {
145
set push_remote origin
@@ -145,13 +150,11 @@ proc do_push_anywhere {} {
150
} else {
151
set push_urltype url
152
}
148
- radiobutton $w.dest.url_r \
153
+ ${NS}::radiobutton $w.dest.url_r \
154
-text [mc "Arbitrary Location:"] \
155
-value url \
156
-variable push_urltype
152
- entry $w.dest.url_t \
153
- -borderwidth 1 \
154
- -relief sunken \
157
+ ${NS}::entry $w.dest.url_t \
158
-width 50 \
159
-textvariable push_url \
160
-validate key \
@@ -166,16 +169,16 @@ proc do_push_anywhere {} {
169
grid columnconfigure $w.dest 1 -weight 1
170
pack $w.dest -anchor nw -fill x -pady 5 -padx 5
171
169
- labelframe $w.options -text [mc "Transfer Options"]
170
- checkbutton $w.options.force \
172
+ ${NS}::labelframe $w.options -text [mc "Transfer Options"]
173
+ ${NS}::checkbutton $w.options.force \
174
-text [mc "Force overwrite existing branch (may discard changes)"] \
175
-variable push_force
176
grid $w.options.force -columnspan 2 -sticky w
174
- checkbutton $w.options.thin \
177
+ ${NS}::checkbutton $w.options.thin \
178
-text [mc "Use thin pack (for slow network connections)"] \
179
-variable push_thin
180
grid $w.options.thin -columnspan 2 -sticky w
178
- checkbutton $w.options.tags \
181
+ ${NS}::checkbutton $w.options.tags \
182
-text [mc "Include tags"] \
183
-variable push_tags
184
grid $w.options.tags -columnspan 2 -sticky w
@@ -191,5 +194,6 @@ proc do_push_anywhere {} {
194
bind $w <Key-Escape> "destroy $w"
195
bind $w <Key-Return> [list start_push_anywhere_action $w]
196
wm title $w [append "[appname] ([reponame]): " [mc "Push"]]
197
+ wm deiconify $w
198
tkwait window $w
199
}