Split up in qt.core.
Annotate for file /src/properties.lisp
2010-01-10 tobias 1 (in-package :cl-smoke.qt.core)
2009-04-05 tobias 2
17:56:16 ' 3 (defun reverse-lispify (symbol)
' 4 "Converts the name of symbol to C++ style."
2009-07-22 tobias 5 (if (eq (symbol-package symbol)
22:21:01 ' 6 (find-package :keyword))
' 7 (smoke::lisp-to-cxx (symbol-name symbol))
' 8 (concatenate 'string
' 9 (package-name (symbol-package symbol))
' 10 "::"
' 11 (symbol-name symbol))))
' 12
' 13 (defun property-package (name)
' 14 (let ((package-end (search "::" name)))
' 15 (if package-end
' 16 (values
' 17 (find-package (intern (subseq name 0 package-end) :keyword))
' 18 (+ 2 package-end))
' 19 (values (find-package :keyword) 0))))
' 20
' 21 (defun lispify-property-name (name)
' 22 (multiple-value-bind (package name-start)
' 23 (property-package name)
' 24 (if (= 0 name-start)
' 25 (smoke::lispify name package)
' 26 (intern (subseq name name-start) package))))
2009-04-05 tobias 27
17:56:16 ' 28 (defun property-name (name)
' 29 "The property name is a string or a to camelCase converted symbol."
' 30 (typecase name
' 31 (string name)
' 32 (symbol (reverse-lispify name))))
' 33
2009-06-11 tobias 34 (defun qt:property (object name)
2009-04-05 tobias 35 "Returns the property NAME of OBJECT."
2009-07-22 tobias 36 (declare (type qt:object object)
22:21:01 ' 37 (type (or string symbol) name))
' 38 (assert (qt:property-p object name)
' 39 (object name)
' 40 "~A has no property ~A." object name)
2009-06-11 tobias 41 (qt:from-variant (cxx:property object (property-name name))))
2009-04-05 tobias 42
2009-06-11 tobias 43 (defun (setf qt:property) (new-value object name)
2009-07-22 tobias 44 (declare (type qt:object object)
22:21:01 ' 45 (type (or string symbol) name))
' 46 (cxx:set-property object (property-name name)
' 47 (make-instance 'qt:variant :arg0 new-value))
2009-04-05 tobias 48 new-value)
17:56:16 ' 49
2009-06-11 tobias 50 (defun qt:remove-property (object name)
2009-05-31 tobias 51 "Removes the property NAME from OBJECT."
2009-07-22 tobias 52 (declare (type qt:object object)
22:21:01 ' 53 (type (or string symbol) name))
2009-06-11 tobias 54 (setf (qt:property object name) (qt:make-variant)))
2009-05-31 tobias 55
2009-06-11 tobias 56 (defun qt:property-p (object name)
2009-04-05 tobias 57 "Returns T when NAME is a property of OBJECT and NIL otherwise."
2009-07-22 tobias 58 (declare (type qt:object object)
22:21:01 ' 59 (type (or string symbol) name))
2009-06-11 tobias 60 (qt:variant-boundp (cxx:property object (property-name name))))
2009-04-05 tobias 61
17:56:16 ' 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)
2009-07-22 tobias 66 collect (lispify-property-name (cxx:name (cxx:property meta-object index)))))
22:21:01 ' 67
' 68 (defun sort-symbols (symbols)
' 69 (sort symbols
' 70 #'(lambda (a b)
' 71 (string<= (write-to-string a) (write-to-string b)))))
2009-04-05 tobias 72
2009-06-11 tobias 73 (defgeneric qt:class-properties (class)
2009-04-05 tobias 74 (:documentation "Returns a list of the properties of CLASS.")
17:56:16 ' 75 (:method ((class class))
2009-07-22 tobias 76 (sort-symbols
22:21:01 ' 77 (meta-object-properties (cxx:static-meta-object class))))
2009-04-05 tobias 78 (:method ((symbol symbol))
2009-06-11 tobias 79 (qt:class-properties (find-class symbol))))
2009-04-05 tobias 80
2009-06-11 tobias 81 (defgeneric qt:class-direct-properties (class)
2009-04-05 tobias 82 (:documentation "Returns a list of the properties of CLASS.")
17:56:16 ' 83 (:method ((class class))
' 84 (meta-object-properties (cxx:static-meta-object class) nil))
' 85 (:method ((symbol symbol))
2009-06-11 tobias 86 (qt:class-direct-properties (find-class symbol))))
2009-04-05 tobias 87
2009-05-27 tobias 88 (defun dynamic-properties (object)
2009-07-22 tobias 89 (map 'list (compose #'lispify-property-name #'cxx:data)
2009-05-27 tobias 90 (cxx:dynamic-property-names object)))
17:18:41 ' 91
2009-06-11 tobias 92 (defun qt:properties (object)
2009-04-05 tobias 93 "Returns a list of the properties of OBJECT."
2009-07-22 tobias 94 (declare (type qt:object object))
22:21:01 ' 95 (sort-symbols
' 96 (nconc (dynamic-properties object)
' 97 (meta-object-properties (cxx:meta-object object)))))