[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