Hello everybody,
I am trying to make my first steps with ltk, and I have problems to reconfigure existing widgets. Here is an example where I try to reconfigure the :TEXT attribute of the LABEL-WIDGET widget whenever the checkbox of the CHECK-BUTTON-WIDGET widget is clicked.
(with-ltk () (setf *debug-tk* t) (let* ((f (make-instance 'frame)) (label-widget (make-instance 'label :master f :text "initial text")) (check-button-widget (make-instance 'check-button :master f :text "check me" :command (lambda (val) (configure label-widget :text val))))) (pack f) (pack label-widget :side :left) (pack check-button-widget :side :left) (configure f :borderwidth 3) (configure f :relief :sunken)))
When I click on the checkbox, the col.or of the checkbox changes and I can see in the debug output something like this:
process_buffer l:(:CALLBACK "we" 1)<= buffer size 27 bt ".wc.wd configure -text {1}" process_buffer l:(:CALLBACK "we" 0)<= buffer size 27 bt ".wc.wd configure -text {0}"
So I assume, the callback is executed properly. But the diplayed text of LABEL-WIDGET is not changed at all.
I have tried to use "text" and 'text instead of :text, but none of those seems to make any difference.
This is on opensuse-12.1 with tk-8.5 and I use LTK-0.98, as it bundled with the newest quicklisp distro.
Any ideas what I am missing here? Here is the complete debug output of LTK:
; compiling (WITH-LTK NIL ...)buffer size 19 bt "package require Tk" process_buffer add-callback (we #<CLOSURE (LAMBDA (VAL) :IN "/lisp/ltk-test.lisp") {C1D9FA5}>) buffer size 3519 bt "if {[catch {package require Ttk} err]} {tk_messageBox -icon error -type ok -message "$err"}" bt "proc debug { msg } { global server puts $server "(:debug \"[escape $msg]\")" flush $server } " bt "proc escape {s} {regsub -all {\\} $s {\\\\} s1;regsub -all {"} $s1 {\"} s2;return $s2}" bt "proc senddata {s} {global server; puts $server "(:data [escape $s])";flush $server}" bt "proc senddatastring {s} { global server
puts $server "(:data \"[escape $s]\")" flush $server } " bt "proc senddatastrings {strings} { global server puts $server "(:data (" foreach s $strings { puts $server "\"[escape $s]\"" } puts $server "))";flush $server} " bt "proc to_keyword {s} { if {[string index $s 0] == "-"} { return ":[string range $s 1 [string length $s]]" } {return ":$s"}}" bt "proc sendpropertylist {l} { global server; set pos 0 set ll [llength $l] puts $server "(:data (" while {$pos < $ll} { puts $server " [to_keyword [lindex $l $pos]] " set pos [expr $pos + 1] puts $server " [lindex $l $pos] " set pos [expr $pos + 1] } puts $server "))"
}" bt "proc searchall {widget pattern} { set l [string length $pattern] set result [$widget search $pattern 1.0] set previous 0 while {$result > $previous} { $widget tag add sel $result $result+${l}chars set previous $result set result [$widget search $pattern $result+${l}chars] } }" bt "proc searchnext {widget pattern} { set l [string length $pattern] set result [$widget search $pattern insert] if {$result > 0} { $widget tag remove sel 1.0 end $widget tag add sel $result $result+${l}chars $widget mark set insert $result+${l}chars $widget see insert } }" bt "proc resetScroll {c} { $c configure -scrollregion [$c bbox all] }
proc moveToStart {sb} { set range [$sb get] $sb set 0 [expr [lindex $range 1] - [lindex $range 0]] } " bt "proc sendevent {s x y keycode char width height root_x root_y mouse_button} {global server; puts $server "(:event \"$s\" $x $y $keycode $char $width $height $root_x $root_y $mouse_button)"; flush $server} " bt "proc callback {s} {global server; puts $server "(:callback \"$s\")";flush $server} " bt "proc callbackval {s val} {global server; puts $server "(:callback \"$s\" $val)"} " bt "proc callbackstring {s val} {global server; puts $server "(:callback \"$s\" \"[escape $val]\")"} " bt "proc keepalive {} {global server; puts $server "(:keepalive \"[clock format [clock seconds] -format "%d/%m/%y %T"]\")"; flush $server}" bt "global text_wd ; set text_wd "initial text"" bt "global text_we ; set text_we "check me"" bt "ttk::frame .wc " bt "ttk::checkbutton .wc.we -command {callbackval we $we} -textvariable text_we" bt ".wc.we configure -variable we ; global we ; set we {}" bt "pack .wc -side top -fill none" bt "ttk::label .wc.wd -textvariable text_wd" bt "pack .wc.wd -side left -fill none" bt "pack .wc.we -side left -fill none" bt ".wc configure -borderwidth {3}" bt ".wc configure -relief {sunken}" bt ".wc.wd configure -text {x}" process_buffer l:(:CALLBACK "we" 1)<= buffer size 27 bt ".wc.wd configure -text {1}" process_buffer l:(:CALLBACK "we" 0)<= buffer size 27 bt ".wc.wd configure -text {0}" process_buffer Closing wish stream: #<TWO-WAY-STREAM :INPUT-STREAM #<SB-SYS:FD-STREAM for "descriptor 9" {C11D111}> :OUTPUT-STREAM #<SB-SYS:FD-STREAM for "descriptor 8" {C11D4C9}>>