Change UI to use themed widgets.

Support targets that use ttk widgets by toggling the 'active' state where no background option is available.
tcltk · Nov 28, 2020 · 08e5945 · 08e5945
1 parent c2e3183
commit 08e5945
Show file tree

Hide file tree

Showing 14 changed files with 160 additions and 141 deletions.
diff --git a/.editorconfig b/.editorconfig
@@ -0,0 +1,9 @@
+root = true
+
+[*.tcl]
+indent_style = space
+indent_size = 4
+tab_width = 8
+charset = utf-8
+trim_trailing_whitespace = true
+insert_final_newline = true
diff --git a/about.tcl b/about.tcl
@@ -12,16 +12,16 @@ dialog about {
 	global tkinspect tkinspect_library
 	wm withdraw $self
 	wm transient $self .
-	pack [frame $self.border -relief ridge -bd 4] -expand 1 -fill both
-	label $self.title -text "tkinspect" -font $slot(boldFont)
-	label $self.ver \
+	pack [ttk::frame $self.border] -expand 1 -fill both
+	ttk::label $self.title -text "tkinspect" -font $slot(boldFont)
+	ttk::label $self.ver \
 	    -text "Release $tkinspect(release) ($tkinspect(release_date))" \
 	    -font $slot(font)
-	label $self.com -text "\n Bugs, suggestions and patches to:\n\
+	ttk::label $self.com -text "\n Bugs, suggestions and patches to:\n\
                       http://sourceforge.net/projects/tkcon/ \n" \
 	    -font $slot(obliqueFont)
-	frame $self.mug -bd 4
-	label $self.mug.l -justify left \
+	ttk::frame $self.mug
+	ttk::label $self.mug.l -justify left \
             -text "Originally by Sam Shen\n\Contributions\
             from:\nPaul Healy\nJohn LoVerso\n\T. Schotanus\
             \nPat Thoyts\nAlexander Caldwell\n"
@@ -31,11 +31,10 @@ dialog about {
 	    set about_priv(mug_image) \
 		[image create photo -file $tkinspect_library/sls.ppm]
 	}
-	label $self.mug.bm -image $about_priv(mug_image) -bd 2 \
-	    -relief sunken
+	ttk::label $self.mug.bm -image $about_priv(mug_image)
 	pack $self.mug.l -side left -fill both -expand yes
 	pack $self.mug.bm -fill none
-	button $self.ok -text "Ok" -command "destroy $self"
+	ttk::button $self.ok -text "Ok" -command "destroy $self"
 	pack $self.title $self.ver $self.com $self.mug \
 	    -in $self.border -side top -fill x
 	pack $self.ok -in $self.border -side bottom -pady 5
@@ -49,6 +48,6 @@ dialog about {
 	center_window $self
 	tkwait visibility $self
 	grab set $self
-	tkwait window $self	
+	tkwait window $self
     }
 }
diff --git a/defaults.tcl b/defaults.tcl
@@ -10,6 +10,7 @@ proc tkinspect_default_options {} {
     option add *Label*borderWidth 0
     option add *Frame.highlightThickness 0
     option add *Frame.borderWidth 2
+    option add *tearOff: 0
     option add *Menubutton.borderWidth 0
     option add *Command_line.highlightThickness 0
     option add *Command_line.borderWidth 2

diff --git a/globals_list.tcl b/globals_list.tcl
@@ -16,8 +16,8 @@ dialog variable_trace {
     member is_array 0
     member trace_cmd ""
     method create {} {
-	pack [frame $self.menu -bd 2 -relief raised] -side top -fill x
-	menubutton $self.menu.file -text "File" -underline 0 \
+	pack [ttk::frame $self.menu] -side top -fill x
+	ttk::menubutton $self.menu.file -text "File" -underline 0 \
 	    -menu $self.menu.file.m
 	pack $self.menu.file -side left
 	set m [menu $self.menu.file.m]
@@ -26,7 +26,7 @@ dialog variable_trace {
 	$m add separator
 	$m add command -label "Close Window" -command "destroy $self" \
 	    -underline 0
-	scrollbar $self.sb -relief sunken -bd 1 -command "$self.t yview"
+	ttk::scrollbar $self.sb -command "$self.t yview"
 	text $self.t -yscroll "$self.sb set" -setgrid 1
 	pack $self.sb -side right -fill y
 	pack $self.t -side right -fill both -expand 1

diff --git a/help.tcl b/help.tcl
@@ -12,12 +12,12 @@ dialog help_window {
     member history_len 0
     member rendering 0
     method create {} {
-	frame $self.menu -relief raised -bd 2
-	menubutton $self.menu.topics -text "Topics" -underline 0 \
+	ttk::frame $self.menu
+	ttk::menubutton $self.menu.topics -text "Topics" -underline 0 \
 	    -menu $self.menu.topics.m
 	pack $self.menu.topics -in $self.menu -side left
 	set m [menu $self.menu.topics.m]
-	menubutton $self.menu.navigate -text "Navigate" -underline 0 \
+	ttk::menubutton $self.menu.navigate -text "Navigate" -underline 0 \
 	    -menu $self.menu.navigate.m
 	pack $self.menu.navigate -in $self.menu -side left
 	set m [menu $self.menu.navigate.m]
@@ -27,10 +27,10 @@ dialog help_window {
 	    -command "$self back" -accelerator b
 	$m add cascade -label "Go" -underline 0 -menu $m.go
 	menu $m.go -postcommand "$self fill_go_menu"
-	frame $self.text -bd 2 -relief raised
-	scrollbar $self.text.sb -command "$self.text.t yview"
-	text $self.text.t -relief sunken -bd 2 -yscroll "$self.text.sb set" \
-	    -wrap word -setgrid 1
+	ttk::frame $self.text
+	ttk::scrollbar $self.text.sb -command "$self.text.t yview"
+	text $self.text.t -yscrollcommand "$self.text.sb set" \
+	    -wrap word -setgrid 1 -background white
 	set t $self.text.t
 	pack $self.text.sb -in $self.text -side right -fill y
 	pack $self.text.t -in $self.text -side left -fill both -expand yes
@@ -81,7 +81,7 @@ dialog help_window {
 	set txt [read $f]
 	close $f
 
-        # Fix for 
+        # Fix for
         if [string match -nocase "*ChangeLog" $filename] {
             set txt "<html><body><pre>$txt</pre></body></html>"
         }

diff --git a/install.tcl b/install.tcl
@@ -28,8 +28,8 @@ widget install_path {
     param label
     param variable
     method create {} {
-	entry $self.e -width 60 -bd 2 -relief sunken
-	label $self.l
+	ttk::entry $self.e -width 60
+	ttk::label $self.l
 	pack $self.e -side right
 	pack $self.l -side left
     }
@@ -71,14 +71,14 @@ widget install_exec {
     }
 }
 
-label .title -text "Tkinspect Installation" \
+ttk::label .title -text "Tkinspect Installation" \
     -font -adobe-helvetica-bold-r-*-*-*-180-*-*-*-*-*-*
-label .title2 -text "Release $tkinspect(release) ($tkinspect(release_date))" \
+ttk::label .title2 -text "Release $tkinspect(release) ($tkinspect(release_date))" \
     -font -*-helvetica-medium-r-*-*-12-*
 pack .title .title2 -side top
 
-text .instructions -relief ridge -bd 4 -width 20 -height 4 -wrap word \
-    -takefocus 0
+text .instructions -width 20 -height 4 -wrap word \
+    -takefocus 0 -background white
 .instructions insert 1.0 \
 {Fill out the pathnames below and press the install button.  Any errors will appear in log window below.  If you wish to demo tkinspect w/o installing it, try "wish -f tkinspect.tcl".
 }
@@ -87,7 +87,7 @@ pack .instructions -side top -fill both -expand 1
 switch -exact -- $tcl_platform(platform) {
     unix { set prefix /usr/local }
     windows -
-    macintosh { 
+    macintosh {
         set prefix [eval file join [lrange \
                 [file split [info nameofexecutable]] 0 end-2]]
     }
@@ -103,13 +103,13 @@ install_dir .libdir -label "Library dir:" -variable libdir
 install_exec .wish -label "Wish executable:" -variable wish
 pack .prefix .bindir .libdir .wish -side top -fill x
 
-text .log -width 70 -height 10 -bd 4 -relief ridge -takefocus 0
+text .log -width 70 -height 10 -takefocus 0
 pack .log -side top -fill both -expand 1
 
-frame .buttons
+ttk::frame .buttons
 pack .buttons -side top
-button .install -text "Install" -command do_install
-button .cancel -text "Exit" -command "destroy ."
+ttk::button .install -text "Install" -command do_install
+ttk::button .cancel -text "Exit" -command "destroy ."
 pack .install .cancel -in .buttons -side left -padx .1c
 
 wm title . "Tkinspect Installation"
@@ -155,7 +155,7 @@ proc install_files {dir files} {
                 unix { file attributes $dest -permissions 0444 }
                 windows -
                 macintosh { file attributes $dest -readonly 1 }
-                default { 
+                default {
                     error "platform $tcl_platform(platform) not recognised"
                 }
             }
@@ -197,7 +197,7 @@ proc install {} {
 	procs_list.tcl windows_list.tcl images_list.tcl menus_list.tcl
 	canvas_list.tcl value.tcl stl.tcl sls.ppm version.tcl help.tcl
 	cmdline.tcl interface.tcl tclIndex ChangeLog
-	names.tcl classes_list.tcl objects_list.tcl 
+	names.tcl classes_list.tcl objects_list.tcl
         afters_list.tcl namespaces_list.tcl
 	Intro.html Lists.html Procs.html Globals.html Windows.html
 	Images.html Canvases.html Menus.html Classes.html

diff --git a/lists.tcl b/lists.tcl
@@ -7,38 +7,38 @@ dialog filter_editor {
     member patterns
     member filter_type exclude
     method create {} {
-        frame $self.top
-        label $self.l -text "Pattern:"
-        entry $self.e -width 40 -relief sunken
-	bind $self.e <Return> "$self add_pattern"
+        ttk::frame $self.top
+        ttk::label $self.l -text "Pattern:"
+        ttk::entry $self.e -width 40
+        bind $self.e <Return> "$self add_pattern"
         pack $self.l -in $self.top -side left
         pack $self.e -in $self.top -side left -fill x
         pack $self.top -side top -fill x -pady .25c
-        frame $self.buttons -bd 3
-        button $self.ok -text "Apply" -command "$self apply"
-        button $self.close -text "Cancel" -command "wm withdraw $self"
-        button $self.add -text "Add Pattern" \
-	    -command "$self add_pattern"
-        button $self.del -text "Delete Pattern(s)" \
-	    -command "$self delete_patterns"
-        radiobutton $self.inc -variable [object_slotname filter_type] \
-	    -value include -relief flat -text "Include Patterns"
-        radiobutton $self.exc -variable [object_slotname filter_type] \
-	    -value exclude -relief flat -text "Exclude Patterns"
+        ttk::frame $self.buttons
+        ttk::button $self.ok -text "Apply" -command "$self apply"
+        ttk::button $self.close -text "Cancel" -command "wm withdraw $self"
+        ttk::button $self.add -text "Add Pattern" \
+            -command "$self add_pattern"
+        ttk::button $self.del -text "Delete Pattern(s)" \
+            -command "$self delete_patterns"
+        ttk::radiobutton $self.inc -variable [object_slotname filter_type] \
+            -value include -text "Include Patterns"
+        ttk::radiobutton $self.exc -variable [object_slotname filter_type] \
+            -value exclude -text "Exclude Patterns"
         pack $self.inc $self.exc $self.add $self.del -in $self.buttons \
-	    -side top -fill x -pady .1c -anchor w
+            -side top -fill x -pady .1c -anchor w
         pack $self.close $self.ok -in $self.buttons \
-	    -side bottom -fill x -pady .1c
+            -side bottom -fill x -pady .1c
         pack $self.buttons -in $self -side left -fill y
-        frame $self.lframe
-        scrollbar $self.sb -command "$self.list yview"
+        ttk::frame $self.lframe
+        ttk::scrollbar $self.sb -command "$self.list yview"
         listbox $self.list -yscroll "$self.sb set" -relief raised \
-            -width 40 -height 10 -selectmode multiple
+            -width 40 -height 10 -selectmode multiple -background white
         pack $self.sb -in $self.lframe -side right -fill y
         pack $self.list -in $self.lframe -side right -fill both -expand yes
         pack $self.lframe -in $self -side right -fill both -expand yes
-	set title "Edit [$slot(list) cget -title] Filter"
-	wm title $self $title
+        set title "Edit [$slot(list) cget -title] Filter"
+        wm title $self $title
 	foreach pat [$slot(list) cget -patterns] {
 	    $self.list insert end $pat
 	    lappend slot(patterns) $pat
@@ -73,19 +73,19 @@ dialog list_search {
     param list
     param search_type exact
     method create {} {
-	frame $self.top
+	ttk::frame $self.top
 	pack $self.top -side top -fill x
-	label $self.l -text "Search for:"
-	entry $self.e -bd 2 -relief sunken
+	ttk::label $self.l -text "Search for:"
+	ttk::entry $self.e
 	bind $self.e <Return> "$self search"
 	pack $self.l -in $self.top -side left
 	pack $self.e -in $self.top -fill x -expand 1
-	checkbutton $self.re -variable [object_slotname search_type] \
+	ttk::checkbutton $self.re -variable [object_slotname search_type] \
 	    -onvalue regexp -offvalue exact -text "Regexp search"
 	pack $self.re -side top -anchor w
-	button $self.go -text "Find Next" -command "$self search"
-	button $self.reset -text "Reset Search" -command "$self reset"
-	button $self.close -text "Close" -command "destroy $self"
+	ttk::button $self.go -text "Find Next" -command "$self search"
+	ttk::button $self.reset -text "Reset Search" -command "$self reset"
+	ttk::button $self.close -text "Close" -command "destroy $self"
 	pack $self.go $self.reset $self.close -side left
 	set title "Find in [$slot(list) get_item_name] List..."
 	wm title $self $title
@@ -107,15 +107,15 @@ dialog list_search {
 dialog list_show {
     param list
     method create {} {
-	frame $self.top
+	ttk::frame $self.top
 	pack $self.top -side top -fill x
-	label $self.l -text "Show:"
-	entry $self.e -bd 2 -relief sunken
+	ttk::label $self.l -text "Show:"
+	ttk::entry $self.e
 	bind $self.e <Return> "$self show"
 	pack $self.l -in $self.top -side left
 	pack $self.e -in $self.top -fill x -expand 1
-	button $self.show -text "Show" -command "$self show"
-	button $self.close -text "Close" -command "destroy $self"
+	ttk::button $self.show -text "Show" -command "$self show"
+	ttk::button $self.close -text "Close" -command "destroy $self"
 	pack $self.show $self.close -side left
 	wm title $self "Show a [$slot(list) get_item_name]"
 	focus $self.e
@@ -142,15 +142,15 @@ widget tkinspect_list {
     member contents {}
     member search_index 0
     method create {} {
-        $self config -bd 0 -relief raised
-        pack [label $self.title -anchor w] -side top -fill x
-        frame $self.frame  
+        $self configure -borderwidth 0 -relief raised
+        pack [ttk::label $self.title -anchor w] -side top -fill x
+        ttk::frame $self.frame
         pack $self.frame -side top -fill x
-        scrollbar $self.sb -command "$self.list yview" -relief sunken -bd 1
-        scrollbar $self.sb2 -command "$self.list xview" -relief sunken -bd 1 -orient horizontal
-        listbox $self.list -bd 2 -relief groove -exportselection 0 \
+        ttk::scrollbar $self.sb -command "$self.list yview"
+        ttk::scrollbar $self.sb2 -command "$self.list xview" -orient horizontal
+        listbox $self.list -borderwidth 1 -relief groove -exportselection 0 \
             -yscroll "$self.sb set" -selectmode single \
-            -xscroll "$self.sb2 set"
+            -xscroll "$self.sb2 set" -background white
         bind $self.list <1> "$self click %x %y; continue"
         bind $self.list <Key-space> "$self trigger; continue"
         pack $self.sb -in $self.frame -side right -fill y
@@ -186,7 +186,7 @@ widget tkinspect_list {
 	if ![info exists slot(update_pending)] {
 	    set slot(update_pending) 1
 	    after idle "if \[winfo exists $self\] \"$self do_update\""
-	}	
+	}
     }
     method do_update {} {
 	unset slot(update_pending)
@@ -229,7 +229,7 @@ widget tkinspect_list {
 	    if [string length $slot(current_item)] {
 		uplevel #0 [concat $slot(command) [list $slot(current_item)]]
 	    }
-	}	
+	}
     }
     method remove {} {
 	$slot(main) delete_menu $slot(title)

diff --git a/stl-lite/filechsr.tcl b/stl-lite/filechsr.tcl
@@ -49,10 +49,10 @@ dialog filechooser {
     method create {} {
 	set w $self
 	wm minsize $w 100 100
-	frame $w.list
+	ttk::frame $w.list
 	pack $w.list -in $w -side top -fill both -expand yes
-	scrollbar $w.list.sb -command "$w.list.l yview"
-	listbox $w.list.l -yscroll "$w.list.sb set" -relief raised -bd 2 \
+	ttk::scrollbar $w.list.sb -command "$w.list.l yview"
+	listbox $w.list.l -yscroll "$w.list.sb set" \
 	    -exportselection false -selectmode single
 	pack $w.list.sb -in $w.list -side right -fill y
 	pack $w.list.l -in $w.list -side left -fill both -expand 1
@@ -64,8 +64,8 @@ dialog filechooser {
 	}
 	set b [frame $w.bottom -bd 3 -relief ridge]
 	pack $b -side top -fill both -pady 3 -padx 3
-	label $b.status1 -anchor w
-	label $b.status2 -anchor w
+	ttk::label $b.status1 -anchor w
+	ttk::label $b.status2 -anchor w
 	pack $b.status1 $b.status2 -side top -fill x -padx 2
 	simpleentry $b.filter -width 30 -label "Filter:"
 	$b.filter bind <Return> "$self filter \[$b.filter entry get\]"
@@ -74,9 +74,9 @@ dialog filechooser {
 	simpleentry $b.file -width 30 -label "File:"
 	$b.file bind <Return> "$self open 1 \[$b.file entry get\]"
 	pack $b.file -side top -fill x -pady 3 -padx 5
-	button $b.up -command "cd ..; $self fill" -text "Up"
-	button $b.open -command "$self open 0" -text "Open"
-	button $b.cancel -command "object_delete $w" -text "Cancel"
+	ttk::button $b.up -command "cd ..; $self fill" -text "Up"
+	ttk:button $b.open -command "$self open 0" -text "Open"
+	ttk::button $b.cancel -command "object_delete $w" -text "Cancel"
 	pack $b.open $b.up -in $b -side left -ipadx 5 -ipady 5 -padx 5 -pady 5
 	pack $b.cancel -in $b -side right -ipadx 5 -ipady 5 -padx 5 -pady 5
     }