From 6dfb20397142408cc4adfa437bb12d8aa300270e Mon Sep 17 00:00:00 2001 Message-Id: <6dfb20397142408cc4adfa437bb12d8aa300270e.1714083648.git.mdw@distorted.org.uk> From: Mark Wooding Date: Tue, 8 Jun 2010 11:43:53 +0100 Subject: [PATCH 1/1] Fix compilation for Gtk with the new, stricter inheritance rules. Also, change the prefix lookup so that it's possible to bind "GtkClutterFoo", without it landing in :gtk. Organization: Straylight/Edgeware From: Rupert Swarbrick --- gffi/interface.lisp | 20 ++++++++++++-------- gtk/gtktypes.lisp | 5 +++++ 2 files changed, 17 insertions(+), 8 deletions(-) diff --git a/gffi/interface.lisp b/gffi/interface.lisp index 084ed47..d89e9a7 100644 --- a/gffi/interface.lisp +++ b/gffi/interface.lisp @@ -72,15 +72,19 @@ (defun default-alien-type-name (type-name) #'string-capitalize (cons prefix (split-string (symbol-name type-name) :delimiter #\-)))))) -(defun default-type-name (alien-name) - (let ((parts - (mapcar - #'string-upcase - (split-string-if alien-name #'upper-case-p)))) - (intern - (concatenate-strings (rest parts) #\-) - (find-prefix-package (first parts))))) +(defun split-alien-name (alien-name) + (let ((parts (split-string-if alien-name #'upper-case-p))) + (do ((prefix (first parts) (concatenate 'string prefix (first rest))) + (rest (rest parts) (cdr rest))) + ((null rest) + (error "Couldn't split alien name '~A' to find a registered prefix" + alien-name)) + (when (find-prefix-package prefix) + (return (values (string-upcase (concatenate-strings rest #\-)) + (find-prefix-package prefix))))))) +(defun default-type-name (alien-name) + (multiple-value-call #'intern (split-alien-name alien-name))) (defun in-arg-p (style) (find style '(:in :in/out :in/return :in-out :return))) diff --git a/gtk/gtktypes.lisp b/gtk/gtktypes.lisp index dfa9c05..1155977 100644 --- a/gtk/gtktypes.lisp +++ b/gtk/gtktypes.lisp @@ -145,6 +145,11 @@ (define-type-method reader-function ((type position) &optional ref) (declare (ignore type ref)) (reader-function 'int)) +;; Register GtkObject in advance so that eg GtkTooltips, which inherits from it, +;; gets a proper supertype. TODO: This is a hack. Where is it supposed to +;; happen? +(register-type '%object "GtkObject") + (define-types-by-introspection "Gtk" ;; Manually defined ("GtkObject" :ignore t) -- [mdw]