)BBH 10April2001New version using BWidget 1.3 (original done with 1.2.1), so removed all explicit bindings & take advantage of selectcommand. (Old version still listed below).Worked for me with ActiveState's ActiveTcl 8.4.3.2 on Win98, except for an error reading the "Performance Data" tab. I suspect this is because I'm using Win98. -- RoSome questions (added by escargo on 10/23/2002)- Is it possible to extend this browser to save and restore registry settings?
- How hard would it be to implement save/restore?
- Would it be possible to extend the browser to preserve the registry settings in some way and then compare current and preserved settings to highlight the differences?
#
# simple registry browser
#
package require registry
package require BWidget 1.3
set BaseKeys {
HKEY_LOCAL_MACHINE
HKEY_USERS
HKEY_CLASSES_ROOT
HKEY_CURRENT_USER
HKEY_CURRENT_CONFIG
HKEY_PERFORMANCE_DATA
HKEY_DYN_DATA
}
#################################################################################
font create Tabs -family Arial -size 8 -weight bold -slant italic
font create Help -family Arial -size 10
font create HelpSect -family Arial -size 10 -weight bold
font create HelpHead -family Arial -size 12 -weight bold
font create Frames -family Arial -size 8 -weight bold
font create Keys -family Arial -size 8
font create Values -family Arial -size 8
font create FullKey -family Arial -size 8 -weight bold -slant italic
font create ValName -family Arial -size 8 -weight bold
set PROGINC -1
set PROGTXT ""
#################################################################################
proc build_screen {} {
wm title . "Registry Browser"
NoteBook .nb -font Tabs
build_info_tab .nb
foreach k $::BaseKeys {
build_tree_tab .nb $k
}
.nb compute_size
pack .nb -fill both -expand yes
.nb raise [.nb pages 0]
}
proc build_info_tab {nb} {
set f [$nb insert end help -text Help]
text $f.t -tabs {1c 2c 5c} -relief flat \
-font Help -background [. cget -background]
pack $f.t
$f.t tag config HEAD -font HelpHead -justify center
$f.t tag config SECT -font HelpSect
$f.t insert end "Simple Registry Browser" HEAD
$f.t insert end "\n\n"
$f.t insert end "\tEach Tab is a seperate HKEY section of Registry\n"
$f.t insert end "\tSelecting a key on the left side shows all values"
$f.t insert end " under that key\n"
$f.t insert end "\t\n\n"
$f.t insert end "\tMouse Actions:\n" SECT
$f.t insert end "\t\tClick :\t Selects that key\n"
$f.t insert end "\t\tClick :\t (on Cross) Opens/Closes Folder\n"
$f.t insert end "\t\n"
$f.t insert end "\tArrow Key Actions:\n" SECT
$f.t insert end "\t\tUp :\t Moves selection to previous key\n"
$f.t insert end "\t\tDown :\t Moves selection to next key\n"
$f.t insert end "\t\tRight :\t Opens key folder (subkeys)\n"
$f.t insert end "\t\tLeft :\t Closes key folder (subkeys)\n"
}
proc make_readable {key} {
set str {}
foreach word [lrange [split $key _] 1 end] {
regexp {(.)(.*)} $word -> l rest
lappend str "$l[string tolower $rest]"
}
return [join $str]
}
proc build_tree_tab {nb key} {
set f [$nb insert end $key -text [make_readable $key]]
set pw [PanedWindow $f.pw -side top]
set lp [$pw add -weight 1]
set tf [TitleFrame $lp.tf -text "$key" -font Frames]
set sw [ScrolledWindow [$tf getframe].sw -relief sunken -borderwidth 2]
set tree [Tree $sw.tree \
-opencmd "change_node 1 $sw.tree" \
-closecmd "change_node 0 $sw.tree"]
$sw setwidget $tree
pack $sw $tf -fill both -expand yes
set rp [$pw add -weight 2]
set tf [TitleFrame $rp.tf -text "Contents" -font Frames]
set sw [ScrolledWindow [$tf getframe].sw -relief sunken -borderwidth 2]
set txt [text $sw.txt -font Values -wrap none -tabs {4c center 5c left} ]
$txt tag config MAINKEY -font FullKey
$txt tag config NAME -font ValName
$sw setwidget $txt
pack $sw $tf -fill both -expand yes
pack $pw -fill both -expand yes
$tree configure -selectcommand "update_contents $txt"
$nb itemconfigure $key \
-createcmd "init_tree $tree $key" \
-raisecmd "focus $tree"
return $tree
}
proc init_tree {tw key} {
ProgressDlg .prg -textvariable PROGTXT -variable PROGINC \
-type infinite -maximum 50000
set ::PROGTXT "Creating Tree for \n $key"
set ::PROGINC -1
$tw configure -redraw 0
add_nodes $tw root $key 0
$tw configure -redraw 1
update
destroy .prg
}
proc max args {
if {[llength $args] == 1} {
set args [lindex $args 0]
}
lindex [lsort -dict -dec $args] 0
}
set NODECOUNT 0
proc add_nodes {tw node key {cfg 1}} {
if [catch {registry keys $key} keys] {
tk_messageBox -icon error -title "Registry Lookup Failed" -message \
"Unable to get keys from registry.\nKey: $key\nError: $keys"
} else {
set c -1
foreach k $keys {
$tw insert end $node nd:[incr ::NODECOUNT] \
-text $k \
-font Keys \
-data "$key\\$k" \
-drawcross allways \
-image [Bitmap::get folder]
incr ::PROGINC
}
}
set data "$key\n\n"
set tab1 [font measure Values "Name"]
set tab2 [font measure Values "Type"]
if [catch {registry values $key} vals] {
tk_messageBox -icon error -title "Registry Lookup Failed" -message \
"Unable to get values from registry.\nKey: $key\nError: $vals"
append data "ERROR: Cannot Get Values"
} else {
set items {}
foreach n $vals {
set t [registry type $key $n]
set v [registry get $key $n]
lappend items [format "%s\t %s \t%s" $n $t $v ]
set tab1 [max $tab1 [font measure Values $n]]
set tab2 [max $tab2 [font measure Values $t]]
}
if {[llength $items]} {
append data "Name\tType\tValue\n"
append data [join $items "\n"]
} else {
append data "NO VALUES"
}
}
if { $cfg } {
$tw itemconfigure $node -drawcross auto -data [list $tab1 $tab2 $data]
}
incr ::PROGINC
}
proc update_contents {txt tw node} {
$txt config -state normal
$txt delete 1.0 end
set dat [$tw itemcget $node -data]
if {[$tw itemcget $node -drawcross] == "allways"} {
add_nodes $tw $node $dat
set dat [$tw itemcget $node -data]
}
foreach {tab1 tab2 str} $dat {}
set tabs "[expr {$tab1 + ($tab2 / 2) + 10}] center "
append tabs "[expr {$tab1 + $tab2 + 20}] left"
$txt config -tabs $tabs
$txt insert end $str
$txt tag add MAINKEY 1.0 2.0
$txt tag add NAME 3.0 4.0
$txt config -state disabled
}
proc change_node {open tw node} {
if {$open} {
if {[$tw itemcget $node -drawcross] == "allways"} {
add_nodes $tw $node [$tw itemcget $node -data]
if {[llength [$tw nodes $node]]} {
$tw itemconfigure $node -image [Bitmap::get openfold]
} else {
$tw itemconfigure $node -image [Bitmap::get folder]
}
} else {
$tw itemconfigure $node -image [Bitmap::get openfold]
}
} else {
$tw itemconfigure $node -image [Bitmap::get folder]
}
}
#################################################################################
build_screen
tkwait window .Older version for that handles all keyboard traversal & selection actions explicitly
#
# simple registry browser
#
package require registry
package require BWidget
set BaseKeys {
HKEY_LOCAL_MACHINE
HKEY_USERS
HKEY_CLASSES_ROOT
HKEY_CURRENT_USER
HKEY_CURRENT_CONFIG
HKEY_PERFORMANCE_DATA
HKEY_DYN_DATA
}
##############################################################################
font create Tabs -family Arial -size 8 -weight bold -slant italic
font create Help -family Arial -size 10
font create HelpSect -family Arial -size 10 -weight bold
font create HelpHead -family Arial -size 12 -weight bold
font create Frames -family Arial -size 8 -weight bold
font create Keys -family Arial -size 8
font create Values -family Arial -size 8
font create FullKey -family Arial -size 8 -weight bold -slant italic
font create ValName -family Arial -size 8 -weight bold
set PROGINC -1
set PROGTXT ""
##############################################################################
proc build_screen {} {
wm title . "Registry Browser"
NoteBook .nb -font Tabs
build_info_tab .nb
foreach k $::BaseKeys {
build_tree_tab .nb $k
}
.nb compute_size
pack .nb -fill both -expand yes
.nb raise [.nb pages 0]
}
proc build_info_tab {nb} {
set f [$nb insert end help -text Help]
text $f.t -tabs {1c 2c 5c} -relief flat \
-font Help -background [. cget -background]
pack $f.t
$f.t tag config HEAD -font HelpHead -justify center
$f.t tag config SECT -font HelpSect
$f.t insert end "Simple Registry Browser" HEAD
$f.t insert end "\n\n"
$f.t insert end "\tEach Tab is a seperate HKEY section of Registry\n"
$f.t insert end "\tSelecting a key on the left side shows all values under that key\n"
$f.t insert end "\t\n\n"
$f.t insert end "\tMouse Actions:\n" SECT
$f.t insert end "\t\tClick :\t Selects that key\n"
$f.t insert end "\t\tDouble Click :\t Opens/Closes that key folder (subkeys)\n"
$f.t insert end "\t\tControl Click :\t Recursively opens entire subtree \n"
$f.t insert end "\t\n"
$f.t insert end "\tArrow Key Actions:\n" SECT
$f.t insert end "\t\tUp :\t Moves selection to previous key\n"
$f.t insert end "\t\tDown :\t Moves selection to next key\n"
$f.t insert end "\t\tRight :\t Opens key folder (subkeys)\n"
$f.t insert end "\t\tLeft :\t Closes key folder (subkeys)\n"
}
proc make_readable {key} {
set str {}
foreach word [lrange [split $key _] 1 end] {
regexp {(.)(.*)} $word -> l rest
lappend str "$l[string tolower $rest]"
}
return [join $str]
}
proc build_tree_tab {nb key} {
set f [$nb insert end $key -text [make_readable $key]]
set pw [PanedWindow $f.pw -side top]
set lp [$pw add -weight 1]
set tf [TitleFrame $lp.tf -text "$key" -font Frames]
set sw [ScrolledWindow [$tf getframe].sw -relief sunken -borderwidth 2]
set tree [Tree $sw.tree \
-opencmd "change_node 1 $sw.tree" \
-closecmd "change_node 0 $sw.tree"]
$sw setwidget $tree
pack $sw $tf -fill both -expand yes
set rp [$pw add -weight 2]
set tf [TitleFrame $rp.tf -text "Contents" -font Frames]
set sw [ScrolledWindow [$tf getframe].sw -relief sunken -borderwidth 2]
set txt [text $sw.txt -font Values -wrap none -tabs {4c center 5c left} ]
$txt tag config MAINKEY -font FullKey
$txt tag config NAME -font ValName
$sw setwidget $txt
pack $sw $tf -fill both -expand yes
pack $pw -fill both -expand yes
$tree bindText <1> "select_node 1 $tree $txt"
$tree bindImage <1> "select_node 1 $tree $txt"
$tree bindText <Double-1> "select_node 2 $tree $txt"
$tree bindImage <Double-1> "select_node 2 $tree $txt"
$tree bindText <Control-1> "select_node 3 $tree $txt"
$tree bindImage <Control-1> "select_node 3 $tree $txt"
bind $tree <Up> "arrow_select up $tree $txt $key"
bind $tree <Down> "arrow_select down $tree $txt $key"
bind $tree <Left> "arrow_select left $tree $txt $key"
bind $tree <Right> "arrow_select right $tree $txt $key"
$nb itemconfigure $key \
-createcmd "init_tree $tree $key" \
-raisecmd "focus $tree"
return $tree
}
proc init_tree {tw key} {
ProgressDlg .prg -textvariable PROGTXT -variable PROGINC \
-type infinite -maximum 50000
set ::PROGTXT "Creating Tree for \n $key"
set ::PROGINC -1
$tw configure -redraw 0
add_nodes $tw root $key 0
$tw configure -redraw 1
update
destroy .prg
}
set NODECOUNT 0
proc add_nodes {tw node key {cfg 1}} {
if [catch {registry keys $key} keys] {
tk_messageBox -icon error -title "Registry Lookup Failed" -message \
"Unable to get keys from registry.\nKey: $key\nError: $keys"
} else {
set c -1
foreach k $keys {
$tw insert end $node nd:[incr ::NODECOUNT] \
-text $k \
-font Keys \
-data "$key\\$k" \
-drawcross allways \
-image [Bitmap::get folder]
incr ::PROGINC
}
}
set data "$key\n\n"
set tab1 [font measure Values "Name"]
set tab2 [font measure Values "Type"]
if [catch {registry values $key} vals] {
tk_messageBox -icon error -title "Registry Lookup Failed" -message \
"Unable to get values from registry.\nKey: $key\nError: $vals"
append data "ERROR: Cannot Get Values"
} else {
set items {}
foreach n $vals {
set t [registry type $key $n]
set v [registry get $key $n]
lappend items [format "%s\t %s \t%s" $n $t $v ]
set tab1 [max $tab1 [font measure Values $n]]
set tab2 [max $tab2 [font measure Values $t]]
}
if {[llength $items]} {
append data "Name\tType\tValue\n"
append data [join $items "\n"]
} else {
append data "NO VALUES"
}
}
if { $cfg } {
$tw itemconfigure $node -drawcross auto -data [list $tab1 $tab2 $data]
}
incr ::PROGINC
}
proc max {a b} { if {$a > $b} {set a} {set b} }
proc prev_vis_node {tw node} {
if {[set idx [$tw index $node]] == 0} {
if {"[set p [$tw parent $node]]" == "root"} {
return $node
} else {
return $p
}
} else {
return [last_vis_child $tw [$tw nodes [$tw parent $node] [incr idx -1]]]
}
}
proc last_vis_child {tw node} {
if {[$tw itemcget $node -open]} {
if {[llength [set kids [$tw nodes $node]]]} {
return [last_vis_child $tw [lindex $kids end]]
} else {
return $node
}
} else {
return $node
}
}
proc next_vis_node {tw node} {
if {[$tw itemcget $node -open] && "[set n [$tw nodes $node 0]]" != ""} {
return $n
} else {
if {"[set n [next_vis_sib $tw $node]]" == ""} {
return $node
} else {
return $n
}
}
}
proc next_vis_sib {tw node} {
set sib [$tw nodes [$tw parent $node] [expr 1 + [$tw index $node]]]
if {"$sib" != ""} {
return $sib
} else {
if {"[set p [$tw parent $node]]" == "root"} {
return ""
} else {
return [next_vis_sib $tw $p]
}
}
}
proc arrow_select {arrow tw txt root} {
set node [$tw selection get]
if {"$node" == ""} {
select_node 1 $tw $txt $root
} else {
switch $arrow {
right {
$tw itemconfigure $node -open 1
}
left {
$tw itemconfigure $node -open 0
}
up {
select_node 1 $tw $txt [prev_vis_node $tw $node]
}
down {
select_node 1 $tw $txt [next_vis_node $tw $node]
}
}
}
}
proc select_node {num tw txt node} {
$tw selection set $node
$tw see $node
update
switch $num {
3 {
if {[$tw itemcget $node -open] == 0} {
ProgressDlg .prg -textvariable PROGTXT -variable PROGINC \
-type infinite -maximum 50000
set ::PROGTXT "Recursively Opening [$tw itemcget $node -text]"
set ::PROGINC -1
$tw configure -redraw 0
$tw opentree $node
$tw configure -redraw 1
update idletasks
destroy .prg
} else {
ProgressDlg .prg -textvariable PROGTXT -variable PROGINC \
-type infinite -maximum 50000
set ::PROGTXT "Creating Tree for \n $key"
set ::PROGINC -1
$tw configure -redraw 0
add_nodes $tw root $key 0
$tw configure -redraw 1
update
destroy .prg
}
proc max args {
if {[llength $args] == 1} {
set args [lindex $args 0]
}
lindex [lsort -dict -dec $args] 0
}
set NODECOUNT 0
proc add_nodes {tw node key {cfg 1}} {
if [catch {registry keys $key} keys] {
tk_messageBox -icon error -title "Registry Lookup Failed" -message \
"Unable to get keys from registry.\nKey: $key\nError: $keys"
} else {
set c -1
foreach k $keys {
$tw insert end $node nd:[incr ::NODECOUNT] \
-text $k \
-font Keys \
-data "$key\\$k" \
-drawcross allways \
-image [Bitmap::get folder]
incr ::PROGINC
}
}
set data "$key\n\n"
set tab1 [font measure Values "Name"]
set tab2 [font measure Values "Type"]
if [catch {registry values $key} vals] {
tk_messageBox -icon error -title "Registry Lookup Failed" -message \
"Unable to get values from registry.\nKey: $key\nError: $vals"
append data "ERROR: Cannot Get Values"
} else {
set items {}
foreach n $vals {
set t [registry type $key $n]
set v [registry get $key $n]
lappend items [format "%s\t %s \t%s" $n $t $v ]
set tab1 [max $tab1 [font measure Values $n]]
set tab2 [max $tab2 [font measure Values $t]]
}
if {[llength $items]} {
append data "Name\tType\tValue\n"
append data [join $items "\n"]
} else {
append data "NO VALUES"
}
}
if { $cfg } {
$tw itemconfigure $node -drawcross auto -data [list $tab1 $tab2 $data]
}
incr ::PROGINC
}
proc update_contents {txt tw node} {
$txt config -state normal
$txt delete 1.0 end
set dat [$tw itemcget $node -data]
if {[$tw itemcget $node -drawcross] == "allways"} {
add_nodes $tw $node $dat
set dat [$tw itemcget $node -data]
}
foreach {tab1 tab2 str} $dat {}
set tabs "[expr {$tab1 + ($tab2 / 2) + 10}] center "
append tabs "[expr {$tab1 + $tab2 + 20}] left"
$txt config -tabs $tabs
$txt insert end $str
$txt tag add MAINKEY 1.0 2.0
$txt tag add NAME 3.0 4.0
$txt config -state disabled
}
proc change_node {open tw node} {
if {$open} {
if {[$tw itemcget $node -drawcross] == "allways"} {
add_nodes $tw $node [$tw itemcget $node -data]
if {[llength [$tw nodes $node]]} {
$tw itemconfigure $node -image [Bitmap::get openfold]
} else {
$tw itemconfigure $node -image [Bitmap::get folder]
}
} else {
$tw itemconfigure $node -image [Bitmap::get openfold]
}
} else {
$tw itemconfigure $node -image [Bitmap::get folder]
}
}
#################################################################################
build_screen
tkwait window .Older version for that handles all keyboard traversal & selection actions explicitly
----
#
# simple registry browser
#
package require registry
package require BWidget
set BaseKeys {
HKEY_LOCAL_MACHINE
HKEY_USERS
HKEY_CLASSES_ROOT
HKEY_CURRENT_USER
HKEY_CURRENT_CONFIG
HKEY_PERFORMANCE_DATA
HKEY_DYN_DATA
}
##############################################################################
font create Tabs -family Arial -size 8 -weight bold -slant italic
font create Help -family Arial -size 10
font create HelpSect -family Arial -size 10 -weight bold
font create HelpHead -family Arial -size 12 -weight bold
font create Frames -family Arial -size 8 -weight bold
font create Keys -family Arial -size 8
font create Values -family Arial -size 8
font create FullKey -family Arial -size 8 -weight bold -slant italic
font create ValName -family Arial -size 8 -weight bold
set PROGINC -1
set PROGTXT ""
##############################################################################
proc build_screen {} {
wm title . "Registry Browser"
NoteBook .nb -font Tabs
build_info_tab .nb
foreach k $::BaseKeys {
build_tree_tab .nb $k
}
.nb compute_size
pack .nb -fill both -expand yes
.nb raise [.nb pages 0]
}
proc build_info_tab {nb} {
set f [$nb insert end help -text Help]
text $f.t -tabs {1c 2c 5c} -relief flat \
-font Help -background [. cget -background]
pack $f.t
$f.t tag config HEAD -font HelpHead -justify center
$f.t tag config SECT -font HelpSect
$f.t insert end "Simple Registry Browser" HEAD
$f.t insert end "\n\n"
$f.t insert end "\tEach Tab is a seperate HKEY section of Registry\n"
$f.t insert end "\tSelecting a key on the left side shows all values under that key\n"
$f.t insert end "\t\n\n"
$f.t insert end "\tMouse Actions:\n" SECT
$f.t insert end "\t\tClick :\t Selects that key\n"
$f.t insert end "\t\tDouble Click :\t Opens/Closes that key folder (subkeys)\n"
$f.t insert end "\t\tControl Click :\t Recursively opens entire subtree \n"
$f.t insert end "\t\n"
$f.t insert end "\tArrow Key Actions:\n" SECT
$f.t insert end "\t\tUp :\t Moves selection to previous key\n"
$f.t insert end "\t\tDown :\t Moves selection to next key\n"
$f.t insert end "\t\tRight :\t Opens key folder (subkeys)\n"
$f.t insert end "\t\tLeft :\t Closes key folder (subkeys)\n"
}
proc make_readable {key} {
set str {}
foreach word [lrange [split $key _] 1 end] {
regexp {(.)(.*)} $word -> l rest
lappend str "$l[string tolower $rest]"
}
return [join $str]
}
proc build_tree_tab {nb key} {
set f [$nb insert end $key -text [make_readable $key]]
set pw [PanedWindow $f.pw -side top]
set lp [$pw add -weight 1]
set tf [TitleFrame $lp.tf -text "$key" -font Frames]
set sw [ScrolledWindow [$tf getframe].sw -relief sunken -borderwidth 2]
set tree [Tree $sw.tree \
-opencmd "change_node 1 $sw.tree" \
-closecmd "change_node 0 $sw.tree"]
$sw setwidget $tree
pack $sw $tf -fill both -expand yes
set rp [$pw add -weight 2]
set tf [TitleFrame $rp.tf -text "Contents" -font Frames]
set sw [ScrolledWindow [$tf getframe].sw -relief sunken -borderwidth 2]
set txt [text $sw.txt -font Values -wrap none -tabs {4c center 5c left} ]
$txt tag config MAINKEY -font FullKey
$txt tag config NAME -font ValName
$sw setwidget $txt
pack $sw $tf -fill both -expand yes
pack $pw -fill both -expand yes
$tree bindText <1> "select_node 1 $tree $txt"
$tree bindImage <1> "select_node 1 $tree $txt"
$tree bindText <Double-1> "select_node 2 $tree $txt"
$tree bindImage <Double-1> "select_node 2 $tree $txt"
$tree bindText <Control-1> "select_node 3 $tree $txt"
$tree bindImage <Control-1> "select_node 3 $tree $txt"
bind $tree <Up> "arrow_select up $tree $txt $key"
bind $tree <Down> "arrow_select down $tree $txt $key"
bind $tree <Left> "arrow_select left $tree $txt $key"
bind $tree <Right> "arrow_select right $tree $txt $key"
$nb itemconfigure $key \
-createcmd "init_tree $tree $key" \
-raisecmd "focus $tree"
return $tree
}
proc init_tree {tw key} {
ProgressDlg .prg -textvariable PROGTXT -variable PROGINC \
-type infinite -maximum 50000
set ::PROGTXT "Creating Tree for \n $key"
set ::PROGINC -1
$tw configure -redraw 0
add_nodes $tw root $key 0
$tw configure -redraw 1
update
destroy .prg
}
set NODECOUNT 0
proc add_nodes {tw node key {cfg 1}} {
if [catch {registry keys $key} keys] {
tk_messageBox -icon error -title "Registry Lookup Failed" -message \
"Unable to get keys from registry.\nKey: $key\nError: $keys"
} else {
set c -1
foreach k $keys {
$tw insert end $node nd:[incr ::NODECOUNT] \
-text $k \
-font Keys \
-data "$key\\$k" \
-drawcross allways \
-image [Bitmap::get folder]
incr ::PROGINC
}
}
set data "$key\n\n"
set tab1 [font measure Values "Name"]
set tab2 [font measure Values "Type"]
if [catch {registry values $key} vals] {
tk_messageBox -icon error -title "Registry Lookup Failed" -message \
"Unable to get values from registry.\nKey: $key\nError: $vals"
append data "ERROR: Cannot Get Values"
} else {
set items {}
foreach n $vals {
set t [registry type $key $n]
set v [registry get $key $n]
lappend items [format "%s\t %s \t%s" $n $t $v ]
set tab1 [max $tab1 [font measure Values $n]]
set tab2 [max $tab2 [font measure Values $t]]
}
if {[llength $items]} {
append data "Name\tType\tValue\n"
append data [join $items "\n"]
} else {
append data "NO VALUES"
}
}
if { $cfg } {
$tw itemconfigure $node -drawcross auto -data [list $tab1 $tab2 $data]
}
incr ::PROGINC
}
proc max {a b} { if {$a > $b} {set a} {set b} }
proc prev_vis_node {tw node} {
if {[set idx [$tw index $node]] == 0} {
if {"[set p [$tw parent $node]]" == "root"} {
return $node
} else {
return $p
}
} else {
return [last_vis_child $tw [$tw nodes [$tw parent $node] [incr idx -1]]]
}
}
proc last_vis_child {tw node} {
if {[$tw itemcget $node -open]} {
if {[llength [set kids [$tw nodes $node]]]} {
return [last_vis_child $tw [lindex $kids end]]
} else {
return $node
}
} else {
return $node
}
}
proc next_vis_node {tw node} {
if {[$tw itemcget $node -open] && "[set n [$tw nodes $node 0]]" != ""} {
return $n
} else {
if {"[set n [next_vis_sib $tw $node]]" == ""} {
return $node
} else {
return $n
}
}
}
proc next_vis_sib {tw node} {
set sib [$tw nodes [$tw parent $node] [expr 1 + [$tw index $node]]]
if {"$sib" != ""} {
return $sib
} else {
if {"[set p [$tw parent $node]]" == "root"} {
return ""
} else {
return [next_vis_sib $tw $p]
}
}
}
proc arrow_select {arrow tw txt root} {
set node [$tw selection get]
if {"$node" == ""} {
select_node 1 $tw $txt $root
} else {
switch $arrow {
right {
$tw itemconfigure $node -open 1
}
left {
$tw itemconfigure $node -open 0
}
up {
select_node 1 $tw $txt [prev_vis_node $tw $node]
}
down {
select_node 1 $tw $txt [next_vis_node $tw $node]
}
}
}
}
proc select_node {num tw txt node} {
$tw selection set $node
$tw see $node
update
switch $num {
3 {
if {[$tw itemcget $node -open] == 0} {
ProgressDlg .prg -textvariable PROGTXT -variable PROGINC \
-type infinite -maximum 50000
set ::PROGTXT "Recursively Opening [$tw itemcget $node -text]"
set ::PROGINC -1
$tw configure -redraw 0
$tw opentree $node
$tw configure -redraw 1
update idletasks
destroy .prg
} else {
ProgressDlg .prg -textvariable PROGTXT -variable PROGINC \
-type infinite -maximum 50000
set ::PROGTXT "Recursively Closeing [$tw itemcget $node -text]"
set ::PROGINC -1
$tw configure -redraw 0
$tw closetree $node
$tw configure -redraw 1
update idletasks
destroy .prg
}
}
2 {
if {[$tw itemcget $node -open] == 0} {
$tw itemconfigure $node -open 1
} else {
$tw itemconfigure $node -open 0
}
}
}
$txt config -state normal
$txt delete 1.0 end
set dat [$tw itemcget $node -data]
if {[$tw itemcget $node -drawcross] == "allways"} {
add_nodes $tw $node $dat
set dat [$tw itemcget $node -data]
}
foreach {tab1 tab2 str} $dat {}
set tabs "[expr {$tab1 + ($tab2 / 2) + 10}] center [expr {$tab1 + $tab2 + 20}] left"
$txt config -tabs $tabs
$txt insert end $str
$txt tag add MAINKEY 1.0 2.0
$txt tag add NAME 3.0 4.0
$txt config -state disabled
}
proc change_node {open tw node} {
if {$open} {
if {[$tw itemcget $node -drawcross] == "allways"} {
add_nodes $tw $node [$tw itemcget $node -data]
if {[llength [$tw nodes $node]]} {
$tw itemconfigure $node -image [Bitmap::get openfold]
} else {
$tw itemconfigure $node -image [Bitmap::get folder]
}
} else {
$tw itemconfigure $node -image [Bitmap::get openfold]
}
} else {
$tw itemconfigure $node -image [Bitmap::get folder]
}
}
######################################################################################
build_screen
tkwait window .21 Aug, 2003 - Why are there three versions of the same program? Which one is newest? How old are they? Is there a really good reason to keep them all here?
LV 2006-Feb-22 I tried the first of the 3 above programs using ActiveTcl 8.4.10.something (1 or 2 I think), on Windows XP SP2. When I click on the Dyn Data tab, I get the error:Unable to get keys from registry. Key: HKEY_DYN_DATA Error: unable to open key: The handle is invalid. A similar one of these showed up under the Local Machine tab, when I clicked on the security key. This time, the error says: Unable to get keys from registry. Key: HKEY_LOCAL_MACHINE\SECURITY Error: unable to open key: Access is denied.Anyone have a fix for these errors?MEd I think thats not really a script-error, the HKEY_DYN_DATA just does not exist in Win XP (i checked my registry with regedit.exe, also running on WinXP) and the HKEY_LOCAL_MACHINE\SECURITY is only browsable when logged in with Administrator-rights.MHo 2006-Feb-22 Sometimes screen updates do not take place. Program stops responding building tree für HKCR. Klicking on the close-icon in the upper right corner leads to an error message (invalid command name "older"...).
See also: Microsoft Windows and Tcl - Microsoft Windows and Tk - Windows: getting desktop properties
