[ltk-user] patch to add ttk-state accessor

Jason Miller jason at milr.com
Tue Oct 15 22:41:18 UTC 2013


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
-------------- next part --------------
Index: ltk.lisp
===================================================================
--- ltk.lisp    (revision 265)
+++ ltk.lisp    (working copy)
@@ -425,7 +425,8 @@
            #:treeview-identify-item
            #:treeview-set-selection
            #:items
-           #:image))
+           #:image
+           #:ttk-state))
 
 (defpackage :ltk-user
   (:use :common-lisp :ltk))
@@ -5336,6 +5337,26 @@
          `(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*)
 
 



More information about the ltk-user mailing list