- ltk-user - mailman3.common-lisp.net

How to use validatecommand?
by Frank 17 Nov '15

17 Nov '15

Hello, I'm trying to use the validatecommand of entry. The following code throws an error. How do I use it correctly? Thanks, Frank (defun foo () (with-ltk () (let ((e (make-instance 'entry :text "hello world!" :validate "focusin" :validatecommand (lambda () (format t "validating..."))))) (pack e)))) (foo) #| invalid command name "1" invalid command name "1" while executing "1" (in -validatecommand validation command executed by .wc) |#

2 1

ltk how to expand widgets with grid?
by Frank 15 Nov '15

15 Nov '15

Hello, I'm toying around with ltk and trying a simple example. I want the entry widget to expand horizontally when you resize the window. Somehow I seem not to get it. (defun test () (with-ltk () (let* ((f (make-instance 'frame :padding 10)) (e (make-instance 'entry :master f :width 20))) (grid f 0 0 :sticky "nsew") (grid-columnconfigure f 0 "weight" 1) (grid e 0 0 :sticky "nsew")))) (test)

1 0

Set-coords arc floating precision
by Nate Chodosh 04 Oct '15

04 Oct '15

Hello, My name is Nate. I have never participated in one of these lists before so I don't know the protocol so I apologize if this isn't the appropriate channel. I am working on an application where I need arrows on the end of arcs, which I am accomplishing by adding very small lines to the end points. However I think I have discovered that set-coords when used with an arc won't update the position unless the coordinates are integers which makes my approach impossible. Is there a workaround for this issue? Thank you, Nate

2 2

how to change button height? - from beginner
by David Wong 13 Sep '15

13 Sep '15

Hi, New to LTK, I just want to change the button height, but couldn’t. Doing it in (make-instance …), I got “Invalid initialization argument: :HEIGHT in call for class #<STANDARD-CLASS BUTTON>” error. Doing it in (configure b :height 10), then I got “Tcl/Tk error: unknown option “-height””. What’s the proper way to do it? Sample code: (defun display-image-button (filename) (with-ltk () (format-wish "package require Img") (let* ((img (make-image)) (b (make-instance 'button :text "Hello World!" :image img :width 10 :command (lambda () (do-msg "Bye! \"Hello World!\"") (setf *exit-mainloop* t))))) ;; Pack the canvas (pack b) ;(scrollregion c 0 0 800 800) ;; Load the image from the file (image-load img filename) ;; Draw the image on the canvas ;(create-image c 0 0 :image img) (configure b :height 10) )) ) thanks, David

2 2

Fwd: ltktest fails on CCL64 on MAC OSX Mavericks
by Peter Herth 14 Jul '15

14 Jul '15

copying the list. ---------- Forwarded message ---------- From: Peter Herth <herth(a)peter-herth.de> Date: Tue, Jul 14, 2015 at 10:39 AM Subject: Re: ltktest fails on CCL64 on MAC OSX Mavericks To: Munawar Cheema <munawar.a.cheema(a)gmail.com> Hi Munawar, thanks for your report, could you please send the exact platform and error messages produced, so I could have a chance to check this out? And please join the mailing list, as I have to manually approve any single mail sent from non subscribers. Best regards, Peter On Sat, Jul 11, 2015 at 12:41 PM, Munawar Cheema <munawar.a.cheema(a)gmail.com > wrote: > I tried quickloading ltk and then running ltk:ltktest on both sbcl and > ccl64 (current release of clozure 64 bit) and it works fine on sbcl > but fails in clozure. > > -- > Kind Regards > Munawar > >

1 0

ltktest fails on CCL64 on MAC OSX Mavericks
by Munawar Cheema 11 Jul '15

11 Jul '15

I tried quickloading ltk and then running ltk:ltktest on both sbcl and ccl64 (current release of clozure 64 bit) and it works fine on sbcl but fails in clozure. -- Kind Regards Munawar

1 0

ttk themes
by Andrew Dabrowski 07 Jul '15

07 Jul '15

You mentioned a while ago that from Tk5 on, ttk doesn't allow changes in background color of buttons. This breaks a program of mine. Is it possible to work around this by choosing a different widget set, either within Ltk or in Tk config files?

2 1

[Ltk-user] Patches
by Jason Miller 27 Jan '15

27 Jan '15

Hi All, I submitted a few patches to the list a while back; any comments on them? -Jaosn

1 1

[ltk-user] Cross platform distribution?
by Joshua Kordani 17 Dec '13

17 Dec '13

Greetings all, I've been very interested in locating an easy to distribute, cross platform gui library that will allow for gui development in common lisp. After finding out about tclkits and seeing how small they are, I get the impression that this goal is reachable via distribution of the platform specific tclkit along with a common lisp image (with ltk configured to locate the supplied tclkit). I didn't find an archive of this list, and from what I've read in ltk docs, it seems like this concept is easily supported, but I am rather new to common lisp and tcl/tk. Given that I am new to common lisp, I don't necessarily know what part of the ltk code I need to read in order to figure out how to invoke a local instance of tcl/tk (let alone make a connection to a remote-tcl). I am open to anything, if someone has walked this path before and knows of some documentation that might be illuminating, I'm all ears. In addition, if anyone has any suggestions about how I might go about this whole cross platform gui common lisp development effort more easily, I'm also all ears. My short term goal is to produce enough material to run the ltkdemo (or at least, my own hello world code) from a lisp image that references a supplied tclkit on at least osx and windows. Cheers! -- Joshua Kordani LSA Autonomy

3 6

[ltk-user] No dialog-box in ltk?
by Josef Wolf 16 Dec '13

16 Dec '13

Hello, I can't find the dialog widget in ltk. I can find message-box, ask-yesno, ask-okcancel and do-msg. But I can't find a dialog box where I can put e.g an entry to ask the user for additional information. Am I missing something? Any hints? -- Josef Wolf jw(a)raven.inka.de

2 1

[ltk-user] Example of scrollbar available?
by Josef Wolf 15 Dec '13

15 Dec '13

Hello folks, are there any examples of scrollbar usage available? I have a hard time to grasp how to use them, and I can't find any examples in the documentation. Thanks! -- Josef Wolf jw(a)raven.inka.de

4 13

[ltk-user] Is this alive?
by Jason Miller 12 Dec '13

12 Dec '13

The web archives for 2013 don't seem to be working; is this list alive? Is LTK being developed? After finding 2 different TCL quoting bugs, I rewrote the quoting layer in my local copy. Is there any interest in incorporating that into the official version? -Jason

4 5

[ltk-user] patch to make children actually do something
by Jason Miller 14 Nov '13

14 Nov '13

For treeviews: #'(setf children) will set the children, but #'children issues the command without reading the value! This fixes that

1 0

Re: [ltk-user] How is ":serve-event t" meant to be used?
by edgar 17 Oct '13

17 Oct '13

Jason Miller <jason(a)milr.com> wrote: > The solution is to catch the tag: > (catch *wish* (exit-wish)) Sorry, but that's not a solution, that's a wacky workaround. If that's the only solution, then this is a clear indicator that the implementation of :serve-event is buggy. But it works, so ... thanks a lot :-) This is only for a toy project, see: http://www.lispforum.com/viewtopic.php?f=2&t=4182 If I find a better solution I will tell it here on the list. Thanks, - edgar

1 0

Re: [ltk-user] How is ":serve-event t" meant to be used?
by edgar 17 Oct '13

17 Oct '13

Jason Miller <jason(a)milr.com> wrote: > On 18:26 Wed 16 Oct , edgar wrote: >> Hi all on the LTK list, >> >> I'm trying to open a scrolled-canvas widget in the Tk main window >> and then interactively drawing a line on the canvas (details in the >> REPL transcripts below), but LTK is throwing nothing but errors at >> me. >> >> The questions are: >> >> 1. Am I doing something fundamentally wrong in the examples below? > Yes >> LTK-TEST> (defun ltk-test () >> (with-ltk (:serve-event t) >> (let ((sc (make-instance 'scrolled-canvas))) >> (pack sc :expand 1 :fill :both) >> (setf *canvas* (canvas sc))))) >> LTK-TEST >> >> LTK-TEST> (ltk-test) >> ; the Tk window appears on the screen >> NIL >> >> LTK-TEST> (create-line *canvas* '(10 10 20 20)) > with-ltk is designed for all the ltk-calls to go within it. It > dynamically binds ltk::*wish* only for its dynamic extent. I have no > idea how the serve-event interactis with dynamic bindings, as I don't > use it. But in any event, *wish* will not be bound at your call to > create-line, so it will fail. > > I would suggest that you not use with-ltk here, but instead run it > manually: http://www.peter-herth.de/ltk/ltkdoc/node8.html > you can pass serve-event to mainloop as well to still get that > functionality. > > so instead your code should look something like: > (defun ltk-test () > (start-wish) > (let ((sc (make-instance 'scrolled-canvas))) > (pack sc :expand 1 :fill :both) > (setf *canvas* (canvas sc))) > (mainloop :serve-event t)) Thank you very much, but: a) your code is 99% the same code that I alredy wrote in the second example of my original mail b) your code produces _exactly_ the same errors that I got with the code from the second example of my original mail Please don't get me wrong: I'm really thankful for your help, but it seems as if you haven't read the full text. Here's the second example again now with your code and the errors: ------------------------- Start of REPL Transcript --------------------- CL-USER> (defpackage :ltk-test (:use :cl :ltk)) #<PACKAGE "LTK-TEST"> CL-USER> (in-package :ltk-test) #<PACKAGE "LTK-TEST"> LTK-TEST> (defparameter *canvas* nil) *CANVAS* LTK-TEST> (defun ltk-test () (start-wish) (let ((sc (make-instance 'scrolled-canvas))) (pack sc :expand 1 :fill :both) (setf *canvas* (canvas sc))) (mainloop :serve-event t)) LTK-TEST LTK-TEST> (ltk-test) ; the Tk window appears on the screen NIL LTK-TEST> (create-line *canvas* '(10 10 20 20)) ; a line appears on the canvas 1 LTK-TEST> (setf *exit-mainloop* t) ; the Tk window doesn't disappear from the screen T LTK-TEST> (exit-wish) ; the Tk window disappears from the screen, but: attempt to THROW to a tag that does not exist: #S(LTK::LTK-CONNECTION :STREAM NIL :CALLBACKS #<HASH-TABLE :TEST EQUAL :COUNT 0 {10068F9063}> :AFTER-IDS #<HASH-TABLE :TEST EQUAL :COUNT 0 {10068F9103}> :COUNTER 5 :AFTER-COUNTER 1 :EVENT-QUEUE NIL :CALL-WITH-CONDITION-HANDLERS-FUNCTION #<FUNCTION FUNCALL> :INPUT-HANDLER NIL :REMOTEP NIL :OUTPUT-BUFFER NIL :VARIABLES #<HASH-TABLE :TEST EQUAL :COUNT 0 {10068F91A3}>) [Condition of type SB-INT:SIMPLE-CONTROL-ERROR] Backtrace: 0: ("no debug information for frame") 1: (EXIT-WISH) [tl,external] 2: (SB-INT:SIMPLE-EVAL-IN-LEXENV (EXIT-WISH) #<NULL-LEXENV>) 3: (EVAL (EXIT-WISH)) -------------------------- End of REPL Transcript ---------------------- After (exit-wish) I can restart wish by calling (ltk-test) and it works, except that I can't close the window from the REPL without getting the error above, but if I close the Tk window by the window's "close" button and then call (ltk-test) again, I get the following error: ------------------------- Start of REPL Transcript --------------------- LTK-TEST> (ltk-test) There is already an inferior wish. [Condition of type LTK::LTK-ERROR] Backtrace: 0: (LTK::LTK-ERROR "There is already an inferior wish.") 1: (START-WISH) 2: (LTK-TEST) 3: (SB-INT:SIMPLE-EVAL-IN-LEXENV (LTK-TEST) #<NULL-LEXENV>) 4: (EVAL (LTK-TEST)) -------------------------- End of REPL Transcript ---------------------- But there is definitely no wish process in my machine anymore: bash$ ps ax | grep wish 6033 pts/0 S+ 0:00 grep wish How can I stop and restart wish with ":serve-event t" from the REPL without getting errors? Thank you, - edgar

1 0

[ltk-user] How is ":serve-event t" meant to be used?
by edgar 16 Oct '13

16 Oct '13

Hi all on the LTK list, I'm trying to open a scrolled-canvas widget in the Tk main window and then interactively drawing a line on the canvas (details in the REPL transcripts below), but LTK is throwing nothing but errors at me. The questions are: 1. Am I doing something fundamentally wrong in the examples below? 2. In case the errors are based on bugs in LTK, how can I help to improve the situation? I have some experience in both Tcl/Tk and Common Lisp. I'm a hardware electrician and not a professional programmer, but I know how to use diff to produce patches. But before starting to hack around in the LTK code I would first like to hear an opinion of somebody who has better insight than me into the LTK internals. SBCL 1.1.12 on Debian 7.2 Wheezy (64-bit), LTK 0.98, Tcl/Tk 8.5 Here is what I'm doing: ------------------------- Start of REPL Transcript --------------------- CL-USER> (ql:quickload :ltk) ; Loading "ltk" (:LTK) CL-USER> ltk:*ltk-version* "0.98" CL-USER> (defpackage :ltk-test (:use :cl :ltk)) #<PACKAGE "LTK-TEST"> CL-USER> (in-package :ltk-test) #<PACKAGE "LTK-TEST"> LTK-TEST> (defparameter *canvas* nil) *CANVAS* LTK-TEST> (defun ltk-test () (with-ltk (:serve-event t) (let ((sc (make-instance 'scrolled-canvas))) (pack sc :expand 1 :fill :both) (setf *canvas* (canvas sc))))) LTK-TEST LTK-TEST> (ltk-test) ; the Tk window appears on the screen NIL LTK-TEST> (create-line *canvas* '(10 10 20 20)) The value NIL is not of type STREAM. [Condition of type TYPE-ERROR] Backtrace: 0: (LTK::FLUSH-WISH) 1: (CREATE-LINE #<CANVAS {1004C0DC13}> (10 10 20 20)) 2: (SB-INT:SIMPLE-EVAL-IN-LEXENV (CREATE-LINE *CANVAS* (QUOTE (10 10 20 20))) #<NULL-LEXENV>) 3: (EVAL (CREATE-LINE *CANVAS* (QUOTE (10 10 20 20)))) ;; Looking at the definition of FLUSH-WISH in ltk.lisp, the reason ;; for the error seems to be: (wish-stream *wish*) => NIL LTK-TEST> *wish* #S(LTK::LTK-CONNECTION :STREAM NIL :CALLBACKS #<HASH-TABLE :TEST EQUAL :COUNT 0 {1007C0E9D3}> :AFTER-IDS #<HASH-TABLE :TEST EQUAL :COUNT 0 {1007C0EA73}> :COUNTER 1 :AFTER-COUNTER 1 :EVENT-QUEUE NIL :CALL-WITH-CONDITION-HANDLERS-FUNCTION #<FUNCTION (LAMBDA # :IN MAKE-LTK-CONNECTION) {1007C0EDCB}> :INPUT-HANDLER NIL :REMOTEP NIL :OUTPUT-BUFFER ("senddata [.wc.wf create line 10 10 20 20]") :VARIABLES #<HASH-TABLE :TEST EQUAL :COUNT 0 {1007C0EE53}>) -------------------------- End of REPL Transcript ---------------------- Here is what happens if I try to do the same thing manually: ------------------------- Start of REPL Transcript --------------------- LTK-TEST> (start-wish) ; an empty Tk window appears on the screen NIL LTK-TEST> (mainloop :serve-event t) NIL LTK-TEST> (defparameter *scrolled-canvas* (make-instance 'scrolled-canvas)) *SCROLLED-CANVAS* LTK-TEST> (pack *scrolled-canvas* :expand 1 :fill :both) ; the scrolled-canvas widget appears in the Tk window #<SCROLLED-CANVAS {10040DEB83}> LTK-TEST> (defparameter *canvas* (canvas *scrolled-canvas*)) *CANVAS* LTK-TEST> (create-line *canvas* '(10 10 20 20)) ; YIPPIE, a line appears on the canvas :-) 1 LTK-TEST> (setf *exit-mainloop* t) ; the Tk window doesn't disappear from the screen T LTK-TEST> (exit-wish) attempt to THROW to a tag that does not exist: #S(LTK::LTK-CONNECTION :STREAM NIL :CALLBACKS #<HASH-TABLE :TEST EQUAL :COUNT 0 {10068F9063}> :AFTER-IDS #<HASH-TABLE :TEST EQUAL :COUNT 0 {10068F9103}> :COUNTER 5 :AFTER-COUNTER 1 :EVENT-QUEUE NIL :CALL-WITH-CONDITION-HANDLERS-FUNCTION #<FUNCTION FUNCALL> :INPUT-HANDLER NIL :REMOTEP NIL :OUTPUT-BUFFER NIL :VARIABLES #<HASH-TABLE :TEST EQUAL :COUNT 0 {10068F91A3}>) [Condition of type SB-INT:SIMPLE-CONTROL-ERROR] Backtrace: 0: ("no debug information for frame") 1: (EXIT-WISH) [tl,external] 2: (SB-INT:SIMPLE-EVAL-IN-LEXENV (EXIT-WISH) #<NULL-LEXENV>) 3: (EVAL (EXIT-WISH)) -------------------------- End of REPL Transcript ---------------------- Looking at the definition of EXIT-WISH in ltk.lisp, the reason for the error is the line (throw *wish* nil) but I'm not sure if the EXIT-WISH function is meant to be called in this context at all. The question remains: How is ":serve-event t" meant to be used in a meaningful way? Or am I too stupid to use LTK properly? Thanks in advance for your answers, - edgar

1 0

[ltk-user] patch to add ttk-state accessor
by Jason Miller 15 Oct '13

15 Oct '13

The current create-name implementation will generate all alphabetic strings starting with "w" which includes "wm" after only 12 new toplevels. This overwrites the global command "wm" which is kind of important. On a side-note, I personally think the encode-base-52 is a bit overengineered vs ~36R but that's not a bug so I didn't include it in this patch. ~36R wouldn't have stomped on any existing globals by the happy accident of it using UPCASED letters only.

1 0

[ltk-user] patch to add ttk-state accessor
by Jason Miller 15 Oct '13

15 Oct '13

Adds an accessor for the ttk-states. example usage: (ttk-state widget :active) ; => nil retrieves the active state (setf (ttk-state widget :active) t) ;sets the active sets

1 0

[ltk-user] patch for quit
by Jason Miller 15 Oct '13

15 Oct '13

New versions of sbcl will warn on a reference to sb-ext:quit. Since new versions of sbcl also include asdf3, I just use uiop:quit if asdf3 is present, and the old code if not.

1 0

[ltk-user] patch for unescaped values
by Jason Miller 14 Oct '13

14 Oct '13

In general this in a format string is a code-smell: "{~A}" it nearly always means that a value isn't properly escaped. Note that even (format-wish "{~A}" (tkescape foo)) will fail for a string that ends with a backslash. I'm pretty sure that I can come up with code to break every single change I made. I used my own escape function as a format specifier just because I find it clearer and less error-prone to have all the escaping in the format string. with tkescape2, you need to surrond the corresponding ~a with dquotes (e.g. (format-wish "\"~a\"" (tkescape2 foo)) is correct but (format-wish "~a" (tkescape foo) and (format-wish "\"~a\"" foo) are both wrong) I found this originally in the setf for text, and the setf for listboxes. When I found the same bug in two places I figured it was a good idea to look for more. -Jason

1 0

[ltk-user] Can't get SCALE value
by JW 21 Dec '12

21 Dec '12

I am having two problems with SCALE. 1. I cannot set bounds to anything other than integers. For example: (make-instance 'scale :from 0 :to (* 2 pi) ... gives me an error. 2. I am unable to retrieve the :VARIABLE value In the below, vales of UPPER-THETA and FORE-THETA never seem to be anything but 0, no matter where I slide the scale. I have tested all the drawing an update code, I am stumped! (defun controltest () "Test of a user-controlled robot arm" (with-ltk () (let* ((upper-theta 0) (fore-theta 0) (upper-slider (make-instance 'scale :from 0 :to 7 :length 360 :variable upper-theta)) (fore-slider (make-instance 'scale :from 0 :to 7 :length 360 :variable fore-theta)) (cnvs (make-instance 'canvas :width cnvs-width :height cnvs-height)) (upper (manip:uctk-beam :cen-x 200 :cen-y 200 :b-length 40 :b-width 20 :tk-cnvs cnvs)) (fore (manip:uctk-beam :cen-x 0 :cen-y 40 ; relative to upper :b-length 40 :b-width 20 :tk-cnvs cnvs)) (slp-time 50) #|ms|# ) (labels ((update () (draw upper nil) ; contains FORE, no need to draw separately (geo:set-member-theta upper 2 fore-theta) (geo:set-theta upper upper-theta) (after slp-time #'update))) (geo:add-geo upper fore) ; make FORE a member of UPPER (pack cnvs :fill :both :expand 1) (pack upper-slider :side :bottom) (pack fore-slider :side :bottom) (update)))))

1 1

[ltk-user] Bug in LTK
by Jason Miller 07 Dec '12

07 Dec '12

LTK constructs names for tcl variables by appending characters to "w" the problem is that there is a command "wm" already in tcl/tk. This can cause issues. I quickly worked around it by making the base-name "ww" as there are no built-in commands that start with ww. However the right solution is probably to make a namespace. -Jason

1 0

[ltk-user] Increamentally build the GUI?
by Josef Wolf 26 Nov '12

26 Nov '12

Hello everybody, I am trying to build my tk GUI incrementally. The SERVE-EVENT parameter seems to suggest that something like the following should be possible: (defvar *frame*) (defvar *label-widget*) (with-ltk (:serve-event t) (setf *frame* (make-instance 'frame)) (pack *frame*)) (with-ltk (:serve-event t) (setf *label-widget* (make-instance 'label :master *frame* :text "initial text")) (pack *label-widget* :side :left)) (with-ltk () ;; All initializations are already done, we just need to enter MAINLOOP ) But instead of a single toplevel containing both, the frame and the label, I get two separate toplevels. And none of those toplevels seem to contain the label widget. The output of the ps command shows, that two separate WISH processes are started, which obviously is not going to work. Does anybody have an example of how to properly use the SERVE-EVENT parameter?

2 1

[ltk-user] Using tags on canvas items?
by Josef Wolf 21 Nov '12

21 Nov '12

Hello everybody, I am trying to use the tags feature of the canvas. So I am trying to attach a list of tags to an item and use those tags later to identify items. Here's an example: (with-ltk () (let* ((sc (make-instance 'scrolled-canvas)) (canvas (canvas sc)) (polygon (create-polygon canvas '(10 20 30 40 60 50)))) (pack sc) (configure canvas :width 100 :height 100) (itemconfigure canvas polygon :tags '(foo bar baz)) (itemconfigure canvas polygon :fill 'red) (itemconfigure canvas 'foo :fill 'yellow))) But it somehow doesn't work the way I expected it to work. The polygon stays red instead of being re-configured to yellow. It also won't work if I use strings instead of symbols. It only works if I use a _single_ string. But this is not how the tags feature is intended to work. Any ideas?

1 1

[ltk-user] How to configure widgets?
by Josef Wolf 21 Nov '12

21 Nov '12

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

2 2