1 (in-package :cl-smoke.qt.core)
3 (defun reverse-lispify (symbol)
4 "Converts the name of symbol to C++ style."
5 (if (eq (symbol-package symbol)
6 (find-package :keyword))
7 (smoke::lisp-to-cxx (symbol-name symbol))
9 (package-name (symbol-package symbol))
11 (symbol-name symbol))))
13 (defun property-package (name)
14 (let ((package-end (search "::" name)))
17 (find-package (intern (subseq name 0 package-end) :keyword))
19 (values (find-package :keyword) 0))))
21 (defun lispify-property-name (name)
22 (multiple-value-bind (package name-start)
23 (property-package name)
25 (smoke::lispify name package)
26 (intern (subseq name name-start) package))))
28 (defun property-name (name)
29 "The property name is a string or a to camelCase converted symbol."
32 (symbol (reverse-lispify name))))
34 (defun qt:property (object name)
35 "Returns the property NAME of OBJECT."
36 (declare (type qt:object object)
37 (type (or string symbol) name))
38 (assert (qt:property-p object name)
40 "~A has no property ~A." object name)
41 (qt:from-variant (cxx:property object (property-name name))))
43 (defun (setf qt:property) (new-value object name)
44 (declare (type qt:object object)
45 (type (or string symbol) name))
46 (cxx:set-property object (property-name name)
47 (make-instance 'qt:variant :arg0 new-value))
50 (defun qt:remove-property (object name)
51 "Removes the property NAME from OBJECT."
52 (declare (type qt:object object)
53 (type (or string symbol) name))
54 (setf (qt:property object name) (qt:make-variant)))
56 (defun qt:property-p (object name)
57 "Returns T when NAME is a property of OBJECT and NIL otherwise."
58 (declare (type qt:object object)
59 (type (or string symbol) name))
60 (qt:variant-boundp (cxx:property object (property-name name))))
62 (defun meta-object-properties (meta-object &optional (all t))
63 "Returns a list of the properties of META-OBJECT."
64 (loop for index from (if all 0 (cxx:property-offset meta-object))
65 below (cxx:property-count meta-object)
66 collect (lispify-property-name (cxx:name (cxx:property meta-object index)))))
68 (defun sort-symbols (symbols)
71 (string<= (write-to-string a) (write-to-string b)))))
73 (defgeneric qt:class-properties (class)
74 (:documentation "Returns a list of the properties of CLASS.")
75 (:method ((class class))
77 (meta-object-properties (cxx:static-meta-object class))))
78 (:method ((symbol symbol))
79 (qt:class-properties (find-class symbol))))
81 (defgeneric qt:class-direct-properties (class)
82 (:documentation "Returns a list of the properties of CLASS.")
83 (:method ((class class))
84 (meta-object-properties (cxx:static-meta-object class) nil))
85 (:method ((symbol symbol))
86 (qt:class-direct-properties (find-class symbol))))
88 (defun dynamic-properties (object)
89 (map 'list (compose #'lispify-property-name #'cxx:data)
90 (cxx:dynamic-property-names object)))
92 (defun qt:properties (object)
93 "Returns a list of the properties of OBJECT."
94 (declare (type qt:object object))
96 (nconc (dynamic-properties object)
97 (meta-object-properties (cxx:meta-object object)))))