From 08e5945c07acb0b2600e1ab0c5a0552c8f910e47 Mon Sep 17 00:00:00 2001 From: Pat Thoyts Date: Sat, 21 Nov 2020 19:57:23 +0000 Subject: [PATCH] Change UI to use themed widgets. Support targets that use ttk widgets by toggling the 'active' state where no background option is available. --- .editorconfig | 9 +++++ about.tcl | 19 +++++---- defaults.tcl | 1 + globals_list.tcl | 6 +-- help.tcl | 16 ++++---- install.tcl | 26 ++++++------ lists.tcl | 86 ++++++++++++++++++++-------------------- stl-lite/filechsr.tcl | 16 ++++---- stl-lite/object.tcl | 11 +++-- stl-lite/simpleentry.tcl | 12 +++--- stl-lite/tkhtml.tcl | 8 ++-- tkinspect.tcl | 48 +++++++++++----------- value.tcl | 25 ++++++------ windows_list.tcl | 18 ++++++--- 14 files changed, 160 insertions(+), 141 deletions(-) create mode 100644 .editorconfig diff --git a/.editorconfig b/.editorconfig new file mode 100644 index 0000000..71746cf --- /dev/null +++ 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 \ No newline at end of file diff --git a/about.tcl b/about.tcl index b137404..86b1b82 100644 --- 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 index bc4a310..1e24809 100644 --- 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 index c44e3d0..20eb49a 100644 --- 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 index 34e67ef..ec97f53 100644 --- 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 "
$txt
" } diff --git a/install.tcl b/install.tcl index b5ea623..8b3a1fa 100644 --- 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 index b189bdf..a625548 100644 --- 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 "$self add_pattern" + ttk::frame $self.top + ttk::label $self.l -text "Pattern:" + ttk::entry $self.e -width 40 + bind $self.e "$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 "$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 "$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 "$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 index a994792..ce52096 100644 --- 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 "$self filter \[$b.filter entry get\]" @@ -74,9 +74,9 @@ dialog filechooser { simpleentry $b.file -width 30 -label "File:" $b.file bind "$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 } diff --git a/stl-lite/object.tcl b/stl-lite/object.tcl index 60b89b8..12c48a3 100644 --- a/stl-lite/object.tcl +++ b/stl-lite/object.tcl @@ -2,7 +2,7 @@ # $Id$ # # This software is copyright (C) 1994 by the Lawrence Berkeley Laboratory. -# +# # Redistribution and use in source and binary forms, with or without # modification, are permitted provided that: (1) source code distributions # retain the above copyright notice and this paragraph in its entirety, (2) @@ -15,7 +15,7 @@ # the University nor the names of its contributors may be used to endorse # or promote products derived from this software without specific prior # written permission. -# +# # THIS SOFTWARE IS PROVIDED ``AS IS'' AND WITHOUT ANY EXPRESS OR IMPLIED # WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF # MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. @@ -144,6 +144,11 @@ proc object_define_creator {windowType name spec} { proc %s:frame {self args} \ "uplevel \[concat object_window_of$window \$args]" uplevel [concat $window config $args] + if {[winfo toplevel $window] eq $window} { + ttk::frame $window.pave + place $window.pave -x 0 -y 0 -relwidth 1.0 -relheight 1.0 + lower $window.pave + } $window create set object(__created) 1 bind $window \ @@ -156,7 +161,7 @@ proc object_define_creator {windowType name spec} { } proc widget {name spec} { - object_define_creator frame $name $spec + object_define_creator ttk::frame $name $spec } proc dialog {name spec} { diff --git a/stl-lite/simpleentry.tcl b/stl-lite/simpleentry.tcl index d378578..855186b 100644 --- a/stl-lite/simpleentry.tcl +++ b/stl-lite/simpleentry.tcl @@ -4,7 +4,7 @@ # A entry in a frame with a label. # # This software is copyright (C) 1994 by the Lawrence Berkeley Laboratory. -# +# # Redistribution and use in source and binary forms, with or without # modification, are permitted provided that: (1) source code distributions # retain the above copyright notice and this paragraph in its entirety, (2) @@ -17,7 +17,7 @@ # the University nor the names of its contributors may be used to endorse # or promote products derived from this software without specific prior # written permission. -# +# # THIS SOFTWARE IS PROVIDED ``AS IS'' AND WITHOUT ANY EXPRESS OR IMPLIED # WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF # MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. @@ -28,15 +28,15 @@ widget simpleentry { param textvariable "" method create {} { set w $self - label $w.l + ttk::label $w.l pack $w.l -in $w -side left - entry $w.e -relief sunken -bd 2 + ttk::entry $w.e pack $w.e -in $w -side left -fill x -expand 1 } method reconfig {} { set w $self - $w.l config -text $slot(label) - $w.e config -width $slot(width) -textvariable $slot(textvariable) + $w.l configure -text $slot(label) + $w.e configure -width $slot(width) -textvariable $slot(textvariable) } method entry args { uplevel [concat $self.e $args] diff --git a/stl-lite/tkhtml.tcl b/stl-lite/tkhtml.tcl index 9289e0f..6c95f84 100644 --- a/stl-lite/tkhtml.tcl +++ b/stl-lite/tkhtml.tcl @@ -2,7 +2,7 @@ # $Id$ # # This software is copyright (C) 1995 by the Lawrence Berkeley Laboratory. -# +# # Redistribution and use in source and binary forms, with or without # modification, are permitted provided that: (1) source code distributions # retain the above copyright notice and this paragraph in its entirety, (2) @@ -15,7 +15,7 @@ # the University nor the names of its contributors may be used to endorse # or promote products derived from this software without specific prior # written permission. -# +# # THIS SOFTWARE IS PROVIDED ``AS IS'' AND WITHOUT ANY EXPRESS OR IMPLIED # WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF # MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. @@ -433,7 +433,7 @@ proc tkhtml_/header {level} { tkhtml_do p } -tkhtml_define_entity pre { +tkhtml_define_entity pre { tkhtml_do tt tkhtml_do br incr tkhtml_priv(pre) @@ -528,7 +528,7 @@ tkhtml_define_entity img { if [info exists ar(align)] { set align [string tolower $ar(align)] } - label $tkhtml_priv(w).$img -image $img + ttk::label $tkhtml_priv(w).$img -image $img $tkhtml_priv(w) window create end -window $tkhtml_priv(w).$img \ -align $align } diff --git a/tkinspect.tcl b/tkinspect.tcl index 8244e54..8774c7c 100644 --- a/tkinspect.tcl +++ b/tkinspect.tcl @@ -153,7 +153,7 @@ dialog tkinspect_main { member cmdlines "" member windows_info method create {} { - global tkinspect + global tkinspect pack [frame $self.menu -bd 2 -relief flat] -side top -fill x menubutton $self.menu.file -menu $self.menu.file.m -text "File" \ -underline 0 @@ -165,7 +165,7 @@ dialog tkinspect_main { $m add cascade -label "Select Interpreter (comm)" -underline 21 \ -menu $self.menu.file.m.comminterps $m add command -label "Connect to (comm)" -underline 0 \ - -command "$self connect_dialog" + -command "$self connect_dialog" } $m add command -label "Update Lists" -underline 0 \ -command "$self update_lists" @@ -178,7 +178,7 @@ dialog tkinspect_main { $m add checkbutton -label "[lindex $list_class 1] List" \ -variable [object_slotname [lindex $list_class 0]_is_on] \ -command "$self toggle_list [lindex $list_class 0]" - } + } $m add separator $m add command -label "Close Window" -underline 0 \ -command "$self close" @@ -207,33 +207,33 @@ dialog tkinspect_main { bind $w {%W configure -relief flat -bd 1} } - pack [set f [frame $self.buttons -bd 0]] -side top -fill x - label $f.cmd_label -text "Command:" + pack [set f [ttk::frame $self.buttons]] -side top -fill x + ttk::label $f.cmd_label -text "Command:" pack $f.cmd_label -side left - entry $f.command -bd 2 -relief sunken + ttk::entry $f.command bind $f.command "$self send_command \[%W get\]" pack $f.command -side left -fill x -expand 1 - button $f.send_command -text "Send Command" \ + ttk::button $f.send_command -text "Send Command" \ -command "$self send_command \[$f.command get\]" - button $f.send_value -text "Send Value" \ + ttk::button $f.send_value -text "Send Value" \ -command "$self.value send_value" pack $f.send_command $f.send_value -side left # change to use a panedwindow instead of a frame - Alex Caldwell if {[package vcompare [package provide Tk] 8.3] == 1} { - pack [panedwindow $self.lists -showhandle 1] -side top -fill both - } else { - pack [frame $self.lists -bd 0] -side top -fill both - } - + pack [ttk::panedwindow $self.lists -orient horizontal] -side top -fill both + } else { + pack [ttk::frame $self.lists] -side top -fill both + } + value $self.value -main $self pack $self.value -side top -fill both -expand 1 foreach list_class $tkinspect(default_lists) { $self add_list $list_class set slot(${list_class}_is_on) 1 } - pack [frame $self.status] -side top -fill x - label $self.status.l -anchor w -bd 0 -relief sunken + pack [ttk::frame $self.status] -side top -fill x + ttk::label $self.status.l -anchor w pack $self.status.l -side left -fill x -expand 1 set slot(windows_info) [object_new windows_info] wm iconname $self $tkinspect(title) @@ -374,7 +374,7 @@ dialog tkinspect_main { -main $self # change to use panedwindow widget instead of frame if {[package vcompare [package provide Tk] 8.3] == 1} { - $self.lists add $list -width 150 + $self.lists add $list ;#-width 150 } else { pack $list -side left -fill both -expand 1 } @@ -388,10 +388,10 @@ dialog tkinspect_main { $self.lists forget $list } else { pack forget $list - + # for some reason if all the lists get unpacked the # .lists frame doesn't collapse unless we force it - $self.lists config -height 1 + $self.lists configure ;# -height 1 } set list_class [lindex [split $list .] 3] set slot(${list_class}_is_on) 0 @@ -448,7 +448,7 @@ proc tkinspect_create_main_window {args} { # # With tk8.0 the default tkerror proc is finally gone - bgerror # takes its place (see the changes tk8.0 changes file). This -# simplified error handling should be ok. +# simplified error handling should be ok. # proc tkinspect_failure {reason} { tk_dialog .failure "Tkinspect Failure" $reason warning 0 Ok @@ -467,16 +467,16 @@ if [file exists .tkinspect_init] { dialog connect_interp { param value method create {} { - frame $self.top + ttk::frame $self.top pack $self.top -side top -fill x - label $self.l -text "Connect to:" - entry $self.e -bd 2 -relief sunken + ttk::label $self.l -text "Connect to:" + ttk::entry $self.e bind $self.e "$self connect" bind $self.e "destroy $self" pack $self.l -in $self.top -side left pack $self.e -in $self.top -fill x -expand 1 - button $self.close -text "OK" -width 8 -command "$self connect" - button $self.cancel -text "Cancel" -width 8 -command "destroy $self" + ttk::button $self.close -text "OK" -width 8 -command "$self connect" + ttk::button $self.cancel -text "Cancel" -width 8 -command "destroy $self" pack $self.close $self.cancel -side left wm title $self "Connect to Interp.." wm iconname $self "Connect to Interp.." diff --git a/value.tcl b/value.tcl index 9141f40..cc98a85 100644 --- a/value.tcl +++ b/value.tcl @@ -18,15 +18,14 @@ widget value { member hist_no 0 member send_filter value_no_filter method create {} { - $self config -bd 0 -relief flat -highlightthickness 0 - pack [frame $self.title] -side top -fill x - pack [label $self.title.l -text "Value: "] -side left - menubutton $self.title.vname -anchor w -menu $self.title.vname.m \ - -bd 0 -state disabled + #$self config -bd 0 -relief flat -highlightthickness 0 + pack [ttk::frame $self.title] -side top -fill x + pack [ttk::label $self.title.l -text "Value: "] -side left + ttk::menubutton $self.title.vname -menu $self.title.vname.m -state disabled menu $self.title.vname.m -postcommand "$self fill_vname_menu" pack $self.title.vname -fill x - scrollbar $self.sb -relief sunken -bd 1 -command "$self.t yview" - text $self.t -yscroll "$self.sb set" + ttk::scrollbar $self.sb -command "$self.t yview" + text $self.t -yscroll "$self.sb set" -background white pack $self.sb -side right -fill y pack $self.t -side right -fill both -expand 1 bind $self.t "$self send_value" @@ -155,18 +154,18 @@ dialog value_search { param value member 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 "$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 "Highlight" -command "$self search" - button $self.close -text "Close" -command "destroy $self" + ttk::button $self.go -text "Highlight" -command "$self search" + ttk::button $self.close -text "Close" -command "destroy $self" pack $self.go $self.close -side left wm title $self "Find in Value.." wm iconname $self "Find in Value.." diff --git a/windows_list.tcl b/windows_list.tcl index 93c32fd..800d7bf 100644 --- a/windows_list.tcl +++ b/windows_list.tcl @@ -74,16 +74,22 @@ widget windows_list { } } method retrieve {target window} { - set result [$self retrieve_$slot(mode) $target $window] - set old_bg [send $target [list $window cget -background]] - send $target [list $window configure -background #ff69b4] - send $target [list after 200 \ + set result [$self retrieve_$slot(mode) $target $window] + if {[catch { + set old_bg [send $target [list $window cget -background]] + send $target [list $window configure -background #ff69b4] + send $target [list after 200 \ [list catch [list $window configure -background $old_bg]]] - return $result + }]} { + # FIXME: for ttk items toggle state active? + set restorestate [send $target [list $window state active]] + send $target [list after 200 [list catch [list $window state $restorestate]]] + } + return $result } method retrieve_config {target window} { set result "# window configuration of [list $window]\n" - append result "[list $window] config" + append result "[list $window] configure" foreach spec [send $target [list $window configure]] { if {[llength $spec] == 2} continue append result " \\\n\t[lindex $spec 0] [list [lindex $spec 4]]" -- 2.23.0