From dherring at tentpost.com  Tue Feb  6 03:17:42 2007
From: dherring at tentpost.com (Daniel Herring)
Date: Mon, 5 Feb 2007 22:17:42 -0500 (EST)
Subject: [fetter-devel] Some Qt progress
In-Reply-To: <Pine.LNX.4.64.0701272021560.2786@strider1.home.net>
References: <Pine.LNX.4.64.0701230040430.4676@strider1.home.net>
	<d082aad0701231155t7eadb696rbcdd50175f9eaf56@mail.gmail.com>
	<oflkjsek8g.fsf@daphne.ted.ericsson.se>
	<Pine.LNX.4.64.0701260006580.2905@strider1.home.net>
	<Pine.LNX.4.64.0701272021560.2786@strider1.home.net>
Message-ID: <Pine.LNX.4.64.0701282329310.4180@strider1.home.net>

Well, I finally got Qt 4.2 "working".  It required some (dubious) hacks to 
verrazano, and I only tested one primitive example.  That said, here's 
what I did (using recent SVN versions of SBCL, CFFI, etc.).

Later,
Daniel


Here's the modifications to verrazano.

cffi-backend/types.lisp:19
+    ("long long unsigned int" . ":long")

frontend/parser.lisp:77
      (with-open-file (in path :direction :input :if-exists :supersede)
        (loop for line = (read-line in nil 'eof)
  	    until (eq line 'eof)
 	    do (if (and (not (equal "" line)) (eq #\# (char line 0)))
                    (push-end (split-sequence #\Space line) macs))))
      macs))


frontend/parser.lisp:228
(defun slot-from-xml (irelt slot xnode attr &optional default)
   (let ((value (get-element-attribute xnode attr)))
     (when (and value (subtypep (type-of default) 'integer))
       (setf value (parse-integer value)))
     ;; "fix" templated types and an instance of std::string
     (when (and value
                ;; these tests appear to have the same effect
                ;; the first is faster - the second, correct
                (eq slot 'name)
                ;(subtypep (type-of value) 'string)
                )
       (cond
         ((and (find #\< value) (find #\> value)) ; template syntax
          (setf value ":pointer"))
         ((string= "string" value) (setf value ":pointer"))
         )
       )
     (set-slot irelt slot value default)))


frontend/simplifier.lisp:164
(defun annotate-base-offsets (node)
   (when (composite-type? node)
     (let ((pbe (edge-to-primary-base node))
 	  (offset 0))
       (when (and pbe
                  (slot-exists-p (edge-target pbe) 'concrete-type-size))
         (incf offset (concrete-type-size (edge-target pbe))))
       (dolist (npbe (remove pbe (edges-to-bases node)))
 	(setf (extends-edge-offset npbe) offset)
 	(incf offset (concrete-type-size (edge-target npbe)))))))



Here's a minimal subset of my qt.binding file.

(defbinding "qt-library"
     (flags "-I/opt/qt4.2/include -DQT_SHARED -DQT_THREAD_SUPPORT")
     (nicknames "qt")
     (include
         "Qt/qapplication.h"
         "Qt/qstring.h"
         "Qt/qerrormessage.h"
         ))


Here's the test program.

(require 'asdf)
(require 'cffi)
(require 'verrazano-support)

(cffi:load-foreign-library "/opt/qt4.2/lib/libQtCore.so.4.2.0")
(cffi:load-foreign-library "/opt/qt4.2/lib/libQtGui.so.4.2.0")
(load "qt-library.lisp")

(defun make-QApplication (&rest args)
   (let ((argc (cffi:foreign-alloc :int :initial-element (length args)))
         (argv (cffi:foreign-alloc :string
                                   :initial-contents args
                                   :null-terminated-p t)))
     (qt:QApplication-new argc argv
                          (cffi:foreign-enum-value
                           'qt:qapplication-type :guiclient))))

(defun make-QString (message)
   (let ((string (cffi:foreign-alloc :pointer))
         (c-string (cffi:foreign-string-alloc message)))
     (setf (cffi:mem-ref string :pointer)
           (qt:QString-fromascii-helper c-string -1))
     string))

(defun make-QErrorMessage ()
   (qt:QErrorMessage-new (cffi:null-pointer)))

;;;; Simple Demo
;; setup
(defvar qapp (make-QApplication))
(defvar qstring (make-QString "Hello World!"))
(defvar error-message (make-QErrorMessage))

;; run this
(progn
   (qt:QErrorMessage-showmessage error-message qstring)
   (sb-int:with-float-traps-masked (:invalid :divide-by-zero)
     (qt:QApplication-exec)))