[ltk-user] PATCH: fix tile namespace problem and widget renaming for 8.5 in one patch

Johan Ur Riise johan at riise-data.no
Sun Apr 27 19:09:23 UTC 2008


If you like, Ignore my other patches from today an apply this.
This  can be applied to ltk-0.91

johan at perle:~/prg/ltk$ git diff 0607d45dda260283ed3e85fffe44efe5a890de33
diff --git a/ltk-tile.lisp b/ltk-tile.lisp
index 559e8da..7fb9914 100644
--- a/ltk-tile.lisp
+++ b/ltk-tile.lisp
@@ -32,29 +32,35 @@
 (defparameter *tile-widgets* '(button check-button entry label radio-button scrollbar  ))
 ;;; checkbutton combobox dialog notebook paned progressbar treeview menubutton separator
 
+(defun tclversion ()
+  (send-wish "senddatastrings [info tclversion]")
+  (read-from-string (first (ltk::read-data))))
+
 (defun require-tile ()
-  (send-wish "package require tile"))
+  (unless (> (tclversion) 8.4) 
+    (send-wish "package require tile")))
 
 (defun activate-tile ()
   (pushnew #'require-tile *init-wish-hook*)
-  (dolist (widget *tile-widgets*)
-    (let ((w (make-instance widget)))
-      (unless (search "ttk::" (widget-class-name w))
-       (setf (widget-class-name w) (concatenate 'string "ttk::" (widget-class-name w)))))))
+  (pushnew (lambda () (dolist (widget *tile-widgets*)
+                        (let ((w (make-instance widget)))
+                          (unless (search "ttk::" (widget-class-name w))
+                            (setf (widget-class-name w) (concatenate 'string "ttk::" (widget-class-name w)))))))
+           *init-wish-hook*))
 
 (defun theme-names ()
-  (send-wish "senddatastrings [style theme names]")
+  (send-wish "senddatastrings [ttk::style theme names]")
   (ltk::read-data))
 
 (defun use-theme(name)
-  (format-wish "style theme use ~a" name))
+  (format-wish "ttk::style theme use ~a" name))
 
 (defun style-element-names ()
-  (send-wish "senddatastrings [style element names]")
+  (send-wish "senddatastrings [ttk::style element names]")
   (ltk::read-data))
 
 (defun style-default (style &rest params)
-  (format-wish "style default ~A ~{ -~(~a~) {~a}~}" style params))
+  (format-wish "ttk::style default ~A ~{ -~(~a~) {~a}~}" style params))
 
 (defun tile-test ()
   (activate-tile)
@@ -72,5 +78,3 @@
                                           (use-theme theme)))))
        )))
 
-            
-       
\ No newline at end of file
johan at perle:~/prg/ltk$ 



More information about the ltk-user mailing list