/usr/share/gauche-0.9/site/lib/h2s/top.scm is in gauche-gtk 0.6~pre1+git20121223-1.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 | (define-module h2s.top
(export
<parse-2-stub>
init-hardwired
standard-parse-n-emit
)
(use h2s.objects)
(use h2s.gtk-types)
; (use h2s.persistence)
(use h2s.fixup)
(use h2s.emit)
;; h2s.parse
(use h2s.utils)
)
(select-module h2s.top)
(define-class <parse-2-stub> ()
(
(hint-files :init-keyword :hint-files)
(types-file :init-keyword :types-file)
(inits-file :init-keyword :inits-file)
(header-file :init-keyword :header-file)
(include-file :init-keyword :include-file)
(init-function :init-keyword :init-function)
;; parsing what?
(parsing-function :init-keyword :parsing-function)
))
(define debug #f)
(define (init-hardwired)
;; define primitive types
(for-each
(lambda (entry)
(if debug (logformat "init: ~a\n" (car entry)))
(make <gtk-type> :c-name (car entry) :body (cadr entry)))
'((gint <int>)
(gint8 <int8>)
(gint16 <int16>)
(gint32 <int32>)
(glong <long>)
(gshort <int16>)
(guint <uint>)
(guint8 <uint8>)
(guint16 <uint16>)
(guint32 <uint32>)
(gulong <ulong>)
(guchar <uint8>)
(gushort <uint16>)
(gboolean <boolean>)
(gfloat <float>)
(gdouble <double>)
(long <long>)
(int <int>)
(short <int16>)
(char <int8>)
(void <void>)
(float <float>)
(double <double>)
;; mmc:
(gunichar <gunichar>) ;uint32
;(PangoGlyphUnit <int32>)
;; cp: PangoGlyphItem PangoLayoutRun
;; C string business is tricky. We can only treat the case that
;; passing const char * or const gchar * - in those cases, gtk copies
;; the passed string immediately, so we can safely pass the string
;; from ScmGetStringConst*.
(const-char* <const-char*>)
(const-gchar* <const-gchar*>)
;; Generic GObject
(GObject* <g-object>)
;; mmc: Will this solve it?
(GObject <g-object>)
;; This is used to box the returned allocated gchar*
(gchar* <gchar*>)
;; Opaque types
(PangoContext* <pango-context>)
(PangoLanguage* <pango-language>)
(PangoAttrList* <pango-attr-list>)
(PangoLayoutIter* <pango-layout-iter>)
(GdkAtom <gdk-atom>)
(GdkRegion* <gdk-region>)
(GdkPixbufFormat* <gdk-pixbuf-format>)
(GtkTreePath* <gtk-tree-path>)
(GtkTreeRowReference* <gtk-tree-row-reference>)
;; GdkEvent is a union.
(GdkEvent* <gdk-event>)
;; GtkAllocation is simply an alias of GdkRectangle
(GtkAllocation* <gdk-rectangle>)
;; Interfaces
(GtkEditable* <gtk-editable>)
(GtkTreeModel* <gtk-tree-model>)
(GtkTreeSortable* <gtk-tree-sortable>))))
(define (standard-parse-n-emit recipe input-db output-db)
(init-hardwired)
(let1 open-database (lambda (filename)
;; (logformat "using GTK definitsion in (BDB) file ~a\n" filename)
(let ((db (open-type-db filename))
(sdb (open-struct-db filename)))
(set! global-sdb sdb)
(set! find-type-in-archive-function
(cut find-type-in-archive <> db))))
(if input-db (open-database input-db))
;; apply
(if (slot-bound? recipe 'parsing-function)
((slot-ref recipe 'parsing-function)))
;;
(report "Fixing up ...")
(fixup (slot-ref recipe 'hint-files))
(report "Generating ...")
(emit-all
(ref recipe 'types-file)
(ref recipe 'header-file)
(ref recipe 'include-file)
(ref recipe 'init-function)
(ref recipe 'inits-file))
;;
;(if output-db (dump-all output-db))
))
(provide "h2s/top")
|