chiark / gitweb /
Initial checkin
authorespen <espen>
Sun, 20 Jan 2002 14:03:59 +0000 (14:03 +0000)
committerespen <espen>
Sun, 20 Jan 2002 14:03:59 +0000 (14:03 +0000)
atk/atk-export.lisp [new file with mode: 0644]
atk/atk-package.lisp [new file with mode: 0644]
atk/atk.lisp [new file with mode: 0644]
glib/ginterface.lisp [new file with mode: 0644]

diff --git a/atk/atk-export.lisp b/atk/atk-export.lisp
new file mode 100644 (file)
index 0000000..f1a0c93
--- /dev/null
@@ -0,0 +1,4 @@
+(in-package "ATK")
+
+;;; Autogenerating exported symbols
+(export-from-file #p"clg:atk;atk.lisp")
diff --git a/atk/atk-package.lisp b/atk/atk-package.lisp
new file mode 100644 (file)
index 0000000..87e7c3d
--- /dev/null
@@ -0,0 +1,6 @@
+(defpackage "ATK"
+  (:use "GLIB" "COMMON-LISP" "AUTOEXPORT")
+  (:shadowing-import-from "PCL"
+   "CLASS-NAME" "CLASS-OF" "FIND-CLASS"))
+
+
diff --git a/atk/atk.lisp b/atk/atk.lisp
new file mode 100644 (file)
index 0000000..98d7542
--- /dev/null
@@ -0,0 +1,25 @@
+;; Common Lisp bindings for GTK+ v2.0
+;; Copyright (C) 2001 Espen S. Johnsen <espen@users.sourceforge.net>
+;;
+;; This library is free software; you can redistribute it and/or
+;; modify it under the terms of the GNU Lesser General Public
+;; License as published by the Free Software Foundation; either
+;; version 2 of the License, or (at your option) any later version.
+;;
+;; This library is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;; Lesser General Public License for more details.
+;;
+;; You should have received a copy of the GNU Lesser General Public
+;; License along with this library; if not, write to the Free Software
+;; Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+;; $Id: atk.lisp,v 1.1 2002-01-20 14:03:59 espen Exp $
+
+(in-package "ATK")
+
+(eval-when (:compile-toplevel :load-toplevel :execute)
+  (init-types-in-library "libatk.so")
+
+  (define-types-by-introspection "Atk"))
diff --git a/glib/ginterface.lisp b/glib/ginterface.lisp
new file mode 100644 (file)
index 0000000..ca61631
--- /dev/null
@@ -0,0 +1,80 @@
+;; Common Lisp bindings for GTK+ v2.0
+;; Copyright (C) 2001 Espen S. Johnsen <espen@users.sourceforge.net>
+;;
+;; This library is free software; you can redistribute it and/or
+;; modify it under the terms of the GNU Lesser General Public
+;; License as published by the Free Software Foundation; either
+;; version 2 of the License, or (at your option) any later version.
+;;
+;; This library is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;; Lesser General Public License for more details.
+;;
+;; You should have received a copy of the GNU Lesser General Public
+;; License along with this library; if not, write to the Free Software
+;; Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+;; $Id: ginterface.lisp,v 1.1 2002-01-20 14:05:27 espen Exp $
+
+(in-package "GLIB")
+
+(use-prefix "g")
+
+;;;; 
+
+(defclass ginterface ())
+
+(deftype-method translate-type-spec ginterface (type-spec)
+  (declare (ignore type-spec))
+  (translate-type-spec 'gobject))
+
+(deftype-method size-of ginterface (type-spec)
+  (declare (ignore type-spec))
+  (size-of 'gobject))
+
+(deftype-method translate-from-alien
+    ginterface (type-spec location &optional weak-ref)
+  (declare (ignore type-spec))
+  (translate-from-alien 'gobject location weak-ref))
+
+(deftype-method translate-to-alien
+    ginterface (type-spec instance &optional weak-ref)
+  (declare (ignore type-spec))
+  (translate-to-alien 'gobject instance weak-ref))
+
+
+
+;;;; Metaclass for interfaces
+
+(eval-when (:compile-toplevel :load-toplevel :execute)
+  (defclass ginterface-class (pcl::standard-class)))
+
+
+(defmethod shared-initialize ((class ginterface-class) names
+                             &rest initargs &key name alien-name)
+  (declare (ignore initargs names))
+  (let* ((class-name (or name (class-name class)))
+        (type-number
+         (find-type-number
+          (or (first alien-name) (default-alien-type-name class-name)) t)))
+    (register-type class-name type-number))
+  (call-next-method))
+
+
+(defmethod validate-superclass
+    ((class ginterface-class) (super pcl::standard-class))
+  (subtypep (class-name super) 'ginterface))
+
+
+;;;;
+
+(defun expand-ginterface-type (type-number &rest args)
+  (declare (ignore args))
+  `(defclass ,(type-from-number type-number) (ginterface)
+     ()
+     (:metaclass ginterface-class)
+     (:alien-name ,(find-type-name type-number))))
+
+
+(register-derivable-type 'ginterface "GInterface" 'expand-ginterface-type)