### ----------------------------------------------------
### -- Gnome::Gtk3
### -- Licenses: Artistic-2.0
### -- Authors: Marcel Timmerman
### -- File: xbin/gnome-gtk3-source-skim-tool.raku
### ----------------------------------------------------
### -- Chunk 1 of 5
#!/usr/bin/env -S raku -I lib

use v6;

#-------------------------------------------------------------------------------
my Str $output-file;

my Str ( $section-doc, $short-description, $see-also);

my @gtkdirlist = ();
my @gdkpixbufdirlist = ();
my @gdkdirlist = ();
my @gobjectdirlist = ();
my @glibdirlist = ();
my @pangodirlist = ();
my @giodirlist = ();
my %gnome-names-map = %();

my @enum-list = ();

# No leaf, role, top or standalone means class not at the top nor at the end.
# Methods must call self._f('gtk widget class name') to get native object and
# perform casting. Leaf classes do not need casting and can call
# self._get-native-object-no-reffing. Roles have a simpler interface and does not
# inherit from TopLevelClassSupport. Top classes inherit directly from
# TopLevelClassSupport and have a native object of their own, and do not need
# Boxed class. Standalone classes do not have an object and therefore no need to
# inherit anything
my Bool $class-is-leaf;
my Bool $class-is-role; # is leaf implicitly
my Bool $class-is-top;

#-------------------------------------------------------------------------------
sub MAIN (
  Str:D $base-name, Str $base-sub-name? is copy,
  Bool :$main = False, Bool :$sig = False, Bool :$prop = False,
  Bool :$sub = False, Bool :$types = False, Bool :$test = False,
  Bool :$leaf = False, Bool :$role = False, Bool :$top = False,
) {

  my Str $include-content;    # contents of xyz.h
  my Str $source-content;     # contents of xyz.c

  my Str $*base-sub-name;
  my Str $*library = '';
  my Str $*raku-lib-name;
  my Str $*lib-class-name;
  my Str $*raku-class-name;
  my Str $*raku-parentlib-name = '';
  my Str $*raku-parentclass-name = '';

  my Bool $do-all = !( [or] $main, $sig, $prop, $sub, $types, $test );

  # Gtk interfaces (roles) are always leaf classes but need to cast their
  # object types, so leaf get False if role is True.
  $class-is-leaf = ($leaf and not $role);
  $class-is-role = $role;
  $class-is-top = $top;

  load-dir-lists();

  $*base-sub-name = $base-sub-name // $base-name;

  # get content of include and source file. exit if files not found
  ( $include-content, $source-content) = setup-names($base-name);

  # test for dir 'xt'
  mkdir( 'xt', 0o766) unless 'xt'.IO.e;
  mkdir( 'xt/NewModules', 0o766) unless 'xt/NewModules'.IO.e;

  set-parent-classes($include-content);

  ( $section-doc, $short-description, $see-also) =
    get-section($source-content);

  substitute-in-template( $do-all, $main, $types, $include-content);

  get-subroutines( $include-content, $source-content) if $do-all or $sub;
  get-signals($source-content) if $do-all or $sig;
  get-properties($source-content) if $do-all or $prop;

  generate-test if $test or $do-all;
}

#-------------------------------------------------------------------------------
sub get-subroutines( Str:D $include-content, Str:D $source-content ) {

  my Str $sub-doc = '';
  my Array $items-src-doc = [];
  my Bool $variable-args-list;

#note "IC: $include-content";
  # get all subroutines starting with 'GDK_AVAILABLE_IN_ALL' or
  # 'GDK_AVAILABLE_IN_\d_\d' version spec. subroutines starting with
  # 'GDK_DEPRECATED_IN_' are ignored.
  $include-content ~~ m:g/^^ <[\w]>+ '_AVAILABLE_IN_' <-[;]>+ ';' /;
  my List $results = $/[*];

  # process subroutines
  print "Find subroutines ";
  my Hash $sub-documents = %();
  for @$results -> $r {
    print ".";
    $*OUT.flush;

    $variable-args-list = False;
#note "\n $r";

    my Str $declaration = ~$r;

#next unless $declaration ~~ m:s/ const gchar \* /;
    # skip constants and subs with variable argument lists
    next if $declaration ~~ m/ 'G_GNUC_CONST' /;
    $variable-args-list = True if $declaration ~~ m/ 'G_GNUC_NULL_TERMINATED' /;

    # remove some macros
    $declaration ~~ s/ \s* 'G_GNUC_WARN_UNUSED_RESULT' \s* //;

    # remove prefix and tidy up a bit
    $declaration ~~ s/^ <[\w]>+ '_AVAILABLE_IN_' .*?  \n //;
#    $declaration ~~ s:g/ \s* \n \s* / /;
    $declaration ~~ s:g/ \s+ / /;
    $declaration ~~ s/\s* 'G_GNUC_PURE' \s*//;
#note "\n0 >> $declaration";

    my Str ( $return-type, $raku-return-type) = ( '', '');
    my Bool $type-is-class;

    # convert and remove return type from declaration
    ( $declaration, $return-type, $raku-return-type, $type-is-class) =
      get-type( $declaration, :!attr);

    # return types do not have to be coerced
    $raku-return-type ~~ s/\(\)//;

    # get the subroutine name and remove from declaration
    $declaration ~~ m/ $<sub-name> = [ <alnum>+ ] \s* /;
    my Str $sub-name = ~$<sub-name>;
    $declaration ~~ s/ $sub-name \s* //;

    # remove any brackets, and other stuff left before arguments are processed
    $declaration ~~ s:g/ <[();]> || 'void' || 'G_GNUC_NULL_TERMINATED' //;

    # get subroutine documentation from c source
    ( $sub-doc, $items-src-doc) = get-sub-doc( $sub-name, $source-content);
    $sub-doc ~~ s:g/ '(' [
            nullable | 'transfer none' | 'transfer full' | 'allow-none' |
            'array zero-terminated=1' | optional | inout | out | in |
            'not nullable'
          ] ')' //;
    $sub-doc ~~ s/ 'Returns:' \s* ':' \s+ /Returns: /;

#note "Pod items: $items-src-doc.elems()\n  ", $items-src-doc.join("\n  ");

    my Str $args-declaration = $declaration;
    my Str ( $pod-args, $call-args, $args, $pod-doc-items) = ( '', '', '', '');
    my Bool $first-arg = True;
    my Str $convert-lines = "";
    my Str $method-args = '';

    # process arguments
#print "\n$sub-name\n";
    for $args-declaration.split(/ \s* ',' \s* /) -> $raw-arg {
      my Str ( $arg, $arg-type, $raku-arg-type);
      ( $arg, $arg-type, $raku-arg-type, $type-is-class) =
        get-type( $raw-arg, :attr);
#note "  args: $arg, $arg-type, $raku-arg-type";
      if ?$arg {
        # sometimes there are strange argument names like 'index_'
        $arg ~~ s/^ '-'//;
        $arg ~~ s/'_' $//;

        my Str $pod-doc-item-doc = $items-src-doc.shift if $items-src-doc.elems;
#note "  pod info: $raku-arg-type, $arg, $pod-doc-item-doc";

        # skip first argument when type is also the class name
        if $first-arg and $type-is-class {
          #note "  skip $arg";
          #$first-arg = False;
          #next;
        }

        # skip also when variable is $any set to default Any type
        elsif $arg eq 'any = Any' { }

        else {
#note "  not skipped... $sub-name, $arg, $arg-type, $raku-arg-type";
          given $raku-arg-type {
            when 'N-GObject' {
              $raku-arg-type ~= '()';
              $convert-lines ~= "";
              $method-args ~= ',' if ?$method-args;
              $method-args ~= " $raku-arg-type \$$arg";
              $call-args ~= ", \$$arg";
              $pod-args ~= ',' if ?$pod-args;
              $pod-args ~= " $raku-arg-type \$$arg";
            }

            when any(
              < N-GSList N-GList N-GOptionContext N-GOptionGroup
                N-GOptionEntry N-GError
              >
            ) {
              $convert-lines ~= "  \$$arg .= _get-native-object-no-reffing unless \$$arg ~~ $raku-arg-type;\n";

              $method-args ~= ',' if ?$method-args;
              $method-args ~= " \$$arg is copy";
              $call-args ~= ", \$$arg";
              $pod-args ~= ',' if ?$pod-args;
              $pod-args ~= " $raku-arg-type \$$arg";
            }

            when 'Int-ptr' {
              # don't define method args should insert '--> List' at the end
              # also no pod args and also add '--> List' at the end, but how
              # and not always if it only one
              $raku-arg-type = 'Int';
              $call-args ~= ", my gint \$$arg";
            }

            default {
              $method-args ~= ',' if ?$method-args;
              $method-args ~= " $raku-arg-type \$$arg";
              $call-args ~= ", \$$arg";
              $pod-args ~= ',' if ?$pod-args;
              $pod-args ~= " $raku-arg-type \$$arg";
            }
          }


          # remove some c-oriented remarks
          if ?$pod-doc-item-doc {
            $pod-doc-item-doc ~~ s:g/'(' [
                    nullable | 'transfer none' | 'transfer full' |
                    'allow-none' | 'not nullable' | 'array zero-terminated=1' |
                    optional | inout | out | in
                  ] ')' //;
            $pod-doc-item-doc ~~ s/^ \s* <[:;]> \s+ //;
            $pod-doc-item-doc ~~ s/ 'C<Any>-terminated' //;
#            $pod-doc-items ~=
#              "=item $raku-arg-type \$$arg; $pod-doc-item-doc\n";
            $pod-doc-items ~= "=item \$$arg; $pod-doc-item-doc\n";
          }

          else {
#            $pod-doc-items ~= "=item $raku-arg-type \$$arg; \n";
            $pod-doc-items ~= "=item \$$arg; \n";
          }

          $pod-doc-items ~~ s/^ \s+ $//;

#note "  not skipped... $sub-name\n    $pod-args\n    $call-args\n    $pod-doc-items";
        }

        # add argument to list for sub declaration
        $args ~= ', ' if ?$args;
        if $arg-type eq 'gint-ptr' {
          $arg-type = 'gint';
          $args ~= "$arg-type \$$arg is rw";
        }

        else {
          $args ~= "$arg-type \$$arg";
        }
#note "  sub... $sub-name    $args";
      }

      $first-arg = False;
    }

#    note "2 >> $sub-name";
#    note "3 >> $args";
#    note "4 >> $return-type";

    my Str $return-dot-comma = '';
    my Str $pod-returns = '';
    my Str $returns = '';
    if ?$return-type {
      $pod-returns = " --> $raku-return-type";
      $returns = "--> $return-type";
    }

    else {
      $return-dot-comma = ';';
    }

    my Str $start-comment = $variable-args-list ?? '#`{{' ~ "\n" !! '';
    my Str $end-comment = $variable-args-list ?? "\n" ~ '}}' !! '';

    my $pod-sub-name = pod-sub-name($sub-name);

    my Str $sub = '';

    my Str $pod-doc-key;

    my Str $return-conversion = '';
    given $raku-return-type {
      when 'Bool' { $return-conversion = '.Bool'; }
    }

    # process new subroutines. they will be sorted to the end and do not get a
    # method because they are accessed from BUILD. Also doc is commented out.
    if $sub-name ~~ m/^ $*base-sub-name '_new' / {
      $pod-doc-key = "_$sub-name";
#      note "get sub as $pod-doc-key";
      $sub = Q:qq:to/EOSUB/;

        $start-comment#-------------------------------------------------------------------------------
        #TM:1:_$sub-name:
        #`\{\{
        =begin pod
        =head2 _$sub-name

        $sub-doc

          method _$sub-name ($pod-args$pod-returns )

        $pod-doc-items=end pod
        \}\}

        sub _$sub-name ( $args $returns )
          is native($*library)
          is symbol\('$sub-name')
          \{ * \}$end-comment
        EOSUB
    }

    # process methods in leaf classes. they do not need casting
    elsif $class-is-leaf {
      $pod-doc-key = $pod-sub-name;
#      note "get sub as $pod-sub-name";

      $sub = Q:qq:to/EOSUB/;

        $start-comment#-------------------------------------------------------------------------------
        #TM:0:$pod-sub-name:
        =begin pod
        =head2 $pod-sub-name

        $sub-doc

          method $pod-sub-name ($pod-args$pod-returns )

        $pod-doc-items=end pod

        method $pod-sub-name ($method-args$pod-returns ) \{
        $convert-lines  $sub-name\( self\._get-native-object-no-reffing$call-args)$return-conversion$return-dot-comma
        \}

        sub $sub-name (
          $args $returns
        ) is native($*library)
          \{ * \}$end-comment
        EOSUB
    }

    # process methods in other classes. they do need casting
    else {
      $pod-doc-key = $pod-sub-name;
#      note "get sub as $pod-sub-name";

      $sub = Q:qq:to/EOSUB/;

        $start-comment#-------------------------------------------------------------------------------
        #TM:0:$pod-sub-name:
        =begin pod
        =head2 $pod-sub-name

        $sub-doc

          method $pod-sub-name ($pod-args$pod-returns )

        $pod-doc-items=end pod

        method $pod-sub-name ($method-args$pod-returns ) \{
        $convert-lines  $sub-name\( self\._f\('$*lib-class-name')$call-args)$return-conversion$return-dot-comma
        \}

        sub $sub-name (
          $args $returns
        ) is native($*library)
          \{ * \}$end-comment
        EOSUB
    }

#    note $sub;

#    $output-file.IO.spurt( $sub, :append);$sub-documents
    $sub-documents{$pod-doc-key} = $sub;
  }
  print "\n";

  # place all non-new modules at the end
  for $sub-documents.keys.sort -> $key {
    next if $key ~~ m/^ '_' /;
    note "save doc for sub $key";
    $output-file.IO.spurt( $sub-documents{$key}, :append);
  }

  # place all new modules at the end
  for $sub-documents.keys.sort -> $key {
    next unless $key ~~ m/^ '_' /;
    note "save doc for sub $key";
    $output-file.IO.spurt( $sub-documents{$key}, :append);
  }
}

#-------------------------------------------------------------------------------
sub set-parent-classes ( Str:D $include-content ) {

  $include-content ~~ m/
    ^^ \s*
    $<lib-parent> = [<alnum>+]
    \s+ 'parent_class'
  /;

  $*raku-parentclass-name = ~($<lib-parent> // '');
  given $*raku-parentclass-name {
    when /^ Gtk / {
      $*raku-parentlib-name = 'Gtk3';
    }

    when /^ Gdk / {
      $*raku-parentlib-name = 'Gdk3';
    }
  }

  $*raku-parentclass-name ~~ s:g/ ['Gtk' || 'Gdk'|| 'Class'] //;
}

#-------------------------------------------------------------------------------
# Get the type from the start of the declaration and remove it from that
# declaration. The type is cleaned up by removing 'const', 'void' and pointer(*)
sub get-type( Str:D $declaration is copy, Bool :$attr --> List ) {

#note "\nDeclaration: ", $declaration if $declaration ~~ m/ gtk_widget_path_iter_get_siblings /;

  # process types from arg lists, inconsequent use of gchar/char
  if $attr {
    $declaration ~~ m/ ^
      $<type> = [
        [
          \s* const \s* g?char \s* '*' \s* const \s* '*'* \s* ||
          \s* const \s* g?char \s* '*'* \s* ||
          \s* g?char \s* '*'* \s* ||
          \s* const \s* <alnum>+ \s* '*'* \s* ||
          \s* <alnum>+  \s* '*'* \s* ||
          \s* '...'
        ]
      ] <alnum>+ $
    /;
  }

  # process types from sub return
  else {
    $declaration ~~ m/ ^
      $<type> = [
        [
          const \s* g?char \s* '*' \s* const \s* '*'* \s* ||
          const \s* g?char \s* '*' \s* ||
          g?char \s* '*'* \s* ||
          const \s* '*' <alnum>+ \s* '*'* \s* ||
          const \s* <alnum>+ \s* '*'* \s* ||
          <alnum>+ \s* '*'* \s*
        ]
      ] <alnum>+
    /;
  }

  #[ [const]? \s* <alnum>+ \s* \*? ]*

  my Str $type = ~($<type> // '');
  $declaration ~~ s/ $type //;

  # drop the const
  $type ~~ s:g/ const //;

  # convert pointer char types
  $type ~~ s/ g?char \s* '*' \s* '*' \s* '*' /gchar-ppptr/;
  $type ~~ s/ g?char \s* '*' \s* '*' /gchar-pptr/;
  $type ~~ s/ g?char \s* '*' /gchar-ptr/;

  # convert other pointer types
  $type ~~ s/ void \s* '*' /void-ptr/;
  $type ~~ s/ g?int \s* '*' /gint-ptr/;

#  if $type ~~ m/ g?char \s* '*' / {
#    $type ~~ s/ g?char \s* '*' / Str /;
#
#    # if there is still another pointer, make a CArray
#    $type = "CArray[$type]" if $type ~~ m/ '*' /;
#    $type ~~ s:g/ \s* //;
#  }

  if $declaration ~~ m/ ^ '...' / {
    $type = 'Any';
    $declaration = 'any = Any';
  }

#note "Type: $type";
  # cleanup
  $type ~~ s:g/ ['void' || '*'] //;
  $type ~~ s/ \s+ / /;
  $type ~~ s/ \s+ $//;
  $type ~~ s/^ \s+ //;
  $type ~~ s/^ \s* $//;
#note "Cleaned type: $type";

  # check type for its class name
  my Bool $type-is-class = $type eq $*lib-class-name;

  # convert to native Raku types
#note "Type: $type";
  given $type {
    when /GError/ { $type = 'N-GError'; }
    #$type = 'GQuark' if $type ~~ m/GQuark/;
    when /GList/ { $type = 'N-GList'; }
    when /GSList/ { $type = 'N-GSList'; }
    when /GdkEvent/ { $type = 'N-GdkEvent'; }
    when /PangoItem/ { $type = 'N-PangoItem'; }
    when /GVariantType || GVariantDict || GVariant/ { $type = 'N-GObject'; }
    when /GtkTreePath/ { $type = 'N-GtkTreePath'; }
    when /GOptionContext/ { $type = 'N-GOptionContext'; }
    when /GOptionGroup/ { $type = 'N-GOptionGroup'; }
    when /GOptionEntry/ { $type = 'N-GOptionEntry'; }
#    when // { $type = 'N-'; }

    default {
      $type = 'N-GObject' if is-n-gobject($type);
    }
  }

#`{{
  $type = 'uint64' if $type ~~ m/GType/;

  $type = 'int32' if $type ~~ m/GQuark/;
}}

  # copy to Raku type for independent convertions
  my Str $raku-type = $type;

  # convert to native perl types
  #$type ~~ s/ g?char \s+ '*' /str/;

  # process all types from GtkEnum and some
  # use bin/gather-enums.pl6 to create a list in
  # doc/Design-docs/skim-tool-enum-list.txt
  $type = 'GEnum' if $type ~~ any(@enum-list);

#`{{ not translated anymore. they are mapped in Gnome::N::GlibToRakuTypes

  $type ~~ s:s/ gboolean || gint /int/;
  $type ~~ s:s/ gint32 /int32/;
  $type ~~ s:s/ g?char || gint8 /int8/;
  $type ~~ s:s/ gshort || gint16 /int16/;
  $type ~~ s:s/ glong || gint64 /int64/;

  $type ~~ s:s/ guint32 /uint32/;
  $type ~~ s:s/ guint /uint/;
  $type ~~ s:s/ guchar || guint8 /byte/;
  $type ~~ s:s/ gushort || guint16 /uint16/;
  $type ~~ s:s/ gulong || guint64 /uint64/;

  $type ~~ s:s/ gssize || goffset /int64/;
  $type ~~ s:s/ gsize /uint64/;
  $type ~~ s:s/ gfloat /num32/;
  $type ~~ s:s/ gdouble /num64/;

  $type ~~ s:s/ int /int32/;
  $type ~~ s:s/ gpointer /Pointer/;
}}

  # convert to perl types
  #$raku-type ~~ s/ 'gchar' \s+ '*' /Str/;
  #$raku-type ~~ s/ str /Str/;

  $raku-type ~~ s:s/ g?char\-ppptr / CArray[CArray[Str]] /;
  $raku-type ~~ s:s/ g?char\-pptr / CArray[Str] /;
  $raku-type ~~ s:s/ g?char\-ptr / Str /;

  $raku-type ~~ s:s/ guint || guint32 || guchar || guint8 ||
                   gushort || guint16 || gulong || guint64 ||
                   gsize || uint32 || uint64 || uint
                 /UInt/;

  $raku-type ~~ s:s/ gint || gint32 ||
                   gchar || gint8 || gshort || gint16 ||
                   glong || gint64 ||
                   gssize || goffset || int32 || int64 || int || time_t
                 /Int/;

  $raku-type ~~ s:s/ gboolean /Bool/;

#  $raku-type ~~ s:s/ int /Int/;
#  $raku-type ~~ s:s/ uint /UInt/;
  $raku-type ~~ s:s/ gpointer /Pointer/;
  $raku-type ~~ s:s/ gfloat || gdouble /Num/;
  $raku-type ~~ s:s/ GQuark /UInt/;
  $raku-type ~~ s:s/ GFlag /UInt/;

  $raku-type ~~ s:g/ \s+ //;
  $raku-type ~= '()' if $raku-type ~~ any(<Num Int>);

#note "Result type: $type, raku type: $raku-type, is class = $type-is-class";

  ( $declaration, $type, $raku-type, $type-is-class)
}

#-------------------------------------------------------------------------------
sub setup-names ( Str:D $base-name --> List ) {
  my Str $include-file = $base-name;
  if $include-file ~~ m/ 'gdk_pixbuf' || 'pango' / {
    $include-file ~~ s:g/ '_' /-/;
  }

  else {
    $include-file ~~ s:g/ '_' //;
  }

  my @parts = $*base-sub-name.split(/<[_-]>/);
  $*lib-class-name = @parts>>.tc.join;

  $*raku-class-name = @parts[1..*-1]>>.tc.join;

#note "Files: $base-name, $include-file. $*lib-class-name, $*raku-class-name,  @parts.raku()";

#`{{
  my Str $*raku-lib-name = '';
  given $*lib-class-name {
    when /^ Gtk / {
      $*raku-lib-name = 'Gtk3';
    }

    when /^ Gdk / {
      $*raku-lib-name = 'Gdk3';
    }
  }
}}

#`{{
  # assume linux fedora
  my Str $gtk-path = '/usr/include/gtk-3.0/gtk';
  my Str $gdk-path = '/usr/include/gtk-3.0/gdk';
  my Str $gdk-pixbuf-path = '/usr/include/gtk-3.0/gdk';
  my Str $glib-path = '/usr/include/glib-2.0/glib';
  my Str $gobject-path = '/usr/include/glib-2.0/gobject';
#  my Str $gio-path = '/usr/include/glib-2.0/gio';
}}
#`{{
  # c-source file text paths, downloaded latest version. the version does not
  # matter much, just searching for documentation.
  my Str $gtk-srcpath = '/home/marcel/Software/Packages/Sources/Gnome/gtk+-3.22.0/gtk';
  my Str $gdk-srcpath = '/home/marcel/Software/Packages/Sources/Gnome/gtk+-3.22.0/gdk';
  my Str $glib-srcpath = '/home/marcel/Software/Packages/Sources/Gnome/glib-2.60.0/glib';
  my Str $gobject-srcpath = '/home/marcel/Software/Packages/Sources/Gnome/glib-2.60.0/gobject';
#  my Str $gio-srcpath = '/home/marcel/Software/Packages/Sources/Gnome/glib-2.60.0/gio';
}}

  my $source-root = '/home/marcel/Software/Packages/Sources/Gnome';
  my @source-list = (
    "$source-root/gtk+-3.24.36/gtk",
    "$source-root/gdk-pixbuf-2.42.8/gdk-pixbuf",
    "$source-root/gtk+-3.24.36/gdk",
    "$source-root/glib-2.74.5/gio",
    "$source-root/glib-2.74.5/glib",
    "$source-root/glib-2.74.5/gobject",
    "$source-root/pango-1.50.7/pango",
  );

  my Str ( $include-content, $source-content) = ( '', '');
  my Bool $file-found = False;
  for @source-list -> $path {
#note "Include $path/$include-file.h";
    if "$path/$include-file.h".IO.r {
      $file-found = True;
      if $include-file eq 'gdk-pixbuf' and "$path/{$include-file}-core.h".IO.r {
        $include-content = "$path/{$include-file}-core.h".IO.slurp;
      }

      else {
        $include-content = "$path/$include-file.h".IO.slurp;
      }

      $source-content = "$path/$include-file.c".IO.slurp
        if "$path/$include-file.c".IO.r;

#note "Sources: $path, ", ?$include-content, ', ', ?$source-content;

      given $path {
        when / 'gtk+-' <-[/]>+ '/gtk' / {
          $*library = '&gtk-lib';
          $*raku-lib-name = 'Gtk3';
        }

        when / 'gdk-pixbuf' / {
          $*library = '&gdk-pixbuf-lib';
          $*raku-lib-name = 'Gdk3';
        }

        when / 'gtk+-' <-[/]>+ '/gdk' / {
          $*library = "&gdk-lib";
          $*raku-lib-name = 'Gdk3';
        }

        when / 'glib-' <-[/]>+ '/glib' / {
          $*library = "&glib-lib";
          $*raku-lib-name = 'Glib';
        }

        when / 'glib-' <-[/]>+ '/gio' / {
          $*library = "&gio-lib";
          $*raku-lib-name = 'Gio';
        }

        when / 'glib-' <-[/]>+ '/gobject' / {
          $*library = "&gobject-lib";
          $*raku-lib-name = 'GObject';
        }

        when / 'pango-' <-[/]>+ '/pango' / {
          $*library = "&pango-lib";
          $*raku-lib-name = 'Pango';
        }

#        when $gio-path {
#          $*library = "&glib-lib";
#          $*raku-lib-name = 'Glib';
#        }
      }

#note "Library: $*library, $*lib-class-name, $*raku-lib-name";
      last;
    }
  }

  unless $file-found {
    note "Include file '$include-file' is not found";
    exit(1)
  }

  ( $include-content, $source-content)
}

#-------------------------------------------------------------------------------
sub pod-sub-name ( Str:D $sub-name --> Str ) {

  my Str $pod-sub-name = $sub-name;

  # sometimes the sub name does not start with the base name
  if $sub-name ~~ m/ ^ $*base-sub-name / {
    $pod-sub-name = $sub-name;

    # remove base subname and an '_', then test if there is another '_' to
    # see if a part could be made optional by circumventing with '[' and ']'.
    $pod-sub-name ~~ s/^ $*base-sub-name '_' //;
  }

  # and replace '_' with '-'
  $pod-sub-name ~~ s:g/ '_' /-/;

#note "psn: $sub-name, $pod-sub-name, $*base-sub-name";
  $pod-sub-name

#`{{
  my Str $pod-sub-name = $sub-name;

  # sometimes the sub name does not start with the base name
  if $sub-name ~~ m/ ^ $*base-sub-name / {
    my Str $s = $sub-name;

    # remove base subname and an '_', then test if there is another '_' to
    # see if a part could be made optional by circumventing with '[' and ']'.
    $s ~~ s/^ $*base-sub-name '_' //;
    $pod-sub-name = [~] '[', $*base-sub-name, '_] ', $s if $s ~~ m/ '_' /;

    # then make the first part optional
    $pod-sub-name ~~ s/^ ( <-[_]>+ '_' ) /[$0] /;
  }

  $pod-sub-name
}}
}

#-------------------------------------------------------------------------------
sub is-n-gobject ( Str:D $type-name is copy --> Bool ) {

  my Bool $is-n-gobject = False;
  $type-name .= lc;
#note "TN: $type-name";

  given $type-name {
    when /^ gtk / {
      $is-n-gobject = $type-name ~~ any(|@gtkdirlist);
    }

    when /^ gdk / {
      $is-n-gobject = $type-name ~~ any(|@gdkdirlist);
    }

    when /^ gquark / { #`(skip this type) }

    when /^ g / {

      $is-n-gobject = $type-name ~~ any(|@glibdirlist);
      $is-n-gobject = $type-name ~~ any(|@gobjectdirlist) unless $is-n-gobject;
      $is-n-gobject = $type-name ~~ any(|@giodirlist) unless $is-n-gobject;
    }

    when /^ pango / {
      state @modified-pangodirlist = map(
        { .subst( / '-' /, ''); }, @pangodirlist
      );

      $is-n-gobject = $type-name ~~ any(|@modified-pangodirlist);
    }
  }

  $is-n-gobject
}

#-------------------------------------------------------------------------------
sub load-dir-lists ( ) {

  my Str $root-dir = '/home/marcel/Languages/Raku/Projects/gnome-gtk3';
  @gtkdirlist = "$root-dir/Design-docs/gtk3-list.txt".IO.slurp.lines;

  @gdkdirlist = "$root-dir/Design-docs/gdk3-list.txt".IO.slurp.lines;
  @gdkpixbufdirlist = "$root-dir/Design-docs/gdk3-pixbuf-list.txt".IO.slurp.lines;

  @gobjectdirlist = "$root-dir/Design-docs/gobject-list.txt".IO.slurp.lines;
  @glibdirlist = "$root-dir/Design-docs/glib-list.txt".IO.slurp.lines;
  @giodirlist = "$root-dir/Design-docs/gio-list.txt".IO.slurp.lines;

  @pangodirlist = "$root-dir/Design-docs/pango-list.txt".IO.slurp.lines;

  @enum-list = "$root-dir/Design-docs/skim-tool-enum-list".IO.slurp.lines;

  for "$root-dir/Design-docs/gnome-names-map.txt".IO.lines -> $l {
    my Str ( $g, $m ) = $l.split(': ');
    %gnome-names-map{$g} = $m;
  }
}

#-------------------------------------------------------------------------------
sub substitute-in-template (
  Bool $do-all, Bool $main, Bool $types, Str $include-content
) {

  my Str $template-text = Q:q:to/EOTEMPLATE/;
    #TL:1:Gnome::LIBRARYMODULE:

    use v6;
    #-------------------------------------------------------------------------------
    =begin pod

    =head1 Gnome::LIBRARYMODULE

    MODULE-SHORTDESCRIPTION

    =comment ![](images/X.png)


    =head1 Description

    MODULE-DESCRIPTION


    MODULE-SEEALSO


    =head1 Synopsis
    =head2 Declaration
    EOTEMPLATE

  if $class-is-role {
    # no extra info for roles
    $template-text ~= Q:q:to/EOTEMPLATE/;

        unit role Gnome::LIBRARYMODULE;

      =end pod
      #-------------------------------------------------------------------------------
      use NativeCall;

      #use Gnome::N::X:api<1>;
      use Gnome::N::NativeLib:api<1>;
      use Gnome::N::N-GObject:api<1>;
      use Gnome::N::GlibToRakuTypes:api<1>;
      USE-LIBRARY-PARENT

      #-------------------------------------------------------------------------------
      unit role Gnome::LIBRARYMODULE:auth<github:MARTIMM>:api<1>;
      ALSO-IS-LIBRARY-PARENT
      EOTEMPLATE
  }

  else {
    $template-text ~= Q:q:to/EOTEMPLATE/