Skip to content
Browse files

[ADD] bind support

[ADD] bind example
  • Loading branch information...
1 parent fb1f303 commit 5c77e45e282073291aaa29d6b95781095a091126 @siyb committed
Showing with 79 additions and 0 deletions.
  1. +73 −0 XTk.tcl
  2. +3 −0 example/example.tcl
  3. +3 −0 example/example.xml
View
73 XTk.tcl
@@ -85,6 +85,17 @@ namespace eval xtk {
append code "\t$command\n"
}
}
+ if {[dict exists $sys(generate,code) ${namespace}_binds]} {
+ append code "\n\t# GUI Bindings\n"
+ foreach {path evnt virtual callbackString} [dict get $sys(generate,code) ${namespace}_binds] {
+ if {$virtual} {
+ set evnt "<<$evnt>>"
+ } else {
+ set evnt "<$evnt>"
+ }
+ append code "\tbind $path $evnt { ${namespace}::bindCallback $path $callbackString }\n"
+ }
+ }
append code "}\n"
}
return $code
@@ -96,6 +107,11 @@ namespace eval xtk {
dict lappend sys(generate,code) ${namespace}_commands $command
}
+ proc addBind {namespace path event virtual callbackString} {
+ variable sys
+ dict lappend sys(generate,code) ${namespace}_binds $path $event $virtual $callbackString
+ }
+
proc addVariable {namespace variableName value} {
variable sys
addNamespaceToCode $namespace
@@ -149,7 +165,11 @@ namespace eval xtk {
if {![isGeometryManagerSupported $originalNodeName]} {
throwNodeErrorMessage $child "sorry, the '$originalNodeName' geometry manager is not yet supported!"
}
+ if {[hasBindCommand $element]} {
+ throwNodeErrorMessage $child "bind may not be a child of any geometry manager node"
+ }
set sys(currentGeomanagerCommand) [getPackOptions $namespace $child]
+
traverseTree $currentPath $hierarchielevel $namespace $child
continue
} else {
@@ -164,6 +184,7 @@ namespace eval xtk {
set path [getUniquePathSegmentForLevel $hierarchielevel $currentPath]
+ handleBindCommand $namespace $path $child
handleVariableAttribute $namespace $path $child
set tkCommand [string trim "${nodeName} $path [getOptionsFromAttributes $namespace $child]"]
@@ -176,6 +197,25 @@ namespace eval xtk {
}
}
+ proc handleBindCommand {namespace path child} {
+ if {[hasBindCommand $child]} {
+ set bindCommands [getBindCommands $child]
+ foreach bindCommand $bindCommands {
+ if {![hasEvent $bindCommand]} {
+ throwNodeErrorMessage $bindCommand "you need to provide the event attribute"
+ }
+ if {![hasVirtual $bindCommand]} {
+ throwNodeErrorMessage $bindCommand "you need to provide the virtual attribute"
+ }
+ set evnt [getEvent $bindCommand]
+ set callbackString [$bindCommand getAttribute "callbackString" ""]
+ set virtual [$bindCommand getAttribute "virtual"]
+ addBind $namespace $path $evnt $virtual $callbackString
+ }
+ }
+
+ }
+
proc isPack {element} {
set nodeName [$element nodeName]
return [expr {$nodeName eq "pack"}]
@@ -204,6 +244,39 @@ namespace eval xtk {
return [$element getAttribute "variable"]
}
+ proc hasBindCommand {element} {
+ foreach childNode [$element childNodes] {
+ if {[$childNode nodeName] eq "bind"} {
+ return 1
+ }
+ }
+ return 0
+ }
+
+ proc getBindCommands {element} {
+ return [$element getElementsByTagName "bind"]
+ }
+
+ proc hasVirtual {element} {
+ return [$element hasAttribute "virtual"]
+ }
+
+ proc isVirtual {element} {
+ set virtual [$element getAttribute "virtual"]
+ if {$virtual != 0 && $virtual != 1} {
+ throwNodeErrorMessage $element "virtual must be 1 or 0"
+ }
+ return $virtual
+ }
+
+ proc hasEvent {element} {
+ return [$element hasAttribute "event"]
+ }
+
+ proc getEvent {element} {
+ return [$element getAttribute "event"]
+ }
+
proc getOptionsFromAttributes {namespace element} {
set tkAttributes [list]
set tkAttributeValues [list]
View
3 example/example.tcl
@@ -9,3 +9,6 @@ xtk::run $generatedCode
$::foo::hitherebutton configure -text "CHANGED BUTTON TEXT"
+proc foo::bindCallback {path args} {
+ puts "Callback from '$path' -> '$args'"
+}
View
3 example/example.xml
@@ -10,6 +10,9 @@
<pack fill="x" expand="0" side="bottom">
<label text="FOO" variable="foo" />
<label text="BAR" variable="bar" />
+ <label text="BINDTEST" variable="bindtest">
+ <bind event="Button-1" callbackString="%W %T" virtual="0" />
+ </label>
</pack>
</frame>
</pack>

0 comments on commit 5c77e45

Please sign in to comment.
Something went wrong with that request. Please try again.