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

(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)))))