Index: ltk.lisp
===================================================================
--- ltk.lisp	(revision 265)
+++ ltk.lisp	(working copy)
@@ -1115,6 +1115,29 @@
   (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)
@@ -1397,7 +1420,7 @@
       (disabledforeground disabledforeground "~@[ -disabledforeground ~(~a~)~]" disabledforeground "")
       (elementborderwidth elementborderwidth "~@[ -elementborderwidth ~(~a~)~]" elementborderwidth "")
       (exportselection exportselection "~@[ -exportselection ~(~a~)~]" exportselection "")
-      (font font "~@[ -font {~a}~]" font "font to use to display text on the widget")
+      (font font "~@[ -font ~/ltk:esc/~]" font "font to use to display text on the widget")
       (foreground foreground "~@[ -foreground ~(~a~)~]" foreground "foreground color of the widget")
       (format format "~@[ -format ~(~a~)~]" format "")
       (from from "~@[ -from ~(~a~)~]" from "")
@@ -1500,7 +1523,7 @@
       (value value "~@[ -value ~(~a~)~]" value "")
       (value-radio-button nil "~@[ -value ~(~a~)~]" (radio-button-value widget)
        "value for the radio button group to take, when the button is selected")
-      (values values "~@[ -values {~{{~a}~^ ~}}~]" values "")
+      (values values "~@[ -values [list ~{~/ltk:esc/~^ ~}]~]" values "")
       (variable variable "~@[ -variable ~(~a~)~]" variable "name of the variable associated with the widget")
       (variable-radio-button nil "~@[ -variable ~(~a~)~]" (radio-button-variable widget)
        "name of the radio button group the button shall belong to as a string")
@@ -1798,7 +1821,7 @@
   (read-data))
 
 (defun clipboard-append (txt)
-  (format-wish "clipboard append {~a}" txt))
+  (format-wish "clipboard append ~/ltk:esc/" txt))
 
 ;; around - initializer
 
@@ -1924,7 +1947,7 @@
 
 (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 ()
@@ -1975,7 +1998,7 @@
     (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~@[ -underline ~a ~]"
+    (format-wish "~A add cascade -label ~/ltk:esc/ -menu ~a~@[ -underline ~a ~]"
                  (widget-path (master m)) (text m) (widget-path m) underline)))
 
 (defun make-menu(menu text &key underline name (tearoff 0))
@@ -2008,7 +2031,7 @@
 (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}~@[ -underline ~a ~]~@[ -accelerator {~a} ~]~@[ -state ~(~a~)~]"
+  (format-wish "~A add command -label ~/ltk:esc/  -command {callback ~A}~@[ -underline ~a ~]~@[ -accelerator ~/ltk:esc/ ~]~@[ -state ~(~a~)~]"
                (widget-path (master m)) (text m) (name m) underline accelerator state))
 
 (defun make-menubutton(menu text command &key underline accelerator state)
@@ -2022,7 +2045,7 @@
 (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 ~@[ -command {callback ~a}~]"
+  (format-wish "~A add checkbutton -label ~/ltk:esc/ -variable ~a ~@[ -command {callback ~a}~]"
 	       (widget-path (master m)) (text m) (name m) (and (command m) (name m))))
 
 (defmethod value ((cb menucheckbutton))
@@ -2043,7 +2066,7 @@
   (unless (group m)
     (setf (group m)
 	  (name m)))
-  (format-wish "~A add radiobutton -label {~A} -value ~a -variable ~a ~@[ -command {callback ~a}~]"
+  (format-wish "~A add radiobutton -label ~/ltk:esc/ -value ~a -variable ~a ~@[ -command {callback ~a}~]"
                (widget-path (master m)) (text m) (name m) (group m)
                (and (command m) (name m))))
 
@@ -2153,7 +2176,7 @@
 
 #-: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
@@ -2213,7 +2236,7 @@
 (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
@@ -2288,8 +2311,8 @@
 (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))
@@ -2322,8 +2345,8 @@
 (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))
@@ -2377,11 +2400,11 @@
 
 (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))
@@ -2728,11 +2751,11 @@
   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))
@@ -2755,16 +2778,16 @@
 
 (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))
@@ -2817,9 +2840,9 @@
                   (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)
@@ -2898,7 +2921,7 @@
 
 (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)))
 
 
 
@@ -3229,13 +3252,13 @@
          (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))
         ))))
 
@@ -3268,7 +3291,7 @@
              (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))
@@ -3410,13 +3433,13 @@
   (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)
 
@@ -3424,7 +3447,7 @@
 (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
@@ -3452,7 +3475,7 @@
 (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))
@@ -3531,17 +3554,17 @@
 
 (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))
@@ -3568,7 +3591,7 @@
 
 (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)
@@ -3591,7 +3614,7 @@
 
 ;;; 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))
@@ -3619,7 +3642,7 @@
 (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
@@ -3628,7 +3651,7 @@
 
 ;;; 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))
@@ -3707,7 +3730,7 @@
 
 (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
@@ -3937,7 +3960,7 @@
 ;;; Dialog functions
 
 (defun choose-color (&key parent title initialcolor )
-  (format-wish "senddatastring [tk_chooseColor ~@[ -parent ~A~]~@[ -title {~A}~]~@[ -initialcolor {~A}~]]" (when parent (widget-path parent)) title initialcolor)
+  (format-wish "senddatastring [tk_chooseColor ~@[ -parent ~A~]~@[ -title ~/ltk:esc/~]~@[ -initialcolor ~/ltk:esc/~]]" (when parent (widget-path parent)) title initialcolor)
   (read-data))
 
 (defun get-open-file (&key (filetypes '(("All Files" "*")))
@@ -3945,21 +3968,21 @@
 			   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 ~@[ -initialdir {~a}~] -multiple 1 ~
-                      ~@[ -parent ~a~] ~@[ -title {~a}~]]"
+                      -filetypes ~a ~@[ -initialdir ~/ltk:esc/~] -multiple 1 ~
+                      ~@[ -parent ~a~] ~@[ -title ~/ltk:esc/~]]"
 		      files initialdir 
 		      (and parent (widget-path parent)) title)
 	(format-wish "senddatastring [tk_getOpenFile ~
-                      -filetypes ~a ~@[ -initialdir {~a}~]  ~
-                      ~@[ -parent ~a~] ~@[ -title {~a}~]]"
+                      -filetypes ~a ~@[ -initialdir ~/ltk:esc/~]  ~
+                      ~@[ -parent ~a~] ~@[ -title ~/ltk:esc/~]]"
 		      files initialdir 
 		      (and parent (widget-path parent)) title))
     (read-data)))
@@ -3967,18 +3990,18 @@
 (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 ~@[ -initialdir \"~a\"~]~@[ -parent ~a ~]~@[ -title {~a}~]~@[ -mustexist ~a~]]" (tkescape2 initialdir) (and parent (widget-path parent)) title (and mustexist 1))
+  (format-wish "senddatastring [tk_chooseDirectory ~@[ -initialdir \"~a\"~]~@[ -parent ~a ~]~@[ -title ~/ltk:esc/~]~@[ -mustexist ~a~]]" (tkescape2 initialdir) (and parent (widget-path parent)) title (and mustexist 1))
   (read-data))
 
 (defvar *mb-icons* (list "error" "info" "question" "warning")
@@ -3987,7 +4010,7 @@
 ;;; 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~)~@[ -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~)~@[ -parent ~a~]]" (tkescape2 message) title type icon (and parent (widget-path parent)))
   (read-keyword))
 
 
@@ -4053,7 +4076,7 @@
    (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)