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