[lgtk-cvs] CVS update: lgtk/src/gtkclasshierarchy.lisp

Mario Mommer mmommer at common-lisp.net
Thu May 13 20:05:13 UTC 2004


Update of /project/lgtk/cvsroot/lgtk/src
In directory common-lisp.net:/tmp/cvs-serv8875

Modified Files:
	gtkclasshierarchy.lisp 
Log Message:
Classnames are now given by strings. This is a preparation for using the
lgtk_object_type function.

Date: Thu May 13 16:05:12 2004
Author: mmommer

Index: lgtk/src/gtkclasshierarchy.lisp
diff -u lgtk/src/gtkclasshierarchy.lisp:1.4 lgtk/src/gtkclasshierarchy.lisp:1.5
--- lgtk/src/gtkclasshierarchy.lisp:1.4	Mon Nov 10 15:44:47 2003
+++ lgtk/src/gtkclasshierarchy.lisp	Thu May 13 16:05:12 2004
@@ -64,115 +64,119 @@
   (defun generate-class-hierarchy (base h)
     (let ((buf nil))
       (labels ((aux (h base)
-		    (push `(defclass ,(car h) (,base) ()) buf)
-		    (push `(def-capsule-filter ,(car h)) buf)
-		    (push `(export ',(car h)) buf)
-		    (push `(def-encapsulator ,(gencap (car h)) ,(car h)) buf)
-		    (push `(def-binding-type ,(car h)
-			     :in ',(car h)
-			     :out ',(gencap (car h))
-			     :alien '(* t)) buf)
-		    (mapcar #'(lambda (x) (aux x (car h))) (cdr h))))
+		    (let ((name-symbol (read-from-string (car h))))
+		      (push `(defclass ,name-symbol (,base) ()) buf)
+		      (push `(def-capsule-filter ,name-symbol) buf)
+		      (push `(export ',name-symbol) buf)
+		      (push `(def-encapsulator
+			       ,(gencap name-symbol)
+			       ,name-symbol) buf)
+		      (push `(def-binding-type ,name-symbol
+			       :in ',name-symbol
+			       :out ',(gencap name-symbol)
+			       :alien '(* t)) buf)
+		      (mapcar #'(lambda (x) (aux x name-symbol)) (cdr h)))))
 	(aux h base)
 	(let ((xxx (reverse buf)))
 	  xxx))))
 
+
   ;; We got this information as it is from the tutorial.
   (defmacro make-gtk-object-hierarchy ()
     `(progn    ;(eval-when (:compile-toplevel :load-toplevel :execute)
        ,@(generate-class-hierarchy
 	  'gtk-objcapsule
-	  '(GtkObject
-	    (GtkWidget
-	     (GtkMisc
-	      (GtkLabel
-	       (GtkAccelLabel))
-	      (GtkArrow)
-	      (GtkImage))
-	     (GtkContainer
-	      (GtkBin
-	       (GtkAlignment)
-	       (GtkFrame
-		(GtkAspectFrame))
-	       (GtkButton
-		(GtkToggleButton
-		 (GtkCheckButton
-		  (GtkRadioButton)))
-		(GtkOptionMenu))
-	       (GtkItem
-		(GtkMenuItem
-		 (GtkCheckMenuItem
-		  (GtkRadioMenuItem))
-		 (GtkImageMenuItem)
-		 (GtkSeparatorMenuItem)
-		 (GtkTearoffMenuItem)))
-	       (GtkWindow
-		(GtkDialog
-		 (GtkColorSelectionDialog)
-		 (GtkFileSelection)
-		 (GtkFontSelectionDialog)
-		 (GtkInputDialog)
-		 (GtkMessageDialog))
-		(GtkPlug))
-	       (GtkEventBox)
-	       (GtkHandleBox)
-	       (GtkScrolledWindow)
-	       (GtkViewport))
-	      (GtkBox
-	       (GtkButtonBox
-		(GtkHButtonBox)
-		(GtkVButtonBox))
-	       (GtkVBox
-		(GtkColorSelection)
-		(GtkFontSelection)
-		(GtkGammaCurve))
-	       (GtkHBox
-		(GtkCombo)
-		(GtkStatusbar)))
-	      (GtkFixed)
-	      (GtkPaned
-	       (GtkHPaned)
-	       (GtkVPaned))
-	      (GtkLayout)
-	      (GtkMenuShell
-	       (GtkMenuBar)
-	       (GtkMenu))
-	      (GtkNotebook)
-	      (GtkSocket)
-	      (GtkTable)
-	      (GtkTextView)
-	      (GtkToolbar)
-	      (GtkTreeView))
-	     (GtkCalendar)
-	     (GtkDrawingArea
-	      (GtkCurve))
-	     (GtkEditable
-	      (GtkEntry
-	       (GtkSpinButton)))
-	     (GtkRuler
-	      (GtkHRuler)
-	      (GtkVRuler))
-	     (GtkRange
-	      (GtkScale
-	       (GtkHScale)
-	       (GtkVScale))
-	      (GtkScrollbar
-	       (GtkHScrollbar)
-	       (GtkVScrollbar)))
-	     (GtkSeparator
-	      (GtkHSeparator)
-	      (GtkVSeparator))
-	     (GtkInvisible)
-	     (GtkPreview)
-	     (GtkProgressBar))
-	    (GtkAdjustment)
-	    (GtkCellRenderer
-	     (GtkCellRendererPixbuf)
-	     (GtkCellRendererText)
-	     (GtkCellRendererToggle))
-	    (GtkItemFactory)
-	    (GtkTooltips)
-	    (GtkTreeViewColumn)))))
+	  '("GtkObject"
+	    ("GtkWidget"
+	     ("GtkMisc"
+	      ("GtkLabel"
+	       ("GtkAccelLabel"))
+	      ("GtkArrow")
+	      ("GtkImage"))
+	     ("GtkContainer"
+	      ("GtkBin"
+	       ("GtkAlignment")
+	       ("GtkFrame"
+		("GtkAspectFrame"))
+	       ("GtkButton"
+		("GtkToggleButton"
+		 ("GtkCheckButton"
+		  ("GtkRadioButton")))
+		("GtkOptionMenu"))
+	       ("GtkItem"
+		("GtkMenuItem"
+		 ("GtkCheckMenuItem"
+		  ("GtkRadioMenuItem"))
+		 ("GtkImageMenuItem")
+		 ("GtkSeparatorMenuItem")
+		 ("GtkTearoffMenuItem")))
+	       ("GtkWindow"
+		("GtkDialog"
+		 ("GtkColorSelectionDialog")
+		 ("GtkFileSelection")
+		 ("GtkFontSelectionDialog")
+		 ("GtkInputDialog")
+		 ("GtkMessageDialog"))
+		("GtkPlug"))
+	       ("GtkEventBox")
+	       ("GtkHandleBox")
+	       ("GtkScrolledWindow")
+	       ("GtkViewport"))
+	      ("GtkBox"
+	       ("GtkButtonBox"
+		("GtkHButtonBox")
+		("GtkVButtonBox"))
+	       ("GtkVBox"
+		("GtkColorSelection")
+		("GtkFontSelection")
+		("GtkGammaCurve"))
+	       ("GtkHBox"
+		("GtkCombo")
+		("GtkStatusbar")))
+	      ("GtkFixed")
+	      ("GtkPaned"
+	       ("GtkHPaned")
+	       ("GtkVPaned"))
+	      ("GtkLayout")
+	      ("GtkMenuShell"
+	       ("GtkMenuBar")
+	       ("GtkMenu"))
+	      ("GtkNotebook")
+	      ("GtkSocket")
+	      ("GtkTable")
+	      ("GtkTextView")
+	      ("GtkToolbar")
+	      ("GtkTreeView"))
+	     ("GtkCalendar")
+	     ("GtkDrawingArea"
+	      ("GtkCurve"))
+	     ("GtkEditable"
+	      ("GtkEntry"
+	       ("GtkSpinButton")))
+	     ("GtkRuler"
+	      ("GtkHRuler")
+	      ("GtkVRuler"))
+	     ("GtkRange"
+	      ("GtkScale"
+	       ("GtkHScale")
+	       ("GtkVScale"))
+	      ("GtkScrollbar"
+	       ("GtkHScrollbar")
+	       ("GtkVScrollbar")))
+	     ("GtkSeparator"
+	      ("GtkHSeparator")
+	      ("GtkVSeparator"))
+	     ("GtkInvisible")
+	     ("GtkPreview")
+	     ("GtkProgressBar"))
+	    ("GtkAdjustment")
+	    ("GtkCellRenderer"
+	     ("GtkCellRendererPixbuf")
+	     ("GtkCellRendererText")
+	     ("GtkCellRendererToggle"))
+	    ("GtkItemFactory")
+	    ("GtkTooltips")
+	    ("GtkTreeViewColumn")))))
 
   ;; engage.
   (make-gtk-object-hierarchy))





More information about the Lgtk-cvs mailing list