basis/gobject-introspection/gobject-introspection.factor

   1 ! Copyright (C) 2010 Anton Gorenko.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: accessors combinators environment gobject-introspection.common
   4 gobject-introspection.ffi gobject-introspection.loader
   5 gobject-introspection.types io io.files io.pathnames kernel lexer
   6 locals make namespaces parser sequences splitting summary vocabs
   7 vocabs.parser xml ;
   8 FROM: namespaces => change-global ;
   9 IN: gobject-introspection
  10
  11 ERROR: gir-not-found name paths ;
  12
  13 M: gir-not-found summary
  14     [ name>> "“" "” file not found on paths:\n" surround ]
  15     [ paths>> "\n" join ] bi
  16     "\n\nUse the existing path or declare GIR_DIRS environment variable"
  17     3append ;
  18
  19 <PRIVATE
  20
  21 : system-gir-dirs ( -- dirs )
  22     "XDG_DATA_DIRS" os-env "/usr/local/share/:/usr/share/" or
  23     ":" split [ "gir-1.0" append-path ] map ;
  24
  25 : custom-gir-dirs ( -- dirs )
  26     "GIR_DIRS" os-env ":" split ;
  27
  28 : current-vocab-path ( -- path )
  29     current-vocab vocab-name "." split "/" join vocab-path ;
  30
  31 : current-vocab-dirs ( -- dirs )
  32     [
  33         current-vocab-path
  34         [ , ] [ "/ffi" ?tail [ , ] [ drop ] if ] bi
  35     ] { } make ;
  36
  37 :: resolve-gir-path ( path -- path )
  38     path exists?
  39     [ path ] [
  40         current-vocab-dirs custom-gir-dirs system-gir-dirs
  41         3append sift :> paths
  42         paths [ path append-path exists? ] find nip
  43         [ path append-path ] [ path paths gir-not-found ] if*
  44     ] if ;
  45
  46 : define-gir-vocab ( path -- )
  47     resolve-gir-path dup "Loading " write print
  48     file>xml xml>repository
  49     {
  50         [ namespace>> name>> current-namespace-name set-global ]
  51         [ def-ffi-repository ]
  52     } cleave
  53     V{ } clone implement-structs set-global ;
  54
  55 PRIVATE>
  56
  57 SYNTAX: GIR: scan define-gir-vocab ;
  58
  59 SYNTAX: IMPLEMENT-STRUCTS:
  60     ";" parse-tokens
  61     implement-structs [ swap append! ] change-global ;
  62
  63 SYNTAX: FOREIGN-ATOMIC-TYPE:
  64     scan-token scan-object swap register-atomic-type ;
  65
  66 SYNTAX: FOREIGN-ENUM-TYPE:
  67     scan-token scan-object swap register-enum-type ;
  68
  69 SYNTAX: FOREIGN-RECORD-TYPE:
  70     scan-token scan-object swap register-record-type ;