[ltk-user] How to configure widgets? - ltk-user - mailman3.common-lisp.net

19 Nov 2012


      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}>>