Joshua Kordani | 16 Dec 20:16 2013

Cross platform distribution?

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
Josef Wolf | 14 Dec 20:58 2013
Picon

No dialog-box in ltk?

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 <at> raven.inka.de

Josef Wolf | 12 Dec 12:59 2013
Picon

Example of scrollbar available?

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 <at> raven.inka.de

Jason Miller | 14 Nov 22:43 2013

patch to make children actually do something

For treeviews:
#'(setf children) will set the children, but #'children issues the
command without reading the value!  This fixes that 
diff --git a/ltk.lisp b/ltk.lisp
index 127e309..af9b1a5 100644
--- a/ltk.lisp
+++ b/ltk.lisp
 <at>  <at>  -2638,10 +2638,16  <at>  <at>  bind ~a <Configure> [list resetScroll ~a]

 (defgeneric children (tree item))
 (defmethod children ((tree treeview) item)
-  (format-wish "~a children ~a" (widget-path tree) item))
+  (format-wish "senddatastrings [~a children ~a]" (widget-path tree) item)
+  (let ((names (read-data))
+        (items (items tree)))
+    (mapcar (lambda (name)
+              (find name items :key #'name :test #'equal))
+            names)))

 (defmethod children ((tree treeview) (item treeitem))
-  (format-wish "~a children ~a" (widget-path tree) (name item)))
+  (children tree (name item)))
+  ;(format-wish "~a children ~a" (widget-path tree) (name item)))

 (defgeneric (setf children) (val tree item))
 (defmethod (setf children) (val (tree treeview) item)
edgar | 18 Oct 01:33 2013
Picon

Re: How is ":serve-event t" meant to be used?


Jason Miller <jason <at> 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

edgar | 17 Oct 21:00 2013
Picon

Re: How is ":serve-event t" meant to be used?


Jason Miller <jason <at> 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

edgar | 16 Oct 18:26 2013
Picon

How is ":serve-event t" meant to be used?

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

Jason Miller | 16 Oct 00:49 2013

patch to add ttk-state accessor

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.
Index: ltk.lisp
===================================================================
--- ltk.lisp    (revision 265)
+++ ltk.lisp    (working copy)
 <at>  <at>  -1273,7 +1273,7  <at>  <at> 

 (defun create-name ()
   "create unique widget name, append unique number to 'w'"
-  (format nil "w~A" (encode-base-52 (get-counter))))
+  (format nil "ltk~A" (encode-base-52 (get-counter))))

Jason Miller | 16 Oct 00:41 2013

patch to add ttk-state accessor

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
Index: ltk.lisp
===================================================================
--- ltk.lisp    (revision 265)
+++ ltk.lisp    (working copy)
 <at>  <at>  -425,7 +425,8  <at>  <at> 
            #:treeview-identify-item
            #:treeview-set-selection
            #:items
-           #:image))
+           #:image
+           #:ttk-state))

 (defpackage :ltk-user
   (:use :common-lisp :ltk))
 <at>  <at>  -5336,6 +5337,26  <at>  <at> 
          `(configure ,w :cursor ""))
        widgets)))

+(defun (setf ttk-state) (enable widget state)
+  (unless
+      (member state '(:active :disabled :focus :pressed :selected
+             :background :readonly :alternate :invalid :hover))
+    (error "Invalid state ~A" state))
+  (format-wish "~a state ~:[!~;~]~a"
+          (widget-path widget) enable
+          (string-downcase (symbol-name state))))
+
+(defun ttk-state (widget state)
+  (unless
+      (member state '(:active :disabled :focus :pressed :selected
+             :background :readonly :alternate :invalid :hover))
+    (cerror "Invalid state ~A" state))
+  (format-wish "senddatastring [~a state]" (widget-path widget))
+  (let ((states (split (read-data) '(#\Space))) )
+    (member (string-downcase (symbol-name state))
+       states
+       :test #'string=)))
+
 (pushnew :ltk *features*)

Jason Miller | 16 Oct 00:09 2013

patch for quit

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.
Index: ltk.lisp
===================================================================
--- ltk.lisp    (revision 265)
+++ ltk.lisp    (working copy)
 <at>  <at>  -5162,8 +5162,11  <at>  <at> 
   (ignore-errors
     (format *error-output* "An error of has occured: ~%")
     (print-backtrace condition *error-output*)
+    #+asdf3(uiop:quit)
+    #-asdf3
     #+sbcl (quit)
-    #+(or cmu scl) (ext:quit)))
+    #+(or cmu scl) (ext:quit)
+    #-(or cmu scl sbcl)(values)))

 (defun debugger-test (debugger-class)
   (with-ltk (:debugger-class debugger-class :debug-tcl t)
Jason Miller | 14 Oct 21:32 2013

patch for unescaped values

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
Index: ltk.lisp
===================================================================
--- ltk.lisp	(revision 265)
+++ ltk.lisp	(working copy)
 <at>  <at>  -1115,6 +1115,29  <at>  <at> 
   (make-array (length string) :element-type 'character
               :initial-contents string :adjustable t :fill-pointer t))

+;; This works by the following algorithm:
+;; 1) Replace all backslaskes with \x5c
+;; 2) Replace all { with \{
+;; 3) Replace all } with #\}
+;; 4) Generate a tcl command that performs backslash substitution on it
+(defun esc (stream string &rest modifiers)
+  "Creates a tcl command-substitution that will fully reproduce the
+    lisp string"
+  (declare (ignore modifiers))
+  (when (not (stringp string))
+    (setf string (format nil "~a" string)))
+  (progn
+    (write-string "[subst -nocommands -novariables {" stream)
+    (loop for char across string
+       do (case char
+	    (#\\
+	     (write-string "\\x5c" stream))
+	    ((#\{ #\})
+	     (write-char #\\ stream)
+	     (write-char char stream))
+	    (t (write-char char stream))))
+      (write-string "} ]" stream)))
+
 ;; Much faster version. For one test run it takes 2 seconds, where the
 ;; other implementation requires 38 minutes.
 (defun tkescape (text)
 <at>  <at>  -1397,7 +1420,7  <at>  <at> 
       (disabledforeground disabledforeground "~ <at> [ -disabledforeground ~(~a~)~]" disabledforeground "")
       (elementborderwidth elementborderwidth "~ <at> [ -elementborderwidth ~(~a~)~]" elementborderwidth "")
       (exportselection exportselection "~ <at> [ -exportselection ~(~a~)~]" exportselection "")
-      (font font "~ <at> [ -font {~a}~]" font "font to use to display text on the widget")
+      (font font "~ <at> [ -font ~/ltk:esc/~]" font "font to use to display text on the widget")
       (foreground foreground "~ <at> [ -foreground ~(~a~)~]" foreground "foreground color of the widget")
       (format format "~ <at> [ -format ~(~a~)~]" format "")
       (from from "~ <at> [ -from ~(~a~)~]" from "")
 <at>  <at>  -1500,7 +1523,7  <at>  <at> 
       (value value "~ <at> [ -value ~(~a~)~]" value "")
       (value-radio-button nil "~ <at> [ -value ~(~a~)~]" (radio-button-value widget)
        "value for the radio button group to take, when the button is selected")
-      (values values "~ <at> [ -values {~{{~a}~^ ~}}~]" values "")
+      (values values "~ <at> [ -values [list ~{~/ltk:esc/~^ ~}]~]" values "")
       (variable variable "~ <at> [ -variable ~(~a~)~]" variable "name of the variable associated with the widget")
       (variable-radio-button nil "~ <at> [ -variable ~(~a~)~]" (radio-button-variable widget)
        "name of the radio button group the button shall belong to as a string")
 <at>  <at>  -1798,7 +1821,7  <at>  <at> 
   (read-data))

 (defun clipboard-append (txt)
-  (format-wish "clipboard append {~a}" txt))
+  (format-wish "clipboard append ~/ltk:esc/" txt))

 ;; around - initializer

 <at>  <at>  -1924,7 +1947,7  <at>  <at> 

 (defgeneric (setf value) (widget val))
 (defmethod (setf value) (val (v tkvariable))
-  (format-wish "global ~a; set ~a {~a}" (name v) (name v) val)
+  (format-wish "global ~a; set ~a ~/ltk:esc/" (name v) (name v) val)
   val)

 (defclass tktextvariable ()
 <at>  <at>  -1975,7 +1998,7  <at>  <at> 
     (setf (slot-value m 'widget-path) (create-path (master m) (name m))))
   (format-wish "menu ~A -tearoff ~a" (widget-path m) tearoff)
   (when (master m)
-    (format-wish "~A add cascade -label {~A} -menu ~a~ <at> [ -underline ~a ~]"
+    (format-wish "~A add cascade -label ~/ltk:esc/ -menu ~a~ <at> [ -underline ~a ~]"
                  (widget-path (master m)) (text m) (widget-path m) underline)))

 (defun make-menu(menu text &key underline name (tearoff 0))
 <at>  <at>  -2008,7 +2031,7  <at>  <at> 
 (defmethod initialize-instance :after ((m menubutton) &key command underline accelerator state)
   (when command
     (add-callback (name m) command))
-  (format-wish "~A add command -label {~A}  -command {callback ~A}~ <at> [ -underline ~a ~]~ <at> [ -accelerator
{~a} ~]~ <at> [ -state ~(~a~)~]"
+  (format-wish "~A add command -label ~/ltk:esc/  -command {callback ~A}~ <at> [ -underline ~a ~]~ <at> [
-accelerator ~/ltk:esc/ ~]~ <at> [ -state ~(~a~)~]"
                (widget-path (master m)) (text m) (name m) underline accelerator state))

 (defun make-menubutton(menu text command &key underline accelerator state)
 <at>  <at>  -2022,7 +2045,7  <at>  <at> 
 (defmethod initialize-instance :after ((m menucheckbutton) &key)
   (when (command m)
     (add-callback (name m) (command m)))
-  (format-wish "~A add checkbutton -label {~A} -variable ~a ~ <at> [ -command {callback ~a}~]"
+  (format-wish "~A add checkbutton -label ~/ltk:esc/ -variable ~a ~ <at> [ -command {callback ~a}~]"
 	       (widget-path (master m)) (text m) (name m) (and (command m) (name m))))

 (defmethod value ((cb menucheckbutton))
 <at>  <at>  -2043,7 +2066,7  <at>  <at> 
   (unless (group m)
     (setf (group m)
 	  (name m)))
-  (format-wish "~A add radiobutton -label {~A} -value ~a -variable ~a ~ <at> [ -command {callback ~a}~]"
+  (format-wish "~A add radiobutton -label ~/ltk:esc/ -value ~a -variable ~a ~ <at> [ -command {callback ~a}~]"
                (widget-path (master m)) (text m) (name m) (group m)
                (and (command m) (name m))))

 <at>  <at>  -2153,7 +2176,7  <at>  <at> 

 #-:tk84
 (defmethod (setf options) (values (combobox combobox))
-  (format-wish "~a configure -values {~{ \{~a\}~}}" (widget-path combobox) values))
+  (format-wish "~a configure -values [list ~{~/ltk:esc/ ~}]" (widget-path combobox) values))

 
 ;; text entry widget
 <at>  <at>  -2213,7 +2236,7  <at>  <at> 
 (defwrapper labelframe (widget) () "ttk::labelframe")

 (defmethod (setf text) :after (val (l labelframe))
-  (format-wish "~a configure -text {~a}" (widget-path l) val)
+  (format-wish "~a configure -text ~/ltk:esc/" (widget-path l) val)
   val)

 ;;; panedwindow widget
 <at>  <at>  -2288,8 +2311,8  <at>  <at> 
 (defmethod listbox-append ((l listbox) values)
   "append values (which may be a list) to the list box"
   (if (listp values)
-      (format-wish "~a insert end ~{ \{~a\}~}" (widget-path l) values)
-      (format-wish "~a insert end \{~a\}" (widget-path l) values))
+      (format-wish "~a insert end ~{ ~/ltk:esc/~}" (widget-path l) values)
+      (format-wish "~a insert end ~/ltk:esc/" (widget-path l) values))
   l)

 (defgeneric listbox-get-selection (l))
 <at>  <at>  -2322,8 +2345,8  <at>  <at> 
 (defgeneric listbox-insert (l index values))
 (defmethod listbox-insert ((l listbox) index values)
   (if (listp values)
-      (format-wish "~a insert ~a ~{ \{~a\}~}" (widget-path l) index values)
-      (format-wish "~a insert ~a \{~a\}" (widget-path l) index values))
+      (format-wish "~a insert ~a ~{ ~/ltk:esc/~}" (widget-path l) index values)
+      (format-wish "~a insert ~a ~/ltk:esc/" (widget-path l) index values))
   l)

 (defgeneric listbox-configure (l i &rest options))
 <at>  <at>  -2377,11 +2400,11  <at>  <at> 

 (defgeneric notebook-add (nb widget &rest options))
 (defmethod notebook-add ((nb notebook) (w widget) &rest options)
-  (format-wish "~a add ~a ~{-~(~a~) {~a}~}" (widget-path nb) (widget-path w) options))
+  (format-wish "~a add ~a ~{-~(~a~) ~/ltk:esc/~}" (widget-path nb) (widget-path w) options))

 (defgeneric notebook-tab (nb widget option value))
 (defmethod notebook-tab ((nb notebook) (w widget) option value)
-  (format-wish "~a tab ~a -~(~a~) {~a}" (widget-path nb)
+  (format-wish "~a tab ~a -~(~a~) ~/ltk:esc/" (widget-path nb)
 	       (widget-path w) option value))

 (defgeneric notebook-forget (nb widget))
 <at>  <at>  -2728,11 +2751,11  <at>  <at> 
   item)

 (defmethod (setf text) (val (item treeitem))
-  (format-wish "~a item ~a -text {~A}" (widget-path (tree item)) (name item) val)
+  (format-wish "~a item ~a -text ~/ltk:esc/" (widget-path (tree item)) (name item) val)
   val)

 (defmethod (setf image) (val (item treeitem))
-  (format-wish "~a item ~a -image {~A}" (widget-path (tree item)) (name item) val)
+  (format-wish "~a item ~a -image ~/ltk:esc/" (widget-path (tree item)) (name item) val)
   val)

 (defmethod see ((tv treeview) (item treeitem))
 <at>  <at>  -2755,16 +2778,16  <at>  <at> 

 (defgeneric column-configure (tree column option value &rest rest))
 (defmethod column-configure ((tree treeview) column option value &rest rest)
-  (format-wish "~a column ~a -~(~a~) {~a}~{ -~(~a~) {~(~a~)}~}" (widget-path tree) column
+  (format-wish "~a column ~a -~(~a~) ~/ltk:esc/~{ -~(~a~) {~(~a~)}~}" (widget-path tree) column
 	       option value rest))

 (defgeneric treeview-delete (tree items))
 (defmethod treeview-delete ((tree treeview) item)
-  (format-wish "~a delete {~a}" (widget-path tree) item))
+  (format-wish "~a delete ~/ltk:esc/" (widget-path tree) item))

 (defmethod treeview-delete ((tree treeview) (item treeitem))
   (setf (items tree) (remove item (items tree)))
-  (format-wish "~a delete {~a}" (widget-path tree) (name item)))
+  (format-wish "~a delete ~/ltk:esc/" (widget-path tree) (name item)))

 (defmethod treeview-delete ((tree treeview) (items cons))
    (format-wish "~a delete {~{~a~^ ~}}" (widget-path tree) items))
 <at>  <at>  -2817,9 +2840,9  <at>  <at> 
                   (string= arg "")))
          (format stream "{}"))
         ((listp arg)
-         (format stream "{~{~/ltk::tk-princ/~^ ~}}" (mapcar #'tkescape arg)))
+         (format stream "[list ~{~/ltk::tk-princ/~^ ~}]" arg))
         (t
-         (format stream "~a" (tkescape arg)))))
+         (format stream "~/ltk:esc/" arg))))

 (defun treeview-insert (tree &rest options
                         &key (parent "{}") (index "end") (id (create-name)) &allow-other-keys)
 <at>  <at>  -2898,7 +2921,7  <at>  <at> 

 (defgeneric treeview-set-selection (w items))
 (defmethod treeview-set-selection ((tv treeview) items)
-  (format-wish "~a selection set {~{~a ~}}" (widget-path tv) (mapcar #'name items)))
+  (format-wish "~a selection set [list ~{~/ltk:esc/ ~}]" (widget-path tv) (mapcar #'name items)))

 

 <at>  <at>  -3229,13 +3252,13  <at>  <at> 
          (args))

         ((eq itemtype :text)
-         (format stream "~a create text ~a ~a -anchor nw -text {~a} "
-                 cpath (number) (number) (tkescape (arg)))
+         (format stream "~a create text ~a ~a -anchor nw -text \"~a\" "
+                 cpath (number) (number) (tkescape2 (arg)))
          (args))

         ((eq itemtype :ctext)
-         (format stream "~a create text ~a ~a -anchor n -text {~a} "
-                 cpath (number) (number) (tkescape (arg)))
+         (format stream "~a create text ~a ~a -anchor n -text \"~a\" "
+                 cpath (number) (number) (tkescape2 (arg)))
          (args))
         ))))

 <at>  <at>  -3268,7 +3291,7  <at>  <at> 
              (make-instance class :canvas canvas :handle handle))))))

 (defun create-text (canvas x y text)
-  (format-wish "senddata [~a create text ~a ~a -anchor nw -text {~a}]" (widget-path canvas)
+  (format-wish "senddata [~a create text ~a ~a -anchor nw -text ~/ltk:esc/]" (widget-path canvas)
                (tk-number x) (tk-number y)
                text)
   (read-data))
 <at>  <at>  -3410,13 +3433,13  <at>  <at> 
   (read-data))

 (defmethod (setf text) (val (text text))
-  (format-wish "~A delete 0.0 end;~A insert end {~A}" (widget-path text) (widget-path text) val)
+  (format-wish "~A delete 0.0 end;~A insert end ~/ltk:esc/" (widget-path text) (widget-path text) val)
   val)

 (defgeneric save-text (txt filename))
 (defmethod save-text ((txt text) filename)
   "save the content of the text widget into the file <filename>"
-  (format-wish "set file [open {~a} \"w\"];puts $file [~a get 1.0 end];close $file;puts \"asdf\""
filename (widget-path txt))
+  (format-wish "set file [open ~/ltk:esc/ \"w\"];puts $file [~a get 1.0 end];close $file;puts \"asdf\""
filename (widget-path txt))
   (read-line (wish-stream *wish*))
   txt)

 <at>  <at>  -3424,7 +3447,7  <at>  <at> 
 (defmethod load-text((txt text) filename)
   "load the content of the file <filename>"
 ;  (format-wish "set file [open {~a} \"r\"];~a delete 1.0 end;~a insert end [read $file];close $file;puts
\"asdf\"" filename (widget-path txt) (widget-path txt))
-  (format-wish "set file [open {~a} \"r\"];~a delete 1.0 end;~a insert end [read $file];close $file;puts
\"(:DATA asdf)\"" filename (widget-path txt) (widget-path txt))
+  (format-wish "set file [open ~/ltk:esc/ \"r\"];~a delete 1.0 end;~a insert end [read $file];close
$file;puts \"(:DATA asdf)\"" filename (widget-path txt) (widget-path txt))
   (read-data))

 ;;; photo image object
 <at>  <at>  -3452,7 +3475,7  <at>  <at> 
 (defgeneric image-load (p filename))
 (defmethod image-load((p photo-image) filename)
   ;(format t "loading file ~a~&" filename)
-  (send-wish (format nil "~A read {~A} -shrink" (name p) filename))
+  (send-wish (format nil "~A read ~/ltk:esc/ -shrink" (name p) filename))
   p)

 (defgeneric ishow (p name))
 <at>  <at>  -3531,17 +3554,17  <at>  <at> 

 (defgeneric grid-columnconfigure (widget c o v))
 (defmethod grid-columnconfigure (widget column option value)
-  (format-wish "grid columnconfigure ~a ~a -~(~a~) {~a}" (widget-path widget) column option value)
+  (format-wish "grid columnconfigure ~a ~a -~(~a~) ~/ltk:esc/" (widget-path widget) column option value)
   widget)

 (defgeneric grid-rowconfigure (widget r o v))
 (defmethod grid-rowconfigure (widget row option value)
-  (format-wish "grid rowconfigure ~a ~a -~(~a~) {~a}" (widget-path widget) row option value)
+  (format-wish "grid rowconfigure ~a ~a -~(~a~) ~/ltk:esc/" (widget-path widget) row option value)
   widget)

 (defgeneric grid-configure (widget o v))
 (defmethod grid-configure (widget option value)
-  (format-wish "grid configure ~a -~(~a~) {~a}" (widget-path widget) option value)
+  (format-wish "grid configure ~a -~(~a~) ~/ltk:esc/" (widget-path widget) option value)
   widget)

 (defgeneric grid-forget (widget))
 <at>  <at>  -3568,7 +3591,7  <at>  <at> 

 (defmethod configure ((item menuentry) option value &rest others)
   (let ((path (widget-path (master item))))
-    (format-wish "~A entryconfigure [~A index {~A}]~{ -~(~a~) {~/ltk::down/}~}"
+    (format-wish "~A entryconfigure [~A index ~/ltk:esc/]~{ -~(~a~) {~/ltk::down/}~}"
                  path
                  path
                  (text item)
 <at>  <at>  -3591,7 +3614,7  <at>  <at> 

 ;;; for tkobjects, the name of the widget is taken
 (defmethod configure (widget option (value tkobject) &rest others)
-  (format-wish "~A configure -~(~A~) {~A} ~{ -~(~a~) {~(~a~)}~}" (widget-path widget) option
(widget-path value) others)
+  (format-wish "~A configure -~(~A~) ~/ltk:esc/ ~{ -~(~a~) {~(~a~)}~}" (widget-path widget) option
(widget-path value) others)
   widget)

 (defgeneric cget (widget option))
 <at>  <at>  -3619,7 +3642,7  <at>  <at> 
 (defgeneric itemconfigure (widget item option value))

 (defmethod itemconfigure ((widget canvas) item option value)
-  (format-wish "~A itemconfigure ~A -~(~A~) {~A}" (widget-path widget) item option
+  (format-wish "~A itemconfigure ~A -~(~A~) ~/ltk:esc/" (widget-path widget) item option
 	    (if (stringp value) ;; There may be values that need to be passed as
 		value           ;; unmodified strings, so do not downcase strings
 	      (format nil "~(~a~)" value))) ;; if its not a string, print it downcased
 <at>  <at>  -3628,7 +3651,7  <at>  <at> 

 ;;; for tkobjects, the name of the widget is taken
 (defmethod itemconfigure ((widget canvas) item option (value tkobject))
-  (format-wish "~A itemconfigure ~A -~(~A~) {~A}" (widget-path widget) item option (widget-path value))
+  (format-wish "~A itemconfigure ~A -~(~A~) ~/ltk:esc/" (widget-path widget) item option (widget-path value))
   widget)

 (defgeneric itemlower (w i &optional below))
 <at>  <at>  -3707,7 +3730,7  <at>  <at> 

 (defgeneric wm-title (widget title))
 (defmethod wm-title ((w widget) title)
-  (format-wish "wm title ~a {~a}" (widget-path w) title)
+  (format-wish "wm title ~a ~/ltk:esc/" (widget-path w) title)
   w)

 #-:tk84
 <at>  <at>  -3937,7 +3960,7  <at>  <at> 
 ;;; Dialog functions

 (defun choose-color (&key parent title initialcolor )
-  (format-wish "senddatastring [tk_chooseColor ~ <at> [ -parent ~A~]~ <at> [ -title {~A}~]~ <at> [ -initialcolor
{~A}~]]" (when parent (widget-path parent)) title initialcolor)
+  (format-wish "senddatastring [tk_chooseColor ~ <at> [ -parent ~A~]~ <at> [ -title ~/ltk:esc/~]~ <at> [
-initialcolor ~/ltk:esc/~]]" (when parent (widget-path parent)) title initialcolor)
   (read-data))

 (defun get-open-file (&key (filetypes '(("All Files" "*")))
 <at>  <at>  -3945,21 +3968,21  <at>  <at> 
 			   multiple parent title)
   (let ((files
         (with-output-to-string (s)
-          (format s "{")
+          (format s "[list ")
           (dolist (type filetypes)
             (let ((name (first type))
                   (wildcard (second type)))
-              (format s "{{~a} {~a}} " name wildcard)))
-          (format s "}"))))
+              (format s "[list ~/ltk:esc/ ~/ltk:esc/ ] " name wildcard)))
+          (format s " ]"))))
     (if multiple
 	(format-wish "senddatastrings [tk_getOpenFile ~
-                      -filetypes ~a ~ <at> [ -initialdir {~a}~] -multiple 1 ~
-                      ~ <at> [ -parent ~a~] ~ <at> [ -title {~a}~]]"
+                      -filetypes ~a ~ <at> [ -initialdir ~/ltk:esc/~] -multiple 1 ~
+                      ~ <at> [ -parent ~a~] ~ <at> [ -title ~/ltk:esc/~]]"
 		      files initialdir 
 		      (and parent (widget-path parent)) title)
 	(format-wish "senddatastring [tk_getOpenFile ~
-                      -filetypes ~a ~ <at> [ -initialdir {~a}~]  ~
-                      ~ <at> [ -parent ~a~] ~ <at> [ -title {~a}~]]"
+                      -filetypes ~a ~ <at> [ -initialdir ~/ltk:esc/~]  ~
+                      ~ <at> [ -parent ~a~] ~ <at> [ -title ~/ltk:esc/~]]"
 		      files initialdir 
 		      (and parent (widget-path parent)) title))
     (read-data)))
 <at>  <at>  -3967,18 +3990,18  <at>  <at> 
 (defun get-save-file (&key (filetypes '(("All Files" "*"))))
   (let ((files
         (with-output-to-string (s)
-          (format s "{")
+          (format s "[list ")
           (dolist (type filetypes)
             (let ((name (first type))
                   (wildcard (second type)))
-              (format s "{{~a} {~a}} " name wildcard)))
-          (format s "}"))))
+              (format s "[list ~/ltk:esc/ ~/ltk:esc/ ] " name wildcard)))
+          (format s " ]"))))
     (format-wish "senddatastring [tk_getSaveFile -filetypes ~a]" files)
     (read-data)))

 (defun choose-directory (&key (initialdir (namestring *default-pathname-defaults*))
 			      parent title mustexist)
-  (format-wish "senddatastring [tk_chooseDirectory ~ <at> [ -initialdir \"~a\"~]~ <at> [ -parent ~a ~]~ <at> [
-title {~a}~]~ <at> [ -mustexist ~a~]]" (tkescape2 initialdir) (and parent (widget-path parent)) title
(and mustexist 1))
+  (format-wish "senddatastring [tk_chooseDirectory ~ <at> [ -initialdir \"~a\"~]~ <at> [ -parent ~a ~]~ <at> [
-title ~/ltk:esc/~]~ <at> [ -mustexist ~a~]]" (tkescape2 initialdir) (and parent (widget-path parent))
title (and mustexist 1))
   (read-data))

 (defvar *mb-icons* (list "error" "info" "question" "warning")
 <at>  <at>  -3987,7 +4010,7  <at>  <at> 
 ;;; see make-string-output-string/get-output-stream-string
 (defun message-box (message title type icon &key parent)
   ;;; tk_messageBox function
-  (format-wish "senddatastring [tk_messageBox -message \"~a\" -title {~a} -type ~(~a~) -icon
~(~a~)~ <at> [ -parent ~a~]]" (tkescape2 message) title type icon (and parent (widget-path parent)))
+  (format-wish "senddatastring [tk_messageBox -message \"~a\" -title ~/ltk:esc/ -type ~(~a~) -icon
~(~a~)~ <at> [ -parent ~a~]]" (tkescape2 message) title type icon (and parent (widget-path parent)))
   (read-keyword))

 
 <at>  <at>  -4053,7 +4076,7  <at>  <at> 
    (t
     (let* ((name (create-name)))
       (add-callback name (second tree))		     
-      (send-wish (format nil "~A add command -label {~A} -command {puts -nonewline  {(\"~A\")};flush
$server}" widget-path (first tree) name))
+      (send-wish (format nil "~A add command -label ~/ltk:esc/ -command {puts -nonewline  {(\"~A\")};flush
$server}" widget-path (first tree) name))
       ))))

 (defun create-menu2 (menutree)

Gmane