[ltk-user] How to configure widgets?

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

[ltk-user] How to configure widgets?

Josef Wolf