Sun Jan 10 09:52:49 CET 2010 Tobias Rautenkranz <tobias@rautenkranz.ch>

* Split up in qt.gui & cleanup name prefix.

--- old-qt.gui/src/properties.lisp 2014-10-30 07:42:25.000000000 +0100

+++ new-qt.gui/src/properties.lisp 1970-01-01 01:00:00.000000000 +0100

@@ -1,97 +0,0 @@

-(in-package :cl-smoke.qt-impl)

-

-(defun reverse-lispify (symbol)

- "Converts the name of symbol to C++ style."

- (if (eq (symbol-package symbol)

- (find-package :keyword))

- (smoke::lisp-to-cxx (symbol-name symbol))

- (concatenate 'string

- (package-name (symbol-package symbol))

- "::"

- (symbol-name symbol))))

-

-(defun property-package (name)

- (let ((package-end (search "::" name)))

- (if package-end

- (values

- (find-package (intern (subseq name 0 package-end) :keyword))

- (+ 2 package-end))

- (values (find-package :keyword) 0))))

-

-(defun lispify-property-name (name)

- (multiple-value-bind (package name-start)

- (property-package name)

- (if (= 0 name-start)

- (smoke::lispify name package)

- (intern (subseq name name-start) package))))

-

-(defun property-name (name)

- "The property name is a string or a to camelCase converted symbol."

- (typecase name

- (string name)

- (symbol (reverse-lispify name))))

-

-(defun qt:property (object name)

- "Returns the property NAME of OBJECT."

- (declare (type qt:object object)

- (type (or string symbol) name))

- (assert (qt:property-p object name)

- (object name)

- "~A has no property ~A." object name)

- (qt:from-variant (cxx:property object (property-name name))))

-

-(defun (setf qt:property) (new-value object name)

- (declare (type qt:object object)

- (type (or string symbol) name))

- (cxx:set-property object (property-name name)

- (make-instance 'qt:variant :arg0 new-value))

- new-value)

-

-(defun qt:remove-property (object name)

- "Removes the property NAME from OBJECT."

- (declare (type qt:object object)

- (type (or string symbol) name))

- (setf (qt:property object name) (qt:make-variant)))

-

-(defun qt:property-p (object name)

- "Returns T when NAME is a property of OBJECT and NIL otherwise."

- (declare (type qt:object object)

- (type (or string symbol) name))

- (qt:variant-boundp (cxx:property object (property-name name))))

-

-(defun meta-object-properties (meta-object &optional (all t))

- "Returns a list of the properties of META-OBJECT."

- (loop for index from (if all 0 (cxx:property-offset meta-object))

- below (cxx:property-count meta-object)

- collect (lispify-property-name (cxx:name (cxx:property meta-object index)))))

-

-(defun sort-symbols (symbols)

- (sort symbols

- #'(lambda (a b)

- (string<= (write-to-string a) (write-to-string b)))))

-

-(defgeneric qt:class-properties (class)

- (:documentation "Returns a list of the properties of CLASS.")

- (:method ((class class))

- (sort-symbols

- (meta-object-properties (cxx:static-meta-object class))))

- (:method ((symbol symbol))

- (qt:class-properties (find-class symbol))))

-

-(defgeneric qt:class-direct-properties (class)

- (:documentation "Returns a list of the properties of CLASS.")

- (:method ((class class))

- (meta-object-properties (cxx:static-meta-object class) nil))

- (:method ((symbol symbol))

- (qt:class-direct-properties (find-class symbol))))

-

-(defun dynamic-properties (object)

- (map 'list (compose #'lispify-property-name #'cxx:data)

- (cxx:dynamic-property-names object)))

-

-(defun qt:properties (object)

- "Returns a list of the properties of OBJECT."

- (declare (type qt:object object))

- (sort-symbols

- (nconc (dynamic-properties object)

- (meta-object-properties (cxx:meta-object object)))))