3 # Copyright (C) 2004 Naba Kumar <naba@gnome.org>
5 # This program is free software; you can redistribute it and/or modify
6 # it under the terms of the GNU General Public License as published by
7 # the Free Software Foundation; either version 2 of the License, or
8 # (at your option) any later version.
10 # This program is distributed in the hope that it will be useful,
11 # but WITHOUT ANY WARRANTY; without even the implied warranty of
12 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
13 # GNU Library General Public License for more details.
15 # You should have received a copy of the GNU General Public License
16 # along with this program; if not, write to the Free Software
17 # Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
24 die "Usage: perl anjuta-idl-compiler.pl module_name";
27 ## Types starting with prefix mentioned in
28 ## @known_type_prefixes array are automatically assumed to be GObject derived
29 ## class and their type and assertion checks are determined based on that.
30 ## This automation is skipped if the type is found in %not_classes hash table.
31 my $known_type_prefixes = [
39 ## Add your types which are not classes despite starting with above prefixes
44 ## Additional non-standard type mappings.
47 "gtype" => "G_TYPE_NONE",
50 "gtype" => "G_TYPE_STRING",
51 "fail_return" => "NULL"
54 "gtype" => "G_TYPE_STRING",
55 "fail_return" => "NULL"
58 "gtype" => "G_TYPE_CHAR",
62 "gtype" => "G_TYPE_INT",
66 "gtype" => "G_TYPE_BOOLEAN",
67 "fail_return" => "FALSE"
70 "gtype" => "G_TYPE_INTERFACE",
71 "assert" => "G_IS_INTERFACE (__arg__)",
72 "fail_return" => "NULL"
76 "gtype" => "G_TYPE_UCHAR",
77 "assert" => "__arg__ != NULL",
78 "fail_return" => "NULL"
81 "gtype" => "G_TYPE_UCHAR",
82 "assert" => "__arg__ != NULL",
83 "fail_return" => "NULL"
86 "gtype" => "G_TYPE_UINT",
90 "gtype" => "G_TYPE_LONG",
94 "gtype" => "G_TYPE_ULONG",
98 "gtype" => "G_TYPE_INT64",
102 "gtype" => "G_TYPE_UINT64",
108 "gtype" => "G_TYPE_FLOAT",
112 "gtype" => "G_TYPE_DOUBLE",
116 "gtype" => "G_TYPE_POINTER",
117 "assert" => "__arg__ != NULL",
118 "fail_return" => "NULL"
121 "gtype" => "G_TYPE_BOXED",
122 "assert" => "G_IS_VALUE(__arg__)",
123 "fail_return" => "NULL"
126 "gtype" => "G_TYPE_BOXED",
127 "type" => "G_TYPE_ERROR",
128 "fail_return" => "NULL"
132 "gtype" => "G_TYPE_OBJECT",
133 "assert" => "G_IS_OBJECT(__arg__)",
134 "fail_return" => "NULL"
138 my $module_name = $ARGV[0];
139 my $idl_file = "$module_name.idl";
140 open (INFILE
, "<$idl_file")
141 or die "Can not open IDL file for reading";
143 my %marshallers = ();
146 my %class_privates = ();
149 my $parent_class = "";
150 my $current_class = "";
153 my $inside_block = 0;
154 my $inside_comment = 0;
164 while ($line = <INFILE
>)
166 if (is_comment_begin
($line)) {
167 if (current_level
(@level) ne "comment") {
168 push @level, "comment";
171 if (current_level
(@level) eq "comment")
174 if (is_comment_end
($line)) {
175 splice @level, @level - 1, 1;
182 $line =~ s/\/\/.*$//;
185 if ($line =~ /^\s*$/)
191 if ($line =~ /^\#include/)
195 push @global_includes, $line;
199 my $includes_lr = $class_includes[@class_includes-1];
200 push @
$includes_lr, $line;
204 if (is_block_begin
($line))
211 if (is_interface
($line, \
$class))
213 push @level, "interface";
214 if ($current_class ne "")
216 $parent_class = $current_class;
218 push (@class_includes, []);
219 push (@classes, $current_class);
220 $current_class = $class;
221 my $comments_in = get_comments
();
222 compile_class
($data_hr, $parent_class, $comments_in, $current_class);
226 elsif (is_struct
($line, \
$class))
228 push @level, "struct";
233 elsif (is_enum
($line, \
$class))
240 elsif (is_typedef
($line, \
$typedef))
242 die "Parse error at $idl_file:$linenum: typedefs should only be in interface"
243 if (current_level
(@level) ne "interface");
244 die "Parse error at $idl_file:$linenum: Class name expected"
245 if ($current_class eq "");
246 my $comments_in = get_comments
();
247 compile_typedef
($data_hr, $current_class, $comments_in, $typedef);
254 if (is_method
($line, $method_hr)) {
255 die "Parse error at $idl_file:$linenum: Methods should only be in interface"
256 if (current_level
(@level) ne "interface");
257 die "Parse error at $idl_file:$linenum: Class name expected"
258 if ($current_class eq "");
259 my $comments_in = get_comments
();
260 compile_method
($data_hr, $parent_class, $current_class, $comments_in, $method_hr);
264 if (is_block_end
($line))
266 if (current_level
(@level) eq "interface")
268 compile_inclues
($data_hr, $current_class);
269 splice @class_includes, @class_includes - 1, 1;
274 $current_class = splice @classes, @classes - 1, 1;
278 $parent_class = $classes[@classes -1];
282 elsif (current_level
(@level) eq "struct")
284 my $comments_in = get_comments
();
285 $not_classes->{"$current_class$struct"} = "1";
286 compile_struct
($data_hr, $current_class, $struct,
287 $comments_in, @collector);
292 elsif (current_level
(@level) eq "enum")
294 my $comments_in = get_comments
();
295 $not_classes->{"$current_class$enum"} = "1";
296 compile_enum
($data_hr, $current_class, $enum,
297 $comments_in, @collector);
302 splice @level, @level - 1, 1;
305 die "Parse error at $idl_file:$linenum: Type name or method expected"
306 if (current_level
(@level) ne "struct" and
307 current_level
(@level) ne "enum");
308 push @collector, $line;
312 ## print Dumper($data_hr);
313 ## print Dumper(\%class_privates);
314 ## print Dumper($not_classes);
316 generate_files
($data_hr);
323 ## print "Comment begin\n";
334 ## print "Block End\n";
343 if ($line =~ /^\s*\{\s*$/)
345 ## print "Block begin\n";
354 if ($line =~ /^\s*\}\s*$/)
356 ## print "Block End\n";
364 my ($line, $class_ref) = @_;
365 if ($line =~ /^\s*interface\s*([\w|_]+)\s*$/)
368 ## print "Interface: $line\n";
376 my ($line, $class_ref) = @_;
377 if ($line =~ /^\s*enum\s*([\w\d|_]+)\s*$/)
380 add_class_private
($current_class, $enum_name);
381 $$class_ref = $enum_name;
382 ## print "Enum: $line\n";
390 my ($line, $class_ref) = @_;
391 if ($line =~ /^\s*struct\s*([\w\d|_]+)\s*$/)
393 my $struct_name = $1;
394 $$class_ref = $struct_name;
395 add_class_private
($current_class, $struct_name);
396 ## print "Struct: $line\n";
404 my ($line, $typedef_ref) = @_;
405 if ($line =~ /^\s*typedef\s*/)
407 ## Check if it is variable typedef and grab the typedef name.
408 if ($line =~ /([\w_][\w\d_]+)\s*;\s*$/)
410 add_class_private
($current_class, $1);
412 ## Check if it is function typedef and grab the typedef name.
413 elsif ($line =~ /\(\s*\*([\w_][\w\d_]+)\s*\)/)
415 add_class_private
($current_class, $1);
417 $$typedef_ref = $line;
418 ## print "Typedef: $line\n";
426 my ($line, $method_hr) = @_;
427 if ($line =~ s/([\w_][\w\d_]*)\s*\((.*)\)\s*\;\s*$//)
432 $function =~ s/^\s+//;
433 $function =~ s/\s+$//;
436 $rettype =~ s/^\s+//;
437 $rettype =~ s/\s+$//;
438 if ($rettype =~ s/\:\:$//) {
439 $function = "::".$function;
441 $rettype =~ s/\s+$//;
443 $method_hr->{'function'} = $function;
444 $method_hr->{'rettype'} = $rettype;
445 $method_hr->{'args'} = $args;
446 ## print "Function: $line\n";
452 sub normalize_namespace
454 my ($current_class, $text) = @_;
456 my $iter_class = $current_class;
459 if (defined ($class_privates{$iter_class}))
461 foreach my $p (@
{$class_privates{$iter_class}})
463 $text =~ s/\b$p\b/$iter_class$p/g;
466 if (defined ($data_hr) &&
467 defined ($data_hr->{$iter_class}) &&
468 defined ($data_hr->{$iter_class}->{"__parent"}))
470 $iter_class = $data_hr->{$iter_class}->{"__parent"};
483 ## return splice @l, @l - 1, 1;
484 return $_[@_-1] if (@_ > 0);
490 my $comments_in = $comments;
495 $comments_in =~ s/^\t+//mg;
499 sub add_class_private
501 my ($class, $type) = @_;
502 if (!defined ($class_privates{$class}))
504 $class_privates{$class} = [];
506 push (@
{$class_privates{$class}}, $type);
511 my ($class, $type) = @_;
512 if (defined ($class_privates{$class}))
514 foreach my $p (@
{$class_privates{$class}})
527 my ($data_hr, $parent, $comments, $class) = @_;
528 die "Error $idl_file:$linenum: Class $class already exist"
529 if (ref($data_hr->{$class}) eq 'HASH');
530 $data_hr->{$class} = {};
531 my $class_ref = $data_hr->{$class};
533 $class_ref->{'__parent'} = $parent;
534 $class_ref->{'__comments'} = $comments;
539 my ($data_hr, $parent, $class, $comments, $method_hr) = @_;
540 die "Error $idl_file:$linenum: Class $class doesn't exist"
541 if (ref($data_hr->{$class}) ne 'HASH');
542 my $class_hr = $data_hr->{$class};
543 my $method = $method_hr->{'function'};
545 die "Error $idl_file:$linenum: Method $method already defined for class $class."
546 if (ref($class_hr->{$method}) eq 'HASH');
548 $method_hr->{'__comments'} = $comments;
549 $class_hr->{$method} = $method_hr;
554 my ($data_hr, $class) = @_;
555 die "Error $idl_file:$linenum: Class $class doesn't exist"
556 if (ref($data_hr->{$class}) ne 'HASH');
557 my $class_hr = $data_hr->{$class};
559 if (ref($class_hr->{"__include"}) ne 'ARRAY')
562 foreach my $inc (@global_includes)
564 ## Normalize includes.
565 $inc =~ s/\"(.+)\"/\<$module_name\/interfaces\
/$1\>/;
566 push @includes, $inc;
568 my $class_incs_lr = $class_includes[@class_includes-1];
569 foreach my $inc (@
$class_incs_lr)
571 $inc =~ s/\"(.+)\"/\<$module_name\/interfaces\
/$1\>/;
572 push @includes, $inc;
574 $class_hr->{'__include'} = \
@includes;
580 my ($data_hr, $current_class, $comments, $typedef) = @_;
581 my $class_hr = $data_hr->{$current_class};
582 if (!defined($class_hr->{"__typedefs"}))
584 $class_hr->{"__typedefs"} = [];
586 my $typedefs_lr = $class_hr->{"__typedefs"};
587 push (@
$typedefs_lr, $typedef);
592 my ($data_hr, $parent, $class, $comments, @collector) = @_;
593 my $class_hr = $data_hr->{$parent};
594 if (!defined($class_hr->{"__enums"}))
596 $class_hr->{"__enums"} = {};
598 my $enums_hr = $class_hr->{"__enums"};
600 my @data = @collector;
601 $enums_hr->{$class} = {};
602 $enums_hr->{$class}->{"__parent"} = $parent;
603 $enums_hr->{$class}->{"__comments"} = $comments;
604 $enums_hr->{$class}->{"__data"} = \
@data;
606 ## Add to @not_classes and $type_map
612 my $type_map_item_hr = {};
613 my $enum_fullname = "$parent$class";
615 # Add to @not_classes
616 $not_classes->{$enum_fullname} = 1;
619 get_canonical_names
($enum_fullname, \
$prefix, \
$macro_prefix,
620 \
$macro_suffix, \
$macro_name);
621 ## print "Enum Fullname: $enum_fullname\n";
622 $type_map_item_hr->{'gtype'} = 'G_TYPE_ENUM';
623 $type_map_item_hr->{'rettype'} = '0';
624 $type_map_item_hr->{'type'} = $macro_prefix."_TYPE_".$macro_suffix;
625 $type_map->{$enum_fullname} = $type_map_item_hr;
631 my ($data_hr, $parent, $class, $comments, @collector) = @_;
632 my $class_hr = $data_hr->{$parent};
633 if (!defined($class_hr->{"__structs"}))
635 $class_hr->{"__structs"} = {};
637 my $structs_hr = $class_hr->{"__structs"};
639 my @data = @collector;
640 $structs_hr->{$class} = {};
641 $structs_hr->{$class}->{"__parent"} = $parent;
642 $structs_hr->{$class}->{"__comments"} = $comments;
643 $structs_hr->{$class}->{"__data"} = \
@data;
645 ## Add to @not_classes and $type_map
651 my $type_map_item_hr = {};
652 my $struct_fullname = "$parent$class";
654 # Add to @not_classes
655 $not_classes->{$struct_fullname} = 1;
658 ## print "haha struct $struct_fullname\n";
659 $type_map_item_hr->{'gtype'} = 'G_TYPE_POINTER';
660 $type_map_item_hr->{'rettype'} = 'NULL';
661 $type_map_item_hr->{'type'} = "G_TYPE_POINTER";
662 $type_map->{"${struct_fullname}*"} = $type_map_item_hr;
666 ## GObject based C class files
670 foreach my $c (sort keys %$data_hr)
672 my $parent = $data_hr->{$c}->{'__parent'};
673 print "Evaluating Interface $c";
678 generate_class
($c, $data_hr->{$c});
685 sub get_canonical_names
687 my ($class, $cano_name_ref, $cano_macro_prefix_ref,
688 $cano_macro_suffix_ref, $cano_macro_ref) = @_;
691 while ($c =~ s/([A-Z])/\@$1\@/)
695 ## print "Word separator: $uw\n";
697 $c =~ s/\@$uw\@/_$lw/;
699 $c =~ s/_(\w)_/_$1/g;
703 if ($suffix =~ s/(\w+?)_//)
708 $$cano_name_ref = $c;
709 $$cano_macro_prefix_ref = uc($prefix);
710 $$cano_macro_suffix_ref = uc($suffix);
711 $$cano_macro_ref = uc($c);
714 sub get_arg_type_info
716 my ($type, $info) = @_;
717 if (defined ($type_map->{$type}))
719 if (defined ($type_map->{$type}->{$info}))
721 return $type_map->{$type}->{$info};
726 sub get_return_type_val
729 my $fail_ret = get_arg_type_info
($rettype, "fail_return");
730 if (!defined($fail_ret) || $fail_ret eq "")
732 ## Return NULL for pointer types
733 if ($rettype =~ /\*$/ ||
734 $rettype =~ /gpointer/)
748 my ($rettype, $type_arg, $force) = @_;
750 if ($type_arg =~ s/([\w_][\w\d_]*)+$//)
756 if (!defined($force) || $force eq "")
760 my $ainfo = get_arg_type_info
($type, "assert");
761 if (!defined($ainfo) || $ainfo eq "")
763 my $saved_type = $type;
766 ## Check if it is registred non-class type
767 foreach my $nc (keys %$not_classes)
774 # Correctly handle pointers to points (e.g AnjutaType** xy)
775 if ($saved_type =~ /\*\*$/)
779 ## Autodetect type assert
781 (($saved_type =~ /\*$/) &&
785 $type =~ /^Anjuta/ ||
786 $type =~ /^IAnjuta/)))
792 get_canonical_names
($type, \
$prefix, \
$macro_prefix,
793 \
$macro_suffix, \
$macro_name);
794 $ainfo = $macro_prefix."_IS_".$macro_suffix."(__arg__)";
798 ## die "Cannot determine assert macro for type '$type'. Fix it first";
802 if ($rettype eq "void")
804 $ainfo =~ s/__arg__/$arg/;
805 my $ret = "g_return_if_fail ($ainfo);";
810 my $fail_ret = get_return_type_val
($rettype);
811 if (defined($fail_ret))
813 $ainfo =~ s/__arg__/$arg/;
814 my $ret = "g_return_val_if_fail ($ainfo, $fail_ret);";
818 die "Cannot determine failed return value for type '$rettype'. Fix it first";
821 sub construct_marshaller
823 my ($rettype, $args) = @_;
826 my $rtype = get_arg_type_info
($rettype, "gtype");
827 if (!defined($rtype) or $rtype eq '')
829 die "Can not find GType for arg type '$rettype'. Fix it first.";
831 my $args_list = $rtype.",\n\t\t\t__arg_count__";
832 $rtype =~ s/^G_TYPE_//;
833 $rtype =~ s/NONE/VOID/;
834 my $marshal_index = $rtype. "_";
839 my @margs = split(",", $args);
840 foreach my $one_arg (@margs)
842 if ($one_arg =~ s/([\w_][\w\d_]*)$//)
845 my $arg_gtype = get_arg_type_info
($one_arg, "gtype");
846 my $arg_type = get_arg_type_info
($one_arg, "type");
848 if (!defined($arg_gtype) or $arg_gtype eq '')
850 die "Can not find GType for arg type '$one_arg'. Fix it first.";
852 if (!defined($arg_type) or $arg_type eq '')
854 $arg_type = $arg_gtype;
856 $args_list .= ",\n\t\t\t$arg_type";
857 $arg_gtype =~ s/^G_TYPE_//;
858 $arg_gtype =~ s/NONE/VOID/;
859 $marshal_index .= "_$arg_gtype";
864 $args_list =~ s/__arg_count__/$arg_count/;
867 $args_list .= ",\n\t\t\tNULL";
868 $marshal_index .= "_VOID";
870 $marshallers{$marshal_index} = 1;
871 $marshal_index = "${module_name}_iface_cclosure_marshal_$marshal_index";
872 return $marshal_index.",\n\t\t\t".$args_list;
879 if ($ret =~ /const List<.*>/)
881 return "const GList*";
883 elsif ($ret =~ /List<.*>/)
896 my @argsv = split(',', $args);
897 foreach my $arg (@argsv)
899 if ($arg =~ /const List<.*>.*/)
901 my @arg_name = split(' ', $arg);
902 $arg = join(' ',"const GList*", $arg_name[-1]);
904 elsif ($arg =~ /.*List<.*>.*/)
906 my @arg_name = split(' ', $arg);
907 $arg = join(' ', "GList*", $arg_name[-1]);
910 $args = join(', ', @argsv);
917 $e = substr($e, 0, 1) . "_" . substr($e, 1);
923 my ($class, $class_hr) = @_;
924 my $parent = $class_hr->{'__parent'};
931 get_canonical_names
($class, \
$prefix, \
$macro_prefix,
932 \
$macro_suffix, \
$macro_name);
934 my $macro_type = "${macro_prefix}_TYPE_${macro_suffix}";
935 my $macro_assert = "${macro_prefix}_IS_${macro_suffix}";
937 $macro_assert =~ /^_/;
939 my $parent_iface = "GTypeInterface";
940 my $parent_type = "G_TYPE_OBJECT";
941 my $parent_include = "";
944 my ($pprefix, $pmacro_name, $pmacro_prefix, $pmacro_suffix);
945 $parent_iface = "${parent}Iface";
947 get_canonical_names
($parent, \
$pprefix, \
$pmacro_prefix,
948 \
$pmacro_suffix, \
$pmacro_name);
949 $parent_type = $pmacro_prefix."_TYPE_".$pmacro_suffix;
951 $parent_include = $pprefix.".h";
954 ## print "\tmethod prefix: $prefix\n";
955 ## print "\tmacro prefix: $macro_prefix\n";
956 ## print "\tmacro suffix: $macro_suffix\n";
957 ## print "\tmacro name: $macro_name\n\n";
959 my $filename = "$prefix.h";
960 $filename =~ s/_/-/g;
963 "/* -*- Mode: C; indent-tabs-mode: t; c-basic-offset: 4; tab-width: 4 -*- */
965 * $filename -- Autogenerated from $idl_file
967 * This program is free software; you can redistribute it and/or modify
968 * it under the terms of the GNU General Public License as published by
969 * the Free Software Foundation; either version 2 of the License, or
970 * (at your option) any later version.
972 * This program is distributed in the hope that it will be useful,
973 * but WITHOUT ANY WARRANTY; without even the implied warranty of
974 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
975 * GNU Library General Public License for more details.
977 * You should have received a copy of the GNU General Public License
978 * along with this program; if not, write to the Free Software
979 * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
982 #ifndef _${macro_name}_H_
983 #define _${macro_name}_H_
986 my $class_incs_lr = $class_hr->{"__include"};
987 foreach my $inc (@
$class_incs_lr)
991 if ($parent_include ne "")
993 $answer .= "#include <$module_name/interfaces/$parent_include>\n";
999 #define $macro_type (${prefix}_get_type ())
1000 #define ${macro_name}(obj) (G_TYPE_CHECK_INSTANCE_CAST ((obj), $macro_type, $class))
1001 #define ${macro_assert}(obj) (G_TYPE_CHECK_INSTANCE_TYPE ((obj), $macro_type))
1002 #define ${macro_name}_GET_IFACE(obj) (G_TYPE_INSTANCE_GET_INTERFACE ((obj), $macro_type, ${class}Iface))
1005 # Enum GType macros.
1006 my $enums_hr = $class_hr->{"__enums"};
1007 if (defined ($enums_hr))
1009 foreach my $e (sort keys %$enums_hr)
1011 # add an underscore if necassery
1013 $se =~ s/[a-z][A-Z]/enum_split($&)/e;
1014 my $e_upper = uc($se);
1015 my $e_lower = lc($se);
1016 my $e_macro = "${macro_type}_${e_upper}";
1017 my $e_proto = "${prefix}_${e_lower}_get_type";
1019 "#define $e_macro ($e_proto())
1026 if (defined ($enums_hr))
1028 foreach my $e (sort keys %$enums_hr)
1030 $answer .= "typedef enum {\n";
1031 foreach my $d (@
{$enums_hr->{$e}->{"__data"}})
1033 $answer .= "\t${macro_name}_$d\n";
1035 $answer .= "} ${class}$e;\n\n";
1039 my $structs_hr = $class_hr->{"__structs"};
1040 if (defined ($structs_hr))
1042 foreach my $s (sort keys %$structs_hr)
1044 $answer .= "typedef struct _${class}$s ${class}$s;\n";
1045 $answer .= "struct _${class}$s {\n";
1046 foreach my $d (@
{$structs_hr->{$s}->{"__data"}})
1048 $d = normalize_namespace
($class, $d);
1049 $answer .= "\t$d\n";
1051 $answer .= "};\n\n";
1056 "#define ${macro_name}_ERROR ${prefix}_error_quark()
1060 my $typedefs_lr = $class_hr->{"__typedefs"};
1061 if (defined ($typedefs_lr))
1063 foreach my $td (@
$typedefs_lr)
1065 $td = normalize_namespace
($class, $td);
1066 $answer .= $td . "\n";
1072 "typedef struct _$class $class;
1073 typedef struct _${class}Iface ${class}Iface;
1075 struct _${class}Iface {
1076 $parent_iface g_iface;
1079 foreach my $m (sort keys %$class_hr)
1081 next if ($m =~ /^__/);
1082 my $func = $class_hr->{$m}->{'function'};
1083 my $rettype = normalize_namespace
($class, $class_hr->{$m}->{'rettype'});
1084 my $args = normalize_namespace
($class, $class_hr->{$m}->{'args'});
1085 $args = convert_args
($args);
1090 if ($func =~ s/^\:\://)
1092 $rettype = convert_ret
($rettype);
1093 $answer .= "\t/* Signal */\n";
1094 $answer .= "\t$rettype (*$func) ($class *obj${args});\n";
1098 foreach my $m (sort keys %$class_hr)
1100 next if ($m =~ /^__/);
1101 my $func = $class_hr->{$m}->{'function'};
1102 my $rettype = normalize_namespace
($class, $class_hr->{$m}->{'rettype'});
1103 my $args = normalize_namespace
($class, $class_hr->{$m}->{'args'});
1104 $args = convert_args
($args);
1109 if ($func !~ /^\:\:/)
1111 $rettype = convert_ret
($rettype);
1112 $answer .= "\t$rettype (*$func) ($class *obj, ${args}GError **err);\n";
1119 # Enum GType prototypes.
1120 if (defined ($enums_hr))
1122 foreach my $e (sort keys %$enums_hr)
1124 # add an underscore if necassery
1126 $se =~ s/[a-z][A-Z]/enum_split($&)/e;
1127 my $e_lower = lc($se);
1128 my $e_proto = "${prefix}_${e_lower}_get_type";
1130 "GType $e_proto (void);
1137 GQuark ${prefix}_error_quark (void);
1138 GType ${prefix}_get_type (void);
1141 foreach my $m (sort keys %$class_hr)
1143 next if ($m =~ /^__/);
1144 my $func = $class_hr->{$m}->{'function'};
1145 my $rettype = normalize_namespace
($class, $class_hr->{$m}->{'rettype'});
1146 my $args = normalize_namespace
($class, $class_hr->{$m}->{'args'});
1147 $args = convert_args
($args);
1152 if ($func !~ /^\:\:/)
1154 $rettype = convert_ret
($rettype);
1155 $answer .= "${rettype} ${prefix}_$func ($class *obj, ${args}GError **err);\n\n";
1164 write_file
($filename, $answer);
1165 push @header_files, $filename;
1170 my $headerfile = $filename;
1171 $filename = "$prefix.c";
1172 $filename =~ s/_/-/g;
1173 my $dash_prefix = $prefix;
1174 $dash_prefix =~ s/_/-/g;
1176 "/* -*- Mode: C; indent-tabs-mode: t; c-basic-offset: 4; tab-width: 4 -*- */
1178 * $filename -- Autogenerated from $idl_file
1180 * This program is free software; you can redistribute it and/or modify
1181 * it under the terms of the GNU General Public License as published by
1182 * the Free Software Foundation; either version 2 of the License, or
1183 * (at your option) any later version.
1185 * This program is distributed in the hope that it will be useful,
1186 * but WITHOUT ANY WARRANTY; without even the implied warranty of
1187 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
1188 * GNU Library General Public License for more details.
1190 * You should have received a copy of the GNU General Public License
1191 * along with this program; if not, write to the Free Software
1192 * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
1196 # Added class (section) comments
1197 $answer .= $class_hr->{"__comments"};
1200 #include \"$headerfile\"
1201 #include \"$module_name-iface-marshallers.h\"
1204 ${prefix}_error_quark (void)
1206 static GQuark quark = 0;
1209 quark = g_quark_from_static_string (\"${dash_prefix}-quark\");
1216 foreach my $m (sort keys %$class_hr)
1218 next if ($m =~ /^__/);
1219 my $func = $class_hr->{$m}->{'function'};
1220 my $rettype = normalize_namespace
($class, $class_hr->{$m}->{'rettype'});
1221 my $args = normalize_namespace
($class, $class_hr->{$m}->{'args'});
1223 next if ($func =~ /^\:\:/);
1225 my $asserts = "\t".get_arg_assert
($rettype, "$class *obj", 1)."\n";
1227 $args = convert_args
($args);
1231 my @margs = split(",", $args);
1232 foreach my $one_arg (@margs)
1234 my $assert_stmt = get_arg_assert
($rettype, $one_arg, 0);
1235 if (defined($assert_stmt) && $assert_stmt ne "")
1237 $asserts .= "\t$assert_stmt\n";
1239 if ($one_arg =~ /([\w_][\w\d_]*)$/)
1244 $params = join (", ", @params);
1248 $args = convert_args
($args);
1253 my $comments_out = $class_hr->{$m}->{'__comments'};
1254 $rettype = convert_ret
($rettype);
1255 $answer .= "${comments_out}${rettype}\n${prefix}_$func ($class *obj, ${args}GError **err)\n";
1259 $answer .= $asserts;
1262 if ($rettype ne "void") {
1263 $answer .= "return ";
1265 $answer .= "${macro_name}_GET_IFACE (obj)->$func (obj, ${params}err);";
1266 $answer .="\n}\n\n";
1268 ## Default implementation
1269 $answer .= "/* Default implementation */\n";
1270 $answer .= "static ${rettype}\n${prefix}_${func}_default ($class *obj, ${args}GError **err)\n";
1272 if ($rettype ne "void") {
1273 $answer .= "\tg_return_val_if_reached (". get_return_type_val
($rettype). ");";
1275 $answer .= "\tg_return_if_reached ();";
1277 $answer .="\n}\n\n";
1281 ${prefix}_base_init (${class}Iface* klass)
1283 static gboolean initialized = FALSE;
1286 foreach my $m (sort keys %$class_hr)
1288 next if ($m =~ /^__/);
1289 my $func = $class_hr->{$m}->{'function'};
1290 next if ($func =~ /^\:\:/);
1291 $answer .= "\tklass->$func = ${prefix}_${func}_default;\n";
1296 foreach my $m (sort keys %$class_hr)
1298 next if ($m =~ /^__/);
1299 my $func = $class_hr->{$m}->{'function'};
1300 my $rettype = normalize_namespace
($class, $class_hr->{$m}->{'rettype'});
1301 my $args = normalize_namespace
($class, $class_hr->{$m}->{'args'});
1302 $args = convert_args
($args);
1307 if ($func =~ s/^\:\://)
1312 my $marshaller = construct_marshaller
($rettype, $args);
1313 $answer .= "\t\t/* Signal */";
1314 $answer .="\n\t\tg_signal_new (\"$signal\",
1317 G_STRUCT_OFFSET (${class}Iface, $func),
1319 ${marshaller});\n\n";
1330 ${prefix}_get_type (void)
1332 static GType type = 0;
1334 static const GTypeInfo info = {
1335 sizeof (${class}Iface),
1336 (GBaseInitFunc) ${prefix}_base_init,
1345 type = g_type_register_static (G_TYPE_INTERFACE, \"$class\", &info, 0);
1346 g_type_interface_add_prerequisite (type, $parent_type);
1352 if (defined ($enums_hr))
1354 foreach my $e (sort keys %$enums_hr)
1356 # add an underscore if necassery
1358 $se =~ s/[a-z][A-Z]/enum_split($&)/e;
1359 my $e_lower = lc($se);
1363 ${prefix}_${e_lower}_get_type (void)
1365 static const GEnumValue values[] =
1368 foreach my $d (@
{$enums_hr->{$e}->{"__data"}})
1370 $d =~ s/^([\w_\d]+).*$/$1/;
1371 my $e_val = "${macro_name}_$d";
1372 my $e_val_str = lc($d);
1373 $e_val_str =~ s/_/-/g;
1374 $answer .= "\t\t{ $e_val, \"$e_val\", \"$e_val_str\" }, \n";
1380 static GType type = 0;
1384 type = g_enum_register_static (\"${class}$e\", values);
1392 write_file
($filename, $answer);
1393 push @source_files, $filename;
1396 sub write_marshallers
1398 ## Write marshallers
1399 my $filename = "$module_name-iface-marshallers.list";
1400 push @header_files, "$module_name-iface-marshallers.h";
1401 push @source_files, "$module_name-iface-marshallers.c";
1403 foreach my $m (sort keys %marshallers)
1407 $contents .= "$m\n";
1409 if (write_file
($filename, $contents))
1411 system "echo \"#include \\\"${module_name}-iface-marshallers.h\\\"\" ".
1412 "> xgen-gmc && glib-genmarshal --prefix=${module_name}_iface_cclosure_marshal ".
1413 "./${module_name}-iface-marshallers.list --body >> xgen-gmc && cp xgen-gmc ".
1414 "$module_name-iface-marshallers.c && rm -f xgen-gmc";
1415 system "glib-genmarshal --prefix=${module_name}_iface_cclosure_marshal ".
1416 "./${module_name}-iface-marshallers.list --header > xgen-gmc && cp xgen-gmc ".
1417 "$module_name-iface-marshallers.h && rm -f xgen-gmc";
1423 my $iface_headers = "";
1426 /* Interfaces global include file */
1430 foreach my $h (@header_files)
1432 $answer .= "#include \"$h\"\n";
1434 write_file
("libanjuta-interfaces.h", $answer);
1435 push(@header_files, "libanjuta-interfaces.h");
1440 my $iface_headers = "";
1441 foreach my $h (@header_files)
1443 $iface_headers .= "\\\n\t$h";
1445 my $iface_sources = "";
1446 foreach my $s (@source_files)
1448 $iface_sources .= "\\\n\t$s";
1451 my $iface_rules = "noinst_LTLIBRARIES = $module_name-interfaces.la\n";
1452 $iface_rules .= "${module_name}_interfaces_la_LIBADD = \$(MODULE_LIBS)\n";
1453 ## $iface_rules .= "${module_name}_interfaces_la_LIBADD = \n";
1454 $iface_rules .= "${module_name}_interfaces_la_SOURCES = $iface_sources\n";
1455 $iface_rules .= "${module_name}_interfaces_includedir = \$(MODULE_INCLUDEDIR)\n";
1456 $iface_rules .= "${module_name}_interfaces_include = $iface_headers\n";
1458 my $contents = `cat Makefile.am.iface`;
1459 $contents =~ s/\@\@IFACE_RULES\@\@/$iface_rules/;
1460 my $filename = "Makefile.am";
1461 write_file
($filename, $contents);
1466 my ($filename, $contents) = @_;
1467 open (OUTFILE
, ">$filename.tmp")
1468 or die "Can not open $filename.tmp for writing";
1469 print OUTFILE
$contents;
1472 my $diff = "not matched";
1475 $diff = `diff $filename $filename.tmp`;
1477 unlink ("$filename.tmp");
1478 if ($diff !~ /^\s*$/)
1480 print "\tWriting $filename\n";
1481 open (OUTFILE
, ">$filename")
1482 or die "Can not open $filename for writing";
1483 print OUTFILE
$contents;