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

(defcfun cl-smoke-string-to-qstring :pointer
  (data :string)
  (length :int))

(defcfun cl-smoke-free-qstring :void
  (string :pointer))

(defcfun cl-smoke-qstring-to-byte-array :pointer
  (qstring :pointer))

;;; make sure, that you have configured slime correctly.
;;; e.g.:
;;; (string #\U9999) crashed slime for me. Adding
;;; (set-language-environment "UTF-8")
;;; (setq slime-net-coding-system 'utf-8-unix)
;;; to .emacs helps.
;;; Use emacs 23 for better unicode support.
(smoke:eval-startup (:compile-toplevel :execute)
  (qt:text-codec.set-codec-for-cstrings
   (qt:text-codec.codec-for-name (string *default-foreign-encoding*)))
  (qt:text-codec.set-codec-for-locale
   (qt:text-codec.codec-for-name (string *default-foreign-encoding*))))

(smoke:eval-startup (:compile-toplevel :execute)
  (let ((method (smoke::make-smoke-method-from-name (find-class 'qt:byte-array)
                                                    "constData")))
    (defmethod cxx:const-data ((array qt:byte-array))
      (values ;; Discharge second return value (length of string)
       (foreign-string-to-lisp (smoke::pointer-call method
                                                    (smoke::pointer array))
                               :count (cxx:size array))))))

(defun from-qstring (qstring)
  (cxx:const-data (make-instance 'qt:byte-array
                                 :pointer (cl-smoke-qstring-to-byte-array qstring))))

(define-to-lisp-translation ("QString" "const QString&")
    from-qstring cl-smoke-free-qstring)

(defun coerce-qstring (string)
  (make-cleanup-pointer
   (with-foreign-string ((data length) string :null-terminated-p nil)
     (cl-smoke-string-to-qstring data length))
   #'cl-smoke-free-qstring))

(define-from-lisp-translation ("const QString&" "QString") string
  coerce-qstring)

(defmethod print-object ((object qt:byte-array) stream)
  (if (null-pointer-p (pointer object))
      (call-next-method)
      (print-unreadable-object (object stream :type t :identity t)
        (when (smoke::const-p object)
          (princ "CONST " stream))
        (prin1 (cxx:const-data object) stream))))