#!/usr/bin/perl
#
# rapid2glade.pl    RAPID GUI to Glade-3 UI file converter
#
# Usage:
#   rapid2glade.pl [options] [ada_spec_files] <gui_file>
#
# Outputs:
#   1. a GtkBuilder UI file of same filename stem as the GUI file but with
#      extension ".ui"
#   2. an Ada spec and body named according to the WINDOW definition in the
#      GUI input file with added suffix "_Window".
#   Example: Given a GUI file XYZ.gui with a WINDOW line
#      WINDOW "mocd" "MCD Online" FALSE 787 704 SUB_WINDOW "" READ_WRITE
#   following files will be generated:
#      XYZ.ui
#      mocd_window.ads, mocd_window.adb
#
# [options]:
#   -v           Print verbose messages of program execution.
#   -callbacks   Generate action callbacks for elements for which
#                RAPID did not itself generate callbacks but for which
#                generating callbacks can be useful
#   -nocolors    Switch off translation of widget fg/bg colors
#
# [ada_spec_files]:
#   One or more Ada spec files may be given as input files. These Ada
#   specs are expected to contain enum type declarations referenced
#   in the GUI file DROPDOWN items. The enum types are parsed in order
#   to fill the literals into the <items> of ComboBoxText items in the
#   generated UI file.
#   The Ada spec files must be listed in the order of ascending inter-
#   dependence, i.e. specs with enum type declarations must precede
#   specs which reference those types by subtyping or derivation.
#
# Further information:
#   At run time, the generated Ada code expects an environment variable
#   UI_FILE_DIR to exist. (GtkBuilder requires that the UI files be
#   available at run time.) UI_FILE_DIR shall point to the directory of
#   the UI files.
#
# Copyright (C) 2009-2017, O. Kellogg <okellogg@users.sourceforge.net>
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
#
$Version = "20170420";
#            
# For list of changes see:
# svn log svn://svn.savannah.nongnu.org/rapid/trunk/gtk_bin/rapid2glade.pl
#

$indentlevel = 0;
@iddcl  = ();    # Ada widget id declarations
@idass  = ();    # Ada widget id assignments
@hdlrs  = ();    # Ada specs for signal handers
@hdlrb  = ();    # Ada bodies for signal handers
@reghdl = ();    # Ada body for procedure Register_Handlers
@fillw  = ();    # Ada body for procedure Fill_Window
@readw  = ();    # Ada body for procedure Read_Window

sub whitespace {
    return (' ' x (2 * $indentlevel));
}

sub dent {
    my $line = shift;
    print OUT (whitespace . $line . "\n");
}

sub indent {
    dent shift;
    $indentlevel++;
}

sub dedent {
    $indentlevel--;
    dent shift;
}

# Array of tokens into which each line is split
@token = ();
# List for menubar holds references to pairs where each pair consists of
# 1) the menubar name and 2) a reference to the list of submenu items.
@menubar = ();
# Widget counter auxiliary variable
$widgetcnt = 0;
$verbose = 0;          # is set to nonzero by option "-v"
$gen_all_ada_cbs = 0;  # is set to nonzero by option "-callbacks"
$gen_colors = 1;       # is set to zero by option "-nocolors"
$readwrite = 0;      # is changed to true unless WINDOW is READ_ONLY in gui file
$frame_child = 0;    # is changed to true if WINDOW is FRAME_CHILD
%parsed_ada_files = ();
%enum_types = ();    # cache of enum types parsed, is indexed by lower-cased type name
                     # and returns a reference to the list of literals if found.
@withes = ();        # "with" clauses for Ada package body
@separates = ();     # user defined action callbacks are generated as "separate"
$need_interfaces = 0;        # is set to nonzero if we need to "with Interfaces"
$need_unbounded_string = 0;  # is set to nonzero if we need "with Ada.Strings.Unbounded"

sub colorname_to_rgb {
    my $colorname = lc(shift);
    if (!defined($colorname) || !$gen_colors ||
        $colorname eq "" || $colorname eq "default") {
        return undef;
    }
    my %rgb =
       (red         => '#FF0000',
        pink        => '#FFAFAF',
        green       => '#00FF00',
        lightgreen  => '#80FF80',
        darkgreen   => '#008000',
        forestgreen => '#005C00',
        blue        => '#0000FF',
        darkblue    => '#000080',
        lightblue   => '#8080FF',
        cyan        => '#00FFFF',
        lightcyan   => '#80FFFF',
        purple      => '#C800C8',
        magenta     => '#FF00FF',
        yellow      => '#FFFF00',
        lightyellow => '#FFFF80',
        orange      => '#FFC800',
        gray        => '#808080',
        lightgray   => '#C0C0C0',
        darkgray    => '#404040',
        brown       => '#804000',
        black       => '#000000',
        white       => '#FFFFFF');
    unless (exists $rgb{$colorname}) {
        warn "colorname_to_rgb: name \"$colorname\" is unknown\n";
        return undef;
    }
    return $rgb{$colorname};
}

sub prolog {
    my($widget, $ada_type, $id) = @_;
    if ($id) {
        $id .= "_$widgetcnt";
        $widgetcnt++;
    } else {
        $id = $token[1];
    }
    indent('<child>');
    indent("<object class=\"" . $widget . '" id="' . $id . '">');
    dent('<property name="width_request">' . $token[4] . '</property>');
    dent('<property name="height_request">' . $token[5] . '</property>');
    dent('<property name="visible">True</property>');
    push @iddcl, [ $id, $ada_type ];
    push @idass, "$id := $ada_type (Builder.Get_Object (\"$id\"));";
}

sub epilog {
    dedent("</object>");
    indent('<packing>');
    dent('<property name="x">' . $token[2] . '</property>');
    dent('<property name="y">' . $token[3] . '</property>');
    dedent('</packing>');
    dedent('</child>');
}

sub string2xml {
    my $name = shift;
    $name =~ s/^[^"]*"//;
    $name =~ s/"[^"]*$//;
    if ($name =~ /\&/) {
        $name =~ s/\&/&amp;/g;
    } else {
        $name =~ s/</&lt;/g;
        $name =~ s/>/&gt;/g;
    }
    $name =~ s/""/&quot;/g;
    return $name;
}

sub gab {
    my $msg = shift;
    if ($verbose) {
        print "$msg\n";
    }
}

sub parse_enum_types {
    my $pkgfile = shift;
    my $file_stem = $pkgfile;
    $file_stem =~ s@^.*/@@;
    $file_stem =~ s/\..*$//;
    if (exists $parsed_ada_files{$file_stem}) {
        warn "Ignoring further occurrence of $file_stem\n";
        return;
    }
    $parsed_ada_files{$file_stem} = $pkgfile;
    unless (-e "$pkgfile") {
        die "Cannot open input file $pkgfile\n";
    }
    unless (open(SPEC, '<', $pkgfile)) {
        warn "parse_enum_types : could not open $pkgfile\n";
        return;
    }
    my $pkg = $file_stem;
    $pkg =~ s/-/./g;
    my $current_enum = "";
    my @literals = ();
    while (<SPEC>) {
        my $line = $_;
        chop $line;
        $line =~ s/^\s+//;
        $line =~ s/\s+$//;
        $line =~ s/\s*--.*$//;
        next unless $line;
        if ($current_enum) {
            my $seen_end = 0;
            if ($line =~ /\)/) {
                $line =~ s/\s*\).*$//;
                $seen_end = 1;
            }
            push @literals, split /,\s*/, $line;
            if ($seen_end) {
                $enum_types{$pkg . '.' . $current_enum} = [ @literals ];
                $seen_end = 0;
                $current_enum = "";
                @literals = ();
            }
        } elsif ($line =~ /^\s*(sub)?type +(\w+) +is(.*)$/i) {
            my $sub = $1;
            my $t = lc($2);
            my $content = $3;
            unless ($content) {
                $content = <SPEC>;
                chop $content;
                $content =~ s/^\s+/ /;
                $content =~ s/\s+$//;
                $content =~ s/\s*--.*$//;
            }
            my $basetype;
            if ($content =~ /^\s+new\s+([\w.]+)/) {
                $basetype = lc($1);
            } elsif ($sub and $content =~ /^\s+([\w.]+)/) {
                $basetype = lc($1);
            }
            if ($basetype) {
                unless ($basetype =~ /\./) {
                    $basetype = $pkg . '.' . $basetype;
                }
                if (exists $enum_types{$basetype}) {
                    gab "$file_stem : Deriving enum type $t from $basetype";
                    $enum_types{$pkg . '.' . $t} = $enum_types{$basetype};
                } else {
                    gab "$file_stem : Cannot resolve type $basetype";
                }
                next;
            }
            unless ($content =~ /^\s*\(/) {
                # not an enum type declaration
                gab "$file_stem : Ignoring declaration: $line";
                next;
            }
            gab "$file_stem : Storing enum type $t";
            $current_enum = $t;
            $content =~ s/^\s*\(\s*//;
            if ($content) {
                if ($content =~ /\)/) {
                    $content =~ s/\s*\).*$//;
                    @literals = split /,\s*/, $content;
                    $enum_types{$pkg . '.' . $t} = [ @literals ];
                    $current_enum = "";
                    @literals = ();
                } else {
                    @literals = split /,\s*/, $content;
                }
            }
        }
    }
    close SPEC;
}

# In RAPID notation, a fully qualified Ada type name has '-' instead of '.'
# for denoting child packages.
# Example: Given a type T in a package P.C where P is a parent package C is a
#          child package, the RAPID notation is: P-C.T
# This subroutine normalizes the name for Ada (the '-' are replaced by '.')
# and additionally fills the @withes list in order to later generate
# appropriate "with" clauses for user defined packages.
sub normalize {
    my $adatype_in_rapid_notation = shift;
    $adatype_in_rapid_notation =~ s/"//g;
    $adatype_in_rapid_notation or return "";
    if ($adatype_in_rapid_notation =~ /\./) {
        my $pkg = $adatype_in_rapid_notation;
        $pkg =~ s/\..+$//;
        $pkg =~ s/-/./g;
        unless (grep(/^$pkg$/i, @withes)) {
            push @withes, $pkg;
        }
    }
    my $type = $adatype_in_rapid_notation;
    $type =~ s/-/./g;
    return $type;
}

sub push_action_callback {
    my $ada_cb = shift;
    my $cb = lc($ada_cb);
    my @predefined_action_callbacks =
        ("generate_window",
         "fill_window",
         "generate_and_fill_window",
         "read_window",
         "ok",
         "close_window");
    unless (grep { $cb eq $_ } @predefined_action_callbacks) {
        unless (grep /^$ada_cb$/i, @separates) {
            push @separates, $ada_cb;
        }
    }
}

# Main program
while (@ARGV and $ARGV[0] =~ /^-/) {
    if ($ARGV[0] eq "-v") {
        $verbose = 1;
    } elsif ($ARGV[0] eq "-callbacks") {
        $gen_all_ada_cbs = 1;
    } elsif ($ARGV[0] eq "-nocolors") {
        $gen_colors = 0;
    } else {
        die "unknown switch $ARGV[0]\n";
    }
    shift @ARGV;
}

while (scalar(@ARGV) > 1) {
  my $ada_spec_file = shift @ARGV;
  gab "Parsing $ada_spec_file";
  parse_enum_types($ada_spec_file);
}

@ARGV or die "supply input file name\n";

$inputfile = $ARGV[0];
open(IN, "<$inputfile") or die "cannot open file $inputfile\n";
$outputfile = $inputfile;
if ($inputfile =~ /\.gui$/i) {
    $outputfile =~ s/\.gui$/.ui/i;
} else {
    $outputfile .= ".ui";
}
open(OUT, ">$outputfile") or die "cannot create file $outputfile\n";
dent '<?xml version="1.0" encoding="UTF-8"?>';
indent '<interface>';
dent('<!-- generated by rapid2glade.pl version ' . $Version . ' -->');
dent '<requires lib="gtk+" version="2.24"/>';
dent '<!-- interface-naming-policy project-wide -->';

# We need a preparatory pass for translating PICTUREBUTTONs because the
# participating GtkImages shall be parentless.  In the further passes,
# the nesting is such that the GtkImages would have the GtkWindow as
# their parent - which is not what we want.
while (($line = <IN>)) {
    chop $line;
    next if ($line =~ /^\s*$/);
    @token = split /\s+/, $line;
    my $keyword = $token[0];
    if ($keyword eq 'PICTUREBUTTON') {
        my $img_id = $token[1] . '_img';
        my $file = string2xml($token[7]);
        # PICTUREBUTTON openButton 27 0 27 27 "File_Menu.Open_Choice"  "open_gif.gif"  "Open"
        indent "<object class=\"GtkImage\" id=\"$img_id\">";
        dent   '<property name="visible">True</property>';
        dent   '<property name="can_focus">False</property>';
        dent   "<property name=\"pixbuf\">$file</property>";
        dedent "</object>";
    }
}
close IN;                # end of PICTUREBUTTON GtkImage generation
open(IN, "<$inputfile"); # rewind file for WINDOW handling
# Find WINDOW line
while (($line = <IN>)) {
    if ($line =~ /^WINDOW /) {
        chop $line;
        last;
    }
}
my $window = "";
my $title = "";
if ($line =~ /^WINDOW +"(\w+)" +"([^"]*)"/) {
    $window = $1;
    $title = $2;
} else {
  die "expecting WINDOW in first line of input file\n";
}
$line =~ s/WINDOW +"\w+" +"[^"]*" *//;
$readwrite = $line !~ / READ_ONLY/;
$frame_child = $line =~ / FRAME_CHILD/;
@token = split /\s+/, $line;
my $vbox_name = "vbox0";
if ($frame_child) {
    # WINDOW "transit_times_frame" "Transit Time Analysis" FALSE 613 692 FRAME_CHILD "sns_frame" READ_ONLY
    $vbox_name = $window;
} else {
    # Example of pre 3.3 RAPID format:
    # WINDOW "platform_specific_data_normal" "Platform Specific Data Normal"  973 499 
    indent("<object class=\"GtkWindow\" id=\"$window\">");
    dent('<property name="visible">True</property>');
    dent('<property name="can_focus">False</property>');
    dent('<property name="title" translatable="yes">' . string2xml($title) . '</property>');
    dent('<signal name="destroy" handler="destroy_cb" swapped="no"/>');
    indent '<child>';
}

indent("<object class=\"GtkVBox\" id=\"$vbox_name\">");
dent('<property name="visible">True</property>');
dent('<property name="can_focus">False</property>');
push @iddcl, [ $vbox_name, 'Gtk.Box.Gtk_Vbox' ];
push @idass, "$vbox_name := Gtk.Box.Gtk_Vbox (Builder.Get_Object (\"$vbox_name\"));";
$window_width = 0;   # will usually be overwritten by true width
$window_height = 0;  # will usually be overwritten by true height
# Try to find the window width in the WINDOW line
my $i;
for ($i = $#token; $i > 0; $i--) {
    if ($token[$i] =~ /^\d+$/ and $token[$i - 1] =~ /^\d+$/) {
        $window_width = $token[$i - 1];
        $window_height = $token[$i];
        last;
    }
}
# Menu bar and pre 3.3 compatibility pass
while (($line = <IN>)) {
    chop $line;
    next if ($line =~ /^\s*$/);
    if ($line =~ /^\s*(TRUE|FALSE)$/) {
        # WINDOW novice-mode indicator is on separate line pre 3.3 file format
        next;
    }
    @token = split /\s+/, $line;
    if ($token[0] =~ /^\d+$/) {
        # WINDOW width and height are on separate line pre 3.3 file format
        $window_width = $token[0];
        $window_height = $token[1];
        next;
    }
    my $keyword = $token[0];
    last if ($keyword eq 'WIDGETS');
    if ($keyword eq 'MENUBAR') {
        # Nothing to do here; handling MENU and ITEM is sufficient.
    } elsif ($keyword eq 'MENU') {
        # MENU "File" 1 "null"
        my $name = string2xml($token[1]);
        my $underline = $token[2];
        if ($underline) {
            $name = "_$name";
        }
        my $ada_cb = "";
        if (scalar(@token) > 3) {
            $ada_cb = normalize($item[3]);
        }
        push @menubar, [ $name, $ada_cb, [] ];
    } elsif ($keyword eq 'ITEM') {
        # ITEM "Open" 1 "Ada.ItemProc" Ctrl+o
        shift @token;
        my $name = string2xml(shift @token);
        my $underline = shift @token;
        if ($underline and $underline =~ /^\d+$/) {
            if (--$underline) {
                $name = substr($name, 0, $underline) . '_' . substr($name, $underline);
            } else {
                $name = "_$name";
            }
        }
        @menubar or die "Invalid input file: ITEM without preceding MENU\n";
        push @{$menubar[$#menubar]->[2]}, [ $name, @token ];
    }
}
close IN;                # end of menubar handling
indent "<child>";
indent "<object class=\"GtkFixed\" id=\"fixed1\">";
dent('<property name="width_request">' . $window_width . '</property>');
dent('<property name="height_request">' . $window_height . '</property>');
dent('<property name="visible">True</property>');
dent('<property name="can_focus">False</property>');
dent('<property name="border_width">4</property>');
my $sm_name_ada = "Image_Menu_Item";
my $sm_name = $sm_name_ada;
$sm_name =~ s/_//g;
if (@menubar) {
    indent('<child>');
    indent('<object class="GtkMenuBar" id="menubar1">');
    dent('<property name="width_request">300</property>');
    dent('<property name="height_request">20</property>');
    dent('<property name="visible">True</property>');
    dent('<property name="can_focus">False</property>');
    for (my $i = 0; $i < scalar(@menubar); $i++) {
        my $name   = $menubar[$i]->[0];
        my $ada_cb = $menubar[$i]->[1];
        my @items = @{$menubar[$i]->[2]};
        my $id = "menuitem" . $i;
        indent('<child>');
        indent("<object class=\"GtkMenuItem\" id=\"$id\">");
        dent('<property name="visible">True</property>');
        dent('<property name="can_focus">False</property>');
        dent("<property name=\"label\" translatable=\"yes\">$name</property>");
        if ($name =~ /^_/) {
            dent('<property name="use_underline">True</property>');
        }
        push @iddcl, [ $id, 'Gtk.Menu_Item.Gtk_Menu_Item' ];
        push @idass, "$id := Gtk.Menu_Item.Gtk_Menu_Item (Builder.Get_Object (\"$id\"));";
        if ($ada_cb && $ada_cb ne "null") {
            dent("<signal name=\"select\" handler=\"${id}_select_cb\" swapped=\"no\"/>");
            if ($ada_cb =~ /\./) {
                warn "MENU : creation of $ada_cb is not yet implemented\n";
            } else {
                push_action_callback($ada_cb);
                push @reghdl, "   --  Attach signal handler for ${id}_select_cb";
                push @reghdl, "   GtkAda.Builder.Register_Handler";
                push @reghdl, "     (Builder      => Builder,";
                push @reghdl, "      Handler_Name => \"${id}_select_cb\",";
                push @reghdl, "      Handler      => ${ada_cb}'Access);";
            }
        }
        indent('<child type="submenu">');
        my $mid = "${id}submenu";
        dent("<object class=\"GtkMenu\" id=\"$mid\">");
        dent('<property name="visible">True</property>');
        dent('<property name="can_focus">False</property>');
        push @iddcl, [ $mid, 'Gtk.Menu.Gtk_Menu' ];
        push @idass, "$mid := Gtk.Menu.Gtk_Menu (Builder.Get_Object (\"$mid\"));";
        for (my $j = 0; $j < scalar(@items); $j++) {
            indent('<child>');
            my @item = @{$items[$j]};
            my $sid = "${id}subitem$j";
            push @iddcl, [ $sid, "Gtk.${sm_name_ada}.Gtk_$sm_name_ada" ];
            push @idass, "$sid := Gtk.${sm_name_ada}.Gtk_$sm_name_ada (Builder.Get_Object (\"$sid\"));";
            indent("<object class=\"Gtk$sm_name\" id=\"$sid\">");
            dent('<property name="label">' . $item[0] . '</property>');
            dent('<property name="visible">True</property>');
            dent('<property name="can_focus">False</property>');
            dent('<property name="use_underline">True</property>');
            dent('<property name="use_stock">True</property>');
            my $activate_handler = $sid . "_activate_cb";
            dent('<signal name="activate" handler="' . $activate_handler . '"/>');
            dedent('</object>');  # GtkImageMenuItem
            dedent('</child>');
            if (scalar(@item) > 1) {
                my $ada_cb = normalize($item[1]);
                if ($ada_cb =~ /\./) {
                    warn "ITEM : creation of $ada_cb is not yet implemented\n";
                } else {
                    push_action_callback($ada_cb);
                    push @reghdl, "   --  Attach signal handler for $sid";
                    push @reghdl, "   GtkAda.Builder.Register_Handler";
                    push @reghdl, "     (Builder      => Builder,";
                    push @reghdl, "      Handler_Name => \"${activate_handler}\",";
                    push @reghdl, "      Handler      => ${ada_cb}'Access);";
                }
            }
        }
        dedent '</object>';       # GtkMenu
        dedent('</child>');
        dedent '</object>';       # GtkMenuItem
        dedent('</child>');
    }
    dedent("</object>");  # end of <object class="GtkMenuBar">
    dedent '</child>';
}
open(IN, "<$inputfile"); # reopen file for widget handling
while (($line = <IN>)) {
    chop $line;
    next if ($line =~ /^\s*$/);
    next if ($line =~ /^\s*(TRUE|FALSE)$/);
    @token = split /\s+/, $line;
    next if ($token[0] =~ /^(\d+|WINDOW|MENUBAR|MENU|ITEM|WIDGETS|ENDOF)$/);
    # Collaterally, strings containing spaces were split.
    # Join them back into a single token.
    for (my $i = 1; $i < $#token; $i++) {
        loop: {  # This extra block is needed for "do" - see `man perlsyn`
            do {
                my @n_quotes = $token[$i] =~ /"/g;
                scalar(@n_quotes) % 2 or last;
                $token[$i] .= ' ' . splice(@token, $i + 1, 1);
            } while (scalar(@token) > 1);
        }
    }
    my $keyword = $token[0];
    if ($keyword eq 'LABEL') {
        # LABEL lb_id 239 10 350 32 "DisplayText" center black white 
        #       or, including optional font:
        # LABEL nr_lab 5 270 290 20 ! SERIF 18 PLAIN "No Ti Sl" left default default
        prolog('GtkLabel', 'Gtk.Label.Gtk_Label');
        my $name = string2xml($token[$#token - 3]);
        my $mcc_justify = $token[$#token - 2];
        dent('<property name="can_focus">False</property>');
        my $justify = '0.5';
        if ($mcc_justify eq 'left') {
            $justify = '0.0';
        } elsif ($mcc_justify eq 'right') {
            $justify = '1.0';
        }
        if ($justify ne '0.5') {
            dent('<property name="xalign">' . $justify . '</property>');
        }
        dent('<property name="label" translatable="yes">' . $name . '</property>');
        my $fg_color = colorname_to_rgb($token[$#token - 1]);
        my $bg_color = colorname_to_rgb($token[$#token]);
        if (defined($fg_color) || defined($bg_color)) {
            indent('<attributes>');
            if (defined($fg_color)) {
                dent('<attribute name="foreground" value="' . $fg_color . '"/>');
            }
            if (defined($bg_color)) {
                dent('<attribute name="background" value="' . $bg_color . '"/>');
            }
            dedent('</attributes>');
        }
        epilog;
    } elsif ($keyword eq 'TEXTENTRY') {
        # TEXTENTRY te_id 275 135 40 20 Ada.Item Ada.Type UNBOUNDED_STRING
        prolog('GtkEntry', 'Gtk.GEntry.Gtk_Entry');
        dent('<property name="editable">True</property>');
        dent('<property name="has_frame">True</property>');
        dent('<property name="width_chars">4</property>');
        my $name = $token[1];
        my($activate_handler, $ada_cb);
        if ($readwrite) {
            $activate_handler = $name . "_activate_cb";
            $ada_cb = ucfirst($activate_handler);
            my $txt_decl = "Txt : constant Glib.UTF8_String := Gtk.GEntry.Get_Text ($name);";
            push @readw, "   declare";
            push @readw, "      $txt_decl";
            push @readw, "   begin";
            if ($gen_all_ada_cbs) {
                dent('<signal name="activate" handler="' . $activate_handler . '"/>');
                push @hdlrs, "--  signal handler for $name";
                my $bldr = "B : access GtkAda.Builder.Gtkada_Builder_Record'Class";
                push @hdlrs, "procedure $ada_cb";
                push @hdlrs, "            ($bldr);";
                push @hdlrb, "procedure $ada_cb";
                push @hdlrb, "            ($bldr) is";
                push @hdlrb, "   $txt_decl";
                push @hdlrb, "begin";
            }
        }
        my $kind = uc($token[$#token]);
        my $ada_type = normalize($token[$#token - 1]);
        my $ada_item = normalize($token[$#token - 2]);
        if ($kind eq 'STRING_SUBTYPE') {
            if ($readwrite) {
                my $rhs = "mcc.Str.Pad (Txt, ${ada_item}'Length)";
                if (length($ada_item) > 30) {
                    push @readw, "      $ada_item :=";
                    push @readw, "         $rhs;";
                    if ($gen_all_ada_cbs) {
                        push @hdlrb, "   $ada_item :=";
                        push @hdlrb, "      $rhs;";
                    }
                } else {
                    push @readw, "      $ada_item := $rhs;";
                    $gen_all_ada_cbs and push @hdlrb, "   $ada_item := $rhs;";
                }
            }
            if (length($ada_item) > 30) {
                push @fillw, "   Gtk.GEntry.Set_Text";
                push @fillw, "     ($name, $ada_item);";
            } else {
                push @fillw, "   Gtk.GEntry.Set_Text ($name, $ada_item);";
            }
        } elsif ($kind eq 'UNBOUNDED_STRING') {
            if ($readwrite) {
                my $stmt = "$ada_item := Ada.Strings.Unbounded.To_Unbounded_String (Txt);";
                push @readw, "      $stmt";
                $gen_all_ada_cbs and push @hdlrb, "   $stmt";
            }
            push @fillw, "   Gtk.GEntry.Set_Text";
            push @fillw, "     ($name, Ada.Strings.Unbounded.To_String ($ada_item));";
            $need_unbounded_string = 1;
        } else {
            my $rhs = "${ada_type}'Value (Txt)";
            my $long_line = (length($ada_item) + length($ada_type) > 60);
            if ($readwrite) {
                if ($long_line) {
                    push @readw, "      $ada_item :=";
                    push @readw, "         $rhs;";
                    if ($gen_all_ada_cbs) {
                        push @hdlrb, "   $ada_item :=";
                        push @hdlrb, "      $rhs;";
                    }
                } else {
                    push @readw, "      $ada_item := $rhs;";
                    $gen_all_ada_cbs and push @hdlrb, "   $ada_item := $rhs;";
                }
            }
            push @fillw, "   Gtk.GEntry.Set_Text"; 
            if ($kind eq 'ENUMERATION') {
                if ($long_line) {
                    push @fillw, "     ($name,";
                    push @fillw, "      ${ada_type}'Image";
                    push @fillw, "        ($ada_item));";
                } else {
                    push @fillw, "     ($name, ${ada_type}'Image ($ada_item));";
                }
            } else {
                my $img_opt = "";
                my $basetype;
                if ($kind =~ /^FLOAT_(\d)$/) {
                   $img_opt = ", $1";
                   $basetype = "Float";
                } elsif ($kind eq 'FLOAT_E') {
                   $basetype = "Float";
                } elsif ($kind eq 'INTEGER') {
                   $basetype = "Integer";
                } elsif ($kind eq 'UNSIGNED') {
                   $basetype = "Interfaces.Unsigned_32";
                   $need_interfaces = 1;
                }
                if ($basetype) {
                    $ada_item = "$basetype ($ada_item)";
                }
                if (length($ada_item) > 47) {
                    push @fillw, "     ($name,";
                    push @fillw, "      mcc.Str.Img";
                    push @fillw, "        ($ada_item$img_opt));";
                } else {
                    push @fillw, "     ($name, mcc.Str.Img ($ada_item$img_opt));";
                }
            }
        }
        if ($readwrite) {
            push @readw, "   end;";
            if ($gen_all_ada_cbs) {
                push @hdlrb, "end $ada_cb;\n";
                push @reghdl, "   --  Attach signal handler for $name";
                push @reghdl, "   GtkAda.Builder.Register_Handler";
                push @reghdl, "     (Builder      => Builder,";
                push @reghdl, "      Handler_Name => \"${activate_handler}\",";
                push @reghdl, "      Handler      => ${ada_cb}'Access);";
            }
        }
        epilog;
    } elsif ($keyword eq 'TEXTBOX') {
        # TEXTBOX tb_id 14 42 565 237 FALSE FALSE default white  Ada.Item
        # TEXTBOX lb1 14 42 565 237 FALSE FALSE default white  "SPS_GUI-Output-J28_2_0_Dbase.Text" "L16_J28_2_STANAG_Types.J28_2_0_Text_T" STRING_SUBTYPE
        prolog('GtkTextView', 'Gtk.Text_View.Gtk_Text_View');
        dent('<property name="can_focus">True</property>');
        dent('<property name="editable">False</property>');
        epilog;
        if (scalar(@token) > 10) {
            unless (grep(/^Gtk.Text_Buffer$/i, @withes)) {
                push @withes, "Gtk.Text_Buffer";
            }
            my $ada_item = normalize($token[10]);
            push @fillw, "   declare";
            push @fillw, "      use type Gtk.Text_Buffer.Gtk_Text_Buffer;";
            push @fillw, "      T_Buf : Gtk.Text_Buffer.Gtk_Text_Buffer := ${name}.Get_Buffer;";
            push @fillw, "      Do_Set_Buff : Boolean := False;";
            push @fillw, "   begin";
            push @fillw, "      for I in ${ada_item}'Range loop";
            push @fillw, "         if ${ada_item} (I) = Ascii.Nul then";
            push @fillw, "            exit;";
            push @fillw, "         elsif ${ada_item} (I) /= ' ' then";
            push @fillw, "            Do_Set_Buff := True;";
            push @fillw, "            exit;";
            push @fillw, "         end if;";
            push @fillw, "      end loop;";
            push @fillw, "      if Do_Set_Buff then";
            push @fillw, "         if T_Buf = null then";
            push @fillw, "            Gtk.Text_Buffer.Gtk_New (T_Buf);";
            push @fillw, "         end if;";
            push @fillw, "         T_Buf.Set_Text ($ada_item);";
            push @fillw, "         ${name}.Set_Buffer (T_Buf)";
            push @fillw, "      end if;";
            push @fillw, "   end;";
        }
    } elsif ($keyword eq 'TEXTBUTTON') {
        my $name = $token[1];
        my $index = 6;
        if ($token[$index] eq '!') {  # font_info: ! font_family font_size font_style
            $index += 4;
        }
        my $ada_cb = string2xml($token[$index]);
        my $label = string2xml($token[$index + 1]);
        # TEXTBUTTON btn_id 320 135 16 21 "actioncallback" "displaytext"
        prolog('GtkButton', 'Gtk.Button.Gtk_Button');
        dent('<property name="label" translatable="yes">' . $label . '</property>');
        dent('<property name="receives_default">False</property>');
        if ($readwrite) {
            my $click_handler = $name . '_clicked_cb';
            dent('<signal name="clicked" handler="' . $click_handler . '"/>');
            if ($ada_cb) {
                if ($ada_cb =~ /\./) {
                    $ada_cb = normalize($ada_cb);
                } else {
                    push_action_callback($ada_cb);
                }
                push @reghdl, "   --  Attach signal handler for $name";
                push @reghdl, "   GtkAda.Builder.Register_Handler";
                push @reghdl, "     (Builder      => Builder,";
                push @reghdl, "      Handler_Name => \"${click_handler}\",";
                push @reghdl, "      Handler      => ${ada_cb}'Access);";
            } else {
                warn "TEXTBUTTON($name) : No Ada callback procedure defined\n";
            }
        } else {
            warn "TEXTBUTTON($name) : WINDOW should be READ_WRITE\n";
        }
        epilog;
    } elsif ($keyword eq 'PICTUREBUTTON') {
        my $name = $token[1];
        # PICTUREBUTTON openButton 27 0 27 27 "File_Menu.Open_Choice"  "open_gif.gif"  "Open"
        prolog('GtkButton', 'Gtk.Button.Gtk_Button');
        dent '<property name="can_focus">True</property>';
        dent '<property name="receives_default">True</property>';
        dent('<property name="image">' . $name . '_img</property>');
        if ($readwrite) {
            my $click_handler = $name . '_clicked_cb';
            dent('<signal name="clicked" handler="' . $click_handler . '" swapped="no"/>');
            my $index = 6;
            if ($token[$index] eq '!') {  # font_info: ! font_family font_size font_style
                $index += 4;
            }
            my $ada_cb = string2xml($token[$index]);
            if ($ada_cb) {
                if ($ada_cb =~ /\./) {
                    $ada_cb = normalize($ada_cb);
                } else {
                    push_action_callback($ada_cb);
                }
                push @reghdl, "   --  Attach signal handler for $name";
                push @reghdl, "   GtkAda.Builder.Register_Handler";
                push @reghdl, "     (Builder      => Builder,";
                push @reghdl, "      Handler_Name => \"${click_handler}\",";
                push @reghdl, "      Handler      => ${ada_cb}'Access);";
            } else {
                warn "PICTUREBUTTON($name) : No Ada callback procedure defined\n";
            }
        } else {
            warn "PICTUREBUTTON($name) : WINDOW should be READ_WRITE\n";
        }
        epilog;
    } elsif ($keyword eq 'CHECKBUTTON') {
        # CHECKBUTTON vertical 220 35 210 20 "Vertical Scrollbar" Ada.Item Ada.Type
        prolog('GtkCheckButton', 'Gtk.Check_Button.Gtk_Check_Button');
        my $name = $token[1];
        my $label = string2xml($token[6]);
        dent('<property name="label" translatable="yes">' . $label . '</property>');
        dent('<property name="can_focus">True</property>');
        if (scalar(@token) > 7) {
            my $ada_item = normalize($token[7]);
            if (scalar(@token) > 8) {
                my $ada_type = normalize($token[8]);
                my $getpos = "Boolean'Pos (${name}.Get_Active)";
                push @fillw, "   ${name}.Set_Active";
                if (length($ada_item) + length($ada_type) > 44) {
                    if ($readwrite) {
                        push @readw, "   $ada_item :=";
                        push @readw, "      ${ada_type}'Val ($getpos);";
                    }
                    push @fillw, "     (Boolean'Val";
                    push @fillw, "        (${ada_type}'Pos";
                    push @fillw, "           ($ada_item)));";
                } else {
                    if ($readwrite) {
                        push @readw, "   $ada_item := ${ada_type}'Val ($getpos);";
                    }
                    push @fillw, "     (Boolean'Val (${ada_type}'Pos ($ada_item)));";
                }
            } else {
                if ($readwrite) {
                    push @readw, "   $ada_item := ${name}.Get_Active;";
                }
                push @fillw, "   ${name}.Set_Active ($ada_item);";
            }
        }
        epilog;
    } elsif ($keyword eq 'RADIOBUTTON') {
        # RADIOBUTTON horizontal 321 126 100 20 "Horizontal" "Orientation"
        prolog('GtkRadioButton', 'Gtk.Radio_Button.Gtk_Radio_Button');
        my $name = string2xml($token[6]);
        dent('<property name="label" translatable="yes">' . $name . '</property>');
        dent('<property name="can_focus">True</property>');
        epilog;
    } elsif ($keyword eq 'DROPDOWN') {
        # DROPDOWN dd_id 223 85 180 22 16 black white Ada.Item Ada.Type
        prolog('GtkComboBoxText', 'Gtk.Combo_Box_Text.Gtk_Combo_Box_Text');
        dent('<property name="focus_on_click">True</property>');
        # dent('<property name="enable_arrow_keys">True</property>');
        my $name = $token[1];
        unless (scalar(@token) > 9) {
            epilog;
            next;
        }
        my $ada_item = normalize($token[9]);
        my $ada_type = normalize($token[10]);
        my $cache_index = lc($ada_type);
        if (exists $enum_types{$cache_index}) {
            my @literals = @{$enum_types{$cache_index}};
            indent "<items>";
            foreach (@literals) {
                dent "<item>$_</item>";
            }
            dedent "</items>";
        } elsif ($cache_index eq "boolean") {
            indent "<items>";
            dent "<item>False</item>";
            dent "<item>True</item>";
            dedent "</items>";
        }
        my $change_handler = $name . "_changed_cb";
        my $ada_cb = ucfirst($change_handler);
        if ($readwrite) {
            my $pos_decl = "Pos : constant Glib.Gint := ${name}.Get_Active;";
            push @readw, "   declare";
            push @readw, "      $pos_decl";
            push @readw, "   begin";
            push @readw, "      if Pos < 0 then";
            push @readw, "         return;";
            push @readw, "      end if;";
            if ($gen_all_ada_cbs) {
                dent('<signal name="changed" handler="' . $change_handler . '"/>');
                push @hdlrs, "--  signal handler for $name";
                my $bldr = "B : access GtkAda.Builder.Gtkada_Builder_Record'Class";
                push @hdlrs, "procedure $ada_cb";
                push @hdlrs, "            ($bldr);";
                push @hdlrb, "procedure $ada_cb";
                push @hdlrb, "            ($bldr) is";
                push @hdlrb, "   $pos_decl";
                push @hdlrb, "begin";
                push @hdlrb, "   if Pos < 0 then";
                push @hdlrb, "      return;";
                push @hdlrb, "   end if;";
            }
        }
        my $rhs = "${ada_type}'Val (Pos)";
        if (length($ada_item) + length($ada_type) > 60) {
            if ($readwrite) {
                push @readw, "      $ada_item :=";
                push @readw, "         $rhs;";
                if ($gen_all_ada_cbs) {
                    push @hdlrb, "   $ada_item :=";
                    push @hdlrb, "      $rhs;";
                }
            }
            push @fillw, "   ${name}.Set_Active";
            push @fillw, "     (${ada_type}'Pos";
            push @fillw, "        ($ada_item));";
        } else {
            if ($readwrite) {
                push @readw, "      $ada_item := $rhs;";
                $gen_all_ada_cbs and push @hdlrb, "   $ada_item := $rhs;";
            }
            push @fillw, "   ${name}.Set_Active";
            push @fillw, "     (${ada_type}'Pos ($ada_item));";
        }
        if ($readwrite) {
            push @readw, "   end;";
            if ($gen_all_ada_cbs) {
                push @hdlrb, "end $ada_cb;\n";
                push @reghdl, "   --  Attach signal handler for $name";
                push @reghdl, "   GtkAda.Builder.Register_Handler";
                push @reghdl, "     (Builder      => Builder,";
                push @reghdl, "      Handler_Name => \"${change_handler}\",";
                push @reghdl, "      Handler      => ${ada_cb}'Access);";
            }
        }
        epilog;
    } elsif ($keyword eq 'FRAME') {
        # FRAME sns_frame 360 57 850 750 1   (last item is borderwidth - NYI)
        ## prolog('GtkFrame', 'Gtk.Frame.Gtk_Frame');
        ## dent('<property name="can_focus">False</property>');
        prolog('GtkVBox', 'Gtk.Box.Gtk_Vbox');
        epilog;
    } else {
        warn "$keyword is not yet implemented\n";
    }
}
dedent "</object>";   # end of GtkFixed
dedent "</child>";    # GtkFixed is hard coded as child of GtkVBox
dedent "</object>";   # end of GtkVBox
unless ($frame_child) {
    dedent "</child>";    # GtkVBox is hard coded as child of GtkWindow
    dedent "</object>";   # end of GtkWindow
}
dedent('</interface>');
dent('');  # end of output
close IN;
close OUT;

# Write Ada spec and body
my $adawindow = ucfirst($window) . "_Window";
my $specfile = lc($adawindow) . ".ads";
my $bodyfile = lc($adawindow) . ".adb";
open(SPEC, ">$specfile") or die "Cannot create file $specfile\n";
open(BODY, ">$bodyfile") or die "Cannot create file $bodyfile\n";

sub pspec {
    my $str = shift;
    print SPEC $str;
}

sub pbody {
    my $str = shift;
    print BODY $str;
}

sub pboth {
    my $str = shift;
    pspec $str;
    pbody $str;
}

pboth "-- generated by rapid2glade.pl version $Version\n\n";
pspec "with GtkAda.Builder;\n";
unless ($frame_child) {
    pspec "with Gtk.Window;\n";
}
if (@menubar) {
    pspec "with Gtk.Menu_Item;\n";
    pspec "with Gtk.Menu;\n";
    pspec "with Gtk.$sm_name_ada;\n";
}
pspec "with Gtk.Box;\n";
pspec "with Gtk.Label;\n";
pspec "with Gtk.GEntry;\n";
pspec "with Gtk.Button;\n";
pspec "with Gtk.Check_Button;\n";
pspec "with Gtk.Combo_Box_Text;\n";
pspec "with Gtk.Text_View;\n";
pspec "with Gtk.Radio_Button;\n";
pspec "\n";
pspec "package $adawindow is\n\n";
pspec "   Builder : GtkAda.Builder.GtkAda_Builder := null;\n\n";
unless ($frame_child) {
    pspec "   $window : Gtk.Window.Gtk_Window;\n";
}
my $maxidlen = 0;
map { $maxidlen = length($_->[0]) > $maxidlen ? length($_->[0]) : $maxidlen } @iddcl;
foreach (@iddcl) {
    my $id   = $_->[0];
    my $type = $_->[1];
    my $nspc = $maxidlen - length($id) + 1;
    pspec("   " . $id . (' ' x $nspc) . ": $type;\n");
}
pspec "\n";
if ($need_interfaces) {
  pbody "with Interfaces;\n";
}
if ($need_unbounded_string) {
  pbody "with Ada.Strings.Unbounded;\n";
}
pbody "with Ada.Environment_Variables;\n";
pbody "with Glib.Error;\n";
pbody "with Mcc.Str;\n";
pbody "\n";
if (@withes) {
    foreach (@withes) {
        pbody "with $_;\n";
    }
    pbody "\n";
}
pbody "package body $adawindow is\n\n";
pbody "   use type GtkAda.Builder.GtkAda_Builder;\n";
pbody "   use type Glib.Guint;\n";
pbody "   use type Glib.Gint;\n";
pbody "\n";
pbody "   UI_File_Dir : constant String :=\n";
pbody "     Ada.Environment_Variables.Value (\"UI_FILE_DIR\", \"\");\n";
pbody "\n";
pboth "   function Window_Open return Boolean";
pspec ";\n\n";
pbody " is\n";
pbody "   begin\n";
pbody "      return Builder /= null;\n";
pbody "   end Window_Open;\n\n";
pspec "   -- create the window\n";
pboth "   procedure Generate_Window";
pspec ";\n";
pbody " is\n";
pbody "      Filename : constant String := \"$outputfile\";\n";
pbody "      Status : Glib.Guint := 0;\n";
pbody "      Error  : aliased Glib.Error.GError;\n";
pbody "      --  use type Glib.Error.GError;\n";
pbody "   begin\n";
pbody "      if Builder /= null then\n";
pbody "         return;\n";
pbody "      end if;\n";
pbody "      GtkAda.Builder.Gtk_New (Builder);\n";
pbody "      if UI_File_Dir /= \"\" then\n";
pbody "         Status :=\n";
pbody "           GtkAda.Builder.Add_From_File\n";
pbody "             (Builder, UI_File_Dir & '/' & Filename, Error'Unrestricted_Access);\n";
pbody "      else\n";
pbody "         Status := GtkAda.Builder.Add_From_File\n";
pbody "                     (Builder, Filename, Error'Unrestricted_Access);\n";
pbody "      end if;\n";
pbody "      if Status = 0 then\n";
pbody "         raise Constraint_Error;\n";
pbody "      end if;\n";
unless ($frame_child) {
    pbody "      $window := Gtk.Window.Gtk_Window (Builder.Get_Object (\"$window\"));\n";
}
foreach (@idass) {
    pbody "      $_\n";
}
foreach (@reghdl) {
    pbody "   $_\n";
}
unless ($frame_child) {
    pbody "      --  Attach signal handler for window destroy\n";
    pbody "      GtkAda.Builder.Register_Handler\n";
    pbody "        (Builder      => Builder,\n";
    pbody "         Handler_Name => \"destroy_cb\",\n";
    pbody "         Handler      => Close_Window'Access);\n";
}
pbody "      GtkAda.Builder.Do_Connect (Builder);\n";
pbody "   end Generate_Window;\n\n";
pspec "   -- same but usable as a button callback\n";
pboth "   procedure Generate_Window\n";
pboth "     (B : access GtkAda.Builder.Gtkada_Builder_Record'Class)";
pspec ";\n\n";
pbody " is\n";
pbody "      pragma Unreferenced (B);\n";
pbody "   begin\n";
pbody "     Generate_Window;\n";
pbody "   end Generate_Window;\n\n";
if (@fillw) {
    pspec "   -- fill in values as specified in RAPID\n";
    pboth "   procedure Fill_Window";
    pspec ";\n";
    pbody " is\n";
    pbody "   begin\n";
    pbody "      if Builder = null then\n";
    pbody "         -- TBC: Currently, this fails silently.\n";
    pbody "          -- What should be done here: Issue a warning? Raise an exception?\n";
    pbody "         return;\n";
    pbody "      end if;\n";
    foreach (@fillw) {
        pbody "   $_\n";
    }
    pbody "   end Fill_Window;\n\n";
    pspec "   -- same but usable as a button callback\n";
    pboth "   procedure Fill_Window\n";
    pboth "     (B : access GtkAda.Builder.Gtkada_Builder_Record'Class)";
    pspec ";\n\n";
    pbody " is\n";
    pbody "      pragma Unreferenced (B);\n";
    pbody "   begin\n";
    pbody "       Fill_Window;\n";
    pbody "   end Fill_Window;\n\n";
    pspec "   -- -- do both Generate_Window and Fill_Window\n";
    pboth "   procedure Generate_and_Fill_Window";
    pspec ";\n";
    pbody " is\n";
    pbody "   begin\n";
    pbody "       Generate_Window;\n";
    pbody "       Fill_Window;\n";
    pbody "   end Generate_and_Fill_Window;\n\n";
    pspec "   -- same but usable as a button callback\n";
    pboth "   procedure Generate_and_Fill_Window\n";
    pboth "     (B : access GtkAda.Builder.Gtkada_Builder_Record'Class)";
    pspec ";\n\n";
    pbody " is\n";
    pbody "      pragma Unreferenced (B);\n";
    pbody "   begin\n";
    pbody "       Generate_and_Fill_Window;\n";
    pbody "   end Generate_and_Fill_Window;\n\n";
}
if (@readw) {
    pboth "   procedure Read_Window";
    pboth "     (Success : out Boolean)";
    pspec ";\n";
    pbody " is\n";
    pbody "   begin\n";
    pbody "      Success := False;\n";
    pbody "      if Builder = null then\n";
    pbody "         return;\n";
    pbody "      end if;\n";
    foreach (@readw) {
        pbody "   $_\n";
    }
    pbody "      Success := True;\n";
    pbody "   end Read_Window;\n\n";
    pspec "   -- same but usable as a button callback\n";
    pboth "   procedure Read_Window\n";
    pboth "     (B : access GtkAda.Builder.Gtkada_Builder_Record'Class)";
    pspec ";\n\n";
    pbody " is\n";
    pbody "      pragma Unreferenced (B);\n";
    pbody "      Success : Boolean := False;\n";
    pbody "   begin\n";
    pbody "      Read_Window (Success);\n";
    pbody "   end Read_Window;\n\n";
    unless ($frame_child) {
        pboth "   procedure Ok";
        pspec ";\n";
        pbody " is\n";
        pbody "      Success : Boolean := False;\n";
        pbody "   begin\n";
        pbody "      Read_Window (Success);\n";
        pbody "      if Success then\n";
        pbody "         Close_Window;\n";
        pbody "      end if;\n";
        pbody "   end Ok;\n\n";
        pspec "   -- same but usable as a button callback\n";
        pboth "   procedure Ok\n";
        pboth "     (B : access GtkAda.Builder.Gtkada_Builder_Record'Class)";
        pspec ";\n\n";
        pbody " is\n";
        pbody "      pragma Unreferenced (B);\n";
        pbody "   begin\n";
        pbody "      Ok;\n";
        pbody "   end Ok;\n\n";
    }
}
unless ($frame_child) {
    pspec "   -- close the window\n";
    pboth "   procedure Close_Window";
    pspec ";\n";
    pbody " is\n";
    pbody "   begin\n";
    pbody "      Gtk.Window.Destroy ($window);\n";
    pbody "      Builder.Unref;\n";
    pbody "      Builder := null;\n";
    pbody "   end Close_Window;\n\n";
    pspec "   -- same but usable as a button callback\n";
    pboth "   procedure Close_Window\n";
    pboth "     (B : access GtkAda.Builder.Gtkada_Builder_Record'Class)";
    pspec ";\n\n";
    pbody " is\n";
    pbody "      pragma Unreferenced (B);\n";
    pbody "   begin\n";
    pbody "     Close_Window;\n";
    pbody "   end Close_Window;\n\n";
}
if (@separates || @hdlrs) {
    pspec "private\n\n";
}
if (@separates) {
    foreach (@separates) {
        pboth "   procedure $_\n";
        pboth "     (B : access GtkAda.Builder.Gtkada_Builder_Record'Class)";
        pspec ";\n";
        pbody " is separate;\n";
    }
    pboth "\n";
}
if (@hdlrs) {
    foreach (@hdlrs) {
        pspec "   $_\n";
    }
    foreach (@hdlrb) {
        pbody "   $_\n";
    }
    pboth "\n";
}
pboth "end $adawindow;\n";

close SPEC;
close BODY;

1;