From be4fff49f0164e606d4b2f76f64d4d108895f236 Mon Sep 17 00:00:00 2001 From: Mageia SVN-Git Migration Date: Wed, 25 Apr 2007 15:16:21 +0000 Subject: Rename folder to match history. This is a Synthesized commit to combine perl-MDK-Common and perl_checker repository history. --- fake_packages/CGI.pm | 22 + fake_packages/Getopt/Long.pm | 6 + fake_packages/Glib.pm | 315 +++ fake_packages/Gnome2.pm | 641 +++++ fake_packages/Gnome2/Vte.pm | 72 + fake_packages/Gtk2.pm | 3742 +++++++++++++++++++++++++ fake_packages/MDV/Distribconf.pm | 17 + fake_packages/Net/DNS.pm | 7 + fake_packages/Net/FTP.pm | 9 + fake_packages/Net/Ping.pm | 9 + fake_packages/URPM/Resolve.pm | 17 + fake_packages/gen.pl | 108 + fake_packages/packdrake.pm | 25 + fake_packages/urpm.pm | 9 + perl_checker.src/.cvsignore | 15 - perl_checker.src/Makefile | 34 - perl_checker.src/OCamlMakefile | 912 ------ perl_checker.src/build.mli | 3 - perl_checker.src/common.ml | 1005 ------- perl_checker.src/common.mli | 276 -- perl_checker.src/config_file.ml | 40 - perl_checker.src/config_file.mli | 6 - perl_checker.src/flags.ml | 43 - perl_checker.src/flags.mli | 22 - perl_checker.src/global_checks.ml | 639 ----- perl_checker.src/global_checks.mli | 26 - perl_checker.src/info.ml | 76 - perl_checker.src/info.mli | 17 - perl_checker.src/lexer.mll | 1057 ------- perl_checker.src/parser.mly | 500 ---- perl_checker.src/parser_helper.ml | 1409 ---------- perl_checker.src/parser_helper.mli | 314 --- perl_checker.src/perl_checker.html.pl | 168 -- perl_checker.src/perl_checker.ml | 183 -- perl_checker.src/perl_checker.mli | 1 - perl_checker.src/print.ml | 0 perl_checker.src/print.mli | 1 - perl_checker.src/test/.cvsignore | 2 - perl_checker.src/test/Makefile | 3 - perl_checker.src/test/context.t | 41 - perl_checker.src/test/force_layout.t | 23 - perl_checker.src/test/method.t | 11 - perl_checker.src/test/prototype.t | 23 - perl_checker.src/test/read_t.pm | 28 - perl_checker.src/test/return_value.t | 23 - perl_checker.src/test/suggest_better.t | 112 - perl_checker.src/test/syntax_restrictions.t | 70 - perl_checker.src/test/test_it | 113 - perl_checker.src/test/various_errors.t | 61 - perl_checker.src/tree.ml | 443 --- perl_checker.src/tree.mli | 57 - perl_checker.src/types.mli | 125 - perl_checker_fake_packages/CGI.pm | 22 - perl_checker_fake_packages/Getopt/Long.pm | 6 - perl_checker_fake_packages/Glib.pm | 315 --- perl_checker_fake_packages/Gnome2.pm | 641 ----- perl_checker_fake_packages/Gnome2/Vte.pm | 72 - perl_checker_fake_packages/Gtk2.pm | 3742 ------------------------- perl_checker_fake_packages/MDV/Distribconf.pm | 17 - perl_checker_fake_packages/Net/DNS.pm | 7 - perl_checker_fake_packages/Net/FTP.pm | 9 - perl_checker_fake_packages/Net/Ping.pm | 9 - perl_checker_fake_packages/URPM/Resolve.pm | 17 - perl_checker_fake_packages/gen.pl | 108 - perl_checker_fake_packages/packdrake.pm | 25 - perl_checker_fake_packages/urpm.pm | 9 - src/.cvsignore | 15 + src/Makefile | 34 + src/OCamlMakefile | 912 ++++++ src/build.mli | 3 + src/common.ml | 1005 +++++++ src/common.mli | 276 ++ src/config_file.ml | 40 + src/config_file.mli | 6 + src/flags.ml | 43 + src/flags.mli | 22 + src/global_checks.ml | 639 +++++ src/global_checks.mli | 26 + src/info.ml | 76 + src/info.mli | 17 + src/lexer.mll | 1057 +++++++ src/parser.mly | 500 ++++ src/parser_helper.ml | 1409 ++++++++++ src/parser_helper.mli | 314 +++ src/perl_checker.html.pl | 168 ++ src/perl_checker.ml | 183 ++ src/perl_checker.mli | 1 + src/print.ml | 0 src/print.mli | 1 + src/test/.cvsignore | 2 + src/test/Makefile | 3 + src/test/context.t | 41 + src/test/force_layout.t | 23 + src/test/method.t | 11 + src/test/prototype.t | 23 + src/test/read_t.pm | 28 + src/test/return_value.t | 23 + src/test/suggest_better.t | 112 + src/test/syntax_restrictions.t | 70 + src/test/test_it | 113 + src/test/various_errors.t | 61 + src/tree.ml | 443 +++ src/tree.mli | 57 + src/types.mli | 125 + 104 files changed, 12881 insertions(+), 12881 deletions(-) create mode 100644 fake_packages/CGI.pm create mode 100644 fake_packages/Getopt/Long.pm create mode 100644 fake_packages/Glib.pm create mode 100644 fake_packages/Gnome2.pm create mode 100644 fake_packages/Gnome2/Vte.pm create mode 100644 fake_packages/Gtk2.pm create mode 100644 fake_packages/MDV/Distribconf.pm create mode 100644 fake_packages/Net/DNS.pm create mode 100644 fake_packages/Net/FTP.pm create mode 100644 fake_packages/Net/Ping.pm create mode 100644 fake_packages/URPM/Resolve.pm create mode 100755 fake_packages/gen.pl create mode 100644 fake_packages/packdrake.pm create mode 100644 fake_packages/urpm.pm delete mode 100644 perl_checker.src/.cvsignore delete mode 100644 perl_checker.src/Makefile delete mode 100644 perl_checker.src/OCamlMakefile delete mode 100644 perl_checker.src/build.mli delete mode 100644 perl_checker.src/common.ml delete mode 100644 perl_checker.src/common.mli delete mode 100644 perl_checker.src/config_file.ml delete mode 100644 perl_checker.src/config_file.mli delete mode 100644 perl_checker.src/flags.ml delete mode 100644 perl_checker.src/flags.mli delete mode 100644 perl_checker.src/global_checks.ml delete mode 100644 perl_checker.src/global_checks.mli delete mode 100644 perl_checker.src/info.ml delete mode 100644 perl_checker.src/info.mli delete mode 100644 perl_checker.src/lexer.mll delete mode 100644 perl_checker.src/parser.mly delete mode 100644 perl_checker.src/parser_helper.ml delete mode 100644 perl_checker.src/parser_helper.mli delete mode 100644 perl_checker.src/perl_checker.html.pl delete mode 100644 perl_checker.src/perl_checker.ml delete mode 100644 perl_checker.src/perl_checker.mli delete mode 100644 perl_checker.src/print.ml delete mode 100644 perl_checker.src/print.mli delete mode 100644 perl_checker.src/test/.cvsignore delete mode 100644 perl_checker.src/test/Makefile delete mode 100644 perl_checker.src/test/context.t delete mode 100644 perl_checker.src/test/force_layout.t delete mode 100644 perl_checker.src/test/method.t delete mode 100644 perl_checker.src/test/prototype.t delete mode 100644 perl_checker.src/test/read_t.pm delete mode 100644 perl_checker.src/test/return_value.t delete mode 100644 perl_checker.src/test/suggest_better.t delete mode 100644 perl_checker.src/test/syntax_restrictions.t delete mode 100755 perl_checker.src/test/test_it delete mode 100644 perl_checker.src/test/various_errors.t delete mode 100644 perl_checker.src/tree.ml delete mode 100644 perl_checker.src/tree.mli delete mode 100644 perl_checker.src/types.mli delete mode 100644 perl_checker_fake_packages/CGI.pm delete mode 100644 perl_checker_fake_packages/Getopt/Long.pm delete mode 100644 perl_checker_fake_packages/Glib.pm delete mode 100644 perl_checker_fake_packages/Gnome2.pm delete mode 100644 perl_checker_fake_packages/Gnome2/Vte.pm delete mode 100644 perl_checker_fake_packages/Gtk2.pm delete mode 100644 perl_checker_fake_packages/MDV/Distribconf.pm delete mode 100644 perl_checker_fake_packages/Net/DNS.pm delete mode 100644 perl_checker_fake_packages/Net/FTP.pm delete mode 100644 perl_checker_fake_packages/Net/Ping.pm delete mode 100644 perl_checker_fake_packages/URPM/Resolve.pm delete mode 100755 perl_checker_fake_packages/gen.pl delete mode 100644 perl_checker_fake_packages/packdrake.pm delete mode 100644 perl_checker_fake_packages/urpm.pm create mode 100644 src/.cvsignore create mode 100644 src/Makefile create mode 100644 src/OCamlMakefile create mode 100644 src/build.mli create mode 100644 src/common.ml create mode 100644 src/common.mli create mode 100644 src/config_file.ml create mode 100644 src/config_file.mli create mode 100644 src/flags.ml create mode 100644 src/flags.mli create mode 100644 src/global_checks.ml create mode 100644 src/global_checks.mli create mode 100644 src/info.ml create mode 100644 src/info.mli create mode 100644 src/lexer.mll create mode 100644 src/parser.mly create mode 100644 src/parser_helper.ml create mode 100644 src/parser_helper.mli create mode 100644 src/perl_checker.html.pl create mode 100644 src/perl_checker.ml create mode 100644 src/perl_checker.mli create mode 100644 src/print.ml create mode 100644 src/print.mli create mode 100644 src/test/.cvsignore create mode 100644 src/test/Makefile create mode 100644 src/test/context.t create mode 100644 src/test/force_layout.t create mode 100644 src/test/method.t create mode 100644 src/test/prototype.t create mode 100644 src/test/read_t.pm create mode 100644 src/test/return_value.t create mode 100644 src/test/suggest_better.t create mode 100644 src/test/syntax_restrictions.t create mode 100755 src/test/test_it create mode 100644 src/test/various_errors.t create mode 100644 src/tree.ml create mode 100644 src/tree.mli create mode 100644 src/types.mli diff --git a/fake_packages/CGI.pm b/fake_packages/CGI.pm new file mode 100644 index 0000000..c3ee55a --- /dev/null +++ b/fake_packages/CGI.pm @@ -0,0 +1,22 @@ +package CGI; + +sub new {} + +sub autoflush {} +sub checkbox {} +sub close {} +sub end_form {} +sub end_html {} +sub h1 {} +sub hidden {} +sub param {} +sub password_field {} +sub scrolling_list {} +sub start_form {} +sub submit {} +sub textfield {} + +sub header {} +sub start_html {} +sub br {} +sub p {} diff --git a/fake_packages/Getopt/Long.pm b/fake_packages/Getopt/Long.pm new file mode 100644 index 0000000..6437264 --- /dev/null +++ b/fake_packages/Getopt/Long.pm @@ -0,0 +1,6 @@ +package Getopt::Long; + +our @ISA = qw(Exporter); +our @EXPORT = qw(GetOptions); + +sub GetOptions {} diff --git a/fake_packages/Glib.pm b/fake_packages/Glib.pm new file mode 100644 index 0000000..8f465ad --- /dev/null +++ b/fake_packages/Glib.pm @@ -0,0 +1,315 @@ + +package Glib; +our @ISA = qw(); +sub CHECK_VERSION { my ($_class, $_required_major, $_required_minor, $_required_micro) = @_ } +sub GET_VERSION_INFO { my ($_class) = @_ } +sub MAJOR_VERSION() {} +sub MICRO_VERSION() {} +sub MINOR_VERSION() {} +sub critical { my ($_class, $_domain, $_message) = @_ } +sub error { my ($_class, $_domain, $_message) = @_ } +sub filename_display_basename { my ($_filename) = @_ } +sub filename_display_name { my ($_filename) = @_ } +sub filename_from_unicode { my ($_class_or_filename, $_o_filename) = @_ } +sub filename_from_uri { my (@_more_paras) = @_ } +sub filename_to_unicode { my ($_class_or_filename, $_o_filename) = @_ } +sub filename_to_uri { my (@_more_paras) = @_ } +sub get_application_name() {} +sub get_home_dir() {} +sub get_language_names() {} +sub get_real_name() {} +sub get_system_config_dirs() {} +sub get_system_data_dirs() {} +sub get_tmp_dir() {} +sub get_user_cache_dir() {} +sub get_user_config_dir() {} +sub get_user_data_dir() {} +sub get_user_name() {} +sub install_exception_handler { my ($_class, $_func, $_o_data) = @_ } +sub log { my ($_class, $_log_domain, $_log_level, $_message) = @_ } +sub main_depth() {} +sub major_version() {} +sub message { my ($_class, $_domain, $_message) = @_ } +sub micro_version() {} +sub minor_version() {} +sub remove_exception_handler { my ($_class, $_tag) = @_ } +sub set_application_name { my ($_application_name) = @_ } +sub warning { my ($_class, $_domain, $_message) = @_ } + +package Glib::Boxed; +our @ISA = qw(); +sub DESTROY { my ($_sv) = @_ } +sub copy { my ($_sv) = @_ } + +package Glib::Error; +our @ISA = qw(); +sub code { my ($_error) = @_ } +sub domain { my ($_error) = @_ } +sub location { my ($_error) = @_ } +sub matches { my ($_error, $_domain, $_code) = @_ } +sub message { my ($_error) = @_ } +sub new { my ($_class, $_code, $_message) = @_ } +sub register { my ($_package, $_enum_package) = @_ } +sub throw { my ($_class, $_code, $_message) = @_ } +sub value { my ($_error) = @_ } + +package Glib::Flags; +our @ISA = qw(); +sub all { my ($_a, $_b, $_swap) = @_ } +sub as_arrayref { my ($_a, $_b, $_swap) = @_ } +sub bool { my ($_a, $_b, $_swap) = @_ } +sub Glib::Flags::eq { my ($_a, $_b, $_swap) = @_ } +sub Glib::Flags::ge { my ($_a, $_b, $_swap) = @_ } +sub intersect { my ($_a, $_b, $_swap) = @_ } +sub Glib::Flags::sub { my ($_a, $_b, $_swap) = @_ } +sub union { my ($_a, $_b, $_swap) = @_ } +sub Glib::Flags::xor { my ($_a, $_b, $_swap) = @_ } + +package Glib::IO; +our @ISA = qw(); +sub add_watch { my ($_class, $_fd, $_condition, $_callback, $_o_data, $_o_priority) = @_ } + +package Glib::Idle; +our @ISA = qw(); +sub add { my ($_class, $_callback, $_o_data, $_o_priority) = @_ } + +package Glib::KeyFile; +our @ISA = qw(); +sub DESTROY { my ($_key_file) = @_ } +sub get_boolean { my ($_key_file, $_group_name, $_key) = @_ } +sub get_boolean_list { my ($_key_file, $_group_name, $_key) = @_ } +sub get_comment { my ($_key_file, $_o_group_name, $_o_key) = @_ } +sub get_groups { my ($_key_file) = @_ } +sub get_integer { my ($_key_file, $_group_name, $_key) = @_ } +sub get_integer_list { my ($_key_file, $_group_name, $_key) = @_ } +sub get_keys { my ($_key_file, $_group_name) = @_ } +sub get_locale_string { my ($_key_file, $_group_name, $_key, $_o_locale) = @_ } +sub get_locale_string_list { my ($_key_file, $_group_name, $_key, $_locale) = @_ } +sub get_start_group { my ($_key_file) = @_ } +sub get_string { my ($_key_file, $_group_name, $_key) = @_ } +sub get_string_list { my ($_key_file, $_group_name, $_key) = @_ } +sub get_value { my ($_key_file, $_group_name, $_key) = @_ } +sub has_group { my ($_key_file, $_group_name) = @_ } +sub has_key { my ($_key_file, $_group_name, $_key) = @_ } +sub load_from_data { my ($_key_file, $_buf, $_flags) = @_ } +sub load_from_data_dirs { my ($_key_file, $_file, $_flags) = @_ } +sub load_from_file { my ($_key_file, $_file, $_flags) = @_ } +sub new { my ($_class) = @_ } +sub remove_comment { my ($_key_file, $_o_group_name, $_o_key) = @_ } +sub remove_group { my ($_key_file, $_group_name) = @_ } +sub remove_key { my ($_key_file, $_group_name, $_key) = @_ } +sub set_boolean { my ($_key_file, $_group_name, $_key, $_value) = @_ } +sub set_boolean_list { my ($_key_file, $_group_name, $_key, @_more_paras) = @_ } +sub set_comment { my ($_key_file, $_group_name, $_key, $_comment) = @_ } +sub set_integer { my ($_key_file, $_group_name, $_key, $_value) = @_ } +sub set_integer_list { my ($_key_file, $_group_name, $_key, @_more_paras) = @_ } +sub set_list_separator { my ($_key_file, $_separator) = @_ } +sub set_locale_string { my ($_key_file, $_group_name, $_key, $_locale, $_string) = @_ } +sub set_locale_string_list { my ($_key_file, $_group_name, $_key, $_locale, @_more_paras) = @_ } +sub set_string { my ($_key_file, $_group_name, $_key, $_value) = @_ } +sub set_string_list { my ($_key_file, $_group_name, $_key, @_more_paras) = @_ } +sub set_value { my ($_key_file, $_group_name, $_key, $_value) = @_ } +sub to_data { my ($_key_file) = @_ } + +package Glib::Log; +our @ISA = qw(); +sub remove_handler { my ($_class, $_log_domain, $_handler_id) = @_ } +sub set_always_fatal { my ($_class, $_fatal_mask) = @_ } +sub set_fatal_mask { my ($_class, $_log_domain, $_fatal_mask) = @_ } +sub set_handler { my ($_class, $_log_domain, $_log_levels, $_log_func, $_o_user_data) = @_ } + +package Glib::MainContext; +our @ISA = qw(); +sub DESTROY { my ($_maincontext) = @_ } +sub default { my ($_class) = @_ } +sub iteration { my ($_context, $_may_block) = @_ } +sub new { my ($_class) = @_ } +sub pending { my ($_context) = @_ } + +package Glib::MainLoop; +our @ISA = qw(); +sub DESTROY { my ($_mainloop) = @_ } +sub get_context { my ($_loop) = @_ } +sub is_running { my ($_loop) = @_ } +sub new { my ($_class, $_o_context, $_o_is_running) = @_ } +sub quit { my ($_loop) = @_ } +sub run { my ($_loop) = @_ } + +package Glib::Markup; +our @ISA = qw(); +sub escape_text { my ($_text) = @_ } + +package Glib::Object; +our @ISA = qw(); +sub CLONE { my ($_class) = @_ } +sub DESTROY { my ($_sv) = @_ } +sub freeze_notify { my ($_object) = @_ } +sub get { my ($_object, @_more_paras) = @_ } +sub get_data { my ($_object, $_key) = @_ } +sub get_pointer { my ($_object) = @_ } +sub get_property { my ($_object, @_more_paras) = @_ } +sub list_properties { my ($_object_or_class_name) = @_ } +sub new { my ($_class, @_more_paras) = @_ } +sub new_from_pointer { my ($_class, $_pointer, $_o_noinc) = @_ } +sub notify { my ($_object, $_property_name) = @_ } +sub set { my ($_object, @_more_paras) = @_ } +sub set_data { my ($_object, $_key, $_data) = @_ } +sub set_property { my ($_object, @_more_paras) = @_ } +sub set_threadsafe { my ($_class, $_threadsafe) = @_ } +sub signal_add_emission_hook { my ($_object_or_class_name, $_detailed_signal, $_hook_func, $_o_hook_data) = @_ } +sub signal_chain_from_overridden { my ($_instance, @_more_paras) = @_ } +sub signal_connect { my ($_instance, $_detailed_signal, $_callback, $_o_data) = @_ } +sub signal_connect_after { my ($_instance, $_detailed_signal, $_callback, $_o_data) = @_ } +sub signal_connect_swapped { my ($_instance, $_detailed_signal, $_callback, $_o_data) = @_ } +sub signal_emit { my ($_instance, $_name, @_more_paras) = @_ } +sub signal_handler_block { my ($_object, $_handler_id) = @_ } +sub signal_handler_disconnect { my ($_object, $_handler_id) = @_ } +sub signal_handler_is_connected { my ($_object, $_handler_id) = @_ } +sub signal_handler_unblock { my ($_object, $_handler_id) = @_ } +sub signal_handlers_block_by_func { my ($_instance, $_func, $_o_data) = @_ } +sub signal_handlers_disconnect_by_func { my ($_instance, $_func, $_o_data) = @_ } +sub signal_handlers_unblock_by_func { my ($_instance, $_func, $_o_data) = @_ } +sub signal_query { my ($_object_or_class_name, $_name) = @_ } +sub signal_remove_emission_hook { my ($_object_or_class_name, $_signal_name, $_hook_id) = @_ } +sub signal_stop_emission_by_name { my ($_instance, $_detailed_signal) = @_ } +sub thaw_notify { my ($_object) = @_ } +sub tie_properties { my ($_object, $_o_all) = @_ } + +package Glib::Object::_LazyLoader; +our @ISA = qw(); +sub _load { my ($_package) = @_ } + +package Glib::Param::Boolean; +our @ISA = qw(); +sub get_default_value { my ($_pspec_boolean) = @_ } + +package Glib::Param::Char; +our @ISA = qw(); +sub get_default_value { my ($_pspec) = @_ } +sub get_maximum { my ($_pspec) = @_ } +sub get_minimum { my ($_pspec) = @_ } + +package Glib::Param::Double; +our @ISA = qw(); +sub get_default_value { my ($_pspec) = @_ } +sub get_epsilon { my ($_pspec) = @_ } +sub get_maximum { my ($_pspec) = @_ } +sub get_minimum { my ($_pspec) = @_ } + +package Glib::Param::Enum; +our @ISA = qw(); +sub get_default_value { my ($_pspec_enum) = @_ } +sub get_enum_class { my ($_pspec_enum) = @_ } + +package Glib::Param::Flags; +our @ISA = qw(); +sub get_default_value { my ($_pspec_flags) = @_ } +sub get_flags_class { my ($_pspec_flags) = @_ } + +package Glib::Param::Float; +our @ISA = qw(); +sub get_default_value { my ($_pspec) = @_ } +sub get_epsilon { my ($_pspec) = @_ } +sub get_maximum { my ($_pspec) = @_ } +sub get_minimum { my ($_pspec) = @_ } + +package Glib::Param::Int; +our @ISA = qw(); +sub get_default_value { my ($_pspec) = @_ } +sub get_maximum { my ($_pspec) = @_ } +sub get_minimum { my ($_pspec) = @_ } + +package Glib::Param::Int64; +our @ISA = qw(); +sub get_default_value { my ($_pspec) = @_ } +sub get_maximum { my ($_pspec) = @_ } +sub get_minimum { my ($_pspec) = @_ } + +package Glib::Param::Long; +our @ISA = qw(); +sub get_default_value { my ($_pspec) = @_ } +sub get_maximum { my ($_pspec) = @_ } +sub get_minimum { my ($_pspec) = @_ } + +package Glib::Param::String; +our @ISA = qw(); +sub get_default_value { my ($_pspec_string) = @_ } + +package Glib::Param::UChar; +our @ISA = qw(); +sub get_default_value { my ($_pspec) = @_ } +sub get_maximum { my ($_pspec) = @_ } +sub get_minimum { my ($_pspec) = @_ } + +package Glib::Param::UInt; +our @ISA = qw(); +sub get_default_value { my ($_pspec) = @_ } +sub get_maximum { my ($_pspec) = @_ } +sub get_minimum { my ($_pspec) = @_ } + +package Glib::Param::UInt64; +our @ISA = qw(); +sub get_default_value { my ($_pspec) = @_ } +sub get_maximum { my ($_pspec) = @_ } +sub get_minimum { my ($_pspec) = @_ } + +package Glib::Param::ULong; +our @ISA = qw(); +sub get_default_value { my ($_pspec) = @_ } +sub get_maximum { my ($_pspec) = @_ } +sub get_minimum { my ($_pspec) = @_ } + +package Glib::Param::Unichar; +our @ISA = qw(); +sub get_default_value { my ($_pspec_unichar) = @_ } + +package Glib::ParamSpec; +our @ISA = qw(); +sub DESTROY { my ($_pspec) = @_ } +sub IV { my ($_class, $_name, $_nick, $_blurb, $_minimum, $_maximum, $_default_value, $_flags) = @_ } +sub UV { my ($_class, $_name, $_nick, $_blurb, $_minimum, $_maximum, $_default_value, $_flags) = @_ } +sub boolean { my ($_class, $_name, $_nick, $_blurb, $_default_value, $_flags) = @_ } +sub boxed { my ($_class, $_name, $_nick, $_blurb, $_package, $_flags) = @_ } +sub char { my ($_class, $_name, $_nick, $_blurb, $_minimum, $_maximum, $_default_value, $_flags) = @_ } +sub double { my ($_class, $_name, $_nick, $_blurb, $_minimum, $_maximum, $_default_value, $_flags) = @_ } +sub enum { my ($_class, $_name, $_nick, $_blurb, $_enum_type, $_default_value, $_flags) = @_ } +sub flags { my ($_class, $_name, $_nick, $_blurb, $_flags_type, $_default_value, $_flags) = @_ } +sub float { my ($_class, $_name, $_nick, $_blurb, $_minimum, $_maximum, $_default_value, $_flags) = @_ } +sub get_blurb { my ($_pspec) = @_ } +sub get_flags { my ($_pspec) = @_ } +sub get_name { my ($_pspec) = @_ } +sub get_nick { my ($_pspec) = @_ } +sub get_owner_type { my ($_pspec) = @_ } +sub get_value_type { my ($_pspec) = @_ } +sub int { my ($_class, $_name, $_nick, $_blurb, $_minimum, $_maximum, $_default_value, $_flags) = @_ } +sub int64 { my ($_class, $_name, $_nick, $_blurb, $_minimum, $_maximum, $_default_value, $_flags) = @_ } +sub long { my ($_class, $_name, $_nick, $_blurb, $_minimum, $_maximum, $_default_value, $_flags) = @_ } +sub object { my ($_class, $_name, $_nick, $_blurb, $_package, $_flags) = @_ } +sub param_spec { my ($_class, $_name, $_nick, $_blurb, $_package, $_flags) = @_ } +sub scalar { my ($_class, $_name, $_nick, $_blurb, $_flags) = @_ } +sub string { my ($_class, $_name, $_nick, $_blurb, $_default_value, $_flags) = @_ } +sub uchar { my ($_class, $_name, $_nick, $_blurb, $_minimum, $_maximum, $_default_value, $_flags) = @_ } +sub uint { my ($_class, $_name, $_nick, $_blurb, $_minimum, $_maximum, $_default_value, $_flags) = @_ } +sub uint64 { my ($_class, $_name, $_nick, $_blurb, $_minimum, $_maximum, $_default_value, $_flags) = @_ } +sub ulong { my ($_class, $_name, $_nick, $_blurb, $_minimum, $_maximum, $_default_value, $_flags) = @_ } +sub unichar { my ($_class, $_name, $_nick, $_blurb, $_default_value, $_flags) = @_ } + +package Glib::Source; +our @ISA = qw(); +sub remove { my ($_class, $_tag) = @_ } + +package Glib::Timeout; +our @ISA = qw(); +sub add { my ($_class, $_interval, $_callback, $_o_data, $_o_priority) = @_ } + +package Glib::Type; +our @ISA = qw(); +sub list_ancestors { my ($_class, $_package) = @_ } +sub list_interfaces { my ($_class, $_package) = @_ } +sub list_signals { my ($_class, $_package) = @_ } +sub list_values { my ($_class, $_package) = @_ } +sub package_from_cname { my ($_class, $_cname) = @_ } +sub register { my ($_class, $_parent_class, $_new_class, @_more_paras) = @_ } +sub register_enum { my ($_class, $_name, @_more_paras) = @_ } +sub register_flags { my ($_class, $_name, @_more_paras) = @_ } +sub register_object { my ($_class, $_parent_package, $_new_package, @_more_paras) = @_ } diff --git a/fake_packages/Gnome2.pm b/fake_packages/Gnome2.pm new file mode 100644 index 0000000..7c6f6bf --- /dev/null +++ b/fake_packages/Gnome2.pm @@ -0,0 +1,641 @@ + +package Gnome2; +our @ISA = qw(); +sub CHECK_VERSION { my ($_class, $_major, $_minor, $_micro) = @_ } +sub GET_VERSION_INFO { my ($_class) = @_ } +sub accelerators_sync { my ($_class) = @_ } +sub user_accels_dir_get { my ($_class) = @_ } +sub user_dir_get { my ($_class) = @_ } +sub user_private_dir_get { my ($_class) = @_ } + +package Gnome2::About; +our @ISA = qw(); +sub new { my ($_class, $_name, $_version, $_copyright, $_comments, $_authors, $_o_documenters, $_o_translator_credits, $_o_logo_pixbuf) = @_ } + +package Gnome2::App; +our @ISA = qw(); +sub accel_group { my ($_app) = @_ } +sub add_dock_item { my ($_app, $_item, $_placement, $_band_num, $_band_position, $_offset) = @_ } +sub add_docked { my ($_app, $_widget, $_name, $_behavior, $_placement, $_band_num, $_band_position, $_offset) = @_ } +sub add_toolbar { my ($_app, $_toolbar, $_name, $_behavior, $_placement, $_band_num, $_band_position, $_offset) = @_ } +sub contents { my ($_app) = @_ } +sub create_menus { my ($_app, $_uiinfo) = @_ } +sub create_toolbar { my ($_app, $_uiinfo) = @_ } +sub dock { my ($_app) = @_ } +sub enable_layout_config { my ($_app, $_enable) = @_ } +sub get_dock { my ($_app) = @_ } +sub get_dock_item_by_name { my ($_app, $_name) = @_ } +sub get_enable_layout_config { my ($_app) = @_ } +sub insert_menus { my ($_app, $_path, $_menuinfo) = @_ } +sub install_menu_hints { my ($_app, $_uiinfo) = @_ } +sub layout { my ($_app) = @_ } +sub menubar { my ($_app) = @_ } +sub new { my ($_class, $_appname, $_o_title) = @_ } +sub prefix { my ($_app) = @_ } +sub remove_menu_range { my ($_app, $_path, $_start, $_items) = @_ } +sub remove_menus { my ($_app, $_path, $_items) = @_ } +sub set_contents { my ($_app, $_contents) = @_ } +sub set_menus { my ($_app, $_menubar) = @_ } +sub set_statusbar { my ($_app, $_statusbar) = @_ } +sub set_statusbar_custom { my ($_app, $_container, $_statusbar) = @_ } +sub set_toolbar { my ($_app, $_toolbar) = @_ } +sub setup_toolbar { my ($_class, $_toolbar, $_dock_item) = @_ } +sub statusbar { my ($_app) = @_ } +sub vbox { my ($_app) = @_ } + +package Gnome2::AppBar; +our @ISA = qw(); +sub clear_prompt { my ($_appbar) = @_ } +sub clear_stack { my ($_appbar) = @_ } +sub get_progress { my ($_appbar) = @_ } +sub get_response { my ($_appbar) = @_ } +sub get_status { my ($_appbar) = @_ } +sub install_menu_hints { my ($_appbar, $_uiinfo) = @_ } +sub new { my ($_class, $_has_progress, $_has_status, $_interactivity) = @_ } +sub pop { my ($_appbar) = @_ } +sub push { my ($_appbar, $_status) = @_ } +sub refresh { my ($_appbar) = @_ } +sub set_default { my ($_appbar, $_default_status) = @_ } +sub set_progress_percentage { my ($_appbar, $_percentage) = @_ } +sub set_prompt { my ($_appbar, $_prompt, $_modal) = @_ } +sub set_status { my ($_appbar, $_status) = @_ } + +package Gnome2::AuthenticationManager; +our @ISA = qw(); +sub init { my ($_class) = @_ } + +package Gnome2::Bonobo; +our @ISA = qw(); +sub CHECK_VERSION { my ($_class, $_major, $_minor, $_micro) = @_ } +sub GET_VERSION_INFO { my ($_class) = @_ } + +package Gnome2::Bonobo::Dock; +our @ISA = qw(); +sub add_floating_item { my ($_dock, $_widget, $_x, $_y, $_orientation) = @_ } +sub add_from_layout { my ($_dock, $_layout) = @_ } +sub add_item { my ($_dock, $_item, $_placement, $_band_num, $_position, $_offset, $_in_new_band) = @_ } +sub allow_floating_items { my ($_dock, $_enable) = @_ } +sub get_client_area { my ($_dock) = @_ } +sub get_item_by_name { my ($_dock, $_name) = @_ } +sub get_layout { my ($_dock) = @_ } +sub new { my ($_class) = @_ } +sub set_client_area { my ($_dock, $_widget) = @_ } + +package Gnome2::Bonobo::DockItem; +our @ISA = qw(); +sub get_behavior { my ($_dock_item) = @_ } +sub get_child { my ($_dock_item) = @_ } +sub get_name { my ($_dock_item) = @_ } +sub get_orientation { my ($_dock_item) = @_ } +sub get_shadow_type { my ($_dock_item) = @_ } +sub new { my ($_class, $_name, $_behavior) = @_ } +sub set_orientation { my ($_dock_item, $_orientation) = @_ } +sub set_shadow_type { my ($_dock_item, $_type) = @_ } + +package Gnome2::Client; +our @ISA = qw(); +sub add_static_arg { my ($_client, @_more_paras) = @_ } +sub connect { my ($_client) = @_ } +sub connected { my ($_client) = @_ } +sub disconnect { my ($_client) = @_ } +sub flush { my ($_client) = @_ } +sub get_config_prefix { my ($_client) = @_ } +sub get_desktop_id { my ($_client) = @_ } +sub get_flags { my ($_client) = @_ } +sub get_global_config_prefix { my ($_client) = @_ } +sub get_id { my ($_client) = @_ } +sub get_previous_id { my ($_client) = @_ } +sub interaction_key_return { my ($_class, $_key, $_cancel_shutdown) = @_ } +sub master { my ($_class) = @_ } +sub new { my ($_class) = @_ } +sub new_without_connection { my ($_class) = @_ } +sub request_interaction { my ($_client, $_dialog_type, $_function, $_o_data) = @_ } +sub request_phase_2 { my ($_client) = @_ } +sub request_save { my ($_client, $_save_style, $_shutdown, $_interact_style, $_fast, $_global) = @_ } +sub save_any_dialog { my ($_client, $_dialog) = @_ } +sub save_error_dialog { my ($_client, $_dialog) = @_ } +sub set_clone_command { my ($_client, @_more_paras) = @_ } +sub set_current_directory { my ($_client, $_dir) = @_ } +sub set_discard_command { my ($_client, @_more_paras) = @_ } +sub set_environment { my ($_client, $_name, $_value) = @_ } +sub set_global_config_prefix { my ($_client, $_prefix) = @_ } +sub set_priority { my ($_client, $_priority) = @_ } +sub set_resign_command { my ($_client, @_more_paras) = @_ } +sub set_restart_command { my ($_client, @_more_paras) = @_ } +sub set_restart_style { my ($_client, $_style) = @_ } +sub set_shutdown_command { my ($_client, @_more_paras) = @_ } + +package Gnome2::ColorPicker; +our @ISA = qw(); +sub get_d { my ($_cp) = @_ } +sub get_dither { my ($_cp) = @_ } +sub get_i16 { my ($_cp) = @_ } +sub get_i8 { my ($_cp) = @_ } +sub get_title { my ($_cp) = @_ } +sub get_use_alpha { my ($_cp) = @_ } +sub new { my ($_class) = @_ } +sub set_d { my ($_cp, $_r, $_g, $_b, $_a) = @_ } +sub set_dither { my ($_cp, $_dither) = @_ } +sub set_i16 { my ($_cp, $_r, $_g, $_b, $_a) = @_ } +sub set_i8 { my ($_cp, $_r, $_g, $_b, $_a) = @_ } +sub set_title { my ($_cp, $_title) = @_ } +sub set_use_alpha { my ($_cp, $_use_alpha) = @_ } + +package Gnome2::Config; +our @ISA = qw(); +sub clean_file { my ($_class, $_path) = @_ } +sub clean_key { my ($_class, $_path) = @_ } +sub clean_section { my ($_class, $_path) = @_ } +sub drop_all { my ($_class) = @_ } +sub drop_file { my ($_class, $_path) = @_ } +sub get_bool { my ($_class, $_path) = @_ } +sub get_bool_with_default { my ($_class, $_path) = @_ } +sub get_float { my ($_class, $_path) = @_ } +sub get_float_with_default { my ($_class, $_path) = @_ } +sub get_int { my ($_class, $_path) = @_ } +sub get_int_with_default { my ($_class, $_path) = @_ } +sub get_real_path { my ($_class, $_path) = @_ } +sub get_string { my ($_class, $_path) = @_ } +sub get_string_with_default { my ($_class, $_path) = @_ } +sub get_translated_string { my ($_class, $_path) = @_ } +sub get_translated_string_with_default { my ($_class, $_path) = @_ } +sub get_vector { my ($_class, $_path) = @_ } +sub get_vector_with_default { my ($_class, $_path) = @_ } +sub has_section { my ($_class, $_path) = @_ } +sub init_iterator { my ($_class, $_path) = @_ } +sub init_iterator_sections { my ($_class, $_path) = @_ } +sub pop_prefix { my ($_class) = @_ } +sub push_prefix { my ($_class, $_path) = @_ } +sub set_bool { my ($_class, $_path, $_value) = @_ } +sub set_float { my ($_class, $_path, $_value) = @_ } +sub set_int { my ($_class, $_path, $_value) = @_ } +sub set_string { my ($_class, $_path, $_value) = @_ } +sub set_translated_string { my ($_class, $_path, $_value) = @_ } +sub set_vector { my ($_class, $_path, $_value) = @_ } +sub sync { my ($_class) = @_ } +sub sync_file { my ($_class, $_path) = @_ } + +package Gnome2::Config::Iterator; +our @ISA = qw(); +sub DESTROY { my ($_handle) = @_ } +sub next { my ($_handle) = @_ } + +package Gnome2::Config::Private; +our @ISA = qw(); +sub clean_file { my ($_class, $_path) = @_ } +sub clean_key { my ($_class, $_path) = @_ } +sub clean_section { my ($_class, $_path) = @_ } +sub drop_file { my ($_class, $_path) = @_ } +sub get_bool { my ($_class, $_path) = @_ } +sub get_bool_with_default { my ($_class, $_path) = @_ } +sub get_float { my ($_class, $_path) = @_ } +sub get_float_with_default { my ($_class, $_path) = @_ } +sub get_int { my ($_class, $_path) = @_ } +sub get_int_with_default { my ($_class, $_path) = @_ } +sub get_real_path { my ($_class, $_path) = @_ } +sub get_string { my ($_class, $_path) = @_ } +sub get_string_with_default { my ($_class, $_path) = @_ } +sub get_translated_string { my ($_class, $_path) = @_ } +sub get_translated_string_with_default { my ($_class, $_path) = @_ } +sub get_vector { my ($_class, $_path) = @_ } +sub get_vector_with_default { my ($_class, $_path) = @_ } +sub has_section { my ($_class, $_path) = @_ } +sub init_iterator { my ($_class, $_path) = @_ } +sub init_iterator_sections { my ($_class, $_path) = @_ } +sub set_bool { my ($_class, $_path, $_value) = @_ } +sub set_float { my ($_class, $_path, $_value) = @_ } +sub set_int { my ($_class, $_path, $_value) = @_ } +sub set_string { my ($_class, $_path, $_value) = @_ } +sub set_translated_string { my ($_class, $_path, $_value) = @_ } +sub set_vector { my ($_class, $_path, $_value) = @_ } +sub sync_file { my ($_class, $_path) = @_ } + +package Gnome2::DateEdit; +our @ISA = qw(); +sub get_flags { my ($_gde) = @_ } +sub get_initial_time { my ($_gde) = @_ } +sub get_time { my ($_gde) = @_ } +sub new { my ($_class, $_the_time, $_show_time, $_use_24_format) = @_ } +sub new_flags { my ($_class, $_the_time, $_flags) = @_ } +sub set_flags { my ($_gde, $_flags) = @_ } +sub set_popup_range { my ($_gde, $_low_hour, $_up_hour) = @_ } +sub set_time { my ($_gde, $_the_time) = @_ } + +package Gnome2::Druid; +our @ISA = qw(); +sub append_page { my ($_druid, $_page) = @_ } +sub back { my ($_druid) = @_ } +sub cancel { my ($_druid) = @_ } +sub finish { my ($_druid) = @_ } +sub help { my ($_druid) = @_ } +sub insert_page { my ($_druid, $_back_page, $_page) = @_ } +sub new { my ($_class) = @_ } +sub new_with_window { my ($_class, $_title, $_parent, $_close_on_cancel) = @_ } +sub next { my ($_druid) = @_ } +sub prepend_page { my ($_druid, $_page) = @_ } +sub set_buttons_sensitive { my ($_druid, $_back_sensitive, $_next_sensitive, $_cancel_sensitive, $_help_sensitive) = @_ } +sub set_page { my ($_druid, $_page) = @_ } +sub set_show_finish { my ($_druid, $_show_finish) = @_ } +sub set_show_help { my ($_druid, $_show_help) = @_ } + +package Gnome2::DruidPage; +our @ISA = qw(); +sub back { my ($_druid_page) = @_ } +sub cancel { my ($_druid_page) = @_ } +sub finish { my ($_druid_page) = @_ } +sub new { my ($_class) = @_ } +sub next { my ($_druid_page) = @_ } +sub prepare { my ($_druid_page) = @_ } + +package Gnome2::DruidPageEdge; +our @ISA = qw(); +sub new { my ($_class, $_position) = @_ } +sub new_aa { my ($_class, $_position) = @_ } +sub new_with_vals { my ($_class, $_position, $_antialiased, $_o_title, $_o_text, $_o_logo, $_o_watermark, $_o_top_watermark) = @_ } +sub set_bg_color { my ($_druid_page_edge, $_color) = @_ } +sub set_logo { my ($_druid_page_edge, $_logo_image) = @_ } +sub set_logo_bg_color { my ($_druid_page_edge, $_color) = @_ } +sub set_text { my ($_druid_page_edge, $_text) = @_ } +sub set_text_color { my ($_druid_page_edge, $_color) = @_ } +sub set_textbox_color { my ($_druid_page_edge, $_color) = @_ } +sub set_title { my ($_druid_page_edge, $_title) = @_ } +sub set_title_color { my ($_druid_page_edge, $_color) = @_ } +sub set_top_watermark { my ($_druid_page_edge, $_top_watermark_image) = @_ } +sub set_watermark { my ($_druid_page_edge, $_watermark) = @_ } + +package Gnome2::DruidPageStandard; +our @ISA = qw(); +sub append_item { my ($_druid_page_standard, $_question, $_item, $_additional_info) = @_ } +sub new { my ($_class) = @_ } +sub new_with_vals { my ($_class, $_title, $_o_logo, $_o_top_watermark) = @_ } +sub set_background { my ($_druid_page_standard, $_color) = @_ } +sub set_contents_background { my ($_druid_page_standard, $_color) = @_ } +sub set_logo { my ($_druid_page_standard, $_logo_image) = @_ } +sub set_logo_background { my ($_druid_page_standard, $_color) = @_ } +sub set_title { my ($_druid_page_standard, $_title) = @_ } +sub set_title_foreground { my ($_druid_page_standard, $_color) = @_ } +sub set_top_watermark { my ($_druid_page_standard, $_top_watermark_image) = @_ } +sub vbox { my ($_druid_page_standard) = @_ } + +package Gnome2::Entry; +our @ISA = qw(); +sub append_history { my ($_gentry, $_save, $_text) = @_ } +sub clear_history { my ($_gentry) = @_ } +sub get_history_id { my ($_gentry) = @_ } +sub get_max_saved { my ($_gentry) = @_ } +sub gtk_entry { my ($_gentry) = @_ } +sub new { my ($_class, $_o_history_id) = @_ } +sub prepend_history { my ($_gentry, $_save, $_text) = @_ } +sub set_history_id { my ($_gentry, $_history_id) = @_ } +sub set_max_saved { my ($_gentry, $_max_saved) = @_ } + +package Gnome2::FileEntry; +our @ISA = qw(); +sub get_directory_entry { my ($_fentry) = @_ } +sub get_full_path { my ($_fentry, $_file_must_exist) = @_ } +sub get_modal { my ($_fentry) = @_ } +sub gnome_entry { my ($_fentry) = @_ } +sub gtk_entry { my ($_fentry) = @_ } +sub new { my ($_class, $_history_id, $_browse_dialog_title) = @_ } +sub set_default_path { my ($_fentry, $_path) = @_ } +sub set_directory_entry { my ($_fentry, $_directory_entry) = @_ } +sub set_filename { my ($_fentry, $_filename) = @_ } +sub set_modal { my ($_fentry, $_is_modal) = @_ } +sub set_title { my ($_fentry, $_browse_dialog_title) = @_ } + +package Gnome2::FontPicker; +our @ISA = qw(); +sub fi_set_show_size { my ($_gfp, $_show_size) = @_ } +sub fi_set_use_font_in_label { my ($_gfp, $_use_font_in_label, $_size) = @_ } +sub get_font_name { my ($_gfp) = @_ } +sub get_mode { my ($_gfp) = @_ } +sub get_preview_text { my ($_gfp) = @_ } +sub get_title { my ($_gfp) = @_ } +sub new { my ($_class) = @_ } +sub set_font_name { my ($_gfp, $_fontname) = @_ } +sub set_mode { my ($_gfp, $_mode) = @_ } +sub set_preview_text { my ($_gfp, $_text) = @_ } +sub set_title { my ($_gfp, $_title) = @_ } +sub uw_get_widget { my ($_gfp) = @_ } +sub uw_set_widget { my ($_gfp, $_widget) = @_ } + +package Gnome2::GConf; +our @ISA = qw(); +sub get_app_settings_relative { my ($_class, $_program, $_subkey) = @_ } +sub get_gnome_libs_settings_relative { my ($_class, $_subkey) = @_ } + +package Gnome2::HRef; +our @ISA = qw(); +sub get_label { my ($_href) = @_ } +sub get_text { my ($_href) = @_ } +sub get_url { my ($_href) = @_ } +sub new { my ($_class, $_url, $_text) = @_ } +sub set_label { my ($_href, $_label) = @_ } +sub set_text { my ($_href, $_text) = @_ } +sub set_url { my ($_href, $_url) = @_ } + +package Gnome2::Help; +our @ISA = qw(); +sub display { my ($_class, $_file_name, $_o_link_id) = @_ } +sub display_desktop { my ($_class, $_program, $_doc_id, $_file_name, $_o_link_id) = @_ } +sub display_desktop_with_env { my ($_class, $_program, $_doc_id, $_file_name, $_link_id, $_env_ref) = @_ } + +package Gnome2::I18N; +our @ISA = qw(); +sub get_language_list { my ($_class, $_o_category_name) = @_ } +sub pop_c_numeric_locale { my ($_class) = @_ } +sub push_c_numeric_locale { my ($_class) = @_ } + +package Gnome2::IconEntry; +our @ISA = qw(); +sub get_filename { my ($_ientry) = @_ } +sub new { my ($_class, $_history_id, $_browse_dialog_title) = @_ } +sub pick_dialog { my ($_ientry) = @_ } +sub set_browse_dialog_title { my ($_ientry, $_browse_dialog_title) = @_ } +sub set_filename { my ($_ientry, $_filename) = @_ } +sub set_history_id { my ($_ientry, $_history_id) = @_ } +sub set_max_saved { my ($_ientry, $_max_saved) = @_ } +sub set_pixmap_subdir { my ($_ientry, $_subdir) = @_ } + +package Gnome2::IconList; +our @ISA = qw(); +sub append { my ($_gil, $_icon_filename, $_text) = @_ } +sub append_pixbuf { my ($_gil, $_im, $_icon_filename, $_text) = @_ } +sub clear { my ($_gil) = @_ } +sub find_icon_from_filename { my ($_gil, $_filename) = @_ } +sub focus_icon { my ($_gil, $_idx) = @_ } +sub freeze { my ($_gil) = @_ } +sub get_icon_at { my ($_gil, $_x, $_y) = @_ } +sub get_icon_filename { my ($_gil, $_idx) = @_ } +sub get_icon_pixbuf_item { my ($_gil, $_idx) = @_ } +sub get_icon_text_item { my ($_gil, $_idx) = @_ } +sub get_items_per_line { my ($_gil) = @_ } +sub get_num_icons { my ($_gil) = @_ } +sub get_selection { my ($_gil) = @_ } +sub get_selection_mode { my ($_gil) = @_ } +sub icon_is_visible { my ($_gil, $_pos) = @_ } +sub insert { my ($_gil, $_pos, $_icon_filename, $_text) = @_ } +sub insert_pixbuf { my ($_gil, $_pos, $_im, $_icon_filename, $_text) = @_ } +sub moveto { my ($_gil, $_pos, $_yalign) = @_ } +sub new { my ($_class, $_icon_width, $_adj, $_flags) = @_ } +sub remove { my ($_gil, $_pos) = @_ } +sub select_icon { my ($_gil, $_pos) = @_ } +sub set_col_spacing { my ($_gil, $_pixels) = @_ } +sub set_hadjustment { my ($_gil, $_hadj) = @_ } +sub set_icon_border { my ($_gil, $_pixels) = @_ } +sub set_icon_width { my ($_gil, $_w) = @_ } +sub set_row_spacing { my ($_gil, $_pixels) = @_ } +sub set_selection_mode { my ($_gil, $_mode) = @_ } +sub set_separators { my ($_gil, $_sep) = @_ } +sub set_text_spacing { my ($_gil, $_pixels) = @_ } +sub set_vadjustment { my ($_gil, $_vadj) = @_ } +sub thaw { my ($_gil) = @_ } +sub unselect_all { my ($_gil) = @_ } +sub unselect_icon { my ($_gil, $_pos) = @_ } + +package Gnome2::IconSelection; +our @ISA = qw(); +sub add_defaults { my ($_gis) = @_ } +sub add_directory { my ($_gis, $_dir) = @_ } +sub clear { my ($_gis, $_not_shown) = @_ } +sub get_box { my ($_gis) = @_ } +sub get_gil { my ($_gis) = @_ } +sub get_icon { my ($_gis, $_full_path) = @_ } +sub new { my ($_class) = @_ } +sub select_icon { my ($_gis, $_filename) = @_ } +sub show_icons { my ($_gis) = @_ } +sub stop_loading { my ($_gis) = @_ } + +package Gnome2::IconTextItem; +our @ISA = qw(); +sub configure { my ($_iti, $_x, $_y, $_width, $_fontname, $_text, $_is_editable, $_is_static) = @_ } +sub focus { my ($_iti, $_focused) = @_ } +sub get_editable { my ($_iti) = @_ } +sub get_text { my ($_iti) = @_ } +sub select { my ($_iti, $_sel) = @_ } +sub setxy { my ($_iti, $_x, $_y) = @_ } +sub start_editing { my ($_iti) = @_ } +sub stop_editing { my ($_iti, $_accept) = @_ } + +package Gnome2::IconTheme; +our @ISA = qw(); +sub append_search_path { my ($_theme, $_path) = @_ } +sub get_allow_svg { my ($_theme) = @_ } +sub get_example_icon_name { my ($_theme) = @_ } +sub get_search_path { my ($_theme) = @_ } +sub has_icon { my ($_theme, $_icon_name) = @_ } +sub list_icons { my ($_theme, $_o_context) = @_ } +sub lookup { my ($_icon_theme, $_thumbnail_factory, $_file_uri, $_custom_icon, $_file_info, $_mime_type, $_flags) = @_ } +sub lookup_icon { my ($_theme, $_icon_name, $_size) = @_ } +sub lookup_sync { my ($_icon_theme, $_thumbnail_factory, $_file_uri, $_custom_icon, $_flags) = @_ } +sub new { my ($_class) = @_ } +sub prepend_search_path { my ($_theme, $_path) = @_ } +sub rescan_if_needed { my ($_theme) = @_ } +sub set_allow_svg { my ($_theme, $_allow_svg) = @_ } +sub set_custom_theme { my ($_theme, $_theme_name) = @_ } +sub set_search_path { my ($_theme, @_more_paras) = @_ } + +package Gnome2::ModuleInfo; +our @ISA = qw(); +sub bonobo { my ($_class) = @_ } +sub description { my ($_module_info) = @_ } +sub libgnome { my ($_class) = @_ } +sub libgnomeui { my ($_class) = @_ } +sub name { my ($_module_info) = @_ } +sub opt_prefix { my ($_module_info) = @_ } +sub version { my ($_module_info) = @_ } + +package Gnome2::PasswordDialog; +our @ISA = qw(); +sub get_domain { my ($_password_dialog) = @_ } +sub get_password { my ($_password_dialog) = @_ } +sub get_remember { my ($_password_dialog) = @_ } +sub get_username { my ($_password_dialog) = @_ } +sub new { my ($_class, $_dialog_title, $_message, $_username, $_password, $_readonly_username) = @_ } +sub run_and_block { my ($_password_dialog) = @_ } +sub set_domain { my ($_password_dialog, $_domain) = @_ } +sub set_password { my ($_password_dialog, $_password) = @_ } +sub set_readonly_domain { my ($_password_dialog, $_readonly) = @_ } +sub set_readonly_username { my ($_password_dialog, $_readonly) = @_ } +sub set_remember { my ($_password_dialog, $_remember) = @_ } +sub set_show_domain { my ($_password_dialog, $_show) = @_ } +sub set_show_password { my ($_password_dialog, $_show) = @_ } +sub set_show_remember { my ($_password_dialog, $_show_remember) = @_ } +sub set_show_username { my ($_password_dialog, $_show) = @_ } +sub set_username { my ($_password_dialog, $_username) = @_ } + +package Gnome2::PixmapEntry; +our @ISA = qw(); +sub get_filename { my ($_pentry) = @_ } +sub new { my ($_class, $_history_id, $_browse_dialog_title, $_do_preview) = @_ } +sub preview_widget { my ($_pentry) = @_ } +sub scrolled_window { my ($_pentry) = @_ } +sub set_pixmap_subdir { my ($_pentry, $_subdir) = @_ } +sub set_preview { my ($_pentry, $_do_preview) = @_ } +sub set_preview_size { my ($_pentry, $_preview_w, $_preview_h) = @_ } + +package Gnome2::PopupMenu; +our @ISA = qw(); +sub new { my ($_class, $_uiinfo, $_o_accelgroup) = @_ } +sub new_with_accelgroup { my ($_class, $_uiinfo, $_o_accelgroup) = @_ } + +package Gnome2::Program; +our @ISA = qw(); +sub get_app_id { my ($_program) = @_ } +sub get_app_version { my ($_program) = @_ } +sub get_human_readable_name { my ($_program) = @_ } +sub get_program { my ($_class) = @_ } +sub init { my ($_class, $_app_id, $_app_version, $_o_module_info, @_more_paras) = @_ } +sub locate_file { my ($_program, $_domain, $_file_name, $_only_if_exists) = @_ } +sub module_load { my ($_class, $_mod_name) = @_ } +sub module_register { my ($_class, $_module_info) = @_ } +sub module_registered { my ($_class, $_module_info) = @_ } + +package Gnome2::Score; +our @ISA = qw(); +sub get_notable { my ($_class, $_gamename, $_level) = @_ } +sub init { my ($_class, $_gamename) = @_ } +sub log { my ($_class, $_score, $_level, $_higher_to_lower_score_order) = @_ } + +package Gnome2::Scores; +our @ISA = qw(); +sub display { my ($_class, $_title, $_app_name, $_level, $_pos) = @_ } +sub display_with_pixmap { my ($_class, $_pixmap_logo, $_app_name, $_level, $_pos) = @_ } +sub new { my ($_class, $_names, $_scores, $_times, $_clear) = @_ } +sub set_color { my ($_gs, $_n, $_col) = @_ } +sub set_colors { my ($_gs, $_col) = @_ } +sub set_current_player { my ($_gs, $_i) = @_ } +sub set_def_color { my ($_gs, $_col) = @_ } +sub set_logo_label { my ($_gs, $_txt, $_font, $_col) = @_ } +sub set_logo_label_title { my ($_gs, $_txt) = @_ } +sub set_logo_pixmap { my ($_gs, $_pix_name) = @_ } +sub set_logo_widget { my ($_gs, $_w) = @_ } + +package Gnome2::Sound; +our @ISA = qw(); +sub connection_get { my ($_class) = @_ } +sub init { my ($_class, $_o_hostname) = @_ } +sub play { my ($_class, $_filename) = @_ } +sub sample_load { my ($_class, $_sample_name, $_filename) = @_ } +sub shutdown { my ($_class) = @_ } + +package Gnome2::ThumbnailFactory; +our @ISA = qw(); +sub can_thumbnail { my ($_factory, $_uri, $_mime_type, $_mtime) = @_ } +sub create_failed_thumbnail { my ($_factory, $_uri, $_mtime) = @_ } +sub generate_thumbnail { my ($_factory, $_uri, $_mime_type) = @_ } +sub has_valid_failed_thumbnail { my ($_factory, $_uri, $_mtime) = @_ } +sub lookup { my ($_factory, $_uri, $_mtime) = @_ } +sub new { my ($_class, $_size) = @_ } +sub save_thumbnail { my ($_factory, $_thumbnail, $_uri, $_original_mtime) = @_ } + +package Gnome2::UIDefs; +our @ISA = qw(); +sub key_mod_clear { my ($_class) = @_ } +sub key_mod_close { my ($_class) = @_ } +sub key_mod_close_window { my ($_class) = @_ } +sub key_mod_copy { my ($_class) = @_ } +sub key_mod_cut { my ($_class) = @_ } +sub key_mod_find { my ($_class) = @_ } +sub key_mod_find_again { my ($_class) = @_ } +sub key_mod_new { my ($_class) = @_ } +sub key_mod_new_game { my ($_class) = @_ } +sub key_mod_new_window { my ($_class) = @_ } +sub key_mod_open { my ($_class) = @_ } +sub key_mod_paste { my ($_class) = @_ } +sub key_mod_pause_game { my ($_class) = @_ } +sub key_mod_print { my ($_class) = @_ } +sub key_mod_print_setup { my ($_class) = @_ } +sub key_mod_quit { my ($_class) = @_ } +sub key_mod_redo { my ($_class) = @_ } +sub key_mod_redo_move { my ($_class) = @_ } +sub key_mod_replace { my ($_class) = @_ } +sub key_mod_save { my ($_class) = @_ } +sub key_mod_save_as { my ($_class) = @_ } +sub key_mod_select_all { my ($_class) = @_ } +sub key_mod_undo { my ($_class) = @_ } +sub key_mod_undo_move { my ($_class) = @_ } +sub key_name_clear { my ($_class) = @_ } +sub key_name_close { my ($_class) = @_ } +sub key_name_close_window { my ($_class) = @_ } +sub key_name_copy { my ($_class) = @_ } +sub key_name_cut { my ($_class) = @_ } +sub key_name_find { my ($_class) = @_ } +sub key_name_find_again { my ($_class) = @_ } +sub key_name_new { my ($_class) = @_ } +sub key_name_new_game { my ($_class) = @_ } +sub key_name_new_window { my ($_class) = @_ } +sub key_name_open { my ($_class) = @_ } +sub key_name_paste { my ($_class) = @_ } +sub key_name_pause_game { my ($_class) = @_ } +sub key_name_print { my ($_class) = @_ } +sub key_name_print_setup { my ($_class) = @_ } +sub key_name_quit { my ($_class) = @_ } +sub key_name_redo { my ($_class) = @_ } +sub key_name_redo_move { my ($_class) = @_ } +sub key_name_replace { my ($_class) = @_ } +sub key_name_save { my ($_class) = @_ } +sub key_name_save_as { my ($_class) = @_ } +sub key_name_select_all { my ($_class) = @_ } +sub key_name_undo { my ($_class) = @_ } +sub key_name_undo_move { my ($_class) = @_ } +sub pad { my ($_class) = @_ } +sub pad_big { my ($_class) = @_ } +sub pad_small { my ($_class) = @_ } + +package Gnome2::URL; +our @ISA = qw(); +sub show { my ($_class, $_url) = @_ } +sub show_with_env { my ($_class, $_url, $_env_ref) = @_ } + +package Gnome2::Util; +our @ISA = qw(); +sub extension { my ($_class, $_path) = @_ } +sub home_file { my ($_class, $_file) = @_ } +sub prepend_user_home { my ($_class, $_file) = @_ } +sub user_shell { my ($_class) = @_ } + +package Gnome2::WindowIcon; +our @ISA = qw(); +sub init { my ($_class) = @_ } +sub set_default_from_file { my ($_class, $_filename) = @_ } +sub set_default_from_file_list { my ($_class, $_filenames_ref) = @_ } +sub set_from_default { my ($_class, $_w) = @_ } +sub set_from_file { my ($_class, $_w, $_filename) = @_ } +sub set_from_file_list { my ($_class, $_w, $_filenames_ref) = @_ } + +package Gtk2::Gdk::Pixbuf; +our @ISA = qw(); +sub has_uri { my ($_pixbuf, $_uri) = @_ } +sub is_valid { my ($_pixbuf, $_uri, $_mtime) = @_ } +sub md5 { my ($_class, $_uri) = @_ } +sub path_for_uri { my ($_class, $_uri, $_size) = @_ } +sub scale_down_pixbuf { my ($_pixbuf, $_dest_width, $_dest_height) = @_ } + +package Gtk2::Menu; +our @ISA = qw(); +sub append_from { my ($_popup, $_uiinfo) = @_ } +sub attach_to { my ($_popup, $_widget, $_o_user_data) = @_ } +sub do_popup { my ($_popup, $_pos_func, $_pos_data, $_event, $_user_data, $_for_widget) = @_ } +sub do_popup_modal { my ($_popup, $_pos_func, $_pos_data, $_event, $_user_data, $_for_widget) = @_ } + +package Gtk2::MenuShell; +our @ISA = qw(); +sub fill_menu { my ($_menu_shell, $_uiinfo, $_accel_group, $_uline_accels, $_pos) = @_ } +sub find_menu_pos { my ($_parent, $_path) = @_ } + +package Gtk2::Statusbar; +our @ISA = qw(); +sub install_menu_hints { my ($_bar, $_uiinfo) = @_ } + +package Gtk2::Toolbar; +our @ISA = qw(); +sub fill_toolbar { my ($_toolbar, $_uiinfo, $_accel_group) = @_ } + +package Gtk2::Widget; +our @ISA = qw(); +sub add_popup_items { my ($_widget, $_uiinfo, $_o_user_data) = @_ } + +package Gtk2::Window; +our @ISA = qw(); +sub toplevel_set_title { my ($_window, $_doc_name, $_app_name, $_extension) = @_ } diff --git a/fake_packages/Gnome2/Vte.pm b/fake_packages/Gnome2/Vte.pm new file mode 100644 index 0000000..598c405 --- /dev/null +++ b/fake_packages/Gnome2/Vte.pm @@ -0,0 +1,72 @@ + +package Gnome2::Vte; +our @ISA = qw(); +sub CHECK_VERSION { my ($_class, $_major, $_minor, $_micro) = @_ } +sub GET_VERSION_INFO { my ($_class) = @_ } + +package Gnome2::Vte::Terminal; +our @ISA = qw(); +sub copy_clipboard { my ($_terminal) = @_ } +sub copy_primary { my ($_terminal) = @_ } +sub feed { my ($_terminal, $_data) = @_ } +sub feed_child { my ($_terminal, $_data) = @_ } +sub fork_command { my ($_terminal, $_command, $_arg_ref, $_env_ref, $_directory, $_lastlog, $_utmp, $_wtmp) = @_ } +sub get_adjustment { my ($_terminal) = @_ } +sub get_allow_bold { my ($_terminal) = @_ } +sub get_audible_bell { my ($_terminal) = @_ } +sub get_char_ascent { my ($_terminal) = @_ } +sub get_char_descent { my ($_terminal) = @_ } +sub get_char_height { my ($_terminal) = @_ } +sub get_char_width { my ($_terminal) = @_ } +sub get_column_count { my ($_terminal) = @_ } +sub get_cursor_position { my ($_terminal) = @_ } +sub get_emulation { my ($_terminal) = @_ } +sub get_encoding { my ($_terminal) = @_ } +sub get_font { my ($_terminal) = @_ } +sub get_has_selection { my ($_terminal) = @_ } +sub get_icon_title { my ($_terminal) = @_ } +sub get_mouse_autohide { my ($_terminal) = @_ } +sub get_padding { my ($_terminal) = @_ } +sub get_row_count { my ($_terminal) = @_ } +sub get_status_line { my ($_terminal) = @_ } +sub get_text { my ($_terminal, $_func, $_o_data) = @_ } +sub get_text_range { my ($_terminal, $_start_row, $_start_col, $_end_row, $_end_col, $_func, $_o_data) = @_ } +sub get_using_xft { my ($_terminal) = @_ } +sub get_visible_bell { my ($_terminal) = @_ } +sub get_window_title { my ($_terminal) = @_ } +sub im_append_menuitems { my ($_terminal, $_menushell) = @_ } +sub is_word_char { my ($_terminal, $_c) = @_ } +sub match_add { my ($_terminal, $_match) = @_ } +sub match_check { my ($_terminal, $_column, $_row) = @_ } +sub match_clear_all { my ($_terminal) = @_ } +sub match_remove { my ($_terminal, $_tag) = @_ } +sub new { my ($_class) = @_ } +sub paste_clipboard { my ($_terminal) = @_ } +sub paste_primary { my ($_terminal) = @_ } +sub reset { my ($_terminal, $_full, $_clear_history) = @_ } +sub set_allow_bold { my ($_terminal, $_allow_bold) = @_ } +sub set_audible_bell { my ($_terminal, $_is_audible) = @_ } +sub set_background_image { my ($_terminal, $_image) = @_ } +sub set_background_image_file { my ($_terminal, $_path) = @_ } +sub set_background_saturation { my ($_terminal, $_saturation) = @_ } +sub set_background_transparent { my ($_terminal, $_transparent) = @_ } +sub set_backspace_binding { my ($_terminal, $_binding) = @_ } +sub set_color_background { my ($_terminal, $_background) = @_ } +sub set_color_bold { my ($_terminal, $_bold) = @_ } +sub set_color_dim { my ($_terminal, $_dim) = @_ } +sub set_color_foreground { my ($_terminal, $_foreground) = @_ } +sub set_colors { my ($_terminal, $_foreground, $_background, $_palette_ref) = @_ } +sub set_cursor_blinks { my ($_terminal, $_blink) = @_ } +sub set_default_colors { my ($_terminal) = @_ } +sub set_delete_binding { my ($_terminal, $_binding) = @_ } +sub set_emulation { my ($_terminal, $_emulation) = @_ } +sub set_encoding { my ($_terminal, $_codeset) = @_ } +sub set_font { my ($_terminal, $_font_desc) = @_ } +sub set_font_from_string { my ($_terminal, $_name) = @_ } +sub set_mouse_autohide { my ($_terminal, $_setting) = @_ } +sub set_scroll_on_keystroke { my ($_terminal, $_scroll) = @_ } +sub set_scroll_on_output { my ($_terminal, $_scroll) = @_ } +sub set_scrollback_lines { my ($_terminal, $_lines) = @_ } +sub set_size { my ($_terminal, $_columns, $_rows) = @_ } +sub set_visible_bell { my ($_terminal, $_is_visible) = @_ } +sub set_word_chars { my ($_terminal, $_spec) = @_ } diff --git a/fake_packages/Gtk2.pm b/fake_packages/Gtk2.pm new file mode 100644 index 0000000..6b25db6 --- /dev/null +++ b/fake_packages/Gtk2.pm @@ -0,0 +1,3742 @@ +package Gtk2; +use Glib; + +package Gnome2::Pango::Language; +our @ISA = qw(); +sub matches { my ($_language, $_range_list) = @_ } + +package Gtk2; +our @ISA = qw(); +sub CHECK_VERSION { my ($_class, $_required_major, $_required_minor, $_required_micro) = @_ } +sub GET_VERSION_INFO { my ($_class) = @_ } +sub MAJOR_VERSION() {} +sub MICRO_VERSION() {} +sub MINOR_VERSION() {} +sub alternative_dialog_button_order { my ($_class, $_o_screen) = @_ } +sub check_version { my ($_class, $_required_major, $_required_minor, $_required_micro) = @_ } +sub disable_setlocale { my ($_class) = @_ } +sub draw_insertion_cursor { my ($_class, $_widget, $_drawable, $_area, $_location, $_is_primary, $_direction, $_draw_arrow) = @_ } +sub events_pending { my ($_class) = @_ } +sub get_current_event { my ($_class) = @_ } +sub get_current_event_state { my ($_class) = @_ } +sub get_current_event_time { my ($_class) = @_ } +sub get_default_language { my ($_class) = @_ } +sub get_event_widget { my ($_class, $_event) = @_ } +sub get_version_info { my ($_class) = @_ } +sub grab_add { my ($_class, $_widget) = @_ } +sub grab_get_current { my ($_class) = @_ } +sub grab_remove { my ($_class, $_widget) = @_ } +sub init { my ($_o_class) = @_ } +sub init_add { my ($_class, $_function, $_o_data) = @_ } +sub init_check { my ($_o_class) = @_ } +sub key_snooper_install { my ($_class, $_snooper, $_o_func_data) = @_ } +sub key_snooper_remove { my ($_class, $_snooper_handler_id) = @_ } +sub main { my ($_class) = @_ } +sub main_do_event { my ($_class, $_event) = @_ } +sub main_iteration { my ($_class) = @_ } +sub main_iteration_do { my ($_class, $_blocking) = @_ } +sub main_level { my ($_class) = @_ } +sub main_quit { my ($_o_class) = @_ } +sub major_version() {} +sub micro_version() {} +sub minor_version() {} +sub parse_args { my ($_o_class) = @_ } +sub quit_add { my ($_class, $_main_level, $_function, $_o_data) = @_ } +sub quit_add_destroy { my ($_class, $_main_level, $_object) = @_ } +sub quit_remove { my ($_class, $_quit_handler_id) = @_ } +sub set_locale { my ($_class) = @_ } +sub show_about_dialog { my ($_class, $_parent, $_first_property_name, @_more_paras) = @_ } + +package Gtk2::AboutDialog; +our @ISA = qw(); +sub get_artists { my ($_about) = @_ } +sub get_authors { my ($_about) = @_ } +sub get_comments { my ($_about) = @_ } +sub get_copyright { my ($_about) = @_ } +sub get_documenters { my ($_about) = @_ } +sub get_license { my ($_about) = @_ } +sub get_logo { my ($_about) = @_ } +sub get_logo_icon_name { my ($_about) = @_ } +sub get_name { my ($_about) = @_ } +sub get_translator_credits { my ($_about) = @_ } +sub get_version { my ($_about) = @_ } +sub get_website { my ($_about) = @_ } +sub get_website_label { my ($_about) = @_ } +sub get_wrap_license { my ($_about) = @_ } +sub new { my ($_class) = @_ } +sub set_artists { my ($_about, $_artist1, @_more_paras) = @_ } +sub set_authors { my ($_about, $_author1, @_more_paras) = @_ } +sub set_comments { my ($_about, $_comments) = @_ } +sub set_copyright { my ($_about, $_copyright) = @_ } +sub set_documenters { my ($_about, $_documenter1, @_more_paras) = @_ } +sub set_email_hook { my ($_class, $_func, $_o_data) = @_ } +sub set_license { my ($_about, $_license) = @_ } +sub set_logo { my ($_about, $_logo) = @_ } +sub set_logo_icon_name { my ($_about, $_icon_name) = @_ } +sub set_name { my ($_about, $_name) = @_ } +sub set_translator_credits { my ($_about, $_translator_credits) = @_ } +sub set_url_hook { my ($_class, $_func, $_o_data) = @_ } +sub set_version { my ($_about, $_version) = @_ } +sub set_website { my ($_about, $_website) = @_ } +sub set_website_label { my ($_about, $_website_label) = @_ } +sub set_wrap_license { my ($_about, $_wrap_license) = @_ } + +package Gtk2::AccelGroup; +our @ISA = qw(); +sub connect { my ($_accel_group, $_accel_key, $_accel_mods, $_accel_flags, $_func) = @_ } +sub connect_by_path { my ($_accel_group, $_accel_path, $_func) = @_ } +sub disconnect { my ($_accel_group, $_func) = @_ } +sub disconnect_key { my ($_accel_group, $_accel_key, $_accel_mods) = @_ } +sub lock { my ($_accel_group) = @_ } +sub new { my ($_class) = @_ } +sub unlock { my ($_accel_group) = @_ } + +package Gtk2::AccelGroups; +our @ISA = qw(); +sub activate { my ($_class, $_object, $_accel_key, $_accel_mods) = @_ } +sub from_object { my ($_class, $_object) = @_ } + +package Gtk2::AccelLabel; +our @ISA = qw(); +sub get_accel_widget { my ($_accel_label) = @_ } +sub get_accel_width { my ($_accel_label) = @_ } +sub new { my ($_class, $_string) = @_ } +sub refetch { my ($_accel_label) = @_ } +sub set_accel_widget { my ($_accel_label, $_accel_widget) = @_ } + +package Gtk2::AccelMap; +our @ISA = qw(); +sub add_entry { my ($_class, $_accel_path, $_accel_key, $_accel_mods) = @_ } +sub add_filter { my ($_class, $_filter_pattern) = @_ } +sub change_entry { my ($_class, $_accel_path, $_accel_key, $_accel_mods, $_replace) = @_ } +sub Gtk2::AccelMap::foreach { my ($_class, $_data, $_foreach_func) = @_ } +sub foreach_unfiltered { my ($_class, $_data, $_foreach_func) = @_ } +sub get { my ($_class) = @_ } +sub load { my ($_class, $_file_name) = @_ } +sub load_fd { my ($_class, $_fd) = @_ } +sub lock_path { my ($_class, $_accel_path) = @_ } +sub lookup_entry { my ($_class, $_accel_path) = @_ } +sub save { my ($_class, $_file_name) = @_ } +sub save_fd { my ($_class, $_fd) = @_ } +sub unlock_path { my ($_class, $_accel_path) = @_ } + +package Gtk2::Accelerator; +our @ISA = qw(); +sub get_default_mod_mask { my ($_class) = @_ } +sub get_label { my ($_class, $_accelerator_key, $_accelerator_mods) = @_ } +sub name { my ($_class, $_accelerator_key, $_accelerator_mods) = @_ } +sub parse { my ($_class, $_accelerator) = @_ } +sub set_default_mod_mask { my ($_class, $_default_mod_mask) = @_ } +sub valid { my ($_class, $_keyval, $_modifiers) = @_ } + +package Gtk2::Action; +our @ISA = qw(); +sub activate { my ($_action) = @_ } +sub block_activate_from { my ($_action, $_proxy) = @_ } +sub connect_accelerator { my ($_action) = @_ } +sub connect_proxy { my ($_action, $_proxy) = @_ } +sub create_icon { my ($_action, $_icon_size) = @_ } +sub create_menu_item { my ($_action) = @_ } +sub create_tool_item { my ($_action) = @_ } +sub disconnect_accelerator { my ($_action) = @_ } +sub disconnect_proxy { my ($_action, $_proxy) = @_ } +sub get_accel_path { my ($_action) = @_ } +sub get_name { my ($_action) = @_ } +sub get_proxies { my ($_action) = @_ } +sub get_sensitive { my ($_action) = @_ } +sub get_visible { my ($_action) = @_ } +sub is_sensitive { my ($_action) = @_ } +sub is_visible { my ($_action) = @_ } +sub set_accel_group { my ($_action, $_accel_group) = @_ } +sub set_accel_path { my ($_action, $_accel_path) = @_ } +sub set_sensitive { my ($_action, $_sensitive) = @_ } +sub set_visible { my ($_action, $_visible) = @_ } +sub unblock_activate_from { my ($_action, $_proxy) = @_ } + +package Gtk2::ActionGroup; +our @ISA = qw(); +sub add_action { my ($_action_group, $_action) = @_ } +sub add_action_with_accel { my ($_action_group, $_action, $_accelerator) = @_ } +sub add_actions { my ($_action_group, $_action_entries, $_o_user_data) = @_ } +sub add_radio_actions { my ($_action_group, $_radio_action_entries, $_value, $_on_change, $_o_user_data) = @_ } +sub add_toggle_actions { my ($_action_group, $_toggle_action_entries, $_o_user_data) = @_ } +sub get_action { my ($_action_group, $_action_name) = @_ } +sub get_name { my ($_action_group) = @_ } +sub get_sensitive { my ($_action_group) = @_ } +sub get_visible { my ($_action_group) = @_ } +sub list_actions { my ($_action_group) = @_ } +sub new { my ($_class, $_name) = @_ } +sub remove_action { my ($_action_group, $_action) = @_ } +sub set_sensitive { my ($_action_group, $_sensitive) = @_ } +sub set_translate_func { my ($_action_group, $_func, $_o_data) = @_ } +sub set_translation_domain { my ($_action_group, $_domain) = @_ } +sub set_visible { my ($_action_group, $_sensitive) = @_ } +sub translate_string { my ($_action_group, $_string) = @_ } + +package Gtk2::Adjustment; +our @ISA = qw(); +sub changed { my ($_adjustment) = @_ } +sub clamp_page { my ($_adjustment, $_lower, $_upper) = @_ } +sub get_value { my ($_adjustment) = @_ } +sub lower { my ($_adjustment, $_o_newval) = @_ } +sub new { my ($_class, $_value, $_lower, $_upper, $_step_increment, $_page_increment, $_page_size) = @_ } +sub page_increment { my ($_adjustment, $_o_newval) = @_ } +sub page_size { my ($_adjustment, $_o_newval) = @_ } +sub set_value { my ($_adjustment, $_value) = @_ } +sub step_increment { my ($_adjustment, $_o_newval) = @_ } +sub upper { my ($_adjustment, $_o_newval) = @_ } +sub value { my ($_adjustment, $_o_newval) = @_ } +sub value_changed { my ($_adjustment) = @_ } + +package Gtk2::Alignment; +our @ISA = qw(); +sub get_padding { my ($_alignment) = @_ } +sub new { my ($_class, $_xalign, $_yalign, $_xscale, $_yscale) = @_ } +sub set { my ($_alignment, $_xalign, $_yalign, $_xscale, $_yscale) = @_ } +sub set_padding { my ($_alignment, $_padding_top, $_padding_bottom, $_padding_left, $_padding_right) = @_ } + +package Gtk2::Arrow; +our @ISA = qw(); +sub new { my ($_class, $_arrow_type, $_shadow_type) = @_ } +sub set { my ($_arrow, $_arrow_type, $_shadow_type) = @_ } + +package Gtk2::AspectFrame; +our @ISA = qw(); +sub new { my ($_class, $_label, $_xalign, $_yalign, $_ratio, $_obey_child) = @_ } +sub set_params { my ($_aspect_frame, $_xalign, $_yalign, $_ratio, $_obey_child) = @_ } + +package Gtk2::Bin; +our @ISA = qw(); +sub child { my ($_bin) = @_ } +sub get_child { my ($_bin) = @_ } + +package Gtk2::Box; +our @ISA = qw(); +sub get_homogeneous { my ($_box) = @_ } +sub get_spacing { my ($_box) = @_ } +sub pack_end { my ($_box, $_child, $_expand, $_fill, $_padding) = @_ } +sub pack_end_defaults { my ($_box, $_widget) = @_ } +sub pack_start { my ($_box, $_child, $_expand, $_fill, $_padding) = @_ } +sub pack_start_defaults { my ($_box, $_widget) = @_ } +sub query_child_packing { my ($_box, $_child) = @_ } +sub reorder_child { my ($_box, $_child, $_position) = @_ } +sub set_child_packing { my ($_box, $_child, $_expand, $_fill, $_padding, $_pack_type) = @_ } +sub set_homogeneous { my ($_box, $_homogeneous) = @_ } +sub set_spacing { my ($_box, $_spacing) = @_ } + +package Gtk2::Button; +our @ISA = qw(); +sub clicked { my ($_button) = @_ } +sub enter { my ($_button) = @_ } +sub get_alignment { my ($_button) = @_ } +sub get_focus_on_click { my ($_button) = @_ } +sub get_image { my ($_button) = @_ } +sub get_label { my ($_button) = @_ } +sub get_relief { my ($_button) = @_ } +sub get_use_stock { my ($_button) = @_ } +sub get_use_underline { my ($_button) = @_ } +sub leave { my ($_button) = @_ } +sub new { my ($_class, $_o_label) = @_ } +sub new_from_stock { my ($_class, $_stock_id) = @_ } +sub new_with_label { my ($_class, $_o_label) = @_ } +sub new_with_mnemonic { my ($_class, $_o_label) = @_ } +sub pressed { my ($_button) = @_ } +sub released { my ($_button) = @_ } +sub set_alignment { my ($_button, $_xalign, $_yalign) = @_ } +sub set_focus_on_click { my ($_button, $_focus_on_click) = @_ } +sub set_image { my ($_button, $_image) = @_ } +sub set_label { my ($_button, $_label) = @_ } +sub set_relief { my ($_button, $_newstyle) = @_ } +sub set_use_stock { my ($_button, $_use_stock) = @_ } +sub set_use_underline { my ($_button, $_use_underline) = @_ } + +package Gtk2::ButtonBox; +our @ISA = qw(); +sub get_child_secondary { my ($_widget, $_child) = @_ } +sub get_layout { my ($_widget) = @_ } +sub set_child_secondary { my ($_widget, $_child, $_is_secondary) = @_ } +sub set_layout { my ($_widget, $_layout_style) = @_ } + +package Gtk2::Calendar; +our @ISA = qw(); +sub clear_marks { my ($_calendar) = @_ } +sub display_options { my ($_calendar, $_flags) = @_ } +sub freeze { my ($_calendar) = @_ } +sub get_date { my ($_calendar) = @_ } +sub get_display_options { my ($_calendar) = @_ } +sub mark_day { my ($_calendar, $_day) = @_ } +sub marked_date { my ($_cal) = @_ } +sub month { my ($_cal) = @_ } +sub new { my ($_class) = @_ } +sub num_marked_dates { my ($_cal) = @_ } +sub select_day { my ($_calendar, $_day) = @_ } +sub select_month { my ($_calendar, $_month, $_year) = @_ } +sub selected_day { my ($_cal) = @_ } +sub set_display_options { my ($_calendar, $_flags) = @_ } +sub thaw { my ($_calendar) = @_ } +sub unmark_day { my ($_calendar, $_day) = @_ } +sub year { my ($_cal) = @_ } + +package Gtk2::CellEditable; +our @ISA = qw(); +sub _ADD_INTERFACE { my ($_class, $_target_class) = @_ } +sub editing_done { my ($_cell_editable) = @_ } +sub remove_widget { my ($_cell_editable) = @_ } +sub start_editing { my ($_cell_editable, $_o_event) = @_ } + +package Gtk2::CellLayout; +our @ISA = qw(); +sub add_attribute { my ($_cell_layout, $_cell, $_attribute, $_column) = @_ } +sub clear { my ($_cell_layout) = @_ } +sub clear_attributes { my ($_cell_layout, $_cell) = @_ } +sub pack_end { my ($_cell_layout, $_cell, $_expand) = @_ } +sub pack_start { my ($_cell_layout, $_cell, $_expand) = @_ } +sub reorder { my ($_cell_layout, $_cell, $_position) = @_ } +sub set_attributes { my ($_cell_layout, $_cell, @_more_paras) = @_ } +sub set_cell_data_func { my ($_cell_layout, $_cell, $_func, $_o_func_data) = @_ } + +package Gtk2::CellRenderer; +our @ISA = qw(); +sub ACTIVATE { my ($_cell, @_more_paras) = @_ } +sub GET_SIZE { my ($_cell, @_more_paras) = @_ } +sub RENDER { my ($_cell, @_more_paras) = @_ } +sub START_EDITING { my ($_cell, @_more_paras) = @_ } +sub _INSTALL_OVERRIDES { my ($_package) = @_ } +sub _install_overrides { my ($_package) = @_ } +sub activate { my ($_cell, $_event, $_widget, $_path, $_background_area, $_cell_area, $_flags) = @_ } +sub editing_canceled { my ($_cell) = @_ } +sub get_fixed_size { my ($_cell) = @_ } +sub get_size { my ($_cell, $_widget, $_cell_area) = @_ } +sub parent_activate { my ($_cell, @_more_paras) = @_ } +sub parent_get_size { my ($_cell, @_more_paras) = @_ } +sub parent_render { my ($_cell, @_more_paras) = @_ } +sub parent_start_editing { my ($_cell, @_more_paras) = @_ } +sub render { my ($_cell, $_drawable, $_widget, $_background_area, $_cell_area, $_expose_area, $_flags) = @_ } +sub set_fixed_size { my ($_cell, $_width, $_height) = @_ } +sub start_editing { my ($_cell, $_event, $_widget, $_path, $_background_area, $_cell_area, $_flags) = @_ } +sub stop_editing { my ($_cell, $_canceled) = @_ } + +package Gtk2::CellRendererCombo; +our @ISA = qw(); +sub new { my ($_class) = @_ } + +package Gtk2::CellRendererPixbuf; +our @ISA = qw(); +sub new { my ($_class) = @_ } + +package Gtk2::CellRendererProgress; +our @ISA = qw(); +sub new { my ($_class) = @_ } + +package Gtk2::CellRendererText; +our @ISA = qw(); +sub new { my ($_class) = @_ } +sub set_fixed_height_from_font { my ($_renderer, $_number_of_rows) = @_ } + +package Gtk2::CellRendererToggle; +our @ISA = qw(); +sub get_active { my ($_toggle) = @_ } +sub get_radio { my ($_toggle) = @_ } +sub new { my ($_class) = @_ } +sub set_active { my ($_toggle, $_setting) = @_ } +sub set_radio { my ($_toggle, $_radio) = @_ } + +package Gtk2::CellView; +our @ISA = qw(); +sub get_cell_renderers { my ($_cellview) = @_ } +sub get_displayed_row { my ($_cell_view) = @_ } +sub get_size_of_row { my ($_cell_view, $_path) = @_ } +sub new { my ($_class) = @_ } +sub new_with_markup { my ($_class, $_markup) = @_ } +sub new_with_pixbuf { my ($_class, $_pixbuf) = @_ } +sub new_with_text { my ($_class, $_text) = @_ } +sub set_background_color { my ($_cell_view, $_color) = @_ } +sub set_displayed_row { my ($_cell_view, $_path) = @_ } +sub set_model { my ($_cell_view, $_model) = @_ } + +package Gtk2::CheckButton; +our @ISA = qw(); +sub new { my ($_class, $_o_label) = @_ } +sub new_with_label { my ($_class, $_o_label) = @_ } +sub new_with_mnemonic { my ($_class, $_o_label) = @_ } + +package Gtk2::CheckMenuItem; +our @ISA = qw(); +sub get_active { my ($_check_menu_item) = @_ } +sub get_draw_as_radio { my ($_check_menu_item) = @_ } +sub get_inconsistent { my ($_check_menu_item) = @_ } +sub new { my ($_class, $_o_label) = @_ } +sub new_with_label { my ($_class, $_o_label) = @_ } +sub new_with_mnemonic { my ($_class, $_o_label) = @_ } +sub set_active { my ($_check_menu_item, $_is_active) = @_ } +sub set_draw_as_radio { my ($_check_menu_item, $_draw_as_radio) = @_ } +sub set_inconsistent { my ($_check_menu_item, $_setting) = @_ } +sub set_show_toggle { my ($_menu_item, $_always) = @_ } +sub toggled { my ($_check_menu_item) = @_ } + +package Gtk2::Clipboard; +our @ISA = qw(); +sub clear { my ($_clipboard) = @_ } +sub get { my ($_class, $_selection) = @_ } +sub get_display { my ($_clipboard) = @_ } +sub get_for_display { my ($_class, $_display, $_selection) = @_ } +sub get_owner { my ($_clipboard) = @_ } +sub request_contents { my ($_clipboard, $_target, $_callback, $_o_user_data) = @_ } +sub request_image { my ($_clipboard, $_callback, $_o_user_data) = @_ } +sub request_targets { my ($_clipboard, $_callback, $_o_user_data) = @_ } +sub request_text { my ($_clipboard, $_callback, $_o_user_data) = @_ } +sub set_can_store { my ($_clipboard, @_more_paras) = @_ } +sub set_image { my ($_clipboard, $_pixbuf) = @_ } +sub set_text { my ($_clipboard, $_text, $_text) = @_ } +sub set_with_data { my ($_clipboard, $_get_func, $_clear_func, $_user_data, @_more_paras) = @_ } +sub set_with_owner { my ($_clipboard, $_get_func, $_clear_func, $_owner, @_more_paras) = @_ } +sub store { my ($_clipboard) = @_ } +sub wait_for_contents { my ($_clipboard, $_target) = @_ } +sub wait_for_image { my ($_clipboard) = @_ } +sub wait_for_targets { my ($_clipboard) = @_ } +sub wait_for_text { my ($_clipboard) = @_ } +sub wait_is_image_available { my ($_clipboard) = @_ } +sub wait_is_target_available { my ($_clipboard, $_target) = @_ } +sub wait_is_text_available { my ($_clipboard) = @_ } + +package Gtk2::ColorButton; +our @ISA = qw(); +sub get_alpha { my ($_color_button) = @_ } +sub get_color { my ($_color_button) = @_ } +sub get_title { my ($_color_button) = @_ } +sub get_use_alpha { my ($_color_button) = @_ } +sub new { my ($_class, $_o_color) = @_ } +sub new_with_color { my ($_class, $_o_color) = @_ } +sub set_alpha { my ($_color_button, $_alpha) = @_ } +sub set_color { my ($_color_button, $_color) = @_ } +sub set_title { my ($_color_button, $_title) = @_ } +sub set_use_alpha { my ($_color_button, $_use_alpha) = @_ } + +package Gtk2::ColorSelection; +our @ISA = qw(); +sub get_current_alpha { my ($_colorsel) = @_ } +sub get_current_color { my ($_colorsel) = @_ } +sub get_has_opacity_control { my ($_colorsel) = @_ } +sub get_has_palette { my ($_colorsel) = @_ } +sub get_previous_alpha { my ($_colorsel) = @_ } +sub get_previous_color { my ($_colorsel) = @_ } +sub is_adjusting { my ($_colorsel) = @_ } +sub new { my ($_class) = @_ } +sub palette_from_string { my ($_class, $_string) = @_ } +sub palette_to_string { my ($_class, @_more_paras) = @_ } +sub set_current_alpha { my ($_colorsel, $_alpha) = @_ } +sub set_current_color { my ($_colorsel, $_color) = @_ } +sub set_has_opacity_control { my ($_colorsel, $_has_opacity) = @_ } +sub set_has_palette { my ($_colorsel, $_has_palette) = @_ } +sub set_previous_alpha { my ($_colorsel, $_alpha) = @_ } +sub set_previous_color { my ($_colorsel, $_color) = @_ } + +package Gtk2::ColorSelectionDialog; +our @ISA = qw(); +sub cancel_button { my ($_dialog) = @_ } +sub colorsel { my ($_dialog) = @_ } +sub help_button { my ($_dialog) = @_ } +sub new { my ($_class, $_title) = @_ } +sub ok_button { my ($_dialog) = @_ } + +package Gtk2::Combo; +our @ISA = qw(); +sub disable_activate { my ($_combo) = @_ } +sub entry { my ($_combo) = @_ } +sub list { my ($_combo) = @_ } +sub new { my ($_class) = @_ } +sub set_case_sensitive { my ($_combo, $_val) = @_ } +sub set_item_string { my ($_combo, $_item, $_item_value) = @_ } +sub set_popdown_strings { my ($_combo, @_more_paras) = @_ } +sub set_use_arrows { my ($_combo, $_val) = @_ } +sub set_use_arrows_always { my ($_combo, $_val) = @_ } +sub set_value_in_list { my ($_combo, $_val, $_ok_if_empty) = @_ } + +package Gtk2::ComboBox; +our @ISA = qw(); +sub append_text { my ($_combo_box, $_text) = @_ } +sub get_active { my ($_combo_box) = @_ } +sub get_active_iter { my ($_combo_box) = @_ } +sub get_active_text { my ($_combo_box) = @_ } +sub get_add_tearoffs { my ($_combo_box) = @_ } +sub get_column_span_column { my ($_combo_box) = @_ } +sub get_focus_on_click { my ($_combo_box) = @_ } +sub get_model { my ($_combo_box) = @_ } +sub get_row_span_column { my ($_combo_box) = @_ } +sub get_wrap_width { my ($_combo_box) = @_ } +sub insert_text { my ($_combo_box, $_position, $_text) = @_ } +sub new { my ($_class, $_o_model) = @_ } +sub new_text { my ($_class) = @_ } +sub new_with_model { my ($_class, $_o_model) = @_ } +sub popdown { my ($_combo_box) = @_ } +sub popup { my ($_combo_box) = @_ } +sub prepend_text { my ($_combo_box, $_text) = @_ } +sub remove_text { my ($_combo_box, $_position) = @_ } +sub set_active { my ($_combo_box, $_index) = @_ } +sub set_active_iter { my ($_combo_box, $_iter) = @_ } +sub set_add_tearoffs { my ($_combo_box, $_add_tearoffs) = @_ } +sub set_column_span_column { my ($_combo_box, $_column_span) = @_ } +sub set_focus_on_click { my ($_combo_box, $_focus_on_click) = @_ } +sub set_model { my ($_combo_box, $_model) = @_ } +sub set_row_separator_func { my ($_combo_box, $_func, $_o_data) = @_ } +sub set_row_span_column { my ($_combo_box, $_row_span) = @_ } +sub set_wrap_width { my ($_combo_box, $_width) = @_ } + +package Gtk2::ComboBoxEntry; +our @ISA = qw(); +sub get_text_column { my ($_entry_box) = @_ } +sub new { my ($_class, @_more_paras) = @_ } +sub new_text { my ($_class) = @_ } +sub new_with_model { my ($_class, @_more_paras) = @_ } +sub set_text_column { my ($_entry_box, $_text_column) = @_ } + +package Gtk2::Container; +our @ISA = qw(); +sub add { my ($_container, $_widget) = @_ } +sub add_with_properties { my ($_container, $_widget, @_more_paras) = @_ } +sub check_resize { my ($_container) = @_ } +sub child_get { my ($_container, $_child, @_more_paras) = @_ } +sub child_get_property { my ($_container, $_child, @_more_paras) = @_ } +sub child_set { my ($_container, $_child, @_more_paras) = @_ } +sub child_set_property { my ($_container, $_child, @_more_paras) = @_ } +sub child_type { my ($_container) = @_ } +sub Gtk2::Container::foreach { my ($_container, $_callback, $_o_callback_data) = @_ } +sub get_border_width { my ($_container) = @_ } +sub get_children { my ($_container) = @_ } +sub get_focus_chain { my ($_container) = @_ } +sub get_focus_hadjustment { my ($_container) = @_ } +sub get_focus_vadjustment { my ($_container) = @_ } +sub get_resize_mode { my ($_container) = @_ } +sub propagate_expose { my ($_container, $_child, $_event) = @_ } +sub remove { my ($_container, $_widget) = @_ } +sub resize_children { my ($_container) = @_ } +sub set_border_width { my ($_container, $_border_width) = @_ } +sub set_focus_chain { my ($_container, @_more_paras) = @_ } +sub set_focus_child { my ($_container, $_child) = @_ } +sub set_focus_hadjustment { my ($_container, $_adjustment) = @_ } +sub set_focus_vadjustment { my ($_container, $_adjustment) = @_ } +sub set_reallocate_redraws { my ($_container, $_needs_redraws) = @_ } +sub set_resize_mode { my ($_container, $_resize_mode) = @_ } +sub unset_focus_chain { my ($_container) = @_ } + +package Gtk2::Curve; +our @ISA = qw(); +sub get_vector { my ($_curve, $_o_veclen) = @_ } +sub new { my ($_class) = @_ } +sub reset { my ($_curve) = @_ } +sub set_curve_type { my ($_curve, $_type) = @_ } +sub set_gamma { my ($_curve, $_gamma) = @_ } +sub set_range { my ($_curve, $_min_x, $_max_x, $_min_y, $_max_y) = @_ } +sub set_vector { my ($_curve, @_more_paras) = @_ } + +package Gtk2::Dialog; +our @ISA = qw(); +sub action_area { my ($_dialog) = @_ } +sub add_action_widget { my ($_dialog, $_child, $_response_id) = @_ } +sub add_button { my ($_dialog, $_button_text, $_response_id) = @_ } +sub add_buttons { my ($_dialog, @_more_paras) = @_ } +sub get_has_separator { my ($_dialog) = @_ } +sub get_response_for_widget { my ($_dialog, $_widget) = @_ } +sub new { my ($_class, @_more_paras) = @_ } +sub new_with_buttons { my ($_class, @_more_paras) = @_ } +sub response { my ($_dialog, $_response_id) = @_ } +sub run { my ($_dialog) = @_ } +sub set_alternative_button_order { my ($_dialog, @_more_paras) = @_ } +sub set_default_response { my ($_dialog, $_response_id) = @_ } +sub set_has_separator { my ($_dialog, $_setting) = @_ } +sub set_response_sensitive { my ($_dialog, $_response_id, $_setting) = @_ } +sub vbox { my ($_dialog) = @_ } + +package Gtk2::Drag; +our @ISA = qw(); +sub begin { my ($_class, $_widget, $_targets, $_actions, $_button, $_event) = @_ } + +package Gtk2::DrawingArea; +our @ISA = qw(); +sub new { my ($_class) = @_ } +sub size { my ($_darea, $_width, $_height) = @_ } + +package Gtk2::Editable; +our @ISA = qw(); +sub copy_clipboard { my ($_editable) = @_ } +sub cut_clipboard { my ($_editable) = @_ } +sub delete_selection { my ($_editable) = @_ } +sub delete_text { my ($_editable, $_start_pos, $_end_pos) = @_ } +sub get_chars { my ($_editable, $_start_pos, $_end_pos) = @_ } +sub get_editable { my ($_editable) = @_ } +sub get_position { my ($_editable) = @_ } +sub get_selection_bounds { my ($_editable) = @_ } +sub insert_text { my ($_editable, $_new_text, @_more_paras) = @_ } +sub paste_clipboard { my ($_editable) = @_ } +sub select_region { my ($_editable, $_start, $_end) = @_ } +sub set_editable { my ($_editable, $_is_editable) = @_ } +sub set_position { my ($_editable, $_position) = @_ } + +package Gtk2::Entry; +our @ISA = qw(); +sub append_text { my ($_entry, $_text) = @_ } +sub get_activates_default { my ($_entry) = @_ } +sub get_alignment { my ($_entry) = @_ } +sub get_completion { my ($_entry) = @_ } +sub get_has_frame { my ($_entry) = @_ } +sub get_invisible_char { my ($_entry) = @_ } +sub get_layout { my ($_entry) = @_ } +sub get_layout_offsets { my ($_entry) = @_ } +sub get_max_length { my ($_entry) = @_ } +sub get_text { my ($_entry) = @_ } +sub get_visibility { my ($_entry) = @_ } +sub get_width_chars { my ($_entry) = @_ } +sub layout_index_to_text_index { my ($_entry, $_layout_index) = @_ } +sub new { my ($_class) = @_ } +sub new_with_max_length { my ($_class, $_max) = @_ } +sub prepend_text { my ($_entry, $_text) = @_ } +sub select_region { my ($_entry, $_start, $_end) = @_ } +sub set_activates_default { my ($_entry, $_setting) = @_ } +sub set_alignment { my ($_entry, $_xalign) = @_ } +sub set_completion { my ($_entry, $_completion) = @_ } +sub set_editable { my ($_entry, $_editable) = @_ } +sub set_has_frame { my ($_entry, $_setting) = @_ } +sub set_invisible_char { my ($_entry, $_ch) = @_ } +sub set_max_length { my ($_entry, $_max) = @_ } +sub set_position { my ($_entry, $_position) = @_ } +sub set_text { my ($_entry, $_text) = @_ } +sub set_visibility { my ($_entry, $_visible) = @_ } +sub set_width_chars { my ($_entry, $_n_chars) = @_ } +sub text_index_to_layout_index { my ($_entry, $_text_index) = @_ } + +package Gtk2::EntryCompletion; +our @ISA = qw(); +sub complete { my ($_completion) = @_ } +sub delete_action { my ($_completion, $_index) = @_ } +sub get_entry { my ($_entry) = @_ } +sub get_inline_completion { my ($_completion) = @_ } +sub get_minimum_key_length { my ($_completion) = @_ } +sub get_model { my ($_completion) = @_ } +sub get_popup_completion { my ($_completion) = @_ } +sub get_popup_set_width { my ($_completion) = @_ } +sub get_popup_single_match { my ($_completion) = @_ } +sub get_text_column { my ($_completion) = @_ } +sub insert_action_markup { my ($_completion, $_index, $_markup) = @_ } +sub insert_action_text { my ($_completion, $_index, $_text) = @_ } +sub insert_prefix { my ($_completion) = @_ } +sub new { my ($_class) = @_ } +sub set_inline_completion { my ($_completion, $_inline_completion) = @_ } +sub set_match_func { my ($_completion, $_func, $_o_func_data) = @_ } +sub set_minimum_key_length { my ($_completion, $_length) = @_ } +sub set_model { my ($_completion, $_model) = @_ } +sub set_popup_completion { my ($_completion, $_popup_completion) = @_ } +sub set_popup_set_width { my ($_completion, $_popup_set_width) = @_ } +sub set_popup_single_match { my ($_completion, $_popup_single_match) = @_ } +sub set_text_column { my ($_completion, $_column) = @_ } + +package Gtk2::EventBox; +our @ISA = qw(); +sub get_above_child { my ($_event_box) = @_ } +sub get_visible_window { my ($_event_box) = @_ } +sub new { my ($_class) = @_ } +sub set_above_child { my ($_event_box, $_above_child) = @_ } +sub set_visible_window { my ($_event_box, $_visible_window) = @_ } + +package Gtk2::Expander; +our @ISA = qw(); +sub get_expanded { my ($_expander) = @_ } +sub get_label { my ($_expander) = @_ } +sub get_label_widget { my ($_expander) = @_ } +sub get_spacing { my ($_expander) = @_ } +sub get_use_markup { my ($_expander) = @_ } +sub get_use_underline { my ($_expander) = @_ } +sub new { my ($_class, $_o_label) = @_ } +sub new_with_mnemonic { my ($_class, $_label) = @_ } +sub set_expanded { my ($_expander, $_expanded) = @_ } +sub set_label { my ($_expander, $_label) = @_ } +sub set_label_widget { my ($_expander, $_label_widget) = @_ } +sub set_spacing { my ($_expander, $_spacing) = @_ } +sub set_use_markup { my ($_expander, $_use_markup) = @_ } +sub set_use_underline { my ($_expander, $_use_underline) = @_ } + +package Gtk2::FileChooser; +our @ISA = qw(); +sub add_filter { my ($_chooser, $_filter) = @_ } +sub add_shortcut_folder { my ($_chooser, $_folder) = @_ } +sub add_shortcut_folder_uri { my ($_chooser, $_folder) = @_ } +sub get_action { my ($_chooser) = @_ } +sub get_current_folder { my ($_chooser) = @_ } +sub get_current_folder_uri { my ($_chooser) = @_ } +sub get_do_overwrite_confirmation { my ($_chooser) = @_ } +sub get_extra_widget { my ($_chooser) = @_ } +sub get_filename { my ($_chooser) = @_ } +sub get_filenames { my ($_chooser) = @_ } +sub get_filter { my ($_chooser) = @_ } +sub get_local_only { my ($_chooser) = @_ } +sub get_preview_filename { my ($_file_chooser) = @_ } +sub get_preview_uri { my ($_file_chooser) = @_ } +sub get_preview_widget { my ($_chooser) = @_ } +sub get_preview_widget_active { my ($_chooser) = @_ } +sub get_select_multiple { my ($_chooser) = @_ } +sub get_show_hidden { my ($_chooser) = @_ } +sub get_uri { my ($_chooser) = @_ } +sub get_uris { my ($_chooser) = @_ } +sub get_use_preview_label { my ($_chooser) = @_ } +sub list_filters { my ($_chooser) = @_ } +sub list_shortcut_folder_uris { my ($_chooser) = @_ } +sub list_shortcut_folders { my ($_chooser) = @_ } +sub remove_filter { my ($_chooser, $_filter) = @_ } +sub remove_shortcut_folder { my ($_chooser, $_folder) = @_ } +sub remove_shortcut_folder_uri { my ($_chooser, $_folder) = @_ } +sub select_all { my ($_chooser) = @_ } +sub select_filename { my ($_chooser, $_filename) = @_ } +sub select_uri { my ($_chooser, $_uri) = @_ } +sub set_action { my ($_chooser, $_action) = @_ } +sub set_current_folder { my ($_chooser, $_filename) = @_ } +sub set_current_folder_uri { my ($_chooser, $_uri) = @_ } +sub set_current_name { my ($_chooser, $_name) = @_ } +sub set_do_overwrite_confirmation { my ($_chooser, $_do_overwrite_confirmation) = @_ } +sub set_extra_widget { my ($_chooser, $_extra_widget) = @_ } +sub set_filename { my ($_chooser, $_filename) = @_ } +sub set_filter { my ($_chooser, $_filter) = @_ } +sub set_local_only { my ($_chooser, $_files_only) = @_ } +sub set_preview_widget { my ($_chooser, $_preview_widget) = @_ } +sub set_preview_widget_active { my ($_chooser, $_active) = @_ } +sub set_select_multiple { my ($_chooser, $_select_multiple) = @_ } +sub set_show_hidden { my ($_chooser, $_show_hidden) = @_ } +sub set_uri { my ($_chooser, $_uri) = @_ } +sub set_use_preview_label { my ($_chooser, $_use_label) = @_ } +sub unselect_all { my ($_chooser) = @_ } +sub unselect_filename { my ($_chooser, $_filename) = @_ } +sub unselect_uri { my ($_chooser, $_uri) = @_ } + +package Gtk2::FileChooserButton; +our @ISA = qw(); +sub get_title { my ($_button) = @_ } +sub get_width_chars { my ($_button) = @_ } +sub new { my ($_class, $_title, $_action) = @_ } +sub new_with_backend { my ($_class, $_title, $_action, $_backend) = @_ } +sub new_with_dialog { my ($_class, $_dialog) = @_ } +sub set_title { my ($_button, $_title) = @_ } +sub set_width_chars { my ($_button, $_n_chars) = @_ } + +package Gtk2::FileChooserDialog; +our @ISA = qw(); +sub new { my ($_class, $_title, $_parent, $_action, @_more_paras) = @_ } +sub new_with_backend { my ($_class, $_title, $_parent, $_action, @_more_paras) = @_ } + +package Gtk2::FileChooserWidget; +our @ISA = qw(); +sub new { my ($_class, $_action) = @_ } +sub new_with_backend { my ($_class, $_action, $_backend) = @_ } + +package Gtk2::FileFilter; +our @ISA = qw(); +sub add_custom { my ($_filter, $_needed, $_func, $_o_data) = @_ } +sub add_mime_type { my ($_filter, $_mime_type) = @_ } +sub add_pattern { my ($_filter, $_pattern) = @_ } +sub add_pixbuf_formats { my ($_filter) = @_ } +sub filter { my ($_filter, $_filter_info) = @_ } +sub get_name { my ($_filter) = @_ } +sub get_needed { my ($_filter) = @_ } +sub new { my ($_class) = @_ } +sub set_name { my ($_filter, $_name) = @_ } + +package Gtk2::FileSelection; +our @ISA = qw(); +sub action_area { my ($_fs) = @_ } +sub button_area { my ($_fs) = @_ } +sub cancel_button { my ($_fs) = @_ } +sub complete { my ($_filesel, $_pattern) = @_ } +sub dir_list { my ($_fs) = @_ } +sub file_list { my ($_fs) = @_ } +sub fileop_c_dir { my ($_fs) = @_ } +sub fileop_del_file { my ($_fs) = @_ } +sub fileop_dialog { my ($_fs) = @_ } +sub fileop_entry { my ($_fs) = @_ } +sub fileop_file { my ($_fs) = @_ } +sub fileop_ren_file { my ($_fs) = @_ } +sub get_filename { my ($_filesel) = @_ } +sub get_select_multiple { my ($_filesel) = @_ } +sub get_selections { my ($_filesel) = @_ } +sub help_button { my ($_fs) = @_ } +sub hide_fileop_buttons { my ($_filesel) = @_ } +sub history_menu { my ($_fs) = @_ } +sub history_pulldown { my ($_fs) = @_ } +sub main_vbox { my ($_fs) = @_ } +sub new { my ($_class, $_title) = @_ } +sub ok_button { my ($_fs) = @_ } +sub selection_entry { my ($_fs) = @_ } +sub selection_text { my ($_fs) = @_ } +sub set_filename { my ($_filesel, $_filename) = @_ } +sub set_select_multiple { my ($_filesel, $_select_multiple) = @_ } +sub show_fileop_buttons { my ($_filesel) = @_ } + +package Gtk2::Fixed; +our @ISA = qw(); +sub get_has_window { my ($_fixed) = @_ } +sub move { my ($_fixed, $_widget, $_x, $_y) = @_ } +sub new { my ($_class) = @_ } +sub put { my ($_fixed, $_widget, $_x, $_y) = @_ } +sub set_has_window { my ($_fixed, $_has_window) = @_ } + +package Gtk2::FontButton; +our @ISA = qw(); +sub get_font_name { my ($_font_button) = @_ } +sub get_show_size { my ($_font_button) = @_ } +sub get_show_style { my ($_font_button) = @_ } +sub get_title { my ($_font_button) = @_ } +sub get_use_font { my ($_font_button) = @_ } +sub get_use_size { my ($_font_button) = @_ } +sub new { my ($_class, $_o_fontname) = @_ } +sub new_with_font { my ($_class, $_o_fontname) = @_ } +sub set_font_name { my ($_font_button, $_fontname) = @_ } +sub set_show_size { my ($_font_button, $_show_size) = @_ } +sub set_show_style { my ($_font_button, $_show_style) = @_ } +sub set_title { my ($_font_button, $_title) = @_ } +sub set_use_font { my ($_font_button, $_use_font) = @_ } +sub set_use_size { my ($_font_button, $_use_size) = @_ } + +package Gtk2::FontSelection; +our @ISA = qw(); +sub get_font { my ($_fontsel) = @_ } +sub get_font_name { my ($_fontsel) = @_ } +sub get_preview_text { my ($_fontsel) = @_ } +sub new { my ($_class) = @_ } +sub set_font_name { my ($_fontsel, $_fontname) = @_ } +sub set_preview_text { my ($_fontsel, $_text) = @_ } + +package Gtk2::FontSelectionDialog; +our @ISA = qw(); +sub apply_button { my ($_fsd) = @_ } +sub cancel_button { my ($_fsd) = @_ } +sub get_font { my ($_fsd) = @_ } +sub get_font_name { my ($_fsd) = @_ } +sub get_preview_text { my ($_fsd) = @_ } +sub new { my ($_class, $_title) = @_ } +sub ok_button { my ($_fsd) = @_ } +sub set_font_name { my ($_fsd, $_fontname) = @_ } +sub set_preview_text { my ($_fsd, $_text) = @_ } + +package Gtk2::Frame; +our @ISA = qw(); +sub get_label { my ($_frame) = @_ } +sub get_label_align { my ($_frame) = @_ } +sub get_label_widget { my ($_frame) = @_ } +sub get_shadow_type { my ($_frame) = @_ } +sub new { my ($_class, $_o_label) = @_ } +sub set_label { my ($_frame, $_o_label) = @_ } +sub set_label_align { my ($_frame, $_xalign, $_yalign) = @_ } +sub set_label_widget { my ($_frame, $_label_widget) = @_ } +sub set_shadow_type { my ($_frame, $_type) = @_ } + +package Gtk2::GC; +our @ISA = qw(); +sub get { my ($_class, $_depth, $_colormap, $_values) = @_ } +sub release { my ($_class, $_gc) = @_ } + +package Gtk2::GammaCurve; +our @ISA = qw(); +sub curve { my ($_gamma) = @_ } +sub new { my ($_class) = @_ } + +package Gtk2::Gdk; +our @ISA = qw(); +sub SELECTION_CLIPBOARD { my ($_class) = @_ } +sub SELECTION_PRIMARY { my ($_class) = @_ } +sub SELECTION_SECONDARY { my ($_class) = @_ } +sub SELECTION_TYPE_ATOM { my ($_class) = @_ } +sub SELECTION_TYPE_BITMAP { my ($_class) = @_ } +sub SELECTION_TYPE_COLORMAP { my ($_class) = @_ } +sub SELECTION_TYPE_DRAWABLE { my ($_class) = @_ } +sub SELECTION_TYPE_INTEGER { my ($_class) = @_ } +sub SELECTION_TYPE_PIXMAP { my ($_class) = @_ } +sub SELECTION_TYPE_STRING { my ($_class) = @_ } +sub SELECTION_TYPE_WINDOW { my ($_class) = @_ } +sub TARGET_BITMAP { my ($_class) = @_ } +sub TARGET_COLORMAP { my ($_class) = @_ } +sub TARGET_DRAWABLE { my ($_class) = @_ } +sub TARGET_PIXMAP { my ($_class) = @_ } +sub TARGET_STRING { my ($_class) = @_ } +sub beep { my ($_class) = @_ } +sub devices_list { my ($_class) = @_ } +sub error_trap_pop { my ($_class) = @_ } +sub error_trap_push { my ($_class) = @_ } +sub events_pending { my ($_class) = @_ } +sub flush { my ($_class) = @_ } +sub get_default_root_window { my ($_class) = @_ } +sub get_display { my ($_class) = @_ } +sub get_display_arg_name { my ($_class) = @_ } +sub get_program_class { my ($_class) = @_ } +sub get_show_events { my ($_class) = @_ } +sub init { my ($_o_class) = @_ } +sub init_check { my ($_o_class) = @_ } +sub keyboard_grab { my ($_class, $_window, $_owner_events, $_time_) = @_ } +sub keyboard_ungrab { my ($_class, $_time_) = @_ } +sub keyval_convert_case { my ($_class, $_symbol) = @_ } +sub keyval_from_name { my ($_class, $_keyval_name) = @_ } +sub keyval_is_lower { my ($_class, $_keyval) = @_ } +sub keyval_is_upper { my ($_class, $_keyval) = @_ } +sub keyval_name { my ($_class, $_keyval) = @_ } +sub keyval_to_lower { my ($_class, $_keyval) = @_ } +sub keyval_to_unicode { my ($_class, $_keyval) = @_ } +sub keyval_to_upper { my ($_class, $_keyval) = @_ } +sub list_visuals { my ($_class) = @_ } +sub notify_startup_complete { my ($_class) = @_ } +sub parse_args { my ($_o_class) = @_ } +sub pointer_grab { my ($_class, $_window, $_owner_events, $_event_mask, $_confine_to, $_cursor, $_time_) = @_ } +sub pointer_is_grabbed { my ($_class) = @_ } +sub pointer_ungrab { my ($_class, $_time_) = @_ } +sub query_depths { my ($_class) = @_ } +sub query_visual_types { my ($_class) = @_ } +sub screen_height { my ($_class) = @_ } +sub screen_height_mm { my ($_class) = @_ } +sub screen_width { my ($_class) = @_ } +sub screen_width_mm { my ($_class) = @_ } +sub set_locale { my ($_class) = @_ } +sub set_program_class { my ($_class, $_program_class) = @_ } +sub set_show_events { my ($_class, $_show_events) = @_ } +sub set_sm_client_id { my ($_class, $_o_sm_client_id) = @_ } +sub setting_get { my ($_class, $_name) = @_ } +sub string_to_compound_text { my ($_class, $_str) = @_ } +sub string_to_compound_text_for_display { my ($_class, $_display, $_str) = @_ } +sub text_property_to_text_list { my ($_class, $_encoding, $_format, $_text) = @_ } +sub text_property_to_text_list_for_display { my ($_class, $_display, $_encoding, $_format, $_text) = @_ } +sub text_property_to_utf8_list { my ($_class, $_encoding, $_format, $_text) = @_ } +sub text_property_to_utf8_list_for_display { my ($_class, $_display, $_encoding, $_format, $_text) = @_ } +sub unicode_to_keyval { my ($_class, $_wc) = @_ } +sub utf8_to_compound_text { my ($_class, $_str) = @_ } +sub utf8_to_compound_text_for_display { my ($_class, $_display, $_str) = @_ } +sub utf8_to_string_target { my ($_class, $_str) = @_ } + +package Gtk2::Gdk::Atom; +our @ISA = qw(); +sub Gtk2::Gdk::Atom::eq { my ($_left, $_right, $_o_swap) = @_ } +sub intern { my ($_class, $_atom_name, $_o_only_if_exists) = @_ } +sub name { my ($_atom) = @_ } +sub new { my ($_class, $_atom_name, $_o_only_if_exists) = @_ } + +package Gtk2::Gdk::Bitmap; +our @ISA = qw(); +sub create_from_data { my ($_class, $_drawable, $_data, $_width, $_height) = @_ } + +package Gtk2::Gdk::Cairo::Context; +our @ISA = qw(); +sub create { my ($_class, $_drawable) = @_ } +sub rectangle { my ($_cr, @_more_paras) = @_ } +sub region { my ($_cr, $_region) = @_ } +sub set_source_color { my ($_cr, $_color) = @_ } +sub set_source_pixbuf { my ($_cr, $_pixbuf, $_pixbuf_x, $_pixbuf_y) = @_ } + +package Gtk2::Gdk::Color; +our @ISA = qw(); +sub blue { my ($_color) = @_ } +sub equal { my ($_colora, $_colorb) = @_ } +sub green { my ($_color) = @_ } +sub hash { my ($_colora) = @_ } +sub new { my ($_class, $_red, $_green, $_blue) = @_ } +sub parse { my ($_class, $_spec) = @_ } +sub pixel { my ($_color) = @_ } +sub red { my ($_color) = @_ } + +package Gtk2::Gdk::Colormap; +our @ISA = qw(); +sub alloc_color { my ($_colormap, $_color, $_writeable, $_best_match) = @_ } +sub alloc_colors { my ($_colormap, $_writeable, $_best_match, @_more_paras) = @_ } +sub free_colors { my ($_colormap, @_more_paras) = @_ } +sub get_screen { my ($_cmap) = @_ } +sub get_system { my ($_class) = @_ } +sub get_visual { my ($_colormap) = @_ } +sub new { my ($_class, $_visual, $_allocate) = @_ } +sub query_color { my ($_colormap, $_pixel) = @_ } +sub rgb_find_color { my ($_colormap, $_color) = @_ } + +package Gtk2::Gdk::Cursor; +our @ISA = qw(); +sub get_display { my ($_cursor) = @_ } +sub get_image { my ($_cursor) = @_ } +sub new { my ($_class, $_cursor_type) = @_ } +sub new_for_display { my ($_class, $_display, $_cursor_type) = @_ } +sub new_from_name { my ($_class, $_display, $_name) = @_ } +sub new_from_pixbuf { my ($_class, $_display, $_pixbuf, $_x, $_y) = @_ } +sub new_from_pixmap { my ($_class, $_source, $_mask, $_fg, $_bg, $_x, $_y) = @_ } +sub type { my ($_cursor) = @_ } + +package Gtk2::Gdk::Device; +our @ISA = qw(); +sub axes { my ($_device) = @_ } +sub get_axis { my ($_device, $_use, @_more_paras) = @_ } +sub get_core_pointer { my ($_class) = @_ } +sub get_history { my ($_device, $_window, $_start, $_stop) = @_ } +sub get_state { my ($_device, $_window) = @_ } +sub has_cursor { my ($_device) = @_ } +sub keys { my ($_device) = @_ } +sub mode { my ($_device) = @_ } +sub name { my ($_device) = @_ } +sub set_axis_use { my ($_device, $_index_, $_use) = @_ } +sub set_key { my ($_device, $_index_, $_keyval, $_modifiers) = @_ } +sub set_mode { my ($_device, $_mode) = @_ } +sub set_source { my ($_device, $_source) = @_ } +sub source { my ($_device) = @_ } + +package Gtk2::Gdk::Display; +our @ISA = qw(); +sub beep { my ($_display) = @_ } +sub close { my ($_display) = @_ } +sub flush { my ($_display) = @_ } +sub get_core_pointer { my ($_display) = @_ } +sub get_default { my ($_class) = @_ } +sub get_default_cursor_size { my ($_display) = @_ } +sub get_default_group { my ($_display) = @_ } +sub get_default_screen { my ($_display) = @_ } +sub get_event { my ($_display) = @_ } +sub get_maximal_cursor_size { my ($_display) = @_ } +sub get_n_screens { my ($_display) = @_ } +sub get_name { my ($_display) = @_ } +sub get_pointer { my ($_display) = @_ } +sub get_screen { my ($_display, $_screen_num) = @_ } +sub get_user_time { my ($_display) = @_ } +sub get_window_at_pointer { my ($_display) = @_ } +sub grab { my ($_display) = @_ } +sub keyboard_ungrab { my ($_display, $_time_) = @_ } +sub list_devices { my ($_display) = @_ } +sub open { my ($_class, $_display_name) = @_ } +sub peek_event { my ($_display) = @_ } +sub pointer_is_grabbed { my ($_display) = @_ } +sub pointer_ungrab { my ($_display, $_time_) = @_ } +sub put_event { my ($_display, $_event) = @_ } +sub register_standard_event_type { my ($_display, $_event_base, $_n_events) = @_ } +sub request_selection_notification { my ($_display, $_selection) = @_ } +sub set_cursor_theme { my ($_display, $_theme, $_size) = @_ } +sub set_double_click_distance { my ($_display, $_distance) = @_ } +sub set_double_click_time { my ($_display, $_msec) = @_ } +sub store_clipboard { my ($_display, $_clipboard_window, $_time_, @_more_paras) = @_ } +sub supports_clipboard_persistence { my ($_display) = @_ } +sub supports_cursor_alpha { my ($_display) = @_ } +sub supports_cursor_color { my ($_display) = @_ } +sub supports_selection_notification { my ($_display) = @_ } +sub sync { my ($_display) = @_ } +sub ungrab { my ($_display) = @_ } +sub warp_pointer { my ($_display, $_screen, $_x, $_y) = @_ } + +package Gtk2::Gdk::DisplayManager; +our @ISA = qw(); +sub get { my ($_class) = @_ } +sub get_default_display { my ($_display_manager) = @_ } +sub list_displays { my ($_display_manager) = @_ } +sub set_default_display { my ($_display_manager, $_display) = @_ } + +package Gtk2::Gdk::DragContext; +our @ISA = qw(); +sub abort { my ($_context, $_time_) = @_ } +sub action { my ($_dc) = @_ } +sub actions { my ($_dc) = @_ } +sub begin { my ($_class, $_window, @_more_paras) = @_ } +sub dest_window { my ($_dc) = @_ } +sub drag_drop_succeeded { my ($_context) = @_ } +sub drop { my ($_context, $_time_) = @_ } +sub drop_finish { my ($_context, $_success, $_o_time_) = @_ } +sub drop_reply { my ($_context, $_ok, $_o_time_) = @_ } +sub find_window { my ($_context, $_drag_window, $_x_root, $_y_root) = @_ } +sub find_window_for_screen { my ($_context, $_drag_window, $_screen, $_x_root, $_y_root) = @_ } +sub finish { my ($_context, $_success, $_del, $_time_) = @_ } +sub get_protocol { my ($_class, $_xid) = @_ } +sub get_protocol_for_display { my ($_class, $_display, $_xid) = @_ } +sub get_selection { my ($_context) = @_ } +sub get_source_widget { my ($_context) = @_ } +sub is_source { my ($_dc) = @_ } +sub motion { my ($_context, $_dest_window, $_protocol, $_x_root, $_y_root, $_suggested_action, $_possible_actions, $_time_) = @_ } +sub new { my ($_class) = @_ } +sub protocol { my ($_dc) = @_ } +sub set_icon_default { my ($_context) = @_ } +sub set_icon_name { my ($_context, $_icon_name, $_hot_x, $_hot_y) = @_ } +sub set_icon_pixbuf { my ($_context, $_pixbuf, $_hot_x, $_hot_y) = @_ } +sub set_icon_pixmap { my ($_context, $_colormap, $_pixmap, $_mask, $_hot_x, $_hot_y) = @_ } +sub set_icon_stock { my ($_context, $_stock_id, $_hot_x, $_hot_y) = @_ } +sub set_icon_widget { my ($_context, $_widget, $_hot_x, $_hot_y) = @_ } +sub source_window { my ($_dc) = @_ } +sub start_time { my ($_dc) = @_ } +sub status { my ($_context, $_action, $_o_time_) = @_ } +sub suggested_action { my ($_dc) = @_ } +sub targets { my ($_dc) = @_ } + +package Gtk2::Gdk::Drawable; +our @ISA = qw(); +sub XID { my ($_drawable) = @_ } +sub XWINDOW { my ($_drawable) = @_ } +sub copy_to_image { my ($_drawable, $_image, $_src_x, $_src_y, $_dest_x, $_dest_y, $_width, $_height) = @_ } +sub draw_arc { my ($_drawable, $_gc, $_filled, $_x, $_y, $_width, $_height, $_angle1, $_angle2) = @_ } +sub draw_drawable { my ($_drawable, $_gc, $_src, $_xsrc, $_ysrc, $_xdest, $_ydest, $_width, $_height) = @_ } +sub draw_gray_image { my ($_drawable, $_gc, $_x, $_y, $_width, $_height, $_dith, $_buf, $_rowstride) = @_ } +sub draw_image { my ($_drawable, $_gc, $_image, $_xsrc, $_ysrc, $_xdest, $_ydest, $_width, $_height) = @_ } +sub draw_indexed_image { my ($_drawable, $_gc, $_x, $_y, $_width, $_height, $_dith, $_buf, $_rowstride, $_cmap) = @_ } +sub draw_layout { my ($_drawable, $_gc, $_x, $_y, $_layout) = @_ } +sub draw_layout_with_colors { my ($_drawable, $_gc, $_x, $_y, $_layout, $_foreground, $_background) = @_ } +sub draw_line { my ($_drawable, $_gc, $_x1_, $_y1_, $_x2_, $_y2_) = @_ } +sub draw_lines { my ($_drawable, $_gc, $_x1, $_y1, @_more_paras) = @_ } +sub draw_pixbuf { my ($_drawable, $_gc, $_pixbuf, $_src_x, $_src_y, $_dest_x, $_dest_y, $_width, $_height, $_dither, $_x_dither, $_y_dither) = @_ } +sub draw_point { my ($_drawable, $_gc, $_x, $_y) = @_ } +sub draw_points { my ($_drawable, $_gc, $_x1, $_y1, @_more_paras) = @_ } +sub draw_polygon { my ($_drawable, $_gc, $_filled, $_x1, $_y1, @_more_paras) = @_ } +sub draw_rectangle { my ($_drawable, $_gc, $_filled, $_x, $_y, $_width, $_height) = @_ } +sub draw_rgb_32_image { my ($_drawable, $_gc, $_x, $_y, $_width, $_height, $_dith, $_buf, $_rowstride) = @_ } +sub draw_rgb_32_image_dithalign { my ($_drawable, $_gc, $_x, $_y, $_width, $_height, $_dith, $_rgb_buf, $_rowstride, $_xdith, $_ydith) = @_ } +sub draw_rgb_image { my ($_drawable, $_gc, $_x, $_y, $_width, $_height, $_dith, $_buf, $_rowstride) = @_ } +sub draw_rgb_image_dithalign { my ($_drawable, $_gc, $_x, $_y, $_width, $_height, $_dith, $_rgb_buf, $_rowstride, $_xdith, $_ydith) = @_ } +sub draw_segments { my ($_drawable, $_gc, $_x1, $_y1, $_x2, $_y2, @_more_paras) = @_ } +sub get_clip_region { my ($_drawable) = @_ } +sub get_colormap { my ($_drawable) = @_ } +sub get_depth { my ($_drawable) = @_ } +sub get_display { my ($_drawable) = @_ } +sub get_image { my ($_drawable, $_x, $_y, $_width, $_height) = @_ } +sub get_screen { my ($_drawable) = @_ } +sub get_size { my ($_drawable) = @_ } +sub get_visible_region { my ($_drawable) = @_ } +sub get_visual { my ($_drawable) = @_ } +sub get_xid { my ($_drawable) = @_ } +sub set_colormap { my ($_drawable, $_colormap) = @_ } + +package Gtk2::Gdk::Event; +our @ISA = qw(); +sub DESTROY { my ($_sv) = @_ } +sub axis { my ($_event, $_axis_use) = @_ } +sub coords { my ($_event) = @_ } +sub copy { my ($_event) = @_ } +sub get { my ($_class) = @_ } +sub get_axis { my ($_event, $_axis_use) = @_ } +sub get_coords { my ($_event) = @_ } +sub get_graphics_expose { my ($_class, $_window) = @_ } +sub get_root_coords { my ($_event) = @_ } +sub get_screen { my ($_event) = @_ } +sub get_state { my ($_event, @_more_paras) = @_ } +sub get_time { my ($_event, @_more_paras) = @_ } +sub handler_set { my ($_class, $_func, $_o_data) = @_ } +sub new { my ($_class, $_type) = @_ } +sub peek { my ($_class) = @_ } +sub put { my ($_class, $_event) = @_ } +sub root_coords { my ($_event) = @_ } +sub send_client_message { my ($_class, $_event, $_winid) = @_ } +sub send_client_message_for_display { my ($_class, $_display, $_event, $_winid) = @_ } +sub send_clientmessage_toall { my ($_class, $_event) = @_ } +sub send_event { my ($_event, $_o_newvalue) = @_ } +sub set_screen { my ($_event, $_screen) = @_ } +sub set_state { my ($_event, @_more_paras) = @_ } +sub set_time { my ($_event, @_more_paras) = @_ } +sub state { my ($_event, @_more_paras) = @_ } +sub time { my ($_event, @_more_paras) = @_ } +sub type { my ($_event) = @_ } +sub window { my ($_event, $_o_newvalue) = @_ } +sub x_root { my ($_event) = @_ } +sub y_root { my ($_event) = @_ } + +package Gtk2::Gdk::Event::Button; +our @ISA = qw(); +sub DESTROY { my ($_sv) = @_ } +sub button { my ($_eventbutton, $_o_newvalue) = @_ } +sub device { my ($_eventbutton, $_o_newvalue) = @_ } +sub Gtk2::Gdk::Event::Button::x { my ($_event, $_o_newvalue) = @_ } +sub Gtk2::Gdk::Event::Button::y { my ($_event, $_o_newvalue) = @_ } + +package Gtk2::Gdk::Event::Client; +our @ISA = qw(); +sub DESTROY { my ($_sv) = @_ } +sub data { my ($_eventclient, @_more_paras) = @_ } +sub data_format { my ($_eventclient, $_o_newvalue) = @_ } +sub message_type { my ($_eventclient, $_o_newvalue) = @_ } + +package Gtk2::Gdk::Event::Configure; +our @ISA = qw(); +sub DESTROY { my ($_sv) = @_ } +sub height { my ($_eventconfigure, $_o_newvalue) = @_ } +sub width { my ($_eventconfigure, $_o_newvalue) = @_ } +sub Gtk2::Gdk::Event::Configure::x { my ($_event, $_o_newvalue) = @_ } +sub Gtk2::Gdk::Event::Configure::y { my ($_event, $_o_newvalue) = @_ } + +package Gtk2::Gdk::Event::Crossing; +our @ISA = qw(); +sub DESTROY { my ($_sv) = @_ } +sub detail { my ($_eventcrossing, $_o_newvalue) = @_ } +sub focus { my ($_eventcrossing, $_o_newvalue) = @_ } +sub mode { my ($_eventcrossing, $_o_newvalue) = @_ } +sub subwindow { my ($_event, $_o_newvalue) = @_ } +sub Gtk2::Gdk::Event::Crossing::x { my ($_event, $_o_newvalue) = @_ } +sub Gtk2::Gdk::Event::Crossing::y { my ($_event, $_o_newvalue) = @_ } + +package Gtk2::Gdk::Event::DND; +our @ISA = qw(); +sub DESTROY { my ($_sv) = @_ } +sub context { my ($_eventdnd, $_o_newvalue) = @_ } + +package Gtk2::Gdk::Event::Expose; +our @ISA = qw(); +sub DESTROY { my ($_sv) = @_ } +sub area { my ($_eventexpose, $_o_newvalue) = @_ } +sub count { my ($_eventexpose, $_o_newvalue) = @_ } +sub region { my ($_eventexpose, $_o_newvalue) = @_ } + +package Gtk2::Gdk::Event::Focus; +our @ISA = qw(); +sub DESTROY { my ($_sv) = @_ } +sub in { my ($_eventfocus, $_o_newvalue) = @_ } + +package Gtk2::Gdk::Event::GrabBroken; +our @ISA = qw(); +sub DESTROY { my ($_sv) = @_ } +sub keyboard { my ($_event, $_o_newvalue) = @_ } + +package Gtk2::Gdk::Event::Key; +our @ISA = qw(); +sub DESTROY { my ($_sv) = @_ } +sub group { my ($_eventkey, $_o_newvalue) = @_ } +sub hardware_keycode { my ($_eventkey, $_o_newvalue) = @_ } +sub keyval { my ($_eventkey, $_o_newvalue) = @_ } + +package Gtk2::Gdk::Event::Motion; +our @ISA = qw(); +sub DESTROY { my ($_sv) = @_ } +sub device { my ($_eventmotion, $_o_newvalue) = @_ } +sub is_hint { my ($_eventmotion, $_o_newvalue) = @_ } +sub Gtk2::Gdk::Event::Motion::x { my ($_event, $_o_newvalue) = @_ } +sub Gtk2::Gdk::Event::Motion::y { my ($_event, $_o_newvalue) = @_ } + +package Gtk2::Gdk::Event::NoExpose; +our @ISA = qw(); +sub DESTROY { my ($_sv) = @_ } + +package Gtk2::Gdk::Event::OwnerChange; +our @ISA = qw(); +sub DESTROY { my ($_sv) = @_ } +sub owner { my ($_event, $_o_newvalue) = @_ } +sub reason { my ($_event, $_o_newvalue) = @_ } +sub selection { my ($_event, $_o_newvalue) = @_ } +sub selection_time { my ($_event, $_o_newvalue) = @_ } + +package Gtk2::Gdk::Event::Property; +our @ISA = qw(); +sub DESTROY { my ($_sv) = @_ } +sub atom { my ($_eventproperty, $_o_newvalue) = @_ } +sub state { my ($_eventproperty, $_o_newvalue) = @_ } + +package Gtk2::Gdk::Event::Proximity; +our @ISA = qw(); +sub DESTROY { my ($_sv) = @_ } +sub device { my ($_eventproximity, $_o_newvalue) = @_ } + +package Gtk2::Gdk::Event::Scroll; +our @ISA = qw(); +sub DESTROY { my ($_sv) = @_ } +sub device { my ($_eventscroll, $_o_newvalue) = @_ } +sub direction { my ($_eventscroll, $_o_newvalue) = @_ } +sub Gtk2::Gdk::Event::Scroll::x { my ($_event, $_o_newvalue) = @_ } +sub Gtk2::Gdk::Event::Scroll::y { my ($_event, $_o_newvalue) = @_ } + +package Gtk2::Gdk::Event::Selection; +our @ISA = qw(); +sub DESTROY { my ($_sv) = @_ } +sub property { my ($_eventselection, $_o_newvalue) = @_ } +sub requestor { my ($_eventselection, $_o_newvalue) = @_ } +sub selection { my ($_eventselection, $_o_newvalue) = @_ } +sub target { my ($_eventselection, $_o_newvalue) = @_ } + +package Gtk2::Gdk::Event::Setting; +our @ISA = qw(); +sub DESTROY { my ($_sv) = @_ } +sub action { my ($_eventsetting, $_o_newvalue) = @_ } +sub name { my ($_eventsetting, $_o_newvalue) = @_ } + +package Gtk2::Gdk::Event::Visibility; +our @ISA = qw(); +sub DESTROY { my ($_sv) = @_ } +sub state { my ($_eventvisibility, $_o_newvalue) = @_ } + +package Gtk2::Gdk::Event::WindowState; +our @ISA = qw(); +sub DESTROY { my ($_sv) = @_ } +sub changed_mask { my ($_eventwindowstate, $_o_newvalue) = @_ } +sub new_window_state { my ($_eventwindowstate, $_o_newvalue) = @_ } + +package Gtk2::Gdk::GC; +our @ISA = qw(); +sub copy { my ($_dst_gc, $_src_gc) = @_ } +sub get_colormap { my ($_gc) = @_ } +sub get_screen { my ($_gc) = @_ } +sub get_values { my ($_gc) = @_ } +sub new { my ($_class, $_drawable, $_o_values) = @_ } +sub new_with_values { my ($_class, $_drawable, $_o_values) = @_ } +sub offset { my ($_gc, $_x_offset, $_y_offset) = @_ } +sub rgb_gc_set_background { my ($_gc, $_rgb) = @_ } +sub rgb_gc_set_foreground { my ($_gc, $_rgb) = @_ } +sub set_background { my ($_gc, $_color) = @_ } +sub set_clip_mask { my ($_gc, $_mask) = @_ } +sub set_clip_origin { my ($_gc, $_x, $_y) = @_ } +sub set_clip_rectangle { my ($_gc, $_rectangle) = @_ } +sub set_clip_region { my ($_gc, $_region) = @_ } +sub set_colormap { my ($_gc, $_colormap) = @_ } +sub set_dashes { my ($_gc, $_dash_offset, @_more_paras) = @_ } +sub set_exposures { my ($_gc, $_exposures) = @_ } +sub set_fill { my ($_gc, $_fill) = @_ } +sub set_font { my ($_gc, $_font) = @_ } +sub set_foreground { my ($_gc, $_color) = @_ } +sub set_function { my ($_gc, $_function) = @_ } +sub set_line_attributes { my ($_gc, $_line_width, $_line_style, $_cap_style, $_join_style) = @_ } +sub set_rgb_background { my ($_gc, $_rgb) = @_ } +sub set_rgb_bg_color { my ($_gc, $_color) = @_ } +sub set_rgb_fg_color { my ($_gc, $_color) = @_ } +sub set_rgb_foreground { my ($_gc, $_rgb) = @_ } +sub set_stipple { my ($_gc, $_stipple) = @_ } +sub set_subwindow { my ($_gc, $_mode) = @_ } +sub set_tile { my ($_gc, $_tile) = @_ } +sub set_ts_origin { my ($_gc, $_x, $_y) = @_ } +sub set_values { my ($_gc, $_values) = @_ } + +package Gtk2::Gdk::Geometry; +our @ISA = qw(); +sub base_height { my ($_object, $_o_newvalue) = @_ } +sub base_width { my ($_object, $_o_newvalue) = @_ } +sub constrain_size { my ($_geometry_ref, @_more_paras) = @_ } +sub gravity { my ($_object, $_o_newvalue) = @_ } +sub height_inc { my ($_object, $_o_newvalue) = @_ } +sub max_aspect { my ($_object, $_o_newvalue) = @_ } +sub max_height { my ($_object, $_o_newvalue) = @_ } +sub max_width { my ($_object, $_o_newvalue) = @_ } +sub min_aspect { my ($_object, $_o_newvalue) = @_ } +sub min_height { my ($_object, $_o_newvalue) = @_ } +sub min_width { my ($_object, $_o_newvalue) = @_ } +sub new { my ($_class) = @_ } +sub width_inc { my ($_object, $_o_newvalue) = @_ } +sub win_gravity { my ($_object, $_o_newvalue) = @_ } + +package Gtk2::Gdk::Input; +our @ISA = qw(); +sub set_extension_events { my ($_class, $_window, $_mask, $_mode) = @_ } + +package Gtk2::Gdk::Keymap; +our @ISA = qw(); +sub get_default { my ($_class) = @_ } +sub get_direction { my ($_keymap) = @_ } +sub get_entries_for_keycode { my ($_keymap, $_hardware_keycode) = @_ } +sub get_entries_for_keyval { my ($_keymap, $_keyval) = @_ } +sub get_for_display { my ($_class, $_display) = @_ } +sub lookup_key { my ($_keymap, $_key) = @_ } +sub translate_keyboard_state { my ($_keymap, $_hardware_keycode, $_state, $_group) = @_ } + +package Gtk2::Gdk::PangoRenderer; +our @ISA = qw(); +sub get_default { my ($_class, $_screen) = @_ } +sub new { my ($_class, $_screen) = @_ } +sub set_drawable { my ($_gdk_renderer, $_drawable) = @_ } +sub set_gc { my ($_gdk_renderer, $_gc) = @_ } +sub set_override_color { my ($_gdk_renderer, $_part, $_color) = @_ } +sub set_stipple { my ($_gdk_renderer, $_part, $_stipple) = @_ } + +package Gtk2::Gdk::Pixbuf; +our @ISA = qw(); +sub add_alpha { my ($_pixbuf, $_substitute_color, $_r, $_g, $_b) = @_ } +sub composite { my ($_src, $_dest, $_dest_x, $_dest_y, $_dest_width, $_dest_height, $_offset_x, $_offset_y, $_scale_x, $_scale_y, $_interp_type, $_overall_alpha) = @_ } +sub composite_color { my ($_src, $_dest, $_dest_x, $_dest_y, $_dest_width, $_dest_height, $_offset_x, $_offset_y, $_scale_x, $_scale_y, $_interp_type, $_overall_alpha, $_check_x, $_check_y, $_check_size, $_color1, $_color2) = @_ } +sub composite_color_simple { my ($_src, $_dest_width, $_dest_height, $_interp_type, $_overall_alpha, $_check_size, $_color1, $_color2) = @_ } +sub copy { my ($_pixbuf) = @_ } +sub copy_area { my ($_src_pixbuf, $_src_x, $_src_y, $_width, $_height, $_dest_pixbuf, $_dest_x, $_dest_y) = @_ } +sub fill { my ($_pixbuf, $_pixel) = @_ } +sub flip { my ($_src, $_horizontal) = @_ } +sub get_bits_per_sample { my ($_pixbuf) = @_ } +sub get_colorspace { my ($_pixbuf) = @_ } +sub get_file_info { my ($_class, $_filename) = @_ } +sub get_formats { my ($_o_class) = @_ } +sub get_from_drawable { my ($_dest_or_class, $_src, $_cmap, $_src_x, $_src_y, $_dest_x, $_dest_y, $_width, $_height) = @_ } +sub get_from_image { my ($_dest_or_class, $_src, $_cmap, $_src_x, $_src_y, $_dest_x, $_dest_y, $_width, $_height) = @_ } +sub get_has_alpha { my ($_pixbuf) = @_ } +sub get_height { my ($_pixbuf) = @_ } +sub get_n_channels { my ($_pixbuf) = @_ } +sub get_option { my ($_pixbuf, $_key) = @_ } +sub get_pixels { my ($_pixbuf) = @_ } +sub get_rowstride { my ($_pixbuf) = @_ } +sub get_width { my ($_pixbuf) = @_ } +sub new { my ($_class, $_colorspace, $_has_alpha, $_bits_per_sample, $_width, $_height) = @_ } +sub new_from_data { my ($_class, $_data, $_colorspace, $_has_alpha, $_bits_per_sample, $_width, $_height, $_rowstride) = @_ } +sub new_from_file { my ($_class, $_filename) = @_ } +sub new_from_file_at_scale { my ($_class, $_filename, $_width, $_height, $_preserve_aspect_ratio) = @_ } +sub new_from_file_at_size { my ($_class, $_filename, $_width, $_height) = @_ } +sub new_from_inline { my ($_class, $_data, $_o_copy_pixels) = @_ } +sub new_from_xpm_data { my ($_class, @_more_paras) = @_ } +sub new_subpixbuf { my ($_src_pixbuf, $_src_x, $_src_y, $_width, $_height) = @_ } +sub render_pixmap_and_mask { my ($_pixbuf, $_alpha_threshold) = @_ } +sub render_pixmap_and_mask_for_colormap { my ($_pixbuf, $_colormap, $_alpha_threshold) = @_ } +sub render_threshold_alpha { my ($_pixbuf, $_bitmap, $_src_x, $_src_y, $_dest_x, $_dest_y, $_width, $_height, $_alpha_threshold) = @_ } +sub render_to_drawable { my ($_pixbuf, $_drawable, $_gc, $_src_x, $_src_y, $_dest_x, $_dest_y, $_width, $_height, $_dither, $_x_dither, $_y_dither) = @_ } +sub render_to_drawable_alpha { my ($_pixbuf, $_drawable, $_src_x, $_src_y, $_dest_x, $_dest_y, $_width, $_height, $_alpha_mode, $_alpha_threshold, $_dither, $_x_dither, $_y_dither) = @_ } +sub rotate_simple { my ($_src, $_angle) = @_ } +sub saturate_and_pixelate { my ($_src, $_dest, $_saturation, $_pixelate) = @_ } +sub save { my ($_pixbuf, $_filename, $_type, @_more_paras) = @_ } +sub save_to_buffer { my ($_pixbuf, $_type, @_more_paras) = @_ } +sub scale { my ($_src, $_dest, $_dest_x, $_dest_y, $_dest_width, $_dest_height, $_offset_x, $_offset_y, $_scale_x, $_scale_y, $_interp_type) = @_ } +sub scale_simple { my ($_src, $_dest_width, $_dest_height, $_interp_type) = @_ } + +package Gtk2::Gdk::PixbufAnimation; +our @ISA = qw(); +sub get_height { my ($_animation) = @_ } +sub get_iter { my ($_animation, $_o_start_time_seconds, $_o_start_time_microseconds) = @_ } +sub get_static_image { my ($_animation) = @_ } +sub get_width { my ($_animation) = @_ } +sub is_static_image { my ($_animation) = @_ } +sub new_from_file { my ($_class, $_filename) = @_ } + +package Gtk2::Gdk::PixbufAnimationIter; +our @ISA = qw(); +sub advance { my ($_iter, $_o_current_time_seconds, $_o_current_time_microseconds) = @_ } +sub get_delay_time { my ($_iter) = @_ } +sub get_pixbuf { my ($_iter) = @_ } +sub on_currently_loading_frame { my ($_iter) = @_ } + +package Gtk2::Gdk::PixbufFormat; +our @ISA = qw(); +sub DESTROY { my ($_sv) = @_ } +sub set_disabled { my ($_format, $_disabled) = @_ } + +package Gtk2::Gdk::PixbufLoader; +our @ISA = qw(); +sub close { my ($_loader) = @_ } +sub get_animation { my ($_loader) = @_ } +sub get_format { my ($_loader) = @_ } +sub get_pixbuf { my ($_loader) = @_ } +sub new { my ($_class) = @_ } +sub new_with_mime_type { my (@_more_paras) = @_ } +sub new_with_type { my (@_more_paras) = @_ } +sub set_size { my ($_loader, $_width, $_height) = @_ } +sub write { my ($_loader, $_buf) = @_ } + +package Gtk2::Gdk::PixbufSimpleAnim; +our @ISA = qw(); +sub add_frame { my ($_animation, $_pixbuf) = @_ } +sub new { my ($_class, $_width, $_height, $_rate) = @_ } + +package Gtk2::Gdk::Pixmap; +our @ISA = qw(); +sub colormap_create_from_xpm { my ($_class, $_drawable, $_colormap, $_transparent_color, $_filename) = @_ } +sub colormap_create_from_xpm_d { my ($_class, $_drawable, $_colormap, $_transparent_color, $_data, @_more_paras) = @_ } +sub create_from_data { my ($_class, $_drawable, $_data, $_width, $_height, $_depth, $_fg, $_bg) = @_ } +sub create_from_xpm { my ($_class, $_drawable, $_transparent_color, $_filename) = @_ } +sub create_from_xpm_d { my ($_class, $_drawable, $_transparent_color, $_data, @_more_paras) = @_ } +sub foreign_new { my ($_class, $_anid) = @_ } +sub foreign_new_for_display { my ($_class, $_display, $_anid) = @_ } +sub lookup { my ($_class, $_anid) = @_ } +sub lookup_for_display { my ($_class, $_display, $_anid) = @_ } +sub new { my ($_class, $_drawable, $_width, $_height, $_depth) = @_ } + +package Gtk2::Gdk::Rectangle; +our @ISA = qw(); +sub height { my ($_rectangle, $_o_newvalue) = @_ } +sub intersect { my ($_src1, $_src2) = @_ } +sub new { my ($_class, $_x, $_y, $_width, $_height) = @_ } +sub union { my ($_src1, $_src2) = @_ } +sub values { my ($_rectangle) = @_ } +sub width { my ($_rectangle, $_o_newvalue) = @_ } +sub Gtk2::Gdk::Rectangle::x { my ($_rectangle, $_o_newvalue) = @_ } +sub Gtk2::Gdk::Rectangle::y { my ($_rectangle, $_o_newvalue) = @_ } + +package Gtk2::Gdk::Region; +our @ISA = qw(); +sub empty { my ($_region) = @_ } +sub equal { my ($_region1, $_region2) = @_ } +sub get_clipbox { my ($_region) = @_ } +sub get_rectangles { my ($_region) = @_ } +sub intersect { my ($_source1, $_source2) = @_ } +sub new { my ($_class) = @_ } +sub offset { my ($_region, $_dx, $_dy) = @_ } +sub point_in { my ($_region, $_x, $_y) = @_ } +sub polygon { my ($_class, $_points_ref, $_fill_rule) = @_ } +sub rect_in { my ($_region, $_rect) = @_ } +sub rectangle { my ($_class, $_rectangle) = @_ } +sub shrink { my ($_region, $_dx, $_dy) = @_ } +sub spans_intersect_foreach { my ($_region, $_spans_ref, $_sorted, $_func, $_o_data) = @_ } +sub subtract { my ($_source1, $_source2) = @_ } +sub union { my ($_source1, $_source2) = @_ } +sub union_with_rect { my ($_region, $_rect) = @_ } +sub Gtk2::Gdk::Region::xor { my ($_source1, $_source2) = @_ } + +package Gtk2::Gdk::Rgb; +our @ISA = qw(); +sub colormap_ditherable { my ($_class, $_cmap) = @_ } +sub ditherable { my ($_class) = @_ } +sub set_install { my ($_class, $_install) = @_ } +sub set_min_colors { my ($_class, $_min_colors) = @_ } +sub set_verbose { my ($_class, $_verbose) = @_ } + +package Gtk2::Gdk::Screen; +our @ISA = qw(); +sub broadcast_client_message { my ($_screen, $_event) = @_ } +sub get_default { my ($_class) = @_ } +sub get_default_colormap { my ($_screen) = @_ } +sub get_display { my ($_screen) = @_ } +sub get_height { my ($_screen) = @_ } +sub get_height_mm { my ($_screen) = @_ } +sub get_monitor_at_point { my ($_screen, $_x, $_y) = @_ } +sub get_monitor_at_window { my ($_screen, $_window) = @_ } +sub get_monitor_geometry { my ($_screen, $_monitor_num) = @_ } +sub get_n_monitors { my ($_screen) = @_ } +sub get_number { my ($_screen) = @_ } +sub get_rgb_colormap { my ($_screen) = @_ } +sub get_rgb_visual { my ($_screen) = @_ } +sub get_rgba_colormap { my ($_screen) = @_ } +sub get_rgba_visual { my ($_screen) = @_ } +sub get_root_window { my ($_screen) = @_ } +sub get_screen_number { my ($_screen) = @_ } +sub get_setting { my ($_screen, $_name) = @_ } +sub get_system_colormap { my ($_screen) = @_ } +sub get_system_visual { my ($_screen) = @_ } +sub get_toplevel_windows { my ($_screen) = @_ } +sub get_width { my ($_screen) = @_ } +sub get_width_mm { my ($_screen) = @_ } +sub get_window_manager_name { my ($_screen) = @_ } +sub list_visuals { my ($_screen) = @_ } +sub make_display_name { my ($_screen) = @_ } +sub set_default_colormap { my ($_screen, $_colormap) = @_ } +sub supports_net_wm_hint { my ($_screen, $_property) = @_ } + +package Gtk2::Gdk::Selection; +our @ISA = qw(); +sub convert { my ($_class, $_requestor, $_selection, $_target, $_time_) = @_ } +sub owner_get { my ($_class, $_selection) = @_ } +sub owner_get_for_display { my ($_class, $_display, $_selection) = @_ } +sub owner_set { my ($_class, $_owner, $_selection, $_time_, $_send_event) = @_ } +sub owner_set_for_display { my ($_class, $_display, $_owner, $_selection, $_time_, $_send_event) = @_ } +sub property_get { my ($_class, $_requestor) = @_ } +sub send_notify { my ($_class, $_requestor, $_selection, $_target, $_property, $_time_) = @_ } +sub send_notify_for_display { my ($_class, $_display, $_requestor, $_selection, $_target, $_property, $_time_) = @_ } + +package Gtk2::Gdk::Threads; +our @ISA = qw(); +sub enter { my ($_class) = @_ } +sub init { my ($_class) = @_ } +sub leave { my ($_class) = @_ } + +package Gtk2::Gdk::Visual; +our @ISA = qw(); +sub bits_per_rgb { my ($_visual) = @_ } +sub blue_mask { my ($_visual) = @_ } +sub blue_prec { my ($_visual) = @_ } +sub blue_shift { my ($_visual) = @_ } +sub byte_order { my ($_visual) = @_ } +sub colormap_size { my ($_visual) = @_ } +sub depth { my ($_visual) = @_ } +sub get_best { my ($_class) = @_ } +sub get_best_depth { my ($_class) = @_ } +sub get_best_type { my ($_class) = @_ } +sub get_best_with_both { my ($_class, $_depth, $_visual_type) = @_ } +sub get_best_with_depth { my ($_class, $_depth) = @_ } +sub get_best_with_type { my ($_class, $_visual_type) = @_ } +sub get_screen { my ($_visual) = @_ } +sub get_system { my ($_class) = @_ } +sub green_mask { my ($_visual) = @_ } +sub green_prec { my ($_visual) = @_ } +sub green_shift { my ($_visual) = @_ } +sub red_mask { my ($_visual) = @_ } +sub red_prec { my ($_visual) = @_ } +sub red_shift { my ($_visual) = @_ } +sub type { my ($_visual) = @_ } + +package Gtk2::Gdk::Window; +our @ISA = qw(); +sub at_pointer { my ($_class) = @_ } +sub begin_move_drag { my ($_window, $_button, $_root_x, $_root_y, $_timestamp) = @_ } +sub begin_paint_rect { my ($_window, $_rectangle) = @_ } +sub begin_paint_region { my ($_window, $_region) = @_ } +sub begin_resize_drag { my ($_window, $_edge, $_button, $_root_x, $_root_y, $_timestamp) = @_ } +sub clear { my ($_window) = @_ } +sub clear_area { my ($_window, $_x, $_y, $_width, $_height) = @_ } +sub clear_area_e { my ($_window, $_x, $_y, $_width, $_height) = @_ } +sub configure_finished { my ($_window) = @_ } +sub deiconify { my ($_window) = @_ } +sub destroy { my ($_window) = @_ } +sub enable_synchronized_configure { my ($_window) = @_ } +sub end_paint { my ($_window) = @_ } +sub focus { my ($_window, $_timestamp) = @_ } +sub foreign_new { my ($_class, $_anid) = @_ } +sub foreign_new_for_display { my ($_class, $_display, $_anid) = @_ } +sub freeze_updates { my ($_window) = @_ } +sub fullscreen { my ($_window) = @_ } +sub gdk_set_sm_client_id { my ($_sm_client_id) = @_ } +sub get_children { my ($_window) = @_ } +sub get_decorations { my ($_window) = @_ } +sub get_events { my ($_window) = @_ } +sub get_frame_extents { my ($_window) = @_ } +sub get_geometry { my ($_window) = @_ } +sub get_group { my ($_window) = @_ } +sub get_internal_paint_info { my ($_window) = @_ } +sub get_origin { my ($_window) = @_ } +sub get_parent { my ($_window) = @_ } +sub get_pointer { my ($_window) = @_ } +sub get_position { my ($_window) = @_ } +sub get_root_origin { my ($_window) = @_ } +sub get_state { my ($_window) = @_ } +sub get_toplevel { my ($_window) = @_ } +sub get_toplevels { my ($_class) = @_ } +sub get_update_area { my ($_window) = @_ } +sub get_user_data { my ($_window) = @_ } +sub get_window_type { my ($_window) = @_ } +sub hide { my ($_window) = @_ } +sub iconify { my ($_window) = @_ } +sub invalidate_maybe_recurse { my ($_window, $_region, $_func, $_o_data) = @_ } +sub invalidate_rect { my ($_window, $_rectangle, $_invalidate_children) = @_ } +sub invalidate_region { my ($_window, $_region, $_invalidate_children) = @_ } +sub is_viewable { my ($_window) = @_ } +sub is_visible { my ($_window) = @_ } +sub lookup { my ($_class, $_anid) = @_ } +sub lookup_for_display { my ($_class, $_display, $_anid) = @_ } +sub lower { my ($_window) = @_ } +sub maximize { my ($_window) = @_ } +sub merge_child_shapes { my ($_window) = @_ } +sub move { my ($_window, $_x, $_y) = @_ } +sub move_region { my ($_window, $_region, $_dx, $_dy) = @_ } +sub move_resize { my ($_window, $_x, $_y, $_width, $_height) = @_ } +sub move_to_current_desktop { my ($_window) = @_ } +sub new { my ($_class, $_parent, $_attributes_ref) = @_ } +sub peek_children { my ($_window) = @_ } +sub process_all_updates { my ($_class_or_instance) = @_ } +sub process_updates { my ($_window, $_update_children) = @_ } +sub property_change { my ($_window, $_property, $_type, $_format, $_mode, @_more_paras) = @_ } +sub property_delete { my ($_window, $_property) = @_ } +sub property_get { my ($_window, $_property, $_type, $_offset, $_length, $_pdelete) = @_ } +sub raise { my ($_window) = @_ } +sub register_dnd { my ($_window) = @_ } +sub reparent { my ($_window, $_new_parent, $_x, $_y) = @_ } +sub resize { my ($_window, $_width, $_height) = @_ } +sub scroll { my ($_window, $_dx, $_dy) = @_ } +sub set_accept_focus { my ($_window, $_accept_focus) = @_ } +sub set_back_pixmap { my ($_window, $_pixmap, $_o_parent_relative) = @_ } +sub set_background { my ($_window, $_color) = @_ } +sub set_child_shapes { my ($_window) = @_ } +sub set_cursor { my ($_window, $_cursor) = @_ } +sub set_debug_updates { my ($_class_or_instance, $_enable) = @_ } +sub set_decorations { my ($_window, $_decorations) = @_ } +sub set_events { my ($_window, $_event_mask) = @_ } +sub set_focus_on_map { my ($_window, $_focus_on_map) = @_ } +sub set_functions { my ($_window, $_functions) = @_ } +sub set_geometry_hints { my ($_window, $_geometry_ref, $_o_geom_mask_sv) = @_ } +sub set_group { my ($_window, $_leader) = @_ } +sub set_icon { my ($_window, $_icon_window, $_pixmap, $_mask) = @_ } +sub set_icon_list { my ($_window, @_more_paras) = @_ } +sub set_icon_name { my ($_window, $_name) = @_ } +sub set_keep_above { my ($_window, $_setting) = @_ } +sub set_keep_below { my ($_window, $_setting) = @_ } +sub set_modal_hint { my ($_window, $_modal) = @_ } +sub set_override_redirect { my ($_window, $_override_redirect) = @_ } +sub set_role { my ($_window, $_role) = @_ } +sub set_skip_pager_hint { my ($_window, $_skips_pager) = @_ } +sub set_skip_taskbar_hint { my ($_window, $_skips_taskbar) = @_ } +sub set_static_gravities { my ($_window, $_use_static) = @_ } +sub set_title { my ($_window, $_title) = @_ } +sub set_transient_for { my ($_window, $_parent) = @_ } +sub set_type_hint { my ($_window, $_hint) = @_ } +sub set_urgency_hint { my ($_window, $_urgent) = @_ } +sub set_user_data { my ($_window, $_user_data) = @_ } +sub set_user_time { my ($_window, $_timestamp) = @_ } +sub shape_combine_mask { my ($_window, $_mask, $_x, $_y) = @_ } +sub shape_combine_region { my ($_window, $_shape_region, $_offset_x, $_offset_y) = @_ } +sub show { my ($_window) = @_ } +sub show_unraised { my ($_window) = @_ } +sub stick { my ($_window) = @_ } +sub thaw_updates { my ($_window) = @_ } +sub unfullscreen { my ($_window) = @_ } +sub unmaximize { my ($_window) = @_ } +sub unstick { my ($_window) = @_ } +sub withdraw { my ($_window) = @_ } + +package Gtk2::Gdk::X11; +our @ISA = qw(); +sub get_default_screen { my ($_class) = @_ } +sub get_server_time { my ($_class, $_window) = @_ } +sub grab_server { my ($_class) = @_ } +sub net_wm_supports { my ($_class, $_property) = @_ } +sub ungrab_server { my ($_class) = @_ } + +package Gtk2::HBox; +our @ISA = qw(); +sub new { my ($_class, $_o_homogeneous, $_o_spacing) = @_ } + +package Gtk2::HButtonBox; +our @ISA = qw(); +sub get_layout_default { my ($_class) = @_ } +sub get_spacing_default { my ($_class) = @_ } +sub new { my ($_class) = @_ } +sub set_layout_default { my ($_class, $_layout) = @_ } +sub set_spacing_default { my ($_class, $_spacing) = @_ } + +package Gtk2::HPaned; +our @ISA = qw(); +sub new { my ($_class) = @_ } + +package Gtk2::HRuler; +our @ISA = qw(); +sub new { my ($_class) = @_ } + +package Gtk2::HScale; +our @ISA = qw(); +sub new { my ($_class, $_o_adjustment) = @_ } +sub new_with_range { my ($_class, $_min, $_max, $_step) = @_ } + +package Gtk2::HScrollBar; +our @ISA = qw(); +sub new { my ($_class, $_o_adjustment) = @_ } + +package Gtk2::HScrollbar; +our @ISA = qw(); +sub new { my ($_class, $_o_adjustment) = @_ } + +package Gtk2::HSeparator; +our @ISA = qw(); +sub new { my ($_class) = @_ } + +package Gtk2::HandleBox; +our @ISA = qw(); +sub get_child_detached { my ($_handle_box) = @_ } +sub get_handle_position { my ($_handle_box) = @_ } +sub get_shadow_type { my ($_handle_box) = @_ } +sub get_snap_edge { my ($_handle_box) = @_ } +sub new { my ($_class) = @_ } +sub set_handle_position { my ($_handle_box, $_position) = @_ } +sub set_shadow_type { my ($_handle_box, $_type) = @_ } +sub set_snap_edge { my ($_handle_box, $_edge) = @_ } + +package Gtk2::IconFactory; +our @ISA = qw(); +sub add { my ($_factory, $_stock_id, $_icon_set) = @_ } +sub add_default { my ($_factory) = @_ } +sub lookup { my ($_factory, $_stock_id) = @_ } +sub lookup_default { my ($_class, $_stock_id) = @_ } +sub new { my ($_class) = @_ } +sub remove_default { my ($_factory) = @_ } + +package Gtk2::IconInfo; +our @ISA = qw(); +sub get_attach_points { my ($_icon_info) = @_ } +sub get_base_size { my ($_icon_info) = @_ } +sub get_builtin_pixbuf { my ($_icon_info) = @_ } +sub get_display_name { my ($_icon_info) = @_ } +sub get_embedded_rect { my ($_icon_info) = @_ } +sub get_filename { my ($_icon_info) = @_ } +sub load_icon { my ($_icon_info) = @_ } +sub set_raw_coordinates { my ($_icon_info, $_raw_coordinates) = @_ } + +package Gtk2::IconSet; +our @ISA = qw(); +sub add_source { my ($_icon_set, $_source) = @_ } +sub get_sizes { my ($_icon_set) = @_ } +sub new { my ($_class) = @_ } +sub new_from_pixbuf { my ($_class, $_pixbuf) = @_ } +sub render_icon { my ($_icon_set, $_style, $_direction, $_state, $_size, $_widget, $_o_detail) = @_ } + +package Gtk2::IconSize; +our @ISA = qw(); +sub from_name { my ($_class, $_name) = @_ } +sub lookup { my ($_class, $_size) = @_ } +sub lookup_for_settings { my ($_class, $_settings, $_size) = @_ } +sub register { my ($_class, $_name, $_width, $_height) = @_ } +sub register_alias { my ($_class, $_alias, $_target) = @_ } + +package Gtk2::IconSource; +our @ISA = qw(); +sub get_direction { my ($_source) = @_ } +sub get_direction_wildcarded { my ($_source) = @_ } +sub get_filename { my ($_source) = @_ } +sub get_icon_name { my ($_source) = @_ } +sub get_pixbuf { my ($_source) = @_ } +sub get_size { my ($_source) = @_ } +sub get_size_wildcarded { my ($_source) = @_ } +sub get_state { my ($_source) = @_ } +sub get_state_wildcarded { my ($_source) = @_ } +sub new { my ($_class) = @_ } +sub set_direction { my ($_source, $_direction) = @_ } +sub set_direction_wildcarded { my ($_source, $_setting) = @_ } +sub set_filename { my ($_source, $_filename) = @_ } +sub set_icon_name { my ($_source, $_icon_name) = @_ } +sub set_pixbuf { my ($_source, $_pixbuf) = @_ } +sub set_size { my ($_source, $_size) = @_ } +sub set_size_wildcarded { my ($_source, $_setting) = @_ } +sub set_state { my ($_source, $_state) = @_ } +sub set_state_wildcarded { my ($_source, $_setting) = @_ } + +package Gtk2::IconTheme; +our @ISA = qw(); +sub add_builtin_icon { my ($_class, $_icon_name, $_size, $_pixbuf) = @_ } +sub append_search_path { my ($_icon_theme, $_path) = @_ } +sub get_default { my ($_class) = @_ } +sub get_example_icon_name { my ($_icon_theme) = @_ } +sub get_for_screen { my ($_class, $_screen) = @_ } +sub get_icon_sizes { my ($_icon_theme, $_icon_name) = @_ } +sub get_search_path { my ($_icon_theme) = @_ } +sub has_icon { my ($_icon_theme, $_icon_name) = @_ } +sub list_icons { my ($_icon_theme, $_context) = @_ } +sub load_icon { my ($_icon_theme, $_icon_name, $_size, $_flags) = @_ } +sub lookup_icon { my ($_icon_theme, $_icon_name, $_size, $_flags) = @_ } +sub new { my ($_class) = @_ } +sub prepend_search_path { my ($_icon_theme, $_path) = @_ } +sub rescan_if_needed { my ($_icon_theme) = @_ } +sub set_custom_theme { my ($_icon_theme, $_theme_name) = @_ } +sub set_screen { my ($_icon_theme, $_screen) = @_ } +sub set_search_path { my ($_icon_theme, @_more_paras) = @_ } + +package Gtk2::IconView; +our @ISA = qw(); +sub create_drag_icon { my ($_icon_view, $_path) = @_ } +sub enable_model_drag_dest { my ($_icon_view, $_actions, @_more_paras) = @_ } +sub enable_model_drag_source { my ($_icon_view, $_start_button_mask, $_actions, @_more_paras) = @_ } +sub get_column_spacing { my ($_icon_view) = @_ } +sub get_columns { my ($_icon_view) = @_ } +sub get_cursor { my ($_icon_view) = @_ } +sub get_dest_item_at_pos { my ($_icon_view, $_drag_x, $_drag_y) = @_ } +sub get_drag_dest_item { my ($_icon_view) = @_ } +sub get_item_at_pos { my ($_icon_view, $_x, $_y) = @_ } +sub get_item_width { my ($_icon_view) = @_ } +sub get_margin { my ($_icon_view) = @_ } +sub get_markup_column { my ($_icon_view) = @_ } +sub get_model { my ($_icon_view) = @_ } +sub get_orientation { my ($_icon_view) = @_ } +sub get_path_at_pos { my ($_icon_view, $_x, $_y) = @_ } +sub get_pixbuf_column { my ($_icon_view) = @_ } +sub get_reorderable { my ($_icon_view) = @_ } +sub get_row_spacing { my ($_icon_view) = @_ } +sub get_selected_items { my ($_icon_view) = @_ } +sub get_selection_mode { my ($_icon_view) = @_ } +sub get_spacing { my ($_icon_view) = @_ } +sub get_text_column { my ($_icon_view) = @_ } +sub get_visible_range { my ($_icon_view) = @_ } +sub item_activated { my ($_icon_view, $_path) = @_ } +sub new { my ($_class) = @_ } +sub new_with_model { my ($_class, $_model) = @_ } +sub path_is_selected { my ($_icon_view, $_path) = @_ } +sub scroll_to_path { my ($_icon_view, $_path, $_use_align, $_row_align, $_col_align) = @_ } +sub select_all { my ($_icon_view) = @_ } +sub select_path { my ($_icon_view, $_path) = @_ } +sub selected_foreach { my ($_icon_view, $_func, $_o_data) = @_ } +sub set_column_spacing { my ($_icon_view, $_column_spacing) = @_ } +sub set_columns { my ($_icon_view, $_columns) = @_ } +sub set_cursor { my ($_icon_view, $_path, $_cell, $_start_editing) = @_ } +sub set_drag_dest_item { my ($_icon_view, $_path, $_pos) = @_ } +sub set_item_width { my ($_icon_view, $_item_width) = @_ } +sub set_margin { my ($_icon_view, $_margin) = @_ } +sub set_markup_column { my ($_icon_view, $_column) = @_ } +sub set_model { my ($_icon_view, $_model) = @_ } +sub set_orientation { my ($_icon_view, $_orientation) = @_ } +sub set_pixbuf_column { my ($_icon_view, $_column) = @_ } +sub set_reorderable { my ($_icon_view, $_reorderable) = @_ } +sub set_row_spacing { my ($_icon_view, $_row_spacing) = @_ } +sub set_selection_mode { my ($_icon_view, $_mode) = @_ } +sub set_spacing { my ($_icon_view, $_spacing) = @_ } +sub set_text_column { my ($_icon_view, $_column) = @_ } +sub unselect_all { my ($_icon_view) = @_ } +sub unselect_path { my ($_icon_view, $_path) = @_ } +sub unset_model_drag_dest { my ($_icon_view) = @_ } +sub unset_model_drag_source { my ($_icon_view) = @_ } + +package Gtk2::Image; +our @ISA = qw(); +sub clear { my ($_image) = @_ } +sub get_animation { my ($_image) = @_ } +sub get_icon_name { my ($_image) = @_ } +sub get_icon_set { my ($_image) = @_ } +sub get_image { my ($_image) = @_ } +sub get_pixbuf { my ($_image) = @_ } +sub get_pixel_size { my ($_image) = @_ } +sub get_pixmap { my ($_image) = @_ } +sub get_stock { my ($_image) = @_ } +sub get_storage_type { my ($_image) = @_ } +sub new { my ($_class) = @_ } +sub new_from_animation { my ($_class, $_animation) = @_ } +sub new_from_file { my ($_class, $_filename) = @_ } +sub new_from_icon_name { my ($_class, $_icon_name, $_size) = @_ } +sub new_from_icon_set { my ($_class, $_icon_set, $_size) = @_ } +sub new_from_image { my ($_class, $_image, $_mask) = @_ } +sub new_from_pixbuf { my ($_class, $_pixbuf) = @_ } +sub new_from_pixmap { my ($_class, $_pixmap, $_mask) = @_ } +sub new_from_stock { my ($_class, $_stock_id, $_size) = @_ } +sub set_from_animation { my ($_image, $_animation) = @_ } +sub set_from_file { my ($_image, $_filename) = @_ } +sub set_from_icon_name { my ($_image, $_icon_name, $_size) = @_ } +sub set_from_icon_set { my ($_image, $_icon_set, $_size) = @_ } +sub set_from_image { my ($_image, $_gdk_image, $_mask) = @_ } +sub set_from_pixbuf { my ($_image, $_pixbuf) = @_ } +sub set_from_pixmap { my ($_image, $_pixmap, $_mask) = @_ } +sub set_from_stock { my ($_image, $_stock_id, $_size) = @_ } +sub set_pixel_size { my ($_image, $_pixel_size) = @_ } + +package Gtk2::ImageMenuItem; +our @ISA = qw(); +sub get_image { my ($_image_menu_item) = @_ } +sub new { my ($_class, $_o_label) = @_ } +sub new_from_stock { my ($_class, $_stock_id, $_o_accel_group) = @_ } +sub new_with_label { my ($_class, $_o_label) = @_ } +sub new_with_mnemonic { my ($_class, $_o_label) = @_ } +sub set_image { my ($_image_menu_item, $_image) = @_ } + +package Gtk2::InputDialog; +our @ISA = qw(); +sub new { my ($_class) = @_ } + +package Gtk2::Invisible; +our @ISA = qw(); +sub get_screen { my ($_invisible) = @_ } +sub new { my ($_class) = @_ } +sub new_for_screen { my ($_class, $_screen) = @_ } +sub set_screen { my ($_invisible, $_screen) = @_ } + +package Gtk2::Item; +our @ISA = qw(); +sub deselect { my ($_item) = @_ } +sub select { my ($_item) = @_ } +sub toggle { my ($_item) = @_ } + +package Gtk2::ItemFactory; +our @ISA = qw(); +sub create_item { my ($_ifactory, $_entry_ref, $_o_callback_data) = @_ } +sub create_items { my ($_ifactory, $_callback_data, @_more_paras) = @_ } +sub delete_entries { my ($_ifactory, @_more_paras) = @_ } +sub delete_entry { my ($_ifactory, $_entry_ref) = @_ } +sub delete_item { my ($_ifactory, $_path) = @_ } +sub from_widget { my ($_class, $_widget) = @_ } +sub get_item { my ($_ifactory, $_path) = @_ } +sub get_item_by_action { my ($_ifactory, $_action) = @_ } +sub get_widget { my ($_ifactory, $_path) = @_ } +sub get_widget_by_action { my ($_ifactory, $_action) = @_ } +sub new { my ($_class, $_container_type_package, $_path, $_o_accel_group) = @_ } +sub path_from_widget { my ($_class, $_widget) = @_ } +sub popup { my ($_ifactory, $_x, $_y, $_mouse_button, $_time_, $_o_popup_data) = @_ } +sub popup_data { my ($_ifactory) = @_ } +sub popup_data_from_widget { my ($_class, $_widget) = @_ } +sub set_translate_func { my ($_ifactory, $_func, $_o_data) = @_ } + +package Gtk2::Label; +our @ISA = qw(); +sub get_angle { my ($_label) = @_ } +sub get_attributes { my ($_label) = @_ } +sub get_ellipsize { my ($_label) = @_ } +sub get_justify { my ($_label) = @_ } +sub get_label { my ($_label) = @_ } +sub get_layout { my ($_label) = @_ } +sub get_layout_offsets { my ($_label) = @_ } +sub get_line_wrap { my ($_label) = @_ } +sub get_max_width_chars { my ($_label) = @_ } +sub get_mnemonic_keyval { my ($_label) = @_ } +sub get_mnemonic_widget { my ($_label) = @_ } +sub get_selectable { my ($_label) = @_ } +sub get_selection_bounds { my ($_label) = @_ } +sub get_single_line_mode { my ($_label) = @_ } +sub get_text { my ($_label) = @_ } +sub get_use_markup { my ($_label) = @_ } +sub get_use_underline { my ($_label) = @_ } +sub get_width_chars { my ($_label) = @_ } +sub new { my ($_class, $_o_str) = @_ } +sub new_with_mnemonic { my ($_class, $_str) = @_ } +sub select_region { my ($_label, $_o_start_offset, $_o_end_offset) = @_ } +sub set_angle { my ($_label, $_angle) = @_ } +sub set_attributes { my ($_label, $_attrs) = @_ } +sub set_ellipsize { my ($_label, $_mode) = @_ } +sub set_justify { my ($_label, $_jtype) = @_ } +sub set_label { my ($_label, $_str) = @_ } +sub set_line_wrap { my ($_label, $_wrap) = @_ } +sub set_markup { my ($_label, $_str) = @_ } +sub set_markup_with_mnemonic { my ($_label, $_str) = @_ } +sub set_max_width_chars { my ($_label, $_n_chars) = @_ } +sub set_mnemonic_widget { my ($_label, $_widget) = @_ } +sub set_pattern { my ($_label, $_pattern) = @_ } +sub set_selectable { my ($_label, $_setting) = @_ } +sub set_single_line_mode { my ($_label, $_single_line_mode) = @_ } +sub set_text { my ($_label, $_str) = @_ } +sub set_text_with_mnemonic { my ($_label, $_str) = @_ } +sub set_use_markup { my ($_label, $_setting) = @_ } +sub set_use_underline { my ($_label, $_setting) = @_ } +sub set_width_chars { my ($_label, $_n_chars) = @_ } + +package Gtk2::Layout; +our @ISA = qw(); +sub freeze { my ($_layout) = @_ } +sub get_hadjustment { my ($_layout) = @_ } +sub get_size { my ($_layout) = @_ } +sub get_vadjustment { my ($_layout) = @_ } +sub move { my ($_layout, $_child_widget, $_x, $_y) = @_ } +sub new { my ($_class, $_o_hadjustment, $_o_vadjustment) = @_ } +sub put { my ($_layout, $_child_widget, $_x, $_y) = @_ } +sub set_hadjustment { my ($_layout, $_adjustment) = @_ } +sub set_size { my ($_layout, $_width, $_height) = @_ } +sub set_vadjustment { my ($_layout, $_adjustment) = @_ } +sub thaw { my ($_layout) = @_ } + +package Gtk2::List; +our @ISA = qw(); +sub append_items { my ($_list, @_more_paras) = @_ } +sub child_position { my ($_list, $_child) = @_ } +sub clear_items { my ($_list, $_start, $_end) = @_ } +sub end_drag_selection { my ($_list) = @_ } +sub end_selection { my ($_list) = @_ } +sub extend_selection { my ($_list, $_scroll_type, $_position, $_auto_start_selection) = @_ } +sub insert_items { my ($_list, $_position, @_more_paras) = @_ } +sub new { my ($_class) = @_ } +sub prepend_items { my ($_list, @_more_paras) = @_ } +sub remove_items { my ($_list, @_more_paras) = @_ } +sub scroll_horizontal { my ($_list, $_scroll_type, $_position) = @_ } +sub scroll_vertical { my ($_list, $_scroll_type, $_position) = @_ } +sub select_all { my ($_list) = @_ } +sub select_child { my ($_list, $_child) = @_ } +sub select_item { my ($_list, $_item) = @_ } +sub set_selection_mode { my ($_list, $_mode) = @_ } +sub start_selection { my ($_list) = @_ } +sub toggle_add_mode { my ($_list) = @_ } +sub toggle_focus_row { my ($_list) = @_ } +sub toggle_row { my ($_list, $_item) = @_ } +sub undo_selection { my ($_list) = @_ } +sub unselect_all { my ($_list) = @_ } +sub unselect_child { my ($_list, $_child) = @_ } +sub unselect_item { my ($_list, $_item) = @_ } + +package Gtk2::ListItem; +our @ISA = qw(); +sub deselect { my ($_list_item) = @_ } +sub new { my ($_class, $_o_label) = @_ } +sub new_with_label { my ($_class, $_o_label) = @_ } +sub select { my ($_list_item) = @_ } + +package Gtk2::ListStore; +our @ISA = qw(); +sub append { my ($_list_store) = @_ } +sub clear { my ($_list_store) = @_ } +sub insert { my ($_list_store, $_position) = @_ } +sub insert_after { my ($_list_store, $_sibling) = @_ } +sub insert_before { my ($_list_store, $_sibling) = @_ } +sub insert_with_values { my ($_list_store, $_position, @_more_paras) = @_ } +sub iter_is_valid { my ($_list_store, $_iter) = @_ } +sub move_after { my ($_store, $_iter, $_position) = @_ } +sub move_before { my ($_store, $_iter, $_position) = @_ } +sub new { my ($_class, @_more_paras) = @_ } +sub prepend { my ($_list_store) = @_ } +sub remove { my ($_list_store, $_iter) = @_ } +sub reorder { my ($_store, @_more_paras) = @_ } +sub set { my ($_list_store, $_iter, $_col1, $_val1, @_more_paras) = @_ } +sub set_column_types { my ($_list_store, @_more_paras) = @_ } +sub set_value { my ($_list_store, $_iter, $_col1, $_val1, @_more_paras) = @_ } +sub swap { my ($_store, $_a, $_b) = @_ } + +package Gtk2::Menu; +our @ISA = qw(); +sub attach { my ($_menu, $_child, $_left_attach, $_right_attach, $_top_attach, $_bottom_attach) = @_ } +sub attach_to_widget { my ($_menu, $_attach_widget, $_detacher) = @_ } +sub detach { my ($_menu) = @_ } +sub get_accel_group { my ($_menu) = @_ } +sub get_active { my ($_menu) = @_ } +sub get_attach_widget { my ($_menu) = @_ } +sub get_for_attach_widget { my ($_class, $_widget) = @_ } +sub get_tearoff_state { my ($_menu) = @_ } +sub get_title { my ($_menu) = @_ } +sub new { my ($_class) = @_ } +sub popdown { my ($_menu) = @_ } +sub popup { my ($_menu, $_parent_menu_shell, $_parent_menu_item, $_menu_pos_func, $_data, $_button, $_activate_time) = @_ } +sub reorder_child { my ($_menu, $_child, $_position) = @_ } +sub reposition { my ($_menu) = @_ } +sub set_accel_group { my ($_menu, $_accel_group) = @_ } +sub set_accel_path { my ($_menu, $_accel_path) = @_ } +sub set_active { my ($_menu, $_index) = @_ } +sub set_monitor { my ($_menu, $_monitor_num) = @_ } +sub set_screen { my ($_menu, $_screen) = @_ } +sub set_tearoff_state { my ($_menu, $_torn_off) = @_ } +sub set_title { my ($_menu, $_title) = @_ } + +package Gtk2::MenuBar; +our @ISA = qw(); +sub get_child_pack_direction { my ($_menubar) = @_ } +sub get_pack_direction { my ($_menubar) = @_ } +sub new { my ($_class) = @_ } +sub set_child_pack_direction { my ($_menubar, $_child_pack_dir) = @_ } +sub set_pack_direction { my ($_menubar, $_pack_dir) = @_ } + +package Gtk2::MenuItem; +our @ISA = qw(); +sub activate { my ($_menu_item) = @_ } +sub deselect { my ($_menu_item) = @_ } +sub get_right_justified { my ($_menu_item) = @_ } +sub get_submenu { my ($_menu_item) = @_ } +sub new { my ($_class, $_o_label) = @_ } +sub new_with_label { my ($_class, $_o_label) = @_ } +sub new_with_mnemonic { my ($_class, $_o_label) = @_ } +sub remove_submenu { my ($_menu_item) = @_ } +sub select { my ($_menu_item) = @_ } +sub set_accel_path { my ($_menu_item, $_accel_path) = @_ } +sub set_right_justified { my ($_menu_item, $_right_justified) = @_ } +sub set_submenu { my ($_menu_item, $_submenu) = @_ } +sub toggle_size_allocate { my ($_menu_item, $_allocation) = @_ } +sub toggle_size_request { my ($_menu_item) = @_ } + +package Gtk2::MenuShell; +our @ISA = qw(); +sub activate_item { my ($_menu_shell, $_menu_item, $_force_deactivate) = @_ } +sub append { my ($_menu_shell, $_child) = @_ } +sub cancel { my ($_menu_shell) = @_ } +sub deactivate { my ($_menu_shell) = @_ } +sub deselect { my ($_menu_shell) = @_ } +sub get_take_focus { my ($_menu_shell) = @_ } +sub insert { my ($_menu_shell, $_child, $_position) = @_ } +sub prepend { my ($_menu_shell, $_child) = @_ } +sub select_first { my ($_menu_shell, $_search_sensitive) = @_ } +sub select_item { my ($_menu_shell, $_menu_item) = @_ } +sub set_take_focus { my ($_menu_shell, $_take_focus) = @_ } + +package Gtk2::MenuToolButton; +our @ISA = qw(); +sub get_menu { my ($_button) = @_ } +sub new { my ($_class, $_icon_widget, $_label) = @_ } +sub new_from_stock { my ($_class, $_stock_id) = @_ } +sub set_arrow_tooltip { my ($_button, $_tooltips, $_tip_text, $_tip_private) = @_ } +sub set_menu { my ($_button, $_menu) = @_ } + +package Gtk2::MessageDialog; +our @ISA = qw(); +sub format_secondary_markup { my ($_message_dialog, $_message) = @_ } +sub format_secondary_text { my ($_message_dialog, $_message_format, @_more_paras) = @_ } +sub new { my ($_class, $_parent, $_flags, $_type, $_buttons, $_format, @_more_paras) = @_ } +sub new_with_markup { my ($_class, $_parent, $_flags, $_type, $_buttons, $_message) = @_ } +sub set_markup { my ($_message_dialog, $_str) = @_ } + +package Gtk2::Misc; +our @ISA = qw(); +sub get_alignment { my ($_misc) = @_ } +sub get_padding { my ($_misc) = @_ } +sub set_alignment { my ($_misc, $_xalign, $_yalign) = @_ } +sub set_padding { my ($_misc, $_xpad, $_ypad) = @_ } + +package Gtk2::Notebook; +our @ISA = qw(); +sub append_page { my ($_notebook, $_child, $_o_tab_label) = @_ } +sub append_page_menu { my ($_notebook, $_child, $_tab_label, $_menu_label) = @_ } +sub get_current_page { my ($_notebook) = @_ } +sub get_menu_label { my ($_notebook, $_child) = @_ } +sub get_menu_label_text { my ($_notebook, $_child) = @_ } +sub get_n_pages { my ($_notebook) = @_ } +sub get_nth_page { my ($_notebook, $_page_num) = @_ } +sub get_scrollable { my ($_notebook) = @_ } +sub get_show_border { my ($_notebook) = @_ } +sub get_show_tabs { my ($_notebook) = @_ } +sub get_tab_label { my ($_notebook, $_child) = @_ } +sub get_tab_label_text { my ($_notebook, $_child) = @_ } +sub get_tab_pos { my ($_notebook) = @_ } +sub insert_page { my ($_notebook, $_child, $_tab_label, $_position) = @_ } +sub insert_page_menu { my ($_notebook, $_child, $_tab_label, $_menu_label, $_position) = @_ } +sub new { my ($_class) = @_ } +sub next_page { my ($_notebook) = @_ } +sub page_num { my ($_notebook, $_child) = @_ } +sub popup_disable { my ($_notebook) = @_ } +sub popup_enable { my ($_notebook) = @_ } +sub prepend_page { my ($_notebook, $_child, $_o_tab_label) = @_ } +sub prepend_page_menu { my ($_notebook, $_child, $_tab_label, $_menu_label) = @_ } +sub prev_page { my ($_notebook) = @_ } +sub query_tab_label_packing { my ($_notebook, $_child) = @_ } +sub remove_page { my ($_notebook, $_page_num) = @_ } +sub reorder_child { my ($_notebook, $_child, $_position) = @_ } +sub set_current_page { my ($_notebook, $_page_num) = @_ } +sub set_menu_label { my ($_notebook, $_child, $_o_menu_label) = @_ } +sub set_menu_label_text { my ($_notebook, $_child, $_menu_text) = @_ } +sub set_scrollable { my ($_notebook, $_scrollable) = @_ } +sub set_show_border { my ($_notebook, $_show_border) = @_ } +sub set_show_tabs { my ($_notebook, $_show_tabs) = @_ } +sub set_tab_border { my ($_notebook, $_border_width) = @_ } +sub set_tab_hborder { my ($_notebook, $_tab_hborder) = @_ } +sub set_tab_label { my ($_notebook, $_child, $_o_tab_label) = @_ } +sub set_tab_label_packing { my ($_notebook, $_child, $_expand, $_fill, $_pack_type) = @_ } +sub set_tab_label_text { my ($_notebook, $_child, $_tab_text) = @_ } +sub set_tab_pos { my ($_notebook, $_pos) = @_ } +sub set_tab_vborder { my ($_notebook, $_tab_vborder) = @_ } + +package Gtk2::Object; +our @ISA = qw(); +sub destroy { my ($_object) = @_ } +sub new { my ($_class, $_object_class, @_more_paras) = @_ } + +package Gtk2::OptionMenu; +our @ISA = qw(); +sub get_history { my ($_option_menu) = @_ } +sub get_menu { my ($_option_menu) = @_ } +sub new { my ($_class) = @_ } +sub remove_menu { my ($_option_menu) = @_ } +sub set_history { my ($_option_menu, $_index) = @_ } +sub set_menu { my ($_option_menu, $_menu) = @_ } + +package Gtk2::Paned; +our @ISA = qw(); +sub add1 { my ($_paned, $_child) = @_ } +sub add2 { my ($_paned, $_child) = @_ } +sub child1 { my ($_paned) = @_ } +sub child1_resize { my ($_paned, $_o_newval) = @_ } +sub child1_shrink { my ($_paned, $_o_newval) = @_ } +sub child2 { my ($_paned) = @_ } +sub child2_resize { my ($_paned, $_o_newval) = @_ } +sub child2_shrink { my ($_paned, $_o_newval) = @_ } +sub compute_position { my ($_paned, $_allocation, $_child1_req, $_child2_req) = @_ } +sub get_child1 { my ($_paned) = @_ } +sub get_child2 { my ($_paned) = @_ } +sub get_position { my ($_paned) = @_ } +sub pack1 { my ($_paned, $_child, $_resize, $_shrink) = @_ } +sub pack2 { my ($_paned, $_child, $_resize, $_shrink) = @_ } +sub set_position { my ($_paned, $_position) = @_ } + +package Gtk2::Pango; +our @ISA = qw(); +sub CHECK_VERSION { my ($_class, $_major, $_minor, $_micro) = @_ } +sub GET_VERSION_INFO { my ($_class) = @_ } +sub PANGO_PIXELS { my ($_class, $_d) = @_ } +sub find_base_dir { my ($_class, $_text) = @_ } +sub parse_markup { my ($_class, $_markup_text, $_markup_text, $_o_accel_marker) = @_ } +sub pixels { my ($_class, $_d) = @_ } +sub scale { my ($_class) = @_ } +sub scale_large { my ($_class) = @_ } +sub scale_medium { my ($_class) = @_ } +sub scale_small { my ($_class) = @_ } +sub scale_x_large { my ($_class) = @_ } +sub scale_x_small { my ($_class) = @_ } +sub scale_xx_large { my ($_class) = @_ } +sub scale_xx_small { my ($_class) = @_ } + +package Gtk2::Pango::Cairo; +our @ISA = qw(); +sub create_layout { my ($_cr) = @_ } +sub glyph_string_path { my ($_cr, $_font, $_glyphs) = @_ } +sub layout_path { my ($_cr, $_layout) = @_ } +sub show_glyph_string { my ($_cr, $_font, $_glyphs) = @_ } +sub show_layout { my ($_cr, $_layout) = @_ } +sub update_context { my ($_cr, $_context) = @_ } +sub update_layout { my ($_cr, $_layout) = @_ } + +package Gtk2::Pango::Cairo::Context; +our @ISA = qw(); +sub get_font_options { my ($_context) = @_ } +sub get_resolution { my ($_context) = @_ } +sub set_font_options { my ($_context, $_options) = @_ } +sub set_resolution { my ($_context, $_dpi) = @_ } + +package Gtk2::Pango::Cairo::FontMap; +our @ISA = qw(); +sub create_context { my ($_fontmap) = @_ } +sub get_default { my ($_class) = @_ } +sub get_resolution { my ($_fontmap) = @_ } +sub new { my ($_class) = @_ } +sub set_resolution { my ($_fontmap, $_dpi) = @_ } + +package Gtk2::Pango::Context; +our @ISA = qw(); +sub get_base_dir { my ($_context) = @_ } +sub get_font_description { my ($_context) = @_ } +sub get_font_map { my ($_context) = @_ } +sub get_language { my ($_context) = @_ } +sub get_matrix { my ($_context) = @_ } +sub get_metrics { my ($_context, $_desc, $_language) = @_ } +sub list_families { my ($_context) = @_ } +sub load_font { my ($_context, $_desc) = @_ } +sub load_fontset { my ($_context, $_desc, $_language) = @_ } +sub set_base_dir { my ($_context, $_direction) = @_ } +sub set_font_description { my ($_context, $_desc) = @_ } +sub set_language { my ($_context, $_language) = @_ } +sub set_matrix { my ($_context, $_matrix) = @_ } + +package Gtk2::Pango::Font; +our @ISA = qw(); +sub describe { my ($_font) = @_ } +sub get_glyph_extents { my ($_font, $_glyph) = @_ } +sub get_metrics { my ($_font, $_language) = @_ } + +package Gtk2::Pango::FontDescription; +our @ISA = qw(); +sub better_match { my ($_desc, $_old_match, $_new_match) = @_ } +sub equal { my ($_desc1, $_desc2) = @_ } +sub from_string { my ($_class, $_str) = @_ } +sub get_family { my ($_desc) = @_ } +sub get_set_fields { my ($_desc) = @_ } +sub get_size { my ($_desc) = @_ } +sub get_size_is_absolute { my ($_desc) = @_ } +sub get_stretch { my ($_desc) = @_ } +sub get_style { my ($_desc) = @_ } +sub get_variant { my ($_desc) = @_ } +sub get_weight { my ($_desc) = @_ } +sub hash { my ($_desc) = @_ } +sub merge { my ($_desc, $_desc_to_merge, $_replace_existing) = @_ } +sub merge_static { my ($_desc, $_desc_to_merge, $_replace_existing) = @_ } +sub new { my ($_class) = @_ } +sub set_absolute_size { my ($_desc, $_size) = @_ } +sub set_family { my ($_desc, $_family) = @_ } +sub set_family_static { my ($_desc, $_family) = @_ } +sub set_size { my ($_desc, $_size) = @_ } +sub set_stretch { my ($_desc, $_stretch) = @_ } +sub set_style { my ($_desc, $_style) = @_ } +sub set_variant { my ($_desc, $_variant) = @_ } +sub set_weight { my ($_desc, $_weight) = @_ } +sub to_filename { my ($_desc) = @_ } +sub to_string { my ($_desc) = @_ } +sub unset_fields { my ($_desc, $_to_unset) = @_ } + +package Gtk2::Pango::FontFace; +our @ISA = qw(); +sub describe { my ($_face) = @_ } +sub get_face_name { my ($_face) = @_ } +sub list_sizes { my ($_face) = @_ } + +package Gtk2::Pango::FontFamily; +our @ISA = qw(); +sub get_name { my ($_family) = @_ } +sub is_monospace { my ($_family) = @_ } +sub list_faces { my ($_family) = @_ } + +package Gtk2::Pango::FontMap; +our @ISA = qw(); +sub list_families { my ($_fontmap) = @_ } +sub load_font { my ($_fontmap, $_context, $_desc) = @_ } +sub load_fontset { my ($_fontmap, $_context, $_desc, $_language) = @_ } + +package Gtk2::Pango::FontMetrics; +our @ISA = qw(); +sub get_approximate_char_width { my ($_metrics) = @_ } +sub get_approximate_digit_width { my ($_metrics) = @_ } +sub get_ascent { my ($_metrics) = @_ } +sub get_descent { my ($_metrics) = @_ } +sub get_strikethrough_position { my ($_metrics) = @_ } +sub get_strikethrough_thickness { my ($_metrics) = @_ } +sub get_underline_position { my ($_metrics) = @_ } +sub get_underline_thickness { my ($_metrics) = @_ } + +package Gtk2::Pango::Fontset; +our @ISA = qw(); +sub Gtk2::Pango::Fontset::foreach { my ($_fontset, $_func, $_o_data) = @_ } +sub get_font { my ($_fontset, $_wc) = @_ } +sub get_metrics { my ($_fontset) = @_ } + +package Gtk2::Pango::Language; +our @ISA = qw(); +sub from_string { my ($_class, $_language) = @_ } +sub includes_script { my ($_language, $_script) = @_ } +sub matches { my ($_language, $_range_list) = @_ } +sub to_string { my ($_language) = @_ } + +package Gtk2::Pango::Layout; +our @ISA = qw(); +sub context_changed { my ($_layout) = @_ } +sub copy { my ($_src) = @_ } +sub get_alignment { my ($_layout) = @_ } +sub get_attributes { my ($_layout) = @_ } +sub get_auto_dir { my ($_layout) = @_ } +sub get_context { my ($_layout) = @_ } +sub get_cursor_pos { my ($_layout, $_index_) = @_ } +sub get_ellipsize { my ($_layout) = @_ } +sub get_extents { my ($_layout) = @_ } +sub get_font_description { my ($_layout) = @_ } +sub get_indent { my ($_layout) = @_ } +sub get_iter { my ($_layout) = @_ } +sub get_justify { my ($_layout) = @_ } +sub get_line_count { my ($_layout) = @_ } +sub get_log_attrs { my ($_layout) = @_ } +sub get_pixel_extents { my ($_layout) = @_ } +sub get_pixel_size { my ($_layout) = @_ } +sub get_single_paragraph_mode { my ($_layout) = @_ } +sub get_size { my ($_layout) = @_ } +sub get_spacing { my ($_layout) = @_ } +sub get_tabs { my ($_layout) = @_ } +sub get_text { my ($_layout) = @_ } +sub get_width { my ($_layout) = @_ } +sub get_wrap { my ($_layout) = @_ } +sub index_to_pos { my ($_layout, $_index_) = @_ } +sub move_cursor_visually { my ($_layout, $_strong, $_old_index, $_old_trailing, $_direction) = @_ } +sub new { my ($_class, $_context) = @_ } +sub set_alignment { my ($_layout, $_alignment) = @_ } +sub set_attributes { my ($_layout, $_attrs) = @_ } +sub set_auto_dir { my ($_layout, $_auto_dir) = @_ } +sub set_ellipsize { my ($_layout, $_ellipsize) = @_ } +sub set_font_description { my ($_layout, $_desc) = @_ } +sub set_indent { my ($_layout, $_newval) = @_ } +sub set_justify { my ($_layout, $_newval) = @_ } +sub set_markup { my ($_layout, $_markup, $_markup) = @_ } +sub set_markup_with_accel { my ($_layout, $_markup, $_markup, $_accel_marker) = @_ } +sub set_single_paragraph_mode { my ($_layout, $_newval) = @_ } +sub set_spacing { my ($_layout, $_newval) = @_ } +sub set_tabs { my ($_layout, $_tabs) = @_ } +sub set_text { my ($_layout, $_text, $_text) = @_ } +sub set_width { my ($_layout, $_newval) = @_ } +sub set_wrap { my ($_layout, $_wrap) = @_ } +sub xy_to_index { my ($_layout, $_x, $_y) = @_ } + +package Gtk2::Pango::LayoutIter; +our @ISA = qw(); +sub at_last_line { my ($_iter) = @_ } +sub get_baseline { my ($_iter) = @_ } +sub get_char_extents { my ($_iter) = @_ } +sub get_cluster_extents { my ($_iter) = @_ } +sub get_index { my ($_iter) = @_ } +sub get_layout_extents { my ($_iter) = @_ } +sub get_line_extents { my ($_iter) = @_ } +sub get_line_yrange { my ($_iter) = @_ } +sub get_run_extents { my ($_iter) = @_ } +sub next_char { my ($_iter) = @_ } +sub next_cluster { my ($_iter) = @_ } +sub next_line { my ($_iter) = @_ } +sub next_run { my ($_iter) = @_ } + +package Gtk2::Pango::Matrix; +our @ISA = qw(); +sub concat { my ($_matrix, $_new_matrix) = @_ } +sub new { my ($_class, $_o_xx, $_o_xy, $_o_yx, $_o_yy, $_o_x0, $_o_y0) = @_ } +sub rotate { my ($_matrix, $_degrees) = @_ } +sub scale { my ($_matrix, $_scale_x, $_scale_y) = @_ } +sub translate { my ($_matrix, $_tx, $_ty) = @_ } +sub x0 { my ($_matrix, $_o_new) = @_ } +sub xx { my ($_matrix, $_o_new) = @_ } +sub xy { my ($_matrix, $_o_new) = @_ } +sub y0 { my ($_matrix, $_o_new) = @_ } +sub yx { my ($_matrix, $_o_new) = @_ } +sub yy { my ($_matrix, $_o_new) = @_ } + +package Gtk2::Pango::Renderer; +our @ISA = qw(); +sub activate { my ($_renderer) = @_ } +sub deactivate { my ($_renderer) = @_ } +sub draw_error_underline { my ($_renderer, $_x, $_y, $_width, $_height) = @_ } +sub draw_glyph { my ($_renderer, $_font, $_glyph, $_x, $_y) = @_ } +sub draw_layout { my ($_renderer, $_layout, $_x, $_y) = @_ } +sub draw_rectangle { my ($_renderer, $_part, $_x, $_y, $_width, $_height) = @_ } +sub draw_trapezoid { my ($_renderer, $_part, $_y1_, $_x11, $_x21, $_y2, $_x12, $_x22) = @_ } +sub get_matrix { my ($_renderer) = @_ } +sub part_changed { my ($_renderer, $_part) = @_ } +sub set_matrix { my ($_renderer, $_matrix) = @_ } + +package Gtk2::Pango::Script; +our @ISA = qw(); +sub for_unichar { my ($_class, $_ch) = @_ } +sub get_sample_language { my ($_class, $_script) = @_ } + +package Gtk2::Pango::ScriptIter; +our @ISA = qw(); +sub get_range { my ($_iter) = @_ } +sub new { my ($_class, $_text) = @_ } +sub next { my ($_iter) = @_ } + +package Gtk2::Pango::TabArray; +our @ISA = qw(); +sub get_positions_in_pixels { my ($_tab_array) = @_ } +sub get_size { my ($_tab_array) = @_ } +sub get_tab { my ($_tab_array, $_tab_index) = @_ } +sub get_tabs { my ($_tab_array) = @_ } +sub new { my ($_class, $_initial_size, $_positions_in_pixels, @_more_paras) = @_ } +sub new_with_positions { my ($_class, $_initial_size, $_positions_in_pixels, @_more_paras) = @_ } +sub resize { my ($_tab_array, $_new_size) = @_ } +sub set_tab { my ($_tab_array, $_tab_index, $_alignment, $_location) = @_ } + +package Gtk2::Plug; +our @ISA = qw(); +sub construct { my ($_plug, $_socket_id) = @_ } +sub construct_for_display { my ($_plug, $_display, $_socket_id) = @_ } +sub get_id { my ($_plug) = @_ } +sub new { my ($_class, $_socket_id) = @_ } +sub new_for_display { my ($_display, $_socket_id) = @_ } + +package Gtk2::ProgressBar; +our @ISA = qw(); +sub get_ellipsize { my ($_pbar) = @_ } +sub get_fraction { my ($_pbar) = @_ } +sub get_orientation { my ($_pbar) = @_ } +sub get_pulse_step { my ($_pbar) = @_ } +sub get_text { my ($_pbar) = @_ } +sub new { my ($_class) = @_ } +sub pulse { my ($_pbar) = @_ } +sub set_ellipsize { my ($_pbar, $_mode) = @_ } +sub set_fraction { my ($_pbar, $_fraction) = @_ } +sub set_orientation { my ($_pbar, $_orientation) = @_ } +sub set_pulse_step { my ($_pbar, $_fraction) = @_ } +sub set_text { my ($_pbar, $_text) = @_ } + +package Gtk2::RadioAction; +our @ISA = qw(); +sub get_current_value { my ($_action) = @_ } +sub get_group { my ($_action) = @_ } +sub set_group { my ($_action, $_member_or_listref) = @_ } + +package Gtk2::RadioButton; +our @ISA = qw(); +sub get_group { my ($_radio_button) = @_ } +sub new { my ($_class, $_o_member_or_listref, $_o_label) = @_ } +sub new_from_widget { my ($_class, $_group, $_o_label) = @_ } +sub new_with_label { my ($_class, $_o_member_or_listref, $_o_label) = @_ } +sub new_with_label_from_widget { my ($_class, $_group, $_o_label) = @_ } +sub new_with_mnemonic { my ($_class, $_o_member_or_listref, $_o_label) = @_ } +sub new_with_mnemonic_from_widget { my ($_class, $_group, $_o_label) = @_ } +sub set_group { my ($_radio_button, $_member_or_listref) = @_ } + +package Gtk2::RadioMenuItem; +our @ISA = qw(); +sub get_group { my ($_radio_menu_item) = @_ } +sub new { my ($_class, $_o_member_or_listref, $_o_label) = @_ } +sub new_from_widget { my ($_class, $_group, $_o_label) = @_ } +sub new_with_label { my ($_class, $_o_member_or_listref, $_o_label) = @_ } +sub new_with_label_from_widget { my ($_class, $_group, $_o_label) = @_ } +sub new_with_mnemonic { my ($_class, $_o_member_or_listref, $_o_label) = @_ } +sub new_with_mnemonic_from_widget { my ($_class, $_group, $_o_label) = @_ } +sub set_group { my ($_radio_menu_item, $_member_or_listref) = @_ } + +package Gtk2::RadioToolButton; +our @ISA = qw(); +sub get_group { my ($_button) = @_ } +sub new { my ($_class, $_o_member_or_listref) = @_ } +sub new_from_stock { my ($_class, $_member_or_listref, $_stock_id) = @_ } +sub new_from_widget { my ($_class, $_group) = @_ } +sub new_with_stock_from_widget { my ($_class, $_group, $_stock_id) = @_ } +sub set_group { my ($_button, $_member_or_listref) = @_ } + +package Gtk2::Range; +our @ISA = qw(); +sub get_adjustment { my ($_range) = @_ } +sub get_inverted { my ($_range) = @_ } +sub get_update_policy { my ($_range) = @_ } +sub get_value { my ($_range) = @_ } +sub set_adjustment { my ($_range, $_adjustment) = @_ } +sub set_increments { my ($_range, $_step, $_page) = @_ } +sub set_inverted { my ($_range, $_setting) = @_ } +sub set_range { my ($_range, $_min, $_max) = @_ } +sub set_update_policy { my ($_range, $_policy) = @_ } +sub set_value { my ($_range, $_value) = @_ } + +package Gtk2::Rc; +our @ISA = qw(); +sub add_default_file { my ($_class, $_filename) = @_ } +sub get_default_files { my ($_class) = @_ } +sub get_im_module_file { my ($_class) = @_ } +sub get_im_module_path { my ($_class) = @_ } +sub get_module_dir { my ($_class) = @_ } +sub get_style { my ($_class, $_widget) = @_ } +sub get_style_by_paths { my ($_class, $_settings, $_widget_path, $_class_path, $_package) = @_ } +sub get_theme_dir { my ($_class) = @_ } +sub parse { my ($_class, $_filename) = @_ } +sub parse_string { my ($_class, $_rc_string) = @_ } +sub reparse_all { my ($_class) = @_ } +sub reparse_all_for_settings { my ($_class, $_settings, $_force_load) = @_ } +sub reset_styles { my ($_class, $_settings) = @_ } +sub set_default_files { my ($_class, @_more_paras) = @_ } + +package Gtk2::RcStyle; +our @ISA = qw(); +sub base { my ($_style, $_state, $_o_new) = @_ } +sub bg { my ($_style, $_state, $_o_new) = @_ } +sub bg_pixmap_name { my ($_style, $_state, $_o_new) = @_ } +sub color_flags { my ($_style, $_state, $_o_new) = @_ } +sub copy { my ($_orig) = @_ } +sub fg { my ($_style, $_state, $_o_new) = @_ } +sub font_desc { my ($_style, $_o_new) = @_ } +sub name { my ($_style, $_o_new) = @_ } +sub new { my ($_class) = @_ } +sub text { my ($_style, $_state, $_o_new) = @_ } +sub xthickness { my ($_style, $_o_new) = @_ } +sub ythickness { my ($_style, $_o_new) = @_ } + +package Gtk2::Requisition; +our @ISA = qw(); +sub height { my ($_requisition, $_o_newval) = @_ } +sub new { my ($_class, $_o_width, $_o_height) = @_ } +sub width { my ($_requisition, $_o_newval) = @_ } + +package Gtk2::Ruler; +our @ISA = qw(); +sub draw_pos { my ($_ruler) = @_ } +sub draw_ticks { my ($_ruler) = @_ } +sub get_metric { my ($_ruler) = @_ } +sub get_range { my ($_ruler) = @_ } +sub set_metric { my ($_ruler, $_metric) = @_ } +sub set_range { my ($_ruler, $_lower, $_upper, $_position, $_max_size) = @_ } + +package Gtk2::Scale; +our @ISA = qw(); +sub get_digits { my ($_scale) = @_ } +sub get_draw_value { my ($_scale) = @_ } +sub get_layout { my ($_scale) = @_ } +sub get_layout_offsets { my ($_scale) = @_ } +sub get_value_pos { my ($_scale) = @_ } +sub set_digits { my ($_scale, $_digits) = @_ } +sub set_draw_value { my ($_scale, $_draw_value) = @_ } +sub set_value_pos { my ($_scale, $_pos) = @_ } + +package Gtk2::ScrolledWindow; +our @ISA = qw(); +sub add_with_viewport { my ($_scrolled_window, $_child) = @_ } +sub get_hadjustment { my ($_scrolled_window) = @_ } +sub get_hscrollbar { my ($_scrolled_window) = @_ } +sub get_placement { my ($_scrolled_window) = @_ } +sub get_policy { my ($_scrolled_window) = @_ } +sub get_shadow_type { my ($_scrolled_window) = @_ } +sub get_vadjustment { my ($_scrolled_window) = @_ } +sub get_vscrollbar { my ($_scrolled_window) = @_ } +sub new { my ($_class, $_o_hadjustment, $_o_vadjustment) = @_ } +sub set_hadjustment { my ($_scrolled_window, $_hadjustment) = @_ } +sub set_placement { my ($_scrolled_window, $_window_placement) = @_ } +sub set_policy { my ($_scrolled_window, $_hscrollbar_policy, $_vscrollbar_policy) = @_ } +sub set_shadow_type { my ($_scrolled_window, $_type) = @_ } +sub set_vadjustment { my ($_scrolled_window, $_hadjustment) = @_ } + +package Gtk2::Selection; +our @ISA = qw(); +sub owner_set { my ($_class, $_widget, $_selection, $_time_) = @_ } +sub owner_set_for_display { my ($_class, $_display, $_widget, $_selection, $_time_) = @_ } + +package Gtk2::SelectionData; +our @ISA = qw(); +sub data { my ($_d) = @_ } +sub display { my ($_d) = @_ } +sub Gtk2::SelectionData::format { my ($_d) = @_ } +sub get_pixbuf { my ($_selection_data) = @_ } +sub get_row_drag_data { my ($_selection_data) = @_ } +sub get_targets { my ($_selection_data) = @_ } +sub get_text { my ($_selection_data) = @_ } +sub get_uris { my ($_selection_data) = @_ } +sub gtk_selection_clear { my ($_widget, $_event) = @_ } +sub Gtk2::SelectionData::length { my ($_d) = @_ } +sub selection { my ($_d) = @_ } +sub set { my ($_selection_data, $_type, $_format, $_data) = @_ } +sub set_pixbuf { my ($_selection_data, $_pixbuf) = @_ } +sub set_row_drag_data { my ($_selection_data, $_tree_model, $_path) = @_ } +sub set_text { my ($_selection_data, $_str, $_o_len) = @_ } +sub set_uris { my ($_selection_data, @_more_paras) = @_ } +sub target { my ($_d) = @_ } +sub targets_include_image { my ($_selection_data, $_writable) = @_ } +sub targets_include_text { my ($_selection_data) = @_ } +sub type { my ($_d) = @_ } + +package Gtk2::SeparatorMenuItem; +our @ISA = qw(); +sub new { my ($_class) = @_ } + +package Gtk2::SeparatorToolItem; +our @ISA = qw(); +sub get_draw { my ($_item) = @_ } +sub new { my ($_class) = @_ } +sub set_draw { my ($_tool_item, $_draw) = @_ } + +package Gtk2::SizeGroup; +our @ISA = qw(); +sub add_widget { my ($_size_group, $_widget) = @_ } +sub get_ignore_hidden { my ($_size_group) = @_ } +sub get_mode { my ($_size_group) = @_ } +sub new { my ($_class, $_mode) = @_ } +sub remove_widget { my ($_size_group, $_widget) = @_ } +sub set_ignore_hidden { my ($_size_group, $_ignore_hidden) = @_ } +sub set_mode { my ($_size_group, $_mode) = @_ } + +package Gtk2::Socket; +our @ISA = qw(); +sub add_id { my ($_socket, $_window_id) = @_ } +sub get_id { my ($_socket) = @_ } +sub new { my ($_class) = @_ } +sub steal { my ($_socket, $_wid) = @_ } + +package Gtk2::SpinButton; +our @ISA = qw(); +sub configure { my ($_spin_button, $_adjustment, $_climb_rate, $_digits) = @_ } +sub get_adjustment { my ($_spin_button) = @_ } +sub get_digits { my ($_spin_button) = @_ } +sub get_increments { my ($_spin_button) = @_ } +sub get_numeric { my ($_spin_button) = @_ } +sub get_range { my ($_spin_button) = @_ } +sub get_snap_to_ticks { my ($_spin_button) = @_ } +sub get_update_policy { my ($_spin_button) = @_ } +sub get_value { my ($_spin_button) = @_ } +sub get_value_as_int { my ($_spin_button) = @_ } +sub get_wrap { my ($_spin_button) = @_ } +sub new { my ($_class, $_adjustment, $_climb_rate, $_digits) = @_ } +sub new_with_range { my ($_class, $_min, $_max, $_step) = @_ } +sub set_adjustment { my ($_spin_button, $_adjustment) = @_ } +sub set_digits { my ($_spin_button, $_digits) = @_ } +sub set_increments { my ($_spin_button, $_step, $_page) = @_ } +sub set_numeric { my ($_spin_button, $_numeric) = @_ } +sub set_range { my ($_spin_button, $_min, $_max) = @_ } +sub set_snap_to_ticks { my ($_spin_button, $_snap_to_ticks) = @_ } +sub set_update_policy { my ($_spin_button, $_policy) = @_ } +sub set_value { my ($_spin_button, $_value) = @_ } +sub set_wrap { my ($_spin_button, $_wrap) = @_ } +sub spin { my ($_spin_button, $_direction, $_increment) = @_ } +sub update { my ($_spin_button) = @_ } + +package Gtk2::Statusbar; +our @ISA = qw(); +sub get_context_id { my ($_statusbar, $_context_description) = @_ } +sub get_has_resize_grip { my ($_statusbar) = @_ } +sub new { my ($_class) = @_ } +sub pop { my ($_statusbar, $_context_id) = @_ } +sub push { my ($_statusbar, $_context_id, $_text) = @_ } +sub remove { my ($_statusbar, $_context_id, $_message_id) = @_ } +sub set_has_resize_grip { my ($_statusbar, $_setting) = @_ } + +package Gtk2::Stock; +our @ISA = qw(); +sub add { my ($_class, @_more_paras) = @_ } +sub list_ids { my ($_class) = @_ } +sub lookup { my ($_class, $_stock_id) = @_ } +sub set_translate_func { my ($_class, $_domain, $_func, $_o_data) = @_ } + +package Gtk2::Style; +our @ISA = qw(); +sub apply_default_background { my ($_style, $_window, $_set_bg, $_state_type, $_area, $_x, $_y, $_width, $_height) = @_ } +sub attach { my ($_style, $_window) = @_ } +sub attached { my ($_style) = @_ } +sub base { my ($_style, $_state) = @_ } +sub base_gc { my ($_style, $_state) = @_ } +sub bg { my ($_style, $_state) = @_ } +sub bg_gc { my ($_style, $_state) = @_ } +sub bg_pixmap { my ($_style, $_state, $_o_pixmap) = @_ } +sub black { my ($_style) = @_ } +sub black_gc { my ($_style) = @_ } +sub copy { my ($_style) = @_ } +sub dark { my ($_style, $_state) = @_ } +sub dark_gc { my ($_style, $_state) = @_ } +sub detach { my ($_style) = @_ } +sub fg { my ($_style, $_state) = @_ } +sub fg_gc { my ($_style, $_state) = @_ } +sub font_desc { my ($_style) = @_ } +sub light { my ($_style, $_state) = @_ } +sub light_gc { my ($_style, $_state) = @_ } +sub lookup_icon_set { my ($_style, $_stock_id) = @_ } +sub mid { my ($_style, $_state) = @_ } +sub mid_gc { my ($_style, $_state) = @_ } +sub new { my ($_class) = @_ } +sub paint_arrow { my ($_style, $_window, $_state_type, $_shadow_type, $_area, $_widget, $_detail, $_arrow_type, $_fill, $_x, $_y, $_width, $_height) = @_ } +sub paint_box { my ($_style, $_window, $_state_type, $_shadow_type, $_area, $_widget, $_detail, $_x, $_y, $_width, $_height) = @_ } +sub paint_box_gap { my ($_style, $_window, $_state_type, $_shadow_type, $_area, $_widget, $_detail, $_x, $_y, $_width, $_height, $_gap_side, $_gap_x, $_gap_width) = @_ } +sub paint_check { my ($_style, $_window, $_state_type, $_shadow_type, $_area, $_widget, $_detail, $_x, $_y, $_width, $_height) = @_ } +sub paint_diamond { my ($_style, $_window, $_state_type, $_shadow_type, $_area, $_widget, $_detail, $_x, $_y, $_width, $_height) = @_ } +sub paint_expander { my ($_style, $_window, $_state_type, $_area, $_widget, $_detail, $_x, $_y, $_expander_style) = @_ } +sub paint_extension { my ($_style, $_window, $_state_type, $_shadow_type, $_area, $_widget, $_detail, $_x, $_y, $_width, $_height, $_gap_side) = @_ } +sub paint_flat_box { my ($_style, $_window, $_state_type, $_shadow_type, $_area, $_widget, $_detail, $_x, $_y, $_width, $_height) = @_ } +sub paint_focus { my ($_style, $_window, $_state_type, $_area, $_widget, $_detail, $_x, $_y, $_width, $_height) = @_ } +sub paint_handle { my ($_style, $_window, $_state_type, $_shadow_type, $_area, $_widget, $_detail, $_x, $_y, $_width, $_height, $_orientation) = @_ } +sub paint_hline { my ($_style, $_window, $_state_type, $_area, $_widget, $_detail, $_x1, $_x2, $_y) = @_ } +sub paint_layout { my ($_style, $_window, $_state_type, $_use_text, $_area, $_widget, $_detail, $_x, $_y, $_layout) = @_ } +sub paint_option { my ($_style, $_window, $_state_type, $_shadow_type, $_area, $_widget, $_detail, $_x, $_y, $_width, $_height) = @_ } +sub paint_polygon { my ($_style, $_window, $_state_type, $_shadow_type, $_area, $_widget, $_detail, $_fill, $_x1, $_y1, @_more_paras) = @_ } +sub paint_resize_grip { my ($_style, $_window, $_state_type, $_area, $_widget, $_detail, $_edge, $_x, $_y, $_width, $_height) = @_ } +sub paint_shadow { my ($_style, $_window, $_state_type, $_shadow_type, $_area, $_widget, $_detail, $_x, $_y, $_width, $_height) = @_ } +sub paint_shadow_gap { my ($_style, $_window, $_state_type, $_shadow_type, $_area, $_widget, $_detail, $_x, $_y, $_width, $_height, $_gap_side, $_gap_x, $_gap_width) = @_ } +sub paint_slider { my ($_style, $_window, $_state_type, $_shadow_type, $_area, $_widget, $_detail, $_x, $_y, $_width, $_height, $_orientation) = @_ } +sub paint_tab { my ($_style, $_window, $_state_type, $_shadow_type, $_area, $_widget, $_detail, $_x, $_y, $_width, $_height) = @_ } +sub paint_vline { my ($_style, $_window, $_state_type, $_area, $_widget, $_detail, $_y1_, $_y2_, $_x) = @_ } +sub render_icon { my ($_style, $_source, $_direction, $_state, $_size, $_widget, $_o_detail) = @_ } +sub set_background { my ($_style, $_window, $_state_type) = @_ } +sub text { my ($_style, $_state) = @_ } +sub text_aa { my ($_style, $_state) = @_ } +sub text_aa_gc { my ($_style, $_state) = @_ } +sub text_gc { my ($_style, $_state) = @_ } +sub white { my ($_style) = @_ } +sub white_gc { my ($_style) = @_ } +sub xthickness { my ($_style) = @_ } +sub ythickness { my ($_style) = @_ } + +package Gtk2::Table; +our @ISA = qw(); +sub attach { my ($_table, $_child, $_left_attach, $_right_attach, $_top_attach, $_bottom_attach, $_xoptions, $_yoptions, $_xpadding, $_ypadding) = @_ } +sub attach_defaults { my ($_table, $_widget, $_left_attach, $_right_attach, $_top_attach, $_bottom_attach) = @_ } +sub get_col_spacing { my ($_table, $_column) = @_ } +sub get_default_col_spacing { my ($_table) = @_ } +sub get_default_row_spacing { my ($_table) = @_ } +sub get_homogeneous { my ($_table) = @_ } +sub get_row_spacing { my ($_table, $_row) = @_ } +sub new { my ($_class, $_rows, $_columns, $_o_homogeneous) = @_ } +sub resize { my ($_table, $_rows, $_columns) = @_ } +sub set_col_spacing { my ($_table, $_column, $_spacing) = @_ } +sub set_col_spacings { my ($_table, $_spacing) = @_ } +sub set_homogeneous { my ($_table, $_homogeneous) = @_ } +sub set_row_spacing { my ($_table, $_row, $_spacing) = @_ } +sub set_row_spacings { my ($_table, $_spacing) = @_ } + +package Gtk2::TargetList; +our @ISA = qw(); +sub DESTROY { my ($_list) = @_ } +sub add { my ($_list, $_target, $_flags, $_info) = @_ } +sub add_image_targets { my ($_list, $_info, $_writable) = @_ } +sub add_table { my ($_list, @_more_paras) = @_ } +sub add_text_targets { my ($_list, $_info) = @_ } +sub add_uri_targets { my ($_list, $_info) = @_ } +sub find { my ($_list, $_target) = @_ } +sub new { my ($_class, @_more_paras) = @_ } +sub remove { my ($_list, $_target) = @_ } + +package Gtk2::TearoffMenuItem; +our @ISA = qw(); +sub new { my ($_class) = @_ } + +package Gtk2::TextAttributes; +our @ISA = qw(); +sub copy_values { my ($_dest, $_src) = @_ } +sub new { my ($_class) = @_ } + +package Gtk2::TextBuffer; +our @ISA = qw(); +sub add_selection_clipboard { my ($_buffer, $_clipboard) = @_ } +sub apply_tag { my ($_buffer, $_tag, $_start, $_end) = @_ } +sub apply_tag_by_name { my ($_buffer, $_name, $_start, $_end) = @_ } +sub backspace { my ($_buffer, $_iter, $_interactive, $_default_editable) = @_ } +sub begin_user_action { my ($_buffer) = @_ } +sub copy_clipboard { my ($_buffer, $_clipboard) = @_ } +sub create_child_anchor { my ($_buffer, $_iter) = @_ } +sub create_mark { my ($_buffer, $_mark_name, $_where, $_left_gravity) = @_ } +sub create_tag { my ($_buffer, $_tag_name, $_property_name1, $_property_value1, @_more_paras) = @_ } +sub cut_clipboard { my ($_buffer, $_clipboard, $_default_editable) = @_ } +sub delete { my ($_buffer, $_start, $_end) = @_ } +sub delete_interactive { my ($_buffer, $_start_iter, $_end_iter, $_default_editable) = @_ } +sub delete_mark { my ($_buffer, $_mark) = @_ } +sub delete_mark_by_name { my ($_buffer, $_name) = @_ } +sub delete_selection { my ($_buffer, $_interactive, $_default_editable) = @_ } +sub end_user_action { my ($_buffer) = @_ } +sub get_bounds { my ($_buffer) = @_ } +sub get_char_count { my ($_buffer) = @_ } +sub get_end_iter { my ($_buffer) = @_ } +sub get_insert { my ($_buffer) = @_ } +sub get_iter_at_child_anchor { my ($_buffer, $_anchor) = @_ } +sub get_iter_at_line { my ($_buffer, $_line_number) = @_ } +sub get_iter_at_line_index { my ($_buffer, $_line_number, $_byte_index) = @_ } +sub get_iter_at_line_offset { my ($_buffer, $_line_number, $_char_offset) = @_ } +sub get_iter_at_mark { my ($_buffer, $_mark) = @_ } +sub get_iter_at_offset { my ($_buffer, $_char_offset) = @_ } +sub get_line_count { my ($_buffer) = @_ } +sub get_mark { my ($_buffer, $_name) = @_ } +sub get_modified { my ($_buffer) = @_ } +sub get_selection_bound { my ($_buffer) = @_ } +sub get_selection_bounds { my ($_buffer) = @_ } +sub get_slice { my ($_buffer, $_start, $_end, $_include_hidden_chars) = @_ } +sub get_start_iter { my ($_buffer) = @_ } +sub get_tag_table { my ($_buffer) = @_ } +sub get_text { my ($_buffer, $_start, $_end, $_include_hidden_chars) = @_ } +sub insert { my ($_buffer, $_iter, $_text, $_text) = @_ } +sub insert_at_cursor { my ($_buffer, $_text, $_text) = @_ } +sub insert_child_anchor { my ($_buffer, $_iter, $_anchor) = @_ } +sub insert_interactive { my ($_buffer, $_iter, $_text, $_text, $_default_editable) = @_ } +sub insert_interactive_at_cursor { my ($_buffer, $_text, $_text, $_default_editable) = @_ } +sub insert_pixbuf { my ($_buffer, $_iter, $_pixbuf) = @_ } +sub insert_range { my ($_buffer, $_iter, $_start, $_end) = @_ } +sub insert_range_interactive { my ($_buffer, $_iter, $_start, $_end, $_default_editable) = @_ } +sub insert_with_tags { my ($_buffer, $_iter, $_text, @_more_paras) = @_ } +sub insert_with_tags_by_name { my ($_buffer, $_iter, $_text, @_more_paras) = @_ } +sub move_mark { my ($_buffer, $_mark, $_where) = @_ } +sub move_mark_by_name { my ($_buffer, $_name, $_where) = @_ } +sub new { my ($_class, $_o_tagtable) = @_ } +sub paste_clipboard { my ($_buffer, $_clipboard, $_override_location, $_default_editable) = @_ } +sub place_cursor { my ($_buffer, $_where) = @_ } +sub remove_all_tags { my ($_buffer, $_start, $_end) = @_ } +sub remove_selection_clipboard { my ($_buffer, $_clipboard) = @_ } +sub remove_tag { my ($_buffer, $_tag, $_start, $_end) = @_ } +sub remove_tag_by_name { my ($_buffer, $_name, $_start, $_end) = @_ } +sub select_range { my ($_buffer, $_ins, $_bound) = @_ } +sub set_modified { my ($_buffer, $_setting) = @_ } +sub set_text { my ($_buffer, $_text, $_text) = @_ } + +package Gtk2::TextChildAnchor; +our @ISA = qw(); +sub get_deleted { my ($_anchor) = @_ } +sub get_widgets { my ($_anchor) = @_ } +sub new { my ($_class) = @_ } + +package Gtk2::TextIter; +our @ISA = qw(); +sub backward_char { my ($_iter) = @_ } +sub backward_chars { my ($_iter, $_count) = @_ } +sub backward_cursor_position { my ($_iter) = @_ } +sub backward_cursor_positions { my ($_iter, $_count) = @_ } +sub backward_find_char { my ($_iter, $_pred, $_o_user_data, $_o_limit) = @_ } +sub backward_line { my ($_iter) = @_ } +sub backward_lines { my ($_iter, $_count) = @_ } +sub backward_search { my ($_iter, $_str, $_flags, $_o_limit) = @_ } +sub backward_sentence_start { my ($_iter) = @_ } +sub backward_sentence_starts { my ($_iter, $_count) = @_ } +sub backward_to_tag_toggle { my ($_iter, $_tag) = @_ } +sub backward_visible_cursor_position { my ($_iter) = @_ } +sub backward_visible_cursor_positions { my ($_iter, $_count) = @_ } +sub backward_visible_line { my ($_iter) = @_ } +sub backward_visible_lines { my ($_iter, $_count) = @_ } +sub backward_visible_word_start { my ($_iter) = @_ } +sub backward_visible_word_starts { my ($_iter, $_count) = @_ } +sub backward_word_start { my ($_iter) = @_ } +sub backward_word_starts { my ($_iter, $_count) = @_ } +sub begins_tag { my ($_iter, $_tag) = @_ } +sub can_insert { my ($_iter, $_default_editability) = @_ } +sub compare { my ($_lhs, $_rhs) = @_ } +sub editable { my ($_iter, $_default_setting) = @_ } +sub ends_line { my ($_iter) = @_ } +sub ends_sentence { my ($_iter) = @_ } +sub ends_tag { my ($_iter, $_tag) = @_ } +sub ends_word { my ($_iter) = @_ } +sub equal { my ($_lhs, $_rhs) = @_ } +sub forward_char { my ($_iter) = @_ } +sub forward_chars { my ($_iter, $_count) = @_ } +sub forward_cursor_position { my ($_iter) = @_ } +sub forward_cursor_positions { my ($_iter, $_count) = @_ } +sub forward_find_char { my ($_iter, $_pred, $_o_user_data, $_o_limit) = @_ } +sub forward_line { my ($_iter) = @_ } +sub forward_lines { my ($_iter, $_count) = @_ } +sub forward_search { my ($_iter, $_str, $_flags, $_o_limit) = @_ } +sub forward_sentence_end { my ($_iter) = @_ } +sub forward_sentence_ends { my ($_iter, $_count) = @_ } +sub forward_to_end { my ($_iter) = @_ } +sub forward_to_line_end { my ($_iter) = @_ } +sub forward_to_tag_toggle { my ($_iter, $_tag) = @_ } +sub forward_visible_cursor_position { my ($_iter) = @_ } +sub forward_visible_cursor_positions { my ($_iter, $_count) = @_ } +sub forward_visible_line { my ($_iter) = @_ } +sub forward_visible_lines { my ($_iter, $_count) = @_ } +sub forward_visible_word_end { my ($_iter) = @_ } +sub forward_visible_word_ends { my ($_iter, $_count) = @_ } +sub forward_word_end { my ($_iter) = @_ } +sub forward_word_ends { my ($_iter, $_count) = @_ } +sub get_attributes { my ($_iter) = @_ } +sub get_buffer { my ($_iter) = @_ } +sub get_bytes_in_line { my ($_iter) = @_ } +sub get_char { my ($_iter) = @_ } +sub get_chars_in_line { my ($_iter) = @_ } +sub get_child_anchor { my ($_iter) = @_ } +sub get_language { my ($_iter) = @_ } +sub get_line { my ($_iter) = @_ } +sub get_line_index { my ($_iter) = @_ } +sub get_line_offset { my ($_iter) = @_ } +sub get_marks { my ($_iter) = @_ } +sub get_offset { my ($_iter) = @_ } +sub get_pixbuf { my ($_iter) = @_ } +sub get_slice { my ($_start, $_end) = @_ } +sub get_tags { my ($_iter) = @_ } +sub get_text { my ($_start, $_end) = @_ } +sub get_toggled_tags { my ($_iter, $_toggled_on) = @_ } +sub get_visible_line_index { my ($_iter) = @_ } +sub get_visible_line_offset { my ($_iter) = @_ } +sub get_visible_slice { my ($_start, $_end) = @_ } +sub get_visible_text { my ($_start, $_end) = @_ } +sub has_tag { my ($_iter, $_tag) = @_ } +sub in_range { my ($_iter, $_start, $_end) = @_ } +sub inside_sentence { my ($_iter) = @_ } +sub inside_word { my ($_iter) = @_ } +sub is_cursor_position { my ($_iter) = @_ } +sub is_end { my ($_iter) = @_ } +sub is_start { my ($_iter) = @_ } +sub order { my ($_first, $_second) = @_ } +sub set_line { my ($_iter, $_line_number) = @_ } +sub set_line_index { my ($_iter, $_byte_on_line) = @_ } +sub set_line_offset { my ($_iter, $_char_on_line) = @_ } +sub set_offset { my ($_iter, $_char_offset) = @_ } +sub set_visible_line_index { my ($_iter, $_byte_on_line) = @_ } +sub set_visible_line_offset { my ($_iter, $_char_on_line) = @_ } +sub starts_line { my ($_iter) = @_ } +sub starts_sentence { my ($_iter) = @_ } +sub starts_word { my ($_iter) = @_ } +sub toggles_tag { my ($_iter, $_tag) = @_ } + +package Gtk2::TextMark; +our @ISA = qw(); +sub get_buffer { my ($_mark) = @_ } +sub get_deleted { my ($_mark) = @_ } +sub get_left_gravity { my ($_mark) = @_ } +sub get_name { my ($_mark) = @_ } +sub get_visible { my ($_mark) = @_ } +sub set_visible { my ($_mark, $_setting) = @_ } + +package Gtk2::TextTag; +our @ISA = qw(); +sub event { my ($_tag, $_event_object, $_event, $_iter) = @_ } +sub get_priority { my ($_tag) = @_ } +sub new { my ($_class, $_o_name) = @_ } +sub set_priority { my ($_tag, $_priority) = @_ } + +package Gtk2::TextTagTable; +our @ISA = qw(); +sub add { my ($_table, $_tag) = @_ } +sub Gtk2::TextTagTable::foreach { my ($_table, $_callback, $_o_callback_data) = @_ } +sub get_size { my ($_table) = @_ } +sub lookup { my ($_table, $_name) = @_ } +sub new { my ($_class) = @_ } +sub remove { my ($_table, $_tag) = @_ } + +package Gtk2::TextView; +our @ISA = qw(); +sub add_child_at_anchor { my ($_text_view, $_child, $_anchor) = @_ } +sub add_child_in_window { my ($_text_view, $_child, $_which_window, $_xpos, $_ypos) = @_ } +sub backward_display_line { my ($_text_view, $_iter) = @_ } +sub backward_display_line_start { my ($_text_view, $_iter) = @_ } +sub buffer_to_window_coords { my ($_text_view, $_win, $_buffer_x, $_buffer_y) = @_ } +sub forward_display_line { my ($_text_view, $_iter) = @_ } +sub forward_display_line_end { my ($_text_view, $_iter) = @_ } +sub get_accepts_tab { my ($_text_view) = @_ } +sub get_border_window_size { my ($_text_view, $_type) = @_ } +sub get_buffer { my ($_text_view) = @_ } +sub get_cursor_visible { my ($_text_view) = @_ } +sub get_default_attributes { my ($_text_view) = @_ } +sub get_editable { my ($_text_view) = @_ } +sub get_indent { my ($_text_view) = @_ } +sub get_iter_at_location { my ($_text_view, $_x, $_y) = @_ } +sub get_iter_at_position { my ($_text_view, $_x, $_y) = @_ } +sub get_iter_location { my ($_text_view, $_iter) = @_ } +sub get_justification { my ($_text_view) = @_ } +sub get_left_margin { my ($_text_view) = @_ } +sub get_line_at_y { my ($_text_view, $_y) = @_ } +sub get_line_yrange { my ($_text_view, $_iter) = @_ } +sub get_overwrite { my ($_text_view) = @_ } +sub get_pixels_above_lines { my ($_text_view) = @_ } +sub get_pixels_below_lines { my ($_text_view) = @_ } +sub get_pixels_inside_wrap { my ($_text_view) = @_ } +sub get_right_margin { my ($_text_view) = @_ } +sub get_tabs { my ($_text_view) = @_ } +sub get_visible_rect { my ($_text_view) = @_ } +sub get_window { my ($_text_view, $_win) = @_ } +sub get_window_type { my ($_text_view, $_window) = @_ } +sub get_wrap_mode { my ($_text_view) = @_ } +sub move_child { my ($_text_view, $_child, $_xpos, $_ypos) = @_ } +sub move_mark_onscreen { my ($_text_view, $_mark) = @_ } +sub move_visually { my ($_text_view, $_iter, $_count) = @_ } +sub new { my ($_class) = @_ } +sub new_with_buffer { my ($_class, $_buffer) = @_ } +sub place_cursor_onscreen { my ($_text_view) = @_ } +sub scroll_mark_onscreen { my ($_text_view, $_mark) = @_ } +sub scroll_to_iter { my ($_text_view, $_iter, $_within_margin, $_use_align, $_xalign, $_yalign) = @_ } +sub scroll_to_mark { my ($_text_view, $_mark, $_within_margin, $_use_align, $_xalign, $_yalign) = @_ } +sub set_accepts_tab { my ($_text_view, $_accepts_tab) = @_ } +sub set_border_window_size { my ($_text_view, $_type, $_size) = @_ } +sub set_buffer { my ($_text_view, $_buffer) = @_ } +sub set_cursor_visible { my ($_text_view, $_setting) = @_ } +sub set_editable { my ($_text_view, $_setting) = @_ } +sub set_indent { my ($_text_view, $_indent) = @_ } +sub set_justification { my ($_text_view, $_justification) = @_ } +sub set_left_margin { my ($_text_view, $_left_margin) = @_ } +sub set_overwrite { my ($_text_view, $_overwrite) = @_ } +sub set_pixels_above_lines { my ($_text_view, $_pixels_above_lines) = @_ } +sub set_pixels_below_lines { my ($_text_view, $_pixels_below_lines) = @_ } +sub set_pixels_inside_wrap { my ($_text_view, $_pixels_inside_wrap) = @_ } +sub set_right_margin { my ($_text_view, $_right_margin) = @_ } +sub set_tabs { my ($_text_view, $_tabs) = @_ } +sub set_wrap_mode { my ($_text_view, $_wrap_mode) = @_ } +sub starts_display_line { my ($_text_view, $_iter) = @_ } +sub window_to_buffer_coords { my ($_text_view, $_win, $_window_x, $_window_y) = @_ } + +package Gtk2::ToggleAction; +our @ISA = qw(); +sub get_active { my ($_action) = @_ } +sub get_draw_as_radio { my ($_action) = @_ } +sub set_active { my ($_action, $_is_active) = @_ } +sub set_draw_as_radio { my ($_action, $_draw_as_radio) = @_ } +sub toggled { my ($_action) = @_ } + +package Gtk2::ToggleButton; +our @ISA = qw(); +sub get_active { my ($_toggle_button) = @_ } +sub get_inconsistent { my ($_toggle_button) = @_ } +sub get_mode { my ($_toggle_button) = @_ } +sub new { my ($_class, $_o_label) = @_ } +sub new_with_label { my ($_class, $_o_label) = @_ } +sub new_with_mnemonic { my ($_class, $_o_label) = @_ } +sub set_active { my ($_toggle_button, $_is_active) = @_ } +sub set_inconsistent { my ($_toggle_button, $_setting) = @_ } +sub set_mode { my ($_toggle_button, $_draw_indicator) = @_ } +sub toggled { my ($_toggle_button) = @_ } + +package Gtk2::ToggleToolButton; +our @ISA = qw(); +sub get_active { my ($_button) = @_ } +sub new { my ($_class) = @_ } +sub new_from_stock { my ($_class, $_stock_id) = @_ } +sub set_active { my ($_button, $_is_active) = @_ } + +package Gtk2::ToolButton; +our @ISA = qw(); +sub get_icon_name { my ($_button) = @_ } +sub get_icon_widget { my ($_button) = @_ } +sub get_label { my ($_button) = @_ } +sub get_label_widget { my ($_button) = @_ } +sub get_stock_id { my ($_button) = @_ } +sub get_use_underline { my ($_button) = @_ } +sub new { my ($_class, $_icon_widget, $_label) = @_ } +sub new_from_stock { my ($_class, $_stock_id) = @_ } +sub set_icon_name { my ($_button, $_icon_name) = @_ } +sub set_icon_widget { my ($_button, $_icon_widget) = @_ } +sub set_label { my ($_button, $_label) = @_ } +sub set_label_widget { my ($_button, $_label_widget) = @_ } +sub set_stock_id { my ($_button, $_stock_id) = @_ } +sub set_use_underline { my ($_button, $_use_underline) = @_ } + +package Gtk2::ToolItem; +our @ISA = qw(); +sub get_expand { my ($_tool_item) = @_ } +sub get_homogeneous { my ($_tool_item) = @_ } +sub get_icon_size { my ($_tool_item) = @_ } +sub get_is_important { my ($_tool_item) = @_ } +sub get_orientation { my ($_tool_item) = @_ } +sub get_proxy_menu_item { my ($_tool_item, $_menu_item_id) = @_ } +sub get_relief_style { my ($_tool_item) = @_ } +sub get_toolbar_style { my ($_tool_item) = @_ } +sub get_use_drag_window { my ($_toolitem) = @_ } +sub get_visible_horizontal { my ($_toolitem) = @_ } +sub get_visible_vertical { my ($_toolitem) = @_ } +sub new { my ($_class) = @_ } +sub rebuild_menu { my ($_tool_item) = @_ } +sub retrieve_proxy_menu_item { my ($_tool_item) = @_ } +sub set_expand { my ($_tool_item, $_expand) = @_ } +sub set_homogeneous { my ($_tool_item, $_homogeneous) = @_ } +sub set_is_important { my ($_tool_item, $_is_important) = @_ } +sub set_proxy_menu_item { my ($_tool_item, $_menu_item_id, $_menu_item) = @_ } +sub set_tooltip { my ($_tool_item, $_tooltips, $_tip_text, $_tip_private) = @_ } +sub set_use_drag_window { my ($_toolitem, $_use_drag_window) = @_ } +sub set_visible_horizontal { my ($_toolitem, $_visible_horizontal) = @_ } +sub set_visible_vertical { my ($_toolitem, $_visible_vertical) = @_ } + +package Gtk2::Toolbar; +our @ISA = qw(); +sub append_element { my ($_toolbar, $_type, $_widget, $_text, $_tooltip_text, $_tooltip_private_text, $_icon, $_o_callback, $_o_user_data) = @_ } +sub append_item { my ($_toolbar, $_text, $_tooltip_text, $_tooltip_private_text, $_icon, $_o_callback, $_o_user_data) = @_ } +sub append_space { my ($_toolbar) = @_ } +sub append_widget { my ($_toolbar, $_widget, $_tooltip_text, $_tooltip_private_text) = @_ } +sub get_drop_index { my ($_toolbar, $_x, $_y) = @_ } +sub get_icon_size { my ($_toolbar) = @_ } +sub get_item_index { my ($_toolbar, $_item) = @_ } +sub get_n_items { my ($_toolbar) = @_ } +sub get_nth_item { my ($_toolbar, $_n) = @_ } +sub get_orientation { my ($_toolbar) = @_ } +sub get_relief_style { my ($_toolbar) = @_ } +sub get_show_arrow { my ($_toolbar) = @_ } +sub get_style { my ($_toolbar) = @_ } +sub get_tooltips { my ($_toolbar) = @_ } +sub insert { my ($_toolbar, $_item, $_pos) = @_ } +sub insert_element { my ($_toolbar, $_type, $_widget, $_text, $_tooltip_text, $_tooltip_private_text, $_icon, $_callback, $_user_data, $_position) = @_ } +sub insert_item { my ($_toolbar, $_text, $_tooltip_text, $_tooltip_private_text, $_icon, $_callback, $_user_data, $_position) = @_ } +sub insert_space { my ($_toolbar, $_position) = @_ } +sub insert_stock { my ($_toolbar, $_stock_id, $_tooltip_text, $_tooltip_private_text, $_callback, $_user_data, $_position) = @_ } +sub insert_widget { my ($_toolbar, $_widget, $_tooltip_text, $_tooltip_private_text, $_position) = @_ } +sub new { my ($_class) = @_ } +sub prepend_element { my ($_toolbar, $_type, $_widget, $_text, $_tooltip_text, $_tooltip_private_text, $_icon, $_o_callback, $_o_user_data) = @_ } +sub prepend_item { my ($_toolbar, $_text, $_tooltip_text, $_tooltip_private_text, $_icon, $_o_callback, $_o_user_data) = @_ } +sub prepend_space { my ($_toolbar) = @_ } +sub prepend_widget { my ($_toolbar, $_widget, $_tooltip_text, $_tooltip_private_text) = @_ } +sub remove_space { my ($_toolbar, $_position) = @_ } +sub set_drop_highlight_item { my ($_toolbar, $_tool_item, $_index) = @_ } +sub set_icon_size { my ($_toolbar, $_icon_size) = @_ } +sub set_orientation { my ($_toolbar, $_orientation) = @_ } +sub set_show_arrow { my ($_toolbar, $_show_arrow) = @_ } +sub set_style { my ($_toolbar, $_style) = @_ } +sub set_tooltips { my ($_toolbar, $_enable) = @_ } +sub unset_icon_size { my ($_toolbar) = @_ } +sub unset_style { my ($_toolbar) = @_ } + +package Gtk2::Tooltips; +our @ISA = qw(); +sub data_get { my ($_class, $_widget) = @_ } +sub disable { my ($_tooltips) = @_ } +sub enable { my ($_tooltips) = @_ } +sub force_window { my ($_tooltips) = @_ } +sub new { my ($_class) = @_ } +sub set_tip { my ($_tooltips, $_widget, $_tip_text, $_o_tip_private) = @_ } + +package Gtk2::TreeDragDest; +our @ISA = qw(); +sub _ADD_INTERFACE { my ($_class, $_target_class) = @_ } +sub drag_data_received { my ($_drag_dest, $_dest, $_selection_data) = @_ } +sub row_drop_possible { my ($_drag_dest, $_dest_path, $_selection_data) = @_ } + +package Gtk2::TreeDragSource; +our @ISA = qw(); +sub _ADD_INTERFACE { my ($_class, $_target_class) = @_ } +sub drag_data_delete { my ($_drag_source, $_path) = @_ } +sub drag_data_get { my ($_drag_source, $_path) = @_ } +sub row_draggable { my ($_drag_source, $_path) = @_ } + +package Gtk2::TreeIter; +our @ISA = qw(); +sub new_from_arrayref { my ($_class, $_sv_iter) = @_ } +sub to_arrayref { my ($_iter, $_stamp) = @_ } + +package Gtk2::TreeModel; +our @ISA = qw(); +sub _ADD_INTERFACE { my ($_class, $_target_class) = @_ } +sub Gtk2::TreeModel::foreach { my ($_model, $_func, $_o_user_data) = @_ } +sub get { my ($_tree_model, $_iter, @_more_paras) = @_ } +sub get_column_type { my ($_tree_model, $_index_) = @_ } +sub get_flags { my ($_tree_model) = @_ } +sub get_iter { my ($_tree_model, $_path) = @_ } +sub get_iter_first { my ($_tree_model) = @_ } +sub get_iter_from_string { my ($_tree_model, $_path_string) = @_ } +sub get_n_columns { my ($_tree_model) = @_ } +sub get_path { my ($_tree_model, $_iter) = @_ } +sub get_string_from_iter { my ($_tree_model, $_iter) = @_ } +sub get_value { my ($_tree_model, $_iter, @_more_paras) = @_ } +sub iter_children { my ($_tree_model, $_parent) = @_ } +sub iter_has_child { my ($_tree_model, $_iter) = @_ } +sub iter_n_children { my ($_tree_model, $_o_iter) = @_ } +sub iter_next { my ($_tree_model, $_iter) = @_ } +sub iter_nth_child { my ($_tree_model, $_parent, $_n) = @_ } +sub iter_parent { my ($_tree_model, $_child) = @_ } +sub ref_node { my ($_tree_model, $_iter) = @_ } +sub row_changed { my ($_tree_model, $_path, $_iter) = @_ } +sub row_deleted { my ($_tree_model, $_path) = @_ } +sub row_has_child_toggled { my ($_tree_model, $_path, $_iter) = @_ } +sub row_inserted { my ($_tree_model, $_path, $_iter) = @_ } +sub rows_reordered { my ($_tree_model, $_path, $_iter, @_more_paras) = @_ } +sub unref_node { my ($_tree_model, $_iter) = @_ } + +package Gtk2::TreeModelFilter; +our @ISA = qw(); +sub clear_cache { my ($_filter) = @_ } +sub convert_child_iter_to_iter { my ($_filter, $_child_iter) = @_ } +sub convert_child_path_to_path { my ($_filter, $_child_path) = @_ } +sub convert_iter_to_child_iter { my ($_filter, $_filter_iter) = @_ } +sub convert_path_to_child_path { my ($_path, $_filter_path) = @_ } +sub get_model { my ($_filter) = @_ } +sub new { my ($_class, $_child_model, $_o_root) = @_ } +sub refilter { my ($_filter) = @_ } +sub set_modify_func { my ($_filter, $_types, $_o_func, $_o_data) = @_ } +sub set_visible_column { my ($_filter, $_column) = @_ } +sub set_visible_func { my ($_filter, $_func, $_o_data) = @_ } + +package Gtk2::TreeModelSort; +our @ISA = qw(); +sub clear_cache { my ($_tree_model_sort) = @_ } +sub convert_child_iter_to_iter { my ($_tree_model_sort, $_child_iter) = @_ } +sub convert_child_path_to_path { my ($_tree_model_sort, $_child_path) = @_ } +sub convert_iter_to_child_iter { my ($_tree_model_sort, $_sorted_iter) = @_ } +sub convert_path_to_child_path { my ($_tree_model_sort, $_sorted_path) = @_ } +sub get_model { my ($_tree_model) = @_ } +sub iter_is_valid { my ($_tree_model_sort, $_iter) = @_ } +sub new { my ($_class, @_more_paras) = @_ } +sub new_with_model { my ($_class, $_child_model) = @_ } +sub reset_default_sort_func { my ($_tree_model_sort) = @_ } + +package Gtk2::TreePath; +our @ISA = qw(); +sub append_index { my ($_path, $_index_) = @_ } +sub compare { my ($_a, $_b) = @_ } +sub down { my ($_path) = @_ } +sub get_depth { my ($_path) = @_ } +sub get_indices { my ($_path) = @_ } +sub is_ancestor { my ($_path, $_descendant) = @_ } +sub is_descendant { my ($_path, $_ancestor) = @_ } +sub new { my ($_class, $_o_path) = @_ } +sub new_first { my ($_class) = @_ } +sub new_from_indices { my ($_class, $_first_index, @_more_paras) = @_ } +sub new_from_string { my ($_class, $_o_path) = @_ } +sub next { my ($_path) = @_ } +sub prepend_index { my ($_path, $_index_) = @_ } +sub prev { my ($_path) = @_ } +sub to_string { my ($_path) = @_ } +sub up { my ($_path) = @_ } + +package Gtk2::TreeRowReference; +our @ISA = qw(); +sub get_model { my ($_reference) = @_ } +sub get_path { my ($_reference) = @_ } +sub new { my ($_class, $_model, $_path) = @_ } +sub valid { my ($_reference) = @_ } + +package Gtk2::TreeSelection; +our @ISA = qw(); +sub count_selected_rows { my ($_selection) = @_ } +sub get_mode { my ($_selection) = @_ } +sub get_selected { my ($_selection) = @_ } +sub get_selected_rows { my ($_selection) = @_ } +sub get_tree_view { my ($_selection) = @_ } +sub get_user_data { my ($_selection) = @_ } +sub iter_is_selected { my ($_selection, $_iter) = @_ } +sub path_is_selected { my ($_selection, $_path) = @_ } +sub select_all { my ($_selection) = @_ } +sub select_iter { my ($_selection, $_iter) = @_ } +sub select_path { my ($_selection, $_path) = @_ } +sub select_range { my ($_selection, $_start_path, $_end_path) = @_ } +sub selected_foreach { my ($_selection, $_func, $_o_data) = @_ } +sub set_mode { my ($_selection, $_type) = @_ } +sub set_select_function { my ($_selection, $_func, $_o_data) = @_ } +sub unselect_all { my ($_selection) = @_ } +sub unselect_iter { my ($_selection, $_iter) = @_ } +sub unselect_path { my ($_selection, $_path) = @_ } +sub unselect_range { my ($_selection, $_start_path, $_end_path) = @_ } + +package Gtk2::TreeSortable; +our @ISA = qw(); +sub _ADD_INTERFACE { my ($_class, $_target_class) = @_ } +sub get_sort_column_id { my ($_sortable) = @_ } +sub has_default_sort_func { my ($_sortable) = @_ } +sub set_default_sort_func { my ($_sortable, $_sort_func, $_o_user_data) = @_ } +sub set_sort_column_id { my ($_sortable, $_sort_column_id, $_order) = @_ } +sub set_sort_func { my ($_sortable, $_sort_column_id, $_sort_func, $_o_user_data) = @_ } +sub sort_column_changed { my ($_sortable) = @_ } + +package Gtk2::TreeSortable::IterCompareFunc; +our @ISA = qw(); +sub DESTROY { my ($_code) = @_ } +sub invoke { my ($_model, $_a, $_b, $_data) = @_ } + +package Gtk2::TreeStore; +our @ISA = qw(); +sub append { my ($_tree_store, $_parent) = @_ } +sub clear { my ($_tree_store) = @_ } +sub insert { my ($_tree_store, $_parent, $_position) = @_ } +sub insert_after { my ($_tree_store, $_parent, $_sibling) = @_ } +sub insert_before { my ($_tree_store, $_parent, $_sibling) = @_ } +sub is_ancestor { my ($_tree_store, $_iter, $_descendant) = @_ } +sub iter_depth { my ($_tree_store, $_iter) = @_ } +sub iter_is_valid { my ($_tree_store, $_iter) = @_ } +sub move_after { my ($_tree_store, $_iter, $_position) = @_ } +sub move_before { my ($_tree_store, $_iter, $_position) = @_ } +sub new { my ($_class, @_more_paras) = @_ } +sub prepend { my ($_tree_store, $_parent) = @_ } +sub remove { my ($_tree_store, $_iter) = @_ } +sub reorder { my ($_tree_store, $_parent, @_more_paras) = @_ } +sub set { my ($_tree_store, $_iter, $_col1, $_val1, @_more_paras) = @_ } +sub set_column_types { my ($_tree_store, @_more_paras) = @_ } +sub set_value { my ($_tree_store, $_iter, $_col1, $_val1, @_more_paras) = @_ } +sub swap { my ($_tree_store, $_a, $_b) = @_ } + +package Gtk2::TreeView; +our @ISA = qw(); +sub append_column { my ($_tree_view, $_column) = @_ } +sub collapse_all { my ($_tree_view) = @_ } +sub collapse_row { my ($_tree_view, $_path) = @_ } +sub columns_autosize { my ($_tree_view) = @_ } +sub create_row_drag_icon { my ($_tree_view, $_path) = @_ } +sub enable_model_drag_dest { my ($_tree_view, $_actions, @_more_paras) = @_ } +sub enable_model_drag_source { my ($_tree_view, $_start_button_mask, $_actions, @_more_paras) = @_ } +sub expand_all { my ($_tree_view) = @_ } +sub expand_row { my ($_tree_view, $_path, $_open_all) = @_ } +sub expand_to_path { my ($_tree_view, $_path) = @_ } +sub get_background_area { my ($_tree_view, $_path, $_column) = @_ } +sub get_bin_window { my ($_tree_view) = @_ } +sub get_cell_area { my ($_tree_view, $_path, $_column) = @_ } +sub get_column { my ($_tree_view, $_n) = @_ } +sub get_columns { my ($_tree_view) = @_ } +sub get_cursor { my ($_tree_view) = @_ } +sub get_dest_row_at_pos { my ($_tree_view, $_drag_x, $_drag_y) = @_ } +sub get_drag_dest_row { my ($_tree_view) = @_ } +sub get_enable_search { my ($_tree_view) = @_ } +sub get_expander_column { my ($_tree_view) = @_ } +sub get_fixed_height_mode { my ($_treeview) = @_ } +sub get_hadjustment { my ($_tree_view) = @_ } +sub get_headers_visible { my ($_tree_view) = @_ } +sub get_hover_expand { my ($_treeview) = @_ } +sub get_hover_selection { my ($_treeview) = @_ } +sub get_model { my ($_tree_view) = @_ } +sub get_path_at_pos { my ($_tree_view, $_x, $_y) = @_ } +sub get_reorderable { my ($_tree_view) = @_ } +sub get_rules_hint { my ($_tree_view) = @_ } +sub get_search_column { my ($_tree_view) = @_ } +sub get_selection { my ($_tree_view) = @_ } +sub get_vadjustment { my ($_tree_view) = @_ } +sub get_visible_range { my ($_tree_view) = @_ } +sub get_visible_rect { my ($_tree_view) = @_ } +sub insert_column { my ($_tree_view, $_column, $_position) = @_ } +sub insert_column_with_attributes { my ($_tree_view, $_position, $_title, $_cell, @_more_paras) = @_ } +sub insert_column_with_data_func { my ($_tree_view, $_position, $_title, $_cell, $_func, $_o_data) = @_ } +sub map_expanded_rows { my ($_tree_view, $_func, $_o_data) = @_ } +sub move_column_after { my ($_tree_view, $_column, $_base_column) = @_ } +sub new { my ($_class, $_o_model) = @_ } +sub new_with_model { my ($_class, $_model) = @_ } +sub remove_column { my ($_tree_view, $_column) = @_ } +sub row_activated { my ($_tree_view, $_path, $_column) = @_ } +sub row_expanded { my ($_tree_view, $_path) = @_ } +sub scroll_to_cell { my ($_tree_view, $_path, $_o_column, $_o_use_align, $_o_row_align, $_o_col_align) = @_ } +sub scroll_to_point { my ($_tree_view, $_tree_x, $_tree_y) = @_ } +sub set_column_drag_function { my ($_tree_view, $_func, $_o_data) = @_ } +sub set_cursor { my ($_tree_view, $_path, $_o_focus_column, $_o_start_editing) = @_ } +sub set_cursor_on_cell { my ($_tree_view, $_path, $_focus_column, $_focus_cell, $_start_editing) = @_ } +sub set_drag_dest_row { my ($_tree_view, $_path, $_pos) = @_ } +sub set_enable_search { my ($_tree_view, $_enable_search) = @_ } +sub set_expander_column { my ($_tree_view, $_column) = @_ } +sub set_fixed_height_mode { my ($_treeview, $_enable) = @_ } +sub set_hadjustment { my ($_tree_view, $_adjustment) = @_ } +sub set_headers_clickable { my ($_tree_view, $_setting) = @_ } +sub set_headers_visible { my ($_tree_view, $_headers_visible) = @_ } +sub set_hover_expand { my ($_treeview, $_expand) = @_ } +sub set_hover_selection { my ($_treeview, $_hover) = @_ } +sub set_model { my ($_tree_view, $_model) = @_ } +sub set_reorderable { my ($_tree_view, $_reorderable) = @_ } +sub set_row_separator_func { my ($_tree_view, $_func, $_o_data) = @_ } +sub set_rules_hint { my ($_tree_view, $_setting) = @_ } +sub set_search_column { my ($_tree_view, $_column) = @_ } +sub set_search_equal_func { my ($_tree_view, $_func, $_o_data) = @_ } +sub set_vadjustment { my ($_tree_view, $_adjustment) = @_ } +sub tree_to_widget_coords { my ($_tree_view, $_tx, $_ty) = @_ } +sub unset_rows_drag_dest { my ($_tree_view) = @_ } +sub unset_rows_drag_source { my ($_tree_view) = @_ } +sub widget_to_tree_coords { my ($_tree_view, $_wx, $_wy) = @_ } + +package Gtk2::TreeViewColumn; +our @ISA = qw(); +sub add_attribute { my ($_tree_column, $_cell_renderer, $_attribute, $_column) = @_ } +sub cell_get_position { my ($_tree_column, $_cell_renderer) = @_ } +sub cell_get_size { my ($_tree_column) = @_ } +sub cell_is_visible { my ($_tree_column) = @_ } +sub cell_set_cell_data { my ($_tree_column, $_tree_model, $_iter, $_is_expander, $_is_expanded) = @_ } +sub clear { my ($_tree_column) = @_ } +sub clear_attributes { my ($_tree_column, $_cell_renderer) = @_ } +sub clicked { my ($_tree_column) = @_ } +sub focus_cell { my ($_tree_column, $_cell) = @_ } +sub get_alignment { my ($_tree_column) = @_ } +sub get_cell_renderers { my ($_tree_column) = @_ } +sub get_clickable { my ($_tree_column) = @_ } +sub get_expand { my ($_tree_column) = @_ } +sub get_fixed_width { my ($_tree_column) = @_ } +sub get_max_width { my ($_tree_column) = @_ } +sub get_min_width { my ($_tree_column) = @_ } +sub get_reorderable { my ($_tree_column) = @_ } +sub get_resizable { my ($_tree_column) = @_ } +sub get_sizing { my ($_tree_column) = @_ } +sub get_sort_column_id { my ($_tree_column) = @_ } +sub get_sort_indicator { my ($_tree_column) = @_ } +sub get_sort_order { my ($_tree_column) = @_ } +sub get_spacing { my ($_tree_column) = @_ } +sub get_title { my ($_tree_column) = @_ } +sub get_visible { my ($_tree_column) = @_ } +sub get_widget { my ($_tree_column) = @_ } +sub get_width { my ($_tree_column) = @_ } +sub new { my ($_class) = @_ } +sub new_with_attributes { my ($_class, $_title, $_cell, @_more_paras) = @_ } +sub pack_end { my ($_tree_column, $_cell, $_expand) = @_ } +sub pack_start { my ($_tree_column, $_cell, $_expand) = @_ } +sub queue_resize { my ($_tree_column) = @_ } +sub set_alignment { my ($_tree_column, $_xalign) = @_ } +sub set_attributes { my ($_tree_column, $_cell_renderer, @_more_paras) = @_ } +sub set_cell_data_func { my ($_tree_column, $_cell_renderer, $_func, $_o_data) = @_ } +sub set_clickable { my ($_tree_column, $_clickable) = @_ } +sub set_expand { my ($_tree_column, $_expand) = @_ } +sub set_fixed_width { my ($_tree_column, $_fixed_width) = @_ } +sub set_max_width { my ($_tree_column, $_max_width) = @_ } +sub set_min_width { my ($_tree_column, $_min_width) = @_ } +sub set_reorderable { my ($_tree_column, $_reorderable) = @_ } +sub set_resizable { my ($_tree_column, $_resizable) = @_ } +sub set_sizing { my ($_tree_column, $_type) = @_ } +sub set_sort_column_id { my ($_tree_column, $_sort_column_id) = @_ } +sub set_sort_indicator { my ($_tree_column, $_setting) = @_ } +sub set_sort_order { my ($_tree_column, $_order) = @_ } +sub set_spacing { my ($_tree_column, $_spacing) = @_ } +sub set_title { my ($_tree_column, $_title) = @_ } +sub set_visible { my ($_tree_column, $_visible) = @_ } +sub set_widget { my ($_tree_column, $_widget) = @_ } + +package Gtk2::UIManager; +our @ISA = qw(); +sub add_ui { my ($_self, $_merge_id, $_path, $_name, $_action, $_type, $_top) = @_ } +sub add_ui_from_file { my ($_self, $_filename) = @_ } +sub add_ui_from_string { my ($_self, $_buffer, $_buffer) = @_ } +sub ensure_update { my ($_self) = @_ } +sub get_accel_group { my ($_self) = @_ } +sub get_action { my ($_self, $_path) = @_ } +sub get_action_groups { my ($_self) = @_ } +sub get_add_tearoffs { my ($_self) = @_ } +sub get_toplevels { my ($_self, $_types) = @_ } +sub get_ui { my ($_self) = @_ } +sub get_widget { my ($_self, $_path) = @_ } +sub insert_action_group { my ($_self, $_action_group, $_pos) = @_ } +sub new { my ($_class) = @_ } +sub new_merge_id { my ($_self) = @_ } +sub remove_action_group { my ($_self, $_action_group) = @_ } +sub remove_ui { my ($_self, $_merge_id) = @_ } +sub set_add_tearoffs { my ($_self, $_add_tearoffs) = @_ } + +package Gtk2::VBox; +our @ISA = qw(); +sub new { my ($_class, $_o_homogeneous, $_o_spacing) = @_ } + +package Gtk2::VButtonBox; +our @ISA = qw(); +sub get_layout_default { my ($_class) = @_ } +sub get_spacing_default { my ($_class) = @_ } +sub new { my ($_class) = @_ } +sub set_layout_default { my ($_class, $_layout) = @_ } +sub set_spacing_default { my ($_class, $_spacing) = @_ } + +package Gtk2::VPaned; +our @ISA = qw(); +sub new { my ($_class) = @_ } + +package Gtk2::VRuler; +our @ISA = qw(); +sub new { my ($_class) = @_ } + +package Gtk2::VScale; +our @ISA = qw(); +sub new { my ($_class, $_o_adjustment) = @_ } +sub new_with_range { my ($_class, $_min, $_max, $_step) = @_ } + +package Gtk2::VScrollBar; +our @ISA = qw(); +sub new { my ($_class, $_o_adjustment) = @_ } + +package Gtk2::VScrollbar; +our @ISA = qw(); +sub new { my ($_class, $_o_adjustment) = @_ } + +package Gtk2::VSeparator; +our @ISA = qw(); +sub new { my ($_class) = @_ } + +package Gtk2::Viewport; +our @ISA = qw(); +sub get_hadjustment { my ($_viewport) = @_ } +sub get_shadow_type { my ($_viewport) = @_ } +sub get_vadjustment { my ($_viewport) = @_ } +sub new { my ($_class, $_o_hadjustment, $_o_vadjustment) = @_ } +sub set_hadjustment { my ($_viewport, $_adjustment) = @_ } +sub set_shadow_type { my ($_viewport, $_type) = @_ } +sub set_vadjustment { my ($_viewport, $_adjustment) = @_ } + +package Gtk2::Widget; +our @ISA = qw(); +sub _INSTALL_OVERRIDES { my ($_package) = @_ } +sub activate { my ($_widget) = @_ } +sub add_accelerator { my ($_widget, $_accel_signal, $_accel_group, $_accel_key, $_accel_mods, $_flags) = @_ } +sub add_events { my ($_widget, $_events) = @_ } +sub add_mnemonic_label { my ($_widget, $_label) = @_ } +sub allocation { my ($_widget) = @_ } +sub app_paintable { my ($_widget, @_more_paras) = @_ } +sub can_activate_accel { my ($_widget, $_signal_id) = @_ } +sub can_default { my ($_widget, @_more_paras) = @_ } +sub can_focus { my ($_widget, @_more_paras) = @_ } +sub child_focus { my ($_widget, $_direction) = @_ } +sub child_notify { my ($_widget, $_child_property) = @_ } +sub class_path { my ($_widget) = @_ } +sub composite_child { my ($_widget, @_more_paras) = @_ } +sub create_pango_context { my ($_widget) = @_ } +sub create_pango_layout { my ($_widget, $_text) = @_ } +sub destroy { my ($_widget) = @_ } +sub double_buffered { my ($_widget, @_more_paras) = @_ } +sub drag_begin { my ($_widget, $_targets, $_actions, $_button, $_event) = @_ } +sub drag_check_threshold { my ($_widget, $_start_x, $_start_y, $_current_x, $_current_y) = @_ } +sub drag_dest_add_image_targets { my ($_widget) = @_ } +sub drag_dest_add_text_targets { my ($_widget) = @_ } +sub drag_dest_add_uri_targets { my ($_widget) = @_ } +sub drag_dest_find_target { my ($_widget, $_context, $_target_list) = @_ } +sub drag_dest_get_target_list { my ($_widget) = @_ } +sub drag_dest_set { my ($_widget, $_flags, $_actions, @_more_paras) = @_ } +sub drag_dest_set_proxy { my ($_widget, $_proxy_window, $_protocol, $_use_coordinates) = @_ } +sub drag_dest_set_target_list { my ($_widget, $_target_list) = @_ } +sub drag_dest_unset { my ($_widget) = @_ } +sub drag_get_data { my ($_widget, $_context, $_target, $_time_) = @_ } +sub drag_highlight { my ($_widget) = @_ } +sub drag_source_add_image_targets { my ($_widget) = @_ } +sub drag_source_add_text_targets { my ($_widget) = @_ } +sub drag_source_add_uri_targets { my ($_widget) = @_ } +sub drag_source_get_target_list { my ($_widget) = @_ } +sub drag_source_set { my ($_widget, $_start_button_mask, $_actions, @_more_paras) = @_ } +sub drag_source_set_icon { my ($_widget, $_colormap, $_pixmap, $_mask) = @_ } +sub drag_source_set_icon_name { my ($_widget, $_icon_name) = @_ } +sub drag_source_set_icon_pixbuf { my ($_widget, $_pixbuf) = @_ } +sub drag_source_set_icon_stock { my ($_widget, $_stock_id) = @_ } +sub drag_source_set_target_list { my ($_widget, $_target_list) = @_ } +sub drag_source_unset { my ($_widget) = @_ } +sub drag_unhighlight { my ($_widget) = @_ } +sub drawable { my ($_widget, @_more_paras) = @_ } +sub ensure_style { my ($_widget) = @_ } +sub event { my ($_widget, $_event) = @_ } +sub flags { my ($_widget) = @_ } +sub freeze_child_notify { my ($_widget) = @_ } +sub get_accessible { my ($_widget) = @_ } +sub get_ancestor { my ($_widget, $_ancestor_package) = @_ } +sub get_child_requisition { my ($_widget) = @_ } +sub get_child_visible { my ($_widget) = @_ } +sub get_clipboard { my ($_widget, $_o_selection) = @_ } +sub get_colormap { my ($_widget) = @_ } +sub get_composite_name { my ($_widget) = @_ } +sub get_default_colormap { my ($_class_or_widget) = @_ } +sub get_default_direction { my ($_class) = @_ } +sub get_default_style { my ($_class_or_widget) = @_ } +sub get_default_visual { my ($_class_or_widget) = @_ } +sub get_direction { my ($_widget) = @_ } +sub get_display { my ($_widget) = @_ } +sub get_events { my ($_widget) = @_ } +sub get_extension_events { my ($_widget) = @_ } +sub get_flags { my ($_widget) = @_ } +sub get_modifier_style { my ($_widget) = @_ } +sub get_name { my ($_widget) = @_ } +sub get_no_show_all { my ($_widget) = @_ } +sub get_pango_context { my ($_widget) = @_ } +sub get_parent { my ($_widget) = @_ } +sub get_parent_window { my ($_widget) = @_ } +sub get_pointer { my ($_widget) = @_ } +sub get_root_window { my ($_widget) = @_ } +sub get_screen { my ($_widget) = @_ } +sub get_settings { my ($_widget) = @_ } +sub get_size_request { my ($_widget) = @_ } +sub get_style { my ($_widget) = @_ } +sub get_toplevel { my ($_widget) = @_ } +sub get_visual { my ($_widget) = @_ } +sub grab_default { my ($_widget) = @_ } +sub grab_focus { my ($_widget) = @_ } +sub has_default { my ($_widget, @_more_paras) = @_ } +sub has_focus { my ($_widget, @_more_paras) = @_ } +sub has_grab { my ($_widget, @_more_paras) = @_ } +sub has_screen { my ($_widget) = @_ } +sub hide { my ($_widget) = @_ } +sub hide_all { my ($_widget) = @_ } +sub intersect { my ($_widget, $_area) = @_ } +sub is_ancestor { my ($_widget, $_ancestor) = @_ } +sub is_focus { my ($_widget) = @_ } +sub is_sensitive { my ($_widget, @_more_paras) = @_ } +sub list_mnemonic_labels { my ($_widget) = @_ } +sub map { my ($_widget) = @_ } +sub mapped { my ($_widget, @_more_paras) = @_ } +sub mnemonic_activate { my ($_widget, $_group_cycling) = @_ } +sub modify_base { my ($_widget, $_state, $_color) = @_ } +sub modify_bg { my ($_widget, $_state, $_color) = @_ } +sub modify_fg { my ($_widget, $_state, $_color) = @_ } +sub modify_font { my ($_widget, $_font_desc) = @_ } +sub modify_style { my ($_widget, $_style) = @_ } +sub modify_text { my ($_widget, $_state, $_color) = @_ } +sub no_window { my ($_widget, @_more_paras) = @_ } +sub parent { my ($_widget) = @_ } +sub parent_sensitive { my ($_widget, @_more_paras) = @_ } +sub path { my ($_widget) = @_ } +sub pop_colormap { my ($_class_or_widget) = @_ } +sub pop_composite_child { my ($_o_class_or_widget) = @_ } +sub propagate_event { my ($_widget, $_event) = @_ } +sub push_colormap { my ($_class_or_widget, $_cmap) = @_ } +sub push_composite_child { my ($_o_class_or_widget) = @_ } +sub queue_draw { my ($_widget) = @_ } +sub queue_draw_area { my ($_widget, $_x, $_y, $_width, $_height) = @_ } +sub queue_resize { my ($_widget) = @_ } +sub queue_resize_no_redraw { my ($_widget) = @_ } +sub rc_style { my ($_widget, @_more_paras) = @_ } +sub realize { my ($_widget) = @_ } +sub realized { my ($_widget, @_more_paras) = @_ } +sub receives_default { my ($_widget, @_more_paras) = @_ } +sub region_intersect { my ($_widget, $_region) = @_ } +sub remove_accelerator { my ($_widget, $_accel_group, $_accel_key, $_accel_mods) = @_ } +sub remove_mnemonic_label { my ($_widget, $_label) = @_ } +sub render_icon { my ($_widget, $_stock_id, $_size, $_o_detail) = @_ } +sub reparent { my ($_widget, $_new_parent) = @_ } +sub requisition { my ($_widget) = @_ } +sub reset_rc_styles { my ($_widget) = @_ } +sub reset_shapes { my ($_widget) = @_ } +sub saved_state { my ($_widget) = @_ } +sub selection_add_target { my ($_widget, $_selection, $_target, $_info) = @_ } +sub selection_add_targets { my ($_widget, $_selection, @_more_paras) = @_ } +sub selection_clear_targets { my ($_widget, $_selection) = @_ } +sub selection_convert { my ($_widget, $_selection, $_target, $_time_) = @_ } +sub selection_remove_all { my ($_widget) = @_ } +sub sensitive { my ($_widget, @_more_paras) = @_ } +sub set_accel_path { my ($_widget, $_accel_path, $_accel_group) = @_ } +sub set_app_paintable { my ($_widget, $_app_paintable) = @_ } +sub set_child_visible { my ($_widget, $_is_visible) = @_ } +sub set_colormap { my ($_widget, $_colormap) = @_ } +sub set_composite_name { my ($_widget, $_name) = @_ } +sub set_default_colormap { my ($_class_or_widget, $_colormap) = @_ } +sub set_default_direction { my ($_class, $_dir) = @_ } +sub set_direction { my ($_widget, $_dir) = @_ } +sub set_double_buffered { my ($_widget, $_double_buffered) = @_ } +sub set_events { my ($_widget, $_events) = @_ } +sub set_extension_events { my ($_widget, $_mode) = @_ } +sub set_flags { my ($_widget, $_flags) = @_ } +sub set_name { my ($_widget, $_name) = @_ } +sub set_no_show_all { my ($_widget, $_no_show_all) = @_ } +sub set_parent { my ($_widget, $_parent) = @_ } +sub set_parent_window { my ($_widget, $_parent_window) = @_ } +sub set_redraw_on_allocate { my ($_widget, $_redraw_on_allocate) = @_ } +sub set_scroll_adjustments { my ($_widget, $_hadjustment, $_vadjustment) = @_ } +sub set_sensitive { my ($_widget, $_sensitive) = @_ } +sub set_size_request { my ($_widget, $_o_width, $_o_height) = @_ } +sub set_state { my ($_widget, $_state) = @_ } +sub set_style { my ($_widget, $_style) = @_ } +sub shape_combine_mask { my ($_widget, $_shape_mask, $_offset_x, $_offset_y) = @_ } +sub show { my ($_widget) = @_ } +sub show_all { my ($_widget) = @_ } +sub show_now { my ($_widget) = @_ } +sub size_allocate { my ($_widget, $_allocation) = @_ } +sub size_request { my ($_widget) = @_ } +sub state { my ($_widget) = @_ } +sub style { my ($_widget) = @_ } +sub style_get { my ($_widget, $_first_property_name, @_more_paras) = @_ } +sub style_get_property { my ($_widget, $_first_property_name, @_more_paras) = @_ } +sub thaw_child_notify { my ($_widget) = @_ } +sub toplevel { my ($_widget, @_more_paras) = @_ } +sub translate_coordinates { my ($_src_widget, $_dest_widget, $_src_x, $_src_y) = @_ } +sub unmap { my ($_widget) = @_ } +sub unparent { my ($_widget) = @_ } +sub unrealize { my ($_widget) = @_ } +sub unset_flags { my ($_widget, $_flags) = @_ } +sub visible { my ($_widget, @_more_paras) = @_ } +sub window { my ($_widget, $_o_new) = @_ } + +package Gtk2::Window; +our @ISA = qw(); +sub activate_default { my ($_window) = @_ } +sub activate_focus { my ($_window) = @_ } +sub activate_key { my ($_window, $_event) = @_ } +sub add_accel_group { my ($_window, $_accel_group) = @_ } +sub add_embedded_xid { my ($_window, $_xid) = @_ } +sub add_mnemonic { my ($_window, $_keyval, $_target) = @_ } +sub begin_move_drag { my ($_window, $_button, $_root_x, $_root_y, $_timestamp) = @_ } +sub begin_resize_drag { my ($_window, $_edge, $_button, $_root_x, $_root_y, $_timestamp) = @_ } +sub deiconify { my ($_window) = @_ } +sub fullscreen { my ($_window) = @_ } +sub get_accept_focus { my ($_window) = @_ } +sub get_decorated { my ($_window) = @_ } +sub get_default_icon_list { my ($_class) = @_ } +sub get_default_size { my ($_window) = @_ } +sub get_destroy_with_parent { my ($_window) = @_ } +sub get_focus { my ($_window) = @_ } +sub get_focus_on_map { my ($_window) = @_ } +sub get_frame_dimensions { my ($_window) = @_ } +sub get_gravity { my ($_window) = @_ } +sub get_has_frame { my ($_window) = @_ } +sub get_icon { my ($_window) = @_ } +sub get_icon_list { my ($_window) = @_ } +sub get_icon_name { my ($_window) = @_ } +sub get_mnemonic_modifier { my ($_window) = @_ } +sub get_modal { my ($_window) = @_ } +sub get_position { my ($_window) = @_ } +sub get_resizable { my ($_window) = @_ } +sub get_role { my ($_window) = @_ } +sub get_screen { my ($_window) = @_ } +sub get_size { my ($_window) = @_ } +sub get_skip_pager_hint { my ($_window) = @_ } +sub get_skip_taskbar_hint { my ($_window) = @_ } +sub get_title { my ($_window) = @_ } +sub get_transient_for { my ($_window) = @_ } +sub get_type_hint { my ($_window) = @_ } +sub get_urgency_hint { my ($_window) = @_ } +sub has_toplevel_focus { my ($_window) = @_ } +sub iconify { my ($_window) = @_ } +sub is_active { my ($_window) = @_ } +sub list_toplevels { my ($_class) = @_ } +sub maximize { my ($_window) = @_ } +sub mnemonic_activate { my ($_window, $_keyval, $_modifier) = @_ } +sub move { my ($_window, $_x, $_y) = @_ } +sub new { my ($_class, $_o_type) = @_ } +sub parse_geometry { my ($_window, $_geometry) = @_ } +sub present { my ($_window) = @_ } +sub present_with_time { my ($_window, $_timestamp) = @_ } +sub propagate_key_event { my ($_window, $_event) = @_ } +sub remove_accel_group { my ($_window, $_accel_group) = @_ } +sub remove_embedded_xid { my ($_window, $_xid) = @_ } +sub remove_mnemonic { my ($_window, $_keyval, $_target) = @_ } +sub reshow_with_initial_size { my ($_window) = @_ } +sub resize { my ($_window, $_width, $_height) = @_ } +sub set_accept_focus { my ($_window, $_setting) = @_ } +sub set_auto_startup_notification { my ($_class, $_setting) = @_ } +sub set_decorated { my ($_window, $_setting) = @_ } +sub set_default { my ($_window, $_default_widget) = @_ } +sub set_default_icon { my ($_class, $_icon) = @_ } +sub set_default_icon_from_file { my ($_class_or_instance, $_filename) = @_ } +sub set_default_icon_list { my ($_class, $_pixbuf, @_more_paras) = @_ } +sub set_default_icon_name { my ($_class, $_name) = @_ } +sub set_default_size { my ($_window, $_width, $_height) = @_ } +sub set_destroy_with_parent { my ($_window, $_setting) = @_ } +sub set_focus { my ($_window, $_o_focus) = @_ } +sub set_focus_on_map { my ($_window, $_setting) = @_ } +sub set_frame_dimensions { my ($_window, $_left, $_top, $_right, $_bottom) = @_ } +sub set_geometry_hints { my ($_window, $_geometry_widget, $_geometry_ref, $_o_geom_mask_sv) = @_ } +sub set_gravity { my ($_window, $_gravity) = @_ } +sub set_has_frame { my ($_window, $_setting) = @_ } +sub set_icon { my ($_window, $_icon) = @_ } +sub set_icon_from_file { my ($_window, $_filename) = @_ } +sub set_icon_list { my ($_window, @_more_paras) = @_ } +sub set_icon_name { my ($_window, $_name) = @_ } +sub set_keep_above { my ($_window, $_setting) = @_ } +sub set_keep_below { my ($_window, $_setting) = @_ } +sub set_mnemonic_modifier { my ($_window, $_modifier) = @_ } +sub set_modal { my ($_window, $_modal) = @_ } +sub set_position { my ($_window, $_position) = @_ } +sub set_resizable { my ($_window, $_resizable) = @_ } +sub set_role { my ($_window, $_role) = @_ } +sub set_screen { my ($_window, $_screen) = @_ } +sub set_skip_pager_hint { my ($_window, $_setting) = @_ } +sub set_skip_taskbar_hint { my ($_window, $_setting) = @_ } +sub set_title { my ($_window, $_o_title) = @_ } +sub set_transient_for { my ($_window, $_parent) = @_ } +sub set_type_hint { my ($_window, $_hint) = @_ } +sub set_urgency_hint { my ($_window, $_setting) = @_ } +sub set_wmclass { my ($_window, $_wmclass_name, $_wmclass_class) = @_ } +sub stick { my ($_window) = @_ } +sub unfullscreen { my ($_window) = @_ } +sub unmaximize { my ($_window) = @_ } +sub unstick { my ($_window) = @_ } + +package Gtk2::WindowGroup; +our @ISA = qw(); +sub add_window { my ($_window_group, $_window) = @_ } +sub new { my ($_class) = @_ } +sub remove_window { my ($_window_group, $_window) = @_ } diff --git a/fake_packages/MDV/Distribconf.pm b/fake_packages/MDV/Distribconf.pm new file mode 100644 index 0000000..abd441a --- /dev/null +++ b/fake_packages/MDV/Distribconf.pm @@ -0,0 +1,17 @@ +package MDV::Distribconf; + +sub new { + my ($_class, $_path, $_mediacfg_version) = @_; +} + +sub parse_mediacfg { + my ($_distrib, $_mediacfg) = @_; +} + +sub getvalue { + my ($_distrib, $_media, $_var) = @_; +} + +sub listmedia { + my ($_distrib) = @_; +} diff --git a/fake_packages/Net/DNS.pm b/fake_packages/Net/DNS.pm new file mode 100644 index 0000000..e300f12 --- /dev/null +++ b/fake_packages/Net/DNS.pm @@ -0,0 +1,7 @@ +package Net::DNS; + +package Net::DNS::Resolver; + +sub new {} +sub query {} +sub answer {} diff --git a/fake_packages/Net/FTP.pm b/fake_packages/Net/FTP.pm new file mode 100644 index 0000000..e01695f --- /dev/null +++ b/fake_packages/Net/FTP.pm @@ -0,0 +1,9 @@ +package Net::FTP; + +sub new {} + +sub login {} +sub binary {} +sub cwd {} +sub retr {} +sub code {} diff --git a/fake_packages/Net/Ping.pm b/fake_packages/Net/Ping.pm new file mode 100644 index 0000000..1a8f8a9 --- /dev/null +++ b/fake_packages/Net/Ping.pm @@ -0,0 +1,9 @@ +package Net::Ping; + +sub new { + my ($_class, @_l) = @_; +} + +sub ping { + my ($_class, $_host, $_o_timeout) = @_; +} diff --git a/fake_packages/URPM/Resolve.pm b/fake_packages/URPM/Resolve.pm new file mode 100644 index 0000000..55eadfb --- /dev/null +++ b/fake_packages/URPM/Resolve.pm @@ -0,0 +1,17 @@ +package URPM::Resolve; + +our @ISA = qw(); + +sub resolve_requested { + my ($_urpm, $_db, $_state, $_requested, %_options) = @_; +} +sub request_packages_to_upgrade { + my ($_urpm, $_db, $_state, $_requested, %_options) = @_; +} + +sub disable_selected { + my ($_urpm, $_db, $_state, @_closure) = @_; +} +sub compute_installed_flags { + my ($_urpm, $_db) = @_; +} diff --git a/fake_packages/gen.pl b/fake_packages/gen.pl new file mode 100755 index 0000000..6ca4c21 --- /dev/null +++ b/fake_packages/gen.pl @@ -0,0 +1,108 @@ +#!/usr/bin/perl -w + +use strict; +use MDK::Common; + +my ($current_package, $current_prefix, $current_name); + +my %l; +sub get_paras { + my ($name, $para) = @_; + $name =~ s/\Q$current_prefix//; + $current_name = $name; + $l{$current_package}{$name} = [ map { + if (/\Q.../) { + '@_more_paras'; + } else { + my ($optional) = s/=(.*)//; + my $s = /.*\W(\w+)/ ? $1 : $_; + '$_' . ($optional ? 'o_' : '') . $s; + } + } grep { !/OUTLIST/ } split(',', $para) ]; +} + +sub parse_xs { + my ($file) = @_; + warn "parse_xs $file\n"; + my $state = 'waiting_for_type'; + ($current_package, $current_prefix) = ('', ''); + my $multi_line; + my $c; + foreach (cat_($file)) { + $c++; + next if /^=/ ... /^=cut/; + chomp; + my $orig_line = $_; + + if (/^\s*#/ || (m!^\s*/\*! .. m!\*/!)) { + # forget it + } elsif ($state eq 'multi_line') { + if (/(.*)\)/) { + get_paras($current_name, $multi_line . $1); + $state = 'waiting_for_end'; + } else { + $multi_line .= $_; + } +# } elsif (/^\s*gperl_set_isa\s*\("(.*)", ".*"\)\s*;/) { + } elsif (/MODULE\s*=\s*\S+\s+PACKAGE\s*=\s*(\S+)\s+PREFIX\s*=\s*(\S+)/) { + ($current_package, $current_prefix) = ($1, $2); + } elsif (/MODULE\s*=\s*\S+\s+PACKAGE\s*=\s*(\S+)/) { + ($current_package, $current_prefix) = ($1, ''); + } elsif (!$current_package) { + # waiting for the MODULE line + } elsif (/^\s*$/) { + $state = 'waiting_for_type'; + } elsif (/^\w[^\(]*$/ && $state eq 'waiting_for_type') { + $state = 'waiting_for_function' if !/^BOOT:/ && !/;/; + } elsif (/^\s*ALIAS:\s*$/) { + $state = 'alias'; + } elsif ($state eq 'alias') { + if (my ($f) = /^\s*(\S+)\s*=\s*\d+\s*$/) { + my $pkg = $f =~ s/(.*)::// ? $1 : $current_package; + $l{$pkg}{$f} ||= $l{$current_package}{$current_name}; + } else { + warn "bad line #$c $orig_line (state: $state)\n" if !/^\s*\w+:\s*$/ && !/^\s*$/; + $state = 'waiting_for_end'; + } + } elsif ($state eq 'waiting_for_type' && s/^(const\s*)?\w+\s*(\*\s*)?// || + $state eq 'waiting_for_function' && /^\w+/) { + if (my ($name, $para) = /^(\S+)\s*\((.*)\)\s*;?\s*$/) { + get_paras($name, $para); + $state = 'waiting_for_end'; + } elsif (($name, $para) = /^(\S+)\s*\((.*)$/) { + $multi_line = $para; + $current_name = $name; + $state = 'multi_line'; + } else { + warn "bad line #$c $orig_line (state: $state)\n"; + } + } else { + warn "bad line #$c $orig_line (state: $state)\n" if + !(($state eq 'waiting_for_end' || $state eq 'waiting_for_type') && + (/^\s/ || /^[{}]\s*$/ || /^(CODE|OUTPUT):\s*$/)); + } + } +} + + +my ($pkg_name, $dir) = @ARGV; +my @xs_files = chomp_(`find $dir -name "*.xs"`); +@ARGV == 2 && @xs_files or die "usage: gen.pl \n"; + +parse_xs($_) foreach @xs_files; + +print "package $pkg_name;\nuse Glib;\n" if $pkg_name eq 'Gtk2'; + +foreach my $pkg (sort keys %l) { + print "\npackage $pkg;\n"; + print "our \@ISA = qw();\n"; + foreach my $name (sort keys %{$l{$pkg}}) { + my $para = $l{$pkg}{$name}; + $name = $pkg . '::' . $name if $name =~ /^(eq|foreach|format|ge|length|sub|x|xor|y)$/; + if (@$para) { + print "sub $name { my (", join(", ", @$para), ") = \@_ }\n"; + } else { + print "sub $name() {}\n"; + } + } +} diff --git a/fake_packages/packdrake.pm b/fake_packages/packdrake.pm new file mode 100644 index 0000000..faebf19 --- /dev/null +++ b/fake_packages/packdrake.pm @@ -0,0 +1,25 @@ +package packdrake; + +sub new { + my ($_class, $_file, %_options) = @_; +} + +sub extract_archive { + my ($_pack, $_dir, @_files) = @_; +} + +sub extract_all_archive { + my ($_pack, $_dir) = @_; +} + +sub list_archive { + my (@_files) = @_; +} + +sub build_archive { + my ($_listh, $_dir, $_archive, $_size, $_compress, $_uncompress) = @_; +} + +sub cat_archive { + my (@_files) = @_; +} diff --git a/fake_packages/urpm.pm b/fake_packages/urpm.pm new file mode 100644 index 0000000..0fc3515 --- /dev/null +++ b/fake_packages/urpm.pm @@ -0,0 +1,9 @@ +package urpm; + +sub new { + my ($_class) = @_; +} + +sub read_config { + my ($_urpm, %_options) = @_; +} diff --git a/perl_checker.src/.cvsignore b/perl_checker.src/.cvsignore deleted file mode 100644 index 8c0f1f4..0000000 --- a/perl_checker.src/.cvsignore +++ /dev/null @@ -1,15 +0,0 @@ -._bcdi -._d -._ncdi -*.cmi -*.cmo -*.cmx -perl_checker -perl_checker.html -perl_checker_debug -gmon.out -lexer.ml -parser.ml -parser.mli -parser.output -build.ml diff --git a/perl_checker.src/Makefile b/perl_checker.src/Makefile deleted file mode 100644 index 22a45a6..0000000 --- a/perl_checker.src/Makefile +++ /dev/null @@ -1,34 +0,0 @@ -# OCAMLC = ocamlcp -p a -OCAMLBCFLAGS = -w A -w e -YFLAGS = -v -TRASH = parser.output perl_checker.html TAGS -RESULT = perl_checker -BCSUFFIX = _debug -SOURCES = types.mli build.ml common.ml flags.ml config_file.ml info.ml parser_helper.ml parser.mly lexer.mll tree.ml global_checks.ml perl_checker.ml -LIBS = unix -VENDORLIB = $(shell dirname `pwd`) -DEBUG = 1 - -default: TAGS build_ml build.ml debug-code native-code perl_checker.html - -build_ml: - rm -f build.ml - $(MAKE) build.ml - -build.ml: - date '+let date = "%s"' > $@ - echo 'let fake_packages_dir = "'$(VENDORLIB)'/perl_checker_fake_packages"' >> $@ - echo 'let debugging = $(DEBUG) > 0' >> $@ - -%.html: %.html.pl - rm -f $@ - perl $< > $@ - chmod a-w $@ - -tags: - ocamltags *.ml - -TAGS: - ocamltags *.ml - --include OCamlMakefile diff --git a/perl_checker.src/OCamlMakefile b/perl_checker.src/OCamlMakefile deleted file mode 100644 index 95df83f..0000000 --- a/perl_checker.src/OCamlMakefile +++ /dev/null @@ -1,912 +0,0 @@ -########################################################################### -# OCamlMakefile -# Copyright (C) 1999-2002 Markus Mottl -# -# For updates see: -# http://www.oefai.at/~markus/ocaml_sources -# -# $Id$ -# -########################################################################### - -# Set these variables to the names of the sources to be processed and -# the result variable. Order matters during linkage! - -ifndef SOURCES - SOURCES := foo.ml -endif -export SOURCES - -ifndef RES_CLIB_SUF - RES_CLIB_SUF := _stubs -endif -export RES_CLIB_SUF - -ifndef RESULT - RESULT := foo -endif -export RESULT - -ifndef DOC_FILES - DOC_FILES := $(filter %.mli, $(SOURCES)) -endif -export DOC_FILES - -export BCSUFFIX -export NCSUFFIX - -ifndef TOPSUFFIX - TOPSUFFIX := .top -endif - -export TOPSUFFIX - -# Eventually set include- and library-paths, libraries to link, -# additional compilation-, link- and ocamlyacc-flags -# Path- and library information needs not be written with "-I" and such... -# Define THREADS if you need it, otherwise leave it unset (same for -# USE_CAMLP4)! - -export THREADS -export USE_CAMLP4 - -export INCDIRS -export LIBDIRS -export EXTLIBDIRS -export OCAML_DEFAULT_DIRS -export OCAML_LIB_INSTALL - -export LIBS -export CLIBS - -export OCAMLFLAGS -export OCAMLNCFLAGS -export OCAMLBCFLAGS - -export OCAMLLDFLAGS -export OCAMLNLDFLAGS -export OCAMLBLDFLAGS - -ifndef OCAMLCPFLAGS - OCAMLCPFLAGS := a -endif - -export OCAMLCPFLAGS - -export YFLAGS -export IDLFLAGS - -export OCAMLDOCFLAGS - -export DVIPSFLAGS - -export STATIC - -# Add a list of optional trash files that should be deleted by "make clean" -export TRASH - -#################### variables depending on your OCaml-installation - -ifdef MINGW - export MINGW - WIN32 := 1 -endif -ifdef MSVC - export MSVC - WIN32 := 1 - EXT_OBJ := obj - EXT_LIB := lib - ifeq ($(CC),gcc) - # work around GNU Make default value - ifdef THREADS - CC := cl /MT - else - CC := cl - endif - endif - ifeq ($(CXX),g++) - # work around GNU Make default value - CXX := $(CC) - endif - CFLAG_O := -Fo -endif -ifdef WIN32 - EXT_CXX := cpp - EXE := .exe -endif - -ifndef EXT_OBJ - EXT_OBJ := o -endif -ifndef EXT_LIB - EXT_LIB := a -endif -ifndef EXT_CXX - EXT_CXX := cc -endif -ifndef EXE - EXE := # empty -endif -ifndef CFLAG_O - CFLAG_O := -o # do not delete this comment (preserves trailing whitespace)! -endif - -export CC -export CXX -export CFLAGS -export CXXFLAGS -export LDFLAGS - -BCRESULT := $(addsuffix $(BCSUFFIX), $(RESULT)) -NCRESULT := $(addsuffix $(NCSUFFIX), $(RESULT)) -TOPRESULT := $(addsuffix $(TOPSUFFIX), $(RESULT)) - -ifndef OCAMLC - OCAMLC := ocamlc -endif - -export OCAMLC - -ifndef OCAMLOPT - OCAMLOPT := ocamlopt -endif - -export OCAMLOPT - -ifndef OCAMLMKTOP - OCAMLMKTOP := ocamlmktop -endif - -export OCAMLMKTOP - -ifndef OCAMLCP - OCAMLCP := ocamlcp -endif - -export OCAMLCP - -ifndef OCAMLDEP - OCAMLDEP := ocamldep -endif - -export OCAMLDEP - -ifndef OCAMLLEX - OCAMLLEX := ocamllex -endif - -export OCAMLLEX - -ifndef OCAMLYACC - OCAMLYACC := ocamlyacc -endif - -export OCAMLYACC - -ifndef CAMELEON_REPORT - CAMELEON_REPORT := report -endif - -ifndef CAMELEON_REPORT_FLAGS - CAMELEON_REPORT_FLAGS := -endif - -ifndef CAMELEON_ZOGGY - CAMELEON_ZOGGY := camlp4o pa_zog.cma pr_o.cmo -endif - -ifndef CAMELEON_ZOGGY_FLAGS - CAMELEON_ZOGGY_FLAGS := -endif - -ifndef CAMLIDL - CAMLIDL := camlidl -endif - -export CAMLIDL - -ifndef CAMLIDLDLL - CAMLIDLDLL := camlidldll -endif - -export CAMLIDLDLL - -ifndef NOIDLHEADER - MAYBE_IDL_HEADER := -header -endif - -export NOIDLHEADER - -ifndef CAMLP4 - CAMLP4 := camlp4 -endif - -export CAMLP4 - -ifndef OCAMLDOC - OCAMLDOC := ocamldoc -endif - -export OCAMLDOC - -ifndef LATEX - LATEX := latex -endif - -export LATEX - -ifndef DVIPS - DVIPS := dvips -endif - -export DVIPS - -ifndef PS2PDF - PS2PDF := ps2pdf -endif - -export PS2PDF - -ifndef OCAMLMAKEFILE - OCAMLMAKEFILE := OCamlMakefile -endif - -export OCAMLMAKEFILE - -ifndef OCAMLLIBPATH - OCAMLLIBPATH := \ - $(shell $(OCAMLC) 2>/dev/null -where || echo /usr/local/lib/ocaml) -endif - -export OCAMLLIBPATH - -ifndef OCAML_LIB_INSTALL - OCAML_LIB_INSTALL := $(OCAMLLIBPATH)/contrib -endif - -export OCAML_LIB_INSTALL - -########################################################################### - -#################### change following sections only if -#################### you know what you are doing! - -# delete target files when a build command fails -.PHONY: .DELETE_ON_ERROR -.DELETE_ON_ERROR: - -# for pedants using "--warn-undefined-variables" -export MAYBE_IDL -export REAL_RESULT -export CAMLIDLFLAGS -export THREAD_FLAG -export RES_CLIB -export MAKEDLL - -SHELL := /bin/sh - -MLDEPDIR := ._d -BCDIDIR := ._bcdi -NCDIDIR := ._ncdi - -FILTER_EXTNS := %.mli %.ml %.mll %.mly %.idl %.c %.$(EXT_CXX) %.rep %.zog - -FILTERED := $(filter $(FILTER_EXTNS), $(SOURCES)) -SOURCE_DIRS := $(filter-out ./, $(sort $(dir $(FILTERED)))) - -FILTERED_REP := $(filter %.rep, $(FILTERED)) -DEP_REP := $(FILTERED_REP:%.rep=$(MLDEPDIR)/%.d) -AUTO_REP := $(FILTERED_REP:.rep=.ml) - -FILTERED_ZOG := $(filter %.zog, $(FILTERED)) -DEP_ZOG := $(FILTERED_ZOG:%.zog=$(MLDEPDIR)/%.d) -AUTO_ZOG := $(FILTERED_ZOG:.zog=.ml) - -FILTERED_ML := $(filter %.ml, $(FILTERED)) -DEP_ML := $(FILTERED_ML:%.ml=$(MLDEPDIR)/%.d) - -FILTERED_MLI := $(filter %.mli, $(FILTERED)) -DEP_MLI := $(FILTERED_MLI:.mli=.di) - -FILTERED_MLL := $(filter %.mll, $(FILTERED)) -DEP_MLL := $(FILTERED_MLL:%.mll=$(MLDEPDIR)/%.d) -AUTO_MLL := $(FILTERED_MLL:.mll=.ml) - -FILTERED_MLY := $(filter %.mly, $(FILTERED)) -DEP_MLY := $(FILTERED_MLY:%.mly=$(MLDEPDIR)/%.d) $(FILTERED_MLY:.mly=.di) -AUTO_MLY := $(FILTERED_MLY:.mly=.mli) $(FILTERED_MLY:.mly=.ml) - -FILTERED_IDL := $(filter %.idl, $(FILTERED)) -DEP_IDL := $(FILTERED_IDL:%.idl=$(MLDEPDIR)/%.d) $(FILTERED_IDL:.idl=.di) -C_IDL := $(FILTERED_IDL:%.idl=%_stubs.c) $(FILTERED_IDL:.idl=.h) -OBJ_C_IDL := $(FILTERED_IDL:%.idl=%_stubs.$(EXT_OBJ)) -AUTO_IDL := $(FILTERED_IDL:.idl=.mli) $(FILTERED_IDL:.idl=.ml) $(C_IDL) - -FILTERED_C_CXX := $(filter %.c %.$(EXT_CXX), $(FILTERED)) -OBJ_C_CXX := $(FILTERED_C_CXX:.c=.$(EXT_OBJ)) -OBJ_C_CXX := $(OBJ_C_CXX:.$(EXT_CXX)=.$(EXT_OBJ)) - -PRE_TARGETS += $(AUTO_MLL) $(AUTO_MLY) $(AUTO_IDL) $(AUTO_ZOG) $(AUTO_REP) - -ALL_DEPS := $(DEP_ML) $(DEP_MLI) $(DEP_MLL) $(DEP_MLY) $(DEP_IDL) $(DEP_ZOG) $(DEP_REP) - -MLDEPS := $(filter %.d, $(ALL_DEPS)) -MLIDEPS := $(filter %.di, $(ALL_DEPS)) -BCDEPIS := $(MLIDEPS:%.di=$(BCDIDIR)/%.di) -NCDEPIS := $(MLIDEPS:%.di=$(NCDIDIR)/%.di) - -ALLML := $(filter %.mli %.ml %.mll %.mly %.idl %.rep %.zog, $(FILTERED)) - -IMPLO_INTF := $(ALLML:%.mli=%.mli.__) -IMPLO_INTF := $(foreach file, $(IMPLO_INTF), \ - $(basename $(file)).cmi $(basename $(file)).cmo) -IMPLO_INTF := $(filter-out %.mli.cmo, $(IMPLO_INTF)) -IMPLO_INTF := $(IMPLO_INTF:%.mli.cmi=%.cmi) - -IMPLX_INTF := $(IMPLO_INTF:.cmo=.cmx) - -INTF := $(filter %.cmi, $(IMPLO_INTF)) -IMPL_CMO := $(filter %.cmo, $(IMPLO_INTF)) -IMPL_CMX := $(IMPL_CMO:.cmo=.cmx) - -OBJ_LINK := $(OBJ_C_IDL) $(OBJ_C_CXX) -OBJ_FILES := $(IMPL_CMO:.cmo=.$(EXT_OBJ)) $(OBJ_LINK) - -EXECS := $(addsuffix $(EXE), \ - $(sort $(TOPRESULT) $(BCRESULT) $(NCRESULT))) -ifdef WIN32 - EXECS += $(BCRESULT).dll $(NCRESULT).dll -endif - -CLIB_BASE := $(RESULT)$(RES_CLIB_SUF) -ifneq ($(strip $(OBJ_LINK)),) - RES_CLIB := lib$(CLIB_BASE).$(EXT_LIB) -endif - -ifndef MSVC -DLLSONAME := dll$(CLIB_BASE).so -endif - -NONEXECS := $(INTF) $(IMPL_CMO) $(IMPL_CMX) $(OBJ_FILES) $(PRE_TARGETS) \ - $(BCRESULT).cma $(NCRESULT).cmxa $(NCRESULT).$(EXT_LIB) \ - $(BCRESULT).cmi $(BCRESULT).cmo \ - $(NCRESULT).cmi $(NCRESULT).cmx $(NCRESULT).o \ - $(RES_CLIB) - -ifndef MSVC - NONEXECS += $(DLLSONAME) -endif - -ifndef LIBINSTALL_FILES - LIBINSTALL_FILES := $(RESULT).mli $(RESULT).cmi $(RESULT).cma \ - $(RESULT).cmxa $(RESULT).a $(RES_CLIB) -endif - -ifndef MSVC - LIBINSTALL_FILES += $(DLLSONAME) -endif - -export LIBINSTALL_FILES - -ifdef WIN32 - # some extra stuff is created while linking DLLs - NONEXECS += $(BCRESULT).$(EXT_LIB) $(BCRESULT).exp $(NCRESULT).exp -endif - -TARGETS := $(EXECS) $(NONEXECS) - -# handle ocamlfind -ifdef USING_OCAMLFIND - PACKOPT := -pack -else - PACKOPT := -passopt "-pack" -endif - -# If there are IDL-files -ifneq ($(strip $(FILTERED_IDL)),) - MAYBE_IDL := -cclib -lcamlidl -endif - -ifdef USE_CAMLP4 - CAMLP4PATH := \ - $(shell $(CAMLP4) -where 2>/dev/null || echo /usr/local/lib/camlp4) - INCFLAGS := -I $(CAMLP4PATH) - CINCFLAGS := -I$(CAMLP4PATH) -endif - -INCFLAGS += $(SOURCE_DIRS:%=-I %) $(INCDIRS:%=-I %) $(OCAML_DEFAULT_DIRS:%=-I %) -CINCFLAGS += $(SOURCE_DIRS:%=-I%) $(INCDIRS:%=-I%) $(OCAML_DEFAULT_DIRS:%=-I%) -CLIBFLAGS += $(SOURCE_DIRS:%=-L%) $(LIBDIRS:%=-L%) \ - $(EXTLIBDIRS:%=-L%) $(EXTLIBDIRS:%=-R%) \ - $(OCAML_DEFAULT_DIRS:%=-L%) - -ifndef PROFILING - INTF_OCAMLC := $(OCAMLC) -else - ifndef THREADS - INTF_OCAMLC := $(OCAMLCP) -p $(OCAMLCPFLAGS) - else - # OCaml does not support profiling byte code - # with threads (yet), therefore we force an error. - ifndef REAL_OCAMLC - $(error Profiling of multithreaded byte code not yet supported by OCaml) - endif - endif -endif - -ifndef MSVC - COMMON_LDFLAGS := $(LDFLAGS:%=-ccopt %) $(SOURCE_DIRS:%=-ccopt -L%) \ - $(LIBDIRS:%=-ccopt -L%) \ - $(EXTLIBDIRS:%=-ccopt -L%) $(EXTLIBDIRS:%=-ccopt -R%) \ - $(OCAML_DEFAULT_DIRS:%=-ccopt -L%) -else - # currenly MSVC-build ocamlc/ocamlopt cannot pass any option to C linker :-( - COMMON_LDFLAGS := -endif - -ifndef MSVC - CLIBS_OPTS := $(CLIBS:%=-cclib -l%) -else - # MSVC libraries do not have 'lib' prefix - CLIBS_OPTS := $(CLIBS:%=-ccopt %) -endif -ifneq ($(strip $(OBJ_LINK)),) - ifdef CREATE_LIB - OBJS_LIBS := -cclib -l$(CLIB_BASE) $(CLIBS_OPTS) $(MAYBE_IDL) - else - OBJS_LIBS := $(OBJ_LINK) $(CLIBS_OPTS) $(MAYBE_IDL) - endif -else - OBJS_LIBS := $(CLIBS_OPTS) $(MAYBE_IDL) -endif - -# If we have to make byte-code -ifndef REAL_OCAMLC - # EXTRADEPS is added dependencies we have to insert for all - # executable files we generate. Ideally it should be all of the - # libraries we use, but it's hard to find the ones that get searched on - # the path since I don't know the paths built into the compiler, so - # just include the ones with slashes in their names. - EXTRADEPS := $(addsuffix .cma,$(foreach i,$(LIBS),$(if $(findstring /,$(i)),$(i)))) - SPECIAL_OCAMLFLAGS := $(OCAMLBCFLAGS) - - REAL_OCAMLC := $(INTF_OCAMLC) - - REAL_IMPL := $(IMPL_CMO) - REAL_IMPL_INTF := $(IMPLO_INTF) - IMPL_SUF := .cmo - - DEPFLAGS := - MAKE_DEPS := $(MLDEPS) $(BCDEPIS) - - ifdef CREATE_LIB - ifndef STATIC - ifneq ($(strip $(OBJ_LINK)),) - MAKEDLL := $(DLLSONAME) - ALL_LDFLAGS := -dllib $(DLLSONAME) - endif - endif - endif - - ifndef NO_CUSTOM - ifneq "$(strip $(OBJ_LINK) $(THREADS) $(MAYBE_IDL) $(CLIBS))" "" - ALL_LDFLAGS += -custom - endif - endif - - ALL_LDFLAGS += $(INCFLAGS) $(OCAMLLDFLAGS) $(OCAMLBLDFLAGS) \ - $(COMMON_LDFLAGS) $(LIBS:%=%.cma) - CAMLIDLDLLFLAGS := - - ifdef THREADS - ALL_LDFLAGS := -thread $(ALL_LDFLAGS) - ifndef CREATE_LIB - ALL_LDFLAGS := unix.cma threads.cma $(ALL_LDFLAGS) - endif - THREAD_FLAG := -thread - endif - -# we have to make native-code -else - EXTRADEPS := $(addsuffix .cmxa,$(foreach i,$(LIBS),$(if $(findstring /,$(i)),$(i)))) - ifndef PROFILING - SPECIAL_OCAMLFLAGS := $(OCAMLNCFLAGS) - PLDFLAGS := - else - SPECIAL_OCAMLFLAGS := -p $(OCAMLNCFLAGS) - PLDFLAGS := -p - endif - - REAL_IMPL := $(IMPL_CMX) - REAL_IMPL_INTF := $(IMPLX_INTF) - IMPL_SUF := .cmx - - CFLAGS := -DNATIVE_CODE $(CFLAGS) - - DEPFLAGS := -native - MAKE_DEPS := $(MLDEPS) $(NCDEPIS) - - ALL_LDFLAGS := $(PLDFLAGS) $(INCFLAGS) $(OCAMLLDFLAGS) \ - $(OCAMLNLDFLAGS) $(COMMON_LDFLAGS) - CAMLIDLDLLFLAGS := -opt - - ifndef CREATE_LIB - ALL_LDFLAGS += $(LIBS:%=%.cmxa) - endif - - ifdef THREADS - ALL_LDFLAGS := -thread $(ALL_LDFLAGS) - ifndef CREATE_LIB - ALL_LDFLAGS := unix.cmxa threads.cmxa $(ALL_LDFLAGS) - endif - THREAD_FLAG := -thread - endif -endif - -export MAKE_DEPS - -ALL_OCAMLCFLAGS := $(THREAD_FLAG) $(OCAMLFLAGS) \ - $(INCFLAGS) $(SPECIAL_OCAMLFLAGS) - -ifdef make_deps - -include $(MAKE_DEPS) - PRE_TARGETS := -endif - -########################################################################### -# USER RULES - -# Call "OCamlMakefile QUIET=" to get rid of all of the @'s. -QUIET=@ - -# generates byte-code (default) -byte-code: $(PRE_TARGETS) - $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) $(BCRESULT) \ - REAL_RESULT="$(BCRESULT)" make_deps=yes -bc: byte-code - -byte-code-nolink: $(PRE_TARGETS) - $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) nolink \ - REAL_RESULT="$(BCRESULT)" make_deps=yes -bcnl: byte-code-nolink - -top: $(PRE_TARGETS) - $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) $(TOPRESULT) \ - REAL_RESULT="$(BCRESULT)" make_deps=yes - -# generates native-code - -native-code: $(PRE_TARGETS) - $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) $(NCRESULT) \ - REAL_RESULT="$(NCRESULT)" \ - REAL_OCAMLC="$(OCAMLOPT)" \ - make_deps=yes -nc: native-code - -native-code-nolink: $(PRE_TARGETS) - $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) nolink \ - REAL_RESULT="$(NCRESULT)" \ - REAL_OCAMLC="$(OCAMLOPT)" \ - make_deps=yes -ncnl: native-code-nolink - -# generates byte-code libraries -byte-code-library: $(PRE_TARGETS) - $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) \ - $(RES_CLIB) $(BCRESULT).cma \ - REAL_RESULT="$(BCRESULT)" \ - CREATE_LIB=yes \ - make_deps=yes -bcl: byte-code-library - -# generates native-code libraries -native-code-library: $(PRE_TARGETS) - $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) \ - $(RES_CLIB) $(NCRESULT).cmxa \ - REAL_RESULT="$(NCRESULT)" \ - REAL_OCAMLC="$(OCAMLOPT)" \ - CREATE_LIB=yes \ - make_deps=yes -ncl: native-code-library - -ifdef WIN32 -# generates byte-code dll -byte-code-dll: $(PRE_TARGETS) - $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) \ - $(RES_CLIB) $(BCRESULT).dll \ - REAL_RESULT="$(BCRESULT)" \ - make_deps=yes -bcd: byte-code-dll - -# generates native-code dll -native-code-dll: $(PRE_TARGETS) - $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) \ - $(RES_CLIB) $(NCRESULT).dll \ - REAL_RESULT="$(NCRESULT)" \ - REAL_OCAMLC="$(OCAMLOPT)" \ - make_deps=yes -ncd: native-code-dll -endif - -# generates byte-code with debugging information -debug-code: $(PRE_TARGETS) - $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) $(BCRESULT) \ - REAL_RESULT="$(BCRESULT)" make_deps=yes \ - OCAMLFLAGS="-g $(OCAMLFLAGS)" \ - OCAMLLDFLAGS="-g $(OCAMLLDFLAGS)" -dc: debug-code - -# generates byte-code libraries with debugging information -debug-code-library: $(PRE_TARGETS) - $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) \ - $(RES_CLIB) $(BCRESULT).cma \ - REAL_RESULT="$(BCRESULT)" make_deps=yes \ - CREATE_LIB=yes \ - OCAMLFLAGS="-g $(OCAMLFLAGS)" \ - OCAMLLDFLAGS="-g $(OCAMLLDFLAGS)" -dcl: debug-code-library - -# generates byte-code for profiling -profiling-byte-code: $(PRE_TARGETS) - $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) $(BCRESULT) \ - REAL_RESULT="$(BCRESULT)" PROFILING="y" \ - make_deps=yes -pbc: profiling-byte-code - -# generates native-code - -profiling-native-code: $(PRE_TARGETS) - $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) $(NCRESULT) \ - REAL_RESULT="$(NCRESULT)" \ - REAL_OCAMLC="$(OCAMLOPT)" \ - PROFILING="y" \ - make_deps=yes -pnc: profiling-native-code - -# generates byte-code libraries -profiling-byte-code-library: $(PRE_TARGETS) - $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) \ - $(RES_CLIB) $(BCRESULT).cma \ - REAL_RESULT="$(BCRESULT)" PROFILING="y" \ - CREATE_LIB=yes \ - make_deps=yes -pbcl: profiling-byte-code-library - -# generates native-code libraries -profiling-native-code-library: $(PRE_TARGETS) - $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) \ - $(RES_CLIB) $(NCRESULT).cmxa \ - REAL_RESULT="$(NCRESULT)" PROFILING="y" \ - REAL_OCAMLC="$(OCAMLOPT)" \ - CREATE_LIB=yes \ - make_deps=yes -pncl: profiling-native-code-library - -# packs byte-code objects -pack-byte-code: $(PRE_TARGETS) - $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) $(BCRESULT).cmo \ - REAL_RESULT="$(BCRESULT)" \ - PACK_LIB=yes make_deps=yes -pabc: pack-byte-code - -# packs native-code objects -pack-native-code: $(PRE_TARGETS) - $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) \ - $(NCRESULT).cmx $(NCRESULT).o \ - REAL_RESULT="$(NCRESULT)" \ - REAL_OCAMLC="$(OCAMLOPT)" \ - PACK_LIB=yes make_deps=yes -panc: pack-native-code - -# generates HTML-documentation -htdoc: doc/html - -# generates Latex-documentation -ladoc: doc/latex - -# generates PostScript-documentation -psdoc: doc/latex/doc.ps - -# generates PDF-documentation -pdfdoc: doc/latex/doc.pdf - -# generates all supported forms of documentation -doc: htdoc ladoc psdoc pdfdoc - -########################################################################### -# LOW LEVEL RULES - -$(REAL_RESULT): $(REAL_IMPL_INTF) $(OBJ_LINK) $(EXTRADEPS) - $(REAL_OCAMLC) $(ALL_LDFLAGS) $(OBJS_LIBS) -o $@$(EXE) \ - $(REAL_IMPL) -ifdef MSVC -# work around the bug in ocamlc -- it should delete this file itself - rm -f camlprim?.$(EXT_OBJ) -endif - -nolink: $(REAL_IMPL_INTF) $(OBJ_LINK) - -ifdef WIN32 -$(REAL_RESULT).dll: $(REAL_IMPL_INTF) $(OBJ_LINK) - $(CAMLIDLDLL) $(CAMLIDLDLLFLAGS) $(OBJ_LINK) $(CLIBS) \ - -o $@ $(REAL_IMPL) -endif - -%$(TOPSUFFIX): $(REAL_IMPL_INTF) $(OBJ_LINK) $(EXTRADEPS) - $(OCAMLMKTOP) $(ALL_LDFLAGS) $(OBJS_LIBS) -o $@$(EXE) \ - $(REAL_IMPL) -ifdef MSVC -# work around the bug in ocamltop -- it should delete this file itself - rm -f camlprim?.$(EXT_OBJ) -endif - -.SUFFIXES: .mli .ml .cmi .cmo .cmx .cma .cmxa .$(EXT_OBJ) \ - .mly .di .d .$(EXT_LIB) .idl .c .$(EXT_CXX) .h .so \ - .rep .zog -ifndef MSVC -$(DLLSONAME): $(OBJ_LINK) - $(CC) -shared $(CINCFLAGS) $(CLIBFLAGS) \ - -o $@ $(OBJ_LINK) $(CLIBS:%=-l%) -endif - -$(RESULT).cma: $(REAL_IMPL_INTF) $(MAKEDLL) $(EXTRADEPS) - $(REAL_OCAMLC) -a $(ALL_LDFLAGS) \ - $(OBJS_LIBS) -o $@ $(OCAMLBLDFLAGS) $(REAL_IMPL) - -$(RESULT).cmxa $(RESULT).$(EXT_LIB): $(REAL_IMPL_INTF) $(EXTRADEPS) - $(OCAMLOPT) -a $(ALL_LDFLAGS) $(OBJS_LIBS) \ - $(OCAMLNLDFLAGS) -o $@ $(REAL_IMPL) - -$(RES_CLIB): $(OBJ_LINK) -ifndef MSVC - ifneq ($(strip $(OBJ_LINK)),) - ar rc $@ $(OBJ_LINK) - ranlib $@ - endif -else - ifneq ($(strip $(OBJ_LINK)),) - lib /nologo /debugtype:cv /out:$(RES_CLIB) $(OBJ_LINK) - endif -endif - -.mli.cmi: $(EXTRADEPS) - $(QUIET)pp=`sed -n -e 's/(\*pp \([^*]*\) \*)/\1/p;q' $<`; \ - if [ -z "$$pp" ]; then \ - echo $(INTF_OCAMLC) -c $(THREAD_FLAG) \ - $(OCAMLFLAGS) $(INCFLAGS) $<; \ - $(INTF_OCAMLC) -c $(THREAD_FLAG) $(OCAMLFLAGS) \ - $(INCFLAGS) $<; \ - else \ - echo $(INTF_OCAMLC) -c -pp \"$$pp\" $(THREAD_FLAG) \ - $(OCAMLFLAGS) $(INCFLAGS) $<; \ - $(INTF_OCAMLC) -c -pp "$$pp" $(THREAD_FLAG) \ - $(OCAMLFLAGS) $(INCFLAGS) $<; \ - fi - -.ml.cmi .ml.$(EXT_OBJ) .ml.cmx .ml.cmo: $(EXTRADEPS) - $(QUIET)pp=`sed -n -e 's/(\*pp \([^*]*\) \*)/\1/p;q' $<`; \ - if [ -z "$$pp" ]; then \ - echo $(REAL_OCAMLC) -c $(ALL_OCAMLCFLAGS) $<; \ - $(REAL_OCAMLC) -c $(ALL_OCAMLCFLAGS) $<; \ - else \ - echo $(REAL_OCAMLC) -c -pp \"$$pp\" \ - $(ALL_OCAMLCFLAGS) $<; \ - $(REAL_OCAMLC) -c -pp "$$pp" $(ALL_OCAMLCFLAGS) $<; \ - fi - -ifdef PACK_LIB -$(REAL_RESULT).cmo $(REAL_RESULT).cmx $(REAL_RESULT).o: $(REAL_IMPL_INTF) $(OBJ_LINK) $(EXTRADEPS) - $(REAL_OCAMLC) $(PACKOPT) $(ALL_LDFLAGS) \ - $(OBJS_LIBS) -o $@ $(REAL_IMPL) -endif - -.PRECIOUS: %.ml -%.ml: %.mll - $(OCAMLLEX) $< - -.PRECIOUS: %.ml %.mli -%.ml %.mli: %.mly - $(OCAMLYACC) $(YFLAGS) $< - -.PRECIOUS: %.ml -%.ml : %.rep - $(CAMELEON_REPORT) $(CAMELEON_REPORT_FLAGS) -gen $< - -.PRECIOUS: %.ml -%.ml : %.zog - $(CAMELEON_ZOGGY) $(CAMELEON_ZOGGY_FLAGS) -impl $< > $@ - -.PRECIOUS: %.ml %.mli %_stubs.c %.h -%.ml %.mli %_stubs.c %.h: %.idl - $(CAMLIDL) $(MAYBE_IDL_HEADER) $(IDLFLAGS) \ - $(CAMLIDLFLAGS) $< - $(QUIET)if [ $(NOIDLHEADER) ]; then touch $*.h; fi - -.c.$(EXT_OBJ): - $(CC) -c $(CFLAGS) $(CINCFLAGS) -I$(OCAMLLIBPATH) \ - $< $(CFLAG_O)$@ - -.$(EXT_CXX).$(EXT_OBJ): - $(CXX) -c $(CXXFLAGS) $(CINCFLAGS) -I$(OCAMLLIBPATH) \ - $< $(CFLAG_O)$@ - -$(MLDEPDIR)/%.d: %.ml - $(QUIET)echo making $@ from $< - $(QUIET)if [ ! -d $(@D) ]; then mkdir -p $(@D); fi - $(QUIET)pp=`sed -n -e 's/(\*pp \([^*]*\) \*)/\1/p;q' $<`; \ - if [ -z "$$pp" ]; then \ - $(OCAMLDEP) $(INCFLAGS) $< > $@; \ - else \ - $(OCAMLDEP) -pp "$$pp" $(INCFLAGS) $< > $@; \ - fi - -$(BCDIDIR)/%.di $(NCDIDIR)/%.di: %.mli - $(QUIET)echo making $@ from $< - $(QUIET)if [ ! -d $(@D) ]; then mkdir -p $(@D); fi - $(QUIET)pp=`sed -n -e 's/(\*pp \([^*]*\) \*)/\1/p;q' $<`; \ - if [ -z "$$pp" ]; then \ - $(OCAMLDEP) $(DEPFLAGS) $(INCFLAGS) $< > $@; \ - else \ - $(OCAMLDEP) $(DEPFLAGS) \ - -pp "$$pp" $(INCFLAGS) $< > $@; \ - fi - -doc/html: $(DOC_FILES) - rm -rf $@ - mkdir -p $@ - $(OCAMLDOC) -html -d $@ $(OCAMLDOCFLAGS) $(DOC_FILES) - -doc/latex: $(DOC_FILES) - rm -rf $@ - mkdir -p $@ - $(OCAMLDOC) -latex -d $@ $(OCAMLDOCFLAGS) $(DOC_FILES) -o doc.tex - -doc/latex/doc.ps: doc/latex - cd doc/latex && \ - $(LATEX) doc.tex && \ - $(LATEX) doc.tex && \ - $(DVIPS) $(DVIPSFLAGS) doc.dvi -o $(@F) - -doc/latex/doc.pdf: doc/latex/doc.ps - cd doc/latex && $(PS2PDF) $( [] -let fstfst ((e, _), _) = e -let sndfst ((_, e), _) = e -let fstsnd (_, (e, _)) = e -let sndsnd (_, (_, e)) = e - -let fst3 (e, _, _) = e -let snd3 (_, e, _) = e -let ter3 (_, _, e) = e -let sndter3 (_, a, b) = (a, b) - -let o f g x = f (g x) -let curry f x y = f (x,y) -let uncurry f (x, y) = f x y - -let is_int n = ceil n = n - -let uncons = function - | [] -> failwith "uncons" - | e::l -> e,l - -let has_env var = - try - let _ = Sys.getenv var in true - with Not_found -> false - -let some = function - | Some e -> e - | None -> failwith "some" - -let some_or = function - | None -> id - | Some e -> fun _ -> e - -let option2l = function - | None -> [] - | Some e -> [e] - -let prefer_some f a b = - match a, b with - | Some a, Some b -> Some (f a b) - | None, _ -> b - | _, None -> a - -let rec collect_accu f accu = function - | [] -> accu - | e::l -> collect_accu f (rev_append (f e) accu) l - -let collect f l = rev (collect_accu f [] l) - -let merge_some merge a b = - match a,b with - | None, None -> None - | _, None -> a - | None, _ -> b - | Some(a), Some(b) -> Some(merge a b) - -let rec uniq = function - | [] -> [] - | e::l -> if mem e l then uniq l else e :: uniq l - -let rec uniq_ eq = function - | [] -> [] - | e::l -> - try - let _ = find (eq e) l in - uniq_ eq l - with Not_found -> e :: uniq_ eq l - -let rec non_uniq = function - | [] -> [] - | e::l -> if mem e l then e :: non_uniq l else non_uniq l - -let rec member_ eq e = function - | [] -> false - | e'::l -> if eq e e' then true else member_ eq e l - -let rec find_some p = function - | [] -> raise Not_found - | x :: l -> - match p x with - | Some v -> v - | None -> find_some p l - -let fold_left1 f = function - | [] -> failwith "fold_left1" - | e :: l -> fold_left f e l - -let find_index e l = - let rec find_index_ i = function - | [] -> raise Not_found - | e'::l -> if e=e' then i else find_index_ (i+1) l - in - find_index_ 0 l - -let rec find_some_ p = function - | [] -> None - | x :: l -> - match p x with - | Some v -> Some v - | None -> find_some_ p l - -let rec fpartition p l = - let rec part yes no = function - | [] -> (rev yes, rev no) - | x :: l -> - (match p x with - | None -> part yes (x :: no) l - | Some v -> part (v :: yes) no l) in - part [] [] l - -let partition_either f l = - let rec part_either left right = function - | [] -> (rev left, rev right) - | x :: l -> - (match f x with - | Left e -> part_either (e :: left) right l - | Right e -> part_either left (e :: right) l) in - part_either [] [] l - -let rec keep_best f = - let rec partition e = function - | [] -> e, [] - | e' :: l -> - match f(e,e') with - | None -> let (e'', l') = partition e l in e'', e' :: l' - | Some e'' -> partition e'' l - in function - | [] -> [] - | e::l -> - let (e', l') = partition e l in - e' :: keep_best f l' - -let rec keep_bests f l = - let rec once e unchanged = function - | [] -> None - | e' :: l -> - match f(e,e') with - | None -> once e (e' :: unchanged) l - | Some e'' -> Some(e'', unchanged @ l) - in - let rec as_many_as_possible e l = - match once e [] l with - | None -> None - | Some(e', l') -> Some(some_or (as_many_as_possible e' l') (e', l')) - in - let rec try_with e l_done l_next = - match as_many_as_possible e l_next with - | None -> try_with_next (e :: l_done) l_next - | Some(e2, l_next2) -> - match as_many_as_possible e2 l_done with - | None -> try_with_next (e2 :: l_done) l_next2 - | Some(e3, l_done2) -> try_with e3 l_done2 l_next2 - and try_with_next l_done = function - | [] -> rev l_done - | e::l_next -> try_with e l_done l_next - in - try_with_next [] l - -let rec fold_right1 f = function - | [] -> failwith "fold_right1" - | [e] -> e - | e::l -> f e (fold_right1 f l) - -let rec for_all2_ p l1 l2 = - match (l1, l2) with - ([], []) -> true - | (a1::l1, a2::l2) -> p a1 a2 && for_all2_ p l1 l2 - | (_, _) -> false - -let rec for_all2_true p l1 l2 = - match (l1, l2) with - | (a1::l1, a2::l2) -> p a1 a2 && for_all2_true p l1 l2 - | (_, _) -> true - -let maxl l = fold_right1 max l - -let rec stack2list s = - let l = ref [] in - Stack.iter (fun e -> l := e :: !l) s ; - !l - -let rec stack_exists f s = - try - Stack.iter (fun e -> if f e then raise Found) s ; - false - with Found -> true - -let rec queue2list q = rev (Queue.fold (fun b a -> a :: b) [] q) - -let rec fix_point f p = - let p' = f p in - if p = p' then p else fix_point f p' - -let rec fix_point_withenv f env p = - let p', env' = f env p in - if p = p' then (p, env') else fix_point_withenv f env' p' - -let rec fix_point_ nb f p = - let p' = f p in - if p = p' then p, nb else fix_point_ (nb+1) f p' - -let rec group_by_2 = function - | [] -> [] - | a :: b :: l -> (a, b) :: group_by_2 l - | _ -> failwith "group_by_2" - -(* -let rec lfix_point f e = - let e' = f(e) in - if e = e' then e :: lfix_point f e' else [e] -*) - -let fluid_let ref value f = - let previous_val = !ref in - ref := value ; - let v = f() in - ref := previous_val ; - v - -let do0_withenv doit f env l = - let r_env = ref env in - doit (fun e -> r_env := f !r_env e) l ; - !r_env - -let do0_withenv2 doit f env l = - let r_env = ref env in - doit (fun e e' -> r_env := f !r_env e e') l ; - !r_env - -let do_withenv doit f env l = - let r_env = ref env in - let l' = doit (fun e -> - let e', env' = f !r_env e in - r_env := env' ; e' - ) l in - l', !r_env - -let do2_withenv doit f env l1 l2 = - let r_env = ref env in - let l' = doit (fun e1 e2 -> - let e', env' = f !r_env e1 e2 in - r_env := env' ; e' - ) l1 l2 in - l', !r_env - -let do_collect doit f l1 = - let l = ref [] in - doit (fun i t -> l := f i t @ !l) l1 ; - !l - -let map_withitself f l = - let rec map_withitself_ done_ = function - | [] -> done_ - | e :: l -> - let e' = f (done_ @ e :: l) e in - map_withitself_ (done_ @ [ e' ]) l - in map_withitself_ [] l - -let map_t2 f (x,y) = f x, f y -let map_t3 f (x,y,z) = f x, f y, f z -let map_option f = function - | Some e -> Some (f e) - | None -> None -let map_optionoption f = function - | Some e -> f e - | None -> None -let t2_option2option_t2 = function - | (Some x, Some y) -> Some(x,y) - | _ -> None -let rec l_option2option_l = function - | [] -> Some [] - | None :: _l -> None - | Some e :: l -> map_option (fun l -> e :: l) (l_option2option_l l) -let map_option_env f (e, env) = map_option f e, env - -let t2_to_list (a,b) = [ a ; b ] -let t3_to_list (a,b,c) = [ a ; b ; c ] - -let if_some bool val_ = if bool then Some val_ else None - -let rec fold_left_option f val_ = function - | [] -> Some val_ - | e::l -> - match f val_ e with - | None -> None - | Some val_' -> fold_left_option f val_' l - -let collect_some_withenv f env l = - let rec collect accu env = function - | [] -> rev accu, env - | e::l -> - let e', env' = f env e in - let accu' = - match e' with - | Some e' -> e'::accu - | None -> accu in - collect accu' env' l - in collect [] env l - -let for_all_option_withenv remap f env l = - let rec for_all env accu = function - | [] -> Some(remap (rev accu)), env - | e::l -> - (match f env e with - | None, env' -> None, env' - | Some e', env' -> for_all env' (e' :: accu) l) - in - for_all env [] l - -let for_all2_option_withenv remap f env la lb = - let rec for_all env accu = function - | [], [] -> Some(remap (rev accu)), env - | a::la, b::lb -> - (match f env a b with - | None, env' -> None, env' - | Some ab, env' -> for_all env' (ab :: accu) (la, lb)) - | _ -> None, env - in - for_all env [] (la, lb) - -let map_or_option f = function - | Or_some e -> Or_some (f e) - | Or_error err -> Or_error err - -let map_index f l = - let rec map_ n = function - | [] -> [] - | e::l -> f e n :: map_ (n+1) l - in map_ 0 l - -let filter_index f l = - let rec filter_ n = function - | [] -> [] - | e::l -> - let l' = filter_ (n+1) l in - if f e n then e :: l' else l' - in filter_ 0 l - -let iter_index f l = - let rec iter_ n = function - | [] -> () - | e::l -> f e n ; iter_ (n+1) l - in iter_ 0 l - -let map_fst f (x, y) = f x, y -let map_snd f (x, y) = x, f y - -let map_withenv f env e = do_withenv map f env e -let find_withenv f env e = do_withenv find f env e -let filter_withenv f env e = do_withenv filter f env e -let exists_withenv f env e = do_withenv exists f env e -let map_t2_withenv f env e = do_withenv map_t2 f env e -let for_all_withenv f env e = do_withenv for_all f env e -let collect_withenv f env e = do_withenv collect f env e -let partition_either_withenv f env e = do_withenv partition_either f env e - -let map2_withenv f env l1 l2 = do2_withenv map2 f env l1 l2 -let for_all2_withenv f env l1 l2 = do2_withenv for_all2 f env l1 l2 - -let rec take n l = - if n = 0 then [] - else match l with - | [] -> raise Not_found - | e::l -> e :: take (n-1) l -let last_n n l = rev (take n (rev l)) -let last l = hd (last_n 1 l) - -let rec skipfirst e = function - | [] -> [] - | e'::l when e = e' -> skipfirst e l - | l -> l - -let rec removelast = function - | [] -> failwith "removelast" - | [_] -> [] - | e::l -> e :: removelast l - -let rec split_last l = - let rec spl accu = function - | [] -> failwith "split_last" - | [e] -> rev accu, e - | e::l -> spl (e :: accu) l - in spl [] l - -let iter_assoc_val f l = iter (fun (_,v) -> f v) l -let map_assoc_val f l = map (fun (k,v) -> k, f v) l - -let assoc_or_fail e l = - try assoc e l with Not_found -> failwith "assoc failed" - -let assoc_by is_same e l = - find_some (fun (a,b) -> if is_same e a then Some b else None) l - -let rec update_assoc_by is_same f e = function - | [] -> raise Not_found - | (a,b) :: l when is_same e a -> (a, f b) :: l - | (a,b) :: l -> (a,b) :: update_assoc_by is_same f e l - -let update_assoc f e = update_assoc_by (=) f e - -let rec update_assoc_by_with_default default is_same f e = function - | [] -> [ e, f default ] - | (a,b) :: l when is_same e a -> (a, f b) :: l - | (a,b) :: l -> (a,b) :: update_assoc_by_with_default default is_same f e l - -let update_all_assoc_by is_same f e l = - map (fun (a,b) -> a, if is_same e a then f b else b) l - -let rec rassoc e = function - | [] -> raise Not_found - | (k,v) :: l -> if e = v then k else rassoc e l - -let rec all_assoc e = function - | [] -> [] - | (e',v) :: l when e=e' -> v :: all_assoc e l - | _ :: l -> all_assoc e l - -let rec all_assoc_by is_same e = function - | [] -> [] - | (e',v) :: l when is_same e e' -> v :: all_assoc_by is_same e l - | _ :: l -> all_assoc_by is_same e l - -let prepare_want_all_assoc l = - map (fun n -> n, uniq (all_assoc n l)) (uniq (map fst l)) - -let prepare_want_all_assoc_by is_same l = - map (fun n -> n, uniq_ is_same (all_assoc_by is_same n l)) (uniq_ is_same (map fst l)) - -let prepare_want_all_assoc_by_ is_same_a is_same_b l = - map (fun n -> n, uniq_ is_same_b (all_assoc_by is_same_a n l)) (uniq_ is_same_a (map fst l)) - -let rec count_uniq = function - | [] -> [] - | e::l -> - let has, l' = partition ((=) e) l in - (e, length has + 1) :: count_uniq l' - -let rec repeat e = function - | 0 -> [] - | n -> e :: repeat e (n-1) - -let rec inits = function - | [] -> [[]] - | e::l -> [] :: map (fun l -> e::l) (inits l) -let rec tails = function - | [] -> [[]] - | (_::xs) as xxs -> xxs :: tails xs - -let apply f x = f x;; - -let rec map3 f l1 l2 l3 = - match (l1, l2, l3) with - ([], [], []) -> [] - | (a1::l1, a2::l2, a3::l3) -> let r = f a1 a2 a3 in r :: map3 f l1 l2 l3 - | (_, _, _) -> invalid_arg "map3" - -let filter2 f l1 l2 = - split (filter f (combine l1 l2)) - -let break_at f l = - let rec b l1 = function - | [] -> l1, [] - | e::l2 -> if f e then (l1, e :: l2) else b (l1 @ [e]) l2 - in b [] l -let break v l = break_at ((=) v) l - -let drop_while f l = snd (break_at (fun e -> not (f e)) l) - -(* break_at_indice 0 [1;2] gives [], [1;2] - break_at_indice 1 [1;2] gives [1], [2] - *) -let rec break_at_indice i l = - if i = 0 then [], l else - match l with - | [] -> raise Not_found - | e::l2 -> - let a, b = break_at_indice (i-1) l2 in - e::a, b - -let rev_nth e l = - let rec rev_nth' i = function - | [] -> raise Not_found - | e'::_ when e'=e -> i - | _::l -> rev_nth' (i+1) l - in rev_nth' 0 l - -let rec getset_nth l i f = - match l, i with - | e::l', 0 -> f e :: l' - | [], _ -> failwith "getset_nth" - | e::l', _ -> e :: getset_nth l' (i - 1) f - -let set_nth l i v = getset_nth l i (fun _ -> v) - -let adjustModDown m n = n - (n mod m) -let adjustModUp m n = adjustModDown m (n + m - 1) - - -let hashtbl_find f h = - let r = ref None in - Hashtbl.iter (fun v c -> if f v c then r := Some v) h ; - match !r with - | Some v -> v - | None -> raise Not_found - -let hashtbl_map f h = Hashtbl.iter (fun v c -> Hashtbl.replace h v (f v c)) h - -let hashtbl_values h = Hashtbl.fold (fun _ v l -> v :: l) h [] -let hashtbl_keys h = Hashtbl.fold (fun k _ l -> k :: l) h [] -let hashtbl_to_list h = Hashtbl.fold (fun k v l -> (k,v) :: l) h [] - -let hashtbl_collect f h = - rev (Hashtbl.fold (fun k v l -> rev_append (f k v) l) h []) - -let hashtbl_exists f h = - try - Hashtbl.iter (fun v c -> if f v c then raise Found) h ; - false - with Found -> true - -let memoize f = - let hash = Hashtbl.create 16 in - fun k -> - try Hashtbl.find hash k - with Not_found -> - let v = f k in - Hashtbl.add hash k v ; v - -let array_shift a = Array.sub a 1 (Array.length a - 1) -let array_last_n n a = - let len = Array.length a in - Array.sub a (len - n) n - -let array_collect f a = Array.fold_left (fun l e -> f e @ l) [] a - -let rec lvector_product = - let rec vector_product a b = match a with - | [] -> [] - | e::l -> map (fun e' -> e :: e') b :: vector_product l b - in function - | [] -> [] - | [e] -> map (fun e -> [e]) e - | e::l -> flatten (vector_product e (lvector_product l)) - -let vector_product2 a b = - map (function - | [a;b] -> a,b - | _ -> failwith "vector_product2" - ) (lvector_product [ a ; b ]) - -let rec transpose = function - | [] :: _ -> [] - | ll -> - let l, ll' = split (map (function e::l -> e,l | _ -> raise Not_found) ll) in - l :: transpose ll' - -let rec range min max = - if min >= max then [] else min :: range (min + 1) max - -let sum l = List.fold_left (+) 0 l - -let rec filter_some_with f = function - | [] -> [] - | e :: l -> - match f e with - | None -> filter_some_with f l - | Some e' -> e' :: filter_some_with f l - -let rec filter_some = function - | [] -> [] - | None :: l -> filter_some l - | Some e :: l -> e :: filter_some l - -let rec difference l = function - | [] -> l - | e::l' -> difference (filter ((<>) e) l) l' - -let rec difference_ eq l = function - | [] -> l - | e::l' -> - let l2 = filter (fun e' -> not (eq e e')) l in - difference_ eq l2 l' - -let intersection_by is_same l1 l2 = filter (fun e -> exists (is_same e) l2) l1 - -let intersection_and_differences eq l1 l2 = - let rec both inter l2_only = function - | [], l2 -> inter, [], rev l2_only @ l2 - | l1, [] -> inter, l1, rev l2_only - | l1, e2 :: l2' -> - match partition (eq e2) l1 with - | [], _ -> both inter (e2 :: l2_only) (l1, l2') - | _, l1' -> both (e2 :: inter) l2_only (l1', l2') - in both [] [] (l1, l2) - -let rec triangularize = function - | [] -> [] - | e::l -> (e,l) :: triangularize l - -let diagonalize l = - map_index (fun a i -> - a, filter_index (fun _ j -> i <> j) l - ) l - -let rec list_of_nonempty_sublists = function - | [] -> [] - | e :: l -> - let l' = list_of_nonempty_sublists l in - [e] :: l' @ map (fun l -> e :: l) l' - -let rec graph_is_sorted_by eq = function - | [] -> true - | (_,deps) :: l -> - for_all (fun e -> try let _ = assoc_by eq e l in false with Not_found -> true) deps && graph_is_sorted_by eq l - -let graph_closure_by eq graph = - let err = ref None in - try - let graph_rev = collect (fun (i, l) -> map (fun e -> (e, i)) l) graph in - let bothway = map (fun (i,l) -> i, (l, all_assoc_by eq i graph_rev)) graph in - let closed = fold_left (fun graph j -> - let next, prev = assoc_by eq j graph in - let graph2 = fold_left (fun graph i -> - if member_ eq i next then (err := Some(j,i); raise GraphSort_circular_deps) else - update_assoc_by eq (fun (i_next,i_prev) -> i_next @ next, i_prev) i graph - ) graph (filter (fun a -> not (eq a j)) prev) in - let graph3 = fold_left (fun graph k -> - if member_ eq k prev then (err := Some(j,k); raise GraphSort_circular_deps) else - update_assoc_by eq (fun (k_next,k_prev) -> k_next, k_prev @ prev) k graph - ) graph2 (filter (fun a -> not (eq a j)) next) in - graph3 - ) bothway (map fst bothway) in - Or_some (map (fun (e,(next,_)) -> e, uniq_ eq next) closed) - with GraphSort_circular_deps -> - Or_error (some !err) - -let rec graph_sort_by eq l = - let cmp (_, deps_a) (b, _) = if member_ eq b deps_a then 1 else -1 in - let rec sort_it = function - | [] -> [] - | [e] -> [e] - | e::l -> - let l' = sort_it l in - let gt, lt = break_at (fun ((_, deps) as e') -> deps = [] or cmp e e' = 1) l' in - gt @ [e] @ lt - in - map_or_option (fun l' -> - let l_sorted = rev (sort_it l') in - if not (graph_is_sorted_by eq l_sorted) then internal_error "graph_sort failed" else - l_sorted - ) (graph_closure_by eq l) - -let int_sort l = sort (fun a b -> a - b) l - -let str_begins_with prefix s = - String.sub s 0 (min (String.length s) (String.length prefix)) = prefix - -let rec strstr s subs = - let len_s, len_subs = String.length s, String.length subs in - let rec rec_ i = - let i' = String.index_from s i subs.[0] in - if i' + len_subs <= len_s then - if String.sub s i' len_subs = subs then - i' - else - rec_ (i' + 1) - else - raise Not_found - in - rec_ 0 - -let str_contains s subs = - try - let _ = strstr s subs in true - with Not_found -> false - -let str_ends_with s suffix = - let len = min (String.length s) (String.length suffix) in - String.sub s (String.length s - len) len = suffix - -let chop = function - | "" -> "" - | s -> String.sub s 0 (String.length s - 1) - -let chomps s = - let i = ref (String.length s - 1) in - while !i >= 0 && (s.[!i] = ' ' || s.[!i] = '\t') do decr i done ; - String.sub s 0 (!i+1) - -let rec times e = function - | 0 -> [] - | n -> e :: times e (n-1) - -let skip_n_char_ beg end_ s = - let full_len = String.length s in - if beg < full_len && full_len - beg - end_ > 0 - then String.sub s beg (full_len - beg - end_) - else "" -let skip_n_char n s = skip_n_char_ n 0 s - -let rec non_index_from s beg c = - if s.[beg] = c then non_index_from s (beg+1) c else beg -let non_index s c = non_index_from s 0 c - -let rec non_rindex_from s beg c = - if s.[beg] = c then non_rindex_from s (beg-1) c else beg -let non_rindex s c = non_rindex_from s (String.length s - 1) c - -let rec explode_string = function - | "" -> [] - | s -> (String.get s 0) :: explode_string (String.sub s 1 (String.length s - 1)) - -let count_matching_char s c = - let rec count_matching_char_ nb i = - try - let i' = String.index_from s i c in - count_matching_char_ (nb+1) (i'+1) - with Not_found -> nb - in - count_matching_char_ 0 0 - -let is_uppercase c = Char.lowercase c <> c -let is_lowercase c = Char.uppercase c <> c - -let char_is_alphanumerical c = - let i = Char.code c in - Char.code 'a' <= i && i <= Char.code 'z' || - Char.code 'A' <= i && i <= Char.code 'Z' || - Char.code '0' <= i && i <= Char.code '9' - -let char_is_alphanumerical_ c = - let i = Char.code c in - Char.code 'a' <= i && i <= Char.code 'z' || - Char.code 'A' <= i && i <= Char.code 'Z' || - Char.code '0' <= i && i <= Char.code '9' || c = '_' - -let char_is_alpha c = - let i = Char.code c in - Char.code 'a' <= i && i <= Char.code 'z' || - Char.code 'A' <= i && i <= Char.code 'Z' - -let char_is_number c = - let i = Char.code c in - Char.code '0' <= i && i <= Char.code '9' - -let count_chars_in_string s c = - let rec rec_count_chars_in_string from = - try - let from' = String.index_from s from c in - 1 + rec_count_chars_in_string (from' + 1) - with - Not_found -> 0 - in rec_count_chars_in_string 0 - -let rec string_fold_left f val_ s = - let val_ = ref val_ in - for i = 0 to String.length s - 1 do - val_ := f !val_ s.[i] - done ; - !val_ - -(* -let rec string_forall_with f i s = - try - f s.[i] && string_forall_with f (i+1) s - with Invalid_argument _ -> true -*) -let string_forall_with f i s = - let len = String.length s in - let rec string_forall_with_ i = - i >= len || f s.[i] && string_forall_with_ (i+1) - in string_forall_with_ i - -let starts_with_non_lowercase s = s <> "" && s.[0] <> '_' && not (is_lowercase s.[0]) - -let rec fold_lines f init chan = - try - let line = input_line chan in - fold_lines f (f init line) chan - with End_of_file -> init -let readlines chan = List.rev (fold_lines (fun l e -> e::l) [] chan) - -let split_at c s = - let rec split_at_ accu i = - try - let i' = String.index_from s i c in - split_at_ (String.sub s i (i' - i) :: accu) (i'+1) - with Not_found -> rev (skip_n_char i s :: accu) - in - split_at_ [] 0 - -let split_at2 c1 c2 s = - let rec split_at2_ accu i i2 = - try - let i3 = String.index_from s i2 c1 in - if s.[i3+1] = c2 then split_at2_ (String.sub s i (i3 - i) :: accu) (i3+2) (i3+2) else - split_at2_ accu i i3 - with Not_found | Invalid_argument _ -> rev (skip_n_char i s :: accu) - in - split_at2_ [] 0 0 - -let words s = - let rec words_ accu i s = - try - let i2 = non_index_from s i ' ' in - try - let i3 = String.index_from s i2 ' ' in - words_ (String.sub s i2 (i3 - i2) :: accu) (i3+1) s - with Not_found -> rev (skip_n_char i2 s :: accu) - with Invalid_argument _ -> rev accu - in - collect (words_ [] 0) (split_at '\n' s) - -let to_CamelCase s_ = - let l = ref [] in - let s = String.copy s_ in - for i = 1 to String.length s - 1 do - if is_uppercase (String.unsafe_get s i) && is_lowercase (String.unsafe_get s (i-1)) then ( - String.set s i (Char.lowercase (String.get s i)) ; - l := i :: !l - ) - done ; - if !l = [] then None else - let offset, s' = fold_left (fun (offset, s') i -> - i, s' ^ String.sub s offset (i-offset) ^ "_" - ) (0, "") (rev !l) in - Some (s' ^ String.sub s offset (String.length s - offset)) - -let concat_symlink file link = - if str_begins_with "..//" link then (* ..//foo => /foo *) - skip_n_char 3 link - else - let file = if str_ends_with file "/" then chop file else file in (* s|/$|| *) - let rec reduce file link = - if str_begins_with "../" link then - let file = String.sub file 0 (String.rindex file '/') in (* s|/[^/]+$|| *) - reduce file (skip_n_char 3 link) - else - file ^ "/" ^ link - in - reduce file link - -let expand_symlinks file = - match split_at '/' file with - | "" :: l -> - let rec remove_dotdot accu nb = function - | [] -> if nb = 0 then accu else failwith "remove_dotdot" - | ".." :: l -> remove_dotdot accu (nb + 1) l - | e :: l -> if nb > 0 then remove_dotdot accu (nb - 1) l else remove_dotdot (e :: accu) nb l - in - let l = remove_dotdot [] 0 (List.rev l) in - List.fold_left (fun file piece -> - fix_point (fun file -> - try concat_symlink file ("../" ^ Unix.readlink file) - with _ -> file - ) (file ^ "/" ^ piece)) "" l - | _ -> internal_error (Printf.sprintf "expand_symlinks: %s is relative\n" file) - -let mtime f = (Unix.stat f).Unix.st_mtime - -let rec updir dir nb = - if nb = 0 then dir else - match dir with - | "." -> String.concat "/" (times ".." nb) - | _ -> - if Filename.basename dir = ".." then - dir ^ "/" ^ String.concat "/" (times ".." nb) - else - updir (Filename.dirname dir) (nb-1) - -let (string_of_ref : 'a ref -> string) = fun r -> - Printf.sprintf "0x%x" (Obj.magic r : int) - -let print_endline_flush s = print_endline s ; flush stdout - -let is_int n = n = floor n - -(* total order *) -let rec compare_lists cmp l1 l2 = - match l1, l2 with - | [], [] -> 0 - | [], _ -> -1 - | _, [] -> 1 - | e1::l1, e2::l2 -> - match cmp e1 e2 with - | 0 -> compare_lists cmp l1 l2 - | v -> v - -let compare_best a b = - match a, b with - | 0, 0 -> 0 - | 1, 1 | 1, 0 | 0, 1 -> 1 - | -1, -1 | -1, 0 | 0, -1 -> -1 - | 1, -1 | -1, 1 -> raise Not_comparable - | _ -> failwith "uh?" - -(* partial order *) -let combine_comparison_list l = - fold_left compare_best 0 l - -let min_with_cmp less_than a b = - if less_than a b then a - else if less_than b a then b - else raise Not_comparable - -let max_with_cmp less_than a b = - if less_than a b then b - else if less_than b a then a - else raise Not_comparable - -let rec fold_left2_compare f e l1 l2 = - match l1, l2 with - | [], [] -> e - | e1::l1, e2::l2 -> fold_left2_compare f (f e e1 e2) l1 l2 - | _ -> raise Not_comparable - -let rec exists_compare cmp = function - | [] -> raise Not_comparable - | e :: l -> try cmp e with Not_comparable -> exists_compare cmp l - -let forall_compare cmp = fold_left (fun n e -> compare_best n (cmp e)) 0 -let forall2_compare cmp = fold_left2_compare (fun n e1 e2 -> compare_best n (cmp e1 e2)) 0 - -let exists2_compare left_dropping cmp l1 l2 = - let rec forall_compare_ n = function - | [], [] -> n - | _, [] -> compare_best n left_dropping - | [], _ -> compare_best n (-left_dropping) - | e1::l1, e2::l2 -> - match try Some (cmp e1 e2) with Not_comparable -> None with - | Some n' -> forall_compare_ (compare_best n n') (l1, l2) - | None -> - if n = left_dropping then - forall_compare_ left_dropping (l1, e2::l2) - else if n = -left_dropping then - forall_compare_ (-left_dropping) (e1::l1, l2) - else - (* need to try both *) - try forall_compare_ left_dropping (l1, e2::l2) - with Not_comparable -> forall_compare_ (-left_dropping) (e1::l1, l2) - in forall_compare_ 0 (l1, l2) - - -let rec compare_sorted_sets is_same l1 l2 = - match l1, l2 with - | [], [] -> 0 - | [], _ -> -1 - | _, [] -> 1 - | e1::l1, e2::l2 -> if is_same e1 e2 then compare_sorted_sets is_same l1 l2 else raise Not_found - -let scan_list_while_modifying f l = - let rec scan_list_while_modifying_ prev = function - | [] -> prev - | e :: next -> - let prev', next' = some_or (f prev next e) (prev @ [e], next) in - scan_list_while_modifying_ prev' next' - in scan_list_while_modifying_ [] l - -let bools2compare = function - | true, true -> 0 - | true, false -> -1 - | false, true -> 1 - | _ -> raise Not_comparable - -let lpush l e = l := e :: !l - -(* -let is_greater2compare is_greater a b = - match is_greater a b, is_greater b a with - - *) - -module OrderedString = - struct - type t = string - let compare = compare - end;; - -module StringSet = Set.Make(OrderedString);; - -let stringSet_to_list = StringSet.elements -let stringSet_add set e = StringSet.add e set -let stringSet_difference = StringSet.diff -let list_to_StringSet l = fold_left stringSet_add StringSet.empty l - -(* this character messes emacs caml mode *) -let char_quote = '"' diff --git a/perl_checker.src/common.mli b/perl_checker.src/common.mli deleted file mode 100644 index 86a13cd..0000000 --- a/perl_checker.src/common.mli +++ /dev/null @@ -1,276 +0,0 @@ -exception Found -exception Not_comparable -exception GraphSort_circular_deps -type ('a, 'b) either = Left of 'a | Right of 'b -type ('a, 'b) or_option = Or_some of 'a | Or_error of 'b -val internal_error : string -> 'a -val id : 'a -> 'a -val double : 'a -> 'a * 'a -val swap : 'a * 'b -> 'b * 'a -val safe_tl : 'a list -> 'a list -val fstfst : ('a * 'b) * 'c -> 'a -val sndfst : ('a * 'b) * 'c -> 'b -val fstsnd : 'a * ('b * 'c) -> 'b -val sndsnd : 'a * ('b * 'c) -> 'c -val fst3 : 'a * 'b * 'c -> 'a -val snd3 : 'a * 'b * 'c -> 'b -val ter3 : 'a * 'b * 'c -> 'c -val sndter3 : 'a * 'b * 'c -> 'b * 'c -val o : ('a -> 'b) -> ('c -> 'a) -> 'c -> 'b -val curry : ('a * 'b -> 'c) -> 'a -> 'b -> 'c -val uncurry : ('a -> 'b -> 'c) -> 'a * 'b -> 'c -val uncons : 'a list -> 'a * 'a list -val has_env : string -> bool -val some : 'a option -> 'a -val some_or : 'a option -> 'a -> 'a -val option2l : 'a option -> 'a list -val prefer_some : ('a -> 'a -> 'a) -> 'a option -> 'a option -> 'a option -val collect_accu : ('a -> 'b list) -> 'b list -> 'a list -> 'b list -val collect : ('a -> 'b list) -> 'a list -> 'b list -val merge_some : ('a -> 'a -> 'a) -> 'a option -> 'a option -> 'a option -val uniq : 'a list -> 'a list -val uniq_ : ('a -> 'a -> bool) -> 'a list -> 'a list -val non_uniq : 'a list -> 'a list -val member_ : ('a -> 'b -> bool) -> 'a -> 'b list -> bool -val find_some : ('a -> 'b option) -> 'a list -> 'b -val fold_left1 : ('a -> 'a -> 'a) -> 'a list -> 'a -val find_index : 'a -> 'a list -> int -val find_some_ : ('a -> 'b option) -> 'a list -> 'b option -val fpartition : ('a -> 'b option) -> 'a list -> 'b list * 'a list -val partition_either : - ('a -> ('b, 'c) either) -> 'a list -> 'b list * 'c list -val keep_best : ('a * 'a -> 'a option) -> 'a list -> 'a list -val keep_bests : ('a * 'a -> 'a option) -> 'a list -> 'a list -val fold_right1 : ('a -> 'a -> 'a) -> 'a list -> 'a -val for_all2_ : ('a -> 'b -> bool) -> 'a list -> 'b list -> bool -val for_all2_true : ('a -> 'b -> bool) -> 'a list -> 'b list -> bool -val maxl : 'a list -> 'a -val stack2list : 'a Stack.t -> 'a list -val stack_exists : ('a -> bool) -> 'a Stack.t -> bool -val queue2list : 'a Queue.t -> 'a list -val fix_point : ('a -> 'a) -> 'a -> 'a -val fix_point_withenv : ('a -> 'b -> 'b * 'a) -> 'a -> 'b -> 'b * 'a -val fix_point_ : int -> ('a -> 'a) -> 'a -> 'a * int -val group_by_2 : 'a list -> ('a * 'a) list -val fluid_let : 'a ref -> 'a -> (unit -> 'b) -> 'b -val do0_withenv : - (('a -> unit) -> 'b -> 'c) -> ('d -> 'a -> 'd) -> 'd -> 'b -> 'd -val do0_withenv2 : - (('a -> 'b -> unit) -> 'c -> 'd) -> - ('e -> 'a -> 'b -> 'e) -> 'e -> 'c -> 'e -val do_withenv : - (('a -> 'b) -> 'c -> 'd) -> ('e -> 'a -> 'b * 'e) -> 'e -> 'c -> 'd * 'e -val do2_withenv : - (('a -> 'b -> 'c) -> 'd -> 'e -> 'f) -> - ('g -> 'a -> 'b -> 'c * 'g) -> 'g -> 'd -> 'e -> 'f * 'g -val do_collect : - (('a -> 'b -> unit) -> 'c -> 'd) -> ('a -> 'b -> 'e list) -> 'c -> 'e list -val map_withitself : ('a list -> 'a -> 'a) -> 'a list -> 'a list -val map_t2 : ('a -> 'b) -> 'a * 'a -> 'b * 'b -val map_t3 : ('a -> 'b) -> 'a * 'a * 'a -> 'b * 'b * 'b -val map_option : ('a -> 'b) -> 'a option -> 'b option -val map_optionoption : ('a -> 'b option) -> 'a option -> 'b option -val t2_option2option_t2 : 'a option * 'b option -> ('a * 'b) option -val l_option2option_l : 'a option list -> 'a list option -val map_option_env : ('a -> 'b) -> 'a option * 'c -> 'b option * 'c -val t2_to_list : 'a * 'a -> 'a list -val t3_to_list : 'a * 'a * 'a -> 'a list -val if_some : bool -> 'a -> 'a option -val fold_left_option : ('a -> 'b -> 'a option) -> 'a -> 'b list -> 'a option -val collect_some_withenv : - ('a -> 'b -> 'c option * 'a) -> 'a -> 'b list -> 'c list * 'a -val for_all_option_withenv : - ('a list -> 'b) -> - ('c -> 'd -> 'a option * 'c) -> 'c -> 'd list -> 'b option * 'c -val for_all2_option_withenv : - ('a list -> 'b) -> - ('c -> 'd -> 'e -> 'a option * 'c) -> - 'c -> 'd list -> 'e list -> 'b option * 'c -val map_or_option : ('a -> 'b) -> ('a, 'c) or_option -> ('b, 'c) or_option -val map_index : ('a -> int -> 'b) -> 'a list -> 'b list -val filter_index : ('a -> int -> bool) -> 'a list -> 'a list -val iter_index : ('a -> int -> 'b) -> 'a list -> unit -val map_fst : ('a -> 'b) -> 'a * 'c -> 'b * 'c -val map_snd : ('a -> 'b) -> 'c * 'a -> 'c * 'b -val map_withenv : ('a -> 'b -> 'c * 'a) -> 'a -> 'b list -> 'c list * 'a -val find_withenv : ('a -> 'b -> bool * 'a) -> 'a -> 'b list -> 'b * 'a -val filter_withenv : ('a -> 'b -> bool * 'a) -> 'a -> 'b list -> 'b list * 'a -val exists_withenv : ('a -> 'b -> bool * 'a) -> 'a -> 'b list -> bool * 'a -val map_t2_withenv : ('a -> 'b -> 'c * 'a) -> 'a -> 'b * 'b -> ('c * 'c) * 'a -val for_all_withenv : ('a -> 'b -> bool * 'a) -> 'a -> 'b list -> bool * 'a -val collect_withenv : - ('a -> 'b -> 'c list * 'a) -> 'a -> 'b list -> 'c list * 'a -val partition_either_withenv : - ('a -> 'b -> ('c, 'd) either * 'a) -> - 'a -> 'b list -> ('c list * 'd list) * 'a -val map2_withenv : - ('a -> 'b -> 'c -> 'd * 'a) -> 'a -> 'b list -> 'c list -> 'd list * 'a -val for_all2_withenv : - ('a -> 'b -> 'c -> bool * 'a) -> 'a -> 'b list -> 'c list -> bool * 'a -val take : int -> 'a list -> 'a list -val last_n : int -> 'a list -> 'a list -val last : 'a list -> 'a -val skipfirst : 'a -> 'a list -> 'a list -val removelast : 'a list -> 'a list -val split_last : 'a list -> 'a list * 'a -val iter_assoc_val : ('a -> unit) -> ('b * 'a) list -> unit -val map_assoc_val : ('a -> 'b) -> ('c * 'a) list -> ('c * 'b) list -val assoc_or_fail : 'a -> ('a * 'b) list -> 'b -val assoc_by : ('a -> 'b -> bool) -> 'a -> ('b * 'c) list -> 'c -val update_assoc_by : - ('a -> 'b -> bool) -> ('c -> 'c) -> 'a -> ('b * 'c) list -> ('b * 'c) list -val update_assoc : ('a -> 'a) -> 'b -> ('b * 'a) list -> ('b * 'a) list -val update_assoc_by_with_default : - 'a -> - ('b -> 'b -> bool) -> ('a -> 'a) -> 'b -> ('b * 'a) list -> ('b * 'a) list -val update_all_assoc_by : - ('a -> 'b -> bool) -> ('c -> 'c) -> 'a -> ('b * 'c) list -> ('b * 'c) list -val rassoc : 'a -> ('b * 'a) list -> 'b -val all_assoc : 'a -> ('a * 'b) list -> 'b list -val all_assoc_by : ('a -> 'b -> bool) -> 'a -> ('b * 'c) list -> 'c list -val prepare_want_all_assoc : ('a * 'b) list -> ('a * 'b list) list -val prepare_want_all_assoc_by : - ('a -> 'a -> bool) -> ('a * 'a) list -> ('a * 'a list) list -val prepare_want_all_assoc_by_ : - ('a -> 'a -> bool) -> - ('b -> 'b -> bool) -> ('a * 'b) list -> ('a * 'b list) list -val count_uniq : 'a list -> ('a * int) list -val repeat : 'a -> int -> 'a list -val inits : 'a list -> 'a list list -val tails : 'a list -> 'a list list -val apply : ('a -> 'b) -> 'a -> 'b -val map3 : ('a -> 'b -> 'c -> 'd) -> 'a list -> 'b list -> 'c list -> 'd list -val filter2 : ('a * 'b -> bool) -> 'a list -> 'b list -> 'a list * 'b list -val break_at : ('a -> bool) -> 'a list -> 'a list * 'a list -val break : 'a -> 'a list -> 'a list * 'a list -val drop_while : ('a -> bool) -> 'a list -> 'a list -val break_at_indice : int -> 'a list -> 'a list * 'a list -val rev_nth : 'a -> 'a list -> int -val getset_nth : 'a list -> int -> ('a -> 'a) -> 'a list -val set_nth : 'a list -> int -> 'a -> 'a list -val adjustModDown : int -> int -> int -val adjustModUp : int -> int -> int -val hashtbl_find : ('a -> 'b -> bool) -> ('a, 'b) Hashtbl.t -> 'a -val hashtbl_map : ('a -> 'b -> 'b) -> ('a, 'b) Hashtbl.t -> unit -val hashtbl_values : ('a, 'b) Hashtbl.t -> 'b list -val hashtbl_keys : ('a, 'b) Hashtbl.t -> 'a list -val hashtbl_to_list : ('a, 'b) Hashtbl.t -> ('a * 'b) list -val hashtbl_collect : ('a -> 'b -> 'c list) -> ('a, 'b) Hashtbl.t -> 'c list -val hashtbl_exists : ('a -> 'b -> bool) -> ('a, 'b) Hashtbl.t -> bool -val memoize : ('a -> 'b) -> 'a -> 'b -val array_shift : 'a array -> 'a array -val array_last_n : int -> 'a array -> 'a array -val array_collect : ('a -> 'b list) -> 'a array -> 'b list -val lvector_product : 'a list list -> 'a list list -val vector_product2 : 'a list -> 'a list -> ('a * 'a) list -val transpose : 'a list list -> 'a list list -val range : int -> int -> int list -val sum : int list -> int -val filter_some_with : ('a -> 'b option) -> 'a list -> 'b list -val filter_some : 'a option list -> 'a list -val difference : 'a list -> 'a list -> 'a list -val difference_ : ('a -> 'b -> bool) -> 'b list -> 'a list -> 'b list -val intersection_by : ('a -> 'b -> bool) -> 'a list -> 'b list -> 'a list -val intersection_and_differences : - ('a -> 'b -> bool) -> 'b list -> 'a list -> 'a list * 'b list * 'a list -val triangularize : 'a list -> ('a * 'a list) list -val diagonalize : 'a list -> ('a * 'a list) list -val list_of_nonempty_sublists : 'a list -> 'a list list -val graph_is_sorted_by : ('a -> 'b -> bool) -> ('b * 'a list) list -> bool -val graph_closure_by : - ('a -> 'a -> bool) -> - ('a * 'a list) list -> (('a * 'a list) list, 'a * 'a) or_option -val graph_sort_by : - ('a -> 'a -> bool) -> - ('a * 'a list) list -> (('a * 'a list) list, 'a * 'a) or_option -val int_sort : int list -> int list -val str_begins_with : string -> string -> bool -val strstr : string -> string -> int -val str_contains : string -> string -> bool -val str_ends_with : string -> string -> bool -val chop : string -> string -val chomps : string -> string -val times : 'a -> int -> 'a list -val skip_n_char_ : int -> int -> string -> string -val skip_n_char : int -> string -> string -val non_index_from : string -> int -> char -> int -val non_index : string -> char -> int -val non_rindex_from : string -> int -> char -> int -val non_rindex : string -> char -> int -val explode_string : string -> char list -val count_matching_char : string -> char -> int -val is_uppercase : char -> bool -val is_lowercase : char -> bool -val char_is_alphanumerical : char -> bool -val char_is_alphanumerical_ : char -> bool -val char_is_alpha : char -> bool -val char_is_number : char -> bool -val count_chars_in_string : string -> char -> int -val string_fold_left : ('a -> char -> 'a) -> 'a -> string -> 'a -val string_forall_with : (char -> bool) -> int -> string -> bool -val starts_with_non_lowercase : string -> bool -val fold_lines : ('a -> string -> 'a) -> 'a -> in_channel -> 'a -val readlines : in_channel -> string list -val split_at : char -> string -> string list -val split_at2 : char -> char -> string -> string list -val words : string -> string list -val to_CamelCase : string -> string option -val concat_symlink : string -> string -> string -val expand_symlinks : string -> string -val mtime : string -> float -val updir : string -> int -> string -val string_of_ref : 'a ref -> string -val print_endline_flush : string -> unit -val is_int : float -> bool -val compare_lists : ('a -> 'b -> int) -> 'a list -> 'b list -> int -val compare_best : int -> int -> int -val combine_comparison_list : int list -> int -val min_with_cmp : ('a -> 'a -> bool) -> 'a -> 'a -> 'a -val max_with_cmp : ('a -> 'a -> bool) -> 'a -> 'a -> 'a -val fold_left2_compare : - ('a -> 'b -> 'c -> 'a) -> 'a -> 'b list -> 'c list -> 'a -val exists_compare : ('a -> 'b) -> 'a list -> 'b -val forall_compare : ('a -> int) -> 'a list -> int -val forall2_compare : ('a -> 'b -> int) -> 'a list -> 'b list -> int -val exists2_compare : int -> ('a -> 'b -> int) -> 'a list -> 'b list -> int -val compare_sorted_sets : ('a -> 'b -> bool) -> 'a list -> 'b list -> int -val scan_list_while_modifying : - ('a list -> 'a list -> 'a -> ('a list * 'a list) option) -> - 'a list -> 'a list -val bools2compare : bool * bool -> int -val lpush : 'a list ref -> 'a -> unit -module OrderedString : sig type t = string val compare : 'a -> 'a -> int end -module StringSet : - sig - type elt = OrderedString.t - type t = Set.Make(OrderedString).t - val empty : t - val is_empty : t -> bool - val mem : elt -> t -> bool - val add : elt -> t -> t - val singleton : elt -> t - val remove : elt -> t -> t - val union : t -> t -> t - val inter : t -> t -> t - val diff : t -> t -> t - val compare : t -> t -> int - val equal : t -> t -> bool - val subset : t -> t -> bool - val iter : (elt -> unit) -> t -> unit - val fold : (elt -> 'a -> 'a) -> t -> 'a -> 'a - val for_all : (elt -> bool) -> t -> bool - val exists : (elt -> bool) -> t -> bool - val filter : (elt -> bool) -> t -> t - val partition : (elt -> bool) -> t -> t * t - val cardinal : t -> int - val elements : t -> elt list - val min_elt : t -> elt - val max_elt : t -> elt - val choose : t -> elt - val split : elt -> t -> t * bool * t - end -val stringSet_to_list : StringSet.t -> StringSet.elt list -val stringSet_add : StringSet.t -> StringSet.elt -> StringSet.t -val stringSet_difference : StringSet.t -> StringSet.t -> StringSet.t -val list_to_StringSet : StringSet.elt list -> StringSet.t -val char_quote : char diff --git a/perl_checker.src/config_file.ml b/perl_checker.src/config_file.ml deleted file mode 100644 index a5ee94f..0000000 --- a/perl_checker.src/config_file.ml +++ /dev/null @@ -1,40 +0,0 @@ -open Common - -type config_file = { - basedir : int option ; - } - -let ignored_packages = ref [] - -let default = { basedir = None } - - -let config_cache = Hashtbl.create 16 - -let read dir = - try Hashtbl.find config_cache dir with Not_found -> - try - let file_name = dir ^ "/.perl_checker" in - let fh = open_in file_name in - let config = - fold_lines (fun config line -> - match words line with - | [ "Basedir"; ".." ] -> { config with basedir = Some 1 } - | [ "Basedir"; "../.." ] -> { config with basedir = Some 2 } - | [] -> config (* blank line *) - | [ "Ignore"; pkg ] - | [ pkg ] (* the deprecated form *) - -> lpush ignored_packages pkg; config - | _ -> prerr_endline (Printf.sprintf "bad line \"%s\" in %s" line file_name); config - ) default fh - in - Hashtbl.add config_cache dir config ; - if !Flags.verbose then print_endline_flush ("reading config file " ^ file_name); - config - with Sys_error _ -> default - - -let rec read_any dir depth = - if depth = 0 then () else - let _ = read dir in - read_any (updir dir 1) (depth - 1) diff --git a/perl_checker.src/config_file.mli b/perl_checker.src/config_file.mli deleted file mode 100644 index d5ad2f2..0000000 --- a/perl_checker.src/config_file.mli +++ /dev/null @@ -1,6 +0,0 @@ -type config_file = { basedir : int option; } -val ignored_packages : string list ref -val default : config_file -val config_cache : (string, config_file) Hashtbl.t -val read : string -> config_file -val read_any : string -> int -> unit diff --git a/perl_checker.src/flags.ml b/perl_checker.src/flags.ml deleted file mode 100644 index 187c140..0000000 --- a/perl_checker.src/flags.ml +++ /dev/null @@ -1,43 +0,0 @@ -open Common -open Types - -let verbose = ref false -let quiet = ref false -let generate_pot = ref false -let expand_tabs = ref (Some 8) -let no_cache = ref false - -let check_unused_global_vars = ref false -let check_white_space = ref true -let check_suggest_simpler = ref true -let check_void = ref true -let check_context = ref true -let check_strange = ref true -let check_traps = ref true -let check_complex_expressions = ref true -let normalized_expressions = ref true -let check_help_perl_checker = ref true -let suggest_functional = ref true -let check_prototypes = ref true -let check_names = ref true -let check_import_export = ref true -let allow_MDK_Common = ref true - -let is_warning_type_set = function - | Warn_white_space -> !check_white_space - | Warn_suggest_simpler -> !check_suggest_simpler - | Warn_unused_global_vars -> !check_unused_global_vars - | Warn_void -> !check_void - | Warn_context -> !check_context - | Warn_strange -> !check_strange - | Warn_traps -> !check_traps - | Warn_complex_expressions -> !check_complex_expressions - | Warn_normalized_expressions -> !normalized_expressions - | Warn_suggest_functional -> !suggest_functional - | Warn_prototypes -> !check_prototypes - | Warn_names -> !check_names - | Warn_import_export -> !check_import_export - | Warn_MDK_Common -> !allow_MDK_Common - | Warn_help_perl_checker -> !check_help_perl_checker - -let are_warning_types_set l = not !quiet && List.for_all is_warning_type_set l diff --git a/perl_checker.src/flags.mli b/perl_checker.src/flags.mli deleted file mode 100644 index 2dc3b26..0000000 --- a/perl_checker.src/flags.mli +++ /dev/null @@ -1,22 +0,0 @@ -val verbose : bool ref -val quiet : bool ref -val generate_pot : bool ref -val expand_tabs : int option ref -val no_cache : bool ref -val check_unused_global_vars : bool ref -val check_white_space : bool ref -val check_suggest_simpler : bool ref -val check_void : bool ref -val check_context : bool ref -val check_strange : bool ref -val check_traps : bool ref -val check_complex_expressions : bool ref -val normalized_expressions : bool ref -val check_help_perl_checker : bool ref -val suggest_functional : bool ref -val check_prototypes : bool ref -val check_names : bool ref -val check_import_export : bool ref -val allow_MDK_Common : bool ref -val is_warning_type_set : Types.warning -> bool -val are_warning_types_set : Types.warning list -> bool diff --git a/perl_checker.src/global_checks.ml b/perl_checker.src/global_checks.ml deleted file mode 100644 index a63e652..0000000 --- a/perl_checker.src/global_checks.ml +++ /dev/null @@ -1,639 +0,0 @@ -open Types -open Common -open Printf -open Config_file -open Parser_helper -open Tree - -type state = { - per_files : (string, per_file) Hashtbl.t ; - per_packages : (string, per_package) Hashtbl.t ; - methods : (string, (string * variable_used ref * prototype option) list) Hashtbl.t ; - global_vars_used : ((context * string * string) * pos) list ref ; - packages_being_classes : (string, unit) Hashtbl.t ; - packages_dependencies : (string * string, unit) Hashtbl.t ; - packages_dependencies_maybe : (string * string * string, unit) Hashtbl.t ; - } - -type vars = { - my_vars : ((context * string) * (pos * variable_used ref * prototype option)) list list ; - our_vars : ((context * string) * (pos * variable_used ref * prototype option)) list list ; - locally_imported : ((context * string) * (string * variable_used ref * prototype option)) list ; - required_vars : (context * string * string) list ; - current_package : per_package ; - is_toplevel : bool ; - write_only : bool ; - state : state ; - } - - -let rec get_imported state current_package (package_name, (imports, pos)) = - try - let package_used = Hashtbl.find state.per_packages package_name in - let exports = package_used.exports in - let get_var_by_name var = - let (b, prototype) = - try sndter3 (Hashtbl.find package_used.vars_declared var) - with Not_found -> - try - sndter3 (List.assoc var (get_imports state package_used)) - with Not_found -> - warn_with_pos [Warn_import_export] pos (sprintf "name %s is not defined in package %s" (variable2s var) package_name) ; - ref Access_various, None - in - var, (package_name, b, prototype) - in - match imports with - | None -> - let re = match exports.special_export with - | Some Re_export_all -> get_imports state package_used - | Some Fake_export_all -> - (* HACK: if package exporting-all is ignored, ignore package importing *) - if List.mem package_name !ignored_packages then Tree.ignore_package current_package.package_name; - - Hashtbl.fold (fun var (_pos, b, proto) l -> (var, (package_name, b, proto)) :: l) package_used.vars_declared [] - | _ -> [] in - let l = List.map get_var_by_name exports.export_auto in - re @ l - | Some l -> - let imports_vars = - collect (function - | I_raw, tag -> - (try - List.assoc tag exports.export_tags - with Not_found -> warn_with_pos [Warn_import_export] pos (sprintf "package %s doesn't export tag %s" package_name tag) ; []) - | variable -> - if List.mem variable exports.export_ok || List.mem variable exports.export_auto then - [ variable ] - else - (warn_with_pos [Warn_import_export] pos (sprintf "package %s doesn't export %s" package_name (variable2s variable)) ; []) - ) l - in - List.map get_var_by_name imports_vars - with Not_found -> [] - -and get_imports state package = - match !(package.imported) with - | Some l -> l - | None -> - let l = collect (get_imported state package) package.uses in - package.imported := Some l ; - l - -let do_para_comply_with_prototype para proto = - match proto with - | Some proto -> - (match para with - | [] as paras - | [List [List paras]] - | [List paras] -> - if List.exists is_not_a_scalar paras then 0 else - let len = List.length paras in - if len < proto.proto_nb_min then -1 - else (match proto.proto_nb_max with - | Some max -> if len > max then 1 else 0 - | None -> 0) - | _ -> 0) - | _ -> 0 - -let check_para_comply_with_prototype para proto = - match para with - | None -> () - | Some(pos, para) -> - match do_para_comply_with_prototype para proto with - | -1 -> warn_with_pos [Warn_prototypes] pos "not enough parameters" - | 1 -> warn_with_pos [Warn_prototypes] pos "too many parameters" - | _ -> () - -let is_anonymous_variable_name s = String.length s > 1 && s.[0] = '_' - -let add_to_packages_really_used state current_package used_name = - Hashtbl.replace state.packages_dependencies (current_package.package_name, used_name) () ; - (*List.iter (fun (p1, p2) -> prerr_endline (Printf.sprintf "%s -> %s" p1 p2)) (hashtbl_keys state.packages_dependencies);*) - () - -let add_to_packages_maybe_used state current_package used_name method_name = - Hashtbl.replace state.packages_dependencies_maybe (current_package.package_name, used_name, method_name) () ; - (*List.iter (fun (p1, p2) -> prerr_endline (Printf.sprintf "%s -> %s" p1 p2)) (hashtbl_keys state.packages_dependencies_maybe);*) - () - -let variable_used write_only used = - if !used != Access_various then - used := if write_only then Access_write_only else Access_various - -let is_my_declared vars t = - List.exists (fun l -> - List.mem_assoc t l && (variable_used vars.write_only (snd3 (List.assoc t l)) ; true) - ) vars.my_vars -let is_our_declared vars t = - List.exists (fun l -> - List.mem_assoc t l && (variable_used vars.write_only (snd3 (List.assoc t l)) ; true) - ) vars.our_vars - -let is_var_declared_raw write_only state package var para = - match - try - let _, used, proto = Hashtbl.find package.vars_declared var in - Some(used, proto) - with Not_found -> try - let package_name, used, proto = List.assoc var (get_imports state package) in - add_to_packages_really_used state package package_name ; - Some(used, proto) - with Not_found -> - None - with - | Some (used, proto) -> - check_para_comply_with_prototype para proto ; - variable_used write_only used ; - true - | None -> - false - -let is_var_declared vars var para = - List.mem_assoc var vars.locally_imported || - is_var_declared_raw vars.write_only vars.state vars.current_package var para - -let is_global_var_declared vars (context, fq, name) para = - try - let package = Hashtbl.find vars.state.per_packages fq in - add_to_packages_really_used vars.state vars.current_package package.package_name ; - is_var_declared_raw vars.write_only vars.state package (context, name) para - with Not_found -> false - - -let is_global_var context ident = - match context with - | I_scalar -> - (match ident with - | "@" | "!" | ">" | "\\" | "$" | "^A" | "'" | "/" | "?" | "<" | "^W" | "|" | "^I" | "&" | "." - | "0" | "1" | "2" | "3" | "4" | "5" | "6" | "7" | "8" | "9" -> true - | _ -> false) - | I_array -> - (match ident with - | "ARGV" | "INC" -> true - | _ -> false) - | I_hash -> - (match ident with - | "ENV" | "SIG" -> true - | _ -> false) - | I_star -> - (match ident with - | "STDIN" | "STDOUT" | "STDERR" | "DATA" - | "__FILE__" | "__LINE__" | "undef" -> true - | _ -> false) - | I_func -> - (match ident with - | "-b" | "-c" | "-d" | "-e" | "-f" | "-l" | "-r" | "-s" | "-w" | "-x" - | "abs" | "alarm" | "atan2" | "bless" - | "caller" | "chdir" | "chmod" | "chomp" | "chop" | "chown" | "chr" | "chroot" | "close" | "closedir" | "cos" | "crypt" - | "defined" | "delete" | "die" - | "each" | "endpwent" | "eof" | "eval" | "exec" | "exists" | "exit" - | "fcntl" | "fileno" | "flock" | "formline" | "fork" - | "gethostbyaddr" | "gethostbyname" | "getgrent" | "getgrnam" | "getgrgid" | "getppid" | "getpwent" | "getpwnam" | "getpwuid" | "getservbyname" | "glob" | "gmtime" | "goto" | "grep" | "hex" - | "index" | "int" | "ioctl" | "join" | "keys" | "kill" - | "last" | "lc" | "lcfirst" | "length" | "link" | "localtime" | "log" | "lstat" - | "map" | "mkdir" | "next" | "no" | "oct" | "open" | "opendir" | "ord" - | "pack" | "pipe" | "pop" | "print" | "printf" | "push" | "quotemeta" - | "rand" | "read" | "readdir" | "readlink" | "redo" | "ref" | "rename" | "require" | "return" | "reverse" | "rindex" | "rmdir" - | "scalar" | "seek" | "select" | "setpwent" | "shift" | "sin" | "sleep" | "sort" | "splice" | "split" | "sprintf" | "sqrt" | "stat" | "substr" - | "symlink" | "syscall" | "sysopen" | "sysread" | "sysseek" | "system" | "syswrite" | "tie" | "time" - | "uc" | "ucfirst" | "umask" | "undef" | "unlink" | "unpack" | "unshift" | "utime" | "values" | "vec" | "wait" | "waitpid" | "wantarray" | "warn" | "write" - -> true - - | _ -> false) - | _ -> false - -let check_variable (context, var) vars para = - match var with - | Ident(_, s, pos) when context <> I_func && is_anonymous_variable_name s && s <> "__FILE__" && s <> "__LINE__" -> - warn_with_pos [Warn_normalized_expressions] pos (sprintf "variable %s must not be used\n (variable with name _XXX are reserved for unused variables)" (variable2s(context, string_of_fromparser var))) - | Ident(Some pkg, _, _) when uses_external_package pkg || List.mem pkg !ignored_packages -> () - | Ident(None, ident, pos) -> - if is_my_declared vars (context, ident) || is_our_declared vars (context, ident) || is_var_declared vars (context, ident) para || is_global_var context ident - then () - else warn_with_pos [Warn_names] pos (if context = I_func then "unknown function " ^ ident else "undeclared variable " ^ variable2s(context, ident)) - | Ident(Some fq, name, pos) -> - if (fq = "CORE") && is_global_var context name || is_global_var_declared vars (context, fq, name) para - then () - else - if context = I_func then - warn_with_pos [Warn_names] pos ("unknown function " ^ string_of_fromparser var) - else - lpush vars.state.global_vars_used ((context, fq, name), pos) - | _ -> () - -let declare_My vars (mys, pos) = - let l_new = List.filter (fun (context, ident) -> - if context = I_raw then - if ident = "undef" then false else die_with_pos pos (sprintf "bad ident %s in my" ident) - else true - ) mys in - let l_pre = List.hd vars.my_vars in - List.iter (fun v -> - if List.mem_assoc v l_pre then warn_with_pos [Warn_names] pos (sprintf "redeclared variable %s" (variable2s v)) - ) l_new ; - { vars with my_vars = (List.map (fun v -> v, (pos, ref Access_none, None)) l_new @ l_pre) :: List.tl vars.my_vars } - -let declare_Our vars (ours, pos) = - match vars.our_vars with - | [] -> vars (* we're at the toplevel, already declared in vars_declared *) - | l_pre :: other -> - List.iter (fun v -> - if List.mem_assoc v l_pre && v <> (I_scalar, "_") then warn_with_pos [Warn_names] pos (sprintf "redeclared variable %s" (variable2s v)) - ) ours ; - { vars with our_vars = (List.map (fun v -> v, (pos, ref Access_none, None)) ours @ l_pre) :: other } - -let declare_My_our vars (my_or_our, l, pos) = - match my_or_our with - | "my" -> declare_My vars (l, pos) - | "local" - | "our" -> declare_Our vars (l, pos) - | _ -> internal_error "declare_My_our" - -let un_parenthesize_one_elt_List = function - | [List l] -> l - | l -> l - -let check_unused_local_variables vars = - List.iter (fun ((context, s as v), (pos, used, _proto)) -> - if !used != Access_various then - match s with - | "BEGIN" | "END" | "DESTROY" -> () - | "_" when context = I_array -> - warn_with_pos [Warn_normalized_expressions] pos "if the function doesn't take any parameters, please use the empty prototype.\nexample \"sub foo() { ... }\"" - | _ -> - if s.[0] != '_' || s = "_" then - let msg = if !used = Access_write_only then sprintf "variable %s assigned, but not read" else sprintf "unused variable %s" in - warn_with_pos [Warn_names] pos (msg (variable2s v)) - ) (List.hd vars.my_vars) - -let check_variables vars t = - let rec check_variables_ vars t = fold_tree check vars t - and check vars = function - | Block l -> - let vars' = { vars with my_vars = [] :: vars.my_vars ; our_vars = [] :: vars.our_vars } in - let vars' = List.fold_left check_variables_ vars' l in - check_unused_local_variables vars' ; - Some vars - | Call(Deref(I_func, Ident(None, "sort", _)), (Anonymous_sub(_, Block f, pos) :: l)) -> - let vars = List.fold_left check_variables_ vars l in - let vars' = { vars with my_vars = [ (I_scalar, "a"), (pos, ref Access_various, None) ; (I_scalar, "b"), (pos, ref Access_various, None) ] :: vars.my_vars ; our_vars = [] :: vars.our_vars } in - let vars' = List.fold_left check_variables_ vars' f in - check_unused_local_variables vars' ; - Some vars - - | Call(Deref(I_func, Ident(None, func, func_pos)), Anonymous_sub(_, Block f, pos) :: l) - when List.mem func [ "grep" ; "map" ; "substInFile" ; "map_index" ; "each_index" ; "partition" ; "find_index" ; "grep_index" ; "find" ; "any" ; "every" ; "uniq_" ] -> - let vars = List.fold_left check_variables_ vars l in - let vars' = { vars with my_vars = [] :: vars.my_vars ; our_vars = [(I_scalar, "_"), (pos, ref Access_various, None)] :: vars.our_vars } in - let vars' = List.fold_left check_variables_ vars' f in - check_unused_local_variables vars' ; - check_variable (I_func, Ident(None, func, func_pos)) vars None ; - Some vars - - | Call(Deref(I_func, (Ident _ as ident)), [ Deref(I_star, (Ident(None, "_", _))) ]) -> - (* the &f case: allow access to @_ *) - check_variable (I_func, ident) vars None ; - let _ = is_my_declared vars (I_array, "_") in - Some vars - - | Call(Deref(I_func, (Ident _ as ident)), [ List [ Deref(I_array, (Ident(None, "_", pos))) ] ]) -> - (* special warning if @_ is unbound *) - check_variable (I_func, ident) vars None ; - if not (is_my_declared vars (I_array, "_")) then - warn_with_pos [Warn_suggest_simpler] pos (sprintf "replace %s(@_) with &%s" (string_of_fromparser ident) (string_of_fromparser ident)) ; - Some vars - - | Call(Deref(I_func, Ident(None, "require", _)), [Ident _]) -> Some vars - - | Call(Deref(I_func, Ident(None, "shift", pos)) as var, []) - | Call(Deref(I_func, Ident(None, "pop", pos)) as var, []) -> - check vars (Call(var, [ Deref(I_array, Ident(None, (if vars.is_toplevel then "ARGV" else "_"), pos)) ])) - - | Call(Deref(context, (Ident(_, _, pos) as var)), para) -> - check_variable (context, var) vars (Some(pos, para)) ; - let vars = List.fold_left check_variables_ vars para in - Some vars - -(* | Call_op("=", -> List.fold_left (fold_tree f) env l*) - - | Call_op("while infix", [ expr ; (List [ Call_op("<>", _, _) ] as l) ], pos) - | Call_op("for infix", [ expr ; l ], pos) -> - let vars = check_variables_ vars l in - let vars' = { vars with my_vars = [] :: vars.my_vars ; our_vars = [(I_scalar, "_"), (pos, ref Access_various, None)] :: vars.our_vars } in - let vars' = check_variables_ vars' expr in - if List.hd(vars'.my_vars) <> [] then warn_with_pos [Warn_traps] pos "you can't declare variables in foreach postfix"; - Some vars - - | Call_op("foreach my", [my; expr; Block block], _) -> - let vars = check_variables_ vars expr in - let vars = check_variables_ vars (Block (my :: block)) in - Some vars - | Call_op(op, l, _) when op = "if" || op = "while" || op = "unless" || op = "until" -> - let vars' = { vars with my_vars = [] :: vars.my_vars ; our_vars = [] :: vars.our_vars } in - let vars' = List.fold_left check_variables_ vars' l in - check_unused_local_variables vars' ; - Some vars - - | Sub_declaration(Ident(fq, name, pos) as ident, perl_proto, Block body, kind) -> - let vars = declare_Our vars ([ I_func, string_of_fromparser ident ], pos) in - - let my_vars, l = - match has_proto perl_proto (Block body) with - | Some(mys, mys_pos, body) -> - [], My_our ("my", mys, mys_pos) :: body - | _ -> - let dont_check_use = - kind = Glob_assign || - fq = None && List.mem name ["DESTROY"] || - Hashtbl.mem vars.state.packages_being_classes (some_or fq vars.current_package.package_name) - in - [(I_array, "_"), (pos, ref (if dont_check_use then Access_various else Access_none), None)], body - in - let local_vars = - if fq = None && name = "AUTOLOAD" - then [ (I_scalar, "AUTOLOAD"), (pos, ref Access_various, None) ] - else [] in - - let vars' = { vars with my_vars = my_vars :: vars.my_vars ; our_vars = local_vars :: vars.our_vars ; is_toplevel = false } in - let vars' = List.fold_left check_variables_ vars' l in - check_unused_local_variables vars' ; - Some vars - - | Anonymous_sub(_, Block l, pos) -> - let vars' = { vars with my_vars = [(I_array, "_"), (pos, ref Access_various, None)] :: vars.my_vars ; is_toplevel = false } in - let vars' = List.fold_left check_variables_ vars' l in - check_unused_local_variables vars' ; - Some vars - - | Call_op("foreach", [ expr ; Block l ], pos) -> - let vars = check_variables_ vars expr in - let vars' = { vars with my_vars = [] :: vars.my_vars ; our_vars = [(I_scalar, "_"), (pos, ref Access_various, None)] :: vars.our_vars } in - let vars' = List.fold_left check_variables_ vars' l in - check_unused_local_variables vars' ; - Some vars - - | Anonymous_sub _ - | Sub_declaration _ -> internal_error "check_variables" - - | Ident _ as var -> - check_variable (I_star, var) vars None ; - Some vars - - | My_our(my_or_our, mys, pos) -> Some(declare_My_our vars (my_or_our, mys, pos)) - | Deref(context, (Ident _ as var)) -> - check_variable (context, var) vars None ; - Some vars - | Deref_with(context, _, (Ident _ as var), para) -> - let vars = check_variables_ vars para in - check_variable (context, var) vars None ; - Some vars - - | Call_op("=", [My_our(my_or_our, mys, pos); e], _) -> - (* check e first *) - let vars = check_variables_ vars e in - List.iter (fun (context, var) -> - if non_scalar_context context then warn_with_pos [Warn_prototypes] pos (sprintf "%s takes all the arguments, %s is undef in any case" (variable2s (context, var)) (variable2s (last mys))) - ) (removelast mys) ; (* mys is never empty *) - Some(declare_My_our vars (my_or_our, mys, pos)) - - | Call_op("if infix", [List [My_our _]; List [Num("0", _)]], _) -> None (* special allowed case *) - | Call_op(op, List (My_our _ :: _) :: _, pos) - | Call_op(op, My_our _ :: _, pos) - | Call_op(op, Call_op("local", _, _) :: _, pos) -> - if op <> "=" then warn_with_pos [Warn_traps] pos (sprintf "applying %s on a new initialized variable is wrong" op); - None - - | Call_op("=", [ Deref(context, (Ident _ as var)) ; para], _) -> - check_variable (context, var) { vars with write_only = true } None ; - Some (check_variables_ vars para) - - | Call_op("=", [ List [ List l ] ; para], _) -> - let vars = List.fold_left (fun vars -> function - | Deref(context, (Ident _ as var)) -> - check_variable (context, var) { vars with write_only = true } None ; - vars - | e -> check_variables_ vars e - ) vars l in - let vars = check_variables_ vars para in - Some vars - - | Method_call(Raw_string(package_name, pos), Raw_string ("import", _), para) -> - let args = - match para with - | [] -> None - | [ List [v] ] -> Some(from_qw v) - | _ -> die_with_pos pos "bad import statement" in - let l = get_imported vars.state vars.current_package (package_name, (args, pos)) in - let vars = - if vars.is_toplevel then ( - vars.current_package.imported := Some (get_imports vars.state vars.current_package @ l) ; - vars - ) else - { vars with locally_imported = l @ vars.locally_imported } in - Some vars - - | Method_call(Raw_string(pkg, _) as class_, Raw_string(method_, pos), para) -> - let vars = List.fold_left check_variables_ vars para in - let rec search pkg = - if is_global_var_declared vars (I_func, pkg, method_) (Some(pos, [ List (class_ :: un_parenthesize_one_elt_List para) ])) then true - else - let package = Hashtbl.find vars.state.per_packages pkg in - List.exists search (List.map fst (some_or package.isa [])) - in - (try - if not (uses_external_package pkg || List.mem pkg !ignored_packages || search pkg || method_ = "bootstrap") then - warn_with_pos [Warn_import_export] pos (sprintf "unknown method %s starting in package %s" method_ pkg); - with Not_found -> warn_with_pos [Warn_import_export] pos (sprintf "unknown package %s" pkg)); - Some vars - - | Method_call(o, Raw_string(method_, pos), para) -> - let vars = check_variables_ vars o in - let vars = List.fold_left check_variables_ vars para in - (try - let l = Hashtbl.find vars.state.methods method_ in - let l_and = List.map (fun (pkg_name, used, proto) -> pkg_name, used, do_para_comply_with_prototype [ List (o :: un_parenthesize_one_elt_List para) ] proto) l in - let l_and' = - match List.filter (fun (_, _, n) -> n = 0) l_and with - | [] -> - (match uniq (List.map ter3 l_and) with - | [-1] -> warn_with_pos [Warn_prototypes] pos "not enough parameters" - | [ 1] -> warn_with_pos [Warn_prototypes] pos "too many parameters" - | _ -> warn_with_pos [Warn_prototypes] pos "not enough or too many parameters") ; - l_and - | l -> l - in - List.iter (fun (pkg_name, _, _) -> add_to_packages_maybe_used vars.state vars.current_package pkg_name method_) l_and' ; - List.iter (fun (_, used, _) -> used := Access_various) l_and' - with Not_found -> - if not (List.mem method_ [ "isa"; "can" ]) then - warn_with_pos [Warn_names] pos ("unknown method " ^ method_)) ; - Some vars - - | _ -> None - in - let vars = List.fold_left check_variables_ { vars with my_vars = [[]] } t in - vars - -let check_tree state package = - let vars = { my_vars = [[]]; our_vars = []; locally_imported = []; required_vars = []; current_package = package; state = state; is_toplevel = true; write_only = false } in - if !Flags.verbose then print_endline_flush ("checking package " ^ package.package_name) ; - let vars = check_variables vars package.body in - check_unused_local_variables vars ; - () - -let imported_add i1 i2 = if i1 = None && i2 = None then None else Some (some_or i1 [] @ some_or i2 []) - -let add_package_to_state state package = - let package = - try - let existing_package = Hashtbl.find state.per_packages package.package_name in - (*print_endline_flush (existing_package.file_name ^ " vs " ^ package.file_name); *) - let vars_declared = existing_package.vars_declared in - Hashtbl.iter (fun var pos -> Hashtbl.replace vars_declared var pos) package.vars_declared ; - let p = { - package_name = package.package_name ; has_package_name = package.has_package_name ; - isa = if existing_package.isa = None then package.isa else existing_package.isa ; - body = existing_package.body @ package.body ; - uses = existing_package.uses @ package.uses ; - required_packages = existing_package.required_packages @ package.required_packages ; - vars_declared = vars_declared ; - imported = ref (imported_add !(existing_package.imported) !(package.imported)) ; - exports = { export_ok = existing_package.exports.export_ok @ package.exports.export_ok ; - export_auto = existing_package.exports.export_auto @ package.exports.export_auto ; - export_tags = existing_package.exports.export_tags @ package.exports.export_tags ; - special_export = None } - } in - Hashtbl.replace state.per_packages package.package_name p ; - p - with Not_found -> package - in - Hashtbl.replace state.per_packages package.package_name package - -let add_file_to_files per_files file = - Hashtbl.replace per_files file.file_name file - -let check_unused_vars package = - Hashtbl.iter (fun (context, name) (pos, is_used, _proto) -> - if !is_used != Access_various && not (List.mem name ["BEGIN"; "END"; "DESTROY"; "ISA"; "AUTOLOAD"; "EXPORT"; "EXPORT_OK"; "EXPORT_TAGS"]) then - warn_with_pos [Warn_unused_global_vars] pos (sprintf "unused %s%s::%s" (if context = I_func then "function " else "variable " ^ context2s context) package.package_name name) - ) package.vars_declared - -let arrange_global_vars_declared global_vars_declared state = - Hashtbl.iter (fun (context, fq, name) (pos, proto) -> - let package = - try - Hashtbl.find state.per_packages fq - with Not_found -> - (* creating a new shadow package *) - let package = - { - package_name = fq; - has_package_name = true ; - exports = empty_exports ; - imported = ref None ; - vars_declared = Hashtbl.create 16 ; - uses = [] ; - required_packages = [] ; - body = [] ; - isa = None ; - } in - Hashtbl.add state.per_packages fq package ; - package - in - if not (Hashtbl.mem package.vars_declared (context, name)) then - Hashtbl.add package.vars_declared (context, name) (pos, ref Access_none, proto) - (* otherwise dropping this second declaration *) - ) global_vars_declared ; - state - -let get_methods_available state = - let classes = uniq ( - hashtbl_collect (fun _ package -> - match package.isa with - | None -> - if Hashtbl.mem package.vars_declared (I_func, "new") then [package] else [] - | Some l -> - package :: List.map (fun (pkg, pos) -> - try - Hashtbl.find state.per_packages pkg - with Not_found -> die_with_pos pos ("bad package " ^ pkg) - ) l - ) state.per_packages - ) in - List.iter (fun pkg -> - Hashtbl.replace state.packages_being_classes pkg.package_name () ; - Hashtbl.iter (fun (context, v) (_pos, is_used, proto) -> - if context = I_func then - let l = try Hashtbl.find state.methods v with Not_found -> [] in - Hashtbl.replace state.methods v ((pkg.package_name, is_used, proto) :: l) - ) pkg.vars_declared - ) classes ; - state - - -let default_per_files() = Hashtbl.create 16 -let default_state per_files = { - per_files = per_files; - per_packages = Hashtbl.create 16; - methods = Hashtbl.create 256; - global_vars_used = ref []; - packages_being_classes = Hashtbl.create 16; - packages_dependencies = Hashtbl.create 16; - packages_dependencies_maybe = Hashtbl.create 16 -} - -let cache_cache = Hashtbl.create 16 - -let pkgs2s prefix l = - let l = List.sort compare (List.map (fun pkg -> pkg.file_name) l) in - String.concat "" (List.map (fun s -> prefix ^ s ^ "\n") l) - -let read_packages_from_cache per_files dir = - if !Flags.no_cache || Hashtbl.mem cache_cache dir then () else - try - Hashtbl.add cache_cache dir (); - let file = dir ^ "/.perl_checker.cache" in - let fh = open_in file in - let magic = input_line fh in - if magic <> "perl_checker cache " ^ Build.date then () else - let l = Marshal.from_channel fh in - close_in fh ; - - let l = List.filter (fun file -> - not (Hashtbl.mem per_files file.file_name) && - (try file.build_time > mtime file.file_name with _ -> false) - ) l in - - if !Flags.verbose then print_endline_flush (sprintf "using cached files\n%sfrom %s" (pkgs2s " " l) file) ; - - List.iter (fun file -> - Info.add_a_file file.file_name file.lines_starts ; - add_file_to_files per_files file - ) l - with Sys_error _ | End_of_file -> () - -let write_packages_cache per_files dir = - try - let l = List.filter (fun per_file -> per_file.require_name <> None) (hashtbl_values per_files) in - let file = dir ^ "/.perl_checker.cache" in - let fh = open_out file in - output_string fh ("perl_checker cache " ^ Build.date ^ "\n") ; - Marshal.to_channel fh l [] ; - close_out fh ; - if !Flags.verbose then print_endline_flush (sprintf "saving cached files\n%sin %s" (pkgs2s " " l) file) - with Sys_error _ -> () - -let generate_package_dependencies_graph state file = - let fh = open_out file in - - List.iter (fun (p1, p2) -> - output_string fh (p1 ^ " -> " ^ p2 ^ "\n") - ) (List.sort compare (hashtbl_keys state.packages_dependencies)) ; - - let l = Hashtbl.fold (fun (p1, p2, method_) _ l -> ((p1, method_), p2) :: l) state.packages_dependencies_maybe [] in - List.iter (fun ((p1, method_), l) -> - output_string fh (p1 ^ " ?-> " ^ String.concat " " l ^ " (" ^ method_ ^ ")\n") - ) (List.sort compare (prepare_want_all_assoc l)); - - close_out fh diff --git a/perl_checker.src/global_checks.mli b/perl_checker.src/global_checks.mli deleted file mode 100644 index 9edacbf..0000000 --- a/perl_checker.src/global_checks.mli +++ /dev/null @@ -1,26 +0,0 @@ -open Types -open Tree - -type state = { - per_files : (string, per_file) Hashtbl.t ; - per_packages : (string, per_package) Hashtbl.t ; - methods : (string, (string * variable_used ref * prototype option) list) Hashtbl.t ; - global_vars_used : ((context * string * string) * pos) list ref ; - packages_being_classes : (string, unit) Hashtbl.t ; - packages_dependencies : (string * string, unit) Hashtbl.t ; - packages_dependencies_maybe : (string * string * string, unit) Hashtbl.t ; - } - -val default_per_files : unit -> (string, per_file) Hashtbl.t -val default_state : (string, per_file) Hashtbl.t -> state -val check_tree : state -> per_package -> unit -val add_file_to_files : (string, per_file) Hashtbl.t -> per_file -> unit -val add_package_to_state : state -> per_package -> unit -val check_unused_vars : per_package -> unit -val arrange_global_vars_declared : (context * string * string, pos * Tree.prototype option) Hashtbl.t -> state -> state -val get_methods_available : state -> state - -val read_packages_from_cache : (string, per_file) Hashtbl.t -> string -> unit -val write_packages_cache : (string, per_file) Hashtbl.t -> string -> unit - -val generate_package_dependencies_graph : state -> string -> unit diff --git a/perl_checker.src/info.ml b/perl_checker.src/info.ml deleted file mode 100644 index ab76b9f..0000000 --- a/perl_checker.src/info.ml +++ /dev/null @@ -1,76 +0,0 @@ -open List -open Printf -open Common - -let (lines_starts : (string, int list) Hashtbl.t) = Hashtbl.create 4 -let current_file_lines_starts = ref [] -let current_file_current_line = ref 0 -let current_file = ref "" - -let start_a_new_file file = - if !current_file <> "" then Hashtbl.add lines_starts !current_file !current_file_lines_starts ; - current_file := file ; - current_file_lines_starts := [0] - -let add_a_file file file_lines_starts = Hashtbl.replace lines_starts file file_lines_starts - -let get_lines_starts_for_file file = - if file = !current_file then !current_file_lines_starts else Hashtbl.find lines_starts file - -let cwd = expand_symlinks (Unix.getcwd()) - -let file_to_absolute_file file = - let abs_file = - if file.[0] = '/' then file else - if file = "." then cwd else cwd ^ "/" ^ file - in - expand_symlinks abs_file - -let absolute_file_to_file = - let s1 = Filename.dirname cwd in - if String.length s1 < 4 then (fun x -> x) else - let short_cwd = - let s2 = Filename.dirname s1 in - if String.length s2 < 4 then s1 else - let s3 = Filename.dirname s2 in (* allow up to ../../../xxx *) - if String.length s3 < 4 then s2 else s3 in - memoize (fun abs_file -> - if str_begins_with (short_cwd ^ "/") abs_file then - let rec to_file rel cwd = - if str_begins_with (cwd ^ "/") abs_file then - rel ^ skip_n_char_ (String.length cwd + 1) 0 abs_file - else - to_file ("../" ^ rel) (Filename.dirname cwd) - in - to_file "" cwd - else - abs_file) - -let raw_pos2raw_line file a = - let starts = map_index (fun a b -> a,b) (rev (get_lines_starts_for_file file)) in - let ((offset, line), _) = find (fun (_,(e,_)) -> e > a) (combine starts (tl starts @ [999999999, 999999999])) in - line, offset - -let pos2line (file, a, b) = - let line, offset = raw_pos2raw_line file a in - file, line, a - offset + 1, b - offset + 1 - -let pos2s (file, a, b) = sprintf "(%s, %d, %d)" file a b - -let pos2sfull pos = - try - let file, line, n1, n2 = pos2line pos in - sprintf "File \"%s\", line %d, character %d-%d\n" (absolute_file_to_file file) (line + 1) n1 n2 - with Not_found -> failwith ("bad position " ^ pos2s pos) - -let pos2s_for_po pos = - let file, line, _, _ = pos2line pos in - absolute_file_to_file file ^ ":" ^ string_of_int (line + 1) - -let is_on_same_line file (a,b) = - let line_a, _ = raw_pos2raw_line file a in - let line_b, _ = raw_pos2raw_line file b in - line_a = line_b - -let is_on_same_line_current (a,b) = is_on_same_line !current_file (a,b) -let pos2sfull_current a b = pos2sfull (!current_file, a, b) diff --git a/perl_checker.src/info.mli b/perl_checker.src/info.mli deleted file mode 100644 index d337316..0000000 --- a/perl_checker.src/info.mli +++ /dev/null @@ -1,17 +0,0 @@ -val lines_starts : (string, int list) Hashtbl.t -val current_file_lines_starts : int list ref -val current_file_current_line : int ref -val current_file : string ref -val start_a_new_file : string -> unit -val add_a_file : string -> int list -> unit -val get_lines_starts_for_file : string -> int list -val file_to_absolute_file : string -> string -val absolute_file_to_file : string -> string -val raw_pos2raw_line : string -> int -> int * int -val pos2line : string * int * int -> string * int * int * int -val pos2s : string * int * int -> string -val pos2sfull : string * int * int -> string -val pos2s_for_po : string * int * int -> string -val is_on_same_line : string -> int * int -> bool -val is_on_same_line_current : int * int -> bool -val pos2sfull_current : int -> int -> string diff --git a/perl_checker.src/lexer.mll b/perl_checker.src/lexer.mll deleted file mode 100644 index f416499..0000000 --- a/perl_checker.src/lexer.mll +++ /dev/null @@ -1,1057 +0,0 @@ -{ (* -*- caml -*- *) -open Common -open Types -open Lexing -open Info - -let bpos = -1,-1 - -type raw_token = - | EOF of raw_pos - | SPACE of int - | CR - | INT of (string * raw_pos) - | FLOAT of (string * raw_pos) - | RAW_STRING of (string * raw_pos) - | STRING of (raw_interpolated_string * raw_pos) - | PATTERN of (raw_interpolated_string * string * raw_pos) - | QR_PATTERN of (raw_interpolated_string * string * raw_pos) - | PATTERN_SUBST of (raw_interpolated_string * raw_interpolated_string * string * raw_pos) - | BAREWORD of (string * raw_pos) - | BAREWORD_PAREN of (string * raw_pos) - | REVISION of (string * raw_pos) - | PERL_CHECKER_COMMENT of (string * raw_pos) - | PO_COMMENT of (string * raw_pos) - | POD of (string * raw_pos) - | LABEL of (string * raw_pos) - | COMMAND_STRING of (raw_interpolated_string * raw_pos) - | PRINT_TO_STAR of ((string * string) * raw_pos) - | PRINT_TO_SCALAR of ((string * string) * raw_pos) - | QUOTEWORDS of (string * raw_pos) - | COMPACT_HASH_SUBSCRIPT of (string * raw_pos) - | RAW_HERE_DOC of ((string * raw_pos) ref * raw_pos) - | HERE_DOC of (raw_interpolated_string * raw_pos) ref * raw_pos - | FORMAT of (raw_interpolated_string * raw_pos) ref * raw_pos - | SCALAR_IDENT of (string option * string * raw_pos) - | ARRAY_IDENT of (string option * string * raw_pos) - | HASH_IDENT of (string option * string * raw_pos) - | FUNC_IDENT of (string option * string * raw_pos) - | STAR_IDENT of (string option * string * raw_pos) - | RAW_IDENT of (string option * string * raw_pos) - | RAW_IDENT_PAREN of (string option * string * raw_pos) - | ARRAYLEN_IDENT of (string option * string * raw_pos) - | SUB_WITH_PROTO of (string * raw_pos) - | FUNC_DECL_WITH_PROTO of (string option * string * string * raw_pos) - - | IF of raw_pos | ELSIF of raw_pos | ELSE of raw_pos | UNLESS of raw_pos | DO of raw_pos | WHILE of raw_pos | UNTIL of raw_pos | MY_OUR of (string * raw_pos) | CONTINUE of raw_pos | SUB of raw_pos - | LOCAL of raw_pos | FOR of (string * raw_pos) | USE of raw_pos | PACKAGE of raw_pos | BEGIN of raw_pos | END of raw_pos | PRINT of (string * raw_pos) - | NEW of (raw_pos) | AT of raw_pos | DOLLAR of raw_pos | PERCENT of raw_pos | AMPERSAND of raw_pos - | STAR of raw_pos | ARRAYLEN of raw_pos | SEMI_COLON of raw_pos | PKG_SCOPE of raw_pos | PAREN of raw_pos | PAREN_END of raw_pos | BRACKET of raw_pos - | BRACKET_END of raw_pos | BRACKET_HASHREF of raw_pos | ARRAYREF of raw_pos | ARRAYREF_END of raw_pos | ARROW of raw_pos | INCR of raw_pos | DECR of raw_pos - | CONCAT of raw_pos | POWER of raw_pos | TIGHT_NOT of raw_pos | BIT_NEG of raw_pos | REF of raw_pos | ONE_SCALAR_PARA of (string * raw_pos) | PATTERN_MATCH of raw_pos | PATTERN_MATCH_NOT of raw_pos | MULT of (string * raw_pos) | MULT_L_STR of raw_pos - | PLUS of (string * raw_pos) | BIT_SHIFT of (string * raw_pos) - | LT of raw_pos | GT of raw_pos | COMPARE_OP of (string * raw_pos) | COMPARE_OP_STR of (string * raw_pos) | EQ_OP of (string * raw_pos) | EQ_OP_STR of (string * raw_pos) - | BIT_AND of raw_pos | BIT_OR of raw_pos | BIT_XOR of raw_pos | AND_TIGHT of raw_pos | OR_TIGHT of raw_pos | DOTDOT of (string * raw_pos) - | QUESTION_MARK of raw_pos | COLON of raw_pos | ASSIGN of (string * raw_pos) | COMMA of raw_pos | RIGHT_ARROW of raw_pos | NOT of raw_pos | AND of raw_pos | OR of raw_pos | XOR of raw_pos - -and raw_interpolated_string = (string * raw_token list) list - -let new_any mcontext any spaces pos = { mcontext = mcontext ; any = any ; spaces = spaces ; pos = pos } - -let pos lexbuf = lexeme_start lexbuf, lexeme_end lexbuf -let pos2sfull_with start end_ = Info.pos2sfull (!current_file, start, end_) -let pos2sfull lexbuf = pos2sfull_with (lexeme_start lexbuf) (lexeme_end lexbuf) - -let warn_with_pos warn_types (start, end_) err = if Flags.are_warning_types_set warn_types then print_endline_flush (pos2sfull_with start end_ ^ err) -let warn warn_types lexbuf err = warn_with_pos warn_types (pos lexbuf) err -let die lexbuf err = failwith (pos2sfull_with (lexeme_start lexbuf) (lexeme_end lexbuf) ^ err) - -let rec concat_bareword_paren accu = function - | PRINT(s, pos1) :: PAREN(pos2) :: l - | BAREWORD(s, pos1) :: PAREN(pos2) :: l -> - concat_bareword_paren (PAREN(pos2) :: BAREWORD_PAREN(s, pos1) :: accu) l - | RAW_IDENT(kind, ident, pos1) :: PAREN(pos2) :: l -> - concat_bareword_paren (PAREN(pos2) :: RAW_IDENT_PAREN(kind, ident, pos1) :: accu) l - | PO_COMMENT(_, pos) as e :: l -> - let l = drop_while (function CR | SPACE _ -> true | _ -> false) l in - (match l with - | PO_COMMENT _ :: _ - (* the check will be done on this PO_COMMENT *) - | BAREWORD("N", _) :: PAREN(_) :: _ - | BAREWORD("N_", _) :: PAREN(_) :: _ -> - concat_bareword_paren (e :: accu) l - | _ -> - warn_with_pos [Warn_MDK_Common] pos "N(...) must follow the #-PO: comment, with nothing in between" ; - concat_bareword_paren accu l) - | [] -> List.rev accu - | e :: l -> - concat_bareword_paren (e :: accu) l - -let rec bracket_bareword_is_hashref accu = function - | (pos, Parser.BRACKET bracket) :: (_, Parser.BAREWORD _ as bareword) :: (_, Parser.RIGHT_ARROW _ as right_arrow) :: l -> - bracket_bareword_is_hashref (right_arrow :: bareword :: (pos, Parser.BRACKET_HASHREF bracket) :: accu) l - | [] -> List.rev accu - | e :: l -> - bracket_bareword_is_hashref (e :: accu) l - - -let rec raw_token_to_pos_and_token spaces = function - | INT(s, pos) -> pos, Parser.NUM(new_any M_int s spaces pos) - | FLOAT(s, pos) -> pos, Parser.NUM(new_any M_float s spaces pos) - | RAW_STRING(s, pos) -> pos, Parser.RAW_STRING(new_any M_string s spaces pos) - | RAW_HERE_DOC(r, pos) -> pos, Parser.RAW_HERE_DOC(new_any M_string !r spaces pos) - | STRING(l, pos) -> pos, Parser.STRING(new_any M_string (raw_interpolated_string_to_tokens l) spaces pos) - | COMMAND_STRING(l, pos) -> pos, Parser.COMMAND_STRING(new_any (M_mixed [M_string; M_array]) (raw_interpolated_string_to_tokens l) spaces pos) - | QR_PATTERN(s, opts, pos) -> pos, Parser.QR_PATTERN(new_any M_special (raw_interpolated_string_to_tokens s, opts) spaces pos) - | PATTERN(s, opts, pos) -> pos, Parser.PATTERN(new_any M_special (raw_interpolated_string_to_tokens s, opts) spaces pos) - | PATTERN_SUBST(from, to_, opts, pos) -> pos, Parser.PATTERN_SUBST(new_any M_special (raw_interpolated_string_to_tokens from, raw_interpolated_string_to_tokens to_, opts) spaces pos) - | HERE_DOC(l, pos) -> pos, Parser.HERE_DOC(new_any M_string (raw_interpolated_string_to_tokens (fst !l), snd !l) spaces pos) - | FORMAT(l, pos) -> pos, Parser.FORMAT(new_any M_string (raw_interpolated_string_to_tokens (fst !l), snd !l) spaces pos) - | BAREWORD(s, pos) -> pos, Parser.BAREWORD(new_any M_special s spaces pos) - | BAREWORD_PAREN(s, pos) -> pos, Parser.BAREWORD_PAREN(new_any M_special s spaces pos) - | REVISION(s, pos) -> pos, Parser.REVISION(new_any M_revision s spaces pos) - | PERL_CHECKER_COMMENT(s, pos) -> pos, Parser.PERL_CHECKER_COMMENT(new_any M_none s spaces pos) - | PO_COMMENT(s, pos) -> pos, Parser.PO_COMMENT(new_any M_special s spaces pos) - | POD(s, pos) -> pos, Parser.POD(new_any M_special s spaces pos) - | LABEL(s, pos) -> pos, Parser.LABEL(new_any M_none s spaces pos) - | PRINT(s, pos) -> pos, Parser.PRINT(new_any M_special s spaces pos) - | PRINT_TO_STAR(s, pos) -> pos, Parser.PRINT_TO_STAR(new_any M_special s spaces pos) - | PRINT_TO_SCALAR(s, pos) -> pos, Parser.PRINT_TO_SCALAR(new_any M_special s spaces pos) - | QUOTEWORDS(s, pos) -> pos, Parser.QUOTEWORDS(new_any M_array s spaces pos) - | COMPACT_HASH_SUBSCRIPT(s, pos) -> pos, Parser.COMPACT_HASH_SUBSCRIPT(new_any M_special s spaces pos) - | SCALAR_IDENT(kind, name, pos) -> pos, Parser.SCALAR_IDENT(new_any M_special (kind, name) spaces pos) - | ARRAY_IDENT(kind, name, pos) -> pos, Parser.ARRAY_IDENT(new_any M_special (kind, name) spaces pos) - | HASH_IDENT(kind, name, pos) -> pos, Parser.HASH_IDENT(new_any M_special (kind, name) spaces pos) - | FUNC_IDENT(kind, name, pos) -> pos, Parser.FUNC_IDENT(new_any M_special (kind, name) spaces pos) - | STAR_IDENT(kind, name, pos) -> pos, Parser.STAR_IDENT(new_any M_special (kind, name) spaces pos) - | RAW_IDENT(kind, name, pos) -> pos, Parser.RAW_IDENT(new_any M_special (kind, name) spaces pos) - | RAW_IDENT_PAREN(kind, name, pos) -> pos, Parser.RAW_IDENT_PAREN(new_any M_special (kind, name) spaces pos) - | ARRAYLEN_IDENT(kind, name, pos) -> pos, Parser.ARRAYLEN_IDENT(new_any M_special (kind, name) spaces pos) - | SUB_WITH_PROTO(proto, pos) -> pos, Parser.SUB_WITH_PROTO(new_any M_special proto spaces pos) - | FUNC_DECL_WITH_PROTO(fq, name, proto, pos) -> pos, Parser.FUNC_DECL_WITH_PROTO(new_any M_special (fq, name, proto) spaces pos) - - | NEW(pos) -> pos, Parser.NEW(new_any M_special () spaces pos) - | COMPARE_OP(s, pos) -> pos, Parser.COMPARE_OP(new_any M_special s spaces pos) - | COMPARE_OP_STR(s, pos) -> pos, Parser.COMPARE_OP_STR(new_any M_special s spaces pos) - | EQ_OP(s, pos) -> pos, Parser.EQ_OP(new_any M_special s spaces pos) - | EQ_OP_STR(s, pos) -> pos, Parser.EQ_OP_STR(new_any M_special s spaces pos) - | ASSIGN(s, pos) -> pos, Parser.ASSIGN(new_any M_special s spaces pos) - | FOR(s, pos) -> pos, Parser.FOR(new_any M_special s spaces pos) - - | DOTDOT(s, pos) -> pos, Parser.DOTDOT(new_any M_special s spaces pos) - | MULT(s, pos) -> pos, Parser.MULT(new_any M_special s spaces pos) - | BIT_SHIFT(s, pos) -> pos, Parser.BIT_SHIFT(new_any M_special s spaces pos) - | PLUS(s, pos) -> pos, Parser.PLUS(new_any M_special s spaces pos) - | ONE_SCALAR_PARA(s, pos) -> pos, Parser.ONE_SCALAR_PARA(new_any M_special s spaces pos) - | MY_OUR(s, pos) -> pos, Parser.MY_OUR(new_any M_special s spaces pos) - - | EOF (pos) -> pos, Parser.EOF (new_any M_special () spaces pos) - | IF (pos) -> pos, Parser.IF (new_any M_special () spaces pos) - | ELSIF (pos) -> pos, Parser.ELSIF (new_any M_special () spaces pos) - | ELSE (pos) -> pos, Parser.ELSE (new_any M_special () spaces pos) - | UNLESS (pos) -> pos, Parser.UNLESS (new_any M_special () spaces pos) - | DO (pos) -> pos, Parser.DO (new_any M_special () spaces pos) - | WHILE (pos) -> pos, Parser.WHILE (new_any M_special () spaces pos) - | UNTIL (pos) -> pos, Parser.UNTIL (new_any M_special () spaces pos) - | CONTINUE (pos) -> pos, Parser.CONTINUE (new_any M_special () spaces pos) - | SUB (pos) -> pos, Parser.SUB (new_any M_special () spaces pos) - | LOCAL (pos) -> pos, Parser.LOCAL (new_any M_special () spaces pos) - | USE (pos) -> pos, Parser.USE (new_any M_special () spaces pos) - | PACKAGE (pos) -> pos, Parser.PACKAGE (new_any M_special () spaces pos) - | BEGIN (pos) -> pos, Parser.BEGIN (new_any M_special () spaces pos) - | END (pos) -> pos, Parser.END (new_any M_special () spaces pos) - | AT (pos) -> pos, Parser.AT (new_any M_special () spaces pos) - | DOLLAR (pos) -> pos, Parser.DOLLAR (new_any M_special () spaces pos) - | PERCENT (pos) -> pos, Parser.PERCENT (new_any M_special () spaces pos) - | AMPERSAND (pos) -> pos, Parser.AMPERSAND (new_any M_special () spaces pos) - | STAR (pos) -> pos, Parser.STAR (new_any M_special () spaces pos) - | ARRAYLEN (pos) -> pos, Parser.ARRAYLEN (new_any M_special () spaces pos) - | SEMI_COLON (pos) -> pos, Parser.SEMI_COLON (new_any M_none () spaces pos) - | PKG_SCOPE (pos) -> pos, Parser.PKG_SCOPE (new_any M_special () spaces pos) - | PAREN (pos) -> pos, Parser.PAREN (new_any M_special () spaces pos) - | PAREN_END (pos) -> pos, Parser.PAREN_END (new_any M_special () spaces pos) - | BRACKET (pos) -> pos, Parser.BRACKET (new_any M_special () spaces pos) - | BRACKET_END (pos) -> pos, Parser.BRACKET_END (new_any M_special () spaces pos) - | BRACKET_HASHREF (pos) -> pos, Parser.BRACKET_HASHREF (new_any M_special () spaces pos) - | ARRAYREF (pos) -> pos, Parser.ARRAYREF (new_any M_special () spaces pos) - | ARRAYREF_END (pos) -> pos, Parser.ARRAYREF_END (new_any M_special () spaces pos) - | ARROW (pos) -> pos, Parser.ARROW (new_any M_special () spaces pos) - | INCR (pos) -> pos, Parser.INCR (new_any M_special () spaces pos) - | DECR (pos) -> pos, Parser.DECR (new_any M_special () spaces pos) - | POWER (pos) -> pos, Parser.POWER (new_any M_special () spaces pos) - | TIGHT_NOT (pos) -> pos, Parser.TIGHT_NOT (new_any M_special () spaces pos) - | BIT_NEG (pos) -> pos, Parser.BIT_NEG (new_any M_special () spaces pos) - | REF (pos) -> pos, Parser.REF (new_any M_special () spaces pos) - | PATTERN_MATCH (pos) -> pos, Parser.PATTERN_MATCH (new_any M_special () spaces pos) - | PATTERN_MATCH_NOT(pos) -> pos, Parser.PATTERN_MATCH_NOT(new_any M_special () spaces pos) - | LT (pos) -> pos, Parser.LT (new_any M_special () spaces pos) - | GT (pos) -> pos, Parser.GT (new_any M_special () spaces pos) - | BIT_AND (pos) -> pos, Parser.BIT_AND (new_any M_special () spaces pos) - | BIT_OR (pos) -> pos, Parser.BIT_OR (new_any M_special () spaces pos) - | BIT_XOR (pos) -> pos, Parser.BIT_XOR (new_any M_special () spaces pos) - | AND_TIGHT (pos) -> pos, Parser.AND_TIGHT (new_any M_special () spaces pos) - | OR_TIGHT (pos) -> pos, Parser.OR_TIGHT (new_any M_special () spaces pos) - | QUESTION_MARK (pos) -> pos, Parser.QUESTION_MARK (new_any M_special () spaces pos) - | COLON (pos) -> pos, Parser.COLON (new_any M_special () spaces pos) - | COMMA (pos) -> pos, Parser.COMMA (new_any M_special () spaces pos) - | CONCAT (pos) -> pos, Parser.CONCAT (new_any M_special () spaces pos) - | MULT_L_STR (pos) -> pos, Parser.MULT_L_STR (new_any M_special () spaces pos) - | RIGHT_ARROW (pos) -> pos, Parser.RIGHT_ARROW (new_any M_special () spaces pos) - | NOT (pos) -> pos, Parser.NOT (new_any M_special () spaces pos) - | AND (pos) -> pos, Parser.AND (new_any M_special () spaces pos) - | OR (pos) -> pos, Parser.OR (new_any M_special () spaces pos) - | XOR (pos) -> pos, Parser.XOR (new_any M_special () spaces pos) - - | SPACE _ | CR -> internal_error "raw_token_to_token" - -and raw_token_to_token spaces raw_token = - let _, token = raw_token_to_pos_and_token spaces raw_token in - token - -and raw_interpolated_string_to_tokens l = - List.map (fun (s, rtok) -> s, concat_spaces [] Space_0 rtok) l - -and concat_spaces ret spaces = function - | CR :: l -> concat_spaces ret Space_cr l - | SPACE n :: l -> - let spaces' = - match spaces with - | Space_cr -> Space_cr - | Space_0 -> if n = 1 then Space_1 else Space_n - | _ -> Space_n - in - concat_spaces ret spaces' l - | [] -> List.rev ret - | token :: l -> concat_spaces (raw_token_to_pos_and_token spaces token :: ret) Space_0 l - -let rec lexbuf2list accu t lexbuf = - match t lexbuf with - | EOF pos -> List.rev (EOF pos :: accu) - | e -> lexbuf2list (e :: accu) t lexbuf - -let get_token token lexbuf = - let tokens = lexbuf2list [] token lexbuf in - let tokens = concat_bareword_paren [] tokens in - let tokens = concat_spaces [] Space_0 tokens in - let tokens = bracket_bareword_is_hashref [] tokens in - tokens - -let next_rule = Stack.create() - - -let putback lexbuf nb = lexbuf.Lexing.lex_curr_pos <- lexbuf.Lexing.lex_curr_pos - nb - -let add_a_new_line raw_pos = - incr current_file_current_line ; - lpush current_file_lines_starts raw_pos - -let here_docs = Queue.create() -let raw_here_docs = Queue.create() -let current_here_doc_mark = ref "" - -let here_doc_next_line mark = - let here_doc_ref = ref([], bpos) in - Queue.push (mark, here_doc_ref) here_docs ; - here_doc_ref -let raw_here_doc_next_line mark = - let here_doc_ref = ref("", bpos) in - Queue.push (mark, here_doc_ref) raw_here_docs ; - here_doc_ref - -let delimit_char = ref '/' -let delimit_char_open = ref '(' -let delimit_char_close = ref ')' -type string_escape_kinds = Double_quote | Qq | Delimited | Here_doc -let string_escape_kind = ref Double_quote -let string_quote_escape = ref false -let string_escape_useful = ref (Left false) -let not_ok_for_match = ref (-1) -let string_nestness = ref 0 -let string_is_i18n = ref false - -let building_current_interpolated_string = Stack.create() -let building_current_string = Stack.create() -let current_string_start_pos = ref 0 -let current_string_start_line = ref 0 - -let die_in_string lexbuf err = failwith (pos2sfull_with !current_string_start_pos (lexeme_end lexbuf) ^ err) -let warn_escape_unneeded lexbuf c = - let s = String.make 1 c in warn [Warn_suggest_simpler] lexbuf ("you can replace \\" ^ s ^ " with " ^ s) -let next_interpolated toks = - let r = Stack.top building_current_string in - Queue.push (!r, toks) (Stack.top building_current_interpolated_string) ; - r := "" - -let raw_ins t lexbuf = - Stack.push (ref "") building_current_string; - current_string_start_pos := lexeme_start lexbuf; - t lexbuf ; - !(Stack.pop building_current_string), (!current_string_start_pos, lexeme_end lexbuf) - -let ins t lexbuf = - Stack.push (Queue.create()) building_current_interpolated_string ; - Stack.push (ref "") building_current_string; - current_string_start_pos := lexeme_start lexbuf; - t lexbuf ; - next_interpolated [] ; - let _ = Stack.pop building_current_string in - queue2list (Stack.pop building_current_interpolated_string), (!current_string_start_pos, lexeme_end lexbuf) - -let raw_ins_to_string t lexbuf = - let s, pos = raw_ins t lexbuf in - not_ok_for_match := lexeme_end lexbuf; - RAW_STRING(s, pos) -let ins_to_string t lexbuf = - string_escape_useful := Left false ; - string_quote_escape := false ; - let s, pos = ins t lexbuf in - - if not !string_is_i18n then - (match !string_escape_useful, s with - | Right c, [ _, [] ] -> - let s = String.make 1 c in - warn_with_pos [Warn_suggest_simpler] pos ("you can replace \"xxx\\" ^ s ^ "xxx\" with 'xxx" ^ s ^ "xxx', that way you don't need to escape <" ^ s ^ ">") - | _ -> - if !string_quote_escape then - let full_s = String.concat "" (List.map fst s) in - let nb = string_fold_left (fun nb c -> - if nb < 0 then nb else - if c = '(' then nb + 1 else - if c = ')' then nb - 1 else nb - ) 0 full_s in - if nb = 0 then - warn_with_pos [Warn_suggest_simpler] pos "you can replace \"xxx\\\"xxx\" with qq(xxx\"xxx), that way you don't need to escape <\">" - ); - - not_ok_for_match := lexeme_end lexbuf; - string_is_i18n := false ; - STRING(s, pos) - -let next_s s t lexbuf = - let r = Stack.top building_current_string in r := !r ^ s ; - t lexbuf -let next t lexbuf = next_s (lexeme lexbuf) t lexbuf - -let ins_re re_delimited_string lexbuf = - let s, pos = ins re_delimited_string lexbuf in - List.iter (fun (s, _) -> - if str_contains s "[^\\s]" then warn [Warn_suggest_simpler] lexbuf "you can replace [^\\s] with \\S"; - if str_contains s "[^\\w]" then warn [Warn_suggest_simpler] lexbuf "you can replace [^\\w] with \\W" - ) s ; - s, pos - -let string_interpolate token pre lexbuf = - let s = lexeme lexbuf in - let local_lexbuf = Lexing.from_string (pre ^ s ^ " ") in (* add a space to help tokenizing "xxx$$" *) - local_lexbuf.lex_start_p <- lexbuf.lex_start_p ; - local_lexbuf.lex_curr_p <- lexbuf.lex_start_p ; - local_lexbuf.lex_abs_pos <- lexeme_start lexbuf ; - let l = lexbuf2list [] token local_lexbuf in - let l = concat_bareword_paren [] l in - next_interpolated l; - (Stack.pop next_rule) lexbuf - -let ident_type_from_char fq name lexbuf c = - not_ok_for_match := lexeme_end lexbuf; - match c with - | '$' -> SCALAR_IDENT(fq, name, pos lexbuf) - | '@' -> ARRAY_IDENT (fq, name, pos lexbuf) - | '%' -> HASH_IDENT (fq, name, pos lexbuf) - | '&' -> FUNC_IDENT (fq, name, pos lexbuf) - | '*' -> STAR_IDENT (fq, name, pos lexbuf) - | _ -> internal_error "ident_type_from_char" - -let split_at_two_colons s = - let i_fq = String.rindex s ':' in - String.sub s 0 (i_fq - 1), skip_n_char (i_fq + 1) s - -let ident_from_lexbuf lexbuf = - let fq, name = split_at_two_colons (lexeme lexbuf) in - RAW_IDENT(Some fq, name, pos lexbuf) - -let typed_ident_from_lexbuf lexbuf = - let s = lexeme lexbuf in - ident_type_from_char None (skip_n_char 1 s) lexbuf s.[0] - -let typed_fqident_from_lexbuf lexbuf = - let s = lexeme lexbuf in - let fq, name = split_at_two_colons (skip_n_char 1 s) in - ident_type_from_char (Some fq) name lexbuf s.[0] - -let arraylen_ident_from_lexbuf lexbuf = - not_ok_for_match := lexeme_end lexbuf; - let s = lexeme lexbuf in - ARRAYLEN_IDENT(None, skip_n_char 2 s, pos lexbuf) - -let arraylen_fqident_from_lexbuf lexbuf = - let s = lexeme lexbuf in - let fq, name = split_at_two_colons (skip_n_char 2 s) in - ARRAYLEN_IDENT(Some fq, name, pos lexbuf) - -let check_multi_line_delimited_string opts (start, end_) = - let check = - match opts with - | None -> true - | Some s -> not (String.contains s 'x') in - if check then - if !current_file_current_line <> !current_string_start_line then - failwith (pos2sfull_with start end_ ^ "multi-line patterns are not allowed (or use /x modifier)") - -let hex_in_string lexbuf next_rule s = - let i = - try int_of_string ("0x" ^ s) - with Failure("int_of_string") -> die_in_string lexbuf ("Bad_hex_in_string \"" ^ lexeme lexbuf ^ "\"") - in - let s = - if i < 256 then - String.make 1 (Char.chr i) - else - "\\x{" ^ s ^ "}" in - next_s s (Stack.pop next_rule) lexbuf - -let set_delimit_char lexbuf op = - let c = lexeme_char lexbuf (String.length op) in - delimit_char := c; - match c with - | '@' -> warn [Warn_complex_expressions] lexbuf ("don't use " ^ op ^ "@...@, replace @ with / ! , or |") - | ':' -> warn [Warn_complex_expressions] lexbuf ("don't use " ^ op ^ ":...:, replace : with / ! , or |") - | _ -> () - -let set_delimit_char_open lexbuf op = - let char_open = lexeme_char lexbuf (String.length op) in - let char_close = - match char_open with - | '(' -> ')' - | '{' -> '}' - | _ -> internal_error "set_delimit_char_open" - in - if op = "qx" then - warn [Warn_complex_expressions] lexbuf (Printf.sprintf "don't use qx%c...%c, use `...` instead" char_open char_close) - else if char_open = '{' then - warn [Warn_complex_expressions] lexbuf ("don't use " ^ op ^ "{...}, use " ^ op ^ "(...) instead"); - delimit_char_open := char_open; - delimit_char_close := char_close -} - -let stash = [ '$' '@' '%' '&' '*' ] -let ident_start = ['a'-'z' 'A'-'Z' '_'] -let ident = ident_start ['0'-'9' 'A'-'Z' 'a'-'z' '_'] * -let pattern_separator = [ '/' '!' ',' '|' '@' ':' ] -let pattern_open = [ '(' '{' ] -let pattern_close = [ ')' '}' ] - -let in_string_expr = (ident | (ident? ("::" ident)+)) "->"? (('{' [^ '{' '}' '\n']* '}') | ('[' [^ '[' ']' '\n']* ']'))* - -rule token = parse -| [' ' '\t']+ { - (* propagate not_ok_for_match when it was set by the previous token *) - if lexeme_start lexbuf = !not_ok_for_match then not_ok_for_match := lexeme_end lexbuf; - SPACE(lexeme_end lexbuf - lexeme_start lexbuf) - } -| "# perl_checker: " [^ '\n']* { PERL_CHECKER_COMMENT(skip_n_char 16 (lexeme lexbuf), pos lexbuf) } -| "#-PO: " [^ '\n']* { PO_COMMENT(skip_n_char 1 (lexeme lexbuf), pos lexbuf) } -| '#' [^ '\n']* { SPACE(1) } - -| "\n=" { - add_a_new_line(lexeme_end lexbuf - 1); - let _ = ins pod_command lexbuf in token lexbuf - } - -| '\n' { - add_a_new_line(lexeme_end lexbuf); - (try - let (mark, r) = Queue.pop here_docs in - current_here_doc_mark := mark ; - r := ins here_doc lexbuf - with Queue.Empty -> - try - let (mark, r) = Queue.pop raw_here_docs in - current_here_doc_mark := mark ; - r := raw_ins raw_here_doc lexbuf - with Queue.Empty -> ()); - CR - } -| "->" { ARROW(pos lexbuf) } -| "++" { INCR(pos lexbuf) } -| "--" { DECR(pos lexbuf) } -| "**" { POWER(pos lexbuf) } -| "!" { TIGHT_NOT(pos lexbuf) } -| "~" { BIT_NEG(pos lexbuf) } -| "=~" { PATTERN_MATCH(pos lexbuf) } -| "!~" { PATTERN_MATCH_NOT(pos lexbuf) } -| "*" { MULT(lexeme lexbuf, pos lexbuf) } -| "%" { MULT(lexeme lexbuf, pos lexbuf) } -| "x" { MULT_L_STR(pos lexbuf) } -| "+" { PLUS(lexeme lexbuf, pos lexbuf) } -| "-" { PLUS(lexeme lexbuf, pos lexbuf) } -| "." { CONCAT(pos lexbuf) } -| "<<" { BIT_SHIFT(lexeme lexbuf, pos lexbuf) } -| ">>" { BIT_SHIFT(lexeme lexbuf, pos lexbuf) } -| "<" { LT(pos lexbuf) } -| ">" { GT(pos lexbuf) } -| "<=" | ">=" { COMPARE_OP(lexeme lexbuf, pos lexbuf) } -| "lt" | "gt" | "le" | "ge" { COMPARE_OP_STR(lexeme lexbuf, pos lexbuf) } -| "==" | "!=" | "<=>" { EQ_OP(lexeme lexbuf, pos lexbuf) } -| "eq" | "ne" | "cmp" { EQ_OP_STR(lexeme lexbuf, pos lexbuf) } -| "&" { BIT_AND(pos lexbuf) } -| "|" { BIT_OR(pos lexbuf) } -| "^" { BIT_XOR(pos lexbuf) } -| "&&" { AND_TIGHT(pos lexbuf) } -| "||" { OR_TIGHT(pos lexbuf) } -| ".." { DOTDOT(lexeme lexbuf, pos lexbuf) } -| "..." { DOTDOT(lexeme lexbuf, pos lexbuf) } -| "?" { QUESTION_MARK(pos lexbuf) } -| ":" { COLON(pos lexbuf) } -| "::" { PKG_SCOPE(pos lexbuf) } - -| "=" | "+=" | "-=" | "*=" | ".=" | "|=" | "&=" | "^=" | "||=" | "&&=" { ASSIGN(lexeme lexbuf, pos lexbuf) } - -| "<<=" | ">>=" | "**=" { - warn [Warn_complex_expressions] lexbuf (Printf.sprintf "don't use \"%s\", use the expanded version instead" (lexeme lexbuf)) ; - ASSIGN(lexeme lexbuf, pos lexbuf) - } - -| "," { COMMA(pos lexbuf) } -| "=>" { RIGHT_ARROW(pos lexbuf) } -| "not" { NOT(pos lexbuf) } -| "and" { AND(pos lexbuf) } -| "or" { OR(pos lexbuf) } -| "xor" { XOR(pos lexbuf) } - -| "if" { IF(pos lexbuf) } -| "else" { ELSE(pos lexbuf) } -| "elsif" { ELSIF(pos lexbuf) } -| "unless" { UNLESS(pos lexbuf) } -| "do" { DO(pos lexbuf) } -| "while" { WHILE(pos lexbuf) } -| "until" { UNTIL(pos lexbuf) } -| "foreach" { FOR(lexeme lexbuf, pos lexbuf) } -| "for" { FOR(lexeme lexbuf, pos lexbuf) } -| "my" { MY_OUR(lexeme lexbuf, pos lexbuf) } -| "our" { MY_OUR(lexeme lexbuf, pos lexbuf) } -| "local" { LOCAL(pos lexbuf) } -| "continue" { CONTINUE(pos lexbuf) } -| "sub" { SUB(pos lexbuf) } -| "package" { PACKAGE(pos lexbuf) } -| "use" { USE(pos lexbuf) } -| "BEGIN" { BEGIN(pos lexbuf) } -| "END" { END(pos lexbuf) } -| "print" { PRINT(lexeme lexbuf, pos lexbuf) } -| "printf" { PRINT(lexeme lexbuf, pos lexbuf) } -| "new" { NEW(pos lexbuf) } -| "format" { let pos = pos lexbuf in FORMAT(here_doc_next_line ".", pos) } -| "delete" -| "defined" -| "length" -| "keys" -| "exists" -| "shift" -| "pop" -| "eval" -| "ref" { ONE_SCALAR_PARA(lexeme lexbuf, pos lexbuf) } - -| "split" -| "grep" { (* ok_for_match! *) BAREWORD(lexeme lexbuf, pos lexbuf) } - -| "print " ['A'-'Z'] ['A'-'Z' '0'-'9']* ['\n' ' '] { - putback lexbuf 1; - PRINT_TO_STAR(("print", skip_n_char 6 (lexeme lexbuf)), pos lexbuf) - } -| "print $" ident ['\n' ' '] { - putback lexbuf 1; - PRINT_TO_SCALAR(("print", skip_n_char 7 (lexeme lexbuf)), pos lexbuf); - } -| "printf " ['A'-'Z'] ['A'-'Z' '0'-'9']* ['\n' ' '] { - putback lexbuf 1; - PRINT_TO_STAR(("printf", skip_n_char 7 (lexeme lexbuf)), pos lexbuf) - } -| "printf $" ident ['\n' ' '] { - putback lexbuf 1; - PRINT_TO_SCALAR(("printf", skip_n_char 8 (lexeme lexbuf)), pos lexbuf); - } - -| ident ' '* "=>" { (* needed so that (if => 1) works *) - let s = lexeme lexbuf in - let end_ = String.length s - 1 in - let ident_end = non_rindex_from s (end_ - 2) ' ' in - putback lexbuf (end_ - ident_end); - BAREWORD(String.sub s 0 (ident_end+1), pos lexbuf) - } - -| "{" ident "}" { (* needed so that $h{if} works *) - not_ok_for_match := lexeme_end lexbuf; - COMPACT_HASH_SUBSCRIPT(skip_n_char_ 1 1 (lexeme lexbuf), pos lexbuf) - } - -| '@' { AT(pos lexbuf) } -| '$' { DOLLAR(pos lexbuf) } -| '$' '#' { ARRAYLEN(pos lexbuf) } -| '%' ['$' '{'] { putback lexbuf 1; PERCENT(pos lexbuf) } -| '&' ['$' '{'] { putback lexbuf 1; AMPERSAND(pos lexbuf) } -| '*' ['$' '{'] { putback lexbuf 1; if lexeme_start lexbuf = !not_ok_for_match then MULT("*", pos lexbuf) else STAR(pos lexbuf) } - - -| ';' { SEMI_COLON(pos lexbuf) } -| '(' { PAREN(pos lexbuf) } -| '{' { BRACKET(pos lexbuf) } -| "+{"{ BRACKET_HASHREF(pos lexbuf) } -| '[' { ARRAYREF(pos lexbuf) } -| ')' { not_ok_for_match := lexeme_end lexbuf; PAREN_END(pos lexbuf) } -| '}' { not_ok_for_match := lexeme_end lexbuf; BRACKET_END(pos lexbuf) } -| ']' { not_ok_for_match := lexeme_end lexbuf; ARRAYREF_END(pos lexbuf) } - -| "/" { - if lexeme_start lexbuf = !not_ok_for_match then MULT("/", pos lexbuf) - else ( - delimit_char := '/' ; - current_string_start_line := !current_file_current_line; - let s, pos = ins_re re_delimited_string lexbuf in - let opts, _ = raw_ins pattern_options lexbuf in - check_multi_line_delimited_string (Some opts) pos ; - PATTERN(s, opts, pos) - ) - } - -| "/=" { - if lexeme_start lexbuf = !not_ok_for_match then ASSIGN(lexeme lexbuf, pos lexbuf) - else ( - putback lexbuf 1 ; - delimit_char := '/' ; - let s, pos = ins_re re_delimited_string lexbuf in - let opts, _ = raw_ins pattern_options lexbuf in - PATTERN(s, opts, pos) - ) - } - -| "m" pattern_separator { - set_delimit_char lexbuf "m" ; - current_string_start_line := !current_file_current_line; - let s, pos = ins_re re_delimited_string lexbuf in - let opts, _ = raw_ins pattern_options lexbuf in - check_multi_line_delimited_string (Some opts) pos ; - PATTERN(s, opts, pos) -} - -| "qr" pattern_separator { - set_delimit_char lexbuf "qr" ; - current_string_start_line := !current_file_current_line; - let s, pos = ins_re re_delimited_string lexbuf in - let opts, _ = raw_ins pattern_options lexbuf in - check_multi_line_delimited_string (Some opts) pos ; - QR_PATTERN(s, opts, pos) -} - -| "qw" pattern_separator { - set_delimit_char lexbuf "qw" ; - current_string_start_line := !current_file_current_line; - let s, pos = raw_ins delimited_string lexbuf in - warn_with_pos [Warn_complex_expressions] pos (Printf.sprintf "don't use qw%c...%c, use qw(...) instead" !delimit_char !delimit_char) ; - QUOTEWORDS(s, pos) -} - -| "s" pattern_separator { - set_delimit_char lexbuf "s" ; - current_string_start_line := !current_file_current_line; - let s1, (start, _) = ins_re re_delimited_string lexbuf in - let s2, (_, end_) = ins delimited_string lexbuf in - let opts, _ = raw_ins pattern_options lexbuf in - let pos = start, end_ in - if String.contains opts 'e' && sum (List.map (fun (s, _) -> count_chars_in_string s '"') s2) > 2 then - die lexbuf ("do not write so complicated things in the eval part of s///,\n" ^ - "i generate wrong warnings for things like s/xxx/die \"yyy \\\"zzz\\\" \"/") ; - check_multi_line_delimited_string (Some opts) pos ; - PATTERN_SUBST(s1, s2, opts, pos) -} - -| "tr" pattern_separator { - set_delimit_char lexbuf "tr" ; - current_string_start_line := !current_file_current_line; - let s1, (start, _) = ins delimited_string lexbuf in - let s2, (_, end_) = ins delimited_string lexbuf in - let opts, _ = raw_ins pattern_options lexbuf in - let pos = start, end_ in - check_multi_line_delimited_string None pos ; - PATTERN_SUBST(s1, s2, opts, pos) -} - -| "<<" ident { - not_ok_for_match := lexeme_end lexbuf; - HERE_DOC(here_doc_next_line (skip_n_char 2 (lexeme lexbuf)), pos lexbuf) - } -| "<<\"" ident "\"" { - warn_with_pos [Warn_suggest_simpler] (lexeme_start lexbuf + 2, lexeme_end lexbuf) "Don't use <<\"MARK\", use <>" (pos2sfull lexbuf) (lexeme lexbuf)) } - -and string = parse -| '"' { () } -| '\\' { Stack.push string next_rule ; string_escape_kind := Double_quote; string_escape lexbuf } -| '$' { Stack.push string next_rule ; string_interpolate_scalar lexbuf } -| '@' { Stack.push string next_rule ; string_interpolate_array lexbuf } -| '\n' { - add_a_new_line(lexeme_end lexbuf); - next string lexbuf - } -| "'" { string_escape_useful := Left true ; next string lexbuf } -| [^ '\n' '\\' '"' '$' '@']+ { next string lexbuf } -| eof { die_in_string lexbuf "Unterminated_string" } - -and delimited_string = parse -| '\\' { Stack.push delimited_string next_rule ; string_escape_kind := Delimited; string_escape lexbuf } -| '$' { Stack.push delimited_string next_rule ; delimited_string_interpolate_scalar lexbuf } -| '@' { Stack.push delimited_string next_rule ; delimited_string_interpolate_array lexbuf } -| '\n' { - add_a_new_line(lexeme_end lexbuf); - next delimited_string lexbuf - } -| eof { die_in_string lexbuf "Unterminated_delimited_string" } -| [ ^ '\n' '\\' '$' '@'] { if lexeme_char lexbuf 0 <> !delimit_char then next delimited_string lexbuf } - -and re_delimited_string = parse -| '\\' { Stack.push re_delimited_string next_rule ; re_string_escape lexbuf } -| '$' { Stack.push re_delimited_string next_rule ; delimited_string_interpolate_scalar lexbuf } -| '@' { if lexeme_char lexbuf 0 <> !delimit_char then - (Stack.push re_delimited_string next_rule ; delimited_string_interpolate_array lexbuf) } -| '\n' { - add_a_new_line(lexeme_end lexbuf); - next re_delimited_string lexbuf - } -| eof { die_in_string lexbuf "Unterminated_delimited_string" } -| [ ^ '\n' '\\' '$' '@'] { if lexeme_char lexbuf 0 <> !delimit_char then next re_delimited_string lexbuf } - -and rawstring = parse -| ''' { () } -| '\n' { - add_a_new_line(lexeme_end lexbuf); - next rawstring lexbuf - } -| '\\' { next rawstring lexbuf } -| "\\'" { next_s "'" rawstring lexbuf } -| [^ '\n' ''' '\\']+ { next rawstring lexbuf } -| eof { die_in_string lexbuf "Unterminated_rawstring" } - -and qqstring = parse -| pattern_close { - if lexeme_char lexbuf 0 = !delimit_char_close then - if !string_nestness <> 0 then (decr string_nestness; next qqstring lexbuf) - else () - else next qstring lexbuf - } -| pattern_open { - if lexeme_char lexbuf 0 = !delimit_char_open then incr string_nestness; - next qqstring lexbuf - } -| '\\' { Stack.push qqstring next_rule ; string_escape_kind := Qq; string_escape lexbuf } -| '$' { Stack.push qqstring next_rule ; string_interpolate_scalar lexbuf } -| '@' { Stack.push qqstring next_rule ; string_interpolate_array lexbuf } -| '\n' { - add_a_new_line(lexeme_end lexbuf); - next qqstring lexbuf - } -| [^ '\n' '(' ')' '{' '}' '\\' '$' '@']+ { next qqstring lexbuf } -| eof { die_in_string lexbuf "Unterminated_qqstring" } - -and qstring = parse -| pattern_close { - if lexeme_char lexbuf 0 = !delimit_char_close then - if !string_nestness <> 0 then (decr string_nestness ; next qstring lexbuf) - else () - else next qstring lexbuf - } -| pattern_open { - if lexeme_char lexbuf 0 = !delimit_char_open then incr string_nestness; - next qstring lexbuf - } -| '\n' { - add_a_new_line(lexeme_end lexbuf); - next qstring lexbuf - } -| [^ '\n' '(' ')' '{' '}']+ { next qstring lexbuf } -| eof { die_in_string lexbuf "Unterminated_qstring" } - -and here_doc = parse -| '\\' { Stack.push here_doc next_rule ; string_escape_kind := Here_doc; string_escape lexbuf } -| '$' { Stack.push here_doc next_rule ; string_interpolate_scalar lexbuf } -| '@' { Stack.push here_doc next_rule ; string_interpolate_array lexbuf } -| [ ^ '\n' '\\' '$' '@' ]* { - let s = lexeme lexbuf in - if chomps s <> !current_here_doc_mark - then next_s s here_doc lexbuf - else if s <> !current_here_doc_mark then warn_with_pos [Warn_traps] (pos lexbuf) "Trailing spaces after HERE-document mark" - } -| '\n' { - add_a_new_line(lexeme_end lexbuf); - next here_doc lexbuf - } -| eof { die_in_string lexbuf "Unterminated_here_doc" } - -and raw_here_doc = parse -| [ ^ '\n' ]* { - let s = lexeme lexbuf in - if chomps s <> !current_here_doc_mark - then next_s s raw_here_doc lexbuf - else if s <> !current_here_doc_mark then warn_with_pos [Warn_traps] (pos lexbuf) "Trailing spaces after HERE-document mark" - } -| '\n' { - add_a_new_line(lexeme_end lexbuf); - next raw_here_doc lexbuf - } -| eof { die_in_string lexbuf "Unterminated_raw_here_doc" } - - -and string_escape = parse -| ['0'-'9'] { string_escape_useful := Left true; next_s (String.make 1 (Char.chr (int_of_string (lexeme lexbuf)))) (Stack.pop next_rule) lexbuf } -| 'n' { string_escape_useful := Left true; next_s "\n" (Stack.pop next_rule) lexbuf } -| 't' { string_escape_useful := Left true; next_s "\t" (Stack.pop next_rule) lexbuf } -| "x{" [^ '}']* '}' { string_escape_useful := Left true; hex_in_string lexbuf next_rule (skip_n_char_ 2 1 (lexeme lexbuf)) } -| 'x' [^ '{'] _ { string_escape_useful := Left true; hex_in_string lexbuf next_rule (skip_n_char 1 (lexeme lexbuf)) } -| '\n' { die lexbuf "do not use \"\\\" before end-of-line, it's useless and generally bad" } -| '\\'{ next_s "\\" (Stack.pop next_rule) lexbuf } -| 'Q' { - warn [Warn_complex_expressions] lexbuf ("don't use \\Q, use quotemeta instead"); - string_escape_useful := Left true; next_s ("\\" ^ lexeme lexbuf) (Stack.pop next_rule) lexbuf } -| ['b' 'f' 'a' 'r'] { string_escape_useful := Left true; next_s ("\\" ^ lexeme lexbuf) (Stack.pop next_rule) lexbuf } -| ['$' '@' '%' '{' '[' ':'] { - if !string_escape_useful = Left false then string_escape_useful := Right (lexeme_char lexbuf 0) ; - next_s (lexeme lexbuf) (Stack.pop next_rule) lexbuf - } -| _ { - let c = lexeme_char lexbuf 0 in - (match !string_escape_kind with - | Double_quote -> - if c <> '"' then - warn_escape_unneeded lexbuf c - else ( - if !string_escape_useful = Left false then string_escape_useful := Right c ; - string_quote_escape := true - ) - | Qq -> if c <> !delimit_char_open && c <> !delimit_char_close then warn_escape_unneeded lexbuf c - | Here_doc -> warn_escape_unneeded lexbuf c - | Delimited -> if c = !delimit_char then - warn [Warn_suggest_simpler] lexbuf ("change the delimit character " ^ String.make 1 !delimit_char ^ " to get rid of this escape") - else warn_escape_unneeded lexbuf c); - let s = if c = '"' then String.make 1 c else "\\" ^ String.make 1 c in - next_s s (Stack.pop next_rule) lexbuf - } - -and re_string_escape = parse -| ['0'-'9'] { next_s (String.make 1 (Char.chr (int_of_string (lexeme lexbuf)))) (Stack.pop next_rule) lexbuf } -| '\\'{ next_s "\\" (Stack.pop next_rule) lexbuf } -| 'n' { next_s "\n" (Stack.pop next_rule) lexbuf } -| 't' { next_s "\t" (Stack.pop next_rule) lexbuf } -| "x{" [^ '}']* '}' { hex_in_string lexbuf next_rule (skip_n_char_ 2 1 (lexeme lexbuf)) } -| 'x' [^ '{'] _ { hex_in_string lexbuf next_rule (skip_n_char 1 (lexeme lexbuf)) } -| '\n' { die lexbuf "do not use \"\\\" before end-of-line, it's useless and generally bad" } -| ['r' 'b' 'f' '$' '@' '%' 's' 'S' 'd' 'D' 'w' 'W' 'Q' 'E' 'b' 'Z' 'z' '^' '.' '*' '+' '?' '[' ']' '(' ')' '|' '{' '}' '-' ':'] { - next_s ("\\" ^ lexeme lexbuf) (Stack.pop next_rule) lexbuf - } -| _ { - let c = lexeme_char lexbuf 0 in - if c = !delimit_char then - warn [Warn_suggest_simpler] lexbuf ("change the delimit character " ^ String.make 1 !delimit_char ^ " to get rid of this escape") - else warn_escape_unneeded lexbuf c ; - next_s ("\\" ^ lexeme lexbuf) (Stack.pop next_rule) lexbuf - } - -and string_interpolate_scalar = parse -| '$' ident -| ['0'-'9'] -| '{' [^ '{' '}']* '}' -| in_string_expr -| [^ '{' '}' ' ' '\n' '"'] { (* eg: $! $$ *) - string_interpolate token "$" lexbuf - } - -| "{" -| ident "->"? '{' -| '"' { putback lexbuf 1; next_s "$" (Stack.pop next_rule) lexbuf } -| eof { next_s "$" (Stack.pop next_rule) lexbuf } -| _ { warn [Warn_strange] lexbuf (Printf.sprintf "weird \"%s\" in string" (lexeme lexbuf)); next_s ("$" ^ lexeme lexbuf) (Stack.pop next_rule) lexbuf } - -and delimited_string_interpolate_scalar = parse (* needed for delimited string like m!foo$! where $! should not be taken as is... *) -| '$' ident -| ['0'-'9'] -| '{' [^ '{' '}']* '}' -| (ident | (ident? ("::" ident)+)) "->"? ('{' [^ '{' '}' '\n']* '}')* -| (ident | (ident? ("::" ident)+)) "->"? (('{' [^ '{' '}' '\n']* '}') | ('[' ('$' ident | ['0'-'9']+) ']'))* - { - string_interpolate token "$" lexbuf - } - -| (ident | (ident? ("::" ident)+)) "->"? (('{' [^ '{' '}' '\n']* '}') | ('[' ['$' '0'-'9'] [^ '[' ']' '\n']* ']'))* - { - die lexbuf (Printf.sprintf "I really can't handle this, [xxx] can be indexing or not based on stellar position :-(") - } - -| "{" -| ident "->"? '{' -| eof { next_s "$" (Stack.pop next_rule) lexbuf } -| _ { - let c = lexeme_char lexbuf 0 in - if c <> !delimit_char && c <> '|' && c<>')' && c<>'/' && c<>' ' then warn [Warn_strange] lexbuf (Printf.sprintf "weird \"%s\" in string" (lexeme lexbuf)); - putback lexbuf 1; - next_s "$" (Stack.pop next_rule) lexbuf - } - -and string_interpolate_array = parse -| '$' ident -| '{' [^ '{' '}']* '}' -| in_string_expr { string_interpolate token "@" lexbuf } - -| [ '@' '*' '<' '>' ']' '.' '(' ' ' ] { next_s ("@" ^ lexeme lexbuf) (Stack.pop next_rule) lexbuf } -| '"' { putback lexbuf 1; next_s "@" (Stack.pop next_rule) lexbuf } -| eof { next_s "@" (Stack.pop next_rule) lexbuf } -| _ { warn [Warn_strange] lexbuf (Printf.sprintf "weird \"%s\" in string" (lexeme lexbuf)); next_s ("@" ^ lexeme lexbuf) (Stack.pop next_rule) lexbuf } - -and delimited_string_interpolate_array = parse -| '$' ident -| '{' [^ '{' '}']* '}' -| in_string_expr - { string_interpolate token "@" lexbuf } - -| [ '@' '*' '<' '>' ']' '.' '(' ' ' ] { next_s ("@" ^ lexeme lexbuf) (Stack.pop next_rule) lexbuf } -| eof { next_s "@" (Stack.pop next_rule) lexbuf } -| _ { - let c = lexeme_char lexbuf 0 in - if c <> !delimit_char then warn [Warn_strange] lexbuf (Printf.sprintf "weird \"%s\" in string" (lexeme lexbuf)); - putback lexbuf 1; - next_s "@" (Stack.pop next_rule) lexbuf - } - -and pattern_options = parse -| [ 'g' 'i' 'm' 'o' 's' 'x' 'e' 'd' ] { next pattern_options lexbuf } -| _ { putback lexbuf 1; () } - -and pod_command = parse -| [^ '\n' ]+ { - let s = lexeme lexbuf in - let command = String.sub s 0 (try String.index s ' ' with Not_found -> String.length s) in - match command with - | "cut" -> - if !(Stack.top building_current_string) = "" then - failwith(pos2sfull lexbuf ^ "found POD command \"=cut\" but it is not a POD block") - | "head1" | "head2" | "head3" | "head4" | "over" | "item" | "back" | "pod" | "begin" | "end" | "for" -> - next pod lexbuf - | s -> failwith(pos2sfull lexbuf ^ "unknown POD command \"" ^ s ^ "\"") - } -| _ { failwith(pos2sfull lexbuf ^ "POD command expected") } - -and pod = parse -| "\n=" { - add_a_new_line(lexeme_end lexbuf - 1); - next pod_command lexbuf - } -| "\n" [^ '=' '\n'] [^ '\n']* -| "\n" { - add_a_new_line(lexeme_end lexbuf); - next pod lexbuf - } -| eof -| _ { failwith(pos2sfull_with !current_string_start_pos (lexeme_end lexbuf) ^ "POD block still open") } diff --git a/perl_checker.src/parser.mly b/perl_checker.src/parser.mly deleted file mode 100644 index a9bf396..0000000 --- a/perl_checker.src/parser.mly +++ /dev/null @@ -1,500 +0,0 @@ -%{ (* -*- caml -*- *) - open Types - open Common - open Parser_helper - - let parse_error msg = die_rule msg - let prog_ref = ref None - let to_String e = Parser_helper.to_String (some !prog_ref) e - let from_PATTERN e = Parser_helper.from_PATTERN (some !prog_ref) e - let from_PATTERN_SUBST e = Parser_helper.from_PATTERN_SUBST (some !prog_ref) e -%} - - -%token EOF -%token NUM RAW_STRING BAREWORD BAREWORD_PAREN REVISION COMMENT POD LABEL PO_COMMENT PERL_CHECKER_COMMENT ONE_SCALAR_PARA -%token <(string * string) Types.any_spaces_pos> PRINT_TO_STAR PRINT_TO_SCALAR -%token QUOTEWORDS COMPACT_HASH_SUBSCRIPT -%token <(string * Types.raw_pos) Types.any_spaces_pos> RAW_HERE_DOC -%token <(string * ((int * int) * token) list) list Types.any_spaces_pos> STRING COMMAND_STRING -%token <((string * ((int * int) * token) list) list * Types.raw_pos) Types.any_spaces_pos> HERE_DOC FORMAT - -%token <((string * ((int * int) * token) list) list * string) Types.any_spaces_pos> PATTERN QR_PATTERN -%token <((string * ((int * int) * token) list) list * (string * ((int * int) * token) list) list * string) Types.any_spaces_pos> PATTERN_SUBST - -%token <(string option * string) Types.any_spaces_pos> SCALAR_IDENT ARRAY_IDENT HASH_IDENT FUNC_IDENT STAR_IDENT RAW_IDENT RAW_IDENT_PAREN ARRAYLEN_IDENT -%token SUB_WITH_PROTO -%token <(string option * string * string) Types.any_spaces_pos> FUNC_DECL_WITH_PROTO - -%token FOR PRINT -%token NEW -%token COMPARE_OP COMPARE_OP_STR EQ_OP EQ_OP_STR -%token ASSIGN MY_OUR - -%token IF ELSIF ELSE UNLESS DO WHILE UNTIL CONTINUE SUB LOCAL -%token USE PACKAGE BEGIN END -%token AT DOLLAR PERCENT AMPERSAND STAR ARRAYLEN -%token SEMI_COLON PKG_SCOPE -%token PAREN PAREN_END -%token BRACKET BRACKET_END BRACKET_HASHREF -%token ARRAYREF ARRAYREF_END - -%token ARROW -%token INCR DECR -%token POWER -%token TIGHT_NOT BIT_NEG REF -%token PATTERN_MATCH PATTERN_MATCH_NOT -%token MULT -%token PLUS -%token BIT_SHIFT -%token LT GT CONCAT MULT_L_STR -%token BIT_AND -%token BIT_OR BIT_XOR -%token AND_TIGHT -%token OR_TIGHT -%token DOTDOT -%token QUESTION_MARK COLON -%token COMMA RIGHT_ARROW -%token NOT -%token AND -%token OR XOR - -%nonassoc PREC_LOW -%nonassoc LOOPEX - -%right OR XOR -%right AND -%right NOT -%nonassoc LSTOP -%left COMMA RIGHT_ARROW - -%right ASSIGN -%right QUESTION_MARK COLON -%nonassoc DOTDOT -%left OR_TIGHT -%left AND_TIGHT -%left BIT_OR BIT_XOR -%left BIT_AND -%nonassoc EQ_OP EQ_OP_STR -%nonassoc LT GT COMPARE_OP COMPARE_OP_STR -%nonassoc UNIOP ONE_SCALAR_PARA -%left BIT_SHIFT -%left PLUS CONCAT -%left MULT MULT_L_STR -%left PATTERN_MATCH PATTERN_MATCH_NOT -%right TIGHT_NOT BIT_NEG REF UNARY_MINUS -%right POWER -%nonassoc INCR DECR -%left ARROW - -%nonassoc PAREN_END -%left PAREN PREC_HIGH -%left ARRAYREF BRACKET - -%type prog -%type expr term -%type scalar bracket_subscript variable restricted_subscripted - -%start prog - - -%% -prog: lines EOF {fst $1.any} - -lines: /* A collection of "lines" in the program */ -| { default_esp ([], true) } -| sideff { new_1esp ([$1.any], false) $1 } -| line lines { if fst $2.any <> [] then mcontext_check_none "value is dropped" $1.any $1; new_esp $2.mcontext ($1.any @ fst $2.any, snd $2.any) $1 $2 } - -line: -| decl { new_1esp [$1.any] $1 } -| if_then_else { new_1esp [$1.any] $1 } -| loop { new_1esp [$1.any] $1 } -| LABEL { sp_cr($1); new_1esp [Label $1.any] $1 } -| PERL_CHECKER_COMMENT {sp_p($1); new_1esp [Perl_checker_comment($1.any, get_pos $1)] $1 } -| semi_colon {warn_rule [Warn_white_space] "unneeded \";\""; new_1esp [Semi_colon] $1 } -| sideff semi_colon {new_1esp [$1.any ; Semi_colon] $1 } -| BRACKET lines BRACKET_END {new_esp $2.mcontext [lines_to_Block $2 $3] $1 $3} - -if_then_else: /* Real conditional expressions */ -| IF PAREN expr PAREN_END BRACKET lines BRACKET_END elsif else_ {sp_p($1); sp_n($2); sp_0($3); sp_0_or_cr($4); sp_p($5); mcontext_check M_bool $3; to_Call_op (if $9.any = [] then M_none else mcontext_lmerge ($6.mcontext :: mcontext_lmaybe $8 @ [$9.mcontext])) "if" (prio_lo P_loose $3 :: lines_to_Block $6 $7 :: $8.any @ $9.any) $1 $9} -| UNLESS PAREN expr PAREN_END BRACKET lines BRACKET_END elsif else_ {sp_p($1); sp_n($2); sp_0($3); sp_0_or_cr($4); sp_p($5); mcontext_check M_bool $3; check_unless_else $8 $9; to_Call_op M_none "unless" (prio_lo P_loose $3 :: lines_to_Block $6 $7 :: $8.any @ $9.any) $1 $9} - -elsif: -| {default_esp []} -| ELSIF PAREN expr PAREN_END BRACKET lines BRACKET_END elsif {sp_p($1); sp_n($2); sp_0($3); sp_0_or_cr($4); sp_p($5); mcontext_check M_bool $3; new_esp (mcontext_lmerge ($6.mcontext :: mcontext_lmaybe $8)) (prio_lo P_loose $3 :: lines_to_Block $6 $7 :: $8.any) $1 $8} - -else_: -| { default_esp [] } -| ELSE BRACKET lines BRACKET_END {sp_p($1); sp_n($2); new_esp $3.mcontext [lines_to_Block $3 $4] $1 $4} - -loop: -| WHILE PAREN expr PAREN_END BRACKET lines BRACKET_END cont {sp_p($1); sp_n($2); sp_0($3); sp_0_or_cr($4); sp_p($5); mcontext_check M_bool $3; to_Call_op M_none "while" [ prio_lo P_loose $3; lines_to_Block $6 $7 ] $1 $8} -| UNTIL PAREN expr PAREN_END BRACKET lines BRACKET_END cont {sp_p($1); sp_n($2); sp_0($3); sp_0_or_cr($4); sp_p($5); mcontext_check M_bool $3; to_Call_op M_none "until" [ prio_lo P_loose $3; lines_to_Block $6 $7 ] $1 $8} -| FOR PAREN expr_or_empty semi_colon expr_or_empty semi_colon expr_or_empty PAREN_END BRACKET lines BRACKET_END {sp_p($1); check_for($1); sp_n($2); sp_0($3); sp_p($5); sp_p($7); sp_0($8); sp_n($9); to_Call_op M_none "for" [ $3.any; $5.any; $7.any; lines_to_Block $10 $11 ] $1 $11} -| FOR SCALAR_IDENT PAREN expr PAREN_END BRACKET lines BRACKET_END cont { warn_rule [Warn_normalized_expressions] "don't use for without \"my\"ing the iteration variable"; sp_p($1); sp_0($4); sp_0_or_cr($5); sp_p($6); mcontext_check M_list $4; to_Call_op M_none "foreach" [ prio_lo P_loose $4; lines_to_Block $7 $8 ] $1 $9} -| FOR PAREN expr PAREN_END BRACKET lines BRACKET_END cont {sp_p($1); sp_n($2); sp_0($3); sp_0_or_cr($4); sp_p($5); mcontext_check M_list $3; check_for_foreach $1 $3; to_Call_op M_none "foreach" [ prio_lo P_loose $3; lines_to_Block $6 $7 ] $1 $8} -| for_my lines BRACKET_END cont { to_Call_op M_none "foreach my" ($1.any @ [ lines_to_Block $2 $3 ]) $1 $4} - -for_my: -| FOR MY_OUR SCALAR_IDENT PAREN expr PAREN_END BRACKET {sp_p($1); check_my($2); check_foreach($1); sp_n($4); sp_0($5); sp_0_or_cr($6); sp_p($7); new_esp M_none [ My_our($2.any, [I_scalar, snd $3.any], get_pos $3); prio_lo P_loose $5 ] $1 $7} - - -cont: /* Continue blocks */ -| {default_esp ()} -| CONTINUE BRACKET lines BRACKET_END {sp_p($1); sp_n($2); check_block_lines $3 $4; new_esp $3.mcontext () $1 $4} - -sideff: /* An expression which may have a side-effect */ -| expr { new_1esp $1.any.expr $1 } -| expr IF expr {sp_p($2); sp_p($3); mcontext_check M_bool $3; call_op_if_infix (prio_lo P_loose $1) (prio_lo P_loose $3) $1 $3} -| expr UNLESS expr {sp_p($2); sp_p($3); mcontext_check M_bool $3; call_op_unless_infix (prio_lo P_loose $1) (prio_lo P_loose $3) $1 $3} -| expr WHILE expr {sp_p($2); sp_p($3); mcontext_check M_bool $3; to_Call_op M_none "while infix" [ prio_lo P_loose $1 ; prio_lo P_loose $3 ] $1 $3} -| expr UNTIL expr {sp_p($2); sp_p($3); mcontext_check M_bool $3; to_Call_op M_none "until infix" [ prio_lo P_loose $1 ; prio_lo P_loose $3 ] $1 $3} -| expr FOR expr {sp_p($2); sp_p($3); mcontext_check M_list $3; check_foreach($2); to_Call_op M_none "for infix" [ prio_lo P_loose $1 ; prio_lo P_loose $3 ] $1 $3} - -decl: -| FORMAT BAREWORD ASSIGN {to_Call_op M_none "format" [Raw_string($2.any, get_pos $2) ; to_String false (new_1esp (fst $1.any) $1)] $1 $3} -| FORMAT ASSIGN {new_esp M_none Too_complex $1 $2} -| func_decl semi_colon {if snd $1.any = None then die_rule "there is no need to pre-declare in Perl!" else (warn_rule [Warn_normalized_expressions] "please don't use prototype pre-declaration" ; new_esp M_special Too_complex $1 $2) } -| func_decl BRACKET BRACKET_END {sp_n($2); sp_0_or_cr($3); let name, proto = $1.any in new_esp M_none (sub_declaration (name, proto) [] Real_sub_declaration) $1 $3} -| func_decl BRACKET lines BRACKET_END {sp_n($2); check_block_lines $3 $4; new_esp M_none (sub_declaration $1.any (fst $3.any) Real_sub_declaration) $1 $4} -| func_decl BRACKET BRACKET expr BRACKET_END BRACKET_END {sp_n($2); sp_p($3); sp_p($4); sp_p($5); check_block_expr false Undef $5 $6; new_esp M_none (sub_declaration $1.any [hash_ref $4] Real_sub_declaration) $1 $6} -| func_decl BRACKET BRACKET expr BRACKET_END semi_colon BRACKET_END {sp_n($2); sp_p($3); sp_p($4); sp_p($5); check_block_expr true Semi_colon $6 $7; new_esp M_none (sub_declaration $1.any [hash_ref $4; Semi_colon] Real_sub_declaration) $1 $7} -| PACKAGE word semi_colon {sp_0_or_cr($1); sp_1($2); new_esp M_none (Package $2.any) $1 $3} -| BEGIN BRACKET lines BRACKET_END {sp_0_or_cr($1); sp_1($2); new_esp M_none (Sub_declaration(Ident(None, "BEGIN", get_pos $1), None, lines_to_Block $3 $4, Glob_assign)) $1 $4} -| END BRACKET lines BRACKET_END {sp_0_or_cr($1); sp_1($2); new_esp M_none (Sub_declaration(Ident(None, "END", get_pos $1), None, lines_to_Block $3 $4, Glob_assign)) $1 $4} -| use {$1} - -use: -| use_word listexpr semi_colon {sp_n($2); new_esp M_none (Use($1.any, $2.any.expr)) $1 $3} -| use_revision word_paren PAREN listexpr PAREN_END {sp_0($4); sp_0_or_cr($5); new_esp M_none (Use($2.any, $4.any.expr)) $1 $5} - -use_word: -| use_revision word comma {new_esp M_none $2.any $1 $3} -| use_revision word {new_esp M_none $2.any $1 $2} -| use_revision {new_1esp Undef $1 } - -use_revision: -| USE REVISION comma {$1} -| USE REVISION {$1} -| USE {$1} - -func_decl: -| SUB word { new_esp M_none ($2.any, None) $1 $2} -| SUB ONE_SCALAR_PARA { new_esp M_none (Ident(None, $2.any, get_pos $2), None) $1 $2} -| SUB BAREWORD_PAREN PAREN PAREN_END { warn_rule [Warn_white_space] "remove carriage return between \"sub\" and the function name"; new_esp M_none (Ident(None, $2.any, get_pos $2), Some "") $1 $4 } -| FUNC_DECL_WITH_PROTO {new_1esp (Ident(fst3 $1.any, snd3 $1.any, get_pos $1), Some (ter3 $1.any)) $1 } - -listexpr: /* Basic list expressions */ -| %prec PREC_LOW { default_pesp P_tok []} -| argexpr %prec PREC_LOW {$1} - -expr: /* Ordinary expressions; logical combinations */ -| expr AND expr {sp_p($2); sp_p($3); mcontext_check M_bool $1; mcontext_check_none "value should be dropped" [$3.any.expr] $3; to_Call_op_ M_none P_and "and" [ prio_lo P_and $1; prio_lo_after P_and $3 ] $1 $3} -| expr OR expr {sp_p($2); sp_p($3); mcontext_check M_bool $1; mcontext_check_none "value should be dropped" [$3.any.expr] $3; to_Call_op_ M_none P_or "or" [ prio_lo P_or $1; prio_lo_after P_or $3 ] $1 $3} -| argexpr %prec PREC_LOW { new_1pesp $1.any.priority (List $1.any.expr) $1 } - -argexpr: /* Expressions are a list of terms joined by commas */ -| argexpr comma { new_pesp $1.mcontext P_comma $1.any.expr $1 $2} -| bareword RIGHT_ARROW term {if not_simple ($3.any.expr) then sp_p($3); new_pesp (mtuple_context_concat M_string $3.mcontext) P_comma (followed_by_comma [$1.any] false @ [$3.any.expr]) $1 $3} -| bareword RIGHT_ARROW BRACKET expr BRACKET_END {sp_p($3); sp_p($5); new_pesp (mtuple_context_concat M_string (M_ref M_hash)) P_comma (followed_by_comma [$1.any] false @ [ hash_ref $4 ]) $1 $5} -| argexpr comma term {prio_lo_check P_comma $1.any.priority $1.pos (last $1.any.expr); if not_simple ($3.any.expr) then sp_p($3); new_pesp (mtuple_context_concat $1.mcontext $3.mcontext) P_comma (followed_by_comma $1.any.expr $2.any @ [$3.any.expr]) $1 $3} -| argexpr comma BRACKET expr BRACKET_END {sp_p($3); sp_p($5); new_pesp (mtuple_context_concat $1.mcontext (M_ref M_hash)) P_comma (followed_by_comma $1.any.expr $2.any @ [ hash_ref $4 ]) $1 $5} -| term %prec PREC_LOW { new_1pesp $1.any.priority [$1.any.expr] $1 } - -/********************************************************************************/ -term: -| term - COMPARE_OP_STR term {sp_p $2; symops P_cmp M_string M_bool $2.any $1 $2 $3} -| term COMPARE_OP term {sp_p $2; symops P_cmp M_float M_bool $2.any $1 $2 $3} -| term LT term {sp_p $2; symops P_cmp M_float M_bool "<" $1 $2 $3} -| term GT term {sp_p $2; symops P_cmp M_float M_bool ">" $1 $2 $3} -| term EQ_OP term {sp_p $2; symops P_eq M_float M_bool $2.any $1 $2 $3} -| term EQ_OP_STR term {sp_p $2; symops P_eq M_string M_bool $2.any $1 $2 $3} - -| term BIT_AND term {sp_p $2; symops P_bit M_int M_int "&" $1 $2 $3} -| term BIT_OR term { symops P_bit M_int M_int "|" $1 $2 $3} -| term BIT_XOR term {sp_p $2; symops P_bit M_int M_int "^" $1 $2 $3} - -| term POWER term { symops P_tight M_float (mcontext_float_or_int [$1.mcontext; $3.mcontext]) "**" $1 $2 $3} -| term PLUS term { symops P_add M_float (mcontext_float_or_int [$1.mcontext; $3.mcontext]) $2.any $1 $2 $3} -| term CONCAT term {sp_p $2; symops P_add M_string M_string "." $1 $2 $3} -| term BIT_SHIFT term { symops (P_paren_wanted P_tight) M_int M_int $2.any $1 $2 $3} -| term XOR term {sp_p $2; symops (P_paren_wanted P_expr) M_bool M_bool "xor" $1 $2 $3} -| term DOTDOT term { symops (P_paren_wanted P_expr) M_unknown_scalar M_string $2.any $1 $2 $3} - -| term AND_TIGHT term {sp_p $2; sp_same $2 $3; mcontext_check M_bool $1; let pri = P_tight_and in to_Call_op_ (mcontext_to_scalar $3.mcontext) pri "&&" [prio_lo pri $1; prio_lo_after pri $3] $1 $3} -| term OR_TIGHT term {sp_p $2; sp_same $2 $3; mcontext_check M_bool $1; let pri = P_tight_or in to_Call_op_ (mcontext_to_scalar (mcontext_merge $1.mcontext $3.mcontext)) pri "||" [prio_lo pri $1; prio_lo_after pri $3] $1 $3} - -| term MULT term {sp_same $2 $3; let pri = P_mul in to_Call_op_ (mcontext_float_or_int [$1.mcontext; $3.mcontext]) pri $2.any [prio_lo_concat $1; prio_lo_after pri $3] $1 $3} -| term MULT_L_STR term {sp_same $2 $3; mcontext_check M_int $3; let pri = P_mul in to_Call_op_ (if mcontext_lower $1.mcontext M_string then M_string else M_list) pri "x" - [prio_lo_concat $1; prio_lo_after pri $3] $1 $3} - -| term ASSIGN term {sp_same $2 $3; let pri = P_assign in to_Call_assign_op_ (mcontext_op_assign $1 $3) pri $2.any ($1.any.expr) (prio_lo_after pri $3) $1 $3} - -| term ASSIGN BRACKET expr_bracket_end {sp_p($2); sp_p($3); sp_p($4); to_Call_assign_op_ (M_mixed [M_ref M_hash; M_none]) P_assign $2.any (prio_lo P_assign $1) $4.any $1 $4} -| term AND_TIGHT BRACKET expr_bracket_end {sp_p($2); sp_p($3); sp_p($4); to_Call_op_ M_bool P_tight_and "&&" [prio_lo P_assign $1; $4.any] $1 $4} -| term OR_TIGHT BRACKET expr_bracket_end {sp_p($2); sp_p($3); sp_p($4); to_Call_op_ M_bool P_tight_or "||" [prio_lo P_assign $1; $4.any] $1 $4} - - -| term PATTERN_MATCH PATTERN {sp_n($2); sp_p($3); check_unneeded_var_dollar_ ($1); mcontext_check M_string $1; to_Call_op_ M_array P_expr "m//" ($1.any.expr :: from_PATTERN $3) $1 $3} -| term PATTERN_MATCH_NOT PATTERN {sp_n($2); sp_p($3); check_unneeded_var_dollar_not($1); mcontext_check M_string $1; to_Call_op_ M_int P_expr "!m//" ($1.any.expr :: from_PATTERN $3) $1 $3} -| term PATTERN_MATCH PATTERN_SUBST {sp_n($2); sp_p($3); check_unneeded_var_dollar_s ($1); to_Call_op_ (M_mixed[M_none; M_int]) P_expr "s///" ($1.any.expr :: from_PATTERN_SUBST $3) $1 $3} -| term PATTERN_MATCH_NOT PATTERN_SUBST {die_with_rawpos $2.pos "use =~ instead of !~ and negate the return value"} - -| term PATTERN_MATCH QR_PATTERN {warn [Warn_traps] $3.pos "use m/.../ or /.../ instead of qr/.../ when you do a pattern matching"; to_Call_op_ M_array P_expr "m//" ($1.any.expr :: from_PATTERN $3) $1 $3} -| term PATTERN_MATCH_NOT QR_PATTERN {warn [Warn_traps] $3.pos "use m/.../ or /.../ instead of qr/.../ when you do a pattern matching"; to_Call_op_ M_int P_expr "!m//" ($1.any.expr :: from_PATTERN $3) $1 $3} -| term PATTERN_MATCH scalar { new_pesp M_array P_expr (Call(Too_complex, [$1.any.expr ; $3.any ])) $1 $3} -| term PATTERN_MATCH_NOT scalar { new_pesp M_int P_expr (Call(Too_complex, [$1.any.expr ; $3.any ])) $1 $3} - -| term PATTERN_MATCH RAW_STRING {warn [Warn_complex_expressions] $3.pos "use a regexp, not a string"; to_Call_op_ M_array P_expr "m//" [ $1.any.expr; to_Raw_string $3 ] $1 $3} -| term PATTERN_MATCH_NOT RAW_STRING {warn [Warn_complex_expressions] $3.pos "use a regexp, not a string"; to_Call_op_ M_int P_expr "!m//" [ $1.any.expr; to_Raw_string $3 ] $1 $3} -| term PATTERN_MATCH STRING {warn [Warn_complex_expressions] $3.pos "use a regexp, not a string"; to_Call_op_ M_array P_expr "m//" [ $1.any.expr; to_String false $3 ] $1 $3} -| term PATTERN_MATCH_NOT STRING {warn [Warn_complex_expressions] $3.pos "use a regexp, not a string"; to_Call_op_ M_int P_expr "!m//" [ $1.any.expr; to_String false $3 ] $1 $3} - - -| term QUESTION_MARK term COLON term {sp_p($2); sp_p($3); sp_p($4); sp_p($5); mcontext_check M_bool $1; to_Call_op_ (mcontext_merge $3.mcontext $5.mcontext) P_ternary "?:" (check_ternary_paras(prio_lo P_ternary $1, prio_lo_after P_ternary $3, prio_lo_after P_ternary $5)) $1 $5} -| term QUESTION_MARK term COLON BRACKET expr BRACKET_END {sp_p($2); sp_p($3); sp_p($4); sp_p($5); sp_p($6); sp_p($7); mcontext_check M_bool $1; to_Call_op_ (mcontext_merge $3.mcontext (M_ref M_hash)) P_ternary "?:" (check_ternary_paras(prio_lo P_ternary $1, prio_lo_after P_ternary $3, hash_ref $6)) $1 $7} -| term QUESTION_MARK BRACKET expr BRACKET_END COLON term {sp_p($2); sp_p($3); sp_p($4); sp_p($5); sp_p($6); sp_p($7); mcontext_check M_bool $1; to_Call_op_ (mcontext_merge $7.mcontext (M_ref M_hash)) P_ternary "?:" (check_ternary_paras(prio_lo P_ternary $1, hash_ref $4, prio_lo_after P_ternary $7)) $1 $7} -| term QUESTION_MARK BRACKET expr BRACKET_END COLON BRACKET expr BRACKET_END {sp_p($2); sp_p($3); sp_p($4); sp_p($5); sp_p($6); sp_p($7); sp_p($8); sp_p($9); mcontext_check M_bool $1; to_Call_op_ (M_ref M_hash) P_ternary "?:" (check_ternary_paras(prio_lo P_ternary $1, hash_ref $4, hash_ref $8)) $1 $9} - -/* Unary operators and terms */ -| PLUS term %prec UNARY_MINUS { - sp_0($2); - match $1.any with - | "+" -> - warn_rule [Warn_normalized_expressions] "don't use unary +" ; - to_Call_op_ (mcontext_float_or_int [$2.mcontext]) P_tight "+ unary" [$2.any.expr] $1 $2 - | "-" -> - (match $2.any.expr with - | Ident(_, _, pos) when $2.spaces = Space_0 -> - let s = "-" ^ string_of_fromparser $2.any.expr in - warn_rule [Warn_complex_expressions] (Printf.sprintf "don't use %s, use '%s' instead" s s); - new_pesp M_string P_tok (Raw_string(s, pos)) $1 $2 - | _ -> to_Call_op_ (mcontext_float_or_int [$2.mcontext]) P_tight "- unary" [$2.any.expr] $1 $2) - | _ -> die_rule "syntax error" -} -| TIGHT_NOT term {check_negatable_expr $2; mcontext_check M_bool $2; to_Call_op_ M_bool P_tight "not" [$2.any.expr] $1 $2} -| BIT_NEG term { mcontext_check M_int $2; to_Call_op_ M_int P_expr "~" [$2.any.expr] $1 $2} -| INCR term {sp_0($2); mcontext_check M_int $2; to_Call_op_ (M_mixed [M_int ; M_none]) P_tight "++" [$2.any.expr] $1 $2} -| DECR term {sp_0($2); mcontext_check M_int $2; to_Call_op_ (M_mixed [M_int ; M_none]) P_tight "--" [$2.any.expr] $1 $2} -| term INCR {sp_0($2); mcontext_check M_int $1; to_Call_op_ (M_mixed [M_int ; M_none]) P_tight "++ post" [$1.any.expr] $1 $2} -| term DECR {sp_0($2); mcontext_check M_int $1; to_Call_op_ (M_mixed [M_int ; M_none]) P_tight "-- post" [$1.any.expr] $1 $2} -| NOT argexpr {warn_rule [Warn_normalized_expressions] "don't use \"not\", use \"!\" instead"; mcontext_check_unop_l M_bool $2; to_Call_op_ M_bool P_and "not" ($2.any.expr) $1 $2} - -/* Constructors for anonymous data */ - -| ARRAYREF ARRAYREF_END {sp_0($2); new_pesp (M_ref M_array) P_expr (Ref(I_array, List[])) $1 $2} -| arrayref_start ARRAYREF_END {(if $1.any = [] then sp_0 else sp_p)($2) ; new_pesp (M_ref M_array) P_expr (Ref(I_array, List $1.any)) $1 $2} -| arrayref_start expr ARRAYREF_END {sp_same $2 $3; new_pesp (M_ref M_array) P_expr (Ref(I_array, List($1.any @ [$2.any.expr]))) $1 $3} -| arrayref_start BRACKET expr BRACKET_END ARRAYREF_END {sp_same $2 $5; new_pesp (M_ref M_array) P_expr (Ref(I_array, List($1.any @ [hash_ref $3]))) $1 $5} - -| BRACKET BRACKET_END {new_pesp (M_ref M_hash) P_expr (Ref(I_hash, List [])) $1 $2} /* empty hash */ -| BRACKET_HASHREF expr BRACKET_END %prec PREC_HIGH {sp_p($3); new_pesp (M_ref M_hash) P_expr (hash_ref $2) $1 $3} /* { foo => "Bar" } */ -| SUB BRACKET BRACKET_END %prec PREC_HIGH {sp_n($2); sp_0($3); new_pesp (M_ref M_sub) P_expr (Anonymous_sub(None, Block [], pos_range $2 $3)) $1 $3} -| SUB_WITH_PROTO BRACKET BRACKET_END %prec PREC_HIGH {sp_n($2); sp_0($3); new_pesp (M_ref M_sub) P_expr (Anonymous_sub(Some $1.any, Block [], pos_range $2 $3)) $1 $3} -| SUB BRACKET lines BRACKET_END %prec PREC_HIGH {sp_n($2); new_pesp (M_ref M_sub) P_expr (anonymous_sub None $3 $4) $1 $4} -| SUB_WITH_PROTO BRACKET lines BRACKET_END %prec PREC_HIGH {sp_n($2); new_pesp (M_ref M_sub) P_expr (anonymous_sub (Some $1.any) $3 $4) $1 $4} - -| termdo {new_1pesp P_tok $1.any $1} -| REF term {new_pesp (M_ref $2.mcontext) P_expr (Ref(I_scalar, remove_call_with_same_para_special $2.any.expr)) $1 $2} /* \$x, \@y, \%z */ -| my_our %prec UNIOP {new_1pesp P_expr $1.any $1} -| LOCAL term %prec UNIOP {sp_n($2); new_pesp (M_mixed [ $2.mcontext ; M_none ]) P_expr (to_Local $2) $1 $2} - -| parenthesized {new_1pesp $1.any.priority (List $1.any.expr) $1} /* (1, 2) */ -| parenthesized arrayref {sp_0($2); let is_slice = not (is_only_one_in_List $2.any) in new_pesp (if is_slice then M_list else M_unknown_scalar) P_tok (to_Deref_with(I_array, (if is_slice then I_array else I_scalar), List $1.any.expr, List $2.any)) $1 $2} /* list indexing or slicing */ - -| variable { - let e = - match $1.any with - | Deref(I_func, Ident _) -> - call_with_same_para_special $1.any (* not the same as f(@_) *) - | e -> e in - new_1pesp P_tok e $1 - } - -| subscripted {new_1pesp P_tok $1.any $1} - -| array arrayref {new_pesp M_list P_expr (to_Deref_with(I_array, I_array, from_array $1, List $2.any)) $1 $2} /* array slice: @array[vals] */ -| array BRACKET expr BRACKET_END {sp_0($2); sp_0($3); sp_0($4); new_pesp M_list P_expr (to_Deref_with(I_hash, I_array, from_array $1, $3.any.expr)) $1 $4} /* hash slice: @hash{@keys} */ - -/* function_calls */ -| ONE_SCALAR_PARA RAW_STRING {call_one_scalar_para P_uniop $1 [to_Raw_string $2] $1 $2} -| ONE_SCALAR_PARA STRING {call_one_scalar_para P_uniop $1 [to_String true $2] $1 $2} -| ONE_SCALAR_PARA variable {call_one_scalar_para P_uniop $1 [$2.any] $1 $2} -| ONE_SCALAR_PARA restricted_subscripted {call_one_scalar_para P_uniop $1 [$2.any] $1 $2} -| ONE_SCALAR_PARA parenthesized {call_one_scalar_para P_tok $1 $2.any.expr $1 $2} -| ONE_SCALAR_PARA BRACKET lines BRACKET_END {sp_n($2); new_pesp M_unknown P_uniop (call(Deref(I_func, Ident(None, $1.any, raw_pos2pos $1.pos)), [anonymous_sub None $3 $4])) $1 $4} /* eval { foo } */ -| ONE_SCALAR_PARA diamond {call_one_scalar_para P_uniop $1 [$2.any] $1 $2} -| ONE_SCALAR_PARA %prec PREC_LOW {call_one_scalar_para P_tok $1 [] $1 $1} -| ONE_SCALAR_PARA word argexpr {check_parenthesized_first_argexpr_with_Ident $2.any $3; call_one_scalar_para P_uniop $1 [call(Deref(I_func, $2.any), $3.any.expr)] $1 $3} /* ref foo $a, $b */ -| ONE_SCALAR_PARA hash PKG_SCOPE {sp_0($3); call_one_scalar_para P_uniop $1 [ Call(Too_complex, [$2.any]) ] $1 $3} /* keys %main:: */ -| ONE_SCALAR_PARA BAREWORD {if $2.any = "_" && $1.any.[0] = '-' then new_pesp M_bool P_uniop Too_complex $1 $2 else die_rule "syntax error"} /* -e "foo" && -f _ */ - -| ONE_SCALAR_PARA array arrayref {call_one_scalar_para P_uniop $1 [to_Deref_with(I_array, I_array, from_array $2, List $3.any)] $1 $3} /* array slice: @array[vals] */ -| ONE_SCALAR_PARA array BRACKET expr BRACKET_END {sp_0($3); sp_0($4); sp_0($5); call_one_scalar_para P_uniop $1 [to_Deref_with(I_hash, I_array, from_array $2, $4.any.expr)] $1 $5} /* hash slice: @hash{@keys} */ - -| func parenthesized {sp_0($2); call_func $1 $2} /* &foo(@args) */ -| word argexpr {check_parenthesized_first_argexpr_with_Ident $1.any $2; call_no_paren $1 $2} /* foo $a, $b */ -| word BRACKET lines BRACKET_END MULT { die_with_rawpos $5.pos "I can't handle this correctly, please add parentheses" } -| word BRACKET lines BRACKET_END COMMA argexpr %prec LSTOP {sp_n($2); new_pesp M_unknown P_call_no_paren (call(Deref(I_func, $1.any), Ref(I_hash, List (fst $3.any)) :: $6.any.expr)) $1 $6} /* bless { foo }, $bar */ -| word_paren parenthesized {sp_0($2); call_with_paren $1 $2} /* foo(@args) */ -| word BRACKET lines BRACKET_END listexpr %prec LSTOP {sp_n($2); call_and_context(Deref(I_func, $1.any), anonymous_sub None $3 $4 :: $5.any.expr) false (if $5.any.expr = [] then P_tok else P_call_no_paren) $1 $5} /* map { foo } @bar */ -| word BRACKET BRACKET expr BRACKET_END BRACKET_END listexpr %prec LSTOP {sp_n($2); sp_p($3); sp_p($4); sp_p($5); sp_p($6); new_pesp M_unknown (if $7.any.expr = [] then P_tok else P_call_no_paren) (call(Deref(I_func, $1.any), anonymous_sub None (new_esp (M_ref M_hash) ([ hash_ref $4 ], false) $3 $5) $6 :: $7.any.expr)) $1 $7} /* map { { foo } } @bar */ -| word BRACKET BRACKET expr BRACKET_END semi_colon BRACKET_END listexpr %prec LSTOP {sp_n($2); sp_p($3); sp_p($4); sp_p($5); sp_p($7); new_pesp M_unknown (if $8.any.expr = [] then P_tok else P_call_no_paren) (call(Deref(I_func, $1.any), anonymous_sub None (new_esp (M_ref M_hash) ([ hash_ref $4; Semi_colon ], true) $3 $6) $7 :: $8.any.expr)) $1 $8} /* map { { foo }; } @bar */ - -| term ARROW word_or_scalar parenthesized {sp_0($2); sp_0($3); sp_0($4); if $4.any.expr = [] then warn [Warn_suggest_simpler] $4.pos "remove these unneeded parentheses"; new_pesp M_unknown P_tok (to_Method_call($1.any.expr, $3.any, $4.any.expr)) $1 $4} /* $foo->bar(list) */ -| term ARROW word_or_scalar {sp_0($2); sp_0($3); new_pesp M_unknown P_tok (to_Method_call($1.any.expr, $3.any, [])) $1 $3} /* $foo->bar */ - -| NEW word { sp_n($2); new_pesp (M_ref M_unknown) P_expr (to_Method_call ($2.any, Ident(None, "new", get_pos $1), [])) $1 $2} /* new Class */ -| NEW word_paren parenthesized { sp_n($2); sp_0($3); new_pesp (M_ref M_unknown) P_expr (to_Method_call($2.any, Ident(None, "new", get_pos $1), $3.any.expr)) $1 $3} /* new Class(...) */ -| NEW word terminal { die_rule "you must parenthesize parameters: \"new Class(...)\" instead of \"new Class ...\"" } -| NEW word variable { die_rule "you must parenthesize parameters: \"new Class(...)\" instead of \"new Class ...\"" } - -| PRINT { to_Call_op_ (M_mixed [M_int; M_none]) P_call_no_paren $1.any (var_STDOUT :: [ var_dollar_ (get_pos $1) ]) $1 $1} -| PRINT argexpr {check_parenthesized_first_argexpr $1.any $2; to_Call_op_ (M_mixed [M_int; M_none]) P_call_no_paren $1.any (var_STDOUT :: $2.any.expr) $1 $2} -| PRINT_TO_SCALAR { to_Call_op_ (M_mixed [M_int; M_none]) P_call_no_paren (fst $1.any) (var_STDOUT :: [ Deref(I_scalar, Ident(None, snd $1.any, get_pos $1)) ]) $1 $1} -| PRINT_TO_SCALAR argexpr { to_Call_op_ (M_mixed [M_int; M_none]) P_call_no_paren (fst $1.any) (Deref(I_scalar, Ident(None, snd $1.any, get_pos $1)) :: $2.any.expr) $1 $2} -| PRINT_TO_STAR { to_Call_op_ (M_mixed [M_int; M_none]) P_call_no_paren (fst $1.any) (Deref(I_star, Ident(None, snd $1.any, get_pos $1)) :: [ var_dollar_ (get_pos $1) ]) $1 $1} -| PRINT_TO_STAR argexpr { to_Call_op_ (M_mixed [M_int; M_none]) P_call_no_paren (fst $1.any) (Deref(I_star, Ident(None, snd $1.any, get_pos $1)) :: $2.any.expr) $1 $2} - -| hash PKG_SCOPE {sp_0($2); new_pesp M_hash P_tok (Call(Too_complex, [$1.any])) $1 $2} /* %main:: */ - -| terminal {$1} - -expr_bracket_end: -| expr BRACKET_END { sp_p($2); new_esp (M_ref M_hash) (hash_ref $1) $1 $2 } -| expr BRACKET_END ARROW bracket_subscript {sp_p($2); sp_0($3); new_esp M_unknown_scalar (to_Deref_with(I_hash, I_scalar, hash_ref $1, $4.any)) $1 $4} /* { foo }->{Bar} */ - -terminal: -| word {word_alone $1} -| NUM {new_1pesp P_tok (Num($1.any, get_pos $1)) $1} -| STRING {new_1pesp P_tok (to_String true $1) $1} -| RAW_STRING {new_1pesp P_tok (to_Raw_string $1) $1} -| REVISION {new_1pesp P_tok (to_Raw_string $1) $1} -| COMMAND_STRING {to_Call_op_ (M_mixed[M_string; M_list]) P_tok "``" [to_String false $1] $1 $1} -| QUOTEWORDS {let l = List.map (fun s -> Raw_string(s, raw_pos2pos $1.pos)) (words $1.any) in new_pesp (M_tuple (repeat M_string (List.length l))) P_tok (List [ List l ]) $1 $1} -| HERE_DOC {new_1pesp P_tok (to_String false (new_1esp (fst $1.any) $1)) $1 } -| RAW_HERE_DOC {new_1pesp P_tok (Raw_string(fst $1.any, raw_pos2pos (snd $1.any))) $1} -| QR_PATTERN {to_Call_op_ M_string P_tok "qr//" (from_PATTERN $1) $1 $1} -| PATTERN {to_Call_op_ M_array P_expr "m//" (var_dollar_ (get_pos $1) :: from_PATTERN $1) $1 $1} -| PATTERN_SUBST {to_Call_op_ (M_mixed[M_none; M_int]) P_expr "s///" (var_dollar_ (get_pos $1) :: from_PATTERN_SUBST $1) $1 $1} -| diamond {new_1pesp P_expr $1.any $1} - -diamond: -| LT GT {sp_0($2); to_Call_op (M_mixed[M_string; M_list]) "<>" [] $1 $2} -| LT term GT {sp_0($2); sp_0($3); to_Call_op (M_mixed[M_string; M_list]) "<>" [$2.any.expr] $1 $3} - -subscripted: /* Some kind of subscripted expression */ -| variable PKG_SCOPE bracket_subscript {sp_0($2); sp_0($3); new_esp M_unknown (Call(Too_complex, [$3.any])) $1 $3} /* $foo::{something} */ -| scalar bracket_subscript {sp_0($2); check_scalar_subscripted $1; new_esp M_unknown_scalar (to_Deref_with(I_hash , I_scalar, from_scalar $1, $2.any )) $1 $2} /* $foo{bar} */ -| scalar arrayref {sp_0($2); check_scalar_subscripted $1; new_esp M_unknown_scalar (to_Deref_with(I_array, I_scalar, from_scalar $1, only_one_array_ref $2)) $1 $2} /* $array[$element] */ -| term ARROW simple_subscript {sp_0($2); sp_0($3); new_esp $3.mcontext (to_Deref_with_arrow $2 (fst $3.any, I_scalar, $1.any.expr, snd $3.any)) $1 $3} -| subscripted simple_subscript {sp_0($2); new_esp $2.mcontext (to_Deref_with(fst $2.any, I_scalar, $1.any, snd $2.any)) $1 $2} - -restricted_subscripted: /* Some kind of subscripted expression */ -| variable PKG_SCOPE bracket_subscript {sp_0($2); sp_0($3); new_esp M_unknown (Call(Too_complex, [$3.any])) $1 $3} /* $foo::{something} */ -| word_paren parenthesized {new_esp M_unknown (call(Deref(I_func, $1.any), $2.any.expr)) $1 $2} -| scalar bracket_subscript {sp_0($2); check_scalar_subscripted $1; new_esp M_unknown_scalar (to_Deref_with(I_hash , I_scalar, from_scalar $1, $2.any )) $1 $2} /* $foo{bar} */ -| scalar arrayref {sp_0($2); check_scalar_subscripted $1; new_esp M_unknown_scalar (to_Deref_with(I_array, I_scalar, from_scalar $1, only_one_array_ref $2)) $1 $2} /* $array[$element] */ -| scalar ARROW simple_subscript {sp_0($2); sp_0($3); new_esp $3.mcontext (to_Deref_with_arrow $2 (fst $3.any, I_scalar, $1.any, snd $3.any)) $1 $3} -| restricted_subscripted ARROW simple_subscript {sp_0($2); sp_0($3); new_esp $3.mcontext (to_Deref_with_arrow $2 (fst $3.any, I_scalar, $1.any, snd $3.any)) $1 $3} /* somehref->{bar} */ -| restricted_subscripted simple_subscript {sp_0($2); new_esp $2.mcontext (to_Deref_with(fst $2.any, I_scalar, $1.any, snd $2.any)) $1 $2} - -| restricted_subscripted ARROW word_or_scalar parenthesized {sp_0($2); sp_0($3); sp_0($4); if $4.any.expr = [] then warn [Warn_suggest_simpler] $4.pos "remove these unneeded parentheses"; new_esp M_unknown (to_Method_call($1.any, $3.any, $4.any.expr)) $1 $4} /* $foo->bar(list) */ -| restricted_subscripted ARROW word_or_scalar {sp_0($2); sp_0($3); new_esp M_unknown (to_Method_call($1.any, $3.any, [])) $1 $3} /* $foo->bar */ - -simple_subscript: -| bracket_subscript {new_esp M_unknown_scalar (I_hash, $1.any) $1 $1} -| arrayref {new_esp M_unknown_scalar (I_array, only_one_array_ref $1) $1 $1} -| parenthesized {new_esp M_unknown (I_func , List($1.any.expr)) $1 $1} - - -arrayref: -| arrayref_start ARRAYREF_END {sp_0($2); new_esp (M_ref M_array) $1.any $1 $2} -| arrayref_start expr ARRAYREF_END {sp_0($3); new_esp (M_ref M_array) ($1.any @ [$2.any.expr]) $1 $3} -| arrayref_start BRACKET expr BRACKET_END ARRAYREF_END {sp_p($2); sp_p($4); sp_0($5); new_esp (M_ref M_hash) ($1.any @ [hash_ref $3]) $1 $5} -parenthesized: -| parenthesized_start PAREN_END {sp_0_or_cr($2); new_pesp (if $1.any = [] then M_list else $1.mcontext) (if $1.any = [] then P_tok else P_paren P_comma) $1.any $1 $2} -| parenthesized_start expr PAREN_END {sp_0_or_cr($3); (if $1.any = [] then sp_0_or_cr else sp_p)($2); new_pesp (if $1.any = [] then $2.mcontext else M_list) (P_paren (if $1.any = [] then $2.any.priority else P_comma)) ($1.any @ [(if $1.any = [] then prio_lo P_loose else prio_lo_after P_comma) $2]) $1 $3} -| parenthesized_start BRACKET expr BRACKET_END PAREN_END {sp_p($4); sp_0_or_cr($5); new_pesp (if $1.any = [] then M_ref M_hash else M_list) (P_paren (if $1.any = [] then P_expr else P_comma)) ($1.any @ [hash_ref $3]) $1 $5} - -arrayref_start: -| ARRAYREF {new_1esp [] $1 } -| arrayref_start BRACKET expr BRACKET_END comma {sp_p($2); sp_p($3); sp_p($4); new_esp M_special ($1.any @ [hash_ref $3]) $1 $5} -parenthesized_start: -| PAREN {new_1esp [] $1 } -| parenthesized_start BRACKET expr BRACKET_END comma {(if $1.any = [] then sp_0_or_cr else sp_p)($2); sp_p($3); sp_p($4); new_esp (M_ref M_hash) ($1.any @ [hash_ref $3]) $1 $5} - -my_our: /* Things that can be "my"'d */ -| my_our_paren PAREN_END {sp_0($2); new_esp (M_mixed [ $1.mcontext ; M_none ]) (My_our(sndfst $1.any, snd $1.any, get_pos $1)) $1 $2} -| my_our_paren SCALAR_IDENT PAREN_END {check_my_our_paren $1 $2; new_esp (M_mixed [ mtuple_context_concat $1.mcontext M_unknown_scalar; M_none ]) (My_our(sndfst $1.any, snd $1.any @ [I_scalar, snd $2.any], pos_range $1 $3)) $1 $3} -| my_our_paren HASH_IDENT PAREN_END {check_my_our_paren $1 $2; new_esp (M_mixed [ M_list ; M_none ]) (My_our(sndfst $1.any, snd $1.any @ [I_hash, snd $2.any], pos_range $1 $3)) $1 $3} -| my_our_paren ARRAY_IDENT PAREN_END {check_my_our_paren $1 $2; new_esp (M_mixed [ M_list ; M_none ]) (My_our(sndfst $1.any, snd $1.any @ [I_array, snd $2.any], pos_range $1 $3)) $1 $3} -| MY_OUR SCALAR_IDENT {new_esp (M_mixed [M_unknown_scalar; M_none]) (My_our($1.any, [I_scalar, snd $2.any], get_pos $2)) $1 $2} -| MY_OUR HASH_IDENT {new_esp (M_mixed [M_hash ; M_none]) (My_our($1.any, [I_hash, snd $2.any], get_pos $2)) $1 $2} -| MY_OUR ARRAY_IDENT {new_esp (M_mixed [M_array ; M_none]) (My_our($1.any, [I_array, snd $2.any], get_pos $2)) $1 $2} - -my_our_paren: -| MY_OUR PAREN {sp_1($2); new_esp (M_tuple []) ((true, $1.any), []) $1 $2} -| my_our_paren comma {if fstfst $1.any then die_rule "syntax error"; new_esp $1.mcontext ((true, sndfst $1.any), snd $1.any) $1 $2} -| my_our_paren BAREWORD {check_my_our_paren $1 $2; if $2.any <> "undef" then die_rule "scalar expected"; new_esp (mtuple_context_concat $1.mcontext M_none) ((false, sndfst $1.any), snd $1.any @ [I_raw, $2.any]) $1 $2} -| my_our_paren SCALAR_IDENT {check_my_our_paren $1 $2; new_esp (mtuple_context_concat $1.mcontext M_unknown_scalar) ((false, sndfst $1.any), snd $1.any @ [I_scalar, snd $2.any]) $1 $2} -| my_our_paren HASH_IDENT {check_my_our_paren $1 $2; new_esp M_list ((false, sndfst $1.any), snd $1.any @ [I_hash, snd $2.any]) $1 $2} -| my_our_paren ARRAY_IDENT {check_my_our_paren $1 $2; new_esp M_list ((false, sndfst $1.any), snd $1.any @ [I_array, snd $2.any]) $1 $2} - -termdo: /* Things called with "do" */ -| DO term %prec UNIOP { die_rule "\"do EXPR\" not allowed" } /* do $filename */ -| DO BRACKET lines BRACKET_END %prec PREC_HIGH {sp_n($2); new_esp $3.mcontext (lines_to_Block $3 $4) $1 $4} /* do { code */ - -bracket_subscript: -| BRACKET expr BRACKET_END {sp_0($1); sp_same $2 $3; check_hash_subscript $2; new_esp M_special (only_one_in_List $2) $1 $3} -| COMPACT_HASH_SUBSCRIPT {sp_0($1); new_1esp (to_Raw_string $1) $1 } - -variable: -| scalar {$1} -| star {$1} -| hash {$1} -| array {$1} -| arraylen {$1} /* $#x, $#{ something } */ -| func {$1} /* &foo; */ - -word: -| bareword { $1 } -| RAW_IDENT { new_1esp (to_Ident $1) $1 } - -comma: COMMA {new_esp M_special true $1 $1} | RIGHT_ARROW {sp_p($1); new_1esp false $1 } - -semi_colon: SEMI_COLON {sp_0($1); $1} - -word_or_scalar: -| word {$1} -| scalar {$1} -| word_paren {$1} -| MULT_L_STR { new_1esp (Ident(None, "x", get_pos $1)) $1 } -| FOR { new_1esp (Ident(None, $1.any, get_pos $1)) $1 } -| ONE_SCALAR_PARA { new_1esp (Ident(None, $1.any, get_pos $1)) $1 } - -bareword: -| NEW { new_1esp (Ident(None, "new", get_pos $1)) $1 } -| BAREWORD { new_1esp (Ident(None, $1.any, get_pos $1)) $1 } - -word_paren: -| BAREWORD_PAREN { new_1esp (Ident(None, $1.any, get_pos $1)) $1 } -| RAW_IDENT_PAREN { new_1esp (to_Ident $1) $1 } -| PO_COMMENT word_paren { po_comment($1); new_esp M_special $2.any $1 $2 } - - -arraylen: ARRAYLEN_IDENT {new_esp M_int (deref_arraylen (to_Ident $1)) $1 $1} | ARRAYLEN scalar {sp_0($2); new_esp M_int (deref_arraylen $2.any ) $1 $1 } | ARRAYLEN bracket_subscript {new_esp M_int (deref_arraylen $2.any) $1 $2} -scalar: SCALAR_IDENT {new_esp M_unknown_scalar (Deref(I_scalar, to_Ident $1)) $1 $1} | DOLLAR scalar {sp_0($2); new_esp M_unknown_scalar (Deref(I_scalar, $2.any)) $1 $1 } | DOLLAR bracket_subscript {new_esp M_unknown_scalar (deref_raw I_scalar $2.any) $1 $2} | DOLLAR BRACKET BRACKET expr BRACKET_END BRACKET_END {sp_0($2); sp_0($3); sp_p($5); sp_0($6); new_esp M_unknown_scalar (Deref(I_scalar, hash_ref $4)) $1 $6} -func: FUNC_IDENT {new_esp M_unknown (Deref(I_func , to_Ident $1)) $1 $1} | AMPERSAND scalar {sp_0($2); new_esp M_unknown (Deref(I_func , $2.any)) $1 $1 } | AMPERSAND bracket_subscript {new_esp M_unknown (deref_raw I_func $2.any) $1 $2} -array: ARRAY_IDENT {new_esp M_array (Deref(I_array , to_Ident $1)) $1 $1} | AT scalar {sp_0($2); new_esp M_array (Deref(I_array , $2.any)) $1 $1 } | AT bracket_subscript {new_esp M_array (deref_raw I_array $2.any) $1 $2} -hash: HASH_IDENT {new_esp M_hash (Deref(I_hash , to_Ident $1)) $1 $1} | PERCENT scalar {sp_0($2); new_esp M_hash (Deref(I_hash , $2.any)) $1 $1 } | PERCENT bracket_subscript {new_esp M_hash (deref_raw I_hash $2.any) $1 $2} -star: STAR_IDENT {new_esp M_unknown (Deref(I_star , to_Ident $1)) $1 $1} | STAR scalar {sp_0($2); new_esp M_unknown (Deref(I_star , $2.any)) $1 $1 } | STAR bracket_subscript {new_esp M_unknown (deref_raw I_star $2.any) $1 $2} - -expr_or_empty: {default_esp (Block [])} | expr {new_1esp $1.any.expr $1 } - -%% - -prog_ref := Some prog -;; diff --git a/perl_checker.src/parser_helper.ml b/perl_checker.src/parser_helper.ml deleted file mode 100644 index 43d60a4..0000000 --- a/perl_checker.src/parser_helper.ml +++ /dev/null @@ -1,1409 +0,0 @@ -open Types -open Common -open Printf - -let bpos = -1, -1 - -let raw_pos2pos(a, b) = !Info.current_file, a, b -let raw_pos_range { pos = (a1, b1) } { pos = (a2, b2) } = (if a1 = -1 then a2 else a1), (if b2 = -1 then b1 else b2) -let pos_range esp1 esp2 = raw_pos2pos (raw_pos_range esp1 esp2) -let get_pos pesp = raw_pos2pos pesp.pos -let get_pos_start { pos = (start, _) } = start -let get_pos_end { pos = (_, end_) } = end_ -let var_dollar_ pos = Deref(I_scalar, Ident(None, "_", pos)) -let var_STDOUT = Deref(I_star, Ident(None, "STDOUT", raw_pos2pos bpos)) - -let new_any mcontext any spaces pos = { mcontext = mcontext ; any = any ; spaces = spaces ; pos = pos } -let new_any_ any spaces pos = new_any M_unknown any spaces pos -let new_esp mcontext e esp_start esp_end = new_any mcontext e esp_start.spaces (raw_pos_range esp_start esp_end) -let new_1esp e esp = new_any esp.mcontext e esp.spaces esp.pos -let new_pesp mcontext prio e esp_start esp_end = new_any mcontext { priority = prio ; expr = e } esp_start.spaces (raw_pos_range esp_start esp_end) -let new_1pesp prio e esp = new_any esp.mcontext { priority = prio ; expr = e } esp.spaces esp.pos -let default_esp e = new_any M_unknown e Space_none bpos -let default_pesp prio e = new_any M_unknown { priority = prio ; expr = e } Space_none bpos - -let split_name_or_fq_name full_ident = - match split_at2 ':'':' full_ident with - | [] -> internal_error "split_ident" - | [ident] -> None, ident - | l -> - let fql, name = split_last l in - let fq = String.concat "::" fql in - Some fq, name - -let is_var_dollar_ = function - | Deref(I_scalar, Ident(None, "_", _)) -> true - | _ -> false -let is_var_number_match = function - | Deref(I_scalar, Ident(None, s, _)) -> String.length s = 1 && s.[0] <> '0' && char_is_number s.[0] - | _ -> false - -let non_scalar_context context = context = I_hash || context = I_array -let is_scalar_context context = context = I_scalar - -let rec is_not_a_scalar = function - | Deref_with(_, context, _, _) - | Deref(context, _) -> non_scalar_context context - | List [] - | List(_ :: _ :: _) -> true - | Call(Deref(I_func, Ident(None, "map", _)), _) - | Call(Deref(I_func, Ident(None, "grep", _)), _) -> true - | Call_op("?:", [ _cond ; a; b ], _) -> is_not_a_scalar a || is_not_a_scalar b - | _ -> false - -let is_a_scalar = function - | Ref _ - | Num _ - | Raw_string _ - | String _ - | Call(Deref(I_func, Ident(None, "N", _)), _) -> true - | My_our(_, [ context, _ ], _) - | Deref_with(_, context, _, _) - | Deref(context, _) -> is_scalar_context context - | _ -> false - -let is_a_string = function - | String _ | Raw_string _ -> true - | _ -> false - -let is_parenthesized = function - | List[] - | List[List _] -> true - | _ -> false - -let un_parenthesize = function - | List[List[e]] -> e - | List[e] -> e - | _ -> internal_error "un_parenthesize" - -let rec un_parenthesize_full = function - | List[e] -> un_parenthesize_full e - | e -> e - -let rec un_parenthesize_full_l = function - | [ List l ] -> un_parenthesize_full_l l - | l -> l - -let is_always_true = function - | Num(n, _) -> float_of_string n <> 0. - | Raw_string(s, _) -> s <> "" - | String(l, _) -> l <> [] - | Ref _ -> true - | _ -> false - -let is_always_false = function - | Num(n, _) -> float_of_string n = 0. - | Raw_string(s, _) -> s = "" - | String(l, _) -> l = [] - | List [] -> true - | Ident(None, "undef", _) -> true - | _ -> false - -let rec is_lvalue = function - | Call(Deref(I_func, Ident(None, f, _)), _) -> List.mem f [ "substr" ] - - | Call_op("?:", [ _ ; a ; b ], _) -> is_lvalue a && is_lvalue b - - | Call_op("local", l, _) - | List [ List l ] - -> List.for_all is_lvalue l - - | My_our _ - | Deref(_, _) - | Deref_with(_, _, _, _) - | Ident(None, "undef", _) - -> true - - | _ -> false - -let not_complex e = - if is_parenthesized e then true else - let rec not_complex_ op = function - | Call_op("?:", _, _) -> false - | Call_op(op', l, _) -> op <> op' && List.for_all (not_complex_ op') l - | e -> not (is_parenthesized e) - in not_complex_ "" (un_parenthesize_full e) - -let not_simple = function - | Num _ | Ident _ | Deref(_, Ident _) -> false - | _ -> true - -let context2s = function - | I_scalar -> "$" - | I_hash -> "%" - | I_array -> "@" - | I_func -> "&" - | I_raw -> "" - | I_star -> "*" -let variable2s(context, ident) = context2s context ^ ident - -let rec string_of_fromparser = function - | Semi_colon -> ";" - | Undef -> "undef" - | Num(num, _) -> num - - | Raw_string(s, _) -> "\"" ^ s ^ "\"" - | String(l, _) -> - let l' = List.map (fun (s, e) -> - s ^ if e = List[] then "" else string_of_fromparser e - ) l in - "\"" ^ String.concat "" l' ^ "\"" - - | Ident(None, s, _) -> s - | Ident(Some fq, s, _) -> fq ^ "::" ^ s - | My_our(myour, l, _) -> myour ^ "(" ^ String.concat "," (List.map (fun (context, s) -> context2s context ^ s) l) ^ ")" - - | Anonymous_sub(_, e, _) -> "sub { " ^ string_of_fromparser e ^ " }" - | Ref(_, e) -> "\\" ^ string_of_fromparser e - | Deref(context, e) -> context2s context ^ string_of_fromparser e - - | Diamond(None) -> "<>" - | Diamond(Some e) -> "<" ^ string_of_fromparser e ^ ">" - - | Sub_declaration(name, _prototype, body, Real_sub_declaration) -> - "sub " ^ string_of_fromparser name ^ " { " ^ string_of_fromparser body ^ " }" - - | Sub_declaration(name, _prototype, body, Glob_assign) -> - "*" ^ string_of_fromparser name ^ " = sub { " ^ string_of_fromparser body ^ " };" - - | Deref_with(_, _, _e1, _e2) -> - internal_error "todo" - - | Package(p) -> "package " ^ string_of_fromparser p - - | Use(e, []) -> "use " ^ string_of_fromparser e - | Use(e, l) -> "use " ^ string_of_fromparser e ^ "(" ^ lstring_of_fromparser l - - | List l -> lstring_of_fromparser_parentheses l - | Block l -> "{ " ^ lstring_of_fromparser l ^ " }" - | Call_op(op, l, _) -> op ^ lstring_of_fromparser_parentheses l - - | Call(e, l) -> string_of_fromparser e ^ lstring_of_fromparser l - - | Method_call(obj, meth, l) -> - let para = if l = [] then "" else lstring_of_fromparser_parentheses l in - string_of_fromparser obj ^ "->" ^ string_of_fromparser meth ^ para - - | Label(e) -> e ^ ": " - - | Perl_checker_comment _ -> "" - | Too_complex -> "XXX" - -and lstring_of_fromparser l = String.concat ", " (List.map string_of_fromparser l) -and lstring_of_fromparser_parentheses l = "(" ^ lstring_of_fromparser l ^ ")" - -let rec is_same_fromparser a b = - match a, b with - | Undef, Undef -> true - | Ident(fq1, s1, _), Ident(fq2, s2, _) -> fq1 = fq2 && s1 = s2 - | Num(s1, _), Num(s2, _) - | Raw_string(s1, _), Raw_string(s2, _) -> s1 = s2 - - | String(l1, _), String(l2, _) -> - for_all2_ (fun (s1, e1) (s2, e2) -> s1 = s2 && is_same_fromparser e1 e2) l1 l2 - - | Ref(c1, e1), Ref(c2, e2) - | Deref(c1, e1), Deref(c2, e2) -> c1 = c2 && is_same_fromparser e1 e2 - - | Deref_with(c1, c_1, e1, e_1), Deref_with(c2, c_2, e2, e_2) -> c1 = c2 && c_1 = c_2 && is_same_fromparser e1 e2 && is_same_fromparser e_1 e_2 - - | Diamond(None), Diamond(None) -> true - | Diamond(Some e1), Diamond(Some e2) -> is_same_fromparser e1 e2 - - | List(l1), List(l2) -> for_all2_ is_same_fromparser l1 l2 - - | Call_op(op1, l1, _), Call_op(op2, l2, _) -> op1 = op2 && for_all2_ is_same_fromparser l1 l2 - | Call(e1, l1), Call(e2, l2) -> is_same_fromparser e1 e2 && for_all2_ is_same_fromparser l1 l2 - - | Method_call(e1, m1, l1), Method_call(e2, m2, l2) -> - is_same_fromparser e1 e2 && is_same_fromparser m1 m2 && for_all2_ is_same_fromparser l1 l2 - - | _ -> false - -let from_scalar esp = - match esp.any with - | Deref(I_scalar, ident) -> ident - | _ -> internal_error "from_scalar" - -let from_array esp = - match esp.any with - | Deref(I_array, ident) -> ident - | _ -> internal_error "from_array" - -let rec get_pos_from_expr = function - | Anonymous_sub(_, _, pos) - | String(_, pos) - | Call_op(_, _, pos) - | Perl_checker_comment(_, pos) - | My_our(_, _, pos) - | Raw_string(_, pos) - | Num(_, pos) - | Ident(_, _, pos) - -> pos - - | Package e - | Ref(_, e) - | Deref(_, e) - | Sub_declaration(e, _, _, _) - | Deref_with(_, _, e, _) - | Use(e, _) - | Call(e, _) - | Method_call(_, e, _) - -> get_pos_from_expr e - - | Diamond(option_e) - -> if option_e = None then raw_pos2pos bpos else get_pos_from_expr (some option_e) - - | List l - | Block l - -> if l = [] then raw_pos2pos bpos else get_pos_from_expr (List.hd l) - - | Semi_colon - | Too_complex - | Undef - | Label _ - -> raw_pos2pos bpos - -let msg_with_rawpos (start, end_) msg = Info.pos2sfull_current start end_ ^ msg -let die_with_rawpos raw_pos msg = failwith (msg_with_rawpos raw_pos msg) -let warn warn_types raw_pos msg = if Flags.are_warning_types_set warn_types then print_endline_flush (msg_with_rawpos raw_pos msg) - -let die_rule msg = die_with_rawpos (Parsing.symbol_start(), Parsing.symbol_end()) msg -let warn_rule warn_types msg = warn warn_types (Parsing.symbol_start(), Parsing.symbol_end()) msg - -let warn_verb warn_types pos msg = if not !Flags.quiet then warn warn_types (pos, pos) msg -let warn_too_many_space start = warn_verb [Warn_white_space] start "you should have only one space here" -let warn_no_space start = warn_verb [Warn_white_space] start "you should have a space here" -let warn_cr start = warn_verb [Warn_white_space] start "you should not have a carriage-return (\\n) here" -let warn_space start = warn_verb [Warn_white_space] start "you should not have a space here" - -let rec prio_less = function - | P_none, _ | _, P_none -> internal_error "prio_less" - - | P_paren_wanted prio1, prio2 - | prio1, P_paren_wanted prio2 -> prio_less(prio1, prio2) - - | P_ternary, P_or -> false - | P_ternary, P_and -> false - - | _, P_loose -> true - | P_loose, _ -> false - | _, P_or -> true - | P_or, _ -> false - - | _, P_and -> true - | P_and, _ -> false - | _, P_call_no_paren -> true - | P_call_no_paren, _ -> false - | _, P_comma -> true - | P_comma, _ -> false - | _, P_assign -> true - | P_assign, _ -> false - | _, P_ternary -> true - | P_ternary, _ -> false - - | _, P_tight_or -> true - | P_tight_or, _ -> false - | _, P_tight_and -> true - | P_tight_and, _ -> false - - | P_bit, P_bit -> true - | P_bit, _ -> false - - | _, P_expr -> true - | P_expr, _ -> false - - | _, P_eq -> true - | P_eq, _ -> false - | _, P_cmp -> true - | P_cmp, _ -> false - | _, P_uniop -> true - | P_uniop, _ -> false - | _, P_add -> true - | P_add, _ -> false - | _, P_mul -> true - | P_mul, _ -> false - | _, P_tight -> true - | P_tight, _ -> false - - | _, P_paren _ -> true - | P_paren _, _ -> true - | P_tok, _ -> true - -let prio_lo_check pri_out pri_in pos expr = - if prio_less(pri_in, pri_out) then - (match pri_in with - | P_paren (P_paren_wanted _) -> () - | P_paren pri_in' -> - if pri_in' <> pri_out && - prio_less(pri_in', pri_out) && not_complex (un_parenthesize expr) then - warn [Warn_suggest_simpler] pos "unneeded parentheses" - | _ -> ()) - else - (match expr with - | Call(Deref(I_func, Ident(None, f, _)), _) when f <> "delete" && pri_in = P_uniop && pri_out = P_add - -> () (* ugly special case since we don't parse uniop correctly (eg: -d $_ . "foo" *) - | Call_op ("print", [Deref (I_star, Ident (None, "STDOUT", _)); (Deref(I_scalar, _) as ident)], _) -> - warn [Warn_traps] pos (sprintf "use parentheses: replace \"print %s ...\" with \"print(%s ...)\"" (string_of_fromparser ident) (string_of_fromparser ident)) - | _ -> warn [Warn_traps] pos "missing parentheses (needed for clarity)") - -let prio_lo pri_out in_ = prio_lo_check pri_out in_.any.priority in_.pos in_.any.expr ; in_.any.expr - -let prio_lo_after pri_out in_ = - if in_.any.priority = P_call_no_paren then in_.any.expr else prio_lo pri_out in_ - -let prio_lo_concat esp = prio_lo P_mul { esp with any = { esp.any with priority = P_paren_wanted esp.any.priority } } - -let hash_ref esp = Ref(I_hash, prio_lo P_loose esp) - -let sp_0 esp = - match esp.spaces with - | Space_none -> () - | Space_0 -> () - | Space_1 - | Space_n -> warn_space (get_pos_start esp) - | Space_cr -> warn_cr (get_pos_start esp) - -let sp_0_or_cr esp = - match esp.spaces with - | Space_none -> () - | Space_0 -> () - | Space_1 - | Space_n -> warn_space (get_pos_start esp) - | Space_cr -> () - -let sp_1 esp = - match esp.spaces with - | Space_none -> () - | Space_0 -> warn_no_space (get_pos_start esp) - | Space_1 -> () - | Space_n -> warn_too_many_space (get_pos_start esp) - | Space_cr -> warn_cr (get_pos_start esp) - -let sp_n esp = - match esp.spaces with - | Space_none -> () - | Space_0 -> warn_no_space (get_pos_start esp) - | Space_1 -> () - | Space_n -> () - | Space_cr -> warn_cr (get_pos_start esp) - -let sp_p esp = - match esp.spaces with - | Space_none -> () - | Space_0 -> warn_no_space (get_pos_start esp) - | Space_1 -> () - | Space_n -> () - | Space_cr -> () - -let sp_cr esp = - match esp.spaces with - | Space_none -> () - | Space_0 - | Space_1 - | Space_n -> warn_verb [Warn_white_space] (get_pos_start esp) "you should have a carriage-return (\\n) here" - | Space_cr -> () - -let sp_same esp1 esp2 = - if esp1.spaces <> Space_0 then sp_p esp2 - else if esp2.spaces <> Space_0 then sp_p esp1 - -let function_to_context word_alone = function - | "map" | "grep" | "grep_index" | "map_index" | "uniq" | "uniq_" -> M_array - | "partition" -> M_tuple [ M_ref M_array ; M_ref M_array ] - | "find" -> M_unknown_scalar - | "any" | "every" -> M_bool - | "find_index" -> M_int - | "each_index" -> M_none - | "N" | "N_" -> M_string - - | "chop" | "chomp" | "push" | "unshift" -> M_none - | "hex" | "length" | "time" | "fork" | "getppid" -> M_int - | "eof" | "wantarray" -> M_int - | "stat" | "lstat" -> M_list - | "arch" | "quotemeta" | "join" | "lc" | "lcfirst" | "uc" | "ucfirst" -> M_string - - | "split" -> M_array - | "shift" | "pop" -> M_unknown_scalar - | "die" | "return" | "redo" | "next" | "last" -> M_unknown - | "caller" -> M_mixed [M_string ; M_list] - - | "ref" -> M_ref M_unknown_scalar - | "undef" -> if word_alone then M_undef else M_none - | _ -> M_unknown - -let word_alone esp = - let word = esp.any in - let mcontext, e = match word with - | Ident(None, f, pos) -> - let e = match f with - | "length" | "stat" | "lstat" | "chop" | "chomp" | "quotemeta" | "lc" | "lcfirst" | "uc" | "ucfirst" -> - Call(Deref(I_func, word), [var_dollar_ pos]) - - | "split" -> Call(Deref(I_func, word), [ Raw_string(" ", pos) ; var_dollar_ pos ]) - | "die" -> Call(Deref(I_func, word), [ Deref(I_scalar, Ident(None, "@", raw_pos2pos bpos)) ]) - | "return" | "eof" | "caller" - | "redo" | "next" | "last" -> - Deref(I_func, word) - - | "hex" | "ref" -> - warn_rule [Warn_complex_expressions] (sprintf "please use \"%s $_\" instead of \"%s\"" f f) ; - Call(Deref(I_func, word), [ Raw_string(" ", pos) ; var_dollar_ pos ]) - | "time" | "wantarray" | "fork" | "getppid" | "arch" -> - warn_rule [Warn_complex_expressions] (sprintf "please use %s() instead of %s" f f) ; - Deref(I_func, word) - | _ -> word - in - function_to_context true f, e - | _ -> M_unknown, word - in - new_pesp mcontext P_tok e esp esp - -let check_parenthesized_first_argexpr word esp = - let want_space = word.[0] = '-' in - if word = "return" then () else - match esp.any.expr with - | [ Call_op(_, (e' :: l), _) ] - | e' :: l -> - if is_parenthesized e' then - if l = [] then - (if want_space then sp_n else sp_0) esp - else - (* eg: join (" ", @l) . "\n" *) - die_with_rawpos (get_pos_start esp, get_pos_start esp) "please remove the space before the function call" - else - sp_p esp - | _ -> - if word = "time" then die_rule "please use time() instead of time"; - sp_p esp - -let check_parenthesized_first_argexpr_with_Ident ident esp = - if esp.any.priority = P_tok then (); - (match ident with - | Ident(Some _, _, _) -> - (match esp.any.expr with - | [e] when is_parenthesized e -> () - | _ -> warn_rule [Warn_suggest_simpler] "use parentheses around argument (otherwise it might cause syntax errors if the package is \"require\"d and not \"use\"d") - | Ident(None, word, _) when List.mem word ["ref" ; "readlink"] -> - if esp.any.priority <> P_tok then warn_rule [Warn_complex_expressions] "use parentheses around argument" - | _ -> ()); - check_parenthesized_first_argexpr (string_of_fromparser ident) esp - -let check_hash_subscript esp = - let can_be_raw_string = function - | "" | "x" | "y" -> false (* special case for {'y'} otherwise the emacs mode goes wild, special case for {'x'} to have the same as {'y'} (since they usually go together) *) - | s -> - char_is_alpha s.[0] && (String.length s = 1 || string_forall_with char_is_alphanumerical_ 1 s) - in - match esp.any.expr with - | List [String ([(s, List [])], _)] when can_be_raw_string s -> warn [Warn_suggest_simpler] esp.pos (sprintf "{\"%s\"} can be written {%s}" s s) - | List [Raw_string(s, _)] when can_be_raw_string s -> warn [Warn_suggest_simpler] esp.pos (sprintf "{'%s'} can be written {%s}" s s) - | _ -> () - -let check_arrow_needed arrow = function - | Deref_with(I_array, I_scalar, List [List [Call _]], _) -> () (* "->" needed for (f())[0]->{XX} *) - | Deref_with _ -> warn [Warn_suggest_simpler] arrow.pos "the arrow \"->\" is unneeded" - | _ -> () - -let check_scalar_subscripted esp = - match esp.any with - | Deref(I_scalar, Deref _) -> warn_rule [Warn_complex_expressions] "for complex dereferencing, use \"->\"" - | _ -> () - -let negatable_ops = collect (fun (a, b) -> [ a, b ; b, a ]) [ - "==", "!=" ; - "eq", "ne" ; -] - -let check_negatable_expr esp = - match un_parenthesize_full esp.any.expr with - | Call_op("m//", var :: _, _) when not (is_var_dollar_ var) -> - warn_rule [Warn_suggest_simpler] "!($var =~ /.../) is better written $var !~ /.../" - | Call_op("!m//", var :: _, _) when not (is_var_dollar_ var) -> - warn_rule [Warn_suggest_simpler] "!($var !~ /.../) is better written $var =~ /.../" - | Call_op(op, _, _) -> - (try - let neg_op = List.assoc op negatable_ops in - warn_rule [Warn_suggest_simpler] (Printf.sprintf "!($foo %s $bar) is better written $foo %s $bar" op neg_op) - with Not_found -> ()) - | _ -> () - -let check_ternary_paras(cond, a, b) = - let rec dont_need_short_circuit_rec = function - | Num _ - | Raw_string _ - | String ([(_, List [])], _) - -> true - | Call(Deref(I_func, Ident(None, "N", _)), [ List(String _ :: l) ]) - | Call_op(".", l, _) - | Ref(I_hash, List l) - | List l -> List.for_all dont_need_short_circuit_rec l - | _ -> false - in - let rec dont_need_short_circuit = function - | Ref(_, Deref(_, Ident _)) - | Deref(_, Ident _) -> true - | Ref(I_hash, List l) - | List l -> List.for_all dont_need_short_circuit l - | e -> dont_need_short_circuit_rec e - in - let check_ternary_para = function - | List [] -> warn_rule [Warn_suggest_simpler; Warn_MDK_Common] "you may use if_() here\n beware that the short-circuit semantic of ?: is not kept\n if you want to keep the short-circuit behaviour, replace () with @{[]} and there will be no warning anymore" - | _ -> () - in - if dont_need_short_circuit a || is_same_fromparser cond a then check_ternary_para b; - if dont_need_short_circuit b || is_same_fromparser cond b then check_ternary_para a; - if is_same_fromparser cond a && is_a_scalar a && is_a_scalar b then warn_rule [Warn_suggest_simpler] "you can replace \"$foo ? $foo : $bar\" with \"$foo || $bar\""; - [ cond; a; b ] - -let check_unneeded_var_dollar_ esp = - if is_var_dollar_ esp.any.expr then warn [Warn_suggest_simpler] esp.pos "\"$_ =~ /regexp/\" can be written \"/regexp/\"" else - if is_var_number_match esp.any.expr then warn [Warn_complex_expressions] esp.pos "do not use the result of a match (eg: $1) to match another pattern" -let check_unneeded_var_dollar_not esp = - if is_var_dollar_ esp.any.expr then warn [Warn_suggest_simpler] esp.pos "\"$_ !~ /regexp/\" can be written \"!/regexp/\"" else - if is_var_number_match esp.any.expr then warn [Warn_complex_expressions] esp.pos "do not use the result of a match (eg: $1) to match another pattern" -let check_unneeded_var_dollar_s esp = - let expr = esp.any.expr in - if is_var_dollar_ expr then warn [Warn_suggest_simpler] esp.pos "\"$_ =~ s/regexp/.../\" can be written \"s/regexp/.../\"" else - if is_var_number_match expr then warn [Warn_traps] esp.pos "do not modify the result of a match (eg: $1)" else - let expr = match expr with - | List [List [Call_op("=", [ expr; _], _)]] -> expr (* check $xx in ($xx = ...) =~ ... *) - | _ -> expr in - if is_a_string expr || not (is_a_scalar expr) then warn [Warn_complex_expressions] esp.pos "you can only use s/// on a variable" - -let check_my esp = if esp.any <> "my" then die_rule "syntax error" -let check_foreach esp = if esp.any = "for" then warn [Warn_normalized_expressions] esp.pos "write \"foreach\" instead of \"for\"" -let check_for esp = if esp.any = "foreach" then warn [Warn_normalized_expressions] esp.pos "write \"for\" instead of \"foreach\"" -let check_for_foreach esp arg = - match arg.any.expr with - | List [ Deref(I_scalar, _) ] -> - if esp.any = "foreach" then warn [Warn_normalized_expressions] esp.pos "you are using the special trick to locally set $_ with a value, for this please use \"for\" instead of \"foreach\"" - | List [ Deref_with(context, I_scalar, _, _) ] when context <> I_func -> - if esp.any = "foreach" then warn [Warn_normalized_expressions] esp.pos "you are using the special trick to locally set $_ with a value, for this please use \"for\" instead of \"foreach\"" - | List [ Deref(I_hash, _) ] -> - warn [Warn_traps] esp.pos "foreach with a hash is usually an error" - | _ -> - if esp.any = "for" then warn [Warn_normalized_expressions] esp.pos "write \"foreach\" instead of \"for\"" - -let check_block_expr has_semi_colon last_expr esp_last esp_BRACKET_END = - sp_p esp_BRACKET_END ; - - if esp_BRACKET_END.spaces = Space_cr then - (if not has_semi_colon then warn_verb [Warn_white_space] (get_pos_end esp_last) "missing \";\"") - else - (if last_expr = Semi_colon then warn_verb [Warn_white_space] (get_pos_end esp_last) "spurious \";\" before closing block") - -let check_block_lines esp_lines esp_BRACKET_END = - match fst esp_lines.any with - | [] -> - sp_0_or_cr esp_BRACKET_END - | l -> - (if List.hd l = Semi_colon then sp_0 else sp_p) esp_lines ; - check_block_expr (snd esp_lines.any) (last l) esp_lines esp_BRACKET_END - -let check_unless_else elsif else_ = - if elsif.any <> [] then warn [Warn_complex_expressions] elsif.pos "don't use \"elsif\" with \"unless\" (replace \"unless\" with \"if\")"; - if else_.any <> [] then warn [Warn_complex_expressions] else_.pos "don't use \"else\" with \"unless\" (replace \"unless\" with \"if\")" - -let check_my_our_paren { any = ((comma_closed, _), l) } after_esp = - (if l = [] then sp_0 else sp_1) after_esp ; - if not comma_closed then die_rule "syntax error" - -let check_simple_pattern = function - | [ String([ st, List [] ], _); Raw_string("", _) ] -> - if String.length st > 2 && - st.[0] = '^' && st.[String.length st - 1] = '$' then - let st = skip_n_char_ 1 1 st in - if string_forall_with char_is_alphanumerical_ 0 st then - warn_rule [Warn_suggest_simpler] (sprintf "\"... =~ /^%s$/\" is better written \"... eq '%s'\"" st st) - | _ -> () - -let rec only_one esp = - match esp.any with - | [List l'] -> only_one { esp with any = l' } - | [e] -> e - | [] -> die_with_rawpos esp.pos "you must give one argument" - | _ -> die_with_rawpos esp.pos "you must give only one argument" - -let only_one_array_ref esp = - let e = only_one esp in - (match e with - | Call_op("last_array_index", [Deref(I_array, e)], _) -> - warn [Warn_suggest_simpler] esp.pos (sprintf "you can replace $#%s with -1" (string_of_fromparser e)) - | _ -> ()); - e - -let only_one_in_List esp = - match esp.any.expr with - | List l -> only_one { esp with any = l } - | e -> e - -let rec is_only_one_in_List = function - | [List l] -> is_only_one_in_List l - | [_] -> true - | _ -> false - -let maybe_to_Raw_string = function - | Ident(None, s, pos) -> Raw_string(s, pos) - | Ident(Some fq, s, pos) -> Raw_string(fq ^ "::" ^ s, pos) - | e -> e - -let to_List = function - | [e] -> e - | l -> List l - -let deref_arraylen e = Call_op("last_array_index", [Deref(I_array, e)], raw_pos2pos bpos) -let deref_raw context e = - let e = match e with - | Raw_string(s, pos) -> - let fq, ident = split_name_or_fq_name s in - Ident(fq, ident, pos) - | Deref(I_scalar, (Ident _ as ident)) -> - warn_rule [Warn_suggest_simpler] (sprintf "%s{$%s} can be written %s$%s" (context2s context) (string_of_fromparser ident) (context2s context) (string_of_fromparser ident)); - e - | _ -> e - in Deref(context, e) - -let to_Ident { any = (fq, name); pos = pos } = Ident(fq, name, raw_pos2pos pos) -let to_Raw_string { any = s; pos = pos } = Raw_string(s, raw_pos2pos pos) -let to_Method_call (object_, method_, para) = - match method_ with - | Ident(Some "SUPER", name, pos) -> Method_call(maybe_to_Raw_string object_, Raw_string(name, pos), para) - | Ident(Some _, _, _) -> Call(Deref(I_func, method_), maybe_to_Raw_string object_ :: para) - | _ -> Method_call(maybe_to_Raw_string object_, maybe_to_Raw_string method_, para) -let to_Deref_with(from_context, to_context, ref_, para) = - if is_not_a_scalar ref_ then warn_rule [] "bad deref"; - Deref_with(from_context, to_context, ref_, para) - -let to_Deref_with_arrow arrow (from_context, to_context, ref_, para) = - if from_context != I_func then check_arrow_needed arrow ref_ ; - to_Deref_with(from_context, to_context, ref_, para) - -let lines_to_Block esp_lines esp_BRACKET_END = - check_block_lines esp_lines esp_BRACKET_END; - Block (fst esp_lines.any) - -let to_Local esp = - let l = - match esp.any.expr with - | List[List l] -> l - | e -> [e] - in - let local_vars, local_exprs = fpartition (function - | Deref(I_star as context, Ident(None, ident, _)) - | Deref(I_scalar as context, Ident(None, ("_" as ident), _)) -> - Some(context, ident) - | Deref(I_scalar, Ident _) - | Deref(I_array, Ident _) - | Deref(I_star, Ident _) - | Deref_with(I_hash, I_scalar, Ident _, _) - | Deref_with(I_hash, I_scalar, Deref(I_scalar, _), _) - | Deref_with(I_hash, I_scalar, Deref_with(I_hash, I_scalar, Ident _, _), _) - | Deref_with(I_hash, I_scalar, Deref_with(I_hash, I_scalar, Deref(I_scalar, Ident _), _), _) -> - None - | _ -> die_with_rawpos esp.pos "bad argument to \"local\"" - ) l in - if local_vars = [] then Call_op("local", local_exprs, raw_pos2pos esp.pos) - else if local_exprs = [] then My_our("local", local_vars, raw_pos2pos esp.pos) - else die_with_rawpos esp.pos "bad argument to \"local\"" - -let sub_declaration (name, proto) body sub_kind = Sub_declaration(name, proto, Block body, sub_kind) -let anonymous_sub proto lines bracket_end = Anonymous_sub (proto, lines_to_Block lines bracket_end, raw_pos2pos lines.pos) -let call_with_same_para_special f = Call(f, [Deref(I_star, (Ident(None, "_", raw_pos2pos bpos)))]) -let remove_call_with_same_para_special = function - | Call(f, [Deref(I_star, (Ident(None, "_", _)))]) -> f - | e -> e - -let check_My_under_condition msg = function - | List [ My_our("my", _, _) ] -> - warn_rule [Warn_traps] "this is stupid" - | List [ Call_op("=", [ My_our("my", _, _); _ ], _) ] -> - warn_rule [Warn_traps] msg - | _ -> () - -let cook_call_op op para pos = - (match op with - | "le" | "ge" | "eq" | "ne" | "gt" | "lt" | "cmp" -> - if List.exists (function Num _ -> true | _ -> false) para then - warn_rule [Warn_traps] (sprintf "you should use a number operator, not the string operator \"%s\" (or replace the number with a string)" op) - | "." -> - if List.exists (function Call(Deref(I_func, Ident(None, "N_", _)), _) -> true | _ -> false) para then - warn_rule [Warn_MDK_Common; Warn_traps] "N_(\"xxx\") . \"yyy\" is dumb since the string \"xxx\" will never get translated" - | _ -> ()); - - (match op, para with - | "if", List [Call_op ("=", [ _; e ], _)] :: _ when is_always_true e || is_always_false e -> - warn_rule [Warn_traps] "are you sure you did not mean \"==\" instead of \"=\"?" - - | "foreach", [ _; Block [ expr ; Semi_colon ] ] - | "foreach", [ _; Block [ expr ] ] -> - (match expr with - | Call_op("if infix", [ List [ Call(Deref(I_func, Ident(None, "push", _)), [ Deref(I_array, Ident _) as l ; Deref(I_scalar, Ident(None, "_", _)) ]) ] ; _ ], _) -> - let l = string_of_fromparser l in - warn_rule [Warn_suggest_functional] (sprintf "use \"push %s, grep { ... } ...\" instead of \"foreach (...) { push %s, $_ if ... }\"\n or sometimes \"%s = grep { ... } ...\"" l l l) - | Call_op("if infix", [ List [ Call(Deref(I_func, Ident(None, "push", _)), [ Deref(I_array, Ident _) as l; _ ]) ] ; _ ], _) -> - let l = string_of_fromparser l in - warn_rule [Warn_suggest_functional] (sprintf "use \"push %s, map { ... ? ... : () } ...\" instead of \"foreach (...) { push %s, ... if ... }\"\n or sometimes \"%s = map { ... ? ... : () } ...\"\n or sometimes \"%s = map { if_(..., ...) } ...\"" l l l l) - - | Call_op ("if", [ _; Block [ List [ Call_op("=", [Deref(I_scalar, _) as ret; Deref(I_scalar, Ident(None, "_", _)) ], _) ]; - Semi_colon; - List [ Deref(I_func, Ident(None, "last", _)) ]; - Semi_colon ] ], _) -> - warn_rule [Warn_suggest_functional; Warn_MDK_Common] (sprintf "use \"%s = find { ... } ...\"" (string_of_fromparser ret)) - - | List [ Call(Deref(I_func, Ident(None, "push", _)), [ Deref(I_array, Ident _) as l; _ ]) ] -> - let l = string_of_fromparser l in - warn_rule [Warn_suggest_functional] (sprintf "use \"push %s, map { ... } ...\" instead of \"foreach (...) { push %s, ... }\"\n or sometimes \"%s = map { ... } ...\"" l l l) - | _ -> ()) - - | "=", [My_our _; Ident(None, "undef", _)] -> - warn [Warn_suggest_simpler] pos "no need to initialize variable, it's done by default" - | "=", [My_our _; List[]] -> - if Info.is_on_same_line_current pos then warn [Warn_suggest_simpler] pos "no need to initialize variables, it's done by default" - - | "=", [ Deref_with(I_array, I_scalar, id, Deref(I_array, id_)); _ ] when is_same_fromparser id id_ -> - warn_rule [Warn_suggest_simpler] "\"$a[@a] = ...\" is better written \"push @a, ...\"" - - | "=", [ Deref(I_star, String ([(sf1, List [])], _)); _ ] -> - warn_rule [Warn_help_perl_checker] (sprintf "write *{'%s'} instead of *{\"%s\"}" sf1 sf1) - - | "||=", List [ List _ ] :: _ - | "&&=", List [ List _ ] :: _ -> warn_rule [Warn_complex_expressions] "remove the parentheses" - | "||=", e :: _ - | "&&=", e :: _ -> if is_not_a_scalar e then warn_rule [Warn_traps] (sprintf "\"%s\" is only useful with a scalar" op) - - | "==", [Call_op("last_array_index", _, _); Num(n, _)] -> - warn_rule [Warn_suggest_simpler] (sprintf "$#x == %s is better written @x == %d" n (1 + int_of_string n)) - | "==", [Call_op("last_array_index", _, _); Call_op("- unary", [Num (n, _)], _)] -> - warn_rule [Warn_suggest_simpler] (sprintf "$#x == -%s is better written @x == %d" n (1 - int_of_string n)) - - - | "||", e :: _ when is_always_true e -> warn_rule [Warn_strange] " || ... is the same as " - | "&&", e :: _ when is_always_false e -> warn_rule [Warn_strange] " && ... is the same as " - | "||", e :: _ when is_always_false e -> warn_rule [Warn_strange] " || ... is the same as ..." - | "&&", e :: _ when is_always_true e -> warn_rule [Warn_strange] " && ... is the same as ..." - - | "or", e :: _ when is_always_true (un_parenthesize_full e) -> warn_rule [Warn_strange] " or ... is the same as " - | "and", e :: _ when is_always_false (un_parenthesize_full e) -> warn_rule [Warn_strange] " and ... is the same as " - | "or", e :: _ when is_always_false (un_parenthesize_full e) -> warn_rule [Warn_strange] " or ... is the same as ..." - | "and", e :: _ when is_always_true (un_parenthesize_full e) -> warn_rule [Warn_strange] " and ... is the same as ..." - - | "or", [ List [ Deref(I_scalar, id) ]; List [ Call_op("=", [ Deref(I_scalar, id_); _], _) ] ] when is_same_fromparser id id_ -> - warn_rule [Warn_suggest_simpler] "\"$foo or $foo = ...\" can be written \"$foo ||= ...\"" - - | "and", [ _cond ; expr ] -> check_My_under_condition "replace \" and my $foo = ...\" with \"my $foo = && ...\"" expr - | "or", [ _cond ; expr ] -> check_My_under_condition "replace \" or my $foo = ...\" with \"my $foo = ! && ...\"" expr - - | _ -> ()); - - match op, para with - | "=", [ Deref(I_star, (Ident _ as f1)); Deref(I_star, (Ident _ as f2)) ] -> - let s1, s2 = string_of_fromparser f1, string_of_fromparser f2 in - warn [Warn_complex_expressions] pos (sprintf "\"*%s = *%s\" is better written \"*%s = \\&%s\"" s1 s2 s1 s2) ; - sub_declaration (f1, None) [ call_with_same_para_special(Deref(I_func, f2)) ] Glob_assign - | "=", [ Deref(I_star, Raw_string(sf1, pos_f1)); Deref(I_star, (Ident _ as f2)) ] -> - let s2 = string_of_fromparser f2 in - warn [Warn_help_perl_checker] pos (sprintf "\"*{'%s'} = *%s\" is better written \"*{'%s'} = \\&%s\"" sf1 s2 sf1 s2) ; - sub_declaration (Ident(None, sf1, pos_f1), None) [ call_with_same_para_special(Deref(I_func, f2)) ] Glob_assign - - | "=", [ Deref(I_star, (Ident _ as f1)); Ref(I_scalar, Deref(I_func, (Ident _ as f2))) ] -> - sub_declaration (f1, None) [ call_with_same_para_special(Deref(I_func, f2)) ] Glob_assign - | "=", [ Deref(I_star, Raw_string(sf1, pos_f1)); Ref(I_scalar, Deref(I_func, (Ident _ as f2))) ] -> - sub_declaration (Ident(None, sf1, pos_f1), None) [ call_with_same_para_special(Deref(I_func, f2)) ] Glob_assign - - | "=", [ Deref(I_star, (Ident _ as f1)); (Anonymous_sub(proto, sub, _)) ] -> - sub_declaration (f1, proto) [ sub ] Glob_assign - - | _ -> Call_op(op, para, raw_pos2pos pos) - -let to_Call_op mcontext op para esp_start esp_end = - let pos = raw_pos_range esp_start esp_end in - new_any mcontext (cook_call_op op para pos) esp_start.spaces pos -let to_Call_op_ mcontext prio op para esp_start esp_end = - let pos = raw_pos_range esp_start esp_end in - new_any mcontext { priority = prio ; expr = cook_call_op op para pos } esp_start.spaces pos -let to_Call_assign_op_ mcontext prio op left right esp_left esp_end = - if not (is_lvalue left) then warn [Warn_strange] esp_left.pos "invalid lvalue"; - to_Call_op_ mcontext prio op [ left ; right ] esp_left esp_end - -let followed_by_comma expr true_comma = - if true_comma then expr else - match split_last expr with - | l, Ident(None, s, pos) -> l @ [Raw_string(s, pos)] - | _ -> expr - - -let pot_strings = Hashtbl.create 16 -let po_comments = ref [] -let po_comment esp = lpush po_comments esp.any - -let check_format_a_la_printf s pos = - let rec check_format_a_la_printf_ contexts i = - try - let i' = String.index_from s i '%' in - try - let contexts = - match s.[i' + 1] with - | '%' -> contexts - | 'd' -> M_int :: contexts - | 's' | 'c' -> M_string :: contexts - | c -> warn [Warn_strange] (pos + i', pos + i') (sprintf "invalid command %%%c" c); contexts - in - check_format_a_la_printf_ contexts (i' + 2) - with Invalid_argument _ -> warn [Warn_strange] (pos + i', pos + i') "invalid command %" ; contexts - with Not_found -> contexts - in check_format_a_la_printf_ [] 0 - -let generate_pot file = - let fd = open_out file in - output_string fd -("# SOME DESCRIPTIVE TITLE. -# Copyright (C) YEAR Free Software Foundation, Inc. -# FIRST AUTHOR , YEAR. -# -#, fuzzy -msgid \"\" -msgstr \"\" -\"Project-Id-Version: PACKAGE VERSION\\n\" -\"POT-Creation-Date: " ^ input_line (Unix.open_process_in "date '+%Y-%m-%d %H:%M%z'") ^ "\\n\" -\"PO-Revision-Date: YEAR-MO-DA HO:MI+ZONE\\n\" -\"Last-Translator: FULL NAME \\n\" -\"Language-Team: LANGUAGE \\n\" -\"MIME-Version: 1.0\\n\" -\"Content-Type: text/plain; charset=CHARSET\\n\" -\"Content-Transfer-Encoding: 8-bit\\n\" - -") ; - - let rec print_formatted_char = function - | '"' -> output_char fd '\\'; output_char fd '"' - | '\t' -> output_char fd '\\'; output_char fd 't' - | '\\' -> output_char fd '\\'; output_char fd '\\' - | '\n' -> output_string fd "\\n\"\n\"" - | c -> output_char fd c - in - let sorted_pot_strings = List.sort (fun (_, pos_a) (_, pos_b) -> compare pos_a pos_b) - (Hashtbl.fold (fun k (v, _) l -> (k,v) :: l) pot_strings [] ) in - List.iter (fun (s, _) -> - match Hashtbl.find_all pot_strings s with - | [] -> () - | l -> - List.iter (fun _ -> Hashtbl.remove pot_strings s) l ; - - List.iter (fun po_comment -> output_string fd ("#. " ^ po_comment ^ "\n")) (collect snd l); - - let pos_l = List.sort compare (List.map fst l) in - fprintf fd "#: %s\n" (String.concat " " (List.map Info.pos2s_for_po pos_l)) ; - output_string fd "#, c-format\n" ; - - output_string fd (if String.contains s '\n' then "msgid \"\"\n\"" else "msgid \"") ; - String.iter print_formatted_char s ; - output_string fd "\"\n" ; - output_string fd "msgstr \"\"\n\n" - ) sorted_pot_strings ; - close_out fd - -let check_system_call = function - | "mkdir" :: l -> - let has_p = List.exists (str_begins_with "-p") l in - let has_m = List.exists (str_begins_with "-m") l in - if has_p && has_m then () - else if has_p then warn_rule [Warn_suggest_simpler; Warn_MDK_Common] "you can replace system(\"mkdir -p ...\") with mkdir_p(...)" - else if has_m then warn_rule [Warn_suggest_simpler; Warn_MDK_Common] "you can replace system(\"mkdir -m ...\") with mkdir(..., )" - else warn_rule [Warn_suggest_simpler; Warn_MDK_Common] "you can replace system(\"mkdir ...\") with mkdir(...)" - | _ -> () - -let call_raw force_non_builtin_func (e, para) = - let check_anonymous_block f = function - | [ Anonymous_sub _ ; Deref (I_hash, _) ] -> - warn_rule [Warn_strange] ("a hash is not a valid parameter to function " ^ f) - - | Anonymous_sub _ :: _ -> () - | _ -> warn_rule [Warn_complex_expressions] (sprintf "always use \"%s\" with a block (eg: %s { ... } @list)" f f) - in - - match e with - | Deref(I_func, Ident(None, f, _)) -> - (match f with - | "join" -> - (match un_parenthesize_full_l para with - | e :: _ when not (is_a_scalar e) -> warn_rule [Warn_traps] "first argument of join() must be a scalar"; - | [_] -> warn_rule [Warn_traps] "not enough parameters" - | [_; e] when is_a_scalar e -> warn_rule [Warn_traps] "join('...', $foo) is the same as $foo" - | _ -> ()) - - | "length" -> - if para = [] then warn_rule [Warn_complex_expressions] (sprintf "please use \"%s $_\" instead of \"%s\"" f f) else - if is_not_a_scalar (List.hd para) then warn_rule [Warn_traps] "never use \"length @l\", it returns the length of the string int(@l)" ; - - | "open" -> - (match para with - | [ List(Ident(None, name, _) :: _) ] - | Ident(None, name, _) :: _ -> - if not (List.mem name [ "STDIN" ; "STDOUT" ; "STDERR" ]) then - warn_rule [Warn_complex_expressions] (sprintf "use a scalar instead of a bareword (eg: occurrences of %s with $%s)" name name) - | _ -> ()) - - | "N" | "N_" -> - (match para with - | [ List(String([ s, List [] ], (_, pos_offset, _ as pos)) :: para) ] -> - if !Flags.generate_pot then ( - Hashtbl.add pot_strings s (pos, !po_comments) ; - po_comments := [] - ) ; - let contexts = check_format_a_la_printf s pos_offset in - if f = "N" then - if List.length para < List.length contexts then - warn_rule [Warn_traps; Warn_MDK_Common] "not enough parameters" - else if List.length para > List.length contexts then - warn_rule [Warn_traps; Warn_MDK_Common] "too many parameters" ; - (*if String.contains s '\t' then warn_rule "tabulation in translated string must be written \\\\t";*) - (*if count_matching_char s '\n' > 10 then warn_rule "long string";*) - | [ List(String _ :: _) ] -> die_rule "don't use interpolated translated string, use %s or %d instead" - | _ -> die_rule (sprintf "%s() must be used with a string" f)) - - | "if_" -> - (match para with - | [ List [ _ ] ] -> warn_rule [Warn_traps; Warn_MDK_Common] "not enough parameters"; - | _ -> ()) - - | "map" -> - (match para with - - | Anonymous_sub(None, Block [ List [ Call(Deref(I_func, Ident(None, "if_", _)), - [ List [ _ ; Deref(I_scalar, Ident(None, "_", _)) ] ]) ] ], _) :: _ -> - warn_rule [Warn_suggest_simpler; Warn_MDK_Common] "you can replace \"map { if_(..., $_) }\" with \"grep { ... }\"" - | _ -> check_anonymous_block f para) - - | "grep" -> - (match para with - | [ Anonymous_sub(None, Block [ List [ Call_op("not", [ Call(Deref(I_func, Ident(None, "member", _)), [ List(Deref(I_scalar, Ident(None, "_", _)) :: _) ]) ], _) ] ], _); _ ] -> - warn_rule [Warn_suggest_simpler; Warn_MDK_Common] "you can replace \"grep { !member($_, ...) } @l\" with \"difference2([ @l ], [ ... ])\"" - | [ Anonymous_sub(None, Block [ List [ Call(Deref(I_func, Ident(None, "member", _)), [ List(Deref(I_scalar, Ident(None, "_", _)) :: _) ]) ] ], _); _ ] -> - warn_rule [Warn_suggest_simpler; Warn_MDK_Common] "you can replace \"grep { member($_, ...) } @l\" with \"intersection([ @l ], [ ... ])\"" - | _ -> check_anonymous_block f para) - - | "any" -> - (match para with - [Anonymous_sub (None, Block - [ List [ Call_op("eq", [Deref(I_scalar, Ident(None, "_", _)); _ ], _) ] ], - _); _ ] -> - warn_rule [Warn_suggest_simpler; Warn_MDK_Common] "you can replace \"any { $_ eq ... } @l\" with \"member(..., @l)\"" - | _ -> check_anonymous_block f para) - - | "grep_index" | "map_index" | "partition" | "uniq_" - | "find" - | "every" - | "find_index" - | "each_index" -> check_anonymous_block f para - - | "member" -> - (match para with - [ List [ _; Call(Deref(I_func, Ident(None, "keys", _)), _) ] ] -> - warn_rule [Warn_suggest_simpler; Warn_MDK_Common] "you can replace \"member($xxx, keys %yyy)\" with \"exists $yyy{$xxx}\"" - | _ -> ()) - - | "pop" | "shift" -> - (match para with - | [] - | [ Deref(I_array, _) ] - | [ List [ Deref(I_array, _) ] ] -> () - | _ -> warn_rule [Warn_traps] (f ^ " is expecting an array and nothing else")) - - | "push" | "unshift" -> - (match para with - | Deref(I_array, _) :: l - | [ List (Deref(I_array, _) :: l) ] -> - if l = [] then warn_rule [Warn_traps] ("you must give some arguments to " ^ f) - | _ -> warn_rule [Warn_traps] (f ^ " is expecting an array")) - - | "system" -> - let fake_string_option_from_expr = function - | String(l, _) -> Some(String.concat "" (List.map fst l)) - | Raw_string(s, _) -> Some s - | _ -> None - in - (match un_parenthesize_full_l para with - | [ e ] -> - (match fake_string_option_from_expr e with - | Some s -> - if List.exists (String.contains s) [ '\'' ; char_quote ] && - not (List.exists (String.contains s) [ '<' ; '>' ; '&' ; ';']) then - warn_rule [Warn_complex_expressions] "instead of quoting parameters you should give a list of arguments"; - check_system_call (split_at ' ' s) - | None -> ()) - | l -> - let l' = filter_some_with fake_string_option_from_expr l in - check_system_call l') - | _ -> () - ); - - let para' = match f with - | "no" -> - (match para with - | [ Ident(_, _, pos) as s ] -> Some [ Raw_string(string_of_fromparser s, pos) ] - | [ Call(Deref(I_func, (Ident(_, _, pos) as s)), l) ] -> Some(Raw_string(string_of_fromparser s, pos) :: l) - | _ -> die_rule "use \"no PACKAGE \"") - | "undef" -> - (match para with - | [ Deref(I_star, ident) ] -> Some [ Deref(I_func, ident) ] - | _ -> None) - - | "goto" -> - (match para with - | [ Ident(None, s, pos) ] -> Some [ Raw_string(s, pos) ] - | _ -> None) - - | "last" | "next" | "redo" when not force_non_builtin_func -> - (match para with - | [ Ident(None, s, pos) ] -> Some [ Raw_string(s, pos) ] - | _ -> die_rule (sprintf "%s must be used with a raw string" f)) - - | "split" -> - (match para with - | [ List(Call_op("m//", Deref(I_scalar, Ident(None, "_", _)) :: pattern, pos) :: l) ] - | Call_op("m//", Deref(I_scalar, Ident(None, "_", _)) :: pattern, pos) :: l -> - Some(Call_op("qr//", pattern, pos) :: l) - | _ -> None) - - | _ -> None - in Call(e, some_or para' para) - | _ -> Call(e, para) - -let call(e, para) = call_raw false (e, para) - -let check_return esp_func esp_para = - match esp_func.any with - | Ident(None, "return", _) -> - prio_lo_check P_call_no_paren esp_para.any.priority esp_para.pos (List esp_para.any.expr) - | _ -> () - -let call_and_context(e, para) force_non_builtin_func priority esp_start esp_end = - let context = - match e with - | Deref(I_func, Ident(None, f, _)) -> function_to_context false f - | _ -> M_unknown - in - new_pesp context priority (call_raw force_non_builtin_func (e, para)) esp_start esp_end - -let call_no_paren esp_func esp_para = check_return esp_func esp_para; call_and_context(Deref(I_func, esp_func.any), esp_para.any.expr) false P_call_no_paren esp_func esp_para -let call_with_paren esp_func esp_para = check_return esp_func esp_para; call_and_context (Deref(I_func, esp_func.any), esp_para.any.expr) false P_tok esp_func esp_para - -let call_func esp_func esp_para = - call_and_context(esp_func.any, esp_para.any.expr) true P_tok esp_func esp_para - -let call_one_scalar_para prio { any = e ; pos = pos } para esp_start esp_end = - let para' = - match para with - | [] -> - if e = "shift" || e = "pop" then - [] (* can't decide here *) - else - (if not (List.mem e [ "length" ]) then warn_rule [Warn_complex_expressions] (sprintf "please use \"%s $_\" instead of \"%s\"" e e) ; - [var_dollar_ (raw_pos2pos pos)]) - | _ -> para - in - new_pesp M_unknown prio (call(Deref(I_func, Ident(None, e, raw_pos2pos pos)), para')) esp_start esp_end - - -let (current_lexbuf : Lexing.lexbuf option ref) = ref None - -let rec list2tokens l = - let rl = ref l in - fun lexbuf -> - match !rl with - | [] -> internal_error "list2tokens" - | ((start, end_), e) :: l -> - (* HACK: fake a normal lexbuf *) - lexbuf.Lexing.lex_start_p <- { Lexing.dummy_pos with Lexing.pos_cnum = start } ; - lexbuf.Lexing.lex_curr_p <- { Lexing.dummy_pos with Lexing.pos_cnum = end_ } ; - rl := l ; e - -let parse_tokens parse tokens lexbuf_opt = - if lexbuf_opt <> None then current_lexbuf := lexbuf_opt ; - if tokens = [] then [] else - parse (list2tokens tokens) (some !current_lexbuf) - -let parse_interpolated parse l = - let l' = List.map (fun (s, tokens) -> s, to_List(parse_tokens parse tokens None)) l in - match split_last l' with - | pl, ("", List []) -> pl - | _ -> l' - -let to_String parse strict { any = l ; pos = pos } = - let l' = parse_interpolated parse l in - (match l' with - | [ "", List [Deref(I_scalar, Ident(None, ident, _))]] -> - if ident <> "!" && strict then warn [Warn_suggest_simpler] pos (sprintf "%s is better written without the double quotes" (variable2s(I_scalar, ident))) - | [ "", List [Deref(I_hash, _)]] -> - warn [Warn_traps] pos "don't use a hash in string context" - | [ "", List [Deref(I_array, _)]] - | [ "", List [Deref_with(I_array, I_array, _, _)]] -> (* for slices like: "@m3[1..$#m3]" *) - () - | [("", _)] -> - if strict then warn [Warn_suggest_simpler] pos "double quotes are unneeded" - | _ -> ()); - String(l', raw_pos2pos pos) - -let from_PATTERN parse { any = (s, opts) ; pos = pos } = - let re = parse_interpolated parse s in - (match List.rev re with - | (s, List []) :: _ -> - if str_ends_with s ".*" then - warn_rule [Warn_suggest_simpler] (sprintf "you can remove \"%s\" at the end of your regexp" ".*") - else if str_ends_with s ".*$" then - warn_rule [Warn_suggest_simpler] (sprintf "you can remove \"%s\" at the end of your regexp" ".*$") - | _ -> ()); - let pattern = [ String(re, raw_pos2pos pos) ; Raw_string(opts, raw_pos2pos pos) ] in - check_simple_pattern pattern; - pattern - -let from_PATTERN_SUBST parse { any = (s1, s2, opts) ; pos = pos } = - [ String(parse_interpolated parse s1, raw_pos2pos pos) ; - String(parse_interpolated parse s2, raw_pos2pos pos) ; - Raw_string(opts, raw_pos2pos pos) ] - - -let rec mcontext2s = function - | M_none -> "()" - - | M_bool -> "bool" - - | M_int -> "int" - | M_float -> "float" - | M_string -> "string" - | M_ref c -> "ref(" ^ mcontext2s c ^ ")" - | M_revision -> "revision" - | M_undef -> "undef" - | M_sub -> "sub" - | M_unknown_scalar -> "scalar" - - | M_tuple l -> "tuple(" ^ String.concat ", " (List.map mcontext2s l) ^ ")" - | M_list -> "list" - | M_array -> "array" - | M_hash -> "hash" - - | M_special -> "special" - | M_unknown -> "unknown" - | M_mixed l -> String.concat " | " (List.map mcontext2s l) - -let rec mcontext_lower c1 c2 = - match c1, c2 with - | M_special, _ | _, M_special -> internal_error "M_special in mcontext_compare" - - | M_unknown, _ - | _, M_unknown -> true - - | M_mixed l, c -> List.exists (fun a -> mcontext_lower a c) l - | c, M_mixed l -> List.exists (mcontext_lower c) l - - | M_none, M_none | M_sub, M_sub | M_hash, M_hash | M_hash, M_bool -> true - | M_none, _ | M_sub, _ | M_hash, _ -> false - - | _, M_list -> true - - | M_list, M_bool - | M_list, M_tuple _ - - (* M_unknown_scalar is M_mixed [ M_int ; M_float ; M_string ; M_bool ; M_ref _ ; M_revision ; M_undef ] *) - | M_unknown_scalar, M_int | M_unknown_scalar, M_float | M_unknown_scalar, M_string | M_unknown_scalar, M_bool - | M_unknown_scalar, M_ref _ | M_unknown_scalar, M_revision | M_unknown_scalar, M_undef | M_unknown_scalar, M_unknown_scalar - - | M_array, M_array | M_array, M_int | M_array, M_float | M_array, M_bool | M_array, M_unknown_scalar | M_array, M_tuple _ - | M_int, M_int | M_int, M_float | M_int, M_string | M_int, M_bool | M_int, M_unknown_scalar - | M_float, M_float | M_float, M_string | M_float, M_bool | M_float, M_unknown_scalar - | M_string, M_string | M_string, M_bool | M_string, M_unknown_scalar - | M_bool, M_bool | M_bool, M_unknown_scalar - - | M_ref _, M_unknown_scalar - | M_revision, M_revision | M_revision, M_unknown_scalar - | M_undef, M_undef | M_undef, M_unknown_scalar - - -> true - - | M_tuple t1, M_tuple t2 -> - List.length t1 = List.length t2 && for_all2_true mcontext_lower t1 t2 - - | M_tuple [c], M_int | M_tuple [c], M_float | M_tuple [c], M_string | M_tuple [c], M_bool - | M_tuple [c], M_ref _ | M_tuple [c], M_revision | M_tuple [c], M_undef | M_tuple [c], M_unknown_scalar - -> mcontext_lower c c2 - -(* | M_ref a, M_ref b -> mcontext_lower a b *) - - | _ -> false - -let mcontext_is_scalar = function - | M_unknown -> false - | c -> mcontext_lower c M_unknown_scalar - -let mcontext_to_scalar = function - | M_array -> M_int - | c -> if mcontext_is_scalar c then c else M_unknown_scalar - -let mcontext_merge_raw c1 c2 = - match c1, c2 with - | M_unknown, _ | _, M_unknown -> Some M_unknown - | M_unknown_scalar, c when mcontext_is_scalar c -> Some M_unknown_scalar - | c, M_unknown_scalar when mcontext_is_scalar c -> Some M_unknown_scalar - | M_mixed _, _ | _, M_mixed _ -> internal_error "mcontext_merge_raw" - | _ -> - if mcontext_lower c1 c2 then Some c2 else - if mcontext_lower c2 c1 then Some c1 else - if c1 = c2 then Some c1 else - None - -let rec mcontext_lmerge_add l = function - | M_mixed l2 -> List.fold_left mcontext_lmerge_add [] (l2 @ l) - | c -> - let rec add_to = function - | [] -> [c] - | M_mixed subl :: l -> add_to (subl @ l) - | c2 :: l -> - match mcontext_merge_raw c c2 with - | Some c' -> c' :: l - | None -> c2 :: add_to l - in add_to l - -let mcontext_lmerge l = - match List.fold_left mcontext_lmerge_add [] l with - | [] -> internal_error "mcontext_lmerge" - | [c] -> c - | l -> M_mixed l - -let mcontext_merge c1 c2 = mcontext_lmerge [ c1 ; c2 ] - -let mcontext_lmaybe esp = if esp.any = [] then [] else [esp.mcontext] - -let mcontext_check_raw wanted_mcontext mcontext = - if not (mcontext_lower mcontext wanted_mcontext) then - warn_rule [Warn_context] (sprintf "context %s is not compatible with context %s" (mcontext2s mcontext) (mcontext2s wanted_mcontext)) - -let mcontext_check wanted_mcontext esp = - (match wanted_mcontext with - | M_list | M_array | M_float | M_mixed [M_array; M_none] | M_tuple _ -> () - | _ -> - match un_parenthesize_full esp.any.expr with - | Call(Deref(I_func, Ident(None, "grep", _)), _) -> - warn_rule [Warn_suggest_simpler; Warn_help_perl_checker] (if wanted_mcontext = M_bool then - "in boolean context, use \"any\" instead of \"grep\"" else - "you may use \"find\" instead of \"grep\"") - | _ -> ()); - mcontext_check_raw wanted_mcontext esp.mcontext - -let mcontext_check_unop_l wanted_mcontext esp = - mcontext_check wanted_mcontext { esp with any = { esp.any with expr = List esp.any.expr } } - -let mcontext_check_non_none esp = - if esp.mcontext = M_none then warn_rule [Warn_context] "() context not accepted here" - -let mcontext_check_none msg expr esp = - let rec mcontext_check_none_rec msg expr = function - | M_none | M_unknown -> () - | M_mixed l when List.exists (fun c -> c = M_none) l -> () - | M_tuple l -> - (match expr with - | [Block [List l_expr]] - | [List l_expr] - | [List l_expr ; Semi_colon] -> - let rec iter = function - | e::l_expr, mcontext::l -> - mcontext_check_none_rec (if l = [] then msg else "value is dropped") [e] mcontext ; - iter (l_expr, l) - | [], [] -> () - | _ -> internal_error "mcontext_check_none" - in iter (un_parenthesize_full_l l_expr, l) - | _ -> internal_error "mcontext_check_none") - | _ -> - match expr with - | [List [Num("1", _)]; Semi_colon] -> () (* allow "1;" for package return value. It would be much better to check we are at toplevel, but hell i don't want to wire this information up to here *) - | [List [Call_op ("<>", [Ident (None, "STDIN", _)], _)]; Semi_colon] -> () (* allow to ask "press return" *) - | [List [Call(Deref(I_func, Ident(None, "map", _)), _)]; Semi_colon] -> warn_rule [Warn_void] "if you don't use the return value, use \"foreach\" instead of \"map\"" - | _ -> warn [Warn_void] esp.pos msg - in - mcontext_check_none_rec msg expr esp.mcontext - -(* only returns M_float when there is at least one float *) -let mcontext_float_or_int l = - List.iter (mcontext_check_raw M_float) l; - if List.mem M_float l then M_float else M_int - -let mcontext_op_assign left right = - mcontext_check_non_none right; - - let left_mcontext = - match left.mcontext with - | M_mixed [ c ; M_none ] -> c - | c -> c - in - - let wanted_mcontext = match left_mcontext with - | M_array -> M_list - | M_hash -> M_mixed [ M_hash ; M_list ] - | m -> m - in - mcontext_check wanted_mcontext right; - - let return_mcontext = - match left_mcontext with - | M_tuple _ -> M_array - | c -> c - in - mcontext_merge return_mcontext M_none - -let mtuple_context_concat c1 c2 = - match c1, c2 with - | M_array, _ | _, M_array - | M_hash, _ | _, M_hash -> M_list - | M_tuple l, _ -> M_tuple (l @ [c2]) - | _ -> M_tuple [c1 ; c2] - -let call_op_if_infix left right esp_start esp_end = - (match left, right with - | List [Call_op("=", [Deref(context, _); _], _)], _ when non_scalar_context context -> () - | List [Call_op("=", [v; _], _)], - List [Call_op("not", [v'], _)] when is_same_fromparser v v' -> - warn_rule [Warn_suggest_simpler] "\"$foo = ... if !$foo\" can be written \"$foo ||= ...\"" - | _ -> ()); - - mcontext_check_none "value is dropped" [left] esp_start; - (match right with - | List [ Num("0", _)] -> () (* allow my $x if 0 *) - | _ -> check_My_under_condition "replace \"my $foo = ... if \" with \"my $foo = && ...\"" left); - - let pos = raw_pos_range esp_start esp_end in - new_any M_none (Call_op("if infix", [ left ; right], raw_pos2pos pos)) esp_start.spaces pos - -let call_op_unless_infix left right esp_start esp_end = - (match left, right with - | List [Call_op("=", [Deref(context, _); _], _)], _ when non_scalar_context context -> () - | List [Call_op("=", [v; _], _)], List [v'] when is_same_fromparser v v' -> - warn_rule [Warn_suggest_simpler] "\"$foo = ... unless $foo\" can be written \"$foo ||= ...\"" - | _ -> ()); - (match right with - | List [Call_op(op, _, _)] -> - (match op with - | "&&" | "||" | "not" | "ne" | "?:" -> warn_rule [Warn_complex_expressions] "don't use \"unless\" when the condition is complex, use \"if\" instead" - | _ -> ()); - | _ -> ()); - - mcontext_check_none "value is dropped" [left] esp_start; - check_My_under_condition "replace \"my $foo = ... unless \" with \"my $foo = ! && ...\"" left; - - let pos = raw_pos_range esp_start esp_end in - new_any M_none (Call_op("unless infix", [ left ; right], raw_pos2pos pos)) esp_start.spaces pos - -let symops pri para_context return_context op_str left op right = - sp_same op right; - let skip_context_check = - (op_str = "==" || op_str = "!=") && (match left.any.expr, right.any.expr with - | Deref(I_array, _), List [] -> true (* allow @l == () and @l != () *) - | _ -> false) - in - if op_str <> "==" && op_str <> "!=" && para_context = M_float then - (match un_parenthesize_full left.any.expr with - | Call_op("last_array_index", _, _) -> warn_rule [Warn_complex_expressions] "change your expression to use @xxx instead of $#xxx" - | _ -> ()); - - if not skip_context_check then - (mcontext_check para_context left ; mcontext_check para_context right) ; - to_Call_op_ return_context pri op_str [prio_lo pri left; prio_lo_after pri right] left right diff --git a/perl_checker.src/parser_helper.mli b/perl_checker.src/parser_helper.mli deleted file mode 100644 index e820703..0000000 --- a/perl_checker.src/parser_helper.mli +++ /dev/null @@ -1,314 +0,0 @@ -val bpos : int * int -val raw_pos2pos : 'a * 'b -> string * 'a * 'b -val raw_pos_range : - 'a Types.any_spaces_pos -> 'b Types.any_spaces_pos -> int * int -val pos_range : - 'a Types.any_spaces_pos -> 'b Types.any_spaces_pos -> string * int * int -val get_pos : 'a Types.any_spaces_pos -> string * int * int -val get_pos_start : 'a Types.any_spaces_pos -> int -val get_pos_end : 'a Types.any_spaces_pos -> int -val var_dollar_ : Types.pos -> Types.fromparser -val var_STDOUT : Types.fromparser -val new_any : - Types.maybe_context -> - 'a -> Types.spaces -> int * int -> 'a Types.any_spaces_pos -val new_any_ : 'a -> Types.spaces -> int * int -> 'a Types.any_spaces_pos -val new_esp : - Types.maybe_context -> - 'a -> - 'b Types.any_spaces_pos -> - 'c Types.any_spaces_pos -> 'a Types.any_spaces_pos -val new_1esp : 'a -> 'b Types.any_spaces_pos -> 'a Types.any_spaces_pos -val new_pesp : - Types.maybe_context -> - Types.priority -> - 'a -> - 'b Types.any_spaces_pos -> - 'c Types.any_spaces_pos -> 'a Types.prio_anyexpr Types.any_spaces_pos -val new_1pesp : - Types.priority -> - 'a -> 'b Types.any_spaces_pos -> 'a Types.prio_anyexpr Types.any_spaces_pos -val default_esp : 'a -> 'a Types.any_spaces_pos -val default_pesp : - Types.priority -> 'a -> 'a Types.prio_anyexpr Types.any_spaces_pos -val split_name_or_fq_name : string -> string option * string -val is_var_dollar_ : Types.fromparser -> bool -val is_var_number_match : Types.fromparser -> bool -val non_scalar_context : Types.context -> bool -val is_scalar_context : Types.context -> bool -val is_not_a_scalar : Types.fromparser -> bool -val is_a_scalar : Types.fromparser -> bool -val is_a_string : Types.fromparser -> bool -val is_parenthesized : Types.fromparser -> bool -val un_parenthesize : Types.fromparser -> Types.fromparser -val un_parenthesize_full : Types.fromparser -> Types.fromparser -val un_parenthesize_full_l : Types.fromparser list -> Types.fromparser list -val is_always_true : Types.fromparser -> bool -val is_always_false : Types.fromparser -> bool -val is_lvalue : Types.fromparser -> bool -val not_complex : Types.fromparser -> bool -val not_simple : Types.fromparser -> bool -val context2s : Types.context -> string -val variable2s : Types.context * string -> string -val string_of_fromparser : Types.fromparser -> string -val lstring_of_fromparser : Types.fromparser list -> string -val lstring_of_fromparser_parentheses : Types.fromparser list -> string -val is_same_fromparser : Types.fromparser -> Types.fromparser -> bool -val from_scalar : Types.fromparser Types.any_spaces_pos -> Types.fromparser -val from_array : Types.fromparser Types.any_spaces_pos -> Types.fromparser -val get_pos_from_expr : Types.fromparser -> Types.pos -val msg_with_rawpos : int * int -> string -> string -val die_with_rawpos : int * int -> string -> 'a -val warn : Types.warning list -> int * int -> string -> unit -val die_rule : string -> 'a -val warn_rule : Types.warning list -> string -> unit -val warn_verb : Types.warning list -> int -> string -> unit -val warn_too_many_space : int -> unit -val warn_no_space : int -> unit -val warn_cr : int -> unit -val warn_space : int -> unit -val prio_less : Types.priority * Types.priority -> bool -val prio_lo_check : - Types.priority -> Types.priority -> int * int -> Types.fromparser -> unit -val prio_lo : - Types.priority -> - Types.fromparser Types.prio_anyexpr Types.any_spaces_pos -> - Types.fromparser -val prio_lo_after : - Types.priority -> - Types.fromparser Types.prio_anyexpr Types.any_spaces_pos -> - Types.fromparser -val prio_lo_concat : - Types.fromparser Types.prio_anyexpr Types.any_spaces_pos -> - Types.fromparser -val hash_ref : - Types.fromparser Types.prio_anyexpr Types.any_spaces_pos -> - Types.fromparser -val sp_0 : 'a Types.any_spaces_pos -> unit -val sp_0_or_cr : 'a Types.any_spaces_pos -> unit -val sp_1 : 'a Types.any_spaces_pos -> unit -val sp_n : 'a Types.any_spaces_pos -> unit -val sp_p : 'a Types.any_spaces_pos -> unit -val sp_cr : 'a Types.any_spaces_pos -> unit -val sp_same : 'a Types.any_spaces_pos -> 'b Types.any_spaces_pos -> unit -val function_to_context : bool -> string -> Types.maybe_context -val word_alone : - Types.fromparser Types.any_spaces_pos -> - Types.fromparser Types.prio_anyexpr Types.any_spaces_pos -val check_parenthesized_first_argexpr : - string -> - Types.fromparser list Types.prio_anyexpr Types.any_spaces_pos -> unit -val check_parenthesized_first_argexpr_with_Ident : - Types.fromparser -> - Types.fromparser list Types.prio_anyexpr Types.any_spaces_pos -> unit -val check_hash_subscript : - Types.fromparser Types.prio_anyexpr Types.any_spaces_pos -> unit -val check_arrow_needed : 'a Types.any_spaces_pos -> Types.fromparser -> unit -val check_scalar_subscripted : Types.fromparser Types.any_spaces_pos -> unit -val negatable_ops : (string * string) list -val check_negatable_expr : - Types.fromparser Types.prio_anyexpr Types.any_spaces_pos -> unit -val check_ternary_paras : - Types.fromparser * Types.fromparser * Types.fromparser -> - Types.fromparser list -val check_unneeded_var_dollar_ : - Types.fromparser Types.prio_anyexpr Types.any_spaces_pos -> unit -val check_unneeded_var_dollar_not : - Types.fromparser Types.prio_anyexpr Types.any_spaces_pos -> unit -val check_unneeded_var_dollar_s : - Types.fromparser Types.prio_anyexpr Types.any_spaces_pos -> unit -val check_my : string Types.any_spaces_pos -> unit -val check_foreach : string Types.any_spaces_pos -> unit -val check_for : string Types.any_spaces_pos -> unit -val check_for_foreach : - string Types.any_spaces_pos -> - Types.fromparser Types.prio_anyexpr Types.any_spaces_pos -> unit -val check_block_expr : - bool -> - Types.fromparser -> - 'a Types.any_spaces_pos -> 'b Types.any_spaces_pos -> unit -val check_block_lines : - (Types.fromparser list * bool) Types.any_spaces_pos -> - 'a Types.any_spaces_pos -> unit -val check_unless_else : - 'a list Types.any_spaces_pos -> 'b list Types.any_spaces_pos -> unit -val check_my_our_paren : - ((bool * 'a) * 'b list) Types.any_spaces_pos -> - 'c Types.any_spaces_pos -> unit -val check_simple_pattern : Types.fromparser list -> unit -val only_one : Types.fromparser list Types.any_spaces_pos -> Types.fromparser -val only_one_array_ref : - Types.fromparser list Types.any_spaces_pos -> Types.fromparser -val only_one_in_List : - Types.fromparser Types.prio_anyexpr Types.any_spaces_pos -> - Types.fromparser -val is_only_one_in_List : Types.fromparser list -> bool -val maybe_to_Raw_string : Types.fromparser -> Types.fromparser -val to_List : Types.fromparser list -> Types.fromparser -val deref_arraylen : Types.fromparser -> Types.fromparser -val deref_raw : Types.context -> Types.fromparser -> Types.fromparser -val to_Ident : - (string option * string) Types.any_spaces_pos -> Types.fromparser -val to_Raw_string : string Types.any_spaces_pos -> Types.fromparser -val to_Method_call : - Types.fromparser * Types.fromparser * Types.fromparser list -> - Types.fromparser -val to_Deref_with : - Types.context * Types.context * Types.fromparser * Types.fromparser -> - Types.fromparser -val to_Deref_with_arrow : - 'a Types.any_spaces_pos -> - Types.context * Types.context * Types.fromparser * Types.fromparser -> - Types.fromparser -val lines_to_Block : - (Types.fromparser list * bool) Types.any_spaces_pos -> - 'a Types.any_spaces_pos -> Types.fromparser -val to_Local : - Types.fromparser Types.prio_anyexpr Types.any_spaces_pos -> - Types.fromparser -val sub_declaration : - Types.fromparser * string option -> - Types.fromparser list -> Types.sub_declaration_kind -> Types.fromparser -val anonymous_sub : - string option -> - (Types.fromparser list * bool) Types.any_spaces_pos -> - 'a Types.any_spaces_pos -> Types.fromparser -val call_with_same_para_special : Types.fromparser -> Types.fromparser -val remove_call_with_same_para_special : Types.fromparser -> Types.fromparser -val check_My_under_condition : string -> Types.fromparser -> unit -val cook_call_op : - string -> Types.fromparser list -> int * int -> Types.fromparser -val to_Call_op : - Types.maybe_context -> - string -> - Types.fromparser list -> - 'a Types.any_spaces_pos -> - 'b Types.any_spaces_pos -> Types.fromparser Types.any_spaces_pos -val to_Call_op_ : - Types.maybe_context -> - Types.priority -> - string -> - Types.fromparser list -> - 'a Types.any_spaces_pos -> - 'b Types.any_spaces_pos -> - Types.fromparser Types.prio_anyexpr Types.any_spaces_pos -val to_Call_assign_op_ : - Types.maybe_context -> - Types.priority -> - string -> - Types.fromparser -> - Types.fromparser -> - 'a Types.any_spaces_pos -> - 'b Types.any_spaces_pos -> - Types.fromparser Types.prio_anyexpr Types.any_spaces_pos -val followed_by_comma : - Types.fromparser list -> bool -> Types.fromparser list -val pot_strings : (string, (string * int * int) * string list) Hashtbl.t -val po_comments : string list ref -val po_comment : string Types.any_spaces_pos -> unit -val check_format_a_la_printf : string -> int -> Types.maybe_context list -val generate_pot : string -> unit -val check_system_call : string list -> unit -val call_raw : - bool -> Types.fromparser * Types.fromparser list -> Types.fromparser -val call : Types.fromparser * Types.fromparser list -> Types.fromparser -val check_return : - Types.fromparser Types.any_spaces_pos -> - Types.fromparser list Types.prio_anyexpr Types.any_spaces_pos -> unit -val call_and_context : - Types.fromparser * Types.fromparser list -> - bool -> - Types.priority -> - 'a Types.any_spaces_pos -> - 'b Types.any_spaces_pos -> - Types.fromparser Types.prio_anyexpr Types.any_spaces_pos -val call_no_paren : - Types.fromparser Types.any_spaces_pos -> - Types.fromparser list Types.prio_anyexpr Types.any_spaces_pos -> - Types.fromparser Types.prio_anyexpr Types.any_spaces_pos -val call_with_paren : - Types.fromparser Types.any_spaces_pos -> - Types.fromparser list Types.prio_anyexpr Types.any_spaces_pos -> - Types.fromparser Types.prio_anyexpr Types.any_spaces_pos -val call_func : - Types.fromparser Types.any_spaces_pos -> - Types.fromparser list Types.prio_anyexpr Types.any_spaces_pos -> - Types.fromparser Types.prio_anyexpr Types.any_spaces_pos -val call_one_scalar_para : - Types.priority -> - string Types.any_spaces_pos -> - Types.fromparser list -> - 'a Types.any_spaces_pos -> - 'b Types.any_spaces_pos -> - Types.fromparser Types.prio_anyexpr Types.any_spaces_pos -val current_lexbuf : Lexing.lexbuf option ref -val list2tokens : ((int * int) * 'a) list -> Lexing.lexbuf -> 'a -val parse_tokens : - ((Lexing.lexbuf -> 'a) -> Lexing.lexbuf -> 'b list) -> - ((int * int) * 'a) list -> Lexing.lexbuf option -> 'b list -val parse_interpolated : - ((Lexing.lexbuf -> 'a) -> Lexing.lexbuf -> Types.fromparser list) -> - (string * ((int * int) * 'a) list) list -> (string * Types.fromparser) list -val to_String : - ((Lexing.lexbuf -> 'a) -> Lexing.lexbuf -> Types.fromparser list) -> - bool -> - (string * ((int * int) * 'a) list) list Types.any_spaces_pos -> - Types.fromparser -val from_PATTERN : - ((Lexing.lexbuf -> 'a) -> Lexing.lexbuf -> Types.fromparser list) -> - ((string * ((int * int) * 'a) list) list * string) Types.any_spaces_pos -> - Types.fromparser list -val from_PATTERN_SUBST : - ((Lexing.lexbuf -> 'a) -> Lexing.lexbuf -> Types.fromparser list) -> - ((string * ((int * int) * 'a) list) list * - (string * ((int * int) * 'a) list) list * string) - Types.any_spaces_pos -> Types.fromparser list -val mcontext2s : Types.maybe_context -> string -val mcontext_lower : Types.maybe_context -> Types.maybe_context -> bool -val mcontext_is_scalar : Types.maybe_context -> bool -val mcontext_to_scalar : Types.maybe_context -> Types.maybe_context -val mcontext_merge_raw : - Types.maybe_context -> Types.maybe_context -> Types.maybe_context option -val mcontext_lmerge_add : - Types.maybe_context list -> Types.maybe_context -> Types.maybe_context list -val mcontext_lmerge : Types.maybe_context list -> Types.maybe_context -val mcontext_merge : - Types.maybe_context -> Types.maybe_context -> Types.maybe_context -val mcontext_lmaybe : - 'a list Types.any_spaces_pos -> Types.maybe_context list -val mcontext_check_raw : Types.maybe_context -> Types.maybe_context -> unit -val mcontext_check : - Types.maybe_context -> - Types.fromparser Types.prio_anyexpr Types.any_spaces_pos -> unit -val mcontext_check_unop_l : - Types.maybe_context -> - Types.fromparser list Types.prio_anyexpr Types.any_spaces_pos -> unit -val mcontext_check_non_none : 'a Types.any_spaces_pos -> unit -val mcontext_check_none : - string -> Types.fromparser list -> 'a Types.any_spaces_pos -> unit -val mcontext_float_or_int : Types.maybe_context list -> Types.maybe_context -val mcontext_op_assign : - 'a Types.any_spaces_pos -> - Types.fromparser Types.prio_anyexpr Types.any_spaces_pos -> - Types.maybe_context -val mtuple_context_concat : - Types.maybe_context -> Types.maybe_context -> Types.maybe_context -val call_op_if_infix : - Types.fromparser -> - Types.fromparser -> - 'a Types.any_spaces_pos -> - 'b Types.any_spaces_pos -> Types.fromparser Types.any_spaces_pos -val call_op_unless_infix : - Types.fromparser -> - Types.fromparser -> - 'a Types.any_spaces_pos -> - 'b Types.any_spaces_pos -> Types.fromparser Types.any_spaces_pos -val symops : - Types.priority -> - Types.maybe_context -> - Types.maybe_context -> - string -> - Types.fromparser Types.prio_anyexpr Types.any_spaces_pos -> - 'a Types.any_spaces_pos -> - Types.fromparser Types.prio_anyexpr Types.any_spaces_pos -> - Types.fromparser Types.prio_anyexpr Types.any_spaces_pos diff --git a/perl_checker.src/perl_checker.html.pl b/perl_checker.src/perl_checker.html.pl deleted file mode 100644 index e90d2eb..0000000 --- a/perl_checker.src/perl_checker.html.pl +++ /dev/null @@ -1,168 +0,0 @@ -$s = <<'EOF'; -perl_checker -

Goals of perl_checker

- -
    -
  • for beginners in perl: - based on what the programmer is writing, -
      -
    • suggest better or more standard ways to do the same -
    • detect wrong code -
      - => a kind of automatic teacher -
    - -
  • for senior programmers: - detect typos, unused variables, check number - of parameters, global analysis to check method calls... - -
  • enforce the same perl style by enforcing a subset of perl of features. - In perl There is more than one way to do it. - In perl_checker's subset of Perl, there is not too many ways to do it. - This is especially useful for big projects. - (NB: the subset is chosen to keep a good expressivity) -
- -

Compared to Perl-Critic - -
    -
  • perl_checker use its own OCaml-written perl parser, which is in no way as robust as PPI. - A PPI require is to be able to parse non finished perl documents. - perl_checker is a checker, and it is not a big deal to die horribly on a weird perl expression, telling the programmer what to write instead. - -
  • perl_checker is much faster (more than 100 times) (ML pattern matching rulez) - -
  • perl_checker checks a lot more things than perlcritic: undeclared variables, unknown functions, unknown methods... - -
  • and of course perl_checker checks are different from the Conways's Perl Best Practices -
- -

Get it

- -CVS source - -

Implemented features

- -
-
white space normalization -
enforce a similar coding style. In many languages you can find a coding - style document (eg: the GNU one). - - TESTS=force_layout.t - -
-
disallow complex expressions -
perl_checker try to ban some weird-not-used-a-lot features. - - TESTS=syntax_restrictions.t - -
-
suggest simpler expressions -
when there is a simpler way to write an expression, suggest it. It can - also help detecting errors. - - TESTS=suggest_better.t - -
-
context checks -
Perl has types associated with variables names, the so-called "context". - Some expressions mixing contexts are stupid, perl_checker detects them. - - TESTS=context.t - -
-
function call check -
detection of unknown functions or mismatching prototypes (warning: since - perl is a dynamic language, some spurious warnings may occur when a function - is defined using stashes). - - TESTS=prototype.t - -
-
method call check -
detection of unknown methods or mismatching prototypes. perl_checker - doesn't have any idea what the object type is, it simply checks if a method - with that name and that number of parameters exists. - - TESTS=method.t - -
-
return value check -
dropping the result of a functionnally pure function is stupid. - using the result of a function returning void is stupid too. - - TESTS=return_value.t - -
-
detect some Perl traps -
some Perl expressions are stupid, and one gets a warning when running - them with perl -w. The drawback are perl -w is the lack of - code coverage, it only detects expressions which are evaluated. - - TESTS=various_errors.t - -
- -

Todo

- -Functionalities that would be nice: -
    -
  • add flow analysis -
  • maybe a "soft typing" type analysis -
  • detect places where imperative code can be replaced with - functional code (already done for some simple loops) -
  • check the number of returned values when checking prototype compliance -
-EOF - -my $_rationale = <<'EOF'; -

Rationale

- -Perl is a big language, there is ThereIsMoreThanOneWayToDoIt. -It has advantages but also some drawbacks for team project: -
    -
  • it is hard to learn every special rules. Automatically enforced syntax - coding rules help learning incrementally -EOF - -use lib ('test', '..'); -use read_t; -sub get_example { - my ($file) = @_; - my @tests = read_t::read_t("test/$file"); - $file =~ s|test/||; - qq(

    \n) . - join('', map { - my $lines = join("
    ", map { "" . html_quote($_) . "" } @{$_->{lines}}); - my $logs = join("
    ", map { html_quote($_) } @{$_->{logs}}); - " \n"; - } @tests) . - "
    \n", $lines, "", $logs, "
    \n"; -} - -sub anchor_to_examples { - my ($s) = @_; - $s =~ s!TESTS=(\S+)!(examples)!g; - $s; -} -sub fill_in_examples { - my ($s) = @_; - $s =~ s!TESTS=(\S+)!get_example($1)!ge; - $s; -} - -$s =~ s!

    Implemented features

    (.*)

    ! - "

    Implemented features

    " . anchor_to_examples($1) . - "

    Examples

    " . fill_in_examples($1) . - "

    "!se; - -print $s; - -sub html_quote { - local $_ = $_[0]; - s//>/g; - s/^(\s*)/" " x length($1)/e; - $_; -} diff --git a/perl_checker.src/perl_checker.ml b/perl_checker.src/perl_checker.ml deleted file mode 100644 index 4459e30..0000000 --- a/perl_checker.src/perl_checker.ml +++ /dev/null @@ -1,183 +0,0 @@ -open Types -open Common -open Tree -open Global_checks - -let search_basedir file_name nb = - let dir = Filename.dirname file_name in - let config = Config_file.read dir in - let nb = some_or config.Config_file.basedir nb in - updir dir nb - -let basedir = ref "" -let set_basedir per_files file = - if !basedir = "" then - let nb = List.length (split_at2 ':'':' (List.hd file.packages).package_name) - 1 in - let dir = search_basedir file.file_name nb in - lpush Tree.use_lib dir ; - Config_file.read_any dir 1 ; - read_packages_from_cache per_files dir ; - if !Flags.verbose then print_endline_flush ("basedir is " ^ dir); - basedir := dir - -let rec parse_file from_basedir require_name per_files file = - try - if !Flags.verbose then print_endline_flush ("parsing " ^ file) ; - let build_time = Unix.time() in - let command = - match !Flags.expand_tabs with - | Some width -> "expand -t " ^ string_of_int width - | None -> "cat" in - let channel = Unix.open_process_in (Printf.sprintf "%s \"%s\"" command file) in - let lexbuf = Lexing.from_channel channel in - try - Info.start_a_new_file file ; - let tokens = Lexer.get_token Lexer.token lexbuf in - if not Build.debugging then ignore (Unix.close_process_in channel) ; - let t = Parser_helper.parse_tokens Parser.prog tokens (Some lexbuf) in - let per_file = get_global_info_from_package from_basedir require_name build_time t in - set_basedir per_files per_file ; - Global_checks.add_file_to_files per_files per_file ; - - let required_packages = collect (fun package -> package.required_packages) per_file.packages in - required_packages, per_files - with Failure s -> ( - print_endline_flush s ; - exit 1 - ) - with - | Not_found -> internal_error "runaway Not_found" - -and parse_package_if_needed per_files (package_name, pos) = - if List.mem package_name !Config_file.ignored_packages then [], per_files else - let splitted = split_at2 ':'':' package_name in - let rel_file = String.concat "/" splitted ^ ".pm" in - - (*print_endline_flush ("wondering about " ^ package_name) ;*) - try - let dir = findfile (Build.fake_packages_dir :: !use_lib) rel_file in - let file = Info.file_to_absolute_file (dir ^ "/" ^ rel_file) in - Config_file.read_any (Filename.dirname file) (List.length splitted) ; - let already_done = - try - let per_file = Hashtbl.find per_files file in - Some (collect (fun pkg -> pkg.required_packages) per_file.packages) - with Not_found -> None in - match already_done with - | Some required_packages -> required_packages, per_files - | None -> parse_file (dir = !basedir) (Some package_name) per_files file - with Not_found -> - print_endline_flush (Info.pos2sfull pos ^ Printf.sprintf "can't find package %s" package_name) ; - [], per_files - -let rec parse_required_packages state already_done = function - | [] -> state, already_done - | e :: l -> - if List.mem e already_done then - parse_required_packages state already_done l - else - let el, state = parse_package_if_needed state e in - parse_required_packages state (e :: already_done) (el @ l) - - -let parse_options = - let args_r = ref [] in - let restrict_to_files = ref false in - - let pot_file = ref "" in - let package_dependencies_graph_file = ref "" in - let generate_pot_chosen file = - Flags.generate_pot := true ; - Flags.expand_tabs := None ; - pot_file := file - in - let options = [ - "-v", Arg.Set Flags.verbose, " be verbose" ; - "-q", Arg.Set Flags.quiet, " be quiet" ; - "-t", Arg.Int (fun i -> Flags.expand_tabs := Some i), " set the tabulation width (default is 8)" ; - "--restrict-to-files", Arg.Set restrict_to_files, " only display warnings concerning the file(s) given on command line" ; - "--no-cache", Arg.Set Flags.no_cache, " do not use cache" ; - "--generate-pot", Arg.String generate_pot_chosen, "" ; - "--generate-package-dependencies-graph", Arg.String (fun f -> package_dependencies_graph_file := f), - "\n" ; - - "--check-unused-global-vars", Arg.Set Flags.check_unused_global_vars, " disable unused global functions & variables check" ^ - "\nBasic warnings:"; - "--no-check-white-space", Arg.Clear Flags.check_white_space, " disable white space check" ; - "--no-suggest-simpler", Arg.Clear Flags.check_suggest_simpler, " disable simpler code suggestion" ; - "--no-suggest-functional", Arg.Clear Flags.suggest_functional, " disable Functional Programming suggestions" ^ - "\nNormalisation warnings:"; - "--no-check-strange", Arg.Clear Flags.check_strange, " disable strange code check" ; - "--no-check-complex-expressions", Arg.Clear Flags.check_complex_expressions, " disable complex expressions check" ; - "--no-check-normalized-expressions", Arg.Clear Flags.normalized_expressions, " don't warn about non normalized expressions" ; - "--no-help-perl-checker", Arg.Clear Flags.check_help_perl_checker, " beware, perl_checker doesn't understand all perl expressions, so those warnings *are* important" ^ - "\nCommon warnings:"; - "--no-check-void", Arg.Clear Flags.check_void, " disable dropped value check" ; - "--no-check-names", Arg.Clear Flags.check_names, " disable variable & function usage check" ; - "--no-check-prototypes", Arg.Clear Flags.check_prototypes, " disable prototypes check" ; - "--no-check-import-export", Arg.Clear Flags.check_import_export, " disable inter modules check" ^ - "\nImportant warnings:"; - "--no-check-context", Arg.Clear Flags.check_context, " disable context check" ; - "--no-check-traps", Arg.Clear Flags.check_traps, " disable traps (errors) check" ^ - "\n"; - - ] in - let usage = "Usage: perl_checker [] \nOptions are:" in - Arg.parse options (lpush args_r) usage; - - let files = if !args_r = [] && Build.debugging then ["../t.pl"] else !args_r in - let files = List.map Info.file_to_absolute_file files in - - let required_packages, per_files = collect_withenv (parse_file true None) (default_per_files()) files in - let required_packages = uniq_ (fun (a,_) (b,_) -> a = b) required_packages in - - if !Flags.generate_pot then Parser_helper.generate_pot !pot_file else ( - - let per_files, required_packages = - fluid_let Flags.quiet (!restrict_to_files || !Flags.quiet) - (fun () -> - parse_required_packages per_files [] required_packages) in - let l_required_packages = List.map fst required_packages in - - write_packages_cache per_files !basedir ; - - (* removing non needed files from per_files (those files come from the cache) *) - List.iter (fun k -> - let per_file = Hashtbl.find per_files k in - if per_file.require_name <> None && not (List.mem (some per_file.require_name) l_required_packages) && not (List.mem per_file.file_name files) then - Hashtbl.remove per_files k - ) (hashtbl_keys per_files); - - let state = default_state per_files in - - Hashtbl.iter (fun _ per_file -> List.iter (add_package_to_state state) per_file.packages) per_files ; - - let state = - let global_vars_declared = Hashtbl.create 16 in - let package_name_to_file_name = hashtbl_collect (fun _ per_file -> List.map (fun pkg -> pkg.package_name, per_file.file_name) per_file.packages) per_files in - Hashtbl.iter (fun _ pkg -> - let file_name = List.assoc pkg.package_name package_name_to_file_name in - fluid_let Flags.quiet (!restrict_to_files || !Flags.quiet) - (fun () -> get_vars_declaration global_vars_declared file_name pkg) - ) state.per_packages ; - arrange_global_vars_declared global_vars_declared state - in - - let state = Global_checks.get_methods_available state in - - let l = hashtbl_values per_files in - let l = if !restrict_to_files then List.filter (fun file -> List.mem file.file_name files) l else l in - - let l = uniq (collect (fun file -> List.map (fun pkg -> pkg.package_name) file.packages) l) in - let l = List.map (Hashtbl.find state.per_packages) l in - - (* HACK: skip ignored_packages. Some package may have appeared in ignored_packages due to the xs bootstrap hack *) - let l = List.filter (fun pkg -> not (List.mem pkg.package_name !Config_file.ignored_packages)) l in - - List.iter (Global_checks.check_tree state) l; - - if !Flags.check_unused_global_vars then List.iter Global_checks.check_unused_vars l; - - if !package_dependencies_graph_file <> "" then generate_package_dependencies_graph state !package_dependencies_graph_file - - ) diff --git a/perl_checker.src/perl_checker.mli b/perl_checker.src/perl_checker.mli deleted file mode 100644 index 8b13789..0000000 --- a/perl_checker.src/perl_checker.mli +++ /dev/null @@ -1 +0,0 @@ - diff --git a/perl_checker.src/print.ml b/perl_checker.src/print.ml deleted file mode 100644 index e69de29..0000000 diff --git a/perl_checker.src/print.mli b/perl_checker.src/print.mli deleted file mode 100644 index 8b13789..0000000 --- a/perl_checker.src/print.mli +++ /dev/null @@ -1 +0,0 @@ - diff --git a/perl_checker.src/test/.cvsignore b/perl_checker.src/test/.cvsignore deleted file mode 100644 index 9f6633c..0000000 --- a/perl_checker.src/test/.cvsignore +++ /dev/null @@ -1,2 +0,0 @@ -.pl -.perl_checker.cache diff --git a/perl_checker.src/test/Makefile b/perl_checker.src/test/Makefile deleted file mode 100644 index abe816c..0000000 --- a/perl_checker.src/test/Makefile +++ /dev/null @@ -1,3 +0,0 @@ - -test: - for i in *.t; do ./test_it $$i || exit 1; done diff --git a/perl_checker.src/test/context.t b/perl_checker.src/test/context.t deleted file mode 100644 index 081abcc..0000000 --- a/perl_checker.src/test/context.t +++ /dev/null @@ -1,41 +0,0 @@ -foreach (%h) {} context hash is not compatible with context list - foreach with a hash is usually an error - -map { 'xxx' } %h a hash is not a valid parameter to function map - -$xxx = ('yyy', 'zzz') context tuple(string, string) is not compatible with context scalar - -@l ||= 'xxx' "||=" is only useful with a scalar - -length @l never use "length @l", it returns the length of the string int(@l) - -%h . 'yyy' context hash is not compatible with context string - -'xxx' > 'yyy' context string is not compatible with context float - context string is not compatible with context float - - -1 cmp 2 you should use a number operator, not the string operator "cmp" (or replace the number with a string) - -$xxx == undef context undef is not compatible with context float - -my ($xxx) = 1 context int is not compatible with context tuple(scalar) - -($xxx, $yyy) = 1 context int is not compatible with context tuple(scalar, scalar) - -($xxx, $yyy) = (1, 2, 3) context tuple(int, int, int) is not compatible with context tuple(scalar, scalar) - -@l eq '3' context array is not compatible with context string - -qw(a b) > 2 context tuple(string, string) is not compatible with context float - -%h > 0 context hash is not compatible with context float - -%h eq 0 context hash is not compatible with context string - you should use a number operator, not the string operator "eq" (or replace the number with a string) - -@l == () - -$xxx = { xxx() }->{xxx}; - -$xxx = { xxx() }->{$xxx}; diff --git a/perl_checker.src/test/force_layout.t b/perl_checker.src/test/force_layout.t deleted file mode 100644 index bb5494e..0000000 --- a/perl_checker.src/test/force_layout.t +++ /dev/null @@ -1,23 +0,0 @@ -sub xxx you should not have a carriage-return (\n) here -{} - -xxx you should not have a carriage-return (\n) here - ($xxx); - -xxx( $xxx) you should not have a space here - -$xxx ++ you should not have a space here - -my($_xxx, $_yyy) you should have a space here - -xxx ($xxx) you should not have a space here - -'foo'.'bar' you should have a space here - -if ($xxx) { missing ";" - xxx() -} - -if ($xxx) { unneeded ";" - xxx(); -}; diff --git a/perl_checker.src/test/method.t b/perl_checker.src/test/method.t deleted file mode 100644 index e59e858..0000000 --- a/perl_checker.src/test/method.t +++ /dev/null @@ -1,11 +0,0 @@ -bad->yyy unknown package bad - -pkg->bad unknown method bad starting in package pkg - -$xxx->bad unknown method bad - -$xxx->m1 not enough parameters - -$xxx->m0('zzz') too many parameters - -$xxx->m0_or_2('zzz') not enough or too many parameters diff --git a/perl_checker.src/test/prototype.t b/perl_checker.src/test/prototype.t deleted file mode 100644 index 6e56aae..0000000 --- a/perl_checker.src/test/prototype.t +++ /dev/null @@ -1,23 +0,0 @@ - -sub xxx { 'yyy' } if the function doesn't take any parameters, please use the empty prototype. - example "sub foo() { ... }" - -sub xxx { an non-optional argument must not follow an optional argument - my ($o_xxx, $yyy) = @_; - ($o_xxx, $yyy); -} - -sub xxx { an array must be the last variable in a prototype - my (@xxx, $yyy) = @_; - @xxx, $yyy; -} - -bad() unknown function bad - -sub f0() {} too many parameters -f0('yyy') - -sub f2 { my ($x, $_y) = @_; $x } not enough parameters -f2('yyy') - -N("xxx %s yyy") not enough parameters diff --git a/perl_checker.src/test/read_t.pm b/perl_checker.src/test/read_t.pm deleted file mode 100644 index a07c041..0000000 --- a/perl_checker.src/test/read_t.pm +++ /dev/null @@ -1,28 +0,0 @@ -package read_t; - -use lib '../..'; -use MDK::Common; - -sub read_t { - my ($file) = @_; - - my @tests; - my ($column_width, $line_number, @lines, @logs); - foreach (cat_($file), "\n") { - if (/^$/) { - push @tests, { line_number => $line_number, lines => [ @lines ], logs => [ @logs ] } if @lines; - @lines = @logs = (); - } else { - $column_width ||= length(first(/(.{20}\s+)/)); - my ($line, $log) = $column_width > 25 && /(.{$column_width})(.*)/ ? (chomp_($1) . "\n", $2) : ($_, ''); - $line =~ s/[ \t]*$//; - push @lines, $line; - push @logs, $log; - } - $line_number++; - } - @tests; -} - -1; - diff --git a/perl_checker.src/test/return_value.t b/perl_checker.src/test/return_value.t deleted file mode 100644 index b4786f5..0000000 --- a/perl_checker.src/test/return_value.t +++ /dev/null @@ -1,23 +0,0 @@ -if ($xxx or $yyy) {} value should be dropped - context () is not compatible with context bool - -if ($xxx and $yyy) {} value should be dropped - context () is not compatible with context bool - -$xxx && yyy(); value is dropped - -`xxx`; value is dropped - -/(.*)/; value is dropped - -'xxx'; value is dropped - -'xxx' if $xxx; value is dropped - -map { xxx($_) } @l; if you don't use the return value, use "foreach" instead of "map" - -$xxx = chomp; () context not accepted here - context () is not compatible with context scalar - -$xxx = push @l, 1 () context not accepted here - context () is not compatible with context scalar diff --git a/perl_checker.src/test/suggest_better.t b/perl_checker.src/test/suggest_better.t deleted file mode 100644 index d76abeb..0000000 --- a/perl_checker.src/test/suggest_better.t +++ /dev/null @@ -1,112 +0,0 @@ -@{$xxx} @{$xxx} can be written @$xxx - -$h{"yyy"} {"yyy"} can be written {yyy} - -"$xxx" $xxx is better written without the double quotes - -$xxx->{yyy}->{zzz} the arrow "->" is unneeded - -"xxx\$xxx" you can replace "xxx\$xxx" with 'xxx$xxx', that way you don't need to escape <$> - -"xxx\$xxx" you can replace "xxx\$xxx" with 'xxx$xxx', that way you don't need to escape <$> - -"xxx\"$xxx" you can replace "xxx\"xxx" with qq(xxx"xxx), that way you don't need to escape <"> - -/xxx\'xxx/ you can replace \' with ' - -/xxx\;xxx/ you can replace \; with ; - -/\// change the delimit character / to get rid of this escape - -{ nop(); } spurious ";" before closing block - -+1 don't use unary + - -return ($xxx) unneeded parentheses - -if (($xxx eq $yyy) || $zzz) {} unneeded parentheses - -if (($xxx =~ /yyy/) || $zzz) {} unneeded parentheses - -nop() foreach ($xxx, $yyy); unneeded parentheses - -($xxx) ||= 'xxx' remove the parentheses - -$o->m0() remove these unneeded parentheses - -$o = xxx() if !$o; "$foo = ... if !$foo" can be written "$foo ||= ..." - -$o = xxx() unless $o; "$foo = ... unless $foo" can be written "$foo ||= ..." - -$o or $o = xxx(); "$foo or $foo = ..." can be written "$foo ||= ..." - -$_ =~ s/xxx/yyy/ "$_ =~ s/regexp/.../" can be written "s/regexp/.../" - -$xxx =~ /^yyy$/ "... =~ /^yyy$/" is better written "... eq 'yyy'" - -/xxx.*/ you can remove ".*" at the end of your regexp - -/xxx.*$/ you can remove ".*$" at the end of your regexp - -/[^\s]/ you can replace [^\s] with \S - -/[^\w]/ you can replace [^\w] with \W - -$xxx ? $xxx : $yyy you can replace "$foo ? $foo : $bar" with "$foo || $bar" - -my @l = (); no need to initialize variables, it's done by default - -$l[$#l] you can replace $#l with -1 - -$#l == 0 $#x == 0 is better written @x == 1 - -$#l == -1 $#x == -1 is better written @x == 0 - -$#l < 0 change your expression to use @xxx instead of $#xxx - -$l[@l] = 1 "$a[@a] = ..." is better written "push @a, ..." - -xxx(@_) replace xxx(@_) with &xxx - -member($xxx, keys %h) you can replace "member($xxx, keys %yyy)" with "exists $yyy{$xxx}" - -!($xxx =~ /.../) !($var =~ /.../) is better written $var !~ /.../ - -!($xxx == 1) !($foo == $bar) is better written $foo != $bar - -!($xxx eq 'foo') !($foo eq $bar) is better written $foo ne $bar - -grep { !member($_, qw(a b c)) } @l you can replace "grep { !member($_, ...) } @l" with "difference2([ @l ], [ ... ])" - -any { $_ eq 'foo' } @l you can replace "any { $_ eq ... } @l" with "member(..., @l)" - -foreach (@l) { use "push @l2, grep { ... } ..." instead of "foreach (...) { push @l2, $_ if ... }" - push @l2, $_ if yyy($_); or sometimes "@l2 = grep { ... } ..." -} - -foreach (@l) { use "push @l2, map { ... } ..." instead of "foreach (...) { push @l2, ... }" - push @l2, yyy($_); or sometimes "@l2 = map { ... } ..." -} - -foreach (@l) { use "push @l2, map { ... ? ... : () } ..." instead of "foreach (...) { push @l2, ... if ... }" - push @l2, yyy($_) if zzz($_); or sometimes "@l2 = map { ... ? ... : () } ..." -} or sometimes "@l2 = map { if_(..., ...) } ..." - -foreach (@l) { use "$xxx = find { ... } ..." - if (xxx($_)) { - $xxx = $_; - last; - } -} - -if (grep { xxx() } @l) {} in boolean context, use "any" instead of "grep" - -$xxx = grep { xxx() } @l; you may use "find" instead of "grep" - -$xxx ? $yyy : () you may use if_() here - beware that the short-circuit semantic of ?: is not kept - if you want to keep the short-circuit behaviour, replace () with @{[]} and there will be no warning anymore - -system(qq(foo "$xxx")) instead of quoting parameters you should give a list of arguments - -system("mkdir", $xxx) you can replace system("mkdir ...") with mkdir(...) diff --git a/perl_checker.src/test/syntax_restrictions.t b/perl_checker.src/test/syntax_restrictions.t deleted file mode 100644 index de7bf77..0000000 --- a/perl_checker.src/test/syntax_restrictions.t +++ /dev/null @@ -1,70 +0,0 @@ -$xxx <<= 2 don't use "<<=", use the expanded version instead - -m@xxx@ don't use m@...@, replace @ with / ! , or | - -s:xxx:yyy: don't use s:...:, replace : with / ! , or | - -qw/a b c/ don't use qw/.../, use qw(...) instead - -qw{a b c} don't use qw{...}, use qw(...) instead - -q{xxx} don't use q{...}, use q(...) instead - -qq{xxx} don't use qq{...}, use qq(...) instead - -qx(xxx) don't use qx(...), use `...` instead - --xxx don't use -xxx, use '-xxx' instead - -not $xxx don't use "not", use "!" instead - -$1 =~ /xxx/ do not use the result of a match (eg: $1) to match another pattern - -$xxx =~ "yyy" use a regexp, not a string - -xxx() =~ s/xxx/yyy/ you can only use s/// on a variable - -$1 =~ /xxx/ do not use the result of a match (eg: $1) to match another pattern - -grep /xxx/, @l always use "grep" with a block (eg: grep { ... } @list) - -for (@l) {} write "foreach" instead of "for" - -foreach ($xxx = 0; $xxx < 9; $xxx++) {} write "for" instead of "foreach" - -foreach $xxx (@l) {} don't use for without "my"ing the iteration variable - -foreach ($xxx) {} you are using the special trick to locally set $_ with a value, for this please use "for" instead of "foreach" - -unless ($xxx) {} else {} don't use "else" with "unless" (replace "unless" with "if") - -unless ($xxx) {} elsif ($yyy) {} don't use "elsif" with "unless" (replace "unless" with "if") - -zzz() unless $xxx || $yyy; don't use "unless" when the condition is complex, use "if" instead - -$$xxx{yyy} for complex dereferencing, use "->" - -wantarray please use wantarray() instead of wantarray - -eval please use "eval $_" instead of "eval" - -local *F; open F, "foo"; use a scalar instead of a bareword (eg: occurrences of F with $F) - -$xxx !~ s/xxx/yyy/ use =~ instead of !~ and negate the return value - -pkg::nop $xxx; use parentheses around argument (otherwise it might cause syntax errors if the package is "require"d and not "use"d - -new foo $xxx you must parenthesize parameters: "new Class(...)" instead of "new Class ..." - -*xxx = *yyy "*xxx = *yyy" is better written "*xxx = \&yyy" - -$_xxx = 1 variable $_xxx must not be used - (variable with name _XXX are reserved for unused variables) - -sub f2 { my ($x, $_y) = @_; $x } not enough parameters -f2(@l); # ok -f2(xxx()); # bad - -$xxx = <<"EOF"; Don't use <<"MARK", use < [ qw(f f0) ], -); -our @EXPORT_OK = qw(f); -EOF - -my $header = <<'EOF'; -package pkg; -use lib "../.."; -sub new {} -sub m0 { my ($_o) = @_; 0 } -sub m1 { my ($_o, $a) = @_; $a } -sub m2 { my ($_o, $_a, $b) = @_; $b } -sub m0_or_2 { my ($_o, $_a, $b) = @_; $b } -package pkg2; -sub new {} -sub m0_or_2 { my ($_o) = @_; 0 } - -package my_pkg; -sub nop {} -sub xxx { @_ } -sub yyy { @_ } -sub zzz { @_ } -sub pkg::nop {} -sub N { $_[0] } -sub N_ { $_[0] } -my ($xxx, $yyy, $zzz, $o, @l, @l2, %h); -xxx($xxx, $yyy, $zzz, $o, @l, @l2, %h); -use MDK::Common; - -EOF - -my $oo_header = <<'EOF'; -EOF - -my $local = <<'EOF'; -{ - local $_; -EOF - -my $local_trailer = <<'EOF'; - - xxx($xxx, $yyy, $zzz, $o, @l, @l2, %h); -} -EOF - -my $new; -foreach my $test (@tests) { - my @l = @{$test->{lines}}; - - pop @l while $l[-1] =~ /^\s*$/; - if (@l == 1) { - if ($l[-1] !~ /(;|[\s{]\})\s*$/) { - $l[-1] =~ s/^(.*?)(\s*$)/xxx($1);$2/; - } else { - # no comma for: - # - prefix for/foreach/... - # - already a comma - # - a block { ... } - my $no_comma = $l[-1] =~ /(^\s*(for|foreach|if|unless|while|sub)\s)|(;\s+$)|(^{.*}\s*$)/; - my $opt_comma = $no_comma ? '' : ';'; - $l[-1] =~ s/(\s+$)/$opt_comma nop();$1/; - } - } - if (! any { /^(sub|use) / } @l) { - @l = ($local, @l, $local_trailer); - } - if (any { /->\w/ } @l) { - @l = ($oo_header, $header, @l); - } else { - @l = ($header, @l); - } - output('.pl', @l); - my @raw_log = `../perl_checker .pl`; - die "@raw_log in .pl ($file):\n" . join('', @{$test->{lines}}) if any { /^syntax error$/ } @raw_log; - - my $f; - my @log = grep { - if (/^File "(.*)", line /) { - $f = $1; - 0; - } else { - $f eq '.pl'; - } - } @raw_log; - - foreach my $i (0 .. max(int @{$test->{lines}}, int @log) - 1) { - my $s = $test->{lines}[$i]; - $s =~ s/\s+$//; - $new .= sprintf "%-40s %s", $s, $log[$i] || "\n"; - } - $new .= "\n"; -} -output("$file.new", $new); -if (system('diff', '-buB', $file, "$file.new") == 0) { - unlink "$file.new", '.pl', 'pkg3.pm'; - exit 0; -} else { - warn "*" x 80, "\nnot same\n"; - exit 1; -} diff --git a/perl_checker.src/test/various_errors.t b/perl_checker.src/test/various_errors.t deleted file mode 100644 index 48a8ece..0000000 --- a/perl_checker.src/test/various_errors.t +++ /dev/null @@ -1,61 +0,0 @@ -local $xxx ||= $yyy applying ||= on a new initialized variable is wrong - -$1 =~ s/xxx/yyy/ do not modify the result of a match (eg: $1) - -$xxx[1, 2] you must give only one argument - -$xxx[] you must give one argument - -my $_x = 'xxx' if $xxx; replace "my $foo = ... if " with "my $foo = && ..." - -$xxx or my $_x = 'xxx'; replace " or my $foo = ..." with "my $foo = ! && ..." - -'' || 'xxx' || ... is the same as ... - -if ($xxx = '') {} are you sure you did not mean "==" instead of "="? - -N("xxx$yyy") don't use interpolated translated string, use %s or %d instead - -if ($xxx && $yyy = xxx()) {} invalid lvalue - -1 + 2 >> 3 missing parentheses (needed for clarity) - -$xxx ? $yyy = 1 : $zzz = 2; missing parentheses (needed for clarity) - invalid lvalue - -N_("xxx") . 'yyy' N_("xxx") . "yyy" is dumb since the string "xxx" will never get translated - -join(@l) first argument of join() must be a scalar - -join(',', 'foo') join('...', $foo) is the same as $foo - -if_($xxx) not enough parameters - -push @l you must give some arguments to push - -push $xxx, 1 push is expecting an array - -pop $xxx pop is expecting an array and nothing else - -my (@l2, $xxx) = @l; @l2 takes all the arguments, $xxx is undef in any case - -$bad undeclared variable $bad - -{ my $a } unused variable $a - -my $xxx; yyy($xxx); my $xxx; redeclared variable $xxx - -{ my $xxx; $xxx = 1 } variable $xxx assigned, but not read - -$a undeclared variable $a - -use bad; can't find package bad - -use pkg3 ':bad'; package pkg3 doesn't export tag :bad -bad(); unknown function bad - -use pkg3 ':missing_fs'; name &f is not defined in package pkg3 -f(); name &f0 is not defined in package pkg3 - -use pkg3 'f'; name &f is not defined in package pkg3 -f(); diff --git a/perl_checker.src/tree.ml b/perl_checker.src/tree.ml deleted file mode 100644 index 16fd0e4..0000000 --- a/perl_checker.src/tree.ml +++ /dev/null @@ -1,443 +0,0 @@ -open Types -open Common -open Printf -open Config_file -open Parser_helper - -type special_export = Re_export_all | Fake_export_all - -type exports = { - export_ok : (context * string) list ; - export_auto : (context * string) list ; - export_tags : (string * (context * string) list) list ; - special_export : special_export option ; - } - -type uses = (string * ((context * string) list option * pos)) list - -type prototype = { - proto_nb_min : int ; - proto_nb_max : int option ; - } - -type variable_used = Access_none | Access_write_only | Access_various - -type per_package = { - package_name : string ; has_package_name : bool ; - vars_declared : (context * string, pos * variable_used ref * prototype option) Hashtbl.t; - imported : ((context * string) * (string * variable_used ref * prototype option)) list option ref; - exports : exports ; - uses : uses ; - required_packages : (string * pos) list ; - body : fromparser list; - isa : (string * pos) list option ; - } - -type per_file = { - file_name : string ; - require_name : string option ; - lines_starts : int list ; - build_time : float ; - packages : per_package list ; - from_basedir : bool ; - } - -let anonymous_package_count = ref 0 -let empty_exports = { export_ok = []; export_auto = []; export_tags = []; special_export = None } -let use_lib = ref (List.map Info.file_to_absolute_file (readlines (Unix.open_process_in "perl -le 'print foreach @INC'"))) - -let ignore_package pkg = - if !Flags.verbose then print_endline_flush ("ignoring package " ^ pkg); - lpush ignored_packages pkg - -let die_with_pos pos msg = failwith (Info.pos2sfull pos ^ msg) -let warn_with_pos warn_types pos msg = if Flags.are_warning_types_set warn_types then print_endline_flush (Info.pos2sfull pos ^ msg) - -let s2context s = - match s.[0] with - | '$' -> I_scalar, skip_n_char 1 s - | '%' -> I_hash , skip_n_char 1 s - | '@' -> I_array , skip_n_char 1 s - | '&' -> I_func , skip_n_char 1 s - | '*' -> I_star , skip_n_char 1 s - | _ -> I_raw, s - - -let get_current_package t = - match t with - | Package(Ident _ as ident) :: body -> - let rec bundled_packages packages current_package found_body = function - | [] -> List.rev ((Some current_package, List.rev found_body) :: packages) - | Package(Ident _ as ident) :: body -> - let packages = (Some current_package, List.rev found_body) :: packages in - bundled_packages packages (string_of_fromparser ident) [] body - | instr :: body -> - bundled_packages packages current_package (instr :: found_body) body - in - bundled_packages [] (string_of_fromparser ident) [] body - | _ -> - if str_ends_with !Info.current_file ".pm" then warn_with_pos [Warn_normalized_expressions] (!Info.current_file, 0, 0) (sprintf "module %s does not have \"package xxxx;\" on its first line" (Info.absolute_file_to_file !Info.current_file)) ; - [ None, t ] - -let from_qw_raw = function - | String([s, List []], pos) -> [ s, pos ] - | String(_, pos) -> - warn_with_pos [] pos "not recognised yet" ; - [] - | Raw_string(s, pos) -> - [ s, pos ] - | List [] -> [] - | List [ List l ] -> - some_or (l_option2option_l (List.map (function - | String([s, List []], pos) - | Raw_string(s, pos) -> Some(s, pos) - | Ident(_, _, pos) as ident -> Some(string_of_fromparser ident, pos) - | e -> warn_with_pos [] (get_pos_from_expr e) "not recognised yet"; None - ) l)) [] - | e -> warn_with_pos [] (get_pos_from_expr e) "not recognised yet"; [] - -let from_qw e = - List.map (fun (s, pos) -> - let context, s' = s2context s in - let context = - match context with - | I_raw -> if s'.[0] = ':' then I_raw else I_func - | I_func -> warn_with_pos [Warn_import_export] pos "weird, exported name with a function context especially given"; I_func - | _ -> context - in context, s' - ) (from_qw_raw e) - -let get_exported t = - List.fold_left (fun exports e -> - match e with - | List [ Call_op("=", [ Deref(I_array, Ident(None, "EXPORT", _)); Call _ ], pos) ] - | List [ Call_op("=", [ My_our("our", [(I_array, "EXPORT")], _); Call _ ], pos) ] -> - if exports.special_export = None then warn_with_pos [Warn_import_export] pos "unrecognised @EXPORT" ; - exports - - | List [ Call_op("=", [ Deref(I_array, Ident(None, "EXPORT", _)); v ], pos)] - | List [ Call_op("=", [ My_our("our", [(I_array, "EXPORT")], _); v ], pos)] -> - if exports.export_auto <> [] then warn_with_pos [Warn_import_export] pos "weird, @EXPORT set twice" ; - { exports with export_auto = from_qw v } - - | Perl_checker_comment("RE-EXPORT-ALL", _) -> { exports with special_export = Some Re_export_all } - | Perl_checker_comment("EXPORT-ALL", _) -> { exports with special_export = Some Fake_export_all } - - | List [ Call_op("=", [ Deref(I_array, Ident(None, "EXPORT_OK", _)); v ], pos)] - | List [ Call_op("=", [ My_our("our", [(I_array, "EXPORT_OK")], _); v ], pos)] -> - if exports.export_ok <> [] then warn_with_pos [Warn_import_export] pos "weird, @EXPORT_OK set twice" ; - (match v with - | Call(Deref(I_func, Ident(None, "map", _)), - [ Anonymous_sub(_, Block [List [Deref(I_array, Deref(I_scalar, Ident (None, "_", _)))]], _); - Call(Deref(I_func, Ident(None, "values", _)), [ Deref(I_hash, Ident(None, "EXPORT_TAGS", _))])]) -> - { exports with export_ok = collect snd exports.export_tags } - | _ -> { exports with export_ok = from_qw v }) - - | List [ Call_op("=", [ Deref(I_hash, Ident(None, "EXPORT_TAGS", _)); v ], pos)] - | List [ Call_op("=", [ My_our("our", [(I_hash, "EXPORT_TAGS")], _); v ], pos)] -> - (try - let export_tags = - match v with - | List [ List l ] -> - List.map (function - | Raw_string(tag, _), Ref(I_array, List [List [v]]) -> - let para = - match v with - | Deref(I_array, Ident(None, "EXPORT_OK", _)) -> exports.export_ok - | _ -> from_qw v - in - ":" ^ tag, para - | _ -> raise Not_found - ) (group_by_2 l) - | _ -> raise Not_found - in - if exports.export_tags <> [] then warn_with_pos [Warn_import_export] pos "weird, %EXPORT_TAGS set twice" ; - { exports with export_tags = export_tags } - with _ -> - warn_with_pos [Warn_import_export] pos "unrecognised %EXPORT_TAGS" ; - exports) - - (* $EXPORT_TAGS{all} = [ map { @$_ } values %EXPORT_TAGS ]; *) - | List [Call_op("=", [ - Deref_with(I_hash, I_scalar, Ident(None, "EXPORT_TAGS", _), Raw_string("all", _)); - Ref(I_array, - List[List[ - Call(Deref(I_func, Ident(None, "map", _)), - [Anonymous_sub(_, Block [List [Deref(I_array, Deref(I_scalar, Ident(None, "_", _)))]], _); - Call(Deref(I_func, Ident(None, "values", _)), [Deref(I_hash, Ident(None, "EXPORT_TAGS", _))])]) - ]]) - ], _)] -> - { exports with export_tags = (":all", collect snd exports.export_tags) :: exports.export_tags } - - | List (My_our _ :: _) -> - let _,_ = e,e in - exports - | _ -> exports - ) empty_exports t - -let uses_external_package = function - | "vars" | "Exporter" | "diagnostics" | "strict" | "warnings" | "lib" | "POSIX" | "Gtk" | "Storable" - | "Config" | "Socket" | "IO::Socket" | "DynaLoader" | "Data::Dumper" | "Time::localtime" | "Expect" -> true - | _ -> false - -let get_uses t = - List.fold_left (fun uses e -> - match e with - | Use(Ident(None, "lib", _), [libs]) -> - use_lib := List.map Info.file_to_absolute_file (List.map snd (from_qw libs)) @ !use_lib ; - uses - | Use(Ident(None, "base", _), classes) -> - let l = List.map (fun (pkg, pos) -> (pkg, (None, pos))) (collect from_qw_raw classes) in - l @ uses - | Use(Ident(_, _, pos) as pkg, l) -> - let package = string_of_fromparser pkg in - if uses_external_package package then - uses - else - let para = match l with - | [] -> None - | [ Num(_, _) ] -> None (* don't care about the version number *) - | _ -> Some(collect from_qw l) - in - (package, (para, pos)) :: uses - | _ -> uses - ) [] t - -let get_isa t = - List.fold_left (fun (isa, exporter) e -> - match e with - | Use(Ident(None, "base", pos), classes) -> - if isa <> None || exporter <> None then die_with_pos pos "\"use base\" and \"@ISA\" must be used once only"; - Some (collect from_qw_raw classes), None - | List [ Call_op("=", [ Deref(I_array, Ident(None, "ISA", pos)) ; classes ], _) ] - | List [ Call_op("=", [ My_our("our", [ I_array, "ISA" ], pos) ; classes ], _) ] -> - if isa <> None || exporter <> None then die_with_pos pos "\"use base\" and \"@ISA\" must be used once only"; - let special, l = List.partition (fun (s, _) -> s = "DynaLoader" || s = "Exporter") (from_qw_raw classes) in - let exporter = if List.mem_assoc "Exporter" special then Some pos else None in - let isa = if l = [] && special <> [] then None else Some l in - isa, exporter - | _ -> isa, exporter - ) (None, None) t - -let read_xs_extension_from_c global_vars_declared file_name package pos = - try - let cfile = Filename.chop_extension file_name ^ ".c" in - let prefix = "newXS(\"" ^ package.package_name ^ "::" in - ignore (fold_lines (fun in_bootstrap s -> - if in_bootstrap then - (try - let offset = strstr s prefix + String.length prefix in - let end_ = String.index_from s offset '"' in - let ident = String.sub s offset (end_ - offset) in - match split_name_or_fq_name ident with - | None, ident -> Hashtbl.replace package.vars_declared (I_func, ident) (pos, ref Access_none, None) - | Some fq, ident -> - let fq = package.package_name ^ "::" ^ fq in - Hashtbl.replace global_vars_declared (I_func, fq, ident) (pos, None) - with Not_found -> ()); - in_bootstrap || str_contains s "XS_VERSION_BOOTCHECK" - ) false (open_in cfile)); - if !Flags.verbose then print_endline_flush (sprintf "using xs symbols from %s" cfile) ; - true - with Invalid_argument _ | Sys_error _ -> false - -let findfile dirs f = List.find (fun dir -> Sys.file_exists (dir ^ "/" ^ f)) dirs - -let read_xs_extension_from_so global_vars_declared package pos = - try - let splitted = split_at2 ':'':' package.package_name in - let rel_file = String.concat "/" ("auto" :: splitted @ [ last splitted ]) ^ ".so" in - let so = (findfile !use_lib rel_file) ^ "/" ^ rel_file in - let channel = Unix.open_process_in (Printf.sprintf "nm --defined-only -D \"%s\"" so) in - if !Flags.verbose then print_endline_flush (sprintf "using shared-object symbols from %s" so) ; - fold_lines (fun () s -> - let s = skip_n_char 11 s in - if str_begins_with "XS_" s then - let s = skip_n_char 3 s in - let len = String.length s in - let rec find_package_name accu i = - try - let i' = String.index_from s i '_' in - let accu = String.sub s i (i'-i) :: accu in - if i' + 1 < len && s.[i'+1] = '_' then - find_package_name accu (i' + 2) - else - List.rev accu, skip_n_char (i'+1) s - with Not_found -> List.rev accu, skip_n_char i s - in - let fq, name = find_package_name [] 0 in - Hashtbl.replace global_vars_declared (I_func, String.concat "::" fq, name) (pos, None) - ) () channel; - if not Build.debugging then ignore (Unix.close_process_in channel) ; - true - with Not_found -> false - -let has_proto perl_proto body = - match perl_proto with - | Some "" -> Some([], raw_pos2pos bpos, [body]) - | _ -> - match body with - | Block [] -> - Some([ I_array, "_empty" ], raw_pos2pos bpos, []) - | Block (List [Call_op ("=", [My_our ("my", mys, mys_pos); Deref(I_array, Ident(None, "_", _))], _pos)] :: body) -> - Some(mys, mys_pos, body) - | _ -> None - -let get_proto perl_proto body = - map_option (fun (mys, pos, _) -> - let scalars, others = break_at (fun (context, _) -> context <> I_scalar) mys in - (match others with - | (I_array, _) :: _ :: _ -> warn_with_pos [Warn_prototypes] pos "an array must be the last variable in a prototype" - | (I_hash, _) :: _ :: _ -> warn_with_pos [Warn_prototypes] pos "an hash must be the last variable in a prototype" - | _ -> ()); - let is_optional (_, s) = - String.length s > 2 && (s.[0] = 'o' || s.[0] = 'b') && s.[1] = '_' || - String.length s > 3 && s.[0] = '_' && (s.[1] = 'o' || s.[1] = 'b') && s.[2] = '_' - in - let must_have, optional = break_at is_optional scalars in - if not (List.for_all is_optional optional) then - warn_with_pos [Warn_prototypes] pos "an non-optional argument must not follow an optional argument"; - let min = List.length must_have in - { proto_nb_min = min; proto_nb_max = if others = [] then Some(min + List.length optional) else None } - ) (has_proto perl_proto body) - -let get_vars_declaration global_vars_declared file_name package = - List.iter (function - | Sub_declaration(Ident(None, name, pos), perl_proto, body, _) -> - Hashtbl.replace package.vars_declared (I_func, name) (pos, ref Access_none, get_proto perl_proto body) - | Sub_declaration(Ident(Some fq, name, pos), perl_proto, body, _) -> - Hashtbl.replace global_vars_declared (I_func, fq, name) (pos, get_proto perl_proto body) - - | List [ Call_op("=", [My_our("our", ours, pos); _], _) ] - | List [ Call_op("=", [My_our("local", ([ I_scalar, "_" ] as ours), pos); _], _) ] - | List [ My_our("our", ours, pos) ] - | My_our("our", ours, pos) -> - List.iter (fun (context, name) -> Hashtbl.replace package.vars_declared (context, name) (pos, ref Access_none, None)) ours - - | Use(Ident(None, "vars", pos), [ours]) -> - List.iter (fun (context, name) -> Hashtbl.replace package.vars_declared (context, name) (pos, ref Access_none, None)) (from_qw ours) - | Use(Ident(None, "vars", pos), _) -> - die_with_pos pos "usage: use vars qw($var func)" - - | List [ Method_call(Raw_string(pkg, pos), Raw_string("bootstrap", _), _) ] -> - if pkg <> package.package_name then - warn_with_pos [Warn_import_export] pos "strange bootstrap (the package name is not the same as the current package)" - else - if not (read_xs_extension_from_c global_vars_declared file_name package pos) then - if not (read_xs_extension_from_so global_vars_declared package pos) then - ignore_package pkg - | _ -> () - ) package.body - -let rec fold_tree f env e = - match f env e with - | Some env -> env - | None -> - match e with - | Anonymous_sub(_, e', _) - | Ref(_, e') - | Deref(_, e') - -> fold_tree f env e' - - | Diamond(e') - -> fold_tree_option f env e' - - | String(l, _) - -> List.fold_left (fun env (_, e) -> fold_tree f env e) env l - - | Sub_declaration(e1, _, e2, _) - | Deref_with(_, _, e1, e2) - -> - let env = fold_tree f env e1 in - let env = fold_tree f env e2 in - env - - | Use(_, l) - | List l - | Block l - | Call_op(_, l, _) - -> List.fold_left (fold_tree f) env l - - | Call(e', l) - -> - let env = fold_tree f env e' in - List.fold_left (fold_tree f) env l - - | Method_call(e1, e2, l) - -> - let env = fold_tree f env e1 in - let env = fold_tree f env e2 in - List.fold_left (fold_tree f) env l - - | _ -> env - -and fold_tree_option f env = function - | None -> env - | Some e -> fold_tree f env e - - -let get_global_info_from_package from_basedir require_name build_time t = - let current_packages = get_current_package t in - let packages = List.map (fun (current_package, t) -> - let exports = get_exported t in - let exporting_something() = exports.export_ok <> [] || exports.export_auto <> [] || exports.export_tags <> [] || exports.special_export = Some Re_export_all in - - let package_name = - match current_package with - | None -> - if exporting_something() then - die_with_pos (!Info.current_file, 0, 0) "file with no package name wants to export!" - else - (incr anonymous_package_count ; sprintf "anonymous%d" !anonymous_package_count) - | Some name -> name - in - let isa, exporter = get_isa t in - (match exporter with - | None -> - if exporting_something() then warn_with_pos [Warn_import_export] (!Info.current_file, 0, 0) "you must have \"@ISA = qw(Exporter)\" to EXPORT something" - | Some pos -> - if not (exporting_something()) then warn_with_pos [Warn_import_export] pos "Inheritating from Exporter without EXPORTing anything"); - - let uses = List.rev (get_uses t) in - let required_packages = List.map (fun (s, (_, pos)) -> s, pos) uses in - let required_packages = List.fold_left (fold_tree (fun l -> - function - | Perl_checker_comment(s, pos) when str_begins_with "require " s -> - Some((skip_n_char 8 s, pos) :: l) - | Call(Deref(I_func, Ident (None, "require", pos)), [Ident _ as pkg]) -> - let package = string_of_fromparser pkg in - if uses_external_package package then None else Some((package, pos) :: l) - | Call(Deref(I_func, Ident (None, "require", pos)), [Raw_string(pkg, _)]) - when not (String.contains pkg '/') && Filename.check_suffix pkg ".pm" -> - let package = Filename.chop_suffix pkg ".pm" in - if uses_external_package package then None else Some((package, pos) :: l) - | _ -> None) - ) required_packages t in - { - package_name = package_name; - has_package_name = current_package <> None ; - exports = exports ; - imported = ref None ; - vars_declared = Hashtbl.create 16 ; - uses = uses ; - required_packages = required_packages ; - body = t ; - isa = isa ; - } - ) current_packages in - - let require_name = match require_name with - | Some require_name -> Some require_name - | None -> match packages with - | [ pkg ] when pkg.has_package_name -> Some pkg.package_name - | _ -> None - in - { - file_name = !Info.current_file ; - require_name = require_name ; - lines_starts = !Info.current_file_lines_starts ; - build_time = build_time ; - packages = packages ; - from_basedir = from_basedir ; - } - diff --git a/perl_checker.src/tree.mli b/perl_checker.src/tree.mli deleted file mode 100644 index 3cdf219..0000000 --- a/perl_checker.src/tree.mli +++ /dev/null @@ -1,57 +0,0 @@ -open Types - -type special_export = Re_export_all | Fake_export_all - -type exports = { - export_ok : (context * string) list; - export_auto : (context * string) list; - export_tags : (string * (context * string) list) list; - special_export : special_export option; -} - - -type uses = (string * ((context * string) list option * pos)) list - -type prototype = { - proto_nb_min : int ; - proto_nb_max : int option ; - } - -type variable_used = Access_none | Access_write_only | Access_various - -type per_package = { - package_name : string ; has_package_name : bool ; - vars_declared : (context * string, pos * variable_used ref * prototype option) Hashtbl.t; - imported : ((context * string) * (string * variable_used ref * prototype option)) list option ref; - exports : exports ; - uses : uses ; - required_packages : (string * pos) list ; - body : fromparser list; - isa : (string * pos) list option ; - } - -type per_file = { - file_name : string ; - require_name : string option ; - lines_starts : int list ; - build_time : float ; - packages : per_package list ; - from_basedir : bool ; - } - -val empty_exports : exports -val ignore_package : string -> unit -val use_lib : string list ref -val uses_external_package : string -> bool -val findfile : string list -> string -> string - -val get_global_info_from_package : bool -> string option -> float -> fromparser list -> per_file - -val has_proto : string option -> fromparser -> ((context * string) list * pos * fromparser list) option -val get_vars_declaration : (context * string * string, pos * prototype option) Hashtbl.t -> string -> per_package -> unit - -val die_with_pos : string * int * int -> string -> 'a -val warn_with_pos : Types.warning list -> string * int * int -> string -> unit - -val fold_tree : ('a -> fromparser -> 'a option) -> 'a -> fromparser -> 'a -val from_qw : fromparser -> (context * string) list diff --git a/perl_checker.src/types.mli b/perl_checker.src/types.mli deleted file mode 100644 index 5f23d3a..0000000 --- a/perl_checker.src/types.mli +++ /dev/null @@ -1,125 +0,0 @@ -exception TooMuchRParen - -type raw_pos = int * int - -type pos = string * int * int - -type spaces = - | Space_0 - | Space_1 - | Space_n - | Space_cr - | Space_none - -type context = I_scalar | I_hash | I_array | I_func | I_raw | I_star - -type maybe_context = - | M_none - - (* scalars *) - | M_bool | M_int | M_float - | M_revision - | M_string - | M_ref of maybe_context - | M_undef - | M_unknown_scalar - - | M_tuple of maybe_context list - | M_list - | M_array - | M_hash - | M_sub - - | M_special - | M_unknown - | M_mixed of maybe_context list - -type sub_declaration_kind = Real_sub_declaration | Glob_assign - -type fromparser = - | Undef - | Ident of string option * string * pos - | Num of string * pos - | Raw_string of string * pos - | String of (string * fromparser) list * pos - - | Ref of context * fromparser - | Deref of context * fromparser - | Deref_with of context * context * fromparser * fromparser (* from_context, to_context, ref, para *) - - | Diamond of fromparser option - - | List of fromparser list - | Block of fromparser list - - | Call_op of string * fromparser list * pos - | Call of fromparser * fromparser list - | Method_call of fromparser * fromparser * fromparser list - - | Anonymous_sub of string option * fromparser * pos (* prototype, expr, pos *) - | My_our of string * (context * string) list * pos - | Use of fromparser * fromparser list - | Sub_declaration of fromparser * string option * fromparser * sub_declaration_kind (* name, prototype, body, kind *) - | Package of fromparser - | Label of string - | Perl_checker_comment of string * pos - - | Too_complex - | Semi_colon - -type priority = -| P_tok -| P_tight -| P_mul -| P_add -| P_uniop -| P_cmp -| P_eq -| P_expr -| P_bit -| P_tight_and -| P_tight_or -| P_ternary -| P_assign -| P_comma -| P_call_no_paren -| P_and -| P_or -| P_loose - -| P_paren_wanted of priority -| P_paren of priority - -| P_none - -type 'a any_spaces_pos = { - any : 'a ; - spaces : spaces ; - pos : int * int ; - mcontext : maybe_context ; - } - -type 'a prio_anyexpr = { - priority : priority ; - expr : 'a - } - -type prio_expr_spaces_pos = fromparser prio_anyexpr any_spaces_pos -type prio_lexpr_spaces_pos = fromparser list prio_anyexpr any_spaces_pos - -type warning = - | Warn_white_space - | Warn_suggest_simpler - | Warn_unused_global_vars - | Warn_void - | Warn_context - | Warn_strange - | Warn_traps - | Warn_complex_expressions - | Warn_normalized_expressions - | Warn_suggest_functional - | Warn_prototypes - | Warn_import_export - | Warn_names - | Warn_MDK_Common - | Warn_help_perl_checker diff --git a/perl_checker_fake_packages/CGI.pm b/perl_checker_fake_packages/CGI.pm deleted file mode 100644 index c3ee55a..0000000 --- a/perl_checker_fake_packages/CGI.pm +++ /dev/null @@ -1,22 +0,0 @@ -package CGI; - -sub new {} - -sub autoflush {} -sub checkbox {} -sub close {} -sub end_form {} -sub end_html {} -sub h1 {} -sub hidden {} -sub param {} -sub password_field {} -sub scrolling_list {} -sub start_form {} -sub submit {} -sub textfield {} - -sub header {} -sub start_html {} -sub br {} -sub p {} diff --git a/perl_checker_fake_packages/Getopt/Long.pm b/perl_checker_fake_packages/Getopt/Long.pm deleted file mode 100644 index 6437264..0000000 --- a/perl_checker_fake_packages/Getopt/Long.pm +++ /dev/null @@ -1,6 +0,0 @@ -package Getopt::Long; - -our @ISA = qw(Exporter); -our @EXPORT = qw(GetOptions); - -sub GetOptions {} diff --git a/perl_checker_fake_packages/Glib.pm b/perl_checker_fake_packages/Glib.pm deleted file mode 100644 index 8f465ad..0000000 --- a/perl_checker_fake_packages/Glib.pm +++ /dev/null @@ -1,315 +0,0 @@ - -package Glib; -our @ISA = qw(); -sub CHECK_VERSION { my ($_class, $_required_major, $_required_minor, $_required_micro) = @_ } -sub GET_VERSION_INFO { my ($_class) = @_ } -sub MAJOR_VERSION() {} -sub MICRO_VERSION() {} -sub MINOR_VERSION() {} -sub critical { my ($_class, $_domain, $_message) = @_ } -sub error { my ($_class, $_domain, $_message) = @_ } -sub filename_display_basename { my ($_filename) = @_ } -sub filename_display_name { my ($_filename) = @_ } -sub filename_from_unicode { my ($_class_or_filename, $_o_filename) = @_ } -sub filename_from_uri { my (@_more_paras) = @_ } -sub filename_to_unicode { my ($_class_or_filename, $_o_filename) = @_ } -sub filename_to_uri { my (@_more_paras) = @_ } -sub get_application_name() {} -sub get_home_dir() {} -sub get_language_names() {} -sub get_real_name() {} -sub get_system_config_dirs() {} -sub get_system_data_dirs() {} -sub get_tmp_dir() {} -sub get_user_cache_dir() {} -sub get_user_config_dir() {} -sub get_user_data_dir() {} -sub get_user_name() {} -sub install_exception_handler { my ($_class, $_func, $_o_data) = @_ } -sub log { my ($_class, $_log_domain, $_log_level, $_message) = @_ } -sub main_depth() {} -sub major_version() {} -sub message { my ($_class, $_domain, $_message) = @_ } -sub micro_version() {} -sub minor_version() {} -sub remove_exception_handler { my ($_class, $_tag) = @_ } -sub set_application_name { my ($_application_name) = @_ } -sub warning { my ($_class, $_domain, $_message) = @_ } - -package Glib::Boxed; -our @ISA = qw(); -sub DESTROY { my ($_sv) = @_ } -sub copy { my ($_sv) = @_ } - -package Glib::Error; -our @ISA = qw(); -sub code { my ($_error) = @_ } -sub domain { my ($_error) = @_ } -sub location { my ($_error) = @_ } -sub matches { my ($_error, $_domain, $_code) = @_ } -sub message { my ($_error) = @_ } -sub new { my ($_class, $_code, $_message) = @_ } -sub register { my ($_package, $_enum_package) = @_ } -sub throw { my ($_class, $_code, $_message) = @_ } -sub value { my ($_error) = @_ } - -package Glib::Flags; -our @ISA = qw(); -sub all { my ($_a, $_b, $_swap) = @_ } -sub as_arrayref { my ($_a, $_b, $_swap) = @_ } -sub bool { my ($_a, $_b, $_swap) = @_ } -sub Glib::Flags::eq { my ($_a, $_b, $_swap) = @_ } -sub Glib::Flags::ge { my ($_a, $_b, $_swap) = @_ } -sub intersect { my ($_a, $_b, $_swap) = @_ } -sub Glib::Flags::sub { my ($_a, $_b, $_swap) = @_ } -sub union { my ($_a, $_b, $_swap) = @_ } -sub Glib::Flags::xor { my ($_a, $_b, $_swap) = @_ } - -package Glib::IO; -our @ISA = qw(); -sub add_watch { my ($_class, $_fd, $_condition, $_callback, $_o_data, $_o_priority) = @_ } - -package Glib::Idle; -our @ISA = qw(); -sub add { my ($_class, $_callback, $_o_data, $_o_priority) = @_ } - -package Glib::KeyFile; -our @ISA = qw(); -sub DESTROY { my ($_key_file) = @_ } -sub get_boolean { my ($_key_file, $_group_name, $_key) = @_ } -sub get_boolean_list { my ($_key_file, $_group_name, $_key) = @_ } -sub get_comment { my ($_key_file, $_o_group_name, $_o_key) = @_ } -sub get_groups { my ($_key_file) = @_ } -sub get_integer { my ($_key_file, $_group_name, $_key) = @_ } -sub get_integer_list { my ($_key_file, $_group_name, $_key) = @_ } -sub get_keys { my ($_key_file, $_group_name) = @_ } -sub get_locale_string { my ($_key_file, $_group_name, $_key, $_o_locale) = @_ } -sub get_locale_string_list { my ($_key_file, $_group_name, $_key, $_locale) = @_ } -sub get_start_group { my ($_key_file) = @_ } -sub get_string { my ($_key_file, $_group_name, $_key) = @_ } -sub get_string_list { my ($_key_file, $_group_name, $_key) = @_ } -sub get_value { my ($_key_file, $_group_name, $_key) = @_ } -sub has_group { my ($_key_file, $_group_name) = @_ } -sub has_key { my ($_key_file, $_group_name, $_key) = @_ } -sub load_from_data { my ($_key_file, $_buf, $_flags) = @_ } -sub load_from_data_dirs { my ($_key_file, $_file, $_flags) = @_ } -sub load_from_file { my ($_key_file, $_file, $_flags) = @_ } -sub new { my ($_class) = @_ } -sub remove_comment { my ($_key_file, $_o_group_name, $_o_key) = @_ } -sub remove_group { my ($_key_file, $_group_name) = @_ } -sub remove_key { my ($_key_file, $_group_name, $_key) = @_ } -sub set_boolean { my ($_key_file, $_group_name, $_key, $_value) = @_ } -sub set_boolean_list { my ($_key_file, $_group_name, $_key, @_more_paras) = @_ } -sub set_comment { my ($_key_file, $_group_name, $_key, $_comment) = @_ } -sub set_integer { my ($_key_file, $_group_name, $_key, $_value) = @_ } -sub set_integer_list { my ($_key_file, $_group_name, $_key, @_more_paras) = @_ } -sub set_list_separator { my ($_key_file, $_separator) = @_ } -sub set_locale_string { my ($_key_file, $_group_name, $_key, $_locale, $_string) = @_ } -sub set_locale_string_list { my ($_key_file, $_group_name, $_key, $_locale, @_more_paras) = @_ } -sub set_string { my ($_key_file, $_group_name, $_key, $_value) = @_ } -sub set_string_list { my ($_key_file, $_group_name, $_key, @_more_paras) = @_ } -sub set_value { my ($_key_file, $_group_name, $_key, $_value) = @_ } -sub to_data { my ($_key_file) = @_ } - -package Glib::Log; -our @ISA = qw(); -sub remove_handler { my ($_class, $_log_domain, $_handler_id) = @_ } -sub set_always_fatal { my ($_class, $_fatal_mask) = @_ } -sub set_fatal_mask { my ($_class, $_log_domain, $_fatal_mask) = @_ } -sub set_handler { my ($_class, $_log_domain, $_log_levels, $_log_func, $_o_user_data) = @_ } - -package Glib::MainContext; -our @ISA = qw(); -sub DESTROY { my ($_maincontext) = @_ } -sub default { my ($_class) = @_ } -sub iteration { my ($_context, $_may_block) = @_ } -sub new { my ($_class) = @_ } -sub pending { my ($_context) = @_ } - -package Glib::MainLoop; -our @ISA = qw(); -sub DESTROY { my ($_mainloop) = @_ } -sub get_context { my ($_loop) = @_ } -sub is_running { my ($_loop) = @_ } -sub new { my ($_class, $_o_context, $_o_is_running) = @_ } -sub quit { my ($_loop) = @_ } -sub run { my ($_loop) = @_ } - -package Glib::Markup; -our @ISA = qw(); -sub escape_text { my ($_text) = @_ } - -package Glib::Object; -our @ISA = qw(); -sub CLONE { my ($_class) = @_ } -sub DESTROY { my ($_sv) = @_ } -sub freeze_notify { my ($_object) = @_ } -sub get { my ($_object, @_more_paras) = @_ } -sub get_data { my ($_object, $_key) = @_ } -sub get_pointer { my ($_object) = @_ } -sub get_property { my ($_object, @_more_paras) = @_ } -sub list_properties { my ($_object_or_class_name) = @_ } -sub new { my ($_class, @_more_paras) = @_ } -sub new_from_pointer { my ($_class, $_pointer, $_o_noinc) = @_ } -sub notify { my ($_object, $_property_name) = @_ } -sub set { my ($_object, @_more_paras) = @_ } -sub set_data { my ($_object, $_key, $_data) = @_ } -sub set_property { my ($_object, @_more_paras) = @_ } -sub set_threadsafe { my ($_class, $_threadsafe) = @_ } -sub signal_add_emission_hook { my ($_object_or_class_name, $_detailed_signal, $_hook_func, $_o_hook_data) = @_ } -sub signal_chain_from_overridden { my ($_instance, @_more_paras) = @_ } -sub signal_connect { my ($_instance, $_detailed_signal, $_callback, $_o_data) = @_ } -sub signal_connect_after { my ($_instance, $_detailed_signal, $_callback, $_o_data) = @_ } -sub signal_connect_swapped { my ($_instance, $_detailed_signal, $_callback, $_o_data) = @_ } -sub signal_emit { my ($_instance, $_name, @_more_paras) = @_ } -sub signal_handler_block { my ($_object, $_handler_id) = @_ } -sub signal_handler_disconnect { my ($_object, $_handler_id) = @_ } -sub signal_handler_is_connected { my ($_object, $_handler_id) = @_ } -sub signal_handler_unblock { my ($_object, $_handler_id) = @_ } -sub signal_handlers_block_by_func { my ($_instance, $_func, $_o_data) = @_ } -sub signal_handlers_disconnect_by_func { my ($_instance, $_func, $_o_data) = @_ } -sub signal_handlers_unblock_by_func { my ($_instance, $_func, $_o_data) = @_ } -sub signal_query { my ($_object_or_class_name, $_name) = @_ } -sub signal_remove_emission_hook { my ($_object_or_class_name, $_signal_name, $_hook_id) = @_ } -sub signal_stop_emission_by_name { my ($_instance, $_detailed_signal) = @_ } -sub thaw_notify { my ($_object) = @_ } -sub tie_properties { my ($_object, $_o_all) = @_ } - -package Glib::Object::_LazyLoader; -our @ISA = qw(); -sub _load { my ($_package) = @_ } - -package Glib::Param::Boolean; -our @ISA = qw(); -sub get_default_value { my ($_pspec_boolean) = @_ } - -package Glib::Param::Char; -our @ISA = qw(); -sub get_default_value { my ($_pspec) = @_ } -sub get_maximum { my ($_pspec) = @_ } -sub get_minimum { my ($_pspec) = @_ } - -package Glib::Param::Double; -our @ISA = qw(); -sub get_default_value { my ($_pspec) = @_ } -sub get_epsilon { my ($_pspec) = @_ } -sub get_maximum { my ($_pspec) = @_ } -sub get_minimum { my ($_pspec) = @_ } - -package Glib::Param::Enum; -our @ISA = qw(); -sub get_default_value { my ($_pspec_enum) = @_ } -sub get_enum_class { my ($_pspec_enum) = @_ } - -package Glib::Param::Flags; -our @ISA = qw(); -sub get_default_value { my ($_pspec_flags) = @_ } -sub get_flags_class { my ($_pspec_flags) = @_ } - -package Glib::Param::Float; -our @ISA = qw(); -sub get_default_value { my ($_pspec) = @_ } -sub get_epsilon { my ($_pspec) = @_ } -sub get_maximum { my ($_pspec) = @_ } -sub get_minimum { my ($_pspec) = @_ } - -package Glib::Param::Int; -our @ISA = qw(); -sub get_default_value { my ($_pspec) = @_ } -sub get_maximum { my ($_pspec) = @_ } -sub get_minimum { my ($_pspec) = @_ } - -package Glib::Param::Int64; -our @ISA = qw(); -sub get_default_value { my ($_pspec) = @_ } -sub get_maximum { my ($_pspec) = @_ } -sub get_minimum { my ($_pspec) = @_ } - -package Glib::Param::Long; -our @ISA = qw(); -sub get_default_value { my ($_pspec) = @_ } -sub get_maximum { my ($_pspec) = @_ } -sub get_minimum { my ($_pspec) = @_ } - -package Glib::Param::String; -our @ISA = qw(); -sub get_default_value { my ($_pspec_string) = @_ } - -package Glib::Param::UChar; -our @ISA = qw(); -sub get_default_value { my ($_pspec) = @_ } -sub get_maximum { my ($_pspec) = @_ } -sub get_minimum { my ($_pspec) = @_ } - -package Glib::Param::UInt; -our @ISA = qw(); -sub get_default_value { my ($_pspec) = @_ } -sub get_maximum { my ($_pspec) = @_ } -sub get_minimum { my ($_pspec) = @_ } - -package Glib::Param::UInt64; -our @ISA = qw(); -sub get_default_value { my ($_pspec) = @_ } -sub get_maximum { my ($_pspec) = @_ } -sub get_minimum { my ($_pspec) = @_ } - -package Glib::Param::ULong; -our @ISA = qw(); -sub get_default_value { my ($_pspec) = @_ } -sub get_maximum { my ($_pspec) = @_ } -sub get_minimum { my ($_pspec) = @_ } - -package Glib::Param::Unichar; -our @ISA = qw(); -sub get_default_value { my ($_pspec_unichar) = @_ } - -package Glib::ParamSpec; -our @ISA = qw(); -sub DESTROY { my ($_pspec) = @_ } -sub IV { my ($_class, $_name, $_nick, $_blurb, $_minimum, $_maximum, $_default_value, $_flags) = @_ } -sub UV { my ($_class, $_name, $_nick, $_blurb, $_minimum, $_maximum, $_default_value, $_flags) = @_ } -sub boolean { my ($_class, $_name, $_nick, $_blurb, $_default_value, $_flags) = @_ } -sub boxed { my ($_class, $_name, $_nick, $_blurb, $_package, $_flags) = @_ } -sub char { my ($_class, $_name, $_nick, $_blurb, $_minimum, $_maximum, $_default_value, $_flags) = @_ } -sub double { my ($_class, $_name, $_nick, $_blurb, $_minimum, $_maximum, $_default_value, $_flags) = @_ } -sub enum { my ($_class, $_name, $_nick, $_blurb, $_enum_type, $_default_value, $_flags) = @_ } -sub flags { my ($_class, $_name, $_nick, $_blurb, $_flags_type, $_default_value, $_flags) = @_ } -sub float { my ($_class, $_name, $_nick, $_blurb, $_minimum, $_maximum, $_default_value, $_flags) = @_ } -sub get_blurb { my ($_pspec) = @_ } -sub get_flags { my ($_pspec) = @_ } -sub get_name { my ($_pspec) = @_ } -sub get_nick { my ($_pspec) = @_ } -sub get_owner_type { my ($_pspec) = @_ } -sub get_value_type { my ($_pspec) = @_ } -sub int { my ($_class, $_name, $_nick, $_blurb, $_minimum, $_maximum, $_default_value, $_flags) = @_ } -sub int64 { my ($_class, $_name, $_nick, $_blurb, $_minimum, $_maximum, $_default_value, $_flags) = @_ } -sub long { my ($_class, $_name, $_nick, $_blurb, $_minimum, $_maximum, $_default_value, $_flags) = @_ } -sub object { my ($_class, $_name, $_nick, $_blurb, $_package, $_flags) = @_ } -sub param_spec { my ($_class, $_name, $_nick, $_blurb, $_package, $_flags) = @_ } -sub scalar { my ($_class, $_name, $_nick, $_blurb, $_flags) = @_ } -sub string { my ($_class, $_name, $_nick, $_blurb, $_default_value, $_flags) = @_ } -sub uchar { my ($_class, $_name, $_nick, $_blurb, $_minimum, $_maximum, $_default_value, $_flags) = @_ } -sub uint { my ($_class, $_name, $_nick, $_blurb, $_minimum, $_maximum, $_default_value, $_flags) = @_ } -sub uint64 { my ($_class, $_name, $_nick, $_blurb, $_minimum, $_maximum, $_default_value, $_flags) = @_ } -sub ulong { my ($_class, $_name, $_nick, $_blurb, $_minimum, $_maximum, $_default_value, $_flags) = @_ } -sub unichar { my ($_class, $_name, $_nick, $_blurb, $_default_value, $_flags) = @_ } - -package Glib::Source; -our @ISA = qw(); -sub remove { my ($_class, $_tag) = @_ } - -package Glib::Timeout; -our @ISA = qw(); -sub add { my ($_class, $_interval, $_callback, $_o_data, $_o_priority) = @_ } - -package Glib::Type; -our @ISA = qw(); -sub list_ancestors { my ($_class, $_package) = @_ } -sub list_interfaces { my ($_class, $_package) = @_ } -sub list_signals { my ($_class, $_package) = @_ } -sub list_values { my ($_class, $_package) = @_ } -sub package_from_cname { my ($_class, $_cname) = @_ } -sub register { my ($_class, $_parent_class, $_new_class, @_more_paras) = @_ } -sub register_enum { my ($_class, $_name, @_more_paras) = @_ } -sub register_flags { my ($_class, $_name, @_more_paras) = @_ } -sub register_object { my ($_class, $_parent_package, $_new_package, @_more_paras) = @_ } diff --git a/perl_checker_fake_packages/Gnome2.pm b/perl_checker_fake_packages/Gnome2.pm deleted file mode 100644 index 7c6f6bf..0000000 --- a/perl_checker_fake_packages/Gnome2.pm +++ /dev/null @@ -1,641 +0,0 @@ - -package Gnome2; -our @ISA = qw(); -sub CHECK_VERSION { my ($_class, $_major, $_minor, $_micro) = @_ } -sub GET_VERSION_INFO { my ($_class) = @_ } -sub accelerators_sync { my ($_class) = @_ } -sub user_accels_dir_get { my ($_class) = @_ } -sub user_dir_get { my ($_class) = @_ } -sub user_private_dir_get { my ($_class) = @_ } - -package Gnome2::About; -our @ISA = qw(); -sub new { my ($_class, $_name, $_version, $_copyright, $_comments, $_authors, $_o_documenters, $_o_translator_credits, $_o_logo_pixbuf) = @_ } - -package Gnome2::App; -our @ISA = qw(); -sub accel_group { my ($_app) = @_ } -sub add_dock_item { my ($_app, $_item, $_placement, $_band_num, $_band_position, $_offset) = @_ } -sub add_docked { my ($_app, $_widget, $_name, $_behavior, $_placement, $_band_num, $_band_position, $_offset) = @_ } -sub add_toolbar { my ($_app, $_toolbar, $_name, $_behavior, $_placement, $_band_num, $_band_position, $_offset) = @_ } -sub contents { my ($_app) = @_ } -sub create_menus { my ($_app, $_uiinfo) = @_ } -sub create_toolbar { my ($_app, $_uiinfo) = @_ } -sub dock { my ($_app) = @_ } -sub enable_layout_config { my ($_app, $_enable) = @_ } -sub get_dock { my ($_app) = @_ } -sub get_dock_item_by_name { my ($_app, $_name) = @_ } -sub get_enable_layout_config { my ($_app) = @_ } -sub insert_menus { my ($_app, $_path, $_menuinfo) = @_ } -sub install_menu_hints { my ($_app, $_uiinfo) = @_ } -sub layout { my ($_app) = @_ } -sub menubar { my ($_app) = @_ } -sub new { my ($_class, $_appname, $_o_title) = @_ } -sub prefix { my ($_app) = @_ } -sub remove_menu_range { my ($_app, $_path, $_start, $_items) = @_ } -sub remove_menus { my ($_app, $_path, $_items) = @_ } -sub set_contents { my ($_app, $_contents) = @_ } -sub set_menus { my ($_app, $_menubar) = @_ } -sub set_statusbar { my ($_app, $_statusbar) = @_ } -sub set_statusbar_custom { my ($_app, $_container, $_statusbar) = @_ } -sub set_toolbar { my ($_app, $_toolbar) = @_ } -sub setup_toolbar { my ($_class, $_toolbar, $_dock_item) = @_ } -sub statusbar { my ($_app) = @_ } -sub vbox { my ($_app) = @_ } - -package Gnome2::AppBar; -our @ISA = qw(); -sub clear_prompt { my ($_appbar) = @_ } -sub clear_stack { my ($_appbar) = @_ } -sub get_progress { my ($_appbar) = @_ } -sub get_response { my ($_appbar) = @_ } -sub get_status { my ($_appbar) = @_ } -sub install_menu_hints { my ($_appbar, $_uiinfo) = @_ } -sub new { my ($_class, $_has_progress, $_has_status, $_interactivity) = @_ } -sub pop { my ($_appbar) = @_ } -sub push { my ($_appbar, $_status) = @_ } -sub refresh { my ($_appbar) = @_ } -sub set_default { my ($_appbar, $_default_status) = @_ } -sub set_progress_percentage { my ($_appbar, $_percentage) = @_ } -sub set_prompt { my ($_appbar, $_prompt, $_modal) = @_ } -sub set_status { my ($_appbar, $_status) = @_ } - -package Gnome2::AuthenticationManager; -our @ISA = qw(); -sub init { my ($_class) = @_ } - -package Gnome2::Bonobo; -our @ISA = qw(); -sub CHECK_VERSION { my ($_class, $_major, $_minor, $_micro) = @_ } -sub GET_VERSION_INFO { my ($_class) = @_ } - -package Gnome2::Bonobo::Dock; -our @ISA = qw(); -sub add_floating_item { my ($_dock, $_widget, $_x, $_y, $_orientation) = @_ } -sub add_from_layout { my ($_dock, $_layout) = @_ } -sub add_item { my ($_dock, $_item, $_placement, $_band_num, $_position, $_offset, $_in_new_band) = @_ } -sub allow_floating_items { my ($_dock, $_enable) = @_ } -sub get_client_area { my ($_dock) = @_ } -sub get_item_by_name { my ($_dock, $_name) = @_ } -sub get_layout { my ($_dock) = @_ } -sub new { my ($_class) = @_ } -sub set_client_area { my ($_dock, $_widget) = @_ } - -package Gnome2::Bonobo::DockItem; -our @ISA = qw(); -sub get_behavior { my ($_dock_item) = @_ } -sub get_child { my ($_dock_item) = @_ } -sub get_name { my ($_dock_item) = @_ } -sub get_orientation { my ($_dock_item) = @_ } -sub get_shadow_type { my ($_dock_item) = @_ } -sub new { my ($_class, $_name, $_behavior) = @_ } -sub set_orientation { my ($_dock_item, $_orientation) = @_ } -sub set_shadow_type { my ($_dock_item, $_type) = @_ } - -package Gnome2::Client; -our @ISA = qw(); -sub add_static_arg { my ($_client, @_more_paras) = @_ } -sub connect { my ($_client) = @_ } -sub connected { my ($_client) = @_ } -sub disconnect { my ($_client) = @_ } -sub flush { my ($_client) = @_ } -sub get_config_prefix { my ($_client) = @_ } -sub get_desktop_id { my ($_client) = @_ } -sub get_flags { my ($_client) = @_ } -sub get_global_config_prefix { my ($_client) = @_ } -sub get_id { my ($_client) = @_ } -sub get_previous_id { my ($_client) = @_ } -sub interaction_key_return { my ($_class, $_key, $_cancel_shutdown) = @_ } -sub master { my ($_class) = @_ } -sub new { my ($_class) = @_ } -sub new_without_connection { my ($_class) = @_ } -sub request_interaction { my ($_client, $_dialog_type, $_function, $_o_data) = @_ } -sub request_phase_2 { my ($_client) = @_ } -sub request_save { my ($_client, $_save_style, $_shutdown, $_interact_style, $_fast, $_global) = @_ } -sub save_any_dialog { my ($_client, $_dialog) = @_ } -sub save_error_dialog { my ($_client, $_dialog) = @_ } -sub set_clone_command { my ($_client, @_more_paras) = @_ } -sub set_current_directory { my ($_client, $_dir) = @_ } -sub set_discard_command { my ($_client, @_more_paras) = @_ } -sub set_environment { my ($_client, $_name, $_value) = @_ } -sub set_global_config_prefix { my ($_client, $_prefix) = @_ } -sub set_priority { my ($_client, $_priority) = @_ } -sub set_resign_command { my ($_client, @_more_paras) = @_ } -sub set_restart_command { my ($_client, @_more_paras) = @_ } -sub set_restart_style { my ($_client, $_style) = @_ } -sub set_shutdown_command { my ($_client, @_more_paras) = @_ } - -package Gnome2::ColorPicker; -our @ISA = qw(); -sub get_d { my ($_cp) = @_ } -sub get_dither { my ($_cp) = @_ } -sub get_i16 { my ($_cp) = @_ } -sub get_i8 { my ($_cp) = @_ } -sub get_title { my ($_cp) = @_ } -sub get_use_alpha { my ($_cp) = @_ } -sub new { my ($_class) = @_ } -sub set_d { my ($_cp, $_r, $_g, $_b, $_a) = @_ } -sub set_dither { my ($_cp, $_dither) = @_ } -sub set_i16 { my ($_cp, $_r, $_g, $_b, $_a) = @_ } -sub set_i8 { my ($_cp, $_r, $_g, $_b, $_a) = @_ } -sub set_title { my ($_cp, $_title) = @_ } -sub set_use_alpha { my ($_cp, $_use_alpha) = @_ } - -package Gnome2::Config; -our @ISA = qw(); -sub clean_file { my ($_class, $_path) = @_ } -sub clean_key { my ($_class, $_path) = @_ } -sub clean_section { my ($_class, $_path) = @_ } -sub drop_all { my ($_class) = @_ } -sub drop_file { my ($_class, $_path) = @_ } -sub get_bool { my ($_class, $_path) = @_ } -sub get_bool_with_default { my ($_class, $_path) = @_ } -sub get_float { my ($_class, $_path) = @_ } -sub get_float_with_default { my ($_class, $_path) = @_ } -sub get_int { my ($_class, $_path) = @_ } -sub get_int_with_default { my ($_class, $_path) = @_ } -sub get_real_path { my ($_class, $_path) = @_ } -sub get_string { my ($_class, $_path) = @_ } -sub get_string_with_default { my ($_class, $_path) = @_ } -sub get_translated_string { my ($_class, $_path) = @_ } -sub get_translated_string_with_default { my ($_class, $_path) = @_ } -sub get_vector { my ($_class, $_path) = @_ } -sub get_vector_with_default { my ($_class, $_path) = @_ } -sub has_section { my ($_class, $_path) = @_ } -sub init_iterator { my ($_class, $_path) = @_ } -sub init_iterator_sections { my ($_class, $_path) = @_ } -sub pop_prefix { my ($_class) = @_ } -sub push_prefix { my ($_class, $_path) = @_ } -sub set_bool { my ($_class, $_path, $_value) = @_ } -sub set_float { my ($_class, $_path, $_value) = @_ } -sub set_int { my ($_class, $_path, $_value) = @_ } -sub set_string { my ($_class, $_path, $_value) = @_ } -sub set_translated_string { my ($_class, $_path, $_value) = @_ } -sub set_vector { my ($_class, $_path, $_value) = @_ } -sub sync { my ($_class) = @_ } -sub sync_file { my ($_class, $_path) = @_ } - -package Gnome2::Config::Iterator; -our @ISA = qw(); -sub DESTROY { my ($_handle) = @_ } -sub next { my ($_handle) = @_ } - -package Gnome2::Config::Private; -our @ISA = qw(); -sub clean_file { my ($_class, $_path) = @_ } -sub clean_key { my ($_class, $_path) = @_ } -sub clean_section { my ($_class, $_path) = @_ } -sub drop_file { my ($_class, $_path) = @_ } -sub get_bool { my ($_class, $_path) = @_ } -sub get_bool_with_default { my ($_class, $_path) = @_ } -sub get_float { my ($_class, $_path) = @_ } -sub get_float_with_default { my ($_class, $_path) = @_ } -sub get_int { my ($_class, $_path) = @_ } -sub get_int_with_default { my ($_class, $_path) = @_ } -sub get_real_path { my ($_class, $_path) = @_ } -sub get_string { my ($_class, $_path) = @_ } -sub get_string_with_default { my ($_class, $_path) = @_ } -sub get_translated_string { my ($_class, $_path) = @_ } -sub get_translated_string_with_default { my ($_class, $_path) = @_ } -sub get_vector { my ($_class, $_path) = @_ } -sub get_vector_with_default { my ($_class, $_path) = @_ } -sub has_section { my ($_class, $_path) = @_ } -sub init_iterator { my ($_class, $_path) = @_ } -sub init_iterator_sections { my ($_class, $_path) = @_ } -sub set_bool { my ($_class, $_path, $_value) = @_ } -sub set_float { my ($_class, $_path, $_value) = @_ } -sub set_int { my ($_class, $_path, $_value) = @_ } -sub set_string { my ($_class, $_path, $_value) = @_ } -sub set_translated_string { my ($_class, $_path, $_value) = @_ } -sub set_vector { my ($_class, $_path, $_value) = @_ } -sub sync_file { my ($_class, $_path) = @_ } - -package Gnome2::DateEdit; -our @ISA = qw(); -sub get_flags { my ($_gde) = @_ } -sub get_initial_time { my ($_gde) = @_ } -sub get_time { my ($_gde) = @_ } -sub new { my ($_class, $_the_time, $_show_time, $_use_24_format) = @_ } -sub new_flags { my ($_class, $_the_time, $_flags) = @_ } -sub set_flags { my ($_gde, $_flags) = @_ } -sub set_popup_range { my ($_gde, $_low_hour, $_up_hour) = @_ } -sub set_time { my ($_gde, $_the_time) = @_ } - -package Gnome2::Druid; -our @ISA = qw(); -sub append_page { my ($_druid, $_page) = @_ } -sub back { my ($_druid) = @_ } -sub cancel { my ($_druid) = @_ } -sub finish { my ($_druid) = @_ } -sub help { my ($_druid) = @_ } -sub insert_page { my ($_druid, $_back_page, $_page) = @_ } -sub new { my ($_class) = @_ } -sub new_with_window { my ($_class, $_title, $_parent, $_close_on_cancel) = @_ } -sub next { my ($_druid) = @_ } -sub prepend_page { my ($_druid, $_page) = @_ } -sub set_buttons_sensitive { my ($_druid, $_back_sensitive, $_next_sensitive, $_cancel_sensitive, $_help_sensitive) = @_ } -sub set_page { my ($_druid, $_page) = @_ } -sub set_show_finish { my ($_druid, $_show_finish) = @_ } -sub set_show_help { my ($_druid, $_show_help) = @_ } - -package Gnome2::DruidPage; -our @ISA = qw(); -sub back { my ($_druid_page) = @_ } -sub cancel { my ($_druid_page) = @_ } -sub finish { my ($_druid_page) = @_ } -sub new { my ($_class) = @_ } -sub next { my ($_druid_page) = @_ } -sub prepare { my ($_druid_page) = @_ } - -package Gnome2::DruidPageEdge; -our @ISA = qw(); -sub new { my ($_class, $_position) = @_ } -sub new_aa { my ($_class, $_position) = @_ } -sub new_with_vals { my ($_class, $_position, $_antialiased, $_o_title, $_o_text, $_o_logo, $_o_watermark, $_o_top_watermark) = @_ } -sub set_bg_color { my ($_druid_page_edge, $_color) = @_ } -sub set_logo { my ($_druid_page_edge, $_logo_image) = @_ } -sub set_logo_bg_color { my ($_druid_page_edge, $_color) = @_ } -sub set_text { my ($_druid_page_edge, $_text) = @_ } -sub set_text_color { my ($_druid_page_edge, $_color) = @_ } -sub set_textbox_color { my ($_druid_page_edge, $_color) = @_ } -sub set_title { my ($_druid_page_edge, $_title) = @_ } -sub set_title_color { my ($_druid_page_edge, $_color) = @_ } -sub set_top_watermark { my ($_druid_page_edge, $_top_watermark_image) = @_ } -sub set_watermark { my ($_druid_page_edge, $_watermark) = @_ } - -package Gnome2::DruidPageStandard; -our @ISA = qw(); -sub append_item { my ($_druid_page_standard, $_question, $_item, $_additional_info) = @_ } -sub new { my ($_class) = @_ } -sub new_with_vals { my ($_class, $_title, $_o_logo, $_o_top_watermark) = @_ } -sub set_background { my ($_druid_page_standard, $_color) = @_ } -sub set_contents_background { my ($_druid_page_standard, $_color) = @_ } -sub set_logo { my ($_druid_page_standard, $_logo_image) = @_ } -sub set_logo_background { my ($_druid_page_standard, $_color) = @_ } -sub set_title { my ($_druid_page_standard, $_title) = @_ } -sub set_title_foreground { my ($_druid_page_standard, $_color) = @_ } -sub set_top_watermark { my ($_druid_page_standard, $_top_watermark_image) = @_ } -sub vbox { my ($_druid_page_standard) = @_ } - -package Gnome2::Entry; -our @ISA = qw(); -sub append_history { my ($_gentry, $_save, $_text) = @_ } -sub clear_history { my ($_gentry) = @_ } -sub get_history_id { my ($_gentry) = @_ } -sub get_max_saved { my ($_gentry) = @_ } -sub gtk_entry { my ($_gentry) = @_ } -sub new { my ($_class, $_o_history_id) = @_ } -sub prepend_history { my ($_gentry, $_save, $_text) = @_ } -sub set_history_id { my ($_gentry, $_history_id) = @_ } -sub set_max_saved { my ($_gentry, $_max_saved) = @_ } - -package Gnome2::FileEntry; -our @ISA = qw(); -sub get_directory_entry { my ($_fentry) = @_ } -sub get_full_path { my ($_fentry, $_file_must_exist) = @_ } -sub get_modal { my ($_fentry) = @_ } -sub gnome_entry { my ($_fentry) = @_ } -sub gtk_entry { my ($_fentry) = @_ } -sub new { my ($_class, $_history_id, $_browse_dialog_title) = @_ } -sub set_default_path { my ($_fentry, $_path) = @_ } -sub set_directory_entry { my ($_fentry, $_directory_entry) = @_ } -sub set_filename { my ($_fentry, $_filename) = @_ } -sub set_modal { my ($_fentry, $_is_modal) = @_ } -sub set_title { my ($_fentry, $_browse_dialog_title) = @_ } - -package Gnome2::FontPicker; -our @ISA = qw(); -sub fi_set_show_size { my ($_gfp, $_show_size) = @_ } -sub fi_set_use_font_in_label { my ($_gfp, $_use_font_in_label, $_size) = @_ } -sub get_font_name { my ($_gfp) = @_ } -sub get_mode { my ($_gfp) = @_ } -sub get_preview_text { my ($_gfp) = @_ } -sub get_title { my ($_gfp) = @_ } -sub new { my ($_class) = @_ } -sub set_font_name { my ($_gfp, $_fontname) = @_ } -sub set_mode { my ($_gfp, $_mode) = @_ } -sub set_preview_text { my ($_gfp, $_text) = @_ } -sub set_title { my ($_gfp, $_title) = @_ } -sub uw_get_widget { my ($_gfp) = @_ } -sub uw_set_widget { my ($_gfp, $_widget) = @_ } - -package Gnome2::GConf; -our @ISA = qw(); -sub get_app_settings_relative { my ($_class, $_program, $_subkey) = @_ } -sub get_gnome_libs_settings_relative { my ($_class, $_subkey) = @_ } - -package Gnome2::HRef; -our @ISA = qw(); -sub get_label { my ($_href) = @_ } -sub get_text { my ($_href) = @_ } -sub get_url { my ($_href) = @_ } -sub new { my ($_class, $_url, $_text) = @_ } -sub set_label { my ($_href, $_label) = @_ } -sub set_text { my ($_href, $_text) = @_ } -sub set_url { my ($_href, $_url) = @_ } - -package Gnome2::Help; -our @ISA = qw(); -sub display { my ($_class, $_file_name, $_o_link_id) = @_ } -sub display_desktop { my ($_class, $_program, $_doc_id, $_file_name, $_o_link_id) = @_ } -sub display_desktop_with_env { my ($_class, $_program, $_doc_id, $_file_name, $_link_id, $_env_ref) = @_ } - -package Gnome2::I18N; -our @ISA = qw(); -sub get_language_list { my ($_class, $_o_category_name) = @_ } -sub pop_c_numeric_locale { my ($_class) = @_ } -sub push_c_numeric_locale { my ($_class) = @_ } - -package Gnome2::IconEntry; -our @ISA = qw(); -sub get_filename { my ($_ientry) = @_ } -sub new { my ($_class, $_history_id, $_browse_dialog_title) = @_ } -sub pick_dialog { my ($_ientry) = @_ } -sub set_browse_dialog_title { my ($_ientry, $_browse_dialog_title) = @_ } -sub set_filename { my ($_ientry, $_filename) = @_ } -sub set_history_id { my ($_ientry, $_history_id) = @_ } -sub set_max_saved { my ($_ientry, $_max_saved) = @_ } -sub set_pixmap_subdir { my ($_ientry, $_subdir) = @_ } - -package Gnome2::IconList; -our @ISA = qw(); -sub append { my ($_gil, $_icon_filename, $_text) = @_ } -sub append_pixbuf { my ($_gil, $_im, $_icon_filename, $_text) = @_ } -sub clear { my ($_gil) = @_ } -sub find_icon_from_filename { my ($_gil, $_filename) = @_ } -sub focus_icon { my ($_gil, $_idx) = @_ } -sub freeze { my ($_gil) = @_ } -sub get_icon_at { my ($_gil, $_x, $_y) = @_ } -sub get_icon_filename { my ($_gil, $_idx) = @_ } -sub get_icon_pixbuf_item { my ($_gil, $_idx) = @_ } -sub get_icon_text_item { my ($_gil, $_idx) = @_ } -sub get_items_per_line { my ($_gil) = @_ } -sub get_num_icons { my ($_gil) = @_ } -sub get_selection { my ($_gil) = @_ } -sub get_selection_mode { my ($_gil) = @_ } -sub icon_is_visible { my ($_gil, $_pos) = @_ } -sub insert { my ($_gil, $_pos, $_icon_filename, $_text) = @_ } -sub insert_pixbuf { my ($_gil, $_pos, $_im, $_icon_filename, $_text) = @_ } -sub moveto { my ($_gil, $_pos, $_yalign) = @_ } -sub new { my ($_class, $_icon_width, $_adj, $_flags) = @_ } -sub remove { my ($_gil, $_pos) = @_ } -sub select_icon { my ($_gil, $_pos) = @_ } -sub set_col_spacing { my ($_gil, $_pixels) = @_ } -sub set_hadjustment { my ($_gil, $_hadj) = @_ } -sub set_icon_border { my ($_gil, $_pixels) = @_ } -sub set_icon_width { my ($_gil, $_w) = @_ } -sub set_row_spacing { my ($_gil, $_pixels) = @_ } -sub set_selection_mode { my ($_gil, $_mode) = @_ } -sub set_separators { my ($_gil, $_sep) = @_ } -sub set_text_spacing { my ($_gil, $_pixels) = @_ } -sub set_vadjustment { my ($_gil, $_vadj) = @_ } -sub thaw { my ($_gil) = @_ } -sub unselect_all { my ($_gil) = @_ } -sub unselect_icon { my ($_gil, $_pos) = @_ } - -package Gnome2::IconSelection; -our @ISA = qw(); -sub add_defaults { my ($_gis) = @_ } -sub add_directory { my ($_gis, $_dir) = @_ } -sub clear { my ($_gis, $_not_shown) = @_ } -sub get_box { my ($_gis) = @_ } -sub get_gil { my ($_gis) = @_ } -sub get_icon { my ($_gis, $_full_path) = @_ } -sub new { my ($_class) = @_ } -sub select_icon { my ($_gis, $_filename) = @_ } -sub show_icons { my ($_gis) = @_ } -sub stop_loading { my ($_gis) = @_ } - -package Gnome2::IconTextItem; -our @ISA = qw(); -sub configure { my ($_iti, $_x, $_y, $_width, $_fontname, $_text, $_is_editable, $_is_static) = @_ } -sub focus { my ($_iti, $_focused) = @_ } -sub get_editable { my ($_iti) = @_ } -sub get_text { my ($_iti) = @_ } -sub select { my ($_iti, $_sel) = @_ } -sub setxy { my ($_iti, $_x, $_y) = @_ } -sub start_editing { my ($_iti) = @_ } -sub stop_editing { my ($_iti, $_accept) = @_ } - -package Gnome2::IconTheme; -our @ISA = qw(); -sub append_search_path { my ($_theme, $_path) = @_ } -sub get_allow_svg { my ($_theme) = @_ } -sub get_example_icon_name { my ($_theme) = @_ } -sub get_search_path { my ($_theme) = @_ } -sub has_icon { my ($_theme, $_icon_name) = @_ } -sub list_icons { my ($_theme, $_o_context) = @_ } -sub lookup { my ($_icon_theme, $_thumbnail_factory, $_file_uri, $_custom_icon, $_file_info, $_mime_type, $_flags) = @_ } -sub lookup_icon { my ($_theme, $_icon_name, $_size) = @_ } -sub lookup_sync { my ($_icon_theme, $_thumbnail_factory, $_file_uri, $_custom_icon, $_flags) = @_ } -sub new { my ($_class) = @_ } -sub prepend_search_path { my ($_theme, $_path) = @_ } -sub rescan_if_needed { my ($_theme) = @_ } -sub set_allow_svg { my ($_theme, $_allow_svg) = @_ } -sub set_custom_theme { my ($_theme, $_theme_name) = @_ } -sub set_search_path { my ($_theme, @_more_paras) = @_ } - -package Gnome2::ModuleInfo; -our @ISA = qw(); -sub bonobo { my ($_class) = @_ } -sub description { my ($_module_info) = @_ } -sub libgnome { my ($_class) = @_ } -sub libgnomeui { my ($_class) = @_ } -sub name { my ($_module_info) = @_ } -sub opt_prefix { my ($_module_info) = @_ } -sub version { my ($_module_info) = @_ } - -package Gnome2::PasswordDialog; -our @ISA = qw(); -sub get_domain { my ($_password_dialog) = @_ } -sub get_password { my ($_password_dialog) = @_ } -sub get_remember { my ($_password_dialog) = @_ } -sub get_username { my ($_password_dialog) = @_ } -sub new { my ($_class, $_dialog_title, $_message, $_username, $_password, $_readonly_username) = @_ } -sub run_and_block { my ($_password_dialog) = @_ } -sub set_domain { my ($_password_dialog, $_domain) = @_ } -sub set_password { my ($_password_dialog, $_password) = @_ } -sub set_readonly_domain { my ($_password_dialog, $_readonly) = @_ } -sub set_readonly_username { my ($_password_dialog, $_readonly) = @_ } -sub set_remember { my ($_password_dialog, $_remember) = @_ } -sub set_show_domain { my ($_password_dialog, $_show) = @_ } -sub set_show_password { my ($_password_dialog, $_show) = @_ } -sub set_show_remember { my ($_password_dialog, $_show_remember) = @_ } -sub set_show_username { my ($_password_dialog, $_show) = @_ } -sub set_username { my ($_password_dialog, $_username) = @_ } - -package Gnome2::PixmapEntry; -our @ISA = qw(); -sub get_filename { my ($_pentry) = @_ } -sub new { my ($_class, $_history_id, $_browse_dialog_title, $_do_preview) = @_ } -sub preview_widget { my ($_pentry) = @_ } -sub scrolled_window { my ($_pentry) = @_ } -sub set_pixmap_subdir { my ($_pentry, $_subdir) = @_ } -sub set_preview { my ($_pentry, $_do_preview) = @_ } -sub set_preview_size { my ($_pentry, $_preview_w, $_preview_h) = @_ } - -package Gnome2::PopupMenu; -our @ISA = qw(); -sub new { my ($_class, $_uiinfo, $_o_accelgroup) = @_ } -sub new_with_accelgroup { my ($_class, $_uiinfo, $_o_accelgroup) = @_ } - -package Gnome2::Program; -our @ISA = qw(); -sub get_app_id { my ($_program) = @_ } -sub get_app_version { my ($_program) = @_ } -sub get_human_readable_name { my ($_program) = @_ } -sub get_program { my ($_class) = @_ } -sub init { my ($_class, $_app_id, $_app_version, $_o_module_info, @_more_paras) = @_ } -sub locate_file { my ($_program, $_domain, $_file_name, $_only_if_exists) = @_ } -sub module_load { my ($_class, $_mod_name) = @_ } -sub module_register { my ($_class, $_module_info) = @_ } -sub module_registered { my ($_class, $_module_info) = @_ } - -package Gnome2::Score; -our @ISA = qw(); -sub get_notable { my ($_class, $_gamename, $_level) = @_ } -sub init { my ($_class, $_gamename) = @_ } -sub log { my ($_class, $_score, $_level, $_higher_to_lower_score_order) = @_ } - -package Gnome2::Scores; -our @ISA = qw(); -sub display { my ($_class, $_title, $_app_name, $_level, $_pos) = @_ } -sub display_with_pixmap { my ($_class, $_pixmap_logo, $_app_name, $_level, $_pos) = @_ } -sub new { my ($_class, $_names, $_scores, $_times, $_clear) = @_ } -sub set_color { my ($_gs, $_n, $_col) = @_ } -sub set_colors { my ($_gs, $_col) = @_ } -sub set_current_player { my ($_gs, $_i) = @_ } -sub set_def_color { my ($_gs, $_col) = @_ } -sub set_logo_label { my ($_gs, $_txt, $_font, $_col) = @_ } -sub set_logo_label_title { my ($_gs, $_txt) = @_ } -sub set_logo_pixmap { my ($_gs, $_pix_name) = @_ } -sub set_logo_widget { my ($_gs, $_w) = @_ } - -package Gnome2::Sound; -our @ISA = qw(); -sub connection_get { my ($_class) = @_ } -sub init { my ($_class, $_o_hostname) = @_ } -sub play { my ($_class, $_filename) = @_ } -sub sample_load { my ($_class, $_sample_name, $_filename) = @_ } -sub shutdown { my ($_class) = @_ } - -package Gnome2::ThumbnailFactory; -our @ISA = qw(); -sub can_thumbnail { my ($_factory, $_uri, $_mime_type, $_mtime) = @_ } -sub create_failed_thumbnail { my ($_factory, $_uri, $_mtime) = @_ } -sub generate_thumbnail { my ($_factory, $_uri, $_mime_type) = @_ } -sub has_valid_failed_thumbnail { my ($_factory, $_uri, $_mtime) = @_ } -sub lookup { my ($_factory, $_uri, $_mtime) = @_ } -sub new { my ($_class, $_size) = @_ } -sub save_thumbnail { my ($_factory, $_thumbnail, $_uri, $_original_mtime) = @_ } - -package Gnome2::UIDefs; -our @ISA = qw(); -sub key_mod_clear { my ($_class) = @_ } -sub key_mod_close { my ($_class) = @_ } -sub key_mod_close_window { my ($_class) = @_ } -sub key_mod_copy { my ($_class) = @_ } -sub key_mod_cut { my ($_class) = @_ } -sub key_mod_find { my ($_class) = @_ } -sub key_mod_find_again { my ($_class) = @_ } -sub key_mod_new { my ($_class) = @_ } -sub key_mod_new_game { my ($_class) = @_ } -sub key_mod_new_window { my ($_class) = @_ } -sub key_mod_open { my ($_class) = @_ } -sub key_mod_paste { my ($_class) = @_ } -sub key_mod_pause_game { my ($_class) = @_ } -sub key_mod_print { my ($_class) = @_ } -sub key_mod_print_setup { my ($_class) = @_ } -sub key_mod_quit { my ($_class) = @_ } -sub key_mod_redo { my ($_class) = @_ } -sub key_mod_redo_move { my ($_class) = @_ } -sub key_mod_replace { my ($_class) = @_ } -sub key_mod_save { my ($_class) = @_ } -sub key_mod_save_as { my ($_class) = @_ } -sub key_mod_select_all { my ($_class) = @_ } -sub key_mod_undo { my ($_class) = @_ } -sub key_mod_undo_move { my ($_class) = @_ } -sub key_name_clear { my ($_class) = @_ } -sub key_name_close { my ($_class) = @_ } -sub key_name_close_window { my ($_class) = @_ } -sub key_name_copy { my ($_class) = @_ } -sub key_name_cut { my ($_class) = @_ } -sub key_name_find { my ($_class) = @_ } -sub key_name_find_again { my ($_class) = @_ } -sub key_name_new { my ($_class) = @_ } -sub key_name_new_game { my ($_class) = @_ } -sub key_name_new_window { my ($_class) = @_ } -sub key_name_open { my ($_class) = @_ } -sub key_name_paste { my ($_class) = @_ } -sub key_name_pause_game { my ($_class) = @_ } -sub key_name_print { my ($_class) = @_ } -sub key_name_print_setup { my ($_class) = @_ } -sub key_name_quit { my ($_class) = @_ } -sub key_name_redo { my ($_class) = @_ } -sub key_name_redo_move { my ($_class) = @_ } -sub key_name_replace { my ($_class) = @_ } -sub key_name_save { my ($_class) = @_ } -sub key_name_save_as { my ($_class) = @_ } -sub key_name_select_all { my ($_class) = @_ } -sub key_name_undo { my ($_class) = @_ } -sub key_name_undo_move { my ($_class) = @_ } -sub pad { my ($_class) = @_ } -sub pad_big { my ($_class) = @_ } -sub pad_small { my ($_class) = @_ } - -package Gnome2::URL; -our @ISA = qw(); -sub show { my ($_class, $_url) = @_ } -sub show_with_env { my ($_class, $_url, $_env_ref) = @_ } - -package Gnome2::Util; -our @ISA = qw(); -sub extension { my ($_class, $_path) = @_ } -sub home_file { my ($_class, $_file) = @_ } -sub prepend_user_home { my ($_class, $_file) = @_ } -sub user_shell { my ($_class) = @_ } - -package Gnome2::WindowIcon; -our @ISA = qw(); -sub init { my ($_class) = @_ } -sub set_default_from_file { my ($_class, $_filename) = @_ } -sub set_default_from_file_list { my ($_class, $_filenames_ref) = @_ } -sub set_from_default { my ($_class, $_w) = @_ } -sub set_from_file { my ($_class, $_w, $_filename) = @_ } -sub set_from_file_list { my ($_class, $_w, $_filenames_ref) = @_ } - -package Gtk2::Gdk::Pixbuf; -our @ISA = qw(); -sub has_uri { my ($_pixbuf, $_uri) = @_ } -sub is_valid { my ($_pixbuf, $_uri, $_mtime) = @_ } -sub md5 { my ($_class, $_uri) = @_ } -sub path_for_uri { my ($_class, $_uri, $_size) = @_ } -sub scale_down_pixbuf { my ($_pixbuf, $_dest_width, $_dest_height) = @_ } - -package Gtk2::Menu; -our @ISA = qw(); -sub append_from { my ($_popup, $_uiinfo) = @_ } -sub attach_to { my ($_popup, $_widget, $_o_user_data) = @_ } -sub do_popup { my ($_popup, $_pos_func, $_pos_data, $_event, $_user_data, $_for_widget) = @_ } -sub do_popup_modal { my ($_popup, $_pos_func, $_pos_data, $_event, $_user_data, $_for_widget) = @_ } - -package Gtk2::MenuShell; -our @ISA = qw(); -sub fill_menu { my ($_menu_shell, $_uiinfo, $_accel_group, $_uline_accels, $_pos) = @_ } -sub find_menu_pos { my ($_parent, $_path) = @_ } - -package Gtk2::Statusbar; -our @ISA = qw(); -sub install_menu_hints { my ($_bar, $_uiinfo) = @_ } - -package Gtk2::Toolbar; -our @ISA = qw(); -sub fill_toolbar { my ($_toolbar, $_uiinfo, $_accel_group) = @_ } - -package Gtk2::Widget; -our @ISA = qw(); -sub add_popup_items { my ($_widget, $_uiinfo, $_o_user_data) = @_ } - -package Gtk2::Window; -our @ISA = qw(); -sub toplevel_set_title { my ($_window, $_doc_name, $_app_name, $_extension) = @_ } diff --git a/perl_checker_fake_packages/Gnome2/Vte.pm b/perl_checker_fake_packages/Gnome2/Vte.pm deleted file mode 100644 index 598c405..0000000 --- a/perl_checker_fake_packages/Gnome2/Vte.pm +++ /dev/null @@ -1,72 +0,0 @@ - -package Gnome2::Vte; -our @ISA = qw(); -sub CHECK_VERSION { my ($_class, $_major, $_minor, $_micro) = @_ } -sub GET_VERSION_INFO { my ($_class) = @_ } - -package Gnome2::Vte::Terminal; -our @ISA = qw(); -sub copy_clipboard { my ($_terminal) = @_ } -sub copy_primary { my ($_terminal) = @_ } -sub feed { my ($_terminal, $_data) = @_ } -sub feed_child { my ($_terminal, $_data) = @_ } -sub fork_command { my ($_terminal, $_command, $_arg_ref, $_env_ref, $_directory, $_lastlog, $_utmp, $_wtmp) = @_ } -sub get_adjustment { my ($_terminal) = @_ } -sub get_allow_bold { my ($_terminal) = @_ } -sub get_audible_bell { my ($_terminal) = @_ } -sub get_char_ascent { my ($_terminal) = @_ } -sub get_char_descent { my ($_terminal) = @_ } -sub get_char_height { my ($_terminal) = @_ } -sub get_char_width { my ($_terminal) = @_ } -sub get_column_count { my ($_terminal) = @_ } -sub get_cursor_position { my ($_terminal) = @_ } -sub get_emulation { my ($_terminal) = @_ } -sub get_encoding { my ($_terminal) = @_ } -sub get_font { my ($_terminal) = @_ } -sub get_has_selection { my ($_terminal) = @_ } -sub get_icon_title { my ($_terminal) = @_ } -sub get_mouse_autohide { my ($_terminal) = @_ } -sub get_padding { my ($_terminal) = @_ } -sub get_row_count { my ($_terminal) = @_ } -sub get_status_line { my ($_terminal) = @_ } -sub get_text { my ($_terminal, $_func, $_o_data) = @_ } -sub get_text_range { my ($_terminal, $_start_row, $_start_col, $_end_row, $_end_col, $_func, $_o_data) = @_ } -sub get_using_xft { my ($_terminal) = @_ } -sub get_visible_bell { my ($_terminal) = @_ } -sub get_window_title { my ($_terminal) = @_ } -sub im_append_menuitems { my ($_terminal, $_menushell) = @_ } -sub is_word_char { my ($_terminal, $_c) = @_ } -sub match_add { my ($_terminal, $_match) = @_ } -sub match_check { my ($_terminal, $_column, $_row) = @_ } -sub match_clear_all { my ($_terminal) = @_ } -sub match_remove { my ($_terminal, $_tag) = @_ } -sub new { my ($_class) = @_ } -sub paste_clipboard { my ($_terminal) = @_ } -sub paste_primary { my ($_terminal) = @_ } -sub reset { my ($_terminal, $_full, $_clear_history) = @_ } -sub set_allow_bold { my ($_terminal, $_allow_bold) = @_ } -sub set_audible_bell { my ($_terminal, $_is_audible) = @_ } -sub set_background_image { my ($_terminal, $_image) = @_ } -sub set_background_image_file { my ($_terminal, $_path) = @_ } -sub set_background_saturation { my ($_terminal, $_saturation) = @_ } -sub set_background_transparent { my ($_terminal, $_transparent) = @_ } -sub set_backspace_binding { my ($_terminal, $_binding) = @_ } -sub set_color_background { my ($_terminal, $_background) = @_ } -sub set_color_bold { my ($_terminal, $_bold) = @_ } -sub set_color_dim { my ($_terminal, $_dim) = @_ } -sub set_color_foreground { my ($_terminal, $_foreground) = @_ } -sub set_colors { my ($_terminal, $_foreground, $_background, $_palette_ref) = @_ } -sub set_cursor_blinks { my ($_terminal, $_blink) = @_ } -sub set_default_colors { my ($_terminal) = @_ } -sub set_delete_binding { my ($_terminal, $_binding) = @_ } -sub set_emulation { my ($_terminal, $_emulation) = @_ } -sub set_encoding { my ($_terminal, $_codeset) = @_ } -sub set_font { my ($_terminal, $_font_desc) = @_ } -sub set_font_from_string { my ($_terminal, $_name) = @_ } -sub set_mouse_autohide { my ($_terminal, $_setting) = @_ } -sub set_scroll_on_keystroke { my ($_terminal, $_scroll) = @_ } -sub set_scroll_on_output { my ($_terminal, $_scroll) = @_ } -sub set_scrollback_lines { my ($_terminal, $_lines) = @_ } -sub set_size { my ($_terminal, $_columns, $_rows) = @_ } -sub set_visible_bell { my ($_terminal, $_is_visible) = @_ } -sub set_word_chars { my ($_terminal, $_spec) = @_ } diff --git a/perl_checker_fake_packages/Gtk2.pm b/perl_checker_fake_packages/Gtk2.pm deleted file mode 100644 index 6b25db6..0000000 --- a/perl_checker_fake_packages/Gtk2.pm +++ /dev/null @@ -1,3742 +0,0 @@ -package Gtk2; -use Glib; - -package Gnome2::Pango::Language; -our @ISA = qw(); -sub matches { my ($_language, $_range_list) = @_ } - -package Gtk2; -our @ISA = qw(); -sub CHECK_VERSION { my ($_class, $_required_major, $_required_minor, $_required_micro) = @_ } -sub GET_VERSION_INFO { my ($_class) = @_ } -sub MAJOR_VERSION() {} -sub MICRO_VERSION() {} -sub MINOR_VERSION() {} -sub alternative_dialog_button_order { my ($_class, $_o_screen) = @_ } -sub check_version { my ($_class, $_required_major, $_required_minor, $_required_micro) = @_ } -sub disable_setlocale { my ($_class) = @_ } -sub draw_insertion_cursor { my ($_class, $_widget, $_drawable, $_area, $_location, $_is_primary, $_direction, $_draw_arrow) = @_ } -sub events_pending { my ($_class) = @_ } -sub get_current_event { my ($_class) = @_ } -sub get_current_event_state { my ($_class) = @_ } -sub get_current_event_time { my ($_class) = @_ } -sub get_default_language { my ($_class) = @_ } -sub get_event_widget { my ($_class, $_event) = @_ } -sub get_version_info { my ($_class) = @_ } -sub grab_add { my ($_class, $_widget) = @_ } -sub grab_get_current { my ($_class) = @_ } -sub grab_remove { my ($_class, $_widget) = @_ } -sub init { my ($_o_class) = @_ } -sub init_add { my ($_class, $_function, $_o_data) = @_ } -sub init_check { my ($_o_class) = @_ } -sub key_snooper_install { my ($_class, $_snooper, $_o_func_data) = @_ } -sub key_snooper_remove { my ($_class, $_snooper_handler_id) = @_ } -sub main { my ($_class) = @_ } -sub main_do_event { my ($_class, $_event) = @_ } -sub main_iteration { my ($_class) = @_ } -sub main_iteration_do { my ($_class, $_blocking) = @_ } -sub main_level { my ($_class) = @_ } -sub main_quit { my ($_o_class) = @_ } -sub major_version() {} -sub micro_version() {} -sub minor_version() {} -sub parse_args { my ($_o_class) = @_ } -sub quit_add { my ($_class, $_main_level, $_function, $_o_data) = @_ } -sub quit_add_destroy { my ($_class, $_main_level, $_object) = @_ } -sub quit_remove { my ($_class, $_quit_handler_id) = @_ } -sub set_locale { my ($_class) = @_ } -sub show_about_dialog { my ($_class, $_parent, $_first_property_name, @_more_paras) = @_ } - -package Gtk2::AboutDialog; -our @ISA = qw(); -sub get_artists { my ($_about) = @_ } -sub get_authors { my ($_about) = @_ } -sub get_comments { my ($_about) = @_ } -sub get_copyright { my ($_about) = @_ } -sub get_documenters { my ($_about) = @_ } -sub get_license { my ($_about) = @_ } -sub get_logo { my ($_about) = @_ } -sub get_logo_icon_name { my ($_about) = @_ } -sub get_name { my ($_about) = @_ } -sub get_translator_credits { my ($_about) = @_ } -sub get_version { my ($_about) = @_ } -sub get_website { my ($_about) = @_ } -sub get_website_label { my ($_about) = @_ } -sub get_wrap_license { my ($_about) = @_ } -sub new { my ($_class) = @_ } -sub set_artists { my ($_about, $_artist1, @_more_paras) = @_ } -sub set_authors { my ($_about, $_author1, @_more_paras) = @_ } -sub set_comments { my ($_about, $_comments) = @_ } -sub set_copyright { my ($_about, $_copyright) = @_ } -sub set_documenters { my ($_about, $_documenter1, @_more_paras) = @_ } -sub set_email_hook { my ($_class, $_func, $_o_data) = @_ } -sub set_license { my ($_about, $_license) = @_ } -sub set_logo { my ($_about, $_logo) = @_ } -sub set_logo_icon_name { my ($_about, $_icon_name) = @_ } -sub set_name { my ($_about, $_name) = @_ } -sub set_translator_credits { my ($_about, $_translator_credits) = @_ } -sub set_url_hook { my ($_class, $_func, $_o_data) = @_ } -sub set_version { my ($_about, $_version) = @_ } -sub set_website { my ($_about, $_website) = @_ } -sub set_website_label { my ($_about, $_website_label) = @_ } -sub set_wrap_license { my ($_about, $_wrap_license) = @_ } - -package Gtk2::AccelGroup; -our @ISA = qw(); -sub connect { my ($_accel_group, $_accel_key, $_accel_mods, $_accel_flags, $_func) = @_ } -sub connect_by_path { my ($_accel_group, $_accel_path, $_func) = @_ } -sub disconnect { my ($_accel_group, $_func) = @_ } -sub disconnect_key { my ($_accel_group, $_accel_key, $_accel_mods) = @_ } -sub lock { my ($_accel_group) = @_ } -sub new { my ($_class) = @_ } -sub unlock { my ($_accel_group) = @_ } - -package Gtk2::AccelGroups; -our @ISA = qw(); -sub activate { my ($_class, $_object, $_accel_key, $_accel_mods) = @_ } -sub from_object { my ($_class, $_object) = @_ } - -package Gtk2::AccelLabel; -our @ISA = qw(); -sub get_accel_widget { my ($_accel_label) = @_ } -sub get_accel_width { my ($_accel_label) = @_ } -sub new { my ($_class, $_string) = @_ } -sub refetch { my ($_accel_label) = @_ } -sub set_accel_widget { my ($_accel_label, $_accel_widget) = @_ } - -package Gtk2::AccelMap; -our @ISA = qw(); -sub add_entry { my ($_class, $_accel_path, $_accel_key, $_accel_mods) = @_ } -sub add_filter { my ($_class, $_filter_pattern) = @_ } -sub change_entry { my ($_class, $_accel_path, $_accel_key, $_accel_mods, $_replace) = @_ } -sub Gtk2::AccelMap::foreach { my ($_class, $_data, $_foreach_func) = @_ } -sub foreach_unfiltered { my ($_class, $_data, $_foreach_func) = @_ } -sub get { my ($_class) = @_ } -sub load { my ($_class, $_file_name) = @_ } -sub load_fd { my ($_class, $_fd) = @_ } -sub lock_path { my ($_class, $_accel_path) = @_ } -sub lookup_entry { my ($_class, $_accel_path) = @_ } -sub save { my ($_class, $_file_name) = @_ } -sub save_fd { my ($_class, $_fd) = @_ } -sub unlock_path { my ($_class, $_accel_path) = @_ } - -package Gtk2::Accelerator; -our @ISA = qw(); -sub get_default_mod_mask { my ($_class) = @_ } -sub get_label { my ($_class, $_accelerator_key, $_accelerator_mods) = @_ } -sub name { my ($_class, $_accelerator_key, $_accelerator_mods) = @_ } -sub parse { my ($_class, $_accelerator) = @_ } -sub set_default_mod_mask { my ($_class, $_default_mod_mask) = @_ } -sub valid { my ($_class, $_keyval, $_modifiers) = @_ } - -package Gtk2::Action; -our @ISA = qw(); -sub activate { my ($_action) = @_ } -sub block_activate_from { my ($_action, $_proxy) = @_ } -sub connect_accelerator { my ($_action) = @_ } -sub connect_proxy { my ($_action, $_proxy) = @_ } -sub create_icon { my ($_action, $_icon_size) = @_ } -sub create_menu_item { my ($_action) = @_ } -sub create_tool_item { my ($_action) = @_ } -sub disconnect_accelerator { my ($_action) = @_ } -sub disconnect_proxy { my ($_action, $_proxy) = @_ } -sub get_accel_path { my ($_action) = @_ } -sub get_name { my ($_action) = @_ } -sub get_proxies { my ($_action) = @_ } -sub get_sensitive { my ($_action) = @_ } -sub get_visible { my ($_action) = @_ } -sub is_sensitive { my ($_action) = @_ } -sub is_visible { my ($_action) = @_ } -sub set_accel_group { my ($_action, $_accel_group) = @_ } -sub set_accel_path { my ($_action, $_accel_path) = @_ } -sub set_sensitive { my ($_action, $_sensitive) = @_ } -sub set_visible { my ($_action, $_visible) = @_ } -sub unblock_activate_from { my ($_action, $_proxy) = @_ } - -package Gtk2::ActionGroup; -our @ISA = qw(); -sub add_action { my ($_action_group, $_action) = @_ } -sub add_action_with_accel { my ($_action_group, $_action, $_accelerator) = @_ } -sub add_actions { my ($_action_group, $_action_entries, $_o_user_data) = @_ } -sub add_radio_actions { my ($_action_group, $_radio_action_entries, $_value, $_on_change, $_o_user_data) = @_ } -sub add_toggle_actions { my ($_action_group, $_toggle_action_entries, $_o_user_data) = @_ } -sub get_action { my ($_action_group, $_action_name) = @_ } -sub get_name { my ($_action_group) = @_ } -sub get_sensitive { my ($_action_group) = @_ } -sub get_visible { my ($_action_group) = @_ } -sub list_actions { my ($_action_group) = @_ } -sub new { my ($_class, $_name) = @_ } -sub remove_action { my ($_action_group, $_action) = @_ } -sub set_sensitive { my ($_action_group, $_sensitive) = @_ } -sub set_translate_func { my ($_action_group, $_func, $_o_data) = @_ } -sub set_translation_domain { my ($_action_group, $_domain) = @_ } -sub set_visible { my ($_action_group, $_sensitive) = @_ } -sub translate_string { my ($_action_group, $_string) = @_ } - -package Gtk2::Adjustment; -our @ISA = qw(); -sub changed { my ($_adjustment) = @_ } -sub clamp_page { my ($_adjustment, $_lower, $_upper) = @_ } -sub get_value { my ($_adjustment) = @_ } -sub lower { my ($_adjustment, $_o_newval) = @_ } -sub new { my ($_class, $_value, $_lower, $_upper, $_step_increment, $_page_increment, $_page_size) = @_ } -sub page_increment { my ($_adjustment, $_o_newval) = @_ } -sub page_size { my ($_adjustment, $_o_newval) = @_ } -sub set_value { my ($_adjustment, $_value) = @_ } -sub step_increment { my ($_adjustment, $_o_newval) = @_ } -sub upper { my ($_adjustment, $_o_newval) = @_ } -sub value { my ($_adjustment, $_o_newval) = @_ } -sub value_changed { my ($_adjustment) = @_ } - -package Gtk2::Alignment; -our @ISA = qw(); -sub get_padding { my ($_alignment) = @_ } -sub new { my ($_class, $_xalign, $_yalign, $_xscale, $_yscale) = @_ } -sub set { my ($_alignment, $_xalign, $_yalign, $_xscale, $_yscale) = @_ } -sub set_padding { my ($_alignment, $_padding_top, $_padding_bottom, $_padding_left, $_padding_right) = @_ } - -package Gtk2::Arrow; -our @ISA = qw(); -sub new { my ($_class, $_arrow_type, $_shadow_type) = @_ } -sub set { my ($_arrow, $_arrow_type, $_shadow_type) = @_ } - -package Gtk2::AspectFrame; -our @ISA = qw(); -sub new { my ($_class, $_label, $_xalign, $_yalign, $_ratio, $_obey_child) = @_ } -sub set_params { my ($_aspect_frame, $_xalign, $_yalign, $_ratio, $_obey_child) = @_ } - -package Gtk2::Bin; -our @ISA = qw(); -sub child { my ($_bin) = @_ } -sub get_child { my ($_bin) = @_ } - -package Gtk2::Box; -our @ISA = qw(); -sub get_homogeneous { my ($_box) = @_ } -sub get_spacing { my ($_box) = @_ } -sub pack_end { my ($_box, $_child, $_expand, $_fill, $_padding) = @_ } -sub pack_end_defaults { my ($_box, $_widget) = @_ } -sub pack_start { my ($_box, $_child, $_expand, $_fill, $_padding) = @_ } -sub pack_start_defaults { my ($_box, $_widget) = @_ } -sub query_child_packing { my ($_box, $_child) = @_ } -sub reorder_child { my ($_box, $_child, $_position) = @_ } -sub set_child_packing { my ($_box, $_child, $_expand, $_fill, $_padding, $_pack_type) = @_ } -sub set_homogeneous { my ($_box, $_homogeneous) = @_ } -sub set_spacing { my ($_box, $_spacing) = @_ } - -package Gtk2::Button; -our @ISA = qw(); -sub clicked { my ($_button) = @_ } -sub enter { my ($_button) = @_ } -sub get_alignment { my ($_button) = @_ } -sub get_focus_on_click { my ($_button) = @_ } -sub get_image { my ($_button) = @_ } -sub get_label { my ($_button) = @_ } -sub get_relief { my ($_button) = @_ } -sub get_use_stock { my ($_button) = @_ } -sub get_use_underline { my ($_button) = @_ } -sub leave { my ($_button) = @_ } -sub new { my ($_class, $_o_label) = @_ } -sub new_from_stock { my ($_class, $_stock_id) = @_ } -sub new_with_label { my ($_class, $_o_label) = @_ } -sub new_with_mnemonic { my ($_class, $_o_label) = @_ } -sub pressed { my ($_button) = @_ } -sub released { my ($_button) = @_ } -sub set_alignment { my ($_button, $_xalign, $_yalign) = @_ } -sub set_focus_on_click { my ($_button, $_focus_on_click) = @_ } -sub set_image { my ($_button, $_image) = @_ } -sub set_label { my ($_button, $_label) = @_ } -sub set_relief { my ($_button, $_newstyle) = @_ } -sub set_use_stock { my ($_button, $_use_stock) = @_ } -sub set_use_underline { my ($_button, $_use_underline) = @_ } - -package Gtk2::ButtonBox; -our @ISA = qw(); -sub get_child_secondary { my ($_widget, $_child) = @_ } -sub get_layout { my ($_widget) = @_ } -sub set_child_secondary { my ($_widget, $_child, $_is_secondary) = @_ } -sub set_layout { my ($_widget, $_layout_style) = @_ } - -package Gtk2::Calendar; -our @ISA = qw(); -sub clear_marks { my ($_calendar) = @_ } -sub display_options { my ($_calendar, $_flags) = @_ } -sub freeze { my ($_calendar) = @_ } -sub get_date { my ($_calendar) = @_ } -sub get_display_options { my ($_calendar) = @_ } -sub mark_day { my ($_calendar, $_day) = @_ } -sub marked_date { my ($_cal) = @_ } -sub month { my ($_cal) = @_ } -sub new { my ($_class) = @_ } -sub num_marked_dates { my ($_cal) = @_ } -sub select_day { my ($_calendar, $_day) = @_ } -sub select_month { my ($_calendar, $_month, $_year) = @_ } -sub selected_day { my ($_cal) = @_ } -sub set_display_options { my ($_calendar, $_flags) = @_ } -sub thaw { my ($_calendar) = @_ } -sub unmark_day { my ($_calendar, $_day) = @_ } -sub year { my ($_cal) = @_ } - -package Gtk2::CellEditable; -our @ISA = qw(); -sub _ADD_INTERFACE { my ($_class, $_target_class) = @_ } -sub editing_done { my ($_cell_editable) = @_ } -sub remove_widget { my ($_cell_editable) = @_ } -sub start_editing { my ($_cell_editable, $_o_event) = @_ } - -package Gtk2::CellLayout; -our @ISA = qw(); -sub add_attribute { my ($_cell_layout, $_cell, $_attribute, $_column) = @_ } -sub clear { my ($_cell_layout) = @_ } -sub clear_attributes { my ($_cell_layout, $_cell) = @_ } -sub pack_end { my ($_cell_layout, $_cell, $_expand) = @_ } -sub pack_start { my ($_cell_layout, $_cell, $_expand) = @_ } -sub reorder { my ($_cell_layout, $_cell, $_position) = @_ } -sub set_attributes { my ($_cell_layout, $_cell, @_more_paras) = @_ } -sub set_cell_data_func { my ($_cell_layout, $_cell, $_func, $_o_func_data) = @_ } - -package Gtk2::CellRenderer; -our @ISA = qw(); -sub ACTIVATE { my ($_cell, @_more_paras) = @_ } -sub GET_SIZE { my ($_cell, @_more_paras) = @_ } -sub RENDER { my ($_cell, @_more_paras) = @_ } -sub START_EDITING { my ($_cell, @_more_paras) = @_ } -sub _INSTALL_OVERRIDES { my ($_package) = @_ } -sub _install_overrides { my ($_package) = @_ } -sub activate { my ($_cell, $_event, $_widget, $_path, $_background_area, $_cell_area, $_flags) = @_ } -sub editing_canceled { my ($_cell) = @_ } -sub get_fixed_size { my ($_cell) = @_ } -sub get_size { my ($_cell, $_widget, $_cell_area) = @_ } -sub parent_activate { my ($_cell, @_more_paras) = @_ } -sub parent_get_size { my ($_cell, @_more_paras) = @_ } -sub parent_render { my ($_cell, @_more_paras) = @_ } -sub parent_start_editing { my ($_cell, @_more_paras) = @_ } -sub render { my ($_cell, $_drawable, $_widget, $_background_area, $_cell_area, $_expose_area, $_flags) = @_ } -sub set_fixed_size { my ($_cell, $_width, $_height) = @_ } -sub start_editing { my ($_cell, $_event, $_widget, $_path, $_background_area, $_cell_area, $_flags) = @_ } -sub stop_editing { my ($_cell, $_canceled) = @_ } - -package Gtk2::CellRendererCombo; -our @ISA = qw(); -sub new { my ($_class) = @_ } - -package Gtk2::CellRendererPixbuf; -our @ISA = qw(); -sub new { my ($_class) = @_ } - -package Gtk2::CellRendererProgress; -our @ISA = qw(); -sub new { my ($_class) = @_ } - -package Gtk2::CellRendererText; -our @ISA = qw(); -sub new { my ($_class) = @_ } -sub set_fixed_height_from_font { my ($_renderer, $_number_of_rows) = @_ } - -package Gtk2::CellRendererToggle; -our @ISA = qw(); -sub get_active { my ($_toggle) = @_ } -sub get_radio { my ($_toggle) = @_ } -sub new { my ($_class) = @_ } -sub set_active { my ($_toggle, $_setting) = @_ } -sub set_radio { my ($_toggle, $_radio) = @_ } - -package Gtk2::CellView; -our @ISA = qw(); -sub get_cell_renderers { my ($_cellview) = @_ } -sub get_displayed_row { my ($_cell_view) = @_ } -sub get_size_of_row { my ($_cell_view, $_path) = @_ } -sub new { my ($_class) = @_ } -sub new_with_markup { my ($_class, $_markup) = @_ } -sub new_with_pixbuf { my ($_class, $_pixbuf) = @_ } -sub new_with_text { my ($_class, $_text) = @_ } -sub set_background_color { my ($_cell_view, $_color) = @_ } -sub set_displayed_row { my ($_cell_view, $_path) = @_ } -sub set_model { my ($_cell_view, $_model) = @_ } - -package Gtk2::CheckButton; -our @ISA = qw(); -sub new { my ($_class, $_o_label) = @_ } -sub new_with_label { my ($_class, $_o_label) = @_ } -sub new_with_mnemonic { my ($_class, $_o_label) = @_ } - -package Gtk2::CheckMenuItem; -our @ISA = qw(); -sub get_active { my ($_check_menu_item) = @_ } -sub get_draw_as_radio { my ($_check_menu_item) = @_ } -sub get_inconsistent { my ($_check_menu_item) = @_ } -sub new { my ($_class, $_o_label) = @_ } -sub new_with_label { my ($_class, $_o_label) = @_ } -sub new_with_mnemonic { my ($_class, $_o_label) = @_ } -sub set_active { my ($_check_menu_item, $_is_active) = @_ } -sub set_draw_as_radio { my ($_check_menu_item, $_draw_as_radio) = @_ } -sub set_inconsistent { my ($_check_menu_item, $_setting) = @_ } -sub set_show_toggle { my ($_menu_item, $_always) = @_ } -sub toggled { my ($_check_menu_item) = @_ } - -package Gtk2::Clipboard; -our @ISA = qw(); -sub clear { my ($_clipboard) = @_ } -sub get { my ($_class, $_selection) = @_ } -sub get_display { my ($_clipboard) = @_ } -sub get_for_display { my ($_class, $_display, $_selection) = @_ } -sub get_owner { my ($_clipboard) = @_ } -sub request_contents { my ($_clipboard, $_target, $_callback, $_o_user_data) = @_ } -sub request_image { my ($_clipboard, $_callback, $_o_user_data) = @_ } -sub request_targets { my ($_clipboard, $_callback, $_o_user_data) = @_ } -sub request_text { my ($_clipboard, $_callback, $_o_user_data) = @_ } -sub set_can_store { my ($_clipboard, @_more_paras) = @_ } -sub set_image { my ($_clipboard, $_pixbuf) = @_ } -sub set_text { my ($_clipboard, $_text, $_text) = @_ } -sub set_with_data { my ($_clipboard, $_get_func, $_clear_func, $_user_data, @_more_paras) = @_ } -sub set_with_owner { my ($_clipboard, $_get_func, $_clear_func, $_owner, @_more_paras) = @_ } -sub store { my ($_clipboard) = @_ } -sub wait_for_contents { my ($_clipboard, $_target) = @_ } -sub wait_for_image { my ($_clipboard) = @_ } -sub wait_for_targets { my ($_clipboard) = @_ } -sub wait_for_text { my ($_clipboard) = @_ } -sub wait_is_image_available { my ($_clipboard) = @_ } -sub wait_is_target_available { my ($_clipboard, $_target) = @_ } -sub wait_is_text_available { my ($_clipboard) = @_ } - -package Gtk2::ColorButton; -our @ISA = qw(); -sub get_alpha { my ($_color_button) = @_ } -sub get_color { my ($_color_button) = @_ } -sub get_title { my ($_color_button) = @_ } -sub get_use_alpha { my ($_color_button) = @_ } -sub new { my ($_class, $_o_color) = @_ } -sub new_with_color { my ($_class, $_o_color) = @_ } -sub set_alpha { my ($_color_button, $_alpha) = @_ } -sub set_color { my ($_color_button, $_color) = @_ } -sub set_title { my ($_color_button, $_title) = @_ } -sub set_use_alpha { my ($_color_button, $_use_alpha) = @_ } - -package Gtk2::ColorSelection; -our @ISA = qw(); -sub get_current_alpha { my ($_colorsel) = @_ } -sub get_current_color { my ($_colorsel) = @_ } -sub get_has_opacity_control { my ($_colorsel) = @_ } -sub get_has_palette { my ($_colorsel) = @_ } -sub get_previous_alpha { my ($_colorsel) = @_ } -sub get_previous_color { my ($_colorsel) = @_ } -sub is_adjusting { my ($_colorsel) = @_ } -sub new { my ($_class) = @_ } -sub palette_from_string { my ($_class, $_string) = @_ } -sub palette_to_string { my ($_class, @_more_paras) = @_ } -sub set_current_alpha { my ($_colorsel, $_alpha) = @_ } -sub set_current_color { my ($_colorsel, $_color) = @_ } -sub set_has_opacity_control { my ($_colorsel, $_has_opacity) = @_ } -sub set_has_palette { my ($_colorsel, $_has_palette) = @_ } -sub set_previous_alpha { my ($_colorsel, $_alpha) = @_ } -sub set_previous_color { my ($_colorsel, $_color) = @_ } - -package Gtk2::ColorSelectionDialog; -our @ISA = qw(); -sub cancel_button { my ($_dialog) = @_ } -sub colorsel { my ($_dialog) = @_ } -sub help_button { my ($_dialog) = @_ } -sub new { my ($_class, $_title) = @_ } -sub ok_button { my ($_dialog) = @_ } - -package Gtk2::Combo; -our @ISA = qw(); -sub disable_activate { my ($_combo) = @_ } -sub entry { my ($_combo) = @_ } -sub list { my ($_combo) = @_ } -sub new { my ($_class) = @_ } -sub set_case_sensitive { my ($_combo, $_val) = @_ } -sub set_item_string { my ($_combo, $_item, $_item_value) = @_ } -sub set_popdown_strings { my ($_combo, @_more_paras) = @_ } -sub set_use_arrows { my ($_combo, $_val) = @_ } -sub set_use_arrows_always { my ($_combo, $_val) = @_ } -sub set_value_in_list { my ($_combo, $_val, $_ok_if_empty) = @_ } - -package Gtk2::ComboBox; -our @ISA = qw(); -sub append_text { my ($_combo_box, $_text) = @_ } -sub get_active { my ($_combo_box) = @_ } -sub get_active_iter { my ($_combo_box) = @_ } -sub get_active_text { my ($_combo_box) = @_ } -sub get_add_tearoffs { my ($_combo_box) = @_ } -sub get_column_span_column { my ($_combo_box) = @_ } -sub get_focus_on_click { my ($_combo_box) = @_ } -sub get_model { my ($_combo_box) = @_ } -sub get_row_span_column { my ($_combo_box) = @_ } -sub get_wrap_width { my ($_combo_box) = @_ } -sub insert_text { my ($_combo_box, $_position, $_text) = @_ } -sub new { my ($_class, $_o_model) = @_ } -sub new_text { my ($_class) = @_ } -sub new_with_model { my ($_class, $_o_model) = @_ } -sub popdown { my ($_combo_box) = @_ } -sub popup { my ($_combo_box) = @_ } -sub prepend_text { my ($_combo_box, $_text) = @_ } -sub remove_text { my ($_combo_box, $_position) = @_ } -sub set_active { my ($_combo_box, $_index) = @_ } -sub set_active_iter { my ($_combo_box, $_iter) = @_ } -sub set_add_tearoffs { my ($_combo_box, $_add_tearoffs) = @_ } -sub set_column_span_column { my ($_combo_box, $_column_span) = @_ } -sub set_focus_on_click { my ($_combo_box, $_focus_on_click) = @_ } -sub set_model { my ($_combo_box, $_model) = @_ } -sub set_row_separator_func { my ($_combo_box, $_func, $_o_data) = @_ } -sub set_row_span_column { my ($_combo_box, $_row_span) = @_ } -sub set_wrap_width { my ($_combo_box, $_width) = @_ } - -package Gtk2::ComboBoxEntry; -our @ISA = qw(); -sub get_text_column { my ($_entry_box) = @_ } -sub new { my ($_class, @_more_paras) = @_ } -sub new_text { my ($_class) = @_ } -sub new_with_model { my ($_class, @_more_paras) = @_ } -sub set_text_column { my ($_entry_box, $_text_column) = @_ } - -package Gtk2::Container; -our @ISA = qw(); -sub add { my ($_container, $_widget) = @_ } -sub add_with_properties { my ($_container, $_widget, @_more_paras) = @_ } -sub check_resize { my ($_container) = @_ } -sub child_get { my ($_container, $_child, @_more_paras) = @_ } -sub child_get_property { my ($_container, $_child, @_more_paras) = @_ } -sub child_set { my ($_container, $_child, @_more_paras) = @_ } -sub child_set_property { my ($_container, $_child, @_more_paras) = @_ } -sub child_type { my ($_container) = @_ } -sub Gtk2::Container::foreach { my ($_container, $_callback, $_o_callback_data) = @_ } -sub get_border_width { my ($_container) = @_ } -sub get_children { my ($_container) = @_ } -sub get_focus_chain { my ($_container) = @_ } -sub get_focus_hadjustment { my ($_container) = @_ } -sub get_focus_vadjustment { my ($_container) = @_ } -sub get_resize_mode { my ($_container) = @_ } -sub propagate_expose { my ($_container, $_child, $_event) = @_ } -sub remove { my ($_container, $_widget) = @_ } -sub resize_children { my ($_container) = @_ } -sub set_border_width { my ($_container, $_border_width) = @_ } -sub set_focus_chain { my ($_container, @_more_paras) = @_ } -sub set_focus_child { my ($_container, $_child) = @_ } -sub set_focus_hadjustment { my ($_container, $_adjustment) = @_ } -sub set_focus_vadjustment { my ($_container, $_adjustment) = @_ } -sub set_reallocate_redraws { my ($_container, $_needs_redraws) = @_ } -sub set_resize_mode { my ($_container, $_resize_mode) = @_ } -sub unset_focus_chain { my ($_container) = @_ } - -package Gtk2::Curve; -our @ISA = qw(); -sub get_vector { my ($_curve, $_o_veclen) = @_ } -sub new { my ($_class) = @_ } -sub reset { my ($_curve) = @_ } -sub set_curve_type { my ($_curve, $_type) = @_ } -sub set_gamma { my ($_curve, $_gamma) = @_ } -sub set_range { my ($_curve, $_min_x, $_max_x, $_min_y, $_max_y) = @_ } -sub set_vector { my ($_curve, @_more_paras) = @_ } - -package Gtk2::Dialog; -our @ISA = qw(); -sub action_area { my ($_dialog) = @_ } -sub add_action_widget { my ($_dialog, $_child, $_response_id) = @_ } -sub add_button { my ($_dialog, $_button_text, $_response_id) = @_ } -sub add_buttons { my ($_dialog, @_more_paras) = @_ } -sub get_has_separator { my ($_dialog) = @_ } -sub get_response_for_widget { my ($_dialog, $_widget) = @_ } -sub new { my ($_class, @_more_paras) = @_ } -sub new_with_buttons { my ($_class, @_more_paras) = @_ } -sub response { my ($_dialog, $_response_id) = @_ } -sub run { my ($_dialog) = @_ } -sub set_alternative_button_order { my ($_dialog, @_more_paras) = @_ } -sub set_default_response { my ($_dialog, $_response_id) = @_ } -sub set_has_separator { my ($_dialog, $_setting) = @_ } -sub set_response_sensitive { my ($_dialog, $_response_id, $_setting) = @_ } -sub vbox { my ($_dialog) = @_ } - -package Gtk2::Drag; -our @ISA = qw(); -sub begin { my ($_class, $_widget, $_targets, $_actions, $_button, $_event) = @_ } - -package Gtk2::DrawingArea; -our @ISA = qw(); -sub new { my ($_class) = @_ } -sub size { my ($_darea, $_width, $_height) = @_ } - -package Gtk2::Editable; -our @ISA = qw(); -sub copy_clipboard { my ($_editable) = @_ } -sub cut_clipboard { my ($_editable) = @_ } -sub delete_selection { my ($_editable) = @_ } -sub delete_text { my ($_editable, $_start_pos, $_end_pos) = @_ } -sub get_chars { my ($_editable, $_start_pos, $_end_pos) = @_ } -sub get_editable { my ($_editable) = @_ } -sub get_position { my ($_editable) = @_ } -sub get_selection_bounds { my ($_editable) = @_ } -sub insert_text { my ($_editable, $_new_text, @_more_paras) = @_ } -sub paste_clipboard { my ($_editable) = @_ } -sub select_region { my ($_editable, $_start, $_end) = @_ } -sub set_editable { my ($_editable, $_is_editable) = @_ } -sub set_position { my ($_editable, $_position) = @_ } - -package Gtk2::Entry; -our @ISA = qw(); -sub append_text { my ($_entry, $_text) = @_ } -sub get_activates_default { my ($_entry) = @_ } -sub get_alignment { my ($_entry) = @_ } -sub get_completion { my ($_entry) = @_ } -sub get_has_frame { my ($_entry) = @_ } -sub get_invisible_char { my ($_entry) = @_ } -sub get_layout { my ($_entry) = @_ } -sub get_layout_offsets { my ($_entry) = @_ } -sub get_max_length { my ($_entry) = @_ } -sub get_text { my ($_entry) = @_ } -sub get_visibility { my ($_entry) = @_ } -sub get_width_chars { my ($_entry) = @_ } -sub layout_index_to_text_index { my ($_entry, $_layout_index) = @_ } -sub new { my ($_class) = @_ } -sub new_with_max_length { my ($_class, $_max) = @_ } -sub prepend_text { my ($_entry, $_text) = @_ } -sub select_region { my ($_entry, $_start, $_end) = @_ } -sub set_activates_default { my ($_entry, $_setting) = @_ } -sub set_alignment { my ($_entry, $_xalign) = @_ } -sub set_completion { my ($_entry, $_completion) = @_ } -sub set_editable { my ($_entry, $_editable) = @_ } -sub set_has_frame { my ($_entry, $_setting) = @_ } -sub set_invisible_char { my ($_entry, $_ch) = @_ } -sub set_max_length { my ($_entry, $_max) = @_ } -sub set_position { my ($_entry, $_position) = @_ } -sub set_text { my ($_entry, $_text) = @_ } -sub set_visibility { my ($_entry, $_visible) = @_ } -sub set_width_chars { my ($_entry, $_n_chars) = @_ } -sub text_index_to_layout_index { my ($_entry, $_text_index) = @_ } - -package Gtk2::EntryCompletion; -our @ISA = qw(); -sub complete { my ($_completion) = @_ } -sub delete_action { my ($_completion, $_index) = @_ } -sub get_entry { my ($_entry) = @_ } -sub get_inline_completion { my ($_completion) = @_ } -sub get_minimum_key_length { my ($_completion) = @_ } -sub get_model { my ($_completion) = @_ } -sub get_popup_completion { my ($_completion) = @_ } -sub get_popup_set_width { my ($_completion) = @_ } -sub get_popup_single_match { my ($_completion) = @_ } -sub get_text_column { my ($_completion) = @_ } -sub insert_action_markup { my ($_completion, $_index, $_markup) = @_ } -sub insert_action_text { my ($_completion, $_index, $_text) = @_ } -sub insert_prefix { my ($_completion) = @_ } -sub new { my ($_class) = @_ } -sub set_inline_completion { my ($_completion, $_inline_completion) = @_ } -sub set_match_func { my ($_completion, $_func, $_o_func_data) = @_ } -sub set_minimum_key_length { my ($_completion, $_length) = @_ } -sub set_model { my ($_completion, $_model) = @_ } -sub set_popup_completion { my ($_completion, $_popup_completion) = @_ } -sub set_popup_set_width { my ($_completion, $_popup_set_width) = @_ } -sub set_popup_single_match { my ($_completion, $_popup_single_match) = @_ } -sub set_text_column { my ($_completion, $_column) = @_ } - -package Gtk2::EventBox; -our @ISA = qw(); -sub get_above_child { my ($_event_box) = @_ } -sub get_visible_window { my ($_event_box) = @_ } -sub new { my ($_class) = @_ } -sub set_above_child { my ($_event_box, $_above_child) = @_ } -sub set_visible_window { my ($_event_box, $_visible_window) = @_ } - -package Gtk2::Expander; -our @ISA = qw(); -sub get_expanded { my ($_expander) = @_ } -sub get_label { my ($_expander) = @_ } -sub get_label_widget { my ($_expander) = @_ } -sub get_spacing { my ($_expander) = @_ } -sub get_use_markup { my ($_expander) = @_ } -sub get_use_underline { my ($_expander) = @_ } -sub new { my ($_class, $_o_label) = @_ } -sub new_with_mnemonic { my ($_class, $_label) = @_ } -sub set_expanded { my ($_expander, $_expanded) = @_ } -sub set_label { my ($_expander, $_label) = @_ } -sub set_label_widget { my ($_expander, $_label_widget) = @_ } -sub set_spacing { my ($_expander, $_spacing) = @_ } -sub set_use_markup { my ($_expander, $_use_markup) = @_ } -sub set_use_underline { my ($_expander, $_use_underline) = @_ } - -package Gtk2::FileChooser; -our @ISA = qw(); -sub add_filter { my ($_chooser, $_filter) = @_ } -sub add_shortcut_folder { my ($_chooser, $_folder) = @_ } -sub add_shortcut_folder_uri { my ($_chooser, $_folder) = @_ } -sub get_action { my ($_chooser) = @_ } -sub get_current_folder { my ($_chooser) = @_ } -sub get_current_folder_uri { my ($_chooser) = @_ } -sub get_do_overwrite_confirmation { my ($_chooser) = @_ } -sub get_extra_widget { my ($_chooser) = @_ } -sub get_filename { my ($_chooser) = @_ } -sub get_filenames { my ($_chooser) = @_ } -sub get_filter { my ($_chooser) = @_ } -sub get_local_only { my ($_chooser) = @_ } -sub get_preview_filename { my ($_file_chooser) = @_ } -sub get_preview_uri { my ($_file_chooser) = @_ } -sub get_preview_widget { my ($_chooser) = @_ } -sub get_preview_widget_active { my ($_chooser) = @_ } -sub get_select_multiple { my ($_chooser) = @_ } -sub get_show_hidden { my ($_chooser) = @_ } -sub get_uri { my ($_chooser) = @_ } -sub get_uris { my ($_chooser) = @_ } -sub get_use_preview_label { my ($_chooser) = @_ } -sub list_filters { my ($_chooser) = @_ } -sub list_shortcut_folder_uris { my ($_chooser) = @_ } -sub list_shortcut_folders { my ($_chooser) = @_ } -sub remove_filter { my ($_chooser, $_filter) = @_ } -sub remove_shortcut_folder { my ($_chooser, $_folder) = @_ } -sub remove_shortcut_folder_uri { my ($_chooser, $_folder) = @_ } -sub select_all { my ($_chooser) = @_ } -sub select_filename { my ($_chooser, $_filename) = @_ } -sub select_uri { my ($_chooser, $_uri) = @_ } -sub set_action { my ($_chooser, $_action) = @_ } -sub set_current_folder { my ($_chooser, $_filename) = @_ } -sub set_current_folder_uri { my ($_chooser, $_uri) = @_ } -sub set_current_name { my ($_chooser, $_name) = @_ } -sub set_do_overwrite_confirmation { my ($_chooser, $_do_overwrite_confirmation) = @_ } -sub set_extra_widget { my ($_chooser, $_extra_widget) = @_ } -sub set_filename { my ($_chooser, $_filename) = @_ } -sub set_filter { my ($_chooser, $_filter) = @_ } -sub set_local_only { my ($_chooser, $_files_only) = @_ } -sub set_preview_widget { my ($_chooser, $_preview_widget) = @_ } -sub set_preview_widget_active { my ($_chooser, $_active) = @_ } -sub set_select_multiple { my ($_chooser, $_select_multiple) = @_ } -sub set_show_hidden { my ($_chooser, $_show_hidden) = @_ } -sub set_uri { my ($_chooser, $_uri) = @_ } -sub set_use_preview_label { my ($_chooser, $_use_label) = @_ } -sub unselect_all { my ($_chooser) = @_ } -sub unselect_filename { my ($_chooser, $_filename) = @_ } -sub unselect_uri { my ($_chooser, $_uri) = @_ } - -package Gtk2::FileChooserButton; -our @ISA = qw(); -sub get_title { my ($_button) = @_ } -sub get_width_chars { my ($_button) = @_ } -sub new { my ($_class, $_title, $_action) = @_ } -sub new_with_backend { my ($_class, $_title, $_action, $_backend) = @_ } -sub new_with_dialog { my ($_class, $_dialog) = @_ } -sub set_title { my ($_button, $_title) = @_ } -sub set_width_chars { my ($_button, $_n_chars) = @_ } - -package Gtk2::FileChooserDialog; -our @ISA = qw(); -sub new { my ($_class, $_title, $_parent, $_action, @_more_paras) = @_ } -sub new_with_backend { my ($_class, $_title, $_parent, $_action, @_more_paras) = @_ } - -package Gtk2::FileChooserWidget; -our @ISA = qw(); -sub new { my ($_class, $_action) = @_ } -sub new_with_backend { my ($_class, $_action, $_backend) = @_ } - -package Gtk2::FileFilter; -our @ISA = qw(); -sub add_custom { my ($_filter, $_needed, $_func, $_o_data) = @_ } -sub add_mime_type { my ($_filter, $_mime_type) = @_ } -sub add_pattern { my ($_filter, $_pattern) = @_ } -sub add_pixbuf_formats { my ($_filter) = @_ } -sub filter { my ($_filter, $_filter_info) = @_ } -sub get_name { my ($_filter) = @_ } -sub get_needed { my ($_filter) = @_ } -sub new { my ($_class) = @_ } -sub set_name { my ($_filter, $_name) = @_ } - -package Gtk2::FileSelection; -our @ISA = qw(); -sub action_area { my ($_fs) = @_ } -sub button_area { my ($_fs) = @_ } -sub cancel_button { my ($_fs) = @_ } -sub complete { my ($_filesel, $_pattern) = @_ } -sub dir_list { my ($_fs) = @_ } -sub file_list { my ($_fs) = @_ } -sub fileop_c_dir { my ($_fs) = @_ } -sub fileop_del_file { my ($_fs) = @_ } -sub fileop_dialog { my ($_fs) = @_ } -sub fileop_entry { my ($_fs) = @_ } -sub fileop_file { my ($_fs) = @_ } -sub fileop_ren_file { my ($_fs) = @_ } -sub get_filename { my ($_filesel) = @_ } -sub get_select_multiple { my ($_filesel) = @_ } -sub get_selections { my ($_filesel) = @_ } -sub help_button { my ($_fs) = @_ } -sub hide_fileop_buttons { my ($_filesel) = @_ } -sub history_menu { my ($_fs) = @_ } -sub history_pulldown { my ($_fs) = @_ } -sub main_vbox { my ($_fs) = @_ } -sub new { my ($_class, $_title) = @_ } -sub ok_button { my ($_fs) = @_ } -sub selection_entry { my ($_fs) = @_ } -sub selection_text { my ($_fs) = @_ } -sub set_filename { my ($_filesel, $_filename) = @_ } -sub set_select_multiple { my ($_filesel, $_select_multiple) = @_ } -sub show_fileop_buttons { my ($_filesel) = @_ } - -package Gtk2::Fixed; -our @ISA = qw(); -sub get_has_window { my ($_fixed) = @_ } -sub move { my ($_fixed, $_widget, $_x, $_y) = @_ } -sub new { my ($_class) = @_ } -sub put { my ($_fixed, $_widget, $_x, $_y) = @_ } -sub set_has_window { my ($_fixed, $_has_window) = @_ } - -package Gtk2::FontButton; -our @ISA = qw(); -sub get_font_name { my ($_font_button) = @_ } -sub get_show_size { my ($_font_button) = @_ } -sub get_show_style { my ($_font_button) = @_ } -sub get_title { my ($_font_button) = @_ } -sub get_use_font { my ($_font_button) = @_ } -sub get_use_size { my ($_font_button) = @_ } -sub new { my ($_class, $_o_fontname) = @_ } -sub new_with_font { my ($_class, $_o_fontname) = @_ } -sub set_font_name { my ($_font_button, $_fontname) = @_ } -sub set_show_size { my ($_font_button, $_show_size) = @_ } -sub set_show_style { my ($_font_button, $_show_style) = @_ } -sub set_title { my ($_font_button, $_title) = @_ } -sub set_use_font { my ($_font_button, $_use_font) = @_ } -sub set_use_size { my ($_font_button, $_use_size) = @_ } - -package Gtk2::FontSelection; -our @ISA = qw(); -sub get_font { my ($_fontsel) = @_ } -sub get_font_name { my ($_fontsel) = @_ } -sub get_preview_text { my ($_fontsel) = @_ } -sub new { my ($_class) = @_ } -sub set_font_name { my ($_fontsel, $_fontname) = @_ } -sub set_preview_text { my ($_fontsel, $_text) = @_ } - -package Gtk2::FontSelectionDialog; -our @ISA = qw(); -sub apply_button { my ($_fsd) = @_ } -sub cancel_button { my ($_fsd) = @_ } -sub get_font { my ($_fsd) = @_ } -sub get_font_name { my ($_fsd) = @_ } -sub get_preview_text { my ($_fsd) = @_ } -sub new { my ($_class, $_title) = @_ } -sub ok_button { my ($_fsd) = @_ } -sub set_font_name { my ($_fsd, $_fontname) = @_ } -sub set_preview_text { my ($_fsd, $_text) = @_ } - -package Gtk2::Frame; -our @ISA = qw(); -sub get_label { my ($_frame) = @_ } -sub get_label_align { my ($_frame) = @_ } -sub get_label_widget { my ($_frame) = @_ } -sub get_shadow_type { my ($_frame) = @_ } -sub new { my ($_class, $_o_label) = @_ } -sub set_label { my ($_frame, $_o_label) = @_ } -sub set_label_align { my ($_frame, $_xalign, $_yalign) = @_ } -sub set_label_widget { my ($_frame, $_label_widget) = @_ } -sub set_shadow_type { my ($_frame, $_type) = @_ } - -package Gtk2::GC; -our @ISA = qw(); -sub get { my ($_class, $_depth, $_colormap, $_values) = @_ } -sub release { my ($_class, $_gc) = @_ } - -package Gtk2::GammaCurve; -our @ISA = qw(); -sub curve { my ($_gamma) = @_ } -sub new { my ($_class) = @_ } - -package Gtk2::Gdk; -our @ISA = qw(); -sub SELECTION_CLIPBOARD { my ($_class) = @_ } -sub SELECTION_PRIMARY { my ($_class) = @_ } -sub SELECTION_SECONDARY { my ($_class) = @_ } -sub SELECTION_TYPE_ATOM { my ($_class) = @_ } -sub SELECTION_TYPE_BITMAP { my ($_class) = @_ } -sub SELECTION_TYPE_COLORMAP { my ($_class) = @_ } -sub SELECTION_TYPE_DRAWABLE { my ($_class) = @_ } -sub SELECTION_TYPE_INTEGER { my ($_class) = @_ } -sub SELECTION_TYPE_PIXMAP { my ($_class) = @_ } -sub SELECTION_TYPE_STRING { my ($_class) = @_ } -sub SELECTION_TYPE_WINDOW { my ($_class) = @_ } -sub TARGET_BITMAP { my ($_class) = @_ } -sub TARGET_COLORMAP { my ($_class) = @_ } -sub TARGET_DRAWABLE { my ($_class) = @_ } -sub TARGET_PIXMAP { my ($_class) = @_ } -sub TARGET_STRING { my ($_class) = @_ } -sub beep { my ($_class) = @_ } -sub devices_list { my ($_class) = @_ } -sub error_trap_pop { my ($_class) = @_ } -sub error_trap_push { my ($_class) = @_ } -sub events_pending { my ($_class) = @_ } -sub flush { my ($_class) = @_ } -sub get_default_root_window { my ($_class) = @_ } -sub get_display { my ($_class) = @_ } -sub get_display_arg_name { my ($_class) = @_ } -sub get_program_class { my ($_class) = @_ } -sub get_show_events { my ($_class) = @_ } -sub init { my ($_o_class) = @_ } -sub init_check { my ($_o_class) = @_ } -sub keyboard_grab { my ($_class, $_window, $_owner_events, $_time_) = @_ } -sub keyboard_ungrab { my ($_class, $_time_) = @_ } -sub keyval_convert_case { my ($_class, $_symbol) = @_ } -sub keyval_from_name { my ($_class, $_keyval_name) = @_ } -sub keyval_is_lower { my ($_class, $_keyval) = @_ } -sub keyval_is_upper { my ($_class, $_keyval) = @_ } -sub keyval_name { my ($_class, $_keyval) = @_ } -sub keyval_to_lower { my ($_class, $_keyval) = @_ } -sub keyval_to_unicode { my ($_class, $_keyval) = @_ } -sub keyval_to_upper { my ($_class, $_keyval) = @_ } -sub list_visuals { my ($_class) = @_ } -sub notify_startup_complete { my ($_class) = @_ } -sub parse_args { my ($_o_class) = @_ } -sub pointer_grab { my ($_class, $_window, $_owner_events, $_event_mask, $_confine_to, $_cursor, $_time_) = @_ } -sub pointer_is_grabbed { my ($_class) = @_ } -sub pointer_ungrab { my ($_class, $_time_) = @_ } -sub query_depths { my ($_class) = @_ } -sub query_visual_types { my ($_class) = @_ } -sub screen_height { my ($_class) = @_ } -sub screen_height_mm { my ($_class) = @_ } -sub screen_width { my ($_class) = @_ } -sub screen_width_mm { my ($_class) = @_ } -sub set_locale { my ($_class) = @_ } -sub set_program_class { my ($_class, $_program_class) = @_ } -sub set_show_events { my ($_class, $_show_events) = @_ } -sub set_sm_client_id { my ($_class, $_o_sm_client_id) = @_ } -sub setting_get { my ($_class, $_name) = @_ } -sub string_to_compound_text { my ($_class, $_str) = @_ } -sub string_to_compound_text_for_display { my ($_class, $_display, $_str) = @_ } -sub text_property_to_text_list { my ($_class, $_encoding, $_format, $_text) = @_ } -sub text_property_to_text_list_for_display { my ($_class, $_display, $_encoding, $_format, $_text) = @_ } -sub text_property_to_utf8_list { my ($_class, $_encoding, $_format, $_text) = @_ } -sub text_property_to_utf8_list_for_display { my ($_class, $_display, $_encoding, $_format, $_text) = @_ } -sub unicode_to_keyval { my ($_class, $_wc) = @_ } -sub utf8_to_compound_text { my ($_class, $_str) = @_ } -sub utf8_to_compound_text_for_display { my ($_class, $_display, $_str) = @_ } -sub utf8_to_string_target { my ($_class, $_str) = @_ } - -package Gtk2::Gdk::Atom; -our @ISA = qw(); -sub Gtk2::Gdk::Atom::eq { my ($_left, $_right, $_o_swap) = @_ } -sub intern { my ($_class, $_atom_name, $_o_only_if_exists) = @_ } -sub name { my ($_atom) = @_ } -sub new { my ($_class, $_atom_name, $_o_only_if_exists) = @_ } - -package Gtk2::Gdk::Bitmap; -our @ISA = qw(); -sub create_from_data { my ($_class, $_drawable, $_data, $_width, $_height) = @_ } - -package Gtk2::Gdk::Cairo::Context; -our @ISA = qw(); -sub create { my ($_class, $_drawable) = @_ } -sub rectangle { my ($_cr, @_more_paras) = @_ } -sub region { my ($_cr, $_region) = @_ } -sub set_source_color { my ($_cr, $_color) = @_ } -sub set_source_pixbuf { my ($_cr, $_pixbuf, $_pixbuf_x, $_pixbuf_y) = @_ } - -package Gtk2::Gdk::Color; -our @ISA = qw(); -sub blue { my ($_color) = @_ } -sub equal { my ($_colora, $_colorb) = @_ } -sub green { my ($_color) = @_ } -sub hash { my ($_colora) = @_ } -sub new { my ($_class, $_red, $_green, $_blue) = @_ } -sub parse { my ($_class, $_spec) = @_ } -sub pixel { my ($_color) = @_ } -sub red { my ($_color) = @_ } - -package Gtk2::Gdk::Colormap; -our @ISA = qw(); -sub alloc_color { my ($_colormap, $_color, $_writeable, $_best_match) = @_ } -sub alloc_colors { my ($_colormap, $_writeable, $_best_match, @_more_paras) = @_ } -sub free_colors { my ($_colormap, @_more_paras) = @_ } -sub get_screen { my ($_cmap) = @_ } -sub get_system { my ($_class) = @_ } -sub get_visual { my ($_colormap) = @_ } -sub new { my ($_class, $_visual, $_allocate) = @_ } -sub query_color { my ($_colormap, $_pixel) = @_ } -sub rgb_find_color { my ($_colormap, $_color) = @_ } - -package Gtk2::Gdk::Cursor; -our @ISA = qw(); -sub get_display { my ($_cursor) = @_ } -sub get_image { my ($_cursor) = @_ } -sub new { my ($_class, $_cursor_type) = @_ } -sub new_for_display { my ($_class, $_display, $_cursor_type) = @_ } -sub new_from_name { my ($_class, $_display, $_name) = @_ } -sub new_from_pixbuf { my ($_class, $_display, $_pixbuf, $_x, $_y) = @_ } -sub new_from_pixmap { my ($_class, $_source, $_mask, $_fg, $_bg, $_x, $_y) = @_ } -sub type { my ($_cursor) = @_ } - -package Gtk2::Gdk::Device; -our @ISA = qw(); -sub axes { my ($_device) = @_ } -sub get_axis { my ($_device, $_use, @_more_paras) = @_ } -sub get_core_pointer { my ($_class) = @_ } -sub get_history { my ($_device, $_window, $_start, $_stop) = @_ } -sub get_state { my ($_device, $_window) = @_ } -sub has_cursor { my ($_device) = @_ } -sub keys { my ($_device) = @_ } -sub mode { my ($_device) = @_ } -sub name { my ($_device) = @_ } -sub set_axis_use { my ($_device, $_index_, $_use) = @_ } -sub set_key { my ($_device, $_index_, $_keyval, $_modifiers) = @_ } -sub set_mode { my ($_device, $_mode) = @_ } -sub set_source { my ($_device, $_source) = @_ } -sub source { my ($_device) = @_ } - -package Gtk2::Gdk::Display; -our @ISA = qw(); -sub beep { my ($_display) = @_ } -sub close { my ($_display) = @_ } -sub flush { my ($_display) = @_ } -sub get_core_pointer { my ($_display) = @_ } -sub get_default { my ($_class) = @_ } -sub get_default_cursor_size { my ($_display) = @_ } -sub get_default_group { my ($_display) = @_ } -sub get_default_screen { my ($_display) = @_ } -sub get_event { my ($_display) = @_ } -sub get_maximal_cursor_size { my ($_display) = @_ } -sub get_n_screens { my ($_display) = @_ } -sub get_name { my ($_display) = @_ } -sub get_pointer { my ($_display) = @_ } -sub get_screen { my ($_display, $_screen_num) = @_ } -sub get_user_time { my ($_display) = @_ } -sub get_window_at_pointer { my ($_display) = @_ } -sub grab { my ($_display) = @_ } -sub keyboard_ungrab { my ($_display, $_time_) = @_ } -sub list_devices { my ($_display) = @_ } -sub open { my ($_class, $_display_name) = @_ } -sub peek_event { my ($_display) = @_ } -sub pointer_is_grabbed { my ($_display) = @_ } -sub pointer_ungrab { my ($_display, $_time_) = @_ } -sub put_event { my ($_display, $_event) = @_ } -sub register_standard_event_type { my ($_display, $_event_base, $_n_events) = @_ } -sub request_selection_notification { my ($_display, $_selection) = @_ } -sub set_cursor_theme { my ($_display, $_theme, $_size) = @_ } -sub set_double_click_distance { my ($_display, $_distance) = @_ } -sub set_double_click_time { my ($_display, $_msec) = @_ } -sub store_clipboard { my ($_display, $_clipboard_window, $_time_, @_more_paras) = @_ } -sub supports_clipboard_persistence { my ($_display) = @_ } -sub supports_cursor_alpha { my ($_display) = @_ } -sub supports_cursor_color { my ($_display) = @_ } -sub supports_selection_notification { my ($_display) = @_ } -sub sync { my ($_display) = @_ } -sub ungrab { my ($_display) = @_ } -sub warp_pointer { my ($_display, $_screen, $_x, $_y) = @_ } - -package Gtk2::Gdk::DisplayManager; -our @ISA = qw(); -sub get { my ($_class) = @_ } -sub get_default_display { my ($_display_manager) = @_ } -sub list_displays { my ($_display_manager) = @_ } -sub set_default_display { my ($_display_manager, $_display) = @_ } - -package Gtk2::Gdk::DragContext; -our @ISA = qw(); -sub abort { my ($_context, $_time_) = @_ } -sub action { my ($_dc) = @_ } -sub actions { my ($_dc) = @_ } -sub begin { my ($_class, $_window, @_more_paras) = @_ } -sub dest_window { my ($_dc) = @_ } -sub drag_drop_succeeded { my ($_context) = @_ } -sub drop { my ($_context, $_time_) = @_ } -sub drop_finish { my ($_context, $_success, $_o_time_) = @_ } -sub drop_reply { my ($_context, $_ok, $_o_time_) = @_ } -sub find_window { my ($_context, $_drag_window, $_x_root, $_y_root) = @_ } -sub find_window_for_screen { my ($_context, $_drag_window, $_screen, $_x_root, $_y_root) = @_ } -sub finish { my ($_context, $_success, $_del, $_time_) = @_ } -sub get_protocol { my ($_class, $_xid) = @_ } -sub get_protocol_for_display { my ($_class, $_display, $_xid) = @_ } -sub get_selection { my ($_context) = @_ } -sub get_source_widget { my ($_context) = @_ } -sub is_source { my ($_dc) = @_ } -sub motion { my ($_context, $_dest_window, $_protocol, $_x_root, $_y_root, $_suggested_action, $_possible_actions, $_time_) = @_ } -sub new { my ($_class) = @_ } -sub protocol { my ($_dc) = @_ } -sub set_icon_default { my ($_context) = @_ } -sub set_icon_name { my ($_context, $_icon_name, $_hot_x, $_hot_y) = @_ } -sub set_icon_pixbuf { my ($_context, $_pixbuf, $_hot_x, $_hot_y) = @_ } -sub set_icon_pixmap { my ($_context, $_colormap, $_pixmap, $_mask, $_hot_x, $_hot_y) = @_ } -sub set_icon_stock { my ($_context, $_stock_id, $_hot_x, $_hot_y) = @_ } -sub set_icon_widget { my ($_context, $_widget, $_hot_x, $_hot_y) = @_ } -sub source_window { my ($_dc) = @_ } -sub start_time { my ($_dc) = @_ } -sub status { my ($_context, $_action, $_o_time_) = @_ } -sub suggested_action { my ($_dc) = @_ } -sub targets { my ($_dc) = @_ } - -package Gtk2::Gdk::Drawable; -our @ISA = qw(); -sub XID { my ($_drawable) = @_ } -sub XWINDOW { my ($_drawable) = @_ } -sub copy_to_image { my ($_drawable, $_image, $_src_x, $_src_y, $_dest_x, $_dest_y, $_width, $_height) = @_ } -sub draw_arc { my ($_drawable, $_gc, $_filled, $_x, $_y, $_width, $_height, $_angle1, $_angle2) = @_ } -sub draw_drawable { my ($_drawable, $_gc, $_src, $_xsrc, $_ysrc, $_xdest, $_ydest, $_width, $_height) = @_ } -sub draw_gray_image { my ($_drawable, $_gc, $_x, $_y, $_width, $_height, $_dith, $_buf, $_rowstride) = @_ } -sub draw_image { my ($_drawable, $_gc, $_image, $_xsrc, $_ysrc, $_xdest, $_ydest, $_width, $_height) = @_ } -sub draw_indexed_image { my ($_drawable, $_gc, $_x, $_y, $_width, $_height, $_dith, $_buf, $_rowstride, $_cmap) = @_ } -sub draw_layout { my ($_drawable, $_gc, $_x, $_y, $_layout) = @_ } -sub draw_layout_with_colors { my ($_drawable, $_gc, $_x, $_y, $_layout, $_foreground, $_background) = @_ } -sub draw_line { my ($_drawable, $_gc, $_x1_, $_y1_, $_x2_, $_y2_) = @_ } -sub draw_lines { my ($_drawable, $_gc, $_x1, $_y1, @_more_paras) = @_ } -sub draw_pixbuf { my ($_drawable, $_gc, $_pixbuf, $_src_x, $_src_y, $_dest_x, $_dest_y, $_width, $_height, $_dither, $_x_dither, $_y_dither) = @_ } -sub draw_point { my ($_drawable, $_gc, $_x, $_y) = @_ } -sub draw_points { my ($_drawable, $_gc, $_x1, $_y1, @_more_paras) = @_ } -sub draw_polygon { my ($_drawable, $_gc, $_filled, $_x1, $_y1, @_more_paras) = @_ } -sub draw_rectangle { my ($_drawable, $_gc, $_filled, $_x, $_y, $_width, $_height) = @_ } -sub draw_rgb_32_image { my ($_drawable, $_gc, $_x, $_y, $_width, $_height, $_dith, $_buf, $_rowstride) = @_ } -sub draw_rgb_32_image_dithalign { my ($_drawable, $_gc, $_x, $_y, $_width, $_height, $_dith, $_rgb_buf, $_rowstride, $_xdith, $_ydith) = @_ } -sub draw_rgb_image { my ($_drawable, $_gc, $_x, $_y, $_width, $_height, $_dith, $_buf, $_rowstride) = @_ } -sub draw_rgb_image_dithalign { my ($_drawable, $_gc, $_x, $_y, $_width, $_height, $_dith, $_rgb_buf, $_rowstride, $_xdith, $_ydith) = @_ } -sub draw_segments { my ($_drawable, $_gc, $_x1, $_y1, $_x2, $_y2, @_more_paras) = @_ } -sub get_clip_region { my ($_drawable) = @_ } -sub get_colormap { my ($_drawable) = @_ } -sub get_depth { my ($_drawable) = @_ } -sub get_display { my ($_drawable) = @_ } -sub get_image { my ($_drawable, $_x, $_y, $_width, $_height) = @_ } -sub get_screen { my ($_drawable) = @_ } -sub get_size { my ($_drawable) = @_ } -sub get_visible_region { my ($_drawable) = @_ } -sub get_visual { my ($_drawable) = @_ } -sub get_xid { my ($_drawable) = @_ } -sub set_colormap { my ($_drawable, $_colormap) = @_ } - -package Gtk2::Gdk::Event; -our @ISA = qw(); -sub DESTROY { my ($_sv) = @_ } -sub axis { my ($_event, $_axis_use) = @_ } -sub coords { my ($_event) = @_ } -sub copy { my ($_event) = @_ } -sub get { my ($_class) = @_ } -sub get_axis { my ($_event, $_axis_use) = @_ } -sub get_coords { my ($_event) = @_ } -sub get_graphics_expose { my ($_class, $_window) = @_ } -sub get_root_coords { my ($_event) = @_ } -sub get_screen { my ($_event) = @_ } -sub get_state { my ($_event, @_more_paras) = @_ } -sub get_time { my ($_event, @_more_paras) = @_ } -sub handler_set { my ($_class, $_func, $_o_data) = @_ } -sub new { my ($_class, $_type) = @_ } -sub peek { my ($_class) = @_ } -sub put { my ($_class, $_event) = @_ } -sub root_coords { my ($_event) = @_ } -sub send_client_message { my ($_class, $_event, $_winid) = @_ } -sub send_client_message_for_display { my ($_class, $_display, $_event, $_winid) = @_ } -sub send_clientmessage_toall { my ($_class, $_event) = @_ } -sub send_event { my ($_event, $_o_newvalue) = @_ } -sub set_screen { my ($_event, $_screen) = @_ } -sub set_state { my ($_event, @_more_paras) = @_ } -sub set_time { my ($_event, @_more_paras) = @_ } -sub state { my ($_event, @_more_paras) = @_ } -sub time { my ($_event, @_more_paras) = @_ } -sub type { my ($_event) = @_ } -sub window { my ($_event, $_o_newvalue) = @_ } -sub x_root { my ($_event) = @_ } -sub y_root { my ($_event) = @_ } - -package Gtk2::Gdk::Event::Button; -our @ISA = qw(); -sub DESTROY { my ($_sv) = @_ } -sub button { my ($_eventbutton, $_o_newvalue) = @_ } -sub device { my ($_eventbutton, $_o_newvalue) = @_ } -sub Gtk2::Gdk::Event::Button::x { my ($_event, $_o_newvalue) = @_ } -sub Gtk2::Gdk::Event::Button::y { my ($_event, $_o_newvalue) = @_ } - -package Gtk2::Gdk::Event::Client; -our @ISA = qw(); -sub DESTROY { my ($_sv) = @_ } -sub data { my ($_eventclient, @_more_paras) = @_ } -sub data_format { my ($_eventclient, $_o_newvalue) = @_ } -sub message_type { my ($_eventclient, $_o_newvalue) = @_ } - -package Gtk2::Gdk::Event::Configure; -our @ISA = qw(); -sub DESTROY { my ($_sv) = @_ } -sub height { my ($_eventconfigure, $_o_newvalue) = @_ } -sub width { my ($_eventconfigure, $_o_newvalue) = @_ } -sub Gtk2::Gdk::Event::Configure::x { my ($_event, $_o_newvalue) = @_ } -sub Gtk2::Gdk::Event::Configure::y { my ($_event, $_o_newvalue) = @_ } - -package Gtk2::Gdk::Event::Crossing; -our @ISA = qw(); -sub DESTROY { my ($_sv) = @_ } -sub detail { my ($_eventcrossing, $_o_newvalue) = @_ } -sub focus { my ($_eventcrossing, $_o_newvalue) = @_ } -sub mode { my ($_eventcrossing, $_o_newvalue) = @_ } -sub subwindow { my ($_event, $_o_newvalue) = @_ } -sub Gtk2::Gdk::Event::Crossing::x { my ($_event, $_o_newvalue) = @_ } -sub Gtk2::Gdk::Event::Crossing::y { my ($_event, $_o_newvalue) = @_ } - -package Gtk2::Gdk::Event::DND; -our @ISA = qw(); -sub DESTROY { my ($_sv) = @_ } -sub context { my ($_eventdnd, $_o_newvalue) = @_ } - -package Gtk2::Gdk::Event::Expose; -our @ISA = qw(); -sub DESTROY { my ($_sv) = @_ } -sub area { my ($_eventexpose, $_o_newvalue) = @_ } -sub count { my ($_eventexpose, $_o_newvalue) = @_ } -sub region { my ($_eventexpose, $_o_newvalue) = @_ } - -package Gtk2::Gdk::Event::Focus; -our @ISA = qw(); -sub DESTROY { my ($_sv) = @_ } -sub in { my ($_eventfocus, $_o_newvalue) = @_ } - -package Gtk2::Gdk::Event::GrabBroken; -our @ISA = qw(); -sub DESTROY { my ($_sv) = @_ } -sub keyboard { my ($_event, $_o_newvalue) = @_ } - -package Gtk2::Gdk::Event::Key; -our @ISA = qw(); -sub DESTROY { my ($_sv) = @_ } -sub group { my ($_eventkey, $_o_newvalue) = @_ } -sub hardware_keycode { my ($_eventkey, $_o_newvalue) = @_ } -sub keyval { my ($_eventkey, $_o_newvalue) = @_ } - -package Gtk2::Gdk::Event::Motion; -our @ISA = qw(); -sub DESTROY { my ($_sv) = @_ } -sub device { my ($_eventmotion, $_o_newvalue) = @_ } -sub is_hint { my ($_eventmotion, $_o_newvalue) = @_ } -sub Gtk2::Gdk::Event::Motion::x { my ($_event, $_o_newvalue) = @_ } -sub Gtk2::Gdk::Event::Motion::y { my ($_event, $_o_newvalue) = @_ } - -package Gtk2::Gdk::Event::NoExpose; -our @ISA = qw(); -sub DESTROY { my ($_sv) = @_ } - -package Gtk2::Gdk::Event::OwnerChange; -our @ISA = qw(); -sub DESTROY { my ($_sv) = @_ } -sub owner { my ($_event, $_o_newvalue) = @_ } -sub reason { my ($_event, $_o_newvalue) = @_ } -sub selection { my ($_event, $_o_newvalue) = @_ } -sub selection_time { my ($_event, $_o_newvalue) = @_ } - -package Gtk2::Gdk::Event::Property; -our @ISA = qw(); -sub DESTROY { my ($_sv) = @_ } -sub atom { my ($_eventproperty, $_o_newvalue) = @_ } -sub state { my ($_eventproperty, $_o_newvalue) = @_ } - -package Gtk2::Gdk::Event::Proximity; -our @ISA = qw(); -sub DESTROY { my ($_sv) = @_ } -sub device { my ($_eventproximity, $_o_newvalue) = @_ } - -package Gtk2::Gdk::Event::Scroll; -our @ISA = qw(); -sub DESTROY { my ($_sv) = @_ } -sub device { my ($_eventscroll, $_o_newvalue) = @_ } -sub direction { my ($_eventscroll, $_o_newvalue) = @_ } -sub Gtk2::Gdk::Event::Scroll::x { my ($_event, $_o_newvalue) = @_ } -sub Gtk2::Gdk::Event::Scroll::y { my ($_event, $_o_newvalue) = @_ } - -package Gtk2::Gdk::Event::Selection; -our @ISA = qw(); -sub DESTROY { my ($_sv) = @_ } -sub property { my ($_eventselection, $_o_newvalue) = @_ } -sub requestor { my ($_eventselection, $_o_newvalue) = @_ } -sub selection { my ($_eventselection, $_o_newvalue) = @_ } -sub target { my ($_eventselection, $_o_newvalue) = @_ } - -package Gtk2::Gdk::Event::Setting; -our @ISA = qw(); -sub DESTROY { my ($_sv) = @_ } -sub action { my ($_eventsetting, $_o_newvalue) = @_ } -sub name { my ($_eventsetting, $_o_newvalue) = @_ } - -package Gtk2::Gdk::Event::Visibility; -our @ISA = qw(); -sub DESTROY { my ($_sv) = @_ } -sub state { my ($_eventvisibility, $_o_newvalue) = @_ } - -package Gtk2::Gdk::Event::WindowState; -our @ISA = qw(); -sub DESTROY { my ($_sv) = @_ } -sub changed_mask { my ($_eventwindowstate, $_o_newvalue) = @_ } -sub new_window_state { my ($_eventwindowstate, $_o_newvalue) = @_ } - -package Gtk2::Gdk::GC; -our @ISA = qw(); -sub copy { my ($_dst_gc, $_src_gc) = @_ } -sub get_colormap { my ($_gc) = @_ } -sub get_screen { my ($_gc) = @_ } -sub get_values { my ($_gc) = @_ } -sub new { my ($_class, $_drawable, $_o_values) = @_ } -sub new_with_values { my ($_class, $_drawable, $_o_values) = @_ } -sub offset { my ($_gc, $_x_offset, $_y_offset) = @_ } -sub rgb_gc_set_background { my ($_gc, $_rgb) = @_ } -sub rgb_gc_set_foreground { my ($_gc, $_rgb) = @_ } -sub set_background { my ($_gc, $_color) = @_ } -sub set_clip_mask { my ($_gc, $_mask) = @_ } -sub set_clip_origin { my ($_gc, $_x, $_y) = @_ } -sub set_clip_rectangle { my ($_gc, $_rectangle) = @_ } -sub set_clip_region { my ($_gc, $_region) = @_ } -sub set_colormap { my ($_gc, $_colormap) = @_ } -sub set_dashes { my ($_gc, $_dash_offset, @_more_paras) = @_ } -sub set_exposures { my ($_gc, $_exposures) = @_ } -sub set_fill { my ($_gc, $_fill) = @_ } -sub set_font { my ($_gc, $_font) = @_ } -sub set_foreground { my ($_gc, $_color) = @_ } -sub set_function { my ($_gc, $_function) = @_ } -sub set_line_attributes { my ($_gc, $_line_width, $_line_style, $_cap_style, $_join_style) = @_ } -sub set_rgb_background { my ($_gc, $_rgb) = @_ } -sub set_rgb_bg_color { my ($_gc, $_color) = @_ } -sub set_rgb_fg_color { my ($_gc, $_color) = @_ } -sub set_rgb_foreground { my ($_gc, $_rgb) = @_ } -sub set_stipple { my ($_gc, $_stipple) = @_ } -sub set_subwindow { my ($_gc, $_mode) = @_ } -sub set_tile { my ($_gc, $_tile) = @_ } -sub set_ts_origin { my ($_gc, $_x, $_y) = @_ } -sub set_values { my ($_gc, $_values) = @_ } - -package Gtk2::Gdk::Geometry; -our @ISA = qw(); -sub base_height { my ($_object, $_o_newvalue) = @_ } -sub base_width { my ($_object, $_o_newvalue) = @_ } -sub constrain_size { my ($_geometry_ref, @_more_paras) = @_ } -sub gravity { my ($_object, $_o_newvalue) = @_ } -sub height_inc { my ($_object, $_o_newvalue) = @_ } -sub max_aspect { my ($_object, $_o_newvalue) = @_ } -sub max_height { my ($_object, $_o_newvalue) = @_ } -sub max_width { my ($_object, $_o_newvalue) = @_ } -sub min_aspect { my ($_object, $_o_newvalue) = @_ } -sub min_height { my ($_object, $_o_newvalue) = @_ } -sub min_width { my ($_object, $_o_newvalue) = @_ } -sub new { my ($_class) = @_ } -sub width_inc { my ($_object, $_o_newvalue) = @_ } -sub win_gravity { my ($_object, $_o_newvalue) = @_ } - -package Gtk2::Gdk::Input; -our @ISA = qw(); -sub set_extension_events { my ($_class, $_window, $_mask, $_mode) = @_ } - -package Gtk2::Gdk::Keymap; -our @ISA = qw(); -sub get_default { my ($_class) = @_ } -sub get_direction { my ($_keymap) = @_ } -sub get_entries_for_keycode { my ($_keymap, $_hardware_keycode) = @_ } -sub get_entries_for_keyval { my ($_keymap, $_keyval) = @_ } -sub get_for_display { my ($_class, $_display) = @_ } -sub lookup_key { my ($_keymap, $_key) = @_ } -sub translate_keyboard_state { my ($_keymap, $_hardware_keycode, $_state, $_group) = @_ } - -package Gtk2::Gdk::PangoRenderer; -our @ISA = qw(); -sub get_default { my ($_class, $_screen) = @_ } -sub new { my ($_class, $_screen) = @_ } -sub set_drawable { my ($_gdk_renderer, $_drawable) = @_ } -sub set_gc { my ($_gdk_renderer, $_gc) = @_ } -sub set_override_color { my ($_gdk_renderer, $_part, $_color) = @_ } -sub set_stipple { my ($_gdk_renderer, $_part, $_stipple) = @_ } - -package Gtk2::Gdk::Pixbuf; -our @ISA = qw(); -sub add_alpha { my ($_pixbuf, $_substitute_color, $_r, $_g, $_b) = @_ } -sub composite { my ($_src, $_dest, $_dest_x, $_dest_y, $_dest_width, $_dest_height, $_offset_x, $_offset_y, $_scale_x, $_scale_y, $_interp_type, $_overall_alpha) = @_ } -sub composite_color { my ($_src, $_dest, $_dest_x, $_dest_y, $_dest_width, $_dest_height, $_offset_x, $_offset_y, $_scale_x, $_scale_y, $_interp_type, $_overall_alpha, $_check_x, $_check_y, $_check_size, $_color1, $_color2) = @_ } -sub composite_color_simple { my ($_src, $_dest_width, $_dest_height, $_interp_type, $_overall_alpha, $_check_size, $_color1, $_color2) = @_ } -sub copy { my ($_pixbuf) = @_ } -sub copy_area { my ($_src_pixbuf, $_src_x, $_src_y, $_width, $_height, $_dest_pixbuf, $_dest_x, $_dest_y) = @_ } -sub fill { my ($_pixbuf, $_pixel) = @_ } -sub flip { my ($_src, $_horizontal) = @_ } -sub get_bits_per_sample { my ($_pixbuf) = @_ } -sub get_colorspace { my ($_pixbuf) = @_ } -sub get_file_info { my ($_class, $_filename) = @_ } -sub get_formats { my ($_o_class) = @_ } -sub get_from_drawable { my ($_dest_or_class, $_src, $_cmap, $_src_x, $_src_y, $_dest_x, $_dest_y, $_width, $_height) = @_ } -sub get_from_image { my ($_dest_or_class, $_src, $_cmap, $_src_x, $_src_y, $_dest_x, $_dest_y, $_width, $_height) = @_ } -sub get_has_alpha { my ($_pixbuf) = @_ } -sub get_height { my ($_pixbuf) = @_ } -sub get_n_channels { my ($_pixbuf) = @_ } -sub get_option { my ($_pixbuf, $_key) = @_ } -sub get_pixels { my ($_pixbuf) = @_ } -sub get_rowstride { my ($_pixbuf) = @_ } -sub get_width { my ($_pixbuf) = @_ } -sub new { my ($_class, $_colorspace, $_has_alpha, $_bits_per_sample, $_width, $_height) = @_ } -sub new_from_data { my ($_class, $_data, $_colorspace, $_has_alpha, $_bits_per_sample, $_width, $_height, $_rowstride) = @_ } -sub new_from_file { my ($_class, $_filename) = @_ } -sub new_from_file_at_scale { my ($_class, $_filename, $_width, $_height, $_preserve_aspect_ratio) = @_ } -sub new_from_file_at_size { my ($_class, $_filename, $_width, $_height) = @_ } -sub new_from_inline { my ($_class, $_data, $_o_copy_pixels) = @_ } -sub new_from_xpm_data { my ($_class, @_more_paras) = @_ } -sub new_subpixbuf { my ($_src_pixbuf, $_src_x, $_src_y, $_width, $_height) = @_ } -sub render_pixmap_and_mask { my ($_pixbuf, $_alpha_threshold) = @_ } -sub render_pixmap_and_mask_for_colormap { my ($_pixbuf, $_colormap, $_alpha_threshold) = @_ } -sub render_threshold_alpha { my ($_pixbuf, $_bitmap, $_src_x, $_src_y, $_dest_x, $_dest_y, $_width, $_height, $_alpha_threshold) = @_ } -sub render_to_drawable { my ($_pixbuf, $_drawable, $_gc, $_src_x, $_src_y, $_dest_x, $_dest_y, $_width, $_height, $_dither, $_x_dither, $_y_dither) = @_ } -sub render_to_drawable_alpha { my ($_pixbuf, $_drawable, $_src_x, $_src_y, $_dest_x, $_dest_y, $_width, $_height, $_alpha_mode, $_alpha_threshold, $_dither, $_x_dither, $_y_dither) = @_ } -sub rotate_simple { my ($_src, $_angle) = @_ } -sub saturate_and_pixelate { my ($_src, $_dest, $_saturation, $_pixelate) = @_ } -sub save { my ($_pixbuf, $_filename, $_type, @_more_paras) = @_ } -sub save_to_buffer { my ($_pixbuf, $_type, @_more_paras) = @_ } -sub scale { my ($_src, $_dest, $_dest_x, $_dest_y, $_dest_width, $_dest_height, $_offset_x, $_offset_y, $_scale_x, $_scale_y, $_interp_type) = @_ } -sub scale_simple { my ($_src, $_dest_width, $_dest_height, $_interp_type) = @_ } - -package Gtk2::Gdk::PixbufAnimation; -our @ISA = qw(); -sub get_height { my ($_animation) = @_ } -sub get_iter { my ($_animation, $_o_start_time_seconds, $_o_start_time_microseconds) = @_ } -sub get_static_image { my ($_animation) = @_ } -sub get_width { my ($_animation) = @_ } -sub is_static_image { my ($_animation) = @_ } -sub new_from_file { my ($_class, $_filename) = @_ } - -package Gtk2::Gdk::PixbufAnimationIter; -our @ISA = qw(); -sub advance { my ($_iter, $_o_current_time_seconds, $_o_current_time_microseconds) = @_ } -sub get_delay_time { my ($_iter) = @_ } -sub get_pixbuf { my ($_iter) = @_ } -sub on_currently_loading_frame { my ($_iter) = @_ } - -package Gtk2::Gdk::PixbufFormat; -our @ISA = qw(); -sub DESTROY { my ($_sv) = @_ } -sub set_disabled { my ($_format, $_disabled) = @_ } - -package Gtk2::Gdk::PixbufLoader; -our @ISA = qw(); -sub close { my ($_loader) = @_ } -sub get_animation { my ($_loader) = @_ } -sub get_format { my ($_loader) = @_ } -sub get_pixbuf { my ($_loader) = @_ } -sub new { my ($_class) = @_ } -sub new_with_mime_type { my (@_more_paras) = @_ } -sub new_with_type { my (@_more_paras) = @_ } -sub set_size { my ($_loader, $_width, $_height) = @_ } -sub write { my ($_loader, $_buf) = @_ } - -package Gtk2::Gdk::PixbufSimpleAnim; -our @ISA = qw(); -sub add_frame { my ($_animation, $_pixbuf) = @_ } -sub new { my ($_class, $_width, $_height, $_rate) = @_ } - -package Gtk2::Gdk::Pixmap; -our @ISA = qw(); -sub colormap_create_from_xpm { my ($_class, $_drawable, $_colormap, $_transparent_color, $_filename) = @_ } -sub colormap_create_from_xpm_d { my ($_class, $_drawable, $_colormap, $_transparent_color, $_data, @_more_paras) = @_ } -sub create_from_data { my ($_class, $_drawable, $_data, $_width, $_height, $_depth, $_fg, $_bg) = @_ } -sub create_from_xpm { my ($_class, $_drawable, $_transparent_color, $_filename) = @_ } -sub create_from_xpm_d { my ($_class, $_drawable, $_transparent_color, $_data, @_more_paras) = @_ } -sub foreign_new { my ($_class, $_anid) = @_ } -sub foreign_new_for_display { my ($_class, $_display, $_anid) = @_ } -sub lookup { my ($_class, $_anid) = @_ } -sub lookup_for_display { my ($_class, $_display, $_anid) = @_ } -sub new { my ($_class, $_drawable, $_width, $_height, $_depth) = @_ } - -package Gtk2::Gdk::Rectangle; -our @ISA = qw(); -sub height { my ($_rectangle, $_o_newvalue) = @_ } -sub intersect { my ($_src1, $_src2) = @_ } -sub new { my ($_class, $_x, $_y, $_width, $_height) = @_ } -sub union { my ($_src1, $_src2) = @_ } -sub values { my ($_rectangle) = @_ } -sub width { my ($_rectangle, $_o_newvalue) = @_ } -sub Gtk2::Gdk::Rectangle::x { my ($_rectangle, $_o_newvalue) = @_ } -sub Gtk2::Gdk::Rectangle::y { my ($_rectangle, $_o_newvalue) = @_ } - -package Gtk2::Gdk::Region; -our @ISA = qw(); -sub empty { my ($_region) = @_ } -sub equal { my ($_region1, $_region2) = @_ } -sub get_clipbox { my ($_region) = @_ } -sub get_rectangles { my ($_region) = @_ } -sub intersect { my ($_source1, $_source2) = @_ } -sub new { my ($_class) = @_ } -sub offset { my ($_region, $_dx, $_dy) = @_ } -sub point_in { my ($_region, $_x, $_y) = @_ } -sub polygon { my ($_class, $_points_ref, $_fill_rule) = @_ } -sub rect_in { my ($_region, $_rect) = @_ } -sub rectangle { my ($_class, $_rectangle) = @_ } -sub shrink { my ($_region, $_dx, $_dy) = @_ } -sub spans_intersect_foreach { my ($_region, $_spans_ref, $_sorted, $_func, $_o_data) = @_ } -sub subtract { my ($_source1, $_source2) = @_ } -sub union { my ($_source1, $_source2) = @_ } -sub union_with_rect { my ($_region, $_rect) = @_ } -sub Gtk2::Gdk::Region::xor { my ($_source1, $_source2) = @_ } - -package Gtk2::Gdk::Rgb; -our @ISA = qw(); -sub colormap_ditherable { my ($_class, $_cmap) = @_ } -sub ditherable { my ($_class) = @_ } -sub set_install { my ($_class, $_install) = @_ } -sub set_min_colors { my ($_class, $_min_colors) = @_ } -sub set_verbose { my ($_class, $_verbose) = @_ } - -package Gtk2::Gdk::Screen; -our @ISA = qw(); -sub broadcast_client_message { my ($_screen, $_event) = @_ } -sub get_default { my ($_class) = @_ } -sub get_default_colormap { my ($_screen) = @_ } -sub get_display { my ($_screen) = @_ } -sub get_height { my ($_screen) = @_ } -sub get_height_mm { my ($_screen) = @_ } -sub get_monitor_at_point { my ($_screen, $_x, $_y) = @_ } -sub get_monitor_at_window { my ($_screen, $_window) = @_ } -sub get_monitor_geometry { my ($_screen, $_monitor_num) = @_ } -sub get_n_monitors { my ($_screen) = @_ } -sub get_number { my ($_screen) = @_ } -sub get_rgb_colormap { my ($_screen) = @_ } -sub get_rgb_visual { my ($_screen) = @_ } -sub get_rgba_colormap { my ($_screen) = @_ } -sub get_rgba_visual { my ($_screen) = @_ } -sub get_root_window { my ($_screen) = @_ } -sub get_screen_number { my ($_screen) = @_ } -sub get_setting { my ($_screen, $_name) = @_ } -sub get_system_colormap { my ($_screen) = @_ } -sub get_system_visual { my ($_screen) = @_ } -sub get_toplevel_windows { my ($_screen) = @_ } -sub get_width { my ($_screen) = @_ } -sub get_width_mm { my ($_screen) = @_ } -sub get_window_manager_name { my ($_screen) = @_ } -sub list_visuals { my ($_screen) = @_ } -sub make_display_name { my ($_screen) = @_ } -sub set_default_colormap { my ($_screen, $_colormap) = @_ } -sub supports_net_wm_hint { my ($_screen, $_property) = @_ } - -package Gtk2::Gdk::Selection; -our @ISA = qw(); -sub convert { my ($_class, $_requestor, $_selection, $_target, $_time_) = @_ } -sub owner_get { my ($_class, $_selection) = @_ } -sub owner_get_for_display { my ($_class, $_display, $_selection) = @_ } -sub owner_set { my ($_class, $_owner, $_selection, $_time_, $_send_event) = @_ } -sub owner_set_for_display { my ($_class, $_display, $_owner, $_selection, $_time_, $_send_event) = @_ } -sub property_get { my ($_class, $_requestor) = @_ } -sub send_notify { my ($_class, $_requestor, $_selection, $_target, $_property, $_time_) = @_ } -sub send_notify_for_display { my ($_class, $_display, $_requestor, $_selection, $_target, $_property, $_time_) = @_ } - -package Gtk2::Gdk::Threads; -our @ISA = qw(); -sub enter { my ($_class) = @_ } -sub init { my ($_class) = @_ } -sub leave { my ($_class) = @_ } - -package Gtk2::Gdk::Visual; -our @ISA = qw(); -sub bits_per_rgb { my ($_visual) = @_ } -sub blue_mask { my ($_visual) = @_ } -sub blue_prec { my ($_visual) = @_ } -sub blue_shift { my ($_visual) = @_ } -sub byte_order { my ($_visual) = @_ } -sub colormap_size { my ($_visual) = @_ } -sub depth { my ($_visual) = @_ } -sub get_best { my ($_class) = @_ } -sub get_best_depth { my ($_class) = @_ } -sub get_best_type { my ($_class) = @_ } -sub get_best_with_both { my ($_class, $_depth, $_visual_type) = @_ } -sub get_best_with_depth { my ($_class, $_depth) = @_ } -sub get_best_with_type { my ($_class, $_visual_type) = @_ } -sub get_screen { my ($_visual) = @_ } -sub get_system { my ($_class) = @_ } -sub green_mask { my ($_visual) = @_ } -sub green_prec { my ($_visual) = @_ } -sub green_shift { my ($_visual) = @_ } -sub red_mask { my ($_visual) = @_ } -sub red_prec { my ($_visual) = @_ } -sub red_shift { my ($_visual) = @_ } -sub type { my ($_visual) = @_ } - -package Gtk2::Gdk::Window; -our @ISA = qw(); -sub at_pointer { my ($_class) = @_ } -sub begin_move_drag { my ($_window, $_button, $_root_x, $_root_y, $_timestamp) = @_ } -sub begin_paint_rect { my ($_window, $_rectangle) = @_ } -sub begin_paint_region { my ($_window, $_region) = @_ } -sub begin_resize_drag { my ($_window, $_edge, $_button, $_root_x, $_root_y, $_timestamp) = @_ } -sub clear { my ($_window) = @_ } -sub clear_area { my ($_window, $_x, $_y, $_width, $_height) = @_ } -sub clear_area_e { my ($_window, $_x, $_y, $_width, $_height) = @_ } -sub configure_finished { my ($_window) = @_ } -sub deiconify { my ($_window) = @_ } -sub destroy { my ($_window) = @_ } -sub enable_synchronized_configure { my ($_window) = @_ } -sub end_paint { my ($_window) = @_ } -sub focus { my ($_window, $_timestamp) = @_ } -sub foreign_new { my ($_class, $_anid) = @_ } -sub foreign_new_for_display { my ($_class, $_display, $_anid) = @_ } -sub freeze_updates { my ($_window) = @_ } -sub fullscreen { my ($_window) = @_ } -sub gdk_set_sm_client_id { my ($_sm_client_id) = @_ } -sub get_children { my ($_window) = @_ } -sub get_decorations { my ($_window) = @_ } -sub get_events { my ($_window) = @_ } -sub get_frame_extents { my ($_window) = @_ } -sub get_geometry { my ($_window) = @_ } -sub get_group { my ($_window) = @_ } -sub get_internal_paint_info { my ($_window) = @_ } -sub get_origin { my ($_window) = @_ } -sub get_parent { my ($_window) = @_ } -sub get_pointer { my ($_window) = @_ } -sub get_position { my ($_window) = @_ } -sub get_root_origin { my ($_window) = @_ } -sub get_state { my ($_window) = @_ } -sub get_toplevel { my ($_window) = @_ } -sub get_toplevels { my ($_class) = @_ } -sub get_update_area { my ($_window) = @_ } -sub get_user_data { my ($_window) = @_ } -sub get_window_type { my ($_window) = @_ } -sub hide { my ($_window) = @_ } -sub iconify { my ($_window) = @_ } -sub invalidate_maybe_recurse { my ($_window, $_region, $_func, $_o_data) = @_ } -sub invalidate_rect { my ($_window, $_rectangle, $_invalidate_children) = @_ } -sub invalidate_region { my ($_window, $_region, $_invalidate_children) = @_ } -sub is_viewable { my ($_window) = @_ } -sub is_visible { my ($_window) = @_ } -sub lookup { my ($_class, $_anid) = @_ } -sub lookup_for_display { my ($_class, $_display, $_anid) = @_ } -sub lower { my ($_window) = @_ } -sub maximize { my ($_window) = @_ } -sub merge_child_shapes { my ($_window) = @_ } -sub move { my ($_window, $_x, $_y) = @_ } -sub move_region { my ($_window, $_region, $_dx, $_dy) = @_ } -sub move_resize { my ($_window, $_x, $_y, $_width, $_height) = @_ } -sub move_to_current_desktop { my ($_window) = @_ } -sub new { my ($_class, $_parent, $_attributes_ref) = @_ } -sub peek_children { my ($_window) = @_ } -sub process_all_updates { my ($_class_or_instance) = @_ } -sub process_updates { my ($_window, $_update_children) = @_ } -sub property_change { my ($_window, $_property, $_type, $_format, $_mode, @_more_paras) = @_ } -sub property_delete { my ($_window, $_property) = @_ } -sub property_get { my ($_window, $_property, $_type, $_offset, $_length, $_pdelete) = @_ } -sub raise { my ($_window) = @_ } -sub register_dnd { my ($_window) = @_ } -sub reparent { my ($_window, $_new_parent, $_x, $_y) = @_ } -sub resize { my ($_window, $_width, $_height) = @_ } -sub scroll { my ($_window, $_dx, $_dy) = @_ } -sub set_accept_focus { my ($_window, $_accept_focus) = @_ } -sub set_back_pixmap { my ($_window, $_pixmap, $_o_parent_relative) = @_ } -sub set_background { my ($_window, $_color) = @_ } -sub set_child_shapes { my ($_window) = @_ } -sub set_cursor { my ($_window, $_cursor) = @_ } -sub set_debug_updates { my ($_class_or_instance, $_enable) = @_ } -sub set_decorations { my ($_window, $_decorations) = @_ } -sub set_events { my ($_window, $_event_mask) = @_ } -sub set_focus_on_map { my ($_window, $_focus_on_map) = @_ } -sub set_functions { my ($_window, $_functions) = @_ } -sub set_geometry_hints { my ($_window, $_geometry_ref, $_o_geom_mask_sv) = @_ } -sub set_group { my ($_window, $_leader) = @_ } -sub set_icon { my ($_window, $_icon_window, $_pixmap, $_mask) = @_ } -sub set_icon_list { my ($_window, @_more_paras) = @_ } -sub set_icon_name { my ($_window, $_name) = @_ } -sub set_keep_above { my ($_window, $_setting) = @_ } -sub set_keep_below { my ($_window, $_setting) = @_ } -sub set_modal_hint { my ($_window, $_modal) = @_ } -sub set_override_redirect { my ($_window, $_override_redirect) = @_ } -sub set_role { my ($_window, $_role) = @_ } -sub set_skip_pager_hint { my ($_window, $_skips_pager) = @_ } -sub set_skip_taskbar_hint { my ($_window, $_skips_taskbar) = @_ } -sub set_static_gravities { my ($_window, $_use_static) = @_ } -sub set_title { my ($_window, $_title) = @_ } -sub set_transient_for { my ($_window, $_parent) = @_ } -sub set_type_hint { my ($_window, $_hint) = @_ } -sub set_urgency_hint { my ($_window, $_urgent) = @_ } -sub set_user_data { my ($_window, $_user_data) = @_ } -sub set_user_time { my ($_window, $_timestamp) = @_ } -sub shape_combine_mask { my ($_window, $_mask, $_x, $_y) = @_ } -sub shape_combine_region { my ($_window, $_shape_region, $_offset_x, $_offset_y) = @_ } -sub show { my ($_window) = @_ } -sub show_unraised { my ($_window) = @_ } -sub stick { my ($_window) = @_ } -sub thaw_updates { my ($_window) = @_ } -sub unfullscreen { my ($_window) = @_ } -sub unmaximize { my ($_window) = @_ } -sub unstick { my ($_window) = @_ } -sub withdraw { my ($_window) = @_ } - -package Gtk2::Gdk::X11; -our @ISA = qw(); -sub get_default_screen { my ($_class) = @_ } -sub get_server_time { my ($_class, $_window) = @_ } -sub grab_server { my ($_class) = @_ } -sub net_wm_supports { my ($_class, $_property) = @_ } -sub ungrab_server { my ($_class) = @_ } - -package Gtk2::HBox; -our @ISA = qw(); -sub new { my ($_class, $_o_homogeneous, $_o_spacing) = @_ } - -package Gtk2::HButtonBox; -our @ISA = qw(); -sub get_layout_default { my ($_class) = @_ } -sub get_spacing_default { my ($_class) = @_ } -sub new { my ($_class) = @_ } -sub set_layout_default { my ($_class, $_layout) = @_ } -sub set_spacing_default { my ($_class, $_spacing) = @_ } - -package Gtk2::HPaned; -our @ISA = qw(); -sub new { my ($_class) = @_ } - -package Gtk2::HRuler; -our @ISA = qw(); -sub new { my ($_class) = @_ } - -package Gtk2::HScale; -our @ISA = qw(); -sub new { my ($_class, $_o_adjustment) = @_ } -sub new_with_range { my ($_class, $_min, $_max, $_step) = @_ } - -package Gtk2::HScrollBar; -our @ISA = qw(); -sub new { my ($_class, $_o_adjustment) = @_ } - -package Gtk2::HScrollbar; -our @ISA = qw(); -sub new { my ($_class, $_o_adjustment) = @_ } - -package Gtk2::HSeparator; -our @ISA = qw(); -sub new { my ($_class) = @_ } - -package Gtk2::HandleBox; -our @ISA = qw(); -sub get_child_detached { my ($_handle_box) = @_ } -sub get_handle_position { my ($_handle_box) = @_ } -sub get_shadow_type { my ($_handle_box) = @_ } -sub get_snap_edge { my ($_handle_box) = @_ } -sub new { my ($_class) = @_ } -sub set_handle_position { my ($_handle_box, $_position) = @_ } -sub set_shadow_type { my ($_handle_box, $_type) = @_ } -sub set_snap_edge { my ($_handle_box, $_edge) = @_ } - -package Gtk2::IconFactory; -our @ISA = qw(); -sub add { my ($_factory, $_stock_id, $_icon_set) = @_ } -sub add_default { my ($_factory) = @_ } -sub lookup { my ($_factory, $_stock_id) = @_ } -sub lookup_default { my ($_class, $_stock_id) = @_ } -sub new { my ($_class) = @_ } -sub remove_default { my ($_factory) = @_ } - -package Gtk2::IconInfo; -our @ISA = qw(); -sub get_attach_points { my ($_icon_info) = @_ } -sub get_base_size { my ($_icon_info) = @_ } -sub get_builtin_pixbuf { my ($_icon_info) = @_ } -sub get_display_name { my ($_icon_info) = @_ } -sub get_embedded_rect { my ($_icon_info) = @_ } -sub get_filename { my ($_icon_info) = @_ } -sub load_icon { my ($_icon_info) = @_ } -sub set_raw_coordinates { my ($_icon_info, $_raw_coordinates) = @_ } - -package Gtk2::IconSet; -our @ISA = qw(); -sub add_source { my ($_icon_set, $_source) = @_ } -sub get_sizes { my ($_icon_set) = @_ } -sub new { my ($_class) = @_ } -sub new_from_pixbuf { my ($_class, $_pixbuf) = @_ } -sub render_icon { my ($_icon_set, $_style, $_direction, $_state, $_size, $_widget, $_o_detail) = @_ } - -package Gtk2::IconSize; -our @ISA = qw(); -sub from_name { my ($_class, $_name) = @_ } -sub lookup { my ($_class, $_size) = @_ } -sub lookup_for_settings { my ($_class, $_settings, $_size) = @_ } -sub register { my ($_class, $_name, $_width, $_height) = @_ } -sub register_alias { my ($_class, $_alias, $_target) = @_ } - -package Gtk2::IconSource; -our @ISA = qw(); -sub get_direction { my ($_source) = @_ } -sub get_direction_wildcarded { my ($_source) = @_ } -sub get_filename { my ($_source) = @_ } -sub get_icon_name { my ($_source) = @_ } -sub get_pixbuf { my ($_source) = @_ } -sub get_size { my ($_source) = @_ } -sub get_size_wildcarded { my ($_source) = @_ } -sub get_state { my ($_source) = @_ } -sub get_state_wildcarded { my ($_source) = @_ } -sub new { my ($_class) = @_ } -sub set_direction { my ($_source, $_direction) = @_ } -sub set_direction_wildcarded { my ($_source, $_setting) = @_ } -sub set_filename { my ($_source, $_filename) = @_ } -sub set_icon_name { my ($_source, $_icon_name) = @_ } -sub set_pixbuf { my ($_source, $_pixbuf) = @_ } -sub set_size { my ($_source, $_size) = @_ } -sub set_size_wildcarded { my ($_source, $_setting) = @_ } -sub set_state { my ($_source, $_state) = @_ } -sub set_state_wildcarded { my ($_source, $_setting) = @_ } - -package Gtk2::IconTheme; -our @ISA = qw(); -sub add_builtin_icon { my ($_class, $_icon_name, $_size, $_pixbuf) = @_ } -sub append_search_path { my ($_icon_theme, $_path) = @_ } -sub get_default { my ($_class) = @_ } -sub get_example_icon_name { my ($_icon_theme) = @_ } -sub get_for_screen { my ($_class, $_screen) = @_ } -sub get_icon_sizes { my ($_icon_theme, $_icon_name) = @_ } -sub get_search_path { my ($_icon_theme) = @_ } -sub has_icon { my ($_icon_theme, $_icon_name) = @_ } -sub list_icons { my ($_icon_theme, $_context) = @_ } -sub load_icon { my ($_icon_theme, $_icon_name, $_size, $_flags) = @_ } -sub lookup_icon { my ($_icon_theme, $_icon_name, $_size, $_flags) = @_ } -sub new { my ($_class) = @_ } -sub prepend_search_path { my ($_icon_theme, $_path) = @_ } -sub rescan_if_needed { my ($_icon_theme) = @_ } -sub set_custom_theme { my ($_icon_theme, $_theme_name) = @_ } -sub set_screen { my ($_icon_theme, $_screen) = @_ } -sub set_search_path { my ($_icon_theme, @_more_paras) = @_ } - -package Gtk2::IconView; -our @ISA = qw(); -sub create_drag_icon { my ($_icon_view, $_path) = @_ } -sub enable_model_drag_dest { my ($_icon_view, $_actions, @_more_paras) = @_ } -sub enable_model_drag_source { my ($_icon_view, $_start_button_mask, $_actions, @_more_paras) = @_ } -sub get_column_spacing { my ($_icon_view) = @_ } -sub get_columns { my ($_icon_view) = @_ } -sub get_cursor { my ($_icon_view) = @_ } -sub get_dest_item_at_pos { my ($_icon_view, $_drag_x, $_drag_y) = @_ } -sub get_drag_dest_item { my ($_icon_view) = @_ } -sub get_item_at_pos { my ($_icon_view, $_x, $_y) = @_ } -sub get_item_width { my ($_icon_view) = @_ } -sub get_margin { my ($_icon_view) = @_ } -sub get_markup_column { my ($_icon_view) = @_ } -sub get_model { my ($_icon_view) = @_ } -sub get_orientation { my ($_icon_view) = @_ } -sub get_path_at_pos { my ($_icon_view, $_x, $_y) = @_ } -sub get_pixbuf_column { my ($_icon_view) = @_ } -sub get_reorderable { my ($_icon_view) = @_ } -sub get_row_spacing { my ($_icon_view) = @_ } -sub get_selected_items { my ($_icon_view) = @_ } -sub get_selection_mode { my ($_icon_view) = @_ } -sub get_spacing { my ($_icon_view) = @_ } -sub get_text_column { my ($_icon_view) = @_ } -sub get_visible_range { my ($_icon_view) = @_ } -sub item_activated { my ($_icon_view, $_path) = @_ } -sub new { my ($_class) = @_ } -sub new_with_model { my ($_class, $_model) = @_ } -sub path_is_selected { my ($_icon_view, $_path) = @_ } -sub scroll_to_path { my ($_icon_view, $_path, $_use_align, $_row_align, $_col_align) = @_ } -sub select_all { my ($_icon_view) = @_ } -sub select_path { my ($_icon_view, $_path) = @_ } -sub selected_foreach { my ($_icon_view, $_func, $_o_data) = @_ } -sub set_column_spacing { my ($_icon_view, $_column_spacing) = @_ } -sub set_columns { my ($_icon_view, $_columns) = @_ } -sub set_cursor { my ($_icon_view, $_path, $_cell, $_start_editing) = @_ } -sub set_drag_dest_item { my ($_icon_view, $_path, $_pos) = @_ } -sub set_item_width { my ($_icon_view, $_item_width) = @_ } -sub set_margin { my ($_icon_view, $_margin) = @_ } -sub set_markup_column { my ($_icon_view, $_column) = @_ } -sub set_model { my ($_icon_view, $_model) = @_ } -sub set_orientation { my ($_icon_view, $_orientation) = @_ } -sub set_pixbuf_column { my ($_icon_view, $_column) = @_ } -sub set_reorderable { my ($_icon_view, $_reorderable) = @_ } -sub set_row_spacing { my ($_icon_view, $_row_spacing) = @_ } -sub set_selection_mode { my ($_icon_view, $_mode) = @_ } -sub set_spacing { my ($_icon_view, $_spacing) = @_ } -sub set_text_column { my ($_icon_view, $_column) = @_ } -sub unselect_all { my ($_icon_view) = @_ } -sub unselect_path { my ($_icon_view, $_path) = @_ } -sub unset_model_drag_dest { my ($_icon_view) = @_ } -sub unset_model_drag_source { my ($_icon_view) = @_ } - -package Gtk2::Image; -our @ISA = qw(); -sub clear { my ($_image) = @_ } -sub get_animation { my ($_image) = @_ } -sub get_icon_name { my ($_image) = @_ } -sub get_icon_set { my ($_image) = @_ } -sub get_image { my ($_image) = @_ } -sub get_pixbuf { my ($_image) = @_ } -sub get_pixel_size { my ($_image) = @_ } -sub get_pixmap { my ($_image) = @_ } -sub get_stock { my ($_image) = @_ } -sub get_storage_type { my ($_image) = @_ } -sub new { my ($_class) = @_ } -sub new_from_animation { my ($_class, $_animation) = @_ } -sub new_from_file { my ($_class, $_filename) = @_ } -sub new_from_icon_name { my ($_class, $_icon_name, $_size) = @_ } -sub new_from_icon_set { my ($_class, $_icon_set, $_size) = @_ } -sub new_from_image { my ($_class, $_image, $_mask) = @_ } -sub new_from_pixbuf { my ($_class, $_pixbuf) = @_ } -sub new_from_pixmap { my ($_class, $_pixmap, $_mask) = @_ } -sub new_from_stock { my ($_class, $_stock_id, $_size) = @_ } -sub set_from_animation { my ($_image, $_animation) = @_ } -sub set_from_file { my ($_image, $_filename) = @_ } -sub set_from_icon_name { my ($_image, $_icon_name, $_size) = @_ } -sub set_from_icon_set { my ($_image, $_icon_set, $_size) = @_ } -sub set_from_image { my ($_image, $_gdk_image, $_mask) = @_ } -sub set_from_pixbuf { my ($_image, $_pixbuf) = @_ } -sub set_from_pixmap { my ($_image, $_pixmap, $_mask) = @_ } -sub set_from_stock { my ($_image, $_stock_id, $_size) = @_ } -sub set_pixel_size { my ($_image, $_pixel_size) = @_ } - -package Gtk2::ImageMenuItem; -our @ISA = qw(); -sub get_image { my ($_image_menu_item) = @_ } -sub new { my ($_class, $_o_label) = @_ } -sub new_from_stock { my ($_class, $_stock_id, $_o_accel_group) = @_ } -sub new_with_label { my ($_class, $_o_label) = @_ } -sub new_with_mnemonic { my ($_class, $_o_label) = @_ } -sub set_image { my ($_image_menu_item, $_image) = @_ } - -package Gtk2::InputDialog; -our @ISA = qw(); -sub new { my ($_class) = @_ } - -package Gtk2::Invisible; -our @ISA = qw(); -sub get_screen { my ($_invisible) = @_ } -sub new { my ($_class) = @_ } -sub new_for_screen { my ($_class, $_screen) = @_ } -sub set_screen { my ($_invisible, $_screen) = @_ } - -package Gtk2::Item; -our @ISA = qw(); -sub deselect { my ($_item) = @_ } -sub select { my ($_item) = @_ } -sub toggle { my ($_item) = @_ } - -package Gtk2::ItemFactory; -our @ISA = qw(); -sub create_item { my ($_ifactory, $_entry_ref, $_o_callback_data) = @_ } -sub create_items { my ($_ifactory, $_callback_data, @_more_paras) = @_ } -sub delete_entries { my ($_ifactory, @_more_paras) = @_ } -sub delete_entry { my ($_ifactory, $_entry_ref) = @_ } -sub delete_item { my ($_ifactory, $_path) = @_ } -sub from_widget { my ($_class, $_widget) = @_ } -sub get_item { my ($_ifactory, $_path) = @_ } -sub get_item_by_action { my ($_ifactory, $_action) = @_ } -sub get_widget { my ($_ifactory, $_path) = @_ } -sub get_widget_by_action { my ($_ifactory, $_action) = @_ } -sub new { my ($_class, $_container_type_package, $_path, $_o_accel_group) = @_ } -sub path_from_widget { my ($_class, $_widget) = @_ } -sub popup { my ($_ifactory, $_x, $_y, $_mouse_button, $_time_, $_o_popup_data) = @_ } -sub popup_data { my ($_ifactory) = @_ } -sub popup_data_from_widget { my ($_class, $_widget) = @_ } -sub set_translate_func { my ($_ifactory, $_func, $_o_data) = @_ } - -package Gtk2::Label; -our @ISA = qw(); -sub get_angle { my ($_label) = @_ } -sub get_attributes { my ($_label) = @_ } -sub get_ellipsize { my ($_label) = @_ } -sub get_justify { my ($_label) = @_ } -sub get_label { my ($_label) = @_ } -sub get_layout { my ($_label) = @_ } -sub get_layout_offsets { my ($_label) = @_ } -sub get_line_wrap { my ($_label) = @_ } -sub get_max_width_chars { my ($_label) = @_ } -sub get_mnemonic_keyval { my ($_label) = @_ } -sub get_mnemonic_widget { my ($_label) = @_ } -sub get_selectable { my ($_label) = @_ } -sub get_selection_bounds { my ($_label) = @_ } -sub get_single_line_mode { my ($_label) = @_ } -sub get_text { my ($_label) = @_ } -sub get_use_markup { my ($_label) = @_ } -sub get_use_underline { my ($_label) = @_ } -sub get_width_chars { my ($_label) = @_ } -sub new { my ($_class, $_o_str) = @_ } -sub new_with_mnemonic { my ($_class, $_str) = @_ } -sub select_region { my ($_label, $_o_start_offset, $_o_end_offset) = @_ } -sub set_angle { my ($_label, $_angle) = @_ } -sub set_attributes { my ($_label, $_attrs) = @_ } -sub set_ellipsize { my ($_label, $_mode) = @_ } -sub set_justify { my ($_label, $_jtype) = @_ } -sub set_label { my ($_label, $_str) = @_ } -sub set_line_wrap { my ($_label, $_wrap) = @_ } -sub set_markup { my ($_label, $_str) = @_ } -sub set_markup_with_mnemonic { my ($_label, $_str) = @_ } -sub set_max_width_chars { my ($_label, $_n_chars) = @_ } -sub set_mnemonic_widget { my ($_label, $_widget) = @_ } -sub set_pattern { my ($_label, $_pattern) = @_ } -sub set_selectable { my ($_label, $_setting) = @_ } -sub set_single_line_mode { my ($_label, $_single_line_mode) = @_ } -sub set_text { my ($_label, $_str) = @_ } -sub set_text_with_mnemonic { my ($_label, $_str) = @_ } -sub set_use_markup { my ($_label, $_setting) = @_ } -sub set_use_underline { my ($_label, $_setting) = @_ } -sub set_width_chars { my ($_label, $_n_chars) = @_ } - -package Gtk2::Layout; -our @ISA = qw(); -sub freeze { my ($_layout) = @_ } -sub get_hadjustment { my ($_layout) = @_ } -sub get_size { my ($_layout) = @_ } -sub get_vadjustment { my ($_layout) = @_ } -sub move { my ($_layout, $_child_widget, $_x, $_y) = @_ } -sub new { my ($_class, $_o_hadjustment, $_o_vadjustment) = @_ } -sub put { my ($_layout, $_child_widget, $_x, $_y) = @_ } -sub set_hadjustment { my ($_layout, $_adjustment) = @_ } -sub set_size { my ($_layout, $_width, $_height) = @_ } -sub set_vadjustment { my ($_layout, $_adjustment) = @_ } -sub thaw { my ($_layout) = @_ } - -package Gtk2::List; -our @ISA = qw(); -sub append_items { my ($_list, @_more_paras) = @_ } -sub child_position { my ($_list, $_child) = @_ } -sub clear_items { my ($_list, $_start, $_end) = @_ } -sub end_drag_selection { my ($_list) = @_ } -sub end_selection { my ($_list) = @_ } -sub extend_selection { my ($_list, $_scroll_type, $_position, $_auto_start_selection) = @_ } -sub insert_items { my ($_list, $_position, @_more_paras) = @_ } -sub new { my ($_class) = @_ } -sub prepend_items { my ($_list, @_more_paras) = @_ } -sub remove_items { my ($_list, @_more_paras) = @_ } -sub scroll_horizontal { my ($_list, $_scroll_type, $_position) = @_ } -sub scroll_vertical { my ($_list, $_scroll_type, $_position) = @_ } -sub select_all { my ($_list) = @_ } -sub select_child { my ($_list, $_child) = @_ } -sub select_item { my ($_list, $_item) = @_ } -sub set_selection_mode { my ($_list, $_mode) = @_ } -sub start_selection { my ($_list) = @_ } -sub toggle_add_mode { my ($_list) = @_ } -sub toggle_focus_row { my ($_list) = @_ } -sub toggle_row { my ($_list, $_item) = @_ } -sub undo_selection { my ($_list) = @_ } -sub unselect_all { my ($_list) = @_ } -sub unselect_child { my ($_list, $_child) = @_ } -sub unselect_item { my ($_list, $_item) = @_ } - -package Gtk2::ListItem; -our @ISA = qw(); -sub deselect { my ($_list_item) = @_ } -sub new { my ($_class, $_o_label) = @_ } -sub new_with_label { my ($_class, $_o_label) = @_ } -sub select { my ($_list_item) = @_ } - -package Gtk2::ListStore; -our @ISA = qw(); -sub append { my ($_list_store) = @_ } -sub clear { my ($_list_store) = @_ } -sub insert { my ($_list_store, $_position) = @_ } -sub insert_after { my ($_list_store, $_sibling) = @_ } -sub insert_before { my ($_list_store, $_sibling) = @_ } -sub insert_with_values { my ($_list_store, $_position, @_more_paras) = @_ } -sub iter_is_valid { my ($_list_store, $_iter) = @_ } -sub move_after { my ($_store, $_iter, $_position) = @_ } -sub move_before { my ($_store, $_iter, $_position) = @_ } -sub new { my ($_class, @_more_paras) = @_ } -sub prepend { my ($_list_store) = @_ } -sub remove { my ($_list_store, $_iter) = @_ } -sub reorder { my ($_store, @_more_paras) = @_ } -sub set { my ($_list_store, $_iter, $_col1, $_val1, @_more_paras) = @_ } -sub set_column_types { my ($_list_store, @_more_paras) = @_ } -sub set_value { my ($_list_store, $_iter, $_col1, $_val1, @_more_paras) = @_ } -sub swap { my ($_store, $_a, $_b) = @_ } - -package Gtk2::Menu; -our @ISA = qw(); -sub attach { my ($_menu, $_child, $_left_attach, $_right_attach, $_top_attach, $_bottom_attach) = @_ } -sub attach_to_widget { my ($_menu, $_attach_widget, $_detacher) = @_ } -sub detach { my ($_menu) = @_ } -sub get_accel_group { my ($_menu) = @_ } -sub get_active { my ($_menu) = @_ } -sub get_attach_widget { my ($_menu) = @_ } -sub get_for_attach_widget { my ($_class, $_widget) = @_ } -sub get_tearoff_state { my ($_menu) = @_ } -sub get_title { my ($_menu) = @_ } -sub new { my ($_class) = @_ } -sub popdown { my ($_menu) = @_ } -sub popup { my ($_menu, $_parent_menu_shell, $_parent_menu_item, $_menu_pos_func, $_data, $_button, $_activate_time) = @_ } -sub reorder_child { my ($_menu, $_child, $_position) = @_ } -sub reposition { my ($_menu) = @_ } -sub set_accel_group { my ($_menu, $_accel_group) = @_ } -sub set_accel_path { my ($_menu, $_accel_path) = @_ } -sub set_active { my ($_menu, $_index) = @_ } -sub set_monitor { my ($_menu, $_monitor_num) = @_ } -sub set_screen { my ($_menu, $_screen) = @_ } -sub set_tearoff_state { my ($_menu, $_torn_off) = @_ } -sub set_title { my ($_menu, $_title) = @_ } - -package Gtk2::MenuBar; -our @ISA = qw(); -sub get_child_pack_direction { my ($_menubar) = @_ } -sub get_pack_direction { my ($_menubar) = @_ } -sub new { my ($_class) = @_ } -sub set_child_pack_direction { my ($_menubar, $_child_pack_dir) = @_ } -sub set_pack_direction { my ($_menubar, $_pack_dir) = @_ } - -package Gtk2::MenuItem; -our @ISA = qw(); -sub activate { my ($_menu_item) = @_ } -sub deselect { my ($_menu_item) = @_ } -sub get_right_justified { my ($_menu_item) = @_ } -sub get_submenu { my ($_menu_item) = @_ } -sub new { my ($_class, $_o_label) = @_ } -sub new_with_label { my ($_class, $_o_label) = @_ } -sub new_with_mnemonic { my ($_class, $_o_label) = @_ } -sub remove_submenu { my ($_menu_item) = @_ } -sub select { my ($_menu_item) = @_ } -sub set_accel_path { my ($_menu_item, $_accel_path) = @_ } -sub set_right_justified { my ($_menu_item, $_right_justified) = @_ } -sub set_submenu { my ($_menu_item, $_submenu) = @_ } -sub toggle_size_allocate { my ($_menu_item, $_allocation) = @_ } -sub toggle_size_request { my ($_menu_item) = @_ } - -package Gtk2::MenuShell; -our @ISA = qw(); -sub activate_item { my ($_menu_shell, $_menu_item, $_force_deactivate) = @_ } -sub append { my ($_menu_shell, $_child) = @_ } -sub cancel { my ($_menu_shell) = @_ } -sub deactivate { my ($_menu_shell) = @_ } -sub deselect { my ($_menu_shell) = @_ } -sub get_take_focus { my ($_menu_shell) = @_ } -sub insert { my ($_menu_shell, $_child, $_position) = @_ } -sub prepend { my ($_menu_shell, $_child) = @_ } -sub select_first { my ($_menu_shell, $_search_sensitive) = @_ } -sub select_item { my ($_menu_shell, $_menu_item) = @_ } -sub set_take_focus { my ($_menu_shell, $_take_focus) = @_ } - -package Gtk2::MenuToolButton; -our @ISA = qw(); -sub get_menu { my ($_button) = @_ } -sub new { my ($_class, $_icon_widget, $_label) = @_ } -sub new_from_stock { my ($_class, $_stock_id) = @_ } -sub set_arrow_tooltip { my ($_button, $_tooltips, $_tip_text, $_tip_private) = @_ } -sub set_menu { my ($_button, $_menu) = @_ } - -package Gtk2::MessageDialog; -our @ISA = qw(); -sub format_secondary_markup { my ($_message_dialog, $_message) = @_ } -sub format_secondary_text { my ($_message_dialog, $_message_format, @_more_paras) = @_ } -sub new { my ($_class, $_parent, $_flags, $_type, $_buttons, $_format, @_more_paras) = @_ } -sub new_with_markup { my ($_class, $_parent, $_flags, $_type, $_buttons, $_message) = @_ } -sub set_markup { my ($_message_dialog, $_str) = @_ } - -package Gtk2::Misc; -our @ISA = qw(); -sub get_alignment { my ($_misc) = @_ } -sub get_padding { my ($_misc) = @_ } -sub set_alignment { my ($_misc, $_xalign, $_yalign) = @_ } -sub set_padding { my ($_misc, $_xpad, $_ypad) = @_ } - -package Gtk2::Notebook; -our @ISA = qw(); -sub append_page { my ($_notebook, $_child, $_o_tab_label) = @_ } -sub append_page_menu { my ($_notebook, $_child, $_tab_label, $_menu_label) = @_ } -sub get_current_page { my ($_notebook) = @_ } -sub get_menu_label { my ($_notebook, $_child) = @_ } -sub get_menu_label_text { my ($_notebook, $_child) = @_ } -sub get_n_pages { my ($_notebook) = @_ } -sub get_nth_page { my ($_notebook, $_page_num) = @_ } -sub get_scrollable { my ($_notebook) = @_ } -sub get_show_border { my ($_notebook) = @_ } -sub get_show_tabs { my ($_notebook) = @_ } -sub get_tab_label { my ($_notebook, $_child) = @_ } -sub get_tab_label_text { my ($_notebook, $_child) = @_ } -sub get_tab_pos { my ($_notebook) = @_ } -sub insert_page { my ($_notebook, $_child, $_tab_label, $_position) = @_ } -sub insert_page_menu { my ($_notebook, $_child, $_tab_label, $_menu_label, $_position) = @_ } -sub new { my ($_class) = @_ } -sub next_page { my ($_notebook) = @_ } -sub page_num { my ($_notebook, $_child) = @_ } -sub popup_disable { my ($_notebook) = @_ } -sub popup_enable { my ($_notebook) = @_ } -sub prepend_page { my ($_notebook, $_child, $_o_tab_label) = @_ } -sub prepend_page_menu { my ($_notebook, $_child, $_tab_label, $_menu_label) = @_ } -sub prev_page { my ($_notebook) = @_ } -sub query_tab_label_packing { my ($_notebook, $_child) = @_ } -sub remove_page { my ($_notebook, $_page_num) = @_ } -sub reorder_child { my ($_notebook, $_child, $_position) = @_ } -sub set_current_page { my ($_notebook, $_page_num) = @_ } -sub set_menu_label { my ($_notebook, $_child, $_o_menu_label) = @_ } -sub set_menu_label_text { my ($_notebook, $_child, $_menu_text) = @_ } -sub set_scrollable { my ($_notebook, $_scrollable) = @_ } -sub set_show_border { my ($_notebook, $_show_border) = @_ } -sub set_show_tabs { my ($_notebook, $_show_tabs) = @_ } -sub set_tab_border { my ($_notebook, $_border_width) = @_ } -sub set_tab_hborder { my ($_notebook, $_tab_hborder) = @_ } -sub set_tab_label { my ($_notebook, $_child, $_o_tab_label) = @_ } -sub set_tab_label_packing { my ($_notebook, $_child, $_expand, $_fill, $_pack_type) = @_ } -sub set_tab_label_text { my ($_notebook, $_child, $_tab_text) = @_ } -sub set_tab_pos { my ($_notebook, $_pos) = @_ } -sub set_tab_vborder { my ($_notebook, $_tab_vborder) = @_ } - -package Gtk2::Object; -our @ISA = qw(); -sub destroy { my ($_object) = @_ } -sub new { my ($_class, $_object_class, @_more_paras) = @_ } - -package Gtk2::OptionMenu; -our @ISA = qw(); -sub get_history { my ($_option_menu) = @_ } -sub get_menu { my ($_option_menu) = @_ } -sub new { my ($_class) = @_ } -sub remove_menu { my ($_option_menu) = @_ } -sub set_history { my ($_option_menu, $_index) = @_ } -sub set_menu { my ($_option_menu, $_menu) = @_ } - -package Gtk2::Paned; -our @ISA = qw(); -sub add1 { my ($_paned, $_child) = @_ } -sub add2 { my ($_paned, $_child) = @_ } -sub child1 { my ($_paned) = @_ } -sub child1_resize { my ($_paned, $_o_newval) = @_ } -sub child1_shrink { my ($_paned, $_o_newval) = @_ } -sub child2 { my ($_paned) = @_ } -sub child2_resize { my ($_paned, $_o_newval) = @_ } -sub child2_shrink { my ($_paned, $_o_newval) = @_ } -sub compute_position { my ($_paned, $_allocation, $_child1_req, $_child2_req) = @_ } -sub get_child1 { my ($_paned) = @_ } -sub get_child2 { my ($_paned) = @_ } -sub get_position { my ($_paned) = @_ } -sub pack1 { my ($_paned, $_child, $_resize, $_shrink) = @_ } -sub pack2 { my ($_paned, $_child, $_resize, $_shrink) = @_ } -sub set_position { my ($_paned, $_position) = @_ } - -package Gtk2::Pango; -our @ISA = qw(); -sub CHECK_VERSION { my ($_class, $_major, $_minor, $_micro) = @_ } -sub GET_VERSION_INFO { my ($_class) = @_ } -sub PANGO_PIXELS { my ($_class, $_d) = @_ } -sub find_base_dir { my ($_class, $_text) = @_ } -sub parse_markup { my ($_class, $_markup_text, $_markup_text, $_o_accel_marker) = @_ } -sub pixels { my ($_class, $_d) = @_ } -sub scale { my ($_class) = @_ } -sub scale_large { my ($_class) = @_ } -sub scale_medium { my ($_class) = @_ } -sub scale_small { my ($_class) = @_ } -sub scale_x_large { my ($_class) = @_ } -sub scale_x_small { my ($_class) = @_ } -sub scale_xx_large { my ($_class) = @_ } -sub scale_xx_small { my ($_class) = @_ } - -package Gtk2::Pango::Cairo; -our @ISA = qw(); -sub create_layout { my ($_cr) = @_ } -sub glyph_string_path { my ($_cr, $_font, $_glyphs) = @_ } -sub layout_path { my ($_cr, $_layout) = @_ } -sub show_glyph_string { my ($_cr, $_font, $_glyphs) = @_ } -sub show_layout { my ($_cr, $_layout) = @_ } -sub update_context { my ($_cr, $_context) = @_ } -sub update_layout { my ($_cr, $_layout) = @_ } - -package Gtk2::Pango::Cairo::Context; -our @ISA = qw(); -sub get_font_options { my ($_context) = @_ } -sub get_resolution { my ($_context) = @_ } -sub set_font_options { my ($_context, $_options) = @_ } -sub set_resolution { my ($_context, $_dpi) = @_ } - -package Gtk2::Pango::Cairo::FontMap; -our @ISA = qw(); -sub create_context { my ($_fontmap) = @_ } -sub get_default { my ($_class) = @_ } -sub get_resolution { my ($_fontmap) = @_ } -sub new { my ($_class) = @_ } -sub set_resolution { my ($_fontmap, $_dpi) = @_ } - -package Gtk2::Pango::Context; -our @ISA = qw(); -sub get_base_dir { my ($_context) = @_ } -sub get_font_description { my ($_context) = @_ } -sub get_font_map { my ($_context) = @_ } -sub get_language { my ($_context) = @_ } -sub get_matrix { my ($_context) = @_ } -sub get_metrics { my ($_context, $_desc, $_language) = @_ } -sub list_families { my ($_context) = @_ } -sub load_font { my ($_context, $_desc) = @_ } -sub load_fontset { my ($_context, $_desc, $_language) = @_ } -sub set_base_dir { my ($_context, $_direction) = @_ } -sub set_font_description { my ($_context, $_desc) = @_ } -sub set_language { my ($_context, $_language) = @_ } -sub set_matrix { my ($_context, $_matrix) = @_ } - -package Gtk2::Pango::Font; -our @ISA = qw(); -sub describe { my ($_font) = @_ } -sub get_glyph_extents { my ($_font, $_glyph) = @_ } -sub get_metrics { my ($_font, $_language) = @_ } - -package Gtk2::Pango::FontDescription; -our @ISA = qw(); -sub better_match { my ($_desc, $_old_match, $_new_match) = @_ } -sub equal { my ($_desc1, $_desc2) = @_ } -sub from_string { my ($_class, $_str) = @_ } -sub get_family { my ($_desc) = @_ } -sub get_set_fields { my ($_desc) = @_ } -sub get_size { my ($_desc) = @_ } -sub get_size_is_absolute { my ($_desc) = @_ } -sub get_stretch { my ($_desc) = @_ } -sub get_style { my ($_desc) = @_ } -sub get_variant { my ($_desc) = @_ } -sub get_weight { my ($_desc) = @_ } -sub hash { my ($_desc) = @_ } -sub merge { my ($_desc, $_desc_to_merge, $_replace_existing) = @_ } -sub merge_static { my ($_desc, $_desc_to_merge, $_replace_existing) = @_ } -sub new { my ($_class) = @_ } -sub set_absolute_size { my ($_desc, $_size) = @_ } -sub set_family { my ($_desc, $_family) = @_ } -sub set_family_static { my ($_desc, $_family) = @_ } -sub set_size { my ($_desc, $_size) = @_ } -sub set_stretch { my ($_desc, $_stretch) = @_ } -sub set_style { my ($_desc, $_style) = @_ } -sub set_variant { my ($_desc, $_variant) = @_ } -sub set_weight { my ($_desc, $_weight) = @_ } -sub to_filename { my ($_desc) = @_ } -sub to_string { my ($_desc) = @_ } -sub unset_fields { my ($_desc, $_to_unset) = @_ } - -package Gtk2::Pango::FontFace; -our @ISA = qw(); -sub describe { my ($_face) = @_ } -sub get_face_name { my ($_face) = @_ } -sub list_sizes { my ($_face) = @_ } - -package Gtk2::Pango::FontFamily; -our @ISA = qw(); -sub get_name { my ($_family) = @_ } -sub is_monospace { my ($_family) = @_ } -sub list_faces { my ($_family) = @_ } - -package Gtk2::Pango::FontMap; -our @ISA = qw(); -sub list_families { my ($_fontmap) = @_ } -sub load_font { my ($_fontmap, $_context, $_desc) = @_ } -sub load_fontset { my ($_fontmap, $_context, $_desc, $_language) = @_ } - -package Gtk2::Pango::FontMetrics; -our @ISA = qw(); -sub get_approximate_char_width { my ($_metrics) = @_ } -sub get_approximate_digit_width { my ($_metrics) = @_ } -sub get_ascent { my ($_metrics) = @_ } -sub get_descent { my ($_metrics) = @_ } -sub get_strikethrough_position { my ($_metrics) = @_ } -sub get_strikethrough_thickness { my ($_metrics) = @_ } -sub get_underline_position { my ($_metrics) = @_ } -sub get_underline_thickness { my ($_metrics) = @_ } - -package Gtk2::Pango::Fontset; -our @ISA = qw(); -sub Gtk2::Pango::Fontset::foreach { my ($_fontset, $_func, $_o_data) = @_ } -sub get_font { my ($_fontset, $_wc) = @_ } -sub get_metrics { my ($_fontset) = @_ } - -package Gtk2::Pango::Language; -our @ISA = qw(); -sub from_string { my ($_class, $_language) = @_ } -sub includes_script { my ($_language, $_script) = @_ } -sub matches { my ($_language, $_range_list) = @_ } -sub to_string { my ($_language) = @_ } - -package Gtk2::Pango::Layout; -our @ISA = qw(); -sub context_changed { my ($_layout) = @_ } -sub copy { my ($_src) = @_ } -sub get_alignment { my ($_layout) = @_ } -sub get_attributes { my ($_layout) = @_ } -sub get_auto_dir { my ($_layout) = @_ } -sub get_context { my ($_layout) = @_ } -sub get_cursor_pos { my ($_layout, $_index_) = @_ } -sub get_ellipsize { my ($_layout) = @_ } -sub get_extents { my ($_layout) = @_ } -sub get_font_description { my ($_layout) = @_ } -sub get_indent { my ($_layout) = @_ } -sub get_iter { my ($_layout) = @_ } -sub get_justify { my ($_layout) = @_ } -sub get_line_count { my ($_layout) = @_ } -sub get_log_attrs { my ($_layout) = @_ } -sub get_pixel_extents { my ($_layout) = @_ } -sub get_pixel_size { my ($_layout) = @_ } -sub get_single_paragraph_mode { my ($_layout) = @_ } -sub get_size { my ($_layout) = @_ } -sub get_spacing { my ($_layout) = @_ } -sub get_tabs { my ($_layout) = @_ } -sub get_text { my ($_layout) = @_ } -sub get_width { my ($_layout) = @_ } -sub get_wrap { my ($_layout) = @_ } -sub index_to_pos { my ($_layout, $_index_) = @_ } -sub move_cursor_visually { my ($_layout, $_strong, $_old_index, $_old_trailing, $_direction) = @_ } -sub new { my ($_class, $_context) = @_ } -sub set_alignment { my ($_layout, $_alignment) = @_ } -sub set_attributes { my ($_layout, $_attrs) = @_ } -sub set_auto_dir { my ($_layout, $_auto_dir) = @_ } -sub set_ellipsize { my ($_layout, $_ellipsize) = @_ } -sub set_font_description { my ($_layout, $_desc) = @_ } -sub set_indent { my ($_layout, $_newval) = @_ } -sub set_justify { my ($_layout, $_newval) = @_ } -sub set_markup { my ($_layout, $_markup, $_markup) = @_ } -sub set_markup_with_accel { my ($_layout, $_markup, $_markup, $_accel_marker) = @_ } -sub set_single_paragraph_mode { my ($_layout, $_newval) = @_ } -sub set_spacing { my ($_layout, $_newval) = @_ } -sub set_tabs { my ($_layout, $_tabs) = @_ } -sub set_text { my ($_layout, $_text, $_text) = @_ } -sub set_width { my ($_layout, $_newval) = @_ } -sub set_wrap { my ($_layout, $_wrap) = @_ } -sub xy_to_index { my ($_layout, $_x, $_y) = @_ } - -package Gtk2::Pango::LayoutIter; -our @ISA = qw(); -sub at_last_line { my ($_iter) = @_ } -sub get_baseline { my ($_iter) = @_ } -sub get_char_extents { my ($_iter) = @_ } -sub get_cluster_extents { my ($_iter) = @_ } -sub get_index { my ($_iter) = @_ } -sub get_layout_extents { my ($_iter) = @_ } -sub get_line_extents { my ($_iter) = @_ } -sub get_line_yrange { my ($_iter) = @_ } -sub get_run_extents { my ($_iter) = @_ } -sub next_char { my ($_iter) = @_ } -sub next_cluster { my ($_iter) = @_ } -sub next_line { my ($_iter) = @_ } -sub next_run { my ($_iter) = @_ } - -package Gtk2::Pango::Matrix; -our @ISA = qw(); -sub concat { my ($_matrix, $_new_matrix) = @_ } -sub new { my ($_class, $_o_xx, $_o_xy, $_o_yx, $_o_yy, $_o_x0, $_o_y0) = @_ } -sub rotate { my ($_matrix, $_degrees) = @_ } -sub scale { my ($_matrix, $_scale_x, $_scale_y) = @_ } -sub translate { my ($_matrix, $_tx, $_ty) = @_ } -sub x0 { my ($_matrix, $_o_new) = @_ } -sub xx { my ($_matrix, $_o_new) = @_ } -sub xy { my ($_matrix, $_o_new) = @_ } -sub y0 { my ($_matrix, $_o_new) = @_ } -sub yx { my ($_matrix, $_o_new) = @_ } -sub yy { my ($_matrix, $_o_new) = @_ } - -package Gtk2::Pango::Renderer; -our @ISA = qw(); -sub activate { my ($_renderer) = @_ } -sub deactivate { my ($_renderer) = @_ } -sub draw_error_underline { my ($_renderer, $_x, $_y, $_width, $_height) = @_ } -sub draw_glyph { my ($_renderer, $_font, $_glyph, $_x, $_y) = @_ } -sub draw_layout { my ($_renderer, $_layout, $_x, $_y) = @_ } -sub draw_rectangle { my ($_renderer, $_part, $_x, $_y, $_width, $_height) = @_ } -sub draw_trapezoid { my ($_renderer, $_part, $_y1_, $_x11, $_x21, $_y2, $_x12, $_x22) = @_ } -sub get_matrix { my ($_renderer) = @_ } -sub part_changed { my ($_renderer, $_part) = @_ } -sub set_matrix { my ($_renderer, $_matrix) = @_ } - -package Gtk2::Pango::Script; -our @ISA = qw(); -sub for_unichar { my ($_class, $_ch) = @_ } -sub get_sample_language { my ($_class, $_script) = @_ } - -package Gtk2::Pango::ScriptIter; -our @ISA = qw(); -sub get_range { my ($_iter) = @_ } -sub new { my ($_class, $_text) = @_ } -sub next { my ($_iter) = @_ } - -package Gtk2::Pango::TabArray; -our @ISA = qw(); -sub get_positions_in_pixels { my ($_tab_array) = @_ } -sub get_size { my ($_tab_array) = @_ } -sub get_tab { my ($_tab_array, $_tab_index) = @_ } -sub get_tabs { my ($_tab_array) = @_ } -sub new { my ($_class, $_initial_size, $_positions_in_pixels, @_more_paras) = @_ } -sub new_with_positions { my ($_class, $_initial_size, $_positions_in_pixels, @_more_paras) = @_ } -sub resize { my ($_tab_array, $_new_size) = @_ } -sub set_tab { my ($_tab_array, $_tab_index, $_alignment, $_location) = @_ } - -package Gtk2::Plug; -our @ISA = qw(); -sub construct { my ($_plug, $_socket_id) = @_ } -sub construct_for_display { my ($_plug, $_display, $_socket_id) = @_ } -sub get_id { my ($_plug) = @_ } -sub new { my ($_class, $_socket_id) = @_ } -sub new_for_display { my ($_display, $_socket_id) = @_ } - -package Gtk2::ProgressBar; -our @ISA = qw(); -sub get_ellipsize { my ($_pbar) = @_ } -sub get_fraction { my ($_pbar) = @_ } -sub get_orientation { my ($_pbar) = @_ } -sub get_pulse_step { my ($_pbar) = @_ } -sub get_text { my ($_pbar) = @_ } -sub new { my ($_class) = @_ } -sub pulse { my ($_pbar) = @_ } -sub set_ellipsize { my ($_pbar, $_mode) = @_ } -sub set_fraction { my ($_pbar, $_fraction) = @_ } -sub set_orientation { my ($_pbar, $_orientation) = @_ } -sub set_pulse_step { my ($_pbar, $_fraction) = @_ } -sub set_text { my ($_pbar, $_text) = @_ } - -package Gtk2::RadioAction; -our @ISA = qw(); -sub get_current_value { my ($_action) = @_ } -sub get_group { my ($_action) = @_ } -sub set_group { my ($_action, $_member_or_listref) = @_ } - -package Gtk2::RadioButton; -our @ISA = qw(); -sub get_group { my ($_radio_button) = @_ } -sub new { my ($_class, $_o_member_or_listref, $_o_label) = @_ } -sub new_from_widget { my ($_class, $_group, $_o_label) = @_ } -sub new_with_label { my ($_class, $_o_member_or_listref, $_o_label) = @_ } -sub new_with_label_from_widget { my ($_class, $_group, $_o_label) = @_ } -sub new_with_mnemonic { my ($_class, $_o_member_or_listref, $_o_label) = @_ } -sub new_with_mnemonic_from_widget { my ($_class, $_group, $_o_label) = @_ } -sub set_group { my ($_radio_button, $_member_or_listref) = @_ } - -package Gtk2::RadioMenuItem; -our @ISA = qw(); -sub get_group { my ($_radio_menu_item) = @_ } -sub new { my ($_class, $_o_member_or_listref, $_o_label) = @_ } -sub new_from_widget { my ($_class, $_group, $_o_label) = @_ } -sub new_with_label { my ($_class, $_o_member_or_listref, $_o_label) = @_ } -sub new_with_label_from_widget { my ($_class, $_group, $_o_label) = @_ } -sub new_with_mnemonic { my ($_class, $_o_member_or_listref, $_o_label) = @_ } -sub new_with_mnemonic_from_widget { my ($_class, $_group, $_o_label) = @_ } -sub set_group { my ($_radio_menu_item, $_member_or_listref) = @_ } - -package Gtk2::RadioToolButton; -our @ISA = qw(); -sub get_group { my ($_button) = @_ } -sub new { my ($_class, $_o_member_or_listref) = @_ } -sub new_from_stock { my ($_class, $_member_or_listref, $_stock_id) = @_ } -sub new_from_widget { my ($_class, $_group) = @_ } -sub new_with_stock_from_widget { my ($_class, $_group, $_stock_id) = @_ } -sub set_group { my ($_button, $_member_or_listref) = @_ } - -package Gtk2::Range; -our @ISA = qw(); -sub get_adjustment { my ($_range) = @_ } -sub get_inverted { my ($_range) = @_ } -sub get_update_policy { my ($_range) = @_ } -sub get_value { my ($_range) = @_ } -sub set_adjustment { my ($_range, $_adjustment) = @_ } -sub set_increments { my ($_range, $_step, $_page) = @_ } -sub set_inverted { my ($_range, $_setting) = @_ } -sub set_range { my ($_range, $_min, $_max) = @_ } -sub set_update_policy { my ($_range, $_policy) = @_ } -sub set_value { my ($_range, $_value) = @_ } - -package Gtk2::Rc; -our @ISA = qw(); -sub add_default_file { my ($_class, $_filename) = @_ } -sub get_default_files { my ($_class) = @_ } -sub get_im_module_file { my ($_class) = @_ } -sub get_im_module_path { my ($_class) = @_ } -sub get_module_dir { my ($_class) = @_ } -sub get_style { my ($_class, $_widget) = @_ } -sub get_style_by_paths { my ($_class, $_settings, $_widget_path, $_class_path, $_package) = @_ } -sub get_theme_dir { my ($_class) = @_ } -sub parse { my ($_class, $_filename) = @_ } -sub parse_string { my ($_class, $_rc_string) = @_ } -sub reparse_all { my ($_class) = @_ } -sub reparse_all_for_settings { my ($_class, $_settings, $_force_load) = @_ } -sub reset_styles { my ($_class, $_settings) = @_ } -sub set_default_files { my ($_class, @_more_paras) = @_ } - -package Gtk2::RcStyle; -our @ISA = qw(); -sub base { my ($_style, $_state, $_o_new) = @_ } -sub bg { my ($_style, $_state, $_o_new) = @_ } -sub bg_pixmap_name { my ($_style, $_state, $_o_new) = @_ } -sub color_flags { my ($_style, $_state, $_o_new) = @_ } -sub copy { my ($_orig) = @_ } -sub fg { my ($_style, $_state, $_o_new) = @_ } -sub font_desc { my ($_style, $_o_new) = @_ } -sub name { my ($_style, $_o_new) = @_ } -sub new { my ($_class) = @_ } -sub text { my ($_style, $_state, $_o_new) = @_ } -sub xthickness { my ($_style, $_o_new) = @_ } -sub ythickness { my ($_style, $_o_new) = @_ } - -package Gtk2::Requisition; -our @ISA = qw(); -sub height { my ($_requisition, $_o_newval) = @_ } -sub new { my ($_class, $_o_width, $_o_height) = @_ } -sub width { my ($_requisition, $_o_newval) = @_ } - -package Gtk2::Ruler; -our @ISA = qw(); -sub draw_pos { my ($_ruler) = @_ } -sub draw_ticks { my ($_ruler) = @_ } -sub get_metric { my ($_ruler) = @_ } -sub get_range { my ($_ruler) = @_ } -sub set_metric { my ($_ruler, $_metric) = @_ } -sub set_range { my ($_ruler, $_lower, $_upper, $_position, $_max_size) = @_ } - -package Gtk2::Scale; -our @ISA = qw(); -sub get_digits { my ($_scale) = @_ } -sub get_draw_value { my ($_scale) = @_ } -sub get_layout { my ($_scale) = @_ } -sub get_layout_offsets { my ($_scale) = @_ } -sub get_value_pos { my ($_scale) = @_ } -sub set_digits { my ($_scale, $_digits) = @_ } -sub set_draw_value { my ($_scale, $_draw_value) = @_ } -sub set_value_pos { my ($_scale, $_pos) = @_ } - -package Gtk2::ScrolledWindow; -our @ISA = qw(); -sub add_with_viewport { my ($_scrolled_window, $_child) = @_ } -sub get_hadjustment { my ($_scrolled_window) = @_ } -sub get_hscrollbar { my ($_scrolled_window) = @_ } -sub get_placement { my ($_scrolled_window) = @_ } -sub get_policy { my ($_scrolled_window) = @_ } -sub get_shadow_type { my ($_scrolled_window) = @_ } -sub get_vadjustment { my ($_scrolled_window) = @_ } -sub get_vscrollbar { my ($_scrolled_window) = @_ } -sub new { my ($_class, $_o_hadjustment, $_o_vadjustment) = @_ } -sub set_hadjustment { my ($_scrolled_window, $_hadjustment) = @_ } -sub set_placement { my ($_scrolled_window, $_window_placement) = @_ } -sub set_policy { my ($_scrolled_window, $_hscrollbar_policy, $_vscrollbar_policy) = @_ } -sub set_shadow_type { my ($_scrolled_window, $_type) = @_ } -sub set_vadjustment { my ($_scrolled_window, $_hadjustment) = @_ } - -package Gtk2::Selection; -our @ISA = qw(); -sub owner_set { my ($_class, $_widget, $_selection, $_time_) = @_ } -sub owner_set_for_display { my ($_class, $_display, $_widget, $_selection, $_time_) = @_ } - -package Gtk2::SelectionData; -our @ISA = qw(); -sub data { my ($_d) = @_ } -sub display { my ($_d) = @_ } -sub Gtk2::SelectionData::format { my ($_d) = @_ } -sub get_pixbuf { my ($_selection_data) = @_ } -sub get_row_drag_data { my ($_selection_data) = @_ } -sub get_targets { my ($_selection_data) = @_ } -sub get_text { my ($_selection_data) = @_ } -sub get_uris { my ($_selection_data) = @_ } -sub gtk_selection_clear { my ($_widget, $_event) = @_ } -sub Gtk2::SelectionData::length { my ($_d) = @_ } -sub selection { my ($_d) = @_ } -sub set { my ($_selection_data, $_type, $_format, $_data) = @_ } -sub set_pixbuf { my ($_selection_data, $_pixbuf) = @_ } -sub set_row_drag_data { my ($_selection_data, $_tree_model, $_path) = @_ } -sub set_text { my ($_selection_data, $_str, $_o_len) = @_ } -sub set_uris { my ($_selection_data, @_more_paras) = @_ } -sub target { my ($_d) = @_ } -sub targets_include_image { my ($_selection_data, $_writable) = @_ } -sub targets_include_text { my ($_selection_data) = @_ } -sub type { my ($_d) = @_ } - -package Gtk2::SeparatorMenuItem; -our @ISA = qw(); -sub new { my ($_class) = @_ } - -package Gtk2::SeparatorToolItem; -our @ISA = qw(); -sub get_draw { my ($_item) = @_ } -sub new { my ($_class) = @_ } -sub set_draw { my ($_tool_item, $_draw) = @_ } - -package Gtk2::SizeGroup; -our @ISA = qw(); -sub add_widget { my ($_size_group, $_widget) = @_ } -sub get_ignore_hidden { my ($_size_group) = @_ } -sub get_mode { my ($_size_group) = @_ } -sub new { my ($_class, $_mode) = @_ } -sub remove_widget { my ($_size_group, $_widget) = @_ } -sub set_ignore_hidden { my ($_size_group, $_ignore_hidden) = @_ } -sub set_mode { my ($_size_group, $_mode) = @_ } - -package Gtk2::Socket; -our @ISA = qw(); -sub add_id { my ($_socket, $_window_id) = @_ } -sub get_id { my ($_socket) = @_ } -sub new { my ($_class) = @_ } -sub steal { my ($_socket, $_wid) = @_ } - -package Gtk2::SpinButton; -our @ISA = qw(); -sub configure { my ($_spin_button, $_adjustment, $_climb_rate, $_digits) = @_ } -sub get_adjustment { my ($_spin_button) = @_ } -sub get_digits { my ($_spin_button) = @_ } -sub get_increments { my ($_spin_button) = @_ } -sub get_numeric { my ($_spin_button) = @_ } -sub get_range { my ($_spin_button) = @_ } -sub get_snap_to_ticks { my ($_spin_button) = @_ } -sub get_update_policy { my ($_spin_button) = @_ } -sub get_value { my ($_spin_button) = @_ } -sub get_value_as_int { my ($_spin_button) = @_ } -sub get_wrap { my ($_spin_button) = @_ } -sub new { my ($_class, $_adjustment, $_climb_rate, $_digits) = @_ } -sub new_with_range { my ($_class, $_min, $_max, $_step) = @_ } -sub set_adjustment { my ($_spin_button, $_adjustment) = @_ } -sub set_digits { my ($_spin_button, $_digits) = @_ } -sub set_increments { my ($_spin_button, $_step, $_page) = @_ } -sub set_numeric { my ($_spin_button, $_numeric) = @_ } -sub set_range { my ($_spin_button, $_min, $_max) = @_ } -sub set_snap_to_ticks { my ($_spin_button, $_snap_to_ticks) = @_ } -sub set_update_policy { my ($_spin_button, $_policy) = @_ } -sub set_value { my ($_spin_button, $_value) = @_ } -sub set_wrap { my ($_spin_button, $_wrap) = @_ } -sub spin { my ($_spin_button, $_direction, $_increment) = @_ } -sub update { my ($_spin_button) = @_ } - -package Gtk2::Statusbar; -our @ISA = qw(); -sub get_context_id { my ($_statusbar, $_context_description) = @_ } -sub get_has_resize_grip { my ($_statusbar) = @_ } -sub new { my ($_class) = @_ } -sub pop { my ($_statusbar, $_context_id) = @_ } -sub push { my ($_statusbar, $_context_id, $_text) = @_ } -sub remove { my ($_statusbar, $_context_id, $_message_id) = @_ } -sub set_has_resize_grip { my ($_statusbar, $_setting) = @_ } - -package Gtk2::Stock; -our @ISA = qw(); -sub add { my ($_class, @_more_paras) = @_ } -sub list_ids { my ($_class) = @_ } -sub lookup { my ($_class, $_stock_id) = @_ } -sub set_translate_func { my ($_class, $_domain, $_func, $_o_data) = @_ } - -package Gtk2::Style; -our @ISA = qw(); -sub apply_default_background { my ($_style, $_window, $_set_bg, $_state_type, $_area, $_x, $_y, $_width, $_height) = @_ } -sub attach { my ($_style, $_window) = @_ } -sub attached { my ($_style) = @_ } -sub base { my ($_style, $_state) = @_ } -sub base_gc { my ($_style, $_state) = @_ } -sub bg { my ($_style, $_state) = @_ } -sub bg_gc { my ($_style, $_state) = @_ } -sub bg_pixmap { my ($_style, $_state, $_o_pixmap) = @_ } -sub black { my ($_style) = @_ } -sub black_gc { my ($_style) = @_ } -sub copy { my ($_style) = @_ } -sub dark { my ($_style, $_state) = @_ } -sub dark_gc { my ($_style, $_state) = @_ } -sub detach { my ($_style) = @_ } -sub fg { my ($_style, $_state) = @_ } -sub fg_gc { my ($_style, $_state) = @_ } -sub font_desc { my ($_style) = @_ } -sub light { my ($_style, $_state) = @_ } -sub light_gc { my ($_style, $_state) = @_ } -sub lookup_icon_set { my ($_style, $_stock_id) = @_ } -sub mid { my ($_style, $_state) = @_ } -sub mid_gc { my ($_style, $_state) = @_ } -sub new { my ($_class) = @_ } -sub paint_arrow { my ($_style, $_window, $_state_type, $_shadow_type, $_area, $_widget, $_detail, $_arrow_type, $_fill, $_x, $_y, $_width, $_height) = @_ } -sub paint_box { my ($_style, $_window, $_state_type, $_shadow_type, $_area, $_widget, $_detail, $_x, $_y, $_width, $_height) = @_ } -sub paint_box_gap { my ($_style, $_window, $_state_type, $_shadow_type, $_area, $_widget, $_detail, $_x, $_y, $_width, $_height, $_gap_side, $_gap_x, $_gap_width) = @_ } -sub paint_check { my ($_style, $_window, $_state_type, $_shadow_type, $_area, $_widget, $_detail, $_x, $_y, $_width, $_height) = @_ } -sub paint_diamond { my ($_style, $_window, $_state_type, $_shadow_type, $_area, $_widget, $_detail, $_x, $_y, $_width, $_height) = @_ } -sub paint_expander { my ($_style, $_window, $_state_type, $_area, $_widget, $_detail, $_x, $_y, $_expander_style) = @_ } -sub paint_extension { my ($_style, $_window, $_state_type, $_shadow_type, $_area, $_widget, $_detail, $_x, $_y, $_width, $_height, $_gap_side) = @_ } -sub paint_flat_box { my ($_style, $_window, $_state_type, $_shadow_type, $_area, $_widget, $_detail, $_x, $_y, $_width, $_height) = @_ } -sub paint_focus { my ($_style, $_window, $_state_type, $_area, $_widget, $_detail, $_x, $_y, $_width, $_height) = @_ } -sub paint_handle { my ($_style, $_window, $_state_type, $_shadow_type, $_area, $_widget, $_detail, $_x, $_y, $_width, $_height, $_orientation) = @_ } -sub paint_hline { my ($_style, $_window, $_state_type, $_area, $_widget, $_detail, $_x1, $_x2, $_y) = @_ } -sub paint_layout { my ($_style, $_window, $_state_type, $_use_text, $_area, $_widget, $_detail, $_x, $_y, $_layout) = @_ } -sub paint_option { my ($_style, $_window, $_state_type, $_shadow_type, $_area, $_widget, $_detail, $_x, $_y, $_width, $_height) = @_ } -sub paint_polygon { my ($_style, $_window, $_state_type, $_shadow_type, $_area, $_widget, $_detail, $_fill, $_x1, $_y1, @_more_paras) = @_ } -sub paint_resize_grip { my ($_style, $_window, $_state_type, $_area, $_widget, $_detail, $_edge, $_x, $_y, $_width, $_height) = @_ } -sub paint_shadow { my ($_style, $_window, $_state_type, $_shadow_type, $_area, $_widget, $_detail, $_x, $_y, $_width, $_height) = @_ } -sub paint_shadow_gap { my ($_style, $_window, $_state_type, $_shadow_type, $_area, $_widget, $_detail, $_x, $_y, $_width, $_height, $_gap_side, $_gap_x, $_gap_width) = @_ } -sub paint_slider { my ($_style, $_window, $_state_type, $_shadow_type, $_area, $_widget, $_detail, $_x, $_y, $_width, $_height, $_orientation) = @_ } -sub paint_tab { my ($_style, $_window, $_state_type, $_shadow_type, $_area, $_widget, $_detail, $_x, $_y, $_width, $_height) = @_ } -sub paint_vline { my ($_style, $_window, $_state_type, $_area, $_widget, $_detail, $_y1_, $_y2_, $_x) = @_ } -sub render_icon { my ($_style, $_source, $_direction, $_state, $_size, $_widget, $_o_detail) = @_ } -sub set_background { my ($_style, $_window, $_state_type) = @_ } -sub text { my ($_style, $_state) = @_ } -sub text_aa { my ($_style, $_state) = @_ } -sub text_aa_gc { my ($_style, $_state) = @_ } -sub text_gc { my ($_style, $_state) = @_ } -sub white { my ($_style) = @_ } -sub white_gc { my ($_style) = @_ } -sub xthickness { my ($_style) = @_ } -sub ythickness { my ($_style) = @_ } - -package Gtk2::Table; -our @ISA = qw(); -sub attach { my ($_table, $_child, $_left_attach, $_right_attach, $_top_attach, $_bottom_attach, $_xoptions, $_yoptions, $_xpadding, $_ypadding) = @_ } -sub attach_defaults { my ($_table, $_widget, $_left_attach, $_right_attach, $_top_attach, $_bottom_attach) = @_ } -sub get_col_spacing { my ($_table, $_column) = @_ } -sub get_default_col_spacing { my ($_table) = @_ } -sub get_default_row_spacing { my ($_table) = @_ } -sub get_homogeneous { my ($_table) = @_ } -sub get_row_spacing { my ($_table, $_row) = @_ } -sub new { my ($_class, $_rows, $_columns, $_o_homogeneous) = @_ } -sub resize { my ($_table, $_rows, $_columns) = @_ } -sub set_col_spacing { my ($_table, $_column, $_spacing) = @_ } -sub set_col_spacings { my ($_table, $_spacing) = @_ } -sub set_homogeneous { my ($_table, $_homogeneous) = @_ } -sub set_row_spacing { my ($_table, $_row, $_spacing) = @_ } -sub set_row_spacings { my ($_table, $_spacing) = @_ } - -package Gtk2::TargetList; -our @ISA = qw(); -sub DESTROY { my ($_list) = @_ } -sub add { my ($_list, $_target, $_flags, $_info) = @_ } -sub add_image_targets { my ($_list, $_info, $_writable) = @_ } -sub add_table { my ($_list, @_more_paras) = @_ } -sub add_text_targets { my ($_list, $_info) = @_ } -sub add_uri_targets { my ($_list, $_info) = @_ } -sub find { my ($_list, $_target) = @_ } -sub new { my ($_class, @_more_paras) = @_ } -sub remove { my ($_list, $_target) = @_ } - -package Gtk2::TearoffMenuItem; -our @ISA = qw(); -sub new { my ($_class) = @_ } - -package Gtk2::TextAttributes; -our @ISA = qw(); -sub copy_values { my ($_dest, $_src) = @_ } -sub new { my ($_class) = @_ } - -package Gtk2::TextBuffer; -our @ISA = qw(); -sub add_selection_clipboard { my ($_buffer, $_clipboard) = @_ } -sub apply_tag { my ($_buffer, $_tag, $_start, $_end) = @_ } -sub apply_tag_by_name { my ($_buffer, $_name, $_start, $_end) = @_ } -sub backspace { my ($_buffer, $_iter, $_interactive, $_default_editable) = @_ } -sub begin_user_action { my ($_buffer) = @_ } -sub copy_clipboard { my ($_buffer, $_clipboard) = @_ } -sub create_child_anchor { my ($_buffer, $_iter) = @_ } -sub create_mark { my ($_buffer, $_mark_name, $_where, $_left_gravity) = @_ } -sub create_tag { my ($_buffer, $_tag_name, $_property_name1, $_property_value1, @_more_paras) = @_ } -sub cut_clipboard { my ($_buffer, $_clipboard, $_default_editable) = @_ } -sub delete { my ($_buffer, $_start, $_end) = @_ } -sub delete_interactive { my ($_buffer, $_start_iter, $_end_iter, $_default_editable) = @_ } -sub delete_mark { my ($_buffer, $_mark) = @_ } -sub delete_mark_by_name { my ($_buffer, $_name) = @_ } -sub delete_selection { my ($_buffer, $_interactive, $_default_editable) = @_ } -sub end_user_action { my ($_buffer) = @_ } -sub get_bounds { my ($_buffer) = @_ } -sub get_char_count { my ($_buffer) = @_ } -sub get_end_iter { my ($_buffer) = @_ } -sub get_insert { my ($_buffer) = @_ } -sub get_iter_at_child_anchor { my ($_buffer, $_anchor) = @_ } -sub get_iter_at_line { my ($_buffer, $_line_number) = @_ } -sub get_iter_at_line_index { my ($_buffer, $_line_number, $_byte_index) = @_ } -sub get_iter_at_line_offset { my ($_buffer, $_line_number, $_char_offset) = @_ } -sub get_iter_at_mark { my ($_buffer, $_mark) = @_ } -sub get_iter_at_offset { my ($_buffer, $_char_offset) = @_ } -sub get_line_count { my ($_buffer) = @_ } -sub get_mark { my ($_buffer, $_name) = @_ } -sub get_modified { my ($_buffer) = @_ } -sub get_selection_bound { my ($_buffer) = @_ } -sub get_selection_bounds { my ($_buffer) = @_ } -sub get_slice { my ($_buffer, $_start, $_end, $_include_hidden_chars) = @_ } -sub get_start_iter { my ($_buffer) = @_ } -sub get_tag_table { my ($_buffer) = @_ } -sub get_text { my ($_buffer, $_start, $_end, $_include_hidden_chars) = @_ } -sub insert { my ($_buffer, $_iter, $_text, $_text) = @_ } -sub insert_at_cursor { my ($_buffer, $_text, $_text) = @_ } -sub insert_child_anchor { my ($_buffer, $_iter, $_anchor) = @_ } -sub insert_interactive { my ($_buffer, $_iter, $_text, $_text, $_default_editable) = @_ } -sub insert_interactive_at_cursor { my ($_buffer, $_text, $_text, $_default_editable) = @_ } -sub insert_pixbuf { my ($_buffer, $_iter, $_pixbuf) = @_ } -sub insert_range { my ($_buffer, $_iter, $_start, $_end) = @_ } -sub insert_range_interactive { my ($_buffer, $_iter, $_start, $_end, $_default_editable) = @_ } -sub insert_with_tags { my ($_buffer, $_iter, $_text, @_more_paras) = @_ } -sub insert_with_tags_by_name { my ($_buffer, $_iter, $_text, @_more_paras) = @_ } -sub move_mark { my ($_buffer, $_mark, $_where) = @_ } -sub move_mark_by_name { my ($_buffer, $_name, $_where) = @_ } -sub new { my ($_class, $_o_tagtable) = @_ } -sub paste_clipboard { my ($_buffer, $_clipboard, $_override_location, $_default_editable) = @_ } -sub place_cursor { my ($_buffer, $_where) = @_ } -sub remove_all_tags { my ($_buffer, $_start, $_end) = @_ } -sub remove_selection_clipboard { my ($_buffer, $_clipboard) = @_ } -sub remove_tag { my ($_buffer, $_tag, $_start, $_end) = @_ } -sub remove_tag_by_name { my ($_buffer, $_name, $_start, $_end) = @_ } -sub select_range { my ($_buffer, $_ins, $_bound) = @_ } -sub set_modified { my ($_buffer, $_setting) = @_ } -sub set_text { my ($_buffer, $_text, $_text) = @_ } - -package Gtk2::TextChildAnchor; -our @ISA = qw(); -sub get_deleted { my ($_anchor) = @_ } -sub get_widgets { my ($_anchor) = @_ } -sub new { my ($_class) = @_ } - -package Gtk2::TextIter; -our @ISA = qw(); -sub backward_char { my ($_iter) = @_ } -sub backward_chars { my ($_iter, $_count) = @_ } -sub backward_cursor_position { my ($_iter) = @_ } -sub backward_cursor_positions { my ($_iter, $_count) = @_ } -sub backward_find_char { my ($_iter, $_pred, $_o_user_data, $_o_limit) = @_ } -sub backward_line { my ($_iter) = @_ } -sub backward_lines { my ($_iter, $_count) = @_ } -sub backward_search { my ($_iter, $_str, $_flags, $_o_limit) = @_ } -sub backward_sentence_start { my ($_iter) = @_ } -sub backward_sentence_starts { my ($_iter, $_count) = @_ } -sub backward_to_tag_toggle { my ($_iter, $_tag) = @_ } -sub backward_visible_cursor_position { my ($_iter) = @_ } -sub backward_visible_cursor_positions { my ($_iter, $_count) = @_ } -sub backward_visible_line { my ($_iter) = @_ } -sub backward_visible_lines { my ($_iter, $_count) = @_ } -sub backward_visible_word_start { my ($_iter) = @_ } -sub backward_visible_word_starts { my ($_iter, $_count) = @_ } -sub backward_word_start { my ($_iter) = @_ } -sub backward_word_starts { my ($_iter, $_count) = @_ } -sub begins_tag { my ($_iter, $_tag) = @_ } -sub can_insert { my ($_iter, $_default_editability) = @_ } -sub compare { my ($_lhs, $_rhs) = @_ } -sub editable { my ($_iter, $_default_setting) = @_ } -sub ends_line { my ($_iter) = @_ } -sub ends_sentence { my ($_iter) = @_ } -sub ends_tag { my ($_iter, $_tag) = @_ } -sub ends_word { my ($_iter) = @_ } -sub equal { my ($_lhs, $_rhs) = @_ } -sub forward_char { my ($_iter) = @_ } -sub forward_chars { my ($_iter, $_count) = @_ } -sub forward_cursor_position { my ($_iter) = @_ } -sub forward_cursor_positions { my ($_iter, $_count) = @_ } -sub forward_find_char { my ($_iter, $_pred, $_o_user_data, $_o_limit) = @_ } -sub forward_line { my ($_iter) = @_ } -sub forward_lines { my ($_iter, $_count) = @_ } -sub forward_search { my ($_iter, $_str, $_flags, $_o_limit) = @_ } -sub forward_sentence_end { my ($_iter) = @_ } -sub forward_sentence_ends { my ($_iter, $_count) = @_ } -sub forward_to_end { my ($_iter) = @_ } -sub forward_to_line_end { my ($_iter) = @_ } -sub forward_to_tag_toggle { my ($_iter, $_tag) = @_ } -sub forward_visible_cursor_position { my ($_iter) = @_ } -sub forward_visible_cursor_positions { my ($_iter, $_count) = @_ } -sub forward_visible_line { my ($_iter) = @_ } -sub forward_visible_lines { my ($_iter, $_count) = @_ } -sub forward_visible_word_end { my ($_iter) = @_ } -sub forward_visible_word_ends { my ($_iter, $_count) = @_ } -sub forward_word_end { my ($_iter) = @_ } -sub forward_word_ends { my ($_iter, $_count) = @_ } -sub get_attributes { my ($_iter) = @_ } -sub get_buffer { my ($_iter) = @_ } -sub get_bytes_in_line { my ($_iter) = @_ } -sub get_char { my ($_iter) = @_ } -sub get_chars_in_line { my ($_iter) = @_ } -sub get_child_anchor { my ($_iter) = @_ } -sub get_language { my ($_iter) = @_ } -sub get_line { my ($_iter) = @_ } -sub get_line_index { my ($_iter) = @_ } -sub get_line_offset { my ($_iter) = @_ } -sub get_marks { my ($_iter) = @_ } -sub get_offset { my ($_iter) = @_ } -sub get_pixbuf { my ($_iter) = @_ } -sub get_slice { my ($_start, $_end) = @_ } -sub get_tags { my ($_iter) = @_ } -sub get_text { my ($_start, $_end) = @_ } -sub get_toggled_tags { my ($_iter, $_toggled_on) = @_ } -sub get_visible_line_index { my ($_iter) = @_ } -sub get_visible_line_offset { my ($_iter) = @_ } -sub get_visible_slice { my ($_start, $_end) = @_ } -sub get_visible_text { my ($_start, $_end) = @_ } -sub has_tag { my ($_iter, $_tag) = @_ } -sub in_range { my ($_iter, $_start, $_end) = @_ } -sub inside_sentence { my ($_iter) = @_ } -sub inside_word { my ($_iter) = @_ } -sub is_cursor_position { my ($_iter) = @_ } -sub is_end { my ($_iter) = @_ } -sub is_start { my ($_iter) = @_ } -sub order { my ($_first, $_second) = @_ } -sub set_line { my ($_iter, $_line_number) = @_ } -sub set_line_index { my ($_iter, $_byte_on_line) = @_ } -sub set_line_offset { my ($_iter, $_char_on_line) = @_ } -sub set_offset { my ($_iter, $_char_offset) = @_ } -sub set_visible_line_index { my ($_iter, $_byte_on_line) = @_ } -sub set_visible_line_offset { my ($_iter, $_char_on_line) = @_ } -sub starts_line { my ($_iter) = @_ } -sub starts_sentence { my ($_iter) = @_ } -sub starts_word { my ($_iter) = @_ } -sub toggles_tag { my ($_iter, $_tag) = @_ } - -package Gtk2::TextMark; -our @ISA = qw(); -sub get_buffer { my ($_mark) = @_ } -sub get_deleted { my ($_mark) = @_ } -sub get_left_gravity { my ($_mark) = @_ } -sub get_name { my ($_mark) = @_ } -sub get_visible { my ($_mark) = @_ } -sub set_visible { my ($_mark, $_setting) = @_ } - -package Gtk2::TextTag; -our @ISA = qw(); -sub event { my ($_tag, $_event_object, $_event, $_iter) = @_ } -sub get_priority { my ($_tag) = @_ } -sub new { my ($_class, $_o_name) = @_ } -sub set_priority { my ($_tag, $_priority) = @_ } - -package Gtk2::TextTagTable; -our @ISA = qw(); -sub add { my ($_table, $_tag) = @_ } -sub Gtk2::TextTagTable::foreach { my ($_table, $_callback, $_o_callback_data) = @_ } -sub get_size { my ($_table) = @_ } -sub lookup { my ($_table, $_name) = @_ } -sub new { my ($_class) = @_ } -sub remove { my ($_table, $_tag) = @_ } - -package Gtk2::TextView; -our @ISA = qw(); -sub add_child_at_anchor { my ($_text_view, $_child, $_anchor) = @_ } -sub add_child_in_window { my ($_text_view, $_child, $_which_window, $_xpos, $_ypos) = @_ } -sub backward_display_line { my ($_text_view, $_iter) = @_ } -sub backward_display_line_start { my ($_text_view, $_iter) = @_ } -sub buffer_to_window_coords { my ($_text_view, $_win, $_buffer_x, $_buffer_y) = @_ } -sub forward_display_line { my ($_text_view, $_iter) = @_ } -sub forward_display_line_end { my ($_text_view, $_iter) = @_ } -sub get_accepts_tab { my ($_text_view) = @_ } -sub get_border_window_size { my ($_text_view, $_type) = @_ } -sub get_buffer { my ($_text_view) = @_ } -sub get_cursor_visible { my ($_text_view) = @_ } -sub get_default_attributes { my ($_text_view) = @_ } -sub get_editable { my ($_text_view) = @_ } -sub get_indent { my ($_text_view) = @_ } -sub get_iter_at_location { my ($_text_view, $_x, $_y) = @_ } -sub get_iter_at_position { my ($_text_view, $_x, $_y) = @_ } -sub get_iter_location { my ($_text_view, $_iter) = @_ } -sub get_justification { my ($_text_view) = @_ } -sub get_left_margin { my ($_text_view) = @_ } -sub get_line_at_y { my ($_text_view, $_y) = @_ } -sub get_line_yrange { my ($_text_view, $_iter) = @_ } -sub get_overwrite { my ($_text_view) = @_ } -sub get_pixels_above_lines { my ($_text_view) = @_ } -sub get_pixels_below_lines { my ($_text_view) = @_ } -sub get_pixels_inside_wrap { my ($_text_view) = @_ } -sub get_right_margin { my ($_text_view) = @_ } -sub get_tabs { my ($_text_view) = @_ } -sub get_visible_rect { my ($_text_view) = @_ } -sub get_window { my ($_text_view, $_win) = @_ } -sub get_window_type { my ($_text_view, $_window) = @_ } -sub get_wrap_mode { my ($_text_view) = @_ } -sub move_child { my ($_text_view, $_child, $_xpos, $_ypos) = @_ } -sub move_mark_onscreen { my ($_text_view, $_mark) = @_ } -sub move_visually { my ($_text_view, $_iter, $_count) = @_ } -sub new { my ($_class) = @_ } -sub new_with_buffer { my ($_class, $_buffer) = @_ } -sub place_cursor_onscreen { my ($_text_view) = @_ } -sub scroll_mark_onscreen { my ($_text_view, $_mark) = @_ } -sub scroll_to_iter { my ($_text_view, $_iter, $_within_margin, $_use_align, $_xalign, $_yalign) = @_ } -sub scroll_to_mark { my ($_text_view, $_mark, $_within_margin, $_use_align, $_xalign, $_yalign) = @_ } -sub set_accepts_tab { my ($_text_view, $_accepts_tab) = @_ } -sub set_border_window_size { my ($_text_view, $_type, $_size) = @_ } -sub set_buffer { my ($_text_view, $_buffer) = @_ } -sub set_cursor_visible { my ($_text_view, $_setting) = @_ } -sub set_editable { my ($_text_view, $_setting) = @_ } -sub set_indent { my ($_text_view, $_indent) = @_ } -sub set_justification { my ($_text_view, $_justification) = @_ } -sub set_left_margin { my ($_text_view, $_left_margin) = @_ } -sub set_overwrite { my ($_text_view, $_overwrite) = @_ } -sub set_pixels_above_lines { my ($_text_view, $_pixels_above_lines) = @_ } -sub set_pixels_below_lines { my ($_text_view, $_pixels_below_lines) = @_ } -sub set_pixels_inside_wrap { my ($_text_view, $_pixels_inside_wrap) = @_ } -sub set_right_margin { my ($_text_view, $_right_margin) = @_ } -sub set_tabs { my ($_text_view, $_tabs) = @_ } -sub set_wrap_mode { my ($_text_view, $_wrap_mode) = @_ } -sub starts_display_line { my ($_text_view, $_iter) = @_ } -sub window_to_buffer_coords { my ($_text_view, $_win, $_window_x, $_window_y) = @_ } - -package Gtk2::ToggleAction; -our @ISA = qw(); -sub get_active { my ($_action) = @_ } -sub get_draw_as_radio { my ($_action) = @_ } -sub set_active { my ($_action, $_is_active) = @_ } -sub set_draw_as_radio { my ($_action, $_draw_as_radio) = @_ } -sub toggled { my ($_action) = @_ } - -package Gtk2::ToggleButton; -our @ISA = qw(); -sub get_active { my ($_toggle_button) = @_ } -sub get_inconsistent { my ($_toggle_button) = @_ } -sub get_mode { my ($_toggle_button) = @_ } -sub new { my ($_class, $_o_label) = @_ } -sub new_with_label { my ($_class, $_o_label) = @_ } -sub new_with_mnemonic { my ($_class, $_o_label) = @_ } -sub set_active { my ($_toggle_button, $_is_active) = @_ } -sub set_inconsistent { my ($_toggle_button, $_setting) = @_ } -sub set_mode { my ($_toggle_button, $_draw_indicator) = @_ } -sub toggled { my ($_toggle_button) = @_ } - -package Gtk2::ToggleToolButton; -our @ISA = qw(); -sub get_active { my ($_button) = @_ } -sub new { my ($_class) = @_ } -sub new_from_stock { my ($_class, $_stock_id) = @_ } -sub set_active { my ($_button, $_is_active) = @_ } - -package Gtk2::ToolButton; -our @ISA = qw(); -sub get_icon_name { my ($_button) = @_ } -sub get_icon_widget { my ($_button) = @_ } -sub get_label { my ($_button) = @_ } -sub get_label_widget { my ($_button) = @_ } -sub get_stock_id { my ($_button) = @_ } -sub get_use_underline { my ($_button) = @_ } -sub new { my ($_class, $_icon_widget, $_label) = @_ } -sub new_from_stock { my ($_class, $_stock_id) = @_ } -sub set_icon_name { my ($_button, $_icon_name) = @_ } -sub set_icon_widget { my ($_button, $_icon_widget) = @_ } -sub set_label { my ($_button, $_label) = @_ } -sub set_label_widget { my ($_button, $_label_widget) = @_ } -sub set_stock_id { my ($_button, $_stock_id) = @_ } -sub set_use_underline { my ($_button, $_use_underline) = @_ } - -package Gtk2::ToolItem; -our @ISA = qw(); -sub get_expand { my ($_tool_item) = @_ } -sub get_homogeneous { my ($_tool_item) = @_ } -sub get_icon_size { my ($_tool_item) = @_ } -sub get_is_important { my ($_tool_item) = @_ } -sub get_orientation { my ($_tool_item) = @_ } -sub get_proxy_menu_item { my ($_tool_item, $_menu_item_id) = @_ } -sub get_relief_style { my ($_tool_item) = @_ } -sub get_toolbar_style { my ($_tool_item) = @_ } -sub get_use_drag_window { my ($_toolitem) = @_ } -sub get_visible_horizontal { my ($_toolitem) = @_ } -sub get_visible_vertical { my ($_toolitem) = @_ } -sub new { my ($_class) = @_ } -sub rebuild_menu { my ($_tool_item) = @_ } -sub retrieve_proxy_menu_item { my ($_tool_item) = @_ } -sub set_expand { my ($_tool_item, $_expand) = @_ } -sub set_homogeneous { my ($_tool_item, $_homogeneous) = @_ } -sub set_is_important { my ($_tool_item, $_is_important) = @_ } -sub set_proxy_menu_item { my ($_tool_item, $_menu_item_id, $_menu_item) = @_ } -sub set_tooltip { my ($_tool_item, $_tooltips, $_tip_text, $_tip_private) = @_ } -sub set_use_drag_window { my ($_toolitem, $_use_drag_window) = @_ } -sub set_visible_horizontal { my ($_toolitem, $_visible_horizontal) = @_ } -sub set_visible_vertical { my ($_toolitem, $_visible_vertical) = @_ } - -package Gtk2::Toolbar; -our @ISA = qw(); -sub append_element { my ($_toolbar, $_type, $_widget, $_text, $_tooltip_text, $_tooltip_private_text, $_icon, $_o_callback, $_o_user_data) = @_ } -sub append_item { my ($_toolbar, $_text, $_tooltip_text, $_tooltip_private_text, $_icon, $_o_callback, $_o_user_data) = @_ } -sub append_space { my ($_toolbar) = @_ } -sub append_widget { my ($_toolbar, $_widget, $_tooltip_text, $_tooltip_private_text) = @_ } -sub get_drop_index { my ($_toolbar, $_x, $_y) = @_ } -sub get_icon_size { my ($_toolbar) = @_ } -sub get_item_index { my ($_toolbar, $_item) = @_ } -sub get_n_items { my ($_toolbar) = @_ } -sub get_nth_item { my ($_toolbar, $_n) = @_ } -sub get_orientation { my ($_toolbar) = @_ } -sub get_relief_style { my ($_toolbar) = @_ } -sub get_show_arrow { my ($_toolbar) = @_ } -sub get_style { my ($_toolbar) = @_ } -sub get_tooltips { my ($_toolbar) = @_ } -sub insert { my ($_toolbar, $_item, $_pos) = @_ } -sub insert_element { my ($_toolbar, $_type, $_widget, $_text, $_tooltip_text, $_tooltip_private_text, $_icon, $_callback, $_user_data, $_position) = @_ } -sub insert_item { my ($_toolbar, $_text, $_tooltip_text, $_tooltip_private_text, $_icon, $_callback, $_user_data, $_position) = @_ } -sub insert_space { my ($_toolbar, $_position) = @_ } -sub insert_stock { my ($_toolbar, $_stock_id, $_tooltip_text, $_tooltip_private_text, $_callback, $_user_data, $_position) = @_ } -sub insert_widget { my ($_toolbar, $_widget, $_tooltip_text, $_tooltip_private_text, $_position) = @_ } -sub new { my ($_class) = @_ } -sub prepend_element { my ($_toolbar, $_type, $_widget, $_text, $_tooltip_text, $_tooltip_private_text, $_icon, $_o_callback, $_o_user_data) = @_ } -sub prepend_item { my ($_toolbar, $_text, $_tooltip_text, $_tooltip_private_text, $_icon, $_o_callback, $_o_user_data) = @_ } -sub prepend_space { my ($_toolbar) = @_ } -sub prepend_widget { my ($_toolbar, $_widget, $_tooltip_text, $_tooltip_private_text) = @_ } -sub remove_space { my ($_toolbar, $_position) = @_ } -sub set_drop_highlight_item { my ($_toolbar, $_tool_item, $_index) = @_ } -sub set_icon_size { my ($_toolbar, $_icon_size) = @_ } -sub set_orientation { my ($_toolbar, $_orientation) = @_ } -sub set_show_arrow { my ($_toolbar, $_show_arrow) = @_ } -sub set_style { my ($_toolbar, $_style) = @_ } -sub set_tooltips { my ($_toolbar, $_enable) = @_ } -sub unset_icon_size { my ($_toolbar) = @_ } -sub unset_style { my ($_toolbar) = @_ } - -package Gtk2::Tooltips; -our @ISA = qw(); -sub data_get { my ($_class, $_widget) = @_ } -sub disable { my ($_tooltips) = @_ } -sub enable { my ($_tooltips) = @_ } -sub force_window { my ($_tooltips) = @_ } -sub new { my ($_class) = @_ } -sub set_tip { my ($_tooltips, $_widget, $_tip_text, $_o_tip_private) = @_ } - -package Gtk2::TreeDragDest; -our @ISA = qw(); -sub _ADD_INTERFACE { my ($_class, $_target_class) = @_ } -sub drag_data_received { my ($_drag_dest, $_dest, $_selection_data) = @_ } -sub row_drop_possible { my ($_drag_dest, $_dest_path, $_selection_data) = @_ } - -package Gtk2::TreeDragSource; -our @ISA = qw(); -sub _ADD_INTERFACE { my ($_class, $_target_class) = @_ } -sub drag_data_delete { my ($_drag_source, $_path) = @_ } -sub drag_data_get { my ($_drag_source, $_path) = @_ } -sub row_draggable { my ($_drag_source, $_path) = @_ } - -package Gtk2::TreeIter; -our @ISA = qw(); -sub new_from_arrayref { my ($_class, $_sv_iter) = @_ } -sub to_arrayref { my ($_iter, $_stamp) = @_ } - -package Gtk2::TreeModel; -our @ISA = qw(); -sub _ADD_INTERFACE { my ($_class, $_target_class) = @_ } -sub Gtk2::TreeModel::foreach { my ($_model, $_func, $_o_user_data) = @_ } -sub get { my ($_tree_model, $_iter, @_more_paras) = @_ } -sub get_column_type { my ($_tree_model, $_index_) = @_ } -sub get_flags { my ($_tree_model) = @_ } -sub get_iter { my ($_tree_model, $_path) = @_ } -sub get_iter_first { my ($_tree_model) = @_ } -sub get_iter_from_string { my ($_tree_model, $_path_string) = @_ } -sub get_n_columns { my ($_tree_model) = @_ } -sub get_path { my ($_tree_model, $_iter) = @_ } -sub get_string_from_iter { my ($_tree_model, $_iter) = @_ } -sub get_value { my ($_tree_model, $_iter, @_more_paras) = @_ } -sub iter_children { my ($_tree_model, $_parent) = @_ } -sub iter_has_child { my ($_tree_model, $_iter) = @_ } -sub iter_n_children { my ($_tree_model, $_o_iter) = @_ } -sub iter_next { my ($_tree_model, $_iter) = @_ } -sub iter_nth_child { my ($_tree_model, $_parent, $_n) = @_ } -sub iter_parent { my ($_tree_model, $_child) = @_ } -sub ref_node { my ($_tree_model, $_iter) = @_ } -sub row_changed { my ($_tree_model, $_path, $_iter) = @_ } -sub row_deleted { my ($_tree_model, $_path) = @_ } -sub row_has_child_toggled { my ($_tree_model, $_path, $_iter) = @_ } -sub row_inserted { my ($_tree_model, $_path, $_iter) = @_ } -sub rows_reordered { my ($_tree_model, $_path, $_iter, @_more_paras) = @_ } -sub unref_node { my ($_tree_model, $_iter) = @_ } - -package Gtk2::TreeModelFilter; -our @ISA = qw(); -sub clear_cache { my ($_filter) = @_ } -sub convert_child_iter_to_iter { my ($_filter, $_child_iter) = @_ } -sub convert_child_path_to_path { my ($_filter, $_child_path) = @_ } -sub convert_iter_to_child_iter { my ($_filter, $_filter_iter) = @_ } -sub convert_path_to_child_path { my ($_path, $_filter_path) = @_ } -sub get_model { my ($_filter) = @_ } -sub new { my ($_class, $_child_model, $_o_root) = @_ } -sub refilter { my ($_filter) = @_ } -sub set_modify_func { my ($_filter, $_types, $_o_func, $_o_data) = @_ } -sub set_visible_column { my ($_filter, $_column) = @_ } -sub set_visible_func { my ($_filter, $_func, $_o_data) = @_ } - -package Gtk2::TreeModelSort; -our @ISA = qw(); -sub clear_cache { my ($_tree_model_sort) = @_ } -sub convert_child_iter_to_iter { my ($_tree_model_sort, $_child_iter) = @_ } -sub convert_child_path_to_path { my ($_tree_model_sort, $_child_path) = @_ } -sub convert_iter_to_child_iter { my ($_tree_model_sort, $_sorted_iter) = @_ } -sub convert_path_to_child_path { my ($_tree_model_sort, $_sorted_path) = @_ } -sub get_model { my ($_tree_model) = @_ } -sub iter_is_valid { my ($_tree_model_sort, $_iter) = @_ } -sub new { my ($_class, @_more_paras) = @_ } -sub new_with_model { my ($_class, $_child_model) = @_ } -sub reset_default_sort_func { my ($_tree_model_sort) = @_ } - -package Gtk2::TreePath; -our @ISA = qw(); -sub append_index { my ($_path, $_index_) = @_ } -sub compare { my ($_a, $_b) = @_ } -sub down { my ($_path) = @_ } -sub get_depth { my ($_path) = @_ } -sub get_indices { my ($_path) = @_ } -sub is_ancestor { my ($_path, $_descendant) = @_ } -sub is_descendant { my ($_path, $_ancestor) = @_ } -sub new { my ($_class, $_o_path) = @_ } -sub new_first { my ($_class) = @_ } -sub new_from_indices { my ($_class, $_first_index, @_more_paras) = @_ } -sub new_from_string { my ($_class, $_o_path) = @_ } -sub next { my ($_path) = @_ } -sub prepend_index { my ($_path, $_index_) = @_ } -sub prev { my ($_path) = @_ } -sub to_string { my ($_path) = @_ } -sub up { my ($_path) = @_ } - -package Gtk2::TreeRowReference; -our @ISA = qw(); -sub get_model { my ($_reference) = @_ } -sub get_path { my ($_reference) = @_ } -sub new { my ($_class, $_model, $_path) = @_ } -sub valid { my ($_reference) = @_ } - -package Gtk2::TreeSelection; -our @ISA = qw(); -sub count_selected_rows { my ($_selection) = @_ } -sub get_mode { my ($_selection) = @_ } -sub get_selected { my ($_selection) = @_ } -sub get_selected_rows { my ($_selection) = @_ } -sub get_tree_view { my ($_selection) = @_ } -sub get_user_data { my ($_selection) = @_ } -sub iter_is_selected { my ($_selection, $_iter) = @_ } -sub path_is_selected { my ($_selection, $_path) = @_ } -sub select_all { my ($_selection) = @_ } -sub select_iter { my ($_selection, $_iter) = @_ } -sub select_path { my ($_selection, $_path) = @_ } -sub select_range { my ($_selection, $_start_path, $_end_path) = @_ } -sub selected_foreach { my ($_selection, $_func, $_o_data) = @_ } -sub set_mode { my ($_selection, $_type) = @_ } -sub set_select_function { my ($_selection, $_func, $_o_data) = @_ } -sub unselect_all { my ($_selection) = @_ } -sub unselect_iter { my ($_selection, $_iter) = @_ } -sub unselect_path { my ($_selection, $_path) = @_ } -sub unselect_range { my ($_selection, $_start_path, $_end_path) = @_ } - -package Gtk2::TreeSortable; -our @ISA = qw(); -sub _ADD_INTERFACE { my ($_class, $_target_class) = @_ } -sub get_sort_column_id { my ($_sortable) = @_ } -sub has_default_sort_func { my ($_sortable) = @_ } -sub set_default_sort_func { my ($_sortable, $_sort_func, $_o_user_data) = @_ } -sub set_sort_column_id { my ($_sortable, $_sort_column_id, $_order) = @_ } -sub set_sort_func { my ($_sortable, $_sort_column_id, $_sort_func, $_o_user_data) = @_ } -sub sort_column_changed { my ($_sortable) = @_ } - -package Gtk2::TreeSortable::IterCompareFunc; -our @ISA = qw(); -sub DESTROY { my ($_code) = @_ } -sub invoke { my ($_model, $_a, $_b, $_data) = @_ } - -package Gtk2::TreeStore; -our @ISA = qw(); -sub append { my ($_tree_store, $_parent) = @_ } -sub clear { my ($_tree_store) = @_ } -sub insert { my ($_tree_store, $_parent, $_position) = @_ } -sub insert_after { my ($_tree_store, $_parent, $_sibling) = @_ } -sub insert_before { my ($_tree_store, $_parent, $_sibling) = @_ } -sub is_ancestor { my ($_tree_store, $_iter, $_descendant) = @_ } -sub iter_depth { my ($_tree_store, $_iter) = @_ } -sub iter_is_valid { my ($_tree_store, $_iter) = @_ } -sub move_after { my ($_tree_store, $_iter, $_position) = @_ } -sub move_before { my ($_tree_store, $_iter, $_position) = @_ } -sub new { my ($_class, @_more_paras) = @_ } -sub prepend { my ($_tree_store, $_parent) = @_ } -sub remove { my ($_tree_store, $_iter) = @_ } -sub reorder { my ($_tree_store, $_parent, @_more_paras) = @_ } -sub set { my ($_tree_store, $_iter, $_col1, $_val1, @_more_paras) = @_ } -sub set_column_types { my ($_tree_store, @_more_paras) = @_ } -sub set_value { my ($_tree_store, $_iter, $_col1, $_val1, @_more_paras) = @_ } -sub swap { my ($_tree_store, $_a, $_b) = @_ } - -package Gtk2::TreeView; -our @ISA = qw(); -sub append_column { my ($_tree_view, $_column) = @_ } -sub collapse_all { my ($_tree_view) = @_ } -sub collapse_row { my ($_tree_view, $_path) = @_ } -sub columns_autosize { my ($_tree_view) = @_ } -sub create_row_drag_icon { my ($_tree_view, $_path) = @_ } -sub enable_model_drag_dest { my ($_tree_view, $_actions, @_more_paras) = @_ } -sub enable_model_drag_source { my ($_tree_view, $_start_button_mask, $_actions, @_more_paras) = @_ } -sub expand_all { my ($_tree_view) = @_ } -sub expand_row { my ($_tree_view, $_path, $_open_all) = @_ } -sub expand_to_path { my ($_tree_view, $_path) = @_ } -sub get_background_area { my ($_tree_view, $_path, $_column) = @_ } -sub get_bin_window { my ($_tree_view) = @_ } -sub get_cell_area { my ($_tree_view, $_path, $_column) = @_ } -sub get_column { my ($_tree_view, $_n) = @_ } -sub get_columns { my ($_tree_view) = @_ } -sub get_cursor { my ($_tree_view) = @_ } -sub get_dest_row_at_pos { my ($_tree_view, $_drag_x, $_drag_y) = @_ } -sub get_drag_dest_row { my ($_tree_view) = @_ } -sub get_enable_search { my ($_tree_view) = @_ } -sub get_expander_column { my ($_tree_view) = @_ } -sub get_fixed_height_mode { my ($_treeview) = @_ } -sub get_hadjustment { my ($_tree_view) = @_ } -sub get_headers_visible { my ($_tree_view) = @_ } -sub get_hover_expand { my ($_treeview) = @_ } -sub get_hover_selection { my ($_treeview) = @_ } -sub get_model { my ($_tree_view) = @_ } -sub get_path_at_pos { my ($_tree_view, $_x, $_y) = @_ } -sub get_reorderable { my ($_tree_view) = @_ } -sub get_rules_hint { my ($_tree_view) = @_ } -sub get_search_column { my ($_tree_view) = @_ } -sub get_selection { my ($_tree_view) = @_ } -sub get_vadjustment { my ($_tree_view) = @_ } -sub get_visible_range { my ($_tree_view) = @_ } -sub get_visible_rect { my ($_tree_view) = @_ } -sub insert_column { my ($_tree_view, $_column, $_position) = @_ } -sub insert_column_with_attributes { my ($_tree_view, $_position, $_title, $_cell, @_more_paras) = @_ } -sub insert_column_with_data_func { my ($_tree_view, $_position, $_title, $_cell, $_func, $_o_data) = @_ } -sub map_expanded_rows { my ($_tree_view, $_func, $_o_data) = @_ } -sub move_column_after { my ($_tree_view, $_column, $_base_column) = @_ } -sub new { my ($_class, $_o_model) = @_ } -sub new_with_model { my ($_class, $_model) = @_ } -sub remove_column { my ($_tree_view, $_column) = @_ } -sub row_activated { my ($_tree_view, $_path, $_column) = @_ } -sub row_expanded { my ($_tree_view, $_path) = @_ } -sub scroll_to_cell { my ($_tree_view, $_path, $_o_column, $_o_use_align, $_o_row_align, $_o_col_align) = @_ } -sub scroll_to_point { my ($_tree_view, $_tree_x, $_tree_y) = @_ } -sub set_column_drag_function { my ($_tree_view, $_func, $_o_data) = @_ } -sub set_cursor { my ($_tree_view, $_path, $_o_focus_column, $_o_start_editing) = @_ } -sub set_cursor_on_cell { my ($_tree_view, $_path, $_focus_column, $_focus_cell, $_start_editing) = @_ } -sub set_drag_dest_row { my ($_tree_view, $_path, $_pos) = @_ } -sub set_enable_search { my ($_tree_view, $_enable_search) = @_ } -sub set_expander_column { my ($_tree_view, $_column) = @_ } -sub set_fixed_height_mode { my ($_treeview, $_enable) = @_ } -sub set_hadjustment { my ($_tree_view, $_adjustment) = @_ } -sub set_headers_clickable { my ($_tree_view, $_setting) = @_ } -sub set_headers_visible { my ($_tree_view, $_headers_visible) = @_ } -sub set_hover_expand { my ($_treeview, $_expand) = @_ } -sub set_hover_selection { my ($_treeview, $_hover) = @_ } -sub set_model { my ($_tree_view, $_model) = @_ } -sub set_reorderable { my ($_tree_view, $_reorderable) = @_ } -sub set_row_separator_func { my ($_tree_view, $_func, $_o_data) = @_ } -sub set_rules_hint { my ($_tree_view, $_setting) = @_ } -sub set_search_column { my ($_tree_view, $_column) = @_ } -sub set_search_equal_func { my ($_tree_view, $_func, $_o_data) = @_ } -sub set_vadjustment { my ($_tree_view, $_adjustment) = @_ } -sub tree_to_widget_coords { my ($_tree_view, $_tx, $_ty) = @_ } -sub unset_rows_drag_dest { my ($_tree_view) = @_ } -sub unset_rows_drag_source { my ($_tree_view) = @_ } -sub widget_to_tree_coords { my ($_tree_view, $_wx, $_wy) = @_ } - -package Gtk2::TreeViewColumn; -our @ISA = qw(); -sub add_attribute { my ($_tree_column, $_cell_renderer, $_attribute, $_column) = @_ } -sub cell_get_position { my ($_tree_column, $_cell_renderer) = @_ } -sub cell_get_size { my ($_tree_column) = @_ } -sub cell_is_visible { my ($_tree_column) = @_ } -sub cell_set_cell_data { my ($_tree_column, $_tree_model, $_iter, $_is_expander, $_is_expanded) = @_ } -sub clear { my ($_tree_column) = @_ } -sub clear_attributes { my ($_tree_column, $_cell_renderer) = @_ } -sub clicked { my ($_tree_column) = @_ } -sub focus_cell { my ($_tree_column, $_cell) = @_ } -sub get_alignment { my ($_tree_column) = @_ } -sub get_cell_renderers { my ($_tree_column) = @_ } -sub get_clickable { my ($_tree_column) = @_ } -sub get_expand { my ($_tree_column) = @_ } -sub get_fixed_width { my ($_tree_column) = @_ } -sub get_max_width { my ($_tree_column) = @_ } -sub get_min_width { my ($_tree_column) = @_ } -sub get_reorderable { my ($_tree_column) = @_ } -sub get_resizable { my ($_tree_column) = @_ } -sub get_sizing { my ($_tree_column) = @_ } -sub get_sort_column_id { my ($_tree_column) = @_ } -sub get_sort_indicator { my ($_tree_column) = @_ } -sub get_sort_order { my ($_tree_column) = @_ } -sub get_spacing { my ($_tree_column) = @_ } -sub get_title { my ($_tree_column) = @_ } -sub get_visible { my ($_tree_column) = @_ } -sub get_widget { my ($_tree_column) = @_ } -sub get_width { my ($_tree_column) = @_ } -sub new { my ($_class) = @_ } -sub new_with_attributes { my ($_class, $_title, $_cell, @_more_paras) = @_ } -sub pack_end { my ($_tree_column, $_cell, $_expand) = @_ } -sub pack_start { my ($_tree_column, $_cell, $_expand) = @_ } -sub queue_resize { my ($_tree_column) = @_ } -sub set_alignment { my ($_tree_column, $_xalign) = @_ } -sub set_attributes { my ($_tree_column, $_cell_renderer, @_more_paras) = @_ } -sub set_cell_data_func { my ($_tree_column, $_cell_renderer, $_func, $_o_data) = @_ } -sub set_clickable { my ($_tree_column, $_clickable) = @_ } -sub set_expand { my ($_tree_column, $_expand) = @_ } -sub set_fixed_width { my ($_tree_column, $_fixed_width) = @_ } -sub set_max_width { my ($_tree_column, $_max_width) = @_ } -sub set_min_width { my ($_tree_column, $_min_width) = @_ } -sub set_reorderable { my ($_tree_column, $_reorderable) = @_ } -sub set_resizable { my ($_tree_column, $_resizable) = @_ } -sub set_sizing { my ($_tree_column, $_type) = @_ } -sub set_sort_column_id { my ($_tree_column, $_sort_column_id) = @_ } -sub set_sort_indicator { my ($_tree_column, $_setting) = @_ } -sub set_sort_order { my ($_tree_column, $_order) = @_ } -sub set_spacing { my ($_tree_column, $_spacing) = @_ } -sub set_title { my ($_tree_column, $_title) = @_ } -sub set_visible { my ($_tree_column, $_visible) = @_ } -sub set_widget { my ($_tree_column, $_widget) = @_ } - -package Gtk2::UIManager; -our @ISA = qw(); -sub add_ui { my ($_self, $_merge_id, $_path, $_name, $_action, $_type, $_top) = @_ } -sub add_ui_from_file { my ($_self, $_filename) = @_ } -sub add_ui_from_string { my ($_self, $_buffer, $_buffer) = @_ } -sub ensure_update { my ($_self) = @_ } -sub get_accel_group { my ($_self) = @_ } -sub get_action { my ($_self, $_path) = @_ } -sub get_action_groups { my ($_self) = @_ } -sub get_add_tearoffs { my ($_self) = @_ } -sub get_toplevels { my ($_self, $_types) = @_ } -sub get_ui { my ($_self) = @_ } -sub get_widget { my ($_self, $_path) = @_ } -sub insert_action_group { my ($_self, $_action_group, $_pos) = @_ } -sub new { my ($_class) = @_ } -sub new_merge_id { my ($_self) = @_ } -sub remove_action_group { my ($_self, $_action_group) = @_ } -sub remove_ui { my ($_self, $_merge_id) = @_ } -sub set_add_tearoffs { my ($_self, $_add_tearoffs) = @_ } - -package Gtk2::VBox; -our @ISA = qw(); -sub new { my ($_class, $_o_homogeneous, $_o_spacing) = @_ } - -package Gtk2::VButtonBox; -our @ISA = qw(); -sub get_layout_default { my ($_class) = @_ } -sub get_spacing_default { my ($_class) = @_ } -sub new { my ($_class) = @_ } -sub set_layout_default { my ($_class, $_layout) = @_ } -sub set_spacing_default { my ($_class, $_spacing) = @_ } - -package Gtk2::VPaned; -our @ISA = qw(); -sub new { my ($_class) = @_ } - -package Gtk2::VRuler; -our @ISA = qw(); -sub new { my ($_class) = @_ } - -package Gtk2::VScale; -our @ISA = qw(); -sub new { my ($_class, $_o_adjustment) = @_ } -sub new_with_range { my ($_class, $_min, $_max, $_step) = @_ } - -package Gtk2::VScrollBar; -our @ISA = qw(); -sub new { my ($_class, $_o_adjustment) = @_ } - -package Gtk2::VScrollbar; -our @ISA = qw(); -sub new { my ($_class, $_o_adjustment) = @_ } - -package Gtk2::VSeparator; -our @ISA = qw(); -sub new { my ($_class) = @_ } - -package Gtk2::Viewport; -our @ISA = qw(); -sub get_hadjustment { my ($_viewport) = @_ } -sub get_shadow_type { my ($_viewport) = @_ } -sub get_vadjustment { my ($_viewport) = @_ } -sub new { my ($_class, $_o_hadjustment, $_o_vadjustment) = @_ } -sub set_hadjustment { my ($_viewport, $_adjustment) = @_ } -sub set_shadow_type { my ($_viewport, $_type) = @_ } -sub set_vadjustment { my ($_viewport, $_adjustment) = @_ } - -package Gtk2::Widget; -our @ISA = qw(); -sub _INSTALL_OVERRIDES { my ($_package) = @_ } -sub activate { my ($_widget) = @_ } -sub add_accelerator { my ($_widget, $_accel_signal, $_accel_group, $_accel_key, $_accel_mods, $_flags) = @_ } -sub add_events { my ($_widget, $_events) = @_ } -sub add_mnemonic_label { my ($_widget, $_label) = @_ } -sub allocation { my ($_widget) = @_ } -sub app_paintable { my ($_widget, @_more_paras) = @_ } -sub can_activate_accel { my ($_widget, $_signal_id) = @_ } -sub can_default { my ($_widget, @_more_paras) = @_ } -sub can_focus { my ($_widget, @_more_paras) = @_ } -sub child_focus { my ($_widget, $_direction) = @_ } -sub child_notify { my ($_widget, $_child_property) = @_ } -sub class_path { my ($_widget) = @_ } -sub composite_child { my ($_widget, @_more_paras) = @_ } -sub create_pango_context { my ($_widget) = @_ } -sub create_pango_layout { my ($_widget, $_text) = @_ } -sub destroy { my ($_widget) = @_ } -sub double_buffered { my ($_widget, @_more_paras) = @_ } -sub drag_begin { my ($_widget, $_targets, $_actions, $_button, $_event) = @_ } -sub drag_check_threshold { my ($_widget, $_start_x, $_start_y, $_current_x, $_current_y) = @_ } -sub drag_dest_add_image_targets { my ($_widget) = @_ } -sub drag_dest_add_text_targets { my ($_widget) = @_ } -sub drag_dest_add_uri_targets { my ($_widget) = @_ } -sub drag_dest_find_target { my ($_widget, $_context, $_target_list) = @_ } -sub drag_dest_get_target_list { my ($_widget) = @_ } -sub drag_dest_set { my ($_widget, $_flags, $_actions, @_more_paras) = @_ } -sub drag_dest_set_proxy { my ($_widget, $_proxy_window, $_protocol, $_use_coordinates) = @_ } -sub drag_dest_set_target_list { my ($_widget, $_target_list) = @_ } -sub drag_dest_unset { my ($_widget) = @_ } -sub drag_get_data { my ($_widget, $_context, $_target, $_time_) = @_ } -sub drag_highlight { my ($_widget) = @_ } -sub drag_source_add_image_targets { my ($_widget) = @_ } -sub drag_source_add_text_targets { my ($_widget) = @_ } -sub drag_source_add_uri_targets { my ($_widget) = @_ } -sub drag_source_get_target_list { my ($_widget) = @_ } -sub drag_source_set { my ($_widget, $_start_button_mask, $_actions, @_more_paras) = @_ } -sub drag_source_set_icon { my ($_widget, $_colormap, $_pixmap, $_mask) = @_ } -sub drag_source_set_icon_name { my ($_widget, $_icon_name) = @_ } -sub drag_source_set_icon_pixbuf { my ($_widget, $_pixbuf) = @_ } -sub drag_source_set_icon_stock { my ($_widget, $_stock_id) = @_ } -sub drag_source_set_target_list { my ($_widget, $_target_list) = @_ } -sub drag_source_unset { my ($_widget) = @_ } -sub drag_unhighlight { my ($_widget) = @_ } -sub drawable { my ($_widget, @_more_paras) = @_ } -sub ensure_style { my ($_widget) = @_ } -sub event { my ($_widget, $_event) = @_ } -sub flags { my ($_widget) = @_ } -sub freeze_child_notify { my ($_widget) = @_ } -sub get_accessible { my ($_widget) = @_ } -sub get_ancestor { my ($_widget, $_ancestor_package) = @_ } -sub get_child_requisition { my ($_widget) = @_ } -sub get_child_visible { my ($_widget) = @_ } -sub get_clipboard { my ($_widget, $_o_selection) = @_ } -sub get_colormap { my ($_widget) = @_ } -sub get_composite_name { my ($_widget) = @_ } -sub get_default_colormap { my ($_class_or_widget) = @_ } -sub get_default_direction { my ($_class) = @_ } -sub get_default_style { my ($_class_or_widget) = @_ } -sub get_default_visual { my ($_class_or_widget) = @_ } -sub get_direction { my ($_widget) = @_ } -sub get_display { my ($_widget) = @_ } -sub get_events { my ($_widget) = @_ } -sub get_extension_events { my ($_widget) = @_ } -sub get_flags { my ($_widget) = @_ } -sub get_modifier_style { my ($_widget) = @_ } -sub get_name { my ($_widget) = @_ } -sub get_no_show_all { my ($_widget) = @_ } -sub get_pango_context { my ($_widget) = @_ } -sub get_parent { my ($_widget) = @_ } -sub get_parent_window { my ($_widget) = @_ } -sub get_pointer { my ($_widget) = @_ } -sub get_root_window { my ($_widget) = @_ } -sub get_screen { my ($_widget) = @_ } -sub get_settings { my ($_widget) = @_ } -sub get_size_request { my ($_widget) = @_ } -sub get_style { my ($_widget) = @_ } -sub get_toplevel { my ($_widget) = @_ } -sub get_visual { my ($_widget) = @_ } -sub grab_default { my ($_widget) = @_ } -sub grab_focus { my ($_widget) = @_ } -sub has_default { my ($_widget, @_more_paras) = @_ } -sub has_focus { my ($_widget, @_more_paras) = @_ } -sub has_grab { my ($_widget, @_more_paras) = @_ } -sub has_screen { my ($_widget) = @_ } -sub hide { my ($_widget) = @_ } -sub hide_all { my ($_widget) = @_ } -sub intersect { my ($_widget, $_area) = @_ } -sub is_ancestor { my ($_widget, $_ancestor) = @_ } -sub is_focus { my ($_widget) = @_ } -sub is_sensitive { my ($_widget, @_more_paras) = @_ } -sub list_mnemonic_labels { my ($_widget) = @_ } -sub map { my ($_widget) = @_ } -sub mapped { my ($_widget, @_more_paras) = @_ } -sub mnemonic_activate { my ($_widget, $_group_cycling) = @_ } -sub modify_base { my ($_widget, $_state, $_color) = @_ } -sub modify_bg { my ($_widget, $_state, $_color) = @_ } -sub modify_fg { my ($_widget, $_state, $_color) = @_ } -sub modify_font { my ($_widget, $_font_desc) = @_ } -sub modify_style { my ($_widget, $_style) = @_ } -sub modify_text { my ($_widget, $_state, $_color) = @_ } -sub no_window { my ($_widget, @_more_paras) = @_ } -sub parent { my ($_widget) = @_ } -sub parent_sensitive { my ($_widget, @_more_paras) = @_ } -sub path { my ($_widget) = @_ } -sub pop_colormap { my ($_class_or_widget) = @_ } -sub pop_composite_child { my ($_o_class_or_widget) = @_ } -sub propagate_event { my ($_widget, $_event) = @_ } -sub push_colormap { my ($_class_or_widget, $_cmap) = @_ } -sub push_composite_child { my ($_o_class_or_widget) = @_ } -sub queue_draw { my ($_widget) = @_ } -sub queue_draw_area { my ($_widget, $_x, $_y, $_width, $_height) = @_ } -sub queue_resize { my ($_widget) = @_ } -sub queue_resize_no_redraw { my ($_widget) = @_ } -sub rc_style { my ($_widget, @_more_paras) = @_ } -sub realize { my ($_widget) = @_ } -sub realized { my ($_widget, @_more_paras) = @_ } -sub receives_default { my ($_widget, @_more_paras) = @_ } -sub region_intersect { my ($_widget, $_region) = @_ } -sub remove_accelerator { my ($_widget, $_accel_group, $_accel_key, $_accel_mods) = @_ } -sub remove_mnemonic_label { my ($_widget, $_label) = @_ } -sub render_icon { my ($_widget, $_stock_id, $_size, $_o_detail) = @_ } -sub reparent { my ($_widget, $_new_parent) = @_ } -sub requisition { my ($_widget) = @_ } -sub reset_rc_styles { my ($_widget) = @_ } -sub reset_shapes { my ($_widget) = @_ } -sub saved_state { my ($_widget) = @_ } -sub selection_add_target { my ($_widget, $_selection, $_target, $_info) = @_ } -sub selection_add_targets { my ($_widget, $_selection, @_more_paras) = @_ } -sub selection_clear_targets { my ($_widget, $_selection) = @_ } -sub selection_convert { my ($_widget, $_selection, $_target, $_time_) = @_ } -sub selection_remove_all { my ($_widget) = @_ } -sub sensitive { my ($_widget, @_more_paras) = @_ } -sub set_accel_path { my ($_widget, $_accel_path, $_accel_group) = @_ } -sub set_app_paintable { my ($_widget, $_app_paintable) = @_ } -sub set_child_visible { my ($_widget, $_is_visible) = @_ } -sub set_colormap { my ($_widget, $_colormap) = @_ } -sub set_composite_name { my ($_widget, $_name) = @_ } -sub set_default_colormap { my ($_class_or_widget, $_colormap) = @_ } -sub set_default_direction { my ($_class, $_dir) = @_ } -sub set_direction { my ($_widget, $_dir) = @_ } -sub set_double_buffered { my ($_widget, $_double_buffered) = @_ } -sub set_events { my ($_widget, $_events) = @_ } -sub set_extension_events { my ($_widget, $_mode) = @_ } -sub set_flags { my ($_widget, $_flags) = @_ } -sub set_name { my ($_widget, $_name) = @_ } -sub set_no_show_all { my ($_widget, $_no_show_all) = @_ } -sub set_parent { my ($_widget, $_parent) = @_ } -sub set_parent_window { my ($_widget, $_parent_window) = @_ } -sub set_redraw_on_allocate { my ($_widget, $_redraw_on_allocate) = @_ } -sub set_scroll_adjustments { my ($_widget, $_hadjustment, $_vadjustment) = @_ } -sub set_sensitive { my ($_widget, $_sensitive) = @_ } -sub set_size_request { my ($_widget, $_o_width, $_o_height) = @_ } -sub set_state { my ($_widget, $_state) = @_ } -sub set_style { my ($_widget, $_style) = @_ } -sub shape_combine_mask { my ($_widget, $_shape_mask, $_offset_x, $_offset_y) = @_ } -sub show { my ($_widget) = @_ } -sub show_all { my ($_widget) = @_ } -sub show_now { my ($_widget) = @_ } -sub size_allocate { my ($_widget, $_allocation) = @_ } -sub size_request { my ($_widget) = @_ } -sub state { my ($_widget) = @_ } -sub style { my ($_widget) = @_ } -sub style_get { my ($_widget, $_first_property_name, @_more_paras) = @_ } -sub style_get_property { my ($_widget, $_first_property_name, @_more_paras) = @_ } -sub thaw_child_notify { my ($_widget) = @_ } -sub toplevel { my ($_widget, @_more_paras) = @_ } -sub translate_coordinates { my ($_src_widget, $_dest_widget, $_src_x, $_src_y) = @_ } -sub unmap { my ($_widget) = @_ } -sub unparent { my ($_widget) = @_ } -sub unrealize { my ($_widget) = @_ } -sub unset_flags { my ($_widget, $_flags) = @_ } -sub visible { my ($_widget, @_more_paras) = @_ } -sub window { my ($_widget, $_o_new) = @_ } - -package Gtk2::Window; -our @ISA = qw(); -sub activate_default { my ($_window) = @_ } -sub activate_focus { my ($_window) = @_ } -sub activate_key { my ($_window, $_event) = @_ } -sub add_accel_group { my ($_window, $_accel_group) = @_ } -sub add_embedded_xid { my ($_window, $_xid) = @_ } -sub add_mnemonic { my ($_window, $_keyval, $_target) = @_ } -sub begin_move_drag { my ($_window, $_button, $_root_x, $_root_y, $_timestamp) = @_ } -sub begin_resize_drag { my ($_window, $_edge, $_button, $_root_x, $_root_y, $_timestamp) = @_ } -sub deiconify { my ($_window) = @_ } -sub fullscreen { my ($_window) = @_ } -sub get_accept_focus { my ($_window) = @_ } -sub get_decorated { my ($_window) = @_ } -sub get_default_icon_list { my ($_class) = @_ } -sub get_default_size { my ($_window) = @_ } -sub get_destroy_with_parent { my ($_window) = @_ } -sub get_focus { my ($_window) = @_ } -sub get_focus_on_map { my ($_window) = @_ } -sub get_frame_dimensions { my ($_window) = @_ } -sub get_gravity { my ($_window) = @_ } -sub get_has_frame { my ($_window) = @_ } -sub get_icon { my ($_window) = @_ } -sub get_icon_list { my ($_window) = @_ } -sub get_icon_name { my ($_window) = @_ } -sub get_mnemonic_modifier { my ($_window) = @_ } -sub get_modal { my ($_window) = @_ } -sub get_position { my ($_window) = @_ } -sub get_resizable { my ($_window) = @_ } -sub get_role { my ($_window) = @_ } -sub get_screen { my ($_window) = @_ } -sub get_size { my ($_window) = @_ } -sub get_skip_pager_hint { my ($_window) = @_ } -sub get_skip_taskbar_hint { my ($_window) = @_ } -sub get_title { my ($_window) = @_ } -sub get_transient_for { my ($_window) = @_ } -sub get_type_hint { my ($_window) = @_ } -sub get_urgency_hint { my ($_window) = @_ } -sub has_toplevel_focus { my ($_window) = @_ } -sub iconify { my ($_window) = @_ } -sub is_active { my ($_window) = @_ } -sub list_toplevels { my ($_class) = @_ } -sub maximize { my ($_window) = @_ } -sub mnemonic_activate { my ($_window, $_keyval, $_modifier) = @_ } -sub move { my ($_window, $_x, $_y) = @_ } -sub new { my ($_class, $_o_type) = @_ } -sub parse_geometry { my ($_window, $_geometry) = @_ } -sub present { my ($_window) = @_ } -sub present_with_time { my ($_window, $_timestamp) = @_ } -sub propagate_key_event { my ($_window, $_event) = @_ } -sub remove_accel_group { my ($_window, $_accel_group) = @_ } -sub remove_embedded_xid { my ($_window, $_xid) = @_ } -sub remove_mnemonic { my ($_window, $_keyval, $_target) = @_ } -sub reshow_with_initial_size { my ($_window) = @_ } -sub resize { my ($_window, $_width, $_height) = @_ } -sub set_accept_focus { my ($_window, $_setting) = @_ } -sub set_auto_startup_notification { my ($_class, $_setting) = @_ } -sub set_decorated { my ($_window, $_setting) = @_ } -sub set_default { my ($_window, $_default_widget) = @_ } -sub set_default_icon { my ($_class, $_icon) = @_ } -sub set_default_icon_from_file { my ($_class_or_instance, $_filename) = @_ } -sub set_default_icon_list { my ($_class, $_pixbuf, @_more_paras) = @_ } -sub set_default_icon_name { my ($_class, $_name) = @_ } -sub set_default_size { my ($_window, $_width, $_height) = @_ } -sub set_destroy_with_parent { my ($_window, $_setting) = @_ } -sub set_focus { my ($_window, $_o_focus) = @_ } -sub set_focus_on_map { my ($_window, $_setting) = @_ } -sub set_frame_dimensions { my ($_window, $_left, $_top, $_right, $_bottom) = @_ } -sub set_geometry_hints { my ($_window, $_geometry_widget, $_geometry_ref, $_o_geom_mask_sv) = @_ } -sub set_gravity { my ($_window, $_gravity) = @_ } -sub set_has_frame { my ($_window, $_setting) = @_ } -sub set_icon { my ($_window, $_icon) = @_ } -sub set_icon_from_file { my ($_window, $_filename) = @_ } -sub set_icon_list { my ($_window, @_more_paras) = @_ } -sub set_icon_name { my ($_window, $_name) = @_ } -sub set_keep_above { my ($_window, $_setting) = @_ } -sub set_keep_below { my ($_window, $_setting) = @_ } -sub set_mnemonic_modifier { my ($_window, $_modifier) = @_ } -sub set_modal { my ($_window, $_modal) = @_ } -sub set_position { my ($_window, $_position) = @_ } -sub set_resizable { my ($_window, $_resizable) = @_ } -sub set_role { my ($_window, $_role) = @_ } -sub set_screen { my ($_window, $_screen) = @_ } -sub set_skip_pager_hint { my ($_window, $_setting) = @_ } -sub set_skip_taskbar_hint { my ($_window, $_setting) = @_ } -sub set_title { my ($_window, $_o_title) = @_ } -sub set_transient_for { my ($_window, $_parent) = @_ } -sub set_type_hint { my ($_window, $_hint) = @_ } -sub set_urgency_hint { my ($_window, $_setting) = @_ } -sub set_wmclass { my ($_window, $_wmclass_name, $_wmclass_class) = @_ } -sub stick { my ($_window) = @_ } -sub unfullscreen { my ($_window) = @_ } -sub unmaximize { my ($_window) = @_ } -sub unstick { my ($_window) = @_ } - -package Gtk2::WindowGroup; -our @ISA = qw(); -sub add_window { my ($_window_group, $_window) = @_ } -sub new { my ($_class) = @_ } -sub remove_window { my ($_window_group, $_window) = @_ } diff --git a/perl_checker_fake_packages/MDV/Distribconf.pm b/perl_checker_fake_packages/MDV/Distribconf.pm deleted file mode 100644 index abd441a..0000000 --- a/perl_checker_fake_packages/MDV/Distribconf.pm +++ /dev/null @@ -1,17 +0,0 @@ -package MDV::Distribconf; - -sub new { - my ($_class, $_path, $_mediacfg_version) = @_; -} - -sub parse_mediacfg { - my ($_distrib, $_mediacfg) = @_; -} - -sub getvalue { - my ($_distrib, $_media, $_var) = @_; -} - -sub listmedia { - my ($_distrib) = @_; -} diff --git a/perl_checker_fake_packages/Net/DNS.pm b/perl_checker_fake_packages/Net/DNS.pm deleted file mode 100644 index e300f12..0000000 --- a/perl_checker_fake_packages/Net/DNS.pm +++ /dev/null @@ -1,7 +0,0 @@ -package Net::DNS; - -package Net::DNS::Resolver; - -sub new {} -sub query {} -sub answer {} diff --git a/perl_checker_fake_packages/Net/FTP.pm b/perl_checker_fake_packages/Net/FTP.pm deleted file mode 100644 index e01695f..0000000 --- a/perl_checker_fake_packages/Net/FTP.pm +++ /dev/null @@ -1,9 +0,0 @@ -package Net::FTP; - -sub new {} - -sub login {} -sub binary {} -sub cwd {} -sub retr {} -sub code {} diff --git a/perl_checker_fake_packages/Net/Ping.pm b/perl_checker_fake_packages/Net/Ping.pm deleted file mode 100644 index 1a8f8a9..0000000 --- a/perl_checker_fake_packages/Net/Ping.pm +++ /dev/null @@ -1,9 +0,0 @@ -package Net::Ping; - -sub new { - my ($_class, @_l) = @_; -} - -sub ping { - my ($_class, $_host, $_o_timeout) = @_; -} diff --git a/perl_checker_fake_packages/URPM/Resolve.pm b/perl_checker_fake_packages/URPM/Resolve.pm deleted file mode 100644 index 55eadfb..0000000 --- a/perl_checker_fake_packages/URPM/Resolve.pm +++ /dev/null @@ -1,17 +0,0 @@ -package URPM::Resolve; - -our @ISA = qw(); - -sub resolve_requested { - my ($_urpm, $_db, $_state, $_requested, %_options) = @_; -} -sub request_packages_to_upgrade { - my ($_urpm, $_db, $_state, $_requested, %_options) = @_; -} - -sub disable_selected { - my ($_urpm, $_db, $_state, @_closure) = @_; -} -sub compute_installed_flags { - my ($_urpm, $_db) = @_; -} diff --git a/perl_checker_fake_packages/gen.pl b/perl_checker_fake_packages/gen.pl deleted file mode 100755 index 6ca4c21..0000000 --- a/perl_checker_fake_packages/gen.pl +++ /dev/null @@ -1,108 +0,0 @@ -#!/usr/bin/perl -w - -use strict; -use MDK::Common; - -my ($current_package, $current_prefix, $current_name); - -my %l; -sub get_paras { - my ($name, $para) = @_; - $name =~ s/\Q$current_prefix//; - $current_name = $name; - $l{$current_package}{$name} = [ map { - if (/\Q.../) { - '@_more_paras'; - } else { - my ($optional) = s/=(.*)//; - my $s = /.*\W(\w+)/ ? $1 : $_; - '$_' . ($optional ? 'o_' : '') . $s; - } - } grep { !/OUTLIST/ } split(',', $para) ]; -} - -sub parse_xs { - my ($file) = @_; - warn "parse_xs $file\n"; - my $state = 'waiting_for_type'; - ($current_package, $current_prefix) = ('', ''); - my $multi_line; - my $c; - foreach (cat_($file)) { - $c++; - next if /^=/ ... /^=cut/; - chomp; - my $orig_line = $_; - - if (/^\s*#/ || (m!^\s*/\*! .. m!\*/!)) { - # forget it - } elsif ($state eq 'multi_line') { - if (/(.*)\)/) { - get_paras($current_name, $multi_line . $1); - $state = 'waiting_for_end'; - } else { - $multi_line .= $_; - } -# } elsif (/^\s*gperl_set_isa\s*\("(.*)", ".*"\)\s*;/) { - } elsif (/MODULE\s*=\s*\S+\s+PACKAGE\s*=\s*(\S+)\s+PREFIX\s*=\s*(\S+)/) { - ($current_package, $current_prefix) = ($1, $2); - } elsif (/MODULE\s*=\s*\S+\s+PACKAGE\s*=\s*(\S+)/) { - ($current_package, $current_prefix) = ($1, ''); - } elsif (!$current_package) { - # waiting for the MODULE line - } elsif (/^\s*$/) { - $state = 'waiting_for_type'; - } elsif (/^\w[^\(]*$/ && $state eq 'waiting_for_type') { - $state = 'waiting_for_function' if !/^BOOT:/ && !/;/; - } elsif (/^\s*ALIAS:\s*$/) { - $state = 'alias'; - } elsif ($state eq 'alias') { - if (my ($f) = /^\s*(\S+)\s*=\s*\d+\s*$/) { - my $pkg = $f =~ s/(.*)::// ? $1 : $current_package; - $l{$pkg}{$f} ||= $l{$current_package}{$current_name}; - } else { - warn "bad line #$c $orig_line (state: $state)\n" if !/^\s*\w+:\s*$/ && !/^\s*$/; - $state = 'waiting_for_end'; - } - } elsif ($state eq 'waiting_for_type' && s/^(const\s*)?\w+\s*(\*\s*)?// || - $state eq 'waiting_for_function' && /^\w+/) { - if (my ($name, $para) = /^(\S+)\s*\((.*)\)\s*;?\s*$/) { - get_paras($name, $para); - $state = 'waiting_for_end'; - } elsif (($name, $para) = /^(\S+)\s*\((.*)$/) { - $multi_line = $para; - $current_name = $name; - $state = 'multi_line'; - } else { - warn "bad line #$c $orig_line (state: $state)\n"; - } - } else { - warn "bad line #$c $orig_line (state: $state)\n" if - !(($state eq 'waiting_for_end' || $state eq 'waiting_for_type') && - (/^\s/ || /^[{}]\s*$/ || /^(CODE|OUTPUT):\s*$/)); - } - } -} - - -my ($pkg_name, $dir) = @ARGV; -my @xs_files = chomp_(`find $dir -name "*.xs"`); -@ARGV == 2 && @xs_files or die "usage: gen.pl \n"; - -parse_xs($_) foreach @xs_files; - -print "package $pkg_name;\nuse Glib;\n" if $pkg_name eq 'Gtk2'; - -foreach my $pkg (sort keys %l) { - print "\npackage $pkg;\n"; - print "our \@ISA = qw();\n"; - foreach my $name (sort keys %{$l{$pkg}}) { - my $para = $l{$pkg}{$name}; - $name = $pkg . '::' . $name if $name =~ /^(eq|foreach|format|ge|length|sub|x|xor|y)$/; - if (@$para) { - print "sub $name { my (", join(", ", @$para), ") = \@_ }\n"; - } else { - print "sub $name() {}\n"; - } - } -} diff --git a/perl_checker_fake_packages/packdrake.pm b/perl_checker_fake_packages/packdrake.pm deleted file mode 100644 index faebf19..0000000 --- a/perl_checker_fake_packages/packdrake.pm +++ /dev/null @@ -1,25 +0,0 @@ -package packdrake; - -sub new { - my ($_class, $_file, %_options) = @_; -} - -sub extract_archive { - my ($_pack, $_dir, @_files) = @_; -} - -sub extract_all_archive { - my ($_pack, $_dir) = @_; -} - -sub list_archive { - my (@_files) = @_; -} - -sub build_archive { - my ($_listh, $_dir, $_archive, $_size, $_compress, $_uncompress) = @_; -} - -sub cat_archive { - my (@_files) = @_; -} diff --git a/perl_checker_fake_packages/urpm.pm b/perl_checker_fake_packages/urpm.pm deleted file mode 100644 index 0fc3515..0000000 --- a/perl_checker_fake_packages/urpm.pm +++ /dev/null @@ -1,9 +0,0 @@ -package urpm; - -sub new { - my ($_class) = @_; -} - -sub read_config { - my ($_urpm, %_options) = @_; -} diff --git a/src/.cvsignore b/src/.cvsignore new file mode 100644 index 0000000..8c0f1f4 --- /dev/null +++ b/src/.cvsignore @@ -0,0 +1,15 @@ +._bcdi +._d +._ncdi +*.cmi +*.cmo +*.cmx +perl_checker +perl_checker.html +perl_checker_debug +gmon.out +lexer.ml +parser.ml +parser.mli +parser.output +build.ml diff --git a/src/Makefile b/src/Makefile new file mode 100644 index 0000000..22a45a6 --- /dev/null +++ b/src/Makefile @@ -0,0 +1,34 @@ +# OCAMLC = ocamlcp -p a +OCAMLBCFLAGS = -w A -w e +YFLAGS = -v +TRASH = parser.output perl_checker.html TAGS +RESULT = perl_checker +BCSUFFIX = _debug +SOURCES = types.mli build.ml common.ml flags.ml config_file.ml info.ml parser_helper.ml parser.mly lexer.mll tree.ml global_checks.ml perl_checker.ml +LIBS = unix +VENDORLIB = $(shell dirname `pwd`) +DEBUG = 1 + +default: TAGS build_ml build.ml debug-code native-code perl_checker.html + +build_ml: + rm -f build.ml + $(MAKE) build.ml + +build.ml: + date '+let date = "%s"' > $@ + echo 'let fake_packages_dir = "'$(VENDORLIB)'/perl_checker_fake_packages"' >> $@ + echo 'let debugging = $(DEBUG) > 0' >> $@ + +%.html: %.html.pl + rm -f $@ + perl $< > $@ + chmod a-w $@ + +tags: + ocamltags *.ml + +TAGS: + ocamltags *.ml + +-include OCamlMakefile diff --git a/src/OCamlMakefile b/src/OCamlMakefile new file mode 100644 index 0000000..95df83f --- /dev/null +++ b/src/OCamlMakefile @@ -0,0 +1,912 @@ +########################################################################### +# OCamlMakefile +# Copyright (C) 1999-2002 Markus Mottl +# +# For updates see: +# http://www.oefai.at/~markus/ocaml_sources +# +# $Id$ +# +########################################################################### + +# Set these variables to the names of the sources to be processed and +# the result variable. Order matters during linkage! + +ifndef SOURCES + SOURCES := foo.ml +endif +export SOURCES + +ifndef RES_CLIB_SUF + RES_CLIB_SUF := _stubs +endif +export RES_CLIB_SUF + +ifndef RESULT + RESULT := foo +endif +export RESULT + +ifndef DOC_FILES + DOC_FILES := $(filter %.mli, $(SOURCES)) +endif +export DOC_FILES + +export BCSUFFIX +export NCSUFFIX + +ifndef TOPSUFFIX + TOPSUFFIX := .top +endif + +export TOPSUFFIX + +# Eventually set include- and library-paths, libraries to link, +# additional compilation-, link- and ocamlyacc-flags +# Path- and library information needs not be written with "-I" and such... +# Define THREADS if you need it, otherwise leave it unset (same for +# USE_CAMLP4)! + +export THREADS +export USE_CAMLP4 + +export INCDIRS +export LIBDIRS +export EXTLIBDIRS +export OCAML_DEFAULT_DIRS +export OCAML_LIB_INSTALL + +export LIBS +export CLIBS + +export OCAMLFLAGS +export OCAMLNCFLAGS +export OCAMLBCFLAGS + +export OCAMLLDFLAGS +export OCAMLNLDFLAGS +export OCAMLBLDFLAGS + +ifndef OCAMLCPFLAGS + OCAMLCPFLAGS := a +endif + +export OCAMLCPFLAGS + +export YFLAGS +export IDLFLAGS + +export OCAMLDOCFLAGS + +export DVIPSFLAGS + +export STATIC + +# Add a list of optional trash files that should be deleted by "make clean" +export TRASH + +#################### variables depending on your OCaml-installation + +ifdef MINGW + export MINGW + WIN32 := 1 +endif +ifdef MSVC + export MSVC + WIN32 := 1 + EXT_OBJ := obj + EXT_LIB := lib + ifeq ($(CC),gcc) + # work around GNU Make default value + ifdef THREADS + CC := cl /MT + else + CC := cl + endif + endif + ifeq ($(CXX),g++) + # work around GNU Make default value + CXX := $(CC) + endif + CFLAG_O := -Fo +endif +ifdef WIN32 + EXT_CXX := cpp + EXE := .exe +endif + +ifndef EXT_OBJ + EXT_OBJ := o +endif +ifndef EXT_LIB + EXT_LIB := a +endif +ifndef EXT_CXX + EXT_CXX := cc +endif +ifndef EXE + EXE := # empty +endif +ifndef CFLAG_O + CFLAG_O := -o # do not delete this comment (preserves trailing whitespace)! +endif + +export CC +export CXX +export CFLAGS +export CXXFLAGS +export LDFLAGS + +BCRESULT := $(addsuffix $(BCSUFFIX), $(RESULT)) +NCRESULT := $(addsuffix $(NCSUFFIX), $(RESULT)) +TOPRESULT := $(addsuffix $(TOPSUFFIX), $(RESULT)) + +ifndef OCAMLC + OCAMLC := ocamlc +endif + +export OCAMLC + +ifndef OCAMLOPT + OCAMLOPT := ocamlopt +endif + +export OCAMLOPT + +ifndef OCAMLMKTOP + OCAMLMKTOP := ocamlmktop +endif + +export OCAMLMKTOP + +ifndef OCAMLCP + OCAMLCP := ocamlcp +endif + +export OCAMLCP + +ifndef OCAMLDEP + OCAMLDEP := ocamldep +endif + +export OCAMLDEP + +ifndef OCAMLLEX + OCAMLLEX := ocamllex +endif + +export OCAMLLEX + +ifndef OCAMLYACC + OCAMLYACC := ocamlyacc +endif + +export OCAMLYACC + +ifndef CAMELEON_REPORT + CAMELEON_REPORT := report +endif + +ifndef CAMELEON_REPORT_FLAGS + CAMELEON_REPORT_FLAGS := +endif + +ifndef CAMELEON_ZOGGY + CAMELEON_ZOGGY := camlp4o pa_zog.cma pr_o.cmo +endif + +ifndef CAMELEON_ZOGGY_FLAGS + CAMELEON_ZOGGY_FLAGS := +endif + +ifndef CAMLIDL + CAMLIDL := camlidl +endif + +export CAMLIDL + +ifndef CAMLIDLDLL + CAMLIDLDLL := camlidldll +endif + +export CAMLIDLDLL + +ifndef NOIDLHEADER + MAYBE_IDL_HEADER := -header +endif + +export NOIDLHEADER + +ifndef CAMLP4 + CAMLP4 := camlp4 +endif + +export CAMLP4 + +ifndef OCAMLDOC + OCAMLDOC := ocamldoc +endif + +export OCAMLDOC + +ifndef LATEX + LATEX := latex +endif + +export LATEX + +ifndef DVIPS + DVIPS := dvips +endif + +export DVIPS + +ifndef PS2PDF + PS2PDF := ps2pdf +endif + +export PS2PDF + +ifndef OCAMLMAKEFILE + OCAMLMAKEFILE := OCamlMakefile +endif + +export OCAMLMAKEFILE + +ifndef OCAMLLIBPATH + OCAMLLIBPATH := \ + $(shell $(OCAMLC) 2>/dev/null -where || echo /usr/local/lib/ocaml) +endif + +export OCAMLLIBPATH + +ifndef OCAML_LIB_INSTALL + OCAML_LIB_INSTALL := $(OCAMLLIBPATH)/contrib +endif + +export OCAML_LIB_INSTALL + +########################################################################### + +#################### change following sections only if +#################### you know what you are doing! + +# delete target files when a build command fails +.PHONY: .DELETE_ON_ERROR +.DELETE_ON_ERROR: + +# for pedants using "--warn-undefined-variables" +export MAYBE_IDL +export REAL_RESULT +export CAMLIDLFLAGS +export THREAD_FLAG +export RES_CLIB +export MAKEDLL + +SHELL := /bin/sh + +MLDEPDIR := ._d +BCDIDIR := ._bcdi +NCDIDIR := ._ncdi + +FILTER_EXTNS := %.mli %.ml %.mll %.mly %.idl %.c %.$(EXT_CXX) %.rep %.zog + +FILTERED := $(filter $(FILTER_EXTNS), $(SOURCES)) +SOURCE_DIRS := $(filter-out ./, $(sort $(dir $(FILTERED)))) + +FILTERED_REP := $(filter %.rep, $(FILTERED)) +DEP_REP := $(FILTERED_REP:%.rep=$(MLDEPDIR)/%.d) +AUTO_REP := $(FILTERED_REP:.rep=.ml) + +FILTERED_ZOG := $(filter %.zog, $(FILTERED)) +DEP_ZOG := $(FILTERED_ZOG:%.zog=$(MLDEPDIR)/%.d) +AUTO_ZOG := $(FILTERED_ZOG:.zog=.ml) + +FILTERED_ML := $(filter %.ml, $(FILTERED)) +DEP_ML := $(FILTERED_ML:%.ml=$(MLDEPDIR)/%.d) + +FILTERED_MLI := $(filter %.mli, $(FILTERED)) +DEP_MLI := $(FILTERED_MLI:.mli=.di) + +FILTERED_MLL := $(filter %.mll, $(FILTERED)) +DEP_MLL := $(FILTERED_MLL:%.mll=$(MLDEPDIR)/%.d) +AUTO_MLL := $(FILTERED_MLL:.mll=.ml) + +FILTERED_MLY := $(filter %.mly, $(FILTERED)) +DEP_MLY := $(FILTERED_MLY:%.mly=$(MLDEPDIR)/%.d) $(FILTERED_MLY:.mly=.di) +AUTO_MLY := $(FILTERED_MLY:.mly=.mli) $(FILTERED_MLY:.mly=.ml) + +FILTERED_IDL := $(filter %.idl, $(FILTERED)) +DEP_IDL := $(FILTERED_IDL:%.idl=$(MLDEPDIR)/%.d) $(FILTERED_IDL:.idl=.di) +C_IDL := $(FILTERED_IDL:%.idl=%_stubs.c) $(FILTERED_IDL:.idl=.h) +OBJ_C_IDL := $(FILTERED_IDL:%.idl=%_stubs.$(EXT_OBJ)) +AUTO_IDL := $(FILTERED_IDL:.idl=.mli) $(FILTERED_IDL:.idl=.ml) $(C_IDL) + +FILTERED_C_CXX := $(filter %.c %.$(EXT_CXX), $(FILTERED)) +OBJ_C_CXX := $(FILTERED_C_CXX:.c=.$(EXT_OBJ)) +OBJ_C_CXX := $(OBJ_C_CXX:.$(EXT_CXX)=.$(EXT_OBJ)) + +PRE_TARGETS += $(AUTO_MLL) $(AUTO_MLY) $(AUTO_IDL) $(AUTO_ZOG) $(AUTO_REP) + +ALL_DEPS := $(DEP_ML) $(DEP_MLI) $(DEP_MLL) $(DEP_MLY) $(DEP_IDL) $(DEP_ZOG) $(DEP_REP) + +MLDEPS := $(filter %.d, $(ALL_DEPS)) +MLIDEPS := $(filter %.di, $(ALL_DEPS)) +BCDEPIS := $(MLIDEPS:%.di=$(BCDIDIR)/%.di) +NCDEPIS := $(MLIDEPS:%.di=$(NCDIDIR)/%.di) + +ALLML := $(filter %.mli %.ml %.mll %.mly %.idl %.rep %.zog, $(FILTERED)) + +IMPLO_INTF := $(ALLML:%.mli=%.mli.__) +IMPLO_INTF := $(foreach file, $(IMPLO_INTF), \ + $(basename $(file)).cmi $(basename $(file)).cmo) +IMPLO_INTF := $(filter-out %.mli.cmo, $(IMPLO_INTF)) +IMPLO_INTF := $(IMPLO_INTF:%.mli.cmi=%.cmi) + +IMPLX_INTF := $(IMPLO_INTF:.cmo=.cmx) + +INTF := $(filter %.cmi, $(IMPLO_INTF)) +IMPL_CMO := $(filter %.cmo, $(IMPLO_INTF)) +IMPL_CMX := $(IMPL_CMO:.cmo=.cmx) + +OBJ_LINK := $(OBJ_C_IDL) $(OBJ_C_CXX) +OBJ_FILES := $(IMPL_CMO:.cmo=.$(EXT_OBJ)) $(OBJ_LINK) + +EXECS := $(addsuffix $(EXE), \ + $(sort $(TOPRESULT) $(BCRESULT) $(NCRESULT))) +ifdef WIN32 + EXECS += $(BCRESULT).dll $(NCRESULT).dll +endif + +CLIB_BASE := $(RESULT)$(RES_CLIB_SUF) +ifneq ($(strip $(OBJ_LINK)),) + RES_CLIB := lib$(CLIB_BASE).$(EXT_LIB) +endif + +ifndef MSVC +DLLSONAME := dll$(CLIB_BASE).so +endif + +NONEXECS := $(INTF) $(IMPL_CMO) $(IMPL_CMX) $(OBJ_FILES) $(PRE_TARGETS) \ + $(BCRESULT).cma $(NCRESULT).cmxa $(NCRESULT).$(EXT_LIB) \ + $(BCRESULT).cmi $(BCRESULT).cmo \ + $(NCRESULT).cmi $(NCRESULT).cmx $(NCRESULT).o \ + $(RES_CLIB) + +ifndef MSVC + NONEXECS += $(DLLSONAME) +endif + +ifndef LIBINSTALL_FILES + LIBINSTALL_FILES := $(RESULT).mli $(RESULT).cmi $(RESULT).cma \ + $(RESULT).cmxa $(RESULT).a $(RES_CLIB) +endif + +ifndef MSVC + LIBINSTALL_FILES += $(DLLSONAME) +endif + +export LIBINSTALL_FILES + +ifdef WIN32 + # some extra stuff is created while linking DLLs + NONEXECS += $(BCRESULT).$(EXT_LIB) $(BCRESULT).exp $(NCRESULT).exp +endif + +TARGETS := $(EXECS) $(NONEXECS) + +# handle ocamlfind +ifdef USING_OCAMLFIND + PACKOPT := -pack +else + PACKOPT := -passopt "-pack" +endif + +# If there are IDL-files +ifneq ($(strip $(FILTERED_IDL)),) + MAYBE_IDL := -cclib -lcamlidl +endif + +ifdef USE_CAMLP4 + CAMLP4PATH := \ + $(shell $(CAMLP4) -where 2>/dev/null || echo /usr/local/lib/camlp4) + INCFLAGS := -I $(CAMLP4PATH) + CINCFLAGS := -I$(CAMLP4PATH) +endif + +INCFLAGS += $(SOURCE_DIRS:%=-I %) $(INCDIRS:%=-I %) $(OCAML_DEFAULT_DIRS:%=-I %) +CINCFLAGS += $(SOURCE_DIRS:%=-I%) $(INCDIRS:%=-I%) $(OCAML_DEFAULT_DIRS:%=-I%) +CLIBFLAGS += $(SOURCE_DIRS:%=-L%) $(LIBDIRS:%=-L%) \ + $(EXTLIBDIRS:%=-L%) $(EXTLIBDIRS:%=-R%) \ + $(OCAML_DEFAULT_DIRS:%=-L%) + +ifndef PROFILING + INTF_OCAMLC := $(OCAMLC) +else + ifndef THREADS + INTF_OCAMLC := $(OCAMLCP) -p $(OCAMLCPFLAGS) + else + # OCaml does not support profiling byte code + # with threads (yet), therefore we force an error. + ifndef REAL_OCAMLC + $(error Profiling of multithreaded byte code not yet supported by OCaml) + endif + endif +endif + +ifndef MSVC + COMMON_LDFLAGS := $(LDFLAGS:%=-ccopt %) $(SOURCE_DIRS:%=-ccopt -L%) \ + $(LIBDIRS:%=-ccopt -L%) \ + $(EXTLIBDIRS:%=-ccopt -L%) $(EXTLIBDIRS:%=-ccopt -R%) \ + $(OCAML_DEFAULT_DIRS:%=-ccopt -L%) +else + # currenly MSVC-build ocamlc/ocamlopt cannot pass any option to C linker :-( + COMMON_LDFLAGS := +endif + +ifndef MSVC + CLIBS_OPTS := $(CLIBS:%=-cclib -l%) +else + # MSVC libraries do not have 'lib' prefix + CLIBS_OPTS := $(CLIBS:%=-ccopt %) +endif +ifneq ($(strip $(OBJ_LINK)),) + ifdef CREATE_LIB + OBJS_LIBS := -cclib -l$(CLIB_BASE) $(CLIBS_OPTS) $(MAYBE_IDL) + else + OBJS_LIBS := $(OBJ_LINK) $(CLIBS_OPTS) $(MAYBE_IDL) + endif +else + OBJS_LIBS := $(CLIBS_OPTS) $(MAYBE_IDL) +endif + +# If we have to make byte-code +ifndef REAL_OCAMLC + # EXTRADEPS is added dependencies we have to insert for all + # executable files we generate. Ideally it should be all of the + # libraries we use, but it's hard to find the ones that get searched on + # the path since I don't know the paths built into the compiler, so + # just include the ones with slashes in their names. + EXTRADEPS := $(addsuffix .cma,$(foreach i,$(LIBS),$(if $(findstring /,$(i)),$(i)))) + SPECIAL_OCAMLFLAGS := $(OCAMLBCFLAGS) + + REAL_OCAMLC := $(INTF_OCAMLC) + + REAL_IMPL := $(IMPL_CMO) + REAL_IMPL_INTF := $(IMPLO_INTF) + IMPL_SUF := .cmo + + DEPFLAGS := + MAKE_DEPS := $(MLDEPS) $(BCDEPIS) + + ifdef CREATE_LIB + ifndef STATIC + ifneq ($(strip $(OBJ_LINK)),) + MAKEDLL := $(DLLSONAME) + ALL_LDFLAGS := -dllib $(DLLSONAME) + endif + endif + endif + + ifndef NO_CUSTOM + ifneq "$(strip $(OBJ_LINK) $(THREADS) $(MAYBE_IDL) $(CLIBS))" "" + ALL_LDFLAGS += -custom + endif + endif + + ALL_LDFLAGS += $(INCFLAGS) $(OCAMLLDFLAGS) $(OCAMLBLDFLAGS) \ + $(COMMON_LDFLAGS) $(LIBS:%=%.cma) + CAMLIDLDLLFLAGS := + + ifdef THREADS + ALL_LDFLAGS := -thread $(ALL_LDFLAGS) + ifndef CREATE_LIB + ALL_LDFLAGS := unix.cma threads.cma $(ALL_LDFLAGS) + endif + THREAD_FLAG := -thread + endif + +# we have to make native-code +else + EXTRADEPS := $(addsuffix .cmxa,$(foreach i,$(LIBS),$(if $(findstring /,$(i)),$(i)))) + ifndef PROFILING + SPECIAL_OCAMLFLAGS := $(OCAMLNCFLAGS) + PLDFLAGS := + else + SPECIAL_OCAMLFLAGS := -p $(OCAMLNCFLAGS) + PLDFLAGS := -p + endif + + REAL_IMPL := $(IMPL_CMX) + REAL_IMPL_INTF := $(IMPLX_INTF) + IMPL_SUF := .cmx + + CFLAGS := -DNATIVE_CODE $(CFLAGS) + + DEPFLAGS := -native + MAKE_DEPS := $(MLDEPS) $(NCDEPIS) + + ALL_LDFLAGS := $(PLDFLAGS) $(INCFLAGS) $(OCAMLLDFLAGS) \ + $(OCAMLNLDFLAGS) $(COMMON_LDFLAGS) + CAMLIDLDLLFLAGS := -opt + + ifndef CREATE_LIB + ALL_LDFLAGS += $(LIBS:%=%.cmxa) + endif + + ifdef THREADS + ALL_LDFLAGS := -thread $(ALL_LDFLAGS) + ifndef CREATE_LIB + ALL_LDFLAGS := unix.cmxa threads.cmxa $(ALL_LDFLAGS) + endif + THREAD_FLAG := -thread + endif +endif + +export MAKE_DEPS + +ALL_OCAMLCFLAGS := $(THREAD_FLAG) $(OCAMLFLAGS) \ + $(INCFLAGS) $(SPECIAL_OCAMLFLAGS) + +ifdef make_deps + -include $(MAKE_DEPS) + PRE_TARGETS := +endif + +########################################################################### +# USER RULES + +# Call "OCamlMakefile QUIET=" to get rid of all of the @'s. +QUIET=@ + +# generates byte-code (default) +byte-code: $(PRE_TARGETS) + $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) $(BCRESULT) \ + REAL_RESULT="$(BCRESULT)" make_deps=yes +bc: byte-code + +byte-code-nolink: $(PRE_TARGETS) + $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) nolink \ + REAL_RESULT="$(BCRESULT)" make_deps=yes +bcnl: byte-code-nolink + +top: $(PRE_TARGETS) + $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) $(TOPRESULT) \ + REAL_RESULT="$(BCRESULT)" make_deps=yes + +# generates native-code + +native-code: $(PRE_TARGETS) + $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) $(NCRESULT) \ + REAL_RESULT="$(NCRESULT)" \ + REAL_OCAMLC="$(OCAMLOPT)" \ + make_deps=yes +nc: native-code + +native-code-nolink: $(PRE_TARGETS) + $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) nolink \ + REAL_RESULT="$(NCRESULT)" \ + REAL_OCAMLC="$(OCAMLOPT)" \ + make_deps=yes +ncnl: native-code-nolink + +# generates byte-code libraries +byte-code-library: $(PRE_TARGETS) + $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) \ + $(RES_CLIB) $(BCRESULT).cma \ + REAL_RESULT="$(BCRESULT)" \ + CREATE_LIB=yes \ + make_deps=yes +bcl: byte-code-library + +# generates native-code libraries +native-code-library: $(PRE_TARGETS) + $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) \ + $(RES_CLIB) $(NCRESULT).cmxa \ + REAL_RESULT="$(NCRESULT)" \ + REAL_OCAMLC="$(OCAMLOPT)" \ + CREATE_LIB=yes \ + make_deps=yes +ncl: native-code-library + +ifdef WIN32 +# generates byte-code dll +byte-code-dll: $(PRE_TARGETS) + $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) \ + $(RES_CLIB) $(BCRESULT).dll \ + REAL_RESULT="$(BCRESULT)" \ + make_deps=yes +bcd: byte-code-dll + +# generates native-code dll +native-code-dll: $(PRE_TARGETS) + $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) \ + $(RES_CLIB) $(NCRESULT).dll \ + REAL_RESULT="$(NCRESULT)" \ + REAL_OCAMLC="$(OCAMLOPT)" \ + make_deps=yes +ncd: native-code-dll +endif + +# generates byte-code with debugging information +debug-code: $(PRE_TARGETS) + $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) $(BCRESULT) \ + REAL_RESULT="$(BCRESULT)" make_deps=yes \ + OCAMLFLAGS="-g $(OCAMLFLAGS)" \ + OCAMLLDFLAGS="-g $(OCAMLLDFLAGS)" +dc: debug-code + +# generates byte-code libraries with debugging information +debug-code-library: $(PRE_TARGETS) + $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) \ + $(RES_CLIB) $(BCRESULT).cma \ + REAL_RESULT="$(BCRESULT)" make_deps=yes \ + CREATE_LIB=yes \ + OCAMLFLAGS="-g $(OCAMLFLAGS)" \ + OCAMLLDFLAGS="-g $(OCAMLLDFLAGS)" +dcl: debug-code-library + +# generates byte-code for profiling +profiling-byte-code: $(PRE_TARGETS) + $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) $(BCRESULT) \ + REAL_RESULT="$(BCRESULT)" PROFILING="y" \ + make_deps=yes +pbc: profiling-byte-code + +# generates native-code + +profiling-native-code: $(PRE_TARGETS) + $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) $(NCRESULT) \ + REAL_RESULT="$(NCRESULT)" \ + REAL_OCAMLC="$(OCAMLOPT)" \ + PROFILING="y" \ + make_deps=yes +pnc: profiling-native-code + +# generates byte-code libraries +profiling-byte-code-library: $(PRE_TARGETS) + $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) \ + $(RES_CLIB) $(BCRESULT).cma \ + REAL_RESULT="$(BCRESULT)" PROFILING="y" \ + CREATE_LIB=yes \ + make_deps=yes +pbcl: profiling-byte-code-library + +# generates native-code libraries +profiling-native-code-library: $(PRE_TARGETS) + $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) \ + $(RES_CLIB) $(NCRESULT).cmxa \ + REAL_RESULT="$(NCRESULT)" PROFILING="y" \ + REAL_OCAMLC="$(OCAMLOPT)" \ + CREATE_LIB=yes \ + make_deps=yes +pncl: profiling-native-code-library + +# packs byte-code objects +pack-byte-code: $(PRE_TARGETS) + $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) $(BCRESULT).cmo \ + REAL_RESULT="$(BCRESULT)" \ + PACK_LIB=yes make_deps=yes +pabc: pack-byte-code + +# packs native-code objects +pack-native-code: $(PRE_TARGETS) + $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) \ + $(NCRESULT).cmx $(NCRESULT).o \ + REAL_RESULT="$(NCRESULT)" \ + REAL_OCAMLC="$(OCAMLOPT)" \ + PACK_LIB=yes make_deps=yes +panc: pack-native-code + +# generates HTML-documentation +htdoc: doc/html + +# generates Latex-documentation +ladoc: doc/latex + +# generates PostScript-documentation +psdoc: doc/latex/doc.ps + +# generates PDF-documentation +pdfdoc: doc/latex/doc.pdf + +# generates all supported forms of documentation +doc: htdoc ladoc psdoc pdfdoc + +########################################################################### +# LOW LEVEL RULES + +$(REAL_RESULT): $(REAL_IMPL_INTF) $(OBJ_LINK) $(EXTRADEPS) + $(REAL_OCAMLC) $(ALL_LDFLAGS) $(OBJS_LIBS) -o $@$(EXE) \ + $(REAL_IMPL) +ifdef MSVC +# work around the bug in ocamlc -- it should delete this file itself + rm -f camlprim?.$(EXT_OBJ) +endif + +nolink: $(REAL_IMPL_INTF) $(OBJ_LINK) + +ifdef WIN32 +$(REAL_RESULT).dll: $(REAL_IMPL_INTF) $(OBJ_LINK) + $(CAMLIDLDLL) $(CAMLIDLDLLFLAGS) $(OBJ_LINK) $(CLIBS) \ + -o $@ $(REAL_IMPL) +endif + +%$(TOPSUFFIX): $(REAL_IMPL_INTF) $(OBJ_LINK) $(EXTRADEPS) + $(OCAMLMKTOP) $(ALL_LDFLAGS) $(OBJS_LIBS) -o $@$(EXE) \ + $(REAL_IMPL) +ifdef MSVC +# work around the bug in ocamltop -- it should delete this file itself + rm -f camlprim?.$(EXT_OBJ) +endif + +.SUFFIXES: .mli .ml .cmi .cmo .cmx .cma .cmxa .$(EXT_OBJ) \ + .mly .di .d .$(EXT_LIB) .idl .c .$(EXT_CXX) .h .so \ + .rep .zog +ifndef MSVC +$(DLLSONAME): $(OBJ_LINK) + $(CC) -shared $(CINCFLAGS) $(CLIBFLAGS) \ + -o $@ $(OBJ_LINK) $(CLIBS:%=-l%) +endif + +$(RESULT).cma: $(REAL_IMPL_INTF) $(MAKEDLL) $(EXTRADEPS) + $(REAL_OCAMLC) -a $(ALL_LDFLAGS) \ + $(OBJS_LIBS) -o $@ $(OCAMLBLDFLAGS) $(REAL_IMPL) + +$(RESULT).cmxa $(RESULT).$(EXT_LIB): $(REAL_IMPL_INTF) $(EXTRADEPS) + $(OCAMLOPT) -a $(ALL_LDFLAGS) $(OBJS_LIBS) \ + $(OCAMLNLDFLAGS) -o $@ $(REAL_IMPL) + +$(RES_CLIB): $(OBJ_LINK) +ifndef MSVC + ifneq ($(strip $(OBJ_LINK)),) + ar rc $@ $(OBJ_LINK) + ranlib $@ + endif +else + ifneq ($(strip $(OBJ_LINK)),) + lib /nologo /debugtype:cv /out:$(RES_CLIB) $(OBJ_LINK) + endif +endif + +.mli.cmi: $(EXTRADEPS) + $(QUIET)pp=`sed -n -e 's/(\*pp \([^*]*\) \*)/\1/p;q' $<`; \ + if [ -z "$$pp" ]; then \ + echo $(INTF_OCAMLC) -c $(THREAD_FLAG) \ + $(OCAMLFLAGS) $(INCFLAGS) $<; \ + $(INTF_OCAMLC) -c $(THREAD_FLAG) $(OCAMLFLAGS) \ + $(INCFLAGS) $<; \ + else \ + echo $(INTF_OCAMLC) -c -pp \"$$pp\" $(THREAD_FLAG) \ + $(OCAMLFLAGS) $(INCFLAGS) $<; \ + $(INTF_OCAMLC) -c -pp "$$pp" $(THREAD_FLAG) \ + $(OCAMLFLAGS) $(INCFLAGS) $<; \ + fi + +.ml.cmi .ml.$(EXT_OBJ) .ml.cmx .ml.cmo: $(EXTRADEPS) + $(QUIET)pp=`sed -n -e 's/(\*pp \([^*]*\) \*)/\1/p;q' $<`; \ + if [ -z "$$pp" ]; then \ + echo $(REAL_OCAMLC) -c $(ALL_OCAMLCFLAGS) $<; \ + $(REAL_OCAMLC) -c $(ALL_OCAMLCFLAGS) $<; \ + else \ + echo $(REAL_OCAMLC) -c -pp \"$$pp\" \ + $(ALL_OCAMLCFLAGS) $<; \ + $(REAL_OCAMLC) -c -pp "$$pp" $(ALL_OCAMLCFLAGS) $<; \ + fi + +ifdef PACK_LIB +$(REAL_RESULT).cmo $(REAL_RESULT).cmx $(REAL_RESULT).o: $(REAL_IMPL_INTF) $(OBJ_LINK) $(EXTRADEPS) + $(REAL_OCAMLC) $(PACKOPT) $(ALL_LDFLAGS) \ + $(OBJS_LIBS) -o $@ $(REAL_IMPL) +endif + +.PRECIOUS: %.ml +%.ml: %.mll + $(OCAMLLEX) $< + +.PRECIOUS: %.ml %.mli +%.ml %.mli: %.mly + $(OCAMLYACC) $(YFLAGS) $< + +.PRECIOUS: %.ml +%.ml : %.rep + $(CAMELEON_REPORT) $(CAMELEON_REPORT_FLAGS) -gen $< + +.PRECIOUS: %.ml +%.ml : %.zog + $(CAMELEON_ZOGGY) $(CAMELEON_ZOGGY_FLAGS) -impl $< > $@ + +.PRECIOUS: %.ml %.mli %_stubs.c %.h +%.ml %.mli %_stubs.c %.h: %.idl + $(CAMLIDL) $(MAYBE_IDL_HEADER) $(IDLFLAGS) \ + $(CAMLIDLFLAGS) $< + $(QUIET)if [ $(NOIDLHEADER) ]; then touch $*.h; fi + +.c.$(EXT_OBJ): + $(CC) -c $(CFLAGS) $(CINCFLAGS) -I$(OCAMLLIBPATH) \ + $< $(CFLAG_O)$@ + +.$(EXT_CXX).$(EXT_OBJ): + $(CXX) -c $(CXXFLAGS) $(CINCFLAGS) -I$(OCAMLLIBPATH) \ + $< $(CFLAG_O)$@ + +$(MLDEPDIR)/%.d: %.ml + $(QUIET)echo making $@ from $< + $(QUIET)if [ ! -d $(@D) ]; then mkdir -p $(@D); fi + $(QUIET)pp=`sed -n -e 's/(\*pp \([^*]*\) \*)/\1/p;q' $<`; \ + if [ -z "$$pp" ]; then \ + $(OCAMLDEP) $(INCFLAGS) $< > $@; \ + else \ + $(OCAMLDEP) -pp "$$pp" $(INCFLAGS) $< > $@; \ + fi + +$(BCDIDIR)/%.di $(NCDIDIR)/%.di: %.mli + $(QUIET)echo making $@ from $< + $(QUIET)if [ ! -d $(@D) ]; then mkdir -p $(@D); fi + $(QUIET)pp=`sed -n -e 's/(\*pp \([^*]*\) \*)/\1/p;q' $<`; \ + if [ -z "$$pp" ]; then \ + $(OCAMLDEP) $(DEPFLAGS) $(INCFLAGS) $< > $@; \ + else \ + $(OCAMLDEP) $(DEPFLAGS) \ + -pp "$$pp" $(INCFLAGS) $< > $@; \ + fi + +doc/html: $(DOC_FILES) + rm -rf $@ + mkdir -p $@ + $(OCAMLDOC) -html -d $@ $(OCAMLDOCFLAGS) $(DOC_FILES) + +doc/latex: $(DOC_FILES) + rm -rf $@ + mkdir -p $@ + $(OCAMLDOC) -latex -d $@ $(OCAMLDOCFLAGS) $(DOC_FILES) -o doc.tex + +doc/latex/doc.ps: doc/latex + cd doc/latex && \ + $(LATEX) doc.tex && \ + $(LATEX) doc.tex && \ + $(DVIPS) $(DVIPSFLAGS) doc.dvi -o $(@F) + +doc/latex/doc.pdf: doc/latex/doc.ps + cd doc/latex && $(PS2PDF) $( [] +let fstfst ((e, _), _) = e +let sndfst ((_, e), _) = e +let fstsnd (_, (e, _)) = e +let sndsnd (_, (_, e)) = e + +let fst3 (e, _, _) = e +let snd3 (_, e, _) = e +let ter3 (_, _, e) = e +let sndter3 (_, a, b) = (a, b) + +let o f g x = f (g x) +let curry f x y = f (x,y) +let uncurry f (x, y) = f x y + +let is_int n = ceil n = n + +let uncons = function + | [] -> failwith "uncons" + | e::l -> e,l + +let has_env var = + try + let _ = Sys.getenv var in true + with Not_found -> false + +let some = function + | Some e -> e + | None -> failwith "some" + +let some_or = function + | None -> id + | Some e -> fun _ -> e + +let option2l = function + | None -> [] + | Some e -> [e] + +let prefer_some f a b = + match a, b with + | Some a, Some b -> Some (f a b) + | None, _ -> b + | _, None -> a + +let rec collect_accu f accu = function + | [] -> accu + | e::l -> collect_accu f (rev_append (f e) accu) l + +let collect f l = rev (collect_accu f [] l) + +let merge_some merge a b = + match a,b with + | None, None -> None + | _, None -> a + | None, _ -> b + | Some(a), Some(b) -> Some(merge a b) + +let rec uniq = function + | [] -> [] + | e::l -> if mem e l then uniq l else e :: uniq l + +let rec uniq_ eq = function + | [] -> [] + | e::l -> + try + let _ = find (eq e) l in + uniq_ eq l + with Not_found -> e :: uniq_ eq l + +let rec non_uniq = function + | [] -> [] + | e::l -> if mem e l then e :: non_uniq l else non_uniq l + +let rec member_ eq e = function + | [] -> false + | e'::l -> if eq e e' then true else member_ eq e l + +let rec find_some p = function + | [] -> raise Not_found + | x :: l -> + match p x with + | Some v -> v + | None -> find_some p l + +let fold_left1 f = function + | [] -> failwith "fold_left1" + | e :: l -> fold_left f e l + +let find_index e l = + let rec find_index_ i = function + | [] -> raise Not_found + | e'::l -> if e=e' then i else find_index_ (i+1) l + in + find_index_ 0 l + +let rec find_some_ p = function + | [] -> None + | x :: l -> + match p x with + | Some v -> Some v + | None -> find_some_ p l + +let rec fpartition p l = + let rec part yes no = function + | [] -> (rev yes, rev no) + | x :: l -> + (match p x with + | None -> part yes (x :: no) l + | Some v -> part (v :: yes) no l) in + part [] [] l + +let partition_either f l = + let rec part_either left right = function + | [] -> (rev left, rev right) + | x :: l -> + (match f x with + | Left e -> part_either (e :: left) right l + | Right e -> part_either left (e :: right) l) in + part_either [] [] l + +let rec keep_best f = + let rec partition e = function + | [] -> e, [] + | e' :: l -> + match f(e,e') with + | None -> let (e'', l') = partition e l in e'', e' :: l' + | Some e'' -> partition e'' l + in function + | [] -> [] + | e::l -> + let (e', l') = partition e l in + e' :: keep_best f l' + +let rec keep_bests f l = + let rec once e unchanged = function + | [] -> None + | e' :: l -> + match f(e,e') with + | None -> once e (e' :: unchanged) l + | Some e'' -> Some(e'', unchanged @ l) + in + let rec as_many_as_possible e l = + match once e [] l with + | None -> None + | Some(e', l') -> Some(some_or (as_many_as_possible e' l') (e', l')) + in + let rec try_with e l_done l_next = + match as_many_as_possible e l_next with + | None -> try_with_next (e :: l_done) l_next + | Some(e2, l_next2) -> + match as_many_as_possible e2 l_done with + | None -> try_with_next (e2 :: l_done) l_next2 + | Some(e3, l_done2) -> try_with e3 l_done2 l_next2 + and try_with_next l_done = function + | [] -> rev l_done + | e::l_next -> try_with e l_done l_next + in + try_with_next [] l + +let rec fold_right1 f = function + | [] -> failwith "fold_right1" + | [e] -> e + | e::l -> f e (fold_right1 f l) + +let rec for_all2_ p l1 l2 = + match (l1, l2) with + ([], []) -> true + | (a1::l1, a2::l2) -> p a1 a2 && for_all2_ p l1 l2 + | (_, _) -> false + +let rec for_all2_true p l1 l2 = + match (l1, l2) with + | (a1::l1, a2::l2) -> p a1 a2 && for_all2_true p l1 l2 + | (_, _) -> true + +let maxl l = fold_right1 max l + +let rec stack2list s = + let l = ref [] in + Stack.iter (fun e -> l := e :: !l) s ; + !l + +let rec stack_exists f s = + try + Stack.iter (fun e -> if f e then raise Found) s ; + false + with Found -> true + +let rec queue2list q = rev (Queue.fold (fun b a -> a :: b) [] q) + +let rec fix_point f p = + let p' = f p in + if p = p' then p else fix_point f p' + +let rec fix_point_withenv f env p = + let p', env' = f env p in + if p = p' then (p, env') else fix_point_withenv f env' p' + +let rec fix_point_ nb f p = + let p' = f p in + if p = p' then p, nb else fix_point_ (nb+1) f p' + +let rec group_by_2 = function + | [] -> [] + | a :: b :: l -> (a, b) :: group_by_2 l + | _ -> failwith "group_by_2" + +(* +let rec lfix_point f e = + let e' = f(e) in + if e = e' then e :: lfix_point f e' else [e] +*) + +let fluid_let ref value f = + let previous_val = !ref in + ref := value ; + let v = f() in + ref := previous_val ; + v + +let do0_withenv doit f env l = + let r_env = ref env in + doit (fun e -> r_env := f !r_env e) l ; + !r_env + +let do0_withenv2 doit f env l = + let r_env = ref env in + doit (fun e e' -> r_env := f !r_env e e') l ; + !r_env + +let do_withenv doit f env l = + let r_env = ref env in + let l' = doit (fun e -> + let e', env' = f !r_env e in + r_env := env' ; e' + ) l in + l', !r_env + +let do2_withenv doit f env l1 l2 = + let r_env = ref env in + let l' = doit (fun e1 e2 -> + let e', env' = f !r_env e1 e2 in + r_env := env' ; e' + ) l1 l2 in + l', !r_env + +let do_collect doit f l1 = + let l = ref [] in + doit (fun i t -> l := f i t @ !l) l1 ; + !l + +let map_withitself f l = + let rec map_withitself_ done_ = function + | [] -> done_ + | e :: l -> + let e' = f (done_ @ e :: l) e in + map_withitself_ (done_ @ [ e' ]) l + in map_withitself_ [] l + +let map_t2 f (x,y) = f x, f y +let map_t3 f (x,y,z) = f x, f y, f z +let map_option f = function + | Some e -> Some (f e) + | None -> None +let map_optionoption f = function + | Some e -> f e + | None -> None +let t2_option2option_t2 = function + | (Some x, Some y) -> Some(x,y) + | _ -> None +let rec l_option2option_l = function + | [] -> Some [] + | None :: _l -> None + | Some e :: l -> map_option (fun l -> e :: l) (l_option2option_l l) +let map_option_env f (e, env) = map_option f e, env + +let t2_to_list (a,b) = [ a ; b ] +let t3_to_list (a,b,c) = [ a ; b ; c ] + +let if_some bool val_ = if bool then Some val_ else None + +let rec fold_left_option f val_ = function + | [] -> Some val_ + | e::l -> + match f val_ e with + | None -> None + | Some val_' -> fold_left_option f val_' l + +let collect_some_withenv f env l = + let rec collect accu env = function + | [] -> rev accu, env + | e::l -> + let e', env' = f env e in + let accu' = + match e' with + | Some e' -> e'::accu + | None -> accu in + collect accu' env' l + in collect [] env l + +let for_all_option_withenv remap f env l = + let rec for_all env accu = function + | [] -> Some(remap (rev accu)), env + | e::l -> + (match f env e with + | None, env' -> None, env' + | Some e', env' -> for_all env' (e' :: accu) l) + in + for_all env [] l + +let for_all2_option_withenv remap f env la lb = + let rec for_all env accu = function + | [], [] -> Some(remap (rev accu)), env + | a::la, b::lb -> + (match f env a b with + | None, env' -> None, env' + | Some ab, env' -> for_all env' (ab :: accu) (la, lb)) + | _ -> None, env + in + for_all env [] (la, lb) + +let map_or_option f = function + | Or_some e -> Or_some (f e) + | Or_error err -> Or_error err + +let map_index f l = + let rec map_ n = function + | [] -> [] + | e::l -> f e n :: map_ (n+1) l + in map_ 0 l + +let filter_index f l = + let rec filter_ n = function + | [] -> [] + | e::l -> + let l' = filter_ (n+1) l in + if f e n then e :: l' else l' + in filter_ 0 l + +let iter_index f l = + let rec iter_ n = function + | [] -> () + | e::l -> f e n ; iter_ (n+1) l + in iter_ 0 l + +let map_fst f (x, y) = f x, y +let map_snd f (x, y) = x, f y + +let map_withenv f env e = do_withenv map f env e +let find_withenv f env e = do_withenv find f env e +let filter_withenv f env e = do_withenv filter f env e +let exists_withenv f env e = do_withenv exists f env e +let map_t2_withenv f env e = do_withenv map_t2 f env e +let for_all_withenv f env e = do_withenv for_all f env e +let collect_withenv f env e = do_withenv collect f env e +let partition_either_withenv f env e = do_withenv partition_either f env e + +let map2_withenv f env l1 l2 = do2_withenv map2 f env l1 l2 +let for_all2_withenv f env l1 l2 = do2_withenv for_all2 f env l1 l2 + +let rec take n l = + if n = 0 then [] + else match l with + | [] -> raise Not_found + | e::l -> e :: take (n-1) l +let last_n n l = rev (take n (rev l)) +let last l = hd (last_n 1 l) + +let rec skipfirst e = function + | [] -> [] + | e'::l when e = e' -> skipfirst e l + | l -> l + +let rec removelast = function + | [] -> failwith "removelast" + | [_] -> [] + | e::l -> e :: removelast l + +let rec split_last l = + let rec spl accu = function + | [] -> failwith "split_last" + | [e] -> rev accu, e + | e::l -> spl (e :: accu) l + in spl [] l + +let iter_assoc_val f l = iter (fun (_,v) -> f v) l +let map_assoc_val f l = map (fun (k,v) -> k, f v) l + +let assoc_or_fail e l = + try assoc e l with Not_found -> failwith "assoc failed" + +let assoc_by is_same e l = + find_some (fun (a,b) -> if is_same e a then Some b else None) l + +let rec update_assoc_by is_same f e = function + | [] -> raise Not_found + | (a,b) :: l when is_same e a -> (a, f b) :: l + | (a,b) :: l -> (a,b) :: update_assoc_by is_same f e l + +let update_assoc f e = update_assoc_by (=) f e + +let rec update_assoc_by_with_default default is_same f e = function + | [] -> [ e, f default ] + | (a,b) :: l when is_same e a -> (a, f b) :: l + | (a,b) :: l -> (a,b) :: update_assoc_by_with_default default is_same f e l + +let update_all_assoc_by is_same f e l = + map (fun (a,b) -> a, if is_same e a then f b else b) l + +let rec rassoc e = function + | [] -> raise Not_found + | (k,v) :: l -> if e = v then k else rassoc e l + +let rec all_assoc e = function + | [] -> [] + | (e',v) :: l when e=e' -> v :: all_assoc e l + | _ :: l -> all_assoc e l + +let rec all_assoc_by is_same e = function + | [] -> [] + | (e',v) :: l when is_same e e' -> v :: all_assoc_by is_same e l + | _ :: l -> all_assoc_by is_same e l + +let prepare_want_all_assoc l = + map (fun n -> n, uniq (all_assoc n l)) (uniq (map fst l)) + +let prepare_want_all_assoc_by is_same l = + map (fun n -> n, uniq_ is_same (all_assoc_by is_same n l)) (uniq_ is_same (map fst l)) + +let prepare_want_all_assoc_by_ is_same_a is_same_b l = + map (fun n -> n, uniq_ is_same_b (all_assoc_by is_same_a n l)) (uniq_ is_same_a (map fst l)) + +let rec count_uniq = function + | [] -> [] + | e::l -> + let has, l' = partition ((=) e) l in + (e, length has + 1) :: count_uniq l' + +let rec repeat e = function + | 0 -> [] + | n -> e :: repeat e (n-1) + +let rec inits = function + | [] -> [[]] + | e::l -> [] :: map (fun l -> e::l) (inits l) +let rec tails = function + | [] -> [[]] + | (_::xs) as xxs -> xxs :: tails xs + +let apply f x = f x;; + +let rec map3 f l1 l2 l3 = + match (l1, l2, l3) with + ([], [], []) -> [] + | (a1::l1, a2::l2, a3::l3) -> let r = f a1 a2 a3 in r :: map3 f l1 l2 l3 + | (_, _, _) -> invalid_arg "map3" + +let filter2 f l1 l2 = + split (filter f (combine l1 l2)) + +let break_at f l = + let rec b l1 = function + | [] -> l1, [] + | e::l2 -> if f e then (l1, e :: l2) else b (l1 @ [e]) l2 + in b [] l +let break v l = break_at ((=) v) l + +let drop_while f l = snd (break_at (fun e -> not (f e)) l) + +(* break_at_indice 0 [1;2] gives [], [1;2] + break_at_indice 1 [1;2] gives [1], [2] + *) +let rec break_at_indice i l = + if i = 0 then [], l else + match l with + | [] -> raise Not_found + | e::l2 -> + let a, b = break_at_indice (i-1) l2 in + e::a, b + +let rev_nth e l = + let rec rev_nth' i = function + | [] -> raise Not_found + | e'::_ when e'=e -> i + | _::l -> rev_nth' (i+1) l + in rev_nth' 0 l + +let rec getset_nth l i f = + match l, i with + | e::l', 0 -> f e :: l' + | [], _ -> failwith "getset_nth" + | e::l', _ -> e :: getset_nth l' (i - 1) f + +let set_nth l i v = getset_nth l i (fun _ -> v) + +let adjustModDown m n = n - (n mod m) +let adjustModUp m n = adjustModDown m (n + m - 1) + + +let hashtbl_find f h = + let r = ref None in + Hashtbl.iter (fun v c -> if f v c then r := Some v) h ; + match !r with + | Some v -> v + | None -> raise Not_found + +let hashtbl_map f h = Hashtbl.iter (fun v c -> Hashtbl.replace h v (f v c)) h + +let hashtbl_values h = Hashtbl.fold (fun _ v l -> v :: l) h [] +let hashtbl_keys h = Hashtbl.fold (fun k _ l -> k :: l) h [] +let hashtbl_to_list h = Hashtbl.fold (fun k v l -> (k,v) :: l) h [] + +let hashtbl_collect f h = + rev (Hashtbl.fold (fun k v l -> rev_append (f k v) l) h []) + +let hashtbl_exists f h = + try + Hashtbl.iter (fun v c -> if f v c then raise Found) h ; + false + with Found -> true + +let memoize f = + let hash = Hashtbl.create 16 in + fun k -> + try Hashtbl.find hash k + with Not_found -> + let v = f k in + Hashtbl.add hash k v ; v + +let array_shift a = Array.sub a 1 (Array.length a - 1) +let array_last_n n a = + let len = Array.length a in + Array.sub a (len - n) n + +let array_collect f a = Array.fold_left (fun l e -> f e @ l) [] a + +let rec lvector_product = + let rec vector_product a b = match a with + | [] -> [] + | e::l -> map (fun e' -> e :: e') b :: vector_product l b + in function + | [] -> [] + | [e] -> map (fun e -> [e]) e + | e::l -> flatten (vector_product e (lvector_product l)) + +let vector_product2 a b = + map (function + | [a;b] -> a,b + | _ -> failwith "vector_product2" + ) (lvector_product [ a ; b ]) + +let rec transpose = function + | [] :: _ -> [] + | ll -> + let l, ll' = split (map (function e::l -> e,l | _ -> raise Not_found) ll) in + l :: transpose ll' + +let rec range min max = + if min >= max then [] else min :: range (min + 1) max + +let sum l = List.fold_left (+) 0 l + +let rec filter_some_with f = function + | [] -> [] + | e :: l -> + match f e with + | None -> filter_some_with f l + | Some e' -> e' :: filter_some_with f l + +let rec filter_some = function + | [] -> [] + | None :: l -> filter_some l + | Some e :: l -> e :: filter_some l + +let rec difference l = function + | [] -> l + | e::l' -> difference (filter ((<>) e) l) l' + +let rec difference_ eq l = function + | [] -> l + | e::l' -> + let l2 = filter (fun e' -> not (eq e e')) l in + difference_ eq l2 l' + +let intersection_by is_same l1 l2 = filter (fun e -> exists (is_same e) l2) l1 + +let intersection_and_differences eq l1 l2 = + let rec both inter l2_only = function + | [], l2 -> inter, [], rev l2_only @ l2 + | l1, [] -> inter, l1, rev l2_only + | l1, e2 :: l2' -> + match partition (eq e2) l1 with + | [], _ -> both inter (e2 :: l2_only) (l1, l2') + | _, l1' -> both (e2 :: inter) l2_only (l1', l2') + in both [] [] (l1, l2) + +let rec triangularize = function + | [] -> [] + | e::l -> (e,l) :: triangularize l + +let diagonalize l = + map_index (fun a i -> + a, filter_index (fun _ j -> i <> j) l + ) l + +let rec list_of_nonempty_sublists = function + | [] -> [] + | e :: l -> + let l' = list_of_nonempty_sublists l in + [e] :: l' @ map (fun l -> e :: l) l' + +let rec graph_is_sorted_by eq = function + | [] -> true + | (_,deps) :: l -> + for_all (fun e -> try let _ = assoc_by eq e l in false with Not_found -> true) deps && graph_is_sorted_by eq l + +let graph_closure_by eq graph = + let err = ref None in + try + let graph_rev = collect (fun (i, l) -> map (fun e -> (e, i)) l) graph in + let bothway = map (fun (i,l) -> i, (l, all_assoc_by eq i graph_rev)) graph in + let closed = fold_left (fun graph j -> + let next, prev = assoc_by eq j graph in + let graph2 = fold_left (fun graph i -> + if member_ eq i next then (err := Some(j,i); raise GraphSort_circular_deps) else + update_assoc_by eq (fun (i_next,i_prev) -> i_next @ next, i_prev) i graph + ) graph (filter (fun a -> not (eq a j)) prev) in + let graph3 = fold_left (fun graph k -> + if member_ eq k prev then (err := Some(j,k); raise GraphSort_circular_deps) else + update_assoc_by eq (fun (k_next,k_prev) -> k_next, k_prev @ prev) k graph + ) graph2 (filter (fun a -> not (eq a j)) next) in + graph3 + ) bothway (map fst bothway) in + Or_some (map (fun (e,(next,_)) -> e, uniq_ eq next) closed) + with GraphSort_circular_deps -> + Or_error (some !err) + +let rec graph_sort_by eq l = + let cmp (_, deps_a) (b, _) = if member_ eq b deps_a then 1 else -1 in + let rec sort_it = function + | [] -> [] + | [e] -> [e] + | e::l -> + let l' = sort_it l in + let gt, lt = break_at (fun ((_, deps) as e') -> deps = [] or cmp e e' = 1) l' in + gt @ [e] @ lt + in + map_or_option (fun l' -> + let l_sorted = rev (sort_it l') in + if not (graph_is_sorted_by eq l_sorted) then internal_error "graph_sort failed" else + l_sorted + ) (graph_closure_by eq l) + +let int_sort l = sort (fun a b -> a - b) l + +let str_begins_with prefix s = + String.sub s 0 (min (String.length s) (String.length prefix)) = prefix + +let rec strstr s subs = + let len_s, len_subs = String.length s, String.length subs in + let rec rec_ i = + let i' = String.index_from s i subs.[0] in + if i' + len_subs <= len_s then + if String.sub s i' len_subs = subs then + i' + else + rec_ (i' + 1) + else + raise Not_found + in + rec_ 0 + +let str_contains s subs = + try + let _ = strstr s subs in true + with Not_found -> false + +let str_ends_with s suffix = + let len = min (String.length s) (String.length suffix) in + String.sub s (String.length s - len) len = suffix + +let chop = function + | "" -> "" + | s -> String.sub s 0 (String.length s - 1) + +let chomps s = + let i = ref (String.length s - 1) in + while !i >= 0 && (s.[!i] = ' ' || s.[!i] = '\t') do decr i done ; + String.sub s 0 (!i+1) + +let rec times e = function + | 0 -> [] + | n -> e :: times e (n-1) + +let skip_n_char_ beg end_ s = + let full_len = String.length s in + if beg < full_len && full_len - beg - end_ > 0 + then String.sub s beg (full_len - beg - end_) + else "" +let skip_n_char n s = skip_n_char_ n 0 s + +let rec non_index_from s beg c = + if s.[beg] = c then non_index_from s (beg+1) c else beg +let non_index s c = non_index_from s 0 c + +let rec non_rindex_from s beg c = + if s.[beg] = c then non_rindex_from s (beg-1) c else beg +let non_rindex s c = non_rindex_from s (String.length s - 1) c + +let rec explode_string = function + | "" -> [] + | s -> (String.get s 0) :: explode_string (String.sub s 1 (String.length s - 1)) + +let count_matching_char s c = + let rec count_matching_char_ nb i = + try + let i' = String.index_from s i c in + count_matching_char_ (nb+1) (i'+1) + with Not_found -> nb + in + count_matching_char_ 0 0 + +let is_uppercase c = Char.lowercase c <> c +let is_lowercase c = Char.uppercase c <> c + +let char_is_alphanumerical c = + let i = Char.code c in + Char.code 'a' <= i && i <= Char.code 'z' || + Char.code 'A' <= i && i <= Char.code 'Z' || + Char.code '0' <= i && i <= Char.code '9' + +let char_is_alphanumerical_ c = + let i = Char.code c in + Char.code 'a' <= i && i <= Char.code 'z' || + Char.code 'A' <= i && i <= Char.code 'Z' || + Char.code '0' <= i && i <= Char.code '9' || c = '_' + +let char_is_alpha c = + let i = Char.code c in + Char.code 'a' <= i && i <= Char.code 'z' || + Char.code 'A' <= i && i <= Char.code 'Z' + +let char_is_number c = + let i = Char.code c in + Char.code '0' <= i && i <= Char.code '9' + +let count_chars_in_string s c = + let rec rec_count_chars_in_string from = + try + let from' = String.index_from s from c in + 1 + rec_count_chars_in_string (from' + 1) + with + Not_found -> 0 + in rec_count_chars_in_string 0 + +let rec string_fold_left f val_ s = + let val_ = ref val_ in + for i = 0 to String.length s - 1 do + val_ := f !val_ s.[i] + done ; + !val_ + +(* +let rec string_forall_with f i s = + try + f s.[i] && string_forall_with f (i+1) s + with Invalid_argument _ -> true +*) +let string_forall_with f i s = + let len = String.length s in + let rec string_forall_with_ i = + i >= len || f s.[i] && string_forall_with_ (i+1) + in string_forall_with_ i + +let starts_with_non_lowercase s = s <> "" && s.[0] <> '_' && not (is_lowercase s.[0]) + +let rec fold_lines f init chan = + try + let line = input_line chan in + fold_lines f (f init line) chan + with End_of_file -> init +let readlines chan = List.rev (fold_lines (fun l e -> e::l) [] chan) + +let split_at c s = + let rec split_at_ accu i = + try + let i' = String.index_from s i c in + split_at_ (String.sub s i (i' - i) :: accu) (i'+1) + with Not_found -> rev (skip_n_char i s :: accu) + in + split_at_ [] 0 + +let split_at2 c1 c2 s = + let rec split_at2_ accu i i2 = + try + let i3 = String.index_from s i2 c1 in + if s.[i3+1] = c2 then split_at2_ (String.sub s i (i3 - i) :: accu) (i3+2) (i3+2) else + split_at2_ accu i i3 + with Not_found | Invalid_argument _ -> rev (skip_n_char i s :: accu) + in + split_at2_ [] 0 0 + +let words s = + let rec words_ accu i s = + try + let i2 = non_index_from s i ' ' in + try + let i3 = String.index_from s i2 ' ' in + words_ (String.sub s i2 (i3 - i2) :: accu) (i3+1) s + with Not_found -> rev (skip_n_char i2 s :: accu) + with Invalid_argument _ -> rev accu + in + collect (words_ [] 0) (split_at '\n' s) + +let to_CamelCase s_ = + let l = ref [] in + let s = String.copy s_ in + for i = 1 to String.length s - 1 do + if is_uppercase (String.unsafe_get s i) && is_lowercase (String.unsafe_get s (i-1)) then ( + String.set s i (Char.lowercase (String.get s i)) ; + l := i :: !l + ) + done ; + if !l = [] then None else + let offset, s' = fold_left (fun (offset, s') i -> + i, s' ^ String.sub s offset (i-offset) ^ "_" + ) (0, "") (rev !l) in + Some (s' ^ String.sub s offset (String.length s - offset)) + +let concat_symlink file link = + if str_begins_with "..//" link then (* ..//foo => /foo *) + skip_n_char 3 link + else + let file = if str_ends_with file "/" then chop file else file in (* s|/$|| *) + let rec reduce file link = + if str_begins_with "../" link then + let file = String.sub file 0 (String.rindex file '/') in (* s|/[^/]+$|| *) + reduce file (skip_n_char 3 link) + else + file ^ "/" ^ link + in + reduce file link + +let expand_symlinks file = + match split_at '/' file with + | "" :: l -> + let rec remove_dotdot accu nb = function + | [] -> if nb = 0 then accu else failwith "remove_dotdot" + | ".." :: l -> remove_dotdot accu (nb + 1) l + | e :: l -> if nb > 0 then remove_dotdot accu (nb - 1) l else remove_dotdot (e :: accu) nb l + in + let l = remove_dotdot [] 0 (List.rev l) in + List.fold_left (fun file piece -> + fix_point (fun file -> + try concat_symlink file ("../" ^ Unix.readlink file) + with _ -> file + ) (file ^ "/" ^ piece)) "" l + | _ -> internal_error (Printf.sprintf "expand_symlinks: %s is relative\n" file) + +let mtime f = (Unix.stat f).Unix.st_mtime + +let rec updir dir nb = + if nb = 0 then dir else + match dir with + | "." -> String.concat "/" (times ".." nb) + | _ -> + if Filename.basename dir = ".." then + dir ^ "/" ^ String.concat "/" (times ".." nb) + else + updir (Filename.dirname dir) (nb-1) + +let (string_of_ref : 'a ref -> string) = fun r -> + Printf.sprintf "0x%x" (Obj.magic r : int) + +let print_endline_flush s = print_endline s ; flush stdout + +let is_int n = n = floor n + +(* total order *) +let rec compare_lists cmp l1 l2 = + match l1, l2 with + | [], [] -> 0 + | [], _ -> -1 + | _, [] -> 1 + | e1::l1, e2::l2 -> + match cmp e1 e2 with + | 0 -> compare_lists cmp l1 l2 + | v -> v + +let compare_best a b = + match a, b with + | 0, 0 -> 0 + | 1, 1 | 1, 0 | 0, 1 -> 1 + | -1, -1 | -1, 0 | 0, -1 -> -1 + | 1, -1 | -1, 1 -> raise Not_comparable + | _ -> failwith "uh?" + +(* partial order *) +let combine_comparison_list l = + fold_left compare_best 0 l + +let min_with_cmp less_than a b = + if less_than a b then a + else if less_than b a then b + else raise Not_comparable + +let max_with_cmp less_than a b = + if less_than a b then b + else if less_than b a then a + else raise Not_comparable + +let rec fold_left2_compare f e l1 l2 = + match l1, l2 with + | [], [] -> e + | e1::l1, e2::l2 -> fold_left2_compare f (f e e1 e2) l1 l2 + | _ -> raise Not_comparable + +let rec exists_compare cmp = function + | [] -> raise Not_comparable + | e :: l -> try cmp e with Not_comparable -> exists_compare cmp l + +let forall_compare cmp = fold_left (fun n e -> compare_best n (cmp e)) 0 +let forall2_compare cmp = fold_left2_compare (fun n e1 e2 -> compare_best n (cmp e1 e2)) 0 + +let exists2_compare left_dropping cmp l1 l2 = + let rec forall_compare_ n = function + | [], [] -> n + | _, [] -> compare_best n left_dropping + | [], _ -> compare_best n (-left_dropping) + | e1::l1, e2::l2 -> + match try Some (cmp e1 e2) with Not_comparable -> None with + | Some n' -> forall_compare_ (compare_best n n') (l1, l2) + | None -> + if n = left_dropping then + forall_compare_ left_dropping (l1, e2::l2) + else if n = -left_dropping then + forall_compare_ (-left_dropping) (e1::l1, l2) + else + (* need to try both *) + try forall_compare_ left_dropping (l1, e2::l2) + with Not_comparable -> forall_compare_ (-left_dropping) (e1::l1, l2) + in forall_compare_ 0 (l1, l2) + + +let rec compare_sorted_sets is_same l1 l2 = + match l1, l2 with + | [], [] -> 0 + | [], _ -> -1 + | _, [] -> 1 + | e1::l1, e2::l2 -> if is_same e1 e2 then compare_sorted_sets is_same l1 l2 else raise Not_found + +let scan_list_while_modifying f l = + let rec scan_list_while_modifying_ prev = function + | [] -> prev + | e :: next -> + let prev', next' = some_or (f prev next e) (prev @ [e], next) in + scan_list_while_modifying_ prev' next' + in scan_list_while_modifying_ [] l + +let bools2compare = function + | true, true -> 0 + | true, false -> -1 + | false, true -> 1 + | _ -> raise Not_comparable + +let lpush l e = l := e :: !l + +(* +let is_greater2compare is_greater a b = + match is_greater a b, is_greater b a with + + *) + +module OrderedString = + struct + type t = string + let compare = compare + end;; + +module StringSet = Set.Make(OrderedString);; + +let stringSet_to_list = StringSet.elements +let stringSet_add set e = StringSet.add e set +let stringSet_difference = StringSet.diff +let list_to_StringSet l = fold_left stringSet_add StringSet.empty l + +(* this character messes emacs caml mode *) +let char_quote = '"' diff --git a/src/common.mli b/src/common.mli new file mode 100644 index 0000000..86a13cd --- /dev/null +++ b/src/common.mli @@ -0,0 +1,276 @@ +exception Found +exception Not_comparable +exception GraphSort_circular_deps +type ('a, 'b) either = Left of 'a | Right of 'b +type ('a, 'b) or_option = Or_some of 'a | Or_error of 'b +val internal_error : string -> 'a +val id : 'a -> 'a +val double : 'a -> 'a * 'a +val swap : 'a * 'b -> 'b * 'a +val safe_tl : 'a list -> 'a list +val fstfst : ('a * 'b) * 'c -> 'a +val sndfst : ('a * 'b) * 'c -> 'b +val fstsnd : 'a * ('b * 'c) -> 'b +val sndsnd : 'a * ('b * 'c) -> 'c +val fst3 : 'a * 'b * 'c -> 'a +val snd3 : 'a * 'b * 'c -> 'b +val ter3 : 'a * 'b * 'c -> 'c +val sndter3 : 'a * 'b * 'c -> 'b * 'c +val o : ('a -> 'b) -> ('c -> 'a) -> 'c -> 'b +val curry : ('a * 'b -> 'c) -> 'a -> 'b -> 'c +val uncurry : ('a -> 'b -> 'c) -> 'a * 'b -> 'c +val uncons : 'a list -> 'a * 'a list +val has_env : string -> bool +val some : 'a option -> 'a +val some_or : 'a option -> 'a -> 'a +val option2l : 'a option -> 'a list +val prefer_some : ('a -> 'a -> 'a) -> 'a option -> 'a option -> 'a option +val collect_accu : ('a -> 'b list) -> 'b list -> 'a list -> 'b list +val collect : ('a -> 'b list) -> 'a list -> 'b list +val merge_some : ('a -> 'a -> 'a) -> 'a option -> 'a option -> 'a option +val uniq : 'a list -> 'a list +val uniq_ : ('a -> 'a -> bool) -> 'a list -> 'a list +val non_uniq : 'a list -> 'a list +val member_ : ('a -> 'b -> bool) -> 'a -> 'b list -> bool +val find_some : ('a -> 'b option) -> 'a list -> 'b +val fold_left1 : ('a -> 'a -> 'a) -> 'a list -> 'a +val find_index : 'a -> 'a list -> int +val find_some_ : ('a -> 'b option) -> 'a list -> 'b option +val fpartition : ('a -> 'b option) -> 'a list -> 'b list * 'a list +val partition_either : + ('a -> ('b, 'c) either) -> 'a list -> 'b list * 'c list +val keep_best : ('a * 'a -> 'a option) -> 'a list -> 'a list +val keep_bests : ('a * 'a -> 'a option) -> 'a list -> 'a list +val fold_right1 : ('a -> 'a -> 'a) -> 'a list -> 'a +val for_all2_ : ('a -> 'b -> bool) -> 'a list -> 'b list -> bool +val for_all2_true : ('a -> 'b -> bool) -> 'a list -> 'b list -> bool +val maxl : 'a list -> 'a +val stack2list : 'a Stack.t -> 'a list +val stack_exists : ('a -> bool) -> 'a Stack.t -> bool +val queue2list : 'a Queue.t -> 'a list +val fix_point : ('a -> 'a) -> 'a -> 'a +val fix_point_withenv : ('a -> 'b -> 'b * 'a) -> 'a -> 'b -> 'b * 'a +val fix_point_ : int -> ('a -> 'a) -> 'a -> 'a * int +val group_by_2 : 'a list -> ('a * 'a) list +val fluid_let : 'a ref -> 'a -> (unit -> 'b) -> 'b +val do0_withenv : + (('a -> unit) -> 'b -> 'c) -> ('d -> 'a -> 'd) -> 'd -> 'b -> 'd +val do0_withenv2 : + (('a -> 'b -> unit) -> 'c -> 'd) -> + ('e -> 'a -> 'b -> 'e) -> 'e -> 'c -> 'e +val do_withenv : + (('a -> 'b) -> 'c -> 'd) -> ('e -> 'a -> 'b * 'e) -> 'e -> 'c -> 'd * 'e +val do2_withenv : + (('a -> 'b -> 'c) -> 'd -> 'e -> 'f) -> + ('g -> 'a -> 'b -> 'c * 'g) -> 'g -> 'd -> 'e -> 'f * 'g +val do_collect : + (('a -> 'b -> unit) -> 'c -> 'd) -> ('a -> 'b -> 'e list) -> 'c -> 'e list +val map_withitself : ('a list -> 'a -> 'a) -> 'a list -> 'a list +val map_t2 : ('a -> 'b) -> 'a * 'a -> 'b * 'b +val map_t3 : ('a -> 'b) -> 'a * 'a * 'a -> 'b * 'b * 'b +val map_option : ('a -> 'b) -> 'a option -> 'b option +val map_optionoption : ('a -> 'b option) -> 'a option -> 'b option +val t2_option2option_t2 : 'a option * 'b option -> ('a * 'b) option +val l_option2option_l : 'a option list -> 'a list option +val map_option_env : ('a -> 'b) -> 'a option * 'c -> 'b option * 'c +val t2_to_list : 'a * 'a -> 'a list +val t3_to_list : 'a * 'a * 'a -> 'a list +val if_some : bool -> 'a -> 'a option +val fold_left_option : ('a -> 'b -> 'a option) -> 'a -> 'b list -> 'a option +val collect_some_withenv : + ('a -> 'b -> 'c option * 'a) -> 'a -> 'b list -> 'c list * 'a +val for_all_option_withenv : + ('a list -> 'b) -> + ('c -> 'd -> 'a option * 'c) -> 'c -> 'd list -> 'b option * 'c +val for_all2_option_withenv : + ('a list -> 'b) -> + ('c -> 'd -> 'e -> 'a option * 'c) -> + 'c -> 'd list -> 'e list -> 'b option * 'c +val map_or_option : ('a -> 'b) -> ('a, 'c) or_option -> ('b, 'c) or_option +val map_index : ('a -> int -> 'b) -> 'a list -> 'b list +val filter_index : ('a -> int -> bool) -> 'a list -> 'a list +val iter_index : ('a -> int -> 'b) -> 'a list -> unit +val map_fst : ('a -> 'b) -> 'a * 'c -> 'b * 'c +val map_snd : ('a -> 'b) -> 'c * 'a -> 'c * 'b +val map_withenv : ('a -> 'b -> 'c * 'a) -> 'a -> 'b list -> 'c list * 'a +val find_withenv : ('a -> 'b -> bool * 'a) -> 'a -> 'b list -> 'b * 'a +val filter_withenv : ('a -> 'b -> bool * 'a) -> 'a -> 'b list -> 'b list * 'a +val exists_withenv : ('a -> 'b -> bool * 'a) -> 'a -> 'b list -> bool * 'a +val map_t2_withenv : ('a -> 'b -> 'c * 'a) -> 'a -> 'b * 'b -> ('c * 'c) * 'a +val for_all_withenv : ('a -> 'b -> bool * 'a) -> 'a -> 'b list -> bool * 'a +val collect_withenv : + ('a -> 'b -> 'c list * 'a) -> 'a -> 'b list -> 'c list * 'a +val partition_either_withenv : + ('a -> 'b -> ('c, 'd) either * 'a) -> + 'a -> 'b list -> ('c list * 'd list) * 'a +val map2_withenv : + ('a -> 'b -> 'c -> 'd * 'a) -> 'a -> 'b list -> 'c list -> 'd list * 'a +val for_all2_withenv : + ('a -> 'b -> 'c -> bool * 'a) -> 'a -> 'b list -> 'c list -> bool * 'a +val take : int -> 'a list -> 'a list +val last_n : int -> 'a list -> 'a list +val last : 'a list -> 'a +val skipfirst : 'a -> 'a list -> 'a list +val removelast : 'a list -> 'a list +val split_last : 'a list -> 'a list * 'a +val iter_assoc_val : ('a -> unit) -> ('b * 'a) list -> unit +val map_assoc_val : ('a -> 'b) -> ('c * 'a) list -> ('c * 'b) list +val assoc_or_fail : 'a -> ('a * 'b) list -> 'b +val assoc_by : ('a -> 'b -> bool) -> 'a -> ('b * 'c) list -> 'c +val update_assoc_by : + ('a -> 'b -> bool) -> ('c -> 'c) -> 'a -> ('b * 'c) list -> ('b * 'c) list +val update_assoc : ('a -> 'a) -> 'b -> ('b * 'a) list -> ('b * 'a) list +val update_assoc_by_with_default : + 'a -> + ('b -> 'b -> bool) -> ('a -> 'a) -> 'b -> ('b * 'a) list -> ('b * 'a) list +val update_all_assoc_by : + ('a -> 'b -> bool) -> ('c -> 'c) -> 'a -> ('b * 'c) list -> ('b * 'c) list +val rassoc : 'a -> ('b * 'a) list -> 'b +val all_assoc : 'a -> ('a * 'b) list -> 'b list +val all_assoc_by : ('a -> 'b -> bool) -> 'a -> ('b * 'c) list -> 'c list +val prepare_want_all_assoc : ('a * 'b) list -> ('a * 'b list) list +val prepare_want_all_assoc_by : + ('a -> 'a -> bool) -> ('a * 'a) list -> ('a * 'a list) list +val prepare_want_all_assoc_by_ : + ('a -> 'a -> bool) -> + ('b -> 'b -> bool) -> ('a * 'b) list -> ('a * 'b list) list +val count_uniq : 'a list -> ('a * int) list +val repeat : 'a -> int -> 'a list +val inits : 'a list -> 'a list list +val tails : 'a list -> 'a list list +val apply : ('a -> 'b) -> 'a -> 'b +val map3 : ('a -> 'b -> 'c -> 'd) -> 'a list -> 'b list -> 'c list -> 'd list +val filter2 : ('a * 'b -> bool) -> 'a list -> 'b list -> 'a list * 'b list +val break_at : ('a -> bool) -> 'a list -> 'a list * 'a list +val break : 'a -> 'a list -> 'a list * 'a list +val drop_while : ('a -> bool) -> 'a list -> 'a list +val break_at_indice : int -> 'a list -> 'a list * 'a list +val rev_nth : 'a -> 'a list -> int +val getset_nth : 'a list -> int -> ('a -> 'a) -> 'a list +val set_nth : 'a list -> int -> 'a -> 'a list +val adjustModDown : int -> int -> int +val adjustModUp : int -> int -> int +val hashtbl_find : ('a -> 'b -> bool) -> ('a, 'b) Hashtbl.t -> 'a +val hashtbl_map : ('a -> 'b -> 'b) -> ('a, 'b) Hashtbl.t -> unit +val hashtbl_values : ('a, 'b) Hashtbl.t -> 'b list +val hashtbl_keys : ('a, 'b) Hashtbl.t -> 'a list +val hashtbl_to_list : ('a, 'b) Hashtbl.t -> ('a * 'b) list +val hashtbl_collect : ('a -> 'b -> 'c list) -> ('a, 'b) Hashtbl.t -> 'c list +val hashtbl_exists : ('a -> 'b -> bool) -> ('a, 'b) Hashtbl.t -> bool +val memoize : ('a -> 'b) -> 'a -> 'b +val array_shift : 'a array -> 'a array +val array_last_n : int -> 'a array -> 'a array +val array_collect : ('a -> 'b list) -> 'a array -> 'b list +val lvector_product : 'a list list -> 'a list list +val vector_product2 : 'a list -> 'a list -> ('a * 'a) list +val transpose : 'a list list -> 'a list list +val range : int -> int -> int list +val sum : int list -> int +val filter_some_with : ('a -> 'b option) -> 'a list -> 'b list +val filter_some : 'a option list -> 'a list +val difference : 'a list -> 'a list -> 'a list +val difference_ : ('a -> 'b -> bool) -> 'b list -> 'a list -> 'b list +val intersection_by : ('a -> 'b -> bool) -> 'a list -> 'b list -> 'a list +val intersection_and_differences : + ('a -> 'b -> bool) -> 'b list -> 'a list -> 'a list * 'b list * 'a list +val triangularize : 'a list -> ('a * 'a list) list +val diagonalize : 'a list -> ('a * 'a list) list +val list_of_nonempty_sublists : 'a list -> 'a list list +val graph_is_sorted_by : ('a -> 'b -> bool) -> ('b * 'a list) list -> bool +val graph_closure_by : + ('a -> 'a -> bool) -> + ('a * 'a list) list -> (('a * 'a list) list, 'a * 'a) or_option +val graph_sort_by : + ('a -> 'a -> bool) -> + ('a * 'a list) list -> (('a * 'a list) list, 'a * 'a) or_option +val int_sort : int list -> int list +val str_begins_with : string -> string -> bool +val strstr : string -> string -> int +val str_contains : string -> string -> bool +val str_ends_with : string -> string -> bool +val chop : string -> string +val chomps : string -> string +val times : 'a -> int -> 'a list +val skip_n_char_ : int -> int -> string -> string +val skip_n_char : int -> string -> string +val non_index_from : string -> int -> char -> int +val non_index : string -> char -> int +val non_rindex_from : string -> int -> char -> int +val non_rindex : string -> char -> int +val explode_string : string -> char list +val count_matching_char : string -> char -> int +val is_uppercase : char -> bool +val is_lowercase : char -> bool +val char_is_alphanumerical : char -> bool +val char_is_alphanumerical_ : char -> bool +val char_is_alpha : char -> bool +val char_is_number : char -> bool +val count_chars_in_string : string -> char -> int +val string_fold_left : ('a -> char -> 'a) -> 'a -> string -> 'a +val string_forall_with : (char -> bool) -> int -> string -> bool +val starts_with_non_lowercase : string -> bool +val fold_lines : ('a -> string -> 'a) -> 'a -> in_channel -> 'a +val readlines : in_channel -> string list +val split_at : char -> string -> string list +val split_at2 : char -> char -> string -> string list +val words : string -> string list +val to_CamelCase : string -> string option +val concat_symlink : string -> string -> string +val expand_symlinks : string -> string +val mtime : string -> float +val updir : string -> int -> string +val string_of_ref : 'a ref -> string +val print_endline_flush : string -> unit +val is_int : float -> bool +val compare_lists : ('a -> 'b -> int) -> 'a list -> 'b list -> int +val compare_best : int -> int -> int +val combine_comparison_list : int list -> int +val min_with_cmp : ('a -> 'a -> bool) -> 'a -> 'a -> 'a +val max_with_cmp : ('a -> 'a -> bool) -> 'a -> 'a -> 'a +val fold_left2_compare : + ('a -> 'b -> 'c -> 'a) -> 'a -> 'b list -> 'c list -> 'a +val exists_compare : ('a -> 'b) -> 'a list -> 'b +val forall_compare : ('a -> int) -> 'a list -> int +val forall2_compare : ('a -> 'b -> int) -> 'a list -> 'b list -> int +val exists2_compare : int -> ('a -> 'b -> int) -> 'a list -> 'b list -> int +val compare_sorted_sets : ('a -> 'b -> bool) -> 'a list -> 'b list -> int +val scan_list_while_modifying : + ('a list -> 'a list -> 'a -> ('a list * 'a list) option) -> + 'a list -> 'a list +val bools2compare : bool * bool -> int +val lpush : 'a list ref -> 'a -> unit +module OrderedString : sig type t = string val compare : 'a -> 'a -> int end +module StringSet : + sig + type elt = OrderedString.t + type t = Set.Make(OrderedString).t + val empty : t + val is_empty : t -> bool + val mem : elt -> t -> bool + val add : elt -> t -> t + val singleton : elt -> t + val remove : elt -> t -> t + val union : t -> t -> t + val inter : t -> t -> t + val diff : t -> t -> t + val compare : t -> t -> int + val equal : t -> t -> bool + val subset : t -> t -> bool + val iter : (elt -> unit) -> t -> unit + val fold : (elt -> 'a -> 'a) -> t -> 'a -> 'a + val for_all : (elt -> bool) -> t -> bool + val exists : (elt -> bool) -> t -> bool + val filter : (elt -> bool) -> t -> t + val partition : (elt -> bool) -> t -> t * t + val cardinal : t -> int + val elements : t -> elt list + val min_elt : t -> elt + val max_elt : t -> elt + val choose : t -> elt + val split : elt -> t -> t * bool * t + end +val stringSet_to_list : StringSet.t -> StringSet.elt list +val stringSet_add : StringSet.t -> StringSet.elt -> StringSet.t +val stringSet_difference : StringSet.t -> StringSet.t -> StringSet.t +val list_to_StringSet : StringSet.elt list -> StringSet.t +val char_quote : char diff --git a/src/config_file.ml b/src/config_file.ml new file mode 100644 index 0000000..a5ee94f --- /dev/null +++ b/src/config_file.ml @@ -0,0 +1,40 @@ +open Common + +type config_file = { + basedir : int option ; + } + +let ignored_packages = ref [] + +let default = { basedir = None } + + +let config_cache = Hashtbl.create 16 + +let read dir = + try Hashtbl.find config_cache dir with Not_found -> + try + let file_name = dir ^ "/.perl_checker" in + let fh = open_in file_name in + let config = + fold_lines (fun config line -> + match words line with + | [ "Basedir"; ".." ] -> { config with basedir = Some 1 } + | [ "Basedir"; "../.." ] -> { config with basedir = Some 2 } + | [] -> config (* blank line *) + | [ "Ignore"; pkg ] + | [ pkg ] (* the deprecated form *) + -> lpush ignored_packages pkg; config + | _ -> prerr_endline (Printf.sprintf "bad line \"%s\" in %s" line file_name); config + ) default fh + in + Hashtbl.add config_cache dir config ; + if !Flags.verbose then print_endline_flush ("reading config file " ^ file_name); + config + with Sys_error _ -> default + + +let rec read_any dir depth = + if depth = 0 then () else + let _ = read dir in + read_any (updir dir 1) (depth - 1) diff --git a/src/config_file.mli b/src/config_file.mli new file mode 100644 index 0000000..d5ad2f2 --- /dev/null +++ b/src/config_file.mli @@ -0,0 +1,6 @@ +type config_file = { basedir : int option; } +val ignored_packages : string list ref +val default : config_file +val config_cache : (string, config_file) Hashtbl.t +val read : string -> config_file +val read_any : string -> int -> unit diff --git a/src/flags.ml b/src/flags.ml new file mode 100644 index 0000000..187c140 --- /dev/null +++ b/src/flags.ml @@ -0,0 +1,43 @@ +open Common +open Types + +let verbose = ref false +let quiet = ref false +let generate_pot = ref false +let expand_tabs = ref (Some 8) +let no_cache = ref false + +let check_unused_global_vars = ref false +let check_white_space = ref true +let check_suggest_simpler = ref true +let check_void = ref true +let check_context = ref true +let check_strange = ref true +let check_traps = ref true +let check_complex_expressions = ref true +let normalized_expressions = ref true +let check_help_perl_checker = ref true +let suggest_functional = ref true +let check_prototypes = ref true +let check_names = ref true +let check_import_export = ref true +let allow_MDK_Common = ref true + +let is_warning_type_set = function + | Warn_white_space -> !check_white_space + | Warn_suggest_simpler -> !check_suggest_simpler + | Warn_unused_global_vars -> !check_unused_global_vars + | Warn_void -> !check_void + | Warn_context -> !check_context + | Warn_strange -> !check_strange + | Warn_traps -> !check_traps + | Warn_complex_expressions -> !check_complex_expressions + | Warn_normalized_expressions -> !normalized_expressions + | Warn_suggest_functional -> !suggest_functional + | Warn_prototypes -> !check_prototypes + | Warn_names -> !check_names + | Warn_import_export -> !check_import_export + | Warn_MDK_Common -> !allow_MDK_Common + | Warn_help_perl_checker -> !check_help_perl_checker + +let are_warning_types_set l = not !quiet && List.for_all is_warning_type_set l diff --git a/src/flags.mli b/src/flags.mli new file mode 100644 index 0000000..2dc3b26 --- /dev/null +++ b/src/flags.mli @@ -0,0 +1,22 @@ +val verbose : bool ref +val quiet : bool ref +val generate_pot : bool ref +val expand_tabs : int option ref +val no_cache : bool ref +val check_unused_global_vars : bool ref +val check_white_space : bool ref +val check_suggest_simpler : bool ref +val check_void : bool ref +val check_context : bool ref +val check_strange : bool ref +val check_traps : bool ref +val check_complex_expressions : bool ref +val normalized_expressions : bool ref +val check_help_perl_checker : bool ref +val suggest_functional : bool ref +val check_prototypes : bool ref +val check_names : bool ref +val check_import_export : bool ref +val allow_MDK_Common : bool ref +val is_warning_type_set : Types.warning -> bool +val are_warning_types_set : Types.warning list -> bool diff --git a/src/global_checks.ml b/src/global_checks.ml new file mode 100644 index 0000000..a63e652 --- /dev/null +++ b/src/global_checks.ml @@ -0,0 +1,639 @@ +open Types +open Common +open Printf +open Config_file +open Parser_helper +open Tree + +type state = { + per_files : (string, per_file) Hashtbl.t ; + per_packages : (string, per_package) Hashtbl.t ; + methods : (string, (string * variable_used ref * prototype option) list) Hashtbl.t ; + global_vars_used : ((context * string * string) * pos) list ref ; + packages_being_classes : (string, unit) Hashtbl.t ; + packages_dependencies : (string * string, unit) Hashtbl.t ; + packages_dependencies_maybe : (string * string * string, unit) Hashtbl.t ; + } + +type vars = { + my_vars : ((context * string) * (pos * variable_used ref * prototype option)) list list ; + our_vars : ((context * string) * (pos * variable_used ref * prototype option)) list list ; + locally_imported : ((context * string) * (string * variable_used ref * prototype option)) list ; + required_vars : (context * string * string) list ; + current_package : per_package ; + is_toplevel : bool ; + write_only : bool ; + state : state ; + } + + +let rec get_imported state current_package (package_name, (imports, pos)) = + try + let package_used = Hashtbl.find state.per_packages package_name in + let exports = package_used.exports in + let get_var_by_name var = + let (b, prototype) = + try sndter3 (Hashtbl.find package_used.vars_declared var) + with Not_found -> + try + sndter3 (List.assoc var (get_imports state package_used)) + with Not_found -> + warn_with_pos [Warn_import_export] pos (sprintf "name %s is not defined in package %s" (variable2s var) package_name) ; + ref Access_various, None + in + var, (package_name, b, prototype) + in + match imports with + | None -> + let re = match exports.special_export with + | Some Re_export_all -> get_imports state package_used + | Some Fake_export_all -> + (* HACK: if package exporting-all is ignored, ignore package importing *) + if List.mem package_name !ignored_packages then Tree.ignore_package current_package.package_name; + + Hashtbl.fold (fun var (_pos, b, proto) l -> (var, (package_name, b, proto)) :: l) package_used.vars_declared [] + | _ -> [] in + let l = List.map get_var_by_name exports.export_auto in + re @ l + | Some l -> + let imports_vars = + collect (function + | I_raw, tag -> + (try + List.assoc tag exports.export_tags + with Not_found -> warn_with_pos [Warn_import_export] pos (sprintf "package %s doesn't export tag %s" package_name tag) ; []) + | variable -> + if List.mem variable exports.export_ok || List.mem variable exports.export_auto then + [ variable ] + else + (warn_with_pos [Warn_import_export] pos (sprintf "package %s doesn't export %s" package_name (variable2s variable)) ; []) + ) l + in + List.map get_var_by_name imports_vars + with Not_found -> [] + +and get_imports state package = + match !(package.imported) with + | Some l -> l + | None -> + let l = collect (get_imported state package) package.uses in + package.imported := Some l ; + l + +let do_para_comply_with_prototype para proto = + match proto with + | Some proto -> + (match para with + | [] as paras + | [List [List paras]] + | [List paras] -> + if List.exists is_not_a_scalar paras then 0 else + let len = List.length paras in + if len < proto.proto_nb_min then -1 + else (match proto.proto_nb_max with + | Some max -> if len > max then 1 else 0 + | None -> 0) + | _ -> 0) + | _ -> 0 + +let check_para_comply_with_prototype para proto = + match para with + | None -> () + | Some(pos, para) -> + match do_para_comply_with_prototype para proto with + | -1 -> warn_with_pos [Warn_prototypes] pos "not enough parameters" + | 1 -> warn_with_pos [Warn_prototypes] pos "too many parameters" + | _ -> () + +let is_anonymous_variable_name s = String.length s > 1 && s.[0] = '_' + +let add_to_packages_really_used state current_package used_name = + Hashtbl.replace state.packages_dependencies (current_package.package_name, used_name) () ; + (*List.iter (fun (p1, p2) -> prerr_endline (Printf.sprintf "%s -> %s" p1 p2)) (hashtbl_keys state.packages_dependencies);*) + () + +let add_to_packages_maybe_used state current_package used_name method_name = + Hashtbl.replace state.packages_dependencies_maybe (current_package.package_name, used_name, method_name) () ; + (*List.iter (fun (p1, p2) -> prerr_endline (Printf.sprintf "%s -> %s" p1 p2)) (hashtbl_keys state.packages_dependencies_maybe);*) + () + +let variable_used write_only used = + if !used != Access_various then + used := if write_only then Access_write_only else Access_various + +let is_my_declared vars t = + List.exists (fun l -> + List.mem_assoc t l && (variable_used vars.write_only (snd3 (List.assoc t l)) ; true) + ) vars.my_vars +let is_our_declared vars t = + List.exists (fun l -> + List.mem_assoc t l && (variable_used vars.write_only (snd3 (List.assoc t l)) ; true) + ) vars.our_vars + +let is_var_declared_raw write_only state package var para = + match + try + let _, used, proto = Hashtbl.find package.vars_declared var in + Some(used, proto) + with Not_found -> try + let package_name, used, proto = List.assoc var (get_imports state package) in + add_to_packages_really_used state package package_name ; + Some(used, proto) + with Not_found -> + None + with + | Some (used, proto) -> + check_para_comply_with_prototype para proto ; + variable_used write_only used ; + true + | None -> + false + +let is_var_declared vars var para = + List.mem_assoc var vars.locally_imported || + is_var_declared_raw vars.write_only vars.state vars.current_package var para + +let is_global_var_declared vars (context, fq, name) para = + try + let package = Hashtbl.find vars.state.per_packages fq in + add_to_packages_really_used vars.state vars.current_package package.package_name ; + is_var_declared_raw vars.write_only vars.state package (context, name) para + with Not_found -> false + + +let is_global_var context ident = + match context with + | I_scalar -> + (match ident with + | "@" | "!" | ">" | "\\" | "$" | "^A" | "'" | "/" | "?" | "<" | "^W" | "|" | "^I" | "&" | "." + | "0" | "1" | "2" | "3" | "4" | "5" | "6" | "7" | "8" | "9" -> true + | _ -> false) + | I_array -> + (match ident with + | "ARGV" | "INC" -> true + | _ -> false) + | I_hash -> + (match ident with + | "ENV" | "SIG" -> true + | _ -> false) + | I_star -> + (match ident with + | "STDIN" | "STDOUT" | "STDERR" | "DATA" + | "__FILE__" | "__LINE__" | "undef" -> true + | _ -> false) + | I_func -> + (match ident with + | "-b" | "-c" | "-d" | "-e" | "-f" | "-l" | "-r" | "-s" | "-w" | "-x" + | "abs" | "alarm" | "atan2" | "bless" + | "caller" | "chdir" | "chmod" | "chomp" | "chop" | "chown" | "chr" | "chroot" | "close" | "closedir" | "cos" | "crypt" + | "defined" | "delete" | "die" + | "each" | "endpwent" | "eof" | "eval" | "exec" | "exists" | "exit" + | "fcntl" | "fileno" | "flock" | "formline" | "fork" + | "gethostbyaddr" | "gethostbyname" | "getgrent" | "getgrnam" | "getgrgid" | "getppid" | "getpwent" | "getpwnam" | "getpwuid" | "getservbyname" | "glob" | "gmtime" | "goto" | "grep" | "hex" + | "index" | "int" | "ioctl" | "join" | "keys" | "kill" + | "last" | "lc" | "lcfirst" | "length" | "link" | "localtime" | "log" | "lstat" + | "map" | "mkdir" | "next" | "no" | "oct" | "open" | "opendir" | "ord" + | "pack" | "pipe" | "pop" | "print" | "printf" | "push" | "quotemeta" + | "rand" | "read" | "readdir" | "readlink" | "redo" | "ref" | "rename" | "require" | "return" | "reverse" | "rindex" | "rmdir" + | "scalar" | "seek" | "select" | "setpwent" | "shift" | "sin" | "sleep" | "sort" | "splice" | "split" | "sprintf" | "sqrt" | "stat" | "substr" + | "symlink" | "syscall" | "sysopen" | "sysread" | "sysseek" | "system" | "syswrite" | "tie" | "time" + | "uc" | "ucfirst" | "umask" | "undef" | "unlink" | "unpack" | "unshift" | "utime" | "values" | "vec" | "wait" | "waitpid" | "wantarray" | "warn" | "write" + -> true + + | _ -> false) + | _ -> false + +let check_variable (context, var) vars para = + match var with + | Ident(_, s, pos) when context <> I_func && is_anonymous_variable_name s && s <> "__FILE__" && s <> "__LINE__" -> + warn_with_pos [Warn_normalized_expressions] pos (sprintf "variable %s must not be used\n (variable with name _XXX are reserved for unused variables)" (variable2s(context, string_of_fromparser var))) + | Ident(Some pkg, _, _) when uses_external_package pkg || List.mem pkg !ignored_packages -> () + | Ident(None, ident, pos) -> + if is_my_declared vars (context, ident) || is_our_declared vars (context, ident) || is_var_declared vars (context, ident) para || is_global_var context ident + then () + else warn_with_pos [Warn_names] pos (if context = I_func then "unknown function " ^ ident else "undeclared variable " ^ variable2s(context, ident)) + | Ident(Some fq, name, pos) -> + if (fq = "CORE") && is_global_var context name || is_global_var_declared vars (context, fq, name) para + then () + else + if context = I_func then + warn_with_pos [Warn_names] pos ("unknown function " ^ string_of_fromparser var) + else + lpush vars.state.global_vars_used ((context, fq, name), pos) + | _ -> () + +let declare_My vars (mys, pos) = + let l_new = List.filter (fun (context, ident) -> + if context = I_raw then + if ident = "undef" then false else die_with_pos pos (sprintf "bad ident %s in my" ident) + else true + ) mys in + let l_pre = List.hd vars.my_vars in + List.iter (fun v -> + if List.mem_assoc v l_pre then warn_with_pos [Warn_names] pos (sprintf "redeclared variable %s" (variable2s v)) + ) l_new ; + { vars with my_vars = (List.map (fun v -> v, (pos, ref Access_none, None)) l_new @ l_pre) :: List.tl vars.my_vars } + +let declare_Our vars (ours, pos) = + match vars.our_vars with + | [] -> vars (* we're at the toplevel, already declared in vars_declared *) + | l_pre :: other -> + List.iter (fun v -> + if List.mem_assoc v l_pre && v <> (I_scalar, "_") then warn_with_pos [Warn_names] pos (sprintf "redeclared variable %s" (variable2s v)) + ) ours ; + { vars with our_vars = (List.map (fun v -> v, (pos, ref Access_none, None)) ours @ l_pre) :: other } + +let declare_My_our vars (my_or_our, l, pos) = + match my_or_our with + | "my" -> declare_My vars (l, pos) + | "local" + | "our" -> declare_Our vars (l, pos) + | _ -> internal_error "declare_My_our" + +let un_parenthesize_one_elt_List = function + | [List l] -> l + | l -> l + +let check_unused_local_variables vars = + List.iter (fun ((context, s as v), (pos, used, _proto)) -> + if !used != Access_various then + match s with + | "BEGIN" | "END" | "DESTROY" -> () + | "_" when context = I_array -> + warn_with_pos [Warn_normalized_expressions] pos "if the function doesn't take any parameters, please use the empty prototype.\nexample \"sub foo() { ... }\"" + | _ -> + if s.[0] != '_' || s = "_" then + let msg = if !used = Access_write_only then sprintf "variable %s assigned, but not read" else sprintf "unused variable %s" in + warn_with_pos [Warn_names] pos (msg (variable2s v)) + ) (List.hd vars.my_vars) + +let check_variables vars t = + let rec check_variables_ vars t = fold_tree check vars t + and check vars = function + | Block l -> + let vars' = { vars with my_vars = [] :: vars.my_vars ; our_vars = [] :: vars.our_vars } in + let vars' = List.fold_left check_variables_ vars' l in + check_unused_local_variables vars' ; + Some vars + | Call(Deref(I_func, Ident(None, "sort", _)), (Anonymous_sub(_, Block f, pos) :: l)) -> + let vars = List.fold_left check_variables_ vars l in + let vars' = { vars with my_vars = [ (I_scalar, "a"), (pos, ref Access_various, None) ; (I_scalar, "b"), (pos, ref Access_various, None) ] :: vars.my_vars ; our_vars = [] :: vars.our_vars } in + let vars' = List.fold_left check_variables_ vars' f in + check_unused_local_variables vars' ; + Some vars + + | Call(Deref(I_func, Ident(None, func, func_pos)), Anonymous_sub(_, Block f, pos) :: l) + when List.mem func [ "grep" ; "map" ; "substInFile" ; "map_index" ; "each_index" ; "partition" ; "find_index" ; "grep_index" ; "find" ; "any" ; "every" ; "uniq_" ] -> + let vars = List.fold_left check_variables_ vars l in + let vars' = { vars with my_vars = [] :: vars.my_vars ; our_vars = [(I_scalar, "_"), (pos, ref Access_various, None)] :: vars.our_vars } in + let vars' = List.fold_left check_variables_ vars' f in + check_unused_local_variables vars' ; + check_variable (I_func, Ident(None, func, func_pos)) vars None ; + Some vars + + | Call(Deref(I_func, (Ident _ as ident)), [ Deref(I_star, (Ident(None, "_", _))) ]) -> + (* the &f case: allow access to @_ *) + check_variable (I_func, ident) vars None ; + let _ = is_my_declared vars (I_array, "_") in + Some vars + + | Call(Deref(I_func, (Ident _ as ident)), [ List [ Deref(I_array, (Ident(None, "_", pos))) ] ]) -> + (* special warning if @_ is unbound *) + check_variable (I_func, ident) vars None ; + if not (is_my_declared vars (I_array, "_")) then + warn_with_pos [Warn_suggest_simpler] pos (sprintf "replace %s(@_) with &%s" (string_of_fromparser ident) (string_of_fromparser ident)) ; + Some vars + + | Call(Deref(I_func, Ident(None, "require", _)), [Ident _]) -> Some vars + + | Call(Deref(I_func, Ident(None, "shift", pos)) as var, []) + | Call(Deref(I_func, Ident(None, "pop", pos)) as var, []) -> + check vars (Call(var, [ Deref(I_array, Ident(None, (if vars.is_toplevel then "ARGV" else "_"), pos)) ])) + + | Call(Deref(context, (Ident(_, _, pos) as var)), para) -> + check_variable (context, var) vars (Some(pos, para)) ; + let vars = List.fold_left check_variables_ vars para in + Some vars + +(* | Call_op("=", -> List.fold_left (fold_tree f) env l*) + + | Call_op("while infix", [ expr ; (List [ Call_op("<>", _, _) ] as l) ], pos) + | Call_op("for infix", [ expr ; l ], pos) -> + let vars = check_variables_ vars l in + let vars' = { vars with my_vars = [] :: vars.my_vars ; our_vars = [(I_scalar, "_"), (pos, ref Access_various, None)] :: vars.our_vars } in + let vars' = check_variables_ vars' expr in + if List.hd(vars'.my_vars) <> [] then warn_with_pos [Warn_traps] pos "you can't declare variables in foreach postfix"; + Some vars + + | Call_op("foreach my", [my; expr; Block block], _) -> + let vars = check_variables_ vars expr in + let vars = check_variables_ vars (Block (my :: block)) in + Some vars + | Call_op(op, l, _) when op = "if" || op = "while" || op = "unless" || op = "until" -> + let vars' = { vars with my_vars = [] :: vars.my_vars ; our_vars = [] :: vars.our_vars } in + let vars' = List.fold_left check_variables_ vars' l in + check_unused_local_variables vars' ; + Some vars + + | Sub_declaration(Ident(fq, name, pos) as ident, perl_proto, Block body, kind) -> + let vars = declare_Our vars ([ I_func, string_of_fromparser ident ], pos) in + + let my_vars, l = + match has_proto perl_proto (Block body) with + | Some(mys, mys_pos, body) -> + [], My_our ("my", mys, mys_pos) :: body + | _ -> + let dont_check_use = + kind = Glob_assign || + fq = None && List.mem name ["DESTROY"] || + Hashtbl.mem vars.state.packages_being_classes (some_or fq vars.current_package.package_name) + in + [(I_array, "_"), (pos, ref (if dont_check_use then Access_various else Access_none), None)], body + in + let local_vars = + if fq = None && name = "AUTOLOAD" + then [ (I_scalar, "AUTOLOAD"), (pos, ref Access_various, None) ] + else [] in + + let vars' = { vars with my_vars = my_vars :: vars.my_vars ; our_vars = local_vars :: vars.our_vars ; is_toplevel = false } in + let vars' = List.fold_left check_variables_ vars' l in + check_unused_local_variables vars' ; + Some vars + + | Anonymous_sub(_, Block l, pos) -> + let vars' = { vars with my_vars = [(I_array, "_"), (pos, ref Access_various, None)] :: vars.my_vars ; is_toplevel = false } in + let vars' = List.fold_left check_variables_ vars' l in + check_unused_local_variables vars' ; + Some vars + + | Call_op("foreach", [ expr ; Block l ], pos) -> + let vars = check_variables_ vars expr in + let vars' = { vars with my_vars = [] :: vars.my_vars ; our_vars = [(I_scalar, "_"), (pos, ref Access_various, None)] :: vars.our_vars } in + let vars' = List.fold_left check_variables_ vars' l in + check_unused_local_variables vars' ; + Some vars + + | Anonymous_sub _ + | Sub_declaration _ -> internal_error "check_variables" + + | Ident _ as var -> + check_variable (I_star, var) vars None ; + Some vars + + | My_our(my_or_our, mys, pos) -> Some(declare_My_our vars (my_or_our, mys, pos)) + | Deref(context, (Ident _ as var)) -> + check_variable (context, var) vars None ; + Some vars + | Deref_with(context, _, (Ident _ as var), para) -> + let vars = check_variables_ vars para in + check_variable (context, var) vars None ; + Some vars + + | Call_op("=", [My_our(my_or_our, mys, pos); e], _) -> + (* check e first *) + let vars = check_variables_ vars e in + List.iter (fun (context, var) -> + if non_scalar_context context then warn_with_pos [Warn_prototypes] pos (sprintf "%s takes all the arguments, %s is undef in any case" (variable2s (context, var)) (variable2s (last mys))) + ) (removelast mys) ; (* mys is never empty *) + Some(declare_My_our vars (my_or_our, mys, pos)) + + | Call_op("if infix", [List [My_our _]; List [Num("0", _)]], _) -> None (* special allowed case *) + | Call_op(op, List (My_our _ :: _) :: _, pos) + | Call_op(op, My_our _ :: _, pos) + | Call_op(op, Call_op("local", _, _) :: _, pos) -> + if op <> "=" then warn_with_pos [Warn_traps] pos (sprintf "applying %s on a new initialized variable is wrong" op); + None + + | Call_op("=", [ Deref(context, (Ident _ as var)) ; para], _) -> + check_variable (context, var) { vars with write_only = true } None ; + Some (check_variables_ vars para) + + | Call_op("=", [ List [ List l ] ; para], _) -> + let vars = List.fold_left (fun vars -> function + | Deref(context, (Ident _ as var)) -> + check_variable (context, var) { vars with write_only = true } None ; + vars + | e -> check_variables_ vars e + ) vars l in + let vars = check_variables_ vars para in + Some vars + + | Method_call(Raw_string(package_name, pos), Raw_string ("import", _), para) -> + let args = + match para with + | [] -> None + | [ List [v] ] -> Some(from_qw v) + | _ -> die_with_pos pos "bad import statement" in + let l = get_imported vars.state vars.current_package (package_name, (args, pos)) in + let vars = + if vars.is_toplevel then ( + vars.current_package.imported := Some (get_imports vars.state vars.current_package @ l) ; + vars + ) else + { vars with locally_imported = l @ vars.locally_imported } in + Some vars + + | Method_call(Raw_string(pkg, _) as class_, Raw_string(method_, pos), para) -> + let vars = List.fold_left check_variables_ vars para in + let rec search pkg = + if is_global_var_declared vars (I_func, pkg, method_) (Some(pos, [ List (class_ :: un_parenthesize_one_elt_List para) ])) then true + else + let package = Hashtbl.find vars.state.per_packages pkg in + List.exists search (List.map fst (some_or package.isa [])) + in + (try + if not (uses_external_package pkg || List.mem pkg !ignored_packages || search pkg || method_ = "bootstrap") then + warn_with_pos [Warn_import_export] pos (sprintf "unknown method %s starting in package %s" method_ pkg); + with Not_found -> warn_with_pos [Warn_import_export] pos (sprintf "unknown package %s" pkg)); + Some vars + + | Method_call(o, Raw_string(method_, pos), para) -> + let vars = check_variables_ vars o in + let vars = List.fold_left check_variables_ vars para in + (try + let l = Hashtbl.find vars.state.methods method_ in + let l_and = List.map (fun (pkg_name, used, proto) -> pkg_name, used, do_para_comply_with_prototype [ List (o :: un_parenthesize_one_elt_List para) ] proto) l in + let l_and' = + match List.filter (fun (_, _, n) -> n = 0) l_and with + | [] -> + (match uniq (List.map ter3 l_and) with + | [-1] -> warn_with_pos [Warn_prototypes] pos "not enough parameters" + | [ 1] -> warn_with_pos [Warn_prototypes] pos "too many parameters" + | _ -> warn_with_pos [Warn_prototypes] pos "not enough or too many parameters") ; + l_and + | l -> l + in + List.iter (fun (pkg_name, _, _) -> add_to_packages_maybe_used vars.state vars.current_package pkg_name method_) l_and' ; + List.iter (fun (_, used, _) -> used := Access_various) l_and' + with Not_found -> + if not (List.mem method_ [ "isa"; "can" ]) then + warn_with_pos [Warn_names] pos ("unknown method " ^ method_)) ; + Some vars + + | _ -> None + in + let vars = List.fold_left check_variables_ { vars with my_vars = [[]] } t in + vars + +let check_tree state package = + let vars = { my_vars = [[]]; our_vars = []; locally_imported = []; required_vars = []; current_package = package; state = state; is_toplevel = true; write_only = false } in + if !Flags.verbose then print_endline_flush ("checking package " ^ package.package_name) ; + let vars = check_variables vars package.body in + check_unused_local_variables vars ; + () + +let imported_add i1 i2 = if i1 = None && i2 = None then None else Some (some_or i1 [] @ some_or i2 []) + +let add_package_to_state state package = + let package = + try + let existing_package = Hashtbl.find state.per_packages package.package_name in + (*print_endline_flush (existing_package.file_name ^ " vs " ^ package.file_name); *) + let vars_declared = existing_package.vars_declared in + Hashtbl.iter (fun var pos -> Hashtbl.replace vars_declared var pos) package.vars_declared ; + let p = { + package_name = package.package_name ; has_package_name = package.has_package_name ; + isa = if existing_package.isa = None then package.isa else existing_package.isa ; + body = existing_package.body @ package.body ; + uses = existing_package.uses @ package.uses ; + required_packages = existing_package.required_packages @ package.required_packages ; + vars_declared = vars_declared ; + imported = ref (imported_add !(existing_package.imported) !(package.imported)) ; + exports = { export_ok = existing_package.exports.export_ok @ package.exports.export_ok ; + export_auto = existing_package.exports.export_auto @ package.exports.export_auto ; + export_tags = existing_package.exports.export_tags @ package.exports.export_tags ; + special_export = None } + } in + Hashtbl.replace state.per_packages package.package_name p ; + p + with Not_found -> package + in + Hashtbl.replace state.per_packages package.package_name package + +let add_file_to_files per_files file = + Hashtbl.replace per_files file.file_name file + +let check_unused_vars package = + Hashtbl.iter (fun (context, name) (pos, is_used, _proto) -> + if !is_used != Access_various && not (List.mem name ["BEGIN"; "END"; "DESTROY"; "ISA"; "AUTOLOAD"; "EXPORT"; "EXPORT_OK"; "EXPORT_TAGS"]) then + warn_with_pos [Warn_unused_global_vars] pos (sprintf "unused %s%s::%s" (if context = I_func then "function " else "variable " ^ context2s context) package.package_name name) + ) package.vars_declared + +let arrange_global_vars_declared global_vars_declared state = + Hashtbl.iter (fun (context, fq, name) (pos, proto) -> + let package = + try + Hashtbl.find state.per_packages fq + with Not_found -> + (* creating a new shadow package *) + let package = + { + package_name = fq; + has_package_name = true ; + exports = empty_exports ; + imported = ref None ; + vars_declared = Hashtbl.create 16 ; + uses = [] ; + required_packages = [] ; + body = [] ; + isa = None ; + } in + Hashtbl.add state.per_packages fq package ; + package + in + if not (Hashtbl.mem package.vars_declared (context, name)) then + Hashtbl.add package.vars_declared (context, name) (pos, ref Access_none, proto) + (* otherwise dropping this second declaration *) + ) global_vars_declared ; + state + +let get_methods_available state = + let classes = uniq ( + hashtbl_collect (fun _ package -> + match package.isa with + | None -> + if Hashtbl.mem package.vars_declared (I_func, "new") then [package] else [] + | Some l -> + package :: List.map (fun (pkg, pos) -> + try + Hashtbl.find state.per_packages pkg + with Not_found -> die_with_pos pos ("bad package " ^ pkg) + ) l + ) state.per_packages + ) in + List.iter (fun pkg -> + Hashtbl.replace state.packages_being_classes pkg.package_name () ; + Hashtbl.iter (fun (context, v) (_pos, is_used, proto) -> + if context = I_func then + let l = try Hashtbl.find state.methods v with Not_found -> [] in + Hashtbl.replace state.methods v ((pkg.package_name, is_used, proto) :: l) + ) pkg.vars_declared + ) classes ; + state + + +let default_per_files() = Hashtbl.create 16 +let default_state per_files = { + per_files = per_files; + per_packages = Hashtbl.create 16; + methods = Hashtbl.create 256; + global_vars_used = ref []; + packages_being_classes = Hashtbl.create 16; + packages_dependencies = Hashtbl.create 16; + packages_dependencies_maybe = Hashtbl.create 16 +} + +let cache_cache = Hashtbl.create 16 + +let pkgs2s prefix l = + let l = List.sort compare (List.map (fun pkg -> pkg.file_name) l) in + String.concat "" (List.map (fun s -> prefix ^ s ^ "\n") l) + +let read_packages_from_cache per_files dir = + if !Flags.no_cache || Hashtbl.mem cache_cache dir then () else + try + Hashtbl.add cache_cache dir (); + let file = dir ^ "/.perl_checker.cache" in + let fh = open_in file in + let magic = input_line fh in + if magic <> "perl_checker cache " ^ Build.date then () else + let l = Marshal.from_channel fh in + close_in fh ; + + let l = List.filter (fun file -> + not (Hashtbl.mem per_files file.file_name) && + (try file.build_time > mtime file.file_name with _ -> false) + ) l in + + if !Flags.verbose then print_endline_flush (sprintf "using cached files\n%sfrom %s" (pkgs2s " " l) file) ; + + List.iter (fun file -> + Info.add_a_file file.file_name file.lines_starts ; + add_file_to_files per_files file + ) l + with Sys_error _ | End_of_file -> () + +let write_packages_cache per_files dir = + try + let l = List.filter (fun per_file -> per_file.require_name <> None) (hashtbl_values per_files) in + let file = dir ^ "/.perl_checker.cache" in + let fh = open_out file in + output_string fh ("perl_checker cache " ^ Build.date ^ "\n") ; + Marshal.to_channel fh l [] ; + close_out fh ; + if !Flags.verbose then print_endline_flush (sprintf "saving cached files\n%sin %s" (pkgs2s " " l) file) + with Sys_error _ -> () + +let generate_package_dependencies_graph state file = + let fh = open_out file in + + List.iter (fun (p1, p2) -> + output_string fh (p1 ^ " -> " ^ p2 ^ "\n") + ) (List.sort compare (hashtbl_keys state.packages_dependencies)) ; + + let l = Hashtbl.fold (fun (p1, p2, method_) _ l -> ((p1, method_), p2) :: l) state.packages_dependencies_maybe [] in + List.iter (fun ((p1, method_), l) -> + output_string fh (p1 ^ " ?-> " ^ String.concat " " l ^ " (" ^ method_ ^ ")\n") + ) (List.sort compare (prepare_want_all_assoc l)); + + close_out fh diff --git a/src/global_checks.mli b/src/global_checks.mli new file mode 100644 index 0000000..9edacbf --- /dev/null +++ b/src/global_checks.mli @@ -0,0 +1,26 @@ +open Types +open Tree + +type state = { + per_files : (string, per_file) Hashtbl.t ; + per_packages : (string, per_package) Hashtbl.t ; + methods : (string, (string * variable_used ref * prototype option) list) Hashtbl.t ; + global_vars_used : ((context * string * string) * pos) list ref ; + packages_being_classes : (string, unit) Hashtbl.t ; + packages_dependencies : (string * string, unit) Hashtbl.t ; + packages_dependencies_maybe : (string * string * string, unit) Hashtbl.t ; + } + +val default_per_files : unit -> (string, per_file) Hashtbl.t +val default_state : (string, per_file) Hashtbl.t -> state +val check_tree : state -> per_package -> unit +val add_file_to_files : (string, per_file) Hashtbl.t -> per_file -> unit +val add_package_to_state : state -> per_package -> unit +val check_unused_vars : per_package -> unit +val arrange_global_vars_declared : (context * string * string, pos * Tree.prototype option) Hashtbl.t -> state -> state +val get_methods_available : state -> state + +val read_packages_from_cache : (string, per_file) Hashtbl.t -> string -> unit +val write_packages_cache : (string, per_file) Hashtbl.t -> string -> unit + +val generate_package_dependencies_graph : state -> string -> unit diff --git a/src/info.ml b/src/info.ml new file mode 100644 index 0000000..ab76b9f --- /dev/null +++ b/src/info.ml @@ -0,0 +1,76 @@ +open List +open Printf +open Common + +let (lines_starts : (string, int list) Hashtbl.t) = Hashtbl.create 4 +let current_file_lines_starts = ref [] +let current_file_current_line = ref 0 +let current_file = ref "" + +let start_a_new_file file = + if !current_file <> "" then Hashtbl.add lines_starts !current_file !current_file_lines_starts ; + current_file := file ; + current_file_lines_starts := [0] + +let add_a_file file file_lines_starts = Hashtbl.replace lines_starts file file_lines_starts + +let get_lines_starts_for_file file = + if file = !current_file then !current_file_lines_starts else Hashtbl.find lines_starts file + +let cwd = expand_symlinks (Unix.getcwd()) + +let file_to_absolute_file file = + let abs_file = + if file.[0] = '/' then file else + if file = "." then cwd else cwd ^ "/" ^ file + in + expand_symlinks abs_file + +let absolute_file_to_file = + let s1 = Filename.dirname cwd in + if String.length s1 < 4 then (fun x -> x) else + let short_cwd = + let s2 = Filename.dirname s1 in + if String.length s2 < 4 then s1 else + let s3 = Filename.dirname s2 in (* allow up to ../../../xxx *) + if String.length s3 < 4 then s2 else s3 in + memoize (fun abs_file -> + if str_begins_with (short_cwd ^ "/") abs_file then + let rec to_file rel cwd = + if str_begins_with (cwd ^ "/") abs_file then + rel ^ skip_n_char_ (String.length cwd + 1) 0 abs_file + else + to_file ("../" ^ rel) (Filename.dirname cwd) + in + to_file "" cwd + else + abs_file) + +let raw_pos2raw_line file a = + let starts = map_index (fun a b -> a,b) (rev (get_lines_starts_for_file file)) in + let ((offset, line), _) = find (fun (_,(e,_)) -> e > a) (combine starts (tl starts @ [999999999, 999999999])) in + line, offset + +let pos2line (file, a, b) = + let line, offset = raw_pos2raw_line file a in + file, line, a - offset + 1, b - offset + 1 + +let pos2s (file, a, b) = sprintf "(%s, %d, %d)" file a b + +let pos2sfull pos = + try + let file, line, n1, n2 = pos2line pos in + sprintf "File \"%s\", line %d, character %d-%d\n" (absolute_file_to_file file) (line + 1) n1 n2 + with Not_found -> failwith ("bad position " ^ pos2s pos) + +let pos2s_for_po pos = + let file, line, _, _ = pos2line pos in + absolute_file_to_file file ^ ":" ^ string_of_int (line + 1) + +let is_on_same_line file (a,b) = + let line_a, _ = raw_pos2raw_line file a in + let line_b, _ = raw_pos2raw_line file b in + line_a = line_b + +let is_on_same_line_current (a,b) = is_on_same_line !current_file (a,b) +let pos2sfull_current a b = pos2sfull (!current_file, a, b) diff --git a/src/info.mli b/src/info.mli new file mode 100644 index 0000000..d337316 --- /dev/null +++ b/src/info.mli @@ -0,0 +1,17 @@ +val lines_starts : (string, int list) Hashtbl.t +val current_file_lines_starts : int list ref +val current_file_current_line : int ref +val current_file : string ref +val start_a_new_file : string -> unit +val add_a_file : string -> int list -> unit +val get_lines_starts_for_file : string -> int list +val file_to_absolute_file : string -> string +val absolute_file_to_file : string -> string +val raw_pos2raw_line : string -> int -> int * int +val pos2line : string * int * int -> string * int * int * int +val pos2s : string * int * int -> string +val pos2sfull : string * int * int -> string +val pos2s_for_po : string * int * int -> string +val is_on_same_line : string -> int * int -> bool +val is_on_same_line_current : int * int -> bool +val pos2sfull_current : int -> int -> string diff --git a/src/lexer.mll b/src/lexer.mll new file mode 100644 index 0000000..f416499 --- /dev/null +++ b/src/lexer.mll @@ -0,0 +1,1057 @@ +{ (* -*- caml -*- *) +open Common +open Types +open Lexing +open Info + +let bpos = -1,-1 + +type raw_token = + | EOF of raw_pos + | SPACE of int + | CR + | INT of (string * raw_pos) + | FLOAT of (string * raw_pos) + | RAW_STRING of (string * raw_pos) + | STRING of (raw_interpolated_string * raw_pos) + | PATTERN of (raw_interpolated_string * string * raw_pos) + | QR_PATTERN of (raw_interpolated_string * string * raw_pos) + | PATTERN_SUBST of (raw_interpolated_string * raw_interpolated_string * string * raw_pos) + | BAREWORD of (string * raw_pos) + | BAREWORD_PAREN of (string * raw_pos) + | REVISION of (string * raw_pos) + | PERL_CHECKER_COMMENT of (string * raw_pos) + | PO_COMMENT of (string * raw_pos) + | POD of (string * raw_pos) + | LABEL of (string * raw_pos) + | COMMAND_STRING of (raw_interpolated_string * raw_pos) + | PRINT_TO_STAR of ((string * string) * raw_pos) + | PRINT_TO_SCALAR of ((string * string) * raw_pos) + | QUOTEWORDS of (string * raw_pos) + | COMPACT_HASH_SUBSCRIPT of (string * raw_pos) + | RAW_HERE_DOC of ((string * raw_pos) ref * raw_pos) + | HERE_DOC of (raw_interpolated_string * raw_pos) ref * raw_pos + | FORMAT of (raw_interpolated_string * raw_pos) ref * raw_pos + | SCALAR_IDENT of (string option * string * raw_pos) + | ARRAY_IDENT of (string option * string * raw_pos) + | HASH_IDENT of (string option * string * raw_pos) + | FUNC_IDENT of (string option * string * raw_pos) + | STAR_IDENT of (string option * string * raw_pos) + | RAW_IDENT of (string option * string * raw_pos) + | RAW_IDENT_PAREN of (string option * string * raw_pos) + | ARRAYLEN_IDENT of (string option * string * raw_pos) + | SUB_WITH_PROTO of (string * raw_pos) + | FUNC_DECL_WITH_PROTO of (string option * string * string * raw_pos) + + | IF of raw_pos | ELSIF of raw_pos | ELSE of raw_pos | UNLESS of raw_pos | DO of raw_pos | WHILE of raw_pos | UNTIL of raw_pos | MY_OUR of (string * raw_pos) | CONTINUE of raw_pos | SUB of raw_pos + | LOCAL of raw_pos | FOR of (string * raw_pos) | USE of raw_pos | PACKAGE of raw_pos | BEGIN of raw_pos | END of raw_pos | PRINT of (string * raw_pos) + | NEW of (raw_pos) | AT of raw_pos | DOLLAR of raw_pos | PERCENT of raw_pos | AMPERSAND of raw_pos + | STAR of raw_pos | ARRAYLEN of raw_pos | SEMI_COLON of raw_pos | PKG_SCOPE of raw_pos | PAREN of raw_pos | PAREN_END of raw_pos | BRACKET of raw_pos + | BRACKET_END of raw_pos | BRACKET_HASHREF of raw_pos | ARRAYREF of raw_pos | ARRAYREF_END of raw_pos | ARROW of raw_pos | INCR of raw_pos | DECR of raw_pos + | CONCAT of raw_pos | POWER of raw_pos | TIGHT_NOT of raw_pos | BIT_NEG of raw_pos | REF of raw_pos | ONE_SCALAR_PARA of (string * raw_pos) | PATTERN_MATCH of raw_pos | PATTERN_MATCH_NOT of raw_pos | MULT of (string * raw_pos) | MULT_L_STR of raw_pos + | PLUS of (string * raw_pos) | BIT_SHIFT of (string * raw_pos) + | LT of raw_pos | GT of raw_pos | COMPARE_OP of (string * raw_pos) | COMPARE_OP_STR of (string * raw_pos) | EQ_OP of (string * raw_pos) | EQ_OP_STR of (string * raw_pos) + | BIT_AND of raw_pos | BIT_OR of raw_pos | BIT_XOR of raw_pos | AND_TIGHT of raw_pos | OR_TIGHT of raw_pos | DOTDOT of (string * raw_pos) + | QUESTION_MARK of raw_pos | COLON of raw_pos | ASSIGN of (string * raw_pos) | COMMA of raw_pos | RIGHT_ARROW of raw_pos | NOT of raw_pos | AND of raw_pos | OR of raw_pos | XOR of raw_pos + +and raw_interpolated_string = (string * raw_token list) list + +let new_any mcontext any spaces pos = { mcontext = mcontext ; any = any ; spaces = spaces ; pos = pos } + +let pos lexbuf = lexeme_start lexbuf, lexeme_end lexbuf +let pos2sfull_with start end_ = Info.pos2sfull (!current_file, start, end_) +let pos2sfull lexbuf = pos2sfull_with (lexeme_start lexbuf) (lexeme_end lexbuf) + +let warn_with_pos warn_types (start, end_) err = if Flags.are_warning_types_set warn_types then print_endline_flush (pos2sfull_with start end_ ^ err) +let warn warn_types lexbuf err = warn_with_pos warn_types (pos lexbuf) err +let die lexbuf err = failwith (pos2sfull_with (lexeme_start lexbuf) (lexeme_end lexbuf) ^ err) + +let rec concat_bareword_paren accu = function + | PRINT(s, pos1) :: PAREN(pos2) :: l + | BAREWORD(s, pos1) :: PAREN(pos2) :: l -> + concat_bareword_paren (PAREN(pos2) :: BAREWORD_PAREN(s, pos1) :: accu) l + | RAW_IDENT(kind, ident, pos1) :: PAREN(pos2) :: l -> + concat_bareword_paren (PAREN(pos2) :: RAW_IDENT_PAREN(kind, ident, pos1) :: accu) l + | PO_COMMENT(_, pos) as e :: l -> + let l = drop_while (function CR | SPACE _ -> true | _ -> false) l in + (match l with + | PO_COMMENT _ :: _ + (* the check will be done on this PO_COMMENT *) + | BAREWORD("N", _) :: PAREN(_) :: _ + | BAREWORD("N_", _) :: PAREN(_) :: _ -> + concat_bareword_paren (e :: accu) l + | _ -> + warn_with_pos [Warn_MDK_Common] pos "N(...) must follow the #-PO: comment, with nothing in between" ; + concat_bareword_paren accu l) + | [] -> List.rev accu + | e :: l -> + concat_bareword_paren (e :: accu) l + +let rec bracket_bareword_is_hashref accu = function + | (pos, Parser.BRACKET bracket) :: (_, Parser.BAREWORD _ as bareword) :: (_, Parser.RIGHT_ARROW _ as right_arrow) :: l -> + bracket_bareword_is_hashref (right_arrow :: bareword :: (pos, Parser.BRACKET_HASHREF bracket) :: accu) l + | [] -> List.rev accu + | e :: l -> + bracket_bareword_is_hashref (e :: accu) l + + +let rec raw_token_to_pos_and_token spaces = function + | INT(s, pos) -> pos, Parser.NUM(new_any M_int s spaces pos) + | FLOAT(s, pos) -> pos, Parser.NUM(new_any M_float s spaces pos) + | RAW_STRING(s, pos) -> pos, Parser.RAW_STRING(new_any M_string s spaces pos) + | RAW_HERE_DOC(r, pos) -> pos, Parser.RAW_HERE_DOC(new_any M_string !r spaces pos) + | STRING(l, pos) -> pos, Parser.STRING(new_any M_string (raw_interpolated_string_to_tokens l) spaces pos) + | COMMAND_STRING(l, pos) -> pos, Parser.COMMAND_STRING(new_any (M_mixed [M_string; M_array]) (raw_interpolated_string_to_tokens l) spaces pos) + | QR_PATTERN(s, opts, pos) -> pos, Parser.QR_PATTERN(new_any M_special (raw_interpolated_string_to_tokens s, opts) spaces pos) + | PATTERN(s, opts, pos) -> pos, Parser.PATTERN(new_any M_special (raw_interpolated_string_to_tokens s, opts) spaces pos) + | PATTERN_SUBST(from, to_, opts, pos) -> pos, Parser.PATTERN_SUBST(new_any M_special (raw_interpolated_string_to_tokens from, raw_interpolated_string_to_tokens to_, opts) spaces pos) + | HERE_DOC(l, pos) -> pos, Parser.HERE_DOC(new_any M_string (raw_interpolated_string_to_tokens (fst !l), snd !l) spaces pos) + | FORMAT(l, pos) -> pos, Parser.FORMAT(new_any M_string (raw_interpolated_string_to_tokens (fst !l), snd !l) spaces pos) + | BAREWORD(s, pos) -> pos, Parser.BAREWORD(new_any M_special s spaces pos) + | BAREWORD_PAREN(s, pos) -> pos, Parser.BAREWORD_PAREN(new_any M_special s spaces pos) + | REVISION(s, pos) -> pos, Parser.REVISION(new_any M_revision s spaces pos) + | PERL_CHECKER_COMMENT(s, pos) -> pos, Parser.PERL_CHECKER_COMMENT(new_any M_none s spaces pos) + | PO_COMMENT(s, pos) -> pos, Parser.PO_COMMENT(new_any M_special s spaces pos) + | POD(s, pos) -> pos, Parser.POD(new_any M_special s spaces pos) + | LABEL(s, pos) -> pos, Parser.LABEL(new_any M_none s spaces pos) + | PRINT(s, pos) -> pos, Parser.PRINT(new_any M_special s spaces pos) + | PRINT_TO_STAR(s, pos) -> pos, Parser.PRINT_TO_STAR(new_any M_special s spaces pos) + | PRINT_TO_SCALAR(s, pos) -> pos, Parser.PRINT_TO_SCALAR(new_any M_special s spaces pos) + | QUOTEWORDS(s, pos) -> pos, Parser.QUOTEWORDS(new_any M_array s spaces pos) + | COMPACT_HASH_SUBSCRIPT(s, pos) -> pos, Parser.COMPACT_HASH_SUBSCRIPT(new_any M_special s spaces pos) + | SCALAR_IDENT(kind, name, pos) -> pos, Parser.SCALAR_IDENT(new_any M_special (kind, name) spaces pos) + | ARRAY_IDENT(kind, name, pos) -> pos, Parser.ARRAY_IDENT(new_any M_special (kind, name) spaces pos) + | HASH_IDENT(kind, name, pos) -> pos, Parser.HASH_IDENT(new_any M_special (kind, name) spaces pos) + | FUNC_IDENT(kind, name, pos) -> pos, Parser.FUNC_IDENT(new_any M_special (kind, name) spaces pos) + | STAR_IDENT(kind, name, pos) -> pos, Parser.STAR_IDENT(new_any M_special (kind, name) spaces pos) + | RAW_IDENT(kind, name, pos) -> pos, Parser.RAW_IDENT(new_any M_special (kind, name) spaces pos) + | RAW_IDENT_PAREN(kind, name, pos) -> pos, Parser.RAW_IDENT_PAREN(new_any M_special (kind, name) spaces pos) + | ARRAYLEN_IDENT(kind, name, pos) -> pos, Parser.ARRAYLEN_IDENT(new_any M_special (kind, name) spaces pos) + | SUB_WITH_PROTO(proto, pos) -> pos, Parser.SUB_WITH_PROTO(new_any M_special proto spaces pos) + | FUNC_DECL_WITH_PROTO(fq, name, proto, pos) -> pos, Parser.FUNC_DECL_WITH_PROTO(new_any M_special (fq, name, proto) spaces pos) + + | NEW(pos) -> pos, Parser.NEW(new_any M_special () spaces pos) + | COMPARE_OP(s, pos) -> pos, Parser.COMPARE_OP(new_any M_special s spaces pos) + | COMPARE_OP_STR(s, pos) -> pos, Parser.COMPARE_OP_STR(new_any M_special s spaces pos) + | EQ_OP(s, pos) -> pos, Parser.EQ_OP(new_any M_special s spaces pos) + | EQ_OP_STR(s, pos) -> pos, Parser.EQ_OP_STR(new_any M_special s spaces pos) + | ASSIGN(s, pos) -> pos, Parser.ASSIGN(new_any M_special s spaces pos) + | FOR(s, pos) -> pos, Parser.FOR(new_any M_special s spaces pos) + + | DOTDOT(s, pos) -> pos, Parser.DOTDOT(new_any M_special s spaces pos) + | MULT(s, pos) -> pos, Parser.MULT(new_any M_special s spaces pos) + | BIT_SHIFT(s, pos) -> pos, Parser.BIT_SHIFT(new_any M_special s spaces pos) + | PLUS(s, pos) -> pos, Parser.PLUS(new_any M_special s spaces pos) + | ONE_SCALAR_PARA(s, pos) -> pos, Parser.ONE_SCALAR_PARA(new_any M_special s spaces pos) + | MY_OUR(s, pos) -> pos, Parser.MY_OUR(new_any M_special s spaces pos) + + | EOF (pos) -> pos, Parser.EOF (new_any M_special () spaces pos) + | IF (pos) -> pos, Parser.IF (new_any M_special () spaces pos) + | ELSIF (pos) -> pos, Parser.ELSIF (new_any M_special () spaces pos) + | ELSE (pos) -> pos, Parser.ELSE (new_any M_special () spaces pos) + | UNLESS (pos) -> pos, Parser.UNLESS (new_any M_special () spaces pos) + | DO (pos) -> pos, Parser.DO (new_any M_special () spaces pos) + | WHILE (pos) -> pos, Parser.WHILE (new_any M_special () spaces pos) + | UNTIL (pos) -> pos, Parser.UNTIL (new_any M_special () spaces pos) + | CONTINUE (pos) -> pos, Parser.CONTINUE (new_any M_special () spaces pos) + | SUB (pos) -> pos, Parser.SUB (new_any M_special () spaces pos) + | LOCAL (pos) -> pos, Parser.LOCAL (new_any M_special () spaces pos) + | USE (pos) -> pos, Parser.USE (new_any M_special () spaces pos) + | PACKAGE (pos) -> pos, Parser.PACKAGE (new_any M_special () spaces pos) + | BEGIN (pos) -> pos, Parser.BEGIN (new_any M_special () spaces pos) + | END (pos) -> pos, Parser.END (new_any M_special () spaces pos) + | AT (pos) -> pos, Parser.AT (new_any M_special () spaces pos) + | DOLLAR (pos) -> pos, Parser.DOLLAR (new_any M_special () spaces pos) + | PERCENT (pos) -> pos, Parser.PERCENT (new_any M_special () spaces pos) + | AMPERSAND (pos) -> pos, Parser.AMPERSAND (new_any M_special () spaces pos) + | STAR (pos) -> pos, Parser.STAR (new_any M_special () spaces pos) + | ARRAYLEN (pos) -> pos, Parser.ARRAYLEN (new_any M_special () spaces pos) + | SEMI_COLON (pos) -> pos, Parser.SEMI_COLON (new_any M_none () spaces pos) + | PKG_SCOPE (pos) -> pos, Parser.PKG_SCOPE (new_any M_special () spaces pos) + | PAREN (pos) -> pos, Parser.PAREN (new_any M_special () spaces pos) + | PAREN_END (pos) -> pos, Parser.PAREN_END (new_any M_special () spaces pos) + | BRACKET (pos) -> pos, Parser.BRACKET (new_any M_special () spaces pos) + | BRACKET_END (pos) -> pos, Parser.BRACKET_END (new_any M_special () spaces pos) + | BRACKET_HASHREF (pos) -> pos, Parser.BRACKET_HASHREF (new_any M_special () spaces pos) + | ARRAYREF (pos) -> pos, Parser.ARRAYREF (new_any M_special () spaces pos) + | ARRAYREF_END (pos) -> pos, Parser.ARRAYREF_END (new_any M_special () spaces pos) + | ARROW (pos) -> pos, Parser.ARROW (new_any M_special () spaces pos) + | INCR (pos) -> pos, Parser.INCR (new_any M_special () spaces pos) + | DECR (pos) -> pos, Parser.DECR (new_any M_special () spaces pos) + | POWER (pos) -> pos, Parser.POWER (new_any M_special () spaces pos) + | TIGHT_NOT (pos) -> pos, Parser.TIGHT_NOT (new_any M_special () spaces pos) + | BIT_NEG (pos) -> pos, Parser.BIT_NEG (new_any M_special () spaces pos) + | REF (pos) -> pos, Parser.REF (new_any M_special () spaces pos) + | PATTERN_MATCH (pos) -> pos, Parser.PATTERN_MATCH (new_any M_special () spaces pos) + | PATTERN_MATCH_NOT(pos) -> pos, Parser.PATTERN_MATCH_NOT(new_any M_special () spaces pos) + | LT (pos) -> pos, Parser.LT (new_any M_special () spaces pos) + | GT (pos) -> pos, Parser.GT (new_any M_special () spaces pos) + | BIT_AND (pos) -> pos, Parser.BIT_AND (new_any M_special () spaces pos) + | BIT_OR (pos) -> pos, Parser.BIT_OR (new_any M_special () spaces pos) + | BIT_XOR (pos) -> pos, Parser.BIT_XOR (new_any M_special () spaces pos) + | AND_TIGHT (pos) -> pos, Parser.AND_TIGHT (new_any M_special () spaces pos) + | OR_TIGHT (pos) -> pos, Parser.OR_TIGHT (new_any M_special () spaces pos) + | QUESTION_MARK (pos) -> pos, Parser.QUESTION_MARK (new_any M_special () spaces pos) + | COLON (pos) -> pos, Parser.COLON (new_any M_special () spaces pos) + | COMMA (pos) -> pos, Parser.COMMA (new_any M_special () spaces pos) + | CONCAT (pos) -> pos, Parser.CONCAT (new_any M_special () spaces pos) + | MULT_L_STR (pos) -> pos, Parser.MULT_L_STR (new_any M_special () spaces pos) + | RIGHT_ARROW (pos) -> pos, Parser.RIGHT_ARROW (new_any M_special () spaces pos) + | NOT (pos) -> pos, Parser.NOT (new_any M_special () spaces pos) + | AND (pos) -> pos, Parser.AND (new_any M_special () spaces pos) + | OR (pos) -> pos, Parser.OR (new_any M_special () spaces pos) + | XOR (pos) -> pos, Parser.XOR (new_any M_special () spaces pos) + + | SPACE _ | CR -> internal_error "raw_token_to_token" + +and raw_token_to_token spaces raw_token = + let _, token = raw_token_to_pos_and_token spaces raw_token in + token + +and raw_interpolated_string_to_tokens l = + List.map (fun (s, rtok) -> s, concat_spaces [] Space_0 rtok) l + +and concat_spaces ret spaces = function + | CR :: l -> concat_spaces ret Space_cr l + | SPACE n :: l -> + let spaces' = + match spaces with + | Space_cr -> Space_cr + | Space_0 -> if n = 1 then Space_1 else Space_n + | _ -> Space_n + in + concat_spaces ret spaces' l + | [] -> List.rev ret + | token :: l -> concat_spaces (raw_token_to_pos_and_token spaces token :: ret) Space_0 l + +let rec lexbuf2list accu t lexbuf = + match t lexbuf with + | EOF pos -> List.rev (EOF pos :: accu) + | e -> lexbuf2list (e :: accu) t lexbuf + +let get_token token lexbuf = + let tokens = lexbuf2list [] token lexbuf in + let tokens = concat_bareword_paren [] tokens in + let tokens = concat_spaces [] Space_0 tokens in + let tokens = bracket_bareword_is_hashref [] tokens in + tokens + +let next_rule = Stack.create() + + +let putback lexbuf nb = lexbuf.Lexing.lex_curr_pos <- lexbuf.Lexing.lex_curr_pos - nb + +let add_a_new_line raw_pos = + incr current_file_current_line ; + lpush current_file_lines_starts raw_pos + +let here_docs = Queue.create() +let raw_here_docs = Queue.create() +let current_here_doc_mark = ref "" + +let here_doc_next_line mark = + let here_doc_ref = ref([], bpos) in + Queue.push (mark, here_doc_ref) here_docs ; + here_doc_ref +let raw_here_doc_next_line mark = + let here_doc_ref = ref("", bpos) in + Queue.push (mark, here_doc_ref) raw_here_docs ; + here_doc_ref + +let delimit_char = ref '/' +let delimit_char_open = ref '(' +let delimit_char_close = ref ')' +type string_escape_kinds = Double_quote | Qq | Delimited | Here_doc +let string_escape_kind = ref Double_quote +let string_quote_escape = ref false +let string_escape_useful = ref (Left false) +let not_ok_for_match = ref (-1) +let string_nestness = ref 0 +let string_is_i18n = ref false + +let building_current_interpolated_string = Stack.create() +let building_current_string = Stack.create() +let current_string_start_pos = ref 0 +let current_string_start_line = ref 0 + +let die_in_string lexbuf err = failwith (pos2sfull_with !current_string_start_pos (lexeme_end lexbuf) ^ err) +let warn_escape_unneeded lexbuf c = + let s = String.make 1 c in warn [Warn_suggest_simpler] lexbuf ("you can replace \\" ^ s ^ " with " ^ s) +let next_interpolated toks = + let r = Stack.top building_current_string in + Queue.push (!r, toks) (Stack.top building_current_interpolated_string) ; + r := "" + +let raw_ins t lexbuf = + Stack.push (ref "") building_current_string; + current_string_start_pos := lexeme_start lexbuf; + t lexbuf ; + !(Stack.pop building_current_string), (!current_string_start_pos, lexeme_end lexbuf) + +let ins t lexbuf = + Stack.push (Queue.create()) building_current_interpolated_string ; + Stack.push (ref "") building_current_string; + current_string_start_pos := lexeme_start lexbuf; + t lexbuf ; + next_interpolated [] ; + let _ = Stack.pop building_current_string in + queue2list (Stack.pop building_current_interpolated_string), (!current_string_start_pos, lexeme_end lexbuf) + +let raw_ins_to_string t lexbuf = + let s, pos = raw_ins t lexbuf in + not_ok_for_match := lexeme_end lexbuf; + RAW_STRING(s, pos) +let ins_to_string t lexbuf = + string_escape_useful := Left false ; + string_quote_escape := false ; + let s, pos = ins t lexbuf in + + if not !string_is_i18n then + (match !string_escape_useful, s with + | Right c, [ _, [] ] -> + let s = String.make 1 c in + warn_with_pos [Warn_suggest_simpler] pos ("you can replace \"xxx\\" ^ s ^ "xxx\" with 'xxx" ^ s ^ "xxx', that way you don't need to escape <" ^ s ^ ">") + | _ -> + if !string_quote_escape then + let full_s = String.concat "" (List.map fst s) in + let nb = string_fold_left (fun nb c -> + if nb < 0 then nb else + if c = '(' then nb + 1 else + if c = ')' then nb - 1 else nb + ) 0 full_s in + if nb = 0 then + warn_with_pos [Warn_suggest_simpler] pos "you can replace \"xxx\\\"xxx\" with qq(xxx\"xxx), that way you don't need to escape <\">" + ); + + not_ok_for_match := lexeme_end lexbuf; + string_is_i18n := false ; + STRING(s, pos) + +let next_s s t lexbuf = + let r = Stack.top building_current_string in r := !r ^ s ; + t lexbuf +let next t lexbuf = next_s (lexeme lexbuf) t lexbuf + +let ins_re re_delimited_string lexbuf = + let s, pos = ins re_delimited_string lexbuf in + List.iter (fun (s, _) -> + if str_contains s "[^\\s]" then warn [Warn_suggest_simpler] lexbuf "you can replace [^\\s] with \\S"; + if str_contains s "[^\\w]" then warn [Warn_suggest_simpler] lexbuf "you can replace [^\\w] with \\W" + ) s ; + s, pos + +let string_interpolate token pre lexbuf = + let s = lexeme lexbuf in + let local_lexbuf = Lexing.from_string (pre ^ s ^ " ") in (* add a space to help tokenizing "xxx$$" *) + local_lexbuf.lex_start_p <- lexbuf.lex_start_p ; + local_lexbuf.lex_curr_p <- lexbuf.lex_start_p ; + local_lexbuf.lex_abs_pos <- lexeme_start lexbuf ; + let l = lexbuf2list [] token local_lexbuf in + let l = concat_bareword_paren [] l in + next_interpolated l; + (Stack.pop next_rule) lexbuf + +let ident_type_from_char fq name lexbuf c = + not_ok_for_match := lexeme_end lexbuf; + match c with + | '$' -> SCALAR_IDENT(fq, name, pos lexbuf) + | '@' -> ARRAY_IDENT (fq, name, pos lexbuf) + | '%' -> HASH_IDENT (fq, name, pos lexbuf) + | '&' -> FUNC_IDENT (fq, name, pos lexbuf) + | '*' -> STAR_IDENT (fq, name, pos lexbuf) + | _ -> internal_error "ident_type_from_char" + +let split_at_two_colons s = + let i_fq = String.rindex s ':' in + String.sub s 0 (i_fq - 1), skip_n_char (i_fq + 1) s + +let ident_from_lexbuf lexbuf = + let fq, name = split_at_two_colons (lexeme lexbuf) in + RAW_IDENT(Some fq, name, pos lexbuf) + +let typed_ident_from_lexbuf lexbuf = + let s = lexeme lexbuf in + ident_type_from_char None (skip_n_char 1 s) lexbuf s.[0] + +let typed_fqident_from_lexbuf lexbuf = + let s = lexeme lexbuf in + let fq, name = split_at_two_colons (skip_n_char 1 s) in + ident_type_from_char (Some fq) name lexbuf s.[0] + +let arraylen_ident_from_lexbuf lexbuf = + not_ok_for_match := lexeme_end lexbuf; + let s = lexeme lexbuf in + ARRAYLEN_IDENT(None, skip_n_char 2 s, pos lexbuf) + +let arraylen_fqident_from_lexbuf lexbuf = + let s = lexeme lexbuf in + let fq, name = split_at_two_colons (skip_n_char 2 s) in + ARRAYLEN_IDENT(Some fq, name, pos lexbuf) + +let check_multi_line_delimited_string opts (start, end_) = + let check = + match opts with + | None -> true + | Some s -> not (String.contains s 'x') in + if check then + if !current_file_current_line <> !current_string_start_line then + failwith (pos2sfull_with start end_ ^ "multi-line patterns are not allowed (or use /x modifier)") + +let hex_in_string lexbuf next_rule s = + let i = + try int_of_string ("0x" ^ s) + with Failure("int_of_string") -> die_in_string lexbuf ("Bad_hex_in_string \"" ^ lexeme lexbuf ^ "\"") + in + let s = + if i < 256 then + String.make 1 (Char.chr i) + else + "\\x{" ^ s ^ "}" in + next_s s (Stack.pop next_rule) lexbuf + +let set_delimit_char lexbuf op = + let c = lexeme_char lexbuf (String.length op) in + delimit_char := c; + match c with + | '@' -> warn [Warn_complex_expressions] lexbuf ("don't use " ^ op ^ "@...@, replace @ with / ! , or |") + | ':' -> warn [Warn_complex_expressions] lexbuf ("don't use " ^ op ^ ":...:, replace : with / ! , or |") + | _ -> () + +let set_delimit_char_open lexbuf op = + let char_open = lexeme_char lexbuf (String.length op) in + let char_close = + match char_open with + | '(' -> ')' + | '{' -> '}' + | _ -> internal_error "set_delimit_char_open" + in + if op = "qx" then + warn [Warn_complex_expressions] lexbuf (Printf.sprintf "don't use qx%c...%c, use `...` instead" char_open char_close) + else if char_open = '{' then + warn [Warn_complex_expressions] lexbuf ("don't use " ^ op ^ "{...}, use " ^ op ^ "(...) instead"); + delimit_char_open := char_open; + delimit_char_close := char_close +} + +let stash = [ '$' '@' '%' '&' '*' ] +let ident_start = ['a'-'z' 'A'-'Z' '_'] +let ident = ident_start ['0'-'9' 'A'-'Z' 'a'-'z' '_'] * +let pattern_separator = [ '/' '!' ',' '|' '@' ':' ] +let pattern_open = [ '(' '{' ] +let pattern_close = [ ')' '}' ] + +let in_string_expr = (ident | (ident? ("::" ident)+)) "->"? (('{' [^ '{' '}' '\n']* '}') | ('[' [^ '[' ']' '\n']* ']'))* + +rule token = parse +| [' ' '\t']+ { + (* propagate not_ok_for_match when it was set by the previous token *) + if lexeme_start lexbuf = !not_ok_for_match then not_ok_for_match := lexeme_end lexbuf; + SPACE(lexeme_end lexbuf - lexeme_start lexbuf) + } +| "# perl_checker: " [^ '\n']* { PERL_CHECKER_COMMENT(skip_n_char 16 (lexeme lexbuf), pos lexbuf) } +| "#-PO: " [^ '\n']* { PO_COMMENT(skip_n_char 1 (lexeme lexbuf), pos lexbuf) } +| '#' [^ '\n']* { SPACE(1) } + +| "\n=" { + add_a_new_line(lexeme_end lexbuf - 1); + let _ = ins pod_command lexbuf in token lexbuf + } + +| '\n' { + add_a_new_line(lexeme_end lexbuf); + (try + let (mark, r) = Queue.pop here_docs in + current_here_doc_mark := mark ; + r := ins here_doc lexbuf + with Queue.Empty -> + try + let (mark, r) = Queue.pop raw_here_docs in + current_here_doc_mark := mark ; + r := raw_ins raw_here_doc lexbuf + with Queue.Empty -> ()); + CR + } +| "->" { ARROW(pos lexbuf) } +| "++" { INCR(pos lexbuf) } +| "--" { DECR(pos lexbuf) } +| "**" { POWER(pos lexbuf) } +| "!" { TIGHT_NOT(pos lexbuf) } +| "~" { BIT_NEG(pos lexbuf) } +| "=~" { PATTERN_MATCH(pos lexbuf) } +| "!~" { PATTERN_MATCH_NOT(pos lexbuf) } +| "*" { MULT(lexeme lexbuf, pos lexbuf) } +| "%" { MULT(lexeme lexbuf, pos lexbuf) } +| "x" { MULT_L_STR(pos lexbuf) } +| "+" { PLUS(lexeme lexbuf, pos lexbuf) } +| "-" { PLUS(lexeme lexbuf, pos lexbuf) } +| "." { CONCAT(pos lexbuf) } +| "<<" { BIT_SHIFT(lexeme lexbuf, pos lexbuf) } +| ">>" { BIT_SHIFT(lexeme lexbuf, pos lexbuf) } +| "<" { LT(pos lexbuf) } +| ">" { GT(pos lexbuf) } +| "<=" | ">=" { COMPARE_OP(lexeme lexbuf, pos lexbuf) } +| "lt" | "gt" | "le" | "ge" { COMPARE_OP_STR(lexeme lexbuf, pos lexbuf) } +| "==" | "!=" | "<=>" { EQ_OP(lexeme lexbuf, pos lexbuf) } +| "eq" | "ne" | "cmp" { EQ_OP_STR(lexeme lexbuf, pos lexbuf) } +| "&" { BIT_AND(pos lexbuf) } +| "|" { BIT_OR(pos lexbuf) } +| "^" { BIT_XOR(pos lexbuf) } +| "&&" { AND_TIGHT(pos lexbuf) } +| "||" { OR_TIGHT(pos lexbuf) } +| ".." { DOTDOT(lexeme lexbuf, pos lexbuf) } +| "..." { DOTDOT(lexeme lexbuf, pos lexbuf) } +| "?" { QUESTION_MARK(pos lexbuf) } +| ":" { COLON(pos lexbuf) } +| "::" { PKG_SCOPE(pos lexbuf) } + +| "=" | "+=" | "-=" | "*=" | ".=" | "|=" | "&=" | "^=" | "||=" | "&&=" { ASSIGN(lexeme lexbuf, pos lexbuf) } + +| "<<=" | ">>=" | "**=" { + warn [Warn_complex_expressions] lexbuf (Printf.sprintf "don't use \"%s\", use the expanded version instead" (lexeme lexbuf)) ; + ASSIGN(lexeme lexbuf, pos lexbuf) + } + +| "," { COMMA(pos lexbuf) } +| "=>" { RIGHT_ARROW(pos lexbuf) } +| "not" { NOT(pos lexbuf) } +| "and" { AND(pos lexbuf) } +| "or" { OR(pos lexbuf) } +| "xor" { XOR(pos lexbuf) } + +| "if" { IF(pos lexbuf) } +| "else" { ELSE(pos lexbuf) } +| "elsif" { ELSIF(pos lexbuf) } +| "unless" { UNLESS(pos lexbuf) } +| "do" { DO(pos lexbuf) } +| "while" { WHILE(pos lexbuf) } +| "until" { UNTIL(pos lexbuf) } +| "foreach" { FOR(lexeme lexbuf, pos lexbuf) } +| "for" { FOR(lexeme lexbuf, pos lexbuf) } +| "my" { MY_OUR(lexeme lexbuf, pos lexbuf) } +| "our" { MY_OUR(lexeme lexbuf, pos lexbuf) } +| "local" { LOCAL(pos lexbuf) } +| "continue" { CONTINUE(pos lexbuf) } +| "sub" { SUB(pos lexbuf) } +| "package" { PACKAGE(pos lexbuf) } +| "use" { USE(pos lexbuf) } +| "BEGIN" { BEGIN(pos lexbuf) } +| "END" { END(pos lexbuf) } +| "print" { PRINT(lexeme lexbuf, pos lexbuf) } +| "printf" { PRINT(lexeme lexbuf, pos lexbuf) } +| "new" { NEW(pos lexbuf) } +| "format" { let pos = pos lexbuf in FORMAT(here_doc_next_line ".", pos) } +| "delete" +| "defined" +| "length" +| "keys" +| "exists" +| "shift" +| "pop" +| "eval" +| "ref" { ONE_SCALAR_PARA(lexeme lexbuf, pos lexbuf) } + +| "split" +| "grep" { (* ok_for_match! *) BAREWORD(lexeme lexbuf, pos lexbuf) } + +| "print " ['A'-'Z'] ['A'-'Z' '0'-'9']* ['\n' ' '] { + putback lexbuf 1; + PRINT_TO_STAR(("print", skip_n_char 6 (lexeme lexbuf)), pos lexbuf) + } +| "print $" ident ['\n' ' '] { + putback lexbuf 1; + PRINT_TO_SCALAR(("print", skip_n_char 7 (lexeme lexbuf)), pos lexbuf); + } +| "printf " ['A'-'Z'] ['A'-'Z' '0'-'9']* ['\n' ' '] { + putback lexbuf 1; + PRINT_TO_STAR(("printf", skip_n_char 7 (lexeme lexbuf)), pos lexbuf) + } +| "printf $" ident ['\n' ' '] { + putback lexbuf 1; + PRINT_TO_SCALAR(("printf", skip_n_char 8 (lexeme lexbuf)), pos lexbuf); + } + +| ident ' '* "=>" { (* needed so that (if => 1) works *) + let s = lexeme lexbuf in + let end_ = String.length s - 1 in + let ident_end = non_rindex_from s (end_ - 2) ' ' in + putback lexbuf (end_ - ident_end); + BAREWORD(String.sub s 0 (ident_end+1), pos lexbuf) + } + +| "{" ident "}" { (* needed so that $h{if} works *) + not_ok_for_match := lexeme_end lexbuf; + COMPACT_HASH_SUBSCRIPT(skip_n_char_ 1 1 (lexeme lexbuf), pos lexbuf) + } + +| '@' { AT(pos lexbuf) } +| '$' { DOLLAR(pos lexbuf) } +| '$' '#' { ARRAYLEN(pos lexbuf) } +| '%' ['$' '{'] { putback lexbuf 1; PERCENT(pos lexbuf) } +| '&' ['$' '{'] { putback lexbuf 1; AMPERSAND(pos lexbuf) } +| '*' ['$' '{'] { putback lexbuf 1; if lexeme_start lexbuf = !not_ok_for_match then MULT("*", pos lexbuf) else STAR(pos lexbuf) } + + +| ';' { SEMI_COLON(pos lexbuf) } +| '(' { PAREN(pos lexbuf) } +| '{' { BRACKET(pos lexbuf) } +| "+{"{ BRACKET_HASHREF(pos lexbuf) } +| '[' { ARRAYREF(pos lexbuf) } +| ')' { not_ok_for_match := lexeme_end lexbuf; PAREN_END(pos lexbuf) } +| '}' { not_ok_for_match := lexeme_end lexbuf; BRACKET_END(pos lexbuf) } +| ']' { not_ok_for_match := lexeme_end lexbuf; ARRAYREF_END(pos lexbuf) } + +| "/" { + if lexeme_start lexbuf = !not_ok_for_match then MULT("/", pos lexbuf) + else ( + delimit_char := '/' ; + current_string_start_line := !current_file_current_line; + let s, pos = ins_re re_delimited_string lexbuf in + let opts, _ = raw_ins pattern_options lexbuf in + check_multi_line_delimited_string (Some opts) pos ; + PATTERN(s, opts, pos) + ) + } + +| "/=" { + if lexeme_start lexbuf = !not_ok_for_match then ASSIGN(lexeme lexbuf, pos lexbuf) + else ( + putback lexbuf 1 ; + delimit_char := '/' ; + let s, pos = ins_re re_delimited_string lexbuf in + let opts, _ = raw_ins pattern_options lexbuf in + PATTERN(s, opts, pos) + ) + } + +| "m" pattern_separator { + set_delimit_char lexbuf "m" ; + current_string_start_line := !current_file_current_line; + let s, pos = ins_re re_delimited_string lexbuf in + let opts, _ = raw_ins pattern_options lexbuf in + check_multi_line_delimited_string (Some opts) pos ; + PATTERN(s, opts, pos) +} + +| "qr" pattern_separator { + set_delimit_char lexbuf "qr" ; + current_string_start_line := !current_file_current_line; + let s, pos = ins_re re_delimited_string lexbuf in + let opts, _ = raw_ins pattern_options lexbuf in + check_multi_line_delimited_string (Some opts) pos ; + QR_PATTERN(s, opts, pos) +} + +| "qw" pattern_separator { + set_delimit_char lexbuf "qw" ; + current_string_start_line := !current_file_current_line; + let s, pos = raw_ins delimited_string lexbuf in + warn_with_pos [Warn_complex_expressions] pos (Printf.sprintf "don't use qw%c...%c, use qw(...) instead" !delimit_char !delimit_char) ; + QUOTEWORDS(s, pos) +} + +| "s" pattern_separator { + set_delimit_char lexbuf "s" ; + current_string_start_line := !current_file_current_line; + let s1, (start, _) = ins_re re_delimited_string lexbuf in + let s2, (_, end_) = ins delimited_string lexbuf in + let opts, _ = raw_ins pattern_options lexbuf in + let pos = start, end_ in + if String.contains opts 'e' && sum (List.map (fun (s, _) -> count_chars_in_string s '"') s2) > 2 then + die lexbuf ("do not write so complicated things in the eval part of s///,\n" ^ + "i generate wrong warnings for things like s/xxx/die \"yyy \\\"zzz\\\" \"/") ; + check_multi_line_delimited_string (Some opts) pos ; + PATTERN_SUBST(s1, s2, opts, pos) +} + +| "tr" pattern_separator { + set_delimit_char lexbuf "tr" ; + current_string_start_line := !current_file_current_line; + let s1, (start, _) = ins delimited_string lexbuf in + let s2, (_, end_) = ins delimited_string lexbuf in + let opts, _ = raw_ins pattern_options lexbuf in + let pos = start, end_ in + check_multi_line_delimited_string None pos ; + PATTERN_SUBST(s1, s2, opts, pos) +} + +| "<<" ident { + not_ok_for_match := lexeme_end lexbuf; + HERE_DOC(here_doc_next_line (skip_n_char 2 (lexeme lexbuf)), pos lexbuf) + } +| "<<\"" ident "\"" { + warn_with_pos [Warn_suggest_simpler] (lexeme_start lexbuf + 2, lexeme_end lexbuf) "Don't use <<\"MARK\", use <>" (pos2sfull lexbuf) (lexeme lexbuf)) } + +and string = parse +| '"' { () } +| '\\' { Stack.push string next_rule ; string_escape_kind := Double_quote; string_escape lexbuf } +| '$' { Stack.push string next_rule ; string_interpolate_scalar lexbuf } +| '@' { Stack.push string next_rule ; string_interpolate_array lexbuf } +| '\n' { + add_a_new_line(lexeme_end lexbuf); + next string lexbuf + } +| "'" { string_escape_useful := Left true ; next string lexbuf } +| [^ '\n' '\\' '"' '$' '@']+ { next string lexbuf } +| eof { die_in_string lexbuf "Unterminated_string" } + +and delimited_string = parse +| '\\' { Stack.push delimited_string next_rule ; string_escape_kind := Delimited; string_escape lexbuf } +| '$' { Stack.push delimited_string next_rule ; delimited_string_interpolate_scalar lexbuf } +| '@' { Stack.push delimited_string next_rule ; delimited_string_interpolate_array lexbuf } +| '\n' { + add_a_new_line(lexeme_end lexbuf); + next delimited_string lexbuf + } +| eof { die_in_string lexbuf "Unterminated_delimited_string" } +| [ ^ '\n' '\\' '$' '@'] { if lexeme_char lexbuf 0 <> !delimit_char then next delimited_string lexbuf } + +and re_delimited_string = parse +| '\\' { Stack.push re_delimited_string next_rule ; re_string_escape lexbuf } +| '$' { Stack.push re_delimited_string next_rule ; delimited_string_interpolate_scalar lexbuf } +| '@' { if lexeme_char lexbuf 0 <> !delimit_char then + (Stack.push re_delimited_string next_rule ; delimited_string_interpolate_array lexbuf) } +| '\n' { + add_a_new_line(lexeme_end lexbuf); + next re_delimited_string lexbuf + } +| eof { die_in_string lexbuf "Unterminated_delimited_string" } +| [ ^ '\n' '\\' '$' '@'] { if lexeme_char lexbuf 0 <> !delimit_char then next re_delimited_string lexbuf } + +and rawstring = parse +| ''' { () } +| '\n' { + add_a_new_line(lexeme_end lexbuf); + next rawstring lexbuf + } +| '\\' { next rawstring lexbuf } +| "\\'" { next_s "'" rawstring lexbuf } +| [^ '\n' ''' '\\']+ { next rawstring lexbuf } +| eof { die_in_string lexbuf "Unterminated_rawstring" } + +and qqstring = parse +| pattern_close { + if lexeme_char lexbuf 0 = !delimit_char_close then + if !string_nestness <> 0 then (decr string_nestness; next qqstring lexbuf) + else () + else next qstring lexbuf + } +| pattern_open { + if lexeme_char lexbuf 0 = !delimit_char_open then incr string_nestness; + next qqstring lexbuf + } +| '\\' { Stack.push qqstring next_rule ; string_escape_kind := Qq; string_escape lexbuf } +| '$' { Stack.push qqstring next_rule ; string_interpolate_scalar lexbuf } +| '@' { Stack.push qqstring next_rule ; string_interpolate_array lexbuf } +| '\n' { + add_a_new_line(lexeme_end lexbuf); + next qqstring lexbuf + } +| [^ '\n' '(' ')' '{' '}' '\\' '$' '@']+ { next qqstring lexbuf } +| eof { die_in_string lexbuf "Unterminated_qqstring" } + +and qstring = parse +| pattern_close { + if lexeme_char lexbuf 0 = !delimit_char_close then + if !string_nestness <> 0 then (decr string_nestness ; next qstring lexbuf) + else () + else next qstring lexbuf + } +| pattern_open { + if lexeme_char lexbuf 0 = !delimit_char_open then incr string_nestness; + next qstring lexbuf + } +| '\n' { + add_a_new_line(lexeme_end lexbuf); + next qstring lexbuf + } +| [^ '\n' '(' ')' '{' '}']+ { next qstring lexbuf } +| eof { die_in_string lexbuf "Unterminated_qstring" } + +and here_doc = parse +| '\\' { Stack.push here_doc next_rule ; string_escape_kind := Here_doc; string_escape lexbuf } +| '$' { Stack.push here_doc next_rule ; string_interpolate_scalar lexbuf } +| '@' { Stack.push here_doc next_rule ; string_interpolate_array lexbuf } +| [ ^ '\n' '\\' '$' '@' ]* { + let s = lexeme lexbuf in + if chomps s <> !current_here_doc_mark + then next_s s here_doc lexbuf + else if s <> !current_here_doc_mark then warn_with_pos [Warn_traps] (pos lexbuf) "Trailing spaces after HERE-document mark" + } +| '\n' { + add_a_new_line(lexeme_end lexbuf); + next here_doc lexbuf + } +| eof { die_in_string lexbuf "Unterminated_here_doc" } + +and raw_here_doc = parse +| [ ^ '\n' ]* { + let s = lexeme lexbuf in + if chomps s <> !current_here_doc_mark + then next_s s raw_here_doc lexbuf + else if s <> !current_here_doc_mark then warn_with_pos [Warn_traps] (pos lexbuf) "Trailing spaces after HERE-document mark" + } +| '\n' { + add_a_new_line(lexeme_end lexbuf); + next raw_here_doc lexbuf + } +| eof { die_in_string lexbuf "Unterminated_raw_here_doc" } + + +and string_escape = parse +| ['0'-'9'] { string_escape_useful := Left true; next_s (String.make 1 (Char.chr (int_of_string (lexeme lexbuf)))) (Stack.pop next_rule) lexbuf } +| 'n' { string_escape_useful := Left true; next_s "\n" (Stack.pop next_rule) lexbuf } +| 't' { string_escape_useful := Left true; next_s "\t" (Stack.pop next_rule) lexbuf } +| "x{" [^ '}']* '}' { string_escape_useful := Left true; hex_in_string lexbuf next_rule (skip_n_char_ 2 1 (lexeme lexbuf)) } +| 'x' [^ '{'] _ { string_escape_useful := Left true; hex_in_string lexbuf next_rule (skip_n_char 1 (lexeme lexbuf)) } +| '\n' { die lexbuf "do not use \"\\\" before end-of-line, it's useless and generally bad" } +| '\\'{ next_s "\\" (Stack.pop next_rule) lexbuf } +| 'Q' { + warn [Warn_complex_expressions] lexbuf ("don't use \\Q, use quotemeta instead"); + string_escape_useful := Left true; next_s ("\\" ^ lexeme lexbuf) (Stack.pop next_rule) lexbuf } +| ['b' 'f' 'a' 'r'] { string_escape_useful := Left true; next_s ("\\" ^ lexeme lexbuf) (Stack.pop next_rule) lexbuf } +| ['$' '@' '%' '{' '[' ':'] { + if !string_escape_useful = Left false then string_escape_useful := Right (lexeme_char lexbuf 0) ; + next_s (lexeme lexbuf) (Stack.pop next_rule) lexbuf + } +| _ { + let c = lexeme_char lexbuf 0 in + (match !string_escape_kind with + | Double_quote -> + if c <> '"' then + warn_escape_unneeded lexbuf c + else ( + if !string_escape_useful = Left false then string_escape_useful := Right c ; + string_quote_escape := true + ) + | Qq -> if c <> !delimit_char_open && c <> !delimit_char_close then warn_escape_unneeded lexbuf c + | Here_doc -> warn_escape_unneeded lexbuf c + | Delimited -> if c = !delimit_char then + warn [Warn_suggest_simpler] lexbuf ("change the delimit character " ^ String.make 1 !delimit_char ^ " to get rid of this escape") + else warn_escape_unneeded lexbuf c); + let s = if c = '"' then String.make 1 c else "\\" ^ String.make 1 c in + next_s s (Stack.pop next_rule) lexbuf + } + +and re_string_escape = parse +| ['0'-'9'] { next_s (String.make 1 (Char.chr (int_of_string (lexeme lexbuf)))) (Stack.pop next_rule) lexbuf } +| '\\'{ next_s "\\" (Stack.pop next_rule) lexbuf } +| 'n' { next_s "\n" (Stack.pop next_rule) lexbuf } +| 't' { next_s "\t" (Stack.pop next_rule) lexbuf } +| "x{" [^ '}']* '}' { hex_in_string lexbuf next_rule (skip_n_char_ 2 1 (lexeme lexbuf)) } +| 'x' [^ '{'] _ { hex_in_string lexbuf next_rule (skip_n_char 1 (lexeme lexbuf)) } +| '\n' { die lexbuf "do not use \"\\\" before end-of-line, it's useless and generally bad" } +| ['r' 'b' 'f' '$' '@' '%' 's' 'S' 'd' 'D' 'w' 'W' 'Q' 'E' 'b' 'Z' 'z' '^' '.' '*' '+' '?' '[' ']' '(' ')' '|' '{' '}' '-' ':'] { + next_s ("\\" ^ lexeme lexbuf) (Stack.pop next_rule) lexbuf + } +| _ { + let c = lexeme_char lexbuf 0 in + if c = !delimit_char then + warn [Warn_suggest_simpler] lexbuf ("change the delimit character " ^ String.make 1 !delimit_char ^ " to get rid of this escape") + else warn_escape_unneeded lexbuf c ; + next_s ("\\" ^ lexeme lexbuf) (Stack.pop next_rule) lexbuf + } + +and string_interpolate_scalar = parse +| '$' ident +| ['0'-'9'] +| '{' [^ '{' '}']* '}' +| in_string_expr +| [^ '{' '}' ' ' '\n' '"'] { (* eg: $! $$ *) + string_interpolate token "$" lexbuf + } + +| "{" +| ident "->"? '{' +| '"' { putback lexbuf 1; next_s "$" (Stack.pop next_rule) lexbuf } +| eof { next_s "$" (Stack.pop next_rule) lexbuf } +| _ { warn [Warn_strange] lexbuf (Printf.sprintf "weird \"%s\" in string" (lexeme lexbuf)); next_s ("$" ^ lexeme lexbuf) (Stack.pop next_rule) lexbuf } + +and delimited_string_interpolate_scalar = parse (* needed for delimited string like m!foo$! where $! should not be taken as is... *) +| '$' ident +| ['0'-'9'] +| '{' [^ '{' '}']* '}' +| (ident | (ident? ("::" ident)+)) "->"? ('{' [^ '{' '}' '\n']* '}')* +| (ident | (ident? ("::" ident)+)) "->"? (('{' [^ '{' '}' '\n']* '}') | ('[' ('$' ident | ['0'-'9']+) ']'))* + { + string_interpolate token "$" lexbuf + } + +| (ident | (ident? ("::" ident)+)) "->"? (('{' [^ '{' '}' '\n']* '}') | ('[' ['$' '0'-'9'] [^ '[' ']' '\n']* ']'))* + { + die lexbuf (Printf.sprintf "I really can't handle this, [xxx] can be indexing or not based on stellar position :-(") + } + +| "{" +| ident "->"? '{' +| eof { next_s "$" (Stack.pop next_rule) lexbuf } +| _ { + let c = lexeme_char lexbuf 0 in + if c <> !delimit_char && c <> '|' && c<>')' && c<>'/' && c<>' ' then warn [Warn_strange] lexbuf (Printf.sprintf "weird \"%s\" in string" (lexeme lexbuf)); + putback lexbuf 1; + next_s "$" (Stack.pop next_rule) lexbuf + } + +and string_interpolate_array = parse +| '$' ident +| '{' [^ '{' '}']* '}' +| in_string_expr { string_interpolate token "@" lexbuf } + +| [ '@' '*' '<' '>' ']' '.' '(' ' ' ] { next_s ("@" ^ lexeme lexbuf) (Stack.pop next_rule) lexbuf } +| '"' { putback lexbuf 1; next_s "@" (Stack.pop next_rule) lexbuf } +| eof { next_s "@" (Stack.pop next_rule) lexbuf } +| _ { warn [Warn_strange] lexbuf (Printf.sprintf "weird \"%s\" in string" (lexeme lexbuf)); next_s ("@" ^ lexeme lexbuf) (Stack.pop next_rule) lexbuf } + +and delimited_string_interpolate_array = parse +| '$' ident +| '{' [^ '{' '}']* '}' +| in_string_expr + { string_interpolate token "@" lexbuf } + +| [ '@' '*' '<' '>' ']' '.' '(' ' ' ] { next_s ("@" ^ lexeme lexbuf) (Stack.pop next_rule) lexbuf } +| eof { next_s "@" (Stack.pop next_rule) lexbuf } +| _ { + let c = lexeme_char lexbuf 0 in + if c <> !delimit_char then warn [Warn_strange] lexbuf (Printf.sprintf "weird \"%s\" in string" (lexeme lexbuf)); + putback lexbuf 1; + next_s "@" (Stack.pop next_rule) lexbuf + } + +and pattern_options = parse +| [ 'g' 'i' 'm' 'o' 's' 'x' 'e' 'd' ] { next pattern_options lexbuf } +| _ { putback lexbuf 1; () } + +and pod_command = parse +| [^ '\n' ]+ { + let s = lexeme lexbuf in + let command = String.sub s 0 (try String.index s ' ' with Not_found -> String.length s) in + match command with + | "cut" -> + if !(Stack.top building_current_string) = "" then + failwith(pos2sfull lexbuf ^ "found POD command \"=cut\" but it is not a POD block") + | "head1" | "head2" | "head3" | "head4" | "over" | "item" | "back" | "pod" | "begin" | "end" | "for" -> + next pod lexbuf + | s -> failwith(pos2sfull lexbuf ^ "unknown POD command \"" ^ s ^ "\"") + } +| _ { failwith(pos2sfull lexbuf ^ "POD command expected") } + +and pod = parse +| "\n=" { + add_a_new_line(lexeme_end lexbuf - 1); + next pod_command lexbuf + } +| "\n" [^ '=' '\n'] [^ '\n']* +| "\n" { + add_a_new_line(lexeme_end lexbuf); + next pod lexbuf + } +| eof +| _ { failwith(pos2sfull_with !current_string_start_pos (lexeme_end lexbuf) ^ "POD block still open") } diff --git a/src/parser.mly b/src/parser.mly new file mode 100644 index 0000000..a9bf396 --- /dev/null +++ b/src/parser.mly @@ -0,0 +1,500 @@ +%{ (* -*- caml -*- *) + open Types + open Common + open Parser_helper + + let parse_error msg = die_rule msg + let prog_ref = ref None + let to_String e = Parser_helper.to_String (some !prog_ref) e + let from_PATTERN e = Parser_helper.from_PATTERN (some !prog_ref) e + let from_PATTERN_SUBST e = Parser_helper.from_PATTERN_SUBST (some !prog_ref) e +%} + + +%token EOF +%token NUM RAW_STRING BAREWORD BAREWORD_PAREN REVISION COMMENT POD LABEL PO_COMMENT PERL_CHECKER_COMMENT ONE_SCALAR_PARA +%token <(string * string) Types.any_spaces_pos> PRINT_TO_STAR PRINT_TO_SCALAR +%token QUOTEWORDS COMPACT_HASH_SUBSCRIPT +%token <(string * Types.raw_pos) Types.any_spaces_pos> RAW_HERE_DOC +%token <(string * ((int * int) * token) list) list Types.any_spaces_pos> STRING COMMAND_STRING +%token <((string * ((int * int) * token) list) list * Types.raw_pos) Types.any_spaces_pos> HERE_DOC FORMAT + +%token <((string * ((int * int) * token) list) list * string) Types.any_spaces_pos> PATTERN QR_PATTERN +%token <((string * ((int * int) * token) list) list * (string * ((int * int) * token) list) list * string) Types.any_spaces_pos> PATTERN_SUBST + +%token <(string option * string) Types.any_spaces_pos> SCALAR_IDENT ARRAY_IDENT HASH_IDENT FUNC_IDENT STAR_IDENT RAW_IDENT RAW_IDENT_PAREN ARRAYLEN_IDENT +%token SUB_WITH_PROTO +%token <(string option * string * string) Types.any_spaces_pos> FUNC_DECL_WITH_PROTO + +%token FOR PRINT +%token NEW +%token COMPARE_OP COMPARE_OP_STR EQ_OP EQ_OP_STR +%token ASSIGN MY_OUR + +%token IF ELSIF ELSE UNLESS DO WHILE UNTIL CONTINUE SUB LOCAL +%token USE PACKAGE BEGIN END +%token AT DOLLAR PERCENT AMPERSAND STAR ARRAYLEN +%token SEMI_COLON PKG_SCOPE +%token PAREN PAREN_END +%token BRACKET BRACKET_END BRACKET_HASHREF +%token ARRAYREF ARRAYREF_END + +%token ARROW +%token INCR DECR +%token POWER +%token TIGHT_NOT BIT_NEG REF +%token PATTERN_MATCH PATTERN_MATCH_NOT +%token MULT +%token PLUS +%token BIT_SHIFT +%token LT GT CONCAT MULT_L_STR +%token BIT_AND +%token BIT_OR BIT_XOR +%token AND_TIGHT +%token OR_TIGHT +%token DOTDOT +%token QUESTION_MARK COLON +%token COMMA RIGHT_ARROW +%token NOT +%token AND +%token OR XOR + +%nonassoc PREC_LOW +%nonassoc LOOPEX + +%right OR XOR +%right AND +%right NOT +%nonassoc LSTOP +%left COMMA RIGHT_ARROW + +%right ASSIGN +%right QUESTION_MARK COLON +%nonassoc DOTDOT +%left OR_TIGHT +%left AND_TIGHT +%left BIT_OR BIT_XOR +%left BIT_AND +%nonassoc EQ_OP EQ_OP_STR +%nonassoc LT GT COMPARE_OP COMPARE_OP_STR +%nonassoc UNIOP ONE_SCALAR_PARA +%left BIT_SHIFT +%left PLUS CONCAT +%left MULT MULT_L_STR +%left PATTERN_MATCH PATTERN_MATCH_NOT +%right TIGHT_NOT BIT_NEG REF UNARY_MINUS +%right POWER +%nonassoc INCR DECR +%left ARROW + +%nonassoc PAREN_END +%left PAREN PREC_HIGH +%left ARRAYREF BRACKET + +%type prog +%type expr term +%type scalar bracket_subscript variable restricted_subscripted + +%start prog + + +%% +prog: lines EOF {fst $1.any} + +lines: /* A collection of "lines" in the program */ +| { default_esp ([], true) } +| sideff { new_1esp ([$1.any], false) $1 } +| line lines { if fst $2.any <> [] then mcontext_check_none "value is dropped" $1.any $1; new_esp $2.mcontext ($1.any @ fst $2.any, snd $2.any) $1 $2 } + +line: +| decl { new_1esp [$1.any] $1 } +| if_then_else { new_1esp [$1.any] $1 } +| loop { new_1esp [$1.any] $1 } +| LABEL { sp_cr($1); new_1esp [Label $1.any] $1 } +| PERL_CHECKER_COMMENT {sp_p($1); new_1esp [Perl_checker_comment($1.any, get_pos $1)] $1 } +| semi_colon {warn_rule [Warn_white_space] "unneeded \";\""; new_1esp [Semi_colon] $1 } +| sideff semi_colon {new_1esp [$1.any ; Semi_colon] $1 } +| BRACKET lines BRACKET_END {new_esp $2.mcontext [lines_to_Block $2 $3] $1 $3} + +if_then_else: /* Real conditional expressions */ +| IF PAREN expr PAREN_END BRACKET lines BRACKET_END elsif else_ {sp_p($1); sp_n($2); sp_0($3); sp_0_or_cr($4); sp_p($5); mcontext_check M_bool $3; to_Call_op (if $9.any = [] then M_none else mcontext_lmerge ($6.mcontext :: mcontext_lmaybe $8 @ [$9.mcontext])) "if" (prio_lo P_loose $3 :: lines_to_Block $6 $7 :: $8.any @ $9.any) $1 $9} +| UNLESS PAREN expr PAREN_END BRACKET lines BRACKET_END elsif else_ {sp_p($1); sp_n($2); sp_0($3); sp_0_or_cr($4); sp_p($5); mcontext_check M_bool $3; check_unless_else $8 $9; to_Call_op M_none "unless" (prio_lo P_loose $3 :: lines_to_Block $6 $7 :: $8.any @ $9.any) $1 $9} + +elsif: +| {default_esp []} +| ELSIF PAREN expr PAREN_END BRACKET lines BRACKET_END elsif {sp_p($1); sp_n($2); sp_0($3); sp_0_or_cr($4); sp_p($5); mcontext_check M_bool $3; new_esp (mcontext_lmerge ($6.mcontext :: mcontext_lmaybe $8)) (prio_lo P_loose $3 :: lines_to_Block $6 $7 :: $8.any) $1 $8} + +else_: +| { default_esp [] } +| ELSE BRACKET lines BRACKET_END {sp_p($1); sp_n($2); new_esp $3.mcontext [lines_to_Block $3 $4] $1 $4} + +loop: +| WHILE PAREN expr PAREN_END BRACKET lines BRACKET_END cont {sp_p($1); sp_n($2); sp_0($3); sp_0_or_cr($4); sp_p($5); mcontext_check M_bool $3; to_Call_op M_none "while" [ prio_lo P_loose $3; lines_to_Block $6 $7 ] $1 $8} +| UNTIL PAREN expr PAREN_END BRACKET lines BRACKET_END cont {sp_p($1); sp_n($2); sp_0($3); sp_0_or_cr($4); sp_p($5); mcontext_check M_bool $3; to_Call_op M_none "until" [ prio_lo P_loose $3; lines_to_Block $6 $7 ] $1 $8} +| FOR PAREN expr_or_empty semi_colon expr_or_empty semi_colon expr_or_empty PAREN_END BRACKET lines BRACKET_END {sp_p($1); check_for($1); sp_n($2); sp_0($3); sp_p($5); sp_p($7); sp_0($8); sp_n($9); to_Call_op M_none "for" [ $3.any; $5.any; $7.any; lines_to_Block $10 $11 ] $1 $11} +| FOR SCALAR_IDENT PAREN expr PAREN_END BRACKET lines BRACKET_END cont { warn_rule [Warn_normalized_expressions] "don't use for without \"my\"ing the iteration variable"; sp_p($1); sp_0($4); sp_0_or_cr($5); sp_p($6); mcontext_check M_list $4; to_Call_op M_none "foreach" [ prio_lo P_loose $4; lines_to_Block $7 $8 ] $1 $9} +| FOR PAREN expr PAREN_END BRACKET lines BRACKET_END cont {sp_p($1); sp_n($2); sp_0($3); sp_0_or_cr($4); sp_p($5); mcontext_check M_list $3; check_for_foreach $1 $3; to_Call_op M_none "foreach" [ prio_lo P_loose $3; lines_to_Block $6 $7 ] $1 $8} +| for_my lines BRACKET_END cont { to_Call_op M_none "foreach my" ($1.any @ [ lines_to_Block $2 $3 ]) $1 $4} + +for_my: +| FOR MY_OUR SCALAR_IDENT PAREN expr PAREN_END BRACKET {sp_p($1); check_my($2); check_foreach($1); sp_n($4); sp_0($5); sp_0_or_cr($6); sp_p($7); new_esp M_none [ My_our($2.any, [I_scalar, snd $3.any], get_pos $3); prio_lo P_loose $5 ] $1 $7} + + +cont: /* Continue blocks */ +| {default_esp ()} +| CONTINUE BRACKET lines BRACKET_END {sp_p($1); sp_n($2); check_block_lines $3 $4; new_esp $3.mcontext () $1 $4} + +sideff: /* An expression which may have a side-effect */ +| expr { new_1esp $1.any.expr $1 } +| expr IF expr {sp_p($2); sp_p($3); mcontext_check M_bool $3; call_op_if_infix (prio_lo P_loose $1) (prio_lo P_loose $3) $1 $3} +| expr UNLESS expr {sp_p($2); sp_p($3); mcontext_check M_bool $3; call_op_unless_infix (prio_lo P_loose $1) (prio_lo P_loose $3) $1 $3} +| expr WHILE expr {sp_p($2); sp_p($3); mcontext_check M_bool $3; to_Call_op M_none "while infix" [ prio_lo P_loose $1 ; prio_lo P_loose $3 ] $1 $3} +| expr UNTIL expr {sp_p($2); sp_p($3); mcontext_check M_bool $3; to_Call_op M_none "until infix" [ prio_lo P_loose $1 ; prio_lo P_loose $3 ] $1 $3} +| expr FOR expr {sp_p($2); sp_p($3); mcontext_check M_list $3; check_foreach($2); to_Call_op M_none "for infix" [ prio_lo P_loose $1 ; prio_lo P_loose $3 ] $1 $3} + +decl: +| FORMAT BAREWORD ASSIGN {to_Call_op M_none "format" [Raw_string($2.any, get_pos $2) ; to_String false (new_1esp (fst $1.any) $1)] $1 $3} +| FORMAT ASSIGN {new_esp M_none Too_complex $1 $2} +| func_decl semi_colon {if snd $1.any = None then die_rule "there is no need to pre-declare in Perl!" else (warn_rule [Warn_normalized_expressions] "please don't use prototype pre-declaration" ; new_esp M_special Too_complex $1 $2) } +| func_decl BRACKET BRACKET_END {sp_n($2); sp_0_or_cr($3); let name, proto = $1.any in new_esp M_none (sub_declaration (name, proto) [] Real_sub_declaration) $1 $3} +| func_decl BRACKET lines BRACKET_END {sp_n($2); check_block_lines $3 $4; new_esp M_none (sub_declaration $1.any (fst $3.any) Real_sub_declaration) $1 $4} +| func_decl BRACKET BRACKET expr BRACKET_END BRACKET_END {sp_n($2); sp_p($3); sp_p($4); sp_p($5); check_block_expr false Undef $5 $6; new_esp M_none (sub_declaration $1.any [hash_ref $4] Real_sub_declaration) $1 $6} +| func_decl BRACKET BRACKET expr BRACKET_END semi_colon BRACKET_END {sp_n($2); sp_p($3); sp_p($4); sp_p($5); check_block_expr true Semi_colon $6 $7; new_esp M_none (sub_declaration $1.any [hash_ref $4; Semi_colon] Real_sub_declaration) $1 $7} +| PACKAGE word semi_colon {sp_0_or_cr($1); sp_1($2); new_esp M_none (Package $2.any) $1 $3} +| BEGIN BRACKET lines BRACKET_END {sp_0_or_cr($1); sp_1($2); new_esp M_none (Sub_declaration(Ident(None, "BEGIN", get_pos $1), None, lines_to_Block $3 $4, Glob_assign)) $1 $4} +| END BRACKET lines BRACKET_END {sp_0_or_cr($1); sp_1($2); new_esp M_none (Sub_declaration(Ident(None, "END", get_pos $1), None, lines_to_Block $3 $4, Glob_assign)) $1 $4} +| use {$1} + +use: +| use_word listexpr semi_colon {sp_n($2); new_esp M_none (Use($1.any, $2.any.expr)) $1 $3} +| use_revision word_paren PAREN listexpr PAREN_END {sp_0($4); sp_0_or_cr($5); new_esp M_none (Use($2.any, $4.any.expr)) $1 $5} + +use_word: +| use_revision word comma {new_esp M_none $2.any $1 $3} +| use_revision word {new_esp M_none $2.any $1 $2} +| use_revision {new_1esp Undef $1 } + +use_revision: +| USE REVISION comma {$1} +| USE REVISION {$1} +| USE {$1} + +func_decl: +| SUB word { new_esp M_none ($2.any, None) $1 $2} +| SUB ONE_SCALAR_PARA { new_esp M_none (Ident(None, $2.any, get_pos $2), None) $1 $2} +| SUB BAREWORD_PAREN PAREN PAREN_END { warn_rule [Warn_white_space] "remove carriage return between \"sub\" and the function name"; new_esp M_none (Ident(None, $2.any, get_pos $2), Some "") $1 $4 } +| FUNC_DECL_WITH_PROTO {new_1esp (Ident(fst3 $1.any, snd3 $1.any, get_pos $1), Some (ter3 $1.any)) $1 } + +listexpr: /* Basic list expressions */ +| %prec PREC_LOW { default_pesp P_tok []} +| argexpr %prec PREC_LOW {$1} + +expr: /* Ordinary expressions; logical combinations */ +| expr AND expr {sp_p($2); sp_p($3); mcontext_check M_bool $1; mcontext_check_none "value should be dropped" [$3.any.expr] $3; to_Call_op_ M_none P_and "and" [ prio_lo P_and $1; prio_lo_after P_and $3 ] $1 $3} +| expr OR expr {sp_p($2); sp_p($3); mcontext_check M_bool $1; mcontext_check_none "value should be dropped" [$3.any.expr] $3; to_Call_op_ M_none P_or "or" [ prio_lo P_or $1; prio_lo_after P_or $3 ] $1 $3} +| argexpr %prec PREC_LOW { new_1pesp $1.any.priority (List $1.any.expr) $1 } + +argexpr: /* Expressions are a list of terms joined by commas */ +| argexpr comma { new_pesp $1.mcontext P_comma $1.any.expr $1 $2} +| bareword RIGHT_ARROW term {if not_simple ($3.any.expr) then sp_p($3); new_pesp (mtuple_context_concat M_string $3.mcontext) P_comma (followed_by_comma [$1.any] false @ [$3.any.expr]) $1 $3} +| bareword RIGHT_ARROW BRACKET expr BRACKET_END {sp_p($3); sp_p($5); new_pesp (mtuple_context_concat M_string (M_ref M_hash)) P_comma (followed_by_comma [$1.any] false @ [ hash_ref $4 ]) $1 $5} +| argexpr comma term {prio_lo_check P_comma $1.any.priority $1.pos (last $1.any.expr); if not_simple ($3.any.expr) then sp_p($3); new_pesp (mtuple_context_concat $1.mcontext $3.mcontext) P_comma (followed_by_comma $1.any.expr $2.any @ [$3.any.expr]) $1 $3} +| argexpr comma BRACKET expr BRACKET_END {sp_p($3); sp_p($5); new_pesp (mtuple_context_concat $1.mcontext (M_ref M_hash)) P_comma (followed_by_comma $1.any.expr $2.any @ [ hash_ref $4 ]) $1 $5} +| term %prec PREC_LOW { new_1pesp $1.any.priority [$1.any.expr] $1 } + +/********************************************************************************/ +term: +| term + COMPARE_OP_STR term {sp_p $2; symops P_cmp M_string M_bool $2.any $1 $2 $3} +| term COMPARE_OP term {sp_p $2; symops P_cmp M_float M_bool $2.any $1 $2 $3} +| term LT term {sp_p $2; symops P_cmp M_float M_bool "<" $1 $2 $3} +| term GT term {sp_p $2; symops P_cmp M_float M_bool ">" $1 $2 $3} +| term EQ_OP term {sp_p $2; symops P_eq M_float M_bool $2.any $1 $2 $3} +| term EQ_OP_STR term {sp_p $2; symops P_eq M_string M_bool $2.any $1 $2 $3} + +| term BIT_AND term {sp_p $2; symops P_bit M_int M_int "&" $1 $2 $3} +| term BIT_OR term { symops P_bit M_int M_int "|" $1 $2 $3} +| term BIT_XOR term {sp_p $2; symops P_bit M_int M_int "^" $1 $2 $3} + +| term POWER term { symops P_tight M_float (mcontext_float_or_int [$1.mcontext; $3.mcontext]) "**" $1 $2 $3} +| term PLUS term { symops P_add M_float (mcontext_float_or_int [$1.mcontext; $3.mcontext]) $2.any $1 $2 $3} +| term CONCAT term {sp_p $2; symops P_add M_string M_string "." $1 $2 $3} +| term BIT_SHIFT term { symops (P_paren_wanted P_tight) M_int M_int $2.any $1 $2 $3} +| term XOR term {sp_p $2; symops (P_paren_wanted P_expr) M_bool M_bool "xor" $1 $2 $3} +| term DOTDOT term { symops (P_paren_wanted P_expr) M_unknown_scalar M_string $2.any $1 $2 $3} + +| term AND_TIGHT term {sp_p $2; sp_same $2 $3; mcontext_check M_bool $1; let pri = P_tight_and in to_Call_op_ (mcontext_to_scalar $3.mcontext) pri "&&" [prio_lo pri $1; prio_lo_after pri $3] $1 $3} +| term OR_TIGHT term {sp_p $2; sp_same $2 $3; mcontext_check M_bool $1; let pri = P_tight_or in to_Call_op_ (mcontext_to_scalar (mcontext_merge $1.mcontext $3.mcontext)) pri "||" [prio_lo pri $1; prio_lo_after pri $3] $1 $3} + +| term MULT term {sp_same $2 $3; let pri = P_mul in to_Call_op_ (mcontext_float_or_int [$1.mcontext; $3.mcontext]) pri $2.any [prio_lo_concat $1; prio_lo_after pri $3] $1 $3} +| term MULT_L_STR term {sp_same $2 $3; mcontext_check M_int $3; let pri = P_mul in to_Call_op_ (if mcontext_lower $1.mcontext M_string then M_string else M_list) pri "x" + [prio_lo_concat $1; prio_lo_after pri $3] $1 $3} + +| term ASSIGN term {sp_same $2 $3; let pri = P_assign in to_Call_assign_op_ (mcontext_op_assign $1 $3) pri $2.any ($1.any.expr) (prio_lo_after pri $3) $1 $3} + +| term ASSIGN BRACKET expr_bracket_end {sp_p($2); sp_p($3); sp_p($4); to_Call_assign_op_ (M_mixed [M_ref M_hash; M_none]) P_assign $2.any (prio_lo P_assign $1) $4.any $1 $4} +| term AND_TIGHT BRACKET expr_bracket_end {sp_p($2); sp_p($3); sp_p($4); to_Call_op_ M_bool P_tight_and "&&" [prio_lo P_assign $1; $4.any] $1 $4} +| term OR_TIGHT BRACKET expr_bracket_end {sp_p($2); sp_p($3); sp_p($4); to_Call_op_ M_bool P_tight_or "||" [prio_lo P_assign $1; $4.any] $1 $4} + + +| term PATTERN_MATCH PATTERN {sp_n($2); sp_p($3); check_unneeded_var_dollar_ ($1); mcontext_check M_string $1; to_Call_op_ M_array P_expr "m//" ($1.any.expr :: from_PATTERN $3) $1 $3} +| term PATTERN_MATCH_NOT PATTERN {sp_n($2); sp_p($3); check_unneeded_var_dollar_not($1); mcontext_check M_string $1; to_Call_op_ M_int P_expr "!m//" ($1.any.expr :: from_PATTERN $3) $1 $3} +| term PATTERN_MATCH PATTERN_SUBST {sp_n($2); sp_p($3); check_unneeded_var_dollar_s ($1); to_Call_op_ (M_mixed[M_none; M_int]) P_expr "s///" ($1.any.expr :: from_PATTERN_SUBST $3) $1 $3} +| term PATTERN_MATCH_NOT PATTERN_SUBST {die_with_rawpos $2.pos "use =~ instead of !~ and negate the return value"} + +| term PATTERN_MATCH QR_PATTERN {warn [Warn_traps] $3.pos "use m/.../ or /.../ instead of qr/.../ when you do a pattern matching"; to_Call_op_ M_array P_expr "m//" ($1.any.expr :: from_PATTERN $3) $1 $3} +| term PATTERN_MATCH_NOT QR_PATTERN {warn [Warn_traps] $3.pos "use m/.../ or /.../ instead of qr/.../ when you do a pattern matching"; to_Call_op_ M_int P_expr "!m//" ($1.any.expr :: from_PATTERN $3) $1 $3} +| term PATTERN_MATCH scalar { new_pesp M_array P_expr (Call(Too_complex, [$1.any.expr ; $3.any ])) $1 $3} +| term PATTERN_MATCH_NOT scalar { new_pesp M_int P_expr (Call(Too_complex, [$1.any.expr ; $3.any ])) $1 $3} + +| term PATTERN_MATCH RAW_STRING {warn [Warn_complex_expressions] $3.pos "use a regexp, not a string"; to_Call_op_ M_array P_expr "m//" [ $1.any.expr; to_Raw_string $3 ] $1 $3} +| term PATTERN_MATCH_NOT RAW_STRING {warn [Warn_complex_expressions] $3.pos "use a regexp, not a string"; to_Call_op_ M_int P_expr "!m//" [ $1.any.expr; to_Raw_string $3 ] $1 $3} +| term PATTERN_MATCH STRING {warn [Warn_complex_expressions] $3.pos "use a regexp, not a string"; to_Call_op_ M_array P_expr "m//" [ $1.any.expr; to_String false $3 ] $1 $3} +| term PATTERN_MATCH_NOT STRING {warn [Warn_complex_expressions] $3.pos "use a regexp, not a string"; to_Call_op_ M_int P_expr "!m//" [ $1.any.expr; to_String false $3 ] $1 $3} + + +| term QUESTION_MARK term COLON term {sp_p($2); sp_p($3); sp_p($4); sp_p($5); mcontext_check M_bool $1; to_Call_op_ (mcontext_merge $3.mcontext $5.mcontext) P_ternary "?:" (check_ternary_paras(prio_lo P_ternary $1, prio_lo_after P_ternary $3, prio_lo_after P_ternary $5)) $1 $5} +| term QUESTION_MARK term COLON BRACKET expr BRACKET_END {sp_p($2); sp_p($3); sp_p($4); sp_p($5); sp_p($6); sp_p($7); mcontext_check M_bool $1; to_Call_op_ (mcontext_merge $3.mcontext (M_ref M_hash)) P_ternary "?:" (check_ternary_paras(prio_lo P_ternary $1, prio_lo_after P_ternary $3, hash_ref $6)) $1 $7} +| term QUESTION_MARK BRACKET expr BRACKET_END COLON term {sp_p($2); sp_p($3); sp_p($4); sp_p($5); sp_p($6); sp_p($7); mcontext_check M_bool $1; to_Call_op_ (mcontext_merge $7.mcontext (M_ref M_hash)) P_ternary "?:" (check_ternary_paras(prio_lo P_ternary $1, hash_ref $4, prio_lo_after P_ternary $7)) $1 $7} +| term QUESTION_MARK BRACKET expr BRACKET_END COLON BRACKET expr BRACKET_END {sp_p($2); sp_p($3); sp_p($4); sp_p($5); sp_p($6); sp_p($7); sp_p($8); sp_p($9); mcontext_check M_bool $1; to_Call_op_ (M_ref M_hash) P_ternary "?:" (check_ternary_paras(prio_lo P_ternary $1, hash_ref $4, hash_ref $8)) $1 $9} + +/* Unary operators and terms */ +| PLUS term %prec UNARY_MINUS { + sp_0($2); + match $1.any with + | "+" -> + warn_rule [Warn_normalized_expressions] "don't use unary +" ; + to_Call_op_ (mcontext_float_or_int [$2.mcontext]) P_tight "+ unary" [$2.any.expr] $1 $2 + | "-" -> + (match $2.any.expr with + | Ident(_, _, pos) when $2.spaces = Space_0 -> + let s = "-" ^ string_of_fromparser $2.any.expr in + warn_rule [Warn_complex_expressions] (Printf.sprintf "don't use %s, use '%s' instead" s s); + new_pesp M_string P_tok (Raw_string(s, pos)) $1 $2 + | _ -> to_Call_op_ (mcontext_float_or_int [$2.mcontext]) P_tight "- unary" [$2.any.expr] $1 $2) + | _ -> die_rule "syntax error" +} +| TIGHT_NOT term {check_negatable_expr $2; mcontext_check M_bool $2; to_Call_op_ M_bool P_tight "not" [$2.any.expr] $1 $2} +| BIT_NEG term { mcontext_check M_int $2; to_Call_op_ M_int P_expr "~" [$2.any.expr] $1 $2} +| INCR term {sp_0($2); mcontext_check M_int $2; to_Call_op_ (M_mixed [M_int ; M_none]) P_tight "++" [$2.any.expr] $1 $2} +| DECR term {sp_0($2); mcontext_check M_int $2; to_Call_op_ (M_mixed [M_int ; M_none]) P_tight "--" [$2.any.expr] $1 $2} +| term INCR {sp_0($2); mcontext_check M_int $1; to_Call_op_ (M_mixed [M_int ; M_none]) P_tight "++ post" [$1.any.expr] $1 $2} +| term DECR {sp_0($2); mcontext_check M_int $1; to_Call_op_ (M_mixed [M_int ; M_none]) P_tight "-- post" [$1.any.expr] $1 $2} +| NOT argexpr {warn_rule [Warn_normalized_expressions] "don't use \"not\", use \"!\" instead"; mcontext_check_unop_l M_bool $2; to_Call_op_ M_bool P_and "not" ($2.any.expr) $1 $2} + +/* Constructors for anonymous data */ + +| ARRAYREF ARRAYREF_END {sp_0($2); new_pesp (M_ref M_array) P_expr (Ref(I_array, List[])) $1 $2} +| arrayref_start ARRAYREF_END {(if $1.any = [] then sp_0 else sp_p)($2) ; new_pesp (M_ref M_array) P_expr (Ref(I_array, List $1.any)) $1 $2} +| arrayref_start expr ARRAYREF_END {sp_same $2 $3; new_pesp (M_ref M_array) P_expr (Ref(I_array, List($1.any @ [$2.any.expr]))) $1 $3} +| arrayref_start BRACKET expr BRACKET_END ARRAYREF_END {sp_same $2 $5; new_pesp (M_ref M_array) P_expr (Ref(I_array, List($1.any @ [hash_ref $3]))) $1 $5} + +| BRACKET BRACKET_END {new_pesp (M_ref M_hash) P_expr (Ref(I_hash, List [])) $1 $2} /* empty hash */ +| BRACKET_HASHREF expr BRACKET_END %prec PREC_HIGH {sp_p($3); new_pesp (M_ref M_hash) P_expr (hash_ref $2) $1 $3} /* { foo => "Bar" } */ +| SUB BRACKET BRACKET_END %prec PREC_HIGH {sp_n($2); sp_0($3); new_pesp (M_ref M_sub) P_expr (Anonymous_sub(None, Block [], pos_range $2 $3)) $1 $3} +| SUB_WITH_PROTO BRACKET BRACKET_END %prec PREC_HIGH {sp_n($2); sp_0($3); new_pesp (M_ref M_sub) P_expr (Anonymous_sub(Some $1.any, Block [], pos_range $2 $3)) $1 $3} +| SUB BRACKET lines BRACKET_END %prec PREC_HIGH {sp_n($2); new_pesp (M_ref M_sub) P_expr (anonymous_sub None $3 $4) $1 $4} +| SUB_WITH_PROTO BRACKET lines BRACKET_END %prec PREC_HIGH {sp_n($2); new_pesp (M_ref M_sub) P_expr (anonymous_sub (Some $1.any) $3 $4) $1 $4} + +| termdo {new_1pesp P_tok $1.any $1} +| REF term {new_pesp (M_ref $2.mcontext) P_expr (Ref(I_scalar, remove_call_with_same_para_special $2.any.expr)) $1 $2} /* \$x, \@y, \%z */ +| my_our %prec UNIOP {new_1pesp P_expr $1.any $1} +| LOCAL term %prec UNIOP {sp_n($2); new_pesp (M_mixed [ $2.mcontext ; M_none ]) P_expr (to_Local $2) $1 $2} + +| parenthesized {new_1pesp $1.any.priority (List $1.any.expr) $1} /* (1, 2) */ +| parenthesized arrayref {sp_0($2); let is_slice = not (is_only_one_in_List $2.any) in new_pesp (if is_slice then M_list else M_unknown_scalar) P_tok (to_Deref_with(I_array, (if is_slice then I_array else I_scalar), List $1.any.expr, List $2.any)) $1 $2} /* list indexing or slicing */ + +| variable { + let e = + match $1.any with + | Deref(I_func, Ident _) -> + call_with_same_para_special $1.any (* not the same as f(@_) *) + | e -> e in + new_1pesp P_tok e $1 + } + +| subscripted {new_1pesp P_tok $1.any $1} + +| array arrayref {new_pesp M_list P_expr (to_Deref_with(I_array, I_array, from_array $1, List $2.any)) $1 $2} /* array slice: @array[vals] */ +| array BRACKET expr BRACKET_END {sp_0($2); sp_0($3); sp_0($4); new_pesp M_list P_expr (to_Deref_with(I_hash, I_array, from_array $1, $3.any.expr)) $1 $4} /* hash slice: @hash{@keys} */ + +/* function_calls */ +| ONE_SCALAR_PARA RAW_STRING {call_one_scalar_para P_uniop $1 [to_Raw_string $2] $1 $2} +| ONE_SCALAR_PARA STRING {call_one_scalar_para P_uniop $1 [to_String true $2] $1 $2} +| ONE_SCALAR_PARA variable {call_one_scalar_para P_uniop $1 [$2.any] $1 $2} +| ONE_SCALAR_PARA restricted_subscripted {call_one_scalar_para P_uniop $1 [$2.any] $1 $2} +| ONE_SCALAR_PARA parenthesized {call_one_scalar_para P_tok $1 $2.any.expr $1 $2} +| ONE_SCALAR_PARA BRACKET lines BRACKET_END {sp_n($2); new_pesp M_unknown P_uniop (call(Deref(I_func, Ident(None, $1.any, raw_pos2pos $1.pos)), [anonymous_sub None $3 $4])) $1 $4} /* eval { foo } */ +| ONE_SCALAR_PARA diamond {call_one_scalar_para P_uniop $1 [$2.any] $1 $2} +| ONE_SCALAR_PARA %prec PREC_LOW {call_one_scalar_para P_tok $1 [] $1 $1} +| ONE_SCALAR_PARA word argexpr {check_parenthesized_first_argexpr_with_Ident $2.any $3; call_one_scalar_para P_uniop $1 [call(Deref(I_func, $2.any), $3.any.expr)] $1 $3} /* ref foo $a, $b */ +| ONE_SCALAR_PARA hash PKG_SCOPE {sp_0($3); call_one_scalar_para P_uniop $1 [ Call(Too_complex, [$2.any]) ] $1 $3} /* keys %main:: */ +| ONE_SCALAR_PARA BAREWORD {if $2.any = "_" && $1.any.[0] = '-' then new_pesp M_bool P_uniop Too_complex $1 $2 else die_rule "syntax error"} /* -e "foo" && -f _ */ + +| ONE_SCALAR_PARA array arrayref {call_one_scalar_para P_uniop $1 [to_Deref_with(I_array, I_array, from_array $2, List $3.any)] $1 $3} /* array slice: @array[vals] */ +| ONE_SCALAR_PARA array BRACKET expr BRACKET_END {sp_0($3); sp_0($4); sp_0($5); call_one_scalar_para P_uniop $1 [to_Deref_with(I_hash, I_array, from_array $2, $4.any.expr)] $1 $5} /* hash slice: @hash{@keys} */ + +| func parenthesized {sp_0($2); call_func $1 $2} /* &foo(@args) */ +| word argexpr {check_parenthesized_first_argexpr_with_Ident $1.any $2; call_no_paren $1 $2} /* foo $a, $b */ +| word BRACKET lines BRACKET_END MULT { die_with_rawpos $5.pos "I can't handle this correctly, please add parentheses" } +| word BRACKET lines BRACKET_END COMMA argexpr %prec LSTOP {sp_n($2); new_pesp M_unknown P_call_no_paren (call(Deref(I_func, $1.any), Ref(I_hash, List (fst $3.any)) :: $6.any.expr)) $1 $6} /* bless { foo }, $bar */ +| word_paren parenthesized {sp_0($2); call_with_paren $1 $2} /* foo(@args) */ +| word BRACKET lines BRACKET_END listexpr %prec LSTOP {sp_n($2); call_and_context(Deref(I_func, $1.any), anonymous_sub None $3 $4 :: $5.any.expr) false (if $5.any.expr = [] then P_tok else P_call_no_paren) $1 $5} /* map { foo } @bar */ +| word BRACKET BRACKET expr BRACKET_END BRACKET_END listexpr %prec LSTOP {sp_n($2); sp_p($3); sp_p($4); sp_p($5); sp_p($6); new_pesp M_unknown (if $7.any.expr = [] then P_tok else P_call_no_paren) (call(Deref(I_func, $1.any), anonymous_sub None (new_esp (M_ref M_hash) ([ hash_ref $4 ], false) $3 $5) $6 :: $7.any.expr)) $1 $7} /* map { { foo } } @bar */ +| word BRACKET BRACKET expr BRACKET_END semi_colon BRACKET_END listexpr %prec LSTOP {sp_n($2); sp_p($3); sp_p($4); sp_p($5); sp_p($7); new_pesp M_unknown (if $8.any.expr = [] then P_tok else P_call_no_paren) (call(Deref(I_func, $1.any), anonymous_sub None (new_esp (M_ref M_hash) ([ hash_ref $4; Semi_colon ], true) $3 $6) $7 :: $8.any.expr)) $1 $8} /* map { { foo }; } @bar */ + +| term ARROW word_or_scalar parenthesized {sp_0($2); sp_0($3); sp_0($4); if $4.any.expr = [] then warn [Warn_suggest_simpler] $4.pos "remove these unneeded parentheses"; new_pesp M_unknown P_tok (to_Method_call($1.any.expr, $3.any, $4.any.expr)) $1 $4} /* $foo->bar(list) */ +| term ARROW word_or_scalar {sp_0($2); sp_0($3); new_pesp M_unknown P_tok (to_Method_call($1.any.expr, $3.any, [])) $1 $3} /* $foo->bar */ + +| NEW word { sp_n($2); new_pesp (M_ref M_unknown) P_expr (to_Method_call ($2.any, Ident(None, "new", get_pos $1), [])) $1 $2} /* new Class */ +| NEW word_paren parenthesized { sp_n($2); sp_0($3); new_pesp (M_ref M_unknown) P_expr (to_Method_call($2.any, Ident(None, "new", get_pos $1), $3.any.expr)) $1 $3} /* new Class(...) */ +| NEW word terminal { die_rule "you must parenthesize parameters: \"new Class(...)\" instead of \"new Class ...\"" } +| NEW word variable { die_rule "you must parenthesize parameters: \"new Class(...)\" instead of \"new Class ...\"" } + +| PRINT { to_Call_op_ (M_mixed [M_int; M_none]) P_call_no_paren $1.any (var_STDOUT :: [ var_dollar_ (get_pos $1) ]) $1 $1} +| PRINT argexpr {check_parenthesized_first_argexpr $1.any $2; to_Call_op_ (M_mixed [M_int; M_none]) P_call_no_paren $1.any (var_STDOUT :: $2.any.expr) $1 $2} +| PRINT_TO_SCALAR { to_Call_op_ (M_mixed [M_int; M_none]) P_call_no_paren (fst $1.any) (var_STDOUT :: [ Deref(I_scalar, Ident(None, snd $1.any, get_pos $1)) ]) $1 $1} +| PRINT_TO_SCALAR argexpr { to_Call_op_ (M_mixed [M_int; M_none]) P_call_no_paren (fst $1.any) (Deref(I_scalar, Ident(None, snd $1.any, get_pos $1)) :: $2.any.expr) $1 $2} +| PRINT_TO_STAR { to_Call_op_ (M_mixed [M_int; M_none]) P_call_no_paren (fst $1.any) (Deref(I_star, Ident(None, snd $1.any, get_pos $1)) :: [ var_dollar_ (get_pos $1) ]) $1 $1} +| PRINT_TO_STAR argexpr { to_Call_op_ (M_mixed [M_int; M_none]) P_call_no_paren (fst $1.any) (Deref(I_star, Ident(None, snd $1.any, get_pos $1)) :: $2.any.expr) $1 $2} + +| hash PKG_SCOPE {sp_0($2); new_pesp M_hash P_tok (Call(Too_complex, [$1.any])) $1 $2} /* %main:: */ + +| terminal {$1} + +expr_bracket_end: +| expr BRACKET_END { sp_p($2); new_esp (M_ref M_hash) (hash_ref $1) $1 $2 } +| expr BRACKET_END ARROW bracket_subscript {sp_p($2); sp_0($3); new_esp M_unknown_scalar (to_Deref_with(I_hash, I_scalar, hash_ref $1, $4.any)) $1 $4} /* { foo }->{Bar} */ + +terminal: +| word {word_alone $1} +| NUM {new_1pesp P_tok (Num($1.any, get_pos $1)) $1} +| STRING {new_1pesp P_tok (to_String true $1) $1} +| RAW_STRING {new_1pesp P_tok (to_Raw_string $1) $1} +| REVISION {new_1pesp P_tok (to_Raw_string $1) $1} +| COMMAND_STRING {to_Call_op_ (M_mixed[M_string; M_list]) P_tok "``" [to_String false $1] $1 $1} +| QUOTEWORDS {let l = List.map (fun s -> Raw_string(s, raw_pos2pos $1.pos)) (words $1.any) in new_pesp (M_tuple (repeat M_string (List.length l))) P_tok (List [ List l ]) $1 $1} +| HERE_DOC {new_1pesp P_tok (to_String false (new_1esp (fst $1.any) $1)) $1 } +| RAW_HERE_DOC {new_1pesp P_tok (Raw_string(fst $1.any, raw_pos2pos (snd $1.any))) $1} +| QR_PATTERN {to_Call_op_ M_string P_tok "qr//" (from_PATTERN $1) $1 $1} +| PATTERN {to_Call_op_ M_array P_expr "m//" (var_dollar_ (get_pos $1) :: from_PATTERN $1) $1 $1} +| PATTERN_SUBST {to_Call_op_ (M_mixed[M_none; M_int]) P_expr "s///" (var_dollar_ (get_pos $1) :: from_PATTERN_SUBST $1) $1 $1} +| diamond {new_1pesp P_expr $1.any $1} + +diamond: +| LT GT {sp_0($2); to_Call_op (M_mixed[M_string; M_list]) "<>" [] $1 $2} +| LT term GT {sp_0($2); sp_0($3); to_Call_op (M_mixed[M_string; M_list]) "<>" [$2.any.expr] $1 $3} + +subscripted: /* Some kind of subscripted expression */ +| variable PKG_SCOPE bracket_subscript {sp_0($2); sp_0($3); new_esp M_unknown (Call(Too_complex, [$3.any])) $1 $3} /* $foo::{something} */ +| scalar bracket_subscript {sp_0($2); check_scalar_subscripted $1; new_esp M_unknown_scalar (to_Deref_with(I_hash , I_scalar, from_scalar $1, $2.any )) $1 $2} /* $foo{bar} */ +| scalar arrayref {sp_0($2); check_scalar_subscripted $1; new_esp M_unknown_scalar (to_Deref_with(I_array, I_scalar, from_scalar $1, only_one_array_ref $2)) $1 $2} /* $array[$element] */ +| term ARROW simple_subscript {sp_0($2); sp_0($3); new_esp $3.mcontext (to_Deref_with_arrow $2 (fst $3.any, I_scalar, $1.any.expr, snd $3.any)) $1 $3} +| subscripted simple_subscript {sp_0($2); new_esp $2.mcontext (to_Deref_with(fst $2.any, I_scalar, $1.any, snd $2.any)) $1 $2} + +restricted_subscripted: /* Some kind of subscripted expression */ +| variable PKG_SCOPE bracket_subscript {sp_0($2); sp_0($3); new_esp M_unknown (Call(Too_complex, [$3.any])) $1 $3} /* $foo::{something} */ +| word_paren parenthesized {new_esp M_unknown (call(Deref(I_func, $1.any), $2.any.expr)) $1 $2} +| scalar bracket_subscript {sp_0($2); check_scalar_subscripted $1; new_esp M_unknown_scalar (to_Deref_with(I_hash , I_scalar, from_scalar $1, $2.any )) $1 $2} /* $foo{bar} */ +| scalar arrayref {sp_0($2); check_scalar_subscripted $1; new_esp M_unknown_scalar (to_Deref_with(I_array, I_scalar, from_scalar $1, only_one_array_ref $2)) $1 $2} /* $array[$element] */ +| scalar ARROW simple_subscript {sp_0($2); sp_0($3); new_esp $3.mcontext (to_Deref_with_arrow $2 (fst $3.any, I_scalar, $1.any, snd $3.any)) $1 $3} +| restricted_subscripted ARROW simple_subscript {sp_0($2); sp_0($3); new_esp $3.mcontext (to_Deref_with_arrow $2 (fst $3.any, I_scalar, $1.any, snd $3.any)) $1 $3} /* somehref->{bar} */ +| restricted_subscripted simple_subscript {sp_0($2); new_esp $2.mcontext (to_Deref_with(fst $2.any, I_scalar, $1.any, snd $2.any)) $1 $2} + +| restricted_subscripted ARROW word_or_scalar parenthesized {sp_0($2); sp_0($3); sp_0($4); if $4.any.expr = [] then warn [Warn_suggest_simpler] $4.pos "remove these unneeded parentheses"; new_esp M_unknown (to_Method_call($1.any, $3.any, $4.any.expr)) $1 $4} /* $foo->bar(list) */ +| restricted_subscripted ARROW word_or_scalar {sp_0($2); sp_0($3); new_esp M_unknown (to_Method_call($1.any, $3.any, [])) $1 $3} /* $foo->bar */ + +simple_subscript: +| bracket_subscript {new_esp M_unknown_scalar (I_hash, $1.any) $1 $1} +| arrayref {new_esp M_unknown_scalar (I_array, only_one_array_ref $1) $1 $1} +| parenthesized {new_esp M_unknown (I_func , List($1.any.expr)) $1 $1} + + +arrayref: +| arrayref_start ARRAYREF_END {sp_0($2); new_esp (M_ref M_array) $1.any $1 $2} +| arrayref_start expr ARRAYREF_END {sp_0($3); new_esp (M_ref M_array) ($1.any @ [$2.any.expr]) $1 $3} +| arrayref_start BRACKET expr BRACKET_END ARRAYREF_END {sp_p($2); sp_p($4); sp_0($5); new_esp (M_ref M_hash) ($1.any @ [hash_ref $3]) $1 $5} +parenthesized: +| parenthesized_start PAREN_END {sp_0_or_cr($2); new_pesp (if $1.any = [] then M_list else $1.mcontext) (if $1.any = [] then P_tok else P_paren P_comma) $1.any $1 $2} +| parenthesized_start expr PAREN_END {sp_0_or_cr($3); (if $1.any = [] then sp_0_or_cr else sp_p)($2); new_pesp (if $1.any = [] then $2.mcontext else M_list) (P_paren (if $1.any = [] then $2.any.priority else P_comma)) ($1.any @ [(if $1.any = [] then prio_lo P_loose else prio_lo_after P_comma) $2]) $1 $3} +| parenthesized_start BRACKET expr BRACKET_END PAREN_END {sp_p($4); sp_0_or_cr($5); new_pesp (if $1.any = [] then M_ref M_hash else M_list) (P_paren (if $1.any = [] then P_expr else P_comma)) ($1.any @ [hash_ref $3]) $1 $5} + +arrayref_start: +| ARRAYREF {new_1esp [] $1 } +| arrayref_start BRACKET expr BRACKET_END comma {sp_p($2); sp_p($3); sp_p($4); new_esp M_special ($1.any @ [hash_ref $3]) $1 $5} +parenthesized_start: +| PAREN {new_1esp [] $1 } +| parenthesized_start BRACKET expr BRACKET_END comma {(if $1.any = [] then sp_0_or_cr else sp_p)($2); sp_p($3); sp_p($4); new_esp (M_ref M_hash) ($1.any @ [hash_ref $3]) $1 $5} + +my_our: /* Things that can be "my"'d */ +| my_our_paren PAREN_END {sp_0($2); new_esp (M_mixed [ $1.mcontext ; M_none ]) (My_our(sndfst $1.any, snd $1.any, get_pos $1)) $1 $2} +| my_our_paren SCALAR_IDENT PAREN_END {check_my_our_paren $1 $2; new_esp (M_mixed [ mtuple_context_concat $1.mcontext M_unknown_scalar; M_none ]) (My_our(sndfst $1.any, snd $1.any @ [I_scalar, snd $2.any], pos_range $1 $3)) $1 $3} +| my_our_paren HASH_IDENT PAREN_END {check_my_our_paren $1 $2; new_esp (M_mixed [ M_list ; M_none ]) (My_our(sndfst $1.any, snd $1.any @ [I_hash, snd $2.any], pos_range $1 $3)) $1 $3} +| my_our_paren ARRAY_IDENT PAREN_END {check_my_our_paren $1 $2; new_esp (M_mixed [ M_list ; M_none ]) (My_our(sndfst $1.any, snd $1.any @ [I_array, snd $2.any], pos_range $1 $3)) $1 $3} +| MY_OUR SCALAR_IDENT {new_esp (M_mixed [M_unknown_scalar; M_none]) (My_our($1.any, [I_scalar, snd $2.any], get_pos $2)) $1 $2} +| MY_OUR HASH_IDENT {new_esp (M_mixed [M_hash ; M_none]) (My_our($1.any, [I_hash, snd $2.any], get_pos $2)) $1 $2} +| MY_OUR ARRAY_IDENT {new_esp (M_mixed [M_array ; M_none]) (My_our($1.any, [I_array, snd $2.any], get_pos $2)) $1 $2} + +my_our_paren: +| MY_OUR PAREN {sp_1($2); new_esp (M_tuple []) ((true, $1.any), []) $1 $2} +| my_our_paren comma {if fstfst $1.any then die_rule "syntax error"; new_esp $1.mcontext ((true, sndfst $1.any), snd $1.any) $1 $2} +| my_our_paren BAREWORD {check_my_our_paren $1 $2; if $2.any <> "undef" then die_rule "scalar expected"; new_esp (mtuple_context_concat $1.mcontext M_none) ((false, sndfst $1.any), snd $1.any @ [I_raw, $2.any]) $1 $2} +| my_our_paren SCALAR_IDENT {check_my_our_paren $1 $2; new_esp (mtuple_context_concat $1.mcontext M_unknown_scalar) ((false, sndfst $1.any), snd $1.any @ [I_scalar, snd $2.any]) $1 $2} +| my_our_paren HASH_IDENT {check_my_our_paren $1 $2; new_esp M_list ((false, sndfst $1.any), snd $1.any @ [I_hash, snd $2.any]) $1 $2} +| my_our_paren ARRAY_IDENT {check_my_our_paren $1 $2; new_esp M_list ((false, sndfst $1.any), snd $1.any @ [I_array, snd $2.any]) $1 $2} + +termdo: /* Things called with "do" */ +| DO term %prec UNIOP { die_rule "\"do EXPR\" not allowed" } /* do $filename */ +| DO BRACKET lines BRACKET_END %prec PREC_HIGH {sp_n($2); new_esp $3.mcontext (lines_to_Block $3 $4) $1 $4} /* do { code */ + +bracket_subscript: +| BRACKET expr BRACKET_END {sp_0($1); sp_same $2 $3; check_hash_subscript $2; new_esp M_special (only_one_in_List $2) $1 $3} +| COMPACT_HASH_SUBSCRIPT {sp_0($1); new_1esp (to_Raw_string $1) $1 } + +variable: +| scalar {$1} +| star {$1} +| hash {$1} +| array {$1} +| arraylen {$1} /* $#x, $#{ something } */ +| func {$1} /* &foo; */ + +word: +| bareword { $1 } +| RAW_IDENT { new_1esp (to_Ident $1) $1 } + +comma: COMMA {new_esp M_special true $1 $1} | RIGHT_ARROW {sp_p($1); new_1esp false $1 } + +semi_colon: SEMI_COLON {sp_0($1); $1} + +word_or_scalar: +| word {$1} +| scalar {$1} +| word_paren {$1} +| MULT_L_STR { new_1esp (Ident(None, "x", get_pos $1)) $1 } +| FOR { new_1esp (Ident(None, $1.any, get_pos $1)) $1 } +| ONE_SCALAR_PARA { new_1esp (Ident(None, $1.any, get_pos $1)) $1 } + +bareword: +| NEW { new_1esp (Ident(None, "new", get_pos $1)) $1 } +| BAREWORD { new_1esp (Ident(None, $1.any, get_pos $1)) $1 } + +word_paren: +| BAREWORD_PAREN { new_1esp (Ident(None, $1.any, get_pos $1)) $1 } +| RAW_IDENT_PAREN { new_1esp (to_Ident $1) $1 } +| PO_COMMENT word_paren { po_comment($1); new_esp M_special $2.any $1 $2 } + + +arraylen: ARRAYLEN_IDENT {new_esp M_int (deref_arraylen (to_Ident $1)) $1 $1} | ARRAYLEN scalar {sp_0($2); new_esp M_int (deref_arraylen $2.any ) $1 $1 } | ARRAYLEN bracket_subscript {new_esp M_int (deref_arraylen $2.any) $1 $2} +scalar: SCALAR_IDENT {new_esp M_unknown_scalar (Deref(I_scalar, to_Ident $1)) $1 $1} | DOLLAR scalar {sp_0($2); new_esp M_unknown_scalar (Deref(I_scalar, $2.any)) $1 $1 } | DOLLAR bracket_subscript {new_esp M_unknown_scalar (deref_raw I_scalar $2.any) $1 $2} | DOLLAR BRACKET BRACKET expr BRACKET_END BRACKET_END {sp_0($2); sp_0($3); sp_p($5); sp_0($6); new_esp M_unknown_scalar (Deref(I_scalar, hash_ref $4)) $1 $6} +func: FUNC_IDENT {new_esp M_unknown (Deref(I_func , to_Ident $1)) $1 $1} | AMPERSAND scalar {sp_0($2); new_esp M_unknown (Deref(I_func , $2.any)) $1 $1 } | AMPERSAND bracket_subscript {new_esp M_unknown (deref_raw I_func $2.any) $1 $2} +array: ARRAY_IDENT {new_esp M_array (Deref(I_array , to_Ident $1)) $1 $1} | AT scalar {sp_0($2); new_esp M_array (Deref(I_array , $2.any)) $1 $1 } | AT bracket_subscript {new_esp M_array (deref_raw I_array $2.any) $1 $2} +hash: HASH_IDENT {new_esp M_hash (Deref(I_hash , to_Ident $1)) $1 $1} | PERCENT scalar {sp_0($2); new_esp M_hash (Deref(I_hash , $2.any)) $1 $1 } | PERCENT bracket_subscript {new_esp M_hash (deref_raw I_hash $2.any) $1 $2} +star: STAR_IDENT {new_esp M_unknown (Deref(I_star , to_Ident $1)) $1 $1} | STAR scalar {sp_0($2); new_esp M_unknown (Deref(I_star , $2.any)) $1 $1 } | STAR bracket_subscript {new_esp M_unknown (deref_raw I_star $2.any) $1 $2} + +expr_or_empty: {default_esp (Block [])} | expr {new_1esp $1.any.expr $1 } + +%% + +prog_ref := Some prog +;; diff --git a/src/parser_helper.ml b/src/parser_helper.ml new file mode 100644 index 0000000..43d60a4 --- /dev/null +++ b/src/parser_helper.ml @@ -0,0 +1,1409 @@ +open Types +open Common +open Printf + +let bpos = -1, -1 + +let raw_pos2pos(a, b) = !Info.current_file, a, b +let raw_pos_range { pos = (a1, b1) } { pos = (a2, b2) } = (if a1 = -1 then a2 else a1), (if b2 = -1 then b1 else b2) +let pos_range esp1 esp2 = raw_pos2pos (raw_pos_range esp1 esp2) +let get_pos pesp = raw_pos2pos pesp.pos +let get_pos_start { pos = (start, _) } = start +let get_pos_end { pos = (_, end_) } = end_ +let var_dollar_ pos = Deref(I_scalar, Ident(None, "_", pos)) +let var_STDOUT = Deref(I_star, Ident(None, "STDOUT", raw_pos2pos bpos)) + +let new_any mcontext any spaces pos = { mcontext = mcontext ; any = any ; spaces = spaces ; pos = pos } +let new_any_ any spaces pos = new_any M_unknown any spaces pos +let new_esp mcontext e esp_start esp_end = new_any mcontext e esp_start.spaces (raw_pos_range esp_start esp_end) +let new_1esp e esp = new_any esp.mcontext e esp.spaces esp.pos +let new_pesp mcontext prio e esp_start esp_end = new_any mcontext { priority = prio ; expr = e } esp_start.spaces (raw_pos_range esp_start esp_end) +let new_1pesp prio e esp = new_any esp.mcontext { priority = prio ; expr = e } esp.spaces esp.pos +let default_esp e = new_any M_unknown e Space_none bpos +let default_pesp prio e = new_any M_unknown { priority = prio ; expr = e } Space_none bpos + +let split_name_or_fq_name full_ident = + match split_at2 ':'':' full_ident with + | [] -> internal_error "split_ident" + | [ident] -> None, ident + | l -> + let fql, name = split_last l in + let fq = String.concat "::" fql in + Some fq, name + +let is_var_dollar_ = function + | Deref(I_scalar, Ident(None, "_", _)) -> true + | _ -> false +let is_var_number_match = function + | Deref(I_scalar, Ident(None, s, _)) -> String.length s = 1 && s.[0] <> '0' && char_is_number s.[0] + | _ -> false + +let non_scalar_context context = context = I_hash || context = I_array +let is_scalar_context context = context = I_scalar + +let rec is_not_a_scalar = function + | Deref_with(_, context, _, _) + | Deref(context, _) -> non_scalar_context context + | List [] + | List(_ :: _ :: _) -> true + | Call(Deref(I_func, Ident(None, "map", _)), _) + | Call(Deref(I_func, Ident(None, "grep", _)), _) -> true + | Call_op("?:", [ _cond ; a; b ], _) -> is_not_a_scalar a || is_not_a_scalar b + | _ -> false + +let is_a_scalar = function + | Ref _ + | Num _ + | Raw_string _ + | String _ + | Call(Deref(I_func, Ident(None, "N", _)), _) -> true + | My_our(_, [ context, _ ], _) + | Deref_with(_, context, _, _) + | Deref(context, _) -> is_scalar_context context + | _ -> false + +let is_a_string = function + | String _ | Raw_string _ -> true + | _ -> false + +let is_parenthesized = function + | List[] + | List[List _] -> true + | _ -> false + +let un_parenthesize = function + | List[List[e]] -> e + | List[e] -> e + | _ -> internal_error "un_parenthesize" + +let rec un_parenthesize_full = function + | List[e] -> un_parenthesize_full e + | e -> e + +let rec un_parenthesize_full_l = function + | [ List l ] -> un_parenthesize_full_l l + | l -> l + +let is_always_true = function + | Num(n, _) -> float_of_string n <> 0. + | Raw_string(s, _) -> s <> "" + | String(l, _) -> l <> [] + | Ref _ -> true + | _ -> false + +let is_always_false = function + | Num(n, _) -> float_of_string n = 0. + | Raw_string(s, _) -> s = "" + | String(l, _) -> l = [] + | List [] -> true + | Ident(None, "undef", _) -> true + | _ -> false + +let rec is_lvalue = function + | Call(Deref(I_func, Ident(None, f, _)), _) -> List.mem f [ "substr" ] + + | Call_op("?:", [ _ ; a ; b ], _) -> is_lvalue a && is_lvalue b + + | Call_op("local", l, _) + | List [ List l ] + -> List.for_all is_lvalue l + + | My_our _ + | Deref(_, _) + | Deref_with(_, _, _, _) + | Ident(None, "undef", _) + -> true + + | _ -> false + +let not_complex e = + if is_parenthesized e then true else + let rec not_complex_ op = function + | Call_op("?:", _, _) -> false + | Call_op(op', l, _) -> op <> op' && List.for_all (not_complex_ op') l + | e -> not (is_parenthesized e) + in not_complex_ "" (un_parenthesize_full e) + +let not_simple = function + | Num _ | Ident _ | Deref(_, Ident _) -> false + | _ -> true + +let context2s = function + | I_scalar -> "$" + | I_hash -> "%" + | I_array -> "@" + | I_func -> "&" + | I_raw -> "" + | I_star -> "*" +let variable2s(context, ident) = context2s context ^ ident + +let rec string_of_fromparser = function + | Semi_colon -> ";" + | Undef -> "undef" + | Num(num, _) -> num + + | Raw_string(s, _) -> "\"" ^ s ^ "\"" + | String(l, _) -> + let l' = List.map (fun (s, e) -> + s ^ if e = List[] then "" else string_of_fromparser e + ) l in + "\"" ^ String.concat "" l' ^ "\"" + + | Ident(None, s, _) -> s + | Ident(Some fq, s, _) -> fq ^ "::" ^ s + | My_our(myour, l, _) -> myour ^ "(" ^ String.concat "," (List.map (fun (context, s) -> context2s context ^ s) l) ^ ")" + + | Anonymous_sub(_, e, _) -> "sub { " ^ string_of_fromparser e ^ " }" + | Ref(_, e) -> "\\" ^ string_of_fromparser e + | Deref(context, e) -> context2s context ^ string_of_fromparser e + + | Diamond(None) -> "<>" + | Diamond(Some e) -> "<" ^ string_of_fromparser e ^ ">" + + | Sub_declaration(name, _prototype, body, Real_sub_declaration) -> + "sub " ^ string_of_fromparser name ^ " { " ^ string_of_fromparser body ^ " }" + + | Sub_declaration(name, _prototype, body, Glob_assign) -> + "*" ^ string_of_fromparser name ^ " = sub { " ^ string_of_fromparser body ^ " };" + + | Deref_with(_, _, _e1, _e2) -> + internal_error "todo" + + | Package(p) -> "package " ^ string_of_fromparser p + + | Use(e, []) -> "use " ^ string_of_fromparser e + | Use(e, l) -> "use " ^ string_of_fromparser e ^ "(" ^ lstring_of_fromparser l + + | List l -> lstring_of_fromparser_parentheses l + | Block l -> "{ " ^ lstring_of_fromparser l ^ " }" + | Call_op(op, l, _) -> op ^ lstring_of_fromparser_parentheses l + + | Call(e, l) -> string_of_fromparser e ^ lstring_of_fromparser l + + | Method_call(obj, meth, l) -> + let para = if l = [] then "" else lstring_of_fromparser_parentheses l in + string_of_fromparser obj ^ "->" ^ string_of_fromparser meth ^ para + + | Label(e) -> e ^ ": " + + | Perl_checker_comment _ -> "" + | Too_complex -> "XXX" + +and lstring_of_fromparser l = String.concat ", " (List.map string_of_fromparser l) +and lstring_of_fromparser_parentheses l = "(" ^ lstring_of_fromparser l ^ ")" + +let rec is_same_fromparser a b = + match a, b with + | Undef, Undef -> true + | Ident(fq1, s1, _), Ident(fq2, s2, _) -> fq1 = fq2 && s1 = s2 + | Num(s1, _), Num(s2, _) + | Raw_string(s1, _), Raw_string(s2, _) -> s1 = s2 + + | String(l1, _), String(l2, _) -> + for_all2_ (fun (s1, e1) (s2, e2) -> s1 = s2 && is_same_fromparser e1 e2) l1 l2 + + | Ref(c1, e1), Ref(c2, e2) + | Deref(c1, e1), Deref(c2, e2) -> c1 = c2 && is_same_fromparser e1 e2 + + | Deref_with(c1, c_1, e1, e_1), Deref_with(c2, c_2, e2, e_2) -> c1 = c2 && c_1 = c_2 && is_same_fromparser e1 e2 && is_same_fromparser e_1 e_2 + + | Diamond(None), Diamond(None) -> true + | Diamond(Some e1), Diamond(Some e2) -> is_same_fromparser e1 e2 + + | List(l1), List(l2) -> for_all2_ is_same_fromparser l1 l2 + + | Call_op(op1, l1, _), Call_op(op2, l2, _) -> op1 = op2 && for_all2_ is_same_fromparser l1 l2 + | Call(e1, l1), Call(e2, l2) -> is_same_fromparser e1 e2 && for_all2_ is_same_fromparser l1 l2 + + | Method_call(e1, m1, l1), Method_call(e2, m2, l2) -> + is_same_fromparser e1 e2 && is_same_fromparser m1 m2 && for_all2_ is_same_fromparser l1 l2 + + | _ -> false + +let from_scalar esp = + match esp.any with + | Deref(I_scalar, ident) -> ident + | _ -> internal_error "from_scalar" + +let from_array esp = + match esp.any with + | Deref(I_array, ident) -> ident + | _ -> internal_error "from_array" + +let rec get_pos_from_expr = function + | Anonymous_sub(_, _, pos) + | String(_, pos) + | Call_op(_, _, pos) + | Perl_checker_comment(_, pos) + | My_our(_, _, pos) + | Raw_string(_, pos) + | Num(_, pos) + | Ident(_, _, pos) + -> pos + + | Package e + | Ref(_, e) + | Deref(_, e) + | Sub_declaration(e, _, _, _) + | Deref_with(_, _, e, _) + | Use(e, _) + | Call(e, _) + | Method_call(_, e, _) + -> get_pos_from_expr e + + | Diamond(option_e) + -> if option_e = None then raw_pos2pos bpos else get_pos_from_expr (some option_e) + + | List l + | Block l + -> if l = [] then raw_pos2pos bpos else get_pos_from_expr (List.hd l) + + | Semi_colon + | Too_complex + | Undef + | Label _ + -> raw_pos2pos bpos + +let msg_with_rawpos (start, end_) msg = Info.pos2sfull_current start end_ ^ msg +let die_with_rawpos raw_pos msg = failwith (msg_with_rawpos raw_pos msg) +let warn warn_types raw_pos msg = if Flags.are_warning_types_set warn_types then print_endline_flush (msg_with_rawpos raw_pos msg) + +let die_rule msg = die_with_rawpos (Parsing.symbol_start(), Parsing.symbol_end()) msg +let warn_rule warn_types msg = warn warn_types (Parsing.symbol_start(), Parsing.symbol_end()) msg + +let warn_verb warn_types pos msg = if not !Flags.quiet then warn warn_types (pos, pos) msg +let warn_too_many_space start = warn_verb [Warn_white_space] start "you should have only one space here" +let warn_no_space start = warn_verb [Warn_white_space] start "you should have a space here" +let warn_cr start = warn_verb [Warn_white_space] start "you should not have a carriage-return (\\n) here" +let warn_space start = warn_verb [Warn_white_space] start "you should not have a space here" + +let rec prio_less = function + | P_none, _ | _, P_none -> internal_error "prio_less" + + | P_paren_wanted prio1, prio2 + | prio1, P_paren_wanted prio2 -> prio_less(prio1, prio2) + + | P_ternary, P_or -> false + | P_ternary, P_and -> false + + | _, P_loose -> true + | P_loose, _ -> false + | _, P_or -> true + | P_or, _ -> false + + | _, P_and -> true + | P_and, _ -> false + | _, P_call_no_paren -> true + | P_call_no_paren, _ -> false + | _, P_comma -> true + | P_comma, _ -> false + | _, P_assign -> true + | P_assign, _ -> false + | _, P_ternary -> true + | P_ternary, _ -> false + + | _, P_tight_or -> true + | P_tight_or, _ -> false + | _, P_tight_and -> true + | P_tight_and, _ -> false + + | P_bit, P_bit -> true + | P_bit, _ -> false + + | _, P_expr -> true + | P_expr, _ -> false + + | _, P_eq -> true + | P_eq, _ -> false + | _, P_cmp -> true + | P_cmp, _ -> false + | _, P_uniop -> true + | P_uniop, _ -> false + | _, P_add -> true + | P_add, _ -> false + | _, P_mul -> true + | P_mul, _ -> false + | _, P_tight -> true + | P_tight, _ -> false + + | _, P_paren _ -> true + | P_paren _, _ -> true + | P_tok, _ -> true + +let prio_lo_check pri_out pri_in pos expr = + if prio_less(pri_in, pri_out) then + (match pri_in with + | P_paren (P_paren_wanted _) -> () + | P_paren pri_in' -> + if pri_in' <> pri_out && + prio_less(pri_in', pri_out) && not_complex (un_parenthesize expr) then + warn [Warn_suggest_simpler] pos "unneeded parentheses" + | _ -> ()) + else + (match expr with + | Call(Deref(I_func, Ident(None, f, _)), _) when f <> "delete" && pri_in = P_uniop && pri_out = P_add + -> () (* ugly special case since we don't parse uniop correctly (eg: -d $_ . "foo" *) + | Call_op ("print", [Deref (I_star, Ident (None, "STDOUT", _)); (Deref(I_scalar, _) as ident)], _) -> + warn [Warn_traps] pos (sprintf "use parentheses: replace \"print %s ...\" with \"print(%s ...)\"" (string_of_fromparser ident) (string_of_fromparser ident)) + | _ -> warn [Warn_traps] pos "missing parentheses (needed for clarity)") + +let prio_lo pri_out in_ = prio_lo_check pri_out in_.any.priority in_.pos in_.any.expr ; in_.any.expr + +let prio_lo_after pri_out in_ = + if in_.any.priority = P_call_no_paren then in_.any.expr else prio_lo pri_out in_ + +let prio_lo_concat esp = prio_lo P_mul { esp with any = { esp.any with priority = P_paren_wanted esp.any.priority } } + +let hash_ref esp = Ref(I_hash, prio_lo P_loose esp) + +let sp_0 esp = + match esp.spaces with + | Space_none -> () + | Space_0 -> () + | Space_1 + | Space_n -> warn_space (get_pos_start esp) + | Space_cr -> warn_cr (get_pos_start esp) + +let sp_0_or_cr esp = + match esp.spaces with + | Space_none -> () + | Space_0 -> () + | Space_1 + | Space_n -> warn_space (get_pos_start esp) + | Space_cr -> () + +let sp_1 esp = + match esp.spaces with + | Space_none -> () + | Space_0 -> warn_no_space (get_pos_start esp) + | Space_1 -> () + | Space_n -> warn_too_many_space (get_pos_start esp) + | Space_cr -> warn_cr (get_pos_start esp) + +let sp_n esp = + match esp.spaces with + | Space_none -> () + | Space_0 -> warn_no_space (get_pos_start esp) + | Space_1 -> () + | Space_n -> () + | Space_cr -> warn_cr (get_pos_start esp) + +let sp_p esp = + match esp.spaces with + | Space_none -> () + | Space_0 -> warn_no_space (get_pos_start esp) + | Space_1 -> () + | Space_n -> () + | Space_cr -> () + +let sp_cr esp = + match esp.spaces with + | Space_none -> () + | Space_0 + | Space_1 + | Space_n -> warn_verb [Warn_white_space] (get_pos_start esp) "you should have a carriage-return (\\n) here" + | Space_cr -> () + +let sp_same esp1 esp2 = + if esp1.spaces <> Space_0 then sp_p esp2 + else if esp2.spaces <> Space_0 then sp_p esp1 + +let function_to_context word_alone = function + | "map" | "grep" | "grep_index" | "map_index" | "uniq" | "uniq_" -> M_array + | "partition" -> M_tuple [ M_ref M_array ; M_ref M_array ] + | "find" -> M_unknown_scalar + | "any" | "every" -> M_bool + | "find_index" -> M_int + | "each_index" -> M_none + | "N" | "N_" -> M_string + + | "chop" | "chomp" | "push" | "unshift" -> M_none + | "hex" | "length" | "time" | "fork" | "getppid" -> M_int + | "eof" | "wantarray" -> M_int + | "stat" | "lstat" -> M_list + | "arch" | "quotemeta" | "join" | "lc" | "lcfirst" | "uc" | "ucfirst" -> M_string + + | "split" -> M_array + | "shift" | "pop" -> M_unknown_scalar + | "die" | "return" | "redo" | "next" | "last" -> M_unknown + | "caller" -> M_mixed [M_string ; M_list] + + | "ref" -> M_ref M_unknown_scalar + | "undef" -> if word_alone then M_undef else M_none + | _ -> M_unknown + +let word_alone esp = + let word = esp.any in + let mcontext, e = match word with + | Ident(None, f, pos) -> + let e = match f with + | "length" | "stat" | "lstat" | "chop" | "chomp" | "quotemeta" | "lc" | "lcfirst" | "uc" | "ucfirst" -> + Call(Deref(I_func, word), [var_dollar_ pos]) + + | "split" -> Call(Deref(I_func, word), [ Raw_string(" ", pos) ; var_dollar_ pos ]) + | "die" -> Call(Deref(I_func, word), [ Deref(I_scalar, Ident(None, "@", raw_pos2pos bpos)) ]) + | "return" | "eof" | "caller" + | "redo" | "next" | "last" -> + Deref(I_func, word) + + | "hex" | "ref" -> + warn_rule [Warn_complex_expressions] (sprintf "please use \"%s $_\" instead of \"%s\"" f f) ; + Call(Deref(I_func, word), [ Raw_string(" ", pos) ; var_dollar_ pos ]) + | "time" | "wantarray" | "fork" | "getppid" | "arch" -> + warn_rule [Warn_complex_expressions] (sprintf "please use %s() instead of %s" f f) ; + Deref(I_func, word) + | _ -> word + in + function_to_context true f, e + | _ -> M_unknown, word + in + new_pesp mcontext P_tok e esp esp + +let check_parenthesized_first_argexpr word esp = + let want_space = word.[0] = '-' in + if word = "return" then () else + match esp.any.expr with + | [ Call_op(_, (e' :: l), _) ] + | e' :: l -> + if is_parenthesized e' then + if l = [] then + (if want_space then sp_n else sp_0) esp + else + (* eg: join (" ", @l) . "\n" *) + die_with_rawpos (get_pos_start esp, get_pos_start esp) "please remove the space before the function call" + else + sp_p esp + | _ -> + if word = "time" then die_rule "please use time() instead of time"; + sp_p esp + +let check_parenthesized_first_argexpr_with_Ident ident esp = + if esp.any.priority = P_tok then (); + (match ident with + | Ident(Some _, _, _) -> + (match esp.any.expr with + | [e] when is_parenthesized e -> () + | _ -> warn_rule [Warn_suggest_simpler] "use parentheses around argument (otherwise it might cause syntax errors if the package is \"require\"d and not \"use\"d") + | Ident(None, word, _) when List.mem word ["ref" ; "readlink"] -> + if esp.any.priority <> P_tok then warn_rule [Warn_complex_expressions] "use parentheses around argument" + | _ -> ()); + check_parenthesized_first_argexpr (string_of_fromparser ident) esp + +let check_hash_subscript esp = + let can_be_raw_string = function + | "" | "x" | "y" -> false (* special case for {'y'} otherwise the emacs mode goes wild, special case for {'x'} to have the same as {'y'} (since they usually go together) *) + | s -> + char_is_alpha s.[0] && (String.length s = 1 || string_forall_with char_is_alphanumerical_ 1 s) + in + match esp.any.expr with + | List [String ([(s, List [])], _)] when can_be_raw_string s -> warn [Warn_suggest_simpler] esp.pos (sprintf "{\"%s\"} can be written {%s}" s s) + | List [Raw_string(s, _)] when can_be_raw_string s -> warn [Warn_suggest_simpler] esp.pos (sprintf "{'%s'} can be written {%s}" s s) + | _ -> () + +let check_arrow_needed arrow = function + | Deref_with(I_array, I_scalar, List [List [Call _]], _) -> () (* "->" needed for (f())[0]->{XX} *) + | Deref_with _ -> warn [Warn_suggest_simpler] arrow.pos "the arrow \"->\" is unneeded" + | _ -> () + +let check_scalar_subscripted esp = + match esp.any with + | Deref(I_scalar, Deref _) -> warn_rule [Warn_complex_expressions] "for complex dereferencing, use \"->\"" + | _ -> () + +let negatable_ops = collect (fun (a, b) -> [ a, b ; b, a ]) [ + "==", "!=" ; + "eq", "ne" ; +] + +let check_negatable_expr esp = + match un_parenthesize_full esp.any.expr with + | Call_op("m//", var :: _, _) when not (is_var_dollar_ var) -> + warn_rule [Warn_suggest_simpler] "!($var =~ /.../) is better written $var !~ /.../" + | Call_op("!m//", var :: _, _) when not (is_var_dollar_ var) -> + warn_rule [Warn_suggest_simpler] "!($var !~ /.../) is better written $var =~ /.../" + | Call_op(op, _, _) -> + (try + let neg_op = List.assoc op negatable_ops in + warn_rule [Warn_suggest_simpler] (Printf.sprintf "!($foo %s $bar) is better written $foo %s $bar" op neg_op) + with Not_found -> ()) + | _ -> () + +let check_ternary_paras(cond, a, b) = + let rec dont_need_short_circuit_rec = function + | Num _ + | Raw_string _ + | String ([(_, List [])], _) + -> true + | Call(Deref(I_func, Ident(None, "N", _)), [ List(String _ :: l) ]) + | Call_op(".", l, _) + | Ref(I_hash, List l) + | List l -> List.for_all dont_need_short_circuit_rec l + | _ -> false + in + let rec dont_need_short_circuit = function + | Ref(_, Deref(_, Ident _)) + | Deref(_, Ident _) -> true + | Ref(I_hash, List l) + | List l -> List.for_all dont_need_short_circuit l + | e -> dont_need_short_circuit_rec e + in + let check_ternary_para = function + | List [] -> warn_rule [Warn_suggest_simpler; Warn_MDK_Common] "you may use if_() here\n beware that the short-circuit semantic of ?: is not kept\n if you want to keep the short-circuit behaviour, replace () with @{[]} and there will be no warning anymore" + | _ -> () + in + if dont_need_short_circuit a || is_same_fromparser cond a then check_ternary_para b; + if dont_need_short_circuit b || is_same_fromparser cond b then check_ternary_para a; + if is_same_fromparser cond a && is_a_scalar a && is_a_scalar b then warn_rule [Warn_suggest_simpler] "you can replace \"$foo ? $foo : $bar\" with \"$foo || $bar\""; + [ cond; a; b ] + +let check_unneeded_var_dollar_ esp = + if is_var_dollar_ esp.any.expr then warn [Warn_suggest_simpler] esp.pos "\"$_ =~ /regexp/\" can be written \"/regexp/\"" else + if is_var_number_match esp.any.expr then warn [Warn_complex_expressions] esp.pos "do not use the result of a match (eg: $1) to match another pattern" +let check_unneeded_var_dollar_not esp = + if is_var_dollar_ esp.any.expr then warn [Warn_suggest_simpler] esp.pos "\"$_ !~ /regexp/\" can be written \"!/regexp/\"" else + if is_var_number_match esp.any.expr then warn [Warn_complex_expressions] esp.pos "do not use the result of a match (eg: $1) to match another pattern" +let check_unneeded_var_dollar_s esp = + let expr = esp.any.expr in + if is_var_dollar_ expr then warn [Warn_suggest_simpler] esp.pos "\"$_ =~ s/regexp/.../\" can be written \"s/regexp/.../\"" else + if is_var_number_match expr then warn [Warn_traps] esp.pos "do not modify the result of a match (eg: $1)" else + let expr = match expr with + | List [List [Call_op("=", [ expr; _], _)]] -> expr (* check $xx in ($xx = ...) =~ ... *) + | _ -> expr in + if is_a_string expr || not (is_a_scalar expr) then warn [Warn_complex_expressions] esp.pos "you can only use s/// on a variable" + +let check_my esp = if esp.any <> "my" then die_rule "syntax error" +let check_foreach esp = if esp.any = "for" then warn [Warn_normalized_expressions] esp.pos "write \"foreach\" instead of \"for\"" +let check_for esp = if esp.any = "foreach" then warn [Warn_normalized_expressions] esp.pos "write \"for\" instead of \"foreach\"" +let check_for_foreach esp arg = + match arg.any.expr with + | List [ Deref(I_scalar, _) ] -> + if esp.any = "foreach" then warn [Warn_normalized_expressions] esp.pos "you are using the special trick to locally set $_ with a value, for this please use \"for\" instead of \"foreach\"" + | List [ Deref_with(context, I_scalar, _, _) ] when context <> I_func -> + if esp.any = "foreach" then warn [Warn_normalized_expressions] esp.pos "you are using the special trick to locally set $_ with a value, for this please use \"for\" instead of \"foreach\"" + | List [ Deref(I_hash, _) ] -> + warn [Warn_traps] esp.pos "foreach with a hash is usually an error" + | _ -> + if esp.any = "for" then warn [Warn_normalized_expressions] esp.pos "write \"foreach\" instead of \"for\"" + +let check_block_expr has_semi_colon last_expr esp_last esp_BRACKET_END = + sp_p esp_BRACKET_END ; + + if esp_BRACKET_END.spaces = Space_cr then + (if not has_semi_colon then warn_verb [Warn_white_space] (get_pos_end esp_last) "missing \";\"") + else + (if last_expr = Semi_colon then warn_verb [Warn_white_space] (get_pos_end esp_last) "spurious \";\" before closing block") + +let check_block_lines esp_lines esp_BRACKET_END = + match fst esp_lines.any with + | [] -> + sp_0_or_cr esp_BRACKET_END + | l -> + (if List.hd l = Semi_colon then sp_0 else sp_p) esp_lines ; + check_block_expr (snd esp_lines.any) (last l) esp_lines esp_BRACKET_END + +let check_unless_else elsif else_ = + if elsif.any <> [] then warn [Warn_complex_expressions] elsif.pos "don't use \"elsif\" with \"unless\" (replace \"unless\" with \"if\")"; + if else_.any <> [] then warn [Warn_complex_expressions] else_.pos "don't use \"else\" with \"unless\" (replace \"unless\" with \"if\")" + +let check_my_our_paren { any = ((comma_closed, _), l) } after_esp = + (if l = [] then sp_0 else sp_1) after_esp ; + if not comma_closed then die_rule "syntax error" + +let check_simple_pattern = function + | [ String([ st, List [] ], _); Raw_string("", _) ] -> + if String.length st > 2 && + st.[0] = '^' && st.[String.length st - 1] = '$' then + let st = skip_n_char_ 1 1 st in + if string_forall_with char_is_alphanumerical_ 0 st then + warn_rule [Warn_suggest_simpler] (sprintf "\"... =~ /^%s$/\" is better written \"... eq '%s'\"" st st) + | _ -> () + +let rec only_one esp = + match esp.any with + | [List l'] -> only_one { esp with any = l' } + | [e] -> e + | [] -> die_with_rawpos esp.pos "you must give one argument" + | _ -> die_with_rawpos esp.pos "you must give only one argument" + +let only_one_array_ref esp = + let e = only_one esp in + (match e with + | Call_op("last_array_index", [Deref(I_array, e)], _) -> + warn [Warn_suggest_simpler] esp.pos (sprintf "you can replace $#%s with -1" (string_of_fromparser e)) + | _ -> ()); + e + +let only_one_in_List esp = + match esp.any.expr with + | List l -> only_one { esp with any = l } + | e -> e + +let rec is_only_one_in_List = function + | [List l] -> is_only_one_in_List l + | [_] -> true + | _ -> false + +let maybe_to_Raw_string = function + | Ident(None, s, pos) -> Raw_string(s, pos) + | Ident(Some fq, s, pos) -> Raw_string(fq ^ "::" ^ s, pos) + | e -> e + +let to_List = function + | [e] -> e + | l -> List l + +let deref_arraylen e = Call_op("last_array_index", [Deref(I_array, e)], raw_pos2pos bpos) +let deref_raw context e = + let e = match e with + | Raw_string(s, pos) -> + let fq, ident = split_name_or_fq_name s in + Ident(fq, ident, pos) + | Deref(I_scalar, (Ident _ as ident)) -> + warn_rule [Warn_suggest_simpler] (sprintf "%s{$%s} can be written %s$%s" (context2s context) (string_of_fromparser ident) (context2s context) (string_of_fromparser ident)); + e + | _ -> e + in Deref(context, e) + +let to_Ident { any = (fq, name); pos = pos } = Ident(fq, name, raw_pos2pos pos) +let to_Raw_string { any = s; pos = pos } = Raw_string(s, raw_pos2pos pos) +let to_Method_call (object_, method_, para) = + match method_ with + | Ident(Some "SUPER", name, pos) -> Method_call(maybe_to_Raw_string object_, Raw_string(name, pos), para) + | Ident(Some _, _, _) -> Call(Deref(I_func, method_), maybe_to_Raw_string object_ :: para) + | _ -> Method_call(maybe_to_Raw_string object_, maybe_to_Raw_string method_, para) +let to_Deref_with(from_context, to_context, ref_, para) = + if is_not_a_scalar ref_ then warn_rule [] "bad deref"; + Deref_with(from_context, to_context, ref_, para) + +let to_Deref_with_arrow arrow (from_context, to_context, ref_, para) = + if from_context != I_func then check_arrow_needed arrow ref_ ; + to_Deref_with(from_context, to_context, ref_, para) + +let lines_to_Block esp_lines esp_BRACKET_END = + check_block_lines esp_lines esp_BRACKET_END; + Block (fst esp_lines.any) + +let to_Local esp = + let l = + match esp.any.expr with + | List[List l] -> l + | e -> [e] + in + let local_vars, local_exprs = fpartition (function + | Deref(I_star as context, Ident(None, ident, _)) + | Deref(I_scalar as context, Ident(None, ("_" as ident), _)) -> + Some(context, ident) + | Deref(I_scalar, Ident _) + | Deref(I_array, Ident _) + | Deref(I_star, Ident _) + | Deref_with(I_hash, I_scalar, Ident _, _) + | Deref_with(I_hash, I_scalar, Deref(I_scalar, _), _) + | Deref_with(I_hash, I_scalar, Deref_with(I_hash, I_scalar, Ident _, _), _) + | Deref_with(I_hash, I_scalar, Deref_with(I_hash, I_scalar, Deref(I_scalar, Ident _), _), _) -> + None + | _ -> die_with_rawpos esp.pos "bad argument to \"local\"" + ) l in + if local_vars = [] then Call_op("local", local_exprs, raw_pos2pos esp.pos) + else if local_exprs = [] then My_our("local", local_vars, raw_pos2pos esp.pos) + else die_with_rawpos esp.pos "bad argument to \"local\"" + +let sub_declaration (name, proto) body sub_kind = Sub_declaration(name, proto, Block body, sub_kind) +let anonymous_sub proto lines bracket_end = Anonymous_sub (proto, lines_to_Block lines bracket_end, raw_pos2pos lines.pos) +let call_with_same_para_special f = Call(f, [Deref(I_star, (Ident(None, "_", raw_pos2pos bpos)))]) +let remove_call_with_same_para_special = function + | Call(f, [Deref(I_star, (Ident(None, "_", _)))]) -> f + | e -> e + +let check_My_under_condition msg = function + | List [ My_our("my", _, _) ] -> + warn_rule [Warn_traps] "this is stupid" + | List [ Call_op("=", [ My_our("my", _, _); _ ], _) ] -> + warn_rule [Warn_traps] msg + | _ -> () + +let cook_call_op op para pos = + (match op with + | "le" | "ge" | "eq" | "ne" | "gt" | "lt" | "cmp" -> + if List.exists (function Num _ -> true | _ -> false) para then + warn_rule [Warn_traps] (sprintf "you should use a number operator, not the string operator \"%s\" (or replace the number with a string)" op) + | "." -> + if List.exists (function Call(Deref(I_func, Ident(None, "N_", _)), _) -> true | _ -> false) para then + warn_rule [Warn_MDK_Common; Warn_traps] "N_(\"xxx\") . \"yyy\" is dumb since the string \"xxx\" will never get translated" + | _ -> ()); + + (match op, para with + | "if", List [Call_op ("=", [ _; e ], _)] :: _ when is_always_true e || is_always_false e -> + warn_rule [Warn_traps] "are you sure you did not mean \"==\" instead of \"=\"?" + + | "foreach", [ _; Block [ expr ; Semi_colon ] ] + | "foreach", [ _; Block [ expr ] ] -> + (match expr with + | Call_op("if infix", [ List [ Call(Deref(I_func, Ident(None, "push", _)), [ Deref(I_array, Ident _) as l ; Deref(I_scalar, Ident(None, "_", _)) ]) ] ; _ ], _) -> + let l = string_of_fromparser l in + warn_rule [Warn_suggest_functional] (sprintf "use \"push %s, grep { ... } ...\" instead of \"foreach (...) { push %s, $_ if ... }\"\n or sometimes \"%s = grep { ... } ...\"" l l l) + | Call_op("if infix", [ List [ Call(Deref(I_func, Ident(None, "push", _)), [ Deref(I_array, Ident _) as l; _ ]) ] ; _ ], _) -> + let l = string_of_fromparser l in + warn_rule [Warn_suggest_functional] (sprintf "use \"push %s, map { ... ? ... : () } ...\" instead of \"foreach (...) { push %s, ... if ... }\"\n or sometimes \"%s = map { ... ? ... : () } ...\"\n or sometimes \"%s = map { if_(..., ...) } ...\"" l l l l) + + | Call_op ("if", [ _; Block [ List [ Call_op("=", [Deref(I_scalar, _) as ret; Deref(I_scalar, Ident(None, "_", _)) ], _) ]; + Semi_colon; + List [ Deref(I_func, Ident(None, "last", _)) ]; + Semi_colon ] ], _) -> + warn_rule [Warn_suggest_functional; Warn_MDK_Common] (sprintf "use \"%s = find { ... } ...\"" (string_of_fromparser ret)) + + | List [ Call(Deref(I_func, Ident(None, "push", _)), [ Deref(I_array, Ident _) as l; _ ]) ] -> + let l = string_of_fromparser l in + warn_rule [Warn_suggest_functional] (sprintf "use \"push %s, map { ... } ...\" instead of \"foreach (...) { push %s, ... }\"\n or sometimes \"%s = map { ... } ...\"" l l l) + | _ -> ()) + + | "=", [My_our _; Ident(None, "undef", _)] -> + warn [Warn_suggest_simpler] pos "no need to initialize variable, it's done by default" + | "=", [My_our _; List[]] -> + if Info.is_on_same_line_current pos then warn [Warn_suggest_simpler] pos "no need to initialize variables, it's done by default" + + | "=", [ Deref_with(I_array, I_scalar, id, Deref(I_array, id_)); _ ] when is_same_fromparser id id_ -> + warn_rule [Warn_suggest_simpler] "\"$a[@a] = ...\" is better written \"push @a, ...\"" + + | "=", [ Deref(I_star, String ([(sf1, List [])], _)); _ ] -> + warn_rule [Warn_help_perl_checker] (sprintf "write *{'%s'} instead of *{\"%s\"}" sf1 sf1) + + | "||=", List [ List _ ] :: _ + | "&&=", List [ List _ ] :: _ -> warn_rule [Warn_complex_expressions] "remove the parentheses" + | "||=", e :: _ + | "&&=", e :: _ -> if is_not_a_scalar e then warn_rule [Warn_traps] (sprintf "\"%s\" is only useful with a scalar" op) + + | "==", [Call_op("last_array_index", _, _); Num(n, _)] -> + warn_rule [Warn_suggest_simpler] (sprintf "$#x == %s is better written @x == %d" n (1 + int_of_string n)) + | "==", [Call_op("last_array_index", _, _); Call_op("- unary", [Num (n, _)], _)] -> + warn_rule [Warn_suggest_simpler] (sprintf "$#x == -%s is better written @x == %d" n (1 - int_of_string n)) + + + | "||", e :: _ when is_always_true e -> warn_rule [Warn_strange] " || ... is the same as " + | "&&", e :: _ when is_always_false e -> warn_rule [Warn_strange] " && ... is the same as " + | "||", e :: _ when is_always_false e -> warn_rule [Warn_strange] " || ... is the same as ..." + | "&&", e :: _ when is_always_true e -> warn_rule [Warn_strange] " && ... is the same as ..." + + | "or", e :: _ when is_always_true (un_parenthesize_full e) -> warn_rule [Warn_strange] " or ... is the same as " + | "and", e :: _ when is_always_false (un_parenthesize_full e) -> warn_rule [Warn_strange] " and ... is the same as " + | "or", e :: _ when is_always_false (un_parenthesize_full e) -> warn_rule [Warn_strange] " or ... is the same as ..." + | "and", e :: _ when is_always_true (un_parenthesize_full e) -> warn_rule [Warn_strange] " and ... is the same as ..." + + | "or", [ List [ Deref(I_scalar, id) ]; List [ Call_op("=", [ Deref(I_scalar, id_); _], _) ] ] when is_same_fromparser id id_ -> + warn_rule [Warn_suggest_simpler] "\"$foo or $foo = ...\" can be written \"$foo ||= ...\"" + + | "and", [ _cond ; expr ] -> check_My_under_condition "replace \" and my $foo = ...\" with \"my $foo = && ...\"" expr + | "or", [ _cond ; expr ] -> check_My_under_condition "replace \" or my $foo = ...\" with \"my $foo = ! && ...\"" expr + + | _ -> ()); + + match op, para with + | "=", [ Deref(I_star, (Ident _ as f1)); Deref(I_star, (Ident _ as f2)) ] -> + let s1, s2 = string_of_fromparser f1, string_of_fromparser f2 in + warn [Warn_complex_expressions] pos (sprintf "\"*%s = *%s\" is better written \"*%s = \\&%s\"" s1 s2 s1 s2) ; + sub_declaration (f1, None) [ call_with_same_para_special(Deref(I_func, f2)) ] Glob_assign + | "=", [ Deref(I_star, Raw_string(sf1, pos_f1)); Deref(I_star, (Ident _ as f2)) ] -> + let s2 = string_of_fromparser f2 in + warn [Warn_help_perl_checker] pos (sprintf "\"*{'%s'} = *%s\" is better written \"*{'%s'} = \\&%s\"" sf1 s2 sf1 s2) ; + sub_declaration (Ident(None, sf1, pos_f1), None) [ call_with_same_para_special(Deref(I_func, f2)) ] Glob_assign + + | "=", [ Deref(I_star, (Ident _ as f1)); Ref(I_scalar, Deref(I_func, (Ident _ as f2))) ] -> + sub_declaration (f1, None) [ call_with_same_para_special(Deref(I_func, f2)) ] Glob_assign + | "=", [ Deref(I_star, Raw_string(sf1, pos_f1)); Ref(I_scalar, Deref(I_func, (Ident _ as f2))) ] -> + sub_declaration (Ident(None, sf1, pos_f1), None) [ call_with_same_para_special(Deref(I_func, f2)) ] Glob_assign + + | "=", [ Deref(I_star, (Ident _ as f1)); (Anonymous_sub(proto, sub, _)) ] -> + sub_declaration (f1, proto) [ sub ] Glob_assign + + | _ -> Call_op(op, para, raw_pos2pos pos) + +let to_Call_op mcontext op para esp_start esp_end = + let pos = raw_pos_range esp_start esp_end in + new_any mcontext (cook_call_op op para pos) esp_start.spaces pos +let to_Call_op_ mcontext prio op para esp_start esp_end = + let pos = raw_pos_range esp_start esp_end in + new_any mcontext { priority = prio ; expr = cook_call_op op para pos } esp_start.spaces pos +let to_Call_assign_op_ mcontext prio op left right esp_left esp_end = + if not (is_lvalue left) then warn [Warn_strange] esp_left.pos "invalid lvalue"; + to_Call_op_ mcontext prio op [ left ; right ] esp_left esp_end + +let followed_by_comma expr true_comma = + if true_comma then expr else + match split_last expr with + | l, Ident(None, s, pos) -> l @ [Raw_string(s, pos)] + | _ -> expr + + +let pot_strings = Hashtbl.create 16 +let po_comments = ref [] +let po_comment esp = lpush po_comments esp.any + +let check_format_a_la_printf s pos = + let rec check_format_a_la_printf_ contexts i = + try + let i' = String.index_from s i '%' in + try + let contexts = + match s.[i' + 1] with + | '%' -> contexts + | 'd' -> M_int :: contexts + | 's' | 'c' -> M_string :: contexts + | c -> warn [Warn_strange] (pos + i', pos + i') (sprintf "invalid command %%%c" c); contexts + in + check_format_a_la_printf_ contexts (i' + 2) + with Invalid_argument _ -> warn [Warn_strange] (pos + i', pos + i') "invalid command %" ; contexts + with Not_found -> contexts + in check_format_a_la_printf_ [] 0 + +let generate_pot file = + let fd = open_out file in + output_string fd +("# SOME DESCRIPTIVE TITLE. +# Copyright (C) YEAR Free Software Foundation, Inc. +# FIRST AUTHOR , YEAR. +# +#, fuzzy +msgid \"\" +msgstr \"\" +\"Project-Id-Version: PACKAGE VERSION\\n\" +\"POT-Creation-Date: " ^ input_line (Unix.open_process_in "date '+%Y-%m-%d %H:%M%z'") ^ "\\n\" +\"PO-Revision-Date: YEAR-MO-DA HO:MI+ZONE\\n\" +\"Last-Translator: FULL NAME \\n\" +\"Language-Team: LANGUAGE \\n\" +\"MIME-Version: 1.0\\n\" +\"Content-Type: text/plain; charset=CHARSET\\n\" +\"Content-Transfer-Encoding: 8-bit\\n\" + +") ; + + let rec print_formatted_char = function + | '"' -> output_char fd '\\'; output_char fd '"' + | '\t' -> output_char fd '\\'; output_char fd 't' + | '\\' -> output_char fd '\\'; output_char fd '\\' + | '\n' -> output_string fd "\\n\"\n\"" + | c -> output_char fd c + in + let sorted_pot_strings = List.sort (fun (_, pos_a) (_, pos_b) -> compare pos_a pos_b) + (Hashtbl.fold (fun k (v, _) l -> (k,v) :: l) pot_strings [] ) in + List.iter (fun (s, _) -> + match Hashtbl.find_all pot_strings s with + | [] -> () + | l -> + List.iter (fun _ -> Hashtbl.remove pot_strings s) l ; + + List.iter (fun po_comment -> output_string fd ("#. " ^ po_comment ^ "\n")) (collect snd l); + + let pos_l = List.sort compare (List.map fst l) in + fprintf fd "#: %s\n" (String.concat " " (List.map Info.pos2s_for_po pos_l)) ; + output_string fd "#, c-format\n" ; + + output_string fd (if String.contains s '\n' then "msgid \"\"\n\"" else "msgid \"") ; + String.iter print_formatted_char s ; + output_string fd "\"\n" ; + output_string fd "msgstr \"\"\n\n" + ) sorted_pot_strings ; + close_out fd + +let check_system_call = function + | "mkdir" :: l -> + let has_p = List.exists (str_begins_with "-p") l in + let has_m = List.exists (str_begins_with "-m") l in + if has_p && has_m then () + else if has_p then warn_rule [Warn_suggest_simpler; Warn_MDK_Common] "you can replace system(\"mkdir -p ...\") with mkdir_p(...)" + else if has_m then warn_rule [Warn_suggest_simpler; Warn_MDK_Common] "you can replace system(\"mkdir -m ...\") with mkdir(..., )" + else warn_rule [Warn_suggest_simpler; Warn_MDK_Common] "you can replace system(\"mkdir ...\") with mkdir(...)" + | _ -> () + +let call_raw force_non_builtin_func (e, para) = + let check_anonymous_block f = function + | [ Anonymous_sub _ ; Deref (I_hash, _) ] -> + warn_rule [Warn_strange] ("a hash is not a valid parameter to function " ^ f) + + | Anonymous_sub _ :: _ -> () + | _ -> warn_rule [Warn_complex_expressions] (sprintf "always use \"%s\" with a block (eg: %s { ... } @list)" f f) + in + + match e with + | Deref(I_func, Ident(None, f, _)) -> + (match f with + | "join" -> + (match un_parenthesize_full_l para with + | e :: _ when not (is_a_scalar e) -> warn_rule [Warn_traps] "first argument of join() must be a scalar"; + | [_] -> warn_rule [Warn_traps] "not enough parameters" + | [_; e] when is_a_scalar e -> warn_rule [Warn_traps] "join('...', $foo) is the same as $foo" + | _ -> ()) + + | "length" -> + if para = [] then warn_rule [Warn_complex_expressions] (sprintf "please use \"%s $_\" instead of \"%s\"" f f) else + if is_not_a_scalar (List.hd para) then warn_rule [Warn_traps] "never use \"length @l\", it returns the length of the string int(@l)" ; + + | "open" -> + (match para with + | [ List(Ident(None, name, _) :: _) ] + | Ident(None, name, _) :: _ -> + if not (List.mem name [ "STDIN" ; "STDOUT" ; "STDERR" ]) then + warn_rule [Warn_complex_expressions] (sprintf "use a scalar instead of a bareword (eg: occurrences of %s with $%s)" name name) + | _ -> ()) + + | "N" | "N_" -> + (match para with + | [ List(String([ s, List [] ], (_, pos_offset, _ as pos)) :: para) ] -> + if !Flags.generate_pot then ( + Hashtbl.add pot_strings s (pos, !po_comments) ; + po_comments := [] + ) ; + let contexts = check_format_a_la_printf s pos_offset in + if f = "N" then + if List.length para < List.length contexts then + warn_rule [Warn_traps; Warn_MDK_Common] "not enough parameters" + else if List.length para > List.length contexts then + warn_rule [Warn_traps; Warn_MDK_Common] "too many parameters" ; + (*if String.contains s '\t' then warn_rule "tabulation in translated string must be written \\\\t";*) + (*if count_matching_char s '\n' > 10 then warn_rule "long string";*) + | [ List(String _ :: _) ] -> die_rule "don't use interpolated translated string, use %s or %d instead" + | _ -> die_rule (sprintf "%s() must be used with a string" f)) + + | "if_" -> + (match para with + | [ List [ _ ] ] -> warn_rule [Warn_traps; Warn_MDK_Common] "not enough parameters"; + | _ -> ()) + + | "map" -> + (match para with + + | Anonymous_sub(None, Block [ List [ Call(Deref(I_func, Ident(None, "if_", _)), + [ List [ _ ; Deref(I_scalar, Ident(None, "_", _)) ] ]) ] ], _) :: _ -> + warn_rule [Warn_suggest_simpler; Warn_MDK_Common] "you can replace \"map { if_(..., $_) }\" with \"grep { ... }\"" + | _ -> check_anonymous_block f para) + + | "grep" -> + (match para with + | [ Anonymous_sub(None, Block [ List [ Call_op("not", [ Call(Deref(I_func, Ident(None, "member", _)), [ List(Deref(I_scalar, Ident(None, "_", _)) :: _) ]) ], _) ] ], _); _ ] -> + warn_rule [Warn_suggest_simpler; Warn_MDK_Common] "you can replace \"grep { !member($_, ...) } @l\" with \"difference2([ @l ], [ ... ])\"" + | [ Anonymous_sub(None, Block [ List [ Call(Deref(I_func, Ident(None, "member", _)), [ List(Deref(I_scalar, Ident(None, "_", _)) :: _) ]) ] ], _); _ ] -> + warn_rule [Warn_suggest_simpler; Warn_MDK_Common] "you can replace \"grep { member($_, ...) } @l\" with \"intersection([ @l ], [ ... ])\"" + | _ -> check_anonymous_block f para) + + | "any" -> + (match para with + [Anonymous_sub (None, Block + [ List [ Call_op("eq", [Deref(I_scalar, Ident(None, "_", _)); _ ], _) ] ], + _); _ ] -> + warn_rule [Warn_suggest_simpler; Warn_MDK_Common] "you can replace \"any { $_ eq ... } @l\" with \"member(..., @l)\"" + | _ -> check_anonymous_block f para) + + | "grep_index" | "map_index" | "partition" | "uniq_" + | "find" + | "every" + | "find_index" + | "each_index" -> check_anonymous_block f para + + | "member" -> + (match para with + [ List [ _; Call(Deref(I_func, Ident(None, "keys", _)), _) ] ] -> + warn_rule [Warn_suggest_simpler; Warn_MDK_Common] "you can replace \"member($xxx, keys %yyy)\" with \"exists $yyy{$xxx}\"" + | _ -> ()) + + | "pop" | "shift" -> + (match para with + | [] + | [ Deref(I_array, _) ] + | [ List [ Deref(I_array, _) ] ] -> () + | _ -> warn_rule [Warn_traps] (f ^ " is expecting an array and nothing else")) + + | "push" | "unshift" -> + (match para with + | Deref(I_array, _) :: l + | [ List (Deref(I_array, _) :: l) ] -> + if l = [] then warn_rule [Warn_traps] ("you must give some arguments to " ^ f) + | _ -> warn_rule [Warn_traps] (f ^ " is expecting an array")) + + | "system" -> + let fake_string_option_from_expr = function + | String(l, _) -> Some(String.concat "" (List.map fst l)) + | Raw_string(s, _) -> Some s + | _ -> None + in + (match un_parenthesize_full_l para with + | [ e ] -> + (match fake_string_option_from_expr e with + | Some s -> + if List.exists (String.contains s) [ '\'' ; char_quote ] && + not (List.exists (String.contains s) [ '<' ; '>' ; '&' ; ';']) then + warn_rule [Warn_complex_expressions] "instead of quoting parameters you should give a list of arguments"; + check_system_call (split_at ' ' s) + | None -> ()) + | l -> + let l' = filter_some_with fake_string_option_from_expr l in + check_system_call l') + | _ -> () + ); + + let para' = match f with + | "no" -> + (match para with + | [ Ident(_, _, pos) as s ] -> Some [ Raw_string(string_of_fromparser s, pos) ] + | [ Call(Deref(I_func, (Ident(_, _, pos) as s)), l) ] -> Some(Raw_string(string_of_fromparser s, pos) :: l) + | _ -> die_rule "use \"no PACKAGE \"") + | "undef" -> + (match para with + | [ Deref(I_star, ident) ] -> Some [ Deref(I_func, ident) ] + | _ -> None) + + | "goto" -> + (match para with + | [ Ident(None, s, pos) ] -> Some [ Raw_string(s, pos) ] + | _ -> None) + + | "last" | "next" | "redo" when not force_non_builtin_func -> + (match para with + | [ Ident(None, s, pos) ] -> Some [ Raw_string(s, pos) ] + | _ -> die_rule (sprintf "%s must be used with a raw string" f)) + + | "split" -> + (match para with + | [ List(Call_op("m//", Deref(I_scalar, Ident(None, "_", _)) :: pattern, pos) :: l) ] + | Call_op("m//", Deref(I_scalar, Ident(None, "_", _)) :: pattern, pos) :: l -> + Some(Call_op("qr//", pattern, pos) :: l) + | _ -> None) + + | _ -> None + in Call(e, some_or para' para) + | _ -> Call(e, para) + +let call(e, para) = call_raw false (e, para) + +let check_return esp_func esp_para = + match esp_func.any with + | Ident(None, "return", _) -> + prio_lo_check P_call_no_paren esp_para.any.priority esp_para.pos (List esp_para.any.expr) + | _ -> () + +let call_and_context(e, para) force_non_builtin_func priority esp_start esp_end = + let context = + match e with + | Deref(I_func, Ident(None, f, _)) -> function_to_context false f + | _ -> M_unknown + in + new_pesp context priority (call_raw force_non_builtin_func (e, para)) esp_start esp_end + +let call_no_paren esp_func esp_para = check_return esp_func esp_para; call_and_context(Deref(I_func, esp_func.any), esp_para.any.expr) false P_call_no_paren esp_func esp_para +let call_with_paren esp_func esp_para = check_return esp_func esp_para; call_and_context (Deref(I_func, esp_func.any), esp_para.any.expr) false P_tok esp_func esp_para + +let call_func esp_func esp_para = + call_and_context(esp_func.any, esp_para.any.expr) true P_tok esp_func esp_para + +let call_one_scalar_para prio { any = e ; pos = pos } para esp_start esp_end = + let para' = + match para with + | [] -> + if e = "shift" || e = "pop" then + [] (* can't decide here *) + else + (if not (List.mem e [ "length" ]) then warn_rule [Warn_complex_expressions] (sprintf "please use \"%s $_\" instead of \"%s\"" e e) ; + [var_dollar_ (raw_pos2pos pos)]) + | _ -> para + in + new_pesp M_unknown prio (call(Deref(I_func, Ident(None, e, raw_pos2pos pos)), para')) esp_start esp_end + + +let (current_lexbuf : Lexing.lexbuf option ref) = ref None + +let rec list2tokens l = + let rl = ref l in + fun lexbuf -> + match !rl with + | [] -> internal_error "list2tokens" + | ((start, end_), e) :: l -> + (* HACK: fake a normal lexbuf *) + lexbuf.Lexing.lex_start_p <- { Lexing.dummy_pos with Lexing.pos_cnum = start } ; + lexbuf.Lexing.lex_curr_p <- { Lexing.dummy_pos with Lexing.pos_cnum = end_ } ; + rl := l ; e + +let parse_tokens parse tokens lexbuf_opt = + if lexbuf_opt <> None then current_lexbuf := lexbuf_opt ; + if tokens = [] then [] else + parse (list2tokens tokens) (some !current_lexbuf) + +let parse_interpolated parse l = + let l' = List.map (fun (s, tokens) -> s, to_List(parse_tokens parse tokens None)) l in + match split_last l' with + | pl, ("", List []) -> pl + | _ -> l' + +let to_String parse strict { any = l ; pos = pos } = + let l' = parse_interpolated parse l in + (match l' with + | [ "", List [Deref(I_scalar, Ident(None, ident, _))]] -> + if ident <> "!" && strict then warn [Warn_suggest_simpler] pos (sprintf "%s is better written without the double quotes" (variable2s(I_scalar, ident))) + | [ "", List [Deref(I_hash, _)]] -> + warn [Warn_traps] pos "don't use a hash in string context" + | [ "", List [Deref(I_array, _)]] + | [ "", List [Deref_with(I_array, I_array, _, _)]] -> (* for slices like: "@m3[1..$#m3]" *) + () + | [("", _)] -> + if strict then warn [Warn_suggest_simpler] pos "double quotes are unneeded" + | _ -> ()); + String(l', raw_pos2pos pos) + +let from_PATTERN parse { any = (s, opts) ; pos = pos } = + let re = parse_interpolated parse s in + (match List.rev re with + | (s, List []) :: _ -> + if str_ends_with s ".*" then + warn_rule [Warn_suggest_simpler] (sprintf "you can remove \"%s\" at the end of your regexp" ".*") + else if str_ends_with s ".*$" then + warn_rule [Warn_suggest_simpler] (sprintf "you can remove \"%s\" at the end of your regexp" ".*$") + | _ -> ()); + let pattern = [ String(re, raw_pos2pos pos) ; Raw_string(opts, raw_pos2pos pos) ] in + check_simple_pattern pattern; + pattern + +let from_PATTERN_SUBST parse { any = (s1, s2, opts) ; pos = pos } = + [ String(parse_interpolated parse s1, raw_pos2pos pos) ; + String(parse_interpolated parse s2, raw_pos2pos pos) ; + Raw_string(opts, raw_pos2pos pos) ] + + +let rec mcontext2s = function + | M_none -> "()" + + | M_bool -> "bool" + + | M_int -> "int" + | M_float -> "float" + | M_string -> "string" + | M_ref c -> "ref(" ^ mcontext2s c ^ ")" + | M_revision -> "revision" + | M_undef -> "undef" + | M_sub -> "sub" + | M_unknown_scalar -> "scalar" + + | M_tuple l -> "tuple(" ^ String.concat ", " (List.map mcontext2s l) ^ ")" + | M_list -> "list" + | M_array -> "array" + | M_hash -> "hash" + + | M_special -> "special" + | M_unknown -> "unknown" + | M_mixed l -> String.concat " | " (List.map mcontext2s l) + +let rec mcontext_lower c1 c2 = + match c1, c2 with + | M_special, _ | _, M_special -> internal_error "M_special in mcontext_compare" + + | M_unknown, _ + | _, M_unknown -> true + + | M_mixed l, c -> List.exists (fun a -> mcontext_lower a c) l + | c, M_mixed l -> List.exists (mcontext_lower c) l + + | M_none, M_none | M_sub, M_sub | M_hash, M_hash | M_hash, M_bool -> true + | M_none, _ | M_sub, _ | M_hash, _ -> false + + | _, M_list -> true + + | M_list, M_bool + | M_list, M_tuple _ + + (* M_unknown_scalar is M_mixed [ M_int ; M_float ; M_string ; M_bool ; M_ref _ ; M_revision ; M_undef ] *) + | M_unknown_scalar, M_int | M_unknown_scalar, M_float | M_unknown_scalar, M_string | M_unknown_scalar, M_bool + | M_unknown_scalar, M_ref _ | M_unknown_scalar, M_revision | M_unknown_scalar, M_undef | M_unknown_scalar, M_unknown_scalar + + | M_array, M_array | M_array, M_int | M_array, M_float | M_array, M_bool | M_array, M_unknown_scalar | M_array, M_tuple _ + | M_int, M_int | M_int, M_float | M_int, M_string | M_int, M_bool | M_int, M_unknown_scalar + | M_float, M_float | M_float, M_string | M_float, M_bool | M_float, M_unknown_scalar + | M_string, M_string | M_string, M_bool | M_string, M_unknown_scalar + | M_bool, M_bool | M_bool, M_unknown_scalar + + | M_ref _, M_unknown_scalar + | M_revision, M_revision | M_revision, M_unknown_scalar + | M_undef, M_undef | M_undef, M_unknown_scalar + + -> true + + | M_tuple t1, M_tuple t2 -> + List.length t1 = List.length t2 && for_all2_true mcontext_lower t1 t2 + + | M_tuple [c], M_int | M_tuple [c], M_float | M_tuple [c], M_string | M_tuple [c], M_bool + | M_tuple [c], M_ref _ | M_tuple [c], M_revision | M_tuple [c], M_undef | M_tuple [c], M_unknown_scalar + -> mcontext_lower c c2 + +(* | M_ref a, M_ref b -> mcontext_lower a b *) + + | _ -> false + +let mcontext_is_scalar = function + | M_unknown -> false + | c -> mcontext_lower c M_unknown_scalar + +let mcontext_to_scalar = function + | M_array -> M_int + | c -> if mcontext_is_scalar c then c else M_unknown_scalar + +let mcontext_merge_raw c1 c2 = + match c1, c2 with + | M_unknown, _ | _, M_unknown -> Some M_unknown + | M_unknown_scalar, c when mcontext_is_scalar c -> Some M_unknown_scalar + | c, M_unknown_scalar when mcontext_is_scalar c -> Some M_unknown_scalar + | M_mixed _, _ | _, M_mixed _ -> internal_error "mcontext_merge_raw" + | _ -> + if mcontext_lower c1 c2 then Some c2 else + if mcontext_lower c2 c1 then Some c1 else + if c1 = c2 then Some c1 else + None + +let rec mcontext_lmerge_add l = function + | M_mixed l2 -> List.fold_left mcontext_lmerge_add [] (l2 @ l) + | c -> + let rec add_to = function + | [] -> [c] + | M_mixed subl :: l -> add_to (subl @ l) + | c2 :: l -> + match mcontext_merge_raw c c2 with + | Some c' -> c' :: l + | None -> c2 :: add_to l + in add_to l + +let mcontext_lmerge l = + match List.fold_left mcontext_lmerge_add [] l with + | [] -> internal_error "mcontext_lmerge" + | [c] -> c + | l -> M_mixed l + +let mcontext_merge c1 c2 = mcontext_lmerge [ c1 ; c2 ] + +let mcontext_lmaybe esp = if esp.any = [] then [] else [esp.mcontext] + +let mcontext_check_raw wanted_mcontext mcontext = + if not (mcontext_lower mcontext wanted_mcontext) then + warn_rule [Warn_context] (sprintf "context %s is not compatible with context %s" (mcontext2s mcontext) (mcontext2s wanted_mcontext)) + +let mcontext_check wanted_mcontext esp = + (match wanted_mcontext with + | M_list | M_array | M_float | M_mixed [M_array; M_none] | M_tuple _ -> () + | _ -> + match un_parenthesize_full esp.any.expr with + | Call(Deref(I_func, Ident(None, "grep", _)), _) -> + warn_rule [Warn_suggest_simpler; Warn_help_perl_checker] (if wanted_mcontext = M_bool then + "in boolean context, use \"any\" instead of \"grep\"" else + "you may use \"find\" instead of \"grep\"") + | _ -> ()); + mcontext_check_raw wanted_mcontext esp.mcontext + +let mcontext_check_unop_l wanted_mcontext esp = + mcontext_check wanted_mcontext { esp with any = { esp.any with expr = List esp.any.expr } } + +let mcontext_check_non_none esp = + if esp.mcontext = M_none then warn_rule [Warn_context] "() context not accepted here" + +let mcontext_check_none msg expr esp = + let rec mcontext_check_none_rec msg expr = function + | M_none | M_unknown -> () + | M_mixed l when List.exists (fun c -> c = M_none) l -> () + | M_tuple l -> + (match expr with + | [Block [List l_expr]] + | [List l_expr] + | [List l_expr ; Semi_colon] -> + let rec iter = function + | e::l_expr, mcontext::l -> + mcontext_check_none_rec (if l = [] then msg else "value is dropped") [e] mcontext ; + iter (l_expr, l) + | [], [] -> () + | _ -> internal_error "mcontext_check_none" + in iter (un_parenthesize_full_l l_expr, l) + | _ -> internal_error "mcontext_check_none") + | _ -> + match expr with + | [List [Num("1", _)]; Semi_colon] -> () (* allow "1;" for package return value. It would be much better to check we are at toplevel, but hell i don't want to wire this information up to here *) + | [List [Call_op ("<>", [Ident (None, "STDIN", _)], _)]; Semi_colon] -> () (* allow to ask "press return" *) + | [List [Call(Deref(I_func, Ident(None, "map", _)), _)]; Semi_colon] -> warn_rule [Warn_void] "if you don't use the return value, use \"foreach\" instead of \"map\"" + | _ -> warn [Warn_void] esp.pos msg + in + mcontext_check_none_rec msg expr esp.mcontext + +(* only returns M_float when there is at least one float *) +let mcontext_float_or_int l = + List.iter (mcontext_check_raw M_float) l; + if List.mem M_float l then M_float else M_int + +let mcontext_op_assign left right = + mcontext_check_non_none right; + + let left_mcontext = + match left.mcontext with + | M_mixed [ c ; M_none ] -> c + | c -> c + in + + let wanted_mcontext = match left_mcontext with + | M_array -> M_list + | M_hash -> M_mixed [ M_hash ; M_list ] + | m -> m + in + mcontext_check wanted_mcontext right; + + let return_mcontext = + match left_mcontext with + | M_tuple _ -> M_array + | c -> c + in + mcontext_merge return_mcontext M_none + +let mtuple_context_concat c1 c2 = + match c1, c2 with + | M_array, _ | _, M_array + | M_hash, _ | _, M_hash -> M_list + | M_tuple l, _ -> M_tuple (l @ [c2]) + | _ -> M_tuple [c1 ; c2] + +let call_op_if_infix left right esp_start esp_end = + (match left, right with + | List [Call_op("=", [Deref(context, _); _], _)], _ when non_scalar_context context -> () + | List [Call_op("=", [v; _], _)], + List [Call_op("not", [v'], _)] when is_same_fromparser v v' -> + warn_rule [Warn_suggest_simpler] "\"$foo = ... if !$foo\" can be written \"$foo ||= ...\"" + | _ -> ()); + + mcontext_check_none "value is dropped" [left] esp_start; + (match right with + | List [ Num("0", _)] -> () (* allow my $x if 0 *) + | _ -> check_My_under_condition "replace \"my $foo = ... if \" with \"my $foo = && ...\"" left); + + let pos = raw_pos_range esp_start esp_end in + new_any M_none (Call_op("if infix", [ left ; right], raw_pos2pos pos)) esp_start.spaces pos + +let call_op_unless_infix left right esp_start esp_end = + (match left, right with + | List [Call_op("=", [Deref(context, _); _], _)], _ when non_scalar_context context -> () + | List [Call_op("=", [v; _], _)], List [v'] when is_same_fromparser v v' -> + warn_rule [Warn_suggest_simpler] "\"$foo = ... unless $foo\" can be written \"$foo ||= ...\"" + | _ -> ()); + (match right with + | List [Call_op(op, _, _)] -> + (match op with + | "&&" | "||" | "not" | "ne" | "?:" -> warn_rule [Warn_complex_expressions] "don't use \"unless\" when the condition is complex, use \"if\" instead" + | _ -> ()); + | _ -> ()); + + mcontext_check_none "value is dropped" [left] esp_start; + check_My_under_condition "replace \"my $foo = ... unless \" with \"my $foo = ! && ...\"" left; + + let pos = raw_pos_range esp_start esp_end in + new_any M_none (Call_op("unless infix", [ left ; right], raw_pos2pos pos)) esp_start.spaces pos + +let symops pri para_context return_context op_str left op right = + sp_same op right; + let skip_context_check = + (op_str = "==" || op_str = "!=") && (match left.any.expr, right.any.expr with + | Deref(I_array, _), List [] -> true (* allow @l == () and @l != () *) + | _ -> false) + in + if op_str <> "==" && op_str <> "!=" && para_context = M_float then + (match un_parenthesize_full left.any.expr with + | Call_op("last_array_index", _, _) -> warn_rule [Warn_complex_expressions] "change your expression to use @xxx instead of $#xxx" + | _ -> ()); + + if not skip_context_check then + (mcontext_check para_context left ; mcontext_check para_context right) ; + to_Call_op_ return_context pri op_str [prio_lo pri left; prio_lo_after pri right] left right diff --git a/src/parser_helper.mli b/src/parser_helper.mli new file mode 100644 index 0000000..e820703 --- /dev/null +++ b/src/parser_helper.mli @@ -0,0 +1,314 @@ +val bpos : int * int +val raw_pos2pos : 'a * 'b -> string * 'a * 'b +val raw_pos_range : + 'a Types.any_spaces_pos -> 'b Types.any_spaces_pos -> int * int +val pos_range : + 'a Types.any_spaces_pos -> 'b Types.any_spaces_pos -> string * int * int +val get_pos : 'a Types.any_spaces_pos -> string * int * int +val get_pos_start : 'a Types.any_spaces_pos -> int +val get_pos_end : 'a Types.any_spaces_pos -> int +val var_dollar_ : Types.pos -> Types.fromparser +val var_STDOUT : Types.fromparser +val new_any : + Types.maybe_context -> + 'a -> Types.spaces -> int * int -> 'a Types.any_spaces_pos +val new_any_ : 'a -> Types.spaces -> int * int -> 'a Types.any_spaces_pos +val new_esp : + Types.maybe_context -> + 'a -> + 'b Types.any_spaces_pos -> + 'c Types.any_spaces_pos -> 'a Types.any_spaces_pos +val new_1esp : 'a -> 'b Types.any_spaces_pos -> 'a Types.any_spaces_pos +val new_pesp : + Types.maybe_context -> + Types.priority -> + 'a -> + 'b Types.any_spaces_pos -> + 'c Types.any_spaces_pos -> 'a Types.prio_anyexpr Types.any_spaces_pos +val new_1pesp : + Types.priority -> + 'a -> 'b Types.any_spaces_pos -> 'a Types.prio_anyexpr Types.any_spaces_pos +val default_esp : 'a -> 'a Types.any_spaces_pos +val default_pesp : + Types.priority -> 'a -> 'a Types.prio_anyexpr Types.any_spaces_pos +val split_name_or_fq_name : string -> string option * string +val is_var_dollar_ : Types.fromparser -> bool +val is_var_number_match : Types.fromparser -> bool +val non_scalar_context : Types.context -> bool +val is_scalar_context : Types.context -> bool +val is_not_a_scalar : Types.fromparser -> bool +val is_a_scalar : Types.fromparser -> bool +val is_a_string : Types.fromparser -> bool +val is_parenthesized : Types.fromparser -> bool +val un_parenthesize : Types.fromparser -> Types.fromparser +val un_parenthesize_full : Types.fromparser -> Types.fromparser +val un_parenthesize_full_l : Types.fromparser list -> Types.fromparser list +val is_always_true : Types.fromparser -> bool +val is_always_false : Types.fromparser -> bool +val is_lvalue : Types.fromparser -> bool +val not_complex : Types.fromparser -> bool +val not_simple : Types.fromparser -> bool +val context2s : Types.context -> string +val variable2s : Types.context * string -> string +val string_of_fromparser : Types.fromparser -> string +val lstring_of_fromparser : Types.fromparser list -> string +val lstring_of_fromparser_parentheses : Types.fromparser list -> string +val is_same_fromparser : Types.fromparser -> Types.fromparser -> bool +val from_scalar : Types.fromparser Types.any_spaces_pos -> Types.fromparser +val from_array : Types.fromparser Types.any_spaces_pos -> Types.fromparser +val get_pos_from_expr : Types.fromparser -> Types.pos +val msg_with_rawpos : int * int -> string -> string +val die_with_rawpos : int * int -> string -> 'a +val warn : Types.warning list -> int * int -> string -> unit +val die_rule : string -> 'a +val warn_rule : Types.warning list -> string -> unit +val warn_verb : Types.warning list -> int -> string -> unit +val warn_too_many_space : int -> unit +val warn_no_space : int -> unit +val warn_cr : int -> unit +val warn_space : int -> unit +val prio_less : Types.priority * Types.priority -> bool +val prio_lo_check : + Types.priority -> Types.priority -> int * int -> Types.fromparser -> unit +val prio_lo : + Types.priority -> + Types.fromparser Types.prio_anyexpr Types.any_spaces_pos -> + Types.fromparser +val prio_lo_after : + Types.priority -> + Types.fromparser Types.prio_anyexpr Types.any_spaces_pos -> + Types.fromparser +val prio_lo_concat : + Types.fromparser Types.prio_anyexpr Types.any_spaces_pos -> + Types.fromparser +val hash_ref : + Types.fromparser Types.prio_anyexpr Types.any_spaces_pos -> + Types.fromparser +val sp_0 : 'a Types.any_spaces_pos -> unit +val sp_0_or_cr : 'a Types.any_spaces_pos -> unit +val sp_1 : 'a Types.any_spaces_pos -> unit +val sp_n : 'a Types.any_spaces_pos -> unit +val sp_p : 'a Types.any_spaces_pos -> unit +val sp_cr : 'a Types.any_spaces_pos -> unit +val sp_same : 'a Types.any_spaces_pos -> 'b Types.any_spaces_pos -> unit +val function_to_context : bool -> string -> Types.maybe_context +val word_alone : + Types.fromparser Types.any_spaces_pos -> + Types.fromparser Types.prio_anyexpr Types.any_spaces_pos +val check_parenthesized_first_argexpr : + string -> + Types.fromparser list Types.prio_anyexpr Types.any_spaces_pos -> unit +val check_parenthesized_first_argexpr_with_Ident : + Types.fromparser -> + Types.fromparser list Types.prio_anyexpr Types.any_spaces_pos -> unit +val check_hash_subscript : + Types.fromparser Types.prio_anyexpr Types.any_spaces_pos -> unit +val check_arrow_needed : 'a Types.any_spaces_pos -> Types.fromparser -> unit +val check_scalar_subscripted : Types.fromparser Types.any_spaces_pos -> unit +val negatable_ops : (string * string) list +val check_negatable_expr : + Types.fromparser Types.prio_anyexpr Types.any_spaces_pos -> unit +val check_ternary_paras : + Types.fromparser * Types.fromparser * Types.fromparser -> + Types.fromparser list +val check_unneeded_var_dollar_ : + Types.fromparser Types.prio_anyexpr Types.any_spaces_pos -> unit +val check_unneeded_var_dollar_not : + Types.fromparser Types.prio_anyexpr Types.any_spaces_pos -> unit +val check_unneeded_var_dollar_s : + Types.fromparser Types.prio_anyexpr Types.any_spaces_pos -> unit +val check_my : string Types.any_spaces_pos -> unit +val check_foreach : string Types.any_spaces_pos -> unit +val check_for : string Types.any_spaces_pos -> unit +val check_for_foreach : + string Types.any_spaces_pos -> + Types.fromparser Types.prio_anyexpr Types.any_spaces_pos -> unit +val check_block_expr : + bool -> + Types.fromparser -> + 'a Types.any_spaces_pos -> 'b Types.any_spaces_pos -> unit +val check_block_lines : + (Types.fromparser list * bool) Types.any_spaces_pos -> + 'a Types.any_spaces_pos -> unit +val check_unless_else : + 'a list Types.any_spaces_pos -> 'b list Types.any_spaces_pos -> unit +val check_my_our_paren : + ((bool * 'a) * 'b list) Types.any_spaces_pos -> + 'c Types.any_spaces_pos -> unit +val check_simple_pattern : Types.fromparser list -> unit +val only_one : Types.fromparser list Types.any_spaces_pos -> Types.fromparser +val only_one_array_ref : + Types.fromparser list Types.any_spaces_pos -> Types.fromparser +val only_one_in_List : + Types.fromparser Types.prio_anyexpr Types.any_spaces_pos -> + Types.fromparser +val is_only_one_in_List : Types.fromparser list -> bool +val maybe_to_Raw_string : Types.fromparser -> Types.fromparser +val to_List : Types.fromparser list -> Types.fromparser +val deref_arraylen : Types.fromparser -> Types.fromparser +val deref_raw : Types.context -> Types.fromparser -> Types.fromparser +val to_Ident : + (string option * string) Types.any_spaces_pos -> Types.fromparser +val to_Raw_string : string Types.any_spaces_pos -> Types.fromparser +val to_Method_call : + Types.fromparser * Types.fromparser * Types.fromparser list -> + Types.fromparser +val to_Deref_with : + Types.context * Types.context * Types.fromparser * Types.fromparser -> + Types.fromparser +val to_Deref_with_arrow : + 'a Types.any_spaces_pos -> + Types.context * Types.context * Types.fromparser * Types.fromparser -> + Types.fromparser +val lines_to_Block : + (Types.fromparser list * bool) Types.any_spaces_pos -> + 'a Types.any_spaces_pos -> Types.fromparser +val to_Local : + Types.fromparser Types.prio_anyexpr Types.any_spaces_pos -> + Types.fromparser +val sub_declaration : + Types.fromparser * string option -> + Types.fromparser list -> Types.sub_declaration_kind -> Types.fromparser +val anonymous_sub : + string option -> + (Types.fromparser list * bool) Types.any_spaces_pos -> + 'a Types.any_spaces_pos -> Types.fromparser +val call_with_same_para_special : Types.fromparser -> Types.fromparser +val remove_call_with_same_para_special : Types.fromparser -> Types.fromparser +val check_My_under_condition : string -> Types.fromparser -> unit +val cook_call_op : + string -> Types.fromparser list -> int * int -> Types.fromparser +val to_Call_op : + Types.maybe_context -> + string -> + Types.fromparser list -> + 'a Types.any_spaces_pos -> + 'b Types.any_spaces_pos -> Types.fromparser Types.any_spaces_pos +val to_Call_op_ : + Types.maybe_context -> + Types.priority -> + string -> + Types.fromparser list -> + 'a Types.any_spaces_pos -> + 'b Types.any_spaces_pos -> + Types.fromparser Types.prio_anyexpr Types.any_spaces_pos +val to_Call_assign_op_ : + Types.maybe_context -> + Types.priority -> + string -> + Types.fromparser -> + Types.fromparser -> + 'a Types.any_spaces_pos -> + 'b Types.any_spaces_pos -> + Types.fromparser Types.prio_anyexpr Types.any_spaces_pos +val followed_by_comma : + Types.fromparser list -> bool -> Types.fromparser list +val pot_strings : (string, (string * int * int) * string list) Hashtbl.t +val po_comments : string list ref +val po_comment : string Types.any_spaces_pos -> unit +val check_format_a_la_printf : string -> int -> Types.maybe_context list +val generate_pot : string -> unit +val check_system_call : string list -> unit +val call_raw : + bool -> Types.fromparser * Types.fromparser list -> Types.fromparser +val call : Types.fromparser * Types.fromparser list -> Types.fromparser +val check_return : + Types.fromparser Types.any_spaces_pos -> + Types.fromparser list Types.prio_anyexpr Types.any_spaces_pos -> unit +val call_and_context : + Types.fromparser * Types.fromparser list -> + bool -> + Types.priority -> + 'a Types.any_spaces_pos -> + 'b Types.any_spaces_pos -> + Types.fromparser Types.prio_anyexpr Types.any_spaces_pos +val call_no_paren : + Types.fromparser Types.any_spaces_pos -> + Types.fromparser list Types.prio_anyexpr Types.any_spaces_pos -> + Types.fromparser Types.prio_anyexpr Types.any_spaces_pos +val call_with_paren : + Types.fromparser Types.any_spaces_pos -> + Types.fromparser list Types.prio_anyexpr Types.any_spaces_pos -> + Types.fromparser Types.prio_anyexpr Types.any_spaces_pos +val call_func : + Types.fromparser Types.any_spaces_pos -> + Types.fromparser list Types.prio_anyexpr Types.any_spaces_pos -> + Types.fromparser Types.prio_anyexpr Types.any_spaces_pos +val call_one_scalar_para : + Types.priority -> + string Types.any_spaces_pos -> + Types.fromparser list -> + 'a Types.any_spaces_pos -> + 'b Types.any_spaces_pos -> + Types.fromparser Types.prio_anyexpr Types.any_spaces_pos +val current_lexbuf : Lexing.lexbuf option ref +val list2tokens : ((int * int) * 'a) list -> Lexing.lexbuf -> 'a +val parse_tokens : + ((Lexing.lexbuf -> 'a) -> Lexing.lexbuf -> 'b list) -> + ((int * int) * 'a) list -> Lexing.lexbuf option -> 'b list +val parse_interpolated : + ((Lexing.lexbuf -> 'a) -> Lexing.lexbuf -> Types.fromparser list) -> + (string * ((int * int) * 'a) list) list -> (string * Types.fromparser) list +val to_String : + ((Lexing.lexbuf -> 'a) -> Lexing.lexbuf -> Types.fromparser list) -> + bool -> + (string * ((int * int) * 'a) list) list Types.any_spaces_pos -> + Types.fromparser +val from_PATTERN : + ((Lexing.lexbuf -> 'a) -> Lexing.lexbuf -> Types.fromparser list) -> + ((string * ((int * int) * 'a) list) list * string) Types.any_spaces_pos -> + Types.fromparser list +val from_PATTERN_SUBST : + ((Lexing.lexbuf -> 'a) -> Lexing.lexbuf -> Types.fromparser list) -> + ((string * ((int * int) * 'a) list) list * + (string * ((int * int) * 'a) list) list * string) + Types.any_spaces_pos -> Types.fromparser list +val mcontext2s : Types.maybe_context -> string +val mcontext_lower : Types.maybe_context -> Types.maybe_context -> bool +val mcontext_is_scalar : Types.maybe_context -> bool +val mcontext_to_scalar : Types.maybe_context -> Types.maybe_context +val mcontext_merge_raw : + Types.maybe_context -> Types.maybe_context -> Types.maybe_context option +val mcontext_lmerge_add : + Types.maybe_context list -> Types.maybe_context -> Types.maybe_context list +val mcontext_lmerge : Types.maybe_context list -> Types.maybe_context +val mcontext_merge : + Types.maybe_context -> Types.maybe_context -> Types.maybe_context +val mcontext_lmaybe : + 'a list Types.any_spaces_pos -> Types.maybe_context list +val mcontext_check_raw : Types.maybe_context -> Types.maybe_context -> unit +val mcontext_check : + Types.maybe_context -> + Types.fromparser Types.prio_anyexpr Types.any_spaces_pos -> unit +val mcontext_check_unop_l : + Types.maybe_context -> + Types.fromparser list Types.prio_anyexpr Types.any_spaces_pos -> unit +val mcontext_check_non_none : 'a Types.any_spaces_pos -> unit +val mcontext_check_none : + string -> Types.fromparser list -> 'a Types.any_spaces_pos -> unit +val mcontext_float_or_int : Types.maybe_context list -> Types.maybe_context +val mcontext_op_assign : + 'a Types.any_spaces_pos -> + Types.fromparser Types.prio_anyexpr Types.any_spaces_pos -> + Types.maybe_context +val mtuple_context_concat : + Types.maybe_context -> Types.maybe_context -> Types.maybe_context +val call_op_if_infix : + Types.fromparser -> + Types.fromparser -> + 'a Types.any_spaces_pos -> + 'b Types.any_spaces_pos -> Types.fromparser Types.any_spaces_pos +val call_op_unless_infix : + Types.fromparser -> + Types.fromparser -> + 'a Types.any_spaces_pos -> + 'b Types.any_spaces_pos -> Types.fromparser Types.any_spaces_pos +val symops : + Types.priority -> + Types.maybe_context -> + Types.maybe_context -> + string -> + Types.fromparser Types.prio_anyexpr Types.any_spaces_pos -> + 'a Types.any_spaces_pos -> + Types.fromparser Types.prio_anyexpr Types.any_spaces_pos -> + Types.fromparser Types.prio_anyexpr Types.any_spaces_pos diff --git a/src/perl_checker.html.pl b/src/perl_checker.html.pl new file mode 100644 index 0000000..e90d2eb --- /dev/null +++ b/src/perl_checker.html.pl @@ -0,0 +1,168 @@ +$s = <<'EOF'; +perl_checker +

    Goals of perl_checker

    + +
      +
    • for beginners in perl: + based on what the programmer is writing, +
        +
      • suggest better or more standard ways to do the same +
      • detect wrong code +
        + => a kind of automatic teacher +
      + +
    • for senior programmers: + detect typos, unused variables, check number + of parameters, global analysis to check method calls... + +
    • enforce the same perl style by enforcing a subset of perl of features. + In perl There is more than one way to do it. + In perl_checker's subset of Perl, there is not too many ways to do it. + This is especially useful for big projects. + (NB: the subset is chosen to keep a good expressivity) +
    + +

    Compared to Perl-Critic + +
      +
    • perl_checker use its own OCaml-written perl parser, which is in no way as robust as PPI. + A PPI require is to be able to parse non finished perl documents. + perl_checker is a checker, and it is not a big deal to die horribly on a weird perl expression, telling the programmer what to write instead. + +
    • perl_checker is much faster (more than 100 times) (ML pattern matching rulez) + +
    • perl_checker checks a lot more things than perlcritic: undeclared variables, unknown functions, unknown methods... + +
    • and of course perl_checker checks are different from the Conways's Perl Best Practices +
    + +

    Get it

    + +CVS source + +

    Implemented features

    + +
    +
    white space normalization +
    enforce a similar coding style. In many languages you can find a coding + style document (eg: the GNU one). + + TESTS=force_layout.t + +
    +
    disallow complex expressions +
    perl_checker try to ban some weird-not-used-a-lot features. + + TESTS=syntax_restrictions.t + +
    +
    suggest simpler expressions +
    when there is a simpler way to write an expression, suggest it. It can + also help detecting errors. + + TESTS=suggest_better.t + +
    +
    context checks +
    Perl has types associated with variables names, the so-called "context". + Some expressions mixing contexts are stupid, perl_checker detects them. + + TESTS=context.t + +
    +
    function call check +
    detection of unknown functions or mismatching prototypes (warning: since + perl is a dynamic language, some spurious warnings may occur when a function + is defined using stashes). + + TESTS=prototype.t + +
    +
    method call check +
    detection of unknown methods or mismatching prototypes. perl_checker + doesn't have any idea what the object type is, it simply checks if a method + with that name and that number of parameters exists. + + TESTS=method.t + +
    +
    return value check +
    dropping the result of a functionnally pure function is stupid. + using the result of a function returning void is stupid too. + + TESTS=return_value.t + +
    +
    detect some Perl traps +
    some Perl expressions are stupid, and one gets a warning when running + them with perl -w. The drawback are perl -w is the lack of + code coverage, it only detects expressions which are evaluated. + + TESTS=various_errors.t + +
    + +

    Todo

    + +Functionalities that would be nice: +
      +
    • add flow analysis +
    • maybe a "soft typing" type analysis +
    • detect places where imperative code can be replaced with + functional code (already done for some simple loops) +
    • check the number of returned values when checking prototype compliance +
    +EOF + +my $_rationale = <<'EOF'; +

    Rationale

    + +Perl is a big language, there is ThereIsMoreThanOneWayToDoIt. +It has advantages but also some drawbacks for team project: +
      +
    • it is hard to learn every special rules. Automatically enforced syntax + coding rules help learning incrementally +EOF + +use lib ('test', '..'); +use read_t; +sub get_example { + my ($file) = @_; + my @tests = read_t::read_t("test/$file"); + $file =~ s|test/||; + qq(

      \n) . + join('', map { + my $lines = join("
      ", map { "" . html_quote($_) . "" } @{$_->{lines}}); + my $logs = join("
      ", map { html_quote($_) } @{$_->{logs}}); + " \n"; + } @tests) . + "
      \n", $lines, "", $logs, "
      \n"; +} + +sub anchor_to_examples { + my ($s) = @_; + $s =~ s!TESTS=(\S+)!(examples)!g; + $s; +} +sub fill_in_examples { + my ($s) = @_; + $s =~ s!TESTS=(\S+)!get_example($1)!ge; + $s; +} + +$s =~ s!

      Implemented features

      (.*)

      ! + "

      Implemented features

      " . anchor_to_examples($1) . + "

      Examples

      " . fill_in_examples($1) . + "

      "!se; + +print $s; + +sub html_quote { + local $_ = $_[0]; + s//>/g; + s/^(\s*)/" " x length($1)/e; + $_; +} diff --git a/src/perl_checker.ml b/src/perl_checker.ml new file mode 100644 index 0000000..4459e30 --- /dev/null +++ b/src/perl_checker.ml @@ -0,0 +1,183 @@ +open Types +open Common +open Tree +open Global_checks + +let search_basedir file_name nb = + let dir = Filename.dirname file_name in + let config = Config_file.read dir in + let nb = some_or config.Config_file.basedir nb in + updir dir nb + +let basedir = ref "" +let set_basedir per_files file = + if !basedir = "" then + let nb = List.length (split_at2 ':'':' (List.hd file.packages).package_name) - 1 in + let dir = search_basedir file.file_name nb in + lpush Tree.use_lib dir ; + Config_file.read_any dir 1 ; + read_packages_from_cache per_files dir ; + if !Flags.verbose then print_endline_flush ("basedir is " ^ dir); + basedir := dir + +let rec parse_file from_basedir require_name per_files file = + try + if !Flags.verbose then print_endline_flush ("parsing " ^ file) ; + let build_time = Unix.time() in + let command = + match !Flags.expand_tabs with + | Some width -> "expand -t " ^ string_of_int width + | None -> "cat" in + let channel = Unix.open_process_in (Printf.sprintf "%s \"%s\"" command file) in + let lexbuf = Lexing.from_channel channel in + try + Info.start_a_new_file file ; + let tokens = Lexer.get_token Lexer.token lexbuf in + if not Build.debugging then ignore (Unix.close_process_in channel) ; + let t = Parser_helper.parse_tokens Parser.prog tokens (Some lexbuf) in + let per_file = get_global_info_from_package from_basedir require_name build_time t in + set_basedir per_files per_file ; + Global_checks.add_file_to_files per_files per_file ; + + let required_packages = collect (fun package -> package.required_packages) per_file.packages in + required_packages, per_files + with Failure s -> ( + print_endline_flush s ; + exit 1 + ) + with + | Not_found -> internal_error "runaway Not_found" + +and parse_package_if_needed per_files (package_name, pos) = + if List.mem package_name !Config_file.ignored_packages then [], per_files else + let splitted = split_at2 ':'':' package_name in + let rel_file = String.concat "/" splitted ^ ".pm" in + + (*print_endline_flush ("wondering about " ^ package_name) ;*) + try + let dir = findfile (Build.fake_packages_dir :: !use_lib) rel_file in + let file = Info.file_to_absolute_file (dir ^ "/" ^ rel_file) in + Config_file.read_any (Filename.dirname file) (List.length splitted) ; + let already_done = + try + let per_file = Hashtbl.find per_files file in + Some (collect (fun pkg -> pkg.required_packages) per_file.packages) + with Not_found -> None in + match already_done with + | Some required_packages -> required_packages, per_files + | None -> parse_file (dir = !basedir) (Some package_name) per_files file + with Not_found -> + print_endline_flush (Info.pos2sfull pos ^ Printf.sprintf "can't find package %s" package_name) ; + [], per_files + +let rec parse_required_packages state already_done = function + | [] -> state, already_done + | e :: l -> + if List.mem e already_done then + parse_required_packages state already_done l + else + let el, state = parse_package_if_needed state e in + parse_required_packages state (e :: already_done) (el @ l) + + +let parse_options = + let args_r = ref [] in + let restrict_to_files = ref false in + + let pot_file = ref "" in + let package_dependencies_graph_file = ref "" in + let generate_pot_chosen file = + Flags.generate_pot := true ; + Flags.expand_tabs := None ; + pot_file := file + in + let options = [ + "-v", Arg.Set Flags.verbose, " be verbose" ; + "-q", Arg.Set Flags.quiet, " be quiet" ; + "-t", Arg.Int (fun i -> Flags.expand_tabs := Some i), " set the tabulation width (default is 8)" ; + "--restrict-to-files", Arg.Set restrict_to_files, " only display warnings concerning the file(s) given on command line" ; + "--no-cache", Arg.Set Flags.no_cache, " do not use cache" ; + "--generate-pot", Arg.String generate_pot_chosen, "" ; + "--generate-package-dependencies-graph", Arg.String (fun f -> package_dependencies_graph_file := f), + "\n" ; + + "--check-unused-global-vars", Arg.Set Flags.check_unused_global_vars, " disable unused global functions & variables check" ^ + "\nBasic warnings:"; + "--no-check-white-space", Arg.Clear Flags.check_white_space, " disable white space check" ; + "--no-suggest-simpler", Arg.Clear Flags.check_suggest_simpler, " disable simpler code suggestion" ; + "--no-suggest-functional", Arg.Clear Flags.suggest_functional, " disable Functional Programming suggestions" ^ + "\nNormalisation warnings:"; + "--no-check-strange", Arg.Clear Flags.check_strange, " disable strange code check" ; + "--no-check-complex-expressions", Arg.Clear Flags.check_complex_expressions, " disable complex expressions check" ; + "--no-check-normalized-expressions", Arg.Clear Flags.normalized_expressions, " don't warn about non normalized expressions" ; + "--no-help-perl-checker", Arg.Clear Flags.check_help_perl_checker, " beware, perl_checker doesn't understand all perl expressions, so those warnings *are* important" ^ + "\nCommon warnings:"; + "--no-check-void", Arg.Clear Flags.check_void, " disable dropped value check" ; + "--no-check-names", Arg.Clear Flags.check_names, " disable variable & function usage check" ; + "--no-check-prototypes", Arg.Clear Flags.check_prototypes, " disable prototypes check" ; + "--no-check-import-export", Arg.Clear Flags.check_import_export, " disable inter modules check" ^ + "\nImportant warnings:"; + "--no-check-context", Arg.Clear Flags.check_context, " disable context check" ; + "--no-check-traps", Arg.Clear Flags.check_traps, " disable traps (errors) check" ^ + "\n"; + + ] in + let usage = "Usage: perl_checker [] \nOptions are:" in + Arg.parse options (lpush args_r) usage; + + let files = if !args_r = [] && Build.debugging then ["../t.pl"] else !args_r in + let files = List.map Info.file_to_absolute_file files in + + let required_packages, per_files = collect_withenv (parse_file true None) (default_per_files()) files in + let required_packages = uniq_ (fun (a,_) (b,_) -> a = b) required_packages in + + if !Flags.generate_pot then Parser_helper.generate_pot !pot_file else ( + + let per_files, required_packages = + fluid_let Flags.quiet (!restrict_to_files || !Flags.quiet) + (fun () -> + parse_required_packages per_files [] required_packages) in + let l_required_packages = List.map fst required_packages in + + write_packages_cache per_files !basedir ; + + (* removing non needed files from per_files (those files come from the cache) *) + List.iter (fun k -> + let per_file = Hashtbl.find per_files k in + if per_file.require_name <> None && not (List.mem (some per_file.require_name) l_required_packages) && not (List.mem per_file.file_name files) then + Hashtbl.remove per_files k + ) (hashtbl_keys per_files); + + let state = default_state per_files in + + Hashtbl.iter (fun _ per_file -> List.iter (add_package_to_state state) per_file.packages) per_files ; + + let state = + let global_vars_declared = Hashtbl.create 16 in + let package_name_to_file_name = hashtbl_collect (fun _ per_file -> List.map (fun pkg -> pkg.package_name, per_file.file_name) per_file.packages) per_files in + Hashtbl.iter (fun _ pkg -> + let file_name = List.assoc pkg.package_name package_name_to_file_name in + fluid_let Flags.quiet (!restrict_to_files || !Flags.quiet) + (fun () -> get_vars_declaration global_vars_declared file_name pkg) + ) state.per_packages ; + arrange_global_vars_declared global_vars_declared state + in + + let state = Global_checks.get_methods_available state in + + let l = hashtbl_values per_files in + let l = if !restrict_to_files then List.filter (fun file -> List.mem file.file_name files) l else l in + + let l = uniq (collect (fun file -> List.map (fun pkg -> pkg.package_name) file.packages) l) in + let l = List.map (Hashtbl.find state.per_packages) l in + + (* HACK: skip ignored_packages. Some package may have appeared in ignored_packages due to the xs bootstrap hack *) + let l = List.filter (fun pkg -> not (List.mem pkg.package_name !Config_file.ignored_packages)) l in + + List.iter (Global_checks.check_tree state) l; + + if !Flags.check_unused_global_vars then List.iter Global_checks.check_unused_vars l; + + if !package_dependencies_graph_file <> "" then generate_package_dependencies_graph state !package_dependencies_graph_file + + ) diff --git a/src/perl_checker.mli b/src/perl_checker.mli new file mode 100644 index 0000000..8b13789 --- /dev/null +++ b/src/perl_checker.mli @@ -0,0 +1 @@ + diff --git a/src/print.ml b/src/print.ml new file mode 100644 index 0000000..e69de29 diff --git a/src/print.mli b/src/print.mli new file mode 100644 index 0000000..8b13789 --- /dev/null +++ b/src/print.mli @@ -0,0 +1 @@ + diff --git a/src/test/.cvsignore b/src/test/.cvsignore new file mode 100644 index 0000000..9f6633c --- /dev/null +++ b/src/test/.cvsignore @@ -0,0 +1,2 @@ +.pl +.perl_checker.cache diff --git a/src/test/Makefile b/src/test/Makefile new file mode 100644 index 0000000..abe816c --- /dev/null +++ b/src/test/Makefile @@ -0,0 +1,3 @@ + +test: + for i in *.t; do ./test_it $$i || exit 1; done diff --git a/src/test/context.t b/src/test/context.t new file mode 100644 index 0000000..081abcc --- /dev/null +++ b/src/test/context.t @@ -0,0 +1,41 @@ +foreach (%h) {} context hash is not compatible with context list + foreach with a hash is usually an error + +map { 'xxx' } %h a hash is not a valid parameter to function map + +$xxx = ('yyy', 'zzz') context tuple(string, string) is not compatible with context scalar + +@l ||= 'xxx' "||=" is only useful with a scalar + +length @l never use "length @l", it returns the length of the string int(@l) + +%h . 'yyy' context hash is not compatible with context string + +'xxx' > 'yyy' context string is not compatible with context float + context string is not compatible with context float + + +1 cmp 2 you should use a number operator, not the string operator "cmp" (or replace the number with a string) + +$xxx == undef context undef is not compatible with context float + +my ($xxx) = 1 context int is not compatible with context tuple(scalar) + +($xxx, $yyy) = 1 context int is not compatible with context tuple(scalar, scalar) + +($xxx, $yyy) = (1, 2, 3) context tuple(int, int, int) is not compatible with context tuple(scalar, scalar) + +@l eq '3' context array is not compatible with context string + +qw(a b) > 2 context tuple(string, string) is not compatible with context float + +%h > 0 context hash is not compatible with context float + +%h eq 0 context hash is not compatible with context string + you should use a number operator, not the string operator "eq" (or replace the number with a string) + +@l == () + +$xxx = { xxx() }->{xxx}; + +$xxx = { xxx() }->{$xxx}; diff --git a/src/test/force_layout.t b/src/test/force_layout.t new file mode 100644 index 0000000..bb5494e --- /dev/null +++ b/src/test/force_layout.t @@ -0,0 +1,23 @@ +sub xxx you should not have a carriage-return (\n) here +{} + +xxx you should not have a carriage-return (\n) here + ($xxx); + +xxx( $xxx) you should not have a space here + +$xxx ++ you should not have a space here + +my($_xxx, $_yyy) you should have a space here + +xxx ($xxx) you should not have a space here + +'foo'.'bar' you should have a space here + +if ($xxx) { missing ";" + xxx() +} + +if ($xxx) { unneeded ";" + xxx(); +}; diff --git a/src/test/method.t b/src/test/method.t new file mode 100644 index 0000000..e59e858 --- /dev/null +++ b/src/test/method.t @@ -0,0 +1,11 @@ +bad->yyy unknown package bad + +pkg->bad unknown method bad starting in package pkg + +$xxx->bad unknown method bad + +$xxx->m1 not enough parameters + +$xxx->m0('zzz') too many parameters + +$xxx->m0_or_2('zzz') not enough or too many parameters diff --git a/src/test/prototype.t b/src/test/prototype.t new file mode 100644 index 0000000..6e56aae --- /dev/null +++ b/src/test/prototype.t @@ -0,0 +1,23 @@ + +sub xxx { 'yyy' } if the function doesn't take any parameters, please use the empty prototype. + example "sub foo() { ... }" + +sub xxx { an non-optional argument must not follow an optional argument + my ($o_xxx, $yyy) = @_; + ($o_xxx, $yyy); +} + +sub xxx { an array must be the last variable in a prototype + my (@xxx, $yyy) = @_; + @xxx, $yyy; +} + +bad() unknown function bad + +sub f0() {} too many parameters +f0('yyy') + +sub f2 { my ($x, $_y) = @_; $x } not enough parameters +f2('yyy') + +N("xxx %s yyy") not enough parameters diff --git a/src/test/read_t.pm b/src/test/read_t.pm new file mode 100644 index 0000000..a07c041 --- /dev/null +++ b/src/test/read_t.pm @@ -0,0 +1,28 @@ +package read_t; + +use lib '../..'; +use MDK::Common; + +sub read_t { + my ($file) = @_; + + my @tests; + my ($column_width, $line_number, @lines, @logs); + foreach (cat_($file), "\n") { + if (/^$/) { + push @tests, { line_number => $line_number, lines => [ @lines ], logs => [ @logs ] } if @lines; + @lines = @logs = (); + } else { + $column_width ||= length(first(/(.{20}\s+)/)); + my ($line, $log) = $column_width > 25 && /(.{$column_width})(.*)/ ? (chomp_($1) . "\n", $2) : ($_, ''); + $line =~ s/[ \t]*$//; + push @lines, $line; + push @logs, $log; + } + $line_number++; + } + @tests; +} + +1; + diff --git a/src/test/return_value.t b/src/test/return_value.t new file mode 100644 index 0000000..b4786f5 --- /dev/null +++ b/src/test/return_value.t @@ -0,0 +1,23 @@ +if ($xxx or $yyy) {} value should be dropped + context () is not compatible with context bool + +if ($xxx and $yyy) {} value should be dropped + context () is not compatible with context bool + +$xxx && yyy(); value is dropped + +`xxx`; value is dropped + +/(.*)/; value is dropped + +'xxx'; value is dropped + +'xxx' if $xxx; value is dropped + +map { xxx($_) } @l; if you don't use the return value, use "foreach" instead of "map" + +$xxx = chomp; () context not accepted here + context () is not compatible with context scalar + +$xxx = push @l, 1 () context not accepted here + context () is not compatible with context scalar diff --git a/src/test/suggest_better.t b/src/test/suggest_better.t new file mode 100644 index 0000000..d76abeb --- /dev/null +++ b/src/test/suggest_better.t @@ -0,0 +1,112 @@ +@{$xxx} @{$xxx} can be written @$xxx + +$h{"yyy"} {"yyy"} can be written {yyy} + +"$xxx" $xxx is better written without the double quotes + +$xxx->{yyy}->{zzz} the arrow "->" is unneeded + +"xxx\$xxx" you can replace "xxx\$xxx" with 'xxx$xxx', that way you don't need to escape <$> + +"xxx\$xxx" you can replace "xxx\$xxx" with 'xxx$xxx', that way you don't need to escape <$> + +"xxx\"$xxx" you can replace "xxx\"xxx" with qq(xxx"xxx), that way you don't need to escape <"> + +/xxx\'xxx/ you can replace \' with ' + +/xxx\;xxx/ you can replace \; with ; + +/\// change the delimit character / to get rid of this escape + +{ nop(); } spurious ";" before closing block + ++1 don't use unary + + +return ($xxx) unneeded parentheses + +if (($xxx eq $yyy) || $zzz) {} unneeded parentheses + +if (($xxx =~ /yyy/) || $zzz) {} unneeded parentheses + +nop() foreach ($xxx, $yyy); unneeded parentheses + +($xxx) ||= 'xxx' remove the parentheses + +$o->m0() remove these unneeded parentheses + +$o = xxx() if !$o; "$foo = ... if !$foo" can be written "$foo ||= ..." + +$o = xxx() unless $o; "$foo = ... unless $foo" can be written "$foo ||= ..." + +$o or $o = xxx(); "$foo or $foo = ..." can be written "$foo ||= ..." + +$_ =~ s/xxx/yyy/ "$_ =~ s/regexp/.../" can be written "s/regexp/.../" + +$xxx =~ /^yyy$/ "... =~ /^yyy$/" is better written "... eq 'yyy'" + +/xxx.*/ you can remove ".*" at the end of your regexp + +/xxx.*$/ you can remove ".*$" at the end of your regexp + +/[^\s]/ you can replace [^\s] with \S + +/[^\w]/ you can replace [^\w] with \W + +$xxx ? $xxx : $yyy you can replace "$foo ? $foo : $bar" with "$foo || $bar" + +my @l = (); no need to initialize variables, it's done by default + +$l[$#l] you can replace $#l with -1 + +$#l == 0 $#x == 0 is better written @x == 1 + +$#l == -1 $#x == -1 is better written @x == 0 + +$#l < 0 change your expression to use @xxx instead of $#xxx + +$l[@l] = 1 "$a[@a] = ..." is better written "push @a, ..." + +xxx(@_) replace xxx(@_) with &xxx + +member($xxx, keys %h) you can replace "member($xxx, keys %yyy)" with "exists $yyy{$xxx}" + +!($xxx =~ /.../) !($var =~ /.../) is better written $var !~ /.../ + +!($xxx == 1) !($foo == $bar) is better written $foo != $bar + +!($xxx eq 'foo') !($foo eq $bar) is better written $foo ne $bar + +grep { !member($_, qw(a b c)) } @l you can replace "grep { !member($_, ...) } @l" with "difference2([ @l ], [ ... ])" + +any { $_ eq 'foo' } @l you can replace "any { $_ eq ... } @l" with "member(..., @l)" + +foreach (@l) { use "push @l2, grep { ... } ..." instead of "foreach (...) { push @l2, $_ if ... }" + push @l2, $_ if yyy($_); or sometimes "@l2 = grep { ... } ..." +} + +foreach (@l) { use "push @l2, map { ... } ..." instead of "foreach (...) { push @l2, ... }" + push @l2, yyy($_); or sometimes "@l2 = map { ... } ..." +} + +foreach (@l) { use "push @l2, map { ... ? ... : () } ..." instead of "foreach (...) { push @l2, ... if ... }" + push @l2, yyy($_) if zzz($_); or sometimes "@l2 = map { ... ? ... : () } ..." +} or sometimes "@l2 = map { if_(..., ...) } ..." + +foreach (@l) { use "$xxx = find { ... } ..." + if (xxx($_)) { + $xxx = $_; + last; + } +} + +if (grep { xxx() } @l) {} in boolean context, use "any" instead of "grep" + +$xxx = grep { xxx() } @l; you may use "find" instead of "grep" + +$xxx ? $yyy : () you may use if_() here + beware that the short-circuit semantic of ?: is not kept + if you want to keep the short-circuit behaviour, replace () with @{[]} and there will be no warning anymore + +system(qq(foo "$xxx")) instead of quoting parameters you should give a list of arguments + +system("mkdir", $xxx) you can replace system("mkdir ...") with mkdir(...) diff --git a/src/test/syntax_restrictions.t b/src/test/syntax_restrictions.t new file mode 100644 index 0000000..de7bf77 --- /dev/null +++ b/src/test/syntax_restrictions.t @@ -0,0 +1,70 @@ +$xxx <<= 2 don't use "<<=", use the expanded version instead + +m@xxx@ don't use m@...@, replace @ with / ! , or | + +s:xxx:yyy: don't use s:...:, replace : with / ! , or | + +qw/a b c/ don't use qw/.../, use qw(...) instead + +qw{a b c} don't use qw{...}, use qw(...) instead + +q{xxx} don't use q{...}, use q(...) instead + +qq{xxx} don't use qq{...}, use qq(...) instead + +qx(xxx) don't use qx(...), use `...` instead + +-xxx don't use -xxx, use '-xxx' instead + +not $xxx don't use "not", use "!" instead + +$1 =~ /xxx/ do not use the result of a match (eg: $1) to match another pattern + +$xxx =~ "yyy" use a regexp, not a string + +xxx() =~ s/xxx/yyy/ you can only use s/// on a variable + +$1 =~ /xxx/ do not use the result of a match (eg: $1) to match another pattern + +grep /xxx/, @l always use "grep" with a block (eg: grep { ... } @list) + +for (@l) {} write "foreach" instead of "for" + +foreach ($xxx = 0; $xxx < 9; $xxx++) {} write "for" instead of "foreach" + +foreach $xxx (@l) {} don't use for without "my"ing the iteration variable + +foreach ($xxx) {} you are using the special trick to locally set $_ with a value, for this please use "for" instead of "foreach" + +unless ($xxx) {} else {} don't use "else" with "unless" (replace "unless" with "if") + +unless ($xxx) {} elsif ($yyy) {} don't use "elsif" with "unless" (replace "unless" with "if") + +zzz() unless $xxx || $yyy; don't use "unless" when the condition is complex, use "if" instead + +$$xxx{yyy} for complex dereferencing, use "->" + +wantarray please use wantarray() instead of wantarray + +eval please use "eval $_" instead of "eval" + +local *F; open F, "foo"; use a scalar instead of a bareword (eg: occurrences of F with $F) + +$xxx !~ s/xxx/yyy/ use =~ instead of !~ and negate the return value + +pkg::nop $xxx; use parentheses around argument (otherwise it might cause syntax errors if the package is "require"d and not "use"d + +new foo $xxx you must parenthesize parameters: "new Class(...)" instead of "new Class ..." + +*xxx = *yyy "*xxx = *yyy" is better written "*xxx = \&yyy" + +$_xxx = 1 variable $_xxx must not be used + (variable with name _XXX are reserved for unused variables) + +sub f2 { my ($x, $_y) = @_; $x } not enough parameters +f2(@l); # ok +f2(xxx()); # bad + +$xxx = <<"EOF"; Don't use <<"MARK", use < [ qw(f f0) ], +); +our @EXPORT_OK = qw(f); +EOF + +my $header = <<'EOF'; +package pkg; +use lib "../.."; +sub new {} +sub m0 { my ($_o) = @_; 0 } +sub m1 { my ($_o, $a) = @_; $a } +sub m2 { my ($_o, $_a, $b) = @_; $b } +sub m0_or_2 { my ($_o, $_a, $b) = @_; $b } +package pkg2; +sub new {} +sub m0_or_2 { my ($_o) = @_; 0 } + +package my_pkg; +sub nop {} +sub xxx { @_ } +sub yyy { @_ } +sub zzz { @_ } +sub pkg::nop {} +sub N { $_[0] } +sub N_ { $_[0] } +my ($xxx, $yyy, $zzz, $o, @l, @l2, %h); +xxx($xxx, $yyy, $zzz, $o, @l, @l2, %h); +use MDK::Common; + +EOF + +my $oo_header = <<'EOF'; +EOF + +my $local = <<'EOF'; +{ + local $_; +EOF + +my $local_trailer = <<'EOF'; + + xxx($xxx, $yyy, $zzz, $o, @l, @l2, %h); +} +EOF + +my $new; +foreach my $test (@tests) { + my @l = @{$test->{lines}}; + + pop @l while $l[-1] =~ /^\s*$/; + if (@l == 1) { + if ($l[-1] !~ /(;|[\s{]\})\s*$/) { + $l[-1] =~ s/^(.*?)(\s*$)/xxx($1);$2/; + } else { + # no comma for: + # - prefix for/foreach/... + # - already a comma + # - a block { ... } + my $no_comma = $l[-1] =~ /(^\s*(for|foreach|if|unless|while|sub)\s)|(;\s+$)|(^{.*}\s*$)/; + my $opt_comma = $no_comma ? '' : ';'; + $l[-1] =~ s/(\s+$)/$opt_comma nop();$1/; + } + } + if (! any { /^(sub|use) / } @l) { + @l = ($local, @l, $local_trailer); + } + if (any { /->\w/ } @l) { + @l = ($oo_header, $header, @l); + } else { + @l = ($header, @l); + } + output('.pl', @l); + my @raw_log = `../perl_checker .pl`; + die "@raw_log in .pl ($file):\n" . join('', @{$test->{lines}}) if any { /^syntax error$/ } @raw_log; + + my $f; + my @log = grep { + if (/^File "(.*)", line /) { + $f = $1; + 0; + } else { + $f eq '.pl'; + } + } @raw_log; + + foreach my $i (0 .. max(int @{$test->{lines}}, int @log) - 1) { + my $s = $test->{lines}[$i]; + $s =~ s/\s+$//; + $new .= sprintf "%-40s %s", $s, $log[$i] || "\n"; + } + $new .= "\n"; +} +output("$file.new", $new); +if (system('diff', '-buB', $file, "$file.new") == 0) { + unlink "$file.new", '.pl', 'pkg3.pm'; + exit 0; +} else { + warn "*" x 80, "\nnot same\n"; + exit 1; +} diff --git a/src/test/various_errors.t b/src/test/various_errors.t new file mode 100644 index 0000000..48a8ece --- /dev/null +++ b/src/test/various_errors.t @@ -0,0 +1,61 @@ +local $xxx ||= $yyy applying ||= on a new initialized variable is wrong + +$1 =~ s/xxx/yyy/ do not modify the result of a match (eg: $1) + +$xxx[1, 2] you must give only one argument + +$xxx[] you must give one argument + +my $_x = 'xxx' if $xxx; replace "my $foo = ... if " with "my $foo = && ..." + +$xxx or my $_x = 'xxx'; replace " or my $foo = ..." with "my $foo = ! && ..." + +'' || 'xxx' || ... is the same as ... + +if ($xxx = '') {} are you sure you did not mean "==" instead of "="? + +N("xxx$yyy") don't use interpolated translated string, use %s or %d instead + +if ($xxx && $yyy = xxx()) {} invalid lvalue + +1 + 2 >> 3 missing parentheses (needed for clarity) + +$xxx ? $yyy = 1 : $zzz = 2; missing parentheses (needed for clarity) + invalid lvalue + +N_("xxx") . 'yyy' N_("xxx") . "yyy" is dumb since the string "xxx" will never get translated + +join(@l) first argument of join() must be a scalar + +join(',', 'foo') join('...', $foo) is the same as $foo + +if_($xxx) not enough parameters + +push @l you must give some arguments to push + +push $xxx, 1 push is expecting an array + +pop $xxx pop is expecting an array and nothing else + +my (@l2, $xxx) = @l; @l2 takes all the arguments, $xxx is undef in any case + +$bad undeclared variable $bad + +{ my $a } unused variable $a + +my $xxx; yyy($xxx); my $xxx; redeclared variable $xxx + +{ my $xxx; $xxx = 1 } variable $xxx assigned, but not read + +$a undeclared variable $a + +use bad; can't find package bad + +use pkg3 ':bad'; package pkg3 doesn't export tag :bad +bad(); unknown function bad + +use pkg3 ':missing_fs'; name &f is not defined in package pkg3 +f(); name &f0 is not defined in package pkg3 + +use pkg3 'f'; name &f is not defined in package pkg3 +f(); diff --git a/src/tree.ml b/src/tree.ml new file mode 100644 index 0000000..16fd0e4 --- /dev/null +++ b/src/tree.ml @@ -0,0 +1,443 @@ +open Types +open Common +open Printf +open Config_file +open Parser_helper + +type special_export = Re_export_all | Fake_export_all + +type exports = { + export_ok : (context * string) list ; + export_auto : (context * string) list ; + export_tags : (string * (context * string) list) list ; + special_export : special_export option ; + } + +type uses = (string * ((context * string) list option * pos)) list + +type prototype = { + proto_nb_min : int ; + proto_nb_max : int option ; + } + +type variable_used = Access_none | Access_write_only | Access_various + +type per_package = { + package_name : string ; has_package_name : bool ; + vars_declared : (context * string, pos * variable_used ref * prototype option) Hashtbl.t; + imported : ((context * string) * (string * variable_used ref * prototype option)) list option ref; + exports : exports ; + uses : uses ; + required_packages : (string * pos) list ; + body : fromparser list; + isa : (string * pos) list option ; + } + +type per_file = { + file_name : string ; + require_name : string option ; + lines_starts : int list ; + build_time : float ; + packages : per_package list ; + from_basedir : bool ; + } + +let anonymous_package_count = ref 0 +let empty_exports = { export_ok = []; export_auto = []; export_tags = []; special_export = None } +let use_lib = ref (List.map Info.file_to_absolute_file (readlines (Unix.open_process_in "perl -le 'print foreach @INC'"))) + +let ignore_package pkg = + if !Flags.verbose then print_endline_flush ("ignoring package " ^ pkg); + lpush ignored_packages pkg + +let die_with_pos pos msg = failwith (Info.pos2sfull pos ^ msg) +let warn_with_pos warn_types pos msg = if Flags.are_warning_types_set warn_types then print_endline_flush (Info.pos2sfull pos ^ msg) + +let s2context s = + match s.[0] with + | '$' -> I_scalar, skip_n_char 1 s + | '%' -> I_hash , skip_n_char 1 s + | '@' -> I_array , skip_n_char 1 s + | '&' -> I_func , skip_n_char 1 s + | '*' -> I_star , skip_n_char 1 s + | _ -> I_raw, s + + +let get_current_package t = + match t with + | Package(Ident _ as ident) :: body -> + let rec bundled_packages packages current_package found_body = function + | [] -> List.rev ((Some current_package, List.rev found_body) :: packages) + | Package(Ident _ as ident) :: body -> + let packages = (Some current_package, List.rev found_body) :: packages in + bundled_packages packages (string_of_fromparser ident) [] body + | instr :: body -> + bundled_packages packages current_package (instr :: found_body) body + in + bundled_packages [] (string_of_fromparser ident) [] body + | _ -> + if str_ends_with !Info.current_file ".pm" then warn_with_pos [Warn_normalized_expressions] (!Info.current_file, 0, 0) (sprintf "module %s does not have \"package xxxx;\" on its first line" (Info.absolute_file_to_file !Info.current_file)) ; + [ None, t ] + +let from_qw_raw = function + | String([s, List []], pos) -> [ s, pos ] + | String(_, pos) -> + warn_with_pos [] pos "not recognised yet" ; + [] + | Raw_string(s, pos) -> + [ s, pos ] + | List [] -> [] + | List [ List l ] -> + some_or (l_option2option_l (List.map (function + | String([s, List []], pos) + | Raw_string(s, pos) -> Some(s, pos) + | Ident(_, _, pos) as ident -> Some(string_of_fromparser ident, pos) + | e -> warn_with_pos [] (get_pos_from_expr e) "not recognised yet"; None + ) l)) [] + | e -> warn_with_pos [] (get_pos_from_expr e) "not recognised yet"; [] + +let from_qw e = + List.map (fun (s, pos) -> + let context, s' = s2context s in + let context = + match context with + | I_raw -> if s'.[0] = ':' then I_raw else I_func + | I_func -> warn_with_pos [Warn_import_export] pos "weird, exported name with a function context especially given"; I_func + | _ -> context + in context, s' + ) (from_qw_raw e) + +let get_exported t = + List.fold_left (fun exports e -> + match e with + | List [ Call_op("=", [ Deref(I_array, Ident(None, "EXPORT", _)); Call _ ], pos) ] + | List [ Call_op("=", [ My_our("our", [(I_array, "EXPORT")], _); Call _ ], pos) ] -> + if exports.special_export = None then warn_with_pos [Warn_import_export] pos "unrecognised @EXPORT" ; + exports + + | List [ Call_op("=", [ Deref(I_array, Ident(None, "EXPORT", _)); v ], pos)] + | List [ Call_op("=", [ My_our("our", [(I_array, "EXPORT")], _); v ], pos)] -> + if exports.export_auto <> [] then warn_with_pos [Warn_import_export] pos "weird, @EXPORT set twice" ; + { exports with export_auto = from_qw v } + + | Perl_checker_comment("RE-EXPORT-ALL", _) -> { exports with special_export = Some Re_export_all } + | Perl_checker_comment("EXPORT-ALL", _) -> { exports with special_export = Some Fake_export_all } + + | List [ Call_op("=", [ Deref(I_array, Ident(None, "EXPORT_OK", _)); v ], pos)] + | List [ Call_op("=", [ My_our("our", [(I_array, "EXPORT_OK")], _); v ], pos)] -> + if exports.export_ok <> [] then warn_with_pos [Warn_import_export] pos "weird, @EXPORT_OK set twice" ; + (match v with + | Call(Deref(I_func, Ident(None, "map", _)), + [ Anonymous_sub(_, Block [List [Deref(I_array, Deref(I_scalar, Ident (None, "_", _)))]], _); + Call(Deref(I_func, Ident(None, "values", _)), [ Deref(I_hash, Ident(None, "EXPORT_TAGS", _))])]) -> + { exports with export_ok = collect snd exports.export_tags } + | _ -> { exports with export_ok = from_qw v }) + + | List [ Call_op("=", [ Deref(I_hash, Ident(None, "EXPORT_TAGS", _)); v ], pos)] + | List [ Call_op("=", [ My_our("our", [(I_hash, "EXPORT_TAGS")], _); v ], pos)] -> + (try + let export_tags = + match v with + | List [ List l ] -> + List.map (function + | Raw_string(tag, _), Ref(I_array, List [List [v]]) -> + let para = + match v with + | Deref(I_array, Ident(None, "EXPORT_OK", _)) -> exports.export_ok + | _ -> from_qw v + in + ":" ^ tag, para + | _ -> raise Not_found + ) (group_by_2 l) + | _ -> raise Not_found + in + if exports.export_tags <> [] then warn_with_pos [Warn_import_export] pos "weird, %EXPORT_TAGS set twice" ; + { exports with export_tags = export_tags } + with _ -> + warn_with_pos [Warn_import_export] pos "unrecognised %EXPORT_TAGS" ; + exports) + + (* $EXPORT_TAGS{all} = [ map { @$_ } values %EXPORT_TAGS ]; *) + | List [Call_op("=", [ + Deref_with(I_hash, I_scalar, Ident(None, "EXPORT_TAGS", _), Raw_string("all", _)); + Ref(I_array, + List[List[ + Call(Deref(I_func, Ident(None, "map", _)), + [Anonymous_sub(_, Block [List [Deref(I_array, Deref(I_scalar, Ident(None, "_", _)))]], _); + Call(Deref(I_func, Ident(None, "values", _)), [Deref(I_hash, Ident(None, "EXPORT_TAGS", _))])]) + ]]) + ], _)] -> + { exports with export_tags = (":all", collect snd exports.export_tags) :: exports.export_tags } + + | List (My_our _ :: _) -> + let _,_ = e,e in + exports + | _ -> exports + ) empty_exports t + +let uses_external_package = function + | "vars" | "Exporter" | "diagnostics" | "strict" | "warnings" | "lib" | "POSIX" | "Gtk" | "Storable" + | "Config" | "Socket" | "IO::Socket" | "DynaLoader" | "Data::Dumper" | "Time::localtime" | "Expect" -> true + | _ -> false + +let get_uses t = + List.fold_left (fun uses e -> + match e with + | Use(Ident(None, "lib", _), [libs]) -> + use_lib := List.map Info.file_to_absolute_file (List.map snd (from_qw libs)) @ !use_lib ; + uses + | Use(Ident(None, "base", _), classes) -> + let l = List.map (fun (pkg, pos) -> (pkg, (None, pos))) (collect from_qw_raw classes) in + l @ uses + | Use(Ident(_, _, pos) as pkg, l) -> + let package = string_of_fromparser pkg in + if uses_external_package package then + uses + else + let para = match l with + | [] -> None + | [ Num(_, _) ] -> None (* don't care about the version number *) + | _ -> Some(collect from_qw l) + in + (package, (para, pos)) :: uses + | _ -> uses + ) [] t + +let get_isa t = + List.fold_left (fun (isa, exporter) e -> + match e with + | Use(Ident(None, "base", pos), classes) -> + if isa <> None || exporter <> None then die_with_pos pos "\"use base\" and \"@ISA\" must be used once only"; + Some (collect from_qw_raw classes), None + | List [ Call_op("=", [ Deref(I_array, Ident(None, "ISA", pos)) ; classes ], _) ] + | List [ Call_op("=", [ My_our("our", [ I_array, "ISA" ], pos) ; classes ], _) ] -> + if isa <> None || exporter <> None then die_with_pos pos "\"use base\" and \"@ISA\" must be used once only"; + let special, l = List.partition (fun (s, _) -> s = "DynaLoader" || s = "Exporter") (from_qw_raw classes) in + let exporter = if List.mem_assoc "Exporter" special then Some pos else None in + let isa = if l = [] && special <> [] then None else Some l in + isa, exporter + | _ -> isa, exporter + ) (None, None) t + +let read_xs_extension_from_c global_vars_declared file_name package pos = + try + let cfile = Filename.chop_extension file_name ^ ".c" in + let prefix = "newXS(\"" ^ package.package_name ^ "::" in + ignore (fold_lines (fun in_bootstrap s -> + if in_bootstrap then + (try + let offset = strstr s prefix + String.length prefix in + let end_ = String.index_from s offset '"' in + let ident = String.sub s offset (end_ - offset) in + match split_name_or_fq_name ident with + | None, ident -> Hashtbl.replace package.vars_declared (I_func, ident) (pos, ref Access_none, None) + | Some fq, ident -> + let fq = package.package_name ^ "::" ^ fq in + Hashtbl.replace global_vars_declared (I_func, fq, ident) (pos, None) + with Not_found -> ()); + in_bootstrap || str_contains s "XS_VERSION_BOOTCHECK" + ) false (open_in cfile)); + if !Flags.verbose then print_endline_flush (sprintf "using xs symbols from %s" cfile) ; + true + with Invalid_argument _ | Sys_error _ -> false + +let findfile dirs f = List.find (fun dir -> Sys.file_exists (dir ^ "/" ^ f)) dirs + +let read_xs_extension_from_so global_vars_declared package pos = + try + let splitted = split_at2 ':'':' package.package_name in + let rel_file = String.concat "/" ("auto" :: splitted @ [ last splitted ]) ^ ".so" in + let so = (findfile !use_lib rel_file) ^ "/" ^ rel_file in + let channel = Unix.open_process_in (Printf.sprintf "nm --defined-only -D \"%s\"" so) in + if !Flags.verbose then print_endline_flush (sprintf "using shared-object symbols from %s" so) ; + fold_lines (fun () s -> + let s = skip_n_char 11 s in + if str_begins_with "XS_" s then + let s = skip_n_char 3 s in + let len = String.length s in + let rec find_package_name accu i = + try + let i' = String.index_from s i '_' in + let accu = String.sub s i (i'-i) :: accu in + if i' + 1 < len && s.[i'+1] = '_' then + find_package_name accu (i' + 2) + else + List.rev accu, skip_n_char (i'+1) s + with Not_found -> List.rev accu, skip_n_char i s + in + let fq, name = find_package_name [] 0 in + Hashtbl.replace global_vars_declared (I_func, String.concat "::" fq, name) (pos, None) + ) () channel; + if not Build.debugging then ignore (Unix.close_process_in channel) ; + true + with Not_found -> false + +let has_proto perl_proto body = + match perl_proto with + | Some "" -> Some([], raw_pos2pos bpos, [body]) + | _ -> + match body with + | Block [] -> + Some([ I_array, "_empty" ], raw_pos2pos bpos, []) + | Block (List [Call_op ("=", [My_our ("my", mys, mys_pos); Deref(I_array, Ident(None, "_", _))], _pos)] :: body) -> + Some(mys, mys_pos, body) + | _ -> None + +let get_proto perl_proto body = + map_option (fun (mys, pos, _) -> + let scalars, others = break_at (fun (context, _) -> context <> I_scalar) mys in + (match others with + | (I_array, _) :: _ :: _ -> warn_with_pos [Warn_prototypes] pos "an array must be the last variable in a prototype" + | (I_hash, _) :: _ :: _ -> warn_with_pos [Warn_prototypes] pos "an hash must be the last variable in a prototype" + | _ -> ()); + let is_optional (_, s) = + String.length s > 2 && (s.[0] = 'o' || s.[0] = 'b') && s.[1] = '_' || + String.length s > 3 && s.[0] = '_' && (s.[1] = 'o' || s.[1] = 'b') && s.[2] = '_' + in + let must_have, optional = break_at is_optional scalars in + if not (List.for_all is_optional optional) then + warn_with_pos [Warn_prototypes] pos "an non-optional argument must not follow an optional argument"; + let min = List.length must_have in + { proto_nb_min = min; proto_nb_max = if others = [] then Some(min + List.length optional) else None } + ) (has_proto perl_proto body) + +let get_vars_declaration global_vars_declared file_name package = + List.iter (function + | Sub_declaration(Ident(None, name, pos), perl_proto, body, _) -> + Hashtbl.replace package.vars_declared (I_func, name) (pos, ref Access_none, get_proto perl_proto body) + | Sub_declaration(Ident(Some fq, name, pos), perl_proto, body, _) -> + Hashtbl.replace global_vars_declared (I_func, fq, name) (pos, get_proto perl_proto body) + + | List [ Call_op("=", [My_our("our", ours, pos); _], _) ] + | List [ Call_op("=", [My_our("local", ([ I_scalar, "_" ] as ours), pos); _], _) ] + | List [ My_our("our", ours, pos) ] + | My_our("our", ours, pos) -> + List.iter (fun (context, name) -> Hashtbl.replace package.vars_declared (context, name) (pos, ref Access_none, None)) ours + + | Use(Ident(None, "vars", pos), [ours]) -> + List.iter (fun (context, name) -> Hashtbl.replace package.vars_declared (context, name) (pos, ref Access_none, None)) (from_qw ours) + | Use(Ident(None, "vars", pos), _) -> + die_with_pos pos "usage: use vars qw($var func)" + + | List [ Method_call(Raw_string(pkg, pos), Raw_string("bootstrap", _), _) ] -> + if pkg <> package.package_name then + warn_with_pos [Warn_import_export] pos "strange bootstrap (the package name is not the same as the current package)" + else + if not (read_xs_extension_from_c global_vars_declared file_name package pos) then + if not (read_xs_extension_from_so global_vars_declared package pos) then + ignore_package pkg + | _ -> () + ) package.body + +let rec fold_tree f env e = + match f env e with + | Some env -> env + | None -> + match e with + | Anonymous_sub(_, e', _) + | Ref(_, e') + | Deref(_, e') + -> fold_tree f env e' + + | Diamond(e') + -> fold_tree_option f env e' + + | String(l, _) + -> List.fold_left (fun env (_, e) -> fold_tree f env e) env l + + | Sub_declaration(e1, _, e2, _) + | Deref_with(_, _, e1, e2) + -> + let env = fold_tree f env e1 in + let env = fold_tree f env e2 in + env + + | Use(_, l) + | List l + | Block l + | Call_op(_, l, _) + -> List.fold_left (fold_tree f) env l + + | Call(e', l) + -> + let env = fold_tree f env e' in + List.fold_left (fold_tree f) env l + + | Method_call(e1, e2, l) + -> + let env = fold_tree f env e1 in + let env = fold_tree f env e2 in + List.fold_left (fold_tree f) env l + + | _ -> env + +and fold_tree_option f env = function + | None -> env + | Some e -> fold_tree f env e + + +let get_global_info_from_package from_basedir require_name build_time t = + let current_packages = get_current_package t in + let packages = List.map (fun (current_package, t) -> + let exports = get_exported t in + let exporting_something() = exports.export_ok <> [] || exports.export_auto <> [] || exports.export_tags <> [] || exports.special_export = Some Re_export_all in + + let package_name = + match current_package with + | None -> + if exporting_something() then + die_with_pos (!Info.current_file, 0, 0) "file with no package name wants to export!" + else + (incr anonymous_package_count ; sprintf "anonymous%d" !anonymous_package_count) + | Some name -> name + in + let isa, exporter = get_isa t in + (match exporter with + | None -> + if exporting_something() then warn_with_pos [Warn_import_export] (!Info.current_file, 0, 0) "you must have \"@ISA = qw(Exporter)\" to EXPORT something" + | Some pos -> + if not (exporting_something()) then warn_with_pos [Warn_import_export] pos "Inheritating from Exporter without EXPORTing anything"); + + let uses = List.rev (get_uses t) in + let required_packages = List.map (fun (s, (_, pos)) -> s, pos) uses in + let required_packages = List.fold_left (fold_tree (fun l -> + function + | Perl_checker_comment(s, pos) when str_begins_with "require " s -> + Some((skip_n_char 8 s, pos) :: l) + | Call(Deref(I_func, Ident (None, "require", pos)), [Ident _ as pkg]) -> + let package = string_of_fromparser pkg in + if uses_external_package package then None else Some((package, pos) :: l) + | Call(Deref(I_func, Ident (None, "require", pos)), [Raw_string(pkg, _)]) + when not (String.contains pkg '/') && Filename.check_suffix pkg ".pm" -> + let package = Filename.chop_suffix pkg ".pm" in + if uses_external_package package then None else Some((package, pos) :: l) + | _ -> None) + ) required_packages t in + { + package_name = package_name; + has_package_name = current_package <> None ; + exports = exports ; + imported = ref None ; + vars_declared = Hashtbl.create 16 ; + uses = uses ; + required_packages = required_packages ; + body = t ; + isa = isa ; + } + ) current_packages in + + let require_name = match require_name with + | Some require_name -> Some require_name + | None -> match packages with + | [ pkg ] when pkg.has_package_name -> Some pkg.package_name + | _ -> None + in + { + file_name = !Info.current_file ; + require_name = require_name ; + lines_starts = !Info.current_file_lines_starts ; + build_time = build_time ; + packages = packages ; + from_basedir = from_basedir ; + } + diff --git a/src/tree.mli b/src/tree.mli new file mode 100644 index 0000000..3cdf219 --- /dev/null +++ b/src/tree.mli @@ -0,0 +1,57 @@ +open Types + +type special_export = Re_export_all | Fake_export_all + +type exports = { + export_ok : (context * string) list; + export_auto : (context * string) list; + export_tags : (string * (context * string) list) list; + special_export : special_export option; +} + + +type uses = (string * ((context * string) list option * pos)) list + +type prototype = { + proto_nb_min : int ; + proto_nb_max : int option ; + } + +type variable_used = Access_none | Access_write_only | Access_various + +type per_package = { + package_name : string ; has_package_name : bool ; + vars_declared : (context * string, pos * variable_used ref * prototype option) Hashtbl.t; + imported : ((context * string) * (string * variable_used ref * prototype option)) list option ref; + exports : exports ; + uses : uses ; + required_packages : (string * pos) list ; + body : fromparser list; + isa : (string * pos) list option ; + } + +type per_file = { + file_name : string ; + require_name : string option ; + lines_starts : int list ; + build_time : float ; + packages : per_package list ; + from_basedir : bool ; + } + +val empty_exports : exports +val ignore_package : string -> unit +val use_lib : string list ref +val uses_external_package : string -> bool +val findfile : string list -> string -> string + +val get_global_info_from_package : bool -> string option -> float -> fromparser list -> per_file + +val has_proto : string option -> fromparser -> ((context * string) list * pos * fromparser list) option +val get_vars_declaration : (context * string * string, pos * prototype option) Hashtbl.t -> string -> per_package -> unit + +val die_with_pos : string * int * int -> string -> 'a +val warn_with_pos : Types.warning list -> string * int * int -> string -> unit + +val fold_tree : ('a -> fromparser -> 'a option) -> 'a -> fromparser -> 'a +val from_qw : fromparser -> (context * string) list diff --git a/src/types.mli b/src/types.mli new file mode 100644 index 0000000..5f23d3a --- /dev/null +++ b/src/types.mli @@ -0,0 +1,125 @@ +exception TooMuchRParen + +type raw_pos = int * int + +type pos = string * int * int + +type spaces = + | Space_0 + | Space_1 + | Space_n + | Space_cr + | Space_none + +type context = I_scalar | I_hash | I_array | I_func | I_raw | I_star + +type maybe_context = + | M_none + + (* scalars *) + | M_bool | M_int | M_float + | M_revision + | M_string + | M_ref of maybe_context + | M_undef + | M_unknown_scalar + + | M_tuple of maybe_context list + | M_list + | M_array + | M_hash + | M_sub + + | M_special + | M_unknown + | M_mixed of maybe_context list + +type sub_declaration_kind = Real_sub_declaration | Glob_assign + +type fromparser = + | Undef + | Ident of string option * string * pos + | Num of string * pos + | Raw_string of string * pos + | String of (string * fromparser) list * pos + + | Ref of context * fromparser + | Deref of context * fromparser + | Deref_with of context * context * fromparser * fromparser (* from_context, to_context, ref, para *) + + | Diamond of fromparser option + + | List of fromparser list + | Block of fromparser list + + | Call_op of string * fromparser list * pos + | Call of fromparser * fromparser list + | Method_call of fromparser * fromparser * fromparser list + + | Anonymous_sub of string option * fromparser * pos (* prototype, expr, pos *) + | My_our of string * (context * string) list * pos + | Use of fromparser * fromparser list + | Sub_declaration of fromparser * string option * fromparser * sub_declaration_kind (* name, prototype, body, kind *) + | Package of fromparser + | Label of string + | Perl_checker_comment of string * pos + + | Too_complex + | Semi_colon + +type priority = +| P_tok +| P_tight +| P_mul +| P_add +| P_uniop +| P_cmp +| P_eq +| P_expr +| P_bit +| P_tight_and +| P_tight_or +| P_ternary +| P_assign +| P_comma +| P_call_no_paren +| P_and +| P_or +| P_loose + +| P_paren_wanted of priority +| P_paren of priority + +| P_none + +type 'a any_spaces_pos = { + any : 'a ; + spaces : spaces ; + pos : int * int ; + mcontext : maybe_context ; + } + +type 'a prio_anyexpr = { + priority : priority ; + expr : 'a + } + +type prio_expr_spaces_pos = fromparser prio_anyexpr any_spaces_pos +type prio_lexpr_spaces_pos = fromparser list prio_anyexpr any_spaces_pos + +type warning = + | Warn_white_space + | Warn_suggest_simpler + | Warn_unused_global_vars + | Warn_void + | Warn_context + | Warn_strange + | Warn_traps + | Warn_complex_expressions + | Warn_normalized_expressions + | Warn_suggest_functional + | Warn_prototypes + | Warn_import_export + | Warn_names + | Warn_MDK_Common + | Warn_help_perl_checker -- cgit v1.2.1