Re: [gtk-list] Re: GTK modula-3 bindings

[Vollmer Marius <mvo zagadka ping de>]

"Daniel Solaz" <dsolaz@sistelcom.com> writes:

> GTK is an object oriented system, but I didn't see a tree showing the
> structure of the hierarchy of classes.

Yes, gtk.defs contains info about the class hierachy as well.  I think
it hasn't been used for anything yet, so there are some types in it.

Here it is for an not-at-all-upto-date gtk.defs:

    |
    \-GtkObject
      |
      +-GtkData
      | |
      | +-GtkAdjustment
      | |
      | \-GtkTooltips
      |
      \-GtkWidget
	|
	+-GtkRange
	| |
	| +-GtkScrollbar
	| | |
	| | +-GtkVScrollbar
	| | |
	| | \-GtkHScrollbar
	| |
	| \-GtkScale
	|   |
	|   +-GtkVScale
	|   |
	|   \-GtkHScale
	|
	+-GtkDrawingArea
	|
	+-GtkPreview
	|
	+-GtkText
	|
	+-GtkEntry
	|
	+-GtkProgressBar
	|
	+-GtkSeparator
	| |
	| +-GtkVSeparator
	| |
	| \-GtkHSeparator
	|
	+-GtkMisc
	| |
	| +-GtkPixmap
	| |
	| \-GtkLabel
	|
	\-GtkContainer
	  |
	  +-GtkTree
	  |
	  +-GtkPaned
	  | |
	  | +-GtkVPaned
	  | |
	  | \-GtkHPaned
	  |
	  +-GtkNotebook
	  |
	  +-GtkList
	  |
	  +-GtkScrolledWindow
	  |
	  +-GtkMenuShell
	  | |
	  | +-GtkMenu
	  | |
	  | \-GtkMenuBar
	  |
	  +-GtkButton
	  | |
	  | +-GtkOptionMenu
	  | |
	  | \-GtkToggleButton
	  |   |
	  |   \-GtkCheckButton
	  |     |
	  |     \-GtkRadioButton
	  |
	  +-GtkTable
	  |
	  +-GtkBox
	  | |
	  | +-GtkHBox
	  | |
	  | \-GtkVBox
	  |   |
	  |   \-GtkColorSelection
	  |
	  \-GtkBin
	    |
	    +-GtkEventBox
	    |
	    +-GtkAlignment
	    |
	    +-GtkItem
	    | |
	    | +-GtkTreeItem
	    | |
	    | +-GtkListItem
	    | |
	    | \-GtkMenuItem
	    |   |
	    |   \-GtkCheckMenuItem
	    |     |
	    |     \-GtkRadioMenuItem
	    |
	    +-GtkFrame
	    |
	    \-GtkWindow
	      |
	      +-GtkDialog
	      |
	      +-GtkColorSelectionDialog
	      |
	      \-GtkFileSelection

Here is the code used to produce this picture (I leave it as an
exercise to put this into a nice GtkTree widget):

#! /bin/sh
# -*- scheme -*-
exec guile -s $0 $*
!#

(use-modules (mini-format) (ice-9 common-list))

(define (read-file name)
  (with-input-from-file name
    (lambda ()
      (let loop ((res '())
		 (obj (read)))
	(if (eof-object? obj)
	    (reverse res)
	    (loop (cons obj res) (read)))))))

(define (@ fmt . args)
  (apply mini-format #t fmt args)
  (newline))

(define (make-type name)
  (cons name '()))

(define type-name car)
(define type-derived cdr)
(define (type-add-derived t d) (set-cdr! t (cons d (cdr t))))

(define types '())
(define base-types '())
(define (find-type name)
  (or (assq name types) (error "no such type" name)))

(define (register-type name bases)
  (let ((t (make-type name)))
    (if (not (null? bases))
	(let ((b (find-type (car bases))))
	  (type-add-derived b t))
	(set! base-types (cons t base-types)))
    (set! types (cons t types))))

(define (emit-type-hierarchy)
  (define (emit-node-list p nl)
    (if (not (null? nl))
	(let ((n (car nl))
	      (nl (cdr nl)))
	  (@ "~a|" p)
	  (@ "~a~a~a" p (if (null? nl) "\\-" "+-") (type-name n))
	  (let ((p (string-append p (if (null? nl) "  " "| "))))
	    (emit-node-list p (type-derived n)))
	  (emit-node-list p nl))))
  (emit-node-list "" base-types))

(register-type 'GtkObject '())
(define forms (read-file (cadr (command-line))))
(for-each (lambda (f)
	    (cond ((and (pair? f) (eq? 'define-object (car f)))
		   (register-type (cadr f) (caddr f)))))
	  forms)
(emit-type-hierarchy)