summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--Makefile62
-rw-r--r--NEWS18
-rw-r--r--TODO39
-rw-r--r--fake_packages/Curses/UI.pm77
-rw-r--r--fake_packages/Glib.pm49
-rw-r--r--fake_packages/Gnome2.pm4
-rw-r--r--fake_packages/Gnome2/Vte.pm15
-rw-r--r--fake_packages/Gtk2.pm359
-rw-r--r--fake_packages/Gtk2/Html2.pm35
-rw-r--r--fake_packages/Gtk2/NotificationBubble.pm9
-rw-r--r--fake_packages/MDV/Distribconf.pm16
-rw-r--r--fake_packages/URPM/Resolve.pm17
-rw-r--r--fake_packages/urpm.pm9
-rw-r--r--perl_checker.spec318
-rw-r--r--src/Makefile4
-rw-r--r--src/config_file.ml4
-rw-r--r--src/global_checks.ml6
-rw-r--r--src/lexer.mll5
-rw-r--r--src/parser.mly6
-rw-r--r--src/parser_helper.ml97
-rw-r--r--src/parser_helper.mli10
-rw-r--r--src/perl_checker.html.pl112
-rw-r--r--src/test/return_value.t8
-rw-r--r--src/test/suggest_better.t2
-rw-r--r--src/test/various_errors.t4
-rw-r--r--src/tree.ml19
-rw-r--r--src/types.mli2
27 files changed, 852 insertions, 454 deletions
diff --git a/Makefile b/Makefile
index fb060b6..4fb4879 100644
--- a/Makefile
+++ b/Makefile
@@ -2,68 +2,42 @@ RPM ?= $(HOME)/rpm
PREFIX = /usr
BINDIR = $(PREFIX)/bin
-VENDORLIB = $(shell eval "`perl -V:installvendorlib`"; echo $$installvendorlib)
-INSTALLVENDORLIB = $(DESTDIR)$(VENDORLIB)
+DATADIR = $(PREFIX)/share
+fake_packages_dir = $(DATADIR)/perl_checker/fake_packages
PERL_CHECKER_TARGET = native-code
-PERL_CHECKER_VERSION = 1.1.27
+PERL_CHECKER_VERSION = 1.2.4
-FILES-perl_checker = AUTHORS COPYING README.emacs Makefile misc perl_checker.spec perl_checker.src perl_checker_fake_packages
+FILES-perl_checker = AUTHORS COPYING README.emacs Makefile misc src fake_packages
-.PHONY: perl_checker.src
+.PHONY: src
-all: perl_checker.src/perl_checker test
+all: src/perl_checker test
-MDK/Common.pm: %: %.pl
- perl $< > $@
+src/perl_checker:
+ $(MAKE) -C src build_ml perl_checker.html $(PERL_CHECKER_TARGET) fake_packages_dir=$(fake_packages_dir) DEBUG=0
-perl_checker.src/perl_checker:
- $(MAKE) -C perl_checker.src build_ml perl_checker.html $(PERL_CHECKER_TARGET) VENDORLIB=$(VENDORLIB) DEBUG=0
-
-test: perl_checker.src/perl_checker
- $(MAKE) -C perl_checker.src/test
+test: src/perl_checker
+ $(MAKE) -C src/test
clean:
- rm -f Makefile-MDK-Common MDK/Common.pm perl_checker.src/perl_checker *.tar.* .perl_checker.cache lib
- $(MAKE) -C perl_checker.src clean
+ rm -f src/perl_checker *.tar.* .perl_checker.cache lib
+ $(MAKE) -C src clean
find -name "*~" | xargs rm -rf
install: clean all
$(MAKE) -C misc install
- install perl_checker.src/perl_checker $(DESTDIR)$(BINDIR)
- install -d $(INSTALLVENDORLIB)
- tar c `find perl_checker_fake_packages -name "*.pm"` | tar xC $(INSTALLVENDORLIB)
+ install src/perl_checker $(DESTDIR)$(BINDIR)
+ install -d $(DESTDIR)$(fake_packages_dir)
+ cd fake_packages ; tar c `find . -name "*.pm"` | tar xC $(DESTDIR)$(fake_packages_dir)
update:
- cvs update
+ svn update
commit:
- cvs commit
+ svn commit
tar: clean
mkdir -p perl_checker-$(PERL_CHECKER_VERSION)
- tar c --exclude CVS $(FILES-perl_checker) | tar xC perl_checker-$(PERL_CHECKER_VERSION)
+ tar c --exclude "GNUmakefile*" --exclude .svn $(FILES-perl_checker) | tar xC perl_checker-$(PERL_CHECKER_VERSION)
tar cfj perl_checker-$(PERL_CHECKER_VERSION).tar.bz2 perl_checker-$(PERL_CHECKER_VERSION)
rm -rf perl_checker-$(PERL_CHECKER_VERSION)
-
-srpm: tar
- cp -f perl_checker*.tar.* $(RPM)/SOURCES
- cat perl_checker.spec > $(RPM)/SPECS/perl_checker.spec
- -rpmbuild -bs $(RPM)/SPECS/perl_checker.spec
-
-rpm: update srpm
- -rpmbuild -bb $(RPM)/SPECS/perl_checker.spec
-
-
-Makefile-MDK-Common:
- MAKEFILE_NAME=Makefile-MDK-Common perl Makefile.PL
-
-tar-MDK-Common: clean Makefile-MDK-Common
- $(MAKE) -f Makefile-MDK-Common dist
-
-srpm-MDK-Common: tar-MDK-Common
- cp -f MDK-Common*.tar.* $(RPM)/SOURCES
- perl -I. -MMDK::Common -pe 's/THEVERSION/$$MDK::Common::VERSION/' perl-MDK-Common.spec > $(RPM)/SPECS/perl-MDK-Common.spec
- -rpmbuild -bs $(RPM)/SPECS/perl-MDK-Common.spec
-
-rpm-MDK-Common: srpm-MDK-Common
- -rpmbuild -bb $(RPM)/SPECS/perl-MDK-Common.spec
diff --git a/NEWS b/NEWS
new file mode 100644
index 0000000..84a913f
--- /dev/null
+++ b/NEWS
@@ -0,0 +1,18 @@
+Version 1.2.4 - 21 December 2006, by Pascal "Pixel" Rigaux
+
+- handle P(...) for plurals (similar to N(...))
+
+Version 1.2.3 - 4 December 2006, by Pascal "Pixel" Rigaux
+
+- fake_packages:
+ o add MDV::Distribconf methods used by urpm.pm
+ o add Gtk2::Html2 (for mcc)
+ o add a fake module for Gtk2::NotificationBubble so that network tools
+ can be checked
+ o update Gnome2::Vte
+- fix some warnings:
+ o don't suggest replacing "\l" with "l"
+ o fix warning for "\"x'"
+ o handle -z and -t (per titi request)
+ o handle "use base 'Exporter'"
+ o no warnings on: !our $foo
diff --git a/TODO b/TODO
new file mode 100644
index 0000000..8cb08d2
--- /dev/null
+++ b/TODO
@@ -0,0 +1,39 @@
+- $short_entries[$#entries] = $1;
+
+- sort { values %{$list->[$a]} <=> values %{$list->[$b]} }
+- ($p->is_arch_compat < min map { $_->is_arch_compat } @chosen) ? 10 : 0;
+
+- (-e "$urpm->{cachedir}/partial/$basename" && -s _ > 32)
+
+- join('-', ($p->fullname)[0..2])
+
+- $l[1..$#l]
+
+- { sub f {} } f();
+
+- package foo; ... foo::f()
+
+- my $pid = chomp_(`pidof -x net_applet`) and kill 1, $pid;
+
+- unless ($z = "") {}
+
+- vec($mask, $Offsets{'all'}, 1) = 3
+
+- don't use .perl_checker.cache when .perl_checker changed
+
+- bad slice $l{@l} instead of @l{@l}
+
+- last inside a do { ... } until
+
+- map {; "$_.$ext" => 1 } @l
+ suggest map { ("$_.$ext" => 1) } @l
+ instead of saying unneeded ";"
+
+- @l = (@l, foo());
+- @l = (foo(), @l);
+
+- $value =~ s!1!$self->getvalue!ge;
+
+- http://perlcritic.com/pod/Perl/Critic/Policy/ControlStructures/ProhibitUnreachableCode.html
+ die ''; print "FOO\n";
+ exit ; print "FOO\n";
diff --git a/fake_packages/Curses/UI.pm b/fake_packages/Curses/UI.pm
new file mode 100644
index 0000000..d9530a3
--- /dev/null
+++ b/fake_packages/Curses/UI.pm
@@ -0,0 +1,77 @@
+package Curses::UI;
+
+our @ISA = qw();
+
+sub new { my ($_class, %_userargs) = @_ }
+sub leave_curses { my ($_this) = @_ }
+sub mainloop { my ($_this) = @_ }
+sub modalfocus { my ($_this) = @_ }
+sub nostatus { my ($_this) = @_ }
+sub reset_curses { my ($_this) = @_ }
+
+
+package Curses::UI::Widget;
+
+our @ISA = qw();
+
+sub draw { my ($_this, $_b_no_doupdate) = @_ }
+sub focus { my ($_this) = @_ }
+sub focusable { my ($_this, $_b_focusable) = @_ }
+sub intellidraw { my ($_this) = @_ }
+sub set_binding { my ($_this, $_routine, $_key, @_other_keys) = @_ }
+
+
+package Curses::UI::Listbox;
+
+our @ISA = qw(Curses::UI::Widget);
+
+sub id { my ($_this) = @_ }
+sub get { my ($_this) = @_ }
+sub get_active_id { my ($_this) = @_ }
+sub set_active_id { my ($_this, $_id) = @_ }
+sub set_selection { my ($_this, $_id) = @_ }
+
+
+package Curses::UI::TextEditor;
+
+our @ISA = qw(Curses::UI::Widget);
+
+sub get { my ($_this) = @_ }
+sub text { my ($_this, $_o_text) = @_ }
+
+
+package Curses::UI::Buttonbox;
+
+our @ISA = qw(Curses::UI::Widget);
+
+sub get { my ($_this) = @_ }
+sub set_label { my ($_this, $_id, $_text) = @_ }
+
+
+package Curses::UI::Container;
+
+our @ISA = qw(Curses::UI::Widget);
+
+sub add { my ($_this, $_name, $_type, %_para) = @_ }
+sub delete_object { my ($_this, $_object) = @_ }
+sub focus { my ($_this, $_focus_to, $_b_forced, $_b_direction) = @_ }
+
+
+package Curses::UI::Window;
+
+our @ISA = qw(Curses::UI::Container);
+
+
+package Curses::UI::Dialog::Progress;
+
+our @ISA = qw(Curses::UI::Window);
+
+sub pos { my ($_this, $_pos) = @_ }
+sub message { my ($_this, $_msg) = @_ }
+
+
+
+package Curses;
+
+sub KEY_LEFT() {}
+sub KEY_RIGHT() {}
diff --git a/fake_packages/Glib.pm b/fake_packages/Glib.pm
index 8f465ad..fc7edcc 100644
--- a/fake_packages/Glib.pm
+++ b/fake_packages/Glib.pm
@@ -36,6 +36,48 @@ sub remove_exception_handler { my ($_class, $_tag) = @_ }
sub set_application_name { my ($_application_name) = @_ }
sub warning { my ($_class, $_domain, $_message) = @_ }
+package Glib::BookmarkFile;
+our @ISA = qw();
+sub DESTROY { my ($_bookmark_file) = @_ }
+sub add_application { my ($_bookmark_file, $_uri, $_name, $_exec) = @_ }
+sub add_group { my ($_bookmark_file, $_uri, $_group) = @_ }
+sub get_added { my ($_bookmark_file, $_uri) = @_ }
+sub get_app_info { my ($_bookmark_file, $_uri, $_name) = @_ }
+sub get_applications { my ($_bookmark_file, $_uri) = @_ }
+sub get_description { my ($_bookmark_file, $_uri) = @_ }
+sub get_groups { my ($_bookmark_file, $_uri) = @_ }
+sub get_icon { my ($_bookmark_file, $_uri) = @_ }
+sub get_is_private { my ($_bookmark_file, $_uri) = @_ }
+sub get_mime_type { my ($_bookmark_file, $_uri) = @_ }
+sub get_modified { my ($_bookmark_file, $_uri) = @_ }
+sub get_size { my ($_bookmark_file) = @_ }
+sub get_title { my ($_bookmark_file, $_uri) = @_ }
+sub get_uris { my ($_bookmark_file) = @_ }
+sub get_visited { my ($_bookmark_file, $_uri) = @_ }
+sub has_application { my ($_bookmark_file, $_uri, $_name) = @_ }
+sub has_group { my ($_bookmark_file, $_uri, $_group) = @_ }
+sub has_item { my ($_bookmark_file, $_uri) = @_ }
+sub load_from_data { my ($_bookmark_file, $_buf) = @_ }
+sub load_from_data_dirs { my ($_bookmark_file, $_file) = @_ }
+sub load_from_file { my ($_bookmark_file, $_file) = @_ }
+sub move_item { my ($_bookmark_file, $_old_uri, $_new_uri) = @_ }
+sub new { my ($_class) = @_ }
+sub remove_application { my ($_bookmark_file, $_uri, $_name) = @_ }
+sub remove_group { my ($_bookmark_file, $_uri, $_group) = @_ }
+sub remove_item { my ($_bookmark_file, $_uri) = @_ }
+sub set_added { my ($_bookmark_file, $_uri, $_value) = @_ }
+sub set_app_info { my ($_bookmark_file, $_uri, $_name, $_exec, $_count, $_stamp) = @_ }
+sub set_description { my ($_bookmark_file, $_uri, $_description) = @_ }
+sub set_groups { my ($_bookmark_file, $_uri, @_more_paras) = @_ }
+sub set_icon { my ($_bookmark_file, $_uri, $_href, $_mime_type) = @_ }
+sub set_is_private { my ($_bookmark_file, $_uri, $_is_private) = @_ }
+sub set_mime_type { my ($_bookmark_file, $_uri, $_mime_type) = @_ }
+sub set_modified { my ($_bookmark_file, $_uri, $_value) = @_ }
+sub set_title { my ($_bookmark_file, $_uri, $_title) = @_ }
+sub set_visited { my ($_bookmark_file, $_uri, $_value) = @_ }
+sub to_data { my ($_bookmark_file) = @_ }
+sub to_file { my ($_bookmark_file, $_file) = @_ }
+
package Glib::Boxed;
our @ISA = qw();
sub DESTROY { my ($_sv) = @_ }
@@ -79,6 +121,8 @@ 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_double { my ($_key_file, $_group_name, $_key) = @_ }
+sub get_double_list { my ($_key_file, $_group_name, $_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) = @_ }
@@ -101,6 +145,8 @@ 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_double { my ($_key_file, $_group_name, $_key, $_value) = @_ }
+sub set_double_list { my ($_key_file, $_group_name, $_key, @_more_paras) = @_ }
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) = @_ }
@@ -143,12 +189,13 @@ package Glib::Object;
our @ISA = qw();
sub CLONE { my ($_class) = @_ }
sub DESTROY { my ($_sv) = @_ }
+sub find_property { my ($_object_or_class_name, @_more_paras) = @_ }
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 list_properties { my ($_object_or_class_name, @_more_paras) = @_ }
sub new { my ($_class, @_more_paras) = @_ }
sub new_from_pointer { my ($_class, $_pointer, $_o_noinc) = @_ }
sub notify { my ($_object, $_property_name) = @_ }
diff --git a/fake_packages/Gnome2.pm b/fake_packages/Gnome2.pm
index 7c6f6bf..7e5e8ac 100644
--- a/fake_packages/Gnome2.pm
+++ b/fake_packages/Gnome2.pm
@@ -62,6 +62,7 @@ sub set_status { my ($_appbar, $_status) = @_ }
package Gnome2::AuthenticationManager;
our @ISA = qw();
+sub dialog_is_visible { my ($_class) = @_ }
sub init { my ($_class) = @_ }
package Gnome2::Bonobo;
@@ -379,6 +380,7 @@ 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_all { my ($_gil) = @_ }
sub select_icon { my ($_gil, $_pos) = @_ }
sub set_col_spacing { my ($_gil, $_pixels) = @_ }
sub set_hadjustment { my ($_gil, $_hadj) = @_ }
@@ -447,6 +449,7 @@ sub version { my ($_module_info) = @_ }
package Gnome2::PasswordDialog;
our @ISA = qw();
+sub anon_selected { my ($_password_dialog) = @_ }
sub get_domain { my ($_password_dialog) = @_ }
sub get_password { my ($_password_dialog) = @_ }
sub get_remember { my ($_password_dialog) = @_ }
@@ -462,6 +465,7 @@ 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_show_userpass_buttons { my ($_password_dialog, $_show_userpass_buttons) = @_ }
sub set_username { my ($_password_dialog, $_username) = @_ }
package Gnome2::PixmapEntry;
diff --git a/fake_packages/Gnome2/Vte.pm b/fake_packages/Gnome2/Vte.pm
index 598c405..2874a9b 100644
--- a/fake_packages/Gnome2/Vte.pm
+++ b/fake_packages/Gnome2/Vte.pm
@@ -10,6 +10,7 @@ sub copy_clipboard { my ($_terminal) = @_ }
sub copy_primary { my ($_terminal) = @_ }
sub feed { my ($_terminal, $_data) = @_ }
sub feed_child { my ($_terminal, $_data) = @_ }
+sub feed_child_binary { 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) = @_ }
@@ -20,6 +21,7 @@ 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_default_emulation { my ($_terminal) = @_ }
sub get_emulation { my ($_terminal) = @_ }
sub get_encoding { my ($_terminal) = @_ }
sub get_font { my ($_terminal) = @_ }
@@ -29,7 +31,8 @@ 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 { my ($_terminal, $_o_func, $_o_data) = @_ }
+sub get_text_include_trailing_spaces { 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) = @_ }
@@ -40,6 +43,8 @@ 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 match_set_cursor { my ($_terminal, $_tag, $_cursor) = @_ }
+sub match_set_cursor_type { my ($_terminal, $_tag, $_cursor_type) = @_ }
sub new { my ($_class) = @_ }
sub paste_clipboard { my ($_terminal) = @_ }
sub paste_primary { my ($_terminal) = @_ }
@@ -49,12 +54,15 @@ 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_tint_color { my ($_terminal, $_color) = @_ }
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_cursor { my ($_terminal, $_cursor_background) = @_ }
sub set_color_dim { my ($_terminal, $_dim) = @_ }
sub set_color_foreground { my ($_terminal, $_foreground) = @_ }
+sub set_color_highlight { my ($_terminal, $_highlight_background) = @_ }
sub set_colors { my ($_terminal, $_foreground, $_background, $_palette_ref) = @_ }
sub set_cursor_blinks { my ($_terminal, $_blink) = @_ }
sub set_default_colors { my ($_terminal) = @_ }
@@ -63,7 +71,12 @@ 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_font_from_string_full { my ($_terminal, $_name, $_anti_alias) = @_ }
+sub set_font_full { my ($_terminal, $_font_desc, $_anti_alias) = @_ }
sub set_mouse_autohide { my ($_terminal, $_setting) = @_ }
+sub set_opacity { my ($_terminal, $_opacity) = @_ }
+sub set_pty { my ($_terminal, $_pty_master) = @_ }
+sub set_scroll_background { my ($_terminal, $_scroll) = @_ }
sub set_scroll_on_keystroke { my ($_terminal, $_scroll) = @_ }
sub set_scroll_on_output { my ($_terminal, $_scroll) = @_ }
sub set_scrollback_lines { my ($_terminal, $_lines) = @_ }
diff --git a/fake_packages/Gtk2.pm b/fake_packages/Gtk2.pm
index 6b25db6..4aaf7e5 100644
--- a/fake_packages/Gtk2.pm
+++ b/fake_packages/Gtk2.pm
@@ -46,6 +46,10 @@ 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) = @_ }
+sub targets_include_image { my ($_class, $_writable, $_first_target_atom, @_more_paras) = @_ }
+sub targets_include_rich_text { my ($_class, $_buffer, $_first_target_atom, @_more_paras) = @_ }
+sub targets_include_text { my ($_class, $_first_target_atom, @_more_paras) = @_ }
+sub targets_include_uri { my ($_class, $_first_target_atom, @_more_paras) = @_ }
package Gtk2::AboutDialog;
our @ISA = qw();
@@ -205,6 +209,31 @@ 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::Assistant;
+our @ISA = qw();
+sub add_action_widget { my ($_assistant, $_child) = @_ }
+sub append_page { my ($_assistant, $_page) = @_ }
+sub get_current_page { my ($_assistant) = @_ }
+sub get_n_pages { my ($_assistant) = @_ }
+sub get_nth_page { my ($_assistant, $_page_num) = @_ }
+sub get_page_complete { my ($_assistant, $_page) = @_ }
+sub get_page_header_image { my ($_assistant, $_page) = @_ }
+sub get_page_side_image { my ($_assistant, $_page) = @_ }
+sub get_page_title { my ($_assistant, $_page) = @_ }
+sub get_page_type { my ($_assistant, $_page) = @_ }
+sub insert_page { my ($_assistant, $_page, $_position) = @_ }
+sub new { my ($_class) = @_ }
+sub prepend_page { my ($_assistant, $_page) = @_ }
+sub remove_action_widget { my ($_assistant, $_child) = @_ }
+sub set_current_page { my ($_assistant, $_page_num) = @_ }
+sub set_forward_page_func { my ($_assistant, $_func, $_o_data) = @_ }
+sub set_page_complete { my ($_assistant, $_page, $_complete) = @_ }
+sub set_page_header_image { my ($_assistant, $_page, $_pixbuf) = @_ }
+sub set_page_side_image { my ($_assistant, $_page, $_pixbuf) = @_ }
+sub set_page_title { my ($_assistant, $_page, $_title) = @_ }
+sub set_page_type { my ($_assistant, $_page, $_type) = @_ }
+sub update_buttons_state { my ($_assistant) = @_ }
+
package Gtk2::Bin;
our @ISA = qw();
sub child { my ($_bin) = @_ }
@@ -231,6 +260,7 @@ sub enter { my ($_button) = @_ }
sub get_alignment { my ($_button) = @_ }
sub get_focus_on_click { my ($_button) = @_ }
sub get_image { my ($_button) = @_ }
+sub get_image_position { my ($_button) = @_ }
sub get_label { my ($_button) = @_ }
sub get_relief { my ($_button) = @_ }
sub get_use_stock { my ($_button) = @_ }
@@ -245,6 +275,7 @@ 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_image_position { my ($_button, $_position) = @_ }
sub set_label { my ($_button, $_label) = @_ }
sub set_relief { my ($_button, $_newstyle) = @_ }
sub set_use_stock { my ($_button, $_use_stock) = @_ }
@@ -316,6 +347,10 @@ 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::CellRendererAccel;
+our @ISA = qw();
+sub new { my ($_class) = @_ }
+
package Gtk2::CellRendererCombo;
our @ISA = qw();
sub new { my ($_class) = @_ }
@@ -328,6 +363,10 @@ package Gtk2::CellRendererProgress;
our @ISA = qw();
sub new { my ($_class) = @_ }
+package Gtk2::CellRendererSpin;
+our @ISA = qw();
+sub new { my ($_class) = @_ }
+
package Gtk2::CellRendererText;
our @ISA = qw();
sub new { my ($_class) = @_ }
@@ -383,6 +422,7 @@ 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_rich_text { my ($_clipboard, $_buffer, $_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) = @_ }
@@ -393,9 +433,11 @@ sub set_with_owner { my ($_clipboard, $_get_func, $_clear_func, $_owner, @_more_
sub store { my ($_clipboard) = @_ }
sub wait_for_contents { my ($_clipboard, $_target) = @_ }
sub wait_for_image { my ($_clipboard) = @_ }
+sub wait_for_rich_text { my ($_clipboard, $_buffer) = @_ }
sub wait_for_targets { my ($_clipboard) = @_ }
sub wait_for_text { my ($_clipboard) = @_ }
sub wait_is_image_available { my ($_clipboard) = @_ }
+sub wait_is_rich_text_available { my ($_clipboard, $_buffer) = @_ }
sub wait_is_target_available { my ($_clipboard, $_target) = @_ }
sub wait_is_text_available { my ($_clipboard) = @_ }
@@ -463,6 +505,7 @@ 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_title { my ($_combo_box) = @_ }
sub get_wrap_width { my ($_combo_box) = @_ }
sub insert_text { my ($_combo_box, $_position, $_text) = @_ }
sub new { my ($_class, $_o_model) = @_ }
@@ -480,6 +523,7 @@ 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_title { my ($_combo_box, $_title) = @_ }
sub set_wrap_width { my ($_combo_box, $_width) = @_ }
package Gtk2::ComboBoxEntry;
@@ -579,6 +623,7 @@ sub get_activates_default { my ($_entry) = @_ }
sub get_alignment { my ($_entry) = @_ }
sub get_completion { my ($_entry) = @_ }
sub get_has_frame { my ($_entry) = @_ }
+sub get_inner_border { my ($_entry) = @_ }
sub get_invisible_char { my ($_entry) = @_ }
sub get_layout { my ($_entry) = @_ }
sub get_layout_offsets { my ($_entry) = @_ }
@@ -596,6 +641,7 @@ 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_inner_border { my ($_entry, $_border) = @_ }
sub set_invisible_char { my ($_entry, $_ch) = @_ }
sub set_max_length { my ($_entry, $_max) = @_ }
sub set_position { my ($_entry, $_position) = @_ }
@@ -707,11 +753,13 @@ sub unselect_uri { my ($_chooser, $_uri) = @_ }
package Gtk2::FileChooserButton;
our @ISA = qw();
+sub get_focus_on_click { my ($_button) = @_ }
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_focus_on_click { my ($_button, $_focus_on_click) = @_ }
sub set_title { my ($_button, $_title) = @_ }
sub set_width_chars { my ($_button, $_n_chars) = @_ }
@@ -922,6 +970,7 @@ 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) = @_ }
+sub set_source_pixmap { my ($_cr, $_pixmap, $_pixmap_x, $_pixmap_y) = @_ }
package Gtk2::Gdk::Color;
our @ISA = qw();
@@ -1009,7 +1058,9 @@ 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_input_shapes { my ($_display) = @_ }
sub supports_selection_notification { my ($_display) = @_ }
+sub supports_shapes { my ($_display) = @_ }
sub sync { my ($_display) = @_ }
sub ungrab { my ($_display) = @_ }
sub warp_pointer { my ($_display, $_screen, $_x, $_y) = @_ }
@@ -1414,6 +1465,7 @@ 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 foreign_new_for_screen { my ($_class, $_screen, $_anid, $_width, $_height, $_depth) = @_ }
sub lookup { my ($_class, $_anid) = @_ }
sub lookup_for_display { my ($_class, $_display, $_anid) = @_ }
sub new { my ($_class, $_drawable, $_width, $_height, $_depth) = @_ }
@@ -1460,9 +1512,11 @@ sub set_verbose { my ($_class, $_verbose) = @_ }
package Gtk2::Gdk::Screen;
our @ISA = qw();
sub broadcast_client_message { my ($_screen, $_event) = @_ }
+sub get_active_window { my ($_screen) = @_ }
sub get_default { my ($_class) = @_ }
sub get_default_colormap { my ($_screen) = @_ }
sub get_display { my ($_screen) = @_ }
+sub get_font_options { my ($_screen) = @_ }
sub get_height { my ($_screen) = @_ }
sub get_height_mm { my ($_screen) = @_ }
sub get_monitor_at_point { my ($_screen, $_x, $_y) = @_ }
@@ -1470,6 +1524,7 @@ 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_resolution { my ($_screen) = @_ }
sub get_rgb_colormap { my ($_screen) = @_ }
sub get_rgb_visual { my ($_screen) = @_ }
sub get_rgba_colormap { my ($_screen) = @_ }
@@ -1483,9 +1538,13 @@ 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 get_window_stack { my ($_screen) = @_ }
+sub is_composited { my ($_screen) = @_ }
sub list_visuals { my ($_screen) = @_ }
sub make_display_name { my ($_screen) = @_ }
sub set_default_colormap { my ($_screen, $_colormap) = @_ }
+sub set_font_options { my ($_screen, $_options) = @_ }
+sub set_resolution { my ($_screen, $_dpi) = @_ }
sub supports_net_wm_hint { my ($_screen, $_property) = @_ }
package Gtk2::Gdk::Selection;
@@ -1566,11 +1625,14 @@ sub get_root_origin { my ($_window) = @_ }
sub get_state { my ($_window) = @_ }
sub get_toplevel { my ($_window) = @_ }
sub get_toplevels { my ($_class) = @_ }
+sub get_type_hint { my ($_window) = @_ }
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 input_shape_combine_mask { my ($_window, $_mask, $_x, $_y) = @_ }
+sub input_shape_combine_region { my ($_window, $_shape, $_offset_x, $_offset_y) = @_ }
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) = @_ }
@@ -1580,6 +1642,7 @@ sub lookup { my ($_class, $_anid) = @_ }
sub lookup_for_display { my ($_class, $_display, $_anid) = @_ }
sub lower { my ($_window) = @_ }
sub maximize { my ($_window) = @_ }
+sub merge_child_input_shapes { my ($_window) = @_ }
sub merge_child_shapes { my ($_window) = @_ }
sub move { my ($_window, $_x, $_y) = @_ }
sub move_region { my ($_window, $_region, $_dx, $_dy) = @_ }
@@ -1600,6 +1663,7 @@ 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_input_shapes { my ($_window) = @_ }
sub set_child_shapes { my ($_window) = @_ }
sub set_cursor { my ($_window, $_cursor) = @_ }
sub set_debug_updates { my ($_class_or_instance, $_enable) = @_ }
@@ -1910,6 +1974,7 @@ sub get_label { my ($_label) = @_ }
sub get_layout { my ($_label) = @_ }
sub get_layout_offsets { my ($_label) = @_ }
sub get_line_wrap { my ($_label) = @_ }
+sub get_line_wrap_mode { my ($_label) = @_ }
sub get_max_width_chars { my ($_label) = @_ }
sub get_mnemonic_keyval { my ($_label) = @_ }
sub get_mnemonic_widget { my ($_label) = @_ }
@@ -1929,6 +1994,7 @@ 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_line_wrap_mode { my ($_label, $_wrap_mode) = @_ }
sub set_markup { my ($_label, $_str) = @_ }
sub set_markup_with_mnemonic { my ($_label, $_str) = @_ }
sub set_max_width_chars { my ($_label, $_n_chars) = @_ }
@@ -1956,6 +2022,14 @@ sub set_size { my ($_layout, $_width, $_height) = @_ }
sub set_vadjustment { my ($_layout, $_adjustment) = @_ }
sub thaw { my ($_layout) = @_ }
+package Gtk2::LinkButton;
+our @ISA = qw();
+sub get_uri { my ($_link_button) = @_ }
+sub new { my ($_class, $_url, $_o_label) = @_ }
+sub new_with_label { my ($_class, $_url, $_o_label) = @_ }
+sub set_uri { my ($_link_button, $_uri) = @_ }
+sub set_uri_hook { my ($_class, $_func, $_o_data) = @_ }
+
package Gtk2::List;
our @ISA = qw();
sub append_items { my ($_list, @_more_paras) = @_ }
@@ -2087,6 +2161,7 @@ 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_image { my ($_dialog, $_image) = @_ }
sub set_markup { my ($_message_dialog, $_str) = @_ }
package Gtk2::Misc;
@@ -2101,6 +2176,7 @@ 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_group_id { my ($_notebook) = @_ }
sub get_menu_label { my ($_notebook, $_child) = @_ }
sub get_menu_label_text { my ($_notebook, $_child) = @_ }
sub get_n_pages { my ($_notebook) = @_ }
@@ -2108,9 +2184,11 @@ 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_detachable { my ($_notebook, $_child) = @_ }
sub get_tab_label { my ($_notebook, $_child) = @_ }
sub get_tab_label_text { my ($_notebook, $_child) = @_ }
sub get_tab_pos { my ($_notebook) = @_ }
+sub get_tab_reorderable { my ($_notebook, $_child) = @_ }
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) = @_ }
@@ -2125,18 +2203,22 @@ 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_group_id { my ($_notebook, $_group_id) = @_ }
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_detachable { my ($_notebook, $_child, $_detachable) = @_ }
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_reorderable { my ($_notebook, $_child, $_reorderable) = @_ }
sub set_tab_vborder { my ($_notebook, $_tab_vborder) = @_ }
+sub set_window_creation_hook { my ($_class, $_func, $_o_data) = @_ }
package Gtk2::Object;
our @ISA = qw();
@@ -2152,6 +2234,27 @@ sub remove_menu { my ($_option_menu) = @_ }
sub set_history { my ($_option_menu, $_index) = @_ }
sub set_menu { my ($_option_menu, $_menu) = @_ }
+package Gtk2::PageSetup;
+our @ISA = qw();
+sub get_bottom_margin { my ($_setup, $_unit) = @_ }
+sub get_left_margin { my ($_setup, $_unit) = @_ }
+sub get_orientation { my ($_setup) = @_ }
+sub get_page_height { my ($_setup, $_unit) = @_ }
+sub get_page_width { my ($_setup, $_unit) = @_ }
+sub get_paper_height { my ($_setup, $_unit) = @_ }
+sub get_paper_size { my ($_setup) = @_ }
+sub get_paper_width { my ($_setup, $_unit) = @_ }
+sub get_right_margin { my ($_setup, $_unit) = @_ }
+sub get_top_margin { my ($_setup, $_unit) = @_ }
+sub new { my ($_class) = @_ }
+sub set_bottom_margin { my ($_setup, $_margin, $_unit) = @_ }
+sub set_left_margin { my ($_setup, $_margin, $_unit) = @_ }
+sub set_orientation { my ($_setup, $_orientation) = @_ }
+sub set_paper_size { my ($_setup, $_size) = @_ }
+sub set_paper_size_and_default_margins { my ($_setup, $_size) = @_ }
+sub set_right_margin { my ($_setup, $_margin, $_unit) = @_ }
+sub set_top_margin { my ($_setup, $_margin, $_unit) = @_ }
+
package Gtk2::Paned;
our @ISA = qw();
sub add1 { my ($_paned, $_child) = @_ }
@@ -2190,8 +2293,10 @@ sub scale_xx_small { my ($_class) = @_ }
package Gtk2::Pango::Cairo;
our @ISA = qw();
sub create_layout { my ($_cr) = @_ }
+sub error_underline_path { my ($_cr, $_x, $_y, $_width, $_height) = @_ }
sub glyph_string_path { my ($_cr, $_font, $_glyphs) = @_ }
sub layout_path { my ($_cr, $_layout) = @_ }
+sub show_error_underline { my ($_cr, $_x, $_y, $_width, $_height) = @_ }
sub show_glyph_string { my ($_cr, $_font, $_glyphs) = @_ }
sub show_layout { my ($_cr, $_layout) = @_ }
sub update_context { my ($_cr, $_context) = @_ }
@@ -2231,6 +2336,8 @@ sub set_matrix { my ($_context, $_matrix) = @_ }
package Gtk2::Pango::Font;
our @ISA = qw();
sub describe { my ($_font) = @_ }
+sub describe_with_absolute_size { my ($_font) = @_ }
+sub get_font_map { my ($_font) = @_ }
sub get_glyph_extents { my ($_font, $_glyph) = @_ }
sub get_metrics { my ($_font, $_language) = @_ }
@@ -2416,6 +2523,25 @@ sub new_with_positions { my ($_class, $_initial_size, $_positions_in_pixels, @_m
sub resize { my ($_tab_array, $_new_size) = @_ }
sub set_tab { my ($_tab_array, $_tab_index, $_alignment, $_location) = @_ }
+package Gtk2::PaperSize;
+our @ISA = qw();
+sub get_default { my ($_class) = @_ }
+sub get_default_bottom_margin { my ($_size, $_unit) = @_ }
+sub get_default_left_margin { my ($_size, $_unit) = @_ }
+sub get_default_right_margin { my ($_size, $_unit) = @_ }
+sub get_default_top_margin { my ($_size, $_unit) = @_ }
+sub get_display_name { my ($_size) = @_ }
+sub get_height { my ($_size, $_unit) = @_ }
+sub get_name { my ($_size) = @_ }
+sub get_ppd_name { my ($_size) = @_ }
+sub get_width { my ($_size, $_unit) = @_ }
+sub is_custom { my ($_size) = @_ }
+sub is_equal { my ($_size1, $_size2) = @_ }
+sub new { my ($_class, $_name) = @_ }
+sub new_custom { my ($_class, $_name, $_display_name, $_width, $_height, $_unit) = @_ }
+sub new_from_ppd { my ($_class, $_ppd_name, $_ppd_display_name, $_width, $_height) = @_ }
+sub set_size { my ($_size, $_width, $_height, $_unit) = @_ }
+
package Gtk2::Plug;
our @ISA = qw();
sub construct { my ($_plug, $_socket_id) = @_ }
@@ -2424,6 +2550,63 @@ sub get_id { my ($_plug) = @_ }
sub new { my ($_class, $_socket_id) = @_ }
sub new_for_display { my ($_display, $_socket_id) = @_ }
+package Gtk2::Print;
+our @ISA = qw();
+sub run_page_setup_dialog { my ($_class, $_parent, $_page_setup, $_settings) = @_ }
+sub run_page_setup_dialog_async { my ($_class, $_parent, $_page_setup, $_settings, $_func, $_o_data) = @_ }
+
+package Gtk2::PrintContext;
+our @ISA = qw();
+sub create_pango_context { my ($_context) = @_ }
+sub create_pango_layout { my ($_context) = @_ }
+sub get_cairo_context { my ($_context) = @_ }
+sub get_dpi_x { my ($_context) = @_ }
+sub get_dpi_y { my ($_context) = @_ }
+sub get_height { my ($_context) = @_ }
+sub get_page_setup { my ($_context) = @_ }
+sub get_pango_fontmap { my ($_context) = @_ }
+sub get_width { my ($_context) = @_ }
+sub set_cairo_context { my ($_context, $_cr, $_dpi_x, $_dpi_y) = @_ }
+
+package Gtk2::PrintOperation;
+our @ISA = qw();
+sub cancel { my ($_op) = @_ }
+sub get_default_page_setup { my ($_op) = @_ }
+sub get_error { my ($_op) = @_ }
+sub get_print_settings { my ($_op) = @_ }
+sub get_status { my ($_op) = @_ }
+sub get_status_string { my ($_op) = @_ }
+sub is_finished { my ($_op) = @_ }
+sub new { my ($_class) = @_ }
+sub run { my ($_op, $_action, $_parent) = @_ }
+sub set_allow_async { my ($_op, $_allow_async) = @_ }
+sub set_current_page { my ($_op, $_current_page) = @_ }
+sub set_custom_tab_label { my ($_op, $_label) = @_ }
+sub set_default_page_setup { my ($_op, $_default_page_setup) = @_ }
+sub set_export_filename { my ($_op, $_filename) = @_ }
+sub set_job_name { my ($_op, $_job_name) = @_ }
+sub set_n_pages { my ($_op, $_n_pages) = @_ }
+sub set_print_settings { my ($_op, $_print_settings) = @_ }
+sub set_show_progress { my ($_op, $_show_progress) = @_ }
+sub set_track_print_status { my ($_op, $_track_status) = @_ }
+sub set_unit { my ($_op, $_unit) = @_ }
+sub set_use_full_page { my ($_op, $_full_page) = @_ }
+
+package Gtk2::PrintOperationPreview;
+our @ISA = qw();
+sub end_preview { my ($_preview) = @_ }
+sub is_selected { my ($_preview, $_page_nr) = @_ }
+sub render_page { my ($_preview, $_page_nr) = @_ }
+
+package Gtk2::PrintSettings;
+our @ISA = qw();
+sub Gtk2::PrintSettings::foreach { my ($_settings, $_func, $_o_data) = @_ }
+sub get { my ($_settings, $_key) = @_ }
+sub has_key { my ($_settings, $_key) = @_ }
+sub new { my ($_class) = @_ }
+sub set { my ($_settings, $_key, $_value) = @_ }
+sub unset { my ($_settings, $_key) = @_ }
+
package Gtk2::ProgressBar;
our @ISA = qw();
sub get_ellipsize { my ($_pbar) = @_ }
@@ -2443,6 +2626,7 @@ package Gtk2::RadioAction;
our @ISA = qw();
sub get_current_value { my ($_action) = @_ }
sub get_group { my ($_action) = @_ }
+sub set_current_value { my ($_action, $_value) = @_ }
sub set_group { my ($_action, $_member_or_listref) = @_ }
package Gtk2::RadioButton;
@@ -2480,13 +2664,17 @@ package Gtk2::Range;
our @ISA = qw();
sub get_adjustment { my ($_range) = @_ }
sub get_inverted { my ($_range) = @_ }
+sub get_lower_stepper_sensitivity { my ($_range) = @_ }
sub get_update_policy { my ($_range) = @_ }
+sub get_upper_stepper_sensitivity { 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_lower_stepper_sensitivity { my ($_range, $_sensitivity) = @_ }
sub set_range { my ($_range, $_min, $_max) = @_ }
sub set_update_policy { my ($_range, $_policy) = @_ }
+sub set_upper_stepper_sensitivity { my ($_range, $_sensitivity) = @_ }
sub set_value { my ($_range, $_value) = @_ }
package Gtk2::Rc;
@@ -2521,6 +2709,113 @@ sub text { my ($_style, $_state, $_o_new) = @_ }
sub xthickness { my ($_style, $_o_new) = @_ }
sub ythickness { my ($_style, $_o_new) = @_ }
+package Gtk2::RecentChooser;
+our @ISA = qw();
+sub add_filter { my ($_chooser, $_filter) = @_ }
+sub get_current_item { my ($_chooser) = @_ }
+sub get_current_uri { my ($_chooser) = @_ }
+sub get_filter { my ($_chooser) = @_ }
+sub get_items { my ($_chooser) = @_ }
+sub get_limit { my ($_chooser) = @_ }
+sub get_local_only { my ($_chooser) = @_ }
+sub get_select_multiple { my ($_chooser) = @_ }
+sub get_show_icons { my ($_chooser) = @_ }
+sub get_show_not_found { my ($_chooser) = @_ }
+sub get_show_private { my ($_chooser) = @_ }
+sub get_show_tips { my ($_chooser) = @_ }
+sub get_sort_type { my ($_chooser) = @_ }
+sub get_uris { my ($_chooser) = @_ }
+sub list_filters { my ($_chooser) = @_ }
+sub remove_filter { my ($_chooser, $_filter) = @_ }
+sub select_all { my ($_chooser) = @_ }
+sub select_uri { my ($_chooser, $_uri) = @_ }
+sub set_current_uri { my ($_chooser, $_uri) = @_ }
+sub set_filter { my ($_chooser, $_filter) = @_ }
+sub set_limit { my ($_chooser, $_limit) = @_ }
+sub set_local_only { my ($_chooser, $_local_only) = @_ }
+sub set_select_multiple { my ($_chooser, $_select_multiple) = @_ }
+sub set_show_icons { my ($_chooser, $_show_icons) = @_ }
+sub set_show_not_found { my ($_chooser, $_show_not_found) = @_ }
+sub set_show_private { my ($_chooser, $_show_private) = @_ }
+sub set_show_tips { my ($_chooser, $_show_tips) = @_ }
+sub set_sort_func { my ($_chooser, $_sort_func, $_o_sort_data) = @_ }
+sub set_sort_type { my ($_chooser, $_sort_type) = @_ }
+sub unselect_all { my ($_chooser) = @_ }
+sub unselect_uri { my ($_chooser, $_uri) = @_ }
+
+package Gtk2::RecentChooserDialog;
+our @ISA = qw();
+sub new { my ($_class, $_title, $_parent, @_more_paras) = @_ }
+sub new_for_manager { my ($_class, $_title, $_parent, @_more_paras) = @_ }
+
+package Gtk2::RecentChooserMenu;
+our @ISA = qw();
+sub get_show_numbers { my ($_menu) = @_ }
+sub new { my ($_class) = @_ }
+sub new_for_manager { my ($_class, $_manager) = @_ }
+sub set_show_numbers { my ($_menu, $_show_numbers) = @_ }
+
+package Gtk2::RecentChooserWidget;
+our @ISA = qw();
+sub new { my ($_class) = @_ }
+sub new_for_manager { my ($_class, $_manager) = @_ }
+
+package Gtk2::RecentFilter;
+our @ISA = qw();
+sub add_age { my ($_filter, $_days) = @_ }
+sub add_application { my ($_filter, $_application) = @_ }
+sub add_custom { my ($_filter, $_needed, $_func, $_o_data) = @_ }
+sub add_group { my ($_filter, $_group) = @_ }
+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::RecentInfo;
+our @ISA = qw();
+sub exists { my ($_info) = @_ }
+sub get_added { my ($_info) = @_ }
+sub get_age { my ($_info) = @_ }
+sub get_application_info { my ($_info, $_app_name) = @_ }
+sub get_applications { my ($_info) = @_ }
+sub get_description { my ($_info) = @_ }
+sub get_display_name { my ($_info) = @_ }
+sub get_groups { my ($_info) = @_ }
+sub get_icon { my ($_info, $_size) = @_ }
+sub get_mime_type { my ($_info) = @_ }
+sub get_modified { my ($_info) = @_ }
+sub get_private_hint { my ($_info) = @_ }
+sub get_short_name { my ($_info) = @_ }
+sub get_uri { my ($_info) = @_ }
+sub get_uri_display { my ($_info) = @_ }
+sub get_visited { my ($_info) = @_ }
+sub has_application { my ($_info, $_app_name) = @_ }
+sub has_group { my ($_info, $_group_name) = @_ }
+sub is_local { my ($_info) = @_ }
+sub last_application { my ($_info) = @_ }
+sub match { my ($_info, $_other_info) = @_ }
+
+package Gtk2::RecentManager;
+our @ISA = qw();
+sub add_full { my ($_manager, $_uri, $_data) = @_ }
+sub add_item { my ($_manager, $_uri) = @_ }
+sub get_default { my ($_class) = @_ }
+sub get_for_screen { my ($_class, $_screen) = @_ }
+sub get_items { my ($_manager) = @_ }
+sub get_limit { my ($_manager) = @_ }
+sub has_item { my ($_manager, $_uri) = @_ }
+sub lookup_item { my ($_manager, $_uri) = @_ }
+sub move_item { my ($_manager, $_old_uri, $_new_uri) = @_ }
+sub new { my ($_class) = @_ }
+sub purge_items { my ($_manager) = @_ }
+sub remove_item { my ($_manager, $_uri) = @_ }
+sub set_limit { my ($_manager, $_limit) = @_ }
+sub set_screen { my ($_manager, $_screen) = @_ }
+
package Gtk2::Requisition;
our @ISA = qw();
sub height { my ($_requisition, $_o_newval) = @_ }
@@ -2563,6 +2858,7 @@ 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) = @_ }
+sub unset_placement { my ($_scrolled_window) = @_ }
package Gtk2::Selection;
our @ISA = qw();
@@ -2589,7 +2885,9 @@ 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_rich_text { my ($_selection_data, $_buffer) = @_ }
sub targets_include_text { my ($_selection_data) = @_ }
+sub targets_include_uri { my ($_selection_data) = @_ }
sub type { my ($_d) = @_ }
package Gtk2::SeparatorMenuItem;
@@ -2607,6 +2905,7 @@ our @ISA = qw();
sub add_widget { my ($_size_group, $_widget) = @_ }
sub get_ignore_hidden { my ($_size_group) = @_ }
sub get_mode { my ($_size_group) = @_ }
+sub get_widgets { my ($_size_group) = @_ }
sub new { my ($_class, $_mode) = @_ }
sub remove_widget { my ($_size_group, $_widget) = @_ }
sub set_ignore_hidden { my ($_size_group, $_ignore_hidden) = @_ }
@@ -2646,6 +2945,31 @@ sub set_wrap { my ($_spin_button, $_wrap) = @_ }
sub spin { my ($_spin_button, $_direction, $_increment) = @_ }
sub update { my ($_spin_button) = @_ }
+package Gtk2::StatusIcon;
+our @ISA = qw();
+sub get_blinking { my ($_status_icon) = @_ }
+sub get_geometry { my ($_status_icon) = @_ }
+sub get_icon_name { my ($_status_icon) = @_ }
+sub get_pixbuf { my ($_status_icon) = @_ }
+sub get_size { my ($_status_icon) = @_ }
+sub get_stock { my ($_status_icon) = @_ }
+sub get_storage_type { my ($_status_icon) = @_ }
+sub get_visible { my ($_status_icon) = @_ }
+sub is_embedded { my ($_status_icon) = @_ }
+sub new { my ($_class) = @_ }
+sub new_from_file { my ($_class, $_filename) = @_ }
+sub new_from_icon_name { my ($_class, $_icon_name) = @_ }
+sub new_from_pixbuf { my ($_class, $_pixbuf) = @_ }
+sub new_from_stock { my ($_class, $_stock_id) = @_ }
+sub position_menu { my ($_menu, $_x, $_y, $_icon) = @_ }
+sub set_blinking { my ($_status_icon, $_blinking) = @_ }
+sub set_from_file { my ($_status_icon, $_filename) = @_ }
+sub set_from_icon_name { my ($_status_icon, $_icon_name) = @_ }
+sub set_from_pixbuf { my ($_status_icon, $_pixbuf) = @_ }
+sub set_from_stock { my ($_status_icon, $_stock_id) = @_ }
+sub set_tooltip { my ($_status_icon, $_tooltip_text) = @_ }
+sub set_visible { my ($_status_icon, $_visible) = @_ }
+
package Gtk2::Statusbar;
our @ISA = qw();
sub get_context_id { my ($_statusbar, $_context_description) = @_ }
@@ -2684,6 +3008,7 @@ sub fg_gc { my ($_style, $_state) = @_ }
sub font_desc { my ($_style) = @_ }
sub light { my ($_style, $_state) = @_ }
sub light_gc { my ($_style, $_state) = @_ }
+sub lookup_color { my ($_style, $_color_name) = @_ }
sub lookup_icon_set { my ($_style, $_stock_id) = @_ }
sub mid { my ($_style, $_state) = @_ }
sub mid_gc { my ($_style, $_state) = @_ }
@@ -2741,6 +3066,7 @@ our @ISA = qw();
sub DESTROY { my ($_list) = @_ }
sub add { my ($_list, $_target, $_flags, $_info) = @_ }
sub add_image_targets { my ($_list, $_info, $_writable) = @_ }
+sub add_rich_text_targets { my ($_list, $_info, $_deserializable, $_buffer) = @_ }
sub add_table { my ($_list, @_more_paras) = @_ }
sub add_text_targets { my ($_list, $_info) = @_ }
sub add_uri_targets { my ($_list, $_info) = @_ }
@@ -2774,10 +3100,16 @@ sub delete_interactive { my ($_buffer, $_start_iter, $_end_iter, $_default_edita
sub delete_mark { my ($_buffer, $_mark) = @_ }
sub delete_mark_by_name { my ($_buffer, $_name) = @_ }
sub delete_selection { my ($_buffer, $_interactive, $_default_editable) = @_ }
+sub deserialize { my ($_register_buffer, $_content_buffer, $_format, $_iter, $_data) = @_ }
+sub deserialize_get_can_create_tags { my ($_buffer, $_format) = @_ }
+sub deserialize_set_can_create_tags { my ($_buffer, $_format, $_can_create_tags) = @_ }
sub end_user_action { my ($_buffer) = @_ }
sub get_bounds { my ($_buffer) = @_ }
sub get_char_count { my ($_buffer) = @_ }
+sub get_copy_target_list { my ($_buffer) = @_ }
+sub get_deserialize_formats { my ($_buffer) = @_ }
sub get_end_iter { my ($_buffer) = @_ }
+sub get_has_selection { 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) = @_ }
@@ -2788,8 +3120,10 @@ 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_paste_target_list { my ($_buffer) = @_ }
sub get_selection_bound { my ($_buffer) = @_ }
sub get_selection_bounds { my ($_buffer) = @_ }
+sub get_serialize_formats { my ($_buffer) = @_ }
sub get_slice { my ($_buffer, $_start, $_end, $_include_hidden_chars) = @_ }
sub get_start_iter { my ($_buffer) = @_ }
sub get_tag_table { my ($_buffer) = @_ }
@@ -2809,13 +3143,20 @@ 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 register_deserialize_format { my ($_buffer, $_mime_type, $_function, $_o_user_data) = @_ }
+sub register_deserialize_tagset { my ($_buffer, $_tagset_name) = @_ }
+sub register_serialize_format { my ($_buffer, $_mime_type, $_function, $_o_user_data) = @_ }
+sub register_serialize_tagset { my ($_buffer, $_tagset_name) = @_ }
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 serialize { my ($_register_buffer, $_content_buffer, $_format, $_start, $_end) = @_ }
sub set_modified { my ($_buffer, $_setting) = @_ }
sub set_text { my ($_buffer, $_text, $_text) = @_ }
+sub unregister_deserialize_format { my ($_buffer, $_format) = @_ }
+sub unregister_serialize_format { my ($_buffer, $_format) = @_ }
package Gtk2::TextChildAnchor;
our @ISA = qw();
@@ -3258,6 +3599,7 @@ 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 insert_with_values { my ($_tree_store, $_parent, $_position, @_more_paras) = @_ }
sub is_ancestor { my ($_tree_store, $_iter, $_descendant) = @_ }
sub iter_depth { my ($_tree_store, $_iter) = @_ }
sub iter_is_valid { my ($_tree_store, $_iter) = @_ }
@@ -3293,17 +3635,22 @@ 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_enable_tree_lines { my ($_tree_view) = @_ }
sub get_expander_column { my ($_tree_view) = @_ }
sub get_fixed_height_mode { my ($_treeview) = @_ }
+sub get_grid_lines { my ($_tree_view) = @_ }
sub get_hadjustment { my ($_tree_view) = @_ }
+sub get_headers_clickable { 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_rubber_banding { my ($_tree_view) = @_ }
sub get_rules_hint { my ($_tree_view) = @_ }
sub get_search_column { my ($_tree_view) = @_ }
+sub get_search_entry { my ($_tree_view) = @_ }
sub get_selection { my ($_tree_view) = @_ }
sub get_vadjustment { my ($_tree_view) = @_ }
sub get_visible_range { my ($_tree_view) = @_ }
@@ -3325,8 +3672,10 @@ 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_enable_tree_lines { my ($_tree_view, $_enabled) = @_ }
sub set_expander_column { my ($_tree_view, $_column) = @_ }
sub set_fixed_height_mode { my ($_treeview, $_enable) = @_ }
+sub set_grid_lines { my ($_tree_view, $_grid_lines) = @_ }
sub set_hadjustment { my ($_tree_view, $_adjustment) = @_ }
sub set_headers_clickable { my ($_tree_view, $_setting) = @_ }
sub set_headers_visible { my ($_tree_view, $_headers_visible) = @_ }
@@ -3335,9 +3684,12 @@ 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_rubber_banding { my ($_tree_view, $_enable) = @_ }
sub set_rules_hint { my ($_tree_view, $_setting) = @_ }
sub set_search_column { my ($_tree_view, $_column) = @_ }
+sub set_search_entry { my ($_tree_view, $_entry) = @_ }
sub set_search_equal_func { my ($_tree_view, $_func, $_o_data) = @_ }
+sub set_search_position_func { my ($_tree_view, $_func, $_o_user_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) = @_ }
@@ -3491,9 +3843,11 @@ 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_get_track_motion { 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_set_track_motion { my ($_widget, $_track_motion) = @_ }
sub drag_dest_unset { my ($_widget) = @_ }
sub drag_get_data { my ($_widget, $_context, $_target, $_time_) = @_ }
sub drag_highlight { my ($_widget) = @_ }
@@ -3515,6 +3869,7 @@ sub event { my ($_widget, $_event) = @_ }
sub flags { my ($_widget) = @_ }
sub freeze_child_notify { my ($_widget) = @_ }
sub get_accessible { my ($_widget) = @_ }
+sub get_action { my ($_widget) = @_ }
sub get_ancestor { my ($_widget, $_ancestor_package) = @_ }
sub get_child_requisition { my ($_widget) = @_ }
sub get_child_visible { my ($_widget) = @_ }
@@ -3552,6 +3907,7 @@ sub has_grab { my ($_widget, @_more_paras) = @_ }
sub has_screen { my ($_widget) = @_ }
sub hide { my ($_widget) = @_ }
sub hide_all { my ($_widget) = @_ }
+sub input_shape_combine_mask { my ($_widget, $_shape_mask, $_offset_x, $_offset_y) = @_ }
sub intersect { my ($_widget, $_area) = @_ }
sub is_ancestor { my ($_widget, $_ancestor) = @_ }
sub is_focus { my ($_widget) = @_ }
@@ -3656,11 +4012,13 @@ 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_deletable { 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_group { my ($_window) = @_ }
sub get_has_frame { my ($_window) = @_ }
sub get_icon { my ($_window) = @_ }
sub get_icon_list { my ($_window) = @_ }
@@ -3704,6 +4062,7 @@ 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_deletable { my ($_window, $_setting) = @_ }
sub set_destroy_with_parent { my ($_window, $_setting) = @_ }
sub set_focus { my ($_window, $_o_focus) = @_ }
sub set_focus_on_map { my ($_window, $_setting) = @_ }
diff --git a/fake_packages/Gtk2/Html2.pm b/fake_packages/Gtk2/Html2.pm
new file mode 100644
index 0000000..81be0c7
--- /dev/null
+++ b/fake_packages/Gtk2/Html2.pm
@@ -0,0 +1,35 @@
+
+package Gtk2::Html2::Context;
+our @ISA = qw();
+sub get { my ($_class) = @_ }
+
+package Gtk2::Html2::Document;
+our @ISA = qw();
+sub clear { my ($_document) = @_ }
+sub close_stream { my ($_document) = @_ }
+sub current_stream { my ($_document) = @_ }
+sub new { my ($_class) = @_ }
+sub open_stream { my ($_document, $_mime_type) = @_ }
+sub write_stream { my ($_document, $_buffer, $_buffer) = @_ }
+
+package Gtk2::Html2::Stream;
+our @ISA = qw();
+sub cancel { my ($_stream) = @_ }
+sub close { my ($_stream) = @_ }
+sub destroy { my ($_stream) = @_ }
+sub get_mime_type { my ($_stream) = @_ }
+sub get_written { my ($_stream) = @_ }
+sub set_cancel_func { my ($_stream, $_abort_func, $_o_cancel_data) = @_ }
+sub set_mime_type { my ($_stream, $_mime_type) = @_ }
+sub write { my ($_stream, $_buffer, $_buffer) = @_ }
+
+package Gtk2::Html2::View;
+our @ISA = qw();
+sub get_magnification { my ($_view) = @_ }
+sub jump_to_anchor { my ($_view, $_anchor) = @_ }
+sub new { my ($_class) = @_ }
+sub set_document { my ($_view, $_document) = @_ }
+sub set_magnification { my ($_view, $_magnification) = @_ }
+sub zoom_in { my ($_view) = @_ }
+sub zoom_out { my ($_view) = @_ }
+sub zoom_reset { my ($_view) = @_ }
diff --git a/fake_packages/Gtk2/NotificationBubble.pm b/fake_packages/Gtk2/NotificationBubble.pm
new file mode 100644
index 0000000..4977c6c
--- /dev/null
+++ b/fake_packages/Gtk2/NotificationBubble.pm
@@ -0,0 +1,9 @@
+
+package Gtk2::NotificationBubble;
+our @ISA = qw();
+sub attach { my ($_bubble, $_widget) = @_ }
+sub force_window { my ($_bubble) = @_ }
+sub hide { my ($_bubble) = @_ }
+sub new { my ($_class) = @_ }
+sub set { my ($_bubble, $_notification_header, $_icon, $_notification_body) = @_ }
+sub show { my ($_bubble, $_timeout) = @_ }
diff --git a/fake_packages/MDV/Distribconf.pm b/fake_packages/MDV/Distribconf.pm
index abd441a..19df2c2 100644
--- a/fake_packages/MDV/Distribconf.pm
+++ b/fake_packages/MDV/Distribconf.pm
@@ -15,3 +15,19 @@ sub getvalue {
sub listmedia {
my ($_distrib) = @_;
}
+
+sub getfullpath {
+ my ($_distrib, $_media, $_var) = @_;
+}
+
+sub getpath {
+ my ($_distrib, $_media, $_var) = @_;
+}
+
+sub settree {
+ my ($_distrib, $_spec) = @_;
+}
+
+sub load {
+ my ($_distrib) = @_;
+}
diff --git a/fake_packages/URPM/Resolve.pm b/fake_packages/URPM/Resolve.pm
deleted file mode 100644
index 55eadfb..0000000
--- a/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/fake_packages/urpm.pm b/fake_packages/urpm.pm
deleted file mode 100644
index 0fc3515..0000000
--- a/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/perl_checker.spec b/perl_checker.spec
deleted file mode 100644
index 020de46..0000000
--- a/perl_checker.spec
+++ /dev/null
@@ -1,318 +0,0 @@
-# MODIFY IN THE CVS: cvs.mandrakesoft.com:/cooker soft/perl-MDK-Common/
-
-%define version 1.1.27
-%define release %mkrel 1
-
-%ifarch x86_64
-%define build_option PERL_CHECKER_TARGET='debug-code BCSUFFIX=""'
-%define require_ocaml /usr/bin/ocamlrun
-%else
-%define build_option %nil
-%define require_ocaml %nil
-%endif
-
-Summary: Verify perl code
-Name: perl_checker
-Version: %{version}
-Release: %{release}
-License: GPL
-Group: Development/Perl
-Requires: perl-base >= 2:5.8.0 %{require_ocaml}
-URL: http://cvs.mandriva.com/cgi-bin/cvsweb.cgi/soft/perl-MDK-Common/perl_checker.src
-Source0: perl_checker-%version.tar.bz2
-BuildRoot: %{_tmppath}/%{name}-buildroot
-BuildRequires: ocaml >= 3.06
-# for the faked packages:
-AutoReqProv: 0
-
-Obsoletes: perl-MDK-Common-devel <= 1.1.24
-Provides: perl-MDK-Common-devel <= 1.1.24
-
-%description
-Various verifying scripts created for DrakX
-
-%prep
-%setup -q
-
-%build
-make %build_option
-
-%install
-rm -rf $RPM_BUILD_ROOT
-%makeinstall_std %build_option
-
-%clean
-rm -rf $RPM_BUILD_ROOT
-
-%files
-%defattr(-,root,root)
-%doc perl_checker.src/perl_checker.html
-%{_bindir}/*
-%{perl_vendorlib}/perl_checker_fake_packages
-%{_datadir}/vim/ftplugin/*
-%config(noreplace) %{_sysconfdir}/emacs/site-start.d/*
-
-
-# MODIFY IN THE CVS: cvs.mandrakesoft.com:/cooker soft/perl-MDK-Common
-%changelog
-* Wed Aug 23 2006 Pixel <pixel@mandriva.com> 1.1.27-1mdv2007.0
-- add fake MDV::Distribconf
-
-* Wed Jun 21 2006 Pixel <pixel@mandriva.com> 1.1.26-1mdv2007.0
-- handle $o->pop
-
-* Thu Jun 15 2006 Pixel <pixel@mandriva.com> 1.1.25-1mdv2007.0
-- handle "use base ..."
-- add a fake packdrake.pm
-
-* Wed Jun 14 2006 Pixel <pixel@mandriva.com> 1.1.24-1mdv2007.0
-- "pop @l" return value can be dropped (ie make it similar to "shift")
-
-* Mon May 15 2006 Pixel <pixel@mandriva.com> 1.1.23-1mdk
-- it seems stack is smaller on amd64, function concat_spaces need to be tail-recursive
-
-* Tue Apr 11 2006 Thierry Vignaud <tvignaud@mandriva.com> 1.1.22-1mdk
-- sync with Glib/Gtk2-1.120
-
-* Fri Nov 25 2005 Pixel <pixel@mandriva.com> 1.1.21-1mdk
-- renamed package from perl-MDK-Common-devel to perl_checker
-- new option --generate-package-dependencies-graph
-
-* Fri Nov 26 2004 Pixel <pixel@mandrakesoft.com> 1.1.20-2mdk
-- new checks
-
-* Wed Nov 10 2004 Pixel <pixel@mandrakesoft.com> 1.1.19-1mdk
-- various enhancements/fixes
-
-
-* Wed Aug 18 2004 Pixel <pixel@mandrakesoft.com> 1.1.17-3mdk
-- use DESTDIR
-- add perl_checker-vim
-- add Ctrl-return in perl and cperl emacs mode
-- fake Getopt::Long
-
-* Wed Aug 11 2004 Pixel <pixel@mandrakesoft.com> 1.1.17-2mdk
-- various enhancements/fixes
-
-* Fri Jul 23 2004 Pixel <pixel@mandrakesoft.com> 1.1.15-2mdk
-- workaround bug in ocaml on ultrasparc
- (can't catch exception "Fatal error: out-of-bound access in array or string" in native code)
-
-* Mon May 10 2004 Pixel <pixel@mandrakesoft.com> 1.1.12-1mdk
-- many enhancements and cleanup
-
-* Wed Apr 7 2004 Thierry Vignaud <tvignaud@mandrakesoft.com> 1.1.11-4mdk
-- perl_checker:
- o add perl_checker.html
- o add testsuite
- o fix detecting of boolean context vs scalar context
- o fix some warning
- o in "$a ? $a : xxx", "xxx" can need short circuit
- o recognize "-c" function
- o turn some errors to warnings
-- perl_checker's faked packages:
- o sync with glib/gtk+ 2.4.0
- o support Gnome2 and Gnome2::Vte too
-
-* Fri Feb 13 2004 Thierry Vignaud <tvignaud@mandrakesoft.com> 1.1.10-2mdk
-- update gtk2-perl binding fake package
-
-* Tue Jan 13 2004 Pixel <pixel@mandrakesoft.com> 1.1.11-1mdk
-- sync perl_checker_fake_packages/{Glib,Gtk2}.pm
-- fix build time overflow in cache
-
-* Fri Jan 9 2004 Pixel <pixel@mandrakesoft.com> 1.1.10-2mdk
-- entries in generated pot file are sorted by files
-
-* Mon Jan 5 2004 Pixel <pixel@mandrakesoft.com> 1.1.9-1mdk
-- many enhancements
-
-* Tue Nov 18 2003 Thierry Vignaud <tvignaud@mandrakesoft.com> 1.1.8-3mdk
-- perl_checker --generate-pot: unescape "$" & "@" caracters
-
-* Mon Nov 10 2003 Thierry Vignaud <tvignaud@mandrakesoft.com> 1.1.8-2mdk
-- fix path in po generated from sources
-
-* Thu Aug 28 2003 Thierry Vignaud <tvignaud@mandrakesoft.com> 1.1.6-2mdk
-- resync perl_checker fake packages with to perl-Gtk2-0.95-5mdk
-
-* Mon Aug 11 2003 Pixel <pixel@mandrakesoft.com> 1.1.6-1mdk
-- allow $_o_XXX parameter name which is both unused and optional (same for $_b_XXX)
-- shift is a ONE_SCALAR_PARA so that $box->pack_start(shift @l, 0, 0, 4) is parsed correctly
-- in arrange_global_vars_declared(), don't keep anything in global_vars_declared, better
- create shadow packages to contain them
-- much better merging of multiple files defining functions in the same package.
- This fixes the bad behaviour when using the cache (esp. do_pkgs, but it was even worse
- with things in ugtk2.pm)
-- adapt to perl-Gtk2 xs (which replace the perl-GTK2 inline version)
-
-* Mon Jun 16 2003 Pixel <pixel@mandrakesoft.com> 1.1.4-2mdk
-- no native perl_checker for x86_64, only bytecode
-- build require ocaml >= 3.06 (thanks to Per Øyvind Karlsen)
-
-* Tue May 27 2003 Pixel <pixel@mandrakesoft.com> 1.1.4-1mdk
-- many enhancements:
- - disallow return(...), prefering return ...
- - enhance restricted_subscripted to correctly handle -e foo::bar()->{boo}
- - handle use foo() and use foo ("x", "y")
- - better warning for: print $a . 'foo'
- - add a special case to handle "arch => 1" without going through word_alone()
- - warn things like: if ($a = 1) { ... } or 0 or ...
- - explicitly disallow <<=, >>= and **= (instead of having a syntax error)
- - check prototype coherence: disallow ($a, @b, $c) or ($a, $o_b, $c)
- - warn spurious space in ( 1, 2) which should be (1, 2)
- - warn $o->method() which should be $o->method
- - suggest using the functional map instead of the imperative foreach when possible
- - add warning: you can replace "map { if_(..., $_) }" with "grep { ... }"
- - suggest any instead of grep in scalar context
- - suggest foreach instead of map in empty context
- - fix "/^\d+\.\*$/" giving warning "you can remove \".*$\" at the end of your regexp"
-
-* Fri May 16 2003 Pixel <pixel@mandrakesoft.com> 1.1.3-1mdk
-- fix pot generation (have \" instead of \\\")
-
-* Tue Apr 29 2003 Pixel <pixel@mandrakesoft.com> 1.1.2-1mdk
-- more context checks
- - ensure the values are used (eg: "map { ... } ...", "/xxx/")
- - ensure the values "... or ...", "... and ..." are not used
-
-* Fri Apr 25 2003 Pixel <pixel@mandrakesoft.com> 1.1.1-1mdk
-- enhanced "number of arguments" checking, including method calls
-
-* Thu Apr 17 2003 Pixel <pixel@mandrakesoft.com> 1.1.0-1mdk
-- basic "number of arguments" checking
-
-* Fri Apr 11 2003 Pixel <pixel@mandrakesoft.com> 1.0.5-1mdk
-- many enhancements:
- - allow 333 * `xxx` with no warning
- - warn non-useful or non-readable escaped sequences in strings and regexps
- (eg: /^\// should be m|^/|, /xxx\=xxx/ should be /xxx=xxx/ ...)
- - warn things like: ($foo) ||= ...
- - enhance non_scalar case for some operators using is_not_a_scalar
- - handle "keys %pkg::" (twas broken because keys() is now a ONE_SCALAR_PARA)
- - keys() is a ONE_SCALAR_PARA
- - correctly (in Perl way) handle priority for some special unary functions (length, exists, ref)
- - warn xxx == "ia64", xxx eq 2
- - 0.2 is a NUM, not a REVISION (otherwise it gets into a Raw_string)
- - better error message ("please remove the space before the function call"
- instead of "can't handle this nicely")
- - warn when using a regexp terminated with .* or .*$ (which is useless)
- - allow to selectively import from @EXPORT instead of only accepting @EXPORT_OK
-
-* Mon Feb 24 2003 Pixel <pixel@mandrakesoft.com> 1.0.4-23mdk
-- have the POT-Creation-Date set to the current date (when --generate-pot)
-- various fixes
-
-* Fri Feb 14 2003 Pixel <pixel@mandrakesoft.com> 1.0.4-21mdk
-- don't suggest to replace "@foo ? @foo : @bar" with "@foo || @bar", this is wrong!
-
-* Thu Feb 13 2003 Pixel <pixel@mandrakesoft.com> 1.0.4-20mdk
-- add some more Gtk2 methods
-- check use of variables with name _XXX (reserved for unused variables)
-
-* Wed Feb 12 2003 Pixel <pixel@mandrakesoft.com> 1.0.4-19mdk
-- handle ${foo} (including "${foo}bar")
-- warn when "ref" priority is badly handled by perl_checker
-
-* Thu Feb 6 2003 Pixel <pixel@mandrakesoft.com> 1.0.4-18mdk
-- add various Gtk2 methods
-- handle "...\x{hex}..."
-- suggest replacing $l[$#l] with $l[-1]
-
-* Tue Jan 21 2003 Pixel <pixel@mandrakesoft.com> 1.0.4-16mdk
-- add some Gtk2 methods
-
-* Thu Jan 16 2003 Pixel <pixel@mandrakesoft.com> 1.0.4-15mdk
--
- - check occurences of "$foo ? $foo : $bar"
- - disallow "fq::f args" when args is not parenthesized
-
-* Wed Jan 15 2003 Pixel <pixel@mandrakesoft.com> 1.0.4-14mdk
-- when generating pot, add an header and fake line numbers to
- please msgmerge
-
-* Sat Dec 28 2002 Pixel <pixel@mandrakesoft.com> 1.0.4-12mdk
-- add some more Gtk2 functions
-
-* Wed Dec 18 2002 Pixel <pixel@mandrakesoft.com> 1.0.4-11mdk
-- many new features including
- - checking methods being available
- - checking unused functions
- - saving parsed file in .perl_checker.cache
- - new instruction "Basedir .." in .perl_checker (useful for gi/perl-install/standalone/.perl_checker)
-
-* Wed Dec 11 2002 Pixel <pixel@mandrakesoft.com> 1.0.4-10mdk
-- add option "-t" enabling titi to precise tab-width=4
-- fix a bug in getting exported functions (fixes "unknown function gtkshow")
-
-* Tue Dec 10 2002 Pixel <pixel@mandrakesoft.com> 1.0.4-9mdk
-- check the c-format conformity of translated strings
-
-* Tue Dec 10 2002 Pixel <pixel@mandrakesoft.com> 1.0.4-8mdk
-- new --generate-pot feature
-
-* Fri Dec 6 2002 Pixel <pixel@mandrakesoft.com> 1.0.4-7mdk
-- print on stdout, not stderr
-- add option --restrict-to-files (mainly for perl_checko the Clean Keeper)
-
-* Fri Dec 6 2002 Pixel <pixel@mandrakesoft.com> 1.0.4-6mdk
-- perl_checker now checks usage of $_
-- ignore unknown functions coming from XS bootstrap when we can't use the .c
- to know the list of functions provided by the XS extension
-
-* Wed Dec 4 2002 Pixel <pixel@mandrakesoft.com> 1.0.4-5mdk
-- add unused variable detection
-- allow $AUTOLOAD usage in AUTOLOAD()
-- handle "use lib qw(...)"
-
-* Wed Dec 4 2002 Pixel <pixel@mandrakesoft.com> 1.0.4-4mdk
-- warn use of "cond ? list : ()" (use if_(cond, list) instead)
-
-* Mon Dec 2 2002 Pixel <pixel@mandrakesoft.com> 1.0.4-3mdk
-- some more checks ($1 =~ /re/ is a warning)
-
-* Thu Nov 28 2002 Pixel <pixel@mandrakesoft.com> 1.0.4-2mdk
-- new perl_checker now has every feature of the old version
- (except checking $_ in small subs, a more global solution should come)
-
-* Wed Nov 13 2002 Pixel <pixel@mandrakesoft.com> 1.0.4-1mdk
-- new perl_checker written in OCaml (not as featured as previous perl_checker yet)
-
-* Thu Nov 7 2002 Pixel <pixel@mandrakesoft.com> 1.0.3-18mdk
-- many more warnings
- - warn unneeded parentheses after an infix foreach/if/unless
- - error when "unless" is used with complex expressions
- - force $_ to be localised when "while (<FILEHANDLE>)" is used
- - force FILEHANDLE to be localised when "open FILEHANDLE, ..." is used
- - warn about one-character long functions (esp. for &N and &_)
- - warn when N("...") is misused
-
-* Thu Oct 17 2002 Pixel <pixel@mandrakesoft.com> 1.0.3-17mdk
-- add a check for function call PKG::f instead of PKG::f()
-- ensure a missing "=cut" doesn't make perl_checker go crazy (eg: when titi adds some doc)
-
-* Wed Aug 28 2002 Pixel <pixel@mandrakesoft.com> 1.0.3-14mdk
-- no function "xxx undefined" when using "#-#"
-
-* Wed Jul 31 2002 Pixel <pixel@mandrakesoft.com> 1.0.3-11mdk
-- a few more stricter rules
-
-* Wed Jul 31 2002 Pixel <pixel@mandrakesoft.com> 1.0.3-10mdk
-- cleaner, more usable (via .perl_checker for -exclude's)
-- more stricter syntax rules
-
-* Wed Jul 31 2002 Pixel <pixel@mandrakesoft.com> 1.0.3-9mdk
-- add *much* stricter syntax rules
-
-* Tue Jul 23 2002 Pixel <pixel@mandrakesoft.com> 1.0.3-5mdk
-- catch misuse of =~ when = was meant
-
-* Wed Jul 17 2002 Pixel <pixel@mandrakesoft.com> 1.0.3-4mdk
-- add new checks
-- exclude Date::Manip
-
-* Tue Feb 19 2002 Pixel <pixel@mandrakesoft.com> 1.0.2-13mdk
-- skip s///
-
-* Sat Feb 16 2002 Pixel <pixel@mandrakesoft.com> 1.0.2-11mdk
-- don't fail on non-tagged import
diff --git a/src/Makefile b/src/Makefile
index 22a45a6..5df6a31 100644
--- a/src/Makefile
+++ b/src/Makefile
@@ -6,7 +6,7 @@ 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`)
+fake_packages_dir = $(shell dirname `pwd`)/fake_packages
DEBUG = 1
default: TAGS build_ml build.ml debug-code native-code perl_checker.html
@@ -17,7 +17,7 @@ build_ml:
build.ml:
date '+let date = "%s"' > $@
- echo 'let fake_packages_dir = "'$(VENDORLIB)'/perl_checker_fake_packages"' >> $@
+ echo 'let fake_packages_dir = "'$(fake_packages_dir)'"' >> $@
echo 'let debugging = $(DEBUG) > 0' >> $@
%.html: %.html.pl
diff --git a/src/config_file.ml b/src/config_file.ml
index a5ee94f..efb6fb3 100644
--- a/src/config_file.ml
+++ b/src/config_file.ml
@@ -19,8 +19,8 @@ let read dir =
let config =
fold_lines (fun config line ->
match words line with
- | [ "Basedir"; ".." ] -> { config with basedir = Some 1 }
- | [ "Basedir"; "../.." ] -> { config with basedir = Some 2 }
+ | [ "Basedir"; ".." ] -> { basedir = Some 1 }
+ | [ "Basedir"; "../.." ] -> { basedir = Some 2 }
| [] -> config (* blank line *)
| [ "Ignore"; pkg ]
| [ pkg ] (* the deprecated form *)
diff --git a/src/global_checks.ml b/src/global_checks.ml
index a63e652..4a97221 100644
--- a/src/global_checks.ml
+++ b/src/global_checks.ml
@@ -174,7 +174,7 @@ let is_global_var context ident =
| _ -> false)
| I_hash ->
(match ident with
- | "ENV" | "SIG" -> true
+ | "ENV" | "SIG" | "INC" -> true
| _ -> false)
| I_star ->
(match ident with
@@ -183,7 +183,7 @@ let is_global_var context ident =
| _ -> false)
| I_func ->
(match ident with
- | "-b" | "-c" | "-d" | "-e" | "-f" | "-l" | "-r" | "-s" | "-w" | "-x"
+ | "-b" | "-c" | "-d" | "-e" | "-f" | "-l" | "-r" | "-s" | "-w" | "-x" | "-z" | "-t"
| "abs" | "alarm" | "atan2" | "bless"
| "caller" | "chdir" | "chmod" | "chomp" | "chop" | "chown" | "chr" | "chroot" | "close" | "closedir" | "cos" | "crypt"
| "defined" | "delete" | "die"
@@ -399,7 +399,7 @@ let check_variables vars t =
| 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, My_our("my", _, _) :: _, 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
diff --git a/src/lexer.mll b/src/lexer.mll
index f416499..dfa8561 100644
--- a/src/lexer.mll
+++ b/src/lexer.mll
@@ -78,6 +78,7 @@ let rec concat_bareword_paren accu = function
| PO_COMMENT _ :: _
(* the check will be done on this PO_COMMENT *)
| BAREWORD("N", _) :: PAREN(_) :: _
+ | BAREWORD("P", _) :: PAREN(_) :: _
| BAREWORD("N_", _) :: PAREN(_) :: _ ->
concat_bareword_paren (e :: accu) l
| _ ->
@@ -800,7 +801,7 @@ and string = parse
next string lexbuf
}
| "'" { string_escape_useful := Left true ; next string lexbuf }
-| [^ '\n' '\\' '"' '$' '@']+ { next string lexbuf }
+| [^ '\n' '\\' '"' ''' '$' '@']+ { next string lexbuf }
| eof { die_in_string lexbuf "Unterminated_string" }
and delimited_string = parse
@@ -917,7 +918,7 @@ and string_escape = parse
| '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 }
+| ['a' 'c' 'b' 'f' 'l' '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
diff --git a/src/parser.mly b/src/parser.mly
index a9bf396..78fb461 100644
--- a/src/parser.mly
+++ b/src/parser.mly
@@ -104,7 +104,7 @@ 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 lines { if fst $2.any <> [] then mcontext_check_none_no_drop_always $1 $2; new_esp $2.mcontext ($1.any @ fst $2.any, snd $2.any) $1 $2 }
line:
| decl { new_1esp [$1.any] $1 }
@@ -190,8 +190,8 @@ listexpr: /* Basic list expressions */
| 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}
+| expr AND expr {sp_p($2); sp_p($3); mcontext_check M_bool $1; mcontext_check_none_should_drop [$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_should_drop [$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 */
diff --git a/src/parser_helper.ml b/src/parser_helper.ml
index 43d60a4..d798e14 100644
--- a/src/parser_helper.ml
+++ b/src/parser_helper.ml
@@ -56,7 +56,9 @@ let is_a_scalar = function
| Num _
| Raw_string _
| String _
- | Call(Deref(I_func, Ident(None, "N", _)), _) -> true
+ | Call(Deref(I_func, Ident(None, "N", _)), _)
+ | Call(Deref(I_func, Ident(None, "P", _)), _)
+ -> true
| My_our(_, [ context, _ ], _)
| Deref_with(_, context, _, _)
| Deref(context, _) -> is_scalar_context context
@@ -415,7 +417,7 @@ let function_to_context word_alone = function
| "any" | "every" -> M_bool
| "find_index" -> M_int
| "each_index" -> M_none
- | "N" | "N_" -> M_string
+ | "N" | "P" | "N_" -> M_string
| "chop" | "chomp" | "push" | "unshift" -> M_none
| "hex" | "length" | "time" | "fork" | "getppid" -> M_int
@@ -425,7 +427,7 @@ let function_to_context word_alone = function
| "split" -> M_array
| "shift" | "pop" -> M_unknown_scalar
- | "die" | "return" | "redo" | "next" | "last" -> M_unknown
+ | "die" | "return" | "redo" | "next" | "last" | "exit" -> M_break_control_flow
| "caller" -> M_mixed [M_string ; M_list]
| "ref" -> M_ref M_unknown_scalar
@@ -535,6 +537,7 @@ let check_ternary_paras(cond, a, b) =
| String ([(_, List [])], _)
-> true
| Call(Deref(I_func, Ident(None, "N", _)), [ List(String _ :: l) ])
+ | Call(Deref(I_func, Ident(None, "P", _)), [ List(String _ :: l) ])
| Call_op(".", l, _)
| Ref(I_hash, List l)
| List l -> List.for_all dont_need_short_circuit_rec l
@@ -695,6 +698,7 @@ let to_Local esp =
Some(context, ident)
| Deref(I_scalar, Ident _)
| Deref(I_array, Ident _)
+ | Deref(I_hash, Ident _)
| Deref(I_star, Ident _)
| Deref_with(I_hash, I_scalar, Ident _, _)
| Deref_with(I_hash, I_scalar, Deref(I_scalar, _), _)
@@ -832,6 +836,7 @@ let followed_by_comma expr true_comma =
| l, Ident(None, s, pos) -> l @ [Raw_string(s, pos)]
| _ -> expr
+type msgid_t = No_plural of string | With_plural of string * string
let pot_strings = Hashtbl.create 16
let po_comments = ref []
@@ -872,6 +877,7 @@ msgstr \"\"
\"MIME-Version: 1.0\\n\"
\"Content-Type: text/plain; charset=CHARSET\\n\"
\"Content-Transfer-Encoding: 8-bit\\n\"
+\"Plural-Forms: nplurals=INTEGER; plural=EXPRESSION;\\n\"
") ;
@@ -883,12 +889,12 @@ msgstr \"\"
| 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
+ (Hashtbl.fold (fun msgid (pos, _) l -> (msgid,pos) :: l) pot_strings [] ) in
+ List.iter (fun (msgid, _) ->
+ match Hashtbl.find_all pot_strings msgid with
| [] -> ()
| l ->
- List.iter (fun _ -> Hashtbl.remove pot_strings s) l ;
+ List.iter (fun _ -> Hashtbl.remove pot_strings msgid) l ;
List.iter (fun po_comment -> output_string fd ("#. " ^ po_comment ^ "\n")) (collect snd l);
@@ -896,10 +902,19 @@ msgstr \"\"
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"
+ let output_it msgid_s s =
+ output_string fd (msgid_s ^ if String.contains s '\n' then " \"\"\n\"" else " \"") ;
+ String.iter print_formatted_char s ;
+ output_string fd "\"\n"
+ in
+ match msgid with
+ | No_plural s_ ->
+ output_it "msgid" s_ ;
+ output_string fd "msgstr \"\"\n\n"
+ | With_plural (s1, sn) ->
+ output_it "msgid" s1 ;
+ output_it "msgid_plural" sn ;
+ output_string fd "msgstr[0] \"\"\nmsgstr[1] \"\"\n\n"
) sorted_pot_strings ;
close_out fd
@@ -948,7 +963,7 @@ let call_raw force_non_builtin_func (e, para) =
(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) ;
+ Hashtbl.add pot_strings (No_plural s) (pos, !po_comments) ;
po_comments := []
) ;
let contexts = check_format_a_la_printf s pos_offset in
@@ -962,6 +977,29 @@ let call_raw force_non_builtin_func (e, para) =
| [ 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))
+ | "P" ->
+ (match para with
+ | [ List(String([ s1, List [] ], (_, pos1_offset, _ as pos)) ::
+ String([ sn, List [] ], (_, posn_offset, _)) :: _n :: para) ] ->
+ if !Flags.generate_pot then (
+ Hashtbl.add pot_strings (With_plural(s1, sn)) (pos, !po_comments) ;
+ po_comments := []
+ ) ;
+ let contexts1 = check_format_a_la_printf s1 pos1_offset in
+ let contextsn = check_format_a_la_printf sn posn_offset in
+ if List.length contexts1 > List.length contextsn then
+ warn_rule [Warn_traps; Warn_MDK_Common] "the singular string must not use more parameters than the plural string"
+ else if contexts1 <> (take (List.length contexts1) contextsn) then
+ warn_rule [Warn_traps; Warn_MDK_Common] "the singular and plural strings do not use same parameters"
+ else if List.length para < List.length contextsn then
+ warn_rule [Warn_traps; Warn_MDK_Common] "not enough parameters"
+ else if List.length para > List.length contextsn 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";
@@ -1187,8 +1225,13 @@ let rec mcontext2s = function
| M_unknown -> "unknown"
| M_mixed l -> String.concat " | " (List.map mcontext2s l)
+ | M_break_control_flow -> "break control flow"
+
let rec mcontext_lower c1 c2 =
match c1, c2 with
+ | M_break_control_flow, _ -> false
+ | _, M_break_control_flow -> false
+
| M_special, _ | _, M_special -> internal_error "M_special in mcontext_compare"
| M_unknown, _
@@ -1296,8 +1339,8 @@ let mcontext_check_unop_l wanted_mcontext esp =
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
+let rec mcontext_check_none_rec msg expr = function
+ | M_break_control_flow -> ()
| M_none | M_unknown -> ()
| M_mixed l when List.exists (fun c -> c = M_none) l -> ()
| M_tuple l ->
@@ -1318,10 +1361,28 @@ let mcontext_check_none msg expr esp =
| [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 <STDIN> 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
+ | _ -> warn_rule [Warn_void] msg
+
+let mcontext_check_none msg expr esp =
mcontext_check_none_rec msg expr esp.mcontext
+let mcontext_check_none_no_drop expr esp =
+ mcontext_check_none "value is dropped" expr esp
+
+let mcontext_check_none_should_drop expr esp =
+ mcontext_check_none "value should be dropped" expr esp
+
+let mcontext_check_none_no_drop_always esp1 esp_next =
+ match esp1.mcontext with
+ | M_break_control_flow ->
+ let not_Sub_declaration = function Sub_declaration _ -> false | _ -> true in
+ let l = List.filter not_Sub_declaration (fst esp_next.any) in
+ (match l with
+ | Label _ :: _ -> () (* that's ok, we have something like "... goto foo; ... return; foo: ..." *)
+ | [] -> () (* there are only sub declarations *)
+ | _ -> warn [Warn_traps] esp_next.pos "unreachable code")
+ | _ -> mcontext_check_none_no_drop esp1.any esp1
+
(* 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;
@@ -1365,7 +1426,7 @@ let call_op_if_infix left right esp_start esp_end =
warn_rule [Warn_suggest_simpler] "\"$foo = ... if !$foo\" can be written \"$foo ||= ...\""
| _ -> ());
- mcontext_check_none "value is dropped" [left] esp_start;
+ mcontext_check_none_no_drop [left] esp_start;
(match right with
| List [ Num("0", _)] -> () (* allow my $x if 0 *)
| _ -> check_My_under_condition "replace \"my $foo = ... if <cond>\" with \"my $foo = <cond> && ...\"" left);
@@ -1386,7 +1447,7 @@ let call_op_unless_infix left right esp_start esp_end =
| _ -> ());
| _ -> ());
- mcontext_check_none "value is dropped" [left] esp_start;
+ mcontext_check_none_no_drop [left] esp_start;
check_My_under_condition "replace \"my $foo = ... unless <cond>\" with \"my $foo = !<cond> && ...\"" left;
let pos = raw_pos_range esp_start esp_end in
diff --git a/src/parser_helper.mli b/src/parser_helper.mli
index e820703..38afaea 100644
--- a/src/parser_helper.mli
+++ b/src/parser_helper.mli
@@ -203,7 +203,6 @@ val to_Call_assign_op_ :
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
@@ -284,8 +283,17 @@ 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_rec :
+ string -> Types.fromparser list -> Types.maybe_context -> unit
val mcontext_check_none :
string -> Types.fromparser list -> 'a Types.any_spaces_pos -> unit
+val mcontext_check_none_no_drop :
+ Types.fromparser list -> 'a Types.any_spaces_pos -> unit
+val mcontext_check_none_should_drop :
+ Types.fromparser list -> 'a Types.any_spaces_pos -> unit
+val mcontext_check_none_no_drop_always :
+ Types.fromparser list Types.any_spaces_pos ->
+ (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 ->
diff --git a/src/perl_checker.html.pl b/src/perl_checker.html.pl
index e90d2eb..38ec959 100644
--- a/src/perl_checker.html.pl
+++ b/src/perl_checker.html.pl
@@ -1,5 +1,42 @@
$s = <<'EOF';
-<head><title>perl_checker</title></head>
+<head>
+ <title>perl_checker</title>
+ <style> body { max-width: 900; } </style>
+</head>
+
+
+<h1>Quick Start</h1>
+
+To use perl_checker, simply use "perl_checker a_file.pl"
+<p>
+To use under emacs, simply add the following line to your .emacs,
+then when you visit a perl file, you can use Ctrl-Return to run perl_checker
+on this file
+
+<pre>
+ (global-set-key [(control return)] (lambda () (interactive) (save-some-buffers 1) (compile (concat "perl_checker --restrict-to-files " (buffer-file-name (current-buffer))))))
+</pre>
+
+<p>
+To use with vim, use something like:
+<pre>
+ perl_checker --restrict-to-files scanner.pm > errors.err ; vim -c ':copen 4' -c ':so /usr/share/vim/ftplugin/perl_checker.vim' -q
+</pre>
+where /usr/share/vim/ftplugin/perl_checker.vim is
+
+<pre>
+" Error formats
+setlocal efm=
+ \%EFile\ \"%f\"\\,\ line\ %l\\,\ characters\ %c-%*\\d:,
+ \%EFile\ \"%f\"\\,\ line\ %l\\,\ character\ %c:%m,
+ \%+EReference\ to\ unbound\ regexp\ name\ %m,
+ \%Eocamlyacc:\ e\ -\ line\ %l\ of\ \"%f\"\\,\ %m,
+ \%Wocamlyacc:\ w\ -\ %m,
+ \%-Zmake%.%#,
+ \%C%m
+</pre>
+
+
<h1>Goals of perl_checker</h1>
<ul>
@@ -23,12 +60,21 @@ $s = <<'EOF';
(NB: the subset is chosen to keep a good expressivity)
</ul>
-<h1>Compared to <a href="http://perlcritic.tigris.org/">Perl-Critic</a>
+<h1>Compared to <a href="http://www.perl.com/pub/a/2005/06/09/ppi.html">PPI</a> and <a href="http://perlcritic.tigris.org/">Perl-Critic</a></h1>
<ul>
-<li>perl_checker use its own OCaml-written perl parser, which is in no way as robust as <a href="http://www.perl.com/pub/a/2005/06/09/ppi.html">PPI</a>.
- 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.
+<li>perl_checker use its own OCaml-written parser.
+ This parser only handle a subset of perl,
+ whereas one of PPI's goal is to be able to parse non finished perl documents.
+ <p>perl_checker is a checker: it is not a big deal to die horribly on a weird perl expression, it tells the programmer what to write instead.
+ The issue is that perl_checker includes inter-modules analysis, and it implies being able to parse non-perl_checker compliant modules.
+ A solution for this is perl_checker <i>fake</i> modules. No perfect solution though.
+
+<li>PPI doesn't handle operator priorities: <tt>1 + 2 &lt;&lt; 3</tt> is parsed as
+ <ul><li>PPI: a list [ Number(<tt>1</tt>), Operator(<tt>+</tt>), Number(<tt>2</tt>), Operator(<tt>&lt;&lt;</tt>), Number(<tt>3</tt>) ]
+ <li>perl_checker: a tree Operator(<tt>&lt;&lt;</tt>, [ Operator(<tt>+</tt>, [ Number(<tt>1</tt>), Number(<tt>2</tt>) ]), Number(<tt>3</tt>) ])
+ </ul>
+ This limits perlcritic checks to a syntax level.
<li>perl_checker is <b>much</b> faster (more than 100 times) (ML pattern matching rulez)
@@ -39,24 +85,33 @@ $s = <<'EOF';
<h1>Get it</h1>
-<a href="http://cvs.mandriva.com/cgi-bin/cvsweb.cgi/soft/perl-MDK-Common/perl_checker.src/">CVS source</a>
+<a href="http://svn.mandriva.com/cgi-bin/viewvc.cgi/packages/cooker/perl_checker/current/SOURCES/">tarball</a>
+<br>
+<a href="http://svn.mandriva.com/cgi-bin/viewvc.cgi/soft/perl_checker/">SVN source</a>
+<br>
+<a href="http://svn.mandriva.com/cgi-bin/viewvc.cgi/packages/cooker/perl-MDK-Common/current/SOURCES/">MDK::Common tarball</a>
<h1>Implemented features</h1>
<dl>
- <dt>white space normalization
- <dd>enforce a similar coding style. In many languages you can find a coding
- style document (eg: <a href="http://www.gnu.org/prep/standards_23.html">the GNU one</a>).
- TESTS=force_layout.t
+ <dt>detect some Perl traps
+ <dd>some Perl expressions are stupid, and one gets a warning when running
+ them with <tt>perl -w</tt>. The drawback of <tt>perl -w</tt> is the lack of
+ code coverage, it only detects expressions which are evaluated.
+
+ TESTS=various_errors.t
</dd>
- <dt>disallow <i>complex</i> expressions
- <dd>perl_checker try to ban some weird-not-used-a-lot features.
- TESTS=syntax_restrictions.t
+ <dt>context checks
+ <dd>Perl has types associated with variables names, the so-called "context".
+ Some expressions mixing contexts are stupid, perl_checker detects them.
+
+ TESTS=context.t
</dd>
+
<dt>suggest simpler expressions
<dd>when there is a simpler way to write an expression, suggest it. It can
also help detecting errors.
@@ -64,13 +119,7 @@ $s = <<'EOF';
TESTS=suggest_better.t
</dd>
- <dt>context checks
- <dd>Perl has types associated with variables names, the so-called "context".
- Some expressions mixing contexts are stupid, perl_checker detects them.
- TESTS=context.t
-
- </dd>
<dt>function call check
<dd>detection of unknown functions or mismatching prototypes (warning: since
perl is a dynamic language, some spurious warnings may occur when a function
@@ -79,6 +128,7 @@ $s = <<'EOF';
TESTS=prototype.t
</dd>
+
<dt>method call check
<dd>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
@@ -87,19 +137,31 @@ $s = <<'EOF';
TESTS=method.t
</dd>
+
<dt>return value check
<dd>dropping the result of a functionnally <i>pure</i> function is stupid.
using the result of a function returning void is stupid too.
+ <br>(nb: perl_checker enforces <tt>&&</tt> and <tt>||</tt> are used as boolean operators
+ whereas <tt>and</tt> and <tt>or</tt> are used for control flow)
TESTS=return_value.t
</dd>
- <dt>detect some Perl traps
- <dd>some Perl expressions are stupid, and one gets a warning when running
- them with <tt>perl -w</tt>. The drawback are <tt>perl -w</tt> is the lack of
- code coverage, it only detects expressions which are evaluated.
- TESTS=various_errors.t
+ <dt>white space normalization
+ <dd>enforce a similar coding style. In many languages you can find a coding
+ style document (eg: <a href="http://www.gnu.org/prep/standards/standards.html#Writing-C">the GNU one</a>).
+
+ TESTS=force_layout.t
+
+ </dd>
+
+ <dt>disallow <i>complex</i> expressions
+ <dd>perl_checker try to ban some weird-not-used-a-lot features.
+
+ TESTS=syntax_restrictions.t
+
+ </dd>
</dl>
@@ -136,7 +198,7 @@ sub get_example {
join('', map {
my $lines = join("<br>", map { "<tt>" . html_quote($_) . "</tt>" } @{$_->{lines}});
my $logs = join("<br>", map { html_quote($_) } @{$_->{logs}});
- " <tr><td>\n", $lines, "</td><td>", $logs, "</td></tr>\n";
+ $logs ? " <tr><td>\n" . $lines . "</td><td>" . $logs . "</td></tr>\n" : '';
} @tests) .
"</table></a>\n";
}
diff --git a/src/test/return_value.t b/src/test/return_value.t
index b4786f5..89cf9ee 100644
--- a/src/test/return_value.t
+++ b/src/test/return_value.t
@@ -1,3 +1,11 @@
+die; xxx(); unreachable code
+
+exit 1; xxx(); unreachable code
+
+$xxx or die;
+
+next if $xxx;
+
if ($xxx or $yyy) {} value should be dropped
context () is not compatible with context bool
diff --git a/src/test/suggest_better.t b/src/test/suggest_better.t
index d76abeb..208b7cc 100644
--- a/src/test/suggest_better.t
+++ b/src/test/suggest_better.t
@@ -12,6 +12,8 @@ $xxx->{yyy}->{zzz} the arrow "->" is unneeded
"xxx\"$xxx" you can replace "xxx\"xxx" with qq(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 ;
diff --git a/src/test/various_errors.t b/src/test/various_errors.t
index 48a8ece..3a4f4dd 100644
--- a/src/test/various_errors.t
+++ b/src/test/various_errors.t
@@ -1,5 +1,9 @@
local $xxx ||= $yyy applying ||= on a new initialized variable is wrong
+xxx(!my $xxx) applying not on a new initialized variable is wrong
+
+xxx(!our $xxx)
+
$1 =~ s/xxx/yyy/ do not modify the result of a match (eg: $1)
$xxx[1, 2] you must give only one argument
diff --git a/src/tree.ml b/src/tree.ml
index 16fd0e4..f21b9c1 100644
--- a/src/tree.ml
+++ b/src/tree.ml
@@ -188,7 +188,7 @@ let get_uses t =
uses
| Use(Ident(None, "base", _), classes) ->
let l = List.map (fun (pkg, pos) -> (pkg, (None, pos))) (collect from_qw_raw classes) in
- l @ uses
+ List.filter (fun (pkg, _) -> not (uses_external_package pkg)) l @ uses
| Use(Ident(_, _, pos) as pkg, l) ->
let package = string_of_fromparser pkg in
if uses_external_package package then
@@ -204,18 +204,20 @@ let get_uses t =
) [] t
let get_isa t =
+ let get_isa_ isa exporter 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") 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
+ in
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
+ get_isa_ isa exporter pos (collect from_qw_raw classes)
| 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
+ get_isa_ isa exporter pos (from_qw_raw classes)
| _ -> isa, exporter
) (None, None) t
@@ -308,6 +310,7 @@ let get_vars_declaration global_vars_declared file_name package =
| 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) ]
diff --git a/src/types.mli b/src/types.mli
index 5f23d3a..1497f26 100644
--- a/src/types.mli
+++ b/src/types.mli
@@ -34,6 +34,8 @@ type maybe_context =
| M_unknown
| M_mixed of maybe_context list
+ | M_break_control_flow
+
type sub_declaration_kind = Real_sub_declaration | Glob_assign
type fromparser =