[ltk-user] PATCH a much better patch that works on 8.4 and 8.5
Johan Ur Riise
johan at riise-data.no
Sun Apr 27 18:44:00 UTC 2008
Here I leave activate-tile on the outside of the with-ltk form in
tile-test. In stead, I have deferred the renaming of widgets, using the
same technique as is used with require-tile, pushing a lambda to the
init hook. Works beautifully with tile-test on both tcl 8.4 and 8.5,
and also with my own application.
The "unless" in require-tile _could_ be a premature optimization, but it
could also be a hint to the next generation programmers that this is
only for an ancient wish, and could be removed.
So forget my last pathc, but the one adding ttk:: is needed
diff --git a/ltk-tile.lisp b/ltk-tile.lisp
index 0d8c39c..7fb9914 100644
--- a/ltk-tile.lisp
+++ b/ltk-tile.lisp
@@ -32,15 +32,21 @@
(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 [ttk::style theme names]")
--
1.5.4.3
More information about the ltk-user
mailing list