Gtk2-1.24992/0000755000175000017500000000000013076464135011132 5ustar lacklackGtk2-1.24992/gtk2perl.h0000644000175000017500000001644713076462676013061 0ustar lacklack/* * * Copyright (C) 2003-2009 by the gtk2-perl team (see the file AUTHORS for the * full list) * * This library is free software; you can redistribute it and/or modify it * under the terms of the GNU Library General Public License as published by * the Free Software Foundation; either version 2.1 of the License, or (at your * option) any later version. * * This library is distributed in the hope that it will be useful, but WITHOUT * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or * FITNESS FOR A PARTICULAR PURPOSE. See the GNU Library General Public * License for more details. * * You should have received a copy of the GNU Library General Public License * along with this library; if not, write to the Free Software Foundation, * Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. * * * $Id$ */ #ifndef _GTK2PERL_H_ #define _GTK2PERL_H_ #include #include #include #include "gtk2perl-versions.h" /* custom GType for GtkBindingSet */ #ifndef GTK_TYPE_BINDING_SET # define GTK_TYPE_BINDING_SET (gtk2perl_binding_set_get_type ()) GType gtk2perl_binding_set_get_type (void) G_GNUC_CONST; #endif /* custom GType for GdkRegion */ #ifndef GDK_TYPE_REGION # define GDK_TYPE_REGION (gtk2perl_gdk_region_get_type ()) GType gtk2perl_gdk_region_get_type (void) G_GNUC_CONST; #endif #include "gtk2perl-autogen.h" /* no plug/socket on non-X11 despite patches exist for years. */ #ifndef GDK_WINDOWING_X11 # undef GTK_TYPE_PLUG # undef GTK_TYPE_SOCKET #endif /** * gtk2perl_new_gtkobject: * @object: object to wrap. * * convenient wrapper around gperl_new_object() which always passes %TRUE * for gperl_new_object()'s "own" parameter. for #GtkObjects, that parameter * merely results in gtk_object_sink() being called; if the object was not * floating, this does nothing. thus, everything just works out. * * returns: scalar wrapper for @object. * * in xs/GtkObject.xs */ SV * gtk2perl_new_gtkobject (GtkObject * object); /* custom handling for GdkBitmaps, since there are no typemacros for them. */ /* GObject derivative GdkBitmap */ #define SvGdkBitmap(sv) ((GdkBitmap*)gperl_get_object_check (sv, GDK_TYPE_DRAWABLE)) typedef GdkBitmap GdkBitmap_ornull; #define SvGdkBitmap_ornull(sv) (gperl_sv_is_defined (sv) ? SvGdkBitmap(sv) : NULL) typedef GdkBitmap GdkBitmap_noinc; /* these are real functions, rather than macros, because there's some extra * work involved in making sure it's blessed into Gtk2::Gdk::Bitmap when no * GType exists for GdkBitmap. */ SV * newSVGdkBitmap (GdkBitmap * bitmap); SV * newSVGdkBitmap_noinc (GdkBitmap * bitmap); #define newSVGdkBitmap_ornull(b) (b ? newSVGdkBitmap (b) : Nullsv) /* exported for GtkGC */ SV * newSVGdkGCValues (GdkGCValues * v); void SvGdkGCValues (SV * data, GdkGCValues * v, GdkGCValuesMask * m); /* exported for various other parts of pango */ SV * newSVPangoRectangle (PangoRectangle * rectangle); PangoRectangle * SvPangoRectangle (SV * sv); /* * GdkAtom, an opaque pointer */ SV * newSVGdkAtom (GdkAtom atom); GdkAtom SvGdkAtom (SV * sv); SV * newSVGtkTargetEntry (GtkTargetEntry * target_entry); /* do not store GtkTargetEntry objects returned from this function -- * they are only good for the block of code in which they are created */ GtkTargetEntry * SvGtkTargetEntry (SV * sv); void gtk2perl_read_gtk_target_entry (SV * sv, GtkTargetEntry * entry); #define GTK2PERL_STACK_ITEMS_TO_TARGET_ENTRY_ARRAY(first, targets, ntargets) \ { \ guint i; \ if (items <= first) { \ ntargets = 0; \ targets = NULL; \ } else { \ ntargets = items - first; \ targets = gperl_alloc_temp (sizeof (GtkTargetEntry) * ntargets); \ for (i = 0 ; i < ntargets ; i++) \ gtk2perl_read_gtk_target_entry (ST (i + first), \ targets + i); \ } \ } /* * get a list of GTypes from the xsub argument stack * used to collect column types for creating and initializing GtkTreeStores * and GtkListStores. */ #define GTK2PERL_STACK_ITEMS_TO_GTYPE_ARRAY(arrayvar, first, last) \ (arrayvar) = g_array_new (FALSE, FALSE, sizeof (GType)); \ g_array_set_size ((arrayvar), (last) - (first) + 1); \ { \ int i; \ for (i = (first) ; i <= (last) ; i++) { \ char * package = SvPV_nolen (ST (i)); \ /* look up GType by package name. */ \ GType t = gperl_type_from_package (package); \ if (t == 0) { \ g_array_free ((arrayvar), TRUE); \ croak ("package %s is not registered with GPerl", \ package); \ g_assert ("not reached"); \ } \ g_array_index ((arrayvar), GType, i-(first)) = t; \ } \ } /* * some custom opaque object handling for private gtk structures needed * for doing drag and drop. */ /* gtk+ 2.10 introduces a boxed type for GtkTargetList and we use it for * property marshalling, etc. But we also need to keep backwards compatability * with the old wrappers so we overwrite the macros. */ #if GTK_CHECK_VERSION (2, 10, 0) # undef newSVGtkTargetList # undef newSVGtkTargetList_ornull # undef SvGtkTargetList # undef SvGtkTargetList_ornull #else typedef GtkTargetList GtkTargetList_ornull; #endif SV * newSVGtkTargetList (GtkTargetList * list); #define newSVGtkTargetList_ornull(list) ((list) ? newSVGtkTargetList (list) : &PL_sv_undef) GtkTargetList * SvGtkTargetList (SV * sv); #define SvGtkTargetList_ornull(sv) (gperl_sv_is_defined (sv) ? SvGtkTargetList (sv) : NULL) /* * exported so Gnome2 can reuse it in wrappers. other modules might want to * do the same. the callback for it needn't worry about param_types or * return type, as this does all the marshaling by hand (the C function writes * through the params, so we have to handle the stack specially). */ void gtk2perl_menu_position_func (GtkMenu * menu, gint * x, gint * y, gboolean * push_in, GPerlCallback * callback); #if ! GTK_CHECK_VERSION (2, 4, 0) /* in versions prior to 2.4.0, GtkTreeSearchFlags was declared such that * glib-mkenums interpreted and registered it as a GEnum type. sometime * before 2.3.0, this was corrected, and the type is registered as a GFlags. * The maps file has GFlags (since that's correct), but we have to mangle * things somewhat for the bindings to work properly with older libraries. */ # undef SvGtkTextSearchFlags # undef newSVGtkTextSearchFlags # define SvGtkTextSearchFlags(sv) (gperl_convert_enum (GTK_TYPE_TEXT_SEARCH_FLAGS, sv)) # define newSVGtkTextSearchFlags(val) (gperl_convert_back_enum (GTK_TYPE_TEXT_SEARCH_FLAGS, val)) #endif /* object handling for GdkGeometry */ SV * newSVGdkGeometry (GdkGeometry *geometry); GdkGeometry * SvGdkGeometry (SV *object); GdkGeometry * SvGdkGeometryReal (SV *object, GdkWindowHints *hints); /* special handling for GdkPixbufFormat, which was introduced in gtk+ 2.2.0 */ #if GTK_CHECK_VERSION (2, 2, 0) SV * newSVGdkPixbufFormat (GdkPixbufFormat * format); GdkPixbufFormat * SvGdkPixbufFormat (SV * sv); #endif #endif /* _GTK2PERL_H_ */ Gtk2-1.24992/gtk-demo/0000755000175000017500000000000013076464135012641 5ustar lacklackGtk2-1.24992/gtk-demo/main.pl0000644000175000017500000004457013076462676014144 0ustar lacklack#!/usr/bin/perl -w # # $Id$ # our $PROGDIR = $0; $PROGDIR =~ s/main.pl$//; use strict; use Carp; use Glib qw(TRUE FALSE); use Gtk2; use Gtk2::Pango; use Gtk2; use vars qw/ @testgtk_demos /; # lists of demo code descriptions. # the func is a plain string in each of these, as a sentinel value to tell # row_activated_cb that the file containing that function hasn't been # loaded yet. my @child0 = ( { title => "Editable Cells", filename => "editable_cells.pl", func => 'stub', }, { title => "List Store", filename => "list_store.pl", func => 'stub', }, { title => "Tree Store", filename => "tree_store.pl", func => 'stub', }, ); my @child1 = ( { title => "Hypertext", filename => "hypertext.pl", func => 'stub', }, { title => "Multiple Views", filename => "textview.pl", func => 'stub', }, ); @testgtk_demos = ( { title => "Application main window", filename => "appwindow.pl", func => 'stub', }, { title => "Assistant", filename => "assistant.pl", func => 'stub', available => sub { Gtk2->CHECK_VERSION (2, 10, 0); } }, { title => "Builder", filename => "builder.pl", func => 'stub', available => sub { Gtk2->CHECK_VERSION (2, 12, 0); } }, { title => "Button Boxes", filename => "button_box.pl", func => 'stub', }, { title => "Change Display", filename => "changedisplay.pl", func => 'stub', }, { title => "Color Selector", filename => "colorsel.pl", func => 'stub', }, { title => "Combo boxes", filename => "combobox.pl", func => 'stub', available => sub { Gtk2->CHECK_VERSION (2, 4, 0); } }, { title => "Dialog and Message Boxes", filename => "dialog.pl", func => 'stub', }, { title => "Drawing Area", filename => "drawingarea.pl", func => 'stub', }, { title => "Images", filename => "images.pl", func => 'stub', }, { title => "Item Factory", filename => "item_factory.pl", func => 'stub', }, { title => "Menus", filename => "menus.pl", func => 'stub', }, { title => "Paned Widgets", filename => "panes.pl", func => 'stub', }, { title => "Pixbufs", filename => "pixbufs.pl", func => 'stub', }, { title => "Size Groups", filename => "sizegroup.pl", func => 'stub', }, { title => "Stock Item and Icon Browser", filename => "stock_browser.pl", func => 'stub', }, { title => "Text Widget", children => \@child1 }, { title => "Tree View", children => \@child0 }, ); push @testgtk_demos, { title => "Entry Completion", filename => "entry_completion.pl", func => 'stub', }, { title => "UI Manager", filename => "ui_manager.pl", func => 'stub', } if Gtk2->CHECK_VERSION (2, 4, 0); push @testgtk_demos, { title => "Rotated Text", filename => "rotated_text.pl", func => 'stub', }, if Gtk2->CHECK_VERSION (2, 6, 0); # some globals. my $info_buffer; my $source_buffer; my $current_file; # clean names for column numbers. use constant TITLE_COLUMN => 0; use constant FILENAME_COLUMN => 1; use constant FUNC_COLUMN => 2; use constant ITALIC_COLUMN => 3; use constant NUM_COLUMNS => 4; #/** # * demo_find_file: # * @base: base filename # * @err: location to store error, or %NULL. # * # * Looks for @base first in the current directory, then in the # * location GTK+ where it will be installed on make install, # * returns the first file found. # * # * Return value: the filename, if found or %NULL # **/ sub demo_find_file { my $base = shift; return $base if -e $base; my $filename = $PROGDIR.$base; croak "Cannot find demo data file $base ($filename)\n" unless -e $filename; return $filename; } sub window_closed_cb { my ($window, $cbdata) = @_; my $iter = $cbdata->{model}->get_iter ($cbdata->{path}); my ($italic) = $cbdata->{model}->get ($iter, ITALIC_COLUMN); $cbdata->{model}->set ($iter, ITALIC_COLUMN, !$italic) if $italic; } # # Stupid syntax highlighting. # # No regex was used in the making of this highlighting. # It should only work for simple cases. This is good, as # that's all we should have in the demos. # # This code should not be used elsewhere, except perhaps as an example of how # to iterate through a text buffer. # use constant STATE_NORMAL => 0; use constant STATE_IN_COMMENT => 1; =out static gchar *tokens[] = { "/*", "\"", NULL }; static gchar *types[] = { "static", "const ", "void", "gint", "int ", "char ", "gchar ", "gfloat", "float", "gint8", "gint16", "gint32", "guint", "guint8", "guint16", "guint32", "guchar", "glong", "gboolean" , "gshort", "gushort", "gulong", "gdouble", "gldouble", "gpointer", "NULL", "GList", "GSList", "FALSE", "TRUE", "FILE ", "GtkObject ", "GtkColorSelection ", "GtkWidget ", "GtkButton ", "GdkColor ", "GdkRectangle ", "GdkEventExpose ", "GdkGC ", "GdkPixbufLoader ", "GdkPixbuf ", "GError", "size_t", NULL }; static gchar *control[] = { " if ", " while ", " else", " do ", " for ", "?", ":", "return ", "goto ", NULL }; void parse_chars (gchar *text, gchar **end_ptr, gint *state, gchar **tag, gboolean start) { gint i; gchar *next_token; /* Handle comments first */ if (*state == STATE_IN_COMMENT) { *end_ptr = strstr (text, "*/"); if (*end_ptr) { *end_ptr += 2; *state = STATE_NORMAL; *tag = "comment"; } return; } *tag = NULL; *end_ptr = NULL; /* check for comment */ if (!strncmp (text, "/*", 2)) { *end_ptr = strstr (text, "*/"); if (*end_ptr) *end_ptr += 2; else *state = STATE_IN_COMMENT; *tag = "comment"; return; } /* check for preprocessor defines */ if (*text == '#' && start) { *end_ptr = NULL; *tag = "preprocessor"; return; } /* functions */ if (start && * text != '\t' && *text != ' ' && *text != '{' && *text != '}') { if (strstr (text, "(")) { *end_ptr = strstr (text, "("); *tag = "function"; return; } } /* check for types */ for (i = 0; types[i] != NULL; i++) if (!strncmp (text, types[i], strlen (types[i]))) { *end_ptr = text + strlen (types[i]); *tag = "type"; return; } /* check for control */ for (i = 0; control[i] != NULL; i++) if (!strncmp (text, control[i], strlen (control[i]))) { *end_ptr = text + strlen (control[i]); *tag = "control"; return; } /* check for string */ if (text[0] == '"') { gint maybe_escape = FALSE; *end_ptr = text + 1; *tag = "string"; while (**end_ptr != '\000') { if (**end_ptr == '\"' && !maybe_escape) { *end_ptr += 1; return; } if (**end_ptr == '\\') maybe_escape = TRUE; else maybe_escape = FALSE; *end_ptr += 1; } return; } /* not at the start of a tag. Find the next one. */ for (i = 0; tokens[i] != NULL; i++) { next_token = strstr (text, tokens[i]); if (next_token) { if (*end_ptr) *end_ptr = (*end_ptrget_iter_at_offset (0); ## my $next_iter = $start_iter->copy; my $next_iter = $start_iter; while ($next_iter = $next_iter->forward_line) { my $start = TRUE; my $start_ptr = $text = $start_iter->get_text ($next_iter); do { ($end_ptr, $tag) = parse_chars ($start_ptr, $state, $start); my $tmp_iter; $start = FALSE; if ($end_ptr) { ## $tmp_iter = $start_iter->copy; $tmp_iter = $start_iter; $tmp_iter->forward_chars ($end_ptr - $start_ptr); } else { ## $tmp_iter = $next_iter->copy; $tmp_iter = $next_iter; } if ($tag) { $source_buffer->apply_tag_by_name ($tag, $start_iter, $tmp_iter); } $start_iter = $tmp_iter; $start_ptr = $end_ptr; } while ($end_ptr); ## $start_iter = $next_iter->copy; $start_iter = $next_iter; } } sub load_file { my $filename = shift; my $state = 0; my $in_para = 0; return if defined $current_file and $current_file eq $filename; $current_file = $filename; $info_buffer->delete ($info_buffer->get_bounds); $source_buffer->delete ($source_buffer->get_bounds); my $full_filename; eval { $full_filename = demo_find_file ($filename); }; if ($@) { warn $@; } local *IN; open IN, $full_filename or warn("cannot open $full_filename: $!\n"), return; my $start = $info_buffer->get_iter_at_offset (0); while () { if ($state == 0) { # Reading title if (/^#!/) { # skip the interpreter line... } elsif (/^\s*#?\s*$/) { # skip blank lines preceding the title } else { # this must be the title! s/^#\s*//; s/\s*$//; ## my $end = $start->copy; my $end = $start; $info_buffer->insert ($end, $_); ## $start = $end; ###print "$start $end\n"; # gtk_text_iter_backward_chars (&start, len_chars); $start = $info_buffer->get_iter_at_offset (0); $info_buffer->apply_tag_by_name ("title", $start, $end); # $start = $end; $state++; } } elsif ($state == 1) { # Reading body of info section if (/^\s*$/) { # completely blank line ends the info section. $state++; } else { # strip leading junk s/^#?\s+//; # strip trailing junk s/\s+$//; if (length($_) > 0) { $info_buffer->insert ($start, " ") if $in_para; $info_buffer->insert ($start, $_); $in_para = 1; } else { $info_buffer->insert ($start, "\n"); $in_para = 0; } } } elsif ($state == 2) { # Skipping blank lines s/^\s+//; if (length ($_)) { $state++; $start = $source_buffer->get_iter_at_offset (0); $source_buffer->insert ($start, $_); } } elsif ($state == 3) { # Reading program body $source_buffer->insert ($start, $_); } } # fontify (); } sub row_activated_cb { my ($tree_view, $path, $column) = @_; my $model = $tree_view->get_model; my $iter = $model->get_iter ($path); my ($filename, $func, $italic) = $model->get ($iter, FILENAME_COLUMN, FUNC_COLUMN, ITALIC_COLUMN); # this is rather a bit of a departure from the C version. # in the C version, the various demos are in separate modules that # get compiled into the program. perl doesn't work that way. so, we # have the code in external files that define a package with the same # name as the file (sans the .pl). if the demo has never been run, # the func column will contain a string; when we see that, we'll # require the file, set the func column to point to the "do" method # within that file's declared package, and then retrieve that function # pointer again. it's a kind of hackish lazy loading mechanism. # don't try this at home. if ('CODE' ne ref $func) { my $pkg = $filename; $filename = demo_find_file($filename); require $filename; $pkg =~ s/\.pl$//; eval '$model->set ($iter, FUNC_COLUMN, \&'.$pkg.'::do);'; ($func) = $model->get ($iter, FUNC_COLUMN); } if ($func) { # set this row italic to show that the demo is running... $model->set ($iter, ITALIC_COLUMN, !$italic); my $window = $func->($tree_view->get_toplevel); if ($window) { # unset the italics when the window closes. $window->signal_connect (destroy => \&window_closed_cb, { model => $model, path => $path->copy }); } } } sub selection_cb { my ($selection, $model) = @_; my $iter = $selection->get_selected; return unless defined $iter; my ($name) = $model->get ($iter, FILENAME_COLUMN); load_file ($name) if $name; } sub create_text { my ($buffer_ref, $is_source) = @_; my $scrolled_window = Gtk2::ScrolledWindow->new; $scrolled_window->set_policy ('automatic', 'automatic'); $scrolled_window->set_shadow_type ('in'); my $text_view = Gtk2::TextView->new; $$buffer_ref = Gtk2::TextBuffer->new (undef); $text_view->set_buffer ($$buffer_ref); $text_view->set_editable (FALSE); $text_view->set_cursor_visible (FALSE); $scrolled_window->add ($text_view); if ($is_source) { my $font_desc = Gtk2::Pango::FontDescription->from_string ("Courier 12"); $text_view->modify_font ($font_desc); $text_view->set_wrap_mode ('none'); } else { # Make it a bit nicer for text. $text_view->set_wrap_mode ('word'); $text_view->set_pixels_above_lines (2); $text_view->set_pixels_below_lines (2); } return $scrolled_window; } sub create_tree { my $model = Gtk2::TreeStore->new ('Glib::String', 'Glib::String', 'Glib::Scalar', 'Glib::Boolean'); my $tree_view = Gtk2::TreeView->new; $tree_view->set_model ($model); my $selection = $tree_view->get_selection; $selection->set_mode ('browse'); $tree_view->set_size_request (200, -1); # # this code only supports 1 level of children. If we # want more we probably have to use a recursing function. # foreach my $d (@testgtk_demos) { next if ($d->{available} && !$d->{available}->()); my $iter = $model->append (undef); $model->set ($iter, TITLE_COLUMN, $d->{title}, FILENAME_COLUMN, $d->{filename} || '', FUNC_COLUMN, $d->{func} || '', ITALIC_COLUMN, FALSE); next unless $d->{children}; foreach my $child (@{ $d->{children} }) { my $child_iter = $model->append ($iter); $model->set ($child_iter, TITLE_COLUMN, $child->{title}, FILENAME_COLUMN, $child->{filename}, FUNC_COLUMN, $child->{func}, ITALIC_COLUMN, FALSE); } } my $cell = Gtk2::CellRendererText->new; $cell->set ('style' => 'italic'); my $column = Gtk2::TreeViewColumn->new_with_attributes ("Widget (double click for demo)", $cell, 'text' => TITLE_COLUMN, 'style_set' => ITALIC_COLUMN); $tree_view->append_column ($column); $selection->signal_connect (changed => \&selection_cb, $model); $tree_view->signal_connect (row_activated => \&row_activated_cb, $model); $tree_view->expand_all; return $tree_view; } sub setup_default_icon { my $pixbuf; eval { $pixbuf = Gtk2::Gdk::Pixbuf->new_from_file (demo_find_file ("gtk-logo-rgb.gif")); }; if ($@) { my $dialog = Gtk2::MessageDialog->new (undef, [], 'error', 'close', "Failed to read icon file: $@"); $dialog->signal_connect (response => sub { $_[0]->destroy; 1 }); } if ($pixbuf) { # The gtk-logo-rgb icon has a white background, make it transparent my $transparent = $pixbuf->add_alpha (TRUE, 0xff, 0xff, 0xff); # only one item on the parameter list, but the parameter list is a list Gtk2::Window->set_default_icon_list ($transparent); } } Gtk2->init; setup_default_icon (); my $window = Gtk2::Window->new; $window->set_title ("Gtk2-Perl Code Demos"); $window->signal_connect (destroy => sub { Gtk2->main_quit; 1 }); my $hbox = Gtk2::HBox->new (FALSE, 0); $window->add ($hbox); my $tree = create_tree (); $hbox->pack_start ($tree, FALSE, FALSE, 0); my $notebook = Gtk2::Notebook->new; $hbox->pack_start ($notebook, TRUE, TRUE, 0); $notebook->append_page (create_text (\$info_buffer, FALSE), Gtk2::Label->new_with_mnemonic ("_Info")); $notebook->append_page (create_text (\$source_buffer, TRUE), Gtk2::Label->new_with_mnemonic ("_Source")); my $tag; $tag = $info_buffer->create_tag ("title", font => "Sans 18"); $tag = $source_buffer->create_tag ("comment", foreground => "red"); $tag = $source_buffer->create_tag ("type", foreground => "ForestGreen"); $tag = $source_buffer->create_tag ("string", foreground => "RosyBrown", weight => PANGO_WEIGHT_BOLD); $tag = $source_buffer->create_tag ("control", "foreground", "purple"); $tag = $source_buffer->create_tag ('preprocessor', style => 'oblique', foreground => 'burlywood4'); $tag = $source_buffer->create_tag ('function', weight => PANGO_WEIGHT_BOLD, foreground => 'DarkGoldenrod4'); $window->set_default_size (600, 400); $window->show_all; # this happens anyway, when the list selects the first item on show # load_file ($testgtk_demos[0]{filename}); Gtk2->main; __END__ Copyright (C) 2003 by the gtk2-perl team (see the file AUTHORS for the full list) This library is free software; you can redistribute it and/or modify it under the terms of the GNU Library General Public License as published by the Free Software Foundation; either version 2.1 of the License, or (at your option) any later version. This library is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Library General Public License for more details. You should have received a copy of the GNU Library General Public License along with this library; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. Gtk2-1.24992/gtk-demo/combobox.pl0000644000175000017500000002100213076462676015011 0ustar lacklack#!/usr/bin/perl -w # # Combo boxes # # The ComboBox widget allows to select one option out of a list. # The ComboBoxEntry additionally allows the user to enter a value # that is not in the list of options. # # How the options are displayed is controlled by cell renderers. # package combobox; use strict; use warnings; use Glib ':constants'; use Gtk2; #include "demo-common.h" use constant PIXBUF_COL => 0; use constant TEXT_COL => 1; my $window = undef; sub create_stock_icon_store() { my @stock_id = ( 'gtk-dialog-warning', 'gtk-stop', 'gtk-new', 'gtk-clear', undef, 'gtk-open' ); my ($item, $pixbuf, $cellview, $iter, $store, $label); $cellview = Gtk2::CellView->new(); $store = Gtk2::ListStore->new('Gtk2::Gdk::Pixbuf', 'Glib::String'); for my $i (@stock_id) { if ($i) { $pixbuf = $cellview->render_icon($i, 'GTK_ICON_SIZE_BUTTON'); $item = Gtk2::Stock->lookup($i); $label = $item->{label}; # strip underscores $label =~ tr/_//d; $iter = $store->append(); $store->set ($iter, PIXBUF_COL, $pixbuf, TEXT_COL, $label); undef $pixbuf; } else { $iter = $store->append(); $store->set($iter, PIXBUF_COL, undef, TEXT_COL, "separator"); } } $cellview->destroy(); return $store; } # A GtkCellLayoutDataFunc that demonstrates how one can control # sensitivity of rows. This particular function does nothing # useful and just makes the second row insensitive. # sub set_sensitive() { my ($cell_layout, $cell, $tree_model, $iter, $data) = @_; my $path = $tree_model->get_path($iter); my @indices = $path->get_indices(); my $sensitive = $indices[0] != 1; undef $path; $cell->set("sensitive", $sensitive); } # A GtkTreeViewRowSeparatorFunc that demonstrates how rows can be # rendered as separators. This particular function does nothing # useful and just turns the fourth row into a separator. # sub is_separator() { my ($model, $iter, $data) = @_; my $path = $model->get_path($iter); my @indices = $path->get_indices(); my $result = $indices[0] == 4; undef $path; return $result; } sub create_capital_store() { my %capitals = ( "A - B" => [ "Albany", "Annapolis", "Atlanta", "Augusta", "Austin", "Baton Rouge", "Bismarck", "Boise", "Boston" ], "C - D" => [ "Carson City", "Charleston", "Cheyenne", "Columbia", "Columbus", "Concord", "Denver", "Des Moines", "Dover" ], "E - J" => [ "Frankfort", "Harrisburg", "Hartford", "Helena", "Honolulu", "Indianapolis", "Jackson", "Jefferson City", "Juneau" ], "K - O" => [ "Lansing", "Lincoln", "Little Rock", "Madison", "Montgomery", "Montpelier", "Nashville", "Oklahoma City", "Olympia" ], "P - S" => [ "Phoenix", "Pierre", "Providence", "Raleigh", "Richmond", "Sacramento", "Salem", "Salt Lake City", "Santa Fe", "Springfield", "St. Paul", ], "T - Z" => [ "Tallahassee", "Topeka", "Trenton" ], ); my $store = Gtk2::TreeStore->new('Glib::String'); for my $i (sort { $a cmp $b} keys %capitals ) { my $iter = $store->append(undef); $store->set($iter, 0, $i); for my $capital (@{$capitals{$i}}) { my $iter2 = $store->append($iter); $store->set($iter2, 0, $capital); } } return $store; } sub is_capital_sensitive() { my ($cell_layout, $cell, $tree_model, $iter, $data) = @_; my $sensitive = !$tree_model->iter_has_child($iter); $cell->set('sensitive', $sensitive); } sub fill_combo_entry($) { my $combo = shift; $combo->append_text("One"); $combo->append_text("Two"); $combo->append_text("2\x{00bd}"); $combo->append_text("Three"); } # A simple validating entry package Gtk2::MaskEntry; use Gtk2; use base qw(Gtk2::Entry); sub mask_entry_set_background($) { my $entry = shift; if ($entry->get('mask')) { my $re = $entry->get('mask'); if (! ($entry->get_text() =~ $re) ) { $entry->modify_base('GTK_STATE_NORMAL', Gtk2::Gdk::Color->new(65535, 60000, 60000)); return; } } $entry->modify_base('GTK_STATE_NORMAL', undef); } sub mask_entry_changed($) { my $editable = shift; mask_entry_set_background($editable); } sub INIT_INSTANCE($) { my $self = shift; $self->set('mask', undef); } use Glib::Object::Subclass 'Gtk2::Entry', properties => [ Glib::ParamSpec->string ( 'mask', '', '', 'Glib::String', [qw/readable writable/] ), ], signals => { changed => \&mask_entry_changed, }, interfaces => [ 'Gtk2::CellEditable', ]; sub new($@) { my $class = shift; my $self = $class->SUPER::new(); bless $self, $class; $self; } package combobox; sub do { my $do_widget = shift; if (!$window) { $window = Gtk2::Window->new('GTK_WINDOW_TOPLEVEL'); $window->set_screen ($do_widget->get_screen) if Gtk2->CHECK_VERSION (2, 2, 0); $window->set_title("Combo boxes"); $window->signal_connect("destroy", sub { $window = undef; }); $window->set_border_width(10); my $vbox = Gtk2::VBox->new(FALSE, 2); $window->add($vbox); # A combobox demonstrating cell renderers, separators and # insensitive rows # my $frame = Gtk2::Frame->new("Some stock icons"); $vbox->pack_start($frame, FALSE, FALSE, 0); my $box = Gtk2::VBox->new(FALSE, 0); $box->set_border_width(5); $frame->add($box); my $model = create_stock_icon_store(); my $combo = Gtk2::ComboBox->new_with_model($model); undef $model; $box->add($combo); my $renderer = Gtk2::CellRendererPixbuf->new(); $combo->pack_start($renderer, FALSE); $combo->set_attributes($renderer, "pixbuf", PIXBUF_COL); $combo->set_cell_data_func($renderer, \&set_sensitive); $renderer = Gtk2::CellRendererText->new(); $combo->pack_start($renderer, TRUE); $combo->set_attributes($renderer, "text", TEXT_COL); $combo->set_cell_data_func($renderer, \&set_sensitive); $combo->set_row_separator_func(\&is_separator); $combo->set_active(0); # A combobox demonstrating trees. # $frame = Gtk2::Frame->new("Where are we ?"); $vbox->pack_start($frame, FALSE, FALSE, 0); $box = Gtk2::VBox->new(FALSE, 0); $box->set_border_width(5); $frame->add($box); $model = create_capital_store (); $combo = Gtk2::ComboBox->new_with_model($model); # undef $model; $box->add($combo); $renderer = Gtk2::CellRendererText->new(); $combo->pack_start($renderer, TRUE); $combo->set_attributes($renderer, "text", 0); $combo->set_cell_data_func($renderer, \&is_capital_sensitive); my $path = Gtk2::TreePath->new_from_indices(0, 8); my $iter = $model->get_iter($path); undef $path; $combo->set_active_iter($iter); # A GtkComboBoxEntry with validation. # $frame = Gtk2::Frame->new("Editable"); $vbox->pack_start($frame, FALSE, FALSE, 0); $box = Gtk2::VBox->new(FALSE, 0); $box->set_border_width(5); $frame->add($box); $combo = undef; eval { $combo = Gtk2::ComboBox->text_new_with_entry(); }; eval { $combo = Gtk2::ComboBoxEntry->new_text(); } if (!$combo); fill_combo_entry($combo); $box->add($combo); my $entry = Gtk2::MaskEntry->new(); $entry->set('mask', "^([0-9]*|One|Two|2\x{00bd}|Three)\$"); $combo->remove($combo->get_child()); $combo->add($entry); } if (!$window->visible()) { $window->show_all(); } else { $window->destroy(); } return $window; } 1; __END__ Copyright (C) 2003 by the gtk2-perl team (see the file AUTHORS for the full list) This library is free software; you can redistribute it and/or modify it under the terms of the GNU Library General Public License as published by the Free Software Foundation; either version 2.1 of the License, or (at your option) any later version. This library is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Library General Public License for more details. You should have received a copy of the GNU Library General Public License along with this library; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. Gtk2-1.24992/gtk-demo/dialog.pl0000644000175000017500000001147213076462676014452 0ustar lacklack#!/usr/bin/perl -w # # Dialog and Message Boxes # # Dialog widgets are used to pop up a transient window for user feedback. # package dialog; use Glib qw(TRUE FALSE); use Gtk2; my $window = undef; my $entry1 = undef; my $entry2 = undef; my $i = 1; sub message_dialog_clicked { my $dialog = Gtk2::MessageDialog->new ($window, [qw/modal destroy-with-parent/], 'info', 'ok', sprintf "This message box has been popped up the following\nnumber of times:\n\n%d", $i); $dialog->run; $dialog->destroy; $i++; } sub interactive_dialog_clicked { #my $dialog = Gtk2::Dialog->new_with_buttons ("Interactive Dialog", my $dialog = Gtk2::Dialog->new ("Interactive Dialog", $window, [qw/modal destroy-with-parent/], 'gtk-ok', 'ok', "_Non-stock Button", 'cancel'); my $hbox = Gtk2::HBox->new (FALSE, 8); $hbox->set_border_width (8); $dialog->vbox->pack_start ($hbox, FALSE, FALSE, 0); my $stock = Gtk2::Image->new_from_stock ('gtk-dialog-question', 'dialog'); $hbox->pack_start ($stock, FALSE, FALSE, 0); my $table = Gtk2::Table->new (2, 2, FALSE); $table->set_row_spacings (4); $table->set_col_spacings (4); $hbox->pack_start ($table, TRUE, TRUE, 0); my $label = Gtk2::Label->new_with_mnemonic ("_Entry 1"); $table->attach_defaults ($label, 0, 1, 0, 1); my $local_entry1 = Gtk2::Entry->new; $local_entry1->set_text ($entry1->get_text); $table->attach_defaults ($local_entry1, 1, 2, 0, 1); $label->set_mnemonic_widget ($local_entry1); $label = Gtk2::Label->new_with_mnemonic ("E_ntry 2"); $table->attach_defaults ($label, 0, 1, 1, 2); my $local_entry2 = Gtk2::Entry->new; $local_entry2->set_text ($entry2->get_text); $table->attach_defaults ($local_entry2, 1, 2, 1, 2); $label->set_mnemonic_widget ($local_entry2); $hbox->show_all; my $response = $dialog->run; if ($response eq 'ok') { $entry1->set_text ($local_entry1->get_text); $entry2->set_text ($local_entry2->get_text); } $dialog->destroy; } sub do { if (!$window) { $window = Gtk2::Window->new; $window->set_title ("Dialogs"); $window->signal_connect (destroy => sub { $window = undef; 1 }); $window->set_border_width (8); my $frame = Gtk2::Frame->new ("Dialogs"); $window->add ($frame); my $vbox = Gtk2::VBox->new (FALSE, 8); $vbox->set_border_width (8); $frame->add ($vbox); # Standard message dialog my $hbox = Gtk2::HBox->new (FALSE, 8); $vbox->pack_start ($hbox, FALSE, FALSE, 0); my $button = Gtk2::Button->new_with_mnemonic ("_Message Dialog"); $button->signal_connect (clicked => \&message_dialog_clicked); $hbox->pack_start ($button, FALSE, FALSE, 0); $vbox->pack_start (Gtk2::HSeparator->new, FALSE, FALSE, 0); # Interactive dialog $hbox = Gtk2::HBox->new (FALSE, 8); $vbox->pack_start ($hbox, FALSE, FALSE, 0); $vbox2 = Gtk2::VBox->new (FALSE, 0); $button = Gtk2::Button->new_with_mnemonic ("_Interactive Dialog"); $button->signal_connect (clicked => \&interactive_dialog_clicked); $hbox->pack_start ($vbox2, FALSE, FALSE, 0); $vbox2->pack_start ($button, FALSE, FALSE, 0); my $table = Gtk2::Table->new (2, 2, FALSE); $table->set_row_spacings (4); $table->set_col_spacings (4); $hbox->pack_start ($table, FALSE, FALSE, 0); my $label = Gtk2::Label->new_with_mnemonic ("_Entry 1"); $table->attach_defaults ($label, 0, 1, 0, 1); $entry1 = Gtk2::Entry->new; $table->attach_defaults ($entry1, 1, 2, 0, 1); $label->set_mnemonic_widget ($entry1); $label = Gtk2::Label->new_with_mnemonic ("E_ntry 2"); $table->attach_defaults ($label, 0, 1, 1, 2); $entry2 = Gtk2::Entry->new; $table->attach_defaults ($entry2, 1, 2, 1, 2); $label->set_mnemonic_widget ($entry2); } if (!$window->visible) { $window->show_all; } else { $window->destroy; $window = undef; } return $window; } 1; __END__ Copyright (C) 2003 by the gtk2-perl team (see the file AUTHORS for the full list) This library is free software; you can redistribute it and/or modify it under the terms of the GNU Library General Public License as published by the Free Software Foundation; either version 2.1 of the License, or (at your option) any later version. This library is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Library General Public License for more details. You should have received a copy of the GNU Library General Public License along with this library; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. Gtk2-1.24992/gtk-demo/gnome-gsame.png0000644000175000017500000001024713076462676015562 0ustar lacklackPNG  IHDR00WgAMA1_^IDATxYdWy[{U3ӳ3a0+f1F !HI7x,g~Swoߟk03֫6Y,bMWr?[?;j1񪴜S|zoY|쳷S;s%>sj\3Җ\+A {?+%y2 P/=S .>٘cƘ2j;_ 'VF;k wN;njYo9-dG-ӿw?ӟ=B()9 4&0L.~$%KL(K~| _ѹ|h#B4xۍKx`Fi猆F?Ikm!qcQ%7 BY`x)uJRc|'g8w:{S@6s:.&R0 =y;zRJß[޲t_}&[i؋.YoKU!Ejg;*sf[)y@E ^G٠L^B6v@$9J@YJ@cp@hs;}jP `8V\Ib+~fժR9֘0r#?chEb5USб2wdЙBDEF(ՠ-4ƶu ra"nR͜>Y1U @2q{78asC^,yr\ģ'\kW!WbJCvFdIJjDS2B #l\S8IMJV@]e߳83lu2mu6ZYÿvW녙th6jLLX{wNgy=;wd#lm'Y,}T[ 6NsD:bj^tG)ǟ{Mo󙝇{.[Fxt+(M AElZET'12nF/"QlҜ02J+%Am D)C~l"oKm! dn[yǹOyԣ%!)RjV)5jK)kRJ8L]" i昭nil M3"݄"OZVc6F.[#7UPxSDq[kSkmbst!D@<ߪv:;f4ZG(9Α) /Í#$'eZbkAx>.v^ @^޶ֶMkmZ+1Ba1BITn+$:vgjT3p$(c'h3Mr&&4 HPiz6%t N;jZkT!Xp55afvVhCE4Mb"Ռ7N:!hk3\ Jr$PF;* 6|k1L5!D0?9uY>@1nRIiĒ:6/ʉ Ɉ2ֶhQ8r\g*h^1b!D`E`3U @=v޴V0M "I $ 2.f[ `uu{W[Bkg^ ,hkB$Z;֎$W|?Ԭ7pGjz}أO<,mFWu̥O]{l#3-R=И^ZI+~`6t kur>dZ֒8Ɋ3T̬\3*_;w.6?:p`f9zDgnĮKk)ԆfBXJ Zztx{n޿w5g1IT+dy&,#I0 |$[7 n[H^ѷΏN8%>Zq^sw~) !zvb(pd:H(4IyFRE IZQ=.TZpZ%^+x:򖛿!If)I>3\Gh)cTZ)cGQz@զ2rGKkkHuNIApn˅^R7a@ݡ.QuԽ];vuZ!T}jQNRT+UfXC 0&' B?LKRnsu^\yJ yv~1qFCbðpq1 !B@K)m!)W.|;}?QS 4,JV~ okwN33^zb8)q]Yx2a%b !TVTRqr)egi9#o$4Ea,Q<ׄQ\|+eƽ®z@$GIL/c&J~TN\^VmR1h!e/4OQ ]$q]_x^Dh1'{&o f@&`%4j.)!DF 4n)4ιJڻ0n^@eB'qa_|9?R5-oL Jkgѣ␰4`aaA}l6fxӾVn_LLy^8 +)," }MR]gU/mCCҀ/ \KylA[_/M-uǽv%Jy#҄Dv @tpPKQq?66*y |tKRRUVen~bՊ5.emmqAI}y`=Nm+_ϾNiJg3ޤW e)q+|%Ķ;^s1aIENDB`Gtk2-1.24992/gtk-demo/gnu-keys.png0000644000175000017500000000741413076462676015127 0ustar lacklackPNG  IHDR00WgAMA aIDATxkt]e゙[rr-M&i4IoŦC;DgPQTTguleP^Ҧ-msk~9Im}y|)̗:~yy}.qK\2C^Fd"弋Kt᪵UrL+ͷRu-YVV^zU+W (=ݽo `L-(`Fy9&NaYV왳vmۏ:/L/zefB01o2jy_8Pϱup H)B0qm_[ ȿV;@V(\{^fr(6 IG{x3cKս( *H$|)T4h?]ȂeneY9kjx4Jbd+W^y%լhB L  [|aIl2F~~+&OG @Uө|A< _ 8nSOn$I1UfV^~<`wn~ t4'8͞-ZXYyށT{߽ۿ_qǎR\RȬJ Il[8y%e^UQ5Mc_EVvϕxK"yn /﮻iK,554k>+cY=\mOw0 xmO~/P Be``}r!ʊ)- 3blя[i%hF*$LcuTcP⒊;>u{)j0%yyB` p㉸퇿]WWWwBǁQ`rJn'7†jB4E4Lo߫4kp$/w]MP5b$q|tb嗱kҲr=elt_="GeG7tM0M'߽;~rt]G"IA4¡0hhlzFF 3:$ccc$IFc8z9zG BB&Mرc<.馛)/+W||f9pEQP <.ӿxb&8ҊoRinm&77Jj-_Ƽy9s4gΝ"JY8R"}qʦa&j`A4Mlذk\k  ԾZolDUUt]_}}RL7^L@G>2EUPu.+ZJBz{zof$6JEE% ;.' ˪g΂HC "Yz@0H__/CA=ơCعs'K,acض͑#u}ctL%Oxɼ@QQQov(G&]]]]Pe1HSPX+0LښhhlॗvHũcH.iiiq,*QUΞսGbYAx|;w$;7p(*斪yϝxd0 x _bf/H_y_|'<9Bcǎ8y3˙;gPs &pl}G3RK v5V>3tZ͆O~7^/f(=>.\wI àa&M/}TM#;+#?EQQ*̟;˗zΎNod*Iii2~n}.**gdh+HOjo.a 7\rY"&6>55<.<ץ-?žp7QZVi o=B:==Xu,KpUܱAR{`?wE 'OP6ן"#QtM! 12CʛKco}wc) R0u #%'4 U?>D"Yy_?? ,kf:ōm[+k&pmTTT,]=[(x3SE_8R88I*"@+_FW\=|v4 ,\W M -郵ugsrm7d mݽ횪BP@(hB;u…5?=x'uyjS_kOYpݡ:+>6M>۾d;O5;{}#6//oY''UTTT3L'lK}ACRJ%A kBg[ԌT4hzo>JhBkVjUSÙL DUU;?vTaYvȡc=gN7=='yiT]m-mV 3KhqCowL&0 NCDz.L\Τ/y۽e˗rsM5.b$ Dcx}k+V.Ng{cC#4y/x'QV]ʫYZZꍌ Y{Q~WRnaswkwD"&w?K\{;$誂IENDB`Gtk2-1.24992/gtk-demo/assistant.pl0000644000175000017500000001422613076462676015224 0ustar lacklack#!/usr/bin/perl -w # # Assistant # # Demonstrates a sample multistep assistant. Assistants are used to divide # an operation into several simpler sequential steps, and to guide the user # through these steps. # package assistant; use strict; use warnings; use Glib ':constants'; use Gtk2; #include "demo-common.h" my $assistant = undef; my $progress_bar = undef; sub apply_changes_gradually($) { my $fraction; # Work, work, work... Gtk2::Gdk::Threads->leave(); $fraction = $progress_bar->get_fraction(); $fraction += 0.05; my $cont = TRUE; if ($fraction < 1.0) { $progress_bar->set_fraction($fraction); } else { # Close automatically once changes are fully applied. $assistant->destroy(); undef $assistant; $cont = FALSE; } Gtk2::Gdk::Threads->enter(); return $cont; } sub on_assistant_apply($$) { my ($widget, $data) = @_; # Start a timer to simulate changes taking a few seconds to apply. Glib::Timeout->add(100, \&apply_changes_gradually, undef); } sub on_assistant_close_cancel($$) { my ($widget, $assistant) = @_; $$assistant->destroy(); undef $$assistant; } sub on_assistant_prepare($$$) { my ($widget, $page, $data) = @_; my ($current_page, $n_pages, $title); $current_page = $widget->get_current_page(); $n_pages = $widget->get_n_pages(); $title = sprintf("Sample assistant (%d of %d)", $current_page + 1, $n_pages); $widget->window()->set_title($title); # The fourth page (counting from zero) is the progress page. The # user clicked Apply to get here so we tell the assistant to commit, # which means the changes up to this point are permanent and cannot # be cancelled or revisited. if ($current_page == 3) { $widget->commit(); } } sub on_entry_changed($$) { my ($widget, $data) = @_; my $assistant = $data; my ($current_page, $page_number, $text); $page_number = $assistant->get_current_page(); $current_page = $assistant->get_nth_page($page_number); $text = $widget->get_text(); if ($text && $text ne '') { $assistant->set_page_complete($current_page, TRUE); } else { $assistant->set_page_complete($current_page, FALSE); } } sub create_page1($) { my $assistant = shift; my ($box, $label, $entry, $pixbuf); $box = Gtk2::HBox->new(FALSE, 12); $box->set_border_width(12); $label = Gtk2::Label->new("You must fill out this entry to continue:"); $box->pack_start($label, FALSE, FALSE, 0); $entry = Gtk2::Entry->new(); $box->pack_start($entry, TRUE, TRUE, 0); $entry->signal_connect("changed", \&on_entry_changed, $assistant); $box->show_all(); $assistant->append_page($box); $assistant->set_page_title($box, "Page 1"); $assistant->set_page_type($box, 'GTK_ASSISTANT_PAGE_INTRO'); $pixbuf = $assistant->render_icon('gtk-dialog-info', 'GTK_ICON_SIZE_DIALOG'); $assistant->set_page_header_image($box, $pixbuf); undef $pixbuf; } sub create_page2($) { my $assistant = shift; my ($box, $checkbutton, $pixbuf); $box = Gtk2::VBox->new(12, FALSE); $box->set_border_width(12); $checkbutton = Gtk2::CheckButton->new_with_label("This is optional data, you may continue " . "even if you do not check this"); $box->pack_start($checkbutton, FALSE, FALSE, 0); $box->show_all(); $assistant->append_page($box); $assistant->set_page_complete($box, TRUE); $assistant->set_page_title($box, "Page 2"); $pixbuf = $assistant->render_icon('gtk-dialog-info', 'GTK_ICON_SIZE_DIALOG'); $assistant->set_page_header_image($box, $pixbuf); undef $pixbuf; } sub create_page3($) { my $assistant = shift; my ($label, $pixbuf); $label = Gtk2::Label->new ("This is a confirmation page, press 'Apply' to apply changes"); $label->show(); $assistant->append_page($label); $assistant->set_page_type($label, 'GTK_ASSISTANT_PAGE_CONFIRM'); $assistant->set_page_complete($label, TRUE); $assistant->set_page_title($label, "Confirmation"); $pixbuf = $assistant->render_icon('gtk-dialog-info', 'GTK_ICON_SIZE_DIALOG'); $assistant->set_page_header_image($label, $pixbuf); undef $pixbuf; } sub create_page4($) { my $assistant = shift; my ($page); $page = Gtk2::Alignment->new (0.5, 0.5, 0.5, 0.0); $progress_bar = Gtk2::ProgressBar->new(); $page->add($progress_bar); $page->show_all(); $assistant->append_page($page); $assistant->set_page_type($page, 'GTK_ASSISTANT_PAGE_PROGRESS'); $assistant->set_page_title($page, "Applying changes"); # This prevents the assistant window from being # closed while we're "busy" applying changes. $assistant->set_page_complete($page, FALSE); } sub do { my $do_widget = shift; if (!$assistant) { $assistant = Gtk2::Assistant->new (); $assistant->set_default_size(-1, 300); $assistant->set_screen ($do_widget->get_screen) if Gtk2->CHECK_VERSION (2, 2, 0); create_page1 ($assistant); create_page2 ($assistant); create_page3 ($assistant); create_page4 ($assistant); $assistant->signal_connect ("cancel", \&on_assistant_close_cancel, \$assistant); $assistant->signal_connect ("close", \&on_assistant_close_cancel, \$assistant); $assistant->signal_connect ("apply", \&on_assistant_apply, undef); $assistant->signal_connect ("prepare", \&on_assistant_prepare, undef); } if (!$assistant->visible()) { $assistant->show(); } else { $assistant->destroy(); $assistant = undef; } return $assistant; } 1; __END__ Copyright (C) 2003 by the gtk2-perl team (see the file AUTHORS for the full list) This library is free software; you can redistribute it and/or modify it under the terms of the GNU Library General Public License as published by the Free Software Foundation; either version 2.1 of the License, or (at your option) any later version. This library is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Library General Public License for more details. You should have received a copy of the GNU Library General Public License along with this library; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. Gtk2-1.24992/gtk-demo/gnome-foot.png0000644000175000017500000000554413076462676015441 0ustar lacklackPNG  IHDR/0#gAMA1_ IDATxYkly=wfvvfܗ)QŪl#HqdmT i4N A(n ] l<8v*#%RDY$MJ>?2T ,T\0s _e/ׇ o>Н:qj^ڷo߉mXpd WMjo1W[?kll,cСT*5:6M$eW2ob x3}3}xgPUjI3&c+wM& rտ%v{v$+Q):ښNƘUOdΑ/R7ODzHKR"xDb!zKAHiY0 RedLU(fyQݵr]] Cj6ѪU!J-a>奂Jz|q 琈E0ym{A=J|7xx#luS6}Wz6#gޘ%r[%-Mi|Zov,e |YQp"z}_wԪ_hUvyc ѦY|)B&_; qիtMb\^cϏ& G}F+8nu;hdhp6Zbew7%5 3 3j`*-nxw-8ph$Rwmcg.#\ٚmd몂g Kdj,J(*}k_z~'H^sk#-dz7vq5_VONKF8%5*'Qc]Xioiٟĥûo岹#vDP0Ƕ`YoozVYT?/l$,D!M%c-V0̟lV+T%drL\0y?mlВ'FGL%4D2IEM MF>Oy3׳ݽ}X|wo_o,l biuS/#[(=948Ǡ`zz{a[aYGPIg,# Hu^-Cm]X_;+{>VWU mX0, ϣ4C<ЪW`Y"Fni|e̤Pk $>\|r=N"6  CJYǒb!ǶZ@MC#\V˫V)c=vjn̻ [5 VIa[xAqD1׶ XYZd2gr[AWfD/Wk3GiZeyx'eBD1D8%kkeL%OO<^-Fޜ$ 1-;єdhF$EmS'eQ]Ӊm0M,g2x8v,~7|/jf0ֽ%ю^0l8$-I (J=j;.XaZbMo;MC| -Q8<< parent; my $is_child1 = ($child == $paned->child1); my $resize = $is_child1 ? $paned->child1_resize : $paned->child2_resize; my $shrink = $is_child1 ? $paned->child1_shrink : $paned->child2_shrink; $child->parent->remove ($child); if ($is_child1) { $paned->pack1 ($child, !$resize, $shrink); } else { $paned->pack2 ($child, !$resize, $shrink); } } sub toggle_shrink { my ($widget, $child) = @_; my $paned = $child->parent; my $is_child1 = ($child == $paned->child1); my $resize = $is_child1 ? $paned->child1_resize : $paned->child2_resize; my $shrink = $is_child1 ? $paned->child1_shrink : $paned->child2_shrink; $child->parent->remove ($child); if ($is_child1) { $paned->pack1 ($child, $resize, !$shrink); } else { $paned->pack2 ($child, $resize, !$shrink); } } sub create_pane_options { my ($paned, $frame_label, $label1, $label2) = @_; my $frame = Gtk2::Frame->new ($frame_label); $frame->set_border_width (4); my $table = Gtk2::Table->new (3, 2, TRUE); $frame->add ($table); my $label = Gtk2::Label->new ($label1); $table->attach_defaults ($label, 0, 1, 0, 1); my $check_button = Gtk2::CheckButton->new ("_Resize"); $table->attach_defaults ($check_button, 0, 1, 1, 2); $check_button->signal_connect (toggled => \&toggle_resize, $paned->child1); $check_button = Gtk2::CheckButton->new ("_Shrink"); $table->attach_defaults ($check_button, 0, 1, 2, 3); $check_button->set_active (TRUE); $check_button->signal_connect (toggled => \&toggle_shrink, $paned->child1); $label = Gtk2::Label->new ($label2); $table->attach_defaults ($label, 1, 2, 0, 1); $check_button = Gtk2::CheckButton->new ("_Resize"); $table->attach_defaults ($check_button, 1, 2, 1, 2); $check_button->set_active (TRUE); $check_button->signal_connect (toggled => \&toggle_resize, $paned->child2); $check_button = Gtk2::CheckButton->new ("_Shrink"); $table->attach_defaults ($check_button, 1, 2, 2, 3); $check_button->set_active (TRUE); $check_button->signal_connect (toggled => \&toggle_shrink, $paned->child2); return $frame; } my $window = undef; sub do { if (!$window) { $window = Gtk2::Window->new; $window->signal_connect (destroy => sub { $window = undef; 1 }); $window->set_title ("Panes"); $window->set_border_width (0); my $vbox = Gtk2::VBox->new (FALSE, 0); $window->add ($vbox); my $vpaned = Gtk2::VPaned->new; $vbox->pack_start ($vpaned, TRUE, TRUE, 0); $vpaned->set_border_width (5); my $hpaned = Gtk2::HPaned->new; $vpaned->add1 ($hpaned); my $frame = Gtk2::Frame->new; $frame->set_shadow_type ('in'); $frame->set_size_request (60, 60); $hpaned->add1 ($frame); my $button = Gtk2::Button->new ("_Hi there"); $frame->add ($button); $frame = Gtk2::Frame->new; $frame->set_shadow_type ('in'); $frame->set_size_request (80, 60); $hpaned->add2 ($frame); $frame = Gtk2::Frame->new; $frame->set_shadow_type ('in'); $frame->set_size_request (60, 80); $vpaned->add2 ($frame); # Now create toggle buttons to control sizing $vbox->pack_start (create_pane_options ($hpaned, "Horizontal", "Left", "Right"), FALSE, FALSE, 0); $vbox->pack_start (create_pane_options ($vpaned, "Vertical", "Top", "Bottom"), FALSE, FALSE, 0); $vbox->show_all; } if (!$window->visible) { $window->show; } else { $window->destroy; $window = undef; } return $window; } 1; __END__ Copyright (C) 2003 by the gtk2-perl team (see the file AUTHORS for the full list) This library is free software; you can redistribute it and/or modify it under the terms of the GNU Library General Public License as published by the Free Software Foundation; either version 2.1 of the License, or (at your option) any later version. This library is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Library General Public License for more details. You should have received a copy of the GNU Library General Public License along with this library; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. Gtk2-1.24992/gtk-demo/sizegroup.pl0000644000175000017500000001220313076462676015233 0ustar lacklack#!/usr/bin/perl -w # # Size Groups # # GtkSizeGroup provides a mechanism for grouping a number of # widgets together so they all request the same amount of space. # This is typically useful when you want a column of widgets to # have the same size, but you can't use a GtkTable widget. # # Note that size groups only affect the amount of space requested, # not the size that the widgets finally receive. If you want the # widgets in a GtkSizeGroup to actually be the same size, you need # to pack them in such a way that they get the size they request # and not more. For example, if you are packing your widgets # into a table, you would not include the GTK_FILL flag. # package sizegroup; use strict; use Glib qw(TRUE FALSE); use Gtk2; my $window = undef; # # Convenience function to create an option menu holding a number of strings # sub create_option_menu { my @strings = @_; if (Gtk2->CHECK_VERSION (2, 4, 0)) { my $combo_box = Gtk2::ComboBox->new_text; foreach my $str (@strings) { $combo_box->append_text ($str); } $combo_box->set_active (0); return $combo_box; } else { # on older versions, Gtk2::ComboBox is not available. my $menu = Gtk2::Menu->new; foreach my $str (@strings) { my $menu_item = Gtk2::MenuItem->new_with_label ($str); $menu_item->show; $menu->append ($menu_item); } my $option_menu = Gtk2::OptionMenu->new; $option_menu->set_menu ($menu); return $option_menu; } } sub add_row { my ($table, $row, $size_group, $label_text, @options) = @_; my $label = Gtk2::Label->new_with_mnemonic ($label_text); $label->set_alignment (0, 1); $table->attach ($label, 0, 1, $row, $row + 1, [qw/expand fill/], [], 0, 0); my $option_menu = create_option_menu (@options); $label->set_mnemonic_widget ($option_menu); $size_group->add_widget ($option_menu); $table->attach ($option_menu, 1, 2, $row, $row + 1, [], [], 0, 0); } sub toggle_grouping { my ($check_button, $size_group) = @_; # GTK_SIZE_GROUP_NONE is not generally useful, but is useful # here to show the effect of GTK_SIZE_GROUP_HORIZONTAL by # contrast. my $new_mode = $check_button->get_active ? 'horizontal' : 'none'; $size_group->set_mode ($new_mode); } sub do { my @color_options = qw/Red Green Blue/; my @dash_options = qw/Solid Dashed Dotted/; my @end_options = qw/Square Round Arrow/; if (!$window) { $window = Gtk2::Dialog->new_with_buttons ("GtkSizeGroup", undef, [], 'gtk-close' => 'none'); $window->set_resizable (FALSE); $window->signal_connect (response => sub { $window->destroy; 1 }); $window->signal_connect (destroy => sub { $window = undef; 1 }); my $vbox = Gtk2::VBox->new (FALSE, 5); $window->vbox->pack_start ($vbox, TRUE, TRUE, 0); $vbox->set_border_width (5); my $size_group = Gtk2::SizeGroup->new ('horizontal'); # Create one frame holding color options # my $frame = Gtk2::Frame->new ("Color Options"); $vbox->pack_start ($frame, TRUE, TRUE, 0); my $table = Gtk2::Table->new (2, 2, FALSE); $table->set_border_width (5); $table->set_row_spacings (5); $table->set_col_spacings (10); $frame->add ($table); add_row ($table, 0, $size_group, "_Foreground", @color_options); add_row ($table, 1, $size_group, "_Background", @color_options); # And another frame holding line style options # $frame = Gtk2::Frame->new ("Line Options"); $vbox->pack_start ($frame, FALSE, FALSE, 0); $table = Gtk2::Table->new (2, 2, FALSE); $table->set_border_width (5); $table->set_row_spacings (5); $table->set_col_spacings (10); $frame->add ($table); add_row ($table, 0, $size_group, "_Dashing", @dash_options); add_row ($table, 1, $size_group, "_Line ends", @end_options); # And a check button to turn grouping on and off my $check_button = Gtk2::CheckButton->new ("_Enable grouping"); $vbox->pack_start ($check_button, FALSE, FALSE, 0); $check_button->set_active (TRUE); $check_button->signal_connect (toggled => \&toggle_grouping, $size_group); } if (!$window->visible) { $window->show_all; } else { $window->destroy; } return $window; } 1; __END__ Copyright (C) 2003 by the gtk2-perl team (see the file AUTHORS for the full list) This library is free software; you can redistribute it and/or modify it under the terms of the GNU Library General Public License as published by the Free Software Foundation; either version 2.1 of the License, or (at your option) any later version. This library is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Library General Public License for more details. You should have received a copy of the GNU Library General Public License along with this library; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. Gtk2-1.24992/gtk-demo/alphatest.png0000644000175000017500000006364113076462676015356 0ustar lacklackPNG  IHDR|B}>gAMA|Q cHRMo?r$m_j<Wmg,IDATxb?(`i0 F(> F Q0 F(! F Q0 F(! F Q0 F(! F Q0 F(! F Q0 F(! F Q0 9]:= h`3Z G[`Q02@G(`-G(`-G(`-G(`-G(`-G(`-G(`-G(`-G(`-G(`-G(`-G(`-G(`-G(`-G(`-G(`-G(`-G(`-G(`-G(`-G(R@,Q0 F~8.h Q0 FQ0 FQ0 FQ0 FQ0 FQ0 FQ0 FQ0 FQ0 FQ0 FQ0 FQ0 FQ0 FQ0 FQ0 FQ0 FQ0 FQ0 FQ0 FQ0 FQ0 FQ0 FQ0 FQ0 FQ0 FQ0 FQ0 FQ0 F v(C D,R @Z``d"ڭ` b?,SLWRdh$7|4CH4 UPvfdd3 gm0$riUR=7 (Y^`8FXrpIgt(( Obm(F5@ qE7B+:`eD(ʠN< $uG"=X!܋@\?`|kn  c$Fp@'FF \SxIg*ZcR@{  ȿHhr uj45cac1#iUQ4}E;D-T2?,H͋U^$&,#, ta|HwTgF(  |X!0F.W"ˀ@c)!L6 aAFF

J˙{Ie`*z .opf N{ e\0Vy02BZxh y/ƚ:$-8* t? S<a![&^(@9k(u09 u)#*F{hnhR9@+Ѐ_?D1 ,5i0N!#\?:3AP\u`<A!5^VDi&j024M j-у]'`U`a&D@]࣏`zlCȒm"v`a [tz5#R,CSϸd@z+0@Y[K¿PQ0 h h#NXvB}vQKA10i.J=G--|:nh+a $pCw"nGŶ,;؊ {>WVOv3V|VON˙ , >.[=6#7 F4PC:-{I3t`p?Rw|ZctC[H4,n',Z7xҎNdufѕ@Jh?M'7!$Q]RҢ@,7sj7踂l ѥ!L1`+`L ޾mrژ3hn!db5qNiO!=,98-'@;>Ⱦ]ٟX{ft< &]hA9]ƭ< ^(p 931q@MPy NrynX̤ Y]eyjD"4#v84`sK.#@ |X|=0g"ҁ.M74T@LjÍ "K PnX9 WdL#t <&$ԁydElYv_Ԍ!Cr;VOpW02, K U@75ő)fA갫$[eO)ӌqotg|FYHe#RflQgD3tUB!R<@X]0w .dZ+i t%aK*#}HQLzU?HsYL%5B##rL!@Fd7 TXoNxt2]A X0v ]ЍrK|2J^r z vhl4<2@W댈$= $0‰.9L`Y Np1@/Jeu,ldY*\v|Q7= {P z0(Ԟ t;l?tfEtd+Z`aT4<@:ms2*D! Hص 7@F8#Al+!U2x !U Ԇ< RCVTbP ^ π-SoB3tP*PqJ 6`퟼RBFB6Vy;l? ~C4Y9v*J1Q.Q!ɦ;v2XXAѥgN+Y :,C[J[u/~~q! QRP2IjvoMgҁD9 N'ygdI0-z7lB,z|!}i8i| ['D!sf}n{SA7q0R-l i!=Ǚz"ub e52,FsE݃p?;bv+$|o'6<ȳׄ+i v/YA0wTЍ $`de@]*H ;+ƉKrJ Djι/tXe{X;(;o>N4U4p;Z(̀m[#҆3/mbwSD|<n^08B-EDܝjq,/_i [XkB\K\!;nSD.az}&qG\&@"pu{D&bsFXfd?8%Ī|/.ˀgF"nS Ԥ`f2,c?.z$'K'~ +naJ?(HI2/IW` tձr FD9$5i@QPWx?c8d?R ^f`VΩ].n?:r!l 8'P֩٠Bco!4aSx\ئgFjdf6 Zӟp`@ HόyZ&0Tk fϻE-̜Z|'t"-eRP4QM;p{aY"` @SGRPCBÚ)ᣨЋi` -/ 3YX>*Izn=0 #p$F3,HV& (,&X=$q˯`` [D y _.sXI[Old?]ʓe{4o~_[G܈ .ݔ)杓.%%hClD=ӂƫ֫ _m (u dd~N7{sQ3->s m7S  XVQ+`Xʎ}SWDI!P"1I` hl#]OFAXà,ǘL\ @0Uևn}m4#Ĵ~BVmId~.6`n?de @޵ ,l$vXXG`D ,RQ@4ugύ?w1ŭ=פ-!*Gr]O̽Q.XN}1* D= LdjP+cHsCHr; {ܯ Ur5(Vtv$[&;䟝<2%uM;Y*1|ɲ| ]"ISf}5Pp0nTdNPA:wG"3Iji܏K*NxH o"=TXgH:| = qah3p`gg\pǪ&yi+$$jIdzjIo{{6l}t41I/Z[/ې)-,F}~m5 K)8 19P@{eYKw$I0E @"+T]q<]oV=dzeCLp67TIJʎ2xgbӟ G߅}!35tgnko0L}oRę1,qJ'^mh')! $"%;)د,s$9(N5Ԥ.bC uYemb쵴`ox %ygo0 Ca# 4l =;P2 0+q+zO wGsX'?}I ER#܎!*K^|AUY6$գ[ٜIBi /$٣{͵(ѥBh*&iӴNݲo~SƘ7 _Q&` v.o]S}kfHSC-@;J*W0C6p%A2p-@C:Jՠ+y|ڮO&jq@^ѼV|M;}/Js`2JlOЦA2m@ tH,0=s9g;' hD}';_,O)x_J)`m琿gZQS}=IS;x*!1k@'-I`|(Fh2N,& 3X-Wtp;'}e'<)[TӨ架9]jaU E2Ĭ4hWUB-.$sϬ39!}x'v@;iȴ(O4 J$Z{{eK+Gy< qa(lo +`c [!SЩ?RN{qv?r ߃݂_Q ZBՁfm"u6x-{z{gJFUL<~q"d%)mFPg-:d>f2Foy'T;UosEn@_/|e?Ø٠m<>21V$Pܳ)Ti]vӱ cۤ qFw 2$Wʝh9{4$):pVY|31unWȻ#bǫkj% lw<,fFo ax< }F7_^熧 'ڂ04<_?*ȍpC8,Z´KМ-W)|FeB%wfEVm!Aչ3Q4zhKv<ڍah4+0ð @T4,Ai#K iqPdYz/:r|X&Rz3^/Dډ䃇A*z XZhh(Nêp9'6=RXa& drѣ*Ct{=}2; {B`2UāWR I{m)lGKR\E7lulw̱* @Q&B҉uԕxS1wC[2=kTDTSapZi>Ydҧ]{#o]Wa&.FCtD=[ZI&8a1!1!>},Q KN?. u{iDF+A;=lˣ{4_C^ P1Skdx/<9L.I0=eyyN)[3 k 'PY_em#|P\ Ң~VDP0iIp+:C,Z{/4Ts1av)f PI@ap#R0N>*E1]#e:< na`bLX“ 0JDWu&9/v~?s2*H}6=/ %ɦ"3ԨGf BuDLk;. s|'ج 0pB"l`Z+)xeӢi~}vވz)@2,02q;0kg;Z fG3'SQTL{e&vIвLEcr8^a?G6zXT&BISg=0 B0%&L9 c{ @!A҄ ``ÿU@#3;2,fN ӋW:vsRHbldiHV4{( @Xa\jYd}jG<{ %=> eMg땓 m]E29.ckGaaXNfũf)9rS]1+ZA,tG&# k(L fvl+L)\PGa 6=QTdp $6LvyWP>~?w70oa /FFVٗ6*UN2@g*NNLw _H9TAKexa4%a}ߘrH)$ID"ؽZD_7=7ucI>TE"+G,7IG+{$o";?ӛ"1Ϡ\1^)S$>NԴG^b F+7]!k6(Y2.1>oGrea5$H>R*ie[bv;znW4CN@JyEo+ -2&MilǁMOW:}[{ QQOL0N DXB %h+J@Y&8tyno@ $l >b5d8>}Ԋ'2N@uO#q9بjUS6S):OF@ y raX &_E#LIL 4֬M~#k܉< b" ,H )OSMceaYCDktLmup [D):*7'B'%iBE<^E% g)؄jJ;9ֻFd; Eh}4zT%1+f CESwGo,;gFL=/钱*z(6F4.*+& !"ѣ19 @ d3 gԾD FT&״>_!Qq {F,`_ OL_ϥ_n;tfUՠ !KFJ˧jlCH2w&~yJ!.WJFJ9YLcsWrfjӗ6g LX4͹Z)cĻCn9`@ExbDxs t htgZZF蟀8Ja]RJI ).I&PI"#f#a>Wڵ\lf ye|>QUYd"U]8|a}</fp?*'zx)7>k+yV(rrKzɒ=2Ç1u½jTn:᬴sR'p*T/KYTŒgBߔ"x Mn*$TO p=9k@ @l,l? J /QKG[UmN/\5XvU|+[>r\@] $R/c]Nj QEp`fYA'ja<6+Ʈocƭ U, K( &h:#(wU%">*rKylI!iؖ\_s4LNxɍάh[&3:Ia* 0[ |ҨABDO+g{v;Ql9 IJS͆`uhJ’Նb8:}YWdoulArdWb5wWV_pVW XdґR?Lm)CZďyg$tux)OAr:dV^ g(XRҰ-R'T4ц\iǟXx%6y!diϰ18GsV3?oȻa(/:@b ŗ1`(}ֲsb=0oZE{۝|Vy03X9j_)sy~viBesG)oe =ssA#TI !s2nn9Iy^]Zd=]z$}3+2ۈ]"Ɠ+k@ `*:%[{N#{8)[rҳG*ߙvE54*=̆[[N* W?k4o0SV -12JE#j Xg,Tº<3GHӏ.3WTzatM.[Ł0lYK0xž$ ;]H.@k̇] 0 t`>$@Gk?/Ikg g>ˈ~]EpoWbpdAui,=/MlzJS tEAd=""2 19ak *!`D:lf,>T1GFc6 : 70#+ZD8d-hMO?x2!fY{BտLgZP|z |Uu#D٣RҐ*mW'Jr\<7]0 Q( 蘀)-2%Cc%t.DZ-)/A;6lrрg5'']^Q$D gcnj}*oxH;ū<,K&kg}7cd1{~,_eO(دN;-EZ$cYŞaG|Àm I&dJ1dRj!.r&$|/s|szR.؄C=0Ke6PhƠ'!w_58S$':E1st}a B;c V`h)bKq]:p"qȎ[YvjݏYf̳$=kX)MެH,4u[~%srЈU{W˦퐺0I+$,+zy{#%w{|`[3Ɛi%+nx"2i:hM @VJuGX`%i/3H4P!a >5ZSr{4tA1}5Ii,_K";OA4>Pw80 LG>03&2&NQ DBU!MrGr}1eYa\wvqd6̞9OYW{D5J/qfRK߬nRo'W])8*Y*8N.(q9on]ʳ6 kWdԥP5U>]M  z$t?R&obDO|(y#vR X׃Z@& 6Z0psH,gfu@|g@/TC#Z(/80zN!ۜ4 LaW .$?ZIO\guЂO@wM[ 1`q sn(<[V*sa);T?LئFDs/#-ȇaڅȆ5OEp#Q?\@a t T@KAܱ=ŽD.q ?-?}5c4+iA(]i@aH?lv͊4t XnC;$,p@7KUlj{;wpv4iRh;q /I'3k݌z -D@@&ʷG5(BjyhΜNʢҜa@tr~ YhEJn6 $#EUJ?8JH(^}?5k+8uЯΒk% Z"]0 sF`؅-x cp&X#m'G>IDqDnq 33+9XtA f-to.c w=7r4-j9kNz+HGCIx$=HrqEoxI=EԊKZu JiF(~Hi(j_r:SEZ񰝩 VƱw|B:z@:J[G*I^C>!{.{ӒOrFrnj1pPsޜ\OBwqSK^QB >s,L8hFf+ Tgw':/ra{M$ ,`UI5!P.)Z*o׷1ȝ'5Q`ݐ4>V\?ŭ6o mnA2kΟ]10 4 /aeGB06 x;?`gbd&>@-T0!*U(Nj_ KGMRs$M~s2C1.Eُ˘}(M=^zucKvGڛV>v|9M.O x׳_m7*˂H:-,dvkpBQ>Y&7M34"54.J0K׏O,\j1 uZ j֋4z{eJ{5ρ A-8W݋ mbo:X"53P1 % Is|9 (~~ŀ߽y$Lej/-|(?&vY%gp >+Nq<w$d2e}r& WYTaAT;xdz-6GFaT1~lv3ihaSePX͇$Њ-֨ CH̞RTzeA9@G4Pf۳e:"`b^CH:W*NB9jldcz\HIEdw=5@CǿܒpEPElUr-`%H>ne>v([@]& e-;G4k$_zkmH :, +r=%`oͨݳJO; z>Oۦ!u`02/w ]e:D0—ZGI;/`o* 7[xXEib2 s+t >y9LÏZ@Tț gv20Zѳ۫ؿ @vv|X5c@@CG/ı+\ !K5La 3ȁ$:tjQj}O9c~G6$PSa"~(SrNfG-89hPˀvяv/@ [\3S&HK؆*B@:ڗQ0E"^Sq tEZҐn@Z+DzA|h UY=뫴4o`,G3E [ zhGEY9b[4T8ȀmE$#j2C0>#@%`+Ax1@k$`%#8i+J{]r vG<_^;stQ#p-;0w1 9?vBeEgqMcjFt-ms!5-`1BVdvV@A„{$FX9 *@P8 0yąe C9!® 6L:={!\`Cag̓@̇,2'@oGfVaq;2,*X:5p" xd>G.G.8t ,GBpaeo u0Xh H1*a~6/F QpCeB IpH]?7юT};Ia״B,z-a%٥Ѝj~IV3A+j"Nć,e 2$)j [x'j˫E;nUrZ%7&o "ZXc3@0RF J"D -]`u4,@2AMbi4Ej/t4/s VbrˇP _0BfXm†l\#M4y#_,ht #J^aqD+f'- w4s ?1zآ ڮ "C`>m3=KP }HA>` aZ9Kۧ"Ō1{xǀ.h993B%jg͋H^+:a,nvA`a@q &3DhfD\ 1kVpwAkDpOYPz*,)&<9%DhCZC{#e4\ |\l?ZKdgN}+zsB@k0gr }BjT!bPF{5}"]ZY7O!N6`-Ki~ϬHFÊ'$3g=ps?lh O瑋~b)3B!ﰞa/)*-Qcహ(֤!f!Hσ Vb/!2B8lk,c abBKp %M?κSn#C @ 59aqĀ=b@ 1_⒃ #xJ;@AG S8ց_.5~Y{!lPZ־cF+hyX>ubdޑcdY 6F*a711X x*ek@eO>x'J;g@ LOܔa7E<,`eWǐPt$ڏ5+ ͺ@[9 r ́!oE=@{F@uo(>0*&Fx&X%݋SKZ)/G((j;Lȣds!M7b3Pm"r /eM@A#9-EN#PlKpfY'h7,S``a ,Z KN]h?Z@C]5ݲ3L6c3! 1^LB2Ƚc4,:r[4ᏂQ0 1(l;j ,AsC{݈qd]=HZc! H{B GSaQ? +Q@5,e%#|3bt)І5H;pQF<NoD*;#|ƙsM#h? F(&0OCo]tdVBG(Y|]SG)## 9|o)@| F Q0 FUb@: ?P;#$d1 G"vm(d2tXRaO` F'mG(TGy g@7WB7sl/@̪{W] ul?|2R}>t@`FfeȜpAl‡&`ECT#(k푶@%jzy-G(T3yO89 P c&`4b:v"GYHGQ@1n?i*;={<ƏybB)RC h? F(x q%[baxv  z ?`@EnciZK,#*Q0 FUj_tfHMa0@o_ފ>ƀ|C*W~:Š4ZQ0 3>e@) ro Ϣ^.AїOJBb2@6o1 Q?|=j)[t//Q@5lr|#DyX Zy8p3u1ݶw3v2"] ,rk= @(j`Bs`&,F l,rqpkrRc8ԀXw/@6U7W H8 끅Q4ZQ0  \!fa Asgawe@ gW*ТTi_5Zc=Q@uPvLX q^(Ȏ,hg@rw0s* 1l+Ew0Q@P~ :gBVVR5_rM7^ueʘ1gP/D\)o6X ]=8@`lYЋt |Ն/+_):,y`둚K ߡ-G(``h`h`h`h`h`h`h`pwm &uHb10 "7'~gx|9u~>}~$Rۥ]'ckxyYkZz62 6 CY#d?^fLe8\F`Ẇ[y_dA }7o/ػAa%xeli?ɱ#;\y4> Ye©Poly%(cE3'!Opnǁ6*VWKSr\8dbuܫ=9=~' v`NiHą*+çï6mv¨r^25ı38vu墜N94;,j4"d0i᷊֭C'})FQ?Cj[Gε铖r,S WBڡr U4e|iF}sn7MH_&##Us}V+_Wu5 ݼ0ֽ}GnkCਓ]UKgFkuyn$O\%#uD\'I%JpX'w97uoswkxݚ[%| {G։DUjuk8#9V;9@uG3rY:1П[sPdD NK(ڡNR֩0&EUC)U]]5nm OZWZީh)bHY [JLL([v!q3@6P!FDWO./4W8!ہM_@E9\q:e @Owjc;tSkJ=|&ՇaT\$Dy<_ܞ&2\cR[O>xԫoZ]ruq q0IYbbyEJo1 _Jӷu$fv$3I)a}7E u **s"D>7@G;hO|G$:qkG֝ӽ*HߵOؽQ`qAN&iK\dBD)W 3aHnIɘc%! ")= \]+36u׶b.AL% C+}vߋ؁jbK$ pXձY=3BծA++-tk ?8ӹN)+'=?$(a3?JnZ^Hئ$Sc!KhrQR\_'_|ӌ#-][r`_?:<ҡ݊ 37 Pshu0ܝV}(~ ӹuW2`=qjm4 6%: 1{҃@=01-4bZ2/)Wr3 L/:PKT@NwАB)&U^yj\`s WEGߐ LR[\~MzÜP^*60"[ rIO]A}F4"΋$K7)$t5(2;Mb;AU씲]C&>pyԷuqq]1Su6vNeN` 1 k'A%.: Vl/L2f6 IwjmobH t=QLc/]d 6U)Kj̣[UVӉlu4g_:_lBjKrZ# lRR tR]myא*srL?E"?}KlsE*&uqC4bLi CCNܓwo{Sdr_iH,_9atO8-=-j0A'|nٴoQ=+SoeJigg {kMx^=^ 4Sot6n3.Ԩ. 5X| K`u7C2F@1Ǘ $} cK#o褙LQQa;A܈ m'1Q4h2s$3[8cfvfM|[6#9ڵixlm?_:TLS 2d.\*bsXRt~i5/<-Mj i58$Ѷ|ؚGQj')!b=d(` ? F( F Q0 F(! F Q0 F(! F Q0 F(! F Q0 F(! F Q0 F(! F Q0 F(! F Q0 F(! V0,$iaX _..b>ik1rNEo穴F'oG~VgOx^Wduuu2]>>٪3-yib<6g-wg@AjB&60MPs|הRW>';S@A|ZSzN)@uECui .W͎ .Tt).#QQ[(.*j μ8BwBpŸb&~i[ -IsmL y }EВe#@7w[Sx|r}ۿ,-*C;sh|hnkM͗Vȧi9d| Q>qgqq Az[4 e5'Fn,F,Dj؀BS #3 S3NS[bɷ#,NwC}yGS?8nb;q 'qF>9cbgKVZKMAt1`wTSk.GzT{*/$|QIFi;Q_Wftwvunb"bۄBͼ՞^KJOret@tKb5ע׿t;t]> \E;Ap1<vsqd$8GuVҳDtU *_`k<%T :ڸ Y +. ~n@qͰ3|+FAu 50d`qf"B.xQNH$T$c[M2>pKη&3@^Rwՙ2nu qAz[{E A|yA)I)$O L{SqOeIv!vgD9tIN [91"4Ǧhd;[[.) [C̯6 *Tj@]<mZx6[ȩᦙ5@U΁ 0p(\ 8]ۻĒ,rkwk /a\aH\mЉie^5sDA4\ϜK4# MSKTOÉKi={b)4s-mv}r6ަԘ63mҏ |]ktw[jRl.u!'ˌh\0@.EGL/ gx81l> X?cS!QC {9w޶gllc#ǯ_Qܹu7up,+ k, !]?w @u ܴry=>ّ/$~IDhxm~Gȱ=fR.w'{ˡC"_"#acv*KDv ܂VK6Wztl0[; . 9<ckGn΍lR;y介~ &/xԙ ~w:$\":An(EFW~#AcR)ĭ4\OKs{&R@*=tӪW|B$BDp-xgp7zK~RH ѢrW\OBy񟟞Ǔ4++ݟ~xWQ,Z`olRZ2-v hJC g@ 0`O\!8 3v3X 0zE_s]^fvy\o<ЦMz^0o-[~ c8ȤDIdR!,j9ic_[6#)fݼaÆm޼!!Dqbb?=ȶKF|/b``{ޏ5kǐJǖ-[ƪP*VR1Z[Jz3WpdTMdldS*wx===m۶GǽfIo&q<?ժxWh~~vi^{m?8رcꫯBJVR R*( h֒Ʊ='20I.gN;HCyQyBvr''=Z vڅF3'`Fm<3={e&$A;IIJ({f0$GV (mb 0V:@rhrrB,_ѣGP,šs@>q߃a֭\SOhnRf}uՙ0l#٩T*-uM08O*ܝ=== fFehZ(J(9ϝ93'0n~i(RJT 8{}Π^  &VfX &fgseג3|߇Ð(Bp hPڇo}+ex~ԅSHJkZm IښU@BfÜ_Lkqaya!mU'mhـ=`6`f,? Vl$j ApY)rԇs1ro}c}ɞi4˲waE{{zz0 Q.GbCZITPy>=erJkLL]TIq3|fnqTux+ֺZT (ðJa I\CYV AAlIHc뚶p2z y5@4<5}nב˦pM?qx^R{dyZIΜG&SHrk@+ĄnNF sqnb}3VZZkRv;[P!`if[`f9;;{xHISiFJ* CiTJ0;W<.^Z@d-(B/Stz@n/5̘jg<9덎]` ۼqL |,H6ՆBT,T*7BO="Sgr0}SK0H3zjSU^uWu~NLW̧0iORIENDB`Gtk2-1.24992/gtk-demo/stock_browser.pl0000644000175000017500000002434213076462676016101 0ustar lacklack#!/usr/bin/perl -w # # Stock Item and Icon Browser # # This source code for this demo doesn't demonstrate anything # particularly useful in applications. The purpose of the "demo" is # just to provide a handy place to browse the available stock icons # and stock items. # package stock_browser; use Glib qw(TRUE FALSE); use Gtk2; my $window = undef; # # The C version of this sample defines a structure called StockItemInfo # to hold information about the stock items; it makes StockItemInfo into # a new boxed type so that, when used with the GtkListStore, all the # memory management happens properly. # # in perl we don't do such things. the StockItemInfo structure becomes # just a perl hash, and we store it in the Gtk2::ListStore in a column # with the Glib::Scalar type. this way all the memory management happens # properly and you don't have to think up elaborate schemes to do so # (because i already did it for you). # sub id_to_macro { my $id = shift; my $macro = uc($id); $macro =~ s/-/_/g; $macro =~ s/^GTK_/GTK_STOCK_/; return $macro; } sub create_model { #store = gtk_list_store_new (2, STOCK_ITEM_INFO_TYPE, G_TYPE_STRING); #my $store = Gtk2::ListStore->new ('scalar', 'Glib::String'); my $store = Gtk2::ListStore->new ('Glib::Scalar', 'Glib::String'); foreach my $id (sort Gtk2::Stock->list_ids) { my $item = Gtk2::Stock->lookup ($id); my %info = ( id => $id, item => $item ? $item : {} ); # only show icons for stock IDs that have default icons my $icon_set = Gtk2::IconFactory->lookup_default ($info{id}); if ($icon_set) { # See at which sizes this stock icon really exists my @sizes = $icon_set->get_sizes; # Use menu size if it exists, otherwise first size found my $size = grep (@sizes, 'menu') ? 'menu' : $sizes[0]; $info{small_icon} = $window->render_icon ($info{id}, $size); if ($size ne 'menu') { # Make the result the proper size for our thumbnail $info{small_icon} = Gtk2::Gdk::Pixbuf->scale_simple ($info{small_icon}, Gtk2::Icon->size_lookup ('menu'), 'bilinear'); } } $info{accel_str} = $info{item}{keyval} ? Gtk2::Accelerator->name ($info{item}{keyval}, $info{item}{modifier}) : ''; $info{macro} = id_to_macro ($info{id}); # something about redhat9's gnome setup registers a whole slew of # stock items which don't return icons in this context. i don't # know if it's because we don't do Gnome2::Program->init or what, # but it's really annoying, because it messes with lots of things, # and since you can't pass undef/null for an object property, we # can't tell the cell renderers to use NULL for the pixbufs. # so, we only add an entry for stock items which have icons. if ($info{small_icon}) { my $iter = $store->append; $store->set ($iter, 0, \%info, 1, $id); } } return $store; } # # Finds the largest size at which the given image stock id is # available. This would not be useful for a normal application # sub get_largest_size { my $id = shift; my $best_size = 'invalid'; my $best_pixels = 0; my $set = Gtk2::IconFactory->lookup_default ($id); foreach my $size ($set->get_sizes) { my ($width, $height) = Gtk2::IconSize->lookup ($size); next unless defined $height; if ($width * $height > $best_pixels) { $best_size = $size; $best_pixels = $width * $height; } } return $best_size; } sub selection_changed { my $selection = shift; # warn "\n\nselection_changed $selection"; my $treeview = $selection->get_tree_view; my $display = $treeview->{stock_display}; my ($model, $iter) = $selection->get_selected; if ($iter) { my ($info) = $model->get ($iter, 0); if ($info->{small_icon} && $info->{item}{label}) { $display->{type_label}->set_text ("Icon and Item"); } elsif ($info->{small_icon}) { $display->{type_label}->set_text ("Icon Only"); } elsif ($info->{item}{label}) { $display->{type_label}->set_text ("Item Only"); } else { $display->{type_label}->set_text ("???????"); } $display->{macro_label}->set_text ($info->{macro}); $display->{id_label}->set_text ($info->{id}); if ($info->{item}{label}) { $display->{label_accel_label}->set_text_with_mnemonic (sprintf '%s %s', $info->{item}{label}, $info->{accel_str}); } else { $display->{label_accel_label}->set_text (""); } if ($info->{small_icon}) { $display->{icon_image}->set_from_stock ($info->{id}, get_largest_size ($info->{id})); } else { $display->{icon_image}->set_from_pixbuf (undef); } } else { $display->{type_label}->set_text ("No selected item"); $display->{macro_label}->set_text (""); $display->{id_label}->set_text (""); $display->{label_accel_label}->set_text (""); $display->{icon_image}->set_from_pixbuf (undef); } } sub macro_set_func_text { my ($tree_column, $cell, $model, $iter) = @_; my ($info) = $model->get ($iter, 0); $cell->set (text => $info->{macro}); } sub macro_set_func_pixbuf { my ($tree_column, $cell, $model, $iter) = @_; my ($info) = $model->get ($iter, 0); $cell->set (pixbuf => $info->{small_icon}); } sub id_set_func { my ($tree_column, $cell, $model, $iter) = @_; my ($info) = $model->get ($iter, 0); $cell->set (text => $info->{id}); } sub accel_set_func { my ($tree_column, $cell, $model, $iter) = @_; my ($info) = $model->get ($iter, 0); $cell->set (text => $info->{accel_str}); } sub label_set_func { my ($tree_column, $cell, $model, $iter) = @_; my ($info) = $model->get ($iter, 0); # items aren't required to have labels $cell->set (text => $info->{item}{label} || ''); } sub do { if (!$window) { $window = Gtk2::Window->new; $window->set_title ("Stock Icons and Items"); $window->set_default_size (-1, 500); $window->signal_connect (destroy => sub {$window = undef; 1}); $window->set_border_width (8); my $hbox = Gtk2::HBox->new (FALSE, 8); $window->add ($hbox); my $sw = Gtk2::ScrolledWindow->new; $sw->set_policy ('never', 'automatic'); $hbox->pack_start ($sw, FALSE, FALSE, 0); my $model = create_model (); my $treeview = Gtk2::TreeView->new_with_model ($model); $sw->add ($treeview); my $column = Gtk2::TreeViewColumn->new; $column->set_title ("Macro"); my $cell_renderer = Gtk2::CellRendererPixbuf->new; $column->pack_start ($cell_renderer, FALSE); ### this doesn't work for 2.0.x, because stock_id isn't an attribute for the ### renderer until 2.2.x ### $column->set_attributes ($cell_renderer, stock_id => 1); $column->set_cell_data_func ($cell_renderer, \¯o_set_func_pixbuf); $cell_renderer = Gtk2::CellRendererText->new; $column->pack_start ($cell_renderer, TRUE); $column->set_cell_data_func ($cell_renderer, \¯o_set_func_text); $treeview->append_column ($column); $cell_renderer = Gtk2::CellRendererText->new; $treeview->insert_column_with_data_func (-1, "Label", $cell_renderer, \&label_set_func); $cell_renderer = Gtk2::CellRendererText->new; $treeview->insert_column_with_data_func (-1, "Accel", $cell_renderer, \&accel_set_func); $cell_renderer = Gtk2::CellRendererText->new; $treeview->insert_column_with_data_func (-1, "ID", $cell_renderer, \&id_set_func); my $align = Gtk2::Alignment->new (0.5, 0.0, 0.0, 0.0); $hbox->pack_end ($align, FALSE, FALSE, 0); my $frame = Gtk2::Frame->new ("Selected Item"); $align->add ($frame); my $vbox = Gtk2::VBox->new (FALSE, 8); $vbox->set_border_width (4); $frame->add ($vbox); my $display = { type_label => Gtk2::Label->new, macro_label => Gtk2::Label->new, id_label => Gtk2::Label->new, label_accel_label => Gtk2::Label->new, icon_image => Gtk2::Image->new_from_pixbuf (undef), # empty image }; $treeview->{stock_display} = $display; $vbox->pack_start ($display->{type_label}, FALSE, FALSE, 0); $vbox->pack_start ($display->{icon_image}, FALSE, FALSE, 0); $vbox->pack_start ($display->{label_accel_label}, FALSE, FALSE, 0); $vbox->pack_start ($display->{macro_label}, FALSE, FALSE, 0); $vbox->pack_start ($display->{id_label}, FALSE, FALSE, 0); my $selection = $treeview->get_selection; $selection->set_mode ('single'); $selection->signal_connect (changed => \&selection_changed); } if (!$window->visible) { $window->show_all; } else { $window->destroy; $window = undef; } return $window; } 1; __END__ Copyright (C) 2003 by the gtk2-perl team (see the file AUTHORS for the full list) This library is free software; you can redistribute it and/or modify it under the terms of the GNU Library General Public License as published by the Free Software Foundation; either version 2.1 of the License, or (at your option) any later version. This library is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Library General Public License for more details. You should have received a copy of the GNU Library General Public License along with this library; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. Gtk2-1.24992/gtk-demo/drawingarea.pl0000644000175000017500000002166213076462676015501 0ustar lacklack#!/usr/bin/perl -w # # Drawing Area # # GtkDrawingArea is a blank area where you can draw custom displays # of various kinds. # # This demo has two drawing areas. The checkerboard area shows # how you can just draw something; all you have to do is write # a signal handler for expose_event, as shown here. # # The "scribble" area is a bit more advanced, and shows how to handle # events such as button presses and mouse motion. Click the mouse # and drag in the scribble area to draw squiggles. Resize the window # to clear the area. # package drawingarea; use Glib qw(TRUE FALSE); use Gtk2; my $window = undef; # Pixmap for scribble area, to store current scribbles my $pixmap = undef; # Create a new pixmap of the appropriate size to store our scribbles sub scribble_configure_event { my ($widget, $event, $data) = @_; # get rid of the old one $pixmap = undef if $pixmap; $pixmap = Gtk2::Gdk::Pixmap->new ($widget->window, $widget->allocation->width, $widget->allocation->height, -1); # Initialize the pixmap to white $pixmap->draw_rectangle ($widget->style->white_gc, TRUE, 0, 0, $widget->allocation->width, $widget->allocation->height); # We've handled the configure event, no need for further processing. return TRUE; } # Redraw the screen from the pixmap sub scribble_expose_event { my ($widget, $event, $data) = @_; # # We use the "foreground GC" for the widget since it already exists, # but honestly any GC would work. The only thing to worry about # is whether the GC has an inappropriate clip region set. # $widget->window->draw_drawable ($widget->style->fg_gc($widget->state), $pixmap, # Only copy the area that was exposed. $event->area->x, $event->area->y, $event->area->x, $event->area->y, $event->area->width, $event->area->height); return FALSE; } # Draw a rectangle on the screen sub draw_brush { my ($widget, $x, $y) = @_; my $update_rect = Gtk2::Gdk::Rectangle->new ($x - 3, $y - 3, 6, 6); # Paint to the pixmap, where we store our state $pixmap->draw_rectangle ($widget->style->black_gc, TRUE, $update_rect->values); # $update_rect->x, # $update_rect->y, # $update_rect->width, # $update_rect->height); # Now invalidate the affected region of the drawing area. # $widget->window->invalidate_rect (\@update_rect, FALSE); # use Data::Dumper; # warn Dumper($update_rect); $widget->window->invalidate_rect ($update_rect, FALSE); } sub scribble_button_press_event { my ($widget, $event, $data) = @_; return FALSE unless defined $pixmap; # paranoia check, in case we haven't gotten a configure event if ($event->button == 1) { draw_brush ($widget, $event->x, $event->y); } # We've handled the event, stop processing return TRUE; } sub scribble_motion_notify_event { my ($widget, $event, $data) = @_; return FALSE unless defined $pixmap; # paranoia check, in case we haven't gotten a configure event # # This call is very important; it requests the next motion event. # If you don't call gdk_window_get_pointer() you'll only get # a single motion event. The reason is that we specified # GDK_POINTER_MOTION_HINT_MASK to gtk_widget_set_events(). # If we hadn't specified that, we could just use event->x, event->y # as the pointer location. But we'd also get deluged in events. # By requesting the next event as we handle the current one, # we avoid getting a huge number of events faster than we # can cope. # my (undef, $x, $y, $state) = $event->window->get_pointer; # if (state & GDK_BUTTON1_MASK) # if (grep 'button1-mask', @$state) { if (grep (/button1-mask/, @$state)) { draw_brush ($widget, $x, $y); } # We've handled it, stop processing return TRUE; } my $color; sub checkerboard_expose { my ($da, $event, $data) = @_; use constant CHECK_SIZE => 10; use constant SPACING => 2; # # At the start of an expose handler, a clip region of event->area # is set on the window, and event->area has been cleared to the # widget's background color. The docs for # gdk_window_begin_paint_region() give more details on how this # works. # # It would be a bit more efficient to keep these # GCs around instead of recreating on each expose, but # this is the lazy/slow way. # my $gc1 = Gtk2::Gdk::GC->new ($da->window); my $color = Gtk2::Gdk::Color->new (30000, 0, 30000); # my $color = Gtk2::Gdk::Color->parse ('purple'); $gc1->set_rgb_fg_color ($color); my $gc2 = Gtk2::Gdk::GC->new ($da->window); # $color = Gtk2::Gdk::Color->new (65535, 65535, 65535); $color = Gtk2::Gdk::Color->parse ('white'); $gc2->set_rgb_fg_color ($color); my $xcount = 0; my $i = SPACING; while ($i < $da->allocation->width) { my $j = SPACING; my $ycount = $xcount % 2; # start with even/odd depending on row while ($j < $da->allocation->height) { # # If we're outside event->area, this will do nothing. # It might be mildly more efficient if we handled # the clipping ourselves, but again we're feeling lazy. # $da->window->draw_rectangle ($ycount % 2 ? $gc1 : $gc2, TRUE, $i, $j, CHECK_SIZE, CHECK_SIZE); $j += CHECK_SIZE + SPACING; ++$ycount; } $i += CHECK_SIZE + SPACING; ++$xcount; } # g_object_unref (gc1); # g_object_unref (gc2); # # return TRUE because we've handled this event, so no # further processing is required. # return TRUE; } sub do { if (!$window) { $window = Gtk2::Window->new; $window->set_title ("Drawing Area"); $window->signal_connect (destroy => sub { $window = undef; 1 }); $window->set_border_width (8); my $vbox = Gtk2::VBox->new (FALSE, 8); $vbox->set_border_width (8); $window->add ($vbox); # # Create the checkerboard area # my $label = Gtk2::Label->new; $label->set_markup ("Checkerboard pattern"); $vbox->pack_start ($label, FALSE, FALSE, 0); my $frame = Gtk2::Frame->new; $frame->set_shadow_type ('in'); $vbox->pack_start ($frame, TRUE, TRUE, 0); my $da = Gtk2::DrawingArea->new; # set a minimum size $da->set_size_request (100, 100); $frame->add ($da); $da->signal_connect (expose_event => \&checkerboard_expose); # # Create the scribble area # $label = Gtk2::Label->new; $label->set_markup ("Scribble area"); $vbox->pack_start ($label, FALSE, FALSE, 0); $frame = Gtk2::Frame->new; $frame->set_shadow_type ('in'); $vbox->pack_start ($frame, TRUE, TRUE, 0); $da = Gtk2::DrawingArea->new; # set a minimum size $da->set_size_request (100, 100); $frame->add ($da); # Signals used to handle backing pixmap $da->signal_connect (expose_event => \&scribble_expose_event); $da->signal_connect (configure_event => \&scribble_configure_event); # Event signals $da->signal_connect (motion_notify_event => \&scribble_motion_notify_event); $da->signal_connect (button_press_event => \&scribble_button_press_event); # # Ask to receive events the drawing area doesn't normally # subscribe to # $da->set_events ([ @{ $da->get_events }, ## 'exposure-mask', 'leave-notify-mask', 'button-press-mask', 'pointer-motion-mask', 'pointer-motion-hint-mask', ]); } if (!$window->visible) { $window->show_all; } else { $window->destroy; $window = undef; } return $window; } 1; __END__ Copyright (C) 2003 by the gtk2-perl team (see the file AUTHORS for the full list) This library is free software; you can redistribute it and/or modify it under the terms of the GNU Library General Public License as published by the Free Software Foundation; either version 2.1 of the License, or (at your option) any later version. This library is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Library General Public License for more details. You should have received a copy of the GNU Library General Public License along with this library; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. Gtk2-1.24992/gtk-demo/floppybuddy.gif0000644000175000017500000001214013076462676015677 0ustar lacklackGIF89aPF  !!!"""###$$$%%%&&&'''((()))***+++,,,---...///000111222333444555666777888999:::;;;<<<===>>>???@@@AAABBBCCCDDDEEEFFFGGGHHHIIIJJJKKKLLLMMMNNNOOOPPPQQQRRRSSSTTTUUUVVVWWWXXXYYYZZZ[[[\\\]]]^^^___```aaabbbcccdddeeefffggghhhiiijjjkkklllmmmnnnooopppqqqrrrssstttuuuvvvwwwxxxyyyzzz{{{|||}}}~~~ぁ=v{! NETSCAPE2.0! ,L> H*\ȰÇ#JHŋ3jȱǏ CIdA(S\rɅNjI̗ cJϞ@H 2hJ2rD)@*0.O[vDٕ@Xsjj׶l6$٫w5mW)9-͢{,ҁEgu8 5|bSCJ%x3|Cf ۸Icqhq}vmBN-8(U/gys_9qٵ^?9yï>d|p_M6~ϕv(ބ`.} W!*I؅І9gNAȚkhq8S)5Hgf>$JBHL:mh:QIe!I6 $0JY$dHX'umAh긑*9|jB昉aрx&be1aJYziviJ:*A*=ҫꚔ,Bk$KO9Ūl}<WL%*QMi.W~HS•;Rvն;m_2xn~).kn2zk0 .9,o[.fw#! ,L> H*\ȰÇ#JHŋ3jȱǏ CIdA(S\rɅNjI̗ cJϞ@&΃EE4eSF@TL}Z 4TIb͚P vX(Dːյj7)֩VU{n*4YR{5*ʹ ,hq |PJ|]x'ФsWZ_Sޙ'[}u[[E%č_O|9sϥ.PassSWo8yguh` w%V"h rY]ɗփvN(ǁd`]&L%Db'\~ rуxvڌԈҍ&x!AjFd("6DP8%JUqE[V``)eH_qy&[kx'QG)"}y~`1Uh!;)ZބNNf꒤v*iI+¤ҨhꥄVkj*t뎵*+Od!U_Dlv5`u]6k؎4-MfҷyfbnWJ5Ӣc$K~n 7G,T!This GIF file was assembled by CDavis with GIF Construction Set from: Alchemy Mindworks Inc. P.O. Box 500 Beeton, Ontario L0G 1A0 CANADA. ! ,L> H*\ȰÇ#JHŋ3jȱǏ CIdA(S\rɅNjI̗ cJϞ@H 2hJ2rD)@*0.O[vDٕ@Xsjj׶l6$٫w5mW)9-͢{,ҁEgu8 5|bSCJ%x3|Cf ۸Icqhq}vmBN-8(U/gys_9qٵ^?9yï>d|p_M6~ϕv(ބ`.} W!*I؅І9gNAȚkhq8S)5Hgf>$JBHL:mh:QIe!I6 $0JY$dHX'umAh긑*9|jB昉aрx&be1aJYziviJ:*A*=ҫꚔ,Bk$KO9Ūl}<WL%*QMi.W~HS•;Rvն;m_2xn~).kn2zk0 .9,o[.fw#! ,L> H*\ȰÇ#JHŋ3jȱǏ CIdA(S\rɅNjI̗ cJϞ@&΃EE4eSF@TL}Z 4TIb͚P vX(Dːյj7)֩VU{n*4YR{5*ʹ ,hq |PJ|]x'ФsWZ_Sޙ'[}u[[E%č_O|9sϥ.PassSWo8yguh` w%V"h rY]ɗփvN(ǁd`]&L%Db'\~ rуxvڌԈҍ&x!AjFd("6DP8%JUqE[V``)eH_qy&[kx'QG)"}y~`1Uh!;)ZބNNf꒤v*iI+¤ҨhꥄVkj*t뎵*+Od!U_Dlv5`u]6k؎4-MfҷyfbnWJ5Ӣc$K~n 7G,T!This space for rent...! ,L> H*\ȰÇ#JHŋ3jȱǏ CIdA(S\rɅNjI̗ cJϞ@H 2hJ2rD)@*0.O[vDٕ@Xsjj׶l6$٫w5mW)9-͢{,ҁEgu8 5|bSCJ%x3|Cf ۸Icqhq}vmBN-8(U/gys_9qٵ^?9yï>d|p_M6~ϕv(ބ`.} W!*I؅І9gNAȚkhq8S)5Hgf>$JBHL:mh:QIe!I6 $0JY$dHX'umAh긑*9|jB昉aрx&be1aJYziviJ:*A*=ҫꚔ,Bk$KO9Ūl}<WL%*QMi.W~HS•;Rvն;m_2xn~).kn2zk0 .9,o[.fw#! ,L> H*\ȰÇ#JHŋ3jȱǏ CIdA(S\rɅNjI̗ cJϞ@&΃EE4eSF@TL}Z 4TIb͚P vX(Dːյj7)֩VU{n*4YR{5*ʹ ,hq |PJ|]x'ФsWZ_Sޙ'[}u[[E%č_O|9sϥ.PassSWo8yguh` w%V"h rY]ɗփvN(ǁd`]&L%Db'\~ rуxvڌԈҍ&x!AjFd("6DP8%JUqE[V``)eH_qy&[kx'QG)"}y~`1Uh!;)ZބNNf꒤v*iI+¤ҨhꥄVkj*t뎵*+Od!U_Dlv5`u]6k؎4-MfҷyfbnWJ5Ӣc$K~n 7G,T!This GIF file was assembled with GIF Construction Set from: Alchemy Mindworks Inc. P.O. Box 500 Beeton, Ontario L0G 1A0 CANADA. This comment block will not appear in files created with a registered version of GIF Construction Set;Gtk2-1.24992/gtk-demo/appwindow.pl0000644000175000017500000002264513076462676015227 0ustar lacklack#!/usr/bin/perl -w # # Application main window # # Demonstrates a typical application window, with menubar, toolbar, statusbar. # package appwindow; use Glib ':constants'; use Gtk2; #include "demo-common.h" my $window = undef; sub menuitem_cb { my ($callback_data, $callback_action, $widget) = @_; my $dialog = Gtk2::MessageDialog->new ($callback_data, 'destroy-with-parent', 'info', 'close', sprintf "You selected or toggled the menu item: \"%s\"", Gtk2::ItemFactory->path_from_widget ($widget)); # Close dialog on user response $dialog->signal_connect (response => sub { $dialog->destroy; 1 }); $dialog->show; } my @menu_items = ( [ "/_File", undef, undef, 0, "" ], [ "/File/_New", "N", \&menuitem_cb, 0, "", 'gtk-new' ], [ "/File/_Open", "O", \&menuitem_cb, 0, "", 'gtk-open' ], [ "/File/_Save", "S", \&menuitem_cb, 0, "", 'gtk-save' ], [ "/File/Save _As...", undef, \&menuitem_cb, 0, "", 'gtk-save' ], [ "/File/sep1", undef, \&menuitem_cb, 0, "" ], [ "/File/_Quit", "Q", \&menuitem_cb, 0, "", 'gtk-quit' ], [ "/_Preferences", undef, undef, 0, "" ], [ "/_Preferences/_Color", undef, undef, 0, "" ], [ "/_Preferences/Color/_Red", undef, \&menuitem_cb, 0, "" ], [ "/_Preferences/Color/_Green", undef, \&menuitem_cb, 0, "/Preferences/Color/Red" ], [ "/_Preferences/Color/_Blue", undef, \&menuitem_cb, 0, "/Preferences/Color/Red" ], [ "/_Preferences/_Shape", undef, undef, 0, "" ], [ "/_Preferences/Shape/_Square", undef, \&menuitem_cb, 0, "" ], [ "/_Preferences/Shape/_Rectangle", undef, \&menuitem_cb, 0, "/Preferences/Shape/Square" ], [ "/_Preferences/Shape/_Oval", undef, \&menuitem_cb, 0, "/Preferences/Shape/Rectangle" ], # If you wanted this to be right justified you would use "", not "". # Right justified help menu items are generally considered a bad idea now days. [ "/_Help", undef, undef, 0, "" ], [ "/Help/_About", undef, \&menuitem_cb, 0 ], ); sub toolbar_cb { my ($button, $data) = @_; my $dialog = Gtk2::MessageDialog->new ($data, 'destroy-with-parent', 'info', 'close', "You selected a toolbar button"); # Close dialog on user response $dialog->signal_connect (response => sub { $_[0]->destroy; 1 }); $dialog->show; } # # This function registers our custom toolbar icons, so they can be themed. # # It's totally optional to do this, you could just manually insert icons # and have them not be themeable, especially if you never expect people # to theme your app. # my $registered = FALSE; sub register_stock_icons { if (!$registered) { my @items = ( #[ "demo-gtk-logo", "_GTK!", 0, 0, undef ] { stock_id => "demo-gtk-logo", label => "_GTK!", }, ); $registered = TRUE; # Register our stock items Gtk2::Stock->add (@items); # Add our custom icon factory to the list of defaults my $factory = Gtk2::IconFactory->new; $factory->add_default; # # demo_find_file() looks in the the current directory first, # so you can run gtk-demo without installing GTK, then looks # in the location where the file is installed. # my $pixbuf = undef; ### my $filename = demo_find_file ("gtk-logo-rgb.gif", undef); my $filename = "gtk-logo-rgb.gif"; if ($filename) { eval { $pixbuf = Gtk2::Gdk::Pixbuf->new_from_file ( main::demo_find_file ($filename)); # The gtk-logo-rgb icon has a white background, make it transparent my $transparent = $pixbuf->add_alpha (TRUE, 0xff, 0xff, 0xff); my $icon_set = Gtk2::IconSet->new_from_pixbuf ($transparent); $factory->add ("demo-gtk-logo", $icon_set); }; warn "failed to load GTK logo for toolbar" if $@; } # $factory goes out of scope here, but GTK will hold a reference on it. } } sub update_statusbar { my ($buffer, $statusbar) = @_; $statusbar->pop (0); # clear any previous message, underflow is allowed my $count = $buffer->get_char_count; my $iter = $buffer->get_iter_at_mark ($buffer->get_insert); my $row = $iter->get_line; my $col = $iter->get_line_offset; $statusbar->push (0, "Cursor at row $row column $col - $count chars in document"); } sub mark_set_callback { my ($buffer, $new_location, $mark, $data) = @_; update_statusbar ($buffer, $data); } sub do { if (!$window) { register_stock_icons (); # # Create the toplevel window # $window = Gtk2::Window->new; $window->set_title ("Application Window"); # NULL window variable when window is closed $window->signal_connect (destroy => sub { $window = undef; 1 }); my $table = Gtk2::Table->new (1, 4, FALSE); $window->add ($table); # # Create the menubar # my $accel_group = Gtk2::AccelGroup->new; $window->add_accel_group ($accel_group); my $item_factory = Gtk2::ItemFactory->new ("Gtk2::MenuBar", "

", $accel_group); # Set up item factory to go away with the window $window->{'
'} = $item_factory; # create menu items $item_factory->create_items ($window, @menu_items); $table->attach ($item_factory->get_widget ("
"), # X direction Y direction 0, 1, 0, 1, [qw/expand fill/], [], 0, 0); # # Create the toolbar # my $toolbar = Gtk2::Toolbar->new; $toolbar->insert_stock ('gtk-open', "This is a demo button with an 'open' icon", undef, \&toolbar_cb, $window, # user data for callback -1); # -1 means "append" $toolbar->insert_stock ('gtk-quit', "This is a demo button with a 'quit' icon", undef, \&toolbar_cb, $window, # user data for callback -1); # -1 means "append" $toolbar->append_space; $toolbar->insert_stock ("demo-gtk-logo", "This is a demo button with a 'gtk' icon", undef, \&toolbar_cb, $window, # user data for callback -1); # -1 means "append" $table->attach ($toolbar, # X direction Y direction 0, 1, 1, 2, [qw/expand fill/], [], 0, 0); # # Create document # my $sw = Gtk2::ScrolledWindow->new; $sw->set_policy ('automatic', 'automatic'); $sw->set_shadow_type ('in'); $table->attach ($sw, # X direction Y direction 0, 1, 2, 3, [qw/expand fill/], [qw/expand fill/], 0, 0); $window->set_default_size (200, 200); my $contents = Gtk2::TextView->new; $sw->add ($contents); # Create statusbar my $statusbar = Gtk2::Statusbar->new; $table->attach ($statusbar, # X direction Y direction 0, 1, 3, 4, [qw/expand fill/], [], 0, 0); # Show text widget info in the statusbar my $buffer = $contents->get_buffer; $buffer->signal_connect (changed => \&update_statusbar, $statusbar); # mark-set means cursor moved $buffer->signal_connect (mark_set => \&mark_set_callback, $statusbar); update_statusbar ($buffer, $statusbar); } if (!$window->visible) { $window->show_all; } else { $window->destroy; $window = undef; } return $window; } 1; __END__ Copyright (C) 2003 by the gtk2-perl team (see the file AUTHORS for the full list) This library is free software; you can redistribute it and/or modify it under the terms of the GNU Library General Public License as published by the Free Software Foundation; either version 2.1 of the License, or (at your option) any later version. This library is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Library General Public License for more details. You should have received a copy of the GNU Library General Public License along with this library; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. Gtk2-1.24992/gtk-demo/background.jpg0000644000175000017500000005331313076462676015477 0ustar lacklackJFIFHHCreated with The GIMPC    $.' ",#(7),01444'9=82<.342C  2!!22222222222222222222222222222222222222222222222222"8!1AQ"a2q#BR3rbC1 ?T[C GzFh ʎ^h| lFT{(v4 TQ|Q ¡KHylmUw$"G4dvEL C1H2;ށY $=3Y4pVM'UDkYR#B@X㘧X"A8$rB Kиd֩1`Np˛MTDL~)oϊ%%FQ"-ó<P \(@E/zg[}ST-ɌpD* $EV$~7U ` {U-yZTꍻk :ԃD!7@`5{~(1`vֲ0ݤ}N[ͰPb"7"1 rfV $Oo~Pe5'HqTfڠXEgU27?)7fW]ۉ?mos9 hb$CYQG-3]:sRH;սXf$}YڶB[Pr$G N,T4hx>iFER*@=sb;k|*(O>(P$S aN<2UpXK&v^*=Fse{]t߭e-胯WeqM@~t{ u-ҳqmAjX&O5@W ڝyp*ʾ;hrI =C!9g(ǚ 3X:46P c h46P1:Hd{ EDnH:XE; Pn- OZxB2Ց1#>H1Hӏ(3b]0H:TɽԶ(L#ɥZùa{im-ZKPm?.ucʁRKT-[npX3 k-9\x CSnDSڣNrQ(~(`K UuQv)aseTI2)e+a{$W>৐;U ߎi+P꣰t= :{p8ULZ*k$My N_q&^MFy:N嶽Ř0PtUBuH=Ywz̈%)PzpX!\\'jt9 W\*i$ ' WOhl/K{@`d~h`@2y)K,-UB} ) c梳gdbDH)B@M>GYh -剃<^e{ZgMm-HU'Pfh P#9g; 'GH؊e]V._%DkTobvh:` cMs\`Ph99 ~ᕰ@=A[%Ǹ:*)>cE lF܍H2'4l<:+^%m9ƷLtU@QIJ) r?={. ?[p9-7Mmn:b].ۻY!wU ˃ <]zFڤ*2'B2cnRދ9b7ⅲ}H=sxs@m*-W[;1 ~p *ΉhX悳75,4$x5FPg114 1ދLS.:> Pˤvu9"t4Od|ċi,H"=1K2R{οXu2OĞ>k)!8wTPd yb`5^S[rqgg4[CkԎ2vڨ+dL FKb*=v*YXD I~@A}R΢V٠mȂb5qU@}5VcځllKx@U@-r7'g$h?5 ˘S\zxxs3UhQDe&vf1(HCl6Si@8("o[캤KxUn[Sy`椷K=5%pvhnUd hB TsZ+'.40LcwGqjȝ ,nط[>ªbuAඡ@&;P"1P@*"I<,CL~GuInkF -S)wü zfڵZv ?W0Xb}؏hIKVГ6>dOl@#Ku h?{HDH #E@*K 11As Y v,VmP fl(]*?o\[}: P;-KKA ?;eFIրImRAPǽrݫCI~5pYeK}g@ v ӕB$w!| e r1 S1v3(* #=b'KSIrNKyTnތfU"u:~( [H/RI2I317)ڏbOo`L{(i3tk J+;!Ҵq*!yـLB+cڟ#&c*& РGQ@B'Qa0=I6t&d 䊨,nط[>ªbuAඡ@&;TR*I$)}21dy~T>6:Tkx0`2|; ~nͫ]5`p>jLn &*)݈DTo 0+0#cDH6̴9P̶aT@D 9 Tx[;bN eJb`vlU2 ~Ojnbq۲31F5ŷӮ ð^ jAszFThĝh E$ { -ڴ?`q?Q 6^'{b 9T,NZqojXֹ`m< v!m+;zmw$UXȘR[{ i.9Z:nap+q#KGdx^=EИT\׮qz{Nxaڼuze6Ŷq֦ rO›*qle5\(UQu|Q޵K\r} A(83,g[;GޑWӑ8 ==:M$GP)v(@sW SG$=C1ԁ$fi_UMmVDӺgp-dDk5' A(=TqY$ַm3  U fv"qS*`Bݏ?OyZP=c&g3h LE Ŏ,s1kY N(6*< 7X sO>ɓ'A- EIv o+ DLbk7S 3LAQLWitτ! >aIڃ*=T5[ ?K([f{P)9?jֹ`m< v!m+;zmw$U)%[`5ȗ bz_{4xN] Omz hyW W]gSl[i'jj*^ w$)|Gk0Pc\P͜}QUh0']η=\@T G42; A2ɌuHKaTxqM9P܃ڭcJ )A m>P f {(^>PH>)L<9ղXAYE_VITT̘biQQ=z|,2P*P\dR[y$N⢂(Y$qvE-?޶6n\8}^womc Ѵ{y1ոu=O4ޡԨ{J81{'k*CNF 􂋬ξcܚA$F5UFpX7Hf׶\6vKq>)A m>P f {(^>PH>)L<9ղXAYE_VITT̘biQQ=z|,2P*P\dR[y$N⢂(Y$qvE-?޶6n\8}^womc Ѵ{y1\EtonsEZ*?UGlbR.w :W%D&1Q{z MHwwn8^Z l)$5 Z|S?4!-+V( \ĉ1Y%wi-ALU]axX-+r}6UOj RVia*JݲOrP% Yై5@팪b;H@2\" e(PHzWp"ډ1t8;,++\c5O4 t6B:4Urv(qU<- r>;QM'<_IϨ lg( $ncof6ӥ*e B^~hP:f5QqSݸ.3l QBTsFtœ f9WPyEk :'&OmtzyLXzS>N;iReUq/En~ہ@үQY-qL3q2k/\ A⹺wf׻q&893,H␲Rg,4UWP\P@B2b`KF_oimP/к#gAUSXˀ<8fŲI&gj Gڎ0YV  UP{2a汶 2y 5T[]?LL3$r; j95PPX2Z3q'PҰiR/{{@Ы@H9l* @TfX !e)ɢ2ϘXi@*d1YP0,>f_u$# F` yrN>ؤg%R~)U 2ۍNPlG n2,]V!)R.NG~ G:ɊtLkY_$*[v$h a=iF. @'02IcX$ӥ@ ?j5`ANyWǸ`a-)N⋹!f{M#x۞Oڛ ,dyB[9?4WrA#T#[M*n@)Ҥ:Ivs)P'FbΦ˾D.8ԽhDT)OHKAƝL|Q=*i0 vMf[4" EbqT,,xb!x[aP;%?!-ROv'1G0Y/i5nFg#G _ @'zk2V6;_@a,kĚ/̷Qw7&Z FFPAb-j4@b;^f1Vjjl^^ ~sEGӴ0R:q:WL¬€2 X7fAjı8vbnԅ!53ж"<RT Umo6cڵ7oV`|df"džMJ9 Ub9=-r֡)`)0&55<5@]D=kpl? -rZDRPpuUM#`lsk m7ʆkV@5HΪ 1<$P"LGv(Iv,< 2+9lڊ>p@WC)"KhwUIk,1se[P; KK;d 5U7L[NA^.L)Gi2$p/ AUE(ñ:2.kvRfL6&IX80$ʑW׹E۷Qvy[iQӲ-[>3?5Q4:v&&A|ǦO5y"B0[ĝE⵷gkPa1+{ ds ip]GTy>h[Li(~Y'T q588*4H>Kmq@I3?PIi8QdyDS"*+N"`ڀ$YĒq$qYR촋kwnx NLDOsA*\')BvQJ}(hB/;$@ؖhl@$a@@UBAk-솝"c(arFB{&rV:QHRn(2N5飻!Mh@qAD1}o` 4$R]Ndn>*_='@J;gm753ikǓiDYLfO}TSnB! Nк!bL;UwpKiPhj`chTA rA>&Icj}GC@#7sN s^bm#gt1O4Taʏ$UCV䝘nР(9:8Q.oLs!Ar#u%dVwOg7ٮ{6LY().ZN4&>*a 梪O4 +@Y?]#Hb&!'Fnx NLDOsA*\')BvQJ}(hB/;$@ؖhl@$a@@UBAk-솝"c(arFB{&rV:QHRn(2N5飻!Mh@qAD1}o` 4$R]Ndn>*_='@J;gm753ikǓiDYLfO}TSnB! Nк!bL;UwpKiPPKr@ :pf}ܓM)wA;m-#tm#(w{xp o\ޟfw'@*S6[ޙY\E(UTJ2Di46 {UF V ʼnf*:IHM1gGu5l"FB0Ŷ8&GbPJj&fh vbp5!*1\CR}G$tfi d4cftwQMsV)9d*Nc [cM2l4v 4ffH`'f)\Rn0=y4='rI'C+cjq'z'f6'>")[;i[eN "-y1bFTT3DA&h}CB(aR5kV`~$$p?4PỸfPT!Ʃ`" >hYsm4IOdIX ?zP$ (ղ@?+*ǙQ2i~4V.C\=D*# @1X;k"2mРF̬@S}SNŷ1ʠP"a@;a.޳΢M *b?ZկF%}dɬTO H*, !j'SL>#ǓAmEQZiK*O>!mL Dl(S:קҪɮvMr?yuO&uC7aAzt-xdž2-4 M%3ykV}DZIf 9KjGjqp8xJ)LAuv"~yn(#{e*P*O 4~Xk Z`+hjSB?P`8 ,fALd(AfcrcTH4, $觲O$I(fcj LIcj(b4H!݀ Ѭ[L5I6hP#fVw)SbۈYeP(|@LD\|zYQJ&PD±fڭjףhHvvqo'Qm D9a#q+*;z4Ŧp 9'B椑!w{رPI[lG"!tI<T$ߚY>h| lFT{(v4 TQ|Q ¡KHylmUw$"G4dvEL C1H2;ށY $=3Y4pVM'UDkYR#B@X㘧X"A8$rB Kиd֩1`Np˛MTDL~)oϊ%%FQ"-ó<P \(@E/zg[}ST-ɌpD* $EV$~7U ` {U-yZTꍻk :ԃD!7@`5{~(1`vֲ0ݤ}N[ͰPb"7"1 rfV $Oo~Pe5'HqTfڠXEgU27?)7fW]ۉ?mos9 hb$CYQG-3]:sRH;սXf$}YڶB[Pr$G N,T4hx>iFER*@=sb;k|*(O>(P$S aN<2UpXK&v^*=Fse{]t߭e-胯WeqM@~t{ u-ҳqmAjX&O5@W ڝyp*ʾ;hrI =C!9g(ǚ 3X:46P c h46P1:Hd{ EDnH:XE; Pn- OZxB2Ց1#>H1Hӏ(3b]0H:TɽԶ(L#ɥZùa{im-ZKPm?.ucʁRKT-[npX3 k-9\x CSnDSڣNrQ(~(`K UuQv)aseTI2)e+a{$W>৐;U ߎi+P꣰t= :{p8ULZ*k$My N_q&^MFy:N嶽Ř0PtUBuH=Ywz̈%)PzpX!\\'jt9 W\*i$ ' WOhl/K{@`d~h`@2y)K,-UB} ) c梳gdbDH)B@M>GYh -剃<^e{ZgMm-HU'Pfh P#9g; 'GH؊e]V._%DkTobvh:` cMs\`Ph99 ~ᕰ@=A[%Ǹ:*)>cE lF܍H2'4l<:+^%m9ƷLtU@QIJ) r?={. ?[p9-7Mmn:b].ۻY!wU ˃ <]zFڤ*2'B2cnRދ9b7ⅲ}H=sxs@m*-W[;1 ~p *ΉhX悳75,4$x5FPg114 1ދLS.:> Pˤvu9"t4Od|ċi,H"=1K2R{οXu2OĞ>k)!8wTPd yb`5^S[rqgg4[CkԎ2vڨ+dL FKb*=v*YXD I~@A}R΢V٠mȂb5qU@}5VcځllKx@U@-r7'g$h?5 ˘S\zxxs3UhQDe&vf1(HCl6Si@8("o[캤KxUn[Sy`椷K=5%pvhnUd hB TsZ+'.40LcwGqjȝ ,nط[>ªbuAඡ@&;P"1P@*"I<,CL~GuInkF -S)wü zfڵZv ?W0Xb}؏hIKVГ6>dOl@#Ku h?{HDH #E@*K 11As Y v,VmP fl(]*?o\[}: P;-KKA ?;eFIրImRAPǽrݫCI~5pYeK}g@ v ӕB$w!| e r1 S1v3(* #=b'KSIrNKyTnތfU"u:~( [H/RI2I317)ڏbOo`L{(i3tk J+;!Ҵq*!yـLB+cڟ#&c*& РGQ@B'Qa0=I6t&d 䊨,nط[>ªbuAඡ@&;TR*I$)}21dy~T>6:Tkx0`2|; ~nͫ]5`p>jLn &*)݈DTo 0+0#cDH6̴9P̶aT@D 9 Tx[;bN eJb`vlU2 ~Ojnbq۲31F5ŷӮ ð^ jAszFThĝh E$ { -ڴ?`q?Q 6^'{b 9T,NZqojXֹ`m< v!m+;zmw$UXȘR[{ i.9Z:nap+q#KGdx^=EИT\׮qz{Nxaڼuze6Ŷq֦ rO›*qle5\(UQu|Q޵K\r} A(83,g[;GޑWӑ8 ==:M$GP)v(@sW SG$=C1ԁ$fi_UMmVDӺgp-dDk5' A(=TqY$ַm3  U fv"qS*`Bݏ?OyZP=c&g3h LE Ŏ,s1kY N(6*< 7X sO>ɓ'A- EIv o+ DLbk7S 3LAQLWitτ! >aIڃ*=T5[ ?K([f{P)9?jֹ`m< v!m+;zmw$U)%[`5ȗ bz_{4xN] Omz hyW W]gSl[i'jj*^ w$)|Gk0Pc\P͜}QUh0']η=\@T G42; A2ɌuHKaTxqM9P܃ڭcJ )A m>P f {(^>PH>)L<9ղXAYE_VITT̘biQQ=z|,2P*P\dR[y$N⢂(Y$qvE-?޶6n\8}^womc Ѵ{y1ոu=O4ޡԨ{J81{'k*CNF 􂋬ξcܚA$F5UFpX7Hf׶\6vKq>)A m>P f {(^>PH>)L<9ղXAYE_VITT̘biQQ=z|,2P*P\dR[y$N⢂(Y$qvE-?޶6n\8}^womc Ѵ{y1\EtonsEZ*?UGlbR.w :W%D&1Q{z MHwwn8^Z l)$5 Z|S?4!-+V( \ĉ1Y%wi-ALU]axX-+r}6UOj RVia*JݲOrP% Yై5@팪b;H@2\" e(PHzWp"ډ1t8;,++\c5O4 t6B:4Urv(qU<- r>;QM'<_IϨ lg( $ncof6ӥ*e B^~hP:f5QqSݸ.3l QBTsFtœ f9WPyEk :'&OmtzyLXzS>N;iReUq/En~ہ@үQY-qL3q2k/\ A⹺wf׻q&893,H␲Rg,4UWP\P@B2b`KF_oimP/к#gAUSXˀ<8fŲI&gj Gڎ0YV  UP{2a汶 2y 5T[]?LL3$r; j95PPX2Z3q'PҰiR/{{@Ы@H9l* @TfX !e)ɢ2ϘXi@*d1YP0,>f_u$# F` yrN>ؤg%R~)U 2ۍNPlG n2,]V!)R.NG~ G:ɊtLkY_$*[v$h a=iF. @'02IcX$ӥ@ ?j5`ANyWǸ`a-)N⋹!f{M#x۞Oڛ ,dyB[9?4WrA#TGtk2-1.24992/gtk-demo/button_box.pl0000644000175000017500000000605013076462676015372 0ustar lacklack#!/usr/bin/perl -w # # Button Boxes # # The Button Box widgets are used to arrange buttons with padding. # package button_box; use Glib qw(TRUE FALSE); use Gtk2; sub create_bbox { my ($horizontal, $spacing, $layout) = @_; my $title = ucfirst $layout; my $frame = Gtk2::Frame->new ($title); my $bbox = $horizontal ? Gtk2::HButtonBox->new : Gtk2::VButtonBox->new; $bbox->set_border_width (5); $frame->add ($bbox); $bbox->set_layout ($layout); $bbox->set_spacing ($spacing); my $button = Gtk2::Button->new_from_stock ('gtk-ok'); $bbox->add ($button); $button = Gtk2::Button->new_from_stock ('gtk-cancel'); $bbox->add ($button); $button = Gtk2::Button->new_from_stock ('gtk-help'); $bbox->add ($button); return $frame; } my $window = undef; sub do { if (!$window) { $window = Gtk2::Window->new; $window->set_title ("Button Boxes"); $window->signal_connect (destroy => sub { $window = undef; 1 }); $window->set_border_width (10); my $main_vbox = Gtk2::VBox->new (FALSE, 0); $window->add ($main_vbox); my $frame_horz = Gtk2::Frame->new ("Horizontal Button Boxes"); $main_vbox->pack_start ($frame_horz, TRUE, TRUE, 10); my $vbox = Gtk2::VBox->new (FALSE, 0); $vbox->set_border_width (10); $frame_horz->add ($vbox); $vbox->pack_start (create_bbox (TRUE, 40, 'spread'), TRUE, TRUE, 0); $vbox->pack_start (create_bbox (TRUE, 40, 'edge'), TRUE, TRUE, 5); $vbox->pack_start (create_bbox (TRUE, 40, 'start'), TRUE, TRUE, 5); $vbox->pack_start (create_bbox (TRUE, 40, 'end'), TRUE, TRUE, 5); my $frame_vert = Gtk2::Frame->new ("Vertical Button Boxes"); $main_vbox->pack_start ($frame_vert, TRUE, TRUE, 10); my $hbox = Gtk2::HBox->new (FALSE, 0); $hbox->set_border_width (10); $frame_vert->add ($hbox); $hbox->pack_start (create_bbox (FALSE, 30, 'spread'), TRUE, TRUE, 0); $hbox->pack_start (create_bbox (FALSE, 30, 'edge'), TRUE, TRUE, 5); $hbox->pack_start (create_bbox (FALSE, 30, 'start'), TRUE, TRUE, 5); $hbox->pack_start (create_bbox (FALSE, 30, 'end'), TRUE, TRUE, 5); } if (!$window->visible) { $window->show_all; } else { $window->destroy; $window = undef; } return $window; } 1; __END__ Copyright (C) 2003 by the gtk2-perl team (see the file AUTHORS for the full list) This library is free software; you can redistribute it and/or modify it under the terms of the GNU Library General Public License as published by the Free Software Foundation; either version 2.1 of the License, or (at your option) any later version. This library is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Library General Public License for more details. You should have received a copy of the GNU Library General Public License along with this library; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. Gtk2-1.24992/gtk-demo/pixbufs.pl0000644000175000017500000001345413076462676014675 0ustar lacklack#!/usr/bin/perl -w # # Pixbufs # # A GdkPixbuf represents an image, normally in RGB or RGBA format. # Pixbufs are normally used to load files from disk and perform # image scaling. # # This demo is not all that educational, but looks cool. It was written # by Extreme Pixbuf Hacker Federico Mena Quintero. It also shows # off how to use GtkDrawingArea to do a simple animation. # # Look at the Image demo for additional pixbuf usage examples. # # package pixbufs; use Glib qw(TRUE FALSE); use Gtk2; use strict; chdir '../gtk-demo'; use constant FRAME_DELAY => 50; use constant BACKGROUND_NAME => "background.jpg"; my @image_names = ( "apple-red.png", "gnome-applets.png", "gnome-calendar.png", "gnome-foot.png", "gnome-gmush.png", "gnome-gimp.png", "gnome-gsame.png", "gnu-keys.png" ); # demo window my $window = undef; # Current frame my $frame; # Background image my $background; my ($back_width, $back_height); # Images my @images; # Widgets my $da; # Loads the images for the demo. # croaks if anything goes wrong. sub load_pixbufs { return TRUE if $background; # already loaded earlier # demo_find_file() looks in the the current directory first, # so you can run gtk-demo without installing GTK, then looks # in the location where the file is installed. # my $filename = main::demo_find_file (BACKGROUND_NAME); $background = Gtk2::Gdk::Pixbuf->new_from_file ($filename); $back_width = $background->get_width; $back_height = $background->get_height; foreach my $i (@image_names) { push @images, Gtk2::Gdk::Pixbuf->new_from_file ( main::demo_find_file ($i)); } return TRUE; } # Expose callback for the drawing area sub expose_cb { my ($widget, $event) = @_; # the C code that this replaces used gdk_pixbuf_get_pixels and # gdk_draw_rgb_image_dithalign, with pointer math to find the # correct index in the image data; that doesn't work well with # perl scalars, and besides, the GdkPixbuf method render_to_drawable # exists for this very purpose. $frame->render_to_drawable ($widget->window, $widget->style->black_gc, $event->area->x, $event->area->y, $event->area->x, $event->area->y, $event->area->width, $event->area->height, 'normal', $event->area->x, $event->area->y); return TRUE; } use constant CYCLE_LEN => 60; use constant G_PI => 3.141529; use POSIX; sub MAX { $_[0] > $_[1] ? $_[0] : $_[1] } sub MIN { $_[0] < $_[1] ? $_[0] : $_[1] } my $frame_num = 0; # Timeout handler to regenerate the frame sub timeout { $background->copy_area (0, 0, $back_width, $back_height, $frame, 0, 0); my $f = ($frame_num % CYCLE_LEN) / CYCLE_LEN; my $xmid = $back_width / 2.0; my $ymid = $back_height / 2.0; my $radius = MIN ($xmid, $ymid) / 2.0; for (my $i = 0; $i < @images; $i++) { my $ang = 2.0 * G_PI * $i / @images - $f * 2.0 * G_PI; my $iw = $images[$i]->get_width; my $ih = $images[$i]->get_height; my $r = $radius + ($radius / 3.0) * sin ($f * 2.0 * G_PI); my $xpos = POSIX::floor ($xmid + $r * cos ($ang) - $iw / 2.0 + 0.5); my $ypos = POSIX::floor ($ymid + $r * sin ($ang) - $ih / 2.0 + 0.5); my $k = ($i & 1) ? sin ($f * 2.0 * G_PI) : cos ($f * 2.0 * G_PI); $k = 2.0 * $k * $k; $k = MAX (0.25, $k); my $r1 = Gtk2::Gdk::Rectangle->new ($xpos, $ypos, $iw * $k, $ih * $k); my $r2 = Gtk2::Gdk::Rectangle->new (0, 0, $back_width, $back_height); my $dest = $r1->intersect ($r2); if ($dest) { $images[$i]->composite ($frame, $dest->x, $dest->y, $dest->width, $dest->height, $xpos, $ypos, $k, $k, 'nearest', (($i & 1) ? MAX (127, abs (255 * sin ($f * 2.0 * G_PI))) : MAX (127, abs (255 * cos ($f * 2.0 * G_PI))))); } } $da->queue_draw; $frame_num++; return TRUE; } my $timeout_id; sub cleanup_callback { Glib::Source->remove ($timeout_id); $timeout_id = 0; } sub do { if (!$window) { $window = Gtk2::Window->new; $window->set_title ("Pixbufs"); $window->set_resizable (FALSE); $window->signal_connect (destroy => sub {$window=undef; 1}); $window->signal_connect (destroy => \&cleanup_callback); eval { load_pixbufs; }; if ($@) { my $dialog = Gtk2::MessageDialog->new ($window, 'destroy-with-parent', 'error', 'close', "Failed to load an image: $@"); $dialog->signal_connect (response => sub { $_[0]->destroy; 1 }); $dialog->show; } else { $window->set_size_request ($back_width, $back_height); $frame = Gtk2::Gdk::Pixbuf->new ('rgb', FALSE, 8, $back_width, $back_height); $da = Gtk2::DrawingArea->new; $da->signal_connect (expose_event => \&expose_cb); $window->add ($da); $timeout_id = Glib::Timeout->add (FRAME_DELAY, \&timeout); } } if (!$window->visible) { $window->show_all; } else { $window->destroy; $window = undef; } return $window; } 1; __END__ Copyright (C) 2003 by the gtk2-perl team (see the file AUTHORS for the full list) This library is free software; you can redistribute it and/or modify it under the terms of the GNU Library General Public License as published by the Free Software Foundation; either version 2.1 of the License, or (at your option) any later version. This library is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Library General Public License for more details. You should have received a copy of the GNU Library General Public License along with this library; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. Gtk2-1.24992/gtk-demo/images.pl0000644000175000017500000002345413076462676014463 0ustar lacklack#!/usr/bin/perl -w # # Images # # GtkImage is used to display an image; the image can be in a number of formats. # Typically, you load an image into a GdkPixbuf, then display the pixbuf. # # This demo code shows some of the more obscure cases, in the simple # case a call to gtk_image_new_from_file() is all you need. # # If you want to put image data in your program as a C variable, # use the make-inline-pixbuf program that comes with GTK+. # This way you won't need to depend on loading external files, your # application binary can be self-contained. # package images; use Glib qw(TRUE FALSE); use Gtk2; use strict; my $i; #include "demo-common.h" my $window = undef; my $pixbuf_loader = undef; my $load_timeout = 0; my $image_stream = undef; sub error_popup { my $parent = shift; my $message = shift; my $dialog = Gtk2::MessageDialog->new ($parent, 'destroy-with-parent', 'error', 'close', $message); $dialog->signal_connect (response => sub {$_[0]->destroy; 1}); $dialog->show; } sub progressive_prepared_callback { my ($loader, $image) = @_; my $pixbuf = $loader->get_pixbuf; # # Avoid displaying random memory contents, since the pixbuf # isn't filled in yet. # $pixbuf->fill (0xaaaaaaff); $image->set_from_pixbuf ($pixbuf); } sub progressive_updated_callback { my ($loader, $x, $y, $width, $height, $image) = @_; # # We know the pixbuf inside the GtkImage has changed, but the image # itself doesn't know this; so queue a redraw. If we wanted to be # really efficient, we could use a drawing area or something # instead of a GtkImage, so we could control the exact position of # the pixbuf on the display, then we could queue a draw for only # the updated area of the image. # $image->queue_draw; } sub progressive_timeout { my $image = shift; # # This shows off fully-paranoid error handling, so looks scary. # You could factor out the error handling code into a nice separate # function to make things nicer. # if (defined $image_stream) { my $buf; my $bytes_read = read ($image_stream, $buf, 512); # sysread returns undef on error if (not defined $bytes_read) { error_popup ($window, "Failure reading image file 'alphatest.png': $!"); close $image_stream; $image_stream = undef; $load_timeout = 0; return FALSE; # uninstall the timeout } if ($bytes_read == 0) { warn "end of file"; close $image_stream; $image_stream = undef; return TRUE; # do NOT uninstall the timeout, we'll just start loading again } eval { $pixbuf_loader->write ($buf) }; if ($@) { error_popup ($window, "Failed to load image: $@"); close $image_stream; $image_stream = undef; $load_timeout = 0; return FALSE; # uninstall the timeout } if (eof $image_stream) { close $image_stream; $image_stream = undef; # # Errors can happen on close, e.g. if the image file was # truncated we'll know on close that it was incomplete. # eval { $pixbuf_loader->close; }; if ($@) { error_popup ($window, "Failed to load image: $@"); $pixbuf_loader = undef; $load_timeout = 0; return FALSE; # uninstall the timeout } $pixbuf_loader = undef; } } else { my $error_message = undef; # # demo_find_file() looks in the the current directory first, # so you can run gtk-demo without installing GTK, then looks # in the location where the file is installed. # my $filename; eval { $filename = main::demo_find_file ("alphatest.png"); }; if ($@) { $error_message = $@; } else { open $image_stream, "<:raw", $filename or $error_message = "Unable to open image file 'alphatest.png': $!"; } if (not defined $image_stream) { error_popup ($window, $error_message); $load_timeout = 0; return FALSE; # uninstall the timeout } if ($pixbuf_loader) { $pixbuf_loader->close; $pixbuf_loader = undef; } $pixbuf_loader = Gtk2::Gdk::PixbufLoader->new; $pixbuf_loader->signal_connect (area_prepared => \&progressive_prepared_callback, $image); $pixbuf_loader->signal_connect (area_updated => \&progressive_updated_callback, $image); } # leave timeout installed return TRUE; } sub start_progressive_loading { my $image = shift; # # This is obviously totally contrived (we slow down loading # on purpose to show how incremental loading works). # The real purpose of incremental loading is the case where # you are reading data from a slow source such as the network. # The timeout simply simulates a slow data source by inserting # pauses in the reading process. # $load_timeout = Glib::Timeout->add (150, \&progressive_timeout, $image); } sub cleanup_callback { my ($object, $data) = @_; if ($load_timeout) { Glib::Source->remove ($load_timeout); $load_timeout = 0; } if ($pixbuf_loader) { $pixbuf_loader->close; $pixbuf_loader = undef; } if ($image_stream) { close $image_stream; } $image_stream = undef; } sub toggle_sensitivity_callback { my ($togglebutton, $container) = @_; my $newstate = ! $togglebutton->get_active; foreach my $child ($container->get_children) { # don't disable our toggle $child->set_sensitive ($newstate) if $child != $togglebutton; } } sub do { if (!$window) { $window = Gtk2::Window->new; $window->set_title ("Images"); $window->signal_connect (destroy => sub { $window = undef; 1 }); $window->signal_connect (destroy => \&cleanup_callback); $window->set_border_width (8); my $vbox = Gtk2::VBox->new (FALSE, 8); $vbox->set_border_width (8); $window->add ($vbox); my $label = Gtk2::Label->new; $label->set_markup ("Image loaded from a file"); $vbox->pack_start ($label, FALSE, FALSE, 0); my $frame = Gtk2::Frame->new; $frame->set_shadow_type ('in'); # # The alignment keeps the frame from growing when users resize # the window # my $align = Gtk2::Alignment->new (0.5, 0.5, 0, 0); $align->add ($frame); $vbox->pack_start ($align, FALSE, FALSE, 0); # # demo_find_file() looks in the the current directory first, # so you can run gtk-demo without installing GTK, then looks # in the location where the file is installed. # my $pixbuf = undef; eval { $pixbuf = Gtk2::Gdk::Pixbuf->new_from_file (main::demo_find_file ('gtk-logo-rgb.gif')); }; if ($@) { # This code shows off error handling. You can just use # gtk_image_new_from_file() instead if you don't want to report # errors to the user. If the file doesn't load when using # gtk_image_new_from_file(), a "missing image" icon will # be displayed instead. # error_popup ($window, "Unable to open image file 'gtk-logo-rgb.gif': $@"); } my $image = Gtk2::Image->new_from_pixbuf ($pixbuf); $frame->add ($image); # Animation $label = Gtk2::Label->new; $label->set_markup ("Animation loaded from a file"); $vbox->pack_start ($label, FALSE, FALSE, 0); $frame = Gtk2::Frame->new; $frame->set_shadow_type ('in'); # # The alignment keeps the frame from growing when users resize # the window # $align = Gtk2::Alignment->new (0.5, 0.5, 0, 0); $align->add ($frame); $vbox->pack_start ($align, FALSE, FALSE, 0); my $filename; eval { $filename = main::demo_find_file ("floppybuddy.gif"); }; $image = Gtk2::Image->new_from_file ($filename); $frame->add ($image); # Progressive $label = Gtk2::Label->new; $label->set_markup ("Progressive image loading"); $vbox->pack_start ($label, FALSE, FALSE, 0); $frame = Gtk2::Frame->new; $frame->set_shadow_type ('in'); # # The alignment keeps the frame from growing when users resize # the window # $align = Gtk2::Alignment->new (0.5, 0.5, 0, 0); $align->add ($frame); $vbox->pack_start ($align, FALSE, FALSE, 0); # # Create an empty image for now; the progressive loader # will create the pixbuf and fill it in. # $image = Gtk2::Image->new_from_pixbuf (undef); $frame->add ($image); start_progressive_loading ($image); # Sensitivity control my $button = Gtk2::ToggleButton->new ("_Insensitive"); $vbox->pack_start ($button, FALSE, FALSE, 0); $button->signal_connect (toggled => \&toggle_sensitivity_callback, $vbox); } if (!$window->visible) { $window->show_all; } else { $window->destroy; $window = undef; } return $window; } 1; Gtk2->init; &do; $window->signal_connect (destroy => sub {Gtk2->main_quit; 1}); Gtk2->main; 1; __END__ Copyright (C) 2003 by the gtk2-perl team (see the file AUTHORS for the full list) This library is free software; you can redistribute it and/or modify it under the terms of the GNU Library General Public License as published by the Free Software Foundation; either version 2.1 of the License, or (at your option) any later version. This library is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Library General Public License for more details. You should have received a copy of the GNU Library General Public License along with this library; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. Gtk2-1.24992/gtk-demo/menus.pl0000644000175000017500000001464013076462676014342 0ustar lacklack#!/usr/bin/perl -w # # Menus # # There are several widgets involved in displaying menus. The # GtkMenuBar widget is a horizontal menu bar, which normally appears # at the top of an application. The GtkMenu widget is the actual menu # that pops up. Both GtkMenuBar and GtkMenu are subclasses of # GtkMenuShell; a GtkMenuShell contains menu items # (GtkMenuItem). Each menu item contains text and/or images and can # be selected by the user. # # There are several kinds of menu item, including plain GtkMenuItem, # GtkCheckMenuItem which can be checked/unchecked, GtkRadioMenuItem # which is a check menu item that's in a mutually exclusive group, # GtkSeparatorMenuItem which is a separator bar, GtkTearoffMenuItem # which allows a GtkMenu to be torn off, and GtkImageMenuItem which # can place a GtkImage or other widget next to the menu text. # # A GtkMenuItem can have a submenu, which is simply a GtkMenu to pop # up when the menu item is selected. Typically, all menu items in a menu bar # have submenus. # # The GtkOptionMenu widget is a button that pops up a GtkMenu when clicked. # It's used inside dialogs and such. # # GtkItemFactory provides a higher-level interface for creating menu bars # and menus; while you can construct menus manually, most people don't # do that. There's a separate demo for GtkItemFactory. # # package menus; use strict; use Glib qw(TRUE FALSE); use Gtk2; use Gtk2::Gdk::Keysyms; sub create_menu { my ($depth, $tearoff) = @_; return undef if $depth < 1; my $menu = Gtk2::Menu->new; my $group = undef; if ($tearoff) { my $menuitem = Gtk2::TearoffMenuItem->new; $menu->append ($menuitem); $menuitem->show; } my ($i, $j); for ($i = 0, $j = 1; $i < 5; $i++, $j++) { my $buf = sprintf 'item %2d - %d', $depth, $j; #warn "creating [".($group?$group:"undef")."][$buf]\n"; my $menuitem = Gtk2::RadioMenuItem->new_with_label ($group, $buf); $group = $menuitem->get_group; $menu->append ($menuitem); $menuitem->show; $menuitem->set_sensitive (FALSE) if $i == 3; #$menuitem->set_submenu (create_menu ($depth - 1, TRUE)); my $submenu = create_menu ($depth - 1, TRUE); $menuitem->set_submenu ($submenu) if defined $submenu; } return $menu; } my $window = undef; sub do { if (!$window) { $window = Gtk2::Window->new; $window->signal_connect (destroy => sub { $window = undef; 1 }); $window->signal_connect (delete_event => sub { 1 }); my $accel_group = Gtk2::AccelGroup->new; $window->add_accel_group ($accel_group); $window->set_title ("menus"); $window->set_border_width (0); my $box1 = Gtk2::VBox->new (FALSE, 0); $window->add ($box1); $box1->show; my $menubar = Gtk2::MenuBar->new; $box1->pack_start ($menubar, FALSE, TRUE, 0); $menubar->show; my $menu = create_menu (2, TRUE); my $menuitem = Gtk2::MenuItem->new_with_label ("test\nline2"); $menuitem->set_submenu ($menu); $menubar->append ($menuitem); $menuitem->show; $menuitem = Gtk2::MenuItem->new_with_label ("foo"); $menuitem->set_submenu (create_menu (3, TRUE)); $menubar->append ($menuitem); $menuitem->show; $menuitem = Gtk2::MenuItem->new_with_label ("bar"); $menuitem->set_submenu (create_menu (4, TRUE)); $menuitem->set_right_justified (TRUE); $menubar->append ($menuitem); $menuitem->show; my $box2 = Gtk2::VBox->new (FALSE, 10); $box2->set_border_width (10); $box1->pack_start ($box2, TRUE, TRUE, 0); $box2->show; $menu = create_menu (1, FALSE); $menu->set_accel_group ($accel_group); $menuitem = Gtk2::SeparatorMenuItem->new; $menu->append ($menuitem); $menuitem->show; $menuitem = Gtk2::CheckMenuItem->new_with_label ("Accelerate Me"); $menu->append ($menuitem); $menuitem->show; $menuitem->show; $menuitem->add_accelerator (activate => $accel_group, $Gtk2::Gdk::Keysyms{F1}, #GDK_F1, [], ['visible']); $menuitem = Gtk2::CheckMenuItem->new_with_label ("Accelerator Locked"); $menu->append ($menuitem); $menuitem->show; $menuitem->add_accelerator (activate => $accel_group, $Gtk2::Gdk::Keysyms{F2}, #GDK_F2, [], [qw/visible locked/]); $menuitem = Gtk2::CheckMenuItem->new_with_label ("Accelerators Frozen"); $menu->append ($menuitem); $menuitem->show; $menuitem->add_accelerator (activate => $accel_group, $Gtk2::Gdk::Keysyms{F2}, #GDK_F2, [], ['visible']); $menuitem->add_accelerator (activate => $accel_group, $Gtk2::Gdk::Keysyms{F3}, #GDK_F3, [], ['visible']); my $optionmenu = Gtk2::OptionMenu->new; $optionmenu->set_menu ($menu); $optionmenu->set_history (3); $box2->pack_start ($optionmenu, TRUE, TRUE, 0); $optionmenu->show; my $separator = Gtk2::HSeparator->new; $box1->pack_start ($separator, FALSE, TRUE, 0); $separator->show; $box2 = Gtk2::VBox->new (FALSE, 10); $box2->set_border_width (10); $box1->pack_start ($box2, FALSE, TRUE, 0); $box2->show; ## my $button = Gtk2::Button->new_with_label ("close"); my $button = Gtk2::Button->new ("close"); $button->signal_connect_swapped (clicked => sub { $window->destroy; 1 }); $box2->pack_start ($button, TRUE, TRUE, 0); $button->set_flags ('can-default'); $button->grab_default; $button->show; } if (! $window->visible) { $window->show; } else { $window->destroy; $window = undef; } return $window; } 1; __END__ Copyright (C) 2003 by the gtk2-perl team (see the file AUTHORS for the full list) This library is free software; you can redistribute it and/or modify it under the terms of the GNU Library General Public License as published by the Free Software Foundation; either version 2.1 of the License, or (at your option) any later version. This library is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Library General Public License for more details. You should have received a copy of the GNU Library General Public License along with this library; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. Gtk2-1.24992/gtk-demo/tree_store.pl0000644000175000017500000003576413076462676015400 0ustar lacklack# Tree View/Tree Store # # The GtkTreeStore is used to store data in tree form, to be # used later on by a GtkTreeView to display it. This demo builds # a simple GtkTreeStore and displays it. If you're new to the # GtkTreeView widgets and associates, look into the GtkListStore # example first. # package tree_store; use Gtk2; use Glib qw(TRUE FALSE); my $window = undef; # columns use constant HOLIDAY_NAME_COLUMN => 0; use constant ALEX_COLUMN => 1; use constant HAVOC_COLUMN => 2; use constant TIM_COLUMN => 3; use constant OWEN_COLUMN => 4; use constant DAVE_COLUMN => 5; use constant VISIBLE_COLUMN => 6; use constant WORLD_COLUMN => 7; use constant NUM_COLUMNS => 8; # # tree data # my @january = ( { label => "New Years Day", alex => TRUE, havoc => TRUE, tim => TRUE, owen => TRUE, dave => FALSE, world_holiday => TRUE }, { label => "Presidential Inauguration", alex => FALSE, havoc => TRUE, tim => FALSE, owen => TRUE, dave => FALSE, world_holiday => FALSE }, { label => "Martin Luther King Jr. day", alex => FALSE, havoc => TRUE, tim => FALSE, owen => TRUE, dave => FALSE, world_holiday => FALSE }, ); my @february = ( { label => "Presidents' Day", alex => FALSE, havoc => TRUE, tim => FALSE, owen => TRUE, dave => FALSE, world_holiday => FALSE }, { label => "Groundhog Day", alex => FALSE, havoc => FALSE, tim => FALSE, owen => FALSE, dave => FALSE, world_holiday => FALSE }, { label => "Valentine's Day", alex => FALSE, havoc => FALSE, tim => FALSE, owen => FALSE, dave => TRUE, world_holiday => TRUE }, ); my @march = ( { label => "National Tree Planting Day", alex => FALSE, havoc => FALSE, tim => FALSE, owen => FALSE, dave => FALSE, world_holiday => FALSE }, { label => "St Patrick's Day", alex => FALSE, havoc => FALSE, tim => FALSE, owen => FALSE, dave => FALSE, world_holiday => TRUE }, ); my @april = ( { label => "April Fools' Day", alex => FALSE, havoc => FALSE, tim => FALSE, owen => FALSE, dave => FALSE, world_holiday => TRUE }, { label => "Army Day", alex => FALSE, havoc => FALSE, tim => FALSE, owen => FALSE, dave => FALSE, world_holiday => FALSE }, { label => "Earth Day", alex => FALSE, havoc => FALSE, tim => FALSE, owen => FALSE, dave => FALSE, world_holiday => TRUE }, { label => "Administrative Professionals' Day", alex => FALSE, havoc => FALSE, tim => FALSE, owen => FALSE, dave => FALSE, world_holiday => FALSE }, ); my @may = ( { label => "Nurses' Day", alex => FALSE, havoc => FALSE, tim => FALSE, owen => FALSE, dave => FALSE, world_holiday => FALSE }, { label => "National Day of Prayer", alex => FALSE, havoc => FALSE, tim => FALSE, owen => FALSE, dave => FALSE, world_holiday => FALSE }, { label => "Mothers' Day", alex => FALSE, havoc => FALSE, tim => FALSE, owen => FALSE, dave => FALSE, world_holiday => TRUE }, { label => "Armed Forces Day", alex => FALSE, havoc => FALSE, tim => FALSE, owen => FALSE, dave => FALSE, world_holiday => FALSE }, { label => "Memorial Day", alex => TRUE, havoc => TRUE, tim => TRUE, owen => TRUE, dave => FALSE, world_holiday => TRUE }, ); my @june = ( { label => "June Fathers' Day", alex => FALSE, havoc => FALSE, tim => FALSE, owen => FALSE, dave => FALSE, world_holiday => TRUE }, { label => "Juneteenth (Liberation of Slaves)", alex => FALSE, havoc => FALSE, tim => FALSE, owen => FALSE, dave => FALSE, world_holiday => FALSE }, { label => "Flag Day", alex => FALSE, havoc => TRUE, tim => FALSE, owen => TRUE, dave => FALSE, world_holiday => FALSE }, ); my @july = ( { label => "Parents' Day", alex => FALSE, havoc => FALSE, tim => FALSE, owen => FALSE, dave => FALSE, world_holiday => TRUE }, { label => "Independence Day", alex => FALSE, havoc => TRUE, tim => FALSE, owen => TRUE, dave => FALSE, world_holiday => FALSE }, ); my @august = ( { label => "Air Force Day", alex => FALSE, havoc => FALSE, tim => FALSE, owen => FALSE, dave => FALSE, world_holiday => FALSE }, { label => "Coast Guard Day", alex => FALSE, havoc => FALSE, tim => FALSE, owen => FALSE, dave => FALSE, world_holiday => FALSE }, { label => "Friendship Day", alex => FALSE, havoc => FALSE, tim => FALSE, owen => FALSE, dave => FALSE, world_holiday => FALSE }, ); my @september = ( { label => "Grandparents' Day", alex => FALSE, havoc => FALSE, tim => FALSE, owen => FALSE, dave => FALSE, world_holiday => TRUE }, { label => "Citizenship Day or Constitution Day", alex => FALSE, havoc => FALSE, tim => FALSE, owen => FALSE, dave => FALSE, world_holiday => FALSE }, { label => "Labor Day", alex => TRUE, havoc => TRUE, tim => TRUE, owen => TRUE, dave => FALSE, world_holiday => TRUE }, ); my @october = ( { label => "National Children's Day", alex => FALSE, havoc => FALSE, tim => FALSE, owen => FALSE, dave => FALSE, world_holiday => FALSE }, { label => "Bosses' Day", alex => FALSE, havoc => FALSE, tim => FALSE, owen => FALSE, dave => FALSE, world_holiday => FALSE }, { label => "Sweetest Day", alex => FALSE, havoc => FALSE, tim => FALSE, owen => FALSE, dave => FALSE, world_holiday => FALSE }, { label => "Mother-in-Law's Day", alex => FALSE, havoc => FALSE, tim => FALSE, owen => FALSE, dave => FALSE, world_holiday => FALSE }, { label => "Navy Day", alex => FALSE, havoc => FALSE, tim => FALSE, owen => FALSE, dave => FALSE, world_holiday => FALSE }, { label => "Columbus Day", alex => FALSE, havoc => TRUE, tim => FALSE, owen => TRUE, dave => FALSE, world_holiday => FALSE }, { label => "Halloween", alex => FALSE, havoc => FALSE, tim => FALSE, owen => FALSE, dave => FALSE, world_holiday => TRUE }, ); my @november = ( { label => "Marine Corps Day", alex => FALSE, havoc => FALSE, tim => FALSE, owen => FALSE, dave => FALSE, world_holiday => FALSE }, { label => "Veterans' Day", alex => TRUE, havoc => TRUE, tim => TRUE, owen => TRUE, dave => FALSE, world_holiday => TRUE }, { label => "Thanksgiving", alex => FALSE, havoc => TRUE, tim => FALSE, owen => TRUE, dave => FALSE, world_holiday => FALSE }, ); my @december = ( { label => "Pearl Harbor Remembrance Day", alex => FALSE, havoc => FALSE, tim => FALSE, owen => FALSE, dave => FALSE, world_holiday => FALSE }, { label => "Christmas", alex => TRUE, havoc => TRUE, tim => TRUE, owen => TRUE, dave => FALSE, world_holiday => TRUE }, { label => "Kwanzaa", alex => FALSE, havoc => FALSE, tim => FALSE, owen => FALSE, dave => FALSE, world_holiday => FALSE }, ); my @toplevel = ( {label => "January", children => \@january}, {label => "February", children => \@february}, {label => "March", children => \@march}, {label => "April", children => \@april}, {label => "May", children => \@may}, {label => "June", children => \@june}, {label => "July", children => \@july}, {label => "August", children => \@august}, {label => "September", children => \@september}, {label => "October", children => \@october}, {label => "November", children => \@november}, {label => "December", children => \@december}, ); #static GtkTreeModel * #create_model (void) sub create_model { # create tree store # model = gtk_tree_store_new (NUM_COLUMNS, # G_TYPE_STRING, # G_TYPE_BOOLEAN, # G_TYPE_BOOLEAN, # G_TYPE_BOOLEAN, # G_TYPE_BOOLEAN, # G_TYPE_BOOLEAN, # G_TYPE_BOOLEAN, # G_TYPE_BOOLEAN); my $model = Gtk2::TreeStore->new (qw/ Glib::String Glib::Boolean Glib::Boolean Glib::Boolean Glib::Boolean Glib::Boolean Glib::Boolean Glib::Boolean /); # add data to the tree store/ foreach my $month (@toplevel) { my $iter = $model->append (undef); $model->set ($iter, HOLIDAY_NAME_COLUMN, $month->{label}, ALEX_COLUMN, FALSE, HAVOC_COLUMN, FALSE, TIM_COLUMN, FALSE, OWEN_COLUMN, FALSE, DAVE_COLUMN, FALSE, VISIBLE_COLUMN, FALSE, WORLD_COLUMN, FALSE); # add children foreach my $holiday (@{ $month->{children} }) { my $child_iter = $model->append ($iter); $model->set ($child_iter, HOLIDAY_NAME_COLUMN, $holiday->{label}, ALEX_COLUMN, $holiday->{alex}, HAVOC_COLUMN, $holiday->{havoc}, TIM_COLUMN, $holiday->{tim}, OWEN_COLUMN, $holiday->{owen}, DAVE_COLUMN, $holiday->{dave}, VISIBLE_COLUMN, TRUE, WORLD_COLUMN, $holiday->{world_holiday}); } } return $model; } #static void #item_toggled (GtkCellRendererToggle *cell, # gchar *path_str, # gpointer data) sub item_toggled { my ($cell, $path_str, $model) = @_; my $path = Gtk2::TreePath->new_from_string ($path_str); my $column = $cell->get_data ("column"); warn ("column is $column\n"); # get toggled iter $iter = $model->get_iter ($path); my ($toggle_item) = $model->get ($iter, $column); # do something with the value $toggle_item ^= 1; # set new value $model->set ($iter, $column, $toggle_item); # /* clean up */ # gtk_tree_path_free (path); } #static void #add_columns (GtkTreeView *treeview) sub add_columns { my $treeview = shift; my $model = $treeview->get_model; # column for holiday names my $renderer = Gtk2::CellRendererText->new; $renderer->set (xalign => 0.0); my $col_offset = $treeview->insert_column_with_attributes (-1, "Holiday", $renderer, text => HOLIDAY_NAME_COLUMN); my $column = $treeview->get_column ($col_offset - 1); $column->set_clickable (TRUE); # alex column $renderer = Gtk2::CellRendererToggle->new; $renderer->set (xalign => 0.0); $renderer->set_data (column => ALEX_COLUMN); $renderer->signal_connect (toggled => \&item_toggled, $model); $col_offset = $treeview->insert_column_with_attributes (-1, "Alex", $renderer, active => ALEX_COLUMN, visible => VISIBLE_COLUMN, activatable => WORLD_COLUMN); $column = $treeview->get_column ($col_offset - 1); $column->set_sizing ('fixed'); $column->set_fixed_width (50); $column->set_clickable (TRUE); # havoc column $renderer = Gtk2::CellRendererToggle->new; $renderer->set (xalign => 0.0); $renderer->set_data (column => HAVOC_COLUMN); $renderer->signal_connect (toggled => \&item_toggled, $model); $col_offset = $treeview->insert_column_with_attributes (-1, "Havoc", $renderer, active => HAVOC_COLUMN, visible => VISIBLE_COLUMN); $column = $treeview->get_column ($col_offset - 1); $column->set_sizing ('fixed'); $column->set_fixed_width (50); $column->set_clickable (TRUE); # tim column $renderer = Gtk2::CellRendererToggle->new; $renderer->set (xalign => 0.0); $renderer->set_data (column => TIM_COLUMN); $renderer->signal_connect (toggled => \&item_toggled, $model); $col_offset = $treeview->insert_column_with_attributes (-1, "Tim", $renderer, active => TIM_COLUMN, visible => VISIBLE_COLUMN, activatable => WORLD_COLUMN); $column = $treeview->get_column ($col_offset - 1); $column->set_sizing ('fixed'); $column->set_fixed_width (50); $column->set_clickable (TRUE); # owen column $renderer = Gtk2::CellRendererToggle->new; $renderer->set (xalign => 0.0); $renderer->set_data (column => OWEN_COLUMN); $renderer->signal_connect (toggled => \&item_toggled, $model); $col_offset = $treeview->insert_column_with_attributes (-1, "Owen", $renderer, active => OWEN_COLUMN, visible => VISIBLE_COLUMN); $column = $treeview->get_column ($col_offset - 1); $column->set_sizing ('fixed'); $column->set_fixed_width (50); $column->set_clickable (TRUE); # dave column $renderer = Gtk2::CellRendererToggle->new; $renderer->set (xalign => 0.0); $renderer->set_data (column => DAVE_COLUMN); $renderer->signal_connect (toggled => \&item_toggled, $model); $col_offset = $treeview->insert_column_with_attributes (-1, "Dave", $renderer, active => DAVE_COLUMN, visible => VISIBLE_COLUMN); $column = $treeview->get_column ($col_offset - 1); $column->set_sizing ('fixed'); $column->set_fixed_width (50); $column->set_clickable (TRUE); } sub do { if (!$window) { # create window, etc $window = Gtk2::Window->new ('toplevel'); $window->set_title ("Card planning sheet"); $window->signal_connect (destroy => sub { $window = undef }); my $vbox = Gtk2::VBox->new (FALSE, 8); $vbox->set_border_width (8); $window->add ($vbox); $vbox->pack_start (Gtk2::Label->new ("Jonathan's Holiday Card Planning Sheet"), FALSE, FALSE, 0); my $sw = Gtk2::ScrolledWindow->new (undef, undef); $sw->set_shadow_type ('etched-in'); $sw->set_policy ('automatic', 'automatic'); $vbox->pack_start ($sw, TRUE, TRUE, 0); # create model my $model = create_model (); # create tree view ##my $treeview = Gtk2::TreeView->new_with_model ($model); my $treeview = Gtk2::TreeView->new ($model); ### g_object_unref (model); $treeview->set_rules_hint (TRUE); $treeview->get_selection->set_mode ('multiple'); add_columns ($treeview); $sw->add ($treeview); # expand all rows after the treeview widget has been realized $treeview->signal_connect (realize => sub { $_[0]->expand_all; 1 }); $window->set_default_size (650, 400); } if (!$window->visible) { $window->show_all; } else { $window->destroy; $window = undef; } return $window; } 1; __END__ Copyright (C) 2003 by the gtk2-perl team (see the file AUTHORS for the full list) This library is free software; you can redistribute it and/or modify it under the terms of the GNU Library General Public License as published by the Free Software Foundation; either version 2.1 of the License, or (at your option) any later version. This library is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Library General Public License for more details. You should have received a copy of the GNU Library General Public License along with this library; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. Gtk2-1.24992/gtk-demo/editable_cells.pl0000644000175000017500000001313313076462676016142 0ustar lacklack# Tree View/Editable Cells # # This demo demonstrates the use of editable cells in a GtkTreeView. If # you're new to the GtkTreeView widgets and associates, look into # the GtkListStore example first. # # package editable_cells; use Glib qw(TRUE FALSE); use Gtk2; my $window = undef; #typedef struct #{ # gint number; # gchar *product; # gboolean editable; #} #Item; use constant COLUMN_NUMBER => 0; use constant COLUMN_PRODUCT => 1; use constant COLUMN_EDITABLE => 2; use constant NUM_COLUMNS => 3; my @articles = (); sub add_items { push @articles, { number => 3, product => "bottles of coke", editable => TRUE, }, { number => 5, product => "packages of noodles", editable => TRUE, }, { number => 2, product => "packages of chocolate chip cookies", editable => TRUE, }, { number => 1, product => "can vanilla ice cream", editable => TRUE, }, { number => 6, product => "eggs", editable => TRUE, }, ; } sub create_model { # create array add_items (); # create list store my $model = Gtk2::ListStore->new (qw/Glib::Int Glib::String Glib::Boolean/); # add items foreach my $a (@articles) { my $iter = $model->append; $model->set ($iter, COLUMN_NUMBER, $a->{number}, COLUMN_PRODUCT, $a->{product}, COLUMN_EDITABLE, $a->{editable}); } return $model; } sub add_item { my ($button, $model) = @_; push @articles, { number => 0, product => "Description here", editable => TRUE, }; my $iter = $model->append; $model->set ($iter, COLUMN_NUMBER, $articles[-1]{number}, COLUMN_PRODUCT, $articles[-1]{product}, COLUMN_EDITABLE, $articles[-1]{editable}); } sub remove_item { my ($widget, $treeview) = @_; my $model = $treeview->get_model; my $selection = $treeview->get_selection; my $iter = $selection->get_selected; if ($iter) { my $path = $model->get_path ($iter); my $i = ($path->get_indices)[0]; $model->remove ($iter); splice @articles, $i; } } sub cell_edited { my ($cell, $path_string, $new_text, $model) = @_; my $path = Gtk2::TreePath->new_from_string ($path_string); my $column = $cell->get_data ("column"); my $iter = $model->get_iter ($path); if ($column == COLUMN_NUMBER) { my $i = ($path->get_indices)[0]; $articles[$i]{number} = $new_text; $model->set ($iter, $column, $articles[$i]{number}); } elsif ($column == COLUMN_PRODUCT) { my $i = ($path->get_indices)[0]; $articles[$i]{product} = $new_text; $model->set ($iter, $column, $articles[$i]{product}); } } sub add_columns { my $treeview = shift; my $model = $treeview->get_model; # number column my $renderer = Gtk2::CellRendererText->new; $renderer->signal_connect (edited => \&cell_edited, $model); $renderer->set_data (column => COLUMN_NUMBER); $treeview->insert_column_with_attributes (-1, "Number", $renderer, text => COLUMN_NUMBER, editable => COLUMN_EDITABLE); # product column $renderer = Gtk2::CellRendererText->new; $renderer->signal_connect (edited => \&cell_edited, $model); $renderer->set_data (column => COLUMN_PRODUCT); $treeview->insert_column_with_attributes (-1, "Product", $renderer, text => COLUMN_PRODUCT, editable => COLUMN_EDITABLE); } sub do { if (!$window) { # create window, etc $window = Gtk2::Window->new; $window->set_title ("Shopping list"); $window->set_border_width (5); $window->signal_connect (destroy => sub { $window = undef; 1 }); my $vbox = Gtk2::VBox->new (FALSE, 5); $window->add ($vbox); $vbox->pack_start (Gtk2::Label->new ("Shopping list (you can edit the cells!)"), FALSE, FALSE, 0); my $sw = Gtk2::ScrolledWindow->new; $sw->set_shadow_type ('etched-in'); $sw->set_policy ('automatic', 'automatic'); $vbox->pack_start ($sw, TRUE, TRUE, 0); # create model my $model = create_model (); # create tree view my $treeview = Gtk2::TreeView->new_with_model ($model); ## g_object_unref (model); $treeview->set_rules_hint (TRUE); $treeview->get_selection->set_mode ('single'); add_columns ($treeview); $sw->add ($treeview); # some buttons my $hbox = Gtk2::HBox->new (TRUE, 4); $vbox->pack_start ($hbox, FALSE, FALSE, 0); my $button = Gtk2::Button->new ("Add item"); $button->signal_connect (clicked => \&add_item, $model); $hbox->pack_start ($button, TRUE, TRUE, 0); $button = Gtk2::Button->new ("Remove item"); $button->signal_connect (clicked => \&remove_item, $treeview); $hbox->pack_start ($button, TRUE, TRUE, 0); $window->set_default_size (320, 200); } if (!$window->visible) { $window->show_all; } else { $window->destroy; $window = undef; } return $window; } 1; __END__ Copyright (C) 2003 by the gtk2-perl team (see the file AUTHORS for the full list) This library is free software; you can redistribute it and/or modify it under the terms of the GNU Library General Public License as published by the Free Software Foundation; either version 2.1 of the License, or (at your option) any later version. This library is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Library General Public License for more details. You should have received a copy of the GNU Library General Public License along with this library; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. Gtk2-1.24992/gtk-demo/rotated_text.pl0000644000175000017500000000765713076462676015733 0ustar lacklack#!/usr/bin/perl -w # Rotated Text # # This demo shows how to use GDK and Pango to draw rotated and transformed # text. The use of GdkPangoRenderer in this example is a somewhat advanced # technique; most applications can simply use gdk_draw_layout(). We use # it here mostly because that allows us to work in user coordinates - that is, # coordinates prior to the application of the transformation matrix, rather # than device coordinates. # # As of GTK+-2.6, the ability to draw transformed and anti-aliased graphics # as shown in this example is only present for text. With GTK+-2.8, a new # graphics system called "Cairo" will be introduced that provides these # capabilities and many more for all types of graphics. # package rotated_text; use strict; use Glib qw(TRUE FALSE); use Gtk2; use Gtk2::Pango; # constants my $window = undef; sub min { $_[0] < $_[1] ? $_[0] : $_[1] } sub rotated_text_expose_event { my ($widget, $event) = @_; use constant RADIUS => 150; use constant N_WORDS => 10; use constant FONT => "Sans Bold 27"; use constant M_PI => 3.141526; my $matrix = Gtk2::Pango::Matrix->new; # all defaults my $width = $widget->allocation->width; my $height = $widget->allocation->height; # Get the default renderer for the screen, and set it up for drawing my $renderer = Gtk2::Gdk::PangoRenderer->get_default ($widget->get_screen); $renderer->set_drawable ($widget->window); $renderer->set_gc ($widget->style->black_gc); # Set up a transformation matrix so that the user space coordinates for # the centered square where we draw are [-RADIUS, RADIUS], [-RADIUS, RADIUS] # We first center, then change the scale my $device_radius = min ($width, $height) / 2.; $matrix->translate ($device_radius + ($width - 2 * $device_radius) / 2, $device_radius + ($height - 2 * $device_radius) / 2); $matrix->scale ($device_radius / RADIUS, $device_radius / RADIUS); # Create a PangoLayout, set the font and text my $context = $widget->create_pango_context; my $layout = Gtk2::Pango::Layout->new ($context); $layout->set_text ("Text"); my $desc = Gtk2::Pango::FontDescription->from_string (FONT); $layout->set_font_description ($desc); # Draw the layout N_WORDS times in a circle foreach my $i (0..N_WORDS-1) { my $rotated_matrix = $matrix->copy; my $angle = (360. * $i) / N_WORDS; # Gradient from red at angle == 60 to blue at angle == 300 my $red = 65535 * (1 + cos (($angle - 60) * M_PI / 180.)) / 2; my $green = 0; my $blue = 65535 - $red; my $color = Gtk2::Gdk::Color->new ($red, $green, $blue); $renderer->set_override_color ('foreground', $color); $rotated_matrix->rotate ($angle); $context->set_matrix ($rotated_matrix); # Inform Pango to re-layout the text with the new transformation matrix $layout->context_changed; my ($width, $height) = $layout->get_size; $renderer->draw_layout ($layout, - $width / 2, - RADIUS * PANGO_SCALE); } # Clean up default renderer, since it is shared $renderer->set_override_color ('foreground', undef); $renderer->set_drawable (undef); $renderer->set_gc (undef); return FALSE; } sub do { my $do_widget = shift; if (!$window) { my $white = Gtk2::Gdk::Color->new (0xffff, 0xffff, 0xffff); $window = Gtk2::Window->new; $window->set_screen ($do_widget->get_screen); $window->set_title ("Rotated Text"); $window->signal_connect (destroy => sub { $window = undef; }); my $drawing_area = Gtk2::DrawingArea->new; $window->add ($drawing_area); # This overrides the background color from the theme $drawing_area->modify_bg ('normal', $white); $drawing_area->signal_connect (expose_event => \&rotated_text_expose_event); $window->set_default_size (2 * RADIUS, 2 * RADIUS); } if (! $window->visible) { $window->show_all; } else { $window->destroy; $window = undef; } return $window; } 1; Gtk2-1.24992/gtk-demo/entry_completion.pl0000644000175000017500000000346113076462676016604 0ustar lacklack#!/usr/bin/perl -w # # Entry Completion # # GtkEntryCompletion provides a mechanism for adding support for # completion in GtkEntry. # # package entry_completion; use strict; use Glib qw(TRUE FALSE); use Gtk2; my $window = undef; # Creates a tree model containing the completions sub create_completion_model { my $store = Gtk2::ListStore->new (Glib::String::); # Append one word $store->set ($store->append, 0, "GNOME"); # Append another word $store->set ($store->append, 0, "total"); # And another word $store->set ($store->append, 0, "totally"); return $store; } sub do { my $do_widget = shift; if (!$window) { $window = Gtk2::Dialog->new ("GtkEntryCompletion", $do_widget, [], "gtk-close" => 'none'); $window->set_resizable (FALSE); $window->signal_connect (response => sub {$window->destroy}); $window->signal_connect (destroy => sub {$window = undef}); my $vbox = Gtk2::VBox->new (FALSE, 5); $window->vbox->pack_start ($vbox, TRUE, TRUE, 0); $vbox->set_border_width (5); my $label = Gtk2::Label->new; $label->set_markup ("Completion demo, try writing total or gnome for example."); $vbox->pack_start ($label, FALSE, FALSE, 0); # Create our entry my $entry = Gtk2::Entry->new; $vbox->pack_start ($entry, FALSE, FALSE, 0); # Create the completion object my $completion = Gtk2::EntryCompletion->new; # Assign the completion to the entry $entry->set_completion ($completion); # Create a tree model and use it as the completion model $completion->set_model (create_completion_model ()); # Use model column 0 as the text column $completion->set_text_column (0); } if (!$window->visible) { $window->show_all; } else { $window->destroy; } return $window; } 1; Gtk2-1.24992/gtk-demo/gnome-gmush.png0000644000175000017500000000625413076462676015614 0ustar lacklackPNG  IHDR00WgAMA1_ cIDATx[$YNU{{qlbK"1R2QL B ͑xKH<8h`@/+lǻk{޹LwOwuu9UU }|O/}O ĭh(.]X}[W; <_^qƜȄX02#Lcŕ+kzk\Gw}?Ǔp2&N1iFuvIuvr;\{ |鯭4ӉQXd֐KRg5֊VCFϾ'CLXpzWGɬa0걺&=Y*_K+ǎ羓c̘I(c9\{k-)vGC$h 88K__xWWgW't-" .XLvb+Ng0Ƣ2Eeh8kqIz]T2Gd6%"@nY>| `oFX^=vxƚek-ΝEj @f22kU|as <5d$Z-~@RcF޴,:ۼ|GzrTfIZ!|: 8p 91a@Jߗx+6][=Ӧj>pOn_" bc3?ϛukO!DQkuffZlnl> RiΟybҌԦh2 Gl.hxW^wMDŽ " C(Bk &;;=]u4 ֮T*:œqfKssdWw>?v۝}tZ$nR*?x {!koƯ-?ܳ{rHNSGvIRa8  ~#&qL$R0ers7h$NXťuV$J&WrX._M9<|ߗ~K)58ILb,Zn#ʼni$ J}y`1j s*qȷomR)v{sp/oH?[~qX!RJj*RqOiA)d2A)E$ycZs 9GZ%X\gqao.κ<=stؗŷD>Rz{D)>t|cDQDE$IB) jlr!.-h68r mh6:O|=|?k8VۯGkY$ Ks$Ii2 DQD(A0;3#8~|޲Gfnрtww|LN\B<[?~+? q;h6xO|| \),T*cPJ!GUG @NI!:>rC t]qB̀f3'G'~~OwָcJBeH)B0L}BCkspFYufm_]^!tuG/4GK9RT*8Bnׅ!ֲHE0Dx<RzD⯟},BxX~+~u2c}U/dxkR1뽑V@D¿)i>ed!0 ihQJM H)WIFfIoZGn&js\*x-'FkHd$v>iRΎ1fZE'2zkܠ9Ph-'PX,0Okb–IL&&;|7W 9rUˣ_ρmw#$I SZk8- $sV2[/H)d$J81Sŗ <.diZOZ_rљ#Ϝ9R 9HӔ4M}cJGQV[l4K`MI&|^B»xpath_from_widget ($widget) . "\"\n"; } my @menu_items = ( [ "/_File", undef, undef, 0, "" ], [ "/File/tearoff1", undef, \>k_ifactory_cb, 0, "" ], [ "/File/_New", "N", \>k_ifactory_cb, 1 ], [ "/File/_Open", "O", \>k_ifactory_cb, 2 ], [ "/File/_Save", "S", \>k_ifactory_cb, 3 ], [ "/File/Save _As...", undef, \>k_ifactory_cb, 4 ], [ "/File/sep1", undef, \>k_ifactory_cb, 0, "" ], [ "/File/_Quit", "Q", \>k_ifactory_cb, 0 ], [ "/_Preferences", undef, undef, 0, "" ], [ "/_Preferences/_Color", undef, undef, 0, "" ], [ "/_Preferences/Color/_Red", undef, \>k_ifactory_cb, 0, "" ], [ "/_Preferences/Color/_Green", undef, \>k_ifactory_cb, 0, "/Preferences/Color/Red" ], [ "/_Preferences/Color/_Blue", undef, \>k_ifactory_cb, 0, "/Preferences/Color/Red" ], [ "/_Preferences/_Shape", undef, undef, 0, "" ], [ "/_Preferences/Shape/_Square", undef, \>k_ifactory_cb, 0, "" ], [ "/_Preferences/Shape/_Rectangle", undef, \>k_ifactory_cb, 0, "/Preferences/Shape/Square" ], [ "/_Preferences/Shape/_Oval", undef, \>k_ifactory_cb, 0, "/Preferences/Shape/Rectangle" ], [ "/_Help", undef, undef, 0, "" ], [ "/Help/_About", undef, \>k_ifactory_cb, 0 ], ); my $window = undef; sub do { if (!$window) { $window = Gtk2::Window->new; $window->signal_connect (destroy => sub { $window = undef; 1 }); $window->signal_connect (delete_event => sub { $window->destroy; 1 }); my $accel_group = Gtk2::AccelGroup->new; my $item_factory = Gtk2::ItemFactory->new ('Gtk2::MenuBar', '
', $accel_group); $window->{"
"} = $item_factory; $window->add_accel_group ($accel_group); $window->set_title ("Item Factory"); $window->set_border_width (0); ### $item_factory->create_items (nmenu_items, menu_items, NULL); $item_factory->create_items (undef, @menu_items); # preselect /Preferences/Shape/Oval over the other radios $item_factory->get_item ("/Preferences/Shape/Oval")->set_active (TRUE); my $box1 = Gtk2::VBox->new (FALSE, 0); $window->add ($box1); $box1->pack_start ($item_factory->get_widget ("
"), FALSE, FALSE, 0); my $label = Gtk2::Label->new ("Type\n\nto start"); $label->set_size_request (200, 200); $label->set_alignment (0.5, 0.5); $box1->pack_start ($label, TRUE, TRUE, 0); my $separator = Gtk2::HSeparator->new; $box1->pack_start ($separator, FALSE, TRUE, 0); my $box2 = Gtk2::VBox->new (FALSE, 10); $box2->set_border_width (10); $box1->pack_start ($box2, FALSE, TRUE, 0); my $button = Gtk2::Button->new ("close"); $button->signal_connect (clicked => sub {$window->destroy; 1}); $box2->pack_start ($button, TRUE, TRUE, 0); $button->set_flags ('can-default'); $button->grab_default; $window->show_all; } else { $window->destroy; $window = undef; } return $window; } 1; __END__ Copyright (C) 2003 by the gtk2-perl team (see the file AUTHORS for the full list) This library is free software; you can redistribute it and/or modify it under the terms of the GNU Library General Public License as published by the Free Software Foundation; either version 2.1 of the License, or (at your option) any later version. This library is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Library General Public License for more details. You should have received a copy of the GNU Library General Public License along with this library; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. Gtk2-1.24992/gtk-demo/apple-red.png0000644000175000017500000000673113076462676015237 0ustar lacklackPNG  IHDR00WgAMA a IDATx[]Wyk9s8 N)JڄڨB>pE WK R@@@BqS+8v3sk}>31^|֞9e{^tvy_Tz߇} r޽cksM?p<p+E>*ܾ֏ W]vfgvw>yv!'+_dLom]aD֭G7L#ͯ굿>tbލW-,.{>E,&+֬h /ڳ{^>߄z;?/ ;po}U.tKGŇf6)o]EZ91|}~ W--7C4 ;%씍ozۍ! g|aNgnMo,VKU!@0G|׶nڱk5pJog&;W5B8tpao;[6:׽O\ 2R wͮr|Ο=ZEB|[aղ,ꭿw~x VmB)Fhcݷ}\In}GSefc"vԪg/-3j"`wogpr>Aqow;7O ̄ & AXA۰ض8pS9pMNwnmჃja~n,v?s{v}7ُOP v4!tTUMOh[( 0 :4uȢ(;'yn9?Scbጙ!|'/͛7+Wu_իNH)D^'jFĪBĐ,h.%49 0ofH_ CSv&/ʁnzhɖtJ?ܽ^q6]^~ӣ&5)G1!@2 ĺۖzf r\饊6?7=_ޓwַ/;w'W7y'^jc wzCDqbO1H!޴a f曖cP26,dhRЀص0hO~ί{r/VOMVl^}5#ey_\3*1D7*Jx*4+Dƨ$",X^SxAJpǏvpǏ8Gݍ׮YmeM޲zr\ǎ1?L NɈq X4L Iz!u$Dw!P!X(3J⺫~w>*;o; fLթѦO{ A?MtzU:z47"qsHNDS@8ɜn5A75e<3atH` _ v:,~J;I`U"* af#Pp wD0US"Vka`9zT5^W/8Ognl?P2⠥Qs8;A T"J9%3^]vݫ )%@_jBxɘ9w'fT(0 -/lpaAAi#aEN0NKm7]E;tz`@~$Zɘ`xD^1CQƱoN@pu,@z%jS6:ઔEk)e  "`h "TFPv,GbrJ>5ZS TP'4QuGlb*-+18ʨ>L Uǣ",*V1,E, *U;Ή@&D "Ǐљ&}a5\ )"JF0U3 sh БB+isa+  J)-M:&Xɸ "y4âd-TrD@#Ȱ(q@S<ܶwŧULЛYE*J.D B#%Cdb`#j0#qZUT)h}7kCPK VfZaoI@PB iA ֩#  F Q>JdŽP1IP"XTlXE"ia"Z@<hsaЎgyhCL_) LMttzb|[{v0Fԕ*A"E" 'U(G3.ElPSZsD %;١B1rch&3Ԅ%$D9FbwƓ963{;ydb vXs<2N80qY?fza\!9zTr;O97c2~ie8]щblE˜ |\IENDB`Gtk2-1.24992/gtk-demo/gnome-calendar.png0000644000175000017500000000530313076462676016234 0ustar lacklackPNG  IHDR00WgAMA1_ zIDATx]lWwvvwNvc7֤}B"TDAVT臢ҨQ Ayh)BB R>ѠTb'󹉿];wwfa7N*Du5;wN;Nnn0;x}?&Ex @twRJ"T!@QW @ a H_(yJ6'C""a$ BuZ BiM* *=ܪD;ϏweBB E*es8N2H)A6/O^ZJ)[?J%#/hl34*aH(ω|>*c76 $2'\O6.8y}B1aᅊmsu'X aHB|rןP(J(^)RԑRDJNDΗ^ac_kG-VVW6l |#bhm!ne~ye9FhfA^G#7)rp$^<|] QJ"py2 KV^o $ʈ C;Qؐ{Iȥnc2}8ڭ;rk LdGui 8ƃ@ "Z!&7ֽ@^xO,k*)-l ]o[fMCz8@oܸ K;7ę v(d6LJxh-`Oˌ]5MdU`PHw@1c; 9D5#M@.}@7vg):?yyF+C ? lSKl =˓R)/fYZ)JgDeYZXbbGF@o84ށX5e!J:OS)N)w3ccdYv 180H+Mm֢@QNtR|'C^_Cgzt%eTkÐZ25;5эIXخh&BrĻt[jEZjc'ak*ͮa1yKTu]T%onl(r  ~ضrC4d'Ƅ:o!:zGcXd&zI} !ҩh+-G7 I4[=`ŵ $Mce_ܿ'F{1>7wccۀ^k1.Z\10ŁNVdf9v)c|t=< 3ccL̔1E94y0nzz=Du:3 #include #include "demo-common.h" ## ## The ChangeDisplayInfo structure corresponds to a toplevel window and ## holds pointers to widgets inside the toplevel window along with other ## information about the contents of the window. ## This is a common organizational structure in real applications. ## #typedef struct _ChangeDisplayInfo ChangeDisplayInfo; # #struct _ChangeDisplayInfo #{ # GtkWidget *window; # GtkSizeGroup *size_group; # # GtkTreeModel *display_model; # GtkTreeModel *screen_model; # GtkTreeSelection *screen_selection; # # GdkDisplay *current_display; # GdkScreen *current_screen; #}; # # These enumerations provide symbolic names for the columns # in the two GtkListStore models. # use constant DISPLAY_COLUMN_NAME => 0; use constant DISPLAY_COLUMN_DISPLAY => 1; use constant DISPLAY_NUM_COLUMNS => 2; use constant SCREEN_COLUMN_NUMBER => 0; use constant SCREEN_COLUMN_SCREEN => 1; use constant SCREEN_NUM_COLUMNS => 2; # # Finds the toplevel window under the mouse pointer, if any. # sub find_toplevel_at_pointer { my $display = shift; # my $pointer_window = $display->get_window_at_pointer; use Data::Dumper; my ($pointer_window, undef, undef) = $display->get_window_at_pointer; # # The user data field of a GdkWindow is used to store a pointer # to the widget that created it. # if ($pointer_window) { my $ptr = $pointer_window->get_user_data; if ($ptr) { my $widget = Glib::Object->new_from_pointer ($ptr); return $widget ? $widget->get_toplevel : undef; } else { return undef; } } else { return undef; } } sub button_release_event_cb { # my ($widget, $event, $clicked_ref) = @_; my (undef, undef, $clicked_ref) = @_; $$clicked_ref = TRUE; return TRUE; } # # Asks the user to click on a window, then waits for them click # the mouse. When the mouse is released, returns the toplevel # window under the pointer, or NULL, if there is none. # sub query_for_toplevel { my ($screen, $prompt) = @_; my $display = $screen->get_display; my $toplevel = undef; my $popup = Gtk2::Window->new ('popup'); $popup->set_screen ($screen); $popup->set_modal (TRUE); $popup->set_position ('center'); my $frame = Gtk2::Frame->new; $frame->set_shadow_type ('out'); $popup->add ($frame); my $label = Gtk2::Label->new ($prompt); $label->set_padding (10, 10); $frame->add ($label); $popup->show_all; my $cursor = Gtk2::Gdk::Cursor->new_for_display ($display, 'crosshair'); if (Gtk2::Gdk->pointer_grab ($popup->window, FALSE, 'button-release-mask', undef, $cursor, 0) eq 'success') #'GDK_GRAB_SUCCESS') { my $clicked = FALSE; $popup->signal_connect (button_release_event => \&button_release_event_cb, \$clicked); # # Process events until clicked is set by button_release_event_cb. # We pass in may_block=TRUE since we want to wait if there # are no events currently. # while (!$clicked) { Glib::MainContext->default->iteration (TRUE); } $toplevel = find_toplevel_at_pointer ($screen->get_display); # don't move yourself $toplevel = undef if defined $toplevel and $toplevel == $popup; } $popup->destroy; Gtk2::Gdk->flush; # Really release the grab return $toplevel; } # Prompts the user for a toplevel window to move, and then moves # that window to the currently selected display # sub query_change_display { my $info = shift; my $screen = $info->{window}->get_screen; my $toplevel = query_for_toplevel ($screen, "Please select the toplevel\n" . "to move to the new screen"); if ($toplevel) { $toplevel->set_screen ($info->{current_screen}); } else { $screen->get_display->beep; } } # # Fills in the screen list based on the current display # sub fill_screens { my $info = shift; $info->{screen_model}->clear; if ($info->{current_display}) { my $n_screens = $info->{current_display}->get_n_screens; for (my $i = 0; $i < $n_screens; $i++) { my $screen = $info->{current_display}->get_screen ($i); my $iter = $info->{screen_model}->append; $info->{screen_model}->set ($iter, SCREEN_COLUMN_NUMBER, $i, SCREEN_COLUMN_SCREEN, $screen); $info->{screen_selection}->select_iter ($iter) if $i == 0; } } } # # Called when the user clicks on a button in our dialog or # closes the dialog through the window manager. Unless the # "Change" button was clicked, we destroy the dialog. # sub response_cb { my ($dialog, $response_id, $info) = @_; if ($response_id eq 'ok') { query_change_display ($info); } else { $dialog->destroy; } } # # Called when the user clicks on "Open..." in the display # frame. Prompts for a new display, and then opens a connection # to that display. # sub open_display_cb { my ($button, $info) = @_; my $result = undef; my $dialog = Gtk2::Dialog->new ("Open Display", $info->{window}, 'modal', 'gtk-cancel', 'cancel', 'gtk-ok', 'ok'); $dialog->set_default_response ('ok'); my $display_entry = Gtk2::Entry->new; $display_entry->set_activates_default (TRUE); my $dialog_label = Gtk2::Label->new ("Please enter the name of\nthe new display\n"); $dialog->vbox->add ($dialog_label); $dialog->vbox->add ($display_entry); $display_entry->grab_focus; $dialog->child->show_all; while (!$result) { my $response_id = $dialog->run; last unless $response_id eq 'ok'; my $new_screen_name = $display_entry->get_chars (0, -1); if (length $new_screen_name) { $result = Gtk2::Gdk::Display->open ($new_screen_name); if (!$result) { $dialog_label->set_text ("Can't open display :\n\t$new_screen_name\nplease try another one\n"); } } } $dialog->destroy; } # # Called when the user clicks on the "Close" button in the # "Display" frame. Closes the selected display. # sub close_display_cb { my ($button, $info) = @_; $info->{current_display}->close if $info->{current_display}; } # # Called when the selected row in the display list changes. # Updates info->current_display, then refills the list of # screens. # sub display_changed_cb { my ($selection, $info) = @_; my ($model, $iter) = $selection->get_selected; if ($iter) { my ($d) = $model->get ($iter, DISPLAY_COLUMN_DISPLAY); $info->{current_display} = $d; } else { delete $info->{current_display}; } fill_screens ($info); } # # Called when the selected row in the sceen list changes. # Updates info->current_screen. # sub screen_changed_cb { my ($selection, $info) = @_; my ($model, $iter) = $selection->get_selected; if ($iter) { my ($s) = $model->get ($iter, SCREEN_COLUMN_SCREEN); $info->{current_screen} = $s; } else { $info->{current_screen} = undef; } } # # This function is used both for creating the "Display" and # "Screen" frames, since they have a similar structure. The # caller hooks up the right context for the value returned # in tree_view, and packs any relevant buttons into button_vbox. # sub create_frame { my ($info, $title) = @_; my $frame = Gtk2::Frame->new ($title); my $hbox = Gtk2::HBox->new (FALSE, 8); $hbox->set_border_width (8); $frame->add ($hbox); my $scrollwin = Gtk2::ScrolledWindow->new; $scrollwin->set_policy ('never', 'automatic'); $scrollwin->set_shadow_type ('in'); $hbox->pack_start ($scrollwin, TRUE, TRUE, 0); my $tree_view = Gtk2::TreeView->new; $tree_view->set_headers_visible (FALSE); $scrollwin->add ($tree_view); my $selection = $tree_view->get_selection; $selection->set_mode ('browse'); my $button_vbox = Gtk2::VBox->new (FALSE, 5); $hbox->pack_start ($button_vbox, FALSE, FALSE, 0); if (!$info->{size_group}) { $info->{size_group} = Gtk2::SizeGroup->new ('horizontal'); } $info->{size_group}->add_widget ($button_vbox); return ($frame, $tree_view, $button_vbox); } # # If we have a stack of buttons, it often looks better if their contents # are left-aligned, rather than centered. This function creates a button # and left-aligns it contents. # sub left_align_button_new { my $label = shift; my $button = Gtk2::Button->new_with_mnemonic ($label); $button->get_child->set_alignment (0.0, 0.5); return $button; } # # Creates the "Display" frame in the main window. # sub create_display_frame { my $info = shift; my ($frame, $tree_view, $button_vbox) = create_frame ($info, "Display"); my $button = left_align_button_new ("_Open..."); $button->signal_connect (clicked => \&open_display_cb, $info); $button_vbox->pack_start ($button, FALSE, FALSE, 0); $button = left_align_button_new ("_Close"); $button->signal_connect (clicked => \&close_display_cb, $info); $button_vbox->pack_start ($button, FALSE, FALSE, 0); $info->{display_model} = Gtk2::ListStore->new ("Glib::String", "Gtk2::Gdk::Display"); $tree_view->set_model ($info->{display_model}); my $column = Gtk2::TreeViewColumn->new_with_attributes ("Name", Gtk2::CellRendererText->new, text => DISPLAY_COLUMN_NAME); $tree_view->append_column ($column); my $selection = $tree_view->get_selection; $selection->signal_connect (changed => \&display_changed_cb, $info); return $frame; } # # Creates the "Screen" frame in the main window. # sub create_screen_frame { my $info = shift; my ($frame, $tree_view, $button_vbox) = create_frame ($info, "Screen"); $info->{screen_model} = Gtk2::ListStore->new ("Glib::Int", "Gtk2::Gdk::Screen"); $tree_view->set_model ($info->{screen_model}); my $column = Gtk2::TreeViewColumn->new_with_attributes ("Number", Gtk2::CellRendererText->new, text => SCREEN_COLUMN_NUMBER); $tree_view->append_column ($column); $info->{screen_selection} = $tree_view->get_selection; $info->{screen_selection}->signal_connect (changed => \&screen_changed_cb, $info); return $frame; } # # Called when one of the currently open displays is closed. # Remove it from our list of displays. # sub display_closed_cb { my ($display, $is_error, $info) = @_; my $iter = $info->{display_model}->get_iter_first; while ($iter) { my ($tmp_display) = $info->{display_model}->get ($iter, DISPLAY_COLUMN_DISPLAY); if ($tmp_display == $display) { $info->{display_model}->remove ($iter); last; } $iter = $info->{display_model}->iter_next ($iter); } } # # Adds a new display to our list of displays, and connects # to the "closed" signal so that we can remove it from the # list of displays again. # sub add_display { my ($info, $display) = @_; my $name = $display->get_name; my $iter = $info->{display_model}->append; $info->{display_model}->set ($iter, DISPLAY_COLUMN_NAME, $name, DISPLAY_COLUMN_DISPLAY, $display); $display->signal_connect (closed => \&display_closed_cb, $info); } # # Called when a new display is opened # sub display_opened_cb { my ($manager, $display, $info) = @_; add_display ($info, $display); } # # Adds all currently open displays to our list of displays, # and set up a signal connection so that we'll be notified # when displays are opened in the future as well. # sub initialize_displays { my $info = shift; my $manager = Gtk2::Gdk::DisplayManager->get; foreach my $display ($manager->list_displays) { add_display ($info, $display); } $manager->signal_connect (display_opened => \&display_opened_cb, $info); } # # Cleans up when the toplevel is destroyed; we remove the # connections we use to track currently open displays, then # free the ChangeDisplayInfo structure. # sub destroy_info { my $info = shift; my $manager = Gtk2::Gdk::DisplayManager->get; my @displays = $manager->list_displays; $manager->signal_handlers_disconnect_by_func (\&display_opened_cb, $info); foreach my $display ($manager->list_displays) { $display->signal_handlers_disconnect_by_func (\&display_closed_cb, $info); } $info = undef; } sub destroy_cb { my ($object, $inforef) = @_; destroy_info ($$inforef); $$inforef = undef; # just to be sure } my $info = undef; # # Main entry point. If the dialog for this demo doesn't yet exist, creates # it. Otherwise, destroys it. # sub do { if (!$info) { $info = {}; if ($ver = Gtk2->check_version (2, 2, 0)) { my $dialog = Gtk2::MessageDialog->new (undef, 'destroy-with-parent', 'info', 'ok', $ver."\n\nThis sample requires" ." at least Gtk+ version 2.2.0"); $dialog->show; $dialog->signal_connect (destroy => sub {$info = undef}); $dialog->signal_connect (response => sub {$dialog->destroy; 1}); $info->{window} = $dialog; } else { $info->{window} = Gtk2::Dialog->new ("Change Screen or display", undef, # parent 'no-separator', 'gtk-close' => 'close', 'Change' => 'ok'); $info->{window}->set_default_size (300, 400); $info->{window}->signal_connect (response => \&response_cb, $info); $info->{window}->signal_connect (destroy => \&destroy_cb, \$info); my $vbox = Gtk2::VBox->new (FALSE, 5); $vbox->set_border_width (8); $info->{window}->vbox->pack_start ($vbox, TRUE, TRUE, 0); my $frame = create_display_frame ($info); $vbox->pack_start ($frame, TRUE, TRUE, 0); $frame = create_screen_frame ($info); $vbox->pack_start ($frame, TRUE, TRUE, 0); initialize_displays ($info); $info->{window}->show_all; return $info->{window}; } } else { $info->{window}->destroy; return undef; } } 1; __END__ Copyright (C) 2003 by the gtk2-perl team (see the file AUTHORS for the full list) This library is free software; you can redistribute it and/or modify it under the terms of the GNU Library General Public License as published by the Free Software Foundation; either version 2.1 of the License, or (at your option) any later version. This library is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Library General Public License for more details. You should have received a copy of the GNU Library General Public License along with this library; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. Gtk2-1.24992/gtk-demo/list_store.pl0000644000175000017500000001476313076462676015410 0ustar lacklack# Tree View/List Store # # The GtkListStore is used to store data in list form, to be used # later on by a GtkTreeView to display it. This demo builds a # simple GtkListStore and displays it. See the Stock Browser # demo for a more advanced example. # # package list_store; use Glib qw(TRUE FALSE); use Gtk2; use constant COLUMN_FIXED => 0; use constant COLUMN_NUMBER => 1; use constant COLUMN_SEVERITY => 2; use constant COLUMN_DESCRIPTION => 3; use constant NUM_COLUMNS => 4; my @data = ( { fixed => FALSE, number => 60482, severity => "Normal", description => "scrollable notebooks and hidden tabs" }, { fixed => FALSE, number => 60620, severity => "Critical", description => "gdk_window_clear_area (gdkwindow-win32.c) is not thread-safe" }, { fixed => FALSE, number => 50214, severity => "Major", description => "Xft support does not clean up correctly" }, { fixed => TRUE, number => 52877, severity => "Major", description => "GtkFileSelection needs a refresh method. " }, { fixed => FALSE, number => 56070, severity => "Normal", description => "Can't click button after setting in sensitive" }, { fixed => TRUE, number => 56355, severity => "Normal", description => "GtkLabel - Not all changes propagate correctly" }, { fixed => FALSE, number => 50055, severity => "Normal", description => "Rework width/height computations for TreeView" }, { fixed => FALSE, number => 58278, severity => "Normal", description => "gtk_dialog_set_response_sensitive () doesn't work" }, { fixed => FALSE, number => 55767, severity => "Normal", description => "Getters for all setters" }, { fixed => FALSE, number => 56925, severity => "Normal", description => "Gtkcalender size" }, { fixed => FALSE, number => 56221, severity => "Normal", description => "Selectable label needs right-click copy menu" }, { fixed => TRUE, number => 50939, severity => "Normal", description => "Add shift clicking to GtkTextView" }, { fixed => FALSE, number => 6112, severity => "Enhancement",description => "netscape-like collapsable toolbars" }, { fixed => FALSE, number => 1, severity => "Normal", description => "First bug :=)" }, ); sub create_model { # create list store my $store = Gtk2::ListStore->new ('Glib::Boolean', # => G_TYPE_BOOLEAN 'Glib::Uint', # => G_TYPE_UINT 'Glib::String', # => G_TYPE_STRING 'Glib::String'); # you get the idea # add data to the list store foreach my $d (@data) { my $iter = $store->append; $store->set ($iter, COLUMN_FIXED, $d->{fixed}, COLUMN_NUMBER, $d->{number}, COLUMN_SEVERITY, $d->{severity}, COLUMN_DESCRIPTION, $d->{description}, ); } return $store; } sub fixed_toggled { my ($cell, $path_str, $model) = @_; # my $path = Gtk2::TreePath->new_from_string ($path_str); my $path = Gtk2::TreePath->new ($path_str); # get toggled iter my $iter = $model->get_iter ($path); my ($fixed) = $model->get ($iter, COLUMN_FIXED); # do something with the value $fixed ^= 1; # set new value $model->set ($iter, COLUMN_FIXED, $fixed); } sub add_columns { my $treeview = shift; my $model = $treeview->get_model; # column for fixed toggles my $renderer = Gtk2::CellRendererToggle->new; $renderer->signal_connect (toggled => \&fixed_toggled, $model); my $column = Gtk2::TreeViewColumn->new_with_attributes ("Fixed?", $renderer, active => COLUMN_FIXED); # set this column to a fixed sizing (of 50 pixels) $column->set_sizing ('fixed'); $column->set_fixed_width (50); $treeview->append_column ($column); # column for bug numbers $renderer = Gtk2::CellRendererText->new; $column = Gtk2::TreeViewColumn->new_with_attributes ("Bug number", $renderer, text => COLUMN_NUMBER); $column->set_sort_column_id (COLUMN_NUMBER); $treeview->append_column ($column); # column for severities $renderer = Gtk2::CellRendererText->new; $column = Gtk2::TreeViewColumn->new_with_attributes ("Severity", $renderer, text => COLUMN_SEVERITY); $column->set_sort_column_id (COLUMN_SEVERITY); $treeview->append_column ($column); # column for description $renderer = Gtk2::CellRendererText->new; $column = Gtk2::TreeViewColumn->new_with_attributes ("Description", $renderer, text => COLUMN_DESCRIPTION); $column->set_sort_column_id (COLUMN_DESCRIPTION); $treeview->append_column ($column); } sub do { if (!$window) { # create window, etc $window = Gtk2::Window->new ('toplevel'); $window->set_title ('GtkListStore demo'); $window->signal_connect (destroy => sub { $window = undef }); $window->set_border_width (8); my $vbox = Gtk2::VBox->new (FALSE, 8); $window->add ($vbox); my $label = Gtk2::Label->new ("This is the bug list (note: not based on real data, it would be nice to have a nice ODBC interface to bugzilla or so, though)."); $vbox->pack_start ($label, FALSE, FALSE, 0); my $sw = Gtk2::ScrolledWindow->new (undef, undef); $sw->set_shadow_type ('etched-in'); $sw->set_policy ('never', 'automatic'); $vbox->pack_start ($sw, TRUE, TRUE, 0); # create tree model my $model = create_model (); # create tree view my $treeview = Gtk2::TreeView->new ($model); $treeview->set_rules_hint (TRUE); $treeview->set_search_column (COLUMN_DESCRIPTION); $sw->add ($treeview); # add columns to the tree view add_columns ($treeview); # finish & show $window->set_default_size (280, 250); } if (!$window->visible) { $window->show_all; } else { $window->destroy; $window = undef; } return $window; } 1; __END__ Copyright (C) 2003 by the gtk2-perl team (see the file AUTHORS for the full list) This library is free software; you can redistribute it and/or modify it under the terms of the GNU Library General Public License as published by the Free Software Foundation; either version 2.1 of the License, or (at your option) any later version. This library is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Library General Public License for more details. You should have received a copy of the GNU Library General Public License along with this library; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. Gtk2-1.24992/gtk-demo/gnome-applets.png0000644000175000017500000000602213076462676016132 0ustar lacklackPNG  IHDR00WgAMA abKGD pHYs``zxEtIME ( IDATxYuګg㐢9ҖdkMіI@ӒF 'P q^b=F I6<Yk I @L٢hQ#҈Ԉξw5}(e<) ={#qs$L.KgK v\&H a-'r#pUVW cs1,'og])6˽~ @c[ : (&POsp3_:z|dxp4Ȓ4':NZeMo}ߘ]XY3B|y@.ρ|sy޽_$,H( <ϱ]vX[>G/nN(9&P*/=ra0**,!!IRB_쯹 +baGRR/dS*?{ķ+}5,)nj]R7 4%Mb$%NRUS/.Cȥw}TT*S)K覉a訪,ɿ$4!c8!c8ŕ;%l3j>?w\R*)U*eR4Q5EQd.$邕}(8ˆLKzk}}^o| Ǟ{_꺎ii J ib)2 ,S)Ұt+N9voinʲhF ,Q*WɃYӻ໱/ ,QT$uMes;B6x@Ldp edY)2cPUwH2xId Y\'N*$2YzRra/ۥ'}x"K3,#R,,f4%C|&+!4#R$EcyI(Wpz`Rӿ*2 {AަXS#it2EDa@xv| €(KӘ$Iӄ4MIqyxq7/ӱ]TMR.?݌mj8ꮰQݕw\s|}K" C(&j54z^z;Flj☡a\Ͽ/xAډHdOA@{xظݱpm ױ|;>( g}}3gޣ^gV\,rIݮ= +]iE!Bs=_feNt=/~SJ uD*] U(Cǧ/ֱ]xg"e]iJr|qXZ\4?ȓ?JLN& >]CܵGf׮a'2,bychl!{>A!I8V==X6M�{8*f9 xWJ%Iqˬ?ÿ4X= I,ϒ)aF1AA1iS2M8V#lľW_}N`nvCCyȲ Ο'==? ʪ!q#2%äJozw}yusl^[[[a RNZ1l{ &'%BR 45$&Ŭq% $ } ZZ\4c>{`˲fFFF5A (lvnzSo}͖mwszr;BAk*"$ i"+2*aP_K˫/ߚ8juj'F!%{T;%IUUZa*W):r0體 RVjhɩ19nZoO>.^n(HpZFFmfQ{l CM쯡j*#JwKt72y?\v♶ ' m멅# V,ˆg C3TEsuM!YQU)#m+_܈?%! @C^>kR(uc3e՞]lA_x)n/o+uhZQ`Q,<liOU cg7yA|527]B9p @xq bo?ڧE~p{ ցtc Ř5.a[A}/ ef b\GYD@6$-<E/E,E=<VD8q//.!<+dM`PV<}Cvwb}HB&*za+9B{z4zQ$Pr8C7ze^)|oթ {y շX~o$QajmӢ "EBbxvPZs|EkS؎%_X{.^52* @NwBhJiO{]XdZ8'Z O YG2Ad;@zooAkIENDB`Gtk2-1.24992/gtk-demo/hypertext.pl0000644000175000017500000001526413076462676015252 0ustar lacklack#!/usr/bin/perl -w # # Text Widget/Hypertext # # Usually, tags modify the appearance of text in the view, e.g. making it # bold or colored or underlined. But tags are not restricted to appearance. # They can also affect the behavior of mouse and key presses, as this demo # shows. # package hypertext; use strict; use Glib qw(TRUE FALSE); use Gtk2; use Gtk2::Gdk::Keysyms; use Gtk2::Pango; my $window = undef; # Inserts a piece of text into the buffer, giving it the usual # appearance of a hyperlink in a web browser: blue and underlined. # Additionally, attaches some data on the tag, to make it recognizable # as a link. # sub insert_link { my ($buffer, $iter, $text, $page) = @_; my $tag = $buffer->create_tag (undef, foreground => "blue", underline => 'single'); $tag->{page} = $page; $buffer->insert_with_tags ($iter, $text, $tag); } # Fills the buffer with text and interspersed links. In any real # hypertext app, this method would parse a file to identify the links. # sub show_page { my ($buffer, $page) = @_; $buffer->set_text (""); my $iter = $buffer->get_iter_at_offset (0); if ($page == 1) { $buffer->insert ($iter, "Some text to show that simple "); insert_link ($buffer, $iter, "hypertext", 3); $buffer->insert ($iter, " can easily be realized with "); insert_link ($buffer, $iter, "tags", 2); $buffer->insert ($iter, "."); } elsif ($page == 2) { $buffer->insert ($iter, "A tag is an attribute that can be applied to some range of text. " . "For example, a tag might be called \"bold\" and make the text inside " . "the tag bold. However, the tag concept is more general than that; " . "tags don't have to affect appearance. They can instead affect the " . "behavior of mouse and key presses, \"lock\" a range of text so the " . "user can't edit it, or countless other things.\n"); insert_link ($buffer, $iter, "Go back", 1); } elsif ($page == 3) { my $tag = $buffer->create_tag (undef, weight => PANGO_WEIGHT_BOLD); $buffer->insert_with_tags ($iter, "hypertext:\n", $tag); $buffer->insert ($iter, "machine-readable text that is not sequential but is organized " . "so that related items of information are connected.\n"); insert_link ($buffer, $iter, "Go back", 1); } } # Looks at all tags covering the position of iter in the text view, # and if one of them is a link, follow it by showing the page identified # by the data attached to it. # sub follow_if_link { my ($text_view, $iter) = @_; foreach my $tag ($iter->get_tags) { my $page = $tag->{page}; if ($page != 0) { show_page ($text_view->get_buffer, $page); last; } } } # Links can be activated by pressing Enter. # sub key_press_event { my ($text_view, $event) = @_; if ($event->keyval == $Gtk2::Gdk::Keysyms{Return} || $event->keyval == $Gtk2::Gdk::Keysyms{KP_Enter}) { my $buffer = $text_view->get_buffer; my $iter = $buffer->get_iter_at_mark ($buffer->get_insert); follow_if_link ($text_view, $iter); } return FALSE; } # Links can also be activated by clicking. # sub event_after { my ($text_view, $event) = @_; return FALSE unless $event->type eq 'button-release'; return FALSE unless $event->button == 1; my $buffer = $text_view->get_buffer; # we shouldn't follow a link if the user has selected something my ($start, $end) = $buffer->get_selection_bounds; return FALSE if defined $end and $start->get_offset != $end->get_offset; my ($x, $y) = $text_view->window_to_buffer_coords ('widget', #GTK_TEXT_WINDOW_WIDGET, $event->x, $event->y); my $iter = $text_view->get_iter_at_location ($x, $y); follow_if_link ($text_view, $iter); return FALSE; } my $hovering_over_link = FALSE; my $hand_cursor = undef; my $regular_cursor = undef; # Looks at all tags covering the position (x, y) in the text view, # and if one of them is a link, change the cursor to the "hands" cursor # typically used by web browsers. # sub set_cursor_if_appropriate { my ($text_view, $x, $y) = @_; my $hovering = FALSE; my $buffer = $text_view->get_buffer; my $iter = $text_view->get_iter_at_location ($x, $y); foreach my $tag ($iter->get_tags) { if ($tag->{page}) { $hovering = TRUE; last; } } if ($hovering != $hovering_over_link) { $hovering_over_link = $hovering; $text_view->get_window ('text')->set_cursor ($hovering_over_link ? $hand_cursor : $regular_cursor); } } # Update the cursor image if the pointer moved. # sub motion_notify_event { my ($text_view, $event) = @_; my ($x, $y) = $text_view->window_to_buffer_coords ( 'widget', #GTK_TEXT_WINDOW_WIDGET, $event->x, $event->y); set_cursor_if_appropriate ($text_view, $x, $y); $text_view->window->get_pointer; return FALSE; } # Also update the cursor image if the window becomes visible # (e.g. when a window covering it got iconified). # sub visibility_notify_event { my ($text_view, $event) = @_; my (undef, $wx, $wy, undef) = $text_view->window->get_pointer; my ($bx, $by) = $text_view->window_to_buffer_coords ( 'widget', #GTK_TEXT_WINDOW_WIDGET, $wx, $wy); set_cursor_if_appropriate ($text_view, $bx, $by); return FALSE; } sub do { my $do_widget = shift; if (!$window) { $hand_cursor = Gtk2::Gdk::Cursor->new ('hand2'); $regular_cursor = Gtk2::Gdk::Cursor->new ('xterm'); $window = Gtk2::Window->new; $window->set_screen ($do_widget->get_screen) if Gtk2->CHECK_VERSION (2, 2, 0); $window->set_default_size (450, 450); $window->signal_connect (destroy => sub {$window = undef}); $window->set_title ("Hypertext"); $window->set_border_width (0); my $view = Gtk2::TextView->new; $view->set_wrap_mode ('word'); $view->signal_connect (key_press_event => \&key_press_event); $view->signal_connect (event_after => \&event_after); $view->signal_connect (motion_notify_event => \&motion_notify_event); $view->signal_connect (visibility_notify_event => \&visibility_notify_event); my $buffer = $view->get_buffer; my $sw = Gtk2::ScrolledWindow->new; $sw->set_policy ('automatic', 'automatic'); $window->add ($sw); $sw->add ($view); show_page ($buffer, 1); $sw->show_all; } if (!$window->visible) { $window->show; } else { $window->destroy; $window = undef; } return $window; } 1; Gtk2-1.24992/gtk-demo/ui_manager.pl0000644000175000017500000001276613076462676015331 0ustar lacklack#!/usr/bin/perl -w # # UI Manager # # The GtkUIManager object allows the easy creation of menus # from an array of actions and a description of the menu hierarchy. # package ui_manager; use strict; use Glib qw(TRUE FALSE); use Gtk2; my $window = undef; sub activate_action { my $action = shift; warn "Action \"".$action->get_name."\" activated\n"; } sub activate_radio_action { my ($action, $current) = @_; warn "Radio action \"".$action->get_name."\" selected\n"; } my @entries = ( # name, stock id, label [ "FileMenu", undef, "_File" ], [ "PreferencesMenu", undef, "_Preferences" ], [ "ColorMenu", undef, "_Color" ], [ "ShapeMenu", undef, "_Shape" ], [ "HelpMenu", undef, "_Help" ], # name, stock id, label, accelerator, tooltip [ "New", 'gtk-new', "_New", "N", "Create a new file", \&activate_action ], [ "Open", 'gtk-open', "_Open", "O", "Open a file", \&activate_action ], [ "Save", 'gtk-save', "_Save", "S", "Save current file", \&activate_action ], [ "SaveAs", 'gtk-save', "Save _As...", undef, "Save to a file", \&activate_action ], [ "Quit", 'gtk-quit', "_Quit", "Q", "Quit", \&activate_action ], [ "About", undef, "_About", "A", "About", \&activate_action ], [ "Logo", "demo-gtk-logo", undef, undef, "GTK+", \&activate_action ], ); my @toggle_entries = ( [ "Bold", 'gtk-bold', "_Bold", # name, stock id, label "B", "Bold", # accelerator, tooltip \&activate_action, TRUE ], # is_active ); use constant COLOR_RED => 0; use constant COLOR_GREEN => 1; use constant COLOR_BLUE => 2; my @color_entries = ( # name, stock id, label, accelerator, tooltip, value [ "Red", undef, "_Red", "R", "Blood", COLOR_RED ], [ "Green", undef, "_Green", "G", "Grass", COLOR_GREEN ], [ "Blue", undef, "_Blue", "B", "Sky", COLOR_BLUE ], ); use constant SHAPE_SQUARE => 0; use constant SHAPE_RECTANGLE => 1; use constant SHAPE_OVAL => 2; my @shape_entries = ( # name, stock id, label, accelerator, tooltip, value [ "Square", undef, "_Square", "S", "Square", SHAPE_SQUARE ], [ "Rectangle", undef, "_Rectangle", "R", "Rectangle", SHAPE_RECTANGLE ], [ "Oval", undef, "_Oval", "O", "Egg", SHAPE_OVAL ], ); my $ui_info = " "; sub do { my $do_widget = shift; ###static GtkWidget *window = NULL; if (!$window) { $window = Gtk2::Window->new; $window->set_screen ($do_widget->get_screen); $window->signal_connect (destroy => sub { $window = undef }); $window->signal_connect (delete_event => sub {TRUE}); my $actions = Gtk2::ActionGroup->new ("Actions"); $actions->add_actions (\@entries, undef); $actions->add_toggle_actions (\@toggle_entries, undef); $actions->add_radio_actions (\@color_entries, COLOR_RED, \&activate_radio_action); $actions->add_radio_actions (\@shape_entries, SHAPE_OVAL, \&activate_radio_action); my $ui = Gtk2::UIManager->new; $ui->insert_action_group ($actions, 0); $window->add_accel_group ($ui->get_accel_group); $window->set_title ("UI Manager"); $window->set_border_width (0); # eval { $ui->add_ui_from_string ($ui_info); # Glib->message (undef, "building menus failed: %s", error->message); # g_error_free (error); # }; my $box1 = Gtk2::VBox->new (FALSE, 0); $window->add ($box1); $box1->pack_start ($ui->get_widget ("/MenuBar"), FALSE, FALSE, 0); my $label = Gtk2::Label->new ("Type\n\nto start"); $label->set_size_request (200, 200); $label->set_alignment (0.5, 0.5); $box1->pack_start ($label, TRUE, TRUE, 0); my $separator = Gtk2::HSeparator->new; $box1->pack_start ($separator, FALSE, TRUE, 0); my $box2 = Gtk2::VBox->new (FALSE, 10); $box2->set_border_width (10); $box1->pack_start ($box2, FALSE, TRUE, 0); my $button = Gtk2::Button->new_with_label ("close"); $button->signal_connect_swapped (clicked => sub {$window->destroy}); $box2->pack_start ($button, TRUE, TRUE, 0); #GTK_WIDGET_SET_FLAGS (button, GTK_CAN_DEFAULT); $button->set_flags ('can-default'); $button->grab_default; $window->show_all; } else { $window->destroy; $window = undef; } return $window; } Gtk2-1.24992/gtk-demo/gtk-logo-rgb.gif0000644000175000017500000001443313076462676015640 0ustar lacklackGIF89ak󪫹ԏƹ/L\lux 4# "7x:Z5d Y$]'+4 ."dܻҼ-E76Z7nNdlG7]9$7L 5(4=`-LE*48  ; &M=r2fpz$L-M>v!C %e)<9 H FE,)7 IKj)%6#&89;4P 4E&@4ޕpA YhPJ,A~(t,0C&Η"Cwa9 ۔ @5qGZpX@QH"\6eSdX:bR\T 2AdvP0CM p% pRBYDMwlBL h6l5zP10abK%qE9JY@+,6儳G[j72YЀtVa-:#,4!*}51a "mBNh[V0vC0A TIZp&: *L(",h:1B[?8[;B: L֭;n|pΗ$#F*`EuY >CF9BCJ7 C#(0BBG@fCd6tuCsyNDWA[zv'%Ԡ7\]凇sSQTa[`hR".Ye-d, BӡJAqAv`0@i,UA<@\b'^ʐcDƝQPp6" zk|U)L\A #(y B !.PB>0\&n`Cbv`->`k0A a@ @H#!~"Y> RWۂ&Q>TzGJWX(c%-%JP xjb[R? E|@$@:\c @AVpOXĀn~I{i"NЁ x"P#` Xo6(nK IVG7@2ˆAREp I! .X `+c,AC?qQrO~% otDAyiBڇ ^N @$$ి",C.tR$$` d4(t&v  Եk]fv^Ć>xS#U <1`"7{N#ȠS5쌷\pA {ݐH$Ћ$KGZPP֠I$Ӈqy8hwum WЇ~C PK VZo!A @HWl{!q` [s r|Eݵ F ыK@o2}ѵrpq #<Ƹ t@~EAM)^o`un "ems H` p y|pqЀ~0[$x_H~47U` 6r `6Pr_#Wt < 3@27UtPcA}x !0U6``` gW `dO@2@}YRPct&j 16`|px `O ) l9j2$ mIZa0o @|~ ؚG~ p P @A $0o밓{ UplJ/ n  X.Lm~ߐQr`Y rĠ UQq.҃)8iJ@RtًAG `6P%; ]ʀR b lRܠ j0mov~飊@j`H` %FAȐ _hbUwФ叛 {Xm kjtrPtʦ ڐAY`Đ lb)Z!7pqeq" Y|4Un``p`pj6 f` UC`r '/yH[W5 O wh*ʰ<$oqQ"}PUTJ(FS% `ZdZ%0.Apg2 OG`. ZlmخK6e!7 °`GW֤N:Щp.7^Xv{ZRnpl&fAp Y ͺ(d",+ 嚮ٕf_! c+ɛؓ`ЭI [m3$+~@sz]WBP!K yڀ&XVJ ^PkmW[Zi ZbG+4`>2\l!GP (+`Ep[hXWR7+["yfo 2 !g] Q D`|G^f7} 1˛ٖu> !0h}j`km˚Z|tp%o&ЅUj au[m~ / , (V$P{`w% Q 7`` kqC6pgxv7ً[f0ʶ f2%`)7b`Wt A$0f⢐c YY& `H7p !`&PܲwɎP #\)`Ƥ  v WTL3[kUP lbzˋ؈T7 Mo! ΜMǰ DMrI 7נZ^h% ;\X;L3٬ -됡^m k6)!F@ GE4tnew ("Changing color"); $dialog->set_transient_for ($window); my $colorsel = $dialog->colorsel; $colorsel->set_previous_color ($color); $colorsel->set_current_color ($color); $colorsel->set_has_palette (TRUE); my $response = $dialog->run; if ($response eq 'ok') { $color = $colorsel->get_current_color; $da->modify_bg ('normal', $color); } $dialog->destroy; } sub do { if (!$window) { $color = Gtk2::Gdk::Color->new (0, 65535, 0); $window = Gtk2::Window->new; $window->set_title ("Color Selection"); $window->signal_connect (destroy => sub { $window = undef }); $window->set_border_width (8); my $vbox = Gtk2::VBox->new (FALSE, 8); $vbox->set_border_width (8); $window->add ($vbox); # # Create the color swatch area # my $frame = Gtk2::Frame->new; $frame->set_shadow_type ('in'); $vbox->pack_start ($frame, TRUE, TRUE, 0); $da = Gtk2::DrawingArea->new; # set a minimum size $da->set_size_request (200, 200); # set the color $da->modify_bg ('normal', $color); $frame->add ($da); my $alignment = Gtk2::Alignment->new (1.0, 0.5, 0.0, 0.0); my $button = Gtk2::Button->new_with_mnemonic ("_Change the above color"); $alignment->add ($button); $vbox->pack_start ($alignment, FALSE, FALSE, 0); $button->signal_connect (clicked => \&change_color_callback); } if (!$window->visible) { $window->show_all; } else { $window->destroy; $window = undef; } return $window; } 1; __END__ Copyright (C) 2003 by the gtk2-perl team (see the file AUTHORS for the full list) This library is free software; you can redistribute it and/or modify it under the terms of the GNU Library General Public License as published by the Free Software Foundation; either version 2.1 of the License, or (at your option) any later version. This library is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Library General Public License for more details. You should have received a copy of the GNU Library General Public License along with this library; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. Gtk2-1.24992/gtk-demo/textview.pl0000644000175000017500000004471313076462676015076 0ustar lacklack#!/usr/bin/perl -w # # Multiple Views # # The GtkTextView widget displays a GtkTextBuffer. One GtkTextBuffer # can be displayed by multiple GtkTextViews. This demo has two views # displaying a single buffer, and shows off the widget's text # formatting features. # package textview; use Glib qw(TRUE FALSE); use Gtk2; use Carp; # get the PANGO_WEIGHT_* constants use Gtk2::Pango; ##static void easter_egg_callback (GtkWidget *button, gpointer data); use constant gray50_width => 2; use constant gray50_height => 2; my $gray50_bits = pack 'CC', 0x02, 0x01; sub create_tags { my $buffer = shift; # Create a bunch of tags. Note that it's also possible to # create tags with gtk_text_tag_new() then add them to the # tag table for the buffer, gtk_text_buffer_create_tag() is # just a convenience function. Also note that you don't have # to give tags a name; pass NULL for the name to create an # anonymous tag. # # In any real app, another useful optimization would be to create # a GtkTextTagTable in advance, and reuse the same tag table for # all the buffers with the same tag set, instead of creating # new copies of the same tags for every buffer. # # Tags are assigned default priorities in order of addition to the # tag table. That is, tags created later that affect the same text # property affected by an earlier tag will override the earlier # tag. You can modify tag priorities with # gtk_text_tag_set_priority(). $buffer->create_tag ("heading", weight => PANGO_WEIGHT_BOLD, size => 15 * PANGO_SCALE, ); $buffer->create_tag ("italic", style => 'italic'); $buffer->create_tag ("bold", weight => PANGO_WEIGHT_BOLD); $buffer->create_tag ("big", size => 20 * PANGO_SCALE); # points times the PANGO_SCALE factor $buffer->create_tag ("xx-small", scale => PANGO_SCALE_XX_SMALL); $buffer->create_tag ("x-large", scale => PANGO_SCALE_X_LARGE); $buffer->create_tag ("monospace", family => "monospace"); $buffer->create_tag ("blue_foreground", foreground => "blue"); $buffer->create_tag ("red_background", background => "red"); my $stipple = Gtk2::Gdk::Bitmap->create_from_data (undef, $gray50_bits, gray50_width, gray50_height); $buffer->create_tag ("background_stipple", background_stipple => $stipple); $buffer->create_tag ("foreground_stipple", foreground_stipple => $stipple); $buffer->create_tag ("big_gap_before_line", pixels_above_lines => 30); $buffer->create_tag ("big_gap_after_line", pixels_below_lines => 30); $buffer->create_tag ("double_spaced_line", pixels_inside_wrap => 10); $buffer->create_tag ("not_editable", editable => FALSE); $buffer->create_tag ("word_wrap", wrap_mode => 'word'); $buffer->create_tag ("char_wrap", wrap_mode => 'char'); $buffer->create_tag ("no_wrap", wrap_mode => 'none'); $buffer->create_tag ("center", justification => 'center'); $buffer->create_tag ("right_justify", justification => 'right'); $buffer->create_tag ("wide_margins", left_margin => 50, right_margin => 50); $buffer->create_tag ("strikethrough", strikethrough => TRUE); $buffer->create_tag ("underline", underline => 'single'); $buffer->create_tag ("double_underline", underline => 'double'); $buffer->create_tag ("superscript", rise => 10 * PANGO_SCALE, # 10 pixels size => 8 * PANGO_SCALE, # 8 points ); $buffer->create_tag ("subscript", rise => -10 * PANGO_SCALE, # 10 pixels size => 8 * PANGO_SCALE, # 8 points ); $buffer->create_tag ("rtl_quote", wrap_mode => 'word', direction => 'rtl', indent => 30, left_margin => 20, right_margin => 20, ); } sub insert_text { my $buffer = shift; # demo_find_file() looks in the the current directory first, # so you can run gtk-demo without installing GTK, then looks # in the location where the file is installed. # croaks if it can't find the file my $filename = "gtk-logo-rgb.gif"; my $pixbuf; eval { $pixbuf = Gtk2::Gdk::Pixbuf->new_from_file ( main::demo_find_file ($filename)); }; if ($@) { die "caught exception from Gtk2::Gdk::Pixbuf->new_from_file --- $@"; } my $scaled = $pixbuf->scale_simple (32, 32, 'bilinear'); $pixbuf = $scaled; # get start of buffer; each insertion will revalidate the # iterator to point to just after the inserted text. my $iter = $buffer->get_iter_at_offset (0); $buffer->insert ($iter, "The text widget can display text with all kinds of nifty attributes. It also supports multiple views of the same buffer; this demo is showing the same buffer in two places.\n\n"); $buffer->insert_with_tags_by_name ($iter, "Font styles. ", "heading"); $buffer->insert ($iter, "For example, you can have "); $buffer->insert_with_tags_by_name ($iter, "italic", "italic"); $buffer->insert ($iter, ", "); $buffer->insert_with_tags_by_name ($iter, "bold", "bold"); $buffer->insert ($iter, ", or "); $buffer->insert_with_tags_by_name ($iter, "monospace (typewriter)", "monospace"); $buffer->insert ($iter, ", or "); $buffer->insert_with_tags_by_name ($iter, "big", "big"); $buffer->insert ($iter, " text. "); $buffer->insert ($iter, "It's best not to hardcode specific text sizes; you can use relative sizes as with CSS, such as "); $buffer->insert_with_tags_by_name ($iter, "xx-small", "xx-small"); $buffer->insert ($iter, " or "); $buffer->insert_with_tags_by_name ($iter, "x-large", "x-large"); $buffer->insert ($iter, " to ensure that your program properly adapts if the user changes the default font size.\n\n"); $buffer->insert_with_tags_by_name ($iter, "Colors. ", "heading"); $buffer->insert ($iter, "Colors such as "); $buffer->insert_with_tags_by_name ($iter, "a blue foreground", "blue_foreground"); $buffer->insert ($iter, " or "); $buffer->insert_with_tags_by_name ($iter, "a red background", "red_background"); $buffer->insert ($iter, " or even "); $buffer->insert_with_tags_by_name ($iter, "a stippled red background", "red_background", "background_stipple"); $buffer->insert ($iter, " or "); $buffer->insert_with_tags_by_name ($iter, "a stippled blue foreground on solid red background", "blue_foreground", "red_background", "foreground_stipple"); $buffer->insert ($iter, " (select that to read it) can be used.\n\n"); $buffer->insert_with_tags_by_name ($iter, "Underline, strikethrough, and rise. ", "heading"); $buffer->insert_with_tags_by_name ($iter, "Strikethrough", "strikethrough"); $buffer->insert ($iter, ", "); $buffer->insert_with_tags_by_name ($iter, "underline", "underline"); $buffer->insert ($iter, ", "); $buffer->insert_with_tags_by_name ($iter, "double underline", "double_underline"); $buffer->insert ($iter, ", "); $buffer->insert_with_tags_by_name ($iter, "superscript", "superscript"); $buffer->insert ($iter, ", and "); $buffer->insert_with_tags_by_name ($iter, "subscript", "subscript"); $buffer->insert ($iter, " are all supported.\n\n"); $buffer->insert_with_tags_by_name ($iter, "Images. ", "heading"); $buffer->insert ($iter, "The buffer can have images in it: "); $buffer->insert_pixbuf ($iter, $pixbuf); $buffer->insert_pixbuf ($iter, $pixbuf); $buffer->insert_pixbuf ($iter, $pixbuf); $buffer->insert ($iter, " for example.\n\n"); $buffer->insert_with_tags_by_name ($iter, "Spacing. ", "heading"); $buffer->insert ($iter, "You can adjust the amount of space before each line.\n"); $buffer->insert_with_tags_by_name ($iter, "This line has a whole lot of space before it.\n", "big_gap_before_line", "wide_margins"); $buffer->insert_with_tags_by_name ($iter, "You can also adjust the amount of space after each line; this line has a whole lot of space after it.\n", "big_gap_after_line", "wide_margins"); $buffer->insert_with_tags_by_name ($iter, "You can also adjust the amount of space between wrapped lines; this line has extra space between each wrapped line in the same paragraph. To show off wrapping, some filler text: the quick brown fox jumped over the lazy dog. Blah blah blah blah blah blah blah blah blah.\n", "double_spaced_line", "wide_margins"); $buffer->insert ($iter, "Also note that those lines have extra-wide margins.\n\n"); $buffer->insert_with_tags_by_name ($iter, "Editability. ", "heading"); $buffer->insert_with_tags_by_name ($iter, "This line is 'locked down' and can't be edited by the user - just try it! You can't delete this line.\n\n", "not_editable"); $buffer->insert_with_tags_by_name ($iter, "Wrapping. ", "heading"); $buffer->insert ($iter, "This line (and most of the others in this buffer) is word-wrapped, using the proper Unicode algorithm. Word wrap should work in all scripts and languages that GTK+ supports. Let's make this a long paragraph to demonstrate: blah blah blah blah blah blah blah blah blah blah blah blah blah blah blah blah blah blah blah\n\n"); $buffer->insert_with_tags_by_name ($iter, "This line has character-based wrapping, and can wrap between any two character glyphs. Let's make this a long paragraph to demonstrate: blah blah blah blah blah blah blah blah blah blah blah blah blah blah blah blah blah blah blah\n\n", "char_wrap"); $buffer->insert_with_tags_by_name ($iter, "This line has all wrapping turned off, so it makes the horizontal scrollbar appear.\n\n\n", "no_wrap"); $buffer->insert_with_tags_by_name ($iter, "Justification. ", "heading"); $buffer->insert_with_tags_by_name ($iter, "\nThis line has center justification.\n", "center"); $buffer->insert_with_tags_by_name ($iter, "This line has right justification.\n", "right_justify"); $buffer->insert_with_tags_by_name ($iter, "\nThis line has big wide margins. Text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text.\n", "wide_margins"); $buffer->insert_with_tags_by_name ($iter, "Internationalization. ", "heading"); $buffer->insert ($iter, "You can put all sorts of Unicode text in the buffer.\n\nGerman (S\x{fc}ddeutschland) Gr\x{fc}\x{df} Gott\nGreek (\x{395}\x{3bb}\x{3bb}\x{3b7}\x{3bd}\x{3b9}\x{3ba}\x{3ac}) \x{393}\x{3b5}\x{3b9}\x{3ac} \x{3c3}\x{3b1}\x{3c2}\nHebrew \x{5e9}\x{5dc}\x{5d5}\x{5dd}\nJapanese (\x{65e5}\x{672c}\x{8a9e})\n\nThe widget properly handles bidirectional text, word wrapping, DOS/UNIX/Unicode paragraph separators, grapheme boundaries, and so on using the Pango internationalization framework.\n"); $buffer->insert ($iter, "Here's a word-wrapped quote in a right-to-left language:\n"); $buffer->insert_with_tags_by_name ($iter, "\x{648}\x{642}\x{62f} \x{628}\x{62f}\x{623} \x{62b}\x{644}\x{627}\x{62b} \x{645}\x{646} \x{623}\x{643}\x{62b}\x{631} \x{627}\x{644}\x{645}\x{624}\x{633}\x{633}\x{627}\x{62a} \x{62a}\x{642}\x{62f}\x{645}\x{627} \x{641}\x{64a} \x{634}\x{628}\x{643}\x{629} \x{627}\x{643}\x{633}\x{64a}\x{648}\x{646} \x{628}\x{631}\x{627}\x{645}\x{62c}\x{647}\x{627} \x{643}\x{645}\x{646}\x{638}\x{645}\x{627}\x{62a} \x{644}\x{627} \x{62a}\x{633}\x{639}\x{649} \x{644}\x{644}\x{631}\x{628}\x{62d}\x{60c} \x{62b}\x{645} \x{62a}\x{62d}\x{648}\x{644}\x{62a} \x{641}\x{64a} \x{627}\x{644}\x{633}\x{646}\x{648}\x{627}\x{62a} \x{627}\x{644}\x{62e}\x{645}\x{633} \x{627}\x{644}\x{645}\x{627}\x{636}\x{64a}\x{629} \x{625}\x{644}\x{649} \x{645}\x{624}\x{633}\x{633}\x{627}\x{62a} \x{645}\x{627}\x{644}\x{64a}\x{629} \x{645}\x{646}\x{638}\x{645}\x{629}\x{60c} \x{648}\x{628}\x{627}\x{62a}\x{62a} \x{62c}\x{632}\x{621}\x{627} \x{645}\x{646} \x{627}\x{644}\x{646}\x{638}\x{627}\x{645} \x{627}\x{644}\x{645}\x{627}\x{644}\x{64a} \x{641}\x{64a} \x{628}\x{644}\x{62f}\x{627}\x{646}\x{647}\x{627}\x{60c} \x{648}\x{644}\x{643}\x{646}\x{647}\x{627} \x{62a}\x{62a}\x{62e}\x{635}\x{635} \x{641}\x{64a} \x{62e}\x{62f}\x{645}\x{629} \x{642}\x{637}\x{627}\x{639} \x{627}\x{644}\x{645}\x{634}\x{631}\x{648}\x{639}\x{627}\x{62a} \x{627}\x{644}\x{635}\x{63a}\x{64a}\x{631}\x{629}. \x{648}\x{623}\x{62d}\x{62f} \x{623}\x{643}\x{62b}\x{631} \x{647}\x{630}\x{647} \x{627}\x{644}\x{645}\x{624}\x{633}\x{633}\x{627}\x{62a} \x{646}\x{62c}\x{627}\x{62d}\x{627} \x{647}\x{648} \x{bb}\x{628}\x{627}\x{646}\x{643}\x{648}\x{633}\x{648}\x{644}\x{ab} \x{641}\x{64a} \x{628}\x{648}\x{644}\x{64a}\x{641}\x{64a}\x{627}.\n\n", "rtl_quote"); $buffer->insert ($iter, "You can put widgets in the buffer: Here's a button: "); $anchor = $buffer->create_child_anchor ($iter); $buffer->insert ($iter, " and a menu: "); $anchor = $buffer->create_child_anchor ($iter); $buffer->insert ($iter, " and a scale: "); $anchor = $buffer->create_child_anchor ($iter); $buffer->insert ($iter, " and an animation: "); $anchor = $buffer->create_child_anchor ($iter); $buffer->insert ($iter, " finally a text entry: "); $anchor = $buffer->create_child_anchor ($iter); $buffer->insert ($iter, ".\n"); $buffer->insert ($iter, "\n\nThis demo doesn't demonstrate all the GtkTextBuffer features; it leaves out, for example: invisible/hidden text (doesn't work in GTK 2, but planned), tab stops, application-drawn areas on the sides of the widget for displaying breakpoints and such..."); # Apply word_wrap tag to whole buffer $buffer->apply_tag_by_name ("word_wrap", $buffer->get_bounds); } sub find_anchor { my $iter = shift; while ($iter->forward_char) { return TRUE if $iter->get_child_anchor; } return FALSE; } sub attach_widgets { my $text_view = shift; my $buffer = $text_view->get_buffer; my $iter = $buffer->get_start_iter; my $i = 0; while (find_anchor ($iter)) { my $widget; my $anchor = $iter->get_child_anchor; if ($i == 0) { $widget = Gtk2::Button->new ("Click Me"); $widget->signal_connect (clicked => \&easter_egg_callback); } elsif ($i == 1) { if (Gtk2->CHECK_VERSION (2, 4, 0)) { $widget = Gtk2::ComboBox->new_text; $widget->append_text ("Option 1"); $widget->append_text ("Option 2"); $widget->append_text ("Option 3"); } else { # ComboBox is not available, use OptionMenu instead my $menu = Gtk2::Menu->new; $menu->append (Gtk2::MenuItem->new ("Option 1")); $menu->append (Gtk2::MenuItem->new ("Option 2")); $menu->append (Gtk2::MenuItem->new ("Option 3")); $widget = Gtk2::OptionMenu->new; $widget->set_menu ($menu); } } elsif ($i == 2) { $widget = Gtk2::HScale->new (undef); $widget->set_range (0, 100); $widget->set_size_request (70, -1); } elsif ($i == 3) { my $filename = main::demo_find_file ("floppybuddy.gif"); $widget = Gtk2::Image->new_from_file ($filename); } elsif ($i == 4) { $widget = Gtk2::Entry->new; } else { croak "shouldn't get here"; } $text_view->add_child_at_anchor ($widget, $anchor); $widget->show_all; ++$i; } } my $window; sub do { if (!$window) { $window = Gtk2::Window->new ('toplevel'); $window->set_default_size (450, 450); $window->signal_connect (destroy => sub { $window = undef; }); $window->set_title ("TextView"); $window->set_border_width (0); my $vpaned = Gtk2::VPaned->new; $vpaned->set_border_width (5); $window->add ($vpaned); # For convenience, we just use the autocreated buffer from # the first text view; you could also create the buffer # by itself with gtk_text_buffer_new(), then later create # a view widget. my $view1 = Gtk2::TextView->new; my $buffer = $view1->get_buffer; my $view2 = Gtk2::TextView->new_with_buffer ($buffer); my $sw = Gtk2::ScrolledWindow->new; $sw->set_policy ('automatic', 'automatic'); $vpaned->add1 ($sw); $sw->add ($view1); $sw = Gtk2::ScrolledWindow->new; $sw->set_policy ('automatic', 'automatic'); $vpaned->add2 ($sw); $sw->add ($view2); create_tags ($buffer); insert_text ($buffer); attach_widgets ($view1); attach_widgets ($view2); $vpaned->show_all; } if (!$window->visible) { $window->show; } else { $window->destroy; $window = undef; } return $window; } sub recursive_attach_view { my ($depth, $view, $anchor) = @_; return if $depth > 4; my $child_view = Gtk2::TextView->new_with_buffer ($view->get_buffer); # Event box is to add a black border around each child view my $event_box = Gtk2::EventBox->new; my $color = Gtk2::Gdk::Color->parse ("black"); $event_box->modify_bg ('normal', $color); my $align = Gtk2::Alignment->new (0.5, 0.5, 1.0, 1.0); $align->set_border_width (1); $event_box->add ($align); $align->add ($child_view); $view->add_child_at_anchor ($event_box, $anchor); recursive_attach_view ($depth + 1, $child_view, $anchor); } sub easter_egg_callback { my $button = shift; if ($tvee_window) { $tvee_window->present; return; } my $buffer = Gtk2::TextBuffer->new (undef); my $iter = $buffer->get_start_iter; $buffer->insert ($iter, "This buffer is shared by a set of nested text views.\n Nested view:\n"); my $anchor = $buffer->create_child_anchor ($iter); $buffer->insert ($iter, "\nDon't do this in real applications, please.\n"); my $view = Gtk2::TextView->new_with_buffer ($buffer); recursive_attach_view (0, $view, $anchor); $tvee_window = Gtk2::Window->new ('toplevel'); my $sw = Gtk2::ScrolledWindow->new (undef, undef); $sw->set_policy ('automatic', 'automatic'); $tvee_window->add ($sw); $sw->add ($view); $tvee_window->signal_connect (destroy => sub {$tvee_window = undef; 1}); $tvee_window->set_default_size (300, 400); $tvee_window->show_all; } 1; __END__ Copyright (C) 2003 by the gtk2-perl team (see the file AUTHORS for the full list) This library is free software; you can redistribute it and/or modify it under the terms of the GNU Library General Public License as published by the Free Software Foundation; either version 2.1 of the License, or (at your option) any later version. This library is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Library General Public License for more details. You should have received a copy of the GNU Library General Public License along with this library; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. Gtk2-1.24992/gtk-demo/demo.ui0000644000175000017500000002761113076462676014143 0ustar lacklack John Doe 25 This is the John Doe row Mary Unknown 50 This is the Mary Unknown row Copy Copy selected object into the clipboard gtk-copy Cut Cut selected object into the clipboard gtk-cut EditMenu _Edit FileMenu _File New Create a new file gtk-new Open Open a file gtk-open Paste Paste object from the Clipboard gtk-paste Quit Quit the program gtk-quit Save True Save a file gtk-save SaveAs Save with a different name gtk-save-as HelpMenu _Help About gtk-about GtkBuilder demo 250 440 GtkBuilder demo True True The menubar False True The toolbar False 1 automatic in True automatic True liststore1 3 Name list A list of person with name, surname and age columns Name 0 Surname 1 Age 2 2 True False 3 Gtk2-1.24992/xs_files-2.200000644000175000017500000000016313076462677013261 0ustar lacklackxs/GtkCellRendererSpinner.xs xs/GtkOffscreenWindow.xs xs/GtkSpinner.xs xs/GtkToolItemGroup.xs xs/GtkToolPalette.xs Gtk2-1.24992/MANIFEST.SKIP0000644000175000017500000000020613076462676013036 0ustar lacklack~$ \.bak$ blib \.bs$ build \.c$ \.git \.gitignore$ gtk2perl.h.gch$ Makefile$ Makefile\.old$ MYMETA\..* \.o$ \.spec$ \.sw.$ \.tar\.gz$ Gtk2-1.24992/maps-2.160000644000175000017500000000043313076462676012411 0ustar lacklackGTK_TYPE_ACTIVATABLE GtkActivatable GInterface Gtk2::Activatable GTK_TYPE_ARROW_PLACEMENT GtkArrowPlacement GEnum Gtk2::ArrowPlacement GTK_TYPE_ORIENTABLE GtkOrientable GInterface Gtk2::Orientable GTK_TYPE_ENTRY_ICON_POSITION GtkEntryIconPosition GEnum Gtk2::EntryIconPosition Gtk2-1.24992/gtk.typemap0000644000175000017500000000175013076462676013333 0ustar lacklack# Copyright (C) 2003 by the gtk2-perl team (see the file AUTHORS for the full # list) # # This library is free software; you can redistribute it and/or modify it under # the terms of the GNU Library General Public License as published by the Free # Software Foundation; either version 2.1 of the License, or (at your option) # any later version. # # This library is distributed in the hope that it will be useful, but WITHOUT # ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS # FOR A PARTICULAR PURPOSE. See the GNU Library General Public License for # more details. # # You should have received a copy of the GNU Library General Public License # along with this library; if not, write to the Free Software Foundation, Inc., # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. # # $Id$ # hand-coded Gtk+ typemaps TYPEMAP GtkTargetList * T_GPERL_GENERIC_WRAPPER GtkTargetList_ornull * T_GPERL_GENERIC_WRAPPER GtkTargetEntry * T_GPERL_GENERIC_WRAPPER Gtk2-1.24992/maps_pango-1.00000644000175000017500000000601613076462676013510 0ustar lacklack# Copyright (C) 2004 by the gtk2-perl team (see the file AUTHORS for the full # list) # # This library is free software; you can redistribute it and/or modify it under # the terms of the GNU Library General Public License as published by the Free # Software Foundation; either version 2.1 of the License, or (at your option) # any later version. # # This library is distributed in the hope that it will be useful, but WITHOUT # ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS # FOR A PARTICULAR PURPOSE. See the GNU Library General Public License for # more details. # # You should have received a copy of the GNU Library General Public License # along with this library; if not, write to the Free Software Foundation, Inc., # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. # # $Id$ # # # this file defines mappings only for types that existed in pango 1.0.x # PANGO_TYPE_ALIGNMENT PangoAlignment GEnumAlias Gtk2::Pango::Alignment PANGO_TYPE_ATTR_LIST PangoAttrList GBoxedAlias Gtk2::Pango::AttrList PANGO_TYPE_ATTR_TYPE PangoAttrType GEnumAlias Gtk2::Pango::AttrType PANGO_TYPE_COLOR PangoColor GBoxedAlias Gtk2::Pango::Color PANGO_TYPE_CONTEXT PangoContext GObjectAlias Gtk2::Pango::Context PANGO_TYPE_COVERAGE_LEVEL PangoCoverageLevel GEnumAlias Gtk2::Pango::CoverageLevel PANGO_TYPE_DIRECTION PangoDirection GEnumAlias Gtk2::Pango::Direction PANGO_TYPE_FONT_DESCRIPTION PangoFontDescription GBoxedAlias Gtk2::Pango::FontDescription PANGO_TYPE_FONT_FACE PangoFontFace GObjectAlias Gtk2::Pango::FontFace PANGO_TYPE_FONT_FAMILY PangoFontFamily GObjectAlias Gtk2::Pango::FontFamily PANGO_TYPE_FONT_MAP PangoFontMap GObjectAlias Gtk2::Pango::FontMap PANGO_TYPE_FONT_MASK PangoFontMask GFlagsAlias Gtk2::Pango::FontMask PANGO_TYPE_FONT_METRICS PangoFontMetrics GBoxedAlias Gtk2::Pango::FontMetrics PANGO_TYPE_FONT PangoFont GObjectAlias Gtk2::Pango::Font PANGO_TYPE_FONTSET PangoFontset GObjectAlias Gtk2::Pango::Fontset PANGO_TYPE_GLYPH_STRING PangoGlyphString GBoxedAlias Gtk2::Pango::GlyphString PANGO_TYPE_LANGUAGE PangoLanguage GBoxedAlias Gtk2::Pango::Language PANGO_TYPE_LAYOUT PangoLayout GObjectAlias Gtk2::Pango::Layout PANGO_TYPE_SCRIPT PangoScript GEnumAlias Gtk2::Pango::Script PANGO_TYPE_STRETCH PangoStretch GEnumAlias Gtk2::Pango::Stretch PANGO_TYPE_STYLE PangoStyle GEnumAlias Gtk2::Pango::Style PANGO_TYPE_TAB_ALIGN PangoTabAlign GEnumAlias Gtk2::Pango::TabAlign PANGO_TYPE_TAB_ARRAY PangoTabArray GBoxedAlias Gtk2::Pango::TabArray PANGO_TYPE_UNDERLINE PangoUnderline GEnumAlias Gtk2::Pango::Underline PANGO_TYPE_VARIANT PangoVariant GEnumAlias Gtk2::Pango::Variant PANGO_TYPE_WEIGHT PangoWeight GEnumAlias Gtk2::Pango::Weight PANGO_TYPE_WRAP_MODE PangoWrapMode GEnumAlias Gtk2::Pango::WrapMode # custom types PANGO_TYPE_ATTRIBUTE PangoAttribute GBoxedAlias Gtk2::Pango::Attribute PANGO_TYPE_ATTR_ITERATOR PangoAttrIterator GBoxedAlias Gtk2::Pango::AttrIterator PANGO_TYPE_LAYOUT_ITER PangoLayoutIter GBoxedAlias Gtk2::Pango::LayoutIter PANGO_TYPE_LAYOUT_LINE PangoLayoutLine GBoxedAlias Gtk2::Pango::LayoutLine Gtk2-1.24992/xs_files-2.180000644000175000017500000000004613076462677013270 0ustar lacklackxs/GtkInfoBar.xs xs/GtkEntryBuffer.xs Gtk2-1.24992/constants-2.00000644000175000017500000000031313076462676013373 0ustar lacklackGDK_CURRENT_TIME GDK_PRIORITY_EVENTS GDK_PRIORITY_REDRAW GTK_PRIORITY_RESIZE GTK_PATH_PRIO_LOWEST GTK_PATH_PRIO_GTK GTK_PATH_PRIO_APPLICATION GTK_PATH_PRIO_THEME GTK_PATH_PRIO_RC GTK_PATH_PRIO_HIGHEST Gtk2-1.24992/MANIFEST0000644000175000017500000002557613076464136012303 0ustar lacklackAUTHORS ChangeLog.pre-git constants-2.0 constants-2.18 copyright.pod doctypes examples/accel_groups.pl examples/adding_stock_icons.pl examples/assistant.pl examples/attributes.pl examples/buttonbox.pl examples/cairo-clock.pl examples/cairo-rendering.pl examples/calendar.pl examples/cellrenderer_date.pl examples/cellrenderer_popup.pl examples/cellrenderer_progress.pl examples/cellrenderer_spinbutton.pl examples/color_list.pl examples/color_snooper.pl examples/combo_box.pl examples/customlist.pl examples/customrenderer.pl examples/customtree.pl examples/dialog.pl examples/draw_text.pl examples/file_chooser.pl examples/filesel_multisel.pl examples/histogramplot.pl examples/inline-images.pl examples/insert-text-test.pl examples/item_factory_demo.pl examples/layout.pl examples/linkbutton.pl examples/multisel.pl examples/offscreen_reflection.pl examples/offscreen_rotation.pl examples/offscreen_scale.pl examples/plug.pl examples/rulers.pl examples/scribble.pl examples/simple_menu.pl examples/simplelist.pl examples/socket.pl examples/table_packing.pl examples/testdnd.pl examples/thread_usage.pl examples/timeouttest.pl gdk.typemap gtk-demo/alphatest.png gtk-demo/apple-red.png gtk-demo/appwindow.pl gtk-demo/assistant.pl gtk-demo/background.jpg gtk-demo/button_box.pl gtk-demo/changedisplay.pl gtk-demo/colorsel.pl gtk-demo/combobox.pl gtk-demo/demo.ui gtk-demo/dialog.pl gtk-demo/drawingarea.pl gtk-demo/editable_cells.pl gtk-demo/entry_completion.pl gtk-demo/floppybuddy.gif gtk-demo/gnome-applets.png gtk-demo/gnome-calendar.png gtk-demo/gnome-foot.png gtk-demo/gnome-gimp.png gtk-demo/gnome-gmush.png gtk-demo/gnome-gsame.png gtk-demo/gnu-keys.png gtk-demo/gtk-logo-rgb.gif gtk-demo/hypertext.pl gtk-demo/images.pl gtk-demo/item_factory.pl gtk-demo/list_store.pl gtk-demo/main.pl gtk-demo/menus.pl gtk-demo/panes.pl gtk-demo/pixbufs.pl gtk-demo/rotated_text.pl gtk-demo/sizegroup.pl gtk-demo/stock_browser.pl gtk-demo/textview.pl gtk-demo/tree_store.pl gtk-demo/ui_manager.pl gtk.typemap Gtk2.exports gtk2perl-private.h gtk2perl.h lib/Gtk2.pm lib/Gtk2/api.pod lib/Gtk2/CodeGen.pm lib/Gtk2/devel.pod lib/Gtk2/Helper.pm lib/Gtk2/Pango.pm lib/Gtk2/SimpleList.pm lib/Gtk2/SimpleMenu.pm lib/Gtk2/TestHelper.pm LICENSE Makefile.PL MANIFEST MANIFEST.SKIP maps-2.0 maps-2.10 maps-2.12 maps-2.14 maps-2.16 maps-2.18 maps-2.2 maps-2.20 maps-2.4 maps-2.6 maps-2.8 maps_pango-1.0 maps_pango-1.10 maps_pango-1.16 maps_pango-1.18 maps_pango-1.4 maps_pango-1.6 maps_pango-1.8 NEWS perl-Gtk2.doap perl-Gtk2.spec.in README t/00.Gtk2.t t/01.GtkWindow.t t/02.GtkContainer.t t/constants.t t/Gdk.t t/GdkCairo.t t/GdkColor.t t/GdkCursor.t t/GdkDisplay.t t/GdkDisplayManager.t t/GdkDrawable.t t/GdkEvent.t t/GdkGC.t t/GdkImage.t t/GdkInput.t t/GdkKeys.t t/GdkPango.t t/GdkPixbuf.t t/GdkPixbufLoader.t t/GdkPixbufSimpleAnim.t t/GdkPixmap.t t/GdkProperty.t t/GdkRegion.t t/GdkRgb.t t/GdkScreen.t t/GdkSelection.t t/GdkVisual.t t/GdkWindow.t t/GdkX11.t t/GtkAboutDialog.t t/GtkAccelGroup.t t/GtkAccelLabel.t t/GtkAccelMap.t t/GtkAction.t t/GtkActionGroup.t t/GtkActivatable.t t/GtkAdjustment.t t/GtkAlignment.t t/GtkArrow.t t/GtkAspectFrame.t t/GtkAssistant.t t/GtkBin.t t/GtkBindings.t t/GtkBox.t t/GtkBuildable.t t/GtkBuildableIface.t t/GtkBuilder.t t/GtkButton.t t/GtkButtonBox.t t/GtkCalendar.t t/GtkCellEditable.t t/GtkCellLayout.t t/GtkCellLayoutIface.t t/GtkCellRenderer.t t/GtkCellRendererAccel.t t/GtkCellRendererCombo.t t/GtkCellRendererIface-Chaining.t t/GtkCellRendererPixbuf.t t/GtkCellRendererProgress.t t/GtkCellRendererSpin.t t/GtkCellRendererSpinner.t t/GtkCellRendererText.t t/GtkCellRendererToggle.t t/GtkCellView.t t/GtkCheckButton.t t/GtkCheckMenuItem.t t/GtkClipboard.t t/GtkColorButton.t t/GtkColorSelection.t t/GtkColorSelectionDialog.t t/GtkCombo.t t/GtkComboBox.t t/GtkComboBoxEntry.t t/GtkCurve.t t/GtkDialog.t t/GtkDrawingArea.t t/GtkEditable.t t/GtkEntry.t t/GtkEntryBuffer.t t/GtkEntryCompletion.t t/GtkEventBox.t t/GtkExpander.t t/GtkFileChooser.t t/GtkFileChooserButton.t t/GtkFileChooserDialog.t t/GtkFileChooserWidget.t t/GtkFileFilter.t t/GtkFileSelection.t t/GtkFixed.t t/GtkFontButton.t t/GtkFontSelection.t t/GtkFrame.t t/GtkGammaCurve.t t/GtkGC.t t/GtkHandleBox.t t/GtkHBox.t t/GtkHButtonBox.t t/GtkHPaned.t t/GtkHRuler.t t/GtkHScale.t t/GtkHScrollbar.t t/GtkHSeparator.t t/GtkHSV.t t/GtkIconFactory.t t/GtkIconTheme.t t/GtkIconView.t t/GtkImage.t t/GtkImageMenuItem.t t/GtkIMContext.t t/GtkInfoBar.t t/GtkInputDialog.t t/GtkInvisible.t t/GtkItemFactory.t t/GtkLabel.t t/GtkLayout.t t/GtkLinkButton.t t/GtkListStore.t t/GtkMenu.t t/GtkMenuBar.t t/GtkMenuItem.t t/GtkMenuShell.t t/GtkMenuToolButton.t t/GtkMessageDialog.t t/GtkMisc.t t/GtkNotebook.t t/GtkObject.t t/GtkOffscreenWindow.t t/GtkOptionMenu.t t/GtkOrientable.t t/GtkPageSetup.t t/GtkPaned.t t/GtkPaperSize.t t/GtkPrintContext.t t/GtkPrintOperation.t t/GtkPrintOperationPreview.t t/GtkPrintSettings.t t/GtkProgressBar.t t/GtkRadioAction.t t/GtkRadioButton.t t/GtkRadioMenuItem.t t/GtkRadioToolButton.t t/GtkRange.t t/GtkRc.t t/GtkRecentAction.t t/GtkRecentChooser.t t/GtkRecentChooserDialog.t t/GtkRecentChooserMenu.t t/GtkRecentChooserWidget.t t/GtkRecentFilter.t t/GtkRecentManager.t t/GtkRuler.t t/GtkScale.t t/GtkScaleButton.t t/GtkScrolledWindow.t t/GtkSelection.t t/GtkSeparatorMenuItem.t t/GtkSeparatorToolItem.t t/GtkShow.t t/GtkSimpleList.t t/GtkSimpleMenu.t t/GtkSizeGroup.t t/GtkSpinButton.t t/GtkSpinner.t t/GtkStatusbar.t t/GtkStatusIcon.t t/GtkStock.t t/GtkStyle.t t/GtkTable.t t/GtkTearoffMenuItem.t t/GtkTextBuffer.t t/GtkTextBufferRichText.t t/GtkTextChildAnchor.t t/GtkTextIter.t t/GtkTextMark.t t/GtkTextTag.t t/GtkTextTagTable.t t/GtkTextView.t t/GtkToggleAction.t t/GtkToggleButton.t t/GtkToggleToolButton.t t/GtkToolbar.t t/GtkToolButton.t t/GtkToolItem.t t/GtkToolItemGroup.t t/GtkToolPalette.t t/GtkToolShell.t t/GtkTooltip.t t/GtkTooltips.t t/GtkTreeDnd.t t/GtkTreeModel.t t/GtkTreeModelFilter.t t/GtkTreeModelIface.t t/GtkTreeModelSort.t t/GtkTreeSelection.t t/GtkTreeSortable.t t/GtkTreeStore.t t/GtkTreeView-Dnd.t t/GtkTreeView.t t/GtkUIManager.t t/GtkVBox.t t/GtkVButtonBox.t t/GtkViewport.t t/GtkVolumeButton.t t/GtkVPaned.t t/GtkVRuler.t t/GtkVScale.t t/GtkVScrollbar.t t/GtkVSeparator.t t/GtkWidget.t t/options.t t/pango-compat.t t/PangoAttributes.t t/PangoCairo.t t/PangoContext.t t/PangoFont.t t/PangoFontMap.t t/PangoFontset.t t/PangoGravity.t t/PangoLayout.t t/PangoMatrix.t t/PangoRenderer.t t/PangoScript.t t/PangoTabs.t t/PangoTypes.t t/set-scroll-adjustments-signal.t t/signal-chaining.t t/tied-objects.t t/version-checks.t TODO tools/fetch_faq.pl tools/genkeysyms.pl tools/genmaps.pl tools/podifyenums.pl tools/podifystockitems.pl xs/Gdk.xs xs/GdkCairo.xs xs/GdkColor.xs xs/GdkCursor.xs xs/GdkDisplay.xs xs/GdkDisplayManager.xs xs/GdkDnd.xs xs/GdkDrawable.xs xs/GdkEvent.xs xs/GdkGC.xs xs/GdkImage.xs xs/GdkInput.xs xs/GdkKeys.xs xs/GdkPango.xs xs/GdkPixbuf.xs xs/GdkPixbufLoader.xs xs/GdkPixbufSimpleAnim.xs xs/GdkPixmap.xs xs/GdkProperty.xs xs/GdkRegion.xs xs/GdkRgb.xs xs/GdkScreen.xs xs/GdkSelection.xs xs/GdkTypes.xs xs/GdkVisual.xs xs/GdkWindow.xs xs/GdkX11.xs xs/Gtk2.xs xs/GtkAboutDialog.xs xs/GtkAccelGroup.xs xs/GtkAccelLabel.xs xs/GtkAccelMap.xs xs/GtkAction.xs xs/GtkActionGroup.xs xs/GtkActivatable.xs xs/GtkAdjustment.xs xs/GtkAlignment.xs xs/GtkArrow.xs xs/GtkAspectFrame.xs xs/GtkAssistant.xs xs/GtkBin.xs xs/GtkBindings.xs xs/GtkBox.xs xs/GtkBuildable.xs xs/GtkBuilder.xs xs/GtkButton.xs xs/GtkButtonBox.xs xs/GtkCalendar.xs xs/GtkCellEditable.xs xs/GtkCellLayout.xs xs/GtkCellRenderer.xs xs/GtkCellRendererAccel.xs xs/GtkCellRendererCombo.xs xs/GtkCellRendererPixbuf.xs xs/GtkCellRendererProgress.xs xs/GtkCellRendererSpin.xs xs/GtkCellRendererSpinner.xs xs/GtkCellRendererText.xs xs/GtkCellRendererToggle.xs xs/GtkCellView.xs xs/GtkCheckButton.xs xs/GtkCheckMenuItem.xs xs/GtkClipboard.xs xs/GtkColorButton.xs xs/GtkColorSelection.xs xs/GtkColorSelectionDialog.xs xs/GtkCombo.xs xs/GtkComboBox.xs xs/GtkComboBoxEntry.xs xs/GtkContainer.xs xs/GtkCurve.xs xs/GtkDialog.xs xs/GtkDnd.xs xs/GtkDrawingArea.xs xs/GtkEditable.xs xs/GtkEntry.xs xs/GtkEntryBuffer.xs xs/GtkEntryCompletion.xs xs/GtkEventBox.xs xs/GtkExpander.xs xs/GtkFileChooser.xs xs/GtkFileChooserButton.xs xs/GtkFileChooserDialog.xs xs/GtkFileChooserWidget.xs xs/GtkFileFilter.xs xs/GtkFileSelection.xs xs/GtkFixed.xs xs/GtkFontButton.xs xs/GtkFontSelection.xs xs/GtkFrame.xs xs/GtkGammaCurve.xs xs/GtkGC.xs xs/GtkHandleBox.xs xs/GtkHBox.xs xs/GtkHButtonBox.xs xs/GtkHPaned.xs xs/GtkHRuler.xs xs/GtkHScale.xs xs/GtkHScrollbar.xs xs/GtkHSeparator.xs xs/GtkHSV.xs xs/GtkIconFactory.xs xs/GtkIconTheme.xs xs/GtkIconView.xs xs/GtkImage.xs xs/GtkImageMenuItem.xs xs/GtkIMContext.xs xs/GtkIMContextSimple.xs xs/GtkIMMulticontext.xs xs/GtkInfoBar.xs xs/GtkInputDialog.xs xs/GtkInvisible.xs xs/GtkItem.xs xs/GtkItemFactory.xs xs/GtkLabel.xs xs/GtkLayout.xs xs/GtkLinkButton.xs xs/GtkList.xs xs/GtkListItem.xs xs/GtkListStore.xs xs/GtkMenu.xs xs/GtkMenuBar.xs xs/GtkMenuItem.xs xs/GtkMenuShell.xs xs/GtkMenuToolButton.xs xs/GtkMessageDialog.xs xs/GtkMisc.xs xs/GtkNotebook.xs xs/GtkObject.xs xs/GtkOffscreenWindow.xs xs/GtkOptionMenu.xs xs/GtkOrientable.xs xs/GtkPageSetup.xs xs/GtkPaned.xs xs/GtkPaperSize.xs xs/GtkPlug.xs xs/GtkPrintContext.xs xs/GtkPrintOperation.xs xs/GtkPrintOperationPreview.xs xs/GtkPrintSettings.xs xs/GtkProgressBar.xs xs/GtkRadioAction.xs xs/GtkRadioButton.xs xs/GtkRadioMenuItem.xs xs/GtkRadioToolButton.xs xs/GtkRange.xs xs/GtkRc.xs xs/GtkRecentAction.xs xs/GtkRecentChooser.xs xs/GtkRecentChooserDialog.xs xs/GtkRecentChooserMenu.xs xs/GtkRecentChooserWidget.xs xs/GtkRecentFilter.xs xs/GtkRecentManager.xs xs/GtkRuler.xs xs/GtkScale.xs xs/GtkScaleButton.xs xs/GtkScrolledWindow.xs xs/GtkSelection.xs xs/GtkSeparatorMenuItem.xs xs/GtkSeparatorToolItem.xs xs/GtkShow.xs xs/GtkSizeGroup.xs xs/GtkSocket.xs xs/GtkSpinButton.xs xs/GtkSpinner.xs xs/GtkStatusbar.xs xs/GtkStatusIcon.xs xs/GtkStock.xs xs/GtkStyle.xs xs/GtkTable.xs xs/GtkTearoffMenuItem.xs xs/GtkTextBuffer.xs xs/GtkTextBufferRichText.xs xs/GtkTextChildAnchor.xs xs/GtkTextIter.xs xs/GtkTextMark.xs xs/GtkTextTag.xs xs/GtkTextTagTable.xs xs/GtkTextView.xs xs/GtkToggleAction.xs xs/GtkToggleButton.xs xs/GtkToggleToolButton.xs xs/GtkToolbar.xs xs/GtkToolButton.xs xs/GtkToolItem.xs xs/GtkToolItemGroup.xs xs/GtkToolPalette.xs xs/GtkToolShell.xs xs/GtkTooltip.xs xs/GtkTooltips.xs xs/GtkTreeDnd.xs xs/GtkTreeModel.xs xs/GtkTreeModelFilter.xs xs/GtkTreeModelSort.xs xs/GtkTreeSelection.xs xs/GtkTreeSortable.xs xs/GtkTreeStore.xs xs/GtkTreeView.xs xs/GtkTreeViewColumn.xs xs/GtkUIManager.xs xs/GtkVBox.xs xs/GtkVButtonBox.xs xs/GtkViewport.xs xs/GtkVolumeButton.xs xs/GtkVPaned.xs xs/GtkVRuler.xs xs/GtkVScale.xs xs/GtkVScrollbar.xs xs/GtkVSeparator.xs xs/GtkWidget.xs xs/GtkWindow.xs xs_files-2.0 xs_files-2.10 xs_files-2.12 xs_files-2.14 xs_files-2.16 xs_files-2.18 xs_files-2.2 xs_files-2.20 xs_files-2.4 xs_files-2.6 xs_files-2.8 xt/GdkDnd.t xt/GtkDnd.t xt/GtkSocket-GtkPlug.t META.yml Module YAML meta-data (added by MakeMaker) META.json Module JSON meta-data (added by MakeMaker) Gtk2-1.24992/xs_files-2.20000644000175000017500000000031713076462677013202 0ustar lacklack# these xs files implement types that were introduced in gtk+ 2.2.0. # one filename per line, whitespace and comments are ignored. xs/GdkDisplay.xs xs/GdkDisplayManager.xs xs/GdkScreen.xs xs/GtkClipboard.xs Gtk2-1.24992/t/0000755000175000017500000000000013076464135011375 5ustar lacklackGtk2-1.24992/t/GtkPageSetup.t0000644000175000017500000000531313076462677014140 0ustar lacklack#!/usr/bin/perl -w use strict; use Gtk2::TestHelper tests => 23, at_least_version => [2, 10, 0, "GtkPageSetup is new in 2.10"]; # $Id$ use File::Temp qw(tempdir); my $dir = tempdir(CLEANUP => 1); my $setup = Gtk2::PageSetup -> new(); isa_ok($setup, "Gtk2::PageSetup"); $setup -> set_orientation("landscape"); is($setup -> get_orientation(), "landscape"); my $size = Gtk2::PaperSize -> new("iso_a4"); $setup -> set_paper_size($size); isa_ok($setup -> get_paper_size(), "Gtk2::PaperSize"); $setup -> set_top_margin(23, "mm"); is($setup -> get_top_margin("mm"), 23); $setup -> set_bottom_margin(23, "mm"); is($setup -> get_bottom_margin("mm"), 23); $setup -> set_left_margin(23, "mm"); is($setup -> get_left_margin("mm"), 23); $setup -> set_right_margin(23, "mm"); is($setup -> get_right_margin("mm"), 23); $setup -> set_paper_size_and_default_margins($size); ok(defined $setup -> get_paper_width("mm")); ok(defined $setup -> get_paper_height("mm")); ok(defined $setup -> get_page_width("mm")); ok(defined $setup -> get_page_height("mm")); SKIP: { skip "new 2.12 stuff", 7 unless Gtk2->CHECK_VERSION (2, 12, 0); my $new_setup; $setup -> set_top_margin(23, 'mm'); my $file = "$dir/tmp.setup"; eval { $setup -> to_file($file); }; is($@, ''); eval { $new_setup = Gtk2::PageSetup -> new_from_file($file); }; is($@, ''); isa_ok($new_setup, 'Gtk2::PageSetup'); is($new_setup -> get_top_margin('mm'), 23); my $key_file = Glib::KeyFile -> new(); my $group = undef; $setup -> to_key_file($key_file, $group); open my $fh, '>', $file or skip 'key file tests', 3; print $fh $key_file -> to_data(); close $fh; $key_file = Glib::KeyFile -> new(); eval { $key_file -> load_from_file($file, 'none'); $new_setup = Gtk2::PageSetup -> new_from_key_file($key_file, $group); }; is($@, ''); isa_ok($new_setup, 'Gtk2::PageSetup'); is($new_setup -> get_top_margin('mm'), 23); } SKIP: { skip 'new 2.14 stuff', 5 unless Gtk2->CHECK_VERSION(2, 14, 0); my $file = "$dir/tmp.setup"; my $setup = Gtk2::PageSetup -> new(); $setup -> set_top_margin(23, 'mm'); $setup -> to_file($file); my $key_file = Glib::KeyFile -> new(); my $group = undef; $setup -> to_key_file($key_file, $group); my $copy = Gtk2::PageSetup -> new(); eval { $copy -> load_file($file); }; is($@, ''); is($copy -> get_top_margin('mm'), 23); eval { $copy -> load_file('asdf'); }; ok(defined $@); $copy = Gtk2::PageSetup -> new(); eval { $copy -> load_key_file($key_file, $group); }; is($@, ''); is($copy -> get_top_margin('mm'), 23); } __END__ Copyright (C) 2006, 2013 by the gtk2-perl team (see the file AUTHORS for the full list). See LICENSE for more information. Gtk2-1.24992/t/GtkActionGroup.t0000644000175000017500000000675313076462676014505 0ustar lacklack# # $Id$ # use Gtk2::TestHelper at_least_version => [2, 4, 0, "Action-based menus are new in 2.4"], tests => 28; my $action_group = Gtk2::ActionGroup->new ("Fred"); isa_ok ($action_group, "Gtk2::ActionGroup"); is ($action_group->get_name, "Fred"); $action_group->set_sensitive (1); is ($action_group->get_sensitive, 1); $action_group->set_visible (1); is ($action_group->get_visible, 1); my $action = Gtk2::Action->new (name => 'Barney'); $action_group->add_action ($action); my @list = $action_group->list_actions; is (@list, 1); is ($list[0], $action); is ($action_group->get_action ('Barney'), $action); $action_group->remove_action ($action); @list = $action_group->list_actions; is (@list, 0); $action_group->add_action_with_accel ($action, undef); $action_group->remove_action ($action); $action_group->add_action_with_accel ($action, "a"); $action_group->remove_action ($action); my @action_entries = ( { name => 'open', stock_id => 'gtk-open', label => 'Open', accelerator => 'o', tooltip => 'Open something', callback => sub { ok (TRUE) }, }, { name => 'new', stock_id => 'gtk-new', }, { name => 'old', label => 'Old', }, [ 'close', 'gtk-close', 'Close', 'w', 'Close something', sub { ok (TRUE) } ], [ 'quit', 'gtk-quit', undef, 'q', ], [ 'sep', undef, 'blank', ], ); my @toggle_entries = ( [ "Bold", 'gtk-bold', "_Bold", # name, stock id, label "B", "Bold", # accelerator, tooltip \&activate_action, TRUE ], # is_active ); use constant COLOR_RED => 0; use constant COLOR_GREEN => 1; use constant COLOR_BLUE => 2; my @color_entries = ( # name, stock id, label, accelerator, tooltip, value [ "Red", undef, "_Red", "R", "Blood", COLOR_RED ], [ "Green", undef, "_Green", "G", "Grass", COLOR_GREEN ], [ "Blue", undef, "_Blue", "B", "Sky", COLOR_BLUE ], ); #$action_group->add_actions (\@action_entries, 42) $action_group->add_actions (\@action_entries); @list = $action_group->list_actions; is (@list, 6); $action_group->add_toggle_actions (\@toggle_entries, 42); #$action_group->add_toggle_actions (\@toggle_entries); @list = $action_group->list_actions; is (@list, 7); #$action_group->add_radio_actions (\@color_entries, COLOR_BLUE, \&on_change, 42); $action_group->add_radio_actions (\@color_entries, COLOR_GREEN, \&on_change); @list = $action_group->list_actions; is (@list, 10); $action_group->set_translation_domain("de_DE"); SKIP: { skip "translation API is (semi) new in 2.6", 3+14 unless Gtk2->CHECK_VERSION (2, 6, 0); my $action_group = Gtk2::ActionGroup->new ("Fred"); $action_group->set_translate_func(sub { my ($string, $data) = @_; is($string, "Urgs"); is($data, "bla"); return "Sgru"; }, "bla"); is($action_group->translate_string("Urgs"), "Sgru"); # as of 2.6.0 we have the ability to call the translation function # from add_*_actions like we're supposed to, so let's test that. # the following should result in 14 oks. $action_group->set_translate_func (sub { ok(1, 'xlate'); reverse $_[0]; }); $action_group->add_actions (\@action_entries); $action_group->add_toggle_actions (\@toggle_entries, 42); $action_group->add_radio_actions (\@color_entries, COLOR_GREEN, \&on_change); } __END__ Copyright (C) 2003-2005 by the gtk2-perl team (see the file AUTHORS for the full list). See LICENSE for more information. Gtk2-1.24992/t/GtkTreeModelSort.t0000644000175000017500000000357613076462677015004 0ustar lacklack#!/usr/bin/perl -w use strict; use Gtk2::TestHelper tests => 17, noinit => 1; # $Id$ my $list = Gtk2::ListStore -> new("Glib::Int"); $list -> set($list -> append(), 0 => 42); $list -> set($list -> append(), 0 => 23); my $sort = Gtk2::TreeModelSort -> new_with_model($list); isa_ok($sort, "Gtk2::TreeModelSort"); ginterfaces_ok($sort); is($sort -> get_model(), $list); $sort -> set_sort_column_id(0, "ascending"); # Make sure get() always resolves to the correct method. is($sort -> get($sort -> get_iter_from_string("0"), 0), 23); is($sort -> get("model"), $list); my $path = Gtk2::TreePath -> new_from_string("1"); my $iter = $list -> get_iter($path); my $sort_path = $sort -> convert_child_path_to_path($path); isa_ok($sort_path, "Gtk2::TreePath"); is(Gtk2::TreeModel::get($sort, $sort -> get_iter($sort_path), 0), 23); my $sort_iter = $sort -> convert_child_iter_to_iter($iter); isa_ok($sort_iter, "Gtk2::TreeIter"); is(Gtk2::TreeModel::get($sort, $sort_iter, 0), 23); my $child_path = $sort -> convert_path_to_child_path($sort_path); isa_ok($child_path, "Gtk2::TreePath"); is($list -> get($list -> get_iter($child_path), 0), 23); my $child_iter = $sort -> convert_iter_to_child_iter($sort_iter); isa_ok($child_iter, "Gtk2::TreeIter"); is($list -> get($child_iter, 0), 23); $sort -> reset_default_sort_func(); $sort -> clear_cache(); SKIP: { skip("iter_is_valid is new in 2.2", 1) unless Gtk2->CHECK_VERSION (2, 2, 0); is($sort -> iter_is_valid($sort -> get_iter($path)), 1); } # other ways to construct ok (Gtk2::TreeModelSort->new ($list), 'new with one arg'); ok (Gtk2::TreeModelSort->new (model => $list), 'new with two args'); # this should die with a usage message. eval { $sort = Gtk2::TreeModelSort->new(); }; ok ($@, 'new with no args is an error'); __END__ Copyright (C) 2003-2006 by the gtk2-perl team (see the file AUTHORS for the full list). See LICENSE for more information. Gtk2-1.24992/t/GtkTextBuffer.t0000644000175000017500000001401313076462677014316 0ustar lacklack#!/usr/bin/perl -w # vim: set filetype=perl expandtab shiftwidth=2 softtabstop=2 : use strict; use Gtk2::TestHelper tests => 37; # $Id$ my $table = Gtk2::TextTagTable -> new(); my $buffer = Gtk2::TextBuffer -> new($table); isa_ok($buffer, "Gtk2::TextBuffer"); is($buffer -> get_tag_table(), $table); $buffer = Gtk2::TextBuffer -> new(); isa_ok($buffer, "Gtk2::TextBuffer"); isa_ok($buffer -> get_start_iter(), "Gtk2::TextIter"); isa_ok($buffer -> get_end_iter(), "Gtk2::TextIter"); $buffer -> set_modified(0); $buffer -> insert($buffer -> get_start_iter(), "Lore ipsem dolor. I think that is misspelled.\n"); is($buffer -> insert_interactive($buffer -> get_start_iter(), "Lore ipsem dolor. I think that is misspelled.\n", 1), 1); $buffer -> insert_at_cursor("Lore ipsem dolor. I think that is misspelled.\n"); is($buffer -> insert_interactive_at_cursor("Lore ipsem dolor. I think that is misspelled.\n", 1), 1); $buffer -> insert_range($buffer -> get_end_iter(), $buffer -> get_iter_at_offset(141), $buffer -> get_end_iter()); is($buffer -> insert_range_interactive($buffer -> get_end_iter(), $buffer -> get_iter_at_offset(188), $buffer -> get_end_iter(), 1), 1); my @tags = ($buffer -> create_tag("bla", indent => 2), $buffer -> create_tag("blub", indent => 2)); $buffer -> create_tag("blaa", indent => 2); $buffer -> create_tag("bluub", indent => 2); $buffer -> insert_with_tags($buffer -> get_start_iter(), "Lore ipsem dolor. I think that is misspelled.\n", @tags); $buffer -> insert_with_tags_by_name($buffer -> get_start_iter(), "Lore ipsem dolor. I think that is misspelled.\n", "blaa", "bluub"); is($buffer -> get_line_count(), 9); is($buffer -> get_char_count(), 376); is($buffer -> get_modified(), 1); isa_ok($buffer -> get_iter_at_line_offset(1, 10), "Gtk2::TextIter"); isa_ok($buffer -> get_iter_at_offset(100), "Gtk2::TextIter"); isa_ok($buffer -> get_iter_at_line(6), "Gtk2::TextIter"); isa_ok($buffer -> get_iter_at_line_index(3, 12), "Gtk2::TextIter"); my ($start, $end) = $buffer -> get_bounds(); isa_ok($start, "Gtk2::TextIter"); isa_ok($end, "Gtk2::TextIter"); $buffer -> set_text("Lore ipsem dolor. I think that is misspelled.\n"); is($buffer -> get_text($buffer -> get_start_iter(), $buffer -> get_end_iter(), 1), "Lore ipsem dolor. I think that is misspelled.\n"); is($buffer -> get_slice($buffer -> get_start_iter(), $buffer -> get_end_iter(), 1), "Lore ipsem dolor. I think that is misspelled.\n"); $buffer -> delete($buffer -> get_start_iter(), $buffer -> get_end_iter()); is($buffer -> delete_interactive($buffer -> get_start_iter(), $buffer -> get_end_iter(), 1), 1); $buffer -> insert_pixbuf($buffer -> get_start_iter(), Gtk2::Gdk::Pixbuf -> new("rgb", 0, 8, 10, 10)); my $anchor = Gtk2::TextChildAnchor -> new(); $buffer -> insert_child_anchor($buffer -> get_start_iter(), $anchor); isa_ok($buffer -> get_iter_at_child_anchor($anchor), "Gtk2::TextIter"); isa_ok($buffer -> create_child_anchor($buffer -> get_start_iter()), "Gtk2::TextChildAnchor"); my $mark = $buffer -> create_mark("bla", $buffer -> get_start_iter(), 1); isa_ok($mark, "Gtk2::TextMark"); is($buffer -> get_mark("bla"), $mark); isa_ok($buffer -> get_iter_at_mark($mark), "Gtk2::TextIter"); $buffer -> move_mark($mark, $buffer -> get_end_iter()); $buffer -> move_mark_by_name("bla", $buffer -> get_start_iter()); $buffer -> delete_mark($mark); $mark = $buffer -> create_mark("bla", $buffer -> get_start_iter(), 1); $buffer -> delete_mark_by_name("bla"); isa_ok($buffer -> get_insert(), "Gtk2::TextMark"); isa_ok($buffer -> get_selection_bound(), "Gtk2::TextMark"); $buffer -> place_cursor($buffer -> get_end_iter()); ok(!$buffer -> delete_selection(1, 1)); ok(!$buffer -> get_selection_bounds()); SKIP: { skip("select_range is new in 2.4", 0) unless Gtk2->CHECK_VERSION (2, 4, 0); $buffer -> select_range($buffer -> get_start_iter(), $buffer -> get_end_iter()); } my $tag_one = $buffer -> create_tag("alb", indent => 2); isa_ok($tag_one, "Gtk2::TextTag"); $buffer -> apply_tag($tag_one, $buffer -> get_start_iter(), $buffer -> get_end_iter()); $buffer -> apply_tag_by_name("alb", $buffer -> get_start_iter(), $buffer -> get_end_iter()); my $tag_two = $buffer -> create_tag("bulb", indent => 2); my $tag_three = $buffer -> create_tag(undef, indent => 2); isa_ok($tag_two, "Gtk2::TextTag"); isa_ok($tag_three, "Gtk2::TextTag"); $buffer -> remove_tag($tag_one, $buffer -> get_start_iter(), $buffer -> get_end_iter()); $buffer -> remove_tag_by_name("bulb", $buffer -> get_start_iter(), $buffer -> get_end_iter()); $buffer -> remove_all_tags($buffer -> get_start_iter(), $buffer -> get_end_iter()); SKIP: { skip "GtkClipboard is new in 2.2", 0 unless Gtk2->CHECK_VERSION (2, 2, 0); my $clipboard = Gtk2::Clipboard -> get(Gtk2::Gdk -> SELECTION_CLIPBOARD); $buffer -> paste_clipboard($clipboard, $buffer -> get_end_iter(), 1); $buffer -> paste_clipboard($clipboard, undef, 1); $buffer -> copy_clipboard($clipboard); $buffer -> cut_clipboard($clipboard, 1); $buffer -> add_selection_clipboard($clipboard); $buffer -> remove_selection_clipboard($clipboard); } $buffer -> begin_user_action(); $buffer -> end_user_action(); SKIP: { skip "backspace is new in 2.6", 0 unless Gtk2->CHECK_VERSION (2, 6, 0); $buffer -> backspace($buffer -> get_end_iter(), TRUE, TRUE); } SKIP: { skip "new stuff in 2.10", 5 unless Gtk2->CHECK_VERSION (2, 10, 0); my $bool = $buffer -> get_has_selection(); ok (1); my $targetlist = $buffer -> get_copy_target_list(); isa_ok($targetlist, 'Gtk2::TargetList'); $targetlist = $buffer -> get_paste_target_list(); isa_ok($targetlist, 'Gtk2::TargetList'); isa_ok($buffer -> get('copy-target-list'), 'Gtk2::TargetList'); isa_ok($buffer -> get('paste-target-list'), 'Gtk2::TargetList'); } SKIP: { skip 'new 2.12 stuff', 0 unless Gtk2->CHECK_VERSION (2, 12, 0); my $mark = Gtk2::TextMark -> new('bla', TRUE); my $iter = $buffer -> get_end_iter(); $buffer -> add_mark($mark, $iter); } __END__ Copyright (C) 2003-2006 by the gtk2-perl team (see the file AUTHORS for the full list). See LICENSE for more information. Gtk2-1.24992/t/GtkLabel.t0000644000175000017500000000711413076462677013263 0ustar lacklack# # $Id$ # # TODO: # (set|get)_attributes # ######################### # GtkLabel Tests # - rm ######################### ######################### use Gtk2::TestHelper tests => 32; my $win = Gtk2::Window->new; ok (my $label = Gtk2::Label->new (), 'Gtk2::Label->new ()'); ok ($label = Gtk2::Label->new_with_mnemonic ('test'), 'Gtk2::Label->new_with_mnemonic (string)'); ok ($label = Gtk2::Label->new ("Hello World!"), 'Gtk2::Label->new'); $win->add ($label); is ($label->get_text, 'Hello World!', '$label->get_text'); $label->set_text ('Goodbye World!'); is ($label->get_text, 'Goodbye World!', '$label->(set|get)_text'); $label->set_label ('Hello World!'); is ($label->get_label, 'Hello World!', '$label->(set|get)_label'); $label->set_justify ("right"); is ($label->get_justify, 'right', '$label->(set|get)_justify'); $label->set_pattern ('_____'); ok (1, '$label->set_pattern'); $label->set_use_underline (0); is ($label->get_use_underline, '', '$label->(set|get)_use_underline, false'); $label->set_use_underline (1); is ($label->get_use_underline, 1, '$label->(set|get)_use_underline, true'); ok ($label->get_selectable == 0, '$label->get_selectable'); $label->set_selectable (1); ok ($label->get_selectable == 1, '$label->get_selectable'); $label->select_region (2, 8); ok (eq_array ([$label->get_selection_bounds], [2, 8]), '$label->select_region|selection_region'); is ($label->get_use_markup, '', '$label->get_use_markup, false'); $label->set_markup ('Hello World!'); ok (1, '$label->set_markup'); $label->set_markup_with_mnemonic ('_Hello World!'); is ($label->get_mnemonic_keyval , 104, '$label->set_markup_with_mnemonic|get_mnemonic_keyval'); is ($label->get_use_markup, 1, '$label->get_use_markup, true'); $label->set_use_markup (1); is ($label->get_use_markup, 1, '$label->get_use_markup, true'); $label->set_line_wrap (1); ok ($label->get_line_wrap, '$label->(set|get)_line_wrap'); my @offsets = $label->get_layout_offsets; is (scalar (@offsets), 2, '$label->get_layout_offsets'); isa_ok ($label->get_layout, 'Gtk2::Pango::Layout'); is ($label->get_mnemonic_widget, undef, '$label->get_mnemonic_widget, undef'); my $entry = Gtk2::Entry->new; $label->set_mnemonic_widget ($entry); ok ($label->get_mnemonic_widget, '$label->get_mnemonic_widget, entry'); $label->set_text_with_mnemonic ('_Urgs'); SKIP: { skip 'new 2.6 stuff', 6 unless Gtk2->CHECK_VERSION (2, 6, 0); $label->set_ellipsize ('middle'); is ($label->get_ellipsize, 'middle', '[sg]et_ellipsize'); $label->set_width_chars (23); is ($label->get_width_chars, 23, '[sg]et_width_chars'); $label->set_max_width_chars (32); is ($label->get_max_width_chars, 32, '[sg]et_max_width_chars'); $label->set_angle (90); is ($label->get_angle, 90, '[sg]et_angle'); $label->set_single_line_mode (TRUE); ok ($label->get_single_line_mode, '[sg]et_single_line_mode'); $label->set_single_line_mode (FALSE); ok (!$label->get_single_line_mode, '[sg]et_single_line_mode'); } SKIP: { skip 'new 2.10 stuff', 1 unless Gtk2->CHECK_VERSION (2, 10, 0); $label->set_line_wrap_mode('word'); is ($label->get_line_wrap_mode, 'word'); } SKIP: { skip 'new 2.18 stuff', 2 unless Gtk2->CHECK_VERSION (2, 18, 0); $label->set_markup('uri test'); is ($label->get_current_uri,"http://example.com/uri",'get_current_uri'); $label->set_track_visited_links(FALSE); is ($label->get_track_visited_links, FALSE, '[sg]et_track_visited_links'); } 1; __END__ Copyright (C) 2003-2005 by the gtk2-perl team (see the file AUTHORS for the full list). See LICENSE for more information. Gtk2-1.24992/t/GtkTreeSelection.t0000644000175000017500000001006113076462677015004 0ustar lacklack#!/usr/bin/perl -w # $Id$ ############################################################################### use Gtk2::TestHelper tests => 29; ############################################################################### my $model = Gtk2::ListStore -> new("Glib::String"); my $view = Gtk2::TreeView -> new($model); my $renderer = Gtk2::CellRendererText -> new(); my $column = Gtk2::TreeViewColumn -> new_with_attributes( "Hmm", $renderer, text => 0); $view -> append_column($column); foreach (qw(bla ble bli blo blu)) { $model -> set($model -> append(), 0 => $_); } ############################################################################### my $selection = $view -> get_selection(); isa_ok($selection, "Gtk2::TreeSelection"); $selection -> select_path(Gtk2::TreePath -> new_from_string(0)); ############################################################################### $selection -> set_mode("browse"); ok($selection -> get_mode() eq "browse"); ############################################################################### isa_ok($selection -> get_tree_view(), "Gtk2::TreeView"); ############################################################################### my ($tmp_model, $tmp_iter) = $selection -> get_selected(); isa_ok($tmp_model, "Gtk2::ListStore"); isa_ok($tmp_iter, "Gtk2::TreeIter"); is($tmp_model -> get($tmp_iter, 0), "bla"); isa_ok($selection -> get_selected(), "Gtk2::TreeIter"); ############################################################################### isa_ok($selection -> get_selected_rows(), "Gtk2::TreePath"); ############################################################################### is($selection -> count_selected_rows(), 1); my $path = Gtk2::TreePath -> new_from_string(1); $selection -> select_path($path); ok($selection -> path_is_selected($path)); $selection -> unselect_path($path); ok(not $selection -> path_is_selected($path)); ############################################################################### my $iter = $model -> get_iter($path); is($model -> get($iter, 0), "ble"); $selection -> select_iter($iter); ok($selection -> iter_is_selected($iter)); $selection -> unselect_iter($iter); ok(not $selection -> iter_is_selected($iter)); ############################################################################### $selection -> set_mode("multiple"); $selection -> select_all(); is($selection -> count_selected_rows(), 5); $selection -> unselect_all(); is($selection -> count_selected_rows(), 0); my $path_start = Gtk2::TreePath -> new_from_string(3); my $path_end = Gtk2::TreePath -> new_from_string(4); $selection -> select_range($path_start, $path_end); is($selection -> count_selected_rows(), 2); SKIP: { skip("unselect_range is new in 2.2.x", 1) unless Gtk2->CHECK_VERSION (2, 2, 0); $selection -> unselect_range($path_start, $path_end); is($selection -> count_selected_rows(), 0); } ############################################################################### $selection -> unselect_all(); is($selection -> get_user_data(), undef); $selection -> set_select_function(sub { my ($selection, $model, $path, $selected) = @_; isa_ok($selection, "Gtk2::TreeSelection"); isa_ok($model, "Gtk2::ListStore"); isa_ok($path, "Gtk2::TreePath"); return 0; }); is($selection -> get_user_data(), undef); $selection -> select_path(Gtk2::TreePath -> new_from_string(1)); is($selection -> count_selected_rows(), 0); $selection -> set_select_function(sub { return 1; }, "bla"); is($selection -> get_user_data(), "bla"); ############################################################################### $selection -> select_path(Gtk2::TreePath -> new_from_string(1)); $selection -> selected_foreach(sub { my ($model, $path, $iter) = @_; is($model -> get($iter, 0), "ble"); isa_ok($model, "Gtk2::ListStore"); isa_ok($path, "Gtk2::TreePath"); isa_ok($iter, "Gtk2::TreeIter"); }); ############################################################################### run_main; __END__ Copyright (C) 2003-2005 by the gtk2-perl team (see the file AUTHORS for the full list). See LICENSE for more information. Gtk2-1.24992/t/GtkMessageDialog.t0000644000175000017500000000637113076462677014754 0ustar lacklack#!/usr/bin/perl -w use strict; use Gtk2::TestHelper tests => 8; # $Id$ my $dialog = Gtk2::MessageDialog -> new(undef, "destroy-with-parent", "warning", "ok-cancel", "%s, %d", "Bla", 23); isa_ok($dialog, "Gtk2::MessageDialog"); $dialog = Gtk2::MessageDialog -> new(undef, "destroy-with-parent", "warning", "ok-cancel", "Bla, 23"); isa_ok($dialog, "Gtk2::MessageDialog"); $dialog = Gtk2::MessageDialog -> new(undef, "destroy-with-parent", "warning", "ok-cancel", undef); isa_ok($dialog, "Gtk2::MessageDialog"); # Make we sure we get the custom 'response' signal marshaller. { my $dialog = Gtk2::MessageDialog -> new(undef, "destroy-with-parent", "warning", "ok-cancel", undef); $dialog->signal_connect(response => sub { is ($_[1], 'ok'); Gtk2->main_quit; }); $dialog->show; run_main (sub { $dialog->response ('ok'); }); } SKIP: { skip("new_with_markup and set_markup are new in 2.4", 2) unless Gtk2->CHECK_VERSION (2, 4, 0); $dialog = Gtk2::MessageDialog -> new_with_markup(undef, "destroy-with-parent", "warning", "ok-cancel", "Bla, 23"); isa_ok($dialog, "Gtk2::MessageDialog"); $dialog = Gtk2::MessageDialog -> new_with_markup(undef, "destroy-with-parent", "warning", "ok-cancel", undef); isa_ok($dialog, "Gtk2::MessageDialog"); $dialog -> set_markup("Bla, 23"); } SKIP: { skip("new 2.6 stuff", 0) unless Gtk2->CHECK_VERSION (2, 6, 0); $dialog -> format_secondary_text("%s, %d", "Bla", 23); $dialog -> format_secondary_text("Bla, 23"); $dialog -> format_secondary_text(undef); $dialog -> format_secondary_markup("%s, %d", "Bla", 23); $dialog -> format_secondary_markup("Bla, 23"); $dialog -> format_secondary_markup(undef); } my $image = Gtk2::Label -> new(":-)"); SKIP: { skip("new 2.10 stuff", 0) unless Gtk2->CHECK_VERSION (2, 10, 0); $dialog -> set_image($image); } SKIP: { skip 'new 2.14 stuff', 1 unless Gtk2->CHECK_VERSION(2, 14, 0); is ($dialog -> get_image(), $image); } SKIP: { skip 'new 2.22 stuff', 1 unless Gtk2->CHECK_VERSION(2, 22, 0); isa_ok ($dialog -> get_message_area(), 'Gtk2::Widget'); } __END__ Copyright (C) 2003-2006 by the gtk2-perl team (see the file AUTHORS for the full list). See LICENSE for more information. Gtk2-1.24992/t/GtkCellLayoutIface.t0000644000175000017500000000514213076462676015247 0ustar lacklack#!/usr/bin/perl -w # vim: set filetype=perl : package CustomCellLayout; use strict; use warnings; use Glib ':constants'; use Gtk2; use Test::More; use Glib::Object::Subclass Gtk2::Widget::, interfaces => [ qw(Gtk2::CellLayout) ], ; sub PACK_START { my ($self, $cell, $expand) = @_; isa_ok ($self, __PACKAGE__); isa_ok ($cell, 'Gtk2::CellRenderer'); is ($expand, TRUE); } sub PACK_END { my ($self, $cell, $expand) = @_; isa_ok ($self, __PACKAGE__); isa_ok ($cell, 'Gtk2::CellRenderer'); is ($expand, FALSE); } sub CLEAR { my ($self) = @_; isa_ok ($self, __PACKAGE__); } sub ADD_ATTRIBUTE { my ($self, $cell, $attribute, $column) = @_; isa_ok ($self, __PACKAGE__); isa_ok ($cell, 'Gtk2::CellRenderer'); is ($attribute, 'text'); is ($column, 42); } sub SET_CELL_DATA_FUNC { my ($self, $cell, $func, $data) = @_; isa_ok ($self, __PACKAGE__); isa_ok ($cell, 'Gtk2::CellRenderer'); if (defined $func) { isa_ok ($func, 'Gtk2::CellLayout::DataFunc'); ok (defined $data); my $model = Gtk2::ListStore->new (qw/Glib::String/); $func->($self, $cell, $model, $model->append (), $data); } } sub CLEAR_ATTRIBUTES { my ($self, $cell) = @_; isa_ok ($self, __PACKAGE__); isa_ok ($cell, 'Gtk2::CellRenderer'); } sub REORDER { my ($self, $cell, $position) = @_; isa_ok ($self, __PACKAGE__); isa_ok ($cell, 'Gtk2::CellRenderer'); is ($position, 42); } sub grow_the_stack { 0 .. 500 }; sub GET_CELLS { my ($self) = @_; isa_ok ($self, __PACKAGE__); $self->{cell_one} = Gtk2::CellRendererText->new; $self->{cell_two} = Gtk2::CellRendererToggle->new; my @list = grow_the_stack(); return ($self->{cell_one}, $self->{cell_two}); } package main; use strict; use warnings; use Glib ':constants'; use Gtk2::TestHelper tests => 31; my $cell = Gtk2::CellRendererText->new (); my $layout = CustomCellLayout->new (); $layout->pack_start ($cell, TRUE); $layout->pack_end ($cell, FALSE); $layout->clear (); $layout->add_attribute ($cell, text => 42); $layout->clear_attributes ($cell); $layout->reorder ($cell, 42); SKIP: { skip 'get_cells', 4 unless Gtk2->CHECK_VERSION (2, 12, 0); my @cells = $layout->get_cells (); is (scalar @cells, 2); isa_ok ($cells[0], 'Gtk2::CellRendererText'); isa_ok ($cells[1], 'Gtk2::CellRendererToggle'); } my $callback = sub { my ($cb_layout, $cb_cell, $model, $iter, $data) = @_; is ($cb_layout, $layout); is ($cb_cell, $cell); isa_ok ($model, 'Gtk2::ListStore'); isa_ok ($iter, 'Gtk2::TreeIter'); is ($data, 'bla!'); }; $layout->set_cell_data_func ($cell, $callback, 'bla!'); $layout->set_cell_data_func ($cell, undef); Gtk2-1.24992/t/pango-compat.t0000644000175000017500000000146713076462677014170 0ustar lacklack#!/usr/bin/perl use strict; use warnings; use Gtk2::TestHelper tests => 3; # Make sure that the old names for object, boxed, and fundamental types work. # Pango 1.0 didn't have an interface type, so we can't test one without # fiddling with version checks. is (eval { Gtk2::TreeStore->new (qw/Gtk2::Pango::Layout Gtk2::Pango::Color Gtk2::Pango::Weight Gtk2::Pango::FontMask/); 1; }, 1); # Make sure that objects of some type also appear to be of the old type my $label = Gtk2::Label->new (); my $layout = $label->get_layout (); isa_ok ($layout, qw/Gtk2::Pango::Layout/); isa_ok ($layout, qw/Pango::Layout/); __END__ Copyright (C) 2008 by the gtk2-perl team (see the file AUTHORS for the full list). See LICENSE for more information. Gtk2-1.24992/t/GtkFixed.t0000644000175000017500000000067613076462677013311 0ustar lacklack#!/usr/bin/perl -w use strict; use Gtk2::TestHelper tests => 2, noinit => 1; # $Id$ my $fixed = Gtk2::Fixed -> new(); isa_ok($fixed, "Gtk2::Fixed"); my $label = Gtk2::Label -> new("Bla"); $fixed -> put($label, 23, 42); $fixed -> move($label, 5, 5); $fixed -> set_has_window(1); is($fixed -> get_has_window(), 1); __END__ Copyright (C) 2003 by the gtk2-perl team (see the file AUTHORS for the full list). See LICENSE for more information. Gtk2-1.24992/t/GtkDialog.t0000644000175000017500000000757513076462676013455 0ustar lacklack#!/usr/bin/perl # vim: set syntax=perl : # # $Id$ # ######################### # GtkDialog Tests # - rm ######################### use Gtk2::TestHelper tests => 33; ok( my $win = Gtk2::Window->new('toplevel') ); # a constructor made dialog, run ok( my $d1 = Gtk2::Dialog->new("Test Dialog", $win, [qw/destroy-with-parent no-separator/], 'gtk-cancel', 2, 'gtk-quit', 3 ) ); ok( my $btn1 = $d1->add_button('Another', 4) ); ok( $d1->get_has_separator == 0 ); Glib::Idle->add( sub { $btn1->clicked; 0; }); ok( $d1->run == 4 ); $d1->hide; # a hand made dialog, run ok( my $d2 = Gtk2::Dialog->new ); ok( $d2->add_button('First Button', 0) ); ok( my $btn2 = $d2->add_button('gtk-ok', 1) ); $d2->set_has_separator(1); ok( $d2->get_has_separator == 1 ); $d2->set_has_separator(0); ok( $d2->get_has_separator == 0 ); $d2->add_buttons('gtk-cancel', 2, 'gtk-quit', 3, 'Last Button', 4); $d2->add_action_widget(Gtk2::Button->new("Uhh"), 5); $d2->set_default_response(4); $d2->set_response_sensitive(4, 1); $d2->signal_connect( response => sub { ok( $_[1] == 1 ); 1; }); Glib::Idle->add( sub { $btn2->clicked; 0; }); ok( $d2->run == 1 ); $d2->hide; # a constructor made dialog, show ok( my $d3 = Gtk2::Dialog->new("Test Dialog", $win, [qw/destroy-with-parent no-separator/], 'gtk-ok', 22, 'gtk-quit', 33 ) ); ok( my $btn3 = $d3->add_button('Another', 44) ); ok( $d3->get_has_separator == 0 ); $d3->vbox->pack_start( Gtk2::Label->new('This is just a test.'), 0, 0, 0); $d3->action_area->pack_start( Gtk2::Label->new('<- Actions'), 0, 0, 0); $d3->show_all; $d3->signal_connect( response => sub { ok( $_[1] == 44 ); 1; }); ok(1); $btn3->clicked; ok(1); # make sure that known response types are converted to strings for the reponse # signal of Gtk2::Dialog and its ancestors foreach my $package (qw/Gtk2::Dialog Gtk2::InputDialog/) { my $d = $package->new; my $b = $d->add_button('First Button', 'ok'); $d->signal_connect( response => sub { is( $_[1], 'ok', "$package reponse" ); TRUE; }); Glib::Idle->add( sub { $b->clicked; FALSE; }); is( $d->run, 'ok', "$package run" ); $d->hide; } SKIP: { skip 'set_alternative_button_order is new in 2.6', 3 unless Gtk2->CHECK_VERSION (2, 6, 0); $d3->set_alternative_button_order (2, 3); $d3->set_alternative_button_order (qw(ok cancel accept), 3); $d3->set_alternative_button_order; my $screen = Gtk2::Gdk::Screen->get_default; like (Gtk2->alternative_dialog_button_order ($screen), qr/^(?:1|)$/); like (Gtk2->alternative_dialog_button_order (undef), qr/^(?:1|)$/); like (Gtk2->alternative_dialog_button_order, qr/^(?:1|)$/); } SKIP: { skip 'get_response_for_widget is new in 2.8', 1 unless Gtk2->CHECK_VERSION (2, 8, 0); is( $d3->get_response_for_widget (($d3->action_area->get_children)[1]), 44 ); } # 2.14 introduced accessors for the struct members vbox and action_area. we # provide them under the new name for all versions of gtk+ by using direct # struct access on older versions. for compatibility, we continue to provide # the old names. isa_ok ($d3->get_action_area, 'Gtk2::HButtonBox'); isa_ok ($d3->get_content_area, 'Gtk2::VBox'); ok ($d3->action_area == $d3->get_action_area); ok ($d3->vbox == $d3->get_content_area); SKIP: { skip 'get_widget_for_response is new in 2.20', 2 unless Gtk2->CHECK_VERSION (2, 20, 0); # number response id is ($d3->get_widget_for_response(44), $btn3); # enum name response id my $button = Gtk2::Button->new('foo'); $d3->add_action_widget($button, 'help'); is ($d3->get_widget_for_response('help'), $button); } # Make sure that our custom "response" marshaller is used. { my $d = Gtk2::Dialog->new("Test Dialog", undef, [], 'gtk-ok', 'ok'); $d->signal_connect(response => sub { is ($_[1], 'ok'); Gtk2->main_quit; }); run_main (sub { $d->response ('ok'); }); } __END__ Copyright (C) 2003-2005, 2010 by the gtk2-perl team (see the file AUTHORS for the full list). See LICENSE for more information. Gtk2-1.24992/t/GtkOffscreenWindow.t0000644000175000017500000000113013076462677015336 0ustar lacklack#!/usr/bin/env perl use Gtk2::TestHelper tests => 5, at_least_version => [2, 20, 0, "Gtk2::OffscreenWindow is new in 2.20"]; my $window = Gtk2::OffscreenWindow->new; isa_ok ($window, 'Gtk2::OffscreenWindow'); $window->realize; my $pixmap = $window->get_pixmap; isa_ok ($pixmap, 'Gtk2::Gdk::Pixmap'); isa_ok ($pixmap->get_display, 'Gtk2::Gdk::Display'); my $pixbuf = $window->get_pixbuf; isa_ok ($pixbuf, 'Gtk2::Gdk::Pixbuf'); ok (defined $pixbuf->get_colorspace); __END__ Copyright (C) 2010 by the gtk2-perl team (see the file AUTHORS for the full list). See LICENSE for more information. Gtk2-1.24992/t/GtkHSV.t0000644000175000017500000000111513076462677012677 0ustar lacklack#!/usr/bin/env perl use Gtk2::TestHelper tests => 6, noinit => 1, at_least_version => [2, 14, 0, "Gtk2::HSV is new in 2.14"]; my $hsv = Gtk2::HSV->new; isa_ok ($hsv, 'Gtk2::HSV'); $hsv->set_color (0, 0, 0); is_deeply ([$hsv->get_color], [0, 0, 0]); $hsv->set_metrics (23, 1); is_deeply ([$hsv->get_metrics], [23, 1]); ok (!$hsv->is_adjusting); is_deeply ([Gtk2::hsv_to_rgb (0, 0, 0)], [0, 0, 0]); is_deeply ([Gtk2::rgb_to_hsv (0, 0, 0)], [0, 0, 0]); __END__ Copyright (C) 2010 by the gtk2-perl team (see the file AUTHORS for the full list). See LICENSE for more information. Gtk2-1.24992/t/GtkToolShell.t0000644000175000017500000000165213076462677014152 0ustar lacklack#!/usr/bin/perl use strict; use warnings; use Gtk2::TestHelper tests => 9, at_least_version => [2, 14, 0, 'GtkToolShell is new in 2.14'], ; # $Id$ my $toolbar = Gtk2::Toolbar->new (); isa_ok ($toolbar, 'Gtk2::ToolShell'); ok (defined $toolbar->get_icon_size ()); ok (defined $toolbar->get_orientation ()); ok (defined $toolbar->get_relief_style ()); ok (defined $toolbar->get_style ()); $toolbar->rebuild_menu (); SKIP: { skip 'new 2.20 stuff', 4 unless Gtk2->CHECK_VERSION(2, 20, 0); ok (defined $toolbar->get_ellipsize_mode); ok (defined $toolbar->get_text_alignment); ok (defined $toolbar->get_text_orientation); my $palette = Gtk2::ToolPalette->new; my $bar = Gtk2::ToolItemGroup->new ('Test'); $palette->add ($bar); isa_ok ($bar->get_text_size_group, 'Gtk2::SizeGroup'); } __END__ Copyright (C) 2008 by the gtk2-perl team (see the file AUTHORS for the full list). See LICENSE for more information. Gtk2-1.24992/t/GtkPrintSettings.t0000644000175000017500000000554713076462677015071 0ustar lacklack#!/usr/bin/perl -w use strict; use Gtk2::TestHelper tests => 23, at_least_version => [2, 10, 0, 'GtkPrintSettings: it is new in 2.10']; # $Id$ use File::Temp qw(tempdir); my $dir = tempdir(CLEANUP => 1); my $settings = Gtk2::PrintSettings -> new(); isa_ok($settings, 'Gtk2::PrintSettings'); my $key = 'printer'; my $value = 'Bla DeskJet'; $settings -> set($key, $value); is($settings -> get($key), $value); ok($settings -> has_key($key)); $settings -> set($key, undef); is($settings -> get($key), undef); $settings -> unset($key); is($settings -> get($key), undef); my $i_know_you = 0; my $callback = sub { my ($c_key, $c_value, $data) = @_; return if $i_know_you++; is($c_key, $key); is($c_value, $value); is($data, 'blub'); }; $settings -> set($key, $value); $settings -> foreach($callback, 'blub'); SKIP: { skip 'new 2.12 stuff', 7 unless Gtk2->CHECK_VERSION (2, 12, 0); $settings -> set($key, $value); my $new_settings; my $file = "$dir/tmp.settings"; eval { $settings -> to_file($file); }; is($@, ''); eval { $new_settings = Gtk2::PrintSettings -> new_from_file($file); }; is($@, ''); isa_ok($new_settings, 'Gtk2::PrintSettings'); is($new_settings -> get($key), $value); my $key_file = Glib::KeyFile -> new(); my $group = undef; $settings -> to_key_file($key_file, $group); open my $fh, '>', $file or skip 'key file tests', 3; print $fh $key_file -> to_data(); close $fh; $key_file = Glib::KeyFile -> new(); eval { $key_file -> load_from_file($file, 'none'); $new_settings = Gtk2::PrintSettings -> new_from_key_file($key_file, $group); }; is($@, ''); isa_ok($new_settings, 'Gtk2::PrintSettings'); is($new_settings -> get($key), $value); } SKIP: { skip 'new 2.14 stuff', 5 unless Gtk2->CHECK_VERSION(2, 14, 0); my $file = "$dir/tmp.settings2"; my $settings = Gtk2::PrintSettings -> new(); $settings -> set($key, $value); $settings -> to_file($file); my $key_file = Glib::KeyFile -> new(); my $group = undef; $settings -> to_key_file($key_file, $group); my $copy = Gtk2::PrintSettings -> new(); eval { $copy -> load_file($file); }; is($@, ''); is($copy -> get($key), $value); eval { $copy -> load_file('asdf'); }; ok(defined $@); $copy = Gtk2::PrintSettings -> new(); eval { $copy -> load_key_file($key_file, $group); }; is($@, ''); is($copy -> get($key), $value); } SKIP: { skip 'new 2.16 stuff', 3 unless Gtk2->CHECK_VERSION(2, 16, 0); my $settings = Gtk2::PrintSettings -> new(); $settings -> set_printer_lpi(3.1416); delta_ok($settings -> get_printer_lpi(), 3.1416); $settings -> set_resolution_xy(10, 20); is($settings -> get_resolution_x(), 10); is($settings -> get_resolution_y(), 20); } __END__ Copyright (C) 2006, 2013 by the gtk2-perl team (see the file AUTHORS for the full list). See LICENSE for more information. Gtk2-1.24992/t/02.GtkContainer.t0000644000175000017500000001355713076462676014415 0ustar lacklack#!/usr/bin/perl -w # vim: set filetype=perl : # $Id$ use Gtk2::TestHelper tests => 41; # we'll create some containers (windows and boxes are containers) and # mess around with some of the methods to make sure they do things. my $window = Gtk2::Window->new; my $vbox = Gtk2::VBox->new; is ($window->child_type, 'Gtk2::Widget', 'a window wants a widget'); # i think we'd know if $container->add didn't work $window->add ($vbox); ok (1, 'added a widget to the window'); $window->set_focus_child($vbox); ok(1); SKIP: { skip 'new 2.14 stuff', 2 unless Gtk2->CHECK_VERSION(2, 14, 0); is ($window->get_focus_child, $vbox); $window->set_focus_child (undef); is ($window->get_focus_child, undef); } my $adjustment = Gtk2::Adjustment->new(0, 0, 100, 5, 10, 20); $window->set_focus_vadjustment($adjustment); is($window->get_focus_vadjustment, $adjustment); $window->set_focus_hadjustment($adjustment); is($window->get_focus_hadjustment, $adjustment); $window->resize_children; ok(1); $window->set_border_width(10); is($window->get_border_width, 10); my $expose_event = Gtk2::Gdk::Event->new("expose"); $window->propagate_expose($vbox, $expose_event); ok(1); # child_type returns undef when no more children may be added #ok (!defined ($window->child_type), # 'child_type returns undef when the container is full'); is ($window->get_child, $vbox, 'the window\'s child is set'); is ($vbox->child_type, 'Gtk2::Widget', 'a box wants a widget'); $vbox->pack_start (Gtk2::Label->new ("one"), 1, 1, 0); is ($vbox->child_type, 'Gtk2::Widget', 'a box is always hungry'); my $entry = Gtk2::Entry->new (); # let's dump in a few more quickly $vbox->pack_start (Gtk2::Button->new ("two"), 1, 1, 0); $vbox->pack_start (Gtk2::ToggleButton->new ("three"), 1, 1, 0); $vbox->pack_start (Gtk2::CheckButton->new ("four"), 1, 1, 0); $vbox->pack_start ($entry, 1, 1, 0); is_deeply ([$vbox->child_get ($entry, qw(expand fill pack-type padding position))], [1, 1, "start", 0, 4]); $vbox->child_set ($entry, expand => 0, position => 2); $vbox->child_set_property ($entry, fill => 0); is_deeply ([$vbox->child_get_property ($entry, qw(expand fill pack-type padding position))], [0, 0, "start", 0, 2]); my $label = Gtk2::Label->new ("Blub"); $vbox->add_with_properties ($label, pack_type => "end", position => 4); is_deeply ([$vbox->child_get ($label, qw(pack-type position))], ["end", 4]); $vbox->remove ($label); my @children = $vbox->get_children; is (scalar (@children), 5, 'we packed five children'); my @chain = $vbox->get_focus_chain; is (scalar (@chain), 0, 'we have not set a focus chain'); # set focus chain to focusable children in reverse order @chain = reverse map { $_->can_focus ? $_ : () } @children; $vbox->set_focus_chain (@chain); eq_array( [$vbox->get_focus_chain], \@chain, 'focus chain took'); $vbox->unset_focus_chain; is_deeply([$vbox->get_focus_chain], []); # togglebuttons suck. wipe them out... all of them. my $nremoved = 0; $vbox->foreach (sub { if ('Gtk2::ToggleButton' eq ref $_[0]) { $vbox->remove ($_[0]); $nremoved++; } }); is ($nremoved, 1, 'removed one toggle'); @children = $vbox->get_children; is (scalar (@children), 4, 'four children remain'); my $n_total = 0; $vbox->forall (sub { isa_ok ($_[0], Gtk2::Widget::); $n_total++; }); is ($n_total, 4, 'forall walks all children'); is ($vbox->get_resize_mode, 'parent'); $vbox->set_resize_mode ('queue'); is ($vbox->get_resize_mode, 'queue'); $vbox->check_resize; ok(1); $vbox->set_reallocate_redraws(1); ok(1); #$window->show_all; #Gtk2->main; #------------------------------------------------------------------------------ # find_child_property() is (Gtk2::Container->find_child_property('Gtk2-Perl-test-no-such-property'), undef, 'find_child_property() no such child property'); is (eval { Gtk2::Container::find_child_property('Not::A::Container::Class', 'propname'); 1 }, undef, 'find_child_property() Not::A::Container::Class croaks'); is (eval { Gtk2::Container::find_child_property('Gtk2::Widget', 'propname'); 1 }, undef, 'find_child_property() Gtk2::Widget croaks'); { my $pspec = Gtk2::Box->find_child_property('expand'); isa_ok ($pspec, 'Glib::Param::Boolean', 'find_child_property() "expand" is a boolean'); require Scalar::Util; Scalar::Util::weaken($pspec); is ($pspec, undef, 'find_child_property() destroyed when weakened'); } { my $hbox = Gtk2::HBox->new; my $pspec = $hbox->find_child_property('expand'); isa_ok ($pspec, 'Glib::Param::Boolean', 'find_child_property() object method "expand" is a boolean'); } #------------------------------------------------------------------------------ # list_child_properties() # as of Gtk 2.20 the base Gtk2::Container class doesn't have any child # properties, but don't assume that, so don't ask anything of @pspecs, just # that list_child_properties() returns my @pspecs = Gtk2::Container->list_child_properties; is (eval { Gtk2::Container::list_child_properties('Not::A::Container::Class'); 1 }, undef, 'list_child_properties() Not::A::Container::Class croaks'); is (eval { Gtk2::Container::list_child_properties('Gtk2::Widget'); 1 }, undef, 'list_child_properties() Gtk2::Widget croaks'); { my @pspecs = Gtk2::Box->list_child_properties; cmp_ok (scalar(@pspecs), '>=', 2, 'list_child_properties() at least "expand" and "pack"'); require Scalar::Util; foreach (@pspecs) { Scalar::Util::weaken($_); } my $all_undef = 1; foreach (@pspecs) { if ($_) { $all_undef = 0; } } is ($all_undef, 1, 'list_child_properties() pspecs destroyed when weakened'); } { my $hbox = Gtk2::HBox->new; my @pspecs = $hbox->list_child_properties; cmp_ok (scalar(@pspecs), '>=', 2, 'list_child_properties() object method at least "expand" and "pack"'); } __END__ Copyright (C) 2003-2010 by the gtk2-perl team (see the file AUTHORS for the full list). See LICENSE for more information. Gtk2-1.24992/t/GtkIconView.t0000644000175000017500000002035713076462677013773 0ustar lacklack#!/usr/bin/perl # # $Id$ # ######################### # GtkIconView Tests # - rm ######################### ######################### use strict; use warnings; use Gtk2::TestHelper tests => 60, at_least_version => [2, 6, 0, "GtkIconView is new in 2.6"], ; use constant TEXT => 0; use constant PIXBUF => 1; use constant BOOLEAN => 2; use constant ICON_COORD => 30; my $win = Gtk2::Window->new; #my $swin = Gtk2::ScrolledWindow->new; #$win->add ($swin); my $model = create_store (); isa_ok (my $iview = Gtk2::IconView->new, 'Gtk2::IconView', 'Gtk2::IconView->new'); ginterfaces_ok($iview); is ($iview->get_model, undef, '$iview->get_model, undef'); $iview->set_model ($model); is ($iview->get_model, $model, '$iview->set|get_model'); isa_ok ($iview = Gtk2::IconView->new_with_model ($model), 'Gtk2::IconView', 'Gtk2::IconView->new'); #$swin->add ($iview); is ($iview->get_model, $model, '$iview->get_model, new_with_model'); fill_store ($model, get_pixbufs ($win)); is ($iview->get_text_column, -1, '$iview->get_text_column, undef'); $iview->set_text_column (TEXT); is ($iview->get_text_column, TEXT, '$iview->set|get_text_column'); is ($iview->get_pixbuf_column, -1, '$iview->get_pixbuf_column, undef'); $iview->set_pixbuf_column (PIXBUF); is ($iview->get_pixbuf_column, PIXBUF, '$iview->set|get_pixbuf_column'); is ($iview->get_markup_column, -1, '$iview->get_markup_column, undef'); $iview->set_markup_column (TEXT); is ($iview->get_markup_column, TEXT, '$iview->set|get_markup_column'); foreach (qw/horizontal vertical/) { $iview->set_orientation ($_); is ($iview->get_orientation, $_, '$iview->set|get_orienation, '.$_); } # extended should be in this list, but it seems to fail foreach (qw/none single browse multiple/) { $iview->set_selection_mode ($_); is ($iview->get_selection_mode, $_, '$iview->set|get_selection_mode '.$_); } $iview->set_columns (23); is ($iview->get_columns, 23); $iview->set_item_width (23); is ($iview->get_item_width, 23); $iview->set_spacing (23), is ($iview->get_spacing, 23); $iview->set_row_spacing (23); is ($iview->get_row_spacing, 23); $iview->set_column_spacing (23); is ($iview->get_column_spacing, 23); $iview->set_margin (23); is ($iview->get_margin, 23); my $path = $iview->get_path_at_pos (ICON_COORD, ICON_COORD); $path = Gtk2::TreePath->new_first unless defined $path; isa_ok ($path, 'Gtk2::TreePath'); is ($iview->path_is_selected ($path), '', '$iview->path_is_selected, no'); $iview->select_path ($path); is ($iview->path_is_selected ($path), 1, '$iview->path_is_selected, yes'); $iview->unselect_path ($path); is ($iview->path_is_selected ($path), '', '$iview->path_is_selected, no'); $iview->item_activated ($path); my @sels = $iview->get_selected_items; is (scalar (@sels), 0, '$iview->get_selected_items, count 0'); $iview->select_all; @sels = $iview->get_selected_items; is (scalar (@sels), 14, '$iview->get_selected_items, count 14'); isa_ok ($sels[0], 'Gtk2::TreePath', '$iview->get_selected_items, type'); # make sure it's actually a valid path ok (defined $sels[0]->to_string); $iview->unselect_all; @sels = $iview->get_selected_items; is (scalar (@sels), 0, '$iview->get_selected_items, count 0'); $iview->select_path ($path); $iview->selected_foreach (sub { my ($view, $path, $data) = @_; isa_ok ($view, 'Gtk2::IconView'); isa_ok ($path, 'Gtk2::TreePath'); isa_ok ($data, 'HASH'); is ($data->{foo}, 'bar', 'callback data intact'); }, { foo => 'bar' }); $iview->select_all; my $ncalls = 0; $iview->selected_foreach (sub { $ncalls++ }); my @selected_items = $iview->get_selected_items; is ($ncalls, scalar(@selected_items), 'called once for each selected child'); SKIP: { skip 'new 2.8 stuff', 11 unless Gtk2->CHECK_VERSION (2, 8, 0); # For some reason, get_item_at_pos seems to occasionally run into # uninitialized memory when used non-interactively. So it's not tested # here. # run_main sub { warn $iview->get_item_at_pos (ICON_COORD, ICON_COORD); }; my $win = Gtk2::Window->new; my $model = create_store (); fill_store ($model, get_pixbufs ($win)); my $iview = Gtk2::IconView->new_with_model ($model); $iview->set_text_column (TEXT); $iview->set_pixbuf_column (PIXBUF); $win->add ($iview); $win->show_all; my $path = Gtk2::TreePath->new_first; # We have no cell renderer to test with, since get_cells() is not # available. $iview->set_cursor ($path, undef, FALSE); my @tmp = $iview->get_cursor; is (@tmp, 2); isa_ok ($tmp[0], "Gtk2::TreePath"); is ($tmp[1], undef); @tmp = $iview->get_visible_range; isa_ok ($tmp[0], "Gtk2::TreePath"); isa_ok ($tmp[1], "Gtk2::TreePath"); $iview->scroll_to_path ($path, TRUE, 0.5, 0.5); $iview->scroll_to_path ($path); $iview->enable_model_drag_source ([qw/shift-mask/], "copy", { target => "STRING", flags => ["same-app", "same-widget"], info => 42 }); $iview->enable_model_drag_dest ("copy", { target => "STRING", flags => ["same-app", "same-widget"], info => 42 }); $iview->unset_model_drag_source; $iview->unset_model_drag_dest; $iview->set_reorderable (TRUE); ok ($iview->get_reorderable); $iview->set_drag_dest_item ($path, "drop-into"); @tmp = $iview->get_drag_dest_item; isa_ok ($tmp[0], "Gtk2::TreePath"); is ($tmp[1], "drop-into"); my ($tmp_path, $pos) = $iview->get_dest_item_at_pos (ICON_COORD, ICON_COORD); isa_ok ($tmp_path, "Gtk2::TreePath"); like ($pos, qr/drop/); isa_ok ($iview->create_drag_icon ($path), "Gtk2::Gdk::Pixmap"); $win->destroy; } SKIP: { skip 'new 2.12 stuff', 2 unless Gtk2->CHECK_VERSION (2, 12, 0); my $win = Gtk2::Window->new; my $model = create_store (); fill_store ($model, get_pixbufs ($win)); my $iview = Gtk2::IconView->new_with_model ($model); $iview->set_tooltip_column (TEXT); is ($iview->get_tooltip_column, TEXT); my ($bx, $by) = $iview->convert_widget_to_bin_window_coords (0, 0); is_deeply ([$bx, $by], [0, 0]); } SKIP: { skip 'new 2.18 stuff', 1 unless Gtk2->CHECK_VERSION (2, 18, 0); my $win = Gtk2::Window->new; my $model = create_store (); fill_store ($model, get_pixbufs ($win)); my $iview = Gtk2::IconView->new_with_model ($model); $iview->set_item_padding(2); is ($iview->get_item_padding, 2, '[gs]et_icon_padding'); } SKIP: { skip 'query-tooltip is hard to test automatically', 5; my $win = Gtk2::Window->new; $win->set (tooltip_markup => "Bla!"); my $model = create_store (); fill_store ($model, get_pixbufs ($win)); my $iview = Gtk2::IconView->new_with_model ($model); my $path = Gtk2::TreePath->new_first; my $cell = ($iview->get_cells)[PIXBUF]; my $handler_called = 0; $win->signal_connect (query_tooltip => sub { my ($window, $x, $y, $keyboard_mode, $tip) = @_; return TRUE if $handler_called++; $iview->set_tooltip_item ($tip, $path); $iview->set_tooltip_cell ($tip, $path, $cell); my ($bx, $by, $model, $tpath, $iter) = $iview->get_tooltip_context ($x, $y, $keyboard_mode); is ($bx, 0); is ($by, 0); isa_ok ($model, 'Gtk2::TreeModel'); isa_ok ($tpath, 'Gtk2::TreePath'); isa_ok ($iter, 'Gtk2::TreeIter'); Glib::Idle->add (sub { Gtk2->main_quit; }); return TRUE; }); $win->add ($iview); $win->show_all; my $event = Gtk2::Gdk::Event->new ('motion-notify'); $event->window ($win->window); Gtk2->main_do_event ($event); Gtk2->main; $win->destroy; } SKIP: { skip 'new 2.22 stuff', 3 unless Gtk2->CHECK_VERSION (2, 22, 0); my $win = Gtk2::Window->new; my $model = create_store (); fill_store ($model, get_pixbufs ($win)); my $iview = Gtk2::IconView->new_with_model ($model); my $path = Gtk2::TreePath->new_first; ok (defined $iview->get_item_column ($path)); ok (defined $iview->get_item_row ($path)); $iview->set_item_orientation ('vertical'); is ($iview->get_item_orientation, 'vertical'); } sub create_store { my $store = Gtk2::ListStore->new (qw/Glib::String Gtk2::Gdk::Pixbuf Glib::Boolean/); return $store; } sub get_pixbufs { my $win = shift; my @pbs; foreach (qw/gtk-ok gtk-cancel gtk-about gtk-quit/) { push @pbs, $win->render_icon ($_, 'dialog'); } return \@pbs; } sub fill_store { my $store = shift; my $pbs = shift; foreach (qw/one two three four five six seven eight nine uno dos tres quatro cinco/) { my $iter = $store->append; $store->set ($iter, TEXT, "$_", PIXBUF, $pbs->[rand (@$pbs)], BOOLEAN, rand (2), ); } } Gtk2-1.24992/t/PangoScript.t0000644000175000017500000000135713076462677014032 0ustar lacklack#!/usr/bin/perl -w use strict; use Gtk2::TestHelper tests => 8; # $Id$ SKIP: { skip("PangoScript is new in 1.4", 8) unless (Gtk2::Pango -> CHECK_VERSION(1, 4, 0)); is(Gtk2::Pango::Script -> for_unichar("a"), "latin"); my $lang = Gtk2::Pango::Script -> get_sample_language("latin"); isa_ok($lang, "Gtk2::Pango::Language"); is($lang -> includes_script("latin"), 1); my $iter = Gtk2::Pango::ScriptIter -> new("urgs"); isa_ok($iter, "Gtk2::Pango::ScriptIter"); my ($start, $end, $script) = $iter -> get_range(); is($start, "urgs"); is($end, ""); is($script, "latin"); ok(!$iter -> next()); } __END__ Copyright (C) 2004 by the gtk2-perl team (see the file AUTHORS for the full list). See LICENSE for more information. Gtk2-1.24992/t/GtkColorButton.t0000644000175000017500000000216513076462676014516 0ustar lacklack#!/usr/bin/perl -w # $Id$ use Gtk2::TestHelper tests => 10, at_least_version => [2, 4, 0, "GtkColorButton is new in 2.4"], ; sub color_eq { my ($a, $b) = @_; return $a->red == $b->red && $a->green == $b->green && $a->blue == $b->blue } my ($cbn, $color); $cbn = Gtk2::ColorButton->new; isa_ok ($cbn, "Gtk2::ColorButton"); $color = Gtk2::Gdk::Color->new (0, 0, 65535); $cbn = Gtk2::ColorButton->new_with_color ($color); isa_ok ($cbn, "Gtk2::ColorButton"); ok (color_eq ($color, $cbn->get_color)); $cbn = Gtk2::ColorButton->new ($color); isa_ok ($cbn, "Gtk2::ColorButton"); ok (color_eq ($color, $cbn->get_color)); $color = Gtk2::Gdk::Color->new (65535, 0, 0); $cbn->set_color ($color); ok (color_eq ($color, $cbn->get_color)); $cbn->set_alpha (32768); is ($cbn->get_alpha, 32768); $cbn->set_use_alpha (TRUE); ok ($cbn->get_use_alpha); $cbn->set_use_alpha (FALSE); ok (!$cbn->get_use_alpha); $cbn->set_title ("title"); is ($cbn->get_title, "title"); __END__ Copyright (C) 2003 by the gtk2-perl team (see the file AUTHORS for the full list). See LICENSE for more information. Gtk2-1.24992/t/GtkMenuItem.t0000644000175000017500000000703713076462677013773 0ustar lacklack#!/usr/bin/perl -w use strict; use Gtk2::TestHelper tests => 23; # $Id$ my $item = Gtk2::MenuItem -> new(); isa_ok($item, "Gtk2::MenuItem"); $item = Gtk2::MenuItem -> new("_Bla"); isa_ok($item, "Gtk2::MenuItem"); $item = Gtk2::MenuItem -> new_with_label("Bla"); isa_ok($item, "Gtk2::MenuItem"); $item = Gtk2::MenuItem -> new_with_mnemonic("Bla"); isa_ok($item, "Gtk2::MenuItem"); $item -> select(); $item -> deselect(); $item -> toggle(); $item -> activate(); $item -> set_right_justified(1); is($item -> get_right_justified(), 1); my $menu = Gtk2::Menu -> new(); $item -> set_submenu($menu); is($item -> get_submenu(), $menu); SKIP: { skip '2.12 stuff', 1 unless Gtk2 -> CHECK_VERSION(2, 12, 0); $item -> set_submenu(undef); is($item -> get_submenu(), undef); } $item -> remove_submenu(); $item -> set_accel_path(""); # Ensure that both spellings of the signal name get the custom marshaller. foreach my $signal_name (qw/toggle_size_request toggle-size-request/) { my $id = $item -> signal_connect($signal_name => sub { is (shift, $item, $signal_name); is (shift, "bla", $signal_name); return 23; }, "bla"); is ($item -> toggle_size_request(), 23); $item -> signal_handler_disconnect ($id); } $item -> signal_connect(toggle_size_allocate => sub { is (shift, $item); is (shift, 23); is (shift, "bla"); }, "bla"); $item -> toggle_size_allocate(23); SKIP: { skip 'new 2.14 stuff', 1 unless Gtk2->CHECK_VERSION(2, 14, 0); my $item = Gtk2::MenuItem -> new(); $item -> set_accel_path('/bla/bla'); is ($item -> get_accel_path(), '/bla/bla'); } SKIP: { skip 'new 2.16 stuff', 2 unless Gtk2->CHECK_VERSION(2, 16, 0); my $item = Gtk2::MenuItem->new ("_foo"); $item->set_use_underline (TRUE); is ($item->get_use_underline, TRUE, '[gs]et_use_underline'); $item->set_label ('Test'); is ($item->get_label, 'Test'); } #----------------------------------------------------------------------------- # circular ref between MenuItem and child AccelLabel # # These tests verify what's described in the pod of Gtk2::MenuItem->new, # ->new_with_label and ->new_with_mnemonic, namely that circa Gtk 2.18 an # item created with a label gets a circular reference up from the child # AccelLabel "accel-widget" property and thus needs ->destroy or similar. # # If the MenuItems here are in fact destroyed by weakening then that'd be # fine for the code, but the docs would be wrong, for some or other Gtk # version. # require Scalar::Util; { my $item = Gtk2::MenuItem->new("foo"); Scalar::Util::weaken ($item); ok ($item, 'new("foo") not destroyed by weakening (correctness of the docs)'); if ($item) { $item->destroy; } } { my $item = Gtk2::MenuItem->new_with_label("foo"); Scalar::Util::weaken ($item); ok ($item, 'new_with_label("foo") not destroyed by weakening (correctness of the docs)'); if ($item) { $item->destroy; } } { my $item = Gtk2::MenuItem->new_with_mnemonic("foo"); Scalar::Util::weaken ($item); ok ($item, 'new_with_mnemonic("foo") not destroyed by weakening (correctness of the docs)'); if ($item) { $item->destroy; } } SKIP: { # "label" property new in Gtk 2.16 skip 'new 2.16 stuff', 1 unless Gtk2->CHECK_VERSION(2, 16, 0); my $item = Gtk2::MenuItem->new; $item->set (label => "foo"); Scalar::Util::weaken ($item); ok ($item, 'set(label=>"foo") not destroyed by weakening (correctness of the docs)'); if ($item) { $item->destroy; } } __END__ Copyright (C) 2003, 2010 by the gtk2-perl team (see the file AUTHORS for the full list). See LICENSE for more information. Gtk2-1.24992/t/GtkHScale.t0000644000175000017500000000065413076462677013405 0ustar lacklack#!/usr/bin/perl -w use strict; use Gtk2::TestHelper tests => 2; # $Id$ my $adjustment = Gtk2::Adjustment -> new(0, 0, 100, 1, 5, 10); my $scale = Gtk2::HScale -> new($adjustment); isa_ok($scale, "Gtk2::HScale"); $scale = Gtk2::HScale -> new_with_range(0, 100, 1); isa_ok($scale, "Gtk2::HScale"); __END__ Copyright (C) 2003 by the gtk2-perl team (see the file AUTHORS for the full list). See LICENSE for more information. Gtk2-1.24992/t/00.Gtk2.t0000644000175000017500000000610513076462676012621 0ustar lacklack#!/usr/bin/perl # # $Id$ # use strict; use warnings; ######################### # Gtk2 Tests # - rm ######################### ######################### # NOTE: this is the bootstrap test -- no Gtk2::TestHelper here! use Test::More tests => 30; BEGIN { use_ok('Gtk2') }; ######################### my @run_version = Gtk2->get_version_info; my @compile_version = Gtk2->GET_VERSION_INFO; diag 'Testing Gtk2 ', $Gtk2::VERSION; diag ' Running against gtk+ ', join '.', @run_version; diag ' Compiled against gtk+ ', join '.', @compile_version; is( @run_version, 3, 'version info is three items long' ); is (Gtk2->check_version(0,0,0), 'Gtk+ version too new (major mismatch)', 'check_version pass'); is (Gtk2->check_version(50,0,0), 'Gtk+ version too old (major mismatch)', 'check_version fail'); ok (defined (Gtk2::major_version), 'major_version'); ok (defined (Gtk2::minor_version), 'minor_version'); ok (defined (Gtk2::micro_version), 'micro_version'); is (@compile_version, 3, 'version info is three items long'); ok (Gtk2->CHECK_VERSION(0,0,0), 'CHECK_VERSION pass'); ok (!Gtk2->CHECK_VERSION(50,0,0), 'CHECK_VERSION fail'); is (Gtk2::MAJOR_VERSION, $compile_version[0], 'MAJOR_VERSION'); is (Gtk2::MINOR_VERSION, $compile_version[1], 'MINOR_VERSION'); is (Gtk2::MICRO_VERSION, $compile_version[2], 'MICRO_VERSION'); ######################### SKIP: { Gtk2->disable_setlocale; skip 'Gtk2->init_check failed, probably unable to open DISPLAY', 17, unless( Gtk2->init_check ); ok( Gtk2->init ); ok( Gtk2->set_locale ); isa_ok( Gtk2->get_default_language, "Gtk2::Pango::Language" ); is( Gtk2->main_level, 0, 'main level is zero when there are no loops' ); my $window = Gtk2::Object->new ("Gtk2::Window"); my $object = Gtk2::Object->new ("Gtk2::Label"); my $event = Gtk2::Gdk::Event->new ("button-press"); $event->button (1); $event->time (time); $event->state ([qw/shift-mask control-mask/]); Gtk2::Gdk::Event->put ($event); $window->add ($object); $object->realize; $object->propagate_event ($event); # warn Gtk2->get_current_event; # warn Gtk2->get_current_event_time; # warn Gtk2->get_current_event_state; # warn Gtk2->get_event_widget ($event); my $events = 0; my $retval; while (Gtk2->events_pending) { $retval = Gtk2->main_iteration; $events++; } ok( $events ); ok( $retval ); Gtk2::Gdk::Event->put ($event); $events = 0; while (Gtk2->events_pending) { $retval = Gtk2->main_iteration_do (0); $events++; } ok( $events ); ok( $retval ); my $snooper; ok( $snooper = Gtk2->key_snooper_install (sub { warn @_; 0; }, "bla") ); Gtk2->key_snooper_remove ($snooper); Gtk2->init_add( sub { ok(1); } ); Gtk2->init_add( sub { ok($_[0] eq 'foo'); }, 'foo' ); ok(1); Gtk2->quit_add_destroy (1, $object); my $q1; ok( $q1 = Gtk2->quit_add( 0, sub { Gtk2->quit_remove($q1); ok(1); } ) ); ok( Gtk2->quit_add( 0, sub { ok($_[0] eq 'bar'); }, 'bar' ) ); Glib::Idle->add( sub { Gtk2->main_quit; 0 } ); Gtk2->main; ok(1); } __END__ Copyright (C) 2003-2004, 2013 by the gtk2-perl team (see the file AUTHORS for the full list). See LICENSE for more information. Gtk2-1.24992/t/GtkToggleToolButton.t0000644000175000017500000000104413076462677015513 0ustar lacklack# # $Id$ # use Gtk2::TestHelper at_least_version => [2, 4, 0, "Action-based menus are new in 2.4"], tests => 4; my $button = Gtk2::ToggleToolButton->new; isa_ok ($button, 'Gtk2::ToggleToolButton'); $button = Gtk2::ToggleToolButton->new_from_stock ('gtk-ok'); isa_ok ($button, 'Gtk2::ToggleToolButton'); $button->set_active (TRUE); ok ($button->get_active); $button->set_active (FALSE); ok (!$button->get_active); __END__ Copyright (C) 2003 by the gtk2-perl team (see the file AUTHORS for the full list). See LICENSE for more information. Gtk2-1.24992/t/GtkIconTheme.t0000644000175000017500000000624313076462677014121 0ustar lacklack#!/usr/bin/perl # # $Id$ # use Gtk2::TestHelper at_least_version => [2, 4, 0, 'GtkIconTheme is new in 2.4'], tests => 17; my $icon_theme = Gtk2::IconTheme->new; isa_ok ($icon_theme, 'Gtk2::IconTheme'); $icon_theme = Gtk2::IconTheme->get_default; isa_ok ($icon_theme, 'Gtk2::IconTheme'); $icon_theme = Gtk2::IconTheme->get_for_screen (Gtk2::Gdk::Screen->get_default); isa_ok ($icon_theme, 'Gtk2::IconTheme'); $icon_theme->set_screen (Gtk2::Gdk::Screen->get_default); my @icons = $icon_theme->list_icons (undef); # @icons can be anything, even empty ok (!$icon_theme->has_icon ('something crazy')); my $icon_info = $icon_theme->lookup_icon ('stock_edit', 24, 'use-builtin'); SKIP: { skip 'lookup_icon returned undef, skipping the rest', 5 unless defined $icon_info; isa_ok ($icon_info, 'Gtk2::IconInfo'); my $pixbuf = $icon_theme->load_icon ('stock_edit', 24, 'use-builtin'); isa_ok ($pixbuf, 'Gtk2::Gdk::Pixbuf'); isa_ok ($icon_info->load_icon, 'Gtk2::Gdk::Pixbuf'); ok (defined $icon_info->get_base_size); like ($icon_info->get_filename, qr/stock_edit/); # FIXME: # isa_ok ($icon_info->get_builtin_pixbuf, 'Gtk2::Gdk::Pixbuf'); # isa_ok($icon_info->get_embedded_rect, 'Gtk2::Gdk::Rectangle'); # warn $icon_info->get_attach_points; # warn $icon_info->get_display_name; $icon_info->set_raw_coordinates (1); $icon_theme->add_builtin_icon ('stock_edit', 24, $pixbuf); } SKIP: { skip 'new 2.6 stuff', 1 unless Gtk2->CHECK_VERSION (2, 6, 0); my @sizes = $icon_theme->get_icon_sizes ('stock_edit'); skip 'get_icon_sizes returned empty, can not test them', 1 unless (@sizes); # -1 means scalable like ($sizes[0], qr/^(?:-1|\d+)$/); } SKIP: { skip 'new 2.12 stuff', 1 unless Gtk2->CHECK_VERSION (2, 12, 0); my @contexts = $icon_theme->list_contexts; # @contexts might be undef and can contain anything my $info = $icon_theme->choose_icon (['gtk-bla', 'gtk-cancel'], 24, 'use-builtin'); isa_ok ($info, 'Gtk2::IconInfo'); } my @paths = qw(/tmp /etc /home); $icon_theme->set_search_path (@paths); is_deeply ([$icon_theme->get_search_path], \@paths); $icon_theme->append_search_path ('/usr/local/tmp'); push @paths, '/usr/local/tmp'; is_deeply ([$icon_theme->get_search_path], \@paths); $icon_theme->prepend_search_path ('/usr/tmp'); unshift @paths, '/usr/tmp'; is_deeply ([$icon_theme->get_search_path], \@paths); # cannot call set_custom_theme on a default theme $icon_theme = Gtk2::IconTheme->new; $icon_theme->set_custom_theme ('crazy custom theme'); $icon_theme->set_custom_theme (undef); # Ignore result. Might be anything, including undef. $icon_theme->get_example_icon_name; ok (!$icon_theme->rescan_if_needed); SKIP: { skip 'new 2.14 stuff', 2 unless Gtk2->CHECK_VERSION(2, 14, 0); skip 'unable to find the stock_edit icon', 2 unless defined $icon_theme->lookup_icon ('stock_edit', 24, 'use-builtin'); my $pixbuf = $icon_theme->load_icon ('stock_edit', 24, 'use-builtin'); isa_ok (Gtk2::IconInfo->new_for_pixbuf ($icon_theme, $pixbuf), 'Gtk2::IconInfo'); like ($icon_info->get_filename (), qr/stock_edit/);; } __END__ Copyright (C) 2003-2005 by the gtk2-perl team (see the file AUTHORS for the full list). See LICENSE for more information. Gtk2-1.24992/t/GtkRecentChooserMenu.t0000644000175000017500000000164713076462677015641 0ustar lacklack#!/usr/bin/perl -w use strict; sub on_unthreaded_freebsd { if ($^O eq 'freebsd') { require Config; if ($Config::Config{ldflags} !~ m/-pthread\b/) { return 1; } } return 0; } use Gtk2::TestHelper tests => 5, at_least_version => [2, 10, 0, "GtkRecentChooserMenu"], (on_unthreaded_freebsd () ? (skip_all => 'need a perl compiled with "-pthread" on freebsd') : ()); # $Id$ my $manager = Gtk2::RecentManager -> new(); my $chooser = Gtk2::RecentChooserMenu -> new(); isa_ok($chooser, "Gtk2::RecentChooser"); isa_ok($chooser, "Gtk2::RecentChooserMenu"); $chooser = Gtk2::RecentChooserMenu -> new_for_manager($manager); isa_ok($chooser, "Gtk2::RecentChooser"); isa_ok($chooser, "Gtk2::RecentChooserMenu"); $chooser -> set_show_numbers(TRUE); ok($chooser -> get_show_numbers()); __END__ Copyright (C) 2006 by the gtk2-perl team (see the file AUTHORS for the full list). See LICENSE for more information. Gtk2-1.24992/t/GtkCellRendererIface-Chaining.t0000644000175000017500000000466113076462676017263 0ustar lacklack#!/usr/bin/perl # $Id$ use Gtk2::TestHelper tests => 3; # --------------------------------------------------------------------------- # package CellRendererFoo; use Glib::Object::Subclass Gtk2::CellRendererText::, ; our $hits = 0; sub GET_SIZE { #warn __PACKAGE__; $hits++; if ($hits > 50) { die 'Overflow'; } shift->SUPER::GET_SIZE (@_); } package CellRendererBar; use Glib::Object::Subclass CellRendererFoo::, ; our $hits = 0; sub GET_SIZE { #warn __PACKAGE__; $hits++; shift->SUPER::GET_SIZE (@_); } # --------------------------------------------------------------------------- # package CellRendererEmpty; use Glib::Object::Subclass Gtk2::CellRendererText::, ; package ProxyDialog; use Glib::Object::Subclass Gtk2::Dialog:: ; sub INIT_INSTANCE { my ($self) = @_; my $vbox = $self->vbox; my $model = Gtk2::ListStore->new ('Glib::String'); foreach (qw/foo fluffy flurble frob frobnitz ftang fire/) { my $iter = $model->append; $model->set ($iter, 0 => $_); } my $view = Gtk2::TreeView->new ($model); $vbox->add ($view); my $renderer = CellRendererEmpty->new; my $column = Gtk2::TreeViewColumn->new_with_attributes ('F-Words', $renderer, text => 0); $view->append_column ($column); # This eventually results in a call to CellRendererEmpty::GET_SIZE. $self->show_all; } # --------------------------------------------------------------------------- # package main; # Test that Perl renderers can chain up without endless loops ensuing. Even if # a Perl renderer inherits from a Perl renderer. { my $model = Gtk2::ListStore->new ('Glib::String'); foreach (qw/foo fluffy flurble frob frobnitz ftang fire/) { my $iter = $model->append; $model->set ($iter, 0 => $_); } my $view = Gtk2::TreeView->new ($model); my $renderer = CellRendererBar->new; my $column = Gtk2::TreeViewColumn->new_with_attributes ('F-Words', $renderer, text => 0); $view->append_column ($column); my $window = Gtk2::Window->new; $window->add ($view); ok (eval { $window->show_all; 1; }, 'no overflow'); ok ($CellRendererFoo::hits == $CellRendererBar::hits, 'both classes were hit just as often'); } # Test that calls to vfuncs from strange places (like # ProxyDialog::INIT_INSTANCE) don't confuse the fallback functions in # Gtk2::CellRenderer. { ok (eval { my $dialog = ProxyDialog->new; 1; }, 'no exception'); } Gtk2-1.24992/t/GtkCellLayout.t0000644000175000017500000000323213076462676014315 0ustar lacklack#!/usr/bin/perl -w use strict; use Gtk2::TestHelper at_least_version => [2, 4, 0, "GtkCellLayout is new in 2.4"], tests => 5; # $Id$ my $column = Gtk2::TreeViewColumn -> new(); isa_ok($column, "Gtk2::CellLayout"); my $box = Gtk2::ComboBox -> new(); isa_ok($box, "Gtk2::CellLayout"); my $entry = Gtk2::ComboBoxEntry -> new(); isa_ok($entry, "Gtk2::CellLayout"); # make sure there is a model; early versions of 2.4.x do not check for NULL # before unreffing the model. my $model = Gtk2::ListStore->new ('Glib::Int'); $box->set_model ($model); $entry->set_model ($model); my $completion = Gtk2::EntryCompletion -> new(); isa_ok($completion, "Gtk2::CellLayout"); my $renderer = Gtk2::CellRendererText -> new(); $completion -> pack_start($renderer, 0); $completion -> clear(); $completion -> pack_end($renderer, 1); $completion -> set_attributes($renderer, stock_id => 0); $completion -> set_attributes($renderer); # like calling clear $completion -> add_attribute($renderer, activatable => 1); $completion -> clear_attributes($renderer); $completion -> set_cell_data_func($renderer, sub { warn @_; }, 23); $completion -> set_cell_data_func($renderer, undef); SKIP: { skip "2.12 stuff", 1 unless Gtk2 -> CHECK_VERSION (2, 12, 0); # GtkEntryCompletion doesn't seem to implement get_cells yet, so we use the # GtkTreeViewColumn. my $one = Gtk2::CellRendererText -> new(); my $two = Gtk2::CellRendererText -> new(); $column -> pack_start($one, 0); $column -> pack_start($two, 1); is_deeply([$column -> get_cells()], [$one, $two]); } __END__ Copyright (C) 2003 by the gtk2-perl team (see the file AUTHORS for the full list). See LICENSE for more information. Gtk2-1.24992/t/GtkDrawingArea.t0000644000175000017500000000044113076462676014423 0ustar lacklack#!/usr/bin/perl -w use strict; use Gtk2::TestHelper tests => 1, noinit => 1; # $Id$ my $area = Gtk2::DrawingArea -> new(); isa_ok($area, "Gtk2::DrawingArea"); __END__ Copyright (C) 2003 by the gtk2-perl team (see the file AUTHORS for the full list). See LICENSE for more information. Gtk2-1.24992/t/GtkBin.t0000644000175000017500000000061613076462676012753 0ustar lacklack#!/usr/bin/perl -w use strict; use Gtk2::TestHelper tests => 2; # $Id$ my $container = Gtk2::Container -> new(Gtk2::Window::); my $label = Gtk2::Label -> new("Bla"); $container -> add($label); is($container -> get_child(), $label); is($container -> child(), $label); __END__ Copyright (C) 2003 by the gtk2-perl team (see the file AUTHORS for the full list). See LICENSE for more information. Gtk2-1.24992/t/GtkTextIter.t0000644000175000017500000001317013076462677014013 0ustar lacklack#!/usr/bin/perl -w use strict; use Gtk2::TestHelper tests => 93, noinit => 1; # $Id$ my $model = Gtk2::TextBuffer->new; my $tag = $model->create_tag ("indent", indent => 5); $model->insert_with_tags ( $model->get_start_iter, join " ", "Lore ipsem dolor. I think that is misspelled.\n" x 80, $tag); my $iter = $model->get_iter_at_offset (10); isa_ok ($iter, "Gtk2::TextIter"); is ($iter->get_buffer, $model); is ($iter->get_char, ' '); $iter->set_line (0); is ($iter->get_line, 0); $iter->set_line_offset (10); is ($iter->get_line_offset, 10); $iter->set_line_index (10); is ($iter->get_line_index, 10); # prior to 2.4.8, these two functions were broken and did not work as # advertised. see bug #150101 for details. unfortunately, this test relied on # the wrong behavior. lesson learned: don't test for broken results, but use # SKIP or TODO instead. $iter->set_visible_line_index (10); $iter->set_visible_line_offset (10); if (not defined Gtk2->check_version(2, 4, 8)) { is ($iter->get_visible_line_index, 10); is ($iter->get_visible_line_offset, 10); } else { is ($iter->get_visible_line_index, 30); is ($iter->get_visible_line_offset, 30); } $iter->set_offset (10); is ($iter->get_offset, 10); my ($right, $left) = ($model->get_iter_at_offset (9), $model->get_iter_at_offset (11)); $left->order ($right); is ($iter->in_range ($left, $right), 1); my $mark_one = $model->create_mark ("bla", $iter, 1); my $mark_two = $model->create_mark ("blub", $iter, 1); is_deeply ([$iter->get_marks], [$mark_one, $mark_two]); ok (!$iter->begins_tag ($tag)); ok (!$iter->ends_tag ($tag)); ok (!$iter->toggles_tag ($tag)); ok (!$iter->get_toggled_tags(0)); ok (!$iter->get_toggled_tags(1)); ok (!$iter->get_child_anchor); ok (!$iter->has_tag ($tag)); ok (!$iter->get_tags); ok (!$iter->get_pixbuf); ok (!$iter->get_attributes); isa_ok ($iter->get_language, "Gtk2::Pango::Language"); is ($iter->editable (1), 1); is ($iter->can_insert (1), 1); ok (!$iter->starts_word); ok ($iter->ends_word); ok (!$iter->inside_word); ok (!$iter->starts_line); ok (!$iter->ends_line); ok (!$iter->starts_sentence); ok (!$iter->ends_sentence); ok ($iter->inside_sentence); ok ($iter->is_cursor_position); is ($iter->get_chars_in_line, 47); is ($iter->get_bytes_in_line, 47); my $end = $iter->copy; $end->forward_find_char (sub { return 1 if $_[0] eq 'r'; }, undef, undef); my $text = $iter->get_text ($end); is ($text, ' dolo', 'search forward'); is ($iter->get_offset, 10, 'from'); is ($end->get_offset, 15, 'to'); my $begin = $end->copy; $begin->backward_find_char (sub {return 1 if $_[0] eq 'L'; }); $text = $begin->get_text ($end); is ($text, 'Lore ipsem dolo', 'search backward'); is ($begin->get_offset, 0, 'from'); is ($end->get_offset, 15, 'to'); my ($match_start, $match_end) = $iter->forward_search ('that', 'text-only'); isa_ok ($match_start, 'Gtk2::TextIter', 'match start'); isa_ok ($match_end, 'Gtk2::TextIter', 'match end'); if ($match_start) { foreach ($match_start->get_text ($match_end), $match_start->get_slice ($match_end), $match_start->get_visible_text ($match_end), $match_start->get_visible_slice ($match_end)) { is ($_, 'that', 'found string match forward'); } } else { ok (0, 'found string match forward'); ok (0, 'found string match forward'); ok (0, 'found string match forward'); ok (0, 'found string match forward'); } is ($match_start->get_offset, 27, 'match start offset'); is ($match_end->get_offset, 31, 'match end offset'); ($match_start, $match_end) = $model->get_end_iter->backward_search ('Lore', 'text-only'); isa_ok ($match_start, 'Gtk2::TextIter', 'match start'); isa_ok ($match_end, 'Gtk2::TextIter', 'match end'); $text = $match_start ? $match_start->get_text ($match_end) : undef; is ($text, 'Lore', 'found string match backward'); is ($match_start->get_offset, 3713, 'match start offset'); is ($match_end->get_offset, 3717, 'match end offset'); ok ($iter->forward_char); ok ($iter->backward_char); ok ($iter->forward_chars (5)); ok ($iter->backward_chars (5)); ok ($iter->forward_line); ok ($iter->backward_line); ok ($iter->forward_lines (5)); ok ($iter->backward_lines (5)); ok ($iter->forward_word_end); ok ($iter->backward_word_start); ok ($iter->forward_word_ends (5)); ok ($iter->backward_word_starts (5)); ok ($iter->forward_sentence_end); ok ($iter->backward_sentence_start); ok ($iter->forward_sentence_ends (5)); ok ($iter->backward_sentence_starts (5)); ok ($iter->forward_cursor_position); ok ($iter->backward_cursor_position); ok ($iter->forward_cursor_positions (5)); ok ($iter->backward_cursor_positions (5)); SKIP: { skip "stuff new in 2.4", 8 unless Gtk2->CHECK_VERSION (2, 4, 0); ok ($iter->forward_visible_word_ends (1)); ok ($iter->backward_visible_word_starts (1)); ok ($iter->forward_visible_word_end); ok ($iter->backward_visible_word_start); ok ($iter->forward_visible_cursor_position); ok ($iter->backward_visible_cursor_position); ok ($iter->forward_visible_cursor_positions (1)); ok ($iter->backward_visible_cursor_positions (1)); } SKIP: { skip("new 2.8 stuff", 4) unless Gtk2->CHECK_VERSION (2, 8, 0); ok ($iter->forward_visible_line); ok ($iter->backward_visible_line); ok ($iter->forward_visible_lines (2)); ok ($iter->backward_visible_lines (2)); } $iter->forward_to_end; is ($iter->is_end, 1); ok (!$iter->forward_to_line_end); ok (!$iter->is_start); is ($iter->equal ($iter), 1); is ($iter->compare ($iter), 0); ok (!$iter->forward_to_tag_toggle ($tag)); ok (!$iter->backward_to_tag_toggle ($tag)); __END__ Copyright (C) 2003-2005 by the gtk2-perl team (see the file AUTHORS for the full list). See LICENSE for more information. Gtk2-1.24992/t/GdkPixbuf.t0000644000175000017500000003647313076462676013472 0ustar lacklack#!/usr/bin/env perl use strict; use warnings; use Gtk2::TestHelper tests => 112, noinit => 1; my $show = 0; use File::Temp qw(tempdir); my $dir = tempdir(CLEANUP => 1); my $gif = 'gtk-demo/floppybuddy.gif'; SKIP: { skip 'animation not found', 12 unless -r $gif; my $ani = Gtk2::Gdk::PixbufAnimation -> new_from_file($gif); isa_ok ($ani, 'Gtk2::Gdk::PixbufAnimation'); like ($ani->get_width, qr/^\d+$/); like ($ani->get_height, qr/^\d+$/); my $iter = $ani->get_iter; isa_ok ($iter, 'Gtk2::Gdk::PixbufAnimationIter'); $iter = $ani->get_iter (0, 0); isa_ok ($iter, 'Gtk2::Gdk::PixbufAnimationIter'); ok (!$ani->is_static_image); isa_ok($ani->get_static_image, 'Gtk2::Gdk::Pixbuf'); # The next two seem to return TRUE on m68k but FALSE everywhere else, so # just test for definedness. # http://buildd.debian.org/fetch.php?&pkg=libgtk2-perl&ver=1%3A1.121-1&arch=m68k&stamp=1151330512&file=log&as=raw ok (defined $iter->advance); ok (defined $iter->advance (0, 0)); like ($iter->get_delay_time, qr/^\d+$/); ok (!$iter->on_currently_loading_frame); isa_ok ($iter->get_pixbuf, 'Gtk2::Gdk::Pixbuf'); } eval { Gtk2::Gdk::PixbufAnimation -> new_from_file("aslkhaklh.gif"); }; isa_ok ($@, "Glib::File::Error"); my ($pixbuf, $pixels); $pixbuf = Gtk2::Gdk::Pixbuf->new ('rgb', TRUE, 8, 61, 33); isa_ok ($pixbuf, 'Gtk2::Gdk::Pixbuf', 'new with alpha'); is ($pixbuf->get_colorspace, 'rgb'); is ($pixbuf->get_n_channels, 4); ok ($pixbuf->get_has_alpha); is ($pixbuf->get_bits_per_sample, 8); is ($pixbuf->get_width, 61); is ($pixbuf->get_height, 33); is ($pixbuf->get_rowstride, 244); $pixels = $pixbuf->get_pixels; ok ($pixels); is (length($pixels), 8052); $pixbuf = Gtk2::Gdk::Pixbuf->new ('rgb', FALSE, 8, 33, 61); isa_ok ($pixbuf, 'Gtk2::Gdk::Pixbuf', 'new without alpha'); is ($pixbuf->get_colorspace, 'rgb'); is ($pixbuf->get_n_channels, 3); ok (!$pixbuf->get_has_alpha); is ($pixbuf->get_bits_per_sample, 8); is ($pixbuf->get_width, 33); is ($pixbuf->get_height, 61); is ($pixbuf->get_rowstride, 100); # 100 is aligned, 99 is actual $pixels = $pixbuf->get_pixels; ok ($pixels); # last row is not padded to the rowstride, hence 6099 not 6100 is (length($pixels), 6099); isa_ok ($pixbuf->copy, 'Gtk2::Gdk::Pixbuf', 'copy'); my $subpixbuf = $pixbuf->new_subpixbuf (10, 5, 7, 14); isa_ok ($subpixbuf, 'Gtk2::Gdk::Pixbuf', 'new_subpixbuf'); # probably more validation of gdk-pixbuf's stuff, but it makes me happy # to verify invariants like this. is ($subpixbuf->get_width, 7); is ($subpixbuf->get_height, 14); is ($subpixbuf->get_rowstride, $pixbuf->get_rowstride); my ($win, $vbox); if ($show) { $win = Gtk2::Window->new; $vbox = Gtk2::VBox->new; $win->add ($vbox); } my @test_xpm = ( '4 5 3 1', ' c None', '. c red', '+ c blue', '.. +', '. ++', ' ++.', '++..', '+.. '); $pixbuf = Gtk2::Gdk::Pixbuf->new_from_xpm_data (@test_xpm); isa_ok ($pixbuf, 'Gtk2::Gdk::Pixbuf', 'new_from_xpm_data'); is ($pixbuf->get_width, 4); is ($pixbuf->get_height, 5); ok ($pixbuf->get_has_alpha); $vbox->add (Gtk2::Image->new_from_pixbuf ($pixbuf)) if $show; # # Don't crash if we get partial data. Eat the any warnings from GdkPixbuf # to avoid scary messages on stderr from the test suite. # my $log = Glib::Log->set_handler ('GdkPixbuf', ['warning'], sub {print "@_\n"}); $pixbuf = Gtk2::Gdk::Pixbuf->new_from_xpm_data (@test_xpm[0..2]); ok (! defined ($pixbuf), "Don't crash on broken pixmap data"); $pixbuf = Gtk2::Gdk::Pixbuf->new_from_xpm_data (@test_xpm[0..5]); ok (defined $pixbuf, "Don't crash on partial pixmap data"); Glib::Log->remove_handler ('GdkPixbuf', $log); # raw pixel values to make the xpm above my $rawdata = pack 'C*', 255,0,0,255, 255,0,0,255, 0,0,0,0, 0,0,255,255, 255,0,0,255, 0,0,0,0, 0,0,255,255, 0,0,255,255, 0,0,0,0, 0,0,255,255, 0,0,255,255, 255,0,0,255, 0,0,255,255, 0,0,255,255, 255,0,0,255, 255,0,0,255, 0,0,255,255, 255,0,0,255, 255,0,0,255, 0,0,0,0, ; $pixbuf = Gtk2::Gdk::Pixbuf->new_from_data ($rawdata, 'rgb', TRUE, 8, 4, 5, 16); isa_ok ($pixbuf, 'Gtk2::Gdk::Pixbuf', 'new_from_data'); is ($pixbuf->get_colorspace, 'rgb'); ok ($pixbuf->get_has_alpha); is ($pixbuf->get_width, 4); is ($pixbuf->get_height, 5); is ($pixbuf->get_rowstride, 16); $vbox->add (Gtk2::Image->new_from_pixbuf ($pixbuf)) if $show; { { package MyOverloaded; use overload '""' => \&stringize; sub new { my ($class) = @_; my $str = "not this value"; return bless \$str, $class; } sub stringize { my ($self) = @_; return "\x01\x02\x03"; } } my $overloaded = MyOverloaded->new; $pixbuf = Gtk2::Gdk::Pixbuf->new_from_data ($overloaded, 'rgb', 0, # alpha 8, # bits 1,1, # width,height 3); # rowstride is ($pixbuf->get_pixels, "\x01\x02\x03"); $vbox->add (Gtk2::Image->new_from_pixbuf ($pixbuf)) if $show; } # inlined data from gdk-pixbuf-csource, run on the xpm from above my $inlinedata = "GdkP" # Pixbuf magic (0x47646b50) . "\0\0\0[" # length: header (24) + pixel_data (67) . "\2\1\0\2" # pixdata_type (0x2010002) . "\0\0\0\20" # rowstride (16) . "\0\0\0\4" # width (4) . "\0\0\0\5" # height (5) # pixel_data: . "\202\377\0\0\377\4\0\0\0\0\0\0\377\377\377\0\0\377\0\0\0\0\202\0\0\377" . "\377\1\0\0\0\0\202\0\0\377\377\1\377\0\0\377\202\0\0\377\377\202\377" . "\0\0\377\1\0\0\377\377\202\377\0\0\377\1\0\0\0\0"; $pixbuf = Gtk2::Gdk::Pixbuf->new_from_inline ($inlinedata, TRUE); isa_ok ($pixbuf, 'Gtk2::Gdk::Pixbuf', 'new_from_inline'); is ($pixbuf->get_colorspace, 'rgb'); ok ($pixbuf->get_has_alpha); is ($pixbuf->get_width, 4); is ($pixbuf->get_height, 5); is ($pixbuf->get_rowstride, 16); $vbox->add (Gtk2::Image->new_from_pixbuf ($pixbuf)) if $show; # # these functions can throw Gtk2::Gdk::Pixbuf::Error and Glib::File::Error # exceptions. # my $filename = "$dir/testsave1.jpg"; $pixbuf->save ($filename, 'jpeg', quality => 75.0); ok (1); $pixbuf = Gtk2::Gdk::Pixbuf->new_from_file ($filename); isa_ok ($pixbuf, 'Gtk2::Gdk::Pixbuf', 'new_from_file'); SKIP: { skip "new_from_file_at_size is new in 2.4", 3 unless Gtk2->CHECK_VERSION(2,4,0); $pixbuf = Gtk2::Gdk::Pixbuf->new_from_file_at_size ($filename, 20, 25); isa_ok ($pixbuf, 'Gtk2::Gdk::Pixbuf', 'new_from_file_at_size'); is ($pixbuf->get_width, 20); is ($pixbuf->get_height, 25); } SKIP: { skip "new_from_file_at_scale is new in 2.6", 3 unless Gtk2->CHECK_VERSION(2,6,0); $pixbuf = Gtk2::Gdk::Pixbuf->new_from_file_at_scale ($filename, 20, 25, FALSE); isa_ok ($pixbuf, 'Gtk2::Gdk::Pixbuf', 'new_from_file_at_scale'); is ($pixbuf->get_width, 20); is ($pixbuf->get_height, 25); } SKIP: { skip "new stuff", 3 unless Gtk2->CHECK_VERSION (2,6,0); my ($format, $width, $height) = Gtk2::Gdk::Pixbuf->get_file_info ($filename); isa_ok ($format, "Gtk2::Gdk::PixbufFormat"); is ($width, 4); is ($height, 5); } $filename = "$dir/testsaves.png"; eval { $pixbuf->save ($filename, 'png', 'key_arg_without_value_arg'); }; like ($@, qr/odd number of arguments detected/); my $mtime = scalar localtime; my $desc = 'Something really cool'; $pixbuf->save ($filename, 'png', 'tEXt::Thumb::MTime' => $mtime, 'tEXt::Description' => $desc, # # latin1 bytes upgraded to utf8 in the xsub # # Crib note: if there's no upgrade in the xsub then one of # two bad things happen: if libpng was built without iTXt # support then gdk-pixbuf gives a GError because the bytes # are not valid utf8; or if libpng does have iTXt then # gdk-pixbuf drops the bytes straight in an iTXt in the file, # leaving invalid utf8 there. # 'tEXt::Title' => "z \x{B1} .5"); ok (1); $pixbuf = Gtk2::Gdk::Pixbuf->new_from_file ($filename); isa_ok ($pixbuf, 'Gtk2::Gdk::Pixbuf', 'new_from_file'); is ($pixbuf->get_option ('tEXt::Description'), $desc, 'get_option works'); is ($pixbuf->get_option ('tEXt::Thumb::MTime'), $mtime, 'get_option works'); ok (! $pixbuf->get_option ('tEXt::noneXIStenTTag'), 'get_option returns undef if the key is not found'); { my $got = $pixbuf->get_option ('tEXt::Title'); my $want = "z \x{B1} .5"; utf8::upgrade ($want); is ($got, $want, 'get_option tEXt::Title'); SKIP: { utf8->can('is_utf8') or skip 'utf8::is_utf8() not available (perl 5.8.0)', 1; ok (utf8::is_utf8($got), 'get_option tEXt::Title is_utf8()'); } } SKIP: { skip 'new 2.2 stuff', 3 unless Gtk2->CHECK_VERSION(2, 2, 0); ok (! $pixbuf->set_option ('tEXt::Description', reverse $desc), 'set_option refuses to overwrite'); ok ($pixbuf->set_option ('tEXt::woot', 'whee')); is ($pixbuf->get_option ('tEXt::woot'), 'whee'); } # raw pixel values to make the xpm above, but with green for the # transparent pixels, so we can use add_alpha. $rawdata = pack 'C*', 255,0,0, 255,0,0, 0,255,0, 0,0,255, 255,0,0, 0,255,0, 0,0,255, 0,0,255, 0,255,0, 0,0,255, 0,0,255, 255,0,0, 0,0,255, 0,0,255, 255,0,0, 255,0,0, 0,0,255, 255,0,0, 255,0,0, 0,255,0, ; $pixbuf = Gtk2::Gdk::Pixbuf->new_from_data ($rawdata, 'rgb', FALSE, 8, 4, 5, 12); isa_ok ($pixbuf, 'Gtk2::Gdk::Pixbuf', 'new_from_data'); ok (!$pixbuf->get_has_alpha); is ($pixbuf->get_rowstride, 12); $vbox->add (Gtk2::Image->new_from_pixbuf ($pixbuf)) if $show; my $pixbuf2 = $pixbuf->add_alpha (TRUE, 0, 255, 0); isa_ok ($pixbuf2, 'Gtk2::Gdk::Pixbuf', 'add_alpha'); ok ($pixbuf2->get_has_alpha); $vbox->add (Gtk2::Image->new_from_pixbuf ($pixbuf2)) if $show; $pixbuf->copy_area (2, 3, $pixbuf2->get_width - 2, $pixbuf2->get_height - 3, $pixbuf2, 0, 2); $pixbuf2->saturate_and_pixelate ($pixbuf2, 0.75, FALSE); sub pack_rgba { use integer; return (($_[0] << 0) | ($_[1] << 8) | ($_[2] << 16) | ($_[3] << 24)); } $pixbuf->fill (pack_rgba (255, 127, 96, 196)); SKIP: { skip "new 2.6 stuff", 2 unless Gtk2->CHECK_VERSION (2, 6, 0); isa_ok ($pixbuf->flip (TRUE), "Gtk2::Gdk::Pixbuf"); isa_ok ($pixbuf->rotate_simple ("clockwise"), "Gtk2::Gdk::Pixbuf"); } $pixbuf = Gtk2::Gdk::Pixbuf->new ('rgb', TRUE, 8, 32, 32); $pixbuf2->scale ($pixbuf, 0, 0, 10, 15, 1, 2, 1.2, 3.5, 'bilinear'); $pixbuf2->composite ($pixbuf, # dest 10, 5, # dest x & y 4, 5, # dest width & height 0, 0, # offsets 2.0, 4.0, # x & y scale factors 'nearest', # interp type 0.4); # overall alpha $pixbuf2->composite_color ($pixbuf, # dest 10, 5, # dest x & y 4, 5, # dest width & height 0, 0, # offsets 2.0, 4.0, # x & y scale factors 'nearest', # interp type 0.4, # overall alpha 3, 4, # check x & y 5, # check size pack_rgba (75, 75, 75, 255), # color 1 pack_rgba (192, 192, 192, 255)); # color 2 $pixbuf = $pixbuf2->scale_simple (24, 25, 'tiles'); isa_ok ($pixbuf, 'Gtk2::Gdk::Pixbuf', 'scale_simple'); $pixbuf = $pixbuf2->composite_color_simple (24, 25, 'hyper', 0.4, 5, # check size pack_rgba (75, 75, 75, 255), # color 1 pack_rgba (192, 192, 192, 255)); # color 2 isa_ok ($pixbuf, 'Gtk2::Gdk::Pixbuf', 'composite_color_simple'); SKIP: { skip "GdkPixbufFormat stuff is new in 2.2.0", 14 unless Gtk2->CHECK_VERSION (2,2,0); my @formats = Gtk2::Gdk::Pixbuf->get_formats; ok (scalar (@formats), "got a list back"); is (ref $formats[0], 'Gtk2::Gdk::PixbufFormat', "list of formats"); ok (exists $formats[0]{name}, "contains key 'name'"); ok (exists $formats[0]{description}, "contains key 'description'"); ok (exists $formats[0]{mime_types}, "contains key 'mime_types'"); is (ref $formats[0]{mime_types}, 'ARRAY', "'mime_types' is a list"); ok (exists $formats[0]{extensions}, "contains key 'extensions'"); is (ref $formats[0]{extensions}, 'ARRAY', "'extensions' is a list"); ok (exists $formats[0]{is_writable}, "contains key 'is_writable'"); ok ($formats[0]{is_writable} == 0 || $formats[0]{is_writable} == 1, "'is_writable' is 0 or 1"); SKIP: { skip "new format stuff", 4 unless Gtk2->CHECK_VERSION (2,6,0); ok (exists $formats[0]{is_scalable}); ok (exists $formats[0]{is_disabled}); ok (exists $formats[0]{license}); $formats[0]->set_disabled (TRUE); @formats = Gtk2::Gdk::Pixbuf->get_formats; is ($formats[0]->{is_disabled}, TRUE); } } if ($show) { $win->show_all; $win->signal_connect (delete_event => sub {Gtk2->main_quit}); Gtk2->main; } SKIP: { skip "can't test display-related stuff without a display", 7 unless Gtk2->init_check; my $window = Gtk2::Gdk::Window->new (undef, { width => 100, height => 50, wclass => 'output', window_type => 'toplevel', }); my $pixmap = Gtk2::Gdk::Pixmap->new ($window, 100, 50, -1); my $bitmap = Gtk2::Gdk::Pixmap->new ($window, 100, 50, 1); my $gc = Gtk2::Gdk::GC->new ($pixmap); $pixbuf = Gtk2::Gdk::Pixbuf->new ('rgb', FALSE, 8, 100, 50); $pixbuf->render_threshold_alpha ($bitmap, 0, 0, 0, 0, $bitmap->get_size, 0.75); $pixbuf->render_to_drawable ($pixmap, $gc, 0, 0, 50, 20, $pixmap->get_size, 'normal', 1, 3); $pixbuf->render_to_drawable_alpha ($pixmap, 0, 0, 0, 0, $pixmap->get_size, 'bilevel', 0.75, 'normal', 1, 0); my $colormap = $pixmap->get_colormap; $pixbuf = $pixbuf->add_alpha (FALSE, 0, 0, 0); ($pixmap, $bitmap) = $pixbuf->render_pixmap_and_mask_for_colormap ($colormap, 0.75); isa_ok ($pixmap, 'Gtk2::Gdk::Pixmap'); isa_ok ($bitmap, 'Gtk2::Gdk::Bitmap'); # context sensitive, make sure we get the right thing back $pixmap = $pixbuf->render_pixmap_and_mask_for_colormap ($colormap, 0.75); isa_ok ($pixmap, 'Gtk2::Gdk::Pixmap'); ($pixmap, $bitmap) = $pixbuf->render_pixmap_and_mask (0.75); isa_ok ($pixmap, 'Gtk2::Gdk::Pixmap'); isa_ok ($bitmap, 'Gtk2::Gdk::Bitmap'); # context sensitive, make sure we get the right thing back $pixmap = $pixbuf->render_pixmap_and_mask (0.75); isa_ok ($pixmap, 'Gtk2::Gdk::Pixmap'); ## FIXME create a GdkImage somehow #$pixbuf = Gtk2::Gdk::Pixbuf->get_from_image ($src, $cmap, $src_x, $src_y, $dest_x, $dest_y, $width, $height) #$pixbuf = $pixbuf->get_from_image ($src, $cmap, $src_x, $src_y, $dest_x, $dest_y, $width, $height) $pixbuf = Gtk2::Gdk::Pixbuf->get_from_drawable ($pixmap, undef, 0, 0, 0, 0, $pixmap->get_size); isa_ok ($pixbuf, 'Gtk2::Gdk::Pixbuf', 'get_from_drawable'); $pixbuf->get_from_drawable ($pixmap, undef, 0, 0, 0, 0, $pixmap->get_size); } SKIP: { skip "save_to_buffer was introduced in 2.4", 3 unless Gtk2->CHECK_VERSION (2, 4, 0); my ($width, $height) = (45, 89); my $data = pack "C*", map { int rand 255 } 0..(3*$width*$height); my $pixbuf = Gtk2::Gdk::Pixbuf->new_from_data ($data, 'rgb', FALSE, 8, $width, $height, $width*3); my $buffer = eval { $pixbuf->save_to_buffer ('jpeg', quality => 0.75); } || eval { $pixbuf->save_to_buffer ('png'); # fallback if jpeg not supported }; ok ($buffer, 'save_to_buffer'); my $loader = Gtk2::Gdk::PixbufLoader->new; $loader->write ($buffer); $loader->close; $pixbuf = $loader->get_pixbuf; is ($pixbuf->get_width, $width); is ($pixbuf->get_height, $height); } SKIP: { skip 'new 2.12 stuff', 0 unless Gtk2->CHECK_VERSION (2, 12, 0); $pixbuf->apply_embedded_orientation; } # vim: set ft=perl : Gtk2-1.24992/t/GtkGC.t0000644000175000017500000000271413076462677012536 0ustar lacklack#!/usr/bin/perl -w # vim: set filetype=perl : use strict; use Gtk2::TestHelper tests => 3; use Scalar::Util; # $Id$ my $black = Gtk2::Gdk::Color -> new(0, 0, 0); my $colormap = Gtk2::Gdk::Colormap -> get_system(); my $values = { foreground => $black, background => $black, function => "copy", fill => "tiled", subwindow_mode => "clip-by-children", ts_x_origin => 0, ts_y_origin => 0, clip_x_origin => 0, clip_y_origin => 0, graphics_exposures => 1, line_width => 5, line_style => "solid", cap_style => "butt", join_style => "round" }; my $gc = Gtk2::GC -> get(16, $colormap, $values); isa_ok($gc, "Gtk2::Gdk::GC"); isa_ok($gc, "Gtk2::GC"); Gtk2::GC -> release($gc); # regression tests for the automatic releasing of GCs my ($save, $weak_ref); { my $one = Gtk2::GC -> get(16, $colormap, $values); Gtk2::GC -> get(16, $colormap, $values); Gtk2::GC -> get(16, $colormap, $values); Gtk2::GC -> release($one); Gtk2::GC -> release($one); Gtk2::GC -> release($one); $one = undef; my $two = Gtk2::GC -> get(32, $colormap, $values); Gtk2::GC -> get(32, $colormap, $values); { my $three = Gtk2::GC -> get(32, $colormap, $values); } $save = Gtk2::GC -> get(32, $colormap, $values); Gtk2::GC -> get(32, $colormap, $values); Scalar::Util::weaken ($weak_ref = $two); } $save = undef; is ($weak_ref, undef); __END__ Copyright (C) 2003 by the gtk2-perl team (see the file AUTHORS for the full list). See LICENSE for more information. Gtk2-1.24992/t/GtkSeparatorMenuItem.t0000644000175000017500000000045513076462677015651 0ustar lacklack#!/usr/bin/perl -w use strict; use Gtk2::TestHelper tests => 1, noinit => 1; # $Id$ my $item = Gtk2::SeparatorMenuItem -> new(); isa_ok($item, "Gtk2::SeparatorMenuItem"); __END__ Copyright (C) 2003 by the gtk2-perl team (see the file AUTHORS for the full list). See LICENSE for more information. Gtk2-1.24992/t/GdkEvent.t0000644000175000017500000003361413076462676013310 0ustar lacklack# vim: set filetype=perl : # # $Id$ # ######################### # GdkEvent Tests # - rm ######################### use Gtk2::TestHelper tests => 123; use Data::Dumper; # Expose ####################################################################### isa_ok (my $event = Gtk2::Gdk::Event->new ('expose'), 'Gtk2::Gdk::Event::Expose', 'Gtk2::Gdk::Event->new expose'); isa_ok ($event->copy, 'Gtk2::Gdk::Event::Expose'); is ($event->type, 'expose'); $event->area (Gtk2::Gdk::Rectangle->new (0, 0, 100, 100)); my $rect = $event->area; ok (eq_array ([$rect->x, $rect->y, $rect->width, $rect->height], [0, 0, 100, 100]), '$expose_event->area'); $event->region (Gtk2::Gdk::Region->new); isa_ok ($event->region, 'Gtk2::Gdk::Region', '$expose_event->region'); $event->region (undef); is ($event->region, undef, '$expose_event->region'); $event->count (10); is ($event->count, 10, '$expose_event->count'); # Visibility ################################################################### isa_ok ($event = Gtk2::Gdk::Event->new ('visibility-notify'), 'Gtk2::Gdk::Event::Visibility', 'Gtk2::Gdk::Event->new visibility'); $event->state ('partial'); is ($event->state, 'partial', '$visibility_event->state'); # Motion ####################################################################### my $window = Gtk2::Gdk::Window->new (undef, { width => 20, height => 20, wclass => "output", window_type => "toplevel" }); my $device = Gtk2::Gdk::Device -> get_core_pointer(); isa_ok ($event = Gtk2::Gdk::Event->new ('motion-notify'), 'Gtk2::Gdk::Event::Motion', 'Gtk2::Gdk::Event->new motion'); $event->is_hint (2); is ($event->is_hint, 2, '$motion_event->is_hint'); $event->device ($device); is ($event->device, $device, '$motion_event->device'); $event->device (undef); is ($event->device, undef, '$motion_event->device & undef'); $event->x (13); is ($event->x, 13, '$motion_event->x'); $event->y (13); is ($event->y, 13, '$motion_event->y'); SKIP: { skip "new 2.12 stuff", 0 unless Gtk2->CHECK_VERSION (2, 12, 0); $event->device ($device); $event->window ($window); $event->request_motions; } # Button ####################################################################### isa_ok ($event = Gtk2::Gdk::Event->new ('button-press'), 'Gtk2::Gdk::Event::Button', 'Gtk2::Gdk::Event->new button'); $event->button (2); is ($event->button, 2, '$button_event->button'); $event->device ($device); is ($event->device, $device, '$button_event->device'); $event->device (undef); is ($event->device, undef, '$button_event->device & undef'); $event->x (13); is ($event->x, 13, '$button_event->x'); $event->y (13); is ($event->y, 13, '$button_event->y'); # Scroll ####################################################################### isa_ok ($event = Gtk2::Gdk::Event->new ('scroll'), 'Gtk2::Gdk::Event::Scroll', 'Gtk2::Gdk::Event->new scroll'); $event->direction ('down'); is ($event->direction, 'down', '$scroll_event->direction'); $event->device ($device); is ($event->device, $device, '$scroll_event->device'); $event->device (undef); is ($event->device, undef, '$scroll_event->device & undef'); $event->x (13); is ($event->x, 13, '$scroll_event->x'); $event->y (13); is ($event->y, 13, '$scroll_event->y'); # Key ########################################################################## isa_ok ($event = Gtk2::Gdk::Event->new ('key-press'), 'Gtk2::Gdk::Event::Key', 'Gtk2::Gdk::Event->new key'); $event->keyval (44); is ($event->keyval, 44, '$key_event->keyval'); $event->hardware_keycode (10); is ($event->hardware_keycode, 10, '$key_event->hardware_keycode'); $event->group (11); is ($event->group, 11, '$key_event->group'); # Crossing ##################################################################### isa_ok ($event = Gtk2::Gdk::Event->new ('enter-notify'), 'Gtk2::Gdk::Event::Crossing', 'Gtk2::Gdk::Event->new crossing'); $event->subwindow ($window); is ($event->subwindow, $window, '$crossing_event->window'); $event->subwindow (undef); is ($event->subwindow, undef, '$crossing_event->window & undef'); $event->mode ('grab'); is ($event->mode, 'grab', '$crossing_event->mode'); $event->detail ('nonlinear'); is ($event->detail, 'nonlinear', '$crossing_event->detail'); $event->focus (1); is ($event->focus, 1, '$crossing_event->focus'); # try out the base class stuff, crossing is good b/c it has most of the stuff is ($event->time, 0, '$event->time'); is ($event->get_time, 0, '$event->time'); # special case for get_time() is (Gtk2::Gdk::Event::get_time(undef), 0, "get_time with no event gets GDK_CURRENT_TIME, which is 0"); is_deeply (\@{ $event->state }, [], '$event->state'); is_deeply (\@{ $event->get_state }, [], '$event->state'); ok (eq_array ([$event->coords], [0, 0]), '$event->coords'); is ($event->x, 0, '$event->x'); is ($event->y, 0, '$event->y'); is_deeply ([$event->get_root_coords], [0, 0], '$event->get_root_coords'); is ($event->x_root, 0, '$event->x_root'); is ($event->y_root, 0, '$event->y_root'); SKIP: { skip "GdkScreen is new in 2.2", 1 unless Gtk2->CHECK_VERSION (2, 2, 0); my $screen = Gtk2::Gdk::Screen->get_default; $event->set_screen ($screen); is ($event->get_screen, $screen, '$event->get_screen'); } $event->window ($window); is ($event->window, $window, '$event->window'); $event->window (undef); is ($event->window, undef, '$event->window & undef'); $event->send_event (3); is ($event->send_event, 3, '$event->send_event'); $event->x (13); is ($event->x, 13, '$crossing_event->x'); $event->y (13); is ($event->y, 13, '$crossing_event->y'); is ($event->axis ("x"), 13); is ($event->get_axis ("y"), 13); is_deeply ([$event->coords], [13, 13]); is_deeply ([$event->get_coords], [13, 13]); # a little stress-testing on the complicated parameter validation of # get_state|set_state|state eval { $event->set_state; }; like ($@, qr/Usage/, 'set_state with no args croaks'); eval { $event->get_state ('foo'); }; like ($@, qr/Usage/, 'get_state with an arg croaks'); eval { $event->state; }; is ($@, '', "state with no args doesn't croak"); eval { $event->state ('control-mask'); }; is ($@, '', "nor does state with an arg"); # similarly for get_time|set_time|time eval { $event->set_time; }; like ($@, qr/Usage/, "set_time with no args croaks"); eval { $event->get_time ('foo'); }; like ($@, qr/Usage/, "get_time with an arg croaks"); eval { $event->time; }; is ($@, '', "time with no args does not croak"); eval { $event->time (time); }; is ($@, '', "nor does time with an arg"); Gtk2::Gdk::Event->put ($event); is (Gtk2::Gdk->events_pending, 1); isa_ok (Gtk2::Gdk::Event->get, "Gtk2::Gdk::Event"); Gtk2::Gdk::Event->put ($event); is (Gtk2::Gdk->events_pending, 1); isa_ok (Gtk2::Gdk::Event->peek, "Gtk2::Gdk::Event"); my $i_know_you = 0; Gtk2::Gdk::Event -> handler_set(sub { return if $i_know_you++; my ($ev, $data) = @_; ok ((ref $ev eq 'Gtk2::Gdk::Event::Crossing' or UNIVERSAL::isa ($ev, 'Gtk2::Gdk::Event')), '$ev of expected type'); is ($data, 'bla', 'user data passed properly'); # pass to gtk+ default handler Gtk2->main_do_event ($ev); }, 'bla'); Gtk2::Gdk::Event->put ($event); Gtk2->main_iteration while Gtk2->events_pending; # reset Gtk2::Gdk::Event -> handler_set (undef); # FIXME: how to test? seems to block. # warn Gtk2::Gdk::Event->get_graphics_expose ($window); Gtk2::Gdk -> set_show_events (1); is (Gtk2::Gdk -> get_show_events, 1); SKIP: { # this will return undef if the setting is not set on your window manager, # which is pretty much the case when you are not running under gnome. my $dct = Gtk2::Gdk->setting_get ("gtk-double-click-time"); skip "setting gtk-double-click-time not set?", 1 unless defined $dct; like (Gtk2::Gdk->setting_get ("gtk-double-click-time"), qr/^\d+$/); } # Focus ######################################################################## isa_ok ($event = Gtk2::Gdk::Event->new ('focus-change'), 'Gtk2::Gdk::Event::Focus', 'Gtk2::Gdk::Event->new focus'); $event->in (10); is ($event->in, 10, '$focus_event->in'); # Configure #################################################################### isa_ok ($event = Gtk2::Gdk::Event->new ('configure'), 'Gtk2::Gdk::Event::Configure', 'Gtk2::Gdk::Event->new configure'); $event->width (10); is ($event->width, 10, '$configure_event->width'); $event->height (12); is ($event->height, 12, '$configure_event->height'); $event->x (13); is ($event->x, 13, '$configure_event->x'); $event->y (13); is ($event->y, 13, '$configure_event->y'); # Property ##################################################################### isa_ok ($event = Gtk2::Gdk::Event->new ('property-notify'), 'Gtk2::Gdk::Event::Property', 'Gtk2::Gdk::Event->new property'); $event->state (10); is ($event->state, 10, '$property_event->state'); $event->atom (Gtk2::Gdk::Atom->new ('foo')); isa_ok ($event->atom, 'Gtk2::Gdk::Atom', '$property_event->atom'); # Proximity #################################################################### isa_ok ($event = Gtk2::Gdk::Event->new ('proximity-in'), 'Gtk2::Gdk::Event::Proximity', 'Gtk2::Gdk::Event->new proximity'); $event->device ($device); is ($event->device, $device, '$proximity_event->device'); $event->device (undef); is ($event->device, undef, '$proximity_event->device & undef'); # Client ####################################################################### isa_ok ($event = Gtk2::Gdk::Event->new ('client-event'), 'Gtk2::Gdk::Event::Client', 'Gtk2::Gdk::Event->new client'); $event->message_type (Gtk2::Gdk::Atom->new ('string')); isa_ok ($event->message_type, 'Gtk2::Gdk::Atom', '$event->message_type'); $event->data_format (Gtk2::Gdk::CHARS); is ($event->data_format, Gtk2::Gdk::CHARS, '$client_event->data_format'); $event->data ('01234567890123456789'); is ($event->data, '01234567890123456789', '$client_event->data'); $event->data_format (Gtk2::Gdk::SHORTS); is ($event->data_format, Gtk2::Gdk::SHORTS, '$client_event->data_format'); $event->data (0, 1, 2, 3, 4, 5, 6, 7, 8, 9); is_deeply ([$event->data], [0, 1, 2, 3, 4, 5, 6, 7, 8, 9], '$client_event->data'); $event->data_format (Gtk2::Gdk::LONGS); is ($event->data_format, Gtk2::Gdk::LONGS, '$client_event->data_format'); $event->data (0, 1, 2, 3, 4); is_deeply ([$event->data], [0, 1, 2, 3, 4], '$client_event->data'); # Setting ###################################################################### isa_ok ($event = Gtk2::Gdk::Event->new ('setting'), 'Gtk2::Gdk::Event::Setting', 'Gtk2::Gdk::Event->new setting'); $event->action ('new'); is ($event->action, 'new', '$setting_event->action'); $event->name ('a name'); is ($event->name, 'a name', '$setting_event->name'); $event->name (undef); is ($event->name, undef, '$setting_event->name & undef'); # WindowState ################################################################## isa_ok ($event = Gtk2::Gdk::Event->new ('window-state'), 'Gtk2::Gdk::Event::WindowState', 'Gtk2::Gdk::Event->new windowstate'); $event->changed_mask ('maximized'); is_deeply (\@{ $event->changed_mask }, ['maximized'], '$windowstate_event->changed_mask'); $event->new_window_state ('withdrawn'); is_deeply (\@{ $event->new_window_state }, ['withdrawn'], '$windowstate_event->new_window_state'); # DND ########################################################################## isa_ok ($event = Gtk2::Gdk::Event->new ('drag-enter'), 'Gtk2::Gdk::Event::DND', 'Gtk2::Gdk::Event->new dnd'); $event->context (Gtk2::Gdk::DragContext->new); isa_ok ($event->context, 'Gtk2::Gdk::DragContext', '$dnd_event->context'); $event->context (undef); is ($event->context, undef, '$dnd_event->context & undef'); # put this back to keep the event destructor from barfing on a NULL pointer $event->context (Gtk2::Gdk::DragContext->new); # Selection #################################################################### isa_ok ($event = Gtk2::Gdk::Event->new ('selection-clear'), 'Gtk2::Gdk::Event::Selection', 'Gtk2::Gdk::Event->new selection'); $event->selection (Gtk2::Gdk::Atom->new ('foo')); isa_ok ($event->selection, 'Gtk2::Gdk::Atom', '$selection_event->selection'); # try setting to undef once $event->selection (undef); is ($event->selection, undef, '$selection_event->selection'); $event->target (Gtk2::Gdk::Atom->new ('foo')); isa_ok ($event->target, 'Gtk2::Gdk::Atom', '$selection_event->target'); $event->property (Gtk2::Gdk::Atom->new ('foo')); isa_ok ($event->property, 'Gtk2::Gdk::Atom', '$selection_event->property'); SKIP: { skip "can't do x11 stuff on this platform", 1 if $^O eq 'MSWin32'; $event->requestor ($window->get_xid); is ($event->requestor, $window->get_xid, '$selection_event->requestor'); } # OwnerChange ################################################################## SKIP: { skip ("the owner-change event is new in 2.6", 5) unless (Gtk2->CHECK_VERSION (2, 6, 0)); isa_ok ($event = Gtk2::Gdk::Event->new ("owner-change"), "Gtk2::Gdk::Event::OwnerChange"); $event->owner (23); is ($event->owner, 23); $event->reason ("destroy"); is ($event->reason, "destroy"); $event->selection (Gtk2::Gdk::Atom->new ("bar")); isa_ok ($event->selection, "Gtk2::Gdk::Atom"); $event->selection_time (42); is ($event->selection_time, 42); } # GrabBroken ################################################################## SKIP: { skip ("the grab-broken event is new in 2.8", 5) unless (Gtk2->CHECK_VERSION (2, 8, 0)); isa_ok ($event = Gtk2::Gdk::Event->new ("grab-broken"), "Gtk2::Gdk::Event::GrabBroken"); $event->keyboard (TRUE); is ($event->keyboard, TRUE); $event->implicit (FALSE); is ($event->implicit, FALSE); $event->grab_window (undef); is ($event->grab_window, undef); my $window = Gtk2::Gdk::Window->new (undef, {window_type => "toplevel"}); $event->grab_window ($window); is ($event->grab_window, $window); } # Damage ###################################################################### SKIP: { skip ("the damage event is new in 2.14", 2) unless (Gtk2->CHECK_VERSION (2, 14, 0)); isa_ok (my $event = Gtk2::Gdk::Event->new ('damage'), 'Gtk2::Gdk::Event::Expose'); is ($event->type, 'damage'); } __END__ Copyright (C) 2003-2005 by the gtk2-perl team (see the file AUTHORS for the full list). See LICENSE for more information. Gtk2-1.24992/t/GtkTreeDnd.t0000644000175000017500000000170413076462677013570 0ustar lacklack#!/usr/bin/perl -w use strict; use Gtk2::TestHelper tests => 7, noinit => 1; # GtkTreeDragSource drag_data_get() # { my $list = Gtk2::ListStore->new('Glib::String'); $list->insert_with_values (0, 0=>'foo'); $list->insert_with_values (1, 0=>'bar'); # one arg returning new GtkSelectionData my $seldata = $list->drag_data_get (Gtk2::TreePath->new_from_indices(0)); isa_ok($seldata, 'Gtk2::SelectionData'); my ($model, $path) = $seldata->get_row_drag_data; is ($model, $list); is_deeply ([ 0 ], [ $path->get_indices ]); # storing to existing GtkSelectionData $list->drag_data_get (Gtk2::TreePath->new_from_indices(1), $seldata); ($model, $path) = $seldata->get_row_drag_data; is ($model, $list); is_deeply ([ 1 ], [ $path->get_indices ]); # check mortalizing require Scalar::Util; Scalar::Util::weaken ($seldata); is ($seldata, undef); $model = undef; Scalar::Util::weaken ($list); is ($list, undef); } exit 0; __END__ Gtk2-1.24992/t/options.t0000644000175000017500000000207113076462677013266 0ustar lacklack#!/usr/bin/perl use strict; use warnings; use Gtk2::TestHelper tests => 4, noinit => 1; SKIP: { @ARGV = qw(--help --name gtk2perl --urgs tree); skip 'Gtk2->init_check failed, probably unable to open DISPLAY', 1 unless (Gtk2->init_check); is_deeply (\@ARGV, [qw(--help --urgs tree)]); } SKIP: { skip "parse_args is new in 2.4.5", 1 unless Gtk2->CHECK_VERSION (2, 4, 5); # we can't do much more than just calling it, since it always # immediately returns if init() was called already. ok (Gtk2->parse_args); } SKIP: { skip 'new 2.6 stuff', 1 unless Gtk2->CHECK_VERSION(2, 6, 0); my $foos = 1; my $options = [ [ 'foos', 'f', 'int', \$foos ], ]; my $context = Glib::OptionContext->new ('- urgsify your life'); $context->add_main_entries ($options, 'C'); $context->add_group (Gtk2->get_option_group (0)); @ARGV = qw(--name Foo --foos 23); $context->parse (); is (@ARGV, 0); is ($foos, 23); } __END__ Copyright (C) 2003-2013 by the gtk2-perl team (see the file AUTHORS for the full list). See LICENSE for more information. Gtk2-1.24992/t/GdkProperty.t0000644000175000017500000001171213076462676014046 0ustar lacklack#!/usr/bin/perl -w use strict; use Gtk2::TestHelper tests => 49; # $Id$ my $window = Gtk2::Window -> new(); $window -> realize(); my $name = Gtk2::Gdk::Atom -> intern("WM_NAME", 1); my $icon_name = Gtk2::Gdk::Atom -> intern("WM_ICON_NAME", 1); my $strut = Gtk2::Gdk::Atom -> intern("_NET_WM_STRUT", 0); my $strut_partial = Gtk2::Gdk::Atom -> intern("_NET_WM_STRUT_PARTIAL", 0); my $string = Gtk2::Gdk::Atom -> new("STRING"); my $cardinal = Gtk2::Gdk::Atom -> new("CARDINAL"); foreach ($name, $strut, $strut_partial, $string, $cardinal) { isa_ok($_, "Gtk2::Gdk::Atom"); } { my $h1 = Gtk2::Gdk::Atom->intern("hello"); my $h2 = Gtk2::Gdk::Atom->intern("hello"); my $w = Gtk2::Gdk::Atom->intern("world"); ok ($h1 == $h2); ok ($h1 != $w); ok (! ($h1 != $h2)); } is($name -> name(), "WM_NAME"); is($icon_name -> name(), "WM_ICON_NAME"); is($strut -> name(), "_NET_WM_STRUT"); is($strut_partial -> name(), "_NET_WM_STRUT_PARTIAL"); is($string -> name(), "STRING"); is($cardinal -> name(), "CARDINAL"); $window -> window() -> property_change( $name, $string, Gtk2::Gdk::CHARS, "replace", "Bla\0Bla\0Bla"); $window -> window() -> property_change( $icon_name, $string, Gtk2::Gdk::CHARS, "replace", "Bla Bla Bla"); $window -> window() -> property_change( $strut, $cardinal, Gtk2::Gdk::USHORTS, "replace", 0, 0, 26, 0); $window -> window() -> property_change( $strut_partial, $cardinal, Gtk2::Gdk::ULONGS, "replace", 0, 0, 26, 0, 0, 0, 0, 0, 0, 1279, 0, 0); SKIP: { skip 'gdk_property_get is not implemented yet on win32', 34 if $^O eq 'MSWin32'; my ($atom, $format, @data); ($atom, $format, @data) = $window -> window() -> property_get($name, $string, 0, 1024, 0); is($atom -> name(), "STRING"); is($format, Gtk2::Gdk::CHARS); is(@data, 1); is($data[0], "Bla\0Bla\0Bla"); ($atom, $format, @data) = $window -> window() -> property_get($icon_name, $string, 0, 1024, 0); is($atom -> name(), "STRING"); is($format, Gtk2::Gdk::CHARS); is(@data, 1); is($data[0], "Bla Bla Bla"); ($atom, $format, @data) = $window -> window() -> property_get($strut, $cardinal, 0, 1024, 0); is($atom -> name(), "CARDINAL"); is($format, Gtk2::Gdk::USHORTS); is_deeply([@data], [0, 0, 26, 0]); ($atom, $format, @data) = $window -> window() -> property_get($strut_partial, $cardinal, 0, 1024, 0); is($atom -> name(), "CARDINAL"); is($format, Gtk2::Gdk::ULONGS); is_deeply([@data], [0, 0, 26, 0, 0, 0, 0, 0, 0, 1279, 0, 0]); $window -> window() -> property_delete($name); $window -> window() -> property_delete($strut); $window -> window() -> property_delete($strut_partial); SKIP: { my @text_list = Gtk2::Gdk -> text_property_to_text_list( $string, Gtk2::Gdk::CHARS, "Bla\0Bla\0Bla"); skip 'text_property_to_text_list returned an empty list', 1 unless @text_list; is_deeply([@text_list], [qw(Bla Bla Bla)]); } is_deeply([Gtk2::Gdk -> text_property_to_utf8_list( $string, Gtk2::Gdk::CHARS, "Bla\0Bla\0Bla")], [qw(Bla Bla Bla)]); ($atom, $format, @data) = Gtk2::Gdk -> string_to_compound_text("Bla"); SKIP: { skip 'atom tests', 4 unless defined $atom; is($atom -> name(), "COMPOUND_TEXT"); is($format, Gtk2::Gdk::CHARS); is(@data, 1); is($data[0], "Bla"); } ($atom, $format, @data) = Gtk2::Gdk -> utf8_to_compound_text("Bla"); SKIP: { skip 'atom tests', 4 unless defined $atom; is($atom -> name(), "COMPOUND_TEXT"); is($format, Gtk2::Gdk::CHARS); is(@data, 1); is($data[0], "Bla"); } skip("GdkDisplay is new 2.2", 10) unless (Gtk2 -> CHECK_VERSION(2, 2, 0)); my $display = Gtk2::Gdk::Display -> get_default(); SKIP: { my @text_list = Gtk2::Gdk -> text_property_to_text_list_for_display( $display, $string, Gtk2::Gdk::CHARS, "Bla\0Bla\0Bla"); skip 'text_property_to_text_list_for_display returned an empty list', 1 unless @text_list; is_deeply([@text_list], [qw(Bla Bla Bla)]); } is_deeply([Gtk2::Gdk -> text_property_to_utf8_list_for_display( $display, $string, Gtk2::Gdk::CHARS, "Bla\0Bla\0Bla")], [qw(Bla Bla Bla)]); SKIP: { my ($atom, $format, @data) = Gtk2::Gdk -> string_to_compound_text_for_display($display, "Bla"); skip 'string_to_compound_text_for_display did not return an atom', 4 unless defined $atom; is($atom -> name(), "COMPOUND_TEXT"); is($format, Gtk2::Gdk::CHARS); is(@data, 1); is($data[0], "Bla"); } SKIP: { my ($atom, $format, @data) = Gtk2::Gdk -> utf8_to_compound_text_for_display($display, "Bla"); skip 'utf8_to_compound_text_for_display did not return an atom', 4 unless defined $atom; is($atom -> name(), "COMPOUND_TEXT"); is($format, Gtk2::Gdk::CHARS); is(@data, 1); is($data[0], "Bla"); } } is(Gtk2::Gdk -> utf8_to_string_target("Bla"), "Bla"); __END__ Copyright (C) 2003 by the gtk2-perl team (see the file AUTHORS for the full list). See LICENSE for more information. Gtk2-1.24992/t/GtkStock.t0000644000175000017500000000252413076462677013327 0ustar lacklack#!/usr/bin/perl -w use strict; use Gtk2::TestHelper tests => 9, noinit => 1; # $Id$ use Gtk2::Gdk::Keysyms; my @items = ( { stock_id => "gtk2perl-test-script", label => "_gtk2perl test script", modifier => [qw(shift-mask control-mask)], keyval => $Gtk2::Gdk::Keysyms{ KP_Enter }, translation_domain => "de_DE" }, { stock_id => "gtk2perl-bla" } ); Gtk2::Stock -> add(@items); is_deeply([(Gtk2::Stock -> list_ids())[0, 1]], ["gtk2perl-test-script", "gtk2perl-bla"]); my $test = Gtk2::Stock -> lookup("gtk2perl-test-script"); is($test -> { stock_id }, $items[0] -> { stock_id }); is($test -> { label }, $items[0] -> { label }); is_deeply(\@{ $test -> { modifier } }, $items[0] -> { modifier }); is($test -> { keyval }, $items[0] -> { keyval }); is($test -> { translation_domain }, $items[0] -> { translation_domain }); SKIP: { skip("new 2.8 stuff", 3) unless Gtk2->CHECK_VERSION (2, 8, 0); Gtk2::Stock -> set_translate_func("de_DE", sub { my ($label, $data) = @_; is($label, "_gtk2perl test script"); is($data, "bla"); return reverse $label; }, "bla"); my $test = Gtk2::Stock -> lookup("gtk2perl-test-script"); is($test -> { label }, "tpircs tset lrep2ktg_"); } __END__ Copyright (C) 2003-2005 by the gtk2-perl team (see the file AUTHORS for the full list). See LICENSE for more information. Gtk2-1.24992/t/GdkPango.t0000644000175000017500000000561213076462676013270 0ustar lacklack#!/usr/bin/perl use strict; use warnings; use Gtk2::TestHelper at_least_version => [2, 6, 0, "GdkPango is new in 2.6"], tests => 14; # $Id$ my $screen = Gtk2::Gdk::Screen -> get_default(); my $renderer = Gtk2::Gdk::PangoRenderer -> new($screen); isa_ok($renderer, "Gtk2::Gdk::PangoRenderer"); $renderer = Gtk2::Gdk::PangoRenderer -> get_default($screen); isa_ok($renderer, "Gtk2::Gdk::PangoRenderer"); my $window = Gtk2::Window -> new(); $window -> realize(); $renderer -> set_drawable(undef); $renderer -> set_drawable($window -> window); my $gc = Gtk2::Gdk::GC -> new($window -> window); $renderer -> set_gc(undef); $renderer -> set_gc($gc); $renderer -> activate(); # Stolen from examples/color_snooper.pl my $data = pack 'C*', 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x1c, 0x00, 0x00, 0x00, 0x22, 0x00, 0x00, 0x00, 0x41, 0x00, 0x00, 0xc0, 0xa1, 0x00, 0x00, 0x20, 0xbc, 0x00, 0x00, 0x40, 0xbb, 0x00, 0x00, 0x80, 0x44, 0x00, 0x00, 0x40, 0x34, 0x00, 0x00, 0x20, 0x13, 0x00, 0x00, 0x90, 0x15, 0x00, 0x00, 0xc8, 0x00, 0x00, 0x00, 0x64, 0x00, 0x00, 0x00, 0x32, 0x00, 0x00, 0x00, 0x19, 0x00, 0x00, 0x80, 0x0c, 0x00, 0x00, 0x40, 0x06, 0x00, 0x00, 0x40, 0x03, 0x00, 0x00, 0xe0, 0x01, 0x00, 0x00, 0x20, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00; my $bitmap = Gtk2::Gdk::Bitmap -> create_from_data($window -> window, $data, 32, 32); $renderer -> set_stipple("foreground", undef); $renderer -> set_stipple("foreground", $bitmap); my $color = Gtk2::Gdk::Color -> new(0xffff, 0xffff, 0xffff); $renderer -> set_override_color("background", undef); $renderer -> set_override_color("background", $color); my $attr = Gtk2::Gdk::Pango::AttrStipple->new (undef, 0, 23); isa_ok ($attr, "Gtk2::Gdk::Pango::AttrStipple"); isa_ok ($attr, "Gtk2::Pango::Attribute"); is ($attr->stipple ($bitmap), undef); is ($attr->stipple, $bitmap); $attr = Gtk2::Gdk::Pango::AttrEmbossed->new (TRUE, 0, 23); isa_ok ($attr, "Gtk2::Gdk::Pango::AttrEmbossed"); isa_ok ($attr, "Gtk2::Pango::Attribute"); ok ($attr->embossed (FALSE)); ok (!$attr->embossed); SKIP: { skip "2.12 stuff", 4 unless Gtk2->CHECK_VERSION (2, 12, 0); my $color = Gtk2::Gdk::Color->new (0xffff, 0xffff, 0xffff); my $attr = Gtk2::Gdk::Pango::AttrEmbossColor->new ($color); isa_ok ($attr, "Gtk2::Gdk::Pango::AttrEmbossColor"); isa_ok ($attr, "Gtk2::Pango::Attribute"); is_deeply ($attr->color ([0x23, 0x42, 0x00]), [0xffff, 0xffff, 0xffff]); is_deeply ($attr->color, [0x23, 0x42, 0x00]); } __END__ Copyright (C) 2005-2006 by the gtk2-perl team (see the file AUTHORS for the full list). See LICENSE for more information. Gtk2-1.24992/t/GtkAccelGroup.t0000644000175000017500000000366013076462676014271 0ustar lacklack#!/usr/bin/perl -w use strict; use Gtk2::TestHelper tests => 19; # $Id$ use Gtk2::Gdk::Keysyms; my $group = Gtk2::AccelGroup -> new(); isa_ok($group, "Gtk2::AccelGroup"); my $window = Gtk2::Window -> new(); $window -> add_accel_group($group); my $key = $Gtk2::Gdk::Keysyms{ KP_Enter }; my $mask = qw(shift-mask); my $closure = sub { is($_[0], $group); is($_[1], $window); is($_[2], $key); is_deeply(\@{ $_[3] }, [$mask]); }; $group -> connect($key, $mask, qw(visible), $closure); $group -> connect_by_path("/Bla/Blub", $closure); $group -> lock(); $group -> unlock(); like(Gtk2::AccelGroups -> activate($window, $key, $mask), qr/^(?:|1)$/); is(Gtk2::AccelGroups -> from_object($window), $group); is(Gtk2::Accelerator -> valid($key, $mask), 1); my @test = Gtk2::Accelerator -> parse("KP_Enter"); is($test[0], $key); is_deeply(\@{ $test[1] }, [$mask]); is(Gtk2::Accelerator -> name($key, $mask), "KP_Enter"); Gtk2::Accelerator -> set_default_mod_mask([qw(shift-mask control-mask mod1-mask mod2-mask lock-mask)]); ok(Gtk2::Accelerator -> get_default_mod_mask() == [qw(shift-mask control-mask mod1-mask mod2-mask lock-mask)]); is($group -> disconnect_key($key, $mask), 1); SKIP: { skip 'disconnect_key from empty group, bug in gtk+', 1 unless Gtk2->CHECK_VERSION (2, 4, 0); ok (not ($group->disconnect_key (42, qw/shift-mask/)), 'second disconnect_key shift-mask should fail'); } SKIP: { skip 'get_label is new in 2.6', 1 unless Gtk2->CHECK_VERSION (2, 6, 0); ok(defined Gtk2::Accelerator -> get_label($key, $mask)); } is($group -> disconnect($closure), 1); ok(not $group -> disconnect($closure)); SKIP: { skip 'new 2.14 stuff', 2 unless Gtk2->CHECK_VERSION (2, 14, 0); is ($group->get_is_locked, FALSE); ok (defined $group->get_modifier_mask); } __END__ Copyright (C) 2003-2005 by the gtk2-perl team (see the file AUTHORS for the full list). See LICENSE for more information. Gtk2-1.24992/t/GtkHBox.t0000644000175000017500000000144213076462677013102 0ustar lacklack#!/usr/bin/perl -w use strict; use Gtk2::TestHelper tests => 3, noinit => 1; # $Id$ my $box = Gtk2::HBox -> new(); isa_ok($box, "Gtk2::HBox"); { my $label = Gtk2::Label->new ('hello'); $box->pack_start ($label, 0,0,0); $box->remove($label); require Scalar::Util; Scalar::Util::weaken ($label); is ($label, undef, 'child destroyed by weakening after being in box'); } { my $label = Gtk2::Label->new ('hello'); $box->pack_start ($label, 0,0,0); $box->foreach (sub { }); $box->remove($label); require Scalar::Util; Scalar::Util::weaken ($label); is ($label, undef, 'child destroyed by weakening after being in box -- and foreach()'); } __END__ Copyright (C) 2003, 2009 by the gtk2-perl team (see the file AUTHORS for the full list). See LICENSE for more information. Gtk2-1.24992/t/GtkEventBox.t0000644000175000017500000000104313076462677013771 0ustar lacklack#!/usr/bin/perl -w use strict; use Gtk2::TestHelper tests => 3, noinit => 1; # $Id$ my $box = Gtk2::EventBox -> new(); isa_ok($box, "Gtk2::EventBox"); SKIP: { skip("[sg]et_above_child and [sg]et_visible_window are new in 2.4", 2) unless Gtk2->CHECK_VERSION (2, 4, 0); $box -> set_above_child(1); is($box -> get_above_child(), 1); $box -> set_visible_window(1); is($box -> get_visible_window(), 1); } __END__ Copyright (C) 2003 by the gtk2-perl team (see the file AUTHORS for the full list). See LICENSE for more information. Gtk2-1.24992/t/GtkSpinner.t0000644000175000017500000000056013076462677013660 0ustar lacklack#!/usr/bin/env perl use Gtk2::TestHelper tests => 1, noinit => 1, at_least_version => [2, 20, 0, "Gtk2::Spinner is new in 2.20"]; my $spinner = Gtk2::Spinner->new; isa_ok ($spinner, 'Gtk2::Spinner'); $spinner->start; $spinner->stop; __END__ Copyright (C) 2010 by the gtk2-perl team (see the file AUTHORS for the full list). See LICENSE for more information. Gtk2-1.24992/t/GtkPrintOperation.t0000644000175000017500000000671213076462677015224 0ustar lacklack#!/usr/bin/perl -w use strict; use Gtk2::TestHelper tests => 17, at_least_version => [2, 10, 0, "GtkPrintOperation is new in 2.10"]; # $Id$ use File::Temp qw(tempdir); my $dir = tempdir(CLEANUP => 1); my $op = Gtk2::PrintOperation -> new(); isa_ok($op, "Gtk2::PrintOperation"); my $setup = Gtk2::PageSetup -> new(); $op -> set_default_page_setup(undef); is($op -> get_default_page_setup(), undef); $op -> set_default_page_setup($setup); is($op -> get_default_page_setup(), $setup); my $settings = Gtk2::PrintSettings -> new(); $op -> set_print_settings(undef); is($op -> get_print_settings(), undef); $op -> set_print_settings($settings); is($op -> get_print_settings(), $settings); ok(defined $op -> get_status()); ok(defined $op -> get_status_string()); ok(defined $op -> is_finished()); sub get_op { my $op = Gtk2::PrintOperation -> new(); $op -> set_job_name("Test"); $op -> set_n_pages(2); $op -> set_current_page(1); $op -> set_use_full_page(TRUE); $op -> set_unit("mm"); $op -> set_export_filename("$dir/test.pdf"); $op -> set_track_print_status(TRUE); $op -> set_show_progress(FALSE); $op -> set_allow_async(TRUE); $op -> set_custom_tab_label("Print"); return $op; } $op = get_op(); ok(defined $op -> run("export", undef)); $op -> cancel(); $op = get_op(); ok(defined $op -> run("export", Gtk2::Window -> new())); $op -> cancel(); # FIXME: Don't know how to trigger an actual error. # warn $op -> get_error(); SKIP: { skip 'draw page finish (2.16)', 3 unless Gtk2->CHECK_VERSION(2, 16, 0); # NOTE draw_page_finish() has to be called under the right conditions # otherwise the print context doesn't seem to be setup properly causing # the program to crash with a segmentation fault. # # This is tricky as draw_page_finish() must be called if # set_defer_drawing() is called and the latter can be called only from # the 'draw-page' callback. # 'draw-page' is called twice because there are 2 pages, see get_op() $op = get_op(); $op -> signal_connect('draw-page' => sub { # Pretend that the drawing is asynchronous. $op -> set_defer_drawing(); # Finish the drawing later Glib::Idle->add(sub { ok(TRUE, "Draw page finish called"); $op -> draw_page_finish(); return Glib::SOURCE_REMOVE; }); }); ok(defined $op -> run("export", Gtk2::Window -> new())); } SKIP: { skip 'new 2.18 stuff', 4 unless Gtk2->CHECK_VERSION(2, 18, 0); my $op = Gtk2::PrintOperation -> new(); $op -> set_embed_page_setup(TRUE); ok($op -> get_embed_page_setup()); $op -> set_support_selection(TRUE); ok($op -> get_support_selection()); $op -> set_has_selection(TRUE); ok($op -> get_has_selection()); ok(defined $op -> get_n_pages_to_print()); } =comment # Can't non-interactively test these, I think. I manually verified that they # work though. Gtk2::Print -> run_page_setup_dialog_async( undef, undef, $settings, sub { warn join ", ", @_; Gtk2 -> main_quit(); }, "data"); Gtk2 -> main(); Gtk2::Print -> run_page_setup_dialog_async( $window, $setup, $settings, sub { warn join ", ", @_; Gtk2 -> main_quit(); }, "data"); Gtk2 -> main(); warn Gtk2::Print -> run_page_setup_dialog(undef, undef, $settings); warn Gtk2::Print -> run_page_setup_dialog($window, $setup, $settings); =cut __END__ Copyright (C) 2006, 2013 by the gtk2-perl team (see the file AUTHORS for the full list). See LICENSE for more information. Gtk2-1.24992/t/GtkRange.t0000644000175000017500000000374613076462677013307 0ustar lacklack#!/usr/bin/perl -w # vim: set ft=perl : use strict; use Gtk2::TestHelper tests => 15; # $Id$ my $adjustment = Gtk2::Adjustment -> new(0, 0, 100, 1, 5, 10); my $range = Gtk2::HScale -> new($adjustment); isa_ok($range, "Gtk2::Range"); $range -> set_adjustment($adjustment); is($range -> get_adjustment(), $adjustment); $range -> set_update_policy("continuous"); is($range -> get_update_policy(), "continuous"); $range -> set_inverted(1); is($range -> get_inverted(), 1); $range -> set_value(23.42); delta_ok($range -> get_value(), 23.42); $range -> set_increments(1, 5); $range -> set_range(0, 100); SKIP: { skip 'new stuff in 2.10', 2 unless Gtk2 -> CHECK_VERSION(2, 10, 0); $range -> set_lower_stepper_sensitivity('off'); is ($range -> get_lower_stepper_sensitivity, 'off'); $range -> set_upper_stepper_sensitivity('on'); is ($range -> get_upper_stepper_sensitivity, 'on'); } SKIP: { skip 'new stuff in 2.12', 3 unless Gtk2 -> CHECK_VERSION(2, 12, 0); $range -> set_show_fill_level(TRUE); ok($range -> get_show_fill_level()); $range -> set_restrict_to_fill_level(FALSE); ok(!$range -> get_restrict_to_fill_level()); $range -> set_fill_level(0.23); delta_ok($range -> get_fill_level(), 0.23); } SKIP: { skip 'new stuff in 2.18', 1 unless Gtk2 -> CHECK_VERSION(2, 18, 0); $range -> set_flippable(TRUE); ok($range -> get_flippable, '[gs]et_flippable'); } SKIP: { skip 'new 2.20 stuff', 4 unless Gtk2->CHECK_VERSION(2, 20, 0); $range -> set_min_slider_size(TRUE); ok($range -> get_min_slider_size()); my $rect = $range -> get_range_rect(); ok(defined $rect -> width() && defined $rect -> height()); my ($start, $end) = $range -> get_slider_range(); ok(defined $start && defined $end); $range -> set_slider_size_fixed(TRUE); ok($range -> get_slider_size_fixed()); } __END__ Copyright (C) 2003,2006 by the gtk2-perl team (see the file AUTHORS for the full list). See LICENSE for more information. Gtk2-1.24992/t/GtkCellRendererSpin.t0000644000175000017500000000072513076462676015444 0ustar lacklack#!/usr/bin/perl -w # vim: set ft=perl : use strict; use Gtk2::TestHelper tests => 3, noinit => 1, at_least_version => [2, 10, 0, "Gtk2::CellRendererSpin is new in 2.10"]; my $cell = Gtk2::CellRendererSpin->new; isa_ok ($cell, 'Gtk2::CellRendererSpin'); isa_ok ($cell, 'Gtk2::CellRendererText'); isa_ok ($cell, 'Gtk2::CellRenderer'); __END__ Copyright (C) 2006 by the gtk2-perl team (see the file AUTHORS for the full list). See LICENSE for more information. Gtk2-1.24992/t/GtkCellEditable.t0000644000175000017500000000226013076462676014551 0ustar lacklack#!/usr/bin/perl -w use strict; use Gtk2::TestHelper tests => 19; # $Id$ package EditableTest; use Test::More; use Glib::Object::Subclass Gtk2::Label::, interfaces => [ Gtk2::CellEditable:: ]; sub START_EDITING { my ($editable, $event) = @_; isa_ok($editable, "EditableTest"); isa_ok($editable, "Gtk2::Label"); isa_ok($editable, "Gtk2::CellEditable"); ok(not defined $event or ref $event eq "Gtk2::Gdk::Event::Button"); } sub EDITING_DONE { my ($editable, $event) = @_; isa_ok($editable, "EditableTest"); isa_ok($editable, "Gtk2::Label"); isa_ok($editable, "Gtk2::CellEditable"); } sub REMOVE_WIDGET { my ($editable, $event) = @_; isa_ok($editable, "EditableTest"); isa_ok($editable, "Gtk2::Label"); isa_ok($editable, "Gtk2::CellEditable"); } package main; my $editable = EditableTest -> new(); isa_ok($editable, "Gtk2::CellEditable"); $editable -> start_editing(); $editable -> start_editing(undef); $editable -> start_editing(Gtk2::Gdk::Event -> new("button-press")); $editable -> editing_done(); $editable -> remove_widget(); __END__ Copyright (C) 2003 by the gtk2-perl team (see the file AUTHORS for the full list). See LICENSE for more information. Gtk2-1.24992/t/GtkTreeModelIface.t0000644000175000017500000003022313076462677015051 0ustar lacklack#!/usr/bin/perl -w # $Id$ package CustomList; use strict; use warnings; use Glib qw(TRUE FALSE); use Gtk2; use Test::More; use Glib::Object::Subclass Glib::Object::, interfaces => [ Gtk2::TreeModel::, Gtk2::TreeSortable:: ], ; # one-time init: my %ordmap; { my $i = 0; %ordmap = map { $_ => $i++ } qw( First Second Third Fourth Fifth Sixth Seventh Eighth Ninth Tenth Eleventh Twelfth Thirteenth Fourteenth Fifteenth Sixteenth Seventeenth Eighteenth Nineteenth Twentieth ); } sub INIT_INSTANCE { my ($list) = @_; isa_ok ($list, "CustomList", "INIT_INSTANCE"); $list->{data} = []; foreach my $val (sort { $ordmap{$a} <=> $ordmap{$b} } keys %ordmap) { my $record = { pos => $ordmap{$val}, value => $val }; push @{$list->{data}}, $record; } $list->{stamp} = 23; $list->{sort_column_id} = -1; $list->{sort_order} = "ascending"; } sub FINALIZE_INSTANCE { my ($list) = @_; isa_ok ($list, "CustomList", "FINALIZE_INSTANCE"); } sub GET_FLAGS { my ($list) = @_; isa_ok ($list, "CustomList", "GET_FLAGS"); return [ qw/list-only iters-persist/ ]; } sub GET_N_COLUMNS { my ($list) = @_; isa_ok ($list, "CustomList", "GET_N_COLUMNS"); # we don't actually have 23 columns, just 1 -- but the point here is # to test that the marshaling actually puts through the correct # number, not just nonzero. return 23; } sub GET_COLUMN_TYPE { my ($list, $column) = @_; isa_ok ($list, "CustomList", "GET_COLUMN_TYPE"); is ($column, 1, "GET_COLUMN_TYPE"); return Glib::String:: } sub GET_ITER { my ($list, $path) = @_; isa_ok ($list, "CustomList", "GET_ITER"); isa_ok ($path, "Gtk2::TreePath", "GET_ITER"); my @indices = $path->get_indices; my $depth = $path->get_depth; ok ($depth == 1, "GET_ITER"); my $n = $indices[0]; ok ($n < @{$list->{data}}, "GET_ITER"); ok ($n > 0, "GET_ITER"); my $record = $list->{data}[$n]; ok (defined ($record), "GET_ITER"); ok ($record->{pos} == $n, "GET_ITER"); return [ $list->{stamp}, $n, $record, undef ]; } sub GET_PATH { my ($list, $iter) = @_; isa_ok ($list, "CustomList", "GET_PATH"); ok ($iter->[0] == $list->{stamp}, "GET_PATH"); my $record = $iter->[2]; my $path = Gtk2::TreePath->new; $path->append_index ($record->{pos}); return $path; } sub GET_VALUE { my ($list, $iter, $column) = @_; isa_ok ($list, "CustomList"); ok ($iter->[0] == $list->{stamp}, "GET_VALUE"); is ($column, 1, "GET_VALUE"); my $record = $iter->[2]; ok (defined ($record), "GET_VALUE"); ok ($record->{pos} < @{$list->{data}}, "GET_VALUE"); return $record->{value}; } sub ITER_NEXT { my ($list, $iter) = @_; isa_ok ($list, "CustomList", "ITER_NEXT"); ok ($iter->[0] == $list->{stamp}, "ITER_NEXT"); ok (defined ($iter->[2]), "ITER_NEXT"); my $record = $iter->[2]; # Is this the last record in the list? return undef if $record->{pos} >= @{ $list->{data} }; my $nextrecord = $list->{data}[$record->{pos} + 1]; ok (defined ($nextrecord), "ITER_NEXT"); ok ($nextrecord->{pos} == ($record->{pos} + 1), "ITER_NEXT"); return [ $list->{stamp}, $nextrecord->{pos}, $nextrecord, undef ]; } sub ITER_CHILDREN { my ($list, $iter) = @_; isa_ok ($list, "CustomList", "ITER_CHILDREN"); # this is a list, nodes have no children return undef if $iter; # parent == NULL is a special case; we need to return the first top-level row # No rows => no first row return undef unless @{ $list->{data} }; # Set iter to first item in list return [ $list->{stamp}, 0, $list->{data}[0] ]; } sub ITER_HAS_CHILD { my ($list, $iter) = @_; isa_ok ($list, "CustomList", "ITER_HAS_CHILD"); ok ($iter->[0] == $list->{stamp}, "ITER_HAS_CHILD"); return 'asdf'; } sub ITER_N_CHILDREN { my ($list, $iter) = @_; isa_ok ($list, "CustomList", "ITER_N_CHILDREN"); # special case: if iter == NULL, return number of top-level rows return scalar @{$list->{data}} if ! $iter; return 0; # otherwise, this is easy again for a list } sub ITER_NTH_CHILD { my ($list, $iter, $n) = @_; isa_ok ($list, "CustomList", "ITER_NTH_CHILD"); # a list has only top-level rows return undef if $iter; # special case: if parent == NULL, set iter to n-th top-level row ok ($n < @{$list->{data}}, "ITER_NTH_CHILD"); my $record = $list->{data}[$n]; ok (defined ($record), "ITER_NTH_CHILD"); ok ($record->{pos} == $n, "ITER_NTH_CHILD"); return [ $list->{stamp}, $n, $record, undef ]; } sub ITER_PARENT { my ($list, $iter) = @_; isa_ok ($list, "CustomList", "ITER_PARENT"); return undef; } sub REF_NODE { my ($list, $iter) = @_; isa_ok ($list, "CustomList", "REF_NODE"); ok ($iter->[0] == $list->{stamp}); } sub UNREF_NODE { my ($list, $iter) = @_; isa_ok ($list, "CustomList", "UNREF_NODE"); ok ($iter->[0] == $list->{stamp}); } sub set { my $list = shift; my $treeiter = shift; isa_ok ($list, "CustomList", "set"); isa_ok ($treeiter, "Gtk2::TreeIter", "set"); my ($col, $value) = @_; ok ($col == 1, "set"); my $iter = $treeiter->to_arrayref($list->{stamp}); my $record = $iter->[2]; $record->{value} = $value; } sub get_iter_from_ordinal { my $list = shift; my $ord = shift; isa_ok ($list, "CustomList", "get_iter_from_ordinal"); my $n = $ordmap{$ord}; my $record = $list->{data}[$n]; ok (defined ($record), "get_iter_from_ordinal record is valid"); my $iter = Gtk2::TreeIter->new_from_arrayref([$list->{stamp}, $n, $record, undef]); isa_ok ($iter, "Gtk2::TreeIter", "get_iter_from_ordinal"); return $iter; } ############################################################################### sub GET_SORT_COLUMN_ID { my ($list) = @_; isa_ok ($list, "CustomList"); my $id = $list->{sort_column_id}; my $order = $list->{sort_order}; return $id >= 0, $id, $order; } sub SET_SORT_COLUMN_ID { my ($list, $id, $order) = @_; isa_ok ($list, "CustomList"); is ($id, 3); is ($order, "descending"); $list->{sort_column_id} = $id; $list->{sort_order} = $order; } sub SET_SORT_FUNC { my ($list, $id, $func, $data) = @_; isa_ok ($list, "CustomList"); ok ($id == 2 || $id == 3); isa_ok ($func, "Gtk2::TreeSortable::IterCompareFunc"); ok (defined $data); $list->{sort_funcs}->[$id] = [$func, $data]; } sub SET_DEFAULT_SORT_FUNC { my ($list, $func, $data) = @_; isa_ok ($list, "CustomList"); isa_ok ($func, "Gtk2::TreeSortable::IterCompareFunc"); ok (defined $data); $list->{sort_func_default} = [$func, $data]; } sub HAS_DEFAULT_SORT_FUNC { my ($list) = @_; isa_ok ($list, "CustomList"); return defined $list->{sort_func_default}; } sub sort { my ($list, $id) = @_; my $a = $list->get_iter_from_string (1); my $b = $list->get_iter_from_string (2); if (exists $list->{sort_funcs}->[$id]) { my $func = $list->{sort_funcs}->[$id]->[0]; my $data = $list->{sort_funcs}->[$id]->[1]; is ($func->($list, $a, $b, $data), -1); } else { my $func = $list->{sort_func_default}->[0]; my $data = $list->{sort_func_default}->[1]; is ($func->($list, $a, $b, $data), 1); } } ############################################################################### package main; use Gtk2::TestHelper tests => 180, noinit => 1; use strict; use warnings; my $model = CustomList->new; ok ($model->get_flags eq [qw/iters-persist list-only/]); is ($model->get_n_columns, 23, "get_n_columns reports the number correctly"); is ($model->get_column_type (1), Glib::String::); my $path = Gtk2::TreePath->new ("5"); my $iter; isa_ok ($iter = $model->get_iter ($path), "Gtk2::TreeIter"); isa_ok ($path = $model->get_path ($iter), "Gtk2::TreePath"); is_deeply ([$path->get_indices], [5]); is ($model->get_value ($iter, 1), "Sixth"); is ($model->get ($iter, 1), "Sixth"); isa_ok ($iter = $model->iter_next ($iter), "Gtk2::TreeIter"); isa_ok ($path = $model->get_path ($iter), "Gtk2::TreePath"); is_deeply ([$path->get_indices], [6]); isa_ok ($iter = $model->iter_children(undef), "Gtk2::TreeIter"); isa_ok ($path = $model->get_path ($iter), "Gtk2::TreePath"); is_deeply ([$path->get_indices], [0]); is ($model->iter_has_child ($iter), TRUE); is ($model->iter_n_children ($iter), 0); isa_ok ($iter = $model->iter_nth_child (undef, 7), "Gtk2::TreeIter"); isa_ok ($path = $model->get_path ($iter), "Gtk2::TreePath"); is_deeply ([$path->get_indices], [7]); ok (not defined ($model->iter_parent ($iter))); isa_ok ($iter = $model->get_iter_from_ordinal ('Twelfth'), "Gtk2::TreeIter"); isa_ok ($path = $model->get_path ($iter), "Gtk2::TreePath"); is_deeply ([$path->get_indices], [11]); $model->set($iter, 1, '12th'); is ($model->get($iter, 1), '12th'); $model->ref_node ($iter); $model->unref_node ($iter); { my $signal_finished = 0; my $len = @{$model->{data}}; my @array = (0 .. $len-1); my $id = $model->signal_connect (rows_reordered => sub { my ($s_model, $path, $iter, $aref) = @_; is ($s_model, $model); isa_ok ($path, "Gtk2::TreePath"); my @indices = $path->get_indices; is_deeply (\@indices, []); is ($iter, undef); is_deeply ($aref, \@array); $signal_finished = 1; }); $model->rows_reordered (Gtk2::TreePath->new, undef, @array); ok ($signal_finished, 'rows-reordered signal ran'); $model->signal_handler_disconnect ($id); } my $sorter_two = sub { my ($list, $a, $b, $data) = @_; isa_ok ($list, "CustomList"); isa_ok ($a, "Gtk2::TreeIter"); isa_ok ($b, "Gtk2::TreeIter"); is ($data, "tada"); return -1; }; my $sorter_three = sub { my ($list, $a, $b, $data) = @_; isa_ok ($list, "CustomList"); isa_ok ($a, "Gtk2::TreeIter"); isa_ok ($b, "Gtk2::TreeIter"); is ($data, "data"); return -1; }; my $default_sorter = sub { my ($list, $a, $b, $data) = @_; isa_ok ($list, "CustomList"); isa_ok ($a, "Gtk2::TreeIter"); isa_ok ($b, "Gtk2::TreeIter"); is ($data, "atad"); return 1; }; $model->set_sort_column_id (3, "descending"); is_deeply ([$model->get_sort_column_id], [3, "descending"]); $model->set_sort_func (2, $sorter_two, "tada"); $model->set_sort_func (3, $sorter_three, "data"); $model->set_default_sort_func ($default_sorter, "atad"); ok ($model->has_default_sort_func); $model->sort(2); $model->sort(3); $model->sort(23); # This should result in a call to FINALIZE_INSTANCE $model = undef; # Exercise Gtk2::TreeIter->set. { my $myvar; my $stamp = 123; my $iter = Gtk2::TreeIter->new_from_arrayref ([$stamp, 999, \$stamp, undef]); my $aref = [$stamp, 456, undef, \$myvar]; $iter->set ($aref); is_deeply ($iter->to_arrayref($stamp), $aref, 'iter->set() from an array'); } { my $myvar; my $stamp = 123; my $iter = Gtk2::TreeIter->new_from_arrayref ([$stamp, 999, \$stamp, undef]); my $aref = [$stamp, 456, undef, \$myvar]; my $other = Gtk2::TreeIter->new_from_arrayref ($aref); $iter->set ($other); is_deeply ($iter->to_arrayref($stamp), $other->to_arrayref($stamp), 'iter->set() from another iter'); } ############################################################################### package StackTestModel; use strict; use warnings; use Glib qw/TRUE FALSE/; use Glib::Object::Subclass Glib::Object::, interfaces => [ Gtk2::TreeModel::, Gtk2::TreeSortable:: ]; our @ROW = (100,200,300,400,500,600,700,800,900,1000); sub grow_the_stack { 1 .. 500; }; sub GET_N_COLUMNS { my @list = grow_the_stack(); return scalar @ROW; } sub GET_COLUMN_TYPE { return 'Glib::String'; } sub GET_ITER { return [ 123, undef, undef, undef ]; } sub GET_VALUE { my ($self, $iter, $col) = @_; my @list = grow_the_stack(); return $ROW[$col]; } sub GET_SORT_COLUMN_ID { my @list = grow_the_stack(); return TRUE, 3, 'ascending'; } package main; use strict; use warnings; $model = StackTestModel->new; is_deeply ([ $model->get ($model->get_iter_first) ], [ @StackTestModel::ROW ], '$model->get ($iter) does not result in stack corruption'); is_deeply ([ $model->get ($model->get_iter_first, reverse 0 .. 9) ], [ reverse @StackTestModel::ROW ], '$model->get ($iter, @columns) does not result in stack corruption'); is_deeply ([ $model->get_sort_column_id ], [ 3, 'ascending' ], '$model->get_sort_column_id does not result in stack corruption'); # vim: set syntax=perl : Gtk2-1.24992/t/GtkTooltip.t0000644000175000017500000000304013076462677013670 0ustar lacklack#!/usr/bin/perl -w use strict; use Gtk2::TestHelper tests => 1, at_least_version => [2, 12, 0, "GtkTooltip appeared in 2.12"]; # $Id$ my $window = Gtk2::Window->new; $window->set (tooltip_markup => "Bla!"); my $called = 0; $window->signal_connect (query_tooltip => sub { my ($window, $x, $y, $keyboard_mode, $tip) = @_; return TRUE if $called++; isa_ok ($tip, "Gtk2::Tooltip"); $tip->set_markup ("Alb!"); $tip->set_markup (undef); $tip->set_text ('Alb!'); $tip->set_text (undef); $tip->set_icon (Gtk2::Gdk::Pixbuf->new ("rgb", TRUE, 8, 12, 12)); $tip->set_icon (undef); $tip->set_icon_from_stock ("gtk-open", "button"); $tip->set_icon_from_stock (undef, "menu"); SKIP: { skip 'new 2.14 stuff', 0 unless Gtk2->CHECK_VERSION(2, 14, 0); $tip->set_icon_from_icon_name ("gtk-open", "menu"); } $tip->set_custom (Gtk2::Button->new ("Bla!")); $tip->set_custom (undef); $tip->set_tip_area (Gtk2::Gdk::Rectangle->new (0, 0, 10, 10)); $tip->set_tip_area (undef); Glib::Idle->add (sub { Gtk2->main_quit; }); return TRUE; }); $window->realize; my $event = Gtk2::Gdk::Event->new ('motion-notify'); $event->window ($window->window); Gtk2->main_do_event ($event); Gtk2->main_do_event ($event); Gtk2->main_do_event ($event); Gtk2->main_do_event ($event); Gtk2->main_do_event ($event); Gtk2->main; Gtk2::Tooltip::trigger_tooltip_query (Gtk2::Gdk::Display->get_default); __END__ Copyright (C) 2007 by the gtk2-perl team (see the file AUTHORS for the full list). See LICENSE for more information. Gtk2-1.24992/t/GdkVisual.t0000644000175000017500000000502213076462676013462 0ustar lacklack#!/usr/bin/perl -w use strict; use Gtk2::TestHelper tests => 32; # $Id$ my @depths = Gtk2::Gdk -> query_depths(); like($depths[0], qr/^\d+$/); my @types = Gtk2::Gdk -> query_visual_types(); ok(defined($types[0])); my @visuals = Gtk2::Gdk -> list_visuals(); isa_ok($visuals[0], "Gtk2::Gdk::Visual"); like(Gtk2::Gdk::Visual -> get_best_depth(), qr/^\d+$/); ok(defined(Gtk2::Gdk::Visual -> get_best_type())); isa_ok(my $visual = Gtk2::Gdk::Visual -> get_system(), "Gtk2::Gdk::Visual"); isa_ok(Gtk2::Gdk::Visual -> get_best(), "Gtk2::Gdk::Visual"); isa_ok(Gtk2::Gdk::Visual -> get_best_with_type($types[0]), "Gtk2::Gdk::Visual"); SKIP: { my $best = Gtk2::Gdk::Visual -> get_best_with_both($depths[0], $types[0]); skip 'best test', 1 unless defined $best; isa_ok($best, "Gtk2::Gdk::Visual"); } SKIP: { skip("get_best_with_depth seems to be broken in 2.2", 1) if ((Gtk2 -> GET_VERSION_INFO())[0] == 2 && (Gtk2 -> GET_VERSION_INFO())[1] == 2); isa_ok(Gtk2::Gdk::Visual -> get_best_with_depth($depths[0]), "Gtk2::Gdk::Visual"); } SKIP: { skip("GdkScreen is new in 2.2", 1) unless (Gtk2 -> CHECK_VERSION(2, 2, 0)); isa_ok($visual -> get_screen(), "Gtk2::Gdk::Screen"); } ok(defined($visual -> type)); ok(defined($visual -> byte_order)); like($visual -> colormap_size, qr/^\d+$/); like($visual -> bits_per_rgb, qr/^\d+$/); like($visual -> red_mask, qr/^\d+$/); like($visual -> red_shift, qr/^\d+$/); like($visual -> red_prec, qr/^\d+$/); like($visual -> green_mask, qr/^\d+$/); like($visual -> green_shift, qr/^\d+$/); like($visual -> green_prec, qr/^\d+$/); like($visual -> blue_mask, qr/^\d+$/); like($visual -> blue_shift, qr/^\d+$/); like($visual -> blue_prec, qr/^\d+$/); SKIP: { skip 'new 2.22 stuff', 8 unless Gtk2->CHECK_VERSION(2, 22, 0); my $visual = Gtk2::Gdk::Visual -> get_system(); my ($mask, $shift, $precision) = $visual -> get_blue_pixel_details(); ok(defined $mask && defined $shift && defined $precision); ($mask, $shift, $precision) = $visual -> get_green_pixel_details(); ok(defined $mask && defined $shift && defined $precision); ($mask, $shift, $precision) = $visual -> get_red_pixel_details(); ok(defined $mask && defined $shift && defined $precision); ok(defined $visual -> get_bits_per_rgb()); ok(defined $visual -> get_byte_order()); ok(defined $visual -> get_colormap_size()); ok(defined $visual -> get_depth()); ok(defined $visual -> get_visual_type()); } __END__ Copyright (C) 2004 by the gtk2-perl team (see the file AUTHORS for the full list). See LICENSE for more information. Gtk2-1.24992/t/GtkAssistant.t0000644000175000017500000000500113076462676014205 0ustar lacklack#!/usr/bin/perl -w # vim: set ft=perl : use strict; use Gtk2::TestHelper tests => 26, at_least_version => [2, 10, 0, "GtkAssistant is new in 2.10"]; #typedef gint (*GtkAssistantPageFunc) (gint current_page, gpointer data); my $assistant = Gtk2::Assistant->new; isa_ok ($assistant, 'Gtk2::Assistant'); isa_ok ($assistant, 'Gtk2::Window'); isa_ok ($assistant->get_cancel_button (), 'Gtk2::Button'); isa_ok ($assistant->get_forward_button (), 'Gtk2::Button'); isa_ok ($assistant->get_back_button (), 'Gtk2::Button'); isa_ok ($assistant->get_apply_button (), 'Gtk2::Button'); isa_ok ($assistant->get_close_button (), 'Gtk2::Button'); isa_ok ($assistant->get_last_button (), 'Gtk2::Button'); # add some pages... sub make_a_page { my $label = Gtk2::Label->new (shift); $label->show; return $label; } is ($assistant->append_page (make_a_page ("appended")), 0); is ($assistant->prepend_page (make_a_page ("prepended")), 0); is ($assistant->insert_page (make_a_page ("inserted first"), 0), 0); is ($assistant->insert_page (make_a_page ("inserted at 2"), 2), 2); is ($assistant->insert_page (make_a_page ("inserted last"), -1), 4); is ($assistant->get_n_pages, 5); is ($assistant->get_current_page (), -1, "none set yet"); $assistant->set_current_page (3); is ($assistant->get_current_page (), 3); my $page = $assistant->get_nth_page (2); isa_ok ($page, 'Gtk2::Widget'); $assistant->set_page_title ($page, "a title"); is ($assistant->get_page_title ($page), "a title"); $assistant->set_page_type ($page, "content"); is ($assistant->get_page_type ($page), "content"); ok (!$assistant->get_page_complete ($page)); $assistant->set_page_complete ($page, TRUE); ok ($assistant->get_page_complete ($page)); my $header_image = Gtk2::Gdk::Pixbuf->new ('rgb', FALSE, 8, 45, 20); my $side_image = Gtk2::Gdk::Pixbuf->new ('rgb', FALSE, 8, 20, 45); ok (!$assistant->get_page_header_image ($page)); $assistant->set_page_header_image ($page, $header_image); is ($assistant->get_page_header_image ($page), $header_image); ok (!$assistant->get_page_side_image ($page)); $assistant->set_page_side_image ($page, $side_image); is ($assistant->get_page_side_image ($page), $side_image); my $button = Gtk2::Button->new ("extra"); $assistant->add_action_widget ($button); $assistant->remove_action_widget ($button); $assistant->update_buttons_state (); $assistant->set_forward_page_func (\&page_func); sub page_func { ok (1); } SKIP: { skip 'new 2.22 stuff', 0 unless Gtk2->CHECK_VERSION(2, 22, 0); my $assistant = Gtk2::Assistant->new; $assistant->commit; } Gtk2-1.24992/t/GdkDisplay.t0000644000175000017500000000664513076462676013640 0ustar lacklack#!/usr/bin/perl -w use strict; use Gtk2::TestHelper tests => 27, at_least_version => [2, 2, 0, "GdkDisplay is new in 2.2"]; # $Id$ my $display = Gtk2::Gdk::Display -> get_default(); isa_ok($display, "Gtk2::Gdk::Display"); ok(defined($display -> get_name())); SKIP: { skip '$ENV{DISPLAY} is not set', 2 unless exists $ENV{DISPLAY}; isa_ok(Gtk2::Gdk::Display -> open($ENV{DISPLAY}), "Gtk2::Gdk::Display"); isa_ok(Gtk2::Gdk::Display -> open(undef), "Gtk2::Gdk::Display"); } like($display -> get_n_screens(), qr/^\d+$/); isa_ok($display -> get_screen(0), "Gtk2::Gdk::Screen"); isa_ok($display -> get_default_screen(), "Gtk2::Gdk::Screen"); $display -> pointer_ungrab(0); $display -> keyboard_ungrab(0); ok(!$display -> pointer_is_grabbed()); # $display -> beep(); $display -> sync(); # Do this twice to ensure we did not damage the list. isa_ok(($display -> list_devices())[0], "Gtk2::Gdk::Device"); isa_ok(($display -> list_devices())[0], "Gtk2::Gdk::Device"); $display -> put_event(Gtk2::Gdk::Event -> new("button-press")); isa_ok($display -> peek_event(), "Gtk2::Gdk::Event"); isa_ok($display -> get_event(), "Gtk2::Gdk::Event"); $display -> set_double_click_time(20); my ($screen, $x, $y, $mask) = $display -> get_pointer(); isa_ok($screen, "Gtk2::Gdk::Screen"); like($x, qr/^\d+$/); like($y, qr/^\d+$/); isa_ok($mask, "Gtk2::Gdk::ModifierType"); # warn $display -> get_window_at_pointer(); SKIP: { skip("stuff new in 2.4", 6) unless Gtk2 -> CHECK_VERSION(2, 4, 0); $display -> flush(); $display -> set_double_click_distance(5); ok(defined($display -> supports_cursor_color())); ok(defined($display -> supports_cursor_alpha())); like($display -> get_default_cursor_size(), qr/^\d+$/); my ($width, $height) = $display -> get_maximal_cursor_size(); like($width, qr/^\d+$/); like($height, qr/^\d+$/); my $default_group = $display -> get_default_group(); skip 'no default group', 1 unless defined $default_group; isa_ok($default_group, "Gtk2::Gdk::Window"); } SKIP: { skip("new 2.6 stuff", 1) unless Gtk2 -> CHECK_VERSION(2, 6, 0); if ($display -> supports_selection_notification()) { is($display -> request_selection_notification(Gtk2::Gdk::Atom -> intern("text/plain")), TRUE); } else { ok(1); } if ($display -> supports_clipboard_persistence()) { my $window = Gtk2::Window -> new(); $window -> realize(); $display -> store_clipboard($window -> window, 0, Gtk2::Gdk::Atom -> intern("text/plain"), Gtk2::Gdk::Atom -> intern("image/png")); $display -> store_clipboard($window -> window, 0); } } SKIP: { skip("new 2.8 stuff", 0) unless Gtk2 -> CHECK_VERSION(2, 8, 0); $display -> warp_pointer($screen, 100, 100); } SKIP: { skip("new 2.10 stuff", 2) unless Gtk2->CHECK_VERSION(2, 10, 0); ok (defined $display->supports_shapes); ok (defined $display->supports_input_shapes); } SKIP: { skip("new 2.12 stuff", 1) unless Gtk2->CHECK_VERSION(2, 12, 0); ok (defined $display->supports_composite); } # FIXME: currently segfaults for me. see #85715. # $display -> close(); SKIP: { skip 'new 2.22 stuff', 1 unless Gtk2->CHECK_VERSION(2, 22, 0); my $display = Gtk2::Gdk::Display -> get_default(); ok (defined $display->is_closed); } __END__ Copyright (C) 2003-2005, 2012 by the gtk2-perl team (see the file AUTHORS for the full list). See LICENSE for more information. Gtk2-1.24992/t/GtkTable.t0000644000175000017500000000171713076462677013276 0ustar lacklack#!/usr/bin/perl -w use strict; use Gtk2::TestHelper tests => 6; # $Id$ my $table = Gtk2::Table -> new(5, 5, 1); $table -> resize(23, 42); my $label = Gtk2::Label -> new("Bla"); my $button = Gtk2::Button -> new("Bla"); $table -> attach($label, 0, 1, 0, 1, "expand", "shrink", 1, 1); $table -> attach_defaults($button, 0, 1, 1, 2); $table -> set_row_spacing(1, 5); is($table -> get_row_spacing(1), 5); $table -> set_col_spacing(1, 5); is($table -> get_col_spacing(1), 5); $table -> set_row_spacings(5); is($table -> get_default_row_spacing(), 5); $table -> set_col_spacings(5); is($table -> get_default_col_spacing(), 5); $table -> set_homogeneous(0); ok(! $table -> get_homogeneous()); SKIP: { skip 'new 2.22 stuff', 1 unless Gtk2->CHECK_VERSION(2, 22, 0); my ($w, $h) = $table -> get_size(); ok (defined $w && defined $h); } __END__ Copyright (C) 2003 by the gtk2-perl team (see the file AUTHORS for the full list). See LICENSE for more information. Gtk2-1.24992/t/GtkVScrollbar.t0000644000175000017500000000061113076462677014310 0ustar lacklack#!/usr/bin/perl -w use strict; use Gtk2::TestHelper tests => 2, noinit => 1; # $Id$ my $adjustment = Gtk2::Adjustment -> new(0, 0, 100, 1, 5, 10); my $bar = Gtk2::VScrollbar -> new($adjustment); isa_ok($bar, "Gtk2::Scrollbar"); isa_ok($bar, "Gtk2::VScrollbar"); __END__ Copyright (C) 2003 by the gtk2-perl team (see the file AUTHORS for the full list). See LICENSE for more information. Gtk2-1.24992/t/GtkLinkButton.t0000644000175000017500000000465713076462677014346 0ustar lacklack#!/usr/bin/perl -w # vim: set ft=perl : use strict; use Gtk2::TestHelper tests => 28, at_least_version => [2, 10, 0, "GtkLinkButton is new in 2.10"]; my $button; my $url = "http://google.com/"; $button = Gtk2::LinkButton->new ($url); isa_ok ($button, 'Gtk2::LinkButton'); isa_ok ($button, 'Gtk2::Button'); is ($button->get_uri, $url); is ($button->get_label, $url); # interesting $button = Gtk2::LinkButton->new ($url, "a label"); isa_ok ($button, 'Gtk2::LinkButton'); isa_ok ($button, 'Gtk2::Button'); is ($button->get_uri, $url); is ($button->get_label, "a label"); $button = Gtk2::LinkButton->new_with_label ($url, "a label"); isa_ok ($button, 'Gtk2::LinkButton'); isa_ok ($button, 'Gtk2::Button'); is ($button->get_uri, $url); is ($button->get_label, "a label"); # this also works... $button = Gtk2::LinkButton->new_with_label ($url); isa_ok ($button, 'Gtk2::LinkButton'); isa_ok ($button, 'Gtk2::Button'); is ($button->get_uri, $url); is ($button->get_label, $url); # interesting $url = "http://www.gnome.org/"; $button->set_uri ($url); is ($button->get_uri, $url); sub hook { my ($widget, $link, $data) = @_; is ($widget, $button); is ($link, $url); isa_ok ($data, 'HASH'); is ($data->{whee}, "woo hoo"); } $button->set_uri_hook (\&hook, { whee => "woo hoo" }); $button->clicked; $button->set_uri_hook (undef); { my $saw_data; sub hook2 { $saw_data = $_[-1]; $_[-1]++; } $button->set_uri_hook (\&hook2, 100); $button->clicked; is ($saw_data, 100, 'initial userdata'); $button->clicked; is ($saw_data, 101, 'incremented once'); $button->clicked; is ($saw_data, 102, 'incremented twice'); $button->set_uri_hook (undef); } { my $userdata = [ 'something' ]; sub hook3 { $_[-1] = undef; } $button->set_uri_hook (\&hook3, $userdata); require Scalar::Util; Scalar::Util::weaken ($userdata); is_deeply ($userdata, [ 'something' ], 'still alive when first weakened'); $button->clicked; is ($userdata, undef, 'then gone when hook zaps its last arg'); $button->set_uri_hook (undef); } { my $saw_data; sub hook4 { $button->set_uri_hook (undef); $saw_data = $_[-1]; } $button->set_uri_hook (\&hook4, [ 'hello' ]); $button->clicked; is_deeply ($saw_data, [ 'hello' ], 'userdata still ok when hook disconnects itself'); } SKIP: { skip 'new 2.14 stuff', 1 unless Gtk2->CHECK_VERSION(2, 14, 0); $button->set_visited (TRUE); is ($button->get_visited, TRUE); } Gtk2-1.24992/t/GtkArrow.t0000644000175000017500000000110613076462676013330 0ustar lacklack#!/usr/bin/perl -w use strict; use Gtk2::TestHelper tests => 3, noinit => 1; # $Id$ # From Ross' original test. my $arrow = Gtk2::Arrow -> new('up', 'none'); isa_ok($arrow, 'Gtk2::Arrow'); is_deeply([$arrow -> get(qw/arrow-type shadow-type/)], ['up', 'none'], '$arrow->new, verify'); $arrow -> set('down', 'in'); is_deeply([$arrow -> get(qw/arrow-type shadow-type/)], ['down', 'in'], '$arrow->set, verify'); __END__ Copyright (C) 2003 by the gtk2-perl team (see the file AUTHORS for the full list). See LICENSE for more information. Gtk2-1.24992/t/GtkMenuToolButton.t0000644000175000017500000000216213076462677015200 0ustar lacklack#!/usr/bin/perl -w use strict; use Gtk2::TestHelper tests => 5, at_least_version => [2, 6, 0, "GtkMenuToolButton is new in 2.6"]; # $Id$ my $label = Gtk2::Label -> new("Urgs"); my $button = Gtk2::MenuToolButton -> new($label, "Urgs"); isa_ok($button, "Gtk2::MenuToolButton"); $button = Gtk2::MenuToolButton -> new(undef, undef); isa_ok($button, "Gtk2::MenuToolButton"); $button = Gtk2::MenuToolButton -> new_from_stock("gtk-ok"); isa_ok($button, "Gtk2::MenuToolButton"); my $menu = Gtk2::Menu -> new(); $button -> set_menu($menu); is($button -> get_menu(), $menu); $button -> set_menu(undef); is($button -> get_menu(), undef); my $tooltips = Gtk2::Tooltips -> new(); $button -> set_arrow_tooltip($tooltips, "Urgs", "Urgs"); SKIP: { skip 'new 2.12 stuff', 0 unless Gtk2 -> CHECK_VERSION(2, 12, 0); $button -> set_arrow_tooltip_text('Bla!'); $button -> set_arrow_tooltip_text(undef); $button -> set_arrow_tooltip_markup('Bla!'); $button -> set_arrow_tooltip_markup(undef); } __END__ Copyright (C) 2004 by the gtk2-perl team (see the file AUTHORS for the full list). See LICENSE for more information. Gtk2-1.24992/t/PangoFont.t0000644000175000017500000001212313076462677013465 0ustar lacklack#!/usr/bin/perl -w use strict; use Gtk2::TestHelper tests => 57; # $Id$ my $description = Gtk2::Pango::FontDescription -> new(); isa_ok($description, "Gtk2::Pango::FontDescription"); like($description -> hash(), qr/^\d+$/); is($description -> equal($description), 1); $description -> set_family("Sans"); $description -> set_family_static("Sans"); is($description -> get_family(), "Sans"); $description -> set_style("normal"); is($description -> get_style(), "normal"); $description -> set_variant("normal"); is($description -> get_variant(), "normal"); $description -> set_weight("bold"); is($description -> get_weight(), "bold"); $description -> set_stretch("condensed"); is($description -> get_stretch(), "condensed"); $description -> set_size(23); is($description -> get_size(), 23); isa_ok($description -> get_set_fields(), "Gtk2::Pango::FontMask"); $description -> unset_fields([qw(size stretch)]); $description -> merge($description, 1); $description -> merge_static($description, 1); ok(!$description -> better_match($description, $description)); ok($description -> better_match(undef, $description)); $description = Gtk2::Pango::FontDescription -> from_string("Sans 12"); isa_ok($description, "Gtk2::Pango::FontDescription"); is($description -> to_string(), "Sans 12"); ok(defined($description -> to_filename())); SKIP: { skip("new 1.8 stuff", 1) unless (Gtk2::Pango -> CHECK_VERSION(1, 8, 0)); $description -> set_absolute_size(23.42); is($description -> get_size_is_absolute(), TRUE); } SKIP: { skip("new 1.16 stuff", 1) unless (Gtk2::Pango -> CHECK_VERSION(1, 16, 0)); $description -> set_gravity("south"); is($description -> get_gravity(), "south"); } ############################################################################### my $label = Gtk2::Label -> new("Bla"); my $context = $label -> create_pango_context(); my $font = $context -> load_font($description); my $language = Gtk2 -> get_default_language(); my $number = qr/^-?\d+$/; isa_ok($font -> describe(), "Gtk2::Pango::FontDescription"); SKIP: { skip "new 1.14 stuff", 1 unless Gtk2::Pango -> CHECK_VERSION(1, 14, 0); isa_ok($font -> describe_with_absolute_size(), "Gtk2::Pango::FontDescription"); } foreach my $rectangle ($font -> get_glyph_extents(23)) { foreach my $key (qw(x y width height)) { like($rectangle -> { $key }, $number); } } my $metrics = $font -> get_metrics($language); isa_ok($metrics, "Gtk2::Pango::FontMetrics"); like($metrics -> get_ascent(), $number); like($metrics -> get_descent(), $number); like($metrics -> get_approximate_char_width(), $number); like($metrics -> get_approximate_digit_width(), $number); SKIP: { skip("new 1.6 stuff", 4) unless (Gtk2::Pango -> CHECK_VERSION(1, 6, 0)); like($metrics -> get_underline_position(), $number); like($metrics -> get_underline_thickness(), $number); like($metrics -> get_strikethrough_position(), $number); like($metrics -> get_strikethrough_thickness(), $number); } SKIP: { skip("new 1.10 stuff", 1) unless (Gtk2::Pango -> CHECK_VERSION(1, 10, 0)); isa_ok($font -> get_font_map(), "Gtk2::Pango::FontMap"); } ############################################################################### like(int(Gtk2::Pango -> scale()), $number); like(int(Gtk2::Pango -> scale_xx_small()), $number); like(int(Gtk2::Pango -> scale_x_small()), $number); like(int(Gtk2::Pango -> scale_small()), $number); like(int(Gtk2::Pango -> scale_medium()), $number); like(int(Gtk2::Pango -> scale_large()), $number); like(int(Gtk2::Pango -> scale_x_large()), $number); like(int(Gtk2::Pango -> scale_xx_large()), $number); like(int(Gtk2::Pango -> PANGO_PIXELS(23)), $number); like(int(Gtk2::Pango -> pixels(23)), $number); ############################################################################### my @families = $context->list_families; ok (@families > 0, 'got a list of families'); isa_ok ($families[0], 'Gtk2::Pango::FontFamily'); ok ($families[0]->get_name, 'get_name works'); SKIP: { skip "is_monospace is new in 1.4.0", 1 unless Gtk2::Pango->CHECK_VERSION (1, 4, 0); # we don't really have a way of knowing if this font should actually # be monospaced, so just check that the function doesn't die. $families[0]->is_monospace; ok (1, 'is_monospace works'); } my @faces = $families[0]->list_faces; #print "faces @faces\n"; ok (@faces > 0, 'got a list of faces'); isa_ok ($faces[0], 'Gtk2::Pango::FontFace'); my $desc = $faces[0]->describe; isa_ok ($desc, 'Gtk2::Pango::FontDescription'); ok ($faces[0]->get_face_name); SKIP: { skip "list_sizes is new in 1.4.0", 1 unless Gtk2::Pango->CHECK_VERSION (1, 4, 0); # again, whether we'll get sizes depends on whether this first font and # face is a bitmapped font. we can't know that, so just test that the # call does not result in a crash. my @sizes = $faces[0]->list_sizes; #print "sizes @sizes\n"; ok (1, 'list_sizes did not crash'); } SKIP: { skip("new 1.18 stuff", 1) unless (Gtk2::Pango -> CHECK_VERSION(1, 18, 0)); ok(defined $faces[0]->is_synthesized); } __END__ Copyright (C) 2003-2005 by the gtk2-perl team (see the file AUTHORS for the full list). See LICENSE for more information. Gtk2-1.24992/t/GtkLayout.t0000644000175000017500000000220413076462677013514 0ustar lacklack#!/usr/bin/perl -w use strict; use Gtk2::TestHelper tests => 9; # $Id$ my $layout = Gtk2::Layout -> new(); isa_ok($layout, "Gtk2::Layout"); $layout = Gtk2::Layout -> new(undef, undef); isa_ok($layout, "Gtk2::Layout"); my $adjustment = Gtk2::Adjustment -> new(0, 0, 100, 1, 5, 10); $layout -> set_hadjustment($adjustment); is($layout -> get_hadjustment(), $adjustment); $layout -> set_vadjustment($adjustment); is($layout -> get_vadjustment(), $adjustment); $layout = Gtk2::Layout -> new($adjustment, $adjustment); isa_ok($layout, "Gtk2::Layout"); my $label = Gtk2::Label -> new("Bla"); $layout -> put($label, 23, 42); $layout -> move($label, 5, 5); $layout -> set_size(10, 10); is_deeply([$layout -> get_size()], [10, 10]); is($layout -> get_bin_window(), undef); my $window = Gtk2::Window -> new(); $window -> add($layout); $layout -> realize(); isa_ok($layout -> get_bin_window(), "Gtk2::Gdk::Window"); # deprecated but kept for backwards compatibility ok($layout -> bin_window() == $layout -> get_bin_window()); __END__ Copyright (C) 2003 by the gtk2-perl team (see the file AUTHORS for the full list). See LICENSE for more information. Gtk2-1.24992/t/GtkSpinButton.t0000644000175000017500000000224313076462677014347 0ustar lacklack#!/usr/bin/perl -w use strict; use Gtk2::TestHelper tests => 12; # $Id$ my $adjustment = Gtk2::Adjustment -> new(0, 0, 100, 1, 5, 0); my $spin = Gtk2::SpinButton -> new($adjustment, 0.2, 1); isa_ok($spin, "Gtk2::SpinButton"); ginterfaces_ok($spin); $spin -> configure($adjustment, 0.2, 1); $spin -> set_adjustment($adjustment); is($spin -> get_adjustment(), $adjustment); $spin = Gtk2::SpinButton -> new_with_range(0, 100, 5); $spin -> set_digits(3); is($spin -> get_digits(), 3); $spin -> set_increments(5, 20); is_deeply([$spin -> get_increments()], [5, 20]); $spin -> set_range(0, 100); is_deeply([$spin -> get_range()], [0, 100]); $spin -> set_value(23.42); is($spin -> get_value_as_int(), 23); delta_ok($spin -> get_value(), 23.42); $spin -> set_update_policy("if-valid"); is($spin -> get_update_policy(), "if-valid"); $spin -> set_numeric(1); is($spin -> get_numeric(), 1); $spin -> spin("end", 10); $spin -> set_wrap(1); is($spin -> get_wrap(), 1); $spin -> set_snap_to_ticks(1); is($spin -> get_snap_to_ticks(), 1); $spin -> update(); __END__ Copyright (C) 2003 by the gtk2-perl team (see the file AUTHORS for the full list). See LICENSE for more information. Gtk2-1.24992/t/GtkTextTag.t0000644000175000017500000000137413076462677013626 0ustar lacklack#!/usr/bin/perl -w use strict; use Gtk2::TestHelper tests => 2; # $Id$ my $tag = Gtk2::TextTag -> new("bla"); isa_ok($tag, "Gtk2::TextTag"); my $table = Gtk2::TextTagTable -> new(); $table -> add($tag); $tag -> set_priority(0); is($tag -> get_priority(), 0); my $model = Gtk2::TextBuffer -> new(); $model -> insert($model -> get_start_iter(), join("", "Lore ipsem dolor. I think that is misspelled.\n" x 80)); my $button = Gtk2::Button -> new("Bla"); my $event = Gtk2::Gdk::Event -> new("button-press"); my $iter = $model -> get_iter_at_offset(10); # FIXME: check retval? $tag -> event($button, $event, $iter); __END__ Copyright (C) 2003 by the gtk2-perl team (see the file AUTHORS for the full list). See LICENSE for more information. Gtk2-1.24992/t/tied-objects.t0000644000175000017500000000061213076462677014146 0ustar lacklack#!/usr/bin/perl use strict; use warnings; use Tie::Hash; use Glib qw/:constants/; use Gtk2::TestHelper tests => 1; # Make sure a tied Glib::Object is handled normally. Based on a test sent to # the list by Terrence Brannon. tie my %objects, 'Tie::StdHash'; my $vbox = Gtk2::VBox->new (FALSE, 0); $objects{button} = Gtk2::Button->new ('Quit'); ok (eval { $vbox->add ($objects{button}); 1 }); Gtk2-1.24992/t/GdkCairo.t0000644000175000017500000000416113076462676013257 0ustar lacklack#!/usr/bin/perl -w # vim: set ft=perl : use strict; use Glib qw/TRUE FALSE/; use Gtk2; use Test::More; if (! (UNIVERSAL::can("Gtk2::Gdk::Cairo::Context", "create") && Gtk2 -> CHECK_VERSION(2, 8, 0))) { plan skip_all => "Need Cairo"; } elsif (! Gtk2->init_check) { plan skip_all => "Gtk2->init_check failed, probably unable to open DISPLAY"; } else { plan tests => 6; } # $Id$ my $window = Gtk2::Window -> new(); $window -> realize(); my $context = Gtk2::Gdk::Cairo::Context -> create($window -> window); isa_ok($context, "Gtk2::Gdk::Cairo::Context"); isa_ok($context, "Cairo::Context"); my $color = Gtk2::Gdk::Color -> new(0xffff, 0xffff, 0xffff); $context -> set_source_color($color); my $pixbuf = Gtk2::Gdk::Pixbuf -> new("rgb", FALSE, 8, 100, 100); $context -> set_source_pixbuf($pixbuf, 10, 10); my $rectangle = Gtk2::Gdk::Rectangle -> new(10, 10, 10, 10); $context -> rectangle($rectangle); my $region = Gtk2::Gdk::Region -> new(); $context -> region($region); # Making sure it's still a valid Cairo::Context ... $context -> set_operator("clear"); $context -> rectangle(0, 0, 10, 10); SKIP: { skip "new 2.10 stuff", 2 unless Gtk2 -> CHECK_VERSION(2, 10, 0); my $pixmap = Gtk2::Gdk::Pixmap -> new($window->window, 20, 20, -1); $context -> set_source_pixmap($pixmap, 10, 10); my $screen = Gtk2::Gdk::Screen->get_default; my $options = Cairo::FontOptions->create; $screen->set_font_options (undef); is ($screen->get_font_options, undef); $screen->set_font_options ($options); isa_ok ($screen->get_font_options, "Cairo::FontOptions"); } SKIP: { skip "reset_clip is new in gtk+ 2.18", 0 unless Gtk2 -> CHECK_VERSION(2, 18, 0); $context->reset_clip ($window->window); } SKIP: { skip 'new 2.22 stuff', 2 unless Gtk2->CHECK_VERSION(2, 22, 0); my $window = Gtk2::Gdk::Window -> new(undef, { window_type => 'toplevel' }); isa_ok ($window->create_similar_surface ('color', 23, 42), 'Cairo::Surface'); isa_ok ($window->get_background_pattern, 'Cairo::Pattern'); } __END__ Copyright (C) 2005-2008 by the gtk2-perl team (see the file AUTHORS for the full list). See LICENSE for more information. Gtk2-1.24992/t/GdkRegion.t0000644000175000017500000000714313076462676013450 0ustar lacklack#!/usr/bin/perl -w use strict; use Gtk2::TestHelper tests => 35, noinit => 1; # $Id$ my $rectangle_one = Gtk2::Gdk::Rectangle -> new(23, 42, 10, 10); my $rectangle_two = Gtk2::Gdk::Rectangle -> new(23, 42, 15, 15); isa_ok($rectangle_one -> intersect($rectangle_two), "Gtk2::Gdk::Rectangle"); isa_ok($rectangle_one -> union($rectangle_two), "Gtk2::Gdk::Rectangle"); { my $pspec = Glib::ParamSpec->boxed ('bb','bb','blurb', 'Gtk2::Gdk::Rectangle', Glib::G_PARAM_READWRITE); my $rect = Gtk2::Gdk::Rectangle->new (1,2,3,4); my ($flag, $new) = $pspec->value_validate($rect); undef $rect; ok (! $flag, 'value_validate() rectangle unchanged'); is ($new->x, 1, ); is ($new->y, 2); is ($new->width, 3); is ($new->height, 4); } my $region = Gtk2::Gdk::Region -> new(); isa_ok($region, "Gtk2::Gdk::Region"); ok($region -> empty()); $region = Gtk2::Gdk::Region -> polygon([ 5, 5, 10, 5, 5, 10, 10, 10], "winding-rule"); isa_ok($region, "Gtk2::Gdk::Region"); is($region -> rect_in(Gtk2::Gdk::Rectangle -> new(7, 7, 1, 1)), "in"); is($region -> rect_in(Gtk2::Gdk::Rectangle -> new(0, 0, 3, 3)), "out"); is($region -> rect_in(Gtk2::Gdk::Rectangle -> new(5, 5, 6, 6)), "part"); $region = Gtk2::Gdk::Region -> rectangle($rectangle_one); isa_ok($region, "Gtk2::Gdk::Region"); isa_ok($region -> get_clipbox(), "Gtk2::Gdk::Rectangle"); { my $empty = Gtk2::Gdk::Region->new; ok (eq_array ([$empty->get_clipbox->values], [0, 0, 0, 0]), '$empty->get_clipbox returns valid rectangle'); } isa_ok(($region -> get_rectangles())[0], "Gtk2::Gdk::Rectangle"); ok($region -> equal($region)); ok($region -> point_in(30, 50)); $region -> spans_intersect_foreach([24, 43, 5, 24, 43, 5], 1, sub { my ($x, $y, $width, $data) = @_; is($x, 24); is($y, 43); is($width, 5); is($data, "bla"); }, "bla"); { my $callback = 0; $region -> spans_intersect_foreach([], 1, sub { $callback = 1; }); is($callback, 0, 'spans_intersect_foreach() 0 coords - no callback'); } ok (! eval { $region->spans_intersect_foreach([1], 1, sub {}); 1 }, 'spans_intersect_foreach() 1 coord - expect error'); ok (! eval { $region->spans_intersect_foreach([1,2], 1, sub {}); 1 }, 'spans_intersect_foreach() 2 coords - expect error'); ok ( eval { $region->spans_intersect_foreach([1,2,3], 1, sub {}); 1 }, 'spans_intersect_foreach() 3 coords - expect good'); ok (! eval { $region->spans_intersect_foreach([1,2,3,4], 1, sub {}); 1 }, 'spans_intersect_foreach() 4 coords - expect error'); ok (! eval { $region->spans_intersect_foreach([1,2,3,4,5], 1, sub {}); 1 }, 'spans_intersect_foreach() 5 coords - expect error'); ok ( eval { $region->spans_intersect_foreach([1,2,3,4,5,6], 1, sub {}); 1 }, 'spans_intersect_foreach() 6 coords - expect good'); $region -> offset(5, 5); $region -> shrink(5, 5); $region -> union_with_rect($rectangle_two); my $region_two = Gtk2::Gdk::Region -> rectangle($rectangle_two); $region -> intersect($region_two); $region -> union($region_two); $region -> subtract($region_two); $region -> xor($region_two); SKIP: { skip "new 2.18 stuff", 1 unless Gtk2 -> CHECK_VERSION(2, 18, 0); my $region= Gtk2::Gdk::Region -> rectangle($rectangle_one); ok(!$region->rect_equal($rectangle_two), 'rect_equal'); } __END__ Copyright (C) 2003, 2010 by the gtk2-perl team (see the file AUTHORS for the full list). See LICENSE for more information. Gtk2-1.24992/t/GtkAccelLabel.t0000644000175000017500000000111613076462676014206 0ustar lacklack#!/usr/bin/perl -w use strict; use Gtk2::TestHelper tests => 5; # $Id$ my $button = Gtk2::Button -> new("Blub"); my $label = Gtk2::AccelLabel -> new("Bla"); isa_ok($label, "Gtk2::AccelLabel"); # undef for no accel-widget $label -> set_accel_widget(undef); is($label -> get_accel_widget(), undef); $label -> set_accel_widget($button); is($label -> get_accel_widget(), $button); like($label -> get_accel_width(), qr/^\d+$/); ok(! $label -> refetch()); __END__ Copyright (C) 2003, 2010 by the gtk2-perl team (see the file AUTHORS for the full list). See LICENSE for more information. Gtk2-1.24992/t/set-scroll-adjustments-signal.t0000644000175000017500000000247113076462677017500 0ustar lacklack#!/usr/bin/perl -w # vim: set ft=perl : use Gtk2::TestHelper tests => 9; use strict; my $thing = ICanScroll->new; isa_ok ($thing, 'ICanScroll'); my $scroller = Gtk2::ScrolledWindow->new; # this will call gtk_widget_set_scroll_adjustments() and attempt to emit # the set_scroll_adjustments signal. # this isn't a signal you're supposed to connect to, but we're cheating # so we can test it. my $id = $thing->signal_connect (set_scroll_adjustments => sub { my ($self, $hadj, $vadj) = @_; isa_ok ($thing, 'ICanScroll'); is ($hadj, $scroller->get_hadjustment, 'got scroller\'s hadj'); is ($vadj, $scroller->get_vadjustment, 'got scroller\'s vadj'); }); $scroller->add ($thing); $thing->signal_handler_disconnect ($id); # this will call gtk_widget_set_scroll_adjustments() again, this time # with undef for both adjustments. $thing->signal_connect (set_scroll_adjustments => sub { my ($self, $hadj, $vadj) = @_; isa_ok ($thing, 'ICanScroll'); is ($hadj, undef, 'got undef for hadj'); is ($vadj, undef, 'got undef for vadj'); }); $scroller->destroy; $scroller = undef; package ICanScroll; use strict; use Test::More; use Gtk2; use Glib::Object::Subclass Gtk2::HBox::, signals => { set_scroll_adjustments => { param_types => [qw(Gtk2::Adjustment Gtk2::Adjustment)], class_closure => sub { ok(1) }, }, }, ; Gtk2-1.24992/t/GtkFileSelection.t0000644000175000017500000000274113076462677014772 0ustar lacklack#!/usr/bin/perl -w use strict; use Gtk2::TestHelper tests => 19; # $Id$ my $fs = Gtk2::FileSelection -> new("Bla"); isa_ok($fs, "Gtk2::FileSelection"); isa_ok($fs -> dir_list(), "Gtk2::TreeView"); isa_ok($fs -> file_list(), "Gtk2::TreeView"); isa_ok($fs -> selection_entry(), "Gtk2::Entry"); isa_ok($fs -> selection_text(), "Gtk2::Label"); isa_ok($fs -> main_vbox(), "Gtk2::VBox"); isa_ok($fs -> ok_button(), "Gtk2::Button"); isa_ok($fs -> cancel_button(), "Gtk2::Button"); # isa_ok($fs -> help_button(), "Gtk2::Button"); isa_ok($fs -> history_pulldown(), "Gtk2::OptionMenu"); isa_ok($fs -> history_menu(), "Gtk2::Menu"); # isa_ok($fs -> fileop_dialog(), "Gtk2::Dialog"); # isa_ok($fs -> fileop_entry(), "Gtk2::Entry"); isa_ok($fs -> fileop_c_dir(), "Gtk2::Button"); isa_ok($fs -> fileop_del_file(), "Gtk2::Button"); isa_ok($fs -> fileop_ren_file(), "Gtk2::Button"); isa_ok($fs -> button_area(), "Gtk2::Widget"); isa_ok($fs -> action_area(), "Gtk2::HBox"); use Cwd; use File::Spec; my $this = File::Spec -> catfile(cwd(), $0); $fs -> set_filename($this); is($fs -> get_filename(), $this); my $that = $this; substr($that, -1, 1, ""); $fs -> complete($that); is($fs -> get_filename(), $this); $fs -> show_fileop_buttons(); $fs -> hide_fileop_buttons(); is_deeply([$fs -> get_selections()], [$this]); $fs -> set_select_multiple(1); is($fs -> get_select_multiple(), 1); __END__ Copyright (C) 2003 by the gtk2-perl team (see the file AUTHORS for the full list). See LICENSE for more information. Gtk2-1.24992/t/PangoAttributes.t0000644000175000017500000003407713076462677014721 0ustar lacklack#!/usr/bin/perl -w use strict; use Gtk2::TestHelper tests => 202; # $Id$ # # pango_color_parse(), pango_color_to_string() # my $color = Gtk2::Pango::Color->parse ('white'); isa_ok ($color, 'Gtk2::Pango::Color'); isa_ok ($color, 'ARRAY'); is_deeply ($color, [0xffff, 0xffff, 0xffff]); SKIP: { skip 'new 1.16 stuff', 2 unless Gtk2::Pango->CHECK_VERSION (1, 16, 0); is (Gtk2::Pango::Color->to_string ($color), '#ffffffffffff'); is ($color->to_string, '#ffffffffffff'); } # # PangoAttrLanguage # my $lang = Gtk2::Pango::Language->from_string ('de-de'); my $attr = Gtk2::Pango::AttrLanguage->new ($lang); isa_ok ($attr, 'Gtk2::Pango::AttrLanguage'); isa_ok ($attr, 'Gtk2::Pango::Attribute'); is ($attr->value->to_string, 'de-de'); $lang = Gtk2::Pango::Language->from_string ('en-us'); $attr->value ($lang); is ($attr->value->to_string, 'en-us'); $attr = Gtk2::Pango::AttrLanguage->new ($lang, 23, 42); is ($attr->start_index, 23); is ($attr->end_index, 42); # # PangoAttrFamily # $attr = Gtk2::Pango::AttrFamily->new ('sans'); isa_ok ($attr, 'Gtk2::Pango::AttrFamily'); isa_ok ($attr, 'Gtk2::Pango::AttrString'); isa_ok ($attr, 'Gtk2::Pango::Attribute'); is ($attr->value, 'sans'); is ($attr->value ('sans-serif'), 'sans'); is ($attr->value, 'sans-serif'); $attr = Gtk2::Pango::AttrFamily->new ('sans', 23, 42); is ($attr->start_index, 23); is ($attr->end_index, 42); # # PangoAttrForeground # $attr = Gtk2::Pango::AttrForeground->new (0, 0, 0); isa_ok ($attr, 'Gtk2::Pango::AttrForeground'); isa_ok ($attr, 'Gtk2::Pango::AttrColor'); isa_ok ($attr, 'Gtk2::Pango::Attribute'); is_deeply ($attr->value, [0, 0, 0]); is_deeply ($attr->value ([0xffff, 0xffff, 0xffff]), [0, 0, 0]); is_deeply ($attr->value, [0xffff, 0xffff, 0xffff]); $attr = Gtk2::Pango::AttrForeground->new (0, 0, 0, 23, 42); is ($attr->start_index, 23); is ($attr->end_index, 42); # # PangoAttrBackground # $attr = Gtk2::Pango::AttrBackground->new (0, 0, 0); isa_ok ($attr, 'Gtk2::Pango::AttrBackground'); isa_ok ($attr, 'Gtk2::Pango::AttrColor'); isa_ok ($attr, 'Gtk2::Pango::Attribute'); is_deeply ($attr->value, [0, 0, 0]); $attr->value ([0xffff, 0xffff, 0xffff]); is_deeply ($attr->value, [0xffff, 0xffff, 0xffff]); $attr = Gtk2::Pango::AttrBackground->new (0, 0, 0, 23, 42); is ($attr->start_index, 23); is ($attr->end_index, 42); # # PangoAttrSize # $attr = Gtk2::Pango::AttrSize->new (23); isa_ok ($attr, 'Gtk2::Pango::AttrSize'); isa_ok ($attr, 'Gtk2::Pango::AttrInt'); isa_ok ($attr, 'Gtk2::Pango::Attribute'); is ($attr->value, 23); $attr->value (42); is ($attr->value, 42); $attr = Gtk2::Pango::AttrSize->new (23, 23, 42); is ($attr->start_index, 23); is ($attr->end_index, 42); SKIP: { skip 'Gtk2::Pango::AttrSize->new_absolute', 7 unless Gtk2::Pango->CHECK_VERSION (1, 8, 0); $attr = Gtk2::Pango::AttrSize->new_absolute (23); isa_ok ($attr, 'Gtk2::Pango::AttrSize'); isa_ok ($attr, 'Gtk2::Pango::AttrInt'); isa_ok ($attr, 'Gtk2::Pango::Attribute'); is ($attr->value, 23); $attr->value (42); is ($attr->value, 42); $attr = Gtk2::Pango::AttrSize->new_absolute (23, 23, 42); is ($attr->start_index, 23); is ($attr->end_index, 42); } # # PangoAttrStyle # $attr = Gtk2::Pango::AttrStyle->new ('normal'); isa_ok ($attr, 'Gtk2::Pango::AttrStyle'); isa_ok ($attr, 'Gtk2::Pango::Attribute'); is ($attr->value, 'normal'); $attr->value ('italic'); is ($attr->value, 'italic'); $attr = Gtk2::Pango::AttrStyle->new ('normal', 23, 42); is ($attr->start_index, 23); is ($attr->end_index, 42); # # PangoAttrWeight # $attr = Gtk2::Pango::AttrWeight->new ('bold'); isa_ok ($attr, 'Gtk2::Pango::AttrWeight'); isa_ok ($attr, 'Gtk2::Pango::Attribute'); is ($attr->value, 'bold'); $attr->value ('heavy'); is ($attr->value, 'heavy'); $attr = Gtk2::Pango::AttrWeight->new ('bold', 23, 42); is ($attr->start_index, 23); is ($attr->end_index, 42); # # PangoAttrVariant # $attr = Gtk2::Pango::AttrVariant->new ('normal'); isa_ok ($attr, 'Gtk2::Pango::AttrVariant'); isa_ok ($attr, 'Gtk2::Pango::Attribute'); is ($attr->value, 'normal'); $attr->value ('small-caps'); is ($attr->value, 'small-caps'); $attr = Gtk2::Pango::AttrVariant->new ('normal', 23, 42); is ($attr->start_index, 23); is ($attr->end_index, 42); # # PangoAttrStretch # $attr = Gtk2::Pango::AttrStretch->new ('normal'); isa_ok ($attr, 'Gtk2::Pango::AttrStretch'); isa_ok ($attr, 'Gtk2::Pango::Attribute'); is ($attr->value, 'normal'); $attr->value ('condensed'); is ($attr->value, 'condensed'); $attr = Gtk2::Pango::AttrStretch->new ('normal', 23, 42); is ($attr->start_index, 23); is ($attr->end_index, 42); # # PangoAttrUnderline # $attr = Gtk2::Pango::AttrUnderline->new ('none'); isa_ok ($attr, 'Gtk2::Pango::AttrUnderline'); isa_ok ($attr, 'Gtk2::Pango::Attribute'); is ($attr->value, 'none'); $attr->value ('double'); is ($attr->value, 'double'); $attr = Gtk2::Pango::AttrUnderline->new ('none', 23, 42); is ($attr->start_index, 23); is ($attr->end_index, 42); # # PangoAttrStrikethrough # $attr = Gtk2::Pango::AttrStrikethrough->new (FALSE); isa_ok ($attr, 'Gtk2::Pango::AttrStrikethrough'); isa_ok ($attr, 'Gtk2::Pango::Attribute'); ok (!$attr->value); $attr->value (TRUE); ok ($attr->value); $attr = Gtk2::Pango::AttrStrikethrough->new (FALSE, 23, 42); is ($attr->start_index, 23); is ($attr->end_index, 42); # # PangoAttrFontDesc # my $desc = Gtk2::Pango::FontDescription->from_string ('Sans 12'); $attr = Gtk2::Pango::AttrFontDesc->new ($desc); isa_ok ($attr, 'Gtk2::Pango::AttrFontDesc'); isa_ok ($attr, 'Gtk2::Pango::Attribute'); is ($attr->desc->to_string, 'Sans 12'); $desc = Gtk2::Pango::FontDescription->from_string ('Sans 14'); is ($attr->desc ($desc)->to_string, 'Sans 12'); is ($attr->desc->to_string, 'Sans 14'); $attr = Gtk2::Pango::AttrFontDesc->new ($desc, 23, 42); is ($attr->start_index, 23); is ($attr->end_index, 42); # # PangoAttrScale # $attr = Gtk2::Pango::AttrScale->new (2.0); isa_ok ($attr, 'Gtk2::Pango::AttrScale'); isa_ok ($attr, 'Gtk2::Pango::Attribute'); is ($attr->value, 2.0); $attr->value (4.0); is ($attr->value, 4.0); $attr = Gtk2::Pango::AttrScale->new (2.0, 23, 42); is ($attr->start_index, 23); is ($attr->end_index, 42); # # PangoAttrRise # $attr = Gtk2::Pango::AttrRise->new (23); isa_ok ($attr, 'Gtk2::Pango::AttrRise'); isa_ok ($attr, 'Gtk2::Pango::Attribute'); is ($attr->value, 23); $attr->value (42); is ($attr->value, 42); $attr = Gtk2::Pango::AttrRise->new (23, 23, 42); is ($attr->start_index, 23); is ($attr->end_index, 42); # # PangoAttrShape # my $ink = { x => 23, y => 42, width => 10, height => 15 }; my $logical = { x => 42, y => 23, width => 15, height => 10 }; $attr = Gtk2::Pango::AttrShape->new ($ink, $logical); isa_ok ($attr, 'Gtk2::Pango::AttrShape'); isa_ok ($attr, 'Gtk2::Pango::Attribute'); is_deeply ($attr->ink_rect, $ink); is_deeply ($attr->logical_rect, $logical); $attr->ink_rect ($logical); is_deeply ($attr->ink_rect, $logical); $attr->logical_rect ($ink); is_deeply ($attr->logical_rect, $ink); $attr = Gtk2::Pango::AttrShape->new ($ink, $logical, 23, 42); is ($attr->start_index, 23); is ($attr->end_index, 42); # # PangoAttrFallback # SKIP: { skip 'Gtk2::Pango::AttrFallback', 6 unless Gtk2::Pango->CHECK_VERSION (1, 4, 0); $attr = Gtk2::Pango::AttrFallback->new (FALSE); isa_ok ($attr, 'Gtk2::Pango::AttrFallback'); isa_ok ($attr, 'Gtk2::Pango::Attribute'); ok (!$attr->value); $attr->value (TRUE); ok ($attr->value); $attr = Gtk2::Pango::AttrFallback->new (FALSE, 23, 42); is ($attr->start_index, 23); is ($attr->end_index, 42); } # # PangoAttrLetterSpacing # SKIP: { skip 'Gtk2::Pango::AttrLetterSpacing', 7 unless Gtk2::Pango->CHECK_VERSION (1, 6, 0); $attr = Gtk2::Pango::AttrLetterSpacing->new (23); isa_ok ($attr, 'Gtk2::Pango::AttrLetterSpacing'); isa_ok ($attr, 'Gtk2::Pango::AttrInt'); isa_ok ($attr, 'Gtk2::Pango::Attribute'); is ($attr->value, 23); $attr->value (42); is ($attr->value, 42); $attr = Gtk2::Pango::AttrLetterSpacing->new (23, 23, 42); is ($attr->start_index, 23); is ($attr->end_index, 42); } # # PangoAttrUnderlineColor # SKIP: { skip 'Gtk2::Pango::AttrUnderlineColor', 8 unless Gtk2::Pango->CHECK_VERSION (1, 8, 0); $attr = Gtk2::Pango::AttrUnderlineColor->new (0, 0, 0); isa_ok ($attr, 'Gtk2::Pango::AttrUnderlineColor'); isa_ok ($attr, 'Gtk2::Pango::AttrColor'); isa_ok ($attr, 'Gtk2::Pango::Attribute'); is_deeply ($attr->value, [0, 0, 0]); is_deeply ($attr->value ([0xffff, 0xffff, 0xffff]), [0, 0, 0]); is_deeply ($attr->value, [0xffff, 0xffff, 0xffff]); $attr = Gtk2::Pango::AttrUnderlineColor->new (0, 0, 0, 23, 42); is ($attr->start_index, 23); is ($attr->end_index, 42); } # # PangoAttrStrikethroughColor # SKIP: { skip 'Gtk2::Pango::AttrStrikethroughColor', 8 unless Gtk2::Pango->CHECK_VERSION (1, 8, 0); $attr = Gtk2::Pango::AttrStrikethroughColor->new (0, 0, 0); isa_ok ($attr, 'Gtk2::Pango::AttrStrikethroughColor'); isa_ok ($attr, 'Gtk2::Pango::AttrColor'); isa_ok ($attr, 'Gtk2::Pango::Attribute'); is_deeply ($attr->value, [0, 0, 0]); is_deeply ($attr->value ([0xffff, 0xffff, 0xffff]), [0, 0, 0]); is_deeply ($attr->value, [0xffff, 0xffff, 0xffff]); $attr = Gtk2::Pango::AttrStrikethroughColor->new (0, 0, 0, 23, 42); is ($attr->start_index, 23); is ($attr->end_index, 42); } # # PangoAttrGravity, PangoAttrGravityHint # SKIP: { skip 'PangoAttrGravity, PangoAttrGravityHint', 14 unless Gtk2::Pango->CHECK_VERSION (1, 16, 0); $attr = Gtk2::Pango::AttrGravity->new ('south'); isa_ok ($attr, 'Gtk2::Pango::AttrGravity'); isa_ok ($attr, 'Gtk2::Pango::Attribute'); is ($attr->value, 'south'); is ($attr->value ('north'), 'south'); is ($attr->value, 'north'); $attr = Gtk2::Pango::AttrGravity->new ('south', 23, 42); is ($attr->start_index, 23); is ($attr->end_index, 42); $attr = Gtk2::Pango::AttrGravityHint->new ('strong'); isa_ok ($attr, 'Gtk2::Pango::AttrGravityHint'); isa_ok ($attr, 'Gtk2::Pango::Attribute'); is ($attr->value, 'strong'); is ($attr->value ('line'), 'strong'); is ($attr->value, 'line'); $attr = Gtk2::Pango::AttrGravityHint->new ('strong', 23, 42); is ($attr->start_index, 23); is ($attr->end_index, 42); } # # PangoAttrList # my $attr_one = Gtk2::Pango::AttrWeight->new ('light', 23, 42); my $attr_two = Gtk2::Pango::AttrWeight->new ('normal', 23, 42); my $attr_three = Gtk2::Pango::AttrWeight->new ('bold', 23, 42); my $list_one = Gtk2::Pango::AttrList->new; $list_one->insert ($attr_one); $list_one->insert_before ($attr_two); $list_one->change ($attr_three); my $list_two = Gtk2::Pango::AttrList->new; $list_one->insert ($attr_three); $list_one->insert_before ($attr_two); $list_one->change ($attr_one); $list_one->splice ($list_two, 0, 2); # # PangoAttrIterator # my $list = Gtk2::Pango::AttrList->new; my $attr_weight = Gtk2::Pango::AttrWeight->new ('normal', 0, 23); $list->insert ($attr_weight); my $attr_variant = Gtk2::Pango::AttrVariant->new ('normal', 0, 42); $list->insert ($attr_variant); my $iter = $list->get_iterator; isa_ok ($iter, 'Gtk2::Pango::AttrIterator'); is_deeply ([$iter->range], [0, 23]); ok ($iter->get ('weight')->equal ($attr_weight)); my @attrs = $iter->get_attrs; is (scalar @attrs, 2); ok ($attrs[1]->equal ($attr_variant)); ok ($iter->next); ok ($iter->next); @attrs = $iter->get_attrs; is (scalar @attrs, 0); is ($iter->get ('weight'), undef); # get_font $list = Gtk2::Pango::AttrList->new; $lang = Gtk2::Pango::Language->from_string ('de-de'); $attr = Gtk2::Pango::AttrLanguage->new ($lang, 0, 23); $list->insert($attr); $attr = Gtk2::Pango::AttrWeight->new ('bold', 0, 23); $list->insert($attr); $iter = $list->get_iterator; my ($desc_new, $lang_new, @extra) = $iter->get_font; is ($desc_new->get_weight, 'bold'); is ($lang_new->to_string, 'de-de'); is (scalar @extra, 0); $attr = Gtk2::Pango::AttrBackground->new (0, 0, 0, 0, 23); $list->insert($attr); $attr = Gtk2::Pango::AttrForeground->new (0, 0, 0, 0, 23); $list->insert($attr); $iter = $list->get_iterator; ($desc_new, $lang_new, @extra) = $iter->get_font; is ($desc_new->get_weight, 'bold'); is ($lang_new->to_string, 'de-de'); is (scalar @extra, 2); isa_ok ($extra[0], 'Gtk2::Pango::AttrBackground'); isa_ok ($extra[1], 'Gtk2::Pango::AttrForeground'); # filter SKIP: { skip 'filter', 12 unless Gtk2::Pango->CHECK_VERSION (1, 2, 0); # run four times -> 8 tests my $callback = sub { my ($attr, $data) = @_; isa_ok ($attr, 'Gtk2::Pango::Attribute'); is ($data, 'urgs'); return $attr->isa ('Gtk2::Pango::AttrWeight'); }; my $list_new = $list->filter ($callback, 'urgs'); $iter = $list_new->get_iterator; @attrs = $iter->get_attrs; is (scalar @attrs, 1); isa_ok ($attrs[0], 'Gtk2::Pango::AttrWeight'); ok ($iter->next); ok (!$iter->next); } # # pango_parse_markup() # my ($attr_list, $text, $accel_char) = Gtk2::Pango->parse_markup ('this text is really cool (no lie)'); isa_ok ($attr_list, 'Gtk2::Pango::AttrList'); is ($text, 'this text is really cool (no lie)', 'text is stripped of tags'); ok ((not defined $accel_char), 'no accel_char if no accel_marker'); { # first, only my $iter = $attr_list->get_iterator; my @attrs = $iter->get_attrs; is (scalar @attrs, 1); isa_ok ($attrs[0], 'Gtk2::Pango::AttrScale'); # then, and $iter->next; @attrs = $iter->get_attrs; is (scalar @attrs, 2); isa_ok ($attrs[0], 'Gtk2::Pango::AttrScale'); isa_ok ($attrs[1], 'Gtk2::Pango::AttrStyle'); # finally, only again $iter->next; @attrs = $iter->get_attrs; is (scalar @attrs, 1); isa_ok ($attrs[0], 'Gtk2::Pango::AttrScale'); } ($attr_list, $text) = Gtk2::Pango->parse_markup ('no markup here'); isa_ok ($attr_list, 'Gtk2::Pango::AttrList'); is ($text, 'no markup here', 'no tags, nothing stripped'); ($attr_list, $text, $accel_char) = Gtk2::Pango->parse_markup ('Text with _accel__chars', '_'); isa_ok ($attr_list, 'Gtk2::Pango::AttrList'); is ($text, 'Text with accel_chars'); is ($accel_char, 'a'); # invalid markup causes an exception... eval { Gtk2::Pango->parse_markup ('invalid markup') }; isa_ok ($@, 'Glib::Error'); isa_ok ($@, 'Glib::Markup::Error'); is ($@->domain, 'g-markup-error-quark'); ok ($@->matches ('Glib::Markup::Error', 'unknown-element'), 'invalid markup causes exceptions'); $@ = undef; __END__ Copyright (C) 2005-2006 by the gtk2-perl team (see the file AUTHORS for the full list). See LICENSE for more information. Gtk2-1.24992/t/GtkWidget.t0000644000175000017500000004135213076462677013471 0ustar lacklack#!/usr/bin/perl # vim: set ft=perl : # # $Id$ # use warnings; use strict; use Gtk2::TestHelper tests => 158; # we can't instantiate Gtk2::Widget, it's abstract. use a button instead. my $widget = Gtk2::Widget->new ('Gtk2::Button', label => 'Test'); isa_ok( $widget, Gtk2::Widget::, 'we can create widgets' ); ## begin item by item check $widget->set (name => 'foo'); is ($widget->get ('name'), 'foo', '$widget->set|get single'); $widget->set (name => 'foo', height_request => 3); ok (eq_array ([$widget->get ('name', 'height-request')], ['foo', 3]), '$widget->set|get multiple'); $widget->set_name ('bar'); is ($widget->get ('name'), 'bar', '$widget->set_name'); my $win = Gtk2::Window->new; $win->realize; $widget->set_parent ($win); is ($widget->get ('parent'), $win); $widget->set_parent_window ($win->window); is ($widget->get_parent_window, $win->window); $widget->reparent ($win); is ($widget->get ('parent'), $win); $widget->unparent; is ($widget->get ('parent'), undef, '$widget->unparent'); is( $widget->get_parent, undef ); is( $widget->parent, undef ); $widget->show; ok ($widget->get ('visible'), '$widget->show'); $widget->hide; ok ($widget->get ('visible') == 0, '$widget->hide'); $widget->show_now; ok ($widget->get ('visible'), '$widget->show_now'); $widget->hide_all; ok ($widget->get ('visible') == 0, '$widget->hide'); $widget->show_all; ok ($widget->get ('visible') == 1, '$widget->hide'); # we need to parent this widget for tests below, $win = Gtk2::Widget->new ('Gtk2::Window'); $win->add ($widget); print 'trying: $widget->map'."\n"; $widget->map; print 'trying: $widget->unmap'."\n"; $widget->unmap; print 'trying: $widget->realize;'."\n"; $widget->realize; print 'trying: $widget->unrealize;'."\n"; $widget->unrealize; print 'trying: $widget->queue_draw;'."\n"; $widget->queue_draw; print 'trying: $widget->queue_resize;'."\n"; $widget->queue_resize; print 'trying: $widget->activate;'."\n"; $widget->activate; print 'trying: $widget->ensure_style;'."\n"; $widget->ensure_style; print 'trying: $widget->reset_rc_styles;'."\n"; $widget->reset_rc_styles; print 'trying: $widget->push_colormap;'."\n"; $widget->push_colormap (Gtk2::Gdk::Colormap->get_system); print 'trying: $widget->pop_colormap;'."\n"; $widget->pop_colormap; ok (1, '$widget->all-of-^the^-above'); is (ref $widget->size_request, 'Gtk2::Requisition', '$widget->size_request'); is (ref $widget->get_child_requisition, 'Gtk2::Requisition', '$widget->get_child_requisition'); $widget->size_allocate (Gtk2::Gdk::Rectangle->new (5, 5, 100, 100)); use Gtk2::Gdk::Keysyms; my $accel_group = Gtk2::AccelGroup->new; $widget->add_accelerator ("activate", $accel_group, $Gtk2::Gdk::Keysyms{ Return }, qw/shift-mask/, qw/visible/); $widget->set_accel_path ("/Bla", $accel_group); $widget->set_accel_path (undef,undef); $widget->remove_accelerator ($accel_group, $Gtk2::Gdk::Keysyms{ Return }, qw/shift-mask/); isa_ok ($widget->intersect (Gtk2::Gdk::Rectangle->new (0, 0, 10000, 10000)), 'Gtk2::Gdk::Rectangle'); isa_ok ($widget->region_intersect (Gtk2::Gdk::Region->new ()), 'Gtk2::Gdk::Region'); $widget->grab_focus; ok ($widget->is_focus, '$widget->grab_focus|is_focus'); ok (!$widget->has_focus, '$widget->grab_focus|has_focus'); $widget->can_default (1); $widget->grab_default; $widget->set_name ("bla!"); is ($widget->get_name, "bla!"); $widget->set_state ('active'); is ($widget->state, 'active', '$widget->set_state|state'); is ($widget->saved_state, 'normal', '$widget->saved_state'); $widget->set_sensitive (0); is ($widget->sensitive, '', '$widget->set_sensitive|sensitive false'); $widget->set_sensitive (1); is ($widget->sensitive, 1, '$widget->set_sensitive|sensitive true'); $widget->set_events ([qw/leave-notify-mask all-events-mask/]); ok ($widget->get_events >= [qw/leave-notify-mask all-events-mask/], '$widget->set_events|get_events'); $widget->add_events ([qw/button-press-mask/]); ok ($widget->get_events >= [qw/button-press-mask leave-notify-mask all-events-mask/], '$widget->add_events|get_events'); $widget->set_extension_events ('cursor'); is ($widget->get_extension_events, 'cursor', '$widget->set_extension_events|get_extension_events'); is (ref $widget->get_toplevel, 'Gtk2::Window', '$widget->get_toplevel'); is (ref $widget->get_ancestor ('Gtk2::Window'), 'Gtk2::Window', '$widget->get_ancestor'); $widget->set_colormap (Gtk2::Gdk::Colormap->get_system); is (ref $widget->get_colormap, 'Gtk2::Gdk::Colormap', '$widget->set_colormap|get_colormap'); $widget->set_default_colormap (Gtk2::Gdk::Colormap->get_system); is (ref $widget->get_default_colormap, 'Gtk2::Gdk::Colormap', '$widget->set_default_colormap|get_default_colormap'); is (ref $widget->get_visual, 'Gtk2::Gdk::Visual', '$widget->get_visual'); is (ref $widget->get_default_visual, 'Gtk2::Gdk::Visual', '$widget->get_visual'); # TODO: should this be -1? is (scalar ($widget->get_pointer), -1, '$widget->get_pointer'); is ($widget->is_ancestor (Gtk2::Window->new), '', '$widget->is_ancestor, false'); is ($widget->is_ancestor ($win), 1, '$widget->is_ancestor, true'); $widget->realize; my @new = $widget->translate_coordinates ($win, 10, 10); is (@new, 2, '$widget->translate_coordinates'); my $style = Gtk2::Style->new; $widget->set_style ($style); is ($widget->get_style, $style, '$widget->get_style'); is (ref $widget->get_default_style, 'Gtk2::Style', '$widget->get_default_style'); $widget->set_direction ('rtl'); is ($widget->get_direction, 'rtl', '$widget->set_direction|get_direction, rtl'); $widget->set_direction ('ltr'); is ($widget->get_direction, 'ltr', '$widget->set_direction|get_direction, ltr'); $widget->set_default_direction ('rtl'); is ($widget->get_default_direction, 'rtl', '$widget->set_default_direction|get_default_direction, rtl'); $widget->set_default_direction ('ltr'); is ($widget->get_default_direction, 'ltr', '$widget->set_default_direction|get_default_direction, ltr'); is_deeply ([$widget->path], ["GtkWindow.bla!", "!alb.wodniWktG"]); is_deeply ([$widget->class_path], ["GtkWindow.GtkButton", "nottuBktG.wodniWktG"]); $widget->composite_child (1); $widget->set_composite_name ("Bla!"); is ($widget->get_composite_name, "Bla!"); Gtk2->grab_add ($widget); is( Gtk2->grab_get_current, $widget, 'grabbing worked' ); Gtk2->grab_remove ($widget); $widget->realize; $win = $widget->window; isa_ok( $win, "Gtk2::Gdk::Window" ); $widget->window (undef); is( $widget->window, undef ); $widget->window ($win); is( $widget->window, $win ); my $rec = $widget->requisition; isa_ok ($rec, 'Gtk2::Requisition'); is ($rec->width, $widget->requisition->width); is ($rec->height, $widget->requisition->height); my $all = $widget->allocation; isa_ok ($all, 'Gtk2::Gdk::Rectangle'); is ($all->x, $widget->allocation->x); is ($all->y, $widget->allocation->y); is ($all->width, $widget->allocation->width); is ($all->height, $widget->allocation->height); isa_ok ($widget->style, 'Gtk2::Style'); isa_ok ($widget->parent, 'Gtk2::Window'); $widget->event (Gtk2::Gdk::Event->new ("button-press")); ## end item by item check # # widget flags stuff # there are two ways to retrieve flags and two ways to set them; compare # both, to ensure that they are always in sync. # $widget = Gtk2::Widget->new ('Gtk2::DrawingArea', name => 'test widget'); my $flags = $widget->get_flags; print "flags $flags\n"; $widget->set_flags (['can-focus', 'app-paintable']); $flags = $widget->get_flags; ok( $flags >= 'can-focus', 'we set flags successfully' ); ok( $widget->can_focus, 'we can read flags correctly' ); ok( $widget->get ('can-focus'), 'this one also has a property, value match?' ); $widget->can_focus (0); $flags = $widget->flags; $flags = $widget->get_flags; ok( !($flags & 'can-focus'), '$flags & can-focus'); ok( !$widget->can_focus, '!$widget->can_focus'); ok( !$widget->get ('can-focus'), '!$widget->get (can-focus)'); $widget->unset_flags (['app-paintable', 'sensitive']); # alternate syntax for get_flags $flags = $widget->flags; ok (!($flags & 'app-paintable'), '$flags & app-paintable' ); ok (!($flags & 'sensitive'), '$flags & sensitive'); ok (!$widget->app_paintable, '$widget->app_paintable'); ok (!$widget->sensitive, '$widget->sensitive'); print "flags $flags\n"; is( $widget->allocation->x, -1 ); is( $widget->allocation->y, -1 ); is( $widget->allocation->width, 1 ); is( $widget->allocation->height, 1 ); $widget->destroy; my $requisition = Gtk2::Requisition->new; isa_ok( $requisition, "Gtk2::Requisition"); is( $requisition->width (5), 0 ); is( $requisition->height (5), 0 ); is( $requisition->width, 5 ); is( $requisition->height, 5 ); $requisition = Gtk2::Requisition->new (5, 5); isa_ok( $requisition, "Gtk2::Requisition" ); is( $requisition->width, 5 ); is( $requisition->height, 5 ); foreach (qw(toplevel no_window realized mapped visible sensitive parent_sensitive can_focus has_focus can_default has_default has_grab rc_style composite_child app_paintable receives_default double_buffered)) { $widget->$_ (1); is ($widget->$_, 1); $widget->$_ (0); # to avoid strange segfaults } ok (!$widget->drawable); ok (!$widget->is_sensitive); my $rc_style = Gtk2::RcStyle->new; $widget->modify_style ($rc_style); isa_ok ($widget->get_modifier_style, "Gtk2::RcStyle"); my $black = Gtk2::Gdk::Color->new (0, 0, 0); $widget->modify_fg (qw/normal/, $black); $widget->modify_bg (qw/normal/, $black); $widget->modify_text (qw/normal/, $black); $widget->modify_base (qw/normal/, $black); $widget->modify_font (Gtk2::Pango::FontDescription->from_string ("Sans")); # passing undef allows you to undo $widget->modify_fg (qw/normal/, undef); $widget->modify_bg (qw/normal/, undef); $widget->modify_text (qw/normal/, undef); $widget->modify_base (qw/normal/, undef); $widget->modify_font (undef); isa_ok ($widget->create_pango_context, "Gtk2::Pango::Context"); isa_ok ($widget->get_pango_context, "Gtk2::Pango::Context"); isa_ok ($widget->create_pango_layout ("Bla"), "Gtk2::Pango::Layout"); isa_ok ($widget->create_pango_layout(), "Gtk2::Pango::Layout"); isa_ok ($widget->render_icon ("gtk-open", "menu", "detail"), "Gtk2::Gdk::Pixbuf"); Gtk2::Widget->push_composite_child; Gtk2::Widget->pop_composite_child; $win = Gtk2::Window->new; my $box = Gtk2::VBox->new (TRUE, 0); $box->add ($widget); $win->add ($box); $widget->realize; $widget->queue_draw_area (0, 0, 10, 10); $widget->reset_shapes; $widget->set_app_paintable (1); $widget->set_double_buffered (1); $widget->set_redraw_on_allocate (1); my $adjustment = Gtk2::Adjustment->new (0, 0, 100, 1, 5, 10); $widget->set_scroll_adjustments ($adjustment, $adjustment); $widget->mnemonic_activate (1); SKIP: { skip "can't implement style_get without gtk_widget_class_find_style_property, which wasn't available till gtk+ 2.2.0", 1 unless Gtk2->CHECK_VERSION (2, 2, 0); my @style = $widget->style_get ("focus-line-width", "focus-padding"); is (@style, 2); } isa_ok ($widget->get_accessible, "Gtk2::Atk::Object"); ok (!$widget->child_focus ("down")); $widget->child_notify ("expand"); $widget->freeze_child_notify; $widget->thaw_child_notify; $widget->set_child_visible (1); is ($widget->get_child_visible, 1); isa_ok ($widget->get_settings, "Gtk2::Settings"); $widget->set_size_request (100, 100); is_deeply ([$widget->get_size_request], [100, 100]); my $bitmap = Gtk2::Gdk::Bitmap->create_from_data ($win->window, "", 1, 1); $win->realize; $widget->shape_combine_mask ($bitmap, 5, 5); $widget->shape_combine_mask (undef, 5, 5); SKIP: { skip "stuff that's new in 2.2", 10 unless Gtk2->CHECK_VERSION (2, 2, 0); isa_ok ($widget->get_clipboard, "Gtk2::Clipboard"); isa_ok ($widget->get_display, "Gtk2::Gdk::Display"); isa_ok ($widget->get_root_window, "Gtk2::Gdk::Window"); isa_ok ($widget->get_screen, "Gtk2::Gdk::Screen"); is ($widget->has_screen, 1); # not sure it's wise to enquire into what properties exist, but # let's assume there's at least 1 { my @pspecs = $widget->list_style_properties; cmp_ok (scalar(@pspecs), '>', 0); } { my @pspecs = Gtk2::Widget->list_style_properties; cmp_ok (scalar(@pspecs), '>', 0); } is ($widget->find_style_property('no-such-style-property-of-this-name'), undef, "find_style_property() no such name, on object"); is (Gtk2::Widget->find_style_property('no-such-style-property-of-this-name'), undef, "find_style_property() no such name, on class"); is (Gtk2::Label->find_style_property('no-such-style-property-of-this-name'), undef, "find_style_property() no such name, on label class"); # not sure it's wise to depend on properties exist, but at least # exercise the code on "interior-focus" which exists in 2.2 up $widget->find_style_property('interior-focus'); Gtk2::Widget->find_style_property('interior-focus'); Gtk2::Label->find_style_property('interior-focus'); } SKIP: { skip "stuff that's new in 2.4", 3 unless Gtk2->CHECK_VERSION (2, 4, 0); $widget->set_no_show_all (1); is ($widget->get_no_show_all, 1); $widget->queue_resize_no_redraw; ok (!$widget->can_activate_accel (23)); my $label_one = Gtk2::Label->new ("_One"); my $label_two = Gtk2::Label->new ("_Two"); $widget->add_mnemonic_label ($label_one); $widget->add_mnemonic_label ($label_two); is_deeply ([$widget->list_mnemonic_labels], [$label_one, $label_two]); $widget->remove_mnemonic_label ($label_one); $widget->remove_mnemonic_label ($label_two); } SKIP: { skip "stuff that's new in 2.10", 0 unless Gtk2->CHECK_VERSION (2, 10, 0); $widget->input_shape_combine_mask ($bitmap, 23, 42); $widget->input_shape_combine_mask (undef, 0, 0); $widget->is_composited; } SKIP: { skip "new 2.12 stuff", 8 unless Gtk2->CHECK_VERSION (2, 12, 0); ok (defined $widget->keynav_failed ('tab-backward')); $widget->set_tooltip_window (undef); is ($widget->get_tooltip_window, undef); my $window = Gtk2::Window->new; $widget->set_tooltip_window ($window); is ($widget->get_tooltip_window, $window); $widget->trigger_tooltip_query; $widget->set_tooltip_text ('Bla'); is ($widget->get_tooltip_text, 'Bla'); $widget->set_tooltip_markup ('Bla'); is ($widget->get_tooltip_markup, 'Bla'); $widget->set_tooltip_text (undef); is ($widget->get_tooltip_text, undef); $widget->set_tooltip_markup (undef); is ($widget->get_tooltip_markup, undef); $widget->set_has_tooltip (FALSE); is ($widget->get_has_tooltip, FALSE); $widget->error_bell; $widget->modify_cursor (Gtk2::Gdk::Color->new (0x0000, 0x0000, 0x0000), Gtk2::Gdk::Color->new (0xffff, 0xffff, 0xffff)); $widget->modify_cursor (undef,undef); } SKIP: { skip 'new 2.14 stuff', 4 unless Gtk2->CHECK_VERSION(2, 14, 0); my $widget = Gtk2::Label->new ('Bla'); is ($widget->get_snapshot (), undef); my $window = Gtk2::Window->new (); $window->add ($widget); $window->show_all (); isa_ok ($widget->get_snapshot (), 'Gtk2::Gdk::Pixmap'); isa_ok ($widget->get_snapshot (Gtk2::Gdk::Rectangle->new (0, 0, 1, 1)), 'Gtk2::Gdk::Pixmap'); isa_ok ($widget->get_window (), 'Gtk2::Gdk::Window'); $window->signal_connect( delete_event => \&Gtk2::Widget::hide_on_delete); $window->signal_emit( delete_event => Gtk2::Gdk::Event->new ('key-press')); } SKIP: { skip 'new 2.18 stuff', 13 unless Gtk2->CHECK_VERSION(2, 18, 0); my $widget = Gtk2::Label->new ('Bla'); my $rect = Gtk2::Gdk::Rectangle->new (0, 0, 23, 42); $widget->set_allocation ($rect); my $new_rect = $widget->get_allocation; is ($new_rect->width, $rect->width); $widget->set_can_default (TRUE); ok ($widget->get_can_default); $widget->set_can_focus (TRUE); ok ($widget->get_can_focus); $widget->set_has_window (TRUE); ok ($widget->get_has_window); $widget->set_receives_default (TRUE); ok ($widget->get_receives_default); $widget->set_visible (TRUE); ok ($widget->get_visible); ok (defined $widget->get_app_paintable); ok (defined $widget->get_double_buffered); ok (defined $widget->get_sensitive); ok (defined $widget->get_state); ok (defined $widget->is_drawable); ok (defined $widget->is_sensitive); ok (defined $widget->is_toplevel); } SKIP: { skip 'new 2.20 stuff', 4 unless Gtk2->CHECK_VERSION(2, 20, 0); my $widget = Gtk2::Label->new ('Bla'); $widget->set_realized (FALSE); ok (!$widget->get_realized); $widget->set_mapped (FALSE); ok (!$widget->get_mapped); my $req = $widget->get_requisition; ok (defined $req->width && defined $req->height); ok (defined $widget->has_rc_style); my $window = Gtk2::Window->new; $window->add ($widget); $widget->realize; $widget->style_attach; } SKIP: { skip 'new 2.22 stuff', 0 unless Gtk2->CHECK_VERSION(2, 22, 0); my $widget = Gtk2::Label->new ('Bla'); my $event = Gtk2::Gdk::Event->new ('focus-change'); $event->in (TRUE); $event->window ($widget->window); $widget->send_focus_change ($event); } __END__ Copyright (C) 2003-2006, 2010 by the gtk2-perl team (see the file AUTHORS for the full list). See LICENSE for more information. Gtk2-1.24992/t/GtkVPaned.t0000644000175000017500000000042513076462677013417 0ustar lacklack#!/usr/bin/perl -w use strict; use Gtk2::TestHelper tests => 1, noinit => 1; # $Id$ my $box = Gtk2::VPaned -> new(); isa_ok($box, "Gtk2::VPaned"); __END__ Copyright (C) 2003 by the gtk2-perl team (see the file AUTHORS for the full list). See LICENSE for more information. Gtk2-1.24992/t/GtkVBox.t0000644000175000017500000000042113076462677013114 0ustar lacklack#!/usr/bin/perl -w use strict; use Gtk2::TestHelper tests => 1, noinit => 1; # $Id$ my $box = Gtk2::VBox -> new(); isa_ok($box, "Gtk2::VBox"); __END__ Copyright (C) 2003 by the gtk2-perl team (see the file AUTHORS for the full list). See LICENSE for more information. Gtk2-1.24992/t/GtkAdjustment.t0000644000175000017500000000347713076462676014371 0ustar lacklack#!/usr/bin/perl -w use strict; use Gtk2::TestHelper tests => 25, noinit => 1; # $Id$ my $adjustment = Gtk2::Adjustment -> new(0, 0, 100, 1, 5, 10); isa_ok($adjustment, "Gtk2::Adjustment"); is($adjustment -> lower(1), 0); is($adjustment -> lower(), 1); is($adjustment -> upper(99), 100); is($adjustment -> upper(), 99); is($adjustment -> value(23), 0); is($adjustment -> value(), 23); is($adjustment -> step_increment(2), 1); is($adjustment -> step_increment(), 2); is($adjustment -> page_increment(6), 5); is($adjustment -> page_increment(), 6); is($adjustment -> page_size(11), 10); is($adjustment -> page_size(), 11); $adjustment -> set_value(23); is($adjustment -> get_value(), 23); $adjustment -> clamp_page(0, 100); $adjustment -> changed(); $adjustment -> value_changed(); SKIP: { skip "stuff that's new in 2.14", 11 unless Gtk2->CHECK_VERSION (2, 14, 0); # note "value" forced to "lower <= value <= upper-page_size" by # gtk_adjustment_configure(), so must ensure that among these numbers $adjustment->configure(1002,1001,10003,1004,1005,1006); is ($adjustment->value, 1002); is ($adjustment->lower, 1001); is ($adjustment->upper, 10003); is ($adjustment->step_increment, 1004); is ($adjustment->page_increment, 1005); is ($adjustment->page_size, 1006); # see that they match up with the accessors $adjustment->set_lower(2001); is ($adjustment->lower, 2001); $adjustment->set_page_increment(2002); is ($adjustment->page_increment, 2002); $adjustment->set_page_size(2003); is ($adjustment->page_size, 2003); $adjustment->set_step_increment(2004); is ($adjustment->step_increment, 2004); $adjustment->set_upper(2005); is ($adjustment->upper, 2005); } __END__ Copyright (C) 2003, 2009 by the gtk2-perl team (see the file AUTHORS for the full list). See LICENSE for more information. Gtk2-1.24992/t/GtkRuler.t0000644000175000017500000000067313076462677013340 0ustar lacklack#!/usr/bin/perl -w use strict; use Gtk2::TestHelper tests => 3, noinit => 1; # $Id$ my $ruler = Gtk2::VRuler -> new(); isa_ok($ruler, "Gtk2::Ruler"); $ruler -> set_metric("pixels"); is($ruler -> get_metric(), "pixels"); $ruler -> set_range(0, 100, 10, 100); is_deeply([$ruler -> get_range], [0, 100, 10, 100]); __END__ Copyright (C) 2003 by the gtk2-perl team (see the file AUTHORS for the full list). See LICENSE for more information. Gtk2-1.24992/t/GtkHPaned.t0000644000175000017500000000042513076462677013401 0ustar lacklack#!/usr/bin/perl -w use strict; use Gtk2::TestHelper tests => 1, noinit => 1; # $Id$ my $box = Gtk2::HPaned -> new(); isa_ok($box, "Gtk2::HPaned"); __END__ Copyright (C) 2003 by the gtk2-perl team (see the file AUTHORS for the full list). See LICENSE for more information. Gtk2-1.24992/t/GtkOrientable.t0000644000175000017500000000121313076462677014322 0ustar lacklack#!/usr/bin/perl use Gtk2::TestHelper tests => 6, at_least_version => [2, 16, 0, 'GtkOrientable: it appeared in 2.16']; my $vbox = Gtk2::VBox -> new(); isa_ok($vbox, "Gtk2::Orientable"); is($vbox->get_orientation, 'vertical'); my $hbox = Gtk2::HBox -> new(); isa_ok($hbox, "Gtk2::Orientable"); is($hbox->get_orientation, 'horizontal'); # Swap the orientation $vbox->set_orientation('horizontal'); is($vbox->get_orientation, 'horizontal'); $hbox->set_orientation('vertical'); is($hbox->get_orientation, 'vertical'); __END__ Copyright (C) 2009 by the gtk2-perl team (see the file AUTHORS for the full list). See LICENSE for more information. Gtk2-1.24992/t/GdkDrawable.t0000644000175000017500000001060513076462676013743 0ustar lacklack#!/usr/bin/perl -w use strict; use Gtk2::TestHelper tests => 15; # $Id$ my $window = Gtk2::Window -> new(); # # Force the window all the way to the screen, so that the realization and # mapping process completes before we continue. Otherwise, we have issues # with X interactions on some servers. # $window -> show_now(); my $win = $window -> window(); SKIP: { skip("GdkDisplay and GdkScreen are new in 2.2", 2) unless Gtk2->CHECK_VERSION (2, 2, 0); isa_ok($win -> get_display(), "Gtk2::Gdk::Display"); isa_ok($win -> get_screen(), "Gtk2::Gdk::Screen"); } isa_ok($win -> get_visual(), "Gtk2::Gdk::Visual"); my $colormap = Gtk2::Gdk::Colormap -> get_system(); $win -> set_colormap($colormap); is($win -> get_colormap(), $colormap); like($win -> get_depth(), qr/^\d+$/); my ($w, $h) = $win -> get_size(); like($w, qr/^\d+$/); like($h, qr/^\d+$/); isa_ok($win -> get_clip_region(), "Gtk2::Gdk::Region"); isa_ok($win -> get_visible_region(), "Gtk2::Gdk::Region"); my $black = Gtk2::Gdk::Color -> new(0, 0, 0); my $values = { foreground => $black, background => $black, function => "copy", fill => "tiled", subwindow_mode => "clip-by-children", ts_x_origin => 0, ts_y_origin => 0, clip_x_origin => 0, clip_y_origin => 0, graphics_exposures => 1, line_width => 5, line_style => "solid", cap_style => "butt", join_style => "round" }; my $gc = Gtk2::Gdk::GC -> new_with_values($window -> window(), $values); my $layout = $window -> create_pango_layout("Bla!"); $win -> draw_point($gc, 10, 10); $win -> draw_points($gc); # no points $win -> draw_points($gc, 10, 10, 11, 11, 12, 12, 13, 13); $win -> draw_line($gc, 5, 5, 10, 10); $win -> draw_lines($gc); # no lines $win -> draw_lines($gc, 5, 5, 10, 10, 15, 15, 20, 20); $win -> draw_segments($gc); $win -> draw_segments($gc, 1, 2, 3, 4, 10, 11, 12, 13); $win -> draw_rectangle($gc, 1, 0, 0, 10, 10); $win -> draw_arc($gc, 1, 5, 5, 10, 10, 23, 42); $win -> draw_polygon($gc, 0, 1, 1, 2, 2, 3, 3, 4, 4, 5, 5, 6, 6); $win -> draw_layout_line($gc, 10, 10, $layout -> get_line(0)); $win -> draw_layout($gc, 10, 10, $layout); $win -> draw_layout_line_with_colors($gc, 10, 10, $layout -> get_line(0), $black, $black); $win -> draw_layout_line_with_colors($gc, 10, 10, $layout -> get_line(0), $black, undef); $win -> draw_layout_with_colors($gc, 10, 10, $layout, $black, $black); $win -> draw_layout_with_colors($gc, 10, 10, $layout, undef, $black); $win -> draw_drawable($gc, $win, 5, 5, 5, 5, 10, 10); SKIP: { my $image = $win -> get_image(5, 5, 10, 10); skip("get_image returned undef, skipping draw_image", 2) unless (defined($image)); isa_ok($image, "Gtk2::Gdk::Image"); $win -> draw_image($gc, $image, 0, 0, 0, 0, 50, 50); require Scalar::Util; Scalar::Util::weaken ($image); is ($image, undef, 'get_image() resulting image destroyed when unreferenced'); } SKIP: { skip("draw_pixbuf is new in 2.2", 0) unless Gtk2->CHECK_VERSION (2, 2, 0); $win -> draw_pixbuf($gc, Gtk2::Gdk::Pixbuf -> new("rgb", 0, 8, 10, 10), 0, 0, 0, 0, -1, -1, "none", 5, 5); #test with no gc $win -> draw_pixbuf(undef, Gtk2::Gdk::Pixbuf -> new("rgb", 0, 8, 10, 10), 0, 0, 0, 0, -1, -1, "none", 5, 5); } SKIP: { skip("copy_to_image is new in 2.4", 2) unless Gtk2->CHECK_VERSION (2, 4, 0); my $image = $win -> copy_to_image(undef, 0, 0, 0, 0, 50, 50); skip ("copy_to_image returned undef", 2) unless (defined($image)); isa_ok($image, "Gtk2::Gdk::Image", 'copy_to_image() creating an image'); require Scalar::Util; Scalar::Util::weaken ($image); is ($image, undef, 'copy_to_image() creating an image - destroyed when unreferenced'); } SKIP: { skip("copy_to_image is new in 2.4", 1) unless Gtk2->CHECK_VERSION (2, 4, 0); my $existing_image = $win -> get_image(5, 5, 10, 10); skip("get_image returned undef, skipping draw_image", 2) unless (defined($existing_image)); my $image = $win -> copy_to_image($existing_image, 0, 0, 0, 0, 50, 50); skip ("copy_to_image returned undef", 1) unless (defined($image)); isa_ok($image, "Gtk2::Gdk::Image", 'copy_to_image() to a given target image'); require Scalar::Util; Scalar::Util::weaken ($image); Scalar::Util::weaken ($existing_image); is ($image, undef, 'copy_to_image() to a given target image - destroyed when unreferenced'); } __END__ Copyright (C) 2003-2010 by the gtk2-perl team (see the file AUTHORS for the full list). See LICENSE for more information. Gtk2-1.24992/t/GtkRc.t0000644000175000017500000000634113076462677012611 0ustar lacklack#!/usr/bin/perl -w use strict; use Gtk2::TestHelper tests => 41; # $Id$ my $button = Gtk2::Button -> new("Bla"); my $font = Gtk2::Pango::FontDescription -> from_string("Sans 12"); my $green = Gtk2::Gdk::Color -> new(0, 0xFFFF, 0); my $style = Gtk2::Rc -> get_style($button); isa_ok($style, "Gtk2::Style"); my $settings = $button -> get_settings(); my $path = ($button -> path())[0]; my $class_path = ($button -> class_path())[0]; my $retval = Gtk2::Rc -> get_style_by_paths($settings, $path, $class_path, Gtk2::Button::); ok(not defined $retval or UNIVERSAL::isa($retval, "Gtk2::Style")); # Gtk2::Rc -> parse(...); Gtk2::Rc -> parse_string(qq(style "blablabla" { })); like(Gtk2::Rc -> reparse_all(), qr/^$|^0$/); Gtk2::Rc -> reparse_all_for_settings($settings, 1); ok(1); SKIP: { skip("reset_styles is new in 2.4", 0) unless (Gtk2 -> CHECK_VERSION(2, 4, 0)); Gtk2::Rc -> reset_styles($settings); } Gtk2::Rc -> add_default_file("/tmp/bla.rc"); is((Gtk2::Rc -> get_default_files())[-1], "/tmp/bla.rc"); Gtk2::Rc -> set_default_files("/tmp/bla.rc", "/tmp/blub.rc"); is_deeply([Gtk2::Rc -> get_default_files()], ["/tmp/bla.rc", "/tmp/blub.rc"]); ok(Gtk2::Rc -> get_module_dir()); ok(Gtk2::Rc -> get_im_module_path()); ok(Gtk2::Rc -> get_im_module_file()); ok(Gtk2::Rc -> get_theme_dir()); my $rc_style = Gtk2::RcStyle -> new(); isa_ok($rc_style, "Gtk2::RcStyle"); isa_ok($rc_style -> copy(), "Gtk2::RcStyle"); # first, test normal values is($rc_style -> name("bla"), undef); is($rc_style -> bg_pixmap_name("normal", "blub"), undef); is($rc_style -> font_desc($font), undef); isa_ok($rc_style -> fg("active", $green), "Gtk2::Gdk::Color"); isa_ok($rc_style -> bg("prelight", $green), "Gtk2::Gdk::Color"); isa_ok($rc_style -> text("selected", $green), "Gtk2::Gdk::Color"); isa_ok($rc_style -> base("insensitive", $green), "Gtk2::Gdk::Color"); ok($rc_style -> color_flags("active", "fg") == []); ok($rc_style -> color_flags("prelight", "bg") == []); ok($rc_style -> color_flags("selected", "text") == []); ok($rc_style -> color_flags("insensitive", "base") == []); is($rc_style -> xthickness(5), -1); is($rc_style -> ythickness(5), -1); is($rc_style -> name(), "bla"); is($rc_style -> bg_pixmap_name("normal"), "blub"); is($rc_style -> font_desc() -> to_string(), "Sans 12"); is($rc_style -> fg("active") -> green(), 0xFFFF); is($rc_style -> bg("prelight") -> green(), 0xFFFF); is($rc_style -> text("selected") -> green(), 0xFFFF); is($rc_style -> base("insensitive") -> green(), 0xFFFF); ok($rc_style -> color_flags("active") == ["fg"]); ok($rc_style -> color_flags("prelight") == ["bg"]); ok($rc_style -> color_flags("selected") == ["text"]); ok($rc_style -> color_flags("insensitive") == ["base"]); is($rc_style -> xthickness(), 5); is($rc_style -> ythickness(), 5); # second, test undef $rc_style -> name(undef); is($rc_style -> name(), undef); $rc_style -> bg_pixmap_name("normal", undef); is($rc_style -> bg_pixmap_name("normal"), undef); $rc_style -> font_desc(undef); is($rc_style -> font_desc(), undef); __END__ Copyright (C) 2003 by the gtk2-perl team (see the file AUTHORS for the full list). See LICENSE for more information. Gtk2-1.24992/t/GdkWindow.t0000644000175000017500000002551713076462676013501 0ustar lacklack#!/usr/bin/perl -w use strict; use Gtk2::TestHelper tests => 58; # $Id$ my $attributes = { title => "Bla", event_mask => "button-press-mask", x => 10, "y" => 10, width => 20, height => 20, wclass => "output", (Gtk2->CHECK_VERSION (2,2,0) ? (visual => Gtk2::Gdk::Screen -> get_default() -> get_system_visual()) : ()), colormap => Gtk2::Gdk::Colormap -> get_system(), window_type => "toplevel", cursor => Gtk2::Gdk::Cursor -> new("arrow"), override_redirect => '' }; my $attributes_small = { width => 20, height => 20, wclass => "output", window_type => "toplevel" }; my $window = Gtk2::Gdk::Window -> new(undef, $attributes); my $window_two = Gtk2::Gdk::Window -> new(undef, $attributes_small); my $window_three = Gtk2::Gdk::Window -> new(Gtk2::Gdk -> get_default_root_window(), $attributes); isa_ok($window, "Gtk2::Gdk::Window"); isa_ok($window_two, "Gtk2::Gdk::Window"); isa_ok($window_three, "Gtk2::Gdk::Window"); is($window -> get_window_type(), "toplevel"); $window -> show_unraised(); $window -> show(); ok($window -> is_visible()); ok($window -> is_viewable()); $window -> withdraw(); $window -> iconify(); $window -> deiconify(); $window -> stick(); $window -> unstick(); $window -> maximize(); $window -> unmaximize(); SKIP: { skip("(un)fullscreen are new in 2.2.0", 0) unless Gtk2->CHECK_VERSION (2, 2, 0); $window -> fullscreen(); $window -> unfullscreen(); } ok(defined $window -> get_state()); my @position = $window -> get_position(); is(scalar @position, 2); $window -> move(20, 20); $window -> resize(40, 40); $window -> move_resize(20, 20, 40, 40); $window -> scroll(5, 5); $window -> reparent($window_three, 0, 0); $window -> clear(); $window -> clear_area(0, 0, 5, 5); $window -> clear_area_e(0, 0, 5, 5); $window -> raise(); $window -> lower(); $window -> focus(time()); $window -> register_dnd(); # See t/GtkWindow.t for why these are disabled. # $window -> begin_resize_drag("south-east", 1, 20, 20, 0); # $window -> begin_move_drag(1, 20, 20, 0); # FIXME: separate .t for the GdkTypes.xs stuff? my $geometry = Gtk2::Gdk::Geometry -> new(); isa_ok($geometry, "Gtk2::Gdk::Geometry"); $geometry -> min_width(10); $geometry -> max_width(100); $geometry -> min_height(10); $geometry -> max_height(100); $geometry -> base_width(5); $geometry -> base_height(5); $geometry -> width_inc(5); $geometry -> height_inc(5); $geometry -> min_aspect(0.5); $geometry -> max_aspect(0.5); $geometry -> gravity("south-west"); $geometry -> win_gravity("north-east"); is_deeply([$geometry -> min_width(), $geometry -> max_width(), $geometry -> min_height(), $geometry -> max_height(), $geometry -> base_width(), $geometry -> base_height(), $geometry -> width_inc(), $geometry -> height_inc(), $geometry -> min_aspect(), $geometry -> max_aspect(), $geometry -> gravity(), $geometry -> win_gravity()], [10, 100, 10, 100, 5, 5, 5, 5, 0.5, 0.5, "north-east", "north-east"]); my $geometry_two = { min_width => 10, max_width => 100, min_height => 10, max_height => 100, base_width => 5, base_height => 5, width_inc => 5, height_inc => 5, min_aspect => 0.5, max_aspect => 0.5, win_gravity => "north-west" }; my $mask = [qw(min-size max-size base-size aspect resize-inc win-gravity)]; is_deeply([$geometry -> constrain_size($mask, 22, 23)], [10, 20]); is_deeply([$geometry -> constrain_size(22, 23)], [10, 20]); my $rectangle = Gtk2::Gdk::Rectangle -> new(10, 10, 20, 20); isa_ok($rectangle, "Gtk2::Gdk::Rectangle"); is($rectangle -> x(), 10); is($rectangle -> y(), 10); is($rectangle -> width(), 20); is($rectangle -> height(), 20); is_deeply([$rectangle -> values()], [10, 10, 20, 20]); my $region = Gtk2::Gdk::Region -> rectangle($rectangle); $window_two -> begin_paint_rect($rectangle); $window_two -> begin_paint_region($region); $window_two -> end_paint(); $window_two -> invalidate_rect($rectangle, 1); $window_two -> invalidate_rect(undef, 1); $window_two -> invalidate_region($region, 1); # FIXME: never called? $window_three -> invalidate_maybe_recurse($region, sub { warn @_; return 0; }, "bla"); $window -> freeze_updates(); $window -> thaw_updates(); # FIXME: when does it return something defined? is($window_two -> get_update_area(), undef); $window -> process_all_updates(); $window -> process_updates(0); $window -> set_debug_updates(0); my ($drawable, $x_offset, $y_offset) = $window -> get_internal_paint_info(); isa_ok($drawable, "Gtk2::Gdk::Drawable"); is($x_offset, 0); is($y_offset, 0); $window -> set_override_redirect(0); # FIXME # $window -> add_filter(...); # $window -> remove_filter(...); my $bitmap = Gtk2::Gdk::Bitmap->create_from_data ($window, "", 1, 1); $window -> shape_combine_mask($bitmap, 5, 5); $window -> shape_combine_region($region, 1, 1); # test with undef $window -> shape_combine_mask(undef, 0, 0); $window -> shape_combine_region(undef, 0, 0); SKIP: { skip 'child shapes functions trigger a bug', 0 if (Gtk2->CHECK_VERSION (2, 24, 26) && !Gtk2->CHECK_VERSION (2, 24, 29)); # Introduced in # , # fixed in # . $window -> set_child_shapes(); $window -> merge_child_shapes(); } $window -> set_static_gravities(0); # FIXME: check retval? $window -> set_title("Blub"); $window -> set_background(Gtk2::Gdk::Color -> new(255, 255, 255)); my $pixmap = Gtk2::Gdk::Pixmap->new ($window, 1, 1, $window->get_depth); $window -> set_back_pixmap($pixmap, 0); $window -> set_cursor(Gtk2::Gdk::Cursor -> new("arrow")); Gtk2 -> main_iteration() while (Gtk2 -> events_pending()); # can't predict what these will be my @ret = $window -> get_geometry(); is (scalar (@ret), 5, 'get_geomerty'); $window -> set_geometry_hints($geometry, $mask); $window -> set_geometry_hints($geometry_two); $window -> set_icon_list(); $window -> set_icon_list(Gtk2::Gdk::Pixbuf -> new("rgb", 0, 8, 10, 10), Gtk2::Gdk::Pixbuf -> new("rgb", 0, 8, 10, 10)); $window -> set_modal_hint(0); $window -> set_type_hint("normal"); SKIP: { skip "new 2.10 stuff", 1 unless Gtk2 -> CHECK_VERSION(2, 10, 0); ok(defined $window -> get_type_hint()); $window -> set_child_input_shapes(); $window -> merge_child_input_shapes(); $window -> input_shape_combine_mask($bitmap, 23, 42); $window -> input_shape_combine_region($region, 23, 42); # test with undef $window -> input_shape_combine_mask(undef, 0,0); $window -> input_shape_combine_region(undef, 0,0); } SKIP: { skip("set_skip_taskbar_hint and set_skip_pager_hint are new in 2.2.0", 0) unless Gtk2->CHECK_VERSION (2, 2, 0); $window_three -> set_skip_taskbar_hint(0); $window_three -> set_skip_pager_hint(0); } # there's no way to predict this @ret = $window -> get_root_origin(); is (scalar (@ret), 2, 'get_root_origin'); @ret = $window -> get_origin(); is (scalar (@ret), 2, 'get_origin'); isa_ok($window -> get_frame_extents(), "Gtk2::Gdk::Rectangle"); my ($pointer_window, $relative_x, $relative_y, $pointer_mask) = $window -> get_pointer(); # $pointer_window like($relative_x, qr/^-?\d+$/); like($relative_y, qr/^-?\d+$/); isa_ok($pointer_mask, "Gtk2::Gdk::ModifierType"); is($window -> get_parent(), $window_three); isa_ok($window -> get_toplevel(), "Gtk2::Gdk::Window"); # is($window -> get_toplevel(), $window_three); is($window_three -> get_children(), $window); is($window_three -> peek_children(), $window); $window -> set_events("button-press-mask"); isa_ok($window -> get_events(), "Gtk2::Gdk::EventMask"); $window_three -> set_icon(undef, undef, undef); $window -> set_icon_name("Wheeee"); $window -> set_icon_name(undef); $window -> set_transient_for($window_three); $window -> set_role("Playa"); $window_three -> set_group($window_three); $window -> set_decorations("all"); my @deco = $window -> get_decorations(); is(scalar @deco, 2); isa_ok($deco[1], "Gtk2::Gdk::WMDecoration"); $window -> set_functions("all"); isa_ok((Gtk2::Gdk::Window -> get_toplevels())[0], "Gtk2::Gdk::Window"); isa_ok(Gtk2::Gdk -> get_default_root_window(), "Gtk2::Gdk::Window"); $window -> set_user_data(123); is($window -> get_user_data(), 123); SKIP: { skip("new 2.6 stuff", 0) unless Gtk2 -> CHECK_VERSION(2, 6, 0); $window -> enable_synchronized_configure(); $window -> configure_finished(); $window -> set_focus_on_map(TRUE); } SKIP: { skip("new 2.8 stuff", 0) unless Gtk2 -> CHECK_VERSION(2, 8, 0); $window_three -> set_urgency_hint(TRUE); $window_three -> move_region($region, 10, 10); } SKIP: { skip "new 2.12 stuff", 0 unless Gtk2 -> CHECK_VERSION(2, 12, 0); $window -> set_startup_id('bla'); $window -> set_opacity(1.0); $window -> set_composited(FALSE); # $window -> beep(); } SKIP: { skip 'new 2.14 stuff', 0 unless Gtk2->CHECK_VERSION(2, 14, 0); $window -> redirect_to_drawable($window_two, 0, 0, 0, 0, 10, 10); $window -> remove_redirection(); } $window -> hide(); SKIP: { skip 'new 2.18 stuff', 7 unless Gtk2->CHECK_VERSION(2, 18, 0); my $window = Gtk2::Gdk::Window -> new(undef, { window_type => 'toplevel' }); $window -> flush(); ok($window -> ensure_native()); $window -> geometry_changed(); is($window -> get_cursor(), undef); $window -> set_cursor(Gtk2::Gdk::Cursor -> new("arrow")); isa_ok($window -> get_cursor(), 'Gtk2::Gdk::Cursor'); my $sibling = Gtk2::Gdk::Window -> new(undef, { window_type => 'toplevel' }); $window -> restack(undef, TRUE); $window -> restack($sibling, TRUE); my $gtkwindow= Gtk2::Window->new; $gtkwindow->show_all; $gtkwindow->realize; my $offscreen= Gtk2::Gdk::Window->new(undef, { window_type => 'offscreen', }); $offscreen->set_embedder($gtkwindow->window); isa_ok($offscreen->get_pixmap, 'Gtk2::Gdk::Pixmap'); isa_ok($offscreen->get_embedder,'Gtk2::Gdk::Window'); my ($rx, $ry) = $window->get_root_coords(0, 0); ok(defined $rx && defined $ry); ok(defined $window->is_destroyed()); } SKIP: { skip 'new 2.22 stuff', 11 unless Gtk2->CHECK_VERSION(2, 22, 0); my $window = Gtk2::Gdk::Window -> new(undef, { window_type => 'toplevel' }); is_deeply ([$window->coords_from_parent (0, 0)], [0, 0]); is_deeply ([$window->coords_to_parent (0, 0)], [0, 0]); ok (defined $window->get_accept_focus); ok (defined $window->get_composited); isa_ok ($window->get_effective_parent, 'Gtk2::Gdk::Window'); isa_ok ($window->get_effective_toplevel, 'Gtk2::Gdk::Window'); ok (defined $window->get_focus_on_map); ok (defined $window->get_modal_hint); ok (defined $window->has_native); ok (defined $window->is_input_only); ok (defined $window->is_shaped); } __END__ Copyright (C) 2003-2005 by the gtk2-perl team (see the file AUTHORS for the full list). See LICENSE for more information. Gtk2-1.24992/t/GtkFontSelection.t0000644000175000017500000000347213076462677015023 0ustar lacklack#!/usr/bin/perl -w use strict; use Gtk2::TestHelper tests => 23; # $Id$ my $fs = Gtk2::FontSelection -> new(); isa_ok($fs, "Gtk2::FontSelection"); my $window = Gtk2::Window -> new(); $window -> add($fs); ok($fs -> set_font_name("Sans 12")); ok(defined($fs -> get_font_name())); $fs -> set_preview_text("Quick brown gtk2-perl."); is($fs -> get_preview_text(), "Quick brown gtk2-perl."); my $dialog = Gtk2::FontSelectionDialog -> new("Bla"); isa_ok($dialog, "Gtk2::FontSelectionDialog"); isa_ok($dialog -> get_ok_button(), "Gtk2::Button"); isa_ok($dialog -> get_apply_button(), "Gtk2::Button"); isa_ok($dialog -> get_cancel_button(), "Gtk2::Button"); # The accessors without "get" prefix are deprecated. ok($dialog -> ok_button == $dialog -> get_ok_button()); ok($dialog -> apply_button == $dialog -> get_apply_button()); ok($dialog -> cancel_button == $dialog -> get_cancel_button()); ok($dialog -> set_font_name("Sans 12")); ok(defined($dialog -> get_font_name())); $dialog -> set_preview_text("Quick brown gtk2-perl."); is($dialog -> get_preview_text(), "Quick brown gtk2-perl."); SKIP: { skip 'new 2.14 stuff', 8 unless Gtk2->CHECK_VERSION(2, 14, 0); isa_ok($fs -> get_face(), 'Gtk2::Pango::FontFace'); isa_ok($fs -> get_face_list(), 'Gtk2::Widget'); isa_ok($fs -> get_family(), 'Gtk2::Pango::FontFamily'); isa_ok($fs -> get_family_list(), 'Gtk2::Widget'); isa_ok($fs -> get_preview_entry(), 'Gtk2::Widget'); ok(defined $fs -> get_size()); isa_ok($fs -> get_size_entry(), 'Gtk2::Widget'); isa_ok($fs -> get_size_list(), 'Gtk2::Widget'); } SKIP: { skip 'new 2.22 stuff', 1 unless Gtk2->CHECK_VERSION(2, 22, 0); isa_ok($dialog -> get_font_selection(), 'Gtk2::FontSelection'); } __END__ Copyright (C) 2003 by the gtk2-perl team (see the file AUTHORS for the full list). See LICENSE for more information. Gtk2-1.24992/t/GtkCellRenderer.t0000644000175000017500000002005313076462676014606 0ustar lacklack#!/usr/bin/perl -w # $Id$ use Gtk2::TestHelper tests => 46; use strict; ########################################################################## # custom cell renderer package Mup::CellRendererPopup; use Test::More; use Glib::Object::Subclass Gtk2::CellRendererText::, ; my %hits; sub INIT_INSTANCE { $hits{init}++; } sub GET_SIZE { $hits{size}++; shift->SUPER::GET_SIZE (@_) } sub RENDER { $hits{render}++; shift->SUPER::RENDER (@_) } sub ACTIVATE { $hits{activate}++; shift->SUPER::ACTIVATE (@_) } sub START_EDITING { $hits{edit}++; shift->SUPER::START_EDITING (@_) } ########################################################################## # custom cell renderer in the style of 1.02x, to check for regressions of # backward compatibility. package Mup::CellRendererPopupCompat; use Test::More; use Glib::Object::Subclass Gtk2::CellRendererText::, ; __PACKAGE__->_install_overrides; my %hits_compat; sub INIT_INSTANCE { $hits_compat{init}++; } sub on_get_size { $hits_compat{size}++; shift->parent_get_size (@_) } sub on_render { $hits_compat{render}++; shift->parent_render (@_) } sub on_activate { $hits_compat{activate}++; shift->parent_activate (@_) } sub on_start_editing { $hits_compat{edit}++; shift->parent_start_editing (@_) } ########################################################################## # custom cell renderer with newly created entry in START_EDITING package My::CellRendererNewEntry; use strict; use warnings; use Glib::Object::Subclass 'Gtk2::CellRendererText'; my %hits_newentry; sub INIT_INSTANCE { $hits_newentry{init}++; } sub GET_SIZE { $hits_newentry{size}++; shift->SUPER::GET_SIZE (@_) } sub RENDER { $hits_newentry{render}++; shift->SUPER::RENDER (@_) } sub ACTIVATE { $hits_newentry{activate}++; shift->SUPER::ACTIVATE (@_) } sub START_EDITING { $hits_newentry{edit}++; my $entry = Gtk2::Entry->new; $entry->signal_connect (destroy => \&_editable_destroy); return $entry; } sub _editable_destroy { $hits_newentry{editable_destroy}++ } ########################################################################## # driver code package main; my $window = Gtk2::Window->new; $window->set_title ('cell renderer test'); $window->signal_connect (delete_event => sub { Gtk2->main_quit; 0; }); my $vbox = Gtk2::VBox->new; $window->add ($vbox); my $label = Gtk2::Label->new; $label->set_markup ('F-Words'); $vbox->pack_start ($label, 0, 0, 0); # create and load the model my $model = Gtk2::ListStore->new ('Glib::String', 'Glib::Scalar', 'Glib::Int'); foreach (qw/foo fluffy flurble frob frobnitz ftang fire truck/) { my $iter = $model->append; $model->set ($iter, 0, $_); } # now a view my $treeview = Gtk2::TreeView->new ($model); # # custom cell renderer # ok (my $renderer = Mup::CellRendererPopup->new, 'Mup::CellRendererPopup->new'); $renderer->set (mode => 'editable'); $renderer->set (editable => 1); my $column = Gtk2::TreeViewColumn->new_with_attributes ('selector', $renderer, text => 0,); # this handler commits the user's selection to the model. compare with # the one for the typical text renderer -- the only difference is a var name. $renderer->signal_connect (edited => sub { my ($cell, $text_path, $new_text, $model) = @_; my $path = Gtk2::TreePath->new_from_string ($text_path); my $iter = $model->get_iter ($path); $model->set ($iter, 2, $new_text); }, $model); $treeview->append_column ($column); # # custom cell renderer, compat mode # ok (my $renderer_compat = Mup::CellRendererPopupCompat->new, 'Mup::CellRendererPopupCompat->new'); $renderer_compat->set (mode => 'editable'); $renderer_compat->set (editable => 1); my $column_compat = Gtk2::TreeViewColumn->new_with_attributes ('selector', $renderer_compat, text => 0,); # this handler commits the user's selection to the model. compare with # the one for the typical text renderer -- the only difference is a var name. $renderer_compat->signal_connect (edited => sub { my ($cell, $text_path, $new_text, $model) = @_; my $path = Gtk2::TreePath->new_from_string ($text_path); my $iter = $model->get_iter ($path); $model->set ($iter, 2, $new_text); }, $model); $treeview->append_column ($column_compat); # # new entry cell renderer # my $renderer_newentry = My::CellRendererNewEntry->new; $renderer_newentry->set (mode => 'editable'); my $column_newentry = Gtk2::TreeViewColumn->new_with_attributes ('new-entry', $renderer_newentry, text => 0,); $treeview->append_column ($column_newentry); # # plain core CellRendererText # my $renderer_text = Gtk2::CellRendererText->new; $renderer_text->set (editable => 1); my $column_text = Gtk2::TreeViewColumn->new_with_attributes ('core-text', $renderer_text, text => 0,); $treeview->append_column ($column_text); ########################################################################## $vbox->pack_start ($treeview, 1, 1, 0); $window->show_all; ########################################################################## # # test the vfunc-involving stuff for all renderers # my $rect = Gtk2::Gdk::Rectangle->new (5, 5, 10, 10); my $event = Gtk2::Gdk::Event->new ("button-press"); foreach my $r ($renderer, $renderer_compat, $renderer_newentry, $renderer_text) { my @size = $r->get_size ($treeview, $rect); is (@size, 4); like($size[0], qr/^\d+$/); like($size[1], qr/^\d+$/); like($size[2], qr/^\d+$/); like($size[3], qr/^\d+$/); $r->render ($window->window, $treeview, $rect, $rect, $rect, [qw(sorted prelit)]); ok(!$r->activate ($event, $treeview, "0", $rect, $rect, qw(selected))); { my $editable = $r->start_editing ($event, $treeview, "0", $rect, $rect, qw(selected)); isa_ok ($editable, "Gtk2::Entry"); my $destroyed = 0; $editable->signal_connect (destroy => sub { $destroyed = 1 }); undef $editable; is ($destroyed, 1, "editable from start_editing using $r destroyed when forgotten"); } } # # test the normal stuff just for one renderer # isa_ok ($renderer, "Gtk2::CellRenderer"); $renderer->set_fixed_size (23, 42); is_deeply([$renderer->get_fixed_size], [23, 42]); SKIP: { skip "editing_canceled is new in 2.4", 0 unless Gtk2->CHECK_VERSION (2, 4, 0); my $renderer = Gtk2::CellRendererText->new; $renderer->editing_canceled; } SKIP: { skip "stop_editing is new in 2.6", 0 unless Gtk2->CHECK_VERSION (2, 6, 0); my $renderer = Gtk2::CellRendererText->new; $renderer->stop_editing (FALSE); } SKIP: { skip 'new 2.18 stuff', 6 unless Gtk2->CHECK_VERSION(2, 18, 0); my $renderer = Gtk2::CellRendererText->new; $renderer->set_visible (TRUE); ok ($renderer->get_visible); $renderer->set_sensitive (TRUE); ok ($renderer->get_sensitive); $renderer->set_alignment (0.5, 0.5); my ($x, $y) = $renderer->get_alignment; delta_ok ($x, 0.5); delta_ok ($y, 0.5); $renderer->set_padding (23, 42); ($x, $y) = $renderer->get_padding; is ($x, 23); is ($y, 42); } ########################################################################## run_main sub { # set the cursor on the various columns, with editing mode on, to # trigger the vfuncs $treeview->set_cursor (Gtk2::TreePath->new_from_string ('0'), $column, 1); $treeview->set_cursor (Gtk2::TreePath->new_from_string ('0'), $column_compat, 1); $treeview->set_cursor (Gtk2::TreePath->new_from_string ('0'), $column_newentry, 1); # and not editing any more $treeview->set_cursor (Gtk2::TreePath->new_from_string ('0'), $column_text, 0); }; is_deeply ([ sort keys %hits ], [ qw/edit init render size/ ], 'callbacks encountered'); is_deeply ([ sort keys %hits_compat ], [ qw/edit init render size/ ], 'callbacks encountered'); # one start_editing programmatically, and one from set_cursor of $treeview is ($hits_newentry{edit}, 2); is ($hits_newentry{editable_destroy}, 2, 'the otherwise unreferenced GtkEntry should be destroyed'); __END__ Copyright (C) 2003-2005, 2009 by the gtk2-perl team (see the file AUTHORS for the full list). See LICENSE for more information. Gtk2-1.24992/t/constants.t0000644000175000017500000000103613076462676013606 0ustar lacklack#!/usr/bin/perl use strict; use warnings; use Gtk2 qw/:constants/; use Gtk2::TestHelper tests => 8, noinit => 1; my @constants = qw/GDK_CURRENT_TIME GDK_PRIORITY_EVENTS GDK_PRIORITY_REDRAW GTK_PRIORITY_RESIZE/; my $number = qr/^\d+$/; foreach my $constant (@constants) { like (eval "Gtk2::$constant", $number); like (eval "$constant", $number); } __END__ Copyright (C) 2003-2013 by the gtk2-perl team (see the file AUTHORS for the full list). See LICENSE for more information. Gtk2-1.24992/t/GtkAspectFrame.t0000644000175000017500000000135713076462676014440 0ustar lacklack#!/usr/bin/perl -w use strict; use Gtk2::TestHelper tests => 4, noinit => 1; # $Id$ # Blatantly stolen from Ross' original test. my $frame = Gtk2::AspectFrame -> new("Label", 1, 1, 3, 0); isa_ok($frame, "Gtk2::AspectFrame"); is_deeply([$frame -> get(qw/xalign yalign ratio obey-child/)], [1, 1, 3, 0], '$aspect->new, verify'); $frame -> set_params(1, 1, 6, 1); is_deeply([$frame -> get(qw/xalign yalign ratio obey-child/)], [1, 1, 6, 1], '$aspect->set_params, verify'); # label can be undef for no label $frame = Gtk2::AspectFrame -> new(undef, 1, 1, 3, 0); is ($frame->get('label'), undef); __END__ Copyright (C) 2003, 2010 by the gtk2-perl team (see the file AUTHORS for the full list). See LICENSE for more information. Gtk2-1.24992/t/GdkRgb.t0000644000175000017500000000350513076462676012735 0ustar lacklack#!/usr/bin/perl -w use strict; use Gtk2::TestHelper tests => 2; # $Id$ my $window = Gtk2::Window -> new(); $window -> realize(); my $gc = Gtk2::Gdk::GC -> new($window -> window()); my $cmap = [0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 0, 1, 2, 3, 4, 5]; $window -> window() -> draw_indexed_image($gc, 5, 5, 10, 10, "normal", "abcd", 5, $cmap); eval { $window -> window() -> draw_indexed_image($gc, 5, 5, 10, 10, "normal", "abcd", 5, [@$cmap, 6]); }; like($@, qr/a cmap may not consist of more than 256 colors/); SKIP: { skip("new 2.6 stuff", 1) unless Gtk2 -> CHECK_VERSION(2, 6, 0); my $cmap = Gtk2::Gdk::Colormap -> get_system(); like(Gtk2::Gdk::Rgb -> colormap_ditherable($cmap), qr/^(?:1|)$/); } __END__ Copyright (C) 2003-2005 by the gtk2-perl team (see the file AUTHORS for the full list). See LICENSE for more information. Gtk2-1.24992/t/GtkImageMenuItem.t0000644000175000017500000000357413076462677014740 0ustar lacklack#!/usr/bin/perl -w use strict; use Gtk2::TestHelper tests => 12; # $Id$ my $item = Gtk2::ImageMenuItem -> new(); isa_ok($item, "Gtk2::ImageMenuItem"); $item = Gtk2::ImageMenuItem -> new("_Bla"); isa_ok($item, "Gtk2::ImageMenuItem"); $item = Gtk2::ImageMenuItem -> new_with_label("Bla"); isa_ok($item, "Gtk2::ImageMenuItem"); $item = Gtk2::ImageMenuItem -> new_with_mnemonic("Bla"); isa_ok($item, "Gtk2::ImageMenuItem"); $item = Gtk2::ImageMenuItem -> new_from_stock("gtk-ok"); isa_ok($item, "Gtk2::ImageMenuItem"); $item = Gtk2::ImageMenuItem -> new_from_stock("gtk-ok", Gtk2::AccelGroup -> new()); isa_ok($item, "Gtk2::ImageMenuItem"); my $image = Gtk2::Image -> new_from_stock("gtk-quit", "menu"); $item -> set_image($image); is($item -> get_image(), $image); SKIP: { skip 'use_stock methods', 5 unless Gtk2->CHECK_VERSION(2, 16, 0); # Get an item from a stock and test the getter/setter my $from_stock = Gtk2::ImageMenuItem -> new_from_stock("gtk-yes"); is($from_stock -> get_use_stock(), TRUE); $from_stock -> set_use_stock(FALSE); is($from_stock -> get_use_stock(), FALSE); # Get an item WITHOUT a stock and test the getter/setter my $with_label = Gtk2::ImageMenuItem -> new_with_label("Fake"); is($with_label -> get_use_stock(), FALSE); $with_label -> set_use_stock(TRUE); is($with_label -> get_use_stock(), TRUE); # Add an accelator (applies only to stock items). Can't be verified, at least # the method call is tested for a crash my $with_accelartor = Gtk2::ImageMenuItem -> new_from_stock("gtk-no"); $from_stock -> set_accel_group(Gtk2::AccelGroup -> new()); my $imagemitem = Gtk2::ImageMenuItem->new_from_stock("gtk-yes"); $imagemitem->set_always_show_image(TRUE); is( $imagemitem->get_always_show_image, TRUE, '[gs]et_always_show_image'); } __END__ Copyright (C) 2003 by the gtk2-perl team (see the file AUTHORS for the full list). See LICENSE for more information. Gtk2-1.24992/t/PangoRenderer.t0000644000175000017500000000402413076462677014326 0ustar lacklack#!/usr/bin/perl -w use strict; use Gtk2::TestHelper tests => 7; # $Id$ SKIP: { skip("PangoRenderer is new in 1.8", 5) unless (Gtk2::Pango -> CHECK_VERSION(1, 8, 0)); my $screen = Gtk2::Gdk::Screen -> get_default(); my $renderer = Gtk2::Gdk::PangoRenderer -> new($screen); isa_ok($renderer, "Gtk2::Pango::Renderer"); my $window = Gtk2::Window -> new(); $window -> realize(); $renderer -> set_drawable($window -> window); my $gc = Gtk2::Gdk::GC -> new($window -> window); $renderer -> set_gc($gc); $renderer -> activate(); my $layout = $window -> create_pango_layout("Bla"); $renderer -> draw_layout($layout, 0, 0); $renderer -> draw_layout_line($layout -> get_line(0), 0, 0); $renderer -> draw_rectangle("foreground", 0, 0, 10, 10); $renderer -> draw_error_underline(0, 0, 10, 10); my $description = Gtk2::Pango::FontDescription -> new(); $description -> set_family("Sans"); $description -> set_size(23); my $context = $window -> create_pango_context(); my $font = $context -> load_font($description); $renderer -> draw_glyph($font, 0, 0, 0); $renderer -> part_changed("foreground"); $renderer -> set_color("foreground", undef); is($renderer -> get_color("foreground"), undef); $renderer -> set_color("background", [0xaaaa, 0xbbbb, 0xcccc]); is_deeply($renderer -> get_color("background"), [0xaaaa, 0xbbbb, 0xcccc]); $renderer -> set_matrix(undef); is($renderer -> get_matrix(), undef); my $matrix = Gtk2::Pango::Matrix -> new(); $renderer -> set_matrix($matrix); isa_ok($renderer -> get_matrix(), "Gtk2::Pango::Matrix"); $renderer -> deactivate(); SKIP: { skip 'new 1.20 stuff', 2 unless (Gtk2::Pango -> CHECK_VERSION(1, 20, 0)); # These always return undef unless called from inside a subclass' drawing # function. How do we test that? is($renderer -> get_layout(), undef); is($renderer -> get_layout_line(), undef); } } __END__ Copyright (C) 2005 by the gtk2-perl team (see the file AUTHORS for the full list). See LICENSE for more information. Gtk2-1.24992/t/GtkStyle.t0000644000175000017500000002246513076462677013352 0ustar lacklack#!/usr/bin/perl -w # vim: set ft=perl expandtab shiftwidth=2 softtabstop=2 : use strict; use Gtk2::TestHelper tests => 125; use Carp; # $Id$ my $window = Gtk2::Window -> new(); $window -> realize(); my $style = Gtk2::Style -> new(); isa_ok($style, "Gtk2::Style"); ok(!$style -> attached()); $style = $style -> attach($window -> window()); isa_ok($style, "Gtk2::Style"); ok($style -> attached()); foreach my $state (qw(normal active prelight selected insensitive)) { foreach ($style -> fg($state), $style -> bg($state), $style -> light($state), $style -> dark($state), $style -> mid($state), $style -> text($state), $style -> base($state), $style -> text_aa($state)) { isa_ok($_, "Gtk2::Gdk::Color"); } foreach ($style -> fg_gc($state), $style -> bg_gc($state), $style -> light_gc($state), $style -> dark_gc($state), $style -> mid_gc($state), $style -> text_gc($state), $style -> base_gc($state), $style -> text_aa_gc($state)) { isa_ok($_, "Gtk2::Gdk::GC"); } # initially, the bg_pixmap is undef. ok (! $style->bg_pixmap ($state), 'initially, there is no pixmap'); # set one. my $pixmap = Gtk2::Gdk::Pixmap->new ($window->window, 16, 16, -1); isa_ok ($pixmap, 'Gtk2::Gdk::Pixmap'); $style->bg_pixmap ($state, $pixmap); is ($style -> bg_pixmap($state), $pixmap, 'pixmap is now set'); } isa_ok($style -> black(), "Gtk2::Gdk::Color"); isa_ok($style -> white(), "Gtk2::Gdk::Color"); isa_ok($style -> black_gc(), "Gtk2::Gdk::GC"); isa_ok($style -> white_gc(), "Gtk2::Gdk::GC"); isa_ok($style -> font_desc(), "Gtk2::Pango::FontDescription"); $style -> set_background($window -> window(), "normal"); $style -> apply_default_background($window -> window(), 1, "active", Gtk2::Gdk::Rectangle -> new(10, 10, 5, 5), 10, 10, 5, 5); isa_ok($style -> lookup_icon_set("gtk-quit"), "Gtk2::IconSet"); my $source = Gtk2::IconSource -> new(); my $button = Gtk2::Button -> new("Bla"); my $check = Gtk2::CheckButton -> new("Bla"); my $view = Gtk2::TreeView -> new(); my $pixbuf = Gtk2::Gdk::Pixbuf -> new("rgb", 0, 8, 10, 10); $source -> set_pixbuf($pixbuf); isa_ok($style -> render_icon($source, "ltr", "normal", "button", $button, "detail"), "Gtk2::Gdk::Pixbuf"); my $rectangle = Gtk2::Gdk::Rectangle -> new(10, 10, 10, 10); $style -> paint_arrow($window -> window(), "normal", "none", $rectangle, $button, "detail", "up", 1, 10, 10, 10, 10); $style -> paint_box($window -> window(), "normal", "none", $rectangle, $button, "detail", 10, 10, 10, 10); $style -> paint_box_gap($window -> window(), "normal", "none", $rectangle, $button, "detail", 10, 10, 10, 10, "right", 5, 5); $style -> paint_check($window -> window(), "normal", "none", $rectangle, $button, "detail", 10, 10, 10, 10); $style -> paint_diamond($window -> window(), "normal", "none", $rectangle, $button, "detail", 10, 10, 10, 10); $style -> paint_extension($window -> window(), "normal", "none", $rectangle, $button, "detail", 10, 10, 10, 10, "left"); $style -> paint_flat_box($window -> window(), "normal", "none", $rectangle, $button, "detail", 10, 10, 10, 10); $style -> paint_focus($window -> window(), "normal", $rectangle, $button, "detail", 10, 10, 10, 10); $style -> paint_handle($window -> window(), "normal", "none", $rectangle, $button, "detail", 10, 10, 10, 10, "horizontal"); $style -> paint_hline($window -> window(), "normal", $rectangle, $button, "detail", 10, 10, 10); $style -> paint_option($window -> window(), "normal", "none", $rectangle, $button, "detail", 10, 10, 10, 10); $style -> paint_polygon($window -> window(), "normal", "none", $rectangle, $button, "detail", 1, 2, 2, 4, 4, 6, 6); $style -> paint_shadow($window -> window(), "normal", "none", $rectangle, $button, "detail", 10, 10, 10, 10); $style -> paint_shadow_gap($window -> window(), "normal", "none", $rectangle, $button, "detail", 10, 10, 10, 10, "right", 5, 5); $style -> paint_slider($window -> window(), "normal", "none", $rectangle, $button, "detail", 10, 10, 10, 10, "horizontal"); # $style -> paint_tab($window -> window(), "normal", "none", $rectangle, $check, "detail", 10, 10, 10, 10); $style -> paint_vline($window -> window(), "normal", $rectangle, $button, "detail", 10, 10, 10); $style -> paint_expander($window -> window(), "normal", $rectangle, $view, "detail", 10, 10, "collapsed"); # $style -> paint_layout($window -> window(), "normal", "none", $rectangle, $button, "detail", 10, 10, Gtk2::Pango::Layout -> new(Gtk2::Pango::Context -> new())); # versions of gtk+ prior to 2.2.0 handled only 'south-east', which isn't so # bad, except that they actually called g_assert_not_reached() in the branch # of code that you reach by passing other values. so, eh, never pass anything # but south-east to old gtk+. $style -> paint_resize_grip($window -> window(), "normal", $rectangle, $button, "detail", "north-west", 10, 10, 10, 10) if Gtk2->CHECK_VERSION (2, 2, 0); $style -> paint_resize_grip($window -> window(), "normal", $rectangle, $button, "detail", "south-east", 10, 10, 10, 10); $style -> detach(); isa_ok($style, "Gtk2::Style"); ok(!$style -> attached()); $style = Gtk2::Style -> new() -> attach($window -> window()); isa_ok($style, "Gtk2::Style"); ok($style -> attached()); $style -> detach(); isa_ok($style, "Gtk2::Style"); ok(!$style -> attached()); $style = Gtk2::Style -> new(); $style -> attach($window -> window()); $style -> attach($window -> window()); SKIP: { skip("draw_insertion_cursor is new in 2.4", 0) unless (Gtk2 -> CHECK_VERSION(2, 4, 5)); $window -> add($button); Gtk2 -> draw_insertion_cursor($button, $window -> window(), $rectangle, $rectangle, 1, "ltr", 1); } SKIP: { skip("lookup_color is new in 2.10", 1) unless (Gtk2->CHECK_VERSION(2, 10, 0)); my $color = $style->lookup_color ('foreground'); # at this point we can't verify anything about it... ok (1); } SKIP: { skip("get is new in 2.16", 12) unless (Gtk2->CHECK_VERSION(2, 16, 0)); # Test different properties (gint, gboolean, gchar* and GObject) my $treeview = Gtk2::TreeView -> new(); # get gboolean is ( $style -> get('Gtk2::TreeView', 'allow-rules'), $treeview -> style_get_property('allow-rules'), "get_property gboolean" ); # get gint is ( $style -> get('Gtk2::TreeView', 'expander-size'), $treeview -> style_get_property('expander-size'), "get_property gint" ); # get gchar* is ( $style -> get('Gtk2::TreeView', 'grid_line-pattern'), $treeview -> style_get_property('grid_line-pattern'), "get_property gchar*" ); # get GObject (a color) is ( $style -> get('Gtk2::TreeView', 'even-row-color'), $treeview -> style_get_property('even-row-color'), "get_property GObject*" ); # Get multiple properties simultaneously my @properties = $style -> get('Gtk2::TreeView', 'expander-size', 'even-row-color', 'grid_line-pattern'); is_deeply ( \@properties, [ $treeview -> style_get_property('expander-size'), $treeview -> style_get_property('even-row-color'), $treeview -> style_get_property('grid_line-pattern'), ], 'get multiple properties', ); # Test the get_style_property alias is ( $style -> get_style_property('Gtk2::TreeView', 'even-row-color'), $style -> get('Gtk2::TreeView', 'even-row-color'), "get_style_property alias" ); # Make sure that Glib::GObject::get() and Gtk2::Style::get() can coexist. my $custom_style = Custom::Style -> new(); is ($custom_style -> Glib::Object::get('perl-string'), 'empty'); is ($custom_style -> get_property('perl-string'), 'empty'); is ($custom_style -> get('Gtk2::Button', 'image-spacing'), 2); # Test for bad usage # Bad class test_die( sub { $style -> get('wrong::class', 'border'); }, qr/^package wrong::class is not registered with GPerl/ ); # Non existing property test_die( sub { $style -> get('Gtk2::Button', 'image-spacing', 'perl-var', 'default-border'); }, qr/^type Gtk2::Button does not support style property 'perl-var'/ ); # Not a Gtk2::Widget test_die( sub { $style -> get('Glib::Object', 'prop'); }, qr/^Glib::Object is not a subclass of Gtk2::Widget/ ); } SKIP: { skip 'new 2.20 stuff', 0 unless Gtk2->CHECK_VERSION(2, 20, 0); $style -> paint_spinner($window -> window(), "normal", undef, undef, undef, 1, 2, 3, 4, 5); my $area = Gtk2::Gdk::Rectangle -> new(1, 2, 3, 4); $style -> paint_spinner($window -> window(), "normal", $area, $button, "detail", 1, 2, 3, 4, 5); } # Test that an error is thrown sub test_die { my ($code, $regexp) = @_; croak "usage(code, regexp)" unless ref $code eq 'CODE'; my $passed = FALSE; eval { $code->(); }; if (my $error = $@) { if ($error =~ /$regexp/) { $passed = TRUE; } else { diag("Expected $regexp but got $error"); } } return Test::More->builder->ok($passed); } # # Used to test if Gtk2::Style::get() conflicts with Glib::GObject::get(). A new # package is needed because as of gtk+ 2.16, Gtk2::Style defines no properties. # package Custom::Style; use Glib::Object::Subclass 'Gtk2::Style' => properties => [ Glib::ParamSpec->string( 'perl-string', 'Test string', 'A test string.', 'empty', ['readable', 'writable'], ), ], ; __END__ Copyright (C) 2003-2009 by the gtk2-perl team (see the file AUTHORS for the full list). See LICENSE for more information. Gtk2-1.24992/t/GtkCellRendererSpinner.t0000644000175000017500000000056313076462676016151 0ustar lacklack#!/usr/bin/env perl use Gtk2::TestHelper tests => 1, noinit => 1, at_least_version => [2, 20, 0, "Gtk2::CellRendererSpinner is new in 2.20"]; my $spinner = Gtk2::CellRendererSpinner->new; isa_ok ($spinner, 'Gtk2::CellRendererSpinner'); __END__ Copyright (C) 2010 by the gtk2-perl team (see the file AUTHORS for the full list). See LICENSE for more information. Gtk2-1.24992/t/GtkHandleBox.t0000644000175000017500000000146113076462677014107 0ustar lacklack# # $Id$ # ######################### # GtkHandleBox Tests # - rm ######################### use Gtk2::TestHelper tests => 8, noinit => 1; ok( my $hb = Gtk2::HandleBox->new ); $hb->add( Gtk2::Label->new('Just a test label') ); $hb->set_shadow_type('none'); ok( $hb->get_shadow_type eq 'none' ); $hb->set_shadow_type('etched-in'); ok( $hb->get_shadow_type eq 'etched-in' ); $hb->set_snap_edge('top'); ok( $hb->get_snap_edge eq 'top' ); $hb->set_snap_edge('left'); ok( $hb->get_snap_edge eq 'left' ); $hb->set_handle_position('left'); ok( $hb->get_handle_position eq 'left' ); $hb->set_handle_position('top'); ok( $hb->get_handle_position eq 'top' ); ok( ! $hb->get_child_detached ); __END__ Copyright (C) 2003 by the gtk2-perl team (see the file AUTHORS for the full list). See LICENSE for more information. Gtk2-1.24992/t/GtkViewport.t0000644000175000017500000000224513076462677014063 0ustar lacklack#!/usr/bin/perl -w use strict; use Gtk2::TestHelper tests => 8; # $Id$ my $viewport = Gtk2::Viewport -> new(); isa_ok($viewport, "Gtk2::Viewport"); my $adjustment = Gtk2::Adjustment -> new(0, 0, 100, 1, 5, 10); $viewport -> set_hadjustment($adjustment); is($viewport -> get_hadjustment(), $adjustment); $viewport -> set_vadjustment($adjustment); is($viewport -> get_vadjustment(), $adjustment); $viewport = Gtk2::Viewport -> new(undef, undef); isa_ok($viewport, "Gtk2::Viewport"); $viewport = Gtk2::Viewport -> new($adjustment, $adjustment); isa_ok($viewport, "Gtk2::Viewport"); $viewport -> set_shadow_type("etched-in"); is($viewport -> get_shadow_type(), "etched-in"); my $window = Gtk2::Window->new; $window->add ($viewport); $viewport->realize; SKIP: { skip "new 2.20 stuff", 1 unless Gtk2->CHECK_VERSION(2, 20, 0); isa_ok ($viewport->get_bin_window, 'Gtk2::Gdk::Window'); } SKIP: { skip "new 2.22 stuff", 1 unless Gtk2->CHECK_VERSION(2, 22, 0); isa_ok ($viewport->get_view_window, 'Gtk2::Gdk::Window'); } __END__ Copyright (C) 2003, 2010 by the gtk2-perl team (see the file AUTHORS for the full list). See LICENSE for more information. Gtk2-1.24992/t/GtkItemFactory.t0000644000175000017500000000671413076462677014477 0ustar lacklack#!/usr/bin/perl # # $Id$ # ######################### # Gtk2::ItemFactory Tests # - rm ######################### use strict; use Gtk2::TestHelper tests => 58; my @actions_used = (qw/1 0 0 0 0 0/); my @items = ( [ '/_Menu', undef, undef, undef, '', ], [ '/_Menu/Test _1', undef, \&callback, 1, '', 'gtk-execute' ], { path => '/_Menu/Test _2', callback => \&callback, callback_action => 2, item_type => '', extra_data => 'gtk-execute' }, { path => '/_Menu/Sub _Menu', item_type => '', }, [ '/_Menu/Sub Menu/Test _1', undef, \&callback, 3, '', 'gtk-execute' ], [ '/_Menu/Sub Menu/Test _2', undef, sub { my ($data, $action, $widget) = @_; isa_ok( $data, 'HASH' ); isa_ok( $widget, "Gtk2::MenuItem" ); my $tmp_fac = Gtk2::ItemFactory->popup_data_from_widget($widget); isa_ok( $tmp_fac, "Gtk2::ItemFactory" ); is( $tmp_fac->popup_data, $tmp_fac ); $actions_used[4]++; }, undef, undef, ], [ '/_Menu/_Quit', undef, \&callback, 5, '', 'gtk-quit' ], ); sub callback { my ($data, $action, $item) = @_; isa_ok ($data, 'HASH', 'callback data'); $actions_used[$action]++; isa_ok ($item, 'Gtk2::MenuItem'); # Add some "padding" so all menu callbacks have the same number of # tests. ok (TRUE); ok (TRUE); } ok( my $fac = Gtk2::ItemFactory->new('Gtk2::Menu', '
', undef) ); my $item = pop @items; $fac->create_items({foo=>'bar'}, @items); $fac->create_item ($item, {foo=>'bar'}); push @items, $item; $fac->set_translate_func(sub { my ($path, $data) = @_; like( $path, qr(^/_Menu/) ); is( $data, "bla" ); "_Meenyoo" }, "bla"); $fac->popup(10, 10, 1, 0, $fac); isa_ok( $fac->get_widget('
'), "Gtk2::Menu" ); # is( Gtk2::ItemFactory->path_from_widget($fac->get_widget_by_action(2)), # '
/Menu/Test 2' ); # sometimes, these can apparently return undef SKIP: { my $widget = $fac->get_widget_by_action(2); skip 'get_widget_by_action returned undef', 1 unless defined $widget; isa_ok( $widget, "Gtk2::Widget" ); } SKIP: { my $item = $fac->get_item_by_action(2); skip 'get_item_by_action returned undef', 1 unless defined $item; isa_ok( $item, "Gtk2::MenuItem" ); } my $skip_actions_tests = FALSE; foreach ('
/Menu/Test 1', '
/Menu/Test 2', '
/Menu/Sub Menu/Test 1', '
/Menu/Sub Menu/Test 2', '
/Menu/Quit') { my $widget = $fac->get_widget($_); SKIP: { unless (defined $widget) { $skip_actions_tests = TRUE; # $widget->activate would have invoked one of the # callbacks, so add their number of tests to the skip # count. skip "for some reason, get_widget returned undef", 7; } isa_ok( $fac->get_item($_), "Gtk2::MenuItem" ); is( Gtk2::ItemFactory->from_widget($widget), $fac ); is( Gtk2::ItemFactory->path_from_widget($widget), $_ ); $widget->activate; } } $fac->delete_item('
/Menu/Test 1'); $fac->delete_entry($items[2]); $fac->delete_entries(@items[4..6]); foreach ('
/Menu/Test 1', '
/Menu/Test 2', '
/Menu/Sub Menu/Test 1', '
/Menu/Sub Menu/Test 2', '
/Menu/Quit') { is( $fac->get_widget($_), undef ); } SKIP: { skip "actions tests", scalar @actions_used if $skip_actions_tests; foreach (@actions_used) { ok( $_ ); } } __END__ Copyright (C) 2003 by the gtk2-perl team (see the file AUTHORS for the full list). See LICENSE for more information. Gtk2-1.24992/t/GtkColorSelectionDialog.t0000644000175000017500000000112513076462676016303 0ustar lacklack#!/usr/bin/perl -w use strict; use Gtk2::TestHelper tests => 6; # $Id$ my $dialog = Gtk2::ColorSelectionDialog -> new("Bla"); isa_ok($dialog, "Gtk2::ColorSelectionDialog"); isa_ok($dialog -> get_color_selection(), "Gtk2::ColorSelection"); isa_ok($dialog -> ok_button(), "Gtk2::Button"); isa_ok($dialog -> cancel_button(), "Gtk2::Button"); isa_ok($dialog -> help_button(), "Gtk2::Button"); # Deprecated. ok($dialog -> colorsel() == $dialog -> get_color_selection()); __END__ Copyright (C) 2003 by the gtk2-perl team (see the file AUTHORS for the full list). See LICENSE for more information. Gtk2-1.24992/t/GtkTreeModelFilter.t0000644000175000017500000000502613076462677015272 0ustar lacklack#!/usr/bin/perl -w use strict; use Gtk2::TestHelper tests => 27, noinit => 1, at_least_version => [2, 4, 0, "GtkTreeModelFilter is new in 2.4"]; # $Id$ my $list = Gtk2::ListStore -> new("Glib::Int", "Glib::String"); $list -> set($list -> append(), 0 => 42); $list -> set($list -> append(), 0 => 23); $list -> set($list -> append(), 0 => 23); $list -> set($list -> append(), 0 => 23); my $filter = Gtk2::TreeModelFilter -> new($list); isa_ok($filter, "Gtk2::TreeModelFilter"); ginterfaces_ok($filter); # make sure the GInterfaces are set up correctly isa_ok($filter, "Gtk2::TreeModel"); isa_ok($filter, "Gtk2::TreeDragSource"); is(Gtk2::TreeModelFilter->can('get'), Gtk2::TreeModel->can('get'), ' $filter->get should be Gtk2::TreeModel::get'); $filter = Gtk2::TreeModelFilter -> new($list, undef); isa_ok($filter, "Gtk2::TreeModelFilter"); is($filter -> get_model(), $list); my $path = Gtk2::TreePath -> new_from_string("1"); my $iter = $list -> get_iter($path); isa_ok(my $tmp = $filter -> convert_child_iter_to_iter($iter), "Gtk2::TreeIter"); isa_ok($filter -> convert_iter_to_child_iter($tmp), "Gtk2::TreeIter"); isa_ok($tmp = $filter -> convert_child_path_to_path($path), "Gtk2::TreePath"); isa_ok($filter -> convert_path_to_child_path($tmp), "Gtk2::TreePath"); $filter -> set_visible_func(sub { my ($model, $iter, $data) = @_; is($model, $list); isa_ok($iter, "Gtk2::TreeIter"); is($data, 23); return 1; }, 23); $filter -> refilter(); $filter -> clear_cache(); $filter = Gtk2::TreeModelFilter -> new($list, undef); $filter -> set_modify_func (["Glib::Int", "Glib::String"], sub { my ($filter, $iter, $col, $userdata) = @_; my $path = $filter->get_path ($iter); if ($col == 0) { my ($pos) = $path->get_indices; return $pos * 100 + $col; } if ($col == 1) { return "column $col userdata $userdata path " . $path->to_string; } }, 12345); is ($filter->get_value($filter->iter_nth_child(undef,2), 0), 200); is ($filter->get_value($filter->get_iter_first, 1), 'column 1 userdata 12345 path 0'); $filter = Gtk2::TreeModelFilter -> new($list, Gtk2::TreePath -> new_from_string("1")); isa_ok($filter, "Gtk2::TreeModelFilter"); $filter -> set_visible_column(0); { require Scalar::Util; my $f = Gtk2::TreeModelFilter->new($list); Scalar::Util::weaken($f); is ($f, undef, 'destroyed by weakening'); } __END__ Copyright (C) 2003-2009 by the gtk2-perl team (see the file AUTHORS for the full list). See LICENSE for more information. Gtk2-1.24992/t/GtkCheckButton.t0000644000175000017500000000127313076462676014454 0ustar lacklack#!/usr/bin/perl -w use strict; use Gtk2::TestHelper tests => 8; # $Id$ my $button = Gtk2::CheckButton -> new(); isa_ok($button, "Gtk2::CheckButton"); is($button -> get("label"), undef); $button = Gtk2::CheckButton -> new("_Bla"); isa_ok($button, "Gtk2::CheckButton"); is($button -> get("label"), "_Bla"); $button = Gtk2::CheckButton -> new_with_mnemonic("_Bla"); isa_ok($button, "Gtk2::CheckButton"); is($button -> get("label"), "_Bla"); $button = Gtk2::CheckButton -> new_with_label("Bla"); isa_ok($button, "Gtk2::CheckButton"); is($button -> get("label"), "Bla"); __END__ Copyright (C) 2003 by the gtk2-perl team (see the file AUTHORS for the full list). See LICENSE for more information. Gtk2-1.24992/t/GtkCalendar.t0000644000175000017500000000336113076462676013754 0ustar lacklack#!/usr/bin/perl # # $Id$ # ######################### # GtkCalendar Tests # - rm ######################### use Gtk2::TestHelper tests => 18; ok( my $cal = Gtk2::Calendar->new ); $cal->freeze; $cal->select_month (11, 2003); $cal->select_day (4); foreach (qw/6 13 20 27 7 14 21 28 25/) { $cal->mark_day ($_); } $cal->thaw; is ($cal->num_marked_dates, 9); $cal->mark_day (24); is ($cal->num_marked_dates, 10); $cal->unmark_day (24); is ($cal->num_marked_dates, 9); ok (eq_array ([ $cal->marked_date ], [ 0, 0, 0, 0, 0, 1, 1, 0, 0, 0, 0, 0, 1, 1, 0, 0, 0, 0, 0, 1, 1, 0, 0, 0, 1, 0, 1, 1, 0, 0, 0])); $cal->clear_marks; is ($cal->num_marked_dates, 0); is ($cal->year, 2003); is ($cal->month, 11); is ($cal->selected_day, 4); ok (eq_array ([ $cal->get_date ], [ 2003, 11, 4 ])); $cal->display_options ([qw/show-day-names no-month-change/]); $cal->set_display_options ([qw/show-day-names no-month-change/]); ok ($cal->get_display_options == [qw/show-day-names no-month-change/]); SKIP: { skip 'new 2.14 stuff', 7 unless Gtk2->CHECK_VERSION(2, 14, 0); my $cal = Gtk2::Calendar->new; my $number = qr/\A\d+\z/; my $called = 0; $cal->set_detail_func(sub { my ($tmp_cal, $year, $month, $day, $data) = @_; unless ($called++) { is ($tmp_cal, $cal); like ($year, $number); like ($month, $number); like ($day, $number); is ($data, undef); } return 'bla'; }); my $window = Gtk2::Window->new; $window->add ($cal); $window->show_all; $window->hide; $cal->set_detail_height_rows (3); is ($cal->get_detail_height_rows, 3); $cal->set_detail_width_chars (5); is ($cal->get_detail_width_chars, 5); } __END__ Copyright (C) 2003 by the gtk2-perl team (see the file AUTHORS for the full list). See LICENSE for more information. Gtk2-1.24992/t/GtkVRuler.t0000644000175000017500000000043113076462677013456 0ustar lacklack#!/usr/bin/perl -w use strict; use Gtk2::TestHelper tests => 1, noinit => 1; # $Id$ my $ruler = Gtk2::VRuler -> new(); isa_ok($ruler, "Gtk2::VRuler"); __END__ Copyright (C) 2003 by the gtk2-perl team (see the file AUTHORS for the full list). See LICENSE for more information. Gtk2-1.24992/t/GtkToolButton.t0000644000175000017500000000352013076462677014352 0ustar lacklack# # $Id$ # use Gtk2::TestHelper at_least_version => [2, 4, 0, "Action-based menus are new in 2.4"], tests => 15; my $tool_button = Gtk2::ToolButton->new (undef, undef); isa_ok ($tool_button, 'Gtk2::ToolButton'); my $icon_widget = Gtk2::Image->new_from_stock ('gtk-ok', 'large-toolbar'); $tool_button = Gtk2::ToolButton->new ($icon_widget, 'some label string'); isa_ok ($tool_button, 'Gtk2::ToolButton'); $tool_button = Gtk2::ToolButton->new_from_stock ('gtk-cancel'); isa_ok ($tool_button, 'Gtk2::ToolButton'); $tool_button->set_label (undef); is ($tool_button->get_label, undef); $tool_button->set_label ('something'); is ($tool_button->get_label, 'something'); $tool_button->set_use_underline (TRUE); ok ($tool_button->get_use_underline); $tool_button->set_use_underline (FALSE); ok (!$tool_button->get_use_underline); $tool_button->set_stock_id (undef); is ($tool_button->get_stock_id, undef); $tool_button->set_stock_id ('gtk-open'); is ($tool_button->get_stock_id, 'gtk-open'); $icon_widget = Gtk2::Image->new_from_stock ('gtk-cancel', 'large-toolbar'); $tool_button->set_icon_widget ($icon_widget); is ($tool_button->get_icon_widget, $icon_widget); $tool_button->set_icon_widget (undef); is ($tool_button->get_icon_widget, undef); my $label_widget = Gtk2::Label->new ('foo'); $tool_button->set_label_widget ($label_widget); is ($tool_button->get_label_widget, $label_widget); $tool_button->set_label_widget (undef); is ($tool_button->get_label_widget, undef); SKIP: { skip("new 2.8 stuff", 2) unless Gtk2->CHECK_VERSION (2, 8, 0); $tool_button->set_icon_name ("gtk-ok"); is ($tool_button->get_icon_name, "gtk-ok"); $tool_button->set_icon_name (undef); is ($tool_button->get_icon_name, undef); } __END__ Copyright (C) 2003-2005 by the gtk2-perl team (see the file AUTHORS for the full list). See LICENSE for more information. Gtk2-1.24992/t/GtkTreeStore.t0000644000175000017500000001142613076462677014161 0ustar lacklack#!/usr/bin/perl -w # vim: set ft=perl et sw=8 sts=8 : use strict; use Gtk2::TestHelper tests => 44, noinit => 1; # $Id$ ############################################################################### my $model = Gtk2::TreeStore -> new("Glib::String", "Glib::Int"); isa_ok($model, "Gtk2::TreeStore"); ginterfaces_ok($model); $model -> set_column_types("Glib::String", "Glib::Int"); is($model -> get_column_type(0), "Glib::String"); is($model -> get_column_type(1), "Glib::Int"); foreach (qw(bla blee bliii bloooo)) { my $iter = $model -> append(undef); isa_ok($iter, "Gtk2::TreeIter"); $model -> set($iter, 0 => $_, 1 => length($_)); ####################################################################### foreach my $multiplier(1 .. 3) { my $iter_child = $model -> append($iter); isa_ok($iter_child, "Gtk2::TreeIter"); $model -> set($iter_child, 0 => $_ x $multiplier, 1 => length($_ x $multiplier)); my $iter_child_child = $model -> append($iter_child); $model -> set_value($iter_child_child, 0 => reverse($_) x $multiplier, 1 => length(reverse($_) x $multiplier)); } } ############################################################################### SKIP: { skip("swap, move_before, move_after and reorder are new in 2.2.x", 15) unless Gtk2->CHECK_VERSION (2, 2, 0); is($model->get($model->get_iter_from_string("1:1"), 0), "bleeblee"); is($model->get($model->get_iter_from_string("1:2"), 0), "bleebleeblee"); $model -> swap($model -> get_iter_from_string("1:1"), $model -> get_iter_from_string("1:2")); is($model->get($model->get_iter_from_string("1:1"), 0), "bleebleeblee"); is($model->get($model->get_iter_from_string("1:2"), 0), "bleeblee"); is($model -> get($model -> get_iter_from_string("0:0"), 0), "bla"); $model -> move_before($model -> get_iter_from_string("0:0"), $model -> get_iter_from_string("0:2")); is($model -> get($model -> get_iter_from_string("0:1"), 0), "bla"); is($model -> get($model -> get_iter_from_string("2:2"), 0), "bliiibliiibliii"); $model -> move_after($model -> get_iter_from_string("2:2"), $model -> get_iter_from_string("2:0")); is($model -> get($model -> get_iter_from_string("2:1"), 0), "bliiibliiibliii"); eval { $model -> reorder(undef, 3, 2, 1); }; like($@, qr/wrong number of positions passed/); my $tag = $model -> signal_connect(rows_reordered => sub { my $new_order = $_[3]; isa_ok($new_order, "ARRAY", "new index order"); is_deeply($new_order, [3, 1, 2, 0]); }); $model -> reorder(undef, 3, 1, 2, 0); $model -> signal_handler_disconnect ($tag); is($model -> get($model -> get_iter_from_string("0:0"), 0), "bloooo"); is($model -> get($model -> get_iter_from_string("1:0"), 0), "blee"); is($model -> get($model -> get_iter_from_string("2:0"), 0), "bliii"); is($model -> get($model -> get_iter_from_string("3:0"), 0), "blabla"); $model -> move_before($model -> get_iter_from_string("0"), undef); $model -> move_after($model -> get_iter_from_string("3"), undef); } ############################################################################### my $path_model = Gtk2::TreePath -> new_from_string("0"); my $iter_model; # boolean return even in gtk 2.0.0 is($model -> remove($model -> get_iter($path_model)), 1); is($model -> get($model -> get_iter($path_model), 0), "blee"); $model -> clear(); $iter_model = $model -> prepend(undef); $model -> set($iter_model, 0 => "bla", 1 => 3); is($model -> get($iter_model, 0), "bla"); $iter_model = $model -> insert(undef, 1); $model -> set($iter_model, 0 => "ble", 1 => 3); is($model -> get($iter_model, 0), "ble"); $iter_model = $model -> insert_before(undef, $model -> get_iter_from_string("1")); $model -> set($iter_model, 0 => "bli", 1 => 3); is($model -> get($iter_model, 0), "bli"); $iter_model = $model -> insert_after(undef, $model -> get_iter_from_string("1")); $model -> set($iter_model, 0 => "blo", 1 => 3); is($model -> get($iter_model, 0), "blo"); SKIP: { skip "iter_is_valid is new in 2.2.x", 1 unless Gtk2->CHECK_VERSION (2, 2, 0); is($model -> iter_is_valid($iter_model), 1); } SKIP: { skip "new stuff in gtk+ 2.10", 2 unless Gtk2->CHECK_VERSION (2, 10, 0); my $nrows_before = $model->iter_n_children (undef); my $iter = $model->insert_with_values (undef, -1); isa_ok ($iter, 'Gtk2::TreeIter', 'insert_with_values with no values'); $iter = $model->insert_with_values ($iter, -1, 1, 42, 0, 'foo'); isa_ok ($iter, 'Gtk2::TreeIter', 'insert_with_values with values'); } ############################################################################### __END__ Copyright (C) 2003-2006, 2009 by the gtk2-perl team (see the file AUTHORS for the full list). See LICENSE for more information. Gtk2-1.24992/t/GtkEntryCompletion.t0000644000175000017500000000376113076462676015402 0ustar lacklack# # $Id$ # use Gtk2::TestHelper at_least_version => [2, 4, 0, "GtkEntryCompletion is new in 2.4"], tests => 12; sub match_func { my ($completion, $key, $iter, $data) = @_; isa_ok ($completion, 'Gtk2::EntryCompletion'); #isa_ok ($key, 'STRING'); isa_ok ($iter, 'Gtk2::TreeIter'); is ($data, 42); return TRUE; } my $entry = Gtk2::Entry->new; my $completion = Gtk2::EntryCompletion->new; isa_ok ($completion, 'Gtk2::EntryCompletion'); ginterfaces_ok($completion); $entry->set_completion ($completion); is ($completion->get_entry, $entry); $completion->set_model (undef); my $model = Gtk2::ListStore->new ('Glib::String'); $completion->set_model ($model); is ($completion->get_model, $model); $completion->set_text_column (0); $completion->set_match_func (\&match_func, 42); $completion->set_minimum_key_length (5); is ($completion->get_minimum_key_length, 5); $completion->complete; $completion->insert_action_text (1, 'text string'); $completion->insert_action_markup (2, 'markup string'); $entry->set_text ('text s'); $completion->complete; $completion->delete_action (0); SKIP: { skip 'new 2.6 stuff', 3 unless Gtk2->CHECK_VERSION (2, 6, 0); is ($completion->get_text_column, 0); $completion->set_inline_completion (1); is ($completion->get_inline_completion, 1); $completion->set_popup_completion (1); is ($completion->get_popup_completion, 1); $completion->insert_prefix; } SKIP: { skip 'new 2.8 stuff', 2 unless Gtk2->CHECK_VERSION (2, 8, 0); $completion->set_popup_set_width (TRUE); is ($completion->get_popup_set_width, TRUE); $completion->set_popup_single_match (TRUE); is ($completion->get_popup_single_match, TRUE); } SKIP: { skip 'new 2.12 stuff', 2 unless Gtk2->CHECK_VERSION (2, 12, 0); $completion->set_inline_selection (TRUE); is ($completion->get_inline_selection, TRUE); is ($completion->get_completion_prefix, undef); } __END__ Copyright (C) 2003-2005 by the gtk2-perl team (see the file AUTHORS for the full list). See LICENSE for more information. Gtk2-1.24992/t/GtkSizeGroup.t0000644000175000017500000000250313076462677014170 0ustar lacklack#!/usr/bin/perl -w # vim: set ft=perl et sw=2 sts=2 : use strict; use Gtk2::TestHelper tests => 5, noinit => 1; # $Id$ my $group = Gtk2::SizeGroup -> new("vertical"); isa_ok($group, "Gtk2::SizeGroup"); $group -> set_mode("horizontal"); is($group -> get_mode(), "horizontal"); my $label = Gtk2::Label -> new("Bla"); $group -> add_widget($label); $group -> remove_widget($label); SKIP: { skip("new 2.8 stuff", 1) unless Gtk2->CHECK_VERSION (2, 8, 0); $group -> set_ignore_hidden(TRUE); ok($group -> get_ignore_hidden()); } SKIP: { skip("new 2.10 stuff", 2) unless Gtk2->CHECK_VERSION (2, 10, 0); # we last left it empty. my @widgets = $group->get_widgets; ok(!@widgets); my ($uno, $dos, $tres, $cuatro) = (Gtk2::Label->new ("Tinky-Winky"), Gtk2::Label->new ("Dipsy"), Gtk2::Label->new ("La La"), Gtk2::Label->new ("Po")); # now add a few and try again. $group->add_widget($uno); $group->add_widget($dos); $group->add_widget($tres); $group->add_widget($cuatro); @widgets = $group->get_widgets; is (scalar @widgets, 4); # i don't think we can count on an order. do we care about ensuring # that the same widgets are in the group as we added? } __END__ Copyright (C) 2003-2006 by the gtk2-perl team (see the file AUTHORS for the full list). See LICENSE for more information. Gtk2-1.24992/t/GtkTooltips.t0000644000175000017500000000170213076462677014056 0ustar lacklack# # $Id$ # ######################### # GtkTooltips Tests # - rm ######################### use Gtk2::TestHelper tests => 10; ok( my $tips = Gtk2::Tooltips->new ); ok( my $btn = Gtk2::Button->new('Button 1') ); $tips->set_tip($btn, 'Tip 1', 'Vebose Tip 1'); ok(1); ok( $btn = Gtk2::Button->new('Button 2') ); $tips->set_tip($btn, 'Tip 2', 'Vebose Tip 2'); is_deeply( Gtk2::Tooltips->data_get($btn), { tooltips => $tips, widget => $btn, tip_text => 'Tip 2', tip_private => 'Vebose Tip 2' } ); ok( $btn = Gtk2::Button->new('Button 3') ); $tips->set_tip($btn, 'This is a really long, really big tooltip which doesn\'t ' .'tell you anything worth knowning. There\'s no private tip either', undef); ok(1); $tips->force_window; ok(1); $tips->disable; ok(1); $tips->enable; ok(1); __END__ Copyright (C) 2003 by the gtk2-perl team (see the file AUTHORS for the full list). See LICENSE for more information. Gtk2-1.24992/t/GtkHRuler.t0000644000175000017500000000043113076462677013440 0ustar lacklack#!/usr/bin/perl -w use strict; use Gtk2::TestHelper tests => 1, noinit => 1; # $Id$ my $ruler = Gtk2::HRuler -> new(); isa_ok($ruler, "Gtk2::HRuler"); __END__ Copyright (C) 2003 by the gtk2-perl team (see the file AUTHORS for the full list). See LICENSE for more information. Gtk2-1.24992/t/GtkTextMark.t0000644000175000017500000000227413076462677014005 0ustar lacklack#!/usr/bin/perl -w use strict; use Gtk2::TestHelper tests => 11, noinit => 1; # $Id$ my $buffer = Gtk2::TextBuffer -> new(); my $iter = $buffer -> get_start_iter(); $buffer -> insert($iter, "Lore ipsem dolor. I think that is misspelled.\n"); my $mark = $buffer -> create_mark("bla", $iter, 1); is($mark -> get_name(), "bla"); is($mark -> get_buffer(), $buffer); is($mark -> get_left_gravity(), 1); $mark -> set_visible(1); is($mark -> get_visible(), 1); $buffer -> delete_mark($mark); is($mark -> get_deleted(), 1, 'deleted mark - get_deleted()'); is($mark -> get_buffer(), undef, 'deleted mark - get_buffer()'); SKIP: { skip 'new 2.12 stuff', 5 unless Gtk2 -> CHECK_VERSION(2, 12, 0); my $mark = Gtk2::TextMark -> new(undef, TRUE); isa_ok($mark, 'Gtk2::TextMark'); is ($mark->get_name, undef, 'new() anonymous mark - get_name()'); is ($mark->get_buffer, undef, 'new() anonymous mark - get_buffer()'); $mark = Gtk2::TextMark -> new('bla', TRUE); isa_ok($mark, 'Gtk2::TextMark'); is ($mark->get_name, 'bla', 'new() named mark - get_name()'); } __END__ Copyright (C) 2003, 2010 by the gtk2-perl team (see the file AUTHORS for the full list). See LICENSE for more information. Gtk2-1.24992/t/GtkToggleButton.t0000644000175000017500000000140213076462677014653 0ustar lacklack#!/usr/bin/perl -w use strict; use Gtk2::TestHelper tests => 9; # $Id$ my $button = Gtk2::ToggleButton -> new(); isa_ok($button, "Gtk2::ToggleButton"); is($button -> get("label"), undef); $button = Gtk2::ToggleButton -> new_with_label("Bla"); isa_ok($button, "Gtk2::ToggleButton"); is($button -> get("label"), "Bla"); $button = Gtk2::ToggleButton -> new_with_mnemonic("_Bla"); isa_ok($button, "Gtk2::ToggleButton"); is($button -> get("label"), "_Bla"); $button -> set_mode(1); is($button -> get_mode(), 1); $button -> set_active(1); is($button -> get_active(), 1); $button -> set_inconsistent(1); is($button -> get_inconsistent(), 1); __END__ Copyright (C) 2003 by the gtk2-perl team (see the file AUTHORS for the full list). See LICENSE for more information. Gtk2-1.24992/t/GtkTextChildAnchor.t0000644000175000017500000000200113076462677015255 0ustar lacklack#!/usr/bin/perl -w use strict; use Gtk2::TestHelper tests => 3; # $Id$ my $buffer = Gtk2::TextBuffer -> new(); my $view = Gtk2::TextView -> new_with_buffer($buffer); my $iter = $buffer -> get_start_iter(); $buffer -> insert($iter, join("", "Lore ipsem dolor. I think that is misspelled.\n" x 80)); my $anchor = Gtk2::TextChildAnchor -> new(); isa_ok($anchor, "Gtk2::TextChildAnchor"); # letting an anchor die without having inserted it into a buffer causes # very bad things to happen. dispose of it nicely. $buffer->insert_child_anchor ($iter, $anchor); my $button = Gtk2::Button -> new("Bla"); my $label = Gtk2::Label -> new("Bla"); $anchor = $buffer -> create_child_anchor($iter); $view -> add_child_at_anchor($button, $anchor); $view -> add_child_at_anchor($label, $anchor); is_deeply([$anchor -> get_widgets()], [$button, $label]); ok(!$anchor -> get_deleted()); __END__ Copyright (C) 2003 by the gtk2-perl team (see the file AUTHORS for the full list). See LICENSE for more information. Gtk2-1.24992/t/PangoFontMap.t0000644000175000017500000000146313076462677014130 0ustar lacklack#!/usr/bin/perl -w use strict; use Gtk2::TestHelper tests => 4; # $Id$ my $label = Gtk2::Label -> new("Bla"); my $context = $label -> create_pango_context(); isa_ok($context, "Gtk2::Pango::Context"); SKIP: { skip("get_font_map is new in 1.6", 3) unless (Gtk2::Pango -> CHECK_VERSION(1, 6, 0)); my $map = $context -> get_font_map(); my $desc = Gtk2::Pango::FontDescription -> from_string("Sans 12"); my $lang = Gtk2::Pango::Language -> from_string("de_DE"); isa_ok($map -> load_font($context, $desc), "Gtk2::Pango::Font"); isa_ok($map -> load_fontset($context, $desc, $lang), "Gtk2::Pango::Fontset"); isa_ok(($map -> list_families())[0], "Gtk2::Pango::FontFamily"); } __END__ Copyright (C) 2004 by the gtk2-perl team (see the file AUTHORS for the full list). See LICENSE for more information. Gtk2-1.24992/t/GdkPixbufLoader.t0000644000175000017500000001106113076462676014603 0ustar lacklack#!/usr/bin/perl -w # # Copyright (c) 2005 by the gtk2-perl team (see the file AUTHORS) # # This library is free software; you can redistribute it and/or # modify it under the terms of the GNU Library General Public # License as published by the Free Software Foundation; either # version 2.1 of the License, or (at your option) any later version. # # This library is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU # Library General Public License for more details. # # You should have received a copy of the GNU Library General Public # License along with this library; if not, write to the # Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, # Boston, MA 02110-1301 USA. # # $Id$ use strict; use warnings; use Gtk2; use Test::More; unless (Gtk2->CHECK_VERSION (2, 2, 0)) { plan skip_all => "This doesn't seem to work on 2.0"; } else { plan tests => 29; } # first, a helper. sub make_ppm_data { my ($width, $height) = @_; my $header = "P6\n$width $height\n255\n"; my $data = pack 'a*', map { $_ % 255 } 1..($width * $height * 3); return $header.$data; } # now, let's test! # Automatic detection of the image type seems to be broken in some versions of # gtk+; see . So we don't # use an auto-detecting loader here. my $loader = Gtk2::Gdk::PixbufLoader->new_with_mime_type ( 'image/x-portable-pixmap'); isa_ok ($loader, 'Glib::Object'); isa_ok ($loader, 'Gtk2::Gdk::PixbufLoader'); $loader->write (make_ppm_data (10, 15)); $loader->close; my $pixbuf = $loader->get_pixbuf; isa_ok ($pixbuf, 'Gtk2::Gdk::Pixbuf'); is ($pixbuf->get_width, 10, 'image width'); is ($pixbuf->get_height, 15, 'image height'); # looks like you get an animation regardless of whether the file is animated. isa_ok ($loader->get_animation, 'Gtk2::Gdk::PixbufAnimation'); SKIP: { skip 'get_format was added in 2.2.0', 3 if Gtk2->check_version (2, 2, 0); my $format = $loader->get_format; isa_ok ($format, 'HASH'); isa_ok ($format, 'Gtk2::Gdk::PixbufFormat'); is ($format->{name}, 'pnm'); } $loader = undef; $pixbuf = undef; # bad explicit type should throw an exception. eval { $loader = Gtk2::Gdk::PixbufLoader->new_with_type ('something bogus'); }; is ($loader, undef); ok ($@, 'got an exception'); isa_ok ($@, 'Glib::Error'); is ($@->value, 'unknown-type'); foreach (Gtk2::Gdk::PixbufLoader->new_with_type ('png'), Gtk2::Gdk::PixbufLoader::new_with_type ('png')) { # we should get an error when writing ppm data to a png loader. eval { $_->write (make_ppm_data (20, 20)); }; ok ($@, 'got an exception'); isa_ok ($@, 'Glib::Error'); is ($@->value, 'corrupt-image'); $_->close; } SKIP: { skip 'gdk_pixbuf_loader_set_size was added in 2.2.0', 2 if Gtk2->check_version (2, 2, 0); # set_size can be used to do load-time scaling. $loader = Gtk2::Gdk::PixbufLoader->new_with_mime_type ( 'image/x-portable-pixmap'); $loader->set_size (48, 32); $loader->write (make_ppm_data (96, 64)); $loader->close; $pixbuf = $loader->get_pixbuf; is ($pixbuf->get_width, 48); is ($pixbuf->get_height, 32); $loader = undef; } SKIP: { skip 'new_with_mime_type was added in 2.4.0, but only works with 2.6.0', 4 if Gtk2->check_version (2, 6, 0); foreach (Gtk2::Gdk::PixbufLoader->new_with_mime_type ('image/x-portable-pixmap'), Gtk2::Gdk::PixbufLoader::new_with_mime_type ('image/x-portable-pixmap')) { isa_ok ($_, 'Glib::Object'); isa_ok ($_, 'Gtk2::Gdk::PixbufLoader'); $_->write (make_ppm_data (64, 64)); $_->close; $_ = undef; } } # test chunked writing and signals and such SKIP: { my $filename = 'gtk-demo/alphatest.png'; skip "can't locate test image file", 4 unless -f $filename; open IN, $filename or die "can't open $filename: $!"; binmode IN; $loader = Gtk2::Gdk::PixbufLoader->new; $loader->signal_connect (size_prepared => sub { ok (1, 'size-prepared') }); $loader->signal_connect (area_prepared => sub { ok (1, 'area-prepared') }); my $area_updated = 0; $loader->signal_connect (area_updated => sub { $area_updated++ }); $loader->signal_connect (closed => sub { ok (1, 'closed') }); my $data; while (sysread IN, $data, 64) { $loader->write ($data); } ok ($area_updated, 'got some area-updated signals'); close IN; $loader->close; $loader = undef; } Gtk2-1.24992/t/GtkBuildable.t0000644000175000017500000000330013076462676014117 0ustar lacklack#!/usr/bin/perl use strict; use warnings; use Gtk2::TestHelper tests => 7, at_least_version => [2, 12, 0, 'GtkBuildable: it appeared in 2.12']; # $Id$ # --------------------------------------------------------------------------- # my $builder = Gtk2::Builder->new; my $buildable = Gtk2::ListStore->new (qw/Glib::String/); isa_ok ($buildable, 'Gtk2::Buildable'); $buildable->set_name ('store'); is ($buildable->get_name, 'store'); # --------------------------------------------------------------------------- # $buildable = Gtk2::HBox->new; isa_ok ($buildable, 'Gtk2::Buildable'); my $button = Gtk2::Button->new ('Button'); my $label = Gtk2::Label->new ('Label'); $buildable->add_child ($builder, $button, undef); $buildable->add_child ($builder, $label, undef); is_deeply([$buildable->get_children], [$button, $label]); $buildable->set_buildable_property($builder, border_width => 23, resize_mode => 'parent'); is_deeply([$buildable->get (qw/border_width resize_mode/)], [23, 'parent']); # --------------------------------------------------------------------------- # $buildable = Gtk2::UIManager->new; $buildable->add_ui_from_string (<<__EOD__); __EOD__ isa_ok ($buildable->construct_child ($builder, "MenuBar"), "Gtk2::MenuBar"); $buildable->parser_finished ($builder); # --------------------------------------------------------------------------- # $buildable = Gtk2::Dialog->new; isa_ok ($buildable->get_internal_child ($builder, 'vbox'), 'Gtk2::VBox'); __END__ Copyright (C) 2007 by the gtk2-perl team (see the file AUTHORS for the full list). See LICENSE for more information. Gtk2-1.24992/t/GtkRadioButton.t0000644000175000017500000000321413076462677014473 0ustar lacklack# # $Id$ # ######################### # GtkRadioButton Tests # - rm ######################### use Gtk2::TestHelper tests => 13; ok( my $vbox = Gtk2::VBox->new(0, 5) ); # $win->add($vbox); my $rdobtn; ok( $rdobtn = Gtk2::RadioButton->new() ); $vbox->pack_start($rdobtn, 0, 0, 0); ok( $rdobtn = Gtk2::RadioButton->new_from_widget($rdobtn) ); $vbox->pack_start($rdobtn, 0, 0, 0); ok( $rdobtn = Gtk2::RadioButton->new_from_widget($rdobtn, "label") ); $vbox->pack_start($rdobtn, 0, 0, 0); ok( $rdobtn = Gtk2::RadioButton->new(undef, "foo") ); $vbox->pack_start($rdobtn, 0, 0, 0); ok( $rdobtn = Gtk2::RadioButton->new($rdobtn, "bar") ); $vbox->pack_start($rdobtn, 0, 0, 0); ok( $rdobtn = Gtk2::RadioButton->new([ $rdobtn ], "bar2") ); $vbox->pack_start($rdobtn, 0, 0, 0); ok( scalar(@{$rdobtn->get_group}) == 3 ); { # get_group() no memory leaks in arrayref return and array items my $x = Gtk2::RadioButton->new; my $y = Gtk2::RadioButton->new; $y->set_group($x); my $aref = $x->get_group; is_deeply($aref, [$x,$y]); require Scalar::Util; Scalar::Util::weaken ($aref); is ($aref, undef, 'get_group() array destroyed by weakening'); Scalar::Util::weaken ($x); is ($x, undef, 'get_group() item x destroyed by weakening'); Scalar::Util::weaken ($y); is ($y, undef, 'get_group() item y destroyed by weakening'); } my $i; my @rdobtns; for( $i = 0; $i < 5; $i++ ) { $rdobtns[$i] = Gtk2::RadioButton->new(\@rdobtns, $i); $vbox->pack_start($rdobtns[$i], 0, 0, 0); } ok( scalar(@{$rdobtns[0]->get_group}) == 5 ); 1; __END__ Copyright (C) 2003, 2010 by the gtk2-perl team (see the file AUTHORS for the full list). See LICENSE for more information. Gtk2-1.24992/t/GtkTreeModel.t0000644000175000017500000001441713076462677014130 0ustar lacklack#!/usr/bin/perl -w use strict; use Gtk2::TestHelper tests => 75, noinit => 1; # $Id$ ############################################################################### my $model = Gtk2::ListStore -> new("Glib::String", "Glib::Int"); isa_ok($model, "Gtk2::TreeModel"); ok($model -> get_flags() == ["iters-persist", "list-only"]); $model = Gtk2::TreeStore -> new("Glib::String", "Glib::Int"); isa_ok($model, "Gtk2::TreeModel"); ok($model -> get_flags() == ["iters-persist"]); my $count = $model -> get_n_columns(); is($count, 2); is($model -> get_column_type(0), "Glib::String"); is($model -> get_column_type(1), "Glib::Int"); ############################################################################### foreach (qw(bla blee bliii bloooo)) { my $iter = $model -> append(undef); isa_ok($iter, "Gtk2::TreeIter"); $model -> set($iter, 0 => $_, 1 => length($_)); is($model -> get($iter, 0), $_); is($model -> get($iter, 1), length($_)); is(($model -> get($iter, 0, 1))[0], $_); is(($model -> get($iter, 0, 1))[1], length($_)); is($model -> get_value($iter, 0), $_); is($model -> get_value($iter, 1), length($_)); ####################################################################### foreach my $multiplier(1 .. 3) { my $iter_child = $model -> append($iter); $model -> set($iter_child, 0 => $_ x $multiplier, 1 => length($_ x $multiplier)); my $iter_child_child = $model -> append($iter_child); $model -> set($iter_child_child, 0 => reverse($_) x $multiplier, 1 => length(reverse($_) x $multiplier)); } } ############################################################################### SKIP: { skip("there doesn't seem to be a GType for GtkTreeRowReference in 2.0.x", 5) unless Gtk2 -> CHECK_VERSION(2, 2, 0); my ($ref_one, $ref_two, $ref_path); $ref_one = Gtk2::TreeRowReference -> new($model, Gtk2::TreePath -> new_from_string("0")); isa_ok($ref_one, "Gtk2::TreeRowReference"); is($ref_one -> valid(), 1); $ref_path = $ref_one -> get_path(); is($ref_path -> to_string(), "0"); $ref_two = $ref_one -> copy(); is($ref_two -> valid(), 1); SKIP: { skip("new 2.8 stuff", 1) unless Gtk2 -> CHECK_VERSION(2, 8, 0); is($ref_one -> get_model(), $model); } } ############################################################################### $model -> ref_node($model -> get_iter_first()); $model -> unref_node($model -> get_iter_first()); $model -> foreach(sub { my ($model, $path, $iter) = @_; isa_ok($model, "Gtk2::TreeStore"); isa_ok($path, "Gtk2::TreePath"); isa_ok($iter, "Gtk2::TreeIter"); return 1; }); ############################################################################### my ($path_one, $path_two); $path_one = Gtk2::TreePath -> new(); isa_ok($path_one, "Gtk2::TreePath"); $path_one = Gtk2::TreePath -> new_from_string("0"); is($path_one -> to_string(), "0"); $path_one = Gtk2::TreePath -> new_first(); is($path_one -> to_string(), "0"); $path_two = $path_one -> copy(); is($path_one -> compare($path_two), 0); $path_one = Gtk2::TreePath -> new("1"); SKIP: { skip("new_from_indices is new in 2.2.x", 1) unless Gtk2->CHECK_VERSION (2, 2, 0); $path_one = Gtk2::TreePath -> new_from_indices(1); is($model -> get($model -> get_iter($path_one), 0), "blee"); } $path_one -> prepend_index(1); is($model -> get($model -> get_iter($path_one), 0), "bleeblee"); $path_one -> append_index(0); is($model -> get($model -> get_iter($path_one), 0), "eelbeelb"); is($path_one -> get_depth(), 3); is_deeply([$path_one -> get_indices()], [1, 1, 0]); $path_two = Gtk2::TreePath -> new("1:1"); $path_two -> down(); is($path_two -> to_string(), "1:1:0"); is($path_two -> up(), 1); is($path_two -> to_string(), "1:1"); is($path_two -> is_ancestor($path_one), 1); is($path_one -> is_descendant($path_two), 1); $path_two -> next(); is($path_two -> to_string(), "1:2"); is($path_two -> prev(), 1); is($path_two -> to_string(), "1:1"); ############################################################################### my $iter; $iter = $model -> get_iter(Gtk2::TreePath -> new_from_string("0")); isa_ok($iter, "Gtk2::TreeIter"); is($model -> get_path($iter) -> to_string(), "0"); $iter = $model -> get_iter_from_string("0"); is($model -> get_path($iter) -> to_string(), "0"); $iter = $model -> get_iter_first(); is($model -> get_path($iter) -> to_string(), "0"); my $next = $model -> iter_next($iter); is($model -> get_path($iter) -> to_string(), "0"); is($model -> get_path($next) -> to_string(), "1"); SKIP: { skip("get_string_from_iter is new in 2.2.x", 1) unless Gtk2->CHECK_VERSION (2, 2, 0); is($model -> get_string_from_iter($iter), "0"); } ############################################################################### my ($iter_one, $iter_two); $iter_one = $model -> get_iter(Gtk2::TreePath -> new("2:2")); $iter_two = $model -> iter_parent($iter_one); is($model -> get($iter_two, 0), "bliii"); is($model -> iter_has_child($iter_two), 1); is($model -> iter_n_children($iter_two), 3); $iter_one = $model -> iter_nth_child($iter_two, 1); is($model -> get($iter_one, 0), "bliiibliii"); $iter_two = $model -> iter_children($iter_one); is($model -> get($iter_two, 0), "iiilbiiilb"); ############################################################################### $model -> row_changed($path_one, $iter_one); $model -> row_inserted($path_one, $iter_one); $model -> row_has_child_toggled($path_one, $iter_one); $model -> row_deleted($path_one); # Ensure that both spellings of the signal name get the custom marshaller. foreach my $signal_name (qw/rows_reordered rows-reordered/) { my $id = $model -> signal_connect($signal_name => sub { is_deeply($_[3], [3, 2, 1, 0], $signal_name); }); $model -> rows_reordered($path_one, undef, 3, 2, 1, 0); $model -> signal_handler_disconnect($id); } ############################################################################### # Ensure that getting all values of a row in a 1-column model does not result # in a stack handling error with perl >= 5.23. { my $model = Gtk2::ListStore -> new(qw/Glib::Int/); my $iter = $model -> append(); $model -> set($iter, 0 => 23); is ($model -> get($iter), 23); } ############################################################################### __END__ Copyright (C) 2003-2005 by the gtk2-perl team (see the file AUTHORS for the full list). See LICENSE for more information. Gtk2-1.24992/t/GtkMenu.t0000644000175000017500000001210313076462677013142 0ustar lacklack#!/usr/bin/perl # # $Id$ # ######################### # GtkMenu Tests # - rm ######################### use Gtk2::TestHelper tests => 66; ok( my $menubar = Gtk2::MenuBar->new ); my ($num, $menu, $accelgroup, $button, $menuitem, $rootmenu, $optmenu); foreach $num (qw/1 2 3/) { ok( $menu = Gtk2::Menu->new ); $accelgroup = Gtk2::AccelGroup->new; $menu->set_accel_group ($accelgroup); is ($menu->get_accel_group, $accelgroup); $menu->set_accel_path ("/main/menu"); $menu->set_title ("gtk2perl bla"); is ($menu->get_title, "gtk2perl bla"); $menu->set_tearoff_state (FALSE); ok (!$menu->get_tearoff_state); $menu->reposition; $button = Gtk2::Button->new ("Bla"); $menu->attach_to_widget ($button, sub { my ($callback_button, $callback_menu) = @_; is ($callback_button, $button); is ($callback_menu, $menu); }); is ($menu->get_attach_widget, $button); SKIP: { skip "new 2.6 stuff", 1 unless Gtk2->CHECK_VERSION (2, 6, 0); my @list = Gtk2::Menu->get_for_attach_widget ($button); is ($list[0], $menu); } $menu->detach; SKIP: { skip "set_screen is new in 2.2", 0 unless Gtk2->CHECK_VERSION (2, 2, 0); $menu->set_screen (Gtk2::Gdk::Screen->get_default); $menu->set_screen (undef); } $menuitem = undef; foreach (qw/One Two Three Four/) { ok( $menuitem = Gtk2::MenuItem->new($_.' '.$num) ); $menu->append( $menuitem ); } ok( $rootmenu = Gtk2::MenuItem->new('_Root Menu '.$num) ); $menu->reorder_child($menuitem, 1); $menu->set_active (TRUE); is ($menu->get_active, $menuitem); if( $num == 1 ) { $rootmenu->set_submenu($menu); # $menu->set_tearoff_state(TRUE); $menubar->append($rootmenu); ok(TRUE); } elsif( $num == 2 ) { $rootmenu->set_submenu($menu); $rootmenu->set_right_justified(TRUE); $menubar->append($rootmenu); ok(TRUE); } elsif( $num == 3 ) { ok(TRUE); } ok(TRUE); } ok( $optmenu = Gtk2::OptionMenu->new ); $optmenu->set_menu($menu); my $i_know_you = 0; my $position_callback = sub { return if $i_know_you++; my ($menu, $x, $y, $data) = @_; isa_ok ($menu, "Gtk2::Menu"); like ($x, qr/^\d+$/); like ($y, qr/^\d+$/); is ($data, "bla"); SKIP: { skip("attach and set_monitor are new in 2.4", 0) unless Gtk2->CHECK_VERSION (2, 4, 0); $menu->attach(Gtk2::MenuItem->new("Bla"), 0, 1, 0, 1); $menu->set_monitor(0); } return (50, 50); }; $menu->popup(undef, undef, $position_callback, "bla", 1, 0); $menu->popdown; ok(TRUE); # crib note: $position_callback sub must be a proper closure referring to a # variable outside itself to weaken away like this require Scalar::Util; Scalar::Util::weaken($position_callback); ok ($position_callback, 'popup() holds onto position_callback'); my $next_position_callback_variable = 0; my $next_position_callback = sub { $next_position_callback_variable++; return (50,50) }; $menu->popup(undef, undef, $next_position_callback, undef, 1, 0); $menu->popdown; is ($position_callback, undef, 'next popup() drops previously held position_callback'); # crib note: again $next_position_callback must refer to a variable outside # itself to weaken away like this require Scalar::Util; Scalar::Util::weaken($next_position_callback); ok ($next_position_callback, 'popup() holds onto next_position_callback'); $menu->popup(undef, undef, undef, undef, 1, 0); $menu->popdown; is ($next_position_callback, undef, 'popup() with no position func drops held position_callback'); # If we never entered the pos. callback, fake four tests unless ($i_know_you) { foreach (0 .. 3) { ok (TRUE, 'faking pos. callback'); } } { my $item = Gtk2::MenuItem->new; my $menu = Gtk2::Menu->new; my $detach_args; my $detach_func = sub { $detach_args = \@_; }; $menu->attach_to_widget ($item, $detach_func); $menu->detach; is_deeply ($detach_args, [ $item, $menu ], 'detach callback args'); # crib note: $detach_func must be a closure referring to a variable # outside itself to weaken away like this Scalar::Util::weaken ($detach_func); is ($detach_func, undef, 'detach callback func freed after called'); } { my $popup_runs = 0; my $saw_warning = ''; { local $SIG{__WARN__} = sub { $saw_warning = $_[0] }; $menu->popup(undef, undef, sub { $popup_runs = 1; die; }, undef, 1, 0); } note "popup position runs=$popup_runs warn='$saw_warning'"; $menu->popdown; ok ($popup_runs, 'popup positioning die() - popup runs'); ok ($saw_warning, 'popup positioning die() - die not fatal, turned into warning'); } SKIP: { skip 'new 2.14 stuff', 2 unless Gtk2->CHECK_VERSION(2, 14, 0); my $menu = Gtk2::Menu->new; $menu->set_accel_path ('/main/menu'); is ($menu->get_accel_path, '/main/menu'); $menu->set_monitor (0); is ($menu->get_monitor, 0); } SKIP: { skip 'new 2.18 stuff', 1 unless Gtk2->CHECK_VERSION(2, 18, 0); $menu->set_reserve_toggle_size(FALSE); is ($menu->get_reserve_toggle_size, FALSE, '[sg]et_reserve_toggle_size'); } __END__ Copyright (C) 2003, 2010 by the gtk2-perl team (see the file AUTHORS for the full list). See LICENSE for more information. Gtk2-1.24992/t/GtkFileChooserDialog.t0000644000175000017500000000241113076462677015561 0ustar lacklack# # $Id$ # sub on_unthreaded_freebsd { if ($^O eq 'freebsd') { require Config; if ($Config::Config{ldflags} !~ m/-pthread\b/) { return 1; } } return 0; } use Gtk2::TestHelper at_least_version => [2, 4, 0, "GtkFileChooser is new in 2.4"], tests => 6, (on_unthreaded_freebsd () ? (skip_all => 'need a perl compiled with "-pthread" on freebsd') : ()); my $dialog = Gtk2::FileChooserDialog->new ('some title', undef, 'save', 'gtk-cancel' => 'cancel', 'gtk-ok' => 'ok'); isa_ok ($dialog, 'Gtk2::FileChooserDialog'); ginterfaces_ok($dialog); is ($dialog->get_action, 'save'); $dialog = Gtk2::FileChooserDialog->new_with_backend ('some title', undef, 'open', 'backend', 'gtk-cancel' => 'cancel', 'gtk-ok' => 'ok'); isa_ok ($dialog, 'Gtk2::FileChooserDialog'); isa_ok ($dialog, 'Gtk2::FileChooser'); is ($dialog->get_action, 'open'); __END__ Copyright (C) 2003 by the gtk2-perl team (see the file AUTHORS for the full list). See LICENSE for more information. Gtk2-1.24992/t/GtkRadioToolButton.t0000644000175000017500000000330113076462677015326 0ustar lacklack#!/usr/bin/perl -w use strict; use Gtk2::TestHelper at_least_version => [2, 4, 0, "Action-based menus are new in 2.4"], tests => 12; # $Id$ my $item = Gtk2::RadioToolButton -> new(); isa_ok($item, "Gtk2::RadioToolButton"); my $item_two = Gtk2::RadioToolButton -> new(undef); isa_ok($item_two, "Gtk2::RadioToolButton"); my $item_three = Gtk2::RadioToolButton -> new([$item, $item_two]); isa_ok($item_three, "Gtk2::RadioToolButton"); $item_two = Gtk2::RadioToolButton -> new_from_stock(undef, "gtk-quit"); isa_ok($item_two, "Gtk2::RadioToolButton"); $item_three = Gtk2::RadioToolButton -> new_from_stock([$item, $item_two], "gtk-quit"); isa_ok($item_three, "Gtk2::RadioToolButton"); $item = Gtk2::RadioToolButton -> new_from_widget($item_two); isa_ok($item, "Gtk2::RadioToolButton"); $item = Gtk2::RadioToolButton -> new_with_stock_from_widget($item_two, "gtk-quit"); isa_ok($item, "Gtk2::RadioToolButton"); $item = Gtk2::RadioToolButton -> new(); $item -> set_group([$item_two, $item_three]); is_deeply($item -> get_group(), [$item_two, $item_three]); { # get_group() no memory leaks in arrayref return and array items my $x = Gtk2::RadioToolButton->new; my $y = Gtk2::RadioToolButton->new; $y->set_group($x); my $aref = $x->get_group; is_deeply($aref, [$x,$y]); require Scalar::Util; Scalar::Util::weaken ($aref); is ($aref, undef, 'get_group() array destroyed by weakening'); Scalar::Util::weaken ($x); is ($x, undef, 'get_group() item x destroyed by weakening'); Scalar::Util::weaken ($y); is ($y, undef, 'get_group() item y destroyed by weakening'); } __END__ Copyright (C) 2003, 2010 by the gtk2-perl team (see the file AUTHORS for the full list). See LICENSE for more information. Gtk2-1.24992/t/GtkAlignment.t0000644000175000017500000000103713076462676014157 0ustar lacklack#!/usr/bin/perl -w use strict; use Gtk2::TestHelper tests => 2, noinit => 1; # $Id$ my $alignment = Gtk2::Alignment -> new(2.3, 4.2, 7, 13); isa_ok($alignment, "Gtk2::Alignment"); $alignment -> set(2.3, 4.2, 7, 13); SKIP: { skip("[sg]et_padding are new in 2.4", 1) unless Gtk2->CHECK_VERSION (2, 4, 0); $alignment -> set_padding(1, 2, 3, 4); is_deeply([$alignment -> get_padding()], [1, 2, 3, 4]); } __END__ Copyright (C) 2003 by the gtk2-perl team (see the file AUTHORS for the full list). See LICENSE for more information. Gtk2-1.24992/t/GtkPrintOperationPreview.t0000644000175000017500000000157213076462677016565 0ustar lacklack#!/usr/bin/perl -w use strict; use Gtk2::TestHelper tests => 4, at_least_version => [2, 10, 0, "GtkPrintOperationPreview is new in 2.10"]; # $Id$ my $op = Gtk2::PrintOperation -> new(); $op -> signal_connect(preview => sub { my ($op, $preview, $context, $window) = @_; isa_ok($op, "Gtk2::PrintOperation"); isa_ok($preview, "Gtk2::PrintOperationPreview"); isa_ok($context, "Gtk2::PrintContext"); is($window, undef); my $surf = Cairo::ImageSurface -> create("rgb24", 1, 1); my $cr = Cairo::Context -> create($surf); $context -> set_cairo_context($cr, 72, 72); # This is not nice at all, but I know of no other way to convince the op that # now's a good time to stop blocking. exit; return TRUE; }); $op -> run("preview", undef); __END__ Copyright (C) 2006 by the gtk2-perl team (see the file AUTHORS for the full list). See LICENSE for more information. Gtk2-1.24992/t/GtkActivatable.t0000644000175000017500000000135213076462676014460 0ustar lacklack#!/usr/bin/env perl use Gtk2::TestHelper tests => 4, at_least_version => [2, 16, 0, "Gtk2::Activatable is new in 2.16"]; my $activatable = Gtk2::Button->new ('Test'); isa_ok ($activatable, 'Gtk2::Activatable'); my $action = Gtk2::Action->new ('name', 'label', 'tooltip', 'gtk-ok'); is ($activatable->get_related_action, undef); $activatable->set_related_action ($action); is ($activatable->get_related_action, $action); $activatable->set_use_action_appearance (TRUE); ok ($activatable->get_use_action_appearance); $activatable->do_set_related_action ($action); $activatable->sync_action_properties ($action); __END__ Copyright (C) 2010 by the gtk2-perl team (see the file AUTHORS for the full list). See LICENSE for more information. Gtk2-1.24992/t/GdkCursor.t0000644000175000017500000000536713076462676013510 0ustar lacklack#!/usr/bin/perl -w use strict; use Gtk2::TestHelper tests => 9; # $Id$ my $cursor = Gtk2::Gdk::Cursor -> new("watch"); isa_ok($cursor, "Gtk2::Gdk::Cursor"); is($cursor -> type(), "watch"); # new_from_pixmap use constant width => 16; use constant height => 16; my $eyes_bits = pack 'C*', 0x18, 0x18, 0x24, 0x24, 0x42, 0x42, 0x42, 0x42, 0xe1, 0xe1, 0xf1, 0xf1, 0xf1, 0xf1, 0xf1, 0xf1, 0xf1, 0xf1, 0xf1, 0xf1, 0xf1, 0xf1, 0xe1, 0xe1, 0x42, 0x42, 0x42, 0x42, 0x24, 0x24, 0x18, 0x18; my $eyes_mask_bits = pack 'C*', 0x18, 0x18, 0x3c, 0x3c, 0x7e, 0x7e, 0x7e, 0x7e, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0x7e, 0x7e, 0x7e, 0x7e, 0x3c, 0x3c, 0x18, 0x18; my $fg = Gtk2::Gdk::Color->new (0, 0, 0); # black my $bg = Gtk2::Gdk::Color->new (65535, 65535, 65535); # white my $source = Gtk2::Gdk::Bitmap->create_from_data (undef, $eyes_bits, width, height); my $mask = Gtk2::Gdk::Bitmap->create_from_data (undef, $eyes_mask_bits, width, height); $cursor = Gtk2::Gdk::Cursor->new_from_pixmap ($source, $mask, $fg, $bg, 8, 8); isa_ok($cursor, "Gtk2::Gdk::Cursor"); SKIP: { skip("new_for_display is new in 2.2", 2) unless Gtk2 -> CHECK_VERSION(2, 2, 0); my $display = Gtk2::Gdk::Display -> get_default(); $cursor = Gtk2::Gdk::Cursor -> new_for_display($display, "watch"); isa_ok($cursor, "Gtk2::Gdk::Cursor"); is($cursor -> get_display(), $display); } SKIP: { skip("new_from_pixbuf is new in 2.4", 1) unless Gtk2 -> CHECK_VERSION(2, 4, 0); my $display = Gtk2::Gdk::Display -> get_default(); my $pixbuf = Gtk2::Gdk::Pixbuf -> new("rgb", 0, 8, 10, 10); my $cursor = Gtk2::Gdk::Cursor -> new_from_pixbuf($display, $pixbuf, 5, 5); isa_ok($cursor, "Gtk2::Gdk::Cursor"); } SKIP: { skip("new 2.8 stuff", 2) unless Gtk2->CHECK_VERSION (2, 8, 0); my $display = Gtk2::Gdk::Display -> get_default(); # new_from_name will return undef if there is no cursor with that name. # this can happen with different cursor themes and such. my $cursor = Gtk2::Gdk::Cursor -> new_from_name($display, "watch"); skip "no cursor named 'watch'; that probably means that new_from_name works.", 2 unless $cursor; isa_ok($cursor, "Gtk2::Gdk::Cursor"); my $pixbuf = $cursor -> get_image(); ok(!defined $pixbuf || UNIVERSAL::isa($pixbuf, "Gtk2::Gdk::Pixbuf")); } SKIP: { skip 'new 2.22 stuff', 1 unless Gtk2->CHECK_VERSION(2, 22, 0); my $display = Gtk2::Gdk::Display -> get_default(); my $pixbuf = Gtk2::Gdk::Pixbuf -> new("rgb", 0, 8, 10, 10); my $cursor = Gtk2::Gdk::Cursor -> new_from_pixbuf($display, $pixbuf, 5, 5); ok(defined $cursor -> get_cursor_type()); } __END__ Copyright (C) 2003-2005 by the gtk2-perl team (see the file AUTHORS for the full list). See LICENSE for more information. Gtk2-1.24992/t/GdkPixmap.t0000644000175000017500000000253213076462676013460 0ustar lacklack#!/usr/bin/perl -w use strict; use Gtk2::TestHelper tests => 6; # $Id$ my $window = Gtk2::Window -> new(); $window -> realize(); SKIP: { skip("I need X11 for this", 6) unless ($window -> window() -> can("get_xid")); my $xid = $window -> window() -> get_xid(); isa_ok(Gtk2::Gdk::Pixmap -> foreign_new($xid), "Gtk2::Gdk::Pixmap"); isa_ok(Gtk2::Gdk::Pixmap -> lookup($xid), "Gtk2::Gdk::Pixmap"); SKIP: { skip("GdkDisplay is new in 2.2", 3) unless Gtk2 -> CHECK_VERSION(2, 2, 0); my $display = Gtk2::Gdk::Display -> get_default(); isa_ok(Gtk2::Gdk::Pixmap -> foreign_new_for_display($display, $xid), "Gtk2::Gdk::Pixmap"); isa_ok(Gtk2::Gdk::Pixmap -> lookup_for_display($display, $xid), "Gtk2::Gdk::Pixmap"); ok (! Gtk2::Gdk::Pixmap->create_from_xpm ($window->window, undef, 'non-existent.xpm'), 'asking for non-existent xpm returns undef'); # XXX missing tests for the rest of the GdkPixmap API. } SKIP: { skip("2.10 stuff", 1) unless Gtk2 -> CHECK_VERSION(2, 10, 0); my $screen = Gtk2::Gdk::Screen -> get_default(); my $pixmap = Gtk2::Gdk::Pixmap -> foreign_new_for_screen($screen, $xid, 23, 42, 16); isa_ok($pixmap, "Gtk2::Gdk::Pixmap"); } } __END__ Copyright (C) 2003 by the gtk2-perl team (see the file AUTHORS for the full list). See LICENSE for more information. Gtk2-1.24992/t/GtkRadioMenuItem.t0000644000175000017500000000356313076462677014752 0ustar lacklack#!/usr/bin/perl -w use strict; use Gtk2::TestHelper tests => 13; # $Id$ my $item_one = Gtk2::RadioMenuItem -> new(); isa_ok($item_one, "Gtk2::RadioMenuItem"); my $item_two = Gtk2::RadioMenuItem -> new($item_one); isa_ok($item_two, "Gtk2::RadioMenuItem"); my $item_three = Gtk2::RadioMenuItem -> new_with_label([], "Bla"); isa_ok($item_three, "Gtk2::RadioMenuItem"); my $item_four = Gtk2::RadioMenuItem -> new_with_mnemonic([$item_one, $item_two], "_Bla"); isa_ok($item_four, "Gtk2::RadioMenuItem"); $item_three -> set_group($item_one); is_deeply($item_one -> get_group(), [$item_one, $item_two, $item_three, $item_four]); { # get_group() no memory leaks in arrayref return and array items my $x = Gtk2::RadioMenuItem->new; my $y = Gtk2::RadioMenuItem->new; $y->set_group($x); my $aref = $x->get_group; is_deeply($aref, [$x,$y]); require Scalar::Util; Scalar::Util::weaken ($aref); is ($aref, undef, 'get_group() array destroyed by weakening'); Scalar::Util::weaken ($x); is ($x, undef, 'get_group() item x destroyed by weakening'); Scalar::Util::weaken ($y); is ($y, undef, 'get_group() item y destroyed by weakening'); } SKIP: { skip("the from_widget variants are new in 2.4", 4) unless Gtk2->CHECK_VERSION (2, 4, 0); my $item_five = Gtk2::RadioMenuItem -> new_from_widget($item_one); isa_ok($item_five, "Gtk2::RadioMenuItem"); my $item_six = Gtk2::RadioMenuItem -> new_with_label_from_widget($item_two, "Bla"); isa_ok($item_six, "Gtk2::RadioMenuItem"); my $item_seven = Gtk2::RadioMenuItem -> new_with_mnemonic_from_widget($item_three, "_Bla"); isa_ok($item_seven, "Gtk2::RadioMenuItem"); is_deeply($item_one -> get_group(), [$item_one, $item_two, $item_three, $item_four, $item_five, $item_six, $item_seven]); } __END__ Copyright (C) 2003, 2010 by the gtk2-perl team (see the file AUTHORS for the full list). See LICENSE for more information. Gtk2-1.24992/t/PangoTabs.t0000644000175000017500000000145513076462677013456 0ustar lacklack#!/usr/bin/perl -w use strict; use Gtk2::TestHelper tests => 6, noinit => 1; # $Id$ SKIP: { skip("PangoTabs was broken prior to 1.3.3", 6) unless (Gtk2::Pango -> CHECK_VERSION(1, 4, 0)); my $array = Gtk2::Pango::TabArray -> new(8, 0); isa_ok($array, "Gtk2::Pango::TabArray"); $array = Gtk2::Pango::TabArray -> new_with_positions(2, 1, "left", 8, "left", 16); isa_ok($array, "Gtk2::Pango::TabArray"); $array -> resize(3); is($array -> get_size(), 3); $array -> set_tab(2, "left", 24); is_deeply([$array -> get_tab(2)], ["left", 24]); is_deeply([$array -> get_tabs()], ["left", 8, "left", 16, "left", 24]); is($array -> get_positions_in_pixels(), 1); } __END__ Copyright (C) 2003 by the gtk2-perl team (see the file AUTHORS for the full list). See LICENSE for more information. Gtk2-1.24992/t/GtkToggleAction.t0000644000175000017500000000121313076462677014615 0ustar lacklack# # $Id$ # use Gtk2::TestHelper at_least_version => [2, 4, 0, "Action-based menus are new in 2.4"], tests => 8; my $action = Gtk2::ToggleAction->new; isa_ok ($action, 'Gtk2::ToggleAction'); $action->signal_connect (toggled => sub { ok (TRUE) }); $action->toggled; $action->set_active (TRUE); ok ($action->get_active); $action->set_active (FALSE); ok (!$action->get_active); $action->set_draw_as_radio (TRUE); ok ($action->get_draw_as_radio); $action->set_draw_as_radio (FALSE); ok (!$action->get_draw_as_radio); __END__ Copyright (C) 2003 by the gtk2-perl team (see the file AUTHORS for the full list). See LICENSE for more information. Gtk2-1.24992/t/GtkTextTagTable.t0000644000175000017500000000101513076462677014566 0ustar lacklack#!/usr/bin/perl -w use strict; use Gtk2::TestHelper tests => 5, noinit => 1; # $Id$ my $table = Gtk2::TextTagTable -> new(); isa_ok($table, "Gtk2::TextTagTable"); my $tag = Gtk2::TextTag -> new("bla"); $table -> add($tag); is($table -> lookup("bla"), $tag); $table -> foreach(sub { is(shift(), $tag); is(shift(), "bla"); }, "bla"); is($table -> get_size(), 1); $table -> remove($tag); __END__ Copyright (C) 2003 by the gtk2-perl team (see the file AUTHORS for the full list). See LICENSE for more information. Gtk2-1.24992/t/GtkTreeView-Dnd.t0000644000175000017500000000333713076462677014504 0ustar lacklack#!/usr/bin/perl -w use strict; use Gtk2::TestHelper tests => 5, skip_all => 'this test is interactive'; use Data::Dumper; my $win = Gtk2::Window->new; my $model = Gtk2::TreeStore->new (qw/Glib::String/); my $iter; foreach (qw/one two three four five/) { $iter = $model->append (undef); $model->set ($iter, 0 => $_); } my $view = Gtk2::TreeView->new ($model); $view->append_column (Gtk2::TreeViewColumn->new_with_attributes ( 'title', Gtk2::CellRendererText->new, text => 0, )); #my $pixmap = $view->create_row_drag_icon (Gtk2::TreePath->new ("0:0")); #isa_ok ($pixmap, '', 'create_row_drag_icon'); $view->enable_model_drag_source (['button1-mask'], ['copy'], ['example', ['same-app'], 0]); $view->enable_model_drag_dest (['copy'], ['example', ['same-app'], 0]); $view->signal_connect (drag_data_received => sub { print Dumper (@_); my ($self, $context, $x, $y, $selection, $info, $time) = @_; my ($path, $pos) = $view->get_dest_row_at_pos ($x, $y); my $target = $model->get_iter ($path); my ($dpath, $dpos) = $view->get_drag_dest_row; is ($dpath, undef, 'get_drag_dest_row, path, empty'); ok (($dpos =~ /after|before/), 'get_drag_dest_row, pos'); $view->set_drag_dest_row ($path, $pos); ($dpath, $dpos) = $view->get_drag_dest_row; isa_ok ($dpath, 'Gtk2::TreePath', 'set_drag_dest_row, path, filled'); ok (($dpos =~ /after|before/), 'set_drag_dest_row, pos'); $view->unset_rows_drag_dest; $view->unset_rows_drag_source; ok (1, 'unset drag dest/source'); $context->finish (0, 0, $time); }); # TODO/FIXME: synthesize the drag $win->add ($view); $win->show_all; Gtk2->main; __END__ Copyright (C) 2003 by the gtk2-perl team (see the file AUTHORS for the full list). See LICENSE for more information. Gtk2-1.24992/t/GtkOptionMenu.t0000644000175000017500000000114613076462677014340 0ustar lacklack#!/usr/bin/perl -w use strict; use Gtk2::TestHelper tests => 3; # $Id$ my $option_menu = Gtk2::OptionMenu -> new(); isa_ok($option_menu, "Gtk2::OptionMenu"); my $menu = Gtk2::Menu -> new(); $menu -> append(Gtk2::MenuItem -> new_with_label("Bla")); $menu -> append(Gtk2::MenuItem -> new_with_label("Blub")); $option_menu -> set_menu($menu); is($option_menu -> get_menu(), $menu); $option_menu -> set_history(1); is($option_menu -> get_history(), 1); $option_menu -> remove_menu(); __END__ Copyright (C) 2003 by the gtk2-perl team (see the file AUTHORS for the full list). See LICENSE for more information. Gtk2-1.24992/t/GtkSeparatorToolItem.t0000644000175000017500000000065213076462677015661 0ustar lacklack# # $Id$ # use Gtk2::TestHelper at_least_version => [2, 4, 0, "Action-based menus are new in 2.4"], tests => 3; my $item = Gtk2::SeparatorToolItem->new; isa_ok ($item, 'Gtk2::SeparatorToolItem'); $item->set_draw (TRUE); ok ($item->get_draw); $item->set_draw (FALSE); ok (!$item->get_draw); __END__ Copyright (C) 2003 by the gtk2-perl team (see the file AUTHORS for the full list). See LICENSE for more information. Gtk2-1.24992/t/GdkScreen.t0000644000175000017500000000542513076462676013445 0ustar lacklack#!/usr/bin/perl -w # vim: set ft=perl : use strict; use Gtk2::TestHelper tests => 27, at_least_version => [2, 2, 0, "GdkScreen is new in 2.2"]; # $Id$ my $screen = Gtk2::Gdk::Screen -> get_default(); isa_ok($screen, "Gtk2::Gdk::Screen"); my $colormap = $screen -> get_default_colormap(); isa_ok($colormap, "Gtk2::Gdk::Colormap"); $screen -> set_default_colormap($colormap); isa_ok($screen -> get_system_colormap(), "Gtk2::Gdk::Colormap"); isa_ok($screen -> get_system_visual(), "Gtk2::Gdk::Visual"); isa_ok($screen -> get_rgb_colormap(), "Gtk2::Gdk::Colormap"); isa_ok($screen -> get_rgb_visual(), "Gtk2::Gdk::Visual"); isa_ok($screen -> get_root_window(), "Gtk2::Gdk::Window"); isa_ok($screen -> get_display(), "Gtk2::Gdk::Display"); like($screen -> get_number(), qr/^\d+$/); like($screen -> get_width(), qr/^\d+$/); like($screen -> get_height(), qr/^\d+$/); like($screen -> get_width_mm(), qr/^\d+$/); like($screen -> get_height_mm(), qr/^\d+$/); like($screen -> get_n_monitors(), qr/^\d+$/); like($screen -> get_monitor_at_point(10, 10), qr/^\d+$/); like($screen -> get_monitor_at_window($screen -> get_root_window()), qr/^\d+$/); isa_ok(($screen -> list_visuals())[0], "Gtk2::Gdk::Visual"); $screen -> get_toplevel_windows(); # check retval? ok(defined($screen -> make_display_name())); isa_ok($screen -> get_monitor_geometry(0), "Gtk2::Gdk::Rectangle"); # i'm not sure if it's good to do that. $screen -> broadcast_client_message(Gtk2::Gdk::Event -> new("expose")); # FIXME: warn $screen -> get_setting("double_click_interval"); SKIP: { skip("new 2.8 stuff", 2) unless Gtk2->CHECK_VERSION (2, 8, 0); my $visual = $screen -> get_rgba_visual(); skip "visual stuff", 2 unless defined $visual; isa_ok($visual, "Gtk2::Gdk::Visual"); isa_ok($screen -> get_rgba_colormap(), "Gtk2::Gdk::Colormap"); } SKIP: { skip "new 2.10 stuff", 2 unless Gtk2->CHECK_VERSION (2, 10, 0); my $dpi = $screen->get_resolution; ok ($dpi); $screen->set_resolution ($dpi); my @stack = $screen->get_window_stack; if (@stack > 0) { isa_ok ($stack[0], "Gtk2::Gdk::Window"); } else { ok (1); } } SKIP: { skip 'new 2.14 stuff', 3 unless Gtk2->CHECK_VERSION(2, 14, 0); my $screen = Gtk2::Gdk::Screen->get_default (); skip 'no monitors found', 3 unless $screen->get_n_monitors (); my $id = 0; ok (defined $screen->get_monitor_height_mm ($id)); ok (defined $screen->get_monitor_width_mm ($id)); my $plug_name = $screen->get_monitor_plug_name ($id); ok (TRUE); } SKIP: { skip 'new 2.20 stuff', 1 unless Gtk2->CHECK_VERSION(2, 20, 0); my $screen = Gtk2::Gdk::Screen->get_default (); ok (defined $screen->get_primary_monitor ()); } __END__ Copyright (C) 2003-2005 by the gtk2-perl team (see the file AUTHORS for the full list). See LICENSE for more information. Gtk2-1.24992/t/GdkX11.t0000644000175000017500000000553413076462676012600 0ustar lacklack#!/usr/bin/perl -w use strict; use Gtk2::TestHelper tests => 14; # $Id$ my $window = Gtk2::Window -> new(); $window -> realize(); SKIP: { skip("X11 stuff", 12) unless $window -> window() -> can("get_xid"); like($window -> window() -> get_xid(), qr/^\d+$/); like($window -> window() -> XID(), qr/^\d+$/); like($window -> window() -> XWINDOW(), qr/^\d+$/); like(Gtk2::Gdk::X11 -> get_server_time($window -> window()), qr/^\d+$/); SKIP: { skip("2.2 stuff", 5) unless Gtk2->CHECK_VERSION(2, 2, 0); my $display = Gtk2::Gdk::Display -> get_default(); # Should we really do this? $display -> grab(); $display -> ungrab(); my $screen = Gtk2::Gdk::Screen -> get_default(); like($screen -> get_screen_number(), qr/^\d+$/); ok(defined $screen -> get_window_manager_name()); ok(not $screen -> supports_net_wm_hint(Gtk2::Gdk::Atom -> new("just-testing"))); # The values for the STRING atom (and others) are defined as part of the # the X11 protocol ok(Gtk2::Gdk::Atom->intern("STRING")->to_xatom_for_display($display) == 31, "to_xatom_for_display"); SKIP: { skip("not-multihead-safe stuff", 1) unless UNIVERSAL::can("Gtk2::Gdk::X11", "net_wm_supports"); ok(Gtk2::Gdk::Atom->intern("STRING")->to_xatom() == 31,"to_xatom"); } } SKIP: { skip("2.4 stuff", 0) unless Gtk2 -> CHECK_VERSION(2, 4, 0); my $display = Gtk2::Gdk::Display -> get_default(); $display -> register_standard_event_type(1, 2); } SKIP: { skip("2.6 stuff", 0) unless Gtk2->CHECK_VERSION(2, 6, 0); $window -> window() -> set_user_time(time()); } SKIP: { skip("2.8 stuff", 1) unless Gtk2->CHECK_VERSION(2, 8, 0); $window -> window() -> move_to_current_desktop(); my $display = Gtk2::Gdk::Display -> get_default(); $display -> set_cursor_theme("just-testing", 23); like($display -> get_user_time(), qr/^\d+$/); } SKIP: { skip '2.12 stuff', 1 unless Gtk2->CHECK_VERSION(2, 12, 0); my $display = Gtk2::Gdk::Display -> get_default(); my $startup_id = $display -> get_startup_notification_id(); ok(TRUE); # $startup_id might be undef, so we can't really test } SKIP: { skip '2.14 stuff', 1 unless Gtk2->CHECK_VERSION(2, 14, 0); my $screen = Gtk2::Gdk::Screen -> get_default(); ok(defined $screen -> get_monitor_output(0)); } } SKIP: { skip("not-multihead-safe stuff", 2) unless UNIVERSAL::can("Gtk2::Gdk::X11", "net_wm_supports"); like(Gtk2::Gdk::X11 -> get_default_screen(), qr/^\d+$/); ok(not Gtk2::Gdk::X11 -> net_wm_supports(Gtk2::Gdk::Atom -> new("just-testing"))); # Should we really do this? Gtk2::Gdk::X11 -> grab_server(); Gtk2::Gdk::X11 -> ungrab_server(); } __END__ Copyright (C) 2003-2005 by the gtk2-perl team (see the file AUTHORS for the full list). See LICENSE for more information. Gtk2-1.24992/t/GdkPixbufSimpleAnim.t0000644000175000017500000000220313076462676015431 0ustar lacklack#!/usr/bin/perl -w use strict; use Gtk2::TestHelper tests => 131, noinit => 1, at_least_version => [2, 8, 0, 'GdkPixbufSimpleAnim is new in 2.8']; my $simple_anim = Gtk2::Gdk::PixbufSimpleAnim->new (64, 64, 24.0); isa_ok ($simple_anim, 'Gtk2::Gdk::PixbufSimpleAnim'); isa_ok ($simple_anim, 'Gtk2::Gdk::PixbufAnimation'); foreach my $alpha (0..127) { my $pixels = pack 'C*', (0xe2, 0xc6, 0xe1, 2*$alpha) x (64*64); my $pixbuf = Gtk2::Gdk::Pixbuf->new_from_data ($pixels, 'rgb', TRUE, 8, 64, 64, 64*4); $simple_anim->add_frame ($pixbuf); ok (1, 'added frame'); } SKIP: { skip 'new 2.18 stuff', 1 unless Gtk2->CHECK_VERSION(2, 18, 0); $simple_anim->set_loop (TRUE); ok ($simple_anim->get_loop); } my $interactive = $ENV{INTERACTIVE} || (@ARGV > 0); if ($interactive && Gtk2->init_check) { my $window = Gtk2::Window->new; my $image = Gtk2::Image->new_from_animation ($simple_anim); $window->add ($image); $window->show_all; $window->signal_connect (destroy => sub {Gtk2->main_quit}); Gtk2->main; } # vim: set syntax=perl et sw=4 sts=4 : Gtk2-1.24992/t/GtkHSeparator.t0000644000175000017500000000052013076462677014306 0ustar lacklack#!/usr/bin/perl -w use strict; use Gtk2::TestHelper tests => 2, noinit => 1; # $Id$ my $separator = Gtk2::HSeparator -> new(); isa_ok($separator, "Gtk2::Separator"); isa_ok($separator, "Gtk2::HSeparator"); __END__ Copyright (C) 2003 by the gtk2-perl team (see the file AUTHORS for the full list). See LICENSE for more information. Gtk2-1.24992/t/GtkObject.t0000644000175000017500000000054213076462677013450 0ustar lacklack#!/usr/bin/perl -w use strict; use Gtk2::TestHelper tests => 2, noinit => 1; # $Id$ my $label = Gtk2::Object -> new("Gtk2::Label", "Bla"); isa_ok($label, "Gtk2::Object"); isa_ok($label, "Gtk2::Label"); $label -> destroy(); __END__ Copyright (C) 2003 by the gtk2-perl team (see the file AUTHORS for the full list). See LICENSE for more information. Gtk2-1.24992/t/Gdk.t0000644000175000017500000000656413076462676012312 0ustar lacklack#!/usr/bin/perl -w # vim: set ft=perl : use strict; use Test::More; use Gtk2; # $Id$ use Config; my $have_threads = $Config{usethreads}; Gtk2::Gdk::Threads -> init() if $have_threads; @ARGV = qw(--help --name bla --urgs tree); if (Gtk2::Gdk->init_check ) { plan tests => 17; } else { plan skip_all => 'Gtk2->init_check failed, probably unable to ' . 'open DISPLAY'; } Gtk2::Gdk::Threads -> enter(); Gtk2::Gdk::Threads -> leave(); is(Gtk2::Gdk -> init_check(), 1); is(Gtk2::Gdk -> init(), 1); is_deeply(\@ARGV, [qw(--help --urgs tree)]); # Also call Gtk2's init to avoid hangs. Gtk2 -> init(); SKIP: { skip("parse_args, get_display_arg_name and notify_startup_complete are new in 2.2", 1) unless Gtk2 -> CHECK_VERSION(2, 2, 0); @ARGV = qw(--help --name bla --urgs tree); # FIXME: this immediately returns if gdk is already initialized. so does # gdk_init. how to test both of them in one test? Gtk2::Gdk -> parse_args(); is_deeply(\@ARGV, [qw(--help --name bla --urgs tree)]); Gtk2::Gdk -> get_display_arg_name(); # FIXME: check retval? Gtk2::Gdk -> notify_startup_complete(); } SKIP: { skip 'new 2.12 stuff', 0 unless Gtk2 -> CHECK_VERSION(2, 12, 0); Gtk2::Gdk -> notify_startup_complete_with_id('bla'); } ok(Gtk2::Gdk -> set_locale()); Gtk2::Gdk -> set_sm_client_id("blub"); Gtk2::Gdk -> set_sm_client_id(undef); Gtk2::Gdk -> set_program_class("gtk2perl"); is(Gtk2::Gdk -> get_program_class(), "gtk2perl"); ok(Gtk2::Gdk -> get_display()); Gtk2::Gdk -> flush(); my $number = qr/^\d+$/; like(Gtk2::Gdk -> screen_width(), $number); like(Gtk2::Gdk -> screen_height(), $number); like(Gtk2::Gdk -> screen_width_mm(), $number); like(Gtk2::Gdk -> screen_height_mm(), $number); my $window = Gtk2::Window -> new(); $window -> show_all(); $window -> show_now(); my $result = Gtk2::Gdk -> pointer_grab($window -> window(), 1, qw(button-press-mask), undef, Gtk2::Gdk::Cursor -> new("arrow"), 0); like($result, qr/^(?:success|already-grabbed|not-viewable)$/); like(Gtk2::Gdk -> pointer_is_grabbed(), qr/^(?:1|)$/); Gtk2::Gdk -> pointer_ungrab(0); # Gtk2::Gdk -> set_double_click_time(20); $result = Gtk2::Gdk -> keyboard_grab($window -> window(), 1, 0); like($result, qr/^(?:success|already-grabbed|not-viewable)$/); Gtk2::Gdk -> keyboard_ungrab(0); Gtk2::Gdk -> error_trap_push(); is(Gtk2::Gdk -> error_trap_pop(), 0); my $event = Gtk2::Gdk::Event -> new("client-event"); $event -> window($window -> window()); $event -> message_type(Gtk2::Gdk::Atom -> new("string")); $event -> data_format(Gtk2::Gdk::CHARS); $event -> data("01234567890123456789"); SKIP: { skip("X11 stuff", 2) unless $window -> window() -> can("get_xid"); is(Gtk2::Gdk::Event -> send_client_message( $event, $window -> window() -> get_xid()), 1); Gtk2::Gdk::Event -> send_clientmessage_toall($event); skip("GdkDisplay is new in 2.2", 1) unless Gtk2 -> CHECK_VERSION(2, 2, 0); is(Gtk2::Gdk::Event -> send_client_message_for_display( Gtk2::Gdk::Display -> get_default(), $event, $window -> window() -> get_xid()), 1); } # Gtk2::Gdk -> beep(); __END__ Copyright (C) 2003-2006 by the gtk2-perl team (see the file AUTHORS for the full list). See LICENSE for more information. Gtk2-1.24992/t/GtkVolumeButton.t0000644000175000017500000000055213076462677014706 0ustar lacklack#!/usr/bin/perl use strict; use warnings; use Gtk2::TestHelper tests => 1, at_least_version => [2, 12, 0, 'GtkVolumeButton appeared in 2.12']; # $Id$ my $button = Gtk2::VolumeButton->new; isa_ok ($button, 'Gtk2::VolumeButton'); __END__ Copyright (C) 2007 by the gtk2-perl team (see the file AUTHORS for the full list). See LICENSE for more information. Gtk2-1.24992/t/GtkColorSelection.t0000644000175000017500000000216213076462676015165 0ustar lacklack#!/usr/bin/perl -w use strict; use Gtk2::TestHelper tests => 12; # $Id$ my $selection = Gtk2::ColorSelection -> new(); isa_ok($selection, "Gtk2::ColorSelection"); $selection -> set_has_opacity_control(1); is($selection -> get_has_opacity_control(), 1); $selection -> set_has_palette(1); is($selection -> get_has_palette(), 1); $selection -> set_current_alpha(65535); is($selection -> get_current_alpha(), 65535); my $color = Gtk2::Gdk::Color -> new(255, 255, 255); $selection -> set_current_color($color); isa_ok($selection -> get_current_color(), "Gtk2::Gdk::Color"); $selection -> set_previous_alpha(0); is($selection -> get_previous_alpha(), 0); $selection -> set_previous_color($color); isa_ok($selection -> get_previous_color(), "Gtk2::Gdk::Color"); ok(! $selection -> is_adjusting()); my @palette = $selection -> palette_from_string("DarkSlateGray:LightBlue:Black"); isa_ok($_, "Gtk2::Gdk::Color") foreach (@palette); is($selection -> palette_to_string(@palette), "#2F4F4F:#ADD8E6:#000000"); __END__ Copyright (C) 2003 by the gtk2-perl team (see the file AUTHORS for the full list). See LICENSE for more information. Gtk2-1.24992/t/PangoLayout.t0000644000175000017500000001266213076462677014044 0ustar lacklack#!/usr/bin/perl -w use strict; use Gtk2::TestHelper tests => 71; # $Id$ my $label = Gtk2::Label -> new("Bla"); my $context = $label -> create_pango_context(); my $layout = Gtk2::Pango::Layout -> new($context); isa_ok($layout, "Gtk2::Pango::Layout"); is($layout -> get_context(), $context); $layout -> context_changed(); $layout -> set_text("Bla bla."); is($layout -> get_text(), "Bla bla."); $layout -> set_markup("Bla bla."); is($layout -> set_markup_with_accel("Bla _bla.", "_"), "b"); my $font = Gtk2::Pango::FontDescription -> new(); $layout -> set_font_description($font); SKIP: { skip("set_font_description was slightly borken", 0) unless (Gtk2::Pango -> CHECK_VERSION(1, 4, 0)); $layout -> set_font_description(undef); } SKIP: { skip("new 1.8 stuff", 2) unless (Gtk2::Pango -> CHECK_VERSION(1, 8, 0)); is($layout -> get_font_description(), undef); $layout -> set_font_description($font); isa_ok($layout -> get_font_description(), "Gtk2::Pango::FontDescription"); } $layout -> set_width(23); is($layout -> get_width(), 23); $layout -> set_wrap("word"); is($layout -> get_wrap(), "word"); $layout -> set_indent(5); is($layout -> get_indent(), 5); $layout -> set_spacing(5); is($layout -> get_spacing(), 5); $layout -> set_justify(1); is($layout -> get_justify(), 1); my $attributes = $layout -> get_attributes(); isa_ok($attributes, "Gtk2::Pango::AttrList"); $layout -> set_attributes($attributes); SKIP: { skip("[sg]et_auto_dir are new in 1.3.5", 1) unless (Gtk2::Pango -> CHECK_VERSION(1, 4, 0)); $layout -> set_auto_dir(1); is($layout -> get_auto_dir(), 1); } $layout -> set_alignment("left"); is($layout -> get_alignment(), "left"); $layout -> set_tabs(Gtk2::Pango::TabArray -> new(8, 0)); isa_ok($layout -> get_tabs(), "Gtk2::Pango::TabArray"); $layout -> set_single_paragraph_mode(1); is($layout -> get_single_paragraph_mode(), 1); my $attribute = ($layout -> get_log_attrs())[0]; isa_ok($attribute, "HASH"); is_deeply($attribute, { is_line_break => 0, is_mandatory_break => 0, is_char_break => 1, is_white => 0, is_cursor_position => 1, is_word_start => 1, is_word_end => 0, is_sentence_boundary => (Gtk2::Pango -> CHECK_VERSION(1, 22, 0) ? 1 : 0), is_sentence_start => 1, is_sentence_end => 0, Gtk2::Pango -> CHECK_VERSION(1, 4, 0) ? (backspace_deletes_character => 1) : (), Gtk2::Pango -> CHECK_VERSION(1, 18, 0) ? (is_expandable_space => 0) : () }); foreach ($layout -> index_to_pos(23), $layout -> get_cursor_pos(1), $layout -> get_extents(), $layout -> get_pixel_extents()) { isa_ok($_, "HASH"); } my $number = qr/^\d+$/; my ($index, $trailing) = $layout -> xy_to_index(5, 5); like($index, $number); like($trailing, $number); is_deeply([$layout -> move_cursor_visually(1, 0, 0, 1)], [1, 0]); my ($width, $height) = $layout -> get_size(); like($width, $number); like($height, $number); ($width, $height) = $layout -> get_pixel_size(); like($width, $number); like($height, $number); like($layout -> get_line_count(), $number); { my @lines = $layout -> get_lines(); isa_ok($lines[0], "Gtk2::Pango::LayoutLine"); is(scalar @lines, $layout -> get_line_count()); my $line = $layout -> get_line(0); isa_ok($line, "Gtk2::Pango::LayoutLine"); my ($outside, $index, $trailing) = $line -> x_to_index(23); ok(defined $outside && defined $index && defined $trailing); ok(defined $line -> index_to_x(0, TRUE)); my @ranges = $line -> get_x_ranges(0, 8000); isa_ok($ranges[0], "ARRAY"); is(scalar @{$ranges[0]}, 2); my ($ink, $logical); ($ink, $logical) = $line -> get_extents(); isa_ok($ink, "HASH"); isa_ok($logical, "HASH"); ($ink, $logical) = $line -> get_pixel_extents(); isa_ok($ink, "HASH"); isa_ok($logical, "HASH"); } { my $iter = $layout -> get_iter(); isa_ok($iter, "Gtk2::Pango::LayoutIter"); foreach ($iter -> get_char_extents(), $iter -> get_cluster_extents(), $iter -> get_run_extents(), $iter -> get_line_extents(), $iter -> get_layout_extents()) { isa_ok($_, "HASH"); } my ($y0, $y1) = $iter -> get_line_yrange(); like($y0, $number); like($y1, $number); ok($iter -> next_run()); ok($iter -> next_char()); ok($iter -> next_cluster()); ok(!$iter -> next_line()); ok($iter -> at_last_line()); like($iter -> get_index(), $number); like($iter -> get_baseline(), $number); isa_ok($iter -> get_line(), "Gtk2::Pango::LayoutLine"); } SKIP: { skip("[sg]et_ellipsize are new in 1.6", 1) unless (Gtk2::Pango -> CHECK_VERSION(1, 6, 0)); $layout -> set_ellipsize("end"); is($layout -> get_ellipsize(), "end"); } SKIP: { skip "1.16 stuff", 3 unless Gtk2::Pango -> CHECK_VERSION(1, 16, 0); isa_ok($layout -> get_line_readonly(0), "Gtk2::Pango::LayoutLine"); my @lines = $layout -> get_lines_readonly(); is(scalar @lines, $layout -> get_line_count()); my $iter = $layout -> get_iter(); isa_ok($iter -> get_line_readonly(), "Gtk2::Pango::LayoutLine"); } SKIP: { skip 'new 1.20 stuff', 2 unless (Gtk2::Pango -> CHECK_VERSION(1, 20, 0)); my $iter = $layout -> get_iter(); is($iter -> get_layout(), $layout); isa_ok($iter -> copy(), 'Gtk2::Pango::LayoutIter'); } SKIP: { skip 'new 1.20 stuff', 1 unless (Gtk2::Pango -> CHECK_VERSION(1, 20, 0)); $layout -> set_height(23); is($layout -> get_height(), 23); } __END__ Copyright (C) 2003-2005 by the gtk2-perl team (see the file AUTHORS for the full list). See LICENSE for more information. Gtk2-1.24992/t/GdkDisplayManager.t0000644000175000017500000000116013076462676015116 0ustar lacklack#!/usr/bin/perl -w use strict; use Gtk2::TestHelper tests => 4, at_least_version => [2, 2, 0, "GdkDisplayManager is new in 2.2"]; # $Id$ my $manager = Gtk2::Gdk::DisplayManager -> get(); isa_ok($manager, "Gtk2::Gdk::DisplayManager"); my $display = Gtk2::Gdk::Display -> get_default(); $manager -> set_default_display($display); is($manager -> get_default_display(), $display); is(($manager -> list_displays())[0], $display); isa_ok($display -> get_core_pointer(), "Gtk2::Gdk::Device"); __END__ Copyright (C) 2003 by the gtk2-perl team (see the file AUTHORS for the full list). See LICENSE for more information. Gtk2-1.24992/t/GtkPrintContext.t0000644000175000017500000000301213076462677014676 0ustar lacklack#!/usr/bin/perl -w use strict; use Gtk2::TestHelper tests => 11, at_least_version => [2, 10, 0, "GtkPrintContext is new in 2.10"]; # $Id$ use File::Temp qw(tempdir); my $dir = tempdir(CLEANUP => 1); # I hope that signal will always fire ... my $op = Gtk2::PrintOperation -> new(); $op -> signal_connect(begin_print => sub { my ($op, $context) = @_; isa_ok($context, "Gtk2::PrintContext"); isa_ok(my $cr = $context -> get_cairo_context(), "Cairo::Context"); isa_ok($context -> get_page_setup(), "Gtk2::PageSetup"); ok(defined $context -> get_width()); ok(defined $context -> get_height()); ok(defined $context -> get_dpi_x()); ok(defined $context -> get_dpi_y()); isa_ok($context -> get_pango_fontmap(), "Gtk2::Pango::FontMap"); isa_ok($context -> create_pango_context(), "Gtk2::Pango::Context"); isa_ok($context -> create_pango_layout(), "Gtk2::Pango::Layout"); $context -> set_cairo_context($cr, 72, 72); SKIP: { skip 'new 2.20 stuff', 1 unless Gtk2->CHECK_VERSION(2, 20, 0); my ($top, $bottom, $left, $right) = $context -> get_hard_margins(); ok((defined $top && defined $bottom && defined $left && defined $right) || (!defined $top && !defined $bottom && !defined $left && !defined $right)); } }); $op -> set_n_pages(1); $op -> set_allow_async(TRUE); $op -> set_export_filename("$dir/test.pdf"); $op -> run("export", undef); $op -> cancel(); __END__ Copyright (C) 2006, 2013 by the gtk2-perl team (see the file AUTHORS for the full list). See LICENSE for more information. Gtk2-1.24992/t/GtkCellView.t0000644000175000017500000000465313076462676013762 0ustar lacklack#!/usr/bin/perl # # $Id$ # ######################### # GtkCellView Tests # - rm ######################### ######################### use strict; use warnings; use Gtk2::TestHelper tests => 12, at_least_version => [2, 6, 0, "GtkCellView is new in 2.6"], ; use constant PIXBUF => 0; use constant STRING => 1; use constant BOOLEAN => 2; my $win = Gtk2::Window->new; isa_ok (my $cview = Gtk2::CellView->new, 'Gtk2::CellView', 'Gtk2::CellView->new'); ginterfaces_ok($cview); isa_ok ($cview = Gtk2::CellView->new_with_text ('text'), 'Gtk2::CellView', 'Gtk2::CellView->new_with_text'); isa_ok ($cview = Gtk2::CellView->new_with_markup ('markup'), 'Gtk2::CellView', 'Gtk2::CellView->new_with_markup'); isa_ok ($cview = Gtk2::CellView->new_with_pixbuf ($win->render_icon ('gtk-ok', 'dialog')), 'Gtk2::CellView', 'Gtk2::CellView->new_with_pixbuf'); my $model = create_store (); fill_store ($model, get_pixbufs ($win)); ok (eval { $cview->set_model (undef); $cview->set_model ($model); 1; }, '$cview->set_model'); SKIP: { skip 'new 2.16 stuff', 2 unless Gtk2->CHECK_VERSION(2, 16, 0); $cview->set_model (undef); is($cview->get_model(), undef, '$cview->get_model with undef'); $cview->set_model ($model); is($cview->get_model(), $model, '$cview->get_model'); } my $treepath = Gtk2::TreePath->new_from_string ('0'); $cview->set_displayed_row ($treepath); is ($cview->get_displayed_row->to_string, $treepath->to_string, '$cview->set|get_displaed_row'); isa_ok ($cview->get_size_of_row ($treepath), 'Gtk2::Requisition'); ok (eval { $cview->set_background_color (Gtk2::Gdk::Color->new (0, 0, 0)); 1; }, '$cview->set_background_color'); isa_ok ($cview->get_cell_renderers, 'Gtk2::CellRendererPixbuf', '$cview->get_cell_renderers'); my $renderer = ($cview->get_cell_renderers)[0]; sub create_store { my $store = Gtk2::ListStore->new (qw/Gtk2::Gdk::Pixbuf Glib::String Glib::Boolean/); return $store; } sub get_pixbufs { my $win = shift; my @pbs; foreach (qw/gtk-stock-dialog-warning gtk-stock-stop gtk-stock-new/) { push @pbs, $win->render_icon ($_, 'dialog'); } return \@pbs; } sub fill_store { my $store = shift; my $pbs = shift; foreach (qw/one two three four five six seven eight nine uno dos tres quatro cinco/) { my $iter = $store->append; $store->set ($iter, STRING, "$_", PIXBUF, $pbs->[rand (@$pbs)], BOOLEAN, rand (2), ); } } Gtk2-1.24992/t/GtkStatusIcon.t0000644000175000017500000001242013076462677014334 0ustar lacklack#!/usr/bin/perl # vim: set ft=perl : use strict; use warnings; use Gtk2::TestHelper tests => 37, at_least_version => [2, 10, 0, "Gtk2::StatusIcon is new in 2.10"]; # $Id$ my $icon; $icon = Gtk2::StatusIcon -> new(); isa_ok($icon, "Gtk2::StatusIcon"); is($icon -> get_storage_type(), "empty"); like($icon -> get_size(), qr/^\d+$/); $icon -> set_tooltip("bla"); $icon -> set_visible(TRUE); is($icon -> get_visible(), TRUE); $icon -> set_blinking(TRUE); is($icon -> get_blinking(), TRUE); ok(defined $icon -> is_embedded()); # --------------------------------------------------------------------------- # my $pixbuf = Gtk2::Gdk::Pixbuf -> new("rgb", FALSE, 8, 10, 10); $icon = Gtk2::StatusIcon -> new_from_pixbuf($pixbuf); isa_ok($icon, "Gtk2::StatusIcon"); is($icon -> get_storage_type(), "pixbuf"); $icon -> set_from_pixbuf($pixbuf); is($icon -> get_pixbuf(), $pixbuf); # --------------------------------------------------------------------------- # $icon = Gtk2::StatusIcon -> new_from_stock("gtk-ok"); isa_ok($icon, "Gtk2::StatusIcon"); is($icon -> get_storage_type(), "stock"); $icon -> set_from_stock("gtk-ok"); is($icon -> get_stock(), "gtk-ok"); # --------------------------------------------------------------------------- # $icon = Gtk2::StatusIcon -> new_from_icon_name("gtk-ok"); isa_ok($icon, "Gtk2::StatusIcon"); is($icon -> get_storage_type(), "icon-name"); $icon -> set_from_icon_name("gtk-ok"); is($icon -> get_icon_name(), "gtk-ok"); # --------------------------------------------------------------------------- # my $icon_theme = Gtk2::IconTheme -> get_default(); my $icon_info = $icon_theme -> lookup_icon('stock_edit', 24, 'use-builtin'); SKIP: { skip "new_from_file; theme icon not found", 2 unless defined $icon_info; my $icon_file = $icon_info -> get_filename(); $icon = Gtk2::StatusIcon -> new_from_file($icon_file); isa_ok($icon, "Gtk2::StatusIcon"); is($icon -> get_storage_type(), "pixbuf"); $icon -> set_from_file($icon_file); } # --------------------------------------------------------------------------- # my $menu = Gtk2::Menu -> new(); $menu -> popup(undef, undef, \&Gtk2::StatusIcon::position_menu, $icon, 0, 0); $menu -> popdown(); my $callback = sub { my ($menu, $x, $y, $icon) = @_; return Gtk2::StatusIcon::position_menu($menu, $x, $y, $icon); }; $menu -> popup(undef, undef, $callback, $icon, 0, 0); $menu -> popdown(); # Make sure the convenient way of calling works, too. { my @ret = Gtk2::StatusIcon::position_menu($menu, $icon); is (scalar @ret, 3); my ($x, $y, $pushed_in) = @ret; like($x, qr/^-?\d+$/); like($y, qr/^-?\d+$/); like($pushed_in, qr/^[01]$/); # boolean } # --------------------------------------------------------------------------- # my ($screen, $area, $orientation) = $icon -> get_geometry(); SKIP: { skip "geometry tests", 7 unless defined $screen; isa_ok ($screen, "Gtk2::Gdk::Screen"); isa_ok ($area, "Gtk2::Gdk::Rectangle"); ok (defined $orientation); # Make sure the returned rectangle is valid. It's a copy of a stack # object, so we just need to ensure that the values are in some sane # range, rather than garbage. cmp_ok (abs $area->x, '<=', Gtk2::Gdk->screen_width ()); cmp_ok (abs $area->y, '<=', Gtk2::Gdk->screen_height ()); cmp_ok (abs $area->width, '<=', Gtk2::Gdk->screen_width ()); cmp_ok (abs $area->height, '<=', Gtk2::Gdk->screen_height ()); } # --------------------------------------------------------------------------- # SKIP: { skip "new 2.12 stuff", 1 unless Gtk2 -> CHECK_VERSION(2, 12, 0); my $screen = $icon -> get_screen(); isa_ok($screen, "Gtk2::Gdk::Screen"); $icon -> set_screen($screen); } # --------------------------------------------------------------------------- # SKIP: { skip 'new 2.14 stuff', 1 unless Gtk2->CHECK_VERSION(2, 14, 0); ok (defined $icon -> get_x11_window_id()); } # --------------------------------------------------------------------------- # SKIP: { skip 'new 2.16 stuff', 6 unless Gtk2->CHECK_VERSION(2, 16, 0); # Non-X11 platforms require a tooltip text for the below to work. $icon->set_tooltip_text("TEST"); $icon->set_has_tooltip(TRUE); is ($icon->get_has_tooltip(), TRUE); $icon->set_has_tooltip(FALSE); is ($icon->get_has_tooltip(), FALSE); # Non-X11 platforms don't actually support any markup tags. $icon->set_tooltip_markup("TEST1"); is ($icon->get_tooltip_markup(), "TEST1"); $icon->set_tooltip_markup(undef); is ($icon->get_tooltip_markup(), undef); $icon->set_tooltip_text("TEST2"); is ($icon->get_tooltip_text(), "TEST2"); $icon->set_tooltip_text(undef); is ($icon->get_tooltip_text(), undef); } # --------------------------------------------------------------------------- # SKIP: { skip 'new 2.18 stuff', 1 unless Gtk2->CHECK_VERSION(2, 18, 0); $icon->set_title('my statusicon title'); is ($icon->get_title, 'my statusicon title', '[gs]et_title'); } # --------------------------------------------------------------------------- # SKIP: { skip 'new 2.20 stuff', 0 unless Gtk2->CHECK_VERSION(2, 24, 7); # Not usable prior to 2.24.7, see # . my $icon = Gtk2::StatusIcon->new; $icon->set_name('bla'); } __END__ Copyright (C) 2006 by the gtk2-perl team (see the file AUTHORS for the full list). See LICENSE for more information. Gtk2-1.24992/t/GdkGC.t0000644000175000017500000000565313076462676012522 0ustar lacklack#!/usr/bin/perl -w use strict; use Gtk2::TestHelper tests => 35; # $Id$ my $black = Gtk2::Gdk::Color -> new(0, 0, 0); my $values = { foreground => $black, background => $black, function => "copy", fill => "tiled", subwindow_mode => "clip-by-children", ts_x_origin => 0, ts_y_origin => 0, clip_x_origin => 0, clip_y_origin => 0, graphics_exposures => 1, line_width => 5, line_style => "solid", cap_style => "butt", join_style => "round" }; my $window = Gtk2::Window -> new(); $window -> realize(); my $gc = Gtk2::Gdk::GC -> new($window -> window()); isa_ok($gc, "Gtk2::Gdk::GC"); $gc -> copy($gc); $gc -> set_values($values); check_values(); $gc = Gtk2::Gdk::GC -> new($window -> window(), $values); isa_ok($gc, "Gtk2::Gdk::GC"); $gc = Gtk2::Gdk::GC -> new_with_values($window -> window(), $values); isa_ok($gc, "Gtk2::Gdk::GC"); SKIP: { skip "GdkScreen is new in 2.2", 1 unless Gtk2->CHECK_VERSION (2,2,0); isa_ok($gc -> get_screen(), "Gtk2::Gdk::Screen"); } my $pixmap = Gtk2::Gdk::Pixmap -> new($window -> window(), 10, 10, 8); my $rectangle = Gtk2::Gdk::Rectangle -> new(23, 42, 10, 10); my $region = Gtk2::Gdk::Region -> rectangle($rectangle); my $colormap = Gtk2::Gdk::Colormap -> get_system(); my $bitmap = Gtk2::Gdk::Bitmap -> create_from_data($window -> window(), "", 1, 1); $gc -> set_foreground($black); $gc -> set_background($black); $gc -> set_rgb_fg_color($black); $gc -> set_rgb_bg_color($black); $gc -> set_function("copy"); $gc -> set_fill("tiled"); $gc -> set_tile($pixmap); $gc -> set_stipple($pixmap); $gc -> set_ts_origin(0, 0); $gc -> set_clip_origin(0, 0); $gc -> set_clip_mask(undef); $gc -> set_clip_mask($bitmap); $gc -> set_clip_rectangle(undef); $gc -> set_clip_rectangle($rectangle); $gc -> set_clip_region(undef); $gc -> set_clip_region($region); $gc -> set_subwindow("clip-by-children"); $gc -> set_exposures(1); $gc -> set_line_attributes(5, "solid", "butt", "round"); $gc -> set_dashes(0, [1, 2, 3, 4, 5, 6, 7, 8, 9]); $gc -> offset(0, 0); $gc -> set_colormap($colormap); is($gc -> get_colormap(), $colormap); check_values(); sub check_values { my $new_values = $gc -> get_values(); isa_ok($new_values, "HASH"); isa_ok($new_values -> { foreground }, "Gtk2::Gdk::Color"); isa_ok($new_values -> { background }, "Gtk2::Gdk::Color"); is($new_values -> { function }, "copy"); is($new_values -> { fill }, "tiled"); is($new_values -> { subwindow_mode }, "clip-by-children"); is($new_values -> { ts_x_origin }, 0); is($new_values -> { ts_y_origin }, 0); is($new_values -> { clip_x_origin }, 0); is($new_values -> { clip_y_origin }, 0); is($new_values -> { graphics_exposures }, 1); is($new_values -> { line_width }, 5); is($new_values -> { line_style }, "solid"); is($new_values -> { cap_style }, "butt"); is($new_values -> { join_style }, "round"); } __END__ Copyright (C) 2003 by the gtk2-perl team (see the file AUTHORS for the full list). See LICENSE for more information. Gtk2-1.24992/t/GtkToolPalette.t0000644000175000017500000000436013076462677014500 0ustar lacklack#!/usr/bin/env perl use Gtk2::TestHelper tests => 10, at_least_version => [2, 20, 0, "Gtk2::ToolPalette is new in 2.20"]; my $palette = Gtk2::ToolPalette->new; isa_ok ($palette, 'Gtk2::ToolPalette'); my $group = Gtk2::ToolItemGroup->new ('Test'); $palette->add ($group); $palette->set_exclusive ($group, TRUE); ok ($palette->get_exclusive ($group)); $palette->set_expand ($group, TRUE); ok ($palette->get_expand ($group)); $palette->set_group_position ($group, 0); is ($palette->get_group_position ($group), 0); $palette->set_icon_size ('menu'); is ($palette->get_icon_size, 'menu'); $palette->unset_icon_size; $palette->set_style ('icons'); is ($palette->get_style, 'icons'); $palette->unset_style; my $scroller = Gtk2::ScrolledWindow->new; $scroller->add ($palette); isa_ok ($palette->get_hadjustment, 'Gtk2::Adjustment'); isa_ok ($palette->get_vadjustment, 'Gtk2::Adjustment'); my $button = Gtk2::Button->new ('Test'); $palette->add_drag_dest ($button, 'all', 'groups', 'copy'); isa_ok (Gtk2::ToolPalette->get_drag_target_group, 'HASH'); isa_ok (Gtk2::ToolPalette->get_drag_target_item, 'HASH'); $palette->set_drag_source ('groups'); =comment Interactive d'n'd test: { my $palette = Gtk2::ToolPalette->new; my $group = Gtk2::ToolItemGroup->new ('Test'); my $item = Gtk2::ToolItem->new; my $child = Gtk2::Label->new ('TestTest'); $item->add ($child); $group->insert ($item, 0); $palette->add ($group); my $button = Gtk2::Button->new ('Test'); $palette->add_drag_dest ($button, 'all', 'groups', 'copy'); $button->signal_connect (drag_data_received => sub { my ($button, $context, $x, $y, $selection, $info, $time, $data) = @_; my $palette = $context->get_source_widget->get_ancestor ('Gtk2::ToolPalette'); my $group = $palette->get_drag_item ($selection); isa_ok ($group, 'Gtk2::ToolItemGroup'); }); my $window = Gtk2::Window->new; my $vbox = Gtk2::VBox->new; $vbox->add ($palette); $vbox->add ($button); $window->add ($vbox); $window->set_default_size (50, 100); $window->show_all; isa_ok ($palette->get_drop_group (10, 10), 'Gtk2::ToolItemGroup'); isa_ok ($palette->get_drop_item (10, 30), 'Gtk2::ToolItem'); Gtk2->main; } =cut __END__ Copyright (C) 2010 by the gtk2-perl team (see the file AUTHORS for the full list). See LICENSE for more information. Gtk2-1.24992/t/PangoMatrix.t0000644000175000017500000000444313076462677014031 0ustar lacklack#!/usr/bin/perl -w use strict; use Gtk2::TestHelper tests => 48, noinit => 1; # $Id$ SKIP: { skip("PangoMatrix is new in 1.6", 44) unless (Gtk2::Pango -> CHECK_VERSION(1, 6, 0)); my $matrix = Gtk2::Pango::Matrix -> new(2.3, 2.3, 2.3, 2.3, 2.3, 2.3); isa_ok($matrix, "Gtk2::Pango::Matrix"); delta_ok($matrix -> xx, 2.3); delta_ok($matrix -> xy, 2.3); delta_ok($matrix -> yx, 2.3); delta_ok($matrix -> yy, 2.3); delta_ok($matrix -> x0, 2.3); delta_ok($matrix -> y0, 2.3); $matrix = Gtk2::Pango::Matrix -> new(); isa_ok($matrix, "Gtk2::Pango::Matrix"); is($matrix -> xx, 1); is($matrix -> xy, 0); is($matrix -> yx, 0); is($matrix -> yy, 1); is($matrix -> x0, 0); is($matrix -> y0, 0); $matrix -> translate(5, 5); is($matrix -> xx, 1); is($matrix -> xy, 0); is($matrix -> yx, 0); is($matrix -> yy, 1); is($matrix -> x0, 5); is($matrix -> y0, 5); $matrix -> scale(2, 2); is($matrix -> xx, 2); is($matrix -> xy, 0); is($matrix -> yx, 0); is($matrix -> yy, 2); is($matrix -> x0, 5); is($matrix -> y0, 5); $matrix -> rotate(0); is($matrix -> xx, 2); is($matrix -> xy, 0); is($matrix -> yx, 0); is($matrix -> yy, 2); is($matrix -> x0, 5); is($matrix -> y0, 5); $matrix -> concat($matrix); is($matrix -> xx, 4); is($matrix -> xy, 0); is($matrix -> yx, 0); is($matrix -> yy, 4); is($matrix -> x0, 15); is($matrix -> y0, 15); $matrix -> xx(2.3); $matrix -> xy(2.3); $matrix -> yx(2.3); $matrix -> yy(2.3); $matrix -> x0(2.3); $matrix -> y0(2.3); delta_ok($matrix -> xx, 2.3); delta_ok($matrix -> xy, 2.3); delta_ok($matrix -> yx, 2.3); delta_ok($matrix -> yy, 2.3); delta_ok($matrix -> x0, 2.3); delta_ok($matrix -> y0, 2.3); } SKIP: { skip "1.16 stuff", 4 unless Gtk2::Pango -> CHECK_VERSION(1, 16, 0); my $matrix = Gtk2::Pango::Matrix -> new(); # identity is_deeply([$matrix -> transform_distance(1.0, 2.0)], [1.0, 2.0]); is_deeply([$matrix -> transform_point(1.0, 2.0)], [1.0, 2.0]); my $rect = {x => 1.0, y => 2.0, width => 23.0, height => 42.0}; is_deeply($matrix -> transform_rectangle($rect), $rect); is_deeply($matrix -> transform_pixel_rectangle($rect), $rect); } __END__ Copyright (C) 2007 by the gtk2-perl team (see the file AUTHORS for the full list). See LICENSE for more information. Gtk2-1.24992/t/GtkRecentAction.t0000644000175000017500000000154213076462677014621 0ustar lacklack#!/usr/bin/perl # $Id$ sub on_unthreaded_freebsd { if ($^O eq 'freebsd') { require Config; if ($Config::Config{ldflags} !~ m/-pthread\b/) { return 1; } } return 0; } use Gtk2::TestHelper at_least_version => [2, 12, 0, 'GtkRecentAction: new in 2.12'], tests => 1, (on_unthreaded_freebsd () ? (skip_all => 'need a perl compiled with "-pthread" on freebsd') : ()); my $action = Gtk2::RecentAction->new (name => 'one', label => 'one', tooltip => 'one', stock_id => 'gtk-ok', recent_manager => Gtk2::RecentManager->new); isa_ok($action, 'Gtk2::RecentAction'); __END__ Copyright (C) 2007 by the gtk2-perl team (see the file AUTHORS for the full list). See LICENSE for more information. Gtk2-1.24992/t/GtkSimpleList.t0000644000175000017500000002256413076462677014337 0ustar lacklack# vim: set syntax=perl : # # $Id$ # ######################### # GtkSimpleList Tests # - rm ######################### use Gtk2::TestHelper tests => 46; require_ok( 'Gtk2::SimpleList' ); Gtk2::SimpleList->add_column_type( 'ralacs', # think about it for a second... type => 'Glib::Scalar', renderer => 'Gtk2::CellRendererText', attr => sub { my ($tree_column, $cell, $model, $iter, $i) = @_; my ($info) = $model->get ($iter, $i); $info = join('',reverse(split('', $info || '' ))); $cell->set (text => $info ); } ); # add a new type of column that sums up an array reference Gtk2::SimpleList->add_column_type( 'sum_of_array', type => 'Glib::Scalar', renderer => 'Gtk2::CellRendererText', attr => sub { my ($tree_column, $cell, $model, $iter, $i) = @_; my $sum = 0; my $info = $model->get ($iter, $i); foreach (@$info) { $sum += $_; } $cell->set (text => $sum); } ); my $win = Gtk2::Window->new; $win->set_title('19.GtkSimpleList.t test'); $win->set_default_size(450, 350); my $vb = Gtk2::VBox->new(0, 6); $win->add($vb); my $sw = Gtk2::ScrolledWindow->new; $sw->set_policy (qw/automatic automatic/); $vb->pack_start($sw, 1, 1, 0); ok( my $list = Gtk2::SimpleList->new( 'Text Field' => 'text', 'Int Field' => 'int', 'Double Field' => 'double', 'Bool Field' => 'bool', 'Scalar Field' => 'scalar', 'Pixbuf Field' => 'pixbuf', 'Ralacs Field' => 'ralacs', 'Sum of Array' => 'sum_of_array', 'Markup Field' => 'markup', ) ); # $sw->add($list); my $quitbtn = Gtk2::Button->new_from_stock('gtk-quit'); $quitbtn->signal_connect( clicked => sub { Gtk2->main_quit; 1 } ); $vb->pack_start($quitbtn, 0, 0, 0); # begin exercise of SimpleList # this could easily fail, so we'll catch and work around it my $pixbuf; eval { $pixbuf = $win->render_icon ('gtk-ok', 'menu') }; if( $@ ) { $pixbuf = undef; } my $undef; my $scalar = 'scalar'; @{$list->{data}} = ( [ 'one', 1, 11, 1, undef, $pixbuf, undef, [0, 1, 2], 'one' ], [ 'two', 2, 22, 0, undef, undef, $scalar, [1, 2, 3], 'two' ], [ 'three', 3, 33, 1, $scalar, $pixbuf, undef, [2, 3, 4], 'three' ], [ 'four', 4, 44, 0, $scalar, $undef, $scalar, [3, 4, 5], 'four' ], ); ok( scalar(@{$list->{data}}) == 4 ); ok( $list->signal_connect( row_activated => sub { print STDERR "row_activated: @_"; 1; } ) ); my $count = 0; run_main sub { my $ldata = $list->{data}; ok( scalar(@$ldata) == 4 ); # test the initial values we put in there ok( $ldata->[0][0] eq 'one' and $ldata->[1][0] eq 'two' and $ldata->[2][0] eq 'three' and $ldata->[3][0] eq 'four' and $ldata->[0][1] == 1 and $ldata->[1][1] == 2 and $ldata->[2][1] == 3 and $ldata->[3][1] == 4 and $ldata->[0][2] == 11 and $ldata->[1][2] == 22 and $ldata->[2][2] == 33 and $ldata->[3][2] == 44 and $ldata->[0][3] == 1 and $ldata->[1][3] == 0 and $ldata->[2][3] == 1 and $ldata->[3][3] == 0 and not defined($ldata->[0][4]) and not defined($ldata->[1][4]) and $ldata->[2][4] eq $scalar and $ldata->[3][4] eq $scalar and $ldata->[0][5] == $pixbuf and not defined($ldata->[1][5]) and $ldata->[2][5] == $pixbuf and not defined($ldata->[3][5]) and eq_array($ldata->[0][7], [0, 1, 2]) and eq_array($ldata->[1][7], [1, 2, 3]) and eq_array($ldata->[2][7], [2, 3, 4]) and eq_array($ldata->[3][7], [3, 4, 5]) and $ldata->[0][8] eq 'one' and $ldata->[1][8] eq 'two' and $ldata->[2][8] eq 'three' and $ldata->[3][8] eq 'four' ); is (push (@$ldata, [ 'pushed', 1, 10, undef ]), 5); ok( scalar(@$ldata) == 5 ); push @$ldata, [ 'pushed', 2, 20, undef ]; ok( scalar(@$ldata) == 6 ); push @$ldata, [ 'pushed', 3, 30, undef ]; ok( scalar(@$ldata) == 7 ); ok (eq_array (pop @$ldata, ['pushed', 3, 30, 0, undef, undef, undef, undef, undef])); ok( scalar(@$ldata) == 6 ); pop @$ldata; ok( scalar(@$ldata) == 5 ); pop @$ldata; ok( scalar(@$ldata) == 4 ); is (unshift (@$ldata, [ 'unshifted', 1, 10, undef ]), 5); ok( scalar(@$ldata) == 5 ); unshift @$ldata, [ 'unshifted', 2, 20, undef ]; ok( scalar(@$ldata) == 6 ); unshift @$ldata, [ 'unshifted', 3, 30, undef ]; ok( scalar(@$ldata) == 7 ); ok (eq_array (shift @$ldata, ['unshifted', 3, 30, 0, undef, undef, undef, undef, undef])); ok( scalar(@$ldata) == 6 ); shift @$ldata; ok( scalar(@$ldata) == 5 ); shift @$ldata; ok( scalar(@$ldata) == 4 ); # make sure we're back to the initial values we put in there ok( $ldata->[0][0] eq 'one' and $ldata->[1][0] eq 'two' and $ldata->[2][0] eq 'three' and $ldata->[3][0] eq 'four' and $ldata->[0][1] == 1 and $ldata->[1][1] == 2 and $ldata->[2][1] == 3 and $ldata->[3][1] == 4 and $ldata->[0][2] == 11 and $ldata->[1][2] == 22 and $ldata->[2][2] == 33 and $ldata->[3][2] == 44 and $ldata->[0][3] == 1 and $ldata->[1][3] == 0 and $ldata->[2][3] == 1 and $ldata->[3][3] == 0 and not defined($ldata->[0][4]) and not defined($ldata->[1][4]) and $ldata->[2][4] eq $scalar and $ldata->[3][4] eq $scalar and $ldata->[0][5] == $pixbuf and not defined($ldata->[1][5]) and $ldata->[2][5] == $pixbuf and not defined($ldata->[3][5]) and eq_array($ldata->[0][7], [0, 1, 2]) and eq_array($ldata->[1][7], [1, 2, 3]) and eq_array($ldata->[2][7], [2, 3, 4]) and eq_array($ldata->[3][7], [3, 4, 5]) and $ldata->[0][8] eq 'one' and $ldata->[1][8] eq 'two' and $ldata->[2][8] eq 'three' and $ldata->[3][8] eq 'four' ); $ldata->[1][0] = 'getting deleted'; ok( $ldata->[1][0] eq 'getting deleted' ); $ldata->[1] = [ 'right now', -1, -11, 1, undef ]; ok( $ldata->[1][0] eq 'right now' and $ldata->[1][1] == -1 and $ldata->[1][2] == -11 and $ldata->[1][3] == 1 ); $ldata->[1] = 'bye'; ok( $ldata->[1][0] eq 'bye' ); delete $ldata->[1]; ok( scalar(@$ldata) == 3 ); ok( exists($ldata->[0]) ); ok( exists($ldata->[0][0]) ); @{$list->{data}} = (); ok( scalar(@$ldata) == 0 ); push @{$list->{data}}, ( [ 'pushed', 1, 10, undef ], [ 'pushed', 2, 10, undef ], [ 'pushed', 3, 10, undef ], [ 'pushed', 4, 10, undef ], ); unshift @{$list->{data}}, ( [ 'unshifted', 1, 10, undef ], [ 'unshifted', 2, 10, undef ], [ 'unshifted', 3, 10, undef ], [ 'unshifted', 4, 10, undef ], ); is( scalar(@{$list->{data}}), 8 ); my @ret; @ret = splice @{$list->{data}}, 2, 2, [ 'spliced', 1, 10, undef ], [ 'spliced', 2, 10, undef ]; is_deeply (\@ret, [ [ 'unshifted', 2, 10, 0, undef, undef, undef, undef, undef ], [ 'unshifted', 1, 10, 0, undef, undef, undef, undef, undef ] ], 'splice @, 2, 2 @'); @ret = splice @{$list->{data}}, -2, 1, [ 'negspliced', 1, 10, undef ], [ 'negspliced', 2, 10, undef ], [ 'negspliced', 3, 10, undef ]; is_deeply (\@ret, [ [ 'pushed', 3, 10, 0, undef, undef, undef, undef, undef ] ], 'splice @, -2, 1 @'); @ret = splice @{$list->{data}}, 8; is_deeply (\@ret, [ [ 'negspliced', 3, 10, 0, undef, undef, undef, undef, undef ], [ 'pushed', 4, 10, 0, undef, undef, undef, undef, undef ] ], 'splice @, 8'); @ret = splice @{$list->{data}}, -2; is_deeply (\@ret, [ [ 'negspliced', 1, 10, 0, undef, undef, undef, undef, undef ], [ 'negspliced', 2, 10, 0, undef, undef, undef, undef, undef ] ], 'splice @, -2'); @ret = splice @{$list->{data}}, -2, 0, [ 'norem', 1, 10, undef ], [ 'norem', 2, 10, undef ]; is_deeply (\@ret, [], 'splice @, -2, 0, @'); @ret = splice @{$list->{data}}; is_deeply (\@ret, [ [ 'unshifted', 4, 10, 0, undef, undef, undef, undef, undef ], [ 'unshifted', 3, 10, 0, undef, undef, undef, undef, undef ], [ 'spliced', 1, 10, 0, undef, undef, undef, undef, undef ], [ 'spliced', 2, 10, 0, undef, undef, undef, undef, undef ], [ 'norem', 1, 10, 0, undef, undef, undef, undef, undef ], [ 'norem', 2, 10, 0, undef, undef, undef, undef, undef ], [ 'pushed', 1, 10, 0, undef, undef, undef, undef, undef ], [ 'pushed', 2, 10, 0, undef, undef, undef, undef, undef ] ], 'splice @'); }; # end exercise of SimpleList ok(1); # each of these should result in exceptions. eval { Gtk2::SimpleList->new; }; ok( $@ =~ m/no columns/i, 'no args' ); eval { Gtk2::SimpleList->new ('foo'); }; ok( $@ =~ m/no columns/i, 'odd number of params' ); eval { Gtk2::SimpleList->new ('foo' => 'bar'); }; ok( $@ =~ m/unknown column type/i, 'bad column type' ); eval { Gtk2::SimpleList->new_from_treeview; }; ok( $@ =~ m/not a Gtk2::TreeView/i, 'no args triggers invalid treeview first' ); eval { Gtk2::SimpleList->new_from_treeview ('foo'); }; ok( $@ =~ m/not a Gtk2::TreeView/i, 'invalid treeview reference' ); my $tv = Gtk2::TreeView->new; eval { Gtk2::SimpleList->new_from_treeview ($tv, 'bar'); }; ok( $@ =~ m/no columns/i, 'odd number of params' ); eval { Gtk2::SimpleList->new_from_treeview ($tv, 'bar', 'baz'); }; ok( $@ =~ m/unknown column type/i, 'unknown column type' ); eval { Gtk2::SimpleList->new_from_treeview ($tv, 'bar', 'text', 'baz'); }; ok( $@ =~ m/expecting pairs/i, 'odd number of params beyond the required first' ); $tv = undef; __END__ Copyright (C) 2003-2005 by the gtk2-perl team (see the file AUTHORS for the full list). See LICENSE for more information. Gtk2-1.24992/t/GtkRecentChooser.t0000644000175000017500000000560413076462677015011 0ustar lacklack#!/usr/bin/perl -w use strict; sub on_unthreaded_freebsd { if ($^O eq 'freebsd') { require Config; if ($Config::Config{ldflags} !~ m/-pthread\b/) { return 1; } } return 0; } use Gtk2::TestHelper tests => 15, at_least_version => [2, 10, 0, "GtkRecentChooser"], (on_unthreaded_freebsd () ? (skip_all => 'need a perl compiled with "-pthread" on freebsd') : ()); # $Id$ use File::Temp qw(tempdir); my $dir = tempdir(CLEANUP => 1); my $manager = Glib::Object::new("Gtk2::RecentManager", filename => "$dir/test.xbel"); my $chooser = Gtk2::RecentChooserWidget -> new_for_manager($manager); isa_ok($chooser, "Gtk2::RecentChooser"); $chooser -> set_show_private(TRUE); ok($chooser -> get_show_private()); $chooser -> set_show_not_found(TRUE); ok($chooser -> get_show_not_found()); $chooser -> set_select_multiple(TRUE); ok($chooser -> get_select_multiple()); $chooser -> set_limit(23); is($chooser -> get_limit(), 23); $chooser -> set_local_only(TRUE); ok($chooser -> get_local_only()); $chooser -> set_show_tips(TRUE); ok($chooser -> get_show_tips()); $chooser -> set_show_icons(TRUE); ok($chooser -> get_show_icons()); $chooser -> set_sort_type("mru"); is($chooser -> get_sort_type(), "mru"); $chooser -> set_sort_func(sub { warn join ", ", @_; }, "data"); $chooser -> set_sort_func(sub { warn join ", ", @_; }); # --------------------------------------------------------------------------- # use Cwd qw(cwd); my $uri_one = Glib::filename_to_uri(cwd() . "/" . $0, undef); my $uri_two = Glib::filename_to_uri($^X, undef); $manager -> purge_items(); $manager -> add_item($uri_one); $manager -> add_item($uri_two); # add_item() is asynchronous, so let the main loop spin for a while Gtk2->main_iteration while scalar (my @items = $manager->get_items) < 2; $manager->signal_emit("changed"); $chooser -> set_select_multiple(FALSE); run_main(sub { $chooser -> set_current_uri($uri_one); }); run_main(sub { is($chooser -> get_current_uri(), $uri_one); is($chooser -> get_current_item() -> get_uri(), $uri_one); }); $chooser -> select_uri($uri_two); $chooser -> unselect_uri($uri_two); $chooser -> set_select_multiple(TRUE); $chooser -> select_all(); $chooser -> unselect_all(); my @expected_uris = sort ($uri_two, $uri_one); is_deeply([sort $chooser -> get_uris()], \@expected_uris); is_deeply([sort map { $_ -> get_uri() } $chooser -> get_items()], \@expected_uris); my $filter_one = Gtk2::RecentFilter -> new(); my $filter_two = Gtk2::RecentFilter -> new(); $chooser -> add_filter($filter_one); $chooser -> add_filter($filter_two); is_deeply([$chooser -> list_filters()], [$filter_one, $filter_two]); $chooser -> remove_filter($filter_two); $chooser -> remove_filter($filter_one); $chooser -> set_filter($filter_one); is($chooser -> get_filter(), $filter_one); __END__ Copyright (C) 2006, 2013 by the gtk2-perl team (see the file AUTHORS for the full list). See LICENSE for more information. Gtk2-1.24992/t/GtkStatusbar.t0000644000175000017500000000206613076462677014215 0ustar lacklack#!/usr/bin/env perl use strict; use warnings; ######################### # GtkStatusbar Tests # - rm ######################### ######################### use Gtk2::TestHelper tests => 10, noinit => 1; ok( my $sts = Gtk2::Statusbar->new ); $sts->set_has_resize_grip(1); is( $sts->get_has_resize_grip, 1 ); ok( my $sts_cid1 = $sts->get_context_id('Main') ); ok( $sts->push($sts_cid1, 'Ready 1-0') ); ok( $sts->push($sts_cid1, 'Ready 1-1') ); ok( my $sts_cid2 = $sts->get_context_id('Not Main') ); ok( my $sts_mid1 = $sts->push($sts_cid2, 'Ready 2-0') ); ok( $sts->push($sts_cid2, 'Ready 2-1') ); $sts->pop($sts_cid2); $sts->pop($sts_cid1); $sts->pop($sts_cid2); $sts->remove($sts_cid2, $sts_mid1); SKIP: { skip 'new 2.20 stuff', 1 unless Gtk2->CHECK_VERSION(2, 20, 0); isa_ok ($sts->get_message_area, 'Gtk2::Widget'); } SKIP: { skip 'new 2.22 stuff', 0 unless Gtk2->CHECK_VERSION(2, 22, 0); $sts->remove_all ($sts_cid1); } ok(1); __END__ Copyright (C) 2003 by the gtk2-perl team (see the file AUTHORS for the full list). See LICENSE for more information. Gtk2-1.24992/t/GtkVScale.t0000644000175000017500000000065413076462677013423 0ustar lacklack#!/usr/bin/perl -w use strict; use Gtk2::TestHelper tests => 2; # $Id$ my $adjustment = Gtk2::Adjustment -> new(0, 0, 100, 1, 5, 10); my $scale = Gtk2::VScale -> new($adjustment); isa_ok($scale, "Gtk2::VScale"); $scale = Gtk2::VScale -> new_with_range(0, 100, 1); isa_ok($scale, "Gtk2::VScale"); __END__ Copyright (C) 2003 by the gtk2-perl team (see the file AUTHORS for the full list). See LICENSE for more information. Gtk2-1.24992/t/GtkEditable.t0000644000175000017500000000352513076462676013756 0ustar lacklack#!/usr/bin/perl -w use strict; use Gtk2::TestHelper tests => 11; use utf8; # for the umlaut test # $Id$ my $adjustment = Gtk2::Adjustment -> new(0, 0, 100, 1, 5, 0); my $spin = Gtk2::SpinButton -> new($adjustment, 0.2, 1); isa_ok($spin, "Gtk2::Editable"); my $entry = Gtk2::Entry -> new(); isa_ok($entry, "Gtk2::Editable"); $entry -> set_text("Bla"); $entry -> select_region(1, 3); is_deeply([$entry -> get_selection_bounds()], [1, 3]); is($entry -> insert_text(" Blub", 3), 8); is($entry -> get_chars(0, 8), "Bla Blub"); $entry -> delete_text(3, 8); is($entry -> insert_text(" Blub", 5, 3), 8); is($entry -> get_chars(0, 8), "Bla Blub"); $entry -> delete_text(3, 8); $entry -> set_position(2); is($entry -> get_position(), 2); $entry -> set_editable(1); is($entry -> get_editable(), 1); my $window = Gtk2::Window -> new(); $window -> add($entry); $entry -> cut_clipboard(); $entry -> copy_clipboard(); $entry -> paste_clipboard(); $entry -> delete_selection(); # Test the custom insert-text marshaller. { my $entry = Gtk2::Entry -> new(); $entry -> set_text("äöü"); $entry -> signal_connect(insert_text => sub { my ($entry, $new_text, $new_text_length, $position, $data) = @_; $_[1] = reverse $new_text; $_[3] = 0; return (); }); $entry -> insert_text("123", 3); is($entry -> get_text(), "321äöü"); } { my $entry = Gtk2::Entry -> new(); $entry -> set_text("äöü"); $entry -> signal_connect('insert-text' => sub { my ($entry, $new_text, $new_text_length, $position, $data) = @_; my $mangled_new_text = reverse $new_text; my $mangled_position = 0; return ($mangled_new_text, $mangled_position); }); $entry -> insert_text("123", 3); is($entry -> get_text(), "321äöü"); } __END__ Copyright (C) 2003 by the gtk2-perl team (see the file AUTHORS for the full list). See LICENSE for more information. Gtk2-1.24992/t/GtkRecentFilter.t0000644000175000017500000000420513076462677014630 0ustar lacklack#!/usr/bin/perl -w use strict; sub on_unthreaded_freebsd { if ($^O eq 'freebsd') { require Config; if ($Config::Config{ldflags} !~ m/-pthread\b/) { return 1; } } return 0; } use Gtk2::TestHelper tests => 13, at_least_version => [2, 10, 0, "GtkRecentFilter"], (on_unthreaded_freebsd () ? (skip_all => 'need a perl compiled with "-pthread" on freebsd') : ()); # $Id$ my $filter = Gtk2::RecentFilter -> new(); isa_ok($filter, "Gtk2::RecentFilter"); $filter -> set_name("Test"); is($filter -> get_name(), "Test"); $filter -> add_mime_type("image/png"); $filter -> add_pattern("*.png"); $filter -> add_pixbuf_formats(); $filter -> add_group("Images"); $filter -> add_age(23); sub filter_cb { my ($info, $data) = @_; return TRUE if ($info -> {age} == 23); return TRUE if ($info -> {mime_type} eq "image/png"); return FALSE; } $filter = Gtk2::RecentFilter -> new(); $filter -> add_custom([qw/age mime-type/], \&filter_cb); ok($filter -> get_needed() >= [qw/age mime-type/]); ok( $filter -> filter({ contains => [qw/age mime-type/], age => 23, mime_type => "image/jpeg" })); ok( $filter -> filter({ contains => [qw/age mime-type/], age => 42, mime_type => "image/png" })); ok(!$filter -> filter({ contains => [qw/age mime-type/], age => 42, mime_type => "image/jpeg" })); my $stuff = { contains => [qw/display-name mime-type application group age/], display_name => "Bla", mime_type => "bla", applications => ["bla", "blub"], groups => ["Bla", "Blub"], age => 42, }; sub test_cb { my ($info, $data) = @_; is($info -> {display_name}, $stuff -> {display_name}); is($info -> {mime_type}, $stuff -> {mime_type}); is_deeply($info -> {applications}, $stuff -> {applications}); is_deeply($info -> {groups}, $stuff -> {groups}); is($info -> {age}, $stuff -> {age}); is($data, "data"); return TRUE; } $filter = Gtk2::RecentFilter -> new(); $filter -> add_custom([qw/display-name mime-type application group age/], \&test_cb, "data"); ok($filter -> filter($stuff)); __END__ Copyright (C) 2006 by the gtk2-perl team (see the file AUTHORS for the full list). See LICENSE for more information. Gtk2-1.24992/t/GtkAction.t0000644000175000017500000001142413076462676013457 0ustar lacklack#!/usr/bin/perl # # $Id$ # use Gtk2::TestHelper at_least_version => [2, 4, 0, "Action-based menus are new in 2.4"], tests => 31, noinit => 0; my $action = Gtk2::Action->new (name => 'Open', label => '_Open', tooltip => 'Open Something', stock_id => 'gtk-open'); is ($action->is_sensitive, 1); is ($action->get_sensitive, 1); is ($action->is_visible, 1); is ($action->get_visible, 1); isa_ok ($action, 'Gtk2::Action'); is ($action->get_name, 'Open'); $action->signal_connect (activate => sub { ok (TRUE) }); $action->activate; # most of these are for action implementations my $icon_widget = $action->create_icon ('large-toolbar'); isa_ok ($icon_widget, 'Gtk2::Image'); my $group = Gtk2::ActionGroup->new ('dummy'); $group->add_action ($action); my $widget = $action->create_menu_item; isa_ok ($widget, 'Gtk2::MenuItem'); $widget = $action->create_tool_item; isa_ok ($widget, 'Gtk2::ToolItem'); my $proxy = Gtk2::Button->new; $action->connect_proxy ($proxy); my @proxies = $action->get_proxies; ok (grep {$_ == $proxy} @proxies); $action->disconnect_proxy ($proxy); $action->connect_accelerator; $action->disconnect_accelerator; ## /* protected ... for use by child actions */ $action->block_activate_from ($proxy); $action->unblock_activate_from ($proxy); ## /* protected ... for use by action groups */ $action->set_accel_path ('/'); $action->set_accel_group (undef); $action->set_accel_group (Gtk2::AccelGroup->new); # call $action->get_proxies within an ActionGroup connect_proxy signal, to # check the ref-counting/sinking/not-sinking on that get_proxies is ok there. { my $actions = Gtk2::ActionGroup->new ("Actions"); $actions->add_actions ([ [ 'FileMenu', undef, '_File' ] ]); $actions->signal_connect (connect_proxy => \&connect_get_proxies); my $proxies_called = 0; sub connect_get_proxies { my ($actions, $action, $widget) = @_; $action->get_proxies; $proxies_called++; } my $ui = Gtk2::UIManager->new; $ui->insert_action_group ($actions, 0); $ui->add_ui_from_string (<<'HERE'); HERE # dodgy refs result in g_critical logs my $old_fatal = Glib::Log->set_always_fatal (['critical', 'fatal-mask']); $ui->get_widget('/MenuBar'); Glib::Log->set_always_fatal ($old_fatal); is ($proxies_called, 1, '$action->get_proxies ok under a connect_proxy signal'); } SKIP: { skip "new 2.6 stuff", 3 unless Gtk2->CHECK_VERSION (2, 6, 0); $action->set_sensitive(FALSE); is ($action->is_sensitive, FALSE); $action->set_visible(FALSE); is ($action->is_visible, FALSE); ok (defined $action->get_accel_path); } SKIP: { skip "new 2.10 stuff", 1 unless Gtk2->CHECK_VERSION (2, 10, 0); isa_ok ($widget->get_action, 'Gtk2::Action'); } SKIP: { skip "new 2.12 stuff", 1 unless Gtk2->CHECK_VERSION (2, 12, 0); is ($action->create_menu, undef); } SKIP: { skip "new 2.16 stuff", 13 unless Gtk2->CHECK_VERSION (2, 16, 0); $action->set_label('new label'); is ($action->get_label, 'new label', '[gs]et_label'); $action->set_short_label('new short label'); is ($action->get_short_label, 'new short label', '[gs]et_short_label'); # it seems resetting label and short_label to undef is not possible, # so use a new gtkaction with no label/short_label to test the getters my $a_undef = Gtk2::Action->new (name => 'Open'); is ($a_undef->get_label, undef, 'get_label with undef'); is ($a_undef->get_short_label, undef, 'get_short_label with undef'); $action->set_tooltip('new tooltip'); is ($action->get_tooltip, 'new tooltip', '[gs]et_tooltip'); $action->set_tooltip(undef); is ($action->get_tooltip, undef, '[gs]et_tooltip with undef'); $action->set_stock_id('gtk-ok'); is ($action->get_stock_id, 'gtk-ok', '[gs]et_stock_id'); $action->set_stock_id(undef); is ($action->get_stock_id, undef, '[gs]et_stock_id with undef'); $action->set_icon_name('my-icon-name'); is ($action->get_icon_name, 'my-icon-name', '[gs]et_icon_name'); $action->set_icon_name(undef); is ($action->get_icon_name, undef, '[gs]et_icon_name with undef'); $action->set_visible_horizontal(FALSE); is ($action->get_visible_horizontal, FALSE, '[gs]et_visible_horizontal'); $action->set_visible_vertical(FALSE); is ($action->get_visible_vertical, FALSE, '[gs]et_visible_vertical'); $action->set_is_important(TRUE); is ($action->get_is_important, TRUE, '[gs]et_is_important'); $action->block_activate; $action->unblock_activate; } SKIP: { skip 'new 2.20 stuff', 1 unless Gtk2->CHECK_VERSION(2, 20, 0); $action->set_always_show_image (TRUE); ok ($action->get_always_show_image); } __END__ Copyright (C) 2003-2006 by the gtk2-perl team (see the file AUTHORS for the full list). See LICENSE for more information. Gtk2-1.24992/t/GtkIMContext.t0000644000175000017500000000376713076462677014130 0ustar lacklack#!/usr/bin/perl -w # vim: set ft=perl : use Gtk2::TestHelper tests => 9; my $context = Gtk2::IMContextSimple->new; isa_ok ($context, 'Gtk2::IMContextSimple'); isa_ok ($context, 'Gtk2::IMContext'); isa_ok ($context, 'Glib::Object'); # unset. $context->set_client_window (undef); # something with which to mock up the tests my $drawing_area = Gtk2::DrawingArea->new; $drawing_area->set_size_request (200, 200); $drawing_area->show; my $window = Gtk2::Window->new; $window->add ($drawing_area); $window->show_now; $context->set_client_window ($drawing_area->window); my ($str, $attrs, $cursor_pos) = $context->get_preedit_string (); my $key_event = Gtk2::Gdk::Event->new ('key-press'); $key_event->window ($drawing_area->window); my $success = $context->filter_keypress ($key_event); $context->focus_in (); $context->focus_out (); $context->reset (); $context->set_cursor_location (Gtk2::Gdk::Rectangle->new (0, 0, 10, 10)); $context->set_use_preedit (TRUE); $context->set_use_preedit (FALSE); $context->set_surrounding ("some text", "3"); $context->signal_connect (retrieve_surrounding => sub { ok (1, 'retrieve_surrounding called'); }); my ($text, $cursor_index) = $context->get_surrounding (); # The actual behavior here is dependent on the input method being used, so # we can't rely on that for a test. retrieve_surrounding will have been invoked, # so that will have to suffice. #is ($text, 'some text'); #is ($cursor_index, 3); my $offset = 3; my $n_chars = 2; $success = $context->delete_surrounding ($offset, $n_chars); $context = Gtk2::IMMulticontext->new; isa_ok ($context, 'Gtk2::IMMulticontext'); isa_ok ($context, 'Gtk2::IMContext'); isa_ok ($context, 'Glib::Object'); $context->append_menuitems (Gtk2::Menu->new); SKIP: { skip '2.16 additions', 2 unless Gtk2->CHECK_VERSION (2, 16, 0); is ($context->get_context_id, undef, 'No default context ID'); # Get a default context $context->focus_in (); my $id = $context->get_context_id; ok (defined $id, 'Context ID'); $context->set_context_id ($id); } Gtk2-1.24992/t/GtkVSeparator.t0000644000175000017500000000052013076462677014324 0ustar lacklack#!/usr/bin/perl -w use strict; use Gtk2::TestHelper tests => 2, noinit => 1; # $Id$ my $separator = Gtk2::VSeparator -> new(); isa_ok($separator, "Gtk2::Separator"); isa_ok($separator, "Gtk2::VSeparator"); __END__ Copyright (C) 2003 by the gtk2-perl team (see the file AUTHORS for the full list). See LICENSE for more information. Gtk2-1.24992/t/GtkClipboard.t0000644000175000017500000001666313076462676014153 0ustar lacklack#!/usr/bin/perl -w # vim: set ft=perl : use Gtk2::TestHelper tests => 115, at_least_version => [2, 2, 0, "GtkClipboard didn't exist in 2.0.x"]; # $Id$ my $clipboard; SKIP: { skip "GdkDisplay is new in 2.2", 1 unless Gtk2->CHECK_VERSION (2, 2, 0); my $display = Gtk2::Gdk::Display->get_default; $clipboard = Gtk2::Clipboard->get_for_display ( $display, Gtk2::Gdk->SELECTION_CLIPBOARD); isa_ok ($clipboard, 'Gtk2::Clipboard'); is ($clipboard->get_display, $display); } $clipboard = Gtk2::Clipboard->get (Gtk2::Gdk->SELECTION_PRIMARY); isa_ok ($clipboard, 'Gtk2::Clipboard'); my $expect = '0123456789abcdef'; $clipboard->set_text ($expect); my $text = $clipboard->wait_for_text; is ($text, $expect); is ($clipboard->wait_is_text_available, 1); $clipboard->request_text (sub { # print "hello from the callback\n" . Dumper(\@_); is ($_[0], $clipboard); is ($_[1], $expect); is ($_[2], 'user data!'); }, 'user data!'); $clipboard->request_contents (Gtk2::Gdk->SELECTION_TYPE_STRING, sub { #print "hello from the callback\n" . Dumper(\@_); is ($_[0], $clipboard); isa_ok ($_[1], 'Gtk2::SelectionData'); is ($_[2], 'user data!'); is ($_[1]->get_text, $expect); }, 'user data!'); SKIP: { skip 'request_targets and wait_for_targets are new in 2.4', 4 unless Gtk2->CHECK_VERSION (2, 4, 0); $clipboard->request_targets (sub { is ($_[0], $clipboard); isa_ok ($_[1], "ARRAY"); isa_ok ($_[1][0], "Gtk2::Gdk::Atom"); is ($_[2], "bla"); }, "bla"); } SKIP: { skip 'new/now-working targets stuff', 2 unless Gtk2->CHECK_VERSION (2, 6, 0); is ($clipboard->wait_is_target_available (Gtk2::Gdk::Atom->intern ('TEXT')), TRUE); isa_ok (($clipboard->wait_for_targets)[0], 'Gtk2::Gdk::Atom'); } SKIP: { skip "new image stuff", 5 # Some of this was broken in 2.6.0 unless Gtk2->CHECK_VERSION (2, 6, 1); my $pixbuf = Gtk2::Gdk::Pixbuf->new ("rgb", FALSE, 8, 23, 42); $clipboard->set_image ($pixbuf); is ($clipboard->wait_is_image_available, TRUE); isa_ok ($clipboard->wait_for_image, "Gtk2::Gdk::Pixbuf"); $clipboard->request_image (sub { is ($_[0], $clipboard); isa_ok ($_[1], "Gtk2::Gdk::Pixbuf"); is ($_[2], "bla"); }, "bla"); } SKIP: { skip "new stuff in 2.10", 7 unless Gtk2->CHECK_VERSION (2, 10, 0); my $test_text = 'test test test'; my $buffer = Gtk2::TextBuffer->new; $buffer->insert ($buffer->get_start_iter, 'bla!'); $buffer->register_deserialize_format ( 'text/rdf', sub { warn "here"; $_[1]->insert ($_[2], 'bla!'); }); $clipboard->set_with_data ( sub { my ($clipboard, $selection_data, $info, $data) = @_; $selection_data->set (Gtk2::Gdk::Atom->new ('text/rdf'), 8, $data); }, sub {}, $test_text, {target=>'text/rdf'}); $clipboard->request_rich_text ($buffer, sub { # print "hello from the callback\n" . Dumper(\@_); is ($_[0], $clipboard); is ($_[1]->name, 'text/rdf'); is ($_[2], $test_text); is ($_[3], undef); }); ok ($clipboard->wait_is_rich_text_available ($buffer)); my ($data, $atom) = $clipboard->wait_for_rich_text ($buffer); is ($data, $test_text); is ($atom->name, 'text/rdf'); } SKIP: { skip 'new uris stuff', 5 unless Gtk2->CHECK_VERSION (2, 14, 0); my @uris = ('file:///foo/bar', 'file:///bar/foo'); $clipboard->set_with_data ( sub { my ($clipboard, $selection_data, $info, $data) = @_; $selection_data->set_uris (@$data); }, sub {}, \@uris, {target=>'text/uri-list'}); is ($clipboard->wait_is_uris_available, TRUE); is_deeply ($clipboard->wait_for_uris, \@uris); $clipboard->request_uris (sub { my ($tmp_clipboard, $tmp_uris, $data) = @_; is ($tmp_clipboard, $clipboard); is_deeply ($tmp_uris, \@uris); is ($data, undef); }); } run_main; #print "----------------------------------\n"; $expect = 'whee'; my $get_func_call_count = 0; sub get_func { return if ++$get_func_call_count == 3; my ($cb, $sd, $info, $user_data_or_owner) = @_; is ($cb, $clipboard); isa_ok ($sd, 'Gtk2::SelectionData'); is ($info, 0); ok (defined $user_data_or_owner); # Tests for Gtk2::SelectionData: $sd->set (Gtk2::Gdk->TARGET_STRING, 8, 'bla blub'); is ($sd->get_selection ()->name, 'PRIMARY'); ok (defined $sd->get_target ()->name); is ($sd->get_data_type ()->name, 'STRING'); is ($sd->get_format (), 8); is ($sd->get_data (), 'bla blub'); is ($sd->get_length (), 8); # Deprecated but provided for backwards compatibility ok ($sd->selection () == $sd->get_selection ()); ok ($sd->target () == $sd->get_target ()); ok ($sd->type () == $sd->get_data_type ()); ok ($sd->format () == $sd->get_format ()); ok ($sd->data () eq $sd->get_data ()); ok ($sd->length () == $sd->get_length ()); SKIP: { skip 'GdkDisplay is new in 2.2', 2 unless Gtk2->CHECK_VERSION (2, 2, 0); isa_ok ($sd->get_display (), 'Gtk2::Gdk::Display'); # Deprecated but provided for backwards compatibility ok ($sd->display () == $sd->get_display ()); } # FIXME: always empty and false? # warn $sd->get_targets; # warn $sd->targets_include_text; $sd->set_text ($expect); is ($sd->get_text, $expect); is ($sd->data, $expect); is ($sd->length, length ($expect)); SKIP: { skip '2.6 stuff', 7 unless Gtk2->CHECK_VERSION (2, 6, 0); # This won't work with a STRING selection, but I don't know # what else to use, so we just check that both operations fail. my $pixbuf = Gtk2::Gdk::Pixbuf->new ('rgb', FALSE, 8, 23, 42); is ($sd->set_pixbuf ($pixbuf), FALSE); is ($sd->get_pixbuf, undef); # Same here. is ($sd->set_uris, FALSE); is_deeply ([$sd->get_uris], []); is ($sd->set_uris (qw(a b c)), FALSE); is_deeply ([$sd->get_uris], []); is ($sd->targets_include_image (TRUE), FALSE); } SKIP: { skip '2.10 stuff', 2 unless Gtk2->CHECK_VERSION (2, 10, 0); is ($sd->targets_include_uri, FALSE); my $buffer = Gtk2::TextBuffer->new; $buffer->register_deserialize_format ( 'text/rdf', sub { warn "here"; $sd->insert ($info, 'bla!'); }); is ($sd->targets_include_rich_text ($buffer), FALSE); } } sub clear_func { is (shift, $clipboard); ok (shift); } sub received_func { is ($_[0], $clipboard); isa_ok ($_[1], 'Gtk2::SelectionData'); is ($_[2], 'user data!'); is ($_[1]->get_text, $expect); } # set the selection multiple times to make sure we don't crash on # replacing all the GPerlCallbacks. $clipboard->set_with_data (\&get_func, \&clear_func, 'user data, yo', {target=>'TEXT'}, {target=>'STRING'}, {target=>'COMPOUND_TEXT'}, ); ok(1); $clipboard->set_with_data (\&get_func, \&clear_func, 'user data, yo', {target=>'TEXT'}, {target=>'STRING'}, {target=>'COMPOUND_TEXT'}, ); ok(1); $clipboard->set_with_data (\&get_func, \&clear_func, 'user data, yo', {target=>'TEXT'}, {target=>'STRING'}, {target=>'COMPOUND_TEXT'}, ); ok(1); $clipboard->request_contents (Gtk2::Gdk->SELECTION_TYPE_STRING, \&received_func, 'user data!'); run_main; my $widget = Gtk2::Window->new; $clipboard->set_with_owner (\&get_func, \&clear_func, $widget, {target=>'TEXT'}, {target=>'STRING'}, {target=>'COMPOUND_TEXT'}, ); is ($clipboard->get_owner, $widget); $clipboard->request_contents (Gtk2::Gdk->SELECTION_TYPE_STRING, \&received_func, 'user data!'); run_main; SKIP: { skip "new 2.6 stuff", 0 unless Gtk2->CHECK_VERSION (2, 6, 0); $clipboard->set_can_store ({target=>'STRING'}, {target=>'TEXT'}); $clipboard->set_can_store; $clipboard->store; } $clipboard->clear; __END__ Copyright (C) 2003-2006 by the gtk2-perl team (see the file AUTHORS for the full list). See LICENSE for more information. Gtk2-1.24992/t/GtkTreeView.t0000644000175000017500000004342013076462677013776 0ustar lacklack#!/usr/bin/perl -w use strict; use Gtk2::TestHelper tests => 124; # $Id$ ############################################################################### sub setup { my $window = Gtk2::Window -> new("toplevel"); my $model = Gtk2::TreeStore -> new("Glib::String", "Glib::Boolean"); my $view = Gtk2::TreeView -> new(); $view -> set_model($model); foreach (qw(bla blee bliii bloooo)) { my $iter = $model -> append(undef); $model -> set($iter, 0 => $_, 1 => 0); foreach my $multiplier (1 .. 3) { my $iter_child = $model -> append($iter); $model -> set($iter_child, 0 => $_ x $multiplier, 1 => 0); my $iter_child_child = $model -> append($iter_child); $model -> set($iter_child_child, 0 => reverse($_) x $multiplier, 1 => 1); } } $view -> insert_column_with_attributes( 0, "Bla", Gtk2::CellRendererText -> new(), text => 0); $window -> add($view); $view -> realize(); return ($window, $view, $model, $view -> get_column(0)); } ############################################################################### my $view_column = Gtk2::TreeViewColumn -> new(); isa_ok($view_column, "Gtk2::TreeViewColumn"); ginterfaces_ok($view_column); $view_column -> set_spacing(23); is($view_column -> get_spacing(), 23); $view_column -> set_visible(1); is($view_column -> get_visible(), 1); $view_column -> set_resizable(1); is($view_column -> get_resizable(), 1); like($view_column -> get_width(), qr/^\d+$/); $view_column -> set_fixed_width(42); is($view_column -> get_fixed_width(), 42); $view_column -> set_min_width(23); is($view_column -> get_min_width(), 23); $view_column -> set_max_width(42); is($view_column -> get_max_width(), 42); $view_column -> set_sizing("autosize"); is($view_column -> get_sizing(), "autosize"); $view_column -> set_title("Bla"); is($view_column -> get_title(), "Bla"); $view_column -> set_widget(Gtk2::Button -> new("Bla")); isa_ok($view_column -> get_widget(), "Gtk2::Button"); $view_column -> set_alignment(1.0); is($view_column -> get_alignment(), 1.0); $view_column -> set_reorderable(1); is($view_column -> get_reorderable(), 1); $view_column -> set_sort_column_id(5); is($view_column -> get_sort_column_id(), 5); $view_column -> set_sort_indicator(1); is($view_column -> get_sort_indicator(), 1); $view_column -> set_sort_order("descending"); is($view_column -> get_sort_order(), "descending"); SKIP: { skip("cell_is_visible is new in 2.2.x", 1) unless Gtk2->CHECK_VERSION (2, 2, 0); ok(!$view_column -> cell_is_visible()); } SKIP: { skip("[sg]et_expand are new in 2.4", 1) unless Gtk2->CHECK_VERSION (2, 4, 0); $view_column -> set_expand(1); is($view_column -> get_expand(), 1); } SKIP: { skip("new 2.8 stuff", 0) unless Gtk2->CHECK_VERSION (2, 8, 0); $view_column -> queue_resize(); } SKIP: { skip('new 2.12 stuff', 1) unless Gtk2->CHECK_VERSION (2, 12, 0); is($view_column -> get_tree_view(), undef); } ############################################################################### my $cell_renderer = Gtk2::CellRendererText -> new(); isa_ok($cell_renderer, "Gtk2::CellRendererText"); $view_column = Gtk2::TreeViewColumn -> new_with_attributes("Bla", $cell_renderer, text => 0); $cell_renderer -> set_fixed_height_from_font(-1); $view_column -> pack_start(Gtk2::CellRendererToggle -> new(), 1); $view_column -> pack_end(Gtk2::CellRendererPixbuf -> new(), 0); isa_ok(($view_column -> get_cell_renderers())[0], "Gtk2::CellRendererText"); isa_ok(($view_column -> get_cell_renderers())[1], "Gtk2::CellRendererToggle"); isa_ok(($view_column -> get_cell_renderers())[2], "Gtk2::CellRendererPixbuf"); $view_column -> clear(); is($view_column -> get_cell_renderers(), undef); ############################################################################### $cell_renderer = Gtk2::CellRendererToggle -> new(); isa_ok($cell_renderer, "Gtk2::CellRendererToggle"); $view_column -> pack_start($cell_renderer, 1); $view_column -> add_attribute($cell_renderer, activatable => 1); $cell_renderer -> set_radio(1); is($cell_renderer -> get_radio(), 1); $cell_renderer -> set_active(1); is($cell_renderer -> get_active(), 1); ############################################################################### $cell_renderer = Gtk2::CellRendererPixbuf -> new(); isa_ok($cell_renderer, "Gtk2::CellRendererPixbuf"); $view_column -> pack_start($cell_renderer, 1); $view_column -> set_attributes($cell_renderer, stock_id => 0); $view_column -> clear_attributes($cell_renderer); ############################################################################### $view_column -> set_clickable(1); is($view_column -> get_clickable(), 1); $view_column -> signal_connect(clicked => sub { my ($view_column) = @_; isa_ok($view_column, "Gtk2::TreeViewColumn"); }); $view_column -> clicked(); $view_column -> signal_emit("clicked"); ############################################################################### my ($window, $view, $model) = setup(); isa_ok($view, "Gtk2::TreeView"); isa_ok($view -> get_model(), "Gtk2::TreeStore"); $view -> append_column(my $view_column_one = Gtk2::TreeViewColumn -> new()); $view -> insert_column(my $view_column_two = Gtk2::TreeViewColumn -> new(), 1); $view -> insert_column_with_attributes(0, "Bla", Gtk2::CellRendererToggle -> new(), active => 1); $view -> insert_column_with_data_func(1, "Blub", Gtk2::CellRendererText -> new(), sub {}); SKIP: { skip('new 2.12 stuff', 1) unless Gtk2->CHECK_VERSION (2, 12, 0); is($view_column_one -> get_tree_view(), $view); } $view -> move_column_after($view_column_one, $view_column_two); $view -> set_expander_column($view_column_one); SKIP: { skip("get_expander_column is new in 2.2.x", 1) unless Gtk2->CHECK_VERSION (2, 2, 0); is($view -> get_expander_column(), $view_column_one); } my $path = Gtk2::TreePath -> new("0:0"); isa_ok($view -> get_cell_area($path, $view_column_two), "Gtk2::Gdk::Rectangle"); isa_ok($view -> get_cell_area(undef, $view_column_two), "Gtk2::Gdk::Rectangle"); isa_ok($view -> get_cell_area($path, undef), "Gtk2::Gdk::Rectangle"); isa_ok($view -> get_background_area($path, $view_column_two), "Gtk2::Gdk::Rectangle"); isa_ok($view -> get_background_area(undef, $view_column_two), "Gtk2::Gdk::Rectangle"); isa_ok($view -> get_background_area($path, undef), "Gtk2::Gdk::Rectangle"); $view -> expand_all(); $view -> set_cursor(Gtk2::TreePath -> new("1:0"), $view_column_one, 0); is(($view -> get_cursor())[0] -> to_string(), "1:0"); is(($view -> get_cursor())[1], $view_column_one); $view -> scroll_to_cell(Gtk2::TreePath -> new("1:1"), $view_column_one, 1, 0.5, 0.5); $view -> scroll_to_cell(Gtk2::TreePath -> new("1:1"), $view_column_one, 0); $view -> row_activated(Gtk2::TreePath -> new("2:0"), $view_column); $view -> remove_column($view -> get_column(0)); $view -> remove_column($_) foreach ($view -> get_columns()); is($view -> get_columns(), undef); ############################################################################### isa_ok($view -> get_hadjustment(), "Gtk2::Adjustment"); isa_ok($view -> get_vadjustment(), "Gtk2::Adjustment"); my $h_adjustment = Gtk2::Adjustment -> new(0, 0, 100, 5, 20, 40); my $v_adjustment = Gtk2::Adjustment -> new(0, 0, 100, 5, 20, 40); $view -> set_hadjustment($h_adjustment); $view -> set_vadjustment($v_adjustment); is($view -> get_hadjustment(), $h_adjustment); is($view -> get_vadjustment(), $v_adjustment); $view -> set_headers_visible(1); is($view -> get_headers_visible(), 1); $view -> set_headers_clickable(1); SKIP: { skip "new 2.10 stuff", 1 unless Gtk2 -> CHECK_VERSION(2, 10, 0); is($view -> get_headers_clickable(), 1); } $view -> set_rules_hint(1); is($view -> get_rules_hint(), 1); $view -> set_reorderable(1); is($view -> get_reorderable(), 1); $view -> set_enable_search(1); is($view -> get_enable_search(), 1); $view -> set_search_column(1); is($view -> get_search_column(), 1); isa_ok($view -> get_bin_window(), "Gtk2::Gdk::Window"); isa_ok($view -> get_visible_rect(), "Gtk2::Gdk::Rectangle"); $view -> columns_autosize(); ############################################################################### $path = Gtk2::TreePath -> new("1:1"); $view -> expand_all(); is($view -> row_expanded($path), 1); SKIP: { skip("expand_to_path is new in 2.2.x", 1) unless Gtk2->CHECK_VERSION (2, 2, 0); $view -> expand_to_path($path); is($view -> row_expanded($path), 1); } $view -> collapse_row($path); ok(!$view -> row_expanded($path)); $view -> expand_row($path, 0); ok($view -> row_expanded($path)); my $call_count = 0; $view -> map_expanded_rows(sub { my ($view, $path) = @_; return if $call_count++; isa_ok($view, "Gtk2::TreeView"); isa_ok($path, "Gtk2::TreePath"); is($view -> row_expanded($path), 1); }); SKIP: { skip 'map_expanded_rows callback was not called', 3 unless $call_count++; } $view -> collapse_all(); ok(!$view -> row_expanded($path)); ############################################################################### # set_search_equal_func SKIP: { skip 'set_search_equal_func test; need set_search_entry', 5 unless Gtk2 -> CHECK_VERSION(2, 10, 0); my ($window, $view, $model) = setup(); my $been_here = 0; $view -> set_search_equal_func(sub { return if $been_here++; my ($callback_model, $column, $key, $iter, $data) = @_; is($callback_model, $model); is($column, 0); is($key, 'test'); isa_ok($iter, 'Gtk2::TreeIter'); is($data, undef); return 1; }); my $entry = Gtk2::Entry -> new(); $view -> set_search_entry($entry); $entry -> set_text ('test'); run_main sub { $view -> signal_emit('start_interactive_search') }; SKIP: { skip 'set_search_equal_func callback was not called', 5 unless $been_here++; } $view -> set_search_equal_func(sub {}); } # set_search_position_func SKIP: { skip("new 2.10 stuff", 3) unless Gtk2 -> CHECK_VERSION(2, 10, 0); my ($window, $view, $model) = setup(); $window -> show_all(); my $been_here = 0; $view -> set_search_position_func(sub { return if $been_here++; my ($callback_view, $widget, $data) = @_; is($callback_view, $view); isa_ok($widget, 'Gtk2::Widget'); is($data, undef); }); run_main sub { $view -> signal_emit('start_interactive_search') }; SKIP: { skip 'set_search_position_func callback was not called', 3 unless $been_here++; } $view -> set_search_position_func(undef); } ############################################################################### # FIXME $view -> set_column_drag_function(sub { return 1; }); $view -> set_column_drag_function(undef); ############################################################################### SKIP: { # NOTE: the skip count here includes 2 for each tested accessor and # three for the row separator callback. skip "new toys in 2.6", 9 unless Gtk2->CHECK_VERSION (2, 6, 0); # here are a few new properties which default to off; let's check # the accessors & mutators by turning them on and then back off, # to avoid disrupting the tests that follow. foreach my $thing (qw(fixed_height_mode hover_selection hover_expand)) { my $setter = "set_$thing"; my $getter = "get_$thing"; $view->$setter (1); ok ($view->$getter, $thing); $view->$setter (0); ok (!$view->$getter, $thing); } my $i_know_this_place = 0; $view->set_row_separator_func (sub { my ($model, $iter, $data) = @_; return FALSE if ($i_know_this_place++); isa_ok ($model, 'Gtk2::TreeModel'); isa_ok ($iter, 'Gtk2::TreeIter'); isa_ok ($data, 'HASH'); my $path = $model->get_path ($iter); return 1 == ($path->get_indices)[0]; }, {thing=>'foo'}); # trigger the callback $view->insert_column_with_attributes (0, "", Gtk2::CellRendererText->new, text => 0); run_main; $view->remove_column ($view->get_column (0)); SKIP: { skip 'set_row_separator_func callback was not called', 3 unless $i_know_this_place++; } $view->set_row_separator_func (undef); } SKIP: { skip("new 2.8 stuff", 2) unless Gtk2 -> CHECK_VERSION(2, 8, 0); # get_visible_range() doesn't like to be called with no data and # no columns; you get a failed assertion about the node being null # in _gtk_tree_view_find_path(). So, add some data and a column. my $m = $view->get_model (); $m->set ($m->append (undef), 0, $_) foreach qw(one two three four five); $view->insert_column_with_attributes (0, "", Gtk2::CellRendererText->new, text => 0); Gtk2->main_iteration () while Gtk2->events_pending (); my ($start, $end) = $view -> get_visible_range(); isa_ok($start, "Gtk2::TreePath"); isa_ok($end, "Gtk2::TreePath"); # Remove this column to keep from confusing some of the later tests, # which expect the view to have no columns. $view->remove_column ($view->get_column (0)); } SKIP: { skip("new 2.10 stuff", 4) unless Gtk2 -> CHECK_VERSION(2, 10, 0); my $entry = Gtk2::Entry -> new(); $view -> set_search_entry($entry); isa_ok($view -> get_search_entry(), "Gtk2::Entry"); $view -> set_rubber_banding(TRUE); ok($view -> get_rubber_banding()); $view -> set_grid_lines("both"); is($view -> get_grid_lines(), "both"); $view -> set_enable_tree_lines(FALSE); ok(!$view -> get_enable_tree_lines()); } SKIP: { skip "new 2.12 stuff", 15 unless Gtk2 -> CHECK_VERSION(2, 12, 0); my ($window, $view, $model, $view_column) = setup(); $window -> show_all(); $view -> set_show_expanders(TRUE); ok($view -> get_show_expanders()); $view -> set_level_indentation(23); is($view -> get_level_indentation(), 23); foreach my $converter (qw/convert_widget_to_tree_coords convert_tree_to_widget_coords convert_widget_to_bin_window_coords convert_bin_window_to_widget_coords convert_tree_to_bin_window_coords convert_bin_window_to_tree_coords/) { my ($x, $y) = $view -> $converter(0, 0); ok(defined $x && defined $y, $converter); } is($view -> is_rubber_banding_active(), FALSE); $window->set (tooltip_markup => "Bla!"); my $times_tooltip_queried = 0; my $sid = $window->signal_connect (query_tooltip => sub { my ($window, $x, $y, $keyboard_mode, $tip) = @_; return TRUE if $times_tooltip_queried++; my $path = Gtk2::TreePath -> new_from_indices(0); $view->set_tooltip_row ($tip, $path); $view->set_tooltip_cell ($tip, $path, $view_column, $cell_renderer); my ($bx, $by, $model, $tpath, $iter) = $view->get_tooltip_context (0, 0, TRUE); is ($bx, 0); is ($by, 0); isa_ok ($model, 'Gtk2::TreeModel'); isa_ok ($tpath, 'Gtk2::TreePath'); isa_ok ($iter, 'Gtk2::TreeIter'); $view->set_tooltip_column (1); is ($view->get_tooltip_column, 1); return TRUE; }); my $event = Gtk2::Gdk::Event->new ('motion-notify'); $event->window ($window->window); Gtk2->main_do_event ($event); Gtk2->main_do_event ($event); Gtk2->main_do_event ($event); Gtk2->main_do_event ($event); Gtk2->main_do_event ($event); run_main; SKIP: { skip 'query_tooltip was not called', 6 unless $times_tooltip_queried++; } $window->signal_handler_disconnect ($sid); } ############################################################################### my $i_know_this_place = 0; $cell_renderer = Gtk2::CellRendererToggle -> new(); $view_column = Gtk2::TreeViewColumn -> new_with_attributes("Blab", $cell_renderer); $view_column -> set_cell_data_func($cell_renderer, sub { my ($view_column, $cell, $model, $iter) = @_; return if ($i_know_this_place++); $view_column -> cell_set_cell_data($model, $model -> get_iter_first(), 1, 1); my ($x_offset, $y_offset, $width, $height, $cell_area) = $view_column -> cell_get_size(); like($x_offset, qr/^\d+$/); like($y_offset, qr/^\d+$/); like($width, qr/^\d+$/); like($height, qr/^\d+$/); isa_ok($cell_area, "Gtk2::Gdk::Rectangle"); isa_ok($view_column, "Gtk2::TreeViewColumn"); isa_ok($cell, "Gtk2::CellRendererToggle"); isa_ok($model, "Gtk2::TreeStore"); isa_ok($iter, "Gtk2::TreeIter"); SKIP: { skip("focus_cell is new in 2.2.x", 2) unless Gtk2->CHECK_VERSION (2, 2, 0); $view_column -> focus_cell($cell); is(($view_column -> cell_get_position($cell))[0], 0); like(($view_column -> cell_get_position($cell))[1], qr/^\d+$/); } $cell -> set_fixed_size(23, 42); is(($cell -> get_fixed_size())[0], 23); is(($cell -> get_fixed_size())[1], 42); }); $view -> append_column($view_column); SKIP: { skip("set_cursor_on_cell is new in 2.2.x", 2) unless Gtk2->CHECK_VERSION (2, 2, 0); $view -> expand_all(); $view -> set_cursor_on_cell(Gtk2::TreePath -> new("1:1"), $view_column, $cell_renderer, 0); is(($view -> get_cursor())[0] -> to_string(), "1:1"); is(($view -> get_cursor())[1], $view_column); } $view->scroll_to_point (0, 0); $view->set_cursor_on_cell (Gtk2::TreePath->new ("1:1"), undef, undef, 0) if Gtk2->CHECK_VERSION (2, 2, 0); my $invoke_count = 0; $view->signal_connect (button_press_event => sub { my ($v, $e) = @_; return if $invoke_count++; my @res = $view->get_path_at_pos ($e->x, $e->y); isa_ok ($res[0], 'Gtk2::TreePath', 'get_path_at_pos, path'); isa_ok ($res[1], 'Gtk2::TreeViewColumn', 'get_path_at_pos, col'); ok (defined $res[2] && defined $res[3], 'get_path_at_pos, pos'); my $path = $view->get_path_at_pos ($e->x, $e->y); isa_ok ($path, 'Gtk2::TreePath', 'get_path_at_pos in scalar context, path'); @res = $view->tree_to_widget_coords (10, 10); is (scalar (@res), 2, 'tree_to_widget_coords, num returns'); @res = $view->widget_to_tree_coords (@res); is (scalar (@res), 2, 'tree_to_widget_coords, num returns'); ok (eq_array (\@res, [10, 10]), 'tree_to_widget_coords -> widget_to_tree_coords'); }); my $event = Gtk2::Gdk::Event->new ('button-press'); run_main sub { $view->signal_emit ('button_press_event', $event) }; __END__ Copyright (C) 2003-2006 by the gtk2-perl team (see the file AUTHORS for the full list). See LICENSE for more information. Gtk2-1.24992/t/GtkCellRendererAccel.t0000644000175000017500000000077413076462676015546 0ustar lacklack#!/usr/bin/perl -w # vim: set ft=perl : use strict; use Gtk2::TestHelper tests => 3, noinit => 1, at_least_version => [2, 10, 0, "Gtk2::CellRendererAccel is new in 2.10"]; my $cell = Gtk2::CellRendererAccel->new; isa_ok ($cell, 'Gtk2::CellRendererAccel'); isa_ok ($cell, 'Gtk2::CellRenderer'); $cell->set (accel_mode => 'other'); is ($cell->get ('accel_mode'), 'other'); __END__ Copyright (C) 2006 by the gtk2-perl team (see the file AUTHORS for the full list). See LICENSE for more information. Gtk2-1.24992/t/GtkBuildableIface.t0000644000175000017500000002271613076462676015063 0ustar lacklack#!/usr/bin/perl # vim: set filetype=perl expandtab softtabstop=4 shiftwidth=4 : use strict; use warnings; use Gtk2::TestHelper tests => 92, at_least_version => [2, 12, 0, 'GtkBuildable appeared in 2.12']; my $builder = Gtk2::Builder->new (); my $ui = < 7 ftang left FALSE thing1 purple in Woohoo <b>Bold text</b> TRUE EOD $builder->add_from_string ($ui); $builder->connect_signals (); my $thing1 = $builder->get_object ('thing1'); isa_ok ($thing1, 'TestThing'); is ($thing1->get_name(), 'thing1'); is ($thing1->get ('a'), 7); is ($thing1->get ('b'), 'ftang'); is ($thing1->get ('c'), 'left'); $thing1->changed (); sub on_thing1_changed { my $thing = shift; ok (1, "on_thing1_changed connected correctly"); isa_ok ($thing, 'TestThing'); } my $view1 = $builder->get_object ('view1'); isa_ok ($view1, 'TestThingView'); # TestThingView doesn't directly implement Gtk2::Buildable, thus it's not first # in the @ISA chain. So get_name() alone actually resolves to # Gtk2::Widget::get_name(), which breaks things as of gtk+ commit # 46f5ee1d0c0f4601853ed57e99b1b513f1baa445. So fully qualify the method. is ($view1->Gtk2::Buildable::get_name (), 'view1'); ok (! $view1->get ('visible')); is ($view1->get ('thing'), $thing1); is ($view1->get ('color-string'), 'purple'); my $fancything = $builder->get_object ('fancy-thing'); isa_ok ($fancything, 'TestComplexThing'); is ($fancything->get_name (), 'fancy-thing'); use Data::Dumper; print Dumper($fancything); is ($fancything->{options}{x}, 10); is ($fancything->{options}{y}, 15); is ($fancything->{options}{z}, 20); is ($fancything->{selected}, 'y'); my $fancywidget = $builder->get_object ('fancy-widget'); isa_ok ($fancywidget, 'TestComplexWidget'); is ($fancywidget->get_name (), 'fancy-widget'); package TestThing; use strict; use warnings; use Gtk2; use Test::More; use Glib ':constants'; BEGIN { Glib::Type->register_enum ('TestThing::Stuff', qw( left right top bottom )); } use Glib::Object::Subclass Glib::Object::, signals => { changed => {}, }, properties => [ Glib::ParamSpec->int ('a', 'A', 'A', 1, 10, 5, G_PARAM_READWRITE), Glib::ParamSpec->string ('b', 'B', 'B', "whee", G_PARAM_READWRITE), Glib::ParamSpec->enum ('c', 'C', 'C', 'TestThing::Stuff', 'top', G_PARAM_READWRITE), ], interfaces => [ Gtk2::Buildable::, ], ; sub changed { my $self = shift; $self->signal_emit ('changed'); } package TestThingView; use strict; use warnings; use Gtk2; use Test::More; use Glib ':constants'; use Glib::Object::Subclass Gtk2::Table::, signals => { }, properties => [ Glib::ParamSpec->object ('thing', 'Thing', 'The Thing', TestThing::, G_PARAM_READWRITE), Glib::ParamSpec->string ('color-string', 'Color String', 'duh', "red", G_PARAM_READWRITE), ], # NOTE: we DON't implement Buildable here, we inherit it from Gtk2::Widget ; package TestComplexThing; use strict; use warnings; use Gtk2; use Test::More; use Glib ':constants'; use Glib::Object::Subclass Glib::Object::, signals => { }, properties => [ ], # Here we'll override some of the interface methods directly interfaces => [ Gtk2::Buildable::, ], ; sub SET_NAME { my ($self, $name) = @_; $self->{name} = $name; } sub GET_NAME { my $self = shift; return $self->{name}; } sub ADD_CHILD { my ($self, $builder, $child, $type) = @_; print "ADD_CHILD $child\n"; } sub SET_BUILDABLE_PROPERTY { print "SET_BUILDABLE_PROPERTY\n"; } { package TestComplexThing::OptionParser; use strict; use warnings; sub new { my $class = shift; return bless { @_ }, $class; } sub START_ELEMENT { my ($self, $context, $tagname, $attributes) = @_; print "START_ELEMENT $tagname name=\"$attributes->{name}\"\n"; print " ".$context->get_element."\n"; print " ".join(":", $context->get_position)."\n"; print " ".join("/", reverse $context->get_element_stack)."\n" if $context->can ('get_element_stack'); $self->{tagname} = $tagname; $self->{attributes} = $attributes; } sub TEXT { my ($self, $context, $text) = @_; print "TEXT ".$self->{tagname}."\n"; $self->{text} = '' if not defined $self->{text}; $self->{text} .= $text; } sub END_ELEMENT { print "END_ELEMENT ".$_[0]{tagname}."\n"; } sub DESTROY { print "DESTROY ".$_[0]{tagname}."\n"; } } sub CUSTOM_TAG_START { my ($self, $builder, $child, $tagname) = @_; print "CUSTOM_TAG_START $tagname\n"; isa_ok ($self, TestComplexThing::); isa_ok ($self, Gtk2::Buildable::); isa_ok ($self, Glib::Object::); isa_ok ($builder, Gtk2::Builder::); ok (not defined $child); is ($tagname, 'option'); return TestComplexThing::OptionParser->new (); } sub CUSTOM_TAG_END { my ($self, $builder, $child, $tagname, $parser) = @_; print "CUSTOM_TAG_END $tagname\n"; isa_ok ($self, TestComplexThing::); isa_ok ($builder, Gtk2::Builder::); ok (not defined $child); is ($tagname, 'option'); isa_ok ($parser, TestComplexThing::OptionParser::); $self->{options}{$parser->{attributes}{name}} = $parser->{text}; $self->{selected} = $parser->{attributes}{name} if $parser->{attributes}{selected}; } sub CUSTOM_FINISHED { my ($self, $builder, $child, $tagname, $parser) = @_; print "CUSTOM_FINISHED $tagname\n"; isa_ok ($self, TestComplexThing::); isa_ok ($builder, Gtk2::Builder::); ok (not defined $child); is ($tagname, 'option'); isa_ok ($parser, TestComplexThing::OptionParser::); } sub PARSER_FINISHED { my ($self, $builder) = @_; print "PARSER_FINISHED\n"; } sub GET_INTERNAL_CHILD { my ($self, $builder, $childname) = @_; print "GET_INTERNAL_CHILD $childname\n"; return undef; } package TestComplexWidget; use strict; use warnings; use Gtk2; use Test::More; use Glib ':constants'; use Glib::Object::Subclass Gtk2::Frame::, signals => { }, properties => [ ], # Here we'll override some of the interface methods directly interfaces => [ Gtk2::Buildable::, ], ; sub SET_NAME { my ($self, $name) = @_; isa_ok ($self, TestComplexWidget::); isa_ok ($self, Gtk2::Buildable::); isa_ok ($self, Gtk2::Frame::); $self->{name} = $name; } sub GET_NAME { my $self = shift; isa_ok ($self, TestComplexWidget::); isa_ok ($self, Gtk2::Buildable::); isa_ok ($self, Gtk2::Frame::); return $self->{name}; } sub ADD_CHILD { my ($self, $builder, $child, $type) = @_; isa_ok ($self, TestComplexWidget::); isa_ok ($self, Gtk2::Buildable::); isa_ok ($self, Gtk2::Frame::); isa_ok ($builder, Gtk2::Builder::); isa_ok ($child, Gtk2::Widget::); if (defined ($type)) { if ($type eq 'label') { $self->set_label_widget ($child); } else { ok (0, "Unknown internal child type"); } } else { $self->add ($child); } } sub SET_BUILDABLE_PROPERTY { my ($self, $builder, $name, $value) = @_; isa_ok ($self, TestComplexWidget::); isa_ok ($self, Gtk2::Buildable::); isa_ok ($self, Gtk2::Frame::); isa_ok ($builder, Gtk2::Builder::); ok (defined $name); $self->set ($name, $value); } # --------------------------------------------------------------------------- # # GET_INTERNAL_CHILD() returning undef for no such internal child { my $get_internal_child = 0; { package MyWidget; use Glib::Object::Subclass 'Gtk2::Widget', interfaces => [ 'Gtk2::Buildable' ]; sub GET_INTERNAL_CHILD { $get_internal_child = 1; return undef; } } my $builder = Gtk2::Builder->new; eval { $builder->add_from_string (<<'HERE'); HERE }; my $err = $@; is ($get_internal_child, 1, 'GET_INTERNAL_CHILD returning undef - iface func called'); isnt ($@, '', 'GET_INTERNAL_CHILD returning undef - builder throws an error'); isa_ok ($err, 'Glib::Error', 'GET_INTERNAL_CHILD returning undef - builder error is a GError'); } Gtk2-1.24992/t/01.GtkWindow.t0000644000175000017500000002134313076462676013731 0ustar lacklack#!/usr/bin/perl # # $Id$ # ######################### # GtkWindow Tests # - rm ######################### ######################### use Gtk2::TestHelper tests => 120; ok( my $win = Gtk2::Window->new ); ok( $win = Gtk2::Window->new('popup') ); ok( $win = Gtk2::Window->new('toplevel') ); $win->set_title; ok(1); $win->set_title(undef); ok(1); $win->set_title(''); ok(1); $win->set_title('Test Window'); ok(1); is( $win->get_title, 'Test Window' ); $win->set_resizable(TRUE); ok(1); ok( $win->get_resizable ); $win->set_modal(TRUE); ok(1); ok( $win->get_modal ); $win->set_default_size(640, 480); ok(1); # the window manager needn't honor our request, but the # widget should be holding the values and the bindings # should return them correctly. my @s = $win->get_default_size; ok( $s[0] == 640 && $s[1] == 480 ); my $geometry = { min_width => 10, min_height => 10 }; my $label = Gtk2::Label->new("Bla"); $win->set_geometry_hints($label, $geometry); ok(1); $win->set_geometry_hints($label, $geometry, undef); ok(1); $win->set_geometry_hints($label, $geometry, qw(min-size)); ok(1); foreach (qw/north-west north north-east west center east south-west south south-east static/) { $win->set_gravity($_); ok(1); is( $win->get_gravity , $_, "gravity $_" ); } foreach (qw/none center mouse center-always center-on-parent/) { $win->set_position($_); ok(1, "set_position $_"); } $win->set_position('center'); ok(1); my @position = $win->get_position; is(scalar(@position), 2); ok( my $win2 = Gtk2::Window->new ); $win2->set_transient_for($win); ok(1); is( $win2->get_transient_for, $win ); $win2->set_destroy_with_parent(TRUE); ok(1); ok( $win2->get_destroy_with_parent ); my @toplvls = Gtk2::Window->list_toplevels; is(scalar(@toplvls), 4); use Gtk2::Gdk::Keysyms; my $mnemonic = $Gtk2::Gdk::Keysyms{ KP_Enter }; $win2->add_mnemonic($mnemonic, $label); ok(1); ok( defined $win2->mnemonic_activate($mnemonic, "shift-mask") ); SKIP: { skip "activate_key and propagate_key_event are new in 2.4", 2 unless Gtk2->CHECK_VERSION (2, 4, 0); my $event = Gtk2::Gdk::Event::Key->new ("key-press"); $event->keyval ($Gtk2::Gdk::Keysyms{ A }); ok ( ! $win2->activate_key ($event) ); ok ( ! $win2->propagate_key_event ($event) ); } $win2->remove_mnemonic($mnemonic, $label); ok(1); $win2->set_mnemonic_modifier("control-mask"); ok(1); is_deeply(\@{ $win2->get_mnemonic_modifier }, ["control-mask"]); $win2->set_focus; ok(1); $win2->set_focus(Gtk2::Entry->new()); ok(1); my $button = Gtk2::Button->new ('i can default!'); $button->can_default (TRUE); $win2->set_default($button); $win2->set_decorated(TRUE); ok(1); ok( $win2->get_decorated ); $win2->set_has_frame(FALSE); ok(1); ok( !$win2->get_has_frame ); $win2->set_role('tool'); ok(1); is( $win2->get_role, 'tool' ); foreach (qw/normal dialog menu toolbar/) { $win2->set_type_hint($_); ok(1); is( $win2->get_type_hint, $_ ); } SKIP: { skip 'stuff missing in 2.0.x', 6 unless Gtk2->CHECK_VERSION (2, 2, 0); foreach (qw/splashscreen utility dock desktop/) { $win2->set_type_hint($_); is( $win2->get_type_hint, $_ ); } SKIP: { skip 'taskbar stuff missing on windows', 1 if $^O eq 'MSWin32'; $win2->set_skip_taskbar_hint('true'); ok( $win2->get_skip_taskbar_hint ); } $win2->set_skip_pager_hint('true'); ok( $win2->get_skip_pager_hint ); } ok( ! $win->get_default_icon_list ); # need pixbufs #$win->set_default_icon_list(...) # need file #$win->set_default_icon_from_file(...) # need a pixbuf #$win->set_icon($pixbuf); # doesn't have an icon ^ ok( ! $win->get_icon ); # doesn't have an icon ^ ok( ! $win->get_icon_list ); my $accel_group = Gtk2::AccelGroup->new; $win->add_accel_group ($accel_group); $win->remove_accel_group ($accel_group); # we can set this here, but we'll have to wait until events have # been handled to check them. see the run_main block, below. $win->set_frame_dimensions(0, 0, 300, 500); ok( $win2->parse_geometry("100x100+10+10") ); SKIP: { skip 'set_auto_startup_notification is new in 2.2', 0 unless Gtk2->CHECK_VERSION(2, 2, 0); $win2->set_auto_startup_notification(FALSE); } $win->show; ok(1); run_main sub { $win2->show; # there are no widgets, so this should fail ok( ! $win->activate_focus ); # there are no widgets, so this should fail ok( ! $win->activate_default ); # there are no widgets, so this should fail ok( ! $win->get_focus ); $win->present; ok(1); $win->iconify; ok(1); # doesnt work no error message $win->deiconify; ok(1); $win->stick; ok(1); $win->unstick; ok(1); # doesnt work no error message $win->maximize; ok(1); # doesnt work no error message $win->unmaximize; ok(1); # gtk2.2 req SKIP: { my $reason; if ($^O eq 'MSWin32') { $reason = 'GdkScreen not available on win32'; } elsif (!Gtk2->CHECK_VERSION (2, 2, 0)) { $reason = 'stuff not available before 2.2.x'; } else { $reason = undef; } skip $reason, 1 if defined $reason; $win->set_screen(Gtk2::Gdk::Screen->get_default()); is($win->get_screen, Gtk2::Gdk::Screen->get_default()); $win->fullscreen; $win->unfullscreen; } SKIP: { skip "new things in 2.4", 3 unless Gtk2->CHECK_VERSION (2, 4, 0); like($win->is_active, qr/^(1|)$/); like($win->has_toplevel_focus, qr/^(1|)$/); $win->set_keep_above (1); $win->set_keep_below (1); $win->set_accept_focus (1); is ($win->get_accept_focus, 1); $win->set_default_icon (Gtk2::Gdk::Pixbuf->new ("rgb", 0, 8, 15, 15)); } # Commented out because there seems to be no way to finish the # drags. We'd be getting stale pointer grabs otherwise. # $win->begin_resize_drag("south-east", 1, 23, 42, 0); # ok(1); # $win->begin_move_drag(1, 23, 42, 0); # ok(1); $win->move(100, 100); # these are widget methods and not window, but they need # testing and this seemed like a good place to do it my $tmp = $win->intersect(Gtk2::Gdk::Rectangle->new(0, 0, 10, 10)); isa_ok( $tmp, 'Gtk2::Gdk::Rectangle' ); $tmp = $win->intersect(Gtk2::Gdk::Rectangle->new(-10, -10, 1, 1)); ok( !$tmp ); $win->resize(480,600); # window managers don't honor our size request exactly, # or at least we aren't guaranteed they will ok( $win->get_size ); ok( $win->get_frame_dimensions ); $win2->reshow_with_initial_size; ok(1); }; my $group = Gtk2::WindowGroup->new; isa_ok( $group, "Gtk2::WindowGroup" ); $group->add_window ($win); $group->remove_window ($win); SKIP: { skip "new 2.6 stuff", 2 unless Gtk2->CHECK_VERSION (2, 6, 0); $win->set_focus_on_map (TRUE); is ($win->get_focus_on_map, TRUE); $win->set_icon_name ("gtk-ok"); is ($win->get_icon_name, "gtk-ok"); Gtk2::Window->set_default_icon_name ("gtk-cancel"); } SKIP: { skip("new 2.8 stuff", 1) unless Gtk2->CHECK_VERSION (2, 8, 0); $win->set_urgency_hint (TRUE); is ($win->get_urgency_hint, TRUE); $win->present_with_time (time); } SKIP: { skip("new 2.10 stuff", 2) unless Gtk2->CHECK_VERSION (2, 10, 0); $win->set_deletable (TRUE); is ($win->get_deletable, TRUE); isa_ok ($win->get_group, "Gtk2::WindowGroup"); } SKIP: { skip("new 2.12 stuff", 1) unless Gtk2->CHECK_VERSION (2, 12, 0); $win->set_startup_id('Start me!'); $win->set_opacity (0.5); is ($win->get_opacity, 0.5); } SKIP: { skip 'new 2.14 stuff', 4 unless Gtk2->CHECK_VERSION(2, 14, 0); my $window = Gtk2::Window->new (); is ($window->get_default_widget (), undef); my $widget = Gtk2::Entry->new (); $widget->set (can_default => TRUE); $window->set_default ($widget); is ($window->get_default_widget (), $widget); my $group = Gtk2::WindowGroup->new (); $group->add_window (Gtk2::Window->new ()); $group->add_window (Gtk2::Window->new ()); $group->add_window (Gtk2::Window->new ()); my @list = $group->list_windows (); is (scalar @list, 3); isa_ok ($list[0], 'Gtk2::Window'); } SKIP: { skip 'new 2.16 stuff', 2 unless Gtk2->CHECK_VERSION(2, 16, 0); Gtk2::Window->set_default_icon_name (undef); is (Gtk2::Window->get_default_icon_name,undef, '[gs]et_default_icon_name with undef'); Gtk2::Window->set_default_icon_name ('gtk-ok'); is (Gtk2::Window->get_default_icon_name,'gtk-ok', 'get_default_icon_name'); } SKIP: { skip 'new 2.20 stuff', 2 unless Gtk2->CHECK_VERSION(2, 20, 0); my $window = Gtk2::Window->new; is ($window->get_window_type, 'toplevel'); $window->set_mnemonics_visible (TRUE); ok ($window->get_mnemonics_visible); } SKIP: { skip 'new 2.22 stuff', 2 unless Gtk2->CHECK_VERSION(2, 22, 0); my $window = Gtk2::Window->new; my $group = Gtk2::WindowGroup->new (); $group->add_window ($window); ok ($window->has_group); my $grab = $group->get_current_grab; ok ((defined $grab && $grab->isa ('Gtk2::Widget')) || !defined $grab); } __END__ Copyright (C) 2003-2006 by the gtk2-perl team (see the file AUTHORS for the full list). See LICENSE for more information. Gtk2-1.24992/t/GtkCheckMenuItem.t0000644000175000017500000000154613076462676014727 0ustar lacklack#!/usr/bin/perl -w use strict; use Gtk2::TestHelper tests => 7; # $Id$ my $item = Gtk2::CheckMenuItem -> new(); isa_ok($item, "Gtk2::CheckMenuItem"); $item = Gtk2::CheckMenuItem -> new("_Bla"); isa_ok($item, "Gtk2::CheckMenuItem"); $item = Gtk2::CheckMenuItem -> new_with_label("Bla"); isa_ok($item, "Gtk2::CheckMenuItem"); $item = Gtk2::CheckMenuItem -> new_with_mnemonic("Bla"); isa_ok($item, "Gtk2::CheckMenuItem"); $item -> set_active(1); is($item -> get_active(), 1); $item -> toggled(); $item -> set_inconsistent(1); is($item -> get_inconsistent(), 1); SKIP: { skip("[sg]et_draw_as_radio are new in 2.4", 1) unless Gtk2->CHECK_VERSION (2, 4, 0); $item -> set_draw_as_radio(1); is($item -> get_draw_as_radio(), 1); } __END__ Copyright (C) 2003 by the gtk2-perl team (see the file AUTHORS for the full list). See LICENSE for more information. Gtk2-1.24992/t/GtkInfoBar.t0000644000175000017500000000334113076462677013562 0ustar lacklack#!/usr/bin/perl # vim: set syntax=perl : # # $Id$ # # GtkInfoBar Tests use Gtk2::TestHelper tests => 15, at_least_version=> [2,18,0]; ok( my $win = Gtk2::Window->new('toplevel') ); my $infobar=Gtk2::InfoBar->new; isa_ok ($infobar, 'Gtk2::InfoBar', 'new'); $win->add($infobar); isa_ok ($infobar->get_action_area, 'Gtk2::Widget','get_action_area'); isa_ok ($infobar->get_content_area, 'Gtk2::Widget','get_content_area'); isa_ok( $infobar->add_button(test3=>3), 'Gtk2::Widget', 'add_button'); is( button_count($infobar), 1, 'add_button count'); $infobar->add_buttons(test4=>4,test5=>5); is( button_count($infobar), 3, 'add_buttons'); my $button=Gtk2::Button->new("action_widget"); $infobar->add_action_widget($button, 6); is( button_count($infobar), 4, 'add_action_widget'); my $infobar2=Gtk2::InfoBar->new( 'gtk-ok' => 'ok', 'test2' => 2, ); isa_ok ($infobar2, 'Gtk2::InfoBar', 'new_with_buttons'); is( button_count($infobar2), 2, 'new_with_buttons buttons count'); $infobar->set_response_sensitive(6,FALSE); is( $button->is_sensitive, FALSE, 'set_response_sensitive'); $infobar->set_message_type('error'); is( $infobar->get_message_type, 'error', '[gs]et_message_type'); $infobar->set_default_response(4); ok( 1,'set_default_response'); $infobar->signal_connect( response => sub { my ($infobar,$response)=@_; my $expected=$infobar->{expected_response}; ok( $response eq $expected, "response '$expected'" ); 1; }); $infobar->response( $infobar->{expected_response}=5 ); $infobar->response( $infobar->{expected_response}='ok' ); sub button_count { my @b=$_[0]->get_action_area->get_children; return scalar @b; } __END__ Copyright (C) 2010 by the gtk2-perl team (see the file AUTHORS for the full list). See LICENSE for more information. Gtk2-1.24992/t/GtkBuilder.t0000644000175000017500000001306613076462676013634 0ustar lacklack#!/usr/bin/perl use strict; use warnings; use Gtk2::TestHelper tests => 45, at_least_version => [2, 12, 0, 'GtkBuildable: it appeared in 2.12']; # $Id$ use File::Temp qw(tempdir); my $dir = tempdir(CLEANUP => 1); my $builder; my $ui = < 0 5 1 5 True adjustment1 EOD # --------------------------------------------------------------------------- # my $ui_file = "$dir/tmp.ui"; open my $fh, '>', $ui_file or plan skip_all => 'unable to create ui file'; print $fh $ui; close $fh; $builder = Gtk2::Builder->new; isa_ok ($builder, 'Gtk2::Builder'); eval { $builder->add_from_file ('bla.ui'); }; like ($@, qr/bla\.ui/); eval { ok ($builder->add_from_file ($ui_file) > 0); }; is ($@, ''); isa_ok ($builder->get_object ('adjustment1'), 'Gtk2::Adjustment'); $builder->set_translation_domain (undef); is ($builder->get_translation_domain, undef); $builder->set_translation_domain ('de'); is ($builder->get_translation_domain, 'de'); SKIP: { skip 'new 2.14 stuff', 8 unless Gtk2->CHECK_VERSION (2, 14, 0); my $builder = Gtk2::Builder->new; eval { ok ($builder->add_objects_from_file ($ui_file, qw/adjustment1 spinbutton1/)); }; is ($@, ''); ok (defined $builder->get_object ('adjustment1') && defined $builder->get_object ('spinbutton1')); eval { $builder->add_objects_from_file ('bla.ui', qw/adjustment1 spinbutton1/); }; like ($@, qr/bla\.ui/); $builder = Gtk2::Builder->new; eval { ok ($builder->add_objects_from_string ($ui, qw/adjustment1 spinbutton1/)); }; is ($@, ''); ok (defined $builder->get_object ('adjustment1') && defined $builder->get_object ('spinbutton1')); eval { $builder->add_objects_from_string ('', qw/adjustment1 spinbutton1/); }; like ($@, qr/bla/); } # --------------------------------------------------------------------------- # $builder = Gtk2::Builder->new; eval { $builder->add_from_string (''); }; like ($@, qr/bla/); eval { ok ($builder->add_from_string ($ui) > 0); }; is ($@, ''); my @objects = sort { ref $a cmp ref $b } $builder->get_objects; isa_ok ($objects[0], 'Gtk2::Adjustment'); isa_ok ($objects[1], 'Gtk2::SpinButton'); $builder->connect_signals_full(sub { my ($builder, $object, $signal_name, $handler_name, $connect_object, $flags, $data) = @_; if ($signal_name ne 'value-changed') { return; } isa_ok ($builder, 'Gtk2::Builder'); isa_ok ($object, 'Gtk2::SpinButton'); is ($signal_name, 'value-changed'); is ($handler_name, 'value_changed'); isa_ok ($connect_object, 'Gtk2::Adjustment'); ok ($flags == [ qw/after swapped/ ]); is ($data, 'data'); }, 'data'); # --------------------------------------------------------------------------- # package BuilderTestCaller; use Test::More; # for is(), isa_ok(), etc. use Glib qw/:constants/; sub value_changed { my ($spin, $data) = @_; isa_ok ($spin, 'Gtk2::SpinButton'); isa_ok ($data, 'Gtk2::Adjustment'); } sub wrapped { my ($spin, $data) = @_; isa_ok ($spin, 'Gtk2::SpinButton'); is ($data, '!alb'); } $builder = Gtk2::Builder->new; $builder->add_from_string ($ui); $builder->connect_signals ('!alb'); my $spin = $builder->get_object ('spinbutton1'); $spin->set_wrap (TRUE); $spin->spin ('step-forward', 1); # --------------------------------------------------------------------------- # package BuilderTest; use Test::More; # for is(), isa_ok(), etc. use Glib qw/:constants/; sub value_changed { my ($spin, $data) = @_; isa_ok ($spin, 'Gtk2::SpinButton'); isa_ok ($data, 'Gtk2::Adjustment'); } sub wrapped { my ($spin, $data) = @_; isa_ok ($spin, 'Gtk2::SpinButton'); is ($data, 'bla!'); } $builder = Gtk2::Builder->new; $builder->add_from_string ($ui); $builder->connect_signals ('bla!', 'BuilderTest'); $spin = $builder->get_object ('spinbutton1'); $spin->set_wrap (TRUE); $spin->spin ('step-forward', 1); # --------------------------------------------------------------------------- # package BuilderTestOO; use Test::More; # for is(), isa_ok(), etc. use Glib qw/:constants/; sub value_changed { my ($self, $spin, $data) = @_; is ($self->{answer}, 42); isa_ok ($spin, 'Gtk2::SpinButton'); isa_ok ($data, 'Gtk2::Adjustment'); } sub wrapped { my ($self, $spin, $data) = @_; is ($self->{answer}, 42); isa_ok ($spin, 'Gtk2::SpinButton'); is ($data, 'bla!'); } my $self = bless { answer => 42 }, 'BuilderTestOO'; $builder = Gtk2::Builder->new; $builder->add_from_string ($ui); $builder->connect_signals ('bla!', $self); $spin = $builder->get_object ('spinbutton1'); $spin->set_wrap (TRUE); $spin->spin ('step-forward', 1); # --------------------------------------------------------------------------- # $builder = Gtk2::Builder->new; $builder->add_from_string ($ui); $builder->connect_signals ('!alb', value_changed => \&BuilderTest::value_changed, wrapped => \&BuilderTestCaller::wrapped ); $spin = $builder->get_object ('spinbutton1'); $spin->set_wrap (TRUE); $spin->spin ('step-forward', 1); __END__ Copyright (C) 2007, 2013 by the gtk2-perl team (see the file AUTHORS for the full list). See LICENSE for more information. Gtk2-1.24992/t/GtkMenuShell.t0000644000175000017500000000206013076462677014133 0ustar lacklack#!/usr/bin/perl -w use strict; use Gtk2::TestHelper tests => 3; # $Id$ my $shell = Gtk2::Menu -> new(); isa_ok($shell, "Gtk2::MenuShell"); my $item_one = Gtk2::MenuItem -> new(); my $item_two = Gtk2::MenuItem -> new(); my $item_three = Gtk2::MenuItem -> new(); $item_one -> signal_connect(activate => sub { is(shift(), $item_one); }); $shell -> append($item_one); $shell -> prepend($item_two); $shell -> insert($item_three, 1); $shell -> deactivate(); $shell -> select_item($item_three); $shell -> deselect(); $shell -> activate_item($item_one, 1); SKIP: { skip("select_first is new in 2.2", 0) unless Gtk2->CHECK_VERSION (2, 2, 0); $shell -> select_first(0); } SKIP: { skip("cancel is new in 2.4", 0) unless Gtk2->CHECK_VERSION (2, 4, 0); $shell -> cancel(); } SKIP: { skip("new 2.8 stuff", 1) unless Gtk2->CHECK_VERSION (2, 8, 0); $shell -> set_take_focus(TRUE); ok($shell -> get_take_focus()); } __END__ Copyright (C) 2003-2005 by the gtk2-perl team (see the file AUTHORS for the full list). See LICENSE for more information. Gtk2-1.24992/t/GtkRecentChooserWidget.t0000644000175000017500000000155013076462677016151 0ustar lacklack#!/usr/bin/perl -w use strict; sub on_unthreaded_freebsd { if ($^O eq 'freebsd') { require Config; if ($Config::Config{ldflags} !~ m/-pthread\b/) { return 1; } } return 0; } use Gtk2::TestHelper tests => 4, at_least_version => [2, 10, 0, "GtkRecentChooserWidget"], (on_unthreaded_freebsd () ? (skip_all => 'need a perl compiled with "-pthread" on freebsd') : ()); # $Id$ my $manager = Gtk2::RecentManager -> new(); my $chooser = Gtk2::RecentChooserWidget -> new(); isa_ok($chooser, "Gtk2::RecentChooser"); isa_ok($chooser, "Gtk2::RecentChooserWidget"); $chooser = Gtk2::RecentChooserWidget -> new_for_manager($manager); isa_ok($chooser, "Gtk2::RecentChooser"); isa_ok($chooser, "Gtk2::RecentChooserWidget"); __END__ Copyright (C) 2006 by the gtk2-perl team (see the file AUTHORS for the full list). See LICENSE for more information. Gtk2-1.24992/t/GtkComboBoxEntry.t0000644000175000017500000000246113076462676014775 0ustar lacklack# # $Id$ # use Gtk2::TestHelper at_least_version => [2, 4, 0, "GtkComboBoxEntry is new in 2.4"], tests => 9; my $entry_box; $entry_box = Gtk2::ComboBoxEntry->new; isa_ok ($entry_box, 'Gtk2::ComboBoxEntry'); ginterfaces_ok($entry_box); my $model = Gtk2::ListStore->new (qw/Glib::String Glib::Int Glib::String/); foreach (qw/a b c d e f g/) { $model->set ($model->append, 0, $_, 1, ord($_), 2, ord($_)**2); } $entry_box->set_model ($model); is ($entry_box->get_model, $model); $entry_box->set_text_column (2); is ($entry_box->get_text_column, 2); my $text_column = 1; $entry_box = Gtk2::ComboBoxEntry->new ($model, $text_column); isa_ok ($entry_box, 'Gtk2::ComboBoxEntry'); is ($entry_box->get_text_column, $text_column); $text_column = 0; $entry_box = Gtk2::ComboBoxEntry->new_with_model ($model, $text_column); isa_ok ($entry_box, 'Gtk2::ComboBoxEntry'); is ($entry_box->get_text_column, $text_column); $entry_box->get_child->set_editable (TRUE); $entry_box->get_child->set_text ('whee'); #my $dlg = Gtk2::Dialog->new ('foo', undef, [], 'gtk-cancel' => 'cancel'); #$dlg->vbox->add ($entry_box); # #$dlg->show_all; #$dlg->run; isa_ok (Gtk2::ComboBoxEntry->new_text, 'Gtk2::ComboBoxEntry'); __END__ Copyright (C) 2003 by the gtk2-perl team (see the file AUTHORS for the full list). See LICENSE for more information. Gtk2-1.24992/t/GtkRadioAction.t0000644000175000017500000000330313076462677014434 0ustar lacklack# # $Id$ # use Gtk2::TestHelper at_least_version => [2, 4, 0, "Action-based menus are new in 2.4"], tests => 14, noinit => 1; my @actions = (Gtk2::RadioAction->new (name => 'one', value => 0)); isa_ok ($actions[$#actions], 'Gtk2::RadioAction'); my $i = 1; foreach (qw(two three four five)) { push @actions, Gtk2::RadioAction->new (group => $actions[$#actions], name => $_, value => $i++); isa_ok ($actions[$#actions], 'Gtk2::RadioAction'); } my $group = $actions[0]->get_group; push @actions, Gtk2::RadioAction->new (name => 'six', value => 5); isa_ok ($actions[$#actions], 'Gtk2::RadioAction'); $actions[$#actions]->set_group ($group); { # get_group() no memory leaks in arrayref return and array items my $x = Gtk2::RadioAction->new (name => 'x', value => 0); my $y = Gtk2::RadioAction->new (name => 'y', value => 0); $y->set_group($x); my $aref = $x->get_group; is_deeply($aref, [$x,$y]); require Scalar::Util; Scalar::Util::weaken ($aref); is ($aref, undef, 'get_group() array destroyed by weakening'); Scalar::Util::weaken ($x); is ($x, undef, 'get_group() item x destroyed by weakening'); Scalar::Util::weaken ($y); is ($y, undef, 'get_group() item y destroyed by weakening'); } is ($actions[0]->get_current_value, 0); if (Gtk2->CHECK_VERSION (2, 10, 0)) { $actions[0]->set_current_value (3); } else { $actions[0]->set (value => 3); } is ($actions[0]->get_current_value, 3); $actions[3]->set_active (TRUE); ok (!$actions[0]->get_active); ok ($actions[3]->get_active); __END__ Copyright (C) 2003-2006, 2010 by the gtk2-perl team (see the file AUTHORS for the full list). See LICENSE for more information. Gtk2-1.24992/t/GtkButtonBox.t0000644000175000017500000000114013076462676014160 0ustar lacklack#!/usr/bin/perl -w use strict; use Gtk2::TestHelper tests => 3; # $Id$ my $box = Gtk2::VButtonBox -> new(); isa_ok($box, "Gtk2::ButtonBox"); $box -> set_layout("spread"), is($box -> get_layout(), "spread"); my $button = Gtk2::Button -> new("Bla"); $box -> pack_start_defaults($button); $box -> set_child_secondary($button, 1); SKIP: { skip("get_child_secondary is new in 2.4", 1) unless Gtk2->CHECK_VERSION (2, 4, 0); is($box -> get_child_secondary($button), 1); } __END__ Copyright (C) 2003 by the gtk2-perl team (see the file AUTHORS for the full list). See LICENSE for more information. Gtk2-1.24992/t/PangoCairo.t0000644000175000017500000001000213076462677013606 0ustar lacklack#!/usr/bin/perl -w use strict; use Glib qw/TRUE FALSE/; use Gtk2; use Test::More; if (UNIVERSAL::can("Gtk2::Pango::Cairo::FontMap", "new") && Gtk2::Pango -> CHECK_VERSION(1, 10, 0)) { plan tests => 22; } else { plan skip_all => "PangoCairo stuff: need Cairo and pango >= 1.10.0"; } # $Id$ my $fontmap = Gtk2::Pango::Cairo::FontMap -> new(); isa_ok($fontmap, "Gtk2::Pango::Cairo::FontMap"); isa_ok($fontmap, "Gtk2::Pango::FontMap"); SKIP: { skip 'new 1.18 stuff', 3 unless Gtk2::Pango -> CHECK_VERSION(1, 18, 0); $fontmap = Gtk2::Pango::Cairo::FontMap -> new_for_font_type('ft'); skip 'new_for_font_type returned undef', 3 unless defined $fontmap; isa_ok($fontmap, "Gtk2::Pango::Cairo::FontMap"); isa_ok($fontmap, "Gtk2::Pango::FontMap"); is($fontmap -> get_font_type(), 'ft'); } $fontmap = Gtk2::Pango::Cairo::FontMap -> get_default(); isa_ok($fontmap, "Gtk2::Pango::Cairo::FontMap"); isa_ok($fontmap, "Gtk2::Pango::FontMap"); $fontmap -> set_resolution(72); is($fontmap -> get_resolution(), 72); my $context = $fontmap -> create_context(); isa_ok($context, "Gtk2::Pango::Context"); # Just to make sure this is a valid Gtk2::Pango::FontMap isa_ok(($fontmap -> list_families())[0], "Gtk2::Pango::FontFamily"); my $target = Cairo::ImageSurface -> create("argb32", 100, 100); my $cr = Cairo::Context -> create($target); Gtk2::Pango::Cairo::update_context($cr, $context); my $options = Cairo::FontOptions -> create(); # Function interface { Gtk2::Pango::Cairo::Context::set_font_options($context, $options); isa_ok(Gtk2::Pango::Cairo::Context::get_font_options($context), "Cairo::FontOptions"); Gtk2::Pango::Cairo::Context::set_resolution($context, 72); is(Gtk2::Pango::Cairo::Context::get_resolution($context), 72); } # Method interface { isa_ok($context, "Gtk2::Pango::Cairo::Context"); $context -> set_font_options($options); isa_ok($context -> get_font_options(), "Cairo::FontOptions"); $context -> set_resolution(72); is($context -> get_resolution(), 72); } my $layout = Gtk2::Pango::Cairo::create_layout($cr); isa_ok($layout, "Gtk2::Pango::Layout"); my $line = $layout -> get_line(0); Gtk2::Pango::Cairo::show_layout_line($cr, $line); Gtk2::Pango::Cairo::show_layout($cr, $layout); Gtk2::Pango::Cairo::layout_line_path($cr, $line); Gtk2::Pango::Cairo::layout_path($cr, $layout); Gtk2::Pango::Cairo::update_layout($cr, $layout); # FIXME: pango_cairo_show_glyph_string, pango_cairo_glyph_string_path. SKIP: { skip "error line stuff", 0 unless Gtk2::Pango -> CHECK_VERSION(1, 14, 0); Gtk2::Pango::Cairo::show_error_underline($cr, 23, 42, 5, 5); Gtk2::Pango::Cairo::error_underline_path($cr, 23, 42, 5, 5); } SKIP: { skip 'new 1.18 stuff', 6 unless Gtk2::Pango -> CHECK_VERSION(1, 18, 0); $context -> set_shape_renderer(undef, undef); my $target = Cairo::ImageSurface -> create('argb32', 100, 100); my $cr = Cairo::Context -> create($target); my $layout = Gtk2::Pango::Cairo::create_layout($cr); Gtk2::Pango::Cairo::Context::set_shape_renderer( $layout -> get_context(), sub { my ($cr, $shape, $do_path, $data) = @_; isa_ok($cr, 'Cairo::Context'); isa_ok($shape, 'Gtk2::Pango::AttrShape'); ok(defined $do_path); is($data, 'bla'); }, 'bla'); $layout -> set_text('Bla'); my $ink = { x => 23, y => 42, width => 10, height => 15 }; my $logical = { x => 42, y => 23, width => 15, height => 10 }; my $attr = Gtk2::Pango::AttrShape -> new($ink, $logical, 0, 1); my $list = Gtk2::Pango::AttrList -> new(); $list -> insert($attr); $layout -> set_attributes($list); Gtk2::Pango::Cairo::show_layout($cr, $layout); my $desc = Gtk2::Pango::FontDescription -> from_string('Sans 10'); my $font = $fontmap -> load_font($context, $desc); skip 'could not find font', 2 unless defined $font; isa_ok($font, 'Gtk2::Pango::Cairo::Font'); isa_ok($font -> get_scaled_font(), 'Cairo::ScaledFont'); } __END__ Copyright (C) 2005 by the gtk2-perl team (see the file AUTHORS for the full list). See LICENSE for more information. Gtk2-1.24992/t/GtkSelection.t0000644000175000017500000000714013076462677014170 0ustar lacklack#!/usr/bin/perl -w use strict; use Gtk2::TestHelper tests => 16; # $Id$ my $list = Gtk2::TargetList -> new(); isa_ok($list, "Gtk2::TargetList"); SKIP: { skip "2.10 stuff", 1 unless Gtk2 -> CHECK_VERSION(2, 10, 0); isa_ok($list, "Glib::Boxed"); } $list = Gtk2::TargetList -> new( { target => "STRING", flags => "same-app", info => 23 }, { target => "COMPOUND_TEXT", flags => ["same-app", "same-widget"], info => 42 } ); isa_ok($list, "Gtk2::TargetList"); $list -> add(Gtk2::Gdk->TARGET_BITMAP, ["same-app", "same-widget"], 2); $list -> add_table({ target => "COLORMAP", flags => ["same-app", "same-widget"], info => 3 }); $list -> remove(Gtk2::Gdk->TARGET_BITMAP); is($list -> find(Gtk2::Gdk->TARGET_BITMAP), undef); is($list -> find(Gtk2::Gdk->TARGET_STRING), 23); SKIP: { skip("2.6 stuff", 3) unless Gtk2 -> CHECK_VERSION(2, 6, 0); $list -> add_text_targets(42); $list -> add_image_targets(43, TRUE); $list -> add_uri_targets(44); is($list -> find(Gtk2::Gdk::Atom -> intern("text/plain")), 42); is($list -> find(Gtk2::Gdk::Atom -> intern("image/png")), 43); is($list -> find(Gtk2::Gdk::Atom -> intern("text/uri-list")), 44); } SKIP: { skip("2.10 stuff", 5) unless Gtk2 -> CHECK_VERSION(2, 10, 0); my $buffer = Gtk2::TextBuffer->new; $buffer->register_serialize_format ( 'text/rdf', sub { warn "here"; return 'bla!'; }); $buffer->register_deserialize_format ( 'text/rdf', sub { warn "here"; $_[1]->insert ($_[2], 'bla!'); }); $list -> add_rich_text_targets(45, TRUE, $buffer); is($list -> find(Gtk2::Gdk::Atom -> intern("text/rdf")), 45); my @targets = ( Gtk2::Gdk::Atom -> intern("text/plain"), Gtk2::Gdk::Atom -> intern("text/uri-list"), Gtk2::Gdk::Atom -> intern("image/png"), Gtk2::Gdk::Atom -> intern("text/rdf"), ); ok(Gtk2 -> targets_include_text(@targets)); ok(Gtk2 -> targets_include_uri(@targets)); ok(Gtk2 -> targets_include_rich_text($buffer, @targets)); ok(Gtk2 -> targets_include_image(TRUE, @targets)); } ############################################################################### my $window = Gtk2::Window -> new(); $window -> realize(); is(Gtk2::Selection -> owner_set($window, Gtk2::Gdk->SELECTION_PRIMARY, 0), 1); SKIP: { skip("GdkDisplay is new in 2.2", 1) unless Gtk2 -> CHECK_VERSION(2, 2, 0); is(Gtk2::Selection -> owner_set_for_display(Gtk2::Gdk::Display -> get_default(), $window, Gtk2::Gdk->SELECTION_SECONDARY, 0), 1); } $window -> selection_add_target(Gtk2::Gdk->SELECTION_CLIPBOARD, Gtk2::Gdk->TARGET_BITMAP, 5); $window -> selection_add_targets(Gtk2::Gdk->SELECTION_PRIMARY, { target => "drawable", info => 7 }, { target => "pixmap", info => 9 }); $window -> selection_clear_targets(Gtk2::Gdk->SELECTION_CLIPBOARD); is($window -> selection_convert(Gtk2::Gdk->SELECTION_PRIMARY, Gtk2::Gdk->TARGET_PIXMAP, 0), 1); # Test that this function continues to work, even if it's completely misbound. Gtk2::SelectionData::gtk_selection_clear($window, Gtk2::Gdk::Event -> new("nothing")); $window -> selection_remove_all(); ############################################################################### # The Gtk2::SelectionData stuff is tested in GtkClipboard.t. __END__ Copyright (C) 2003-2006 by the gtk2-perl team (see the file AUTHORS for the full list). See LICENSE for more information. Gtk2-1.24992/t/GtkVButtonBox.t0000644000175000017500000000067613076462677014324 0ustar lacklack#!/usr/bin/perl -w use strict; use Gtk2::TestHelper tests => 3, noinit => 1; # $Id$ my $box = Gtk2::VButtonBox -> new(); isa_ok($box, "Gtk2::VButtonBox"); $box -> set_layout_default("spread"); is($box -> get_layout_default(), "spread"); $box -> set_spacing_default(23); is($box -> get_spacing_default(), 23); __END__ Copyright (C) 2003-2006 by the gtk2-perl team (see the file AUTHORS for the full list). See LICENSE for more information. Gtk2-1.24992/t/GtkFontButton.t0000644000175000017500000000224113076462677014342 0ustar lacklack#!/usr/bin/perl -w # $Id$ use Gtk2::TestHelper tests => 15, at_least_version => [2, 4, 0, "GtkFontButton is new in 2.4"], ; my $fbn; $fbn = Gtk2::FontButton->new; isa_ok ($fbn, 'Gtk2::FontButton'); $fbn = Gtk2::FontButton->new_with_font ("monospace"); isa_ok ($fbn, 'Gtk2::FontButton'); like ($fbn->get_font_name, qr/monospace/i); $fbn = Gtk2::FontButton->new ("monospace"); isa_ok ($fbn, 'Gtk2::FontButton'); like ($fbn->get_font_name, qr/monospace/i); $fbn->set_title ("slartibartfast"); is ($fbn->get_title, "slartibartfast"); $fbn->set_use_font (FALSE); ok (!$fbn->get_use_font); $fbn->set_use_font (TRUE); ok ($fbn->get_use_font); $fbn->set_use_size (FALSE); ok (!$fbn->get_use_size); $fbn->set_use_size (TRUE); ok ($fbn->get_use_size); $fbn->set_show_style (FALSE); ok (!$fbn->get_show_style); $fbn->set_show_style (TRUE); ok ($fbn->get_show_style); $fbn->set_show_size (FALSE); ok (!$fbn->get_show_size); $fbn->set_show_size (TRUE); ok ($fbn->get_show_size); $fbn->set_font_name ("sans"); like ($fbn->get_font_name, qr/sans/i); __END__ Copyright (C) 2003 by the gtk2-perl team (see the file AUTHORS for the full list). See LICENSE for more information. Gtk2-1.24992/t/GtkCellRendererPixbuf.t0000644000175000017500000000046313076462676015767 0ustar lacklack#!/usr/bin/perl -w use strict; use Gtk2::TestHelper tests => 1, noinit => 1; # $Id$ my $pixbuf = Gtk2::CellRendererPixbuf -> new(); isa_ok($pixbuf, "Gtk2::CellRendererPixbuf"); __END__ Copyright (C) 2003 by the gtk2-perl team (see the file AUTHORS for the full list). See LICENSE for more information. Gtk2-1.24992/t/GtkBindings.t0000644000175000017500000003443013076462676014001 0ustar lacklack#!/usr/bin/perl # Copyright 2009 by the gtk2-perl team (see the file AUTHORS) # # This library is free software; you can redistribute it and/or # modify it under the terms of the GNU Library General Public # License as published by the Free Software Foundation; either # version 2.1 of the License, or (at your option) any later version. # # This library is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU # Library General Public License for more details. # # You should have received a copy of the GNU Library General Public # License along with this library; if not, see . package My::Object; use strict; use warnings; use Gtk2; use Glib::Object::Subclass 'Gtk2::Object', signals => { mysig => { param_types => [], return_type => undef, flags => ['run-last','action'], class_closure => \&do_mysig }, mysig_with_long => { param_types => [ 'Glib::Long' ], return_type => undef, flags => ['run-last','action'], class_closure => \&do_mysig_with_long }, mysig_with_float => { param_types => [ 'Glib::Double' ], return_type => undef, flags => ['run-last','action'], class_closure => \&do_mysig_with_float }, }; my $mysig_seen; sub do_mysig { #Test::More::diag ("mysig runs"); $mysig_seen = 1; } my $mysig_with_long_value; sub do_mysig_with_long { my ($self, $value) = @_; #Test::More::diag ("mysig_with_long runs, value=$value"); $mysig_with_long_value = $value; } my $mysig_with_float_value; sub do_mysig_with_float { my ($self, $value) = @_; #Test::More::diag ("mysig_with_float runs, value=$value"); $mysig_with_float_value = $value; } package My::Widget; use strict; use warnings; use Gtk2; use Glib::Object::Subclass 'Gtk2::EventBox', signals => { mywidgetsig => { parameter_types => [], return_type => undef, flags => ['run-last','action'], class_closure => \&do_mywidgetsig }, }; my $mywidgetsig_seen; sub do_mywidgetsig { #Test::More::diag ("mywidgetsig runs"); $mywidgetsig_seen = 1; } package main; use strict; use warnings; # Note: need '-init' to make Gtk2::Rc do its thing ... use Gtk2::TestHelper tests => 43; # A few tests below require a valid keymap, which some display servers lack. # So try to determine if we're affected and skip the relevant tests if so. my $keymap = Gtk2::Gdk::Keymap->get_default(); my @entries = $keymap->get_entries_for_keyval( Gtk2::Gdk->keyval_from_name('Return')); my $have_valid_keymap = scalar @entries != 0; #----------------------------------------------------------------------------- # new() my $mybindings = Gtk2::BindingSet->new('mybindings'); ok ($mybindings, 'new()'); #----------------------------------------------------------------------------- # priority constants is (Gtk2::GTK_PATH_PRIO_LOWEST, 0); ok (Gtk2::GTK_PATH_PRIO_GTK); ok (Gtk2::GTK_PATH_PRIO_APPLICATION); ok (Gtk2::GTK_PATH_PRIO_THEME); ok (Gtk2::GTK_PATH_PRIO_RC); ok (Gtk2::GTK_PATH_PRIO_HIGHEST); #----------------------------------------------------------------------------- # set_name() field accessor is ($mybindings->set_name, 'mybindings', 'set_name() of mybindings'); #----------------------------------------------------------------------------- # find() ok (Gtk2::BindingSet->find('mybindings'), 'find() mybindings'); is (Gtk2::BindingSet->find('nosuchbindingset'), undef, 'find() not found'); #----------------------------------------------------------------------------- # by_class() ok (Gtk2::BindingSet->by_class('Gtk2::Entry'), 'by_class() Gtk2::Entry'); #----------------------------------------------------------------------------- # activate() # The rc mechanism doesn't actually parse anything or create any # GtkBindingSet's until one or more GtkSettings objects exist and are # interested in the rc values. Create a dummy label widget to force that to # happen and thus ensure creation of the "some_bindings" set. # my $dummy_label = Gtk2::Label->new; Gtk2::Rc->parse_string (<<'HERE'); binding "some_bindings" { bind "Return" { "mysig" () } } HERE { my $some_bindings = Gtk2::BindingSet->find('some_bindings'); ok ($some_bindings, 'find() of RC parsed bindings'); my $myobj = My::Object->new; $mysig_seen = 0; ok ($some_bindings->activate (Gtk2::Gdk->keyval_from_name('Return'), [],$myobj), 'activate() return true on myobj'); is ($mysig_seen, 1, 'activate() runs mysig on myobj'); } #----------------------------------------------------------------------------- # add_path() and $object->bindings_activate() and bindings_activate_event() Gtk2::Rc->parse_string (<<'HERE'); binding "my_widget_bindings" { bind "Return" { "mywidgetsig" () } } HERE # As of Gtk 2.12 $gtkobj->bindings_activate() only actually works on a # Gtk2::Widget, not a Gtk2::Object, hence using My::Widget to exercise # add_path() instead of My::Object. SKIP: { skip 'Need a keymap and gtk+ >= 2.4', 5 unless $have_valid_keymap && Gtk2->CHECK_VERSION(2, 4, 0); my $my_widget_bindings = Gtk2::BindingSet->find('my_widget_bindings'); ok ($my_widget_bindings, 'find() of RC parsed bindings'); $my_widget_bindings->add_path ('class', 'My__Widget', Gtk2::GTK_PATH_PRIO_APPLICATION); my $mywidget = My::Widget->new; my $keyval = Gtk2::Gdk->keyval_from_name ('Return'); my $modifiers = []; $mywidgetsig_seen = 0; ok ($mywidget->bindings_activate ($keyval,$modifiers), 'bindings_activate() return true on mywidget'); is ($mywidgetsig_seen, 1, 'bindings_activate() runs mywidgetsig on mywidget'); # This diabolical bit of code is what it takes to synthesize a # Gtk2::Gdk::Event::Key which gtk_bindings_activate_event() will dispatch. # That func looks at the hardware_keycode and group, rather than the # keyval in the event, so must generate those. hardware_keycode values # are basically arbitrary aren't they? At any rate the strategy is to # lookup what hardware code is Return in the display keymap and use that. # gtk_bindings_activate_event() then ends up then going the other way, # turning the hardware code into a keyval to lookup in the bindingset! # # The gtk_widget_get_display() docs say $mywidget won't have a display # until it's the child of a toplevel. Gtk 2.12 will give you back the # default display before then, but probably better not to rely on that. # my $toplevel = Gtk2::Window->new; $toplevel->add ($mywidget); my $display = $mywidget->get_display; my $keymap = Gtk2::Gdk::Keymap->get_for_display ($display); my @keys = $keymap->get_entries_for_keyval ($keyval); # diag "keys ", explain \@keys; my $event = Gtk2::Gdk::Event->new ('key-press'); $event->window ($mywidget->window); $event->keyval ($keyval); $event->set_state ($modifiers); $event->group($keys[0]->{'group'}); $event->hardware_keycode($keys[0]->{'keycode'}); $mywidget->bindings_activate_event ($event); $mywidgetsig_seen = 0; ok ($mywidget->bindings_activate_event ($event), 'bindings_activate() return true on mywidget'); is ($mywidgetsig_seen, 1, 'bindings_activate() runs mywidgetsig on mywidget'); $toplevel->destroy; } #----------------------------------------------------------------------------- # entry_add_signal() { my $bindings = Gtk2::BindingSet->new ('entry_add_signal_test'); my $obj = My::Object->new; { my $keyval = Gtk2::Gdk->keyval_from_name('Return'); my $modifiers = []; $bindings->entry_add_signal ($keyval, $modifiers, 'mysig'); $mysig_seen = 0; ok ($bindings->activate ($keyval, $modifiers, $obj), 'entry_add_signal() activate on MyObject -- dispatch mysig'); is ($mysig_seen, 1, 'entry_add_signal() activate on MyObject -- ran mysig'); } # object taking Glib::Long, pass as Glib::Long # { my $keyval = Gtk2::Gdk->keyval_from_name('Escape'); my $modifiers = []; my $arg = 12456; $bindings->entry_add_signal ($keyval, $modifiers, 'mysig-with-long', 'Glib::Long', $arg); $mysig_with_long_value = 0; ok ($bindings->activate ($keyval, $modifiers, $obj), 'entry_add_signal() activate on MyObject -- dispatch mysig_with_long'); is ($mysig_with_long_value, $arg, 'entry_add_signal() activate on MyObject -- mysig_with_long value'); } # object taking Glib::Float, pass as Glib::Double # { my $keyval = Gtk2::Gdk->keyval_from_name('space'); my $modifiers = [ 'control-mask' ]; my $arg = 1.25; $bindings->entry_add_signal ($keyval, $modifiers, 'mysig-with-float', 'Glib::Double', $arg); $mysig_with_float_value = 0; ok ($bindings->activate ($keyval, $modifiers, $obj), 'entry_add_signal() activate on MyObject -- dispatch mysig_with_float'); delta_ok ($mysig_with_float_value, $arg, 'entry_add_signal() activate on MyObject -- mysig_with_float value'); } Glib::Type->register_flags ('My::Flags', ['value-one' => 8 ], ['value-two' => 16 ], ['value-three' => 32 ]); # object taking Glib::Long, give flags as arrayref # { my $keyval = Gtk2::Gdk->keyval_from_name('Escape'); my $modifiers = [ 'control-mask' ]; my $flags = ['value-one', 'value-three']; my $flags_num = 40; $bindings->entry_add_signal ($keyval, $modifiers, 'mysig-with-long', 'My::Flags', $flags); $mysig_with_long_value = -1; ok ($bindings->activate ($keyval, $modifiers, $obj), 'entry_add_signal() activate on MyObject -- dispatch mysig_with_long'); is ($mysig_with_long_value, $flags_num, 'entry_add_signal() activate on MyObject -- mysig_with_long value'); } # object taking Glib::Long, give flags as flags object # { my $keyval = Gtk2::Gdk->keyval_from_name('Escape'); my $modifiers = [ 'control-mask' ]; my $flags = My::Flags->new (['value-one', 'value-two']); my $flags_num = 24; $bindings->entry_add_signal ($keyval, $modifiers, 'mysig-with-long', 'Glib::Flags', $flags); $mysig_with_long_value = -1; ok ($bindings->activate ($keyval, $modifiers, $obj), 'entry_add_signal() activate on MyObject -- dispatch mysig_with_long'); is ($mysig_with_long_value, $flags_num, 'entry_add_signal() activate on MyObject -- mysig_with_long value'); } Glib::Type->register_flags ('My::Enum', [eeeek => 123 ]); # object taking Glib::Long, give enum as string # { my $keyval = Gtk2::Gdk->keyval_from_name('space'); my $modifiers = []; $bindings->entry_add_signal ($keyval, $modifiers, 'mysig-with-long', 'My::Enum', 'eeeek'); $mysig_with_long_value = -1; ok ($bindings->activate ($keyval, $modifiers, $obj), 'entry_add_signal() activate on MyObject -- dispatch mysig_with_long'); is ($mysig_with_long_value, 123, 'entry_add_signal() activate on MyObject -- mysig_with_long value'); } } #----------------------------------------------------------------------------- # entry_remove() { my $bindings = Gtk2::BindingSet->new ('entry_remove_test'); my $obj = My::Object->new; my $keyval = Gtk2::Gdk->keyval_from_name('Return'); my $modifiers = []; $bindings->entry_add_signal ($keyval, $modifiers, 'mysig'); $mysig_seen = 0; ok ($bindings->activate ($keyval, $modifiers, $obj), 'before entry_remove() activate on MyObject -- dispatch mysig'); is ($mysig_seen, 1, 'before entry_remove() activate on MyObject -- ran mysig'); $bindings->entry_remove ($keyval, $modifiers); $mysig_seen = 0; ok (! $bindings->activate ($keyval, $modifiers, $obj), 'after entry_remove() activate on MyObject -- no dispatch mysig'); is ($mysig_seen, 0, 'after entry_remove() activate on MyObject -- no run mysig'); } #----------------------------------------------------------------------------- # entry_skip() SKIP: { skip 'Need a keymap', 8 unless $have_valid_keymap; skip 'entry_skip() new in 2.12', 8 unless Gtk2->CHECK_VERSION(2, 12, 0); # see that basic invocation on object doesn't dispatch # my $skip_bindings = Gtk2::BindingSet->new ('entry_skip_test'); my $keyval = Gtk2::Gdk->keyval_from_name('Return'); my $modifiers = []; $skip_bindings->entry_add_signal ($keyval, $modifiers, 'mysig'); my $obj = My::Object->new; $mysig_seen = 0; ok ($skip_bindings->activate ($keyval, $modifiers, $obj), 'before entry_skip() activate on MyObject -- dispatch mysig'); is ($mysig_seen, 1, 'before entry_skip() activate on MyObject -- ran mysig'); $skip_bindings->entry_skip ($keyval, $modifiers); $mysig_seen = 0; ok (! $skip_bindings->activate ($keyval, $modifiers, $obj), 'after entry_skip() activate on MyObject -- no dispatch mysig'); is ($mysig_seen, 0, 'after entry_skip() activate on MyObject -- no run mysig'); # When an entry_skip() binding shadows another binding the latter doesn't # run. # # This more exercises gtk than it does the bindings, but it does make sure # the shared code of ->entry_skip() and ->entry_remove() have the right # func under the right name. # my $mywidget = My::Widget->new; $mywidgetsig_seen = 0; ok ($mywidget->bindings_activate (Gtk2::Gdk->keyval_from_name('Return'),[]), 'before entry_skip(), bindings_activate return true on mywidget'); is ($mywidgetsig_seen, 1, 'before entry_skip(), bindings_activate runs mywidgetsig on mywidget'); $skip_bindings->add_path ('widget-class', 'My__Widget', Gtk2::GTK_PATH_PRIO_HIGHEST); $mywidgetsig_seen = 0; ok (! $mywidget->bindings_activate(Gtk2::Gdk->keyval_from_name('Return'),[]), 'before entry_skip(), bindings_activate return true on mywidget'); is ($mywidgetsig_seen, 0, 'before entry_skip(), bindings_activate runs mywidgetsig on mywidget'); } exit 0; Gtk2-1.24992/t/GtkShow.t0000644000175000017500000000105513076462677013162 0ustar lacklack#!/usr/bin/perl use strict; use warnings; use Gtk2::TestHelper tests => 1, at_least_version => [2, 14, 0, 'GtkShow is new in 2.14'], skip_all => 'can only test interactively', ; # $Id$ eval { Gtk2::show_uri(undef, 'http://www.gnome.org'); Gtk2::show_uri(undef, 'http://www.gtk.org', time()); my $screen = Gtk2::Gdk::Screen -> get_default(); Gtk2::show_uri($screen, 'http://gtk2-perl.sf.net'); }; is ($@, ''); __END__ Copyright (C) 2008 by the gtk2-perl team (see the file AUTHORS for the full list). See LICENSE for more information. Gtk2-1.24992/t/GtkBox.t0000644000175000017500000000460113076462676012771 0ustar lacklack#!/usr/bin/perl -w use strict; use Gtk2::TestHelper tests => 75; # $Id$ my $box = Gtk2::VBox -> new(); isa_ok($box, "Gtk2::Box"); my $label = Gtk2::Label -> new("Bla"); my $frame = Gtk2::Frame -> new("Bla"); my $button = Gtk2::Button -> new("Bla"); my $entry = Gtk2::Entry -> new(); $box -> pack_start($label, FALSE, TRUE, 5); $box -> pack_end($frame, TRUE, FALSE, 10); $box -> pack_start_defaults($button); $box -> pack_end_defaults($entry); is_deeply([$box -> query_child_packing($label)], [FALSE, TRUE, 5, "start"]); is_deeply([$box -> query_child_packing($frame)], [TRUE, FALSE, 10, "end"]); is_deeply([$box -> query_child_packing($button)], [TRUE, TRUE, 0, "start"]); is_deeply([$box -> query_child_packing($entry)], [TRUE, TRUE, 0, "end"]); $box -> set_child_packing($button, FALSE, FALSE, 23, "end"); is_deeply([$box -> query_child_packing($button)], [FALSE, FALSE, 23, "end"]); $box -> set_homogeneous(TRUE); is($box -> get_homogeneous(), TRUE); $box -> set_spacing(5); is($box -> get_spacing(), 5); $box -> reorder_child($label, -1); ############################################################################### # Ross' 0.7.GtkBoxes.t. ok( my $vbox = Gtk2::VBox->new(FALSE,5) ); my ($r, $c); for( $r = 0; $r < 3; $r++ ) { ok( my $hbox = Gtk2::HBox->new(FALSE, 5), "created hbox for row $r" ); $vbox->pack_start($hbox, FALSE, FALSE, 5); $hbox->set_name ("hbox $r"); for( $c = 0; $c < 3; $c++ ) { ok( my $label = Gtk2::Label->new("(r,c):($r,$c)"), 'created label' ); $hbox->pack_start($label, FALSE, FALSE, 10); # make sure we are where we think we are is( $label->get_ancestor ('Gtk2::Box'), $hbox, 'ancestry' ); is( $label->get_ancestor ('Gtk2::VBox'), $vbox, 'ancestry' ); # interestingly, the second string returned from this # appears to be reversed, rather than the objects in # reverse order. how handy. that makes the second # one fairly useless, but let's verify that it's there. my ($path, $htap) = $label->path; ok( defined($htap), 'path returned two items' ); ok( $path =~ /hbox $r/, "'hbox $r' is in the path" ); ##print "path $path\n"; ($path, $htap) = $label->class_path; ok( defined($htap), 'path returned two items' ); ok( $path !~ /hbox $r/, "'hbox $r' is not in the class path" ); ##print "class path $path\n"; } } __END__ Copyright (C) 2003-2005 by the gtk2-perl team (see the file AUTHORS for the full list). See LICENSE for more information. Gtk2-1.24992/t/GtkCellRendererCombo.t0000644000175000017500000000056613076462676015575 0ustar lacklack#!/usr/bin/perl -w use strict; use Gtk2::TestHelper tests => 1, noinit => 1, at_least_version => [2, 6, 0, "GtkCellRendererCombo is new in 2.6"]; # $Id$ my $text = Gtk2::CellRendererCombo -> new(); isa_ok($text, "Gtk2::CellRendererCombo"); __END__ Copyright (C) 2004 by the gtk2-perl team (see the file AUTHORS for the full list). See LICENSE for more information. Gtk2-1.24992/t/GtkCellRendererProgress.t0000644000175000017500000000057713076462676016344 0ustar lacklack#!/usr/bin/perl -w use strict; use Gtk2::TestHelper tests => 1, noinit => 1, at_least_version => [2, 6, 0, "GtkCellRendererProgress is new in 2.6"]; # $Id$ my $text = Gtk2::CellRendererProgress -> new(); isa_ok($text, "Gtk2::CellRendererProgress"); __END__ Copyright (C) 2004 by the gtk2-perl team (see the file AUTHORS for the full list). See LICENSE for more information. Gtk2-1.24992/t/PangoFontset.t0000644000175000017500000000170013076462677014200 0ustar lacklack#!/usr/bin/perl -w use strict; use Gtk2::TestHelper tests => 7; # $Id$ my $label = Gtk2::Label -> new("Bla"); my $context = $label -> create_pango_context(); my $font = Gtk2::Pango::FontDescription -> from_string("Sans 12"); my $language = Gtk2 -> get_default_language(); my $set = $context -> load_fontset($font, $language); isa_ok($set -> get_font(23), "Gtk2::Pango::Font"); isa_ok($set -> get_metrics(), "Gtk2::Pango::FontMetrics"); SKIP: { skip("foreach is new in 1.4", 5) unless (Gtk2::Pango -> CHECK_VERSION(1, 4, 0)); $set -> foreach(sub { isa_ok(shift(), "Gtk2::Pango::Fontset"); isa_ok(shift(), "Gtk2::Pango::Font"); return 1; }); $set -> foreach(sub { isa_ok(shift(), "Gtk2::Pango::Fontset"); isa_ok(shift(), "Gtk2::Pango::Font"); is(shift(), "bla"); return 1; }, "bla"); } __END__ Copyright (C) 2004 by the gtk2-perl team (see the file AUTHORS for the full list). See LICENSE for more information. Gtk2-1.24992/t/GtkCellRendererText.t0000644000175000017500000000052413076462676015454 0ustar lacklack#!/usr/bin/perl -w use strict; use Gtk2::TestHelper tests => 1, noinit => 1; # $Id$ my $text = Gtk2::CellRendererText -> new(); isa_ok($text, "Gtk2::CellRendererText"); $text -> set_fixed_height_from_font(5); __END__ Copyright (C) 2003 by the gtk2-perl team (see the file AUTHORS for the full list). See LICENSE for more information. Gtk2-1.24992/t/GtkEntry.t0000644000175000017500000001560713076462676013352 0ustar lacklack#!/usr/bin/perl -w use strict; use Gtk2::TestHelper tests => 76; # $Id$ my $entry = Gtk2::Entry -> new(); isa_ok($entry, "Gtk2::Entry"); ginterfaces_ok($entry); $entry -> set_text("Bla"); is($entry -> get_text(), "Bla"); $entry -> set_visibility(1); is($entry -> get_visibility(), 1); $entry -> set_invisible_char("!"); is($entry -> get_invisible_char(), "!"); $entry -> set_max_length(8); is($entry -> get_max_length(), 8); $entry -> set_activates_default(1); is($entry -> get_activates_default(), 1); $entry -> set_has_frame(1); is($entry -> get_has_frame(), 1); $entry -> set_width_chars(23); is($entry -> get_width_chars(), 23); isa_ok($entry -> get_layout(), "Gtk2::Pango::Layout"); my ($x, $y) = $entry -> get_layout_offsets(); like($x, qr/^-?\d+$/); like($y, qr/^-?\d+$/); SKIP: { skip("[sg]et_completion are new in 2.4", 2) unless Gtk2->CHECK_VERSION (2, 4, 0); my $completion = Gtk2::EntryCompletion -> new(); $entry -> set_completion($completion); is($entry -> get_completion(), $completion); $entry -> set_completion(undef); is($entry -> get_completion(), undef); } SKIP: { skip("[sg]et_alignment are new in 2.4", 1) unless Gtk2->CHECK_VERSION (2, 4, 0); $entry -> set_alignment(0.23); is(int($entry -> get_alignment() * 100) / 100, 0.23); } SKIP: { skip("layout_index_to_text_index and text_index_to_layout_index are new in 2.6", 2) unless Gtk2->CHECK_VERSION (2, 6, 0); is($entry -> layout_index_to_text_index(1), 1); is($entry -> text_index_to_layout_index(1), 1); } SKIP: { skip("inner border stuff", 2) unless Gtk2->CHECK_VERSION (2, 10, 0); $entry -> set_inner_border(undef); is($entry -> get_inner_border(), undef); $entry -> set_inner_border({left=>1, right=>2, top=>3, bottom=>4}); is_deeply($entry -> get_inner_border(), {left=>1, right=>2, top=>3, bottom=>4}); } SKIP: { skip("cursor hadjustment stuff", 2) unless Gtk2->CHECK_VERSION (2, 12, 0); $entry -> set_cursor_hadjustment(undef); is($entry -> get_cursor_hadjustment(), undef); my $adj = Gtk2::Adjustment -> new(0.0, -1.0, 1.0, 0.1, 0.2, 0.5); $entry -> set_cursor_hadjustment($adj); is($entry -> get_cursor_hadjustment(), $adj); } SKIP: { skip 'new 2.14 stuff', 2 unless Gtk2->CHECK_VERSION(2, 14, 0); my $entry = Gtk2::Entry -> new(); $entry -> set_text("Bla"); is ($entry -> get_text_length(), 3); $entry -> set_overwrite_mode(FALSE); is ($entry -> get_overwrite_mode(), FALSE); } SKIP: { skip '2.16 stuff', 48 unless Gtk2->CHECK_VERSION(2, 16, 0); ## progress methods my $entry = Gtk2::Entry -> new(); is($entry -> get_icon_at_pos(0, 0), -1); delta_ok($entry -> get_progress_fraction(), 0.0); delta_ok($entry -> get_progress_pulse_step(), 0.1); $entry -> progress_pulse(); # We can't see the changes :( $entry -> set_progress_fraction(0.3); delta_ok($entry -> get_progress_fraction(), 0.3); $entry -> set_progress_pulse_step(0.2); ## unset_invisible_char # Try the new password methods my $password = Gtk2::Entry -> new(); $password -> set_visibility(FALSE); # Change the default character my $default = $password -> get_invisible_char(); my $char = $default eq 'X' ? '?' : 'X'; $password -> set_invisible_char($char); is($password -> get_invisible_char(), $char); # Restore the default character $password -> unset_invisible_char(); is($password -> get_invisible_char(), $default); ## icon methods test_icon_methods('primary'); test_icon_methods('secondary'); } SKIP: { skip 'new 2.18 stuff', 2 unless Gtk2->CHECK_VERSION(2, 18, 0); my $buffer = Gtk2::EntryBuffer->new; my $entry = Gtk2::Entry->new_with_buffer ($buffer); isa_ok ($entry, 'Gtk2::Entry'); $entry->set_buffer ($buffer); is ($entry->get_buffer, $buffer); } SKIP: { skip 'new 2.20 stuff', 2 unless Gtk2->CHECK_VERSION(2, 20, 0); my $entry = Gtk2::Entry->new; my $window = Gtk2::Window->new; $window->add ($entry); $entry->realize; $entry->set_icon_from_icon_name ('primary', 'gtk-yes'); isa_ok ($entry->get_icon_window ('primary'), 'Gtk2::Gdk::Window'); isa_ok ($entry->get_text_window, 'Gtk2::Gdk::Window'); } SKIP: { skip 'new 2.22 stuff', 1 unless Gtk2->CHECK_VERSION(2, 22, 0); my $entry = Gtk2::Entry->new; my $window = Gtk2::Window->new; $window->add ($entry); $entry->realize; my $event = Gtk2::Gdk::Event->new ('key-press'); $event->window ($entry->window); ok (defined $entry->im_context_filter_keypress ($event)); $entry->reset_im_context; } sub test_icon_methods { my ($icon_pos) = @_; my $entry = Gtk2::Entry -> new(); is($entry -> get_icon_name($icon_pos), undef); is($entry -> get_icon_pixbuf($icon_pos), undef); is($entry -> get_icon_stock($icon_pos), undef); is($entry -> get_icon_storage_type($icon_pos), 'empty'); $entry -> set_icon_sensitive($icon_pos, TRUE); is($entry -> get_icon_sensitive($icon_pos), TRUE); $entry -> set_icon_activatable($icon_pos, TRUE); is($entry -> get_icon_activatable($icon_pos), TRUE); # Is an 'icon name' the same as a 'stock icon'? is($entry -> get_icon_name($icon_pos), undef); $entry -> set_icon_from_icon_name($icon_pos, 'gtk-yes'); is($entry -> get_icon_name($icon_pos), 'gtk-yes'); ok($entry -> get_icon_pixbuf($icon_pos)); # Reset through icon_name $entry -> set_icon_from_icon_name($icon_pos, undef); is($entry -> get_icon_pixbuf($icon_pos), undef); # Set and unset the icon through a stock image $entry -> set_icon_from_stock($icon_pos, 'gtk-yes'); ok($entry -> get_icon_pixbuf($icon_pos)); $entry -> set_icon_from_stock($icon_pos, undef); is($entry -> get_icon_pixbuf($icon_pos), undef); # Reset $entry -> set_icon_from_stock($icon_pos, undef); is($entry -> get_icon_name($icon_pos), undef); is($entry -> get_icon_pixbuf($icon_pos), undef); # Set and unset the icon through a pixbuf my $pixbuf = Gtk2::Gdk::Pixbuf->new('rgb', TRUE, 8, 16, 16); $entry -> set_icon_from_pixbuf($icon_pos, $pixbuf); is($entry -> get_icon_pixbuf($icon_pos), $pixbuf); $entry -> set_icon_from_pixbuf($icon_pos, undef); is($entry -> get_icon_pixbuf($icon_pos), undef); # Icon tooltips $entry -> set_icon_tooltip_markup($icon_pos, "PanGo tooltip"); is($entry -> get_icon_tooltip_markup($icon_pos), "PanGo tooltip"); $entry -> set_icon_tooltip_markup($icon_pos, undef); is($entry -> get_icon_tooltip_markup($icon_pos), undef); $entry -> set_icon_tooltip_text($icon_pos, "Text tooltip"); is($entry -> get_icon_tooltip_text($icon_pos), "Text tooltip"); $entry -> set_icon_tooltip_text($icon_pos, undef); is($entry -> get_icon_tooltip_text($icon_pos), undef); $entry -> set_icon_drag_source( $icon_pos, Gtk2::TargetList->new({target => 'TEXT', flags => 'same-app', info => 23 }), 'move'); ok(defined $entry -> get_current_icon_drag_source()); } __END__ Copyright (C) 2003-2006 by the gtk2-perl team (see the file AUTHORS for the full list). See LICENSE for more information. Gtk2-1.24992/t/GtkComboBox.t0000644000175000017500000001022013076462676013743 0ustar lacklack#!/usr/bin/env perl use Gtk2::TestHelper tests => 28, at_least_version => [2, 4, 0, "GtkComboBox is new in 2.4"], ; my $combo_box; ## convenience -- text $combo_box = Gtk2::ComboBox->new_text; isa_ok ($combo_box, 'Gtk2::ComboBox'); ginterfaces_ok($combo_box); $combo_box->append_text ("some text"); $combo_box->append_text ("more text"); $combo_box->prepend_text ("more text"); $combo_box->prepend_text ("more text"); $combo_box->insert_text (1, "even more text"); $combo_box->insert_text (5, "even more text"); $combo_box->remove_text (0); $combo_box->remove_text (2); $combo_box->set_active (2); is ($combo_box->get_active, 2); my $model = $combo_box->get_model; isa_ok ($model, 'Gtk2::TreeModel'); is ($model->get_path ($combo_box->get_active_iter)->to_string, $combo_box->get_active); my $iter = $model->get_iter_first; $combo_box->set_active_iter ($iter); is ($model->get_path ($combo_box->get_active_iter)->to_string, $model->get_path ($iter)->to_string); $combo_box->set_active_iter (undef); is ($combo_box->get_active, -1); is ($combo_box->get_active_iter, undef); $combo_box = Gtk2::ComboBox->new; isa_ok ($combo_box, 'Gtk2::ComboBox'); # set a model to avoid a nastygram when destroying; some versions of gtk+ # do not check for NULL before unreffing the model. $combo_box->set_model ($model); $combo_box = Gtk2::ComboBox->new ($model); isa_ok ($combo_box, 'Gtk2::ComboBox'); $combo_box = Gtk2::ComboBox->new_with_model ($model); isa_ok ($combo_box, 'Gtk2::ComboBox'); ## getters and setters $model = Gtk2::ListStore->new ('Glib::String', 'Glib::Int'); $combo_box->set_model ($model); is ($combo_box->get_model, $model); # get active returns -1 when nothing is selected is ($combo_box->get_active, -1); foreach my $t (qw(fee fie foe fum)) { $model->set ($model->append, 0, $t, 1, 1); } $combo_box->set_active (1); is ($combo_box->get_active, 1, 'set and get active'); SKIP: { skip "new api in gtk+ 2.6", 12 unless Gtk2->CHECK_VERSION (2, 6, 0); my $active_path = Gtk2::TreePath->new_from_string ("".$combo_box->get_active.""); is ($combo_box->get_active_text, $model->get ($model->get_iter ($active_path), 0), 'get active text'); $combo_box->set_add_tearoffs (TRUE); ok ($combo_box->get_add_tearoffs, 'tearoff accessors'); $combo_box->set_add_tearoffs (FALSE); ok (!$combo_box->get_add_tearoffs, 'tearoff accessors'); $combo_box->set_focus_on_click (TRUE); ok ($combo_box->get_focus_on_click, 'focus-on-click accessors'); $combo_box->set_focus_on_click (FALSE); ok (!$combo_box->get_focus_on_click, 'focus-on-click accessors'); $combo_box->set_row_separator_func (sub { my ($model, $iter, $data) = @_; my $been_here = 0 if 0; return if $been_here++; isa_ok ($model, 'Gtk2::ListStore'); isa_ok ($iter, 'Gtk2::TreeIter'); is_deeply ($data, { something => 'else' }); }, { something => 'else'}); # make sure the widget is parented, realized and sized, or popup # and popdown will assert when they try to use combo_box's GdkWindow. # er, also make sure there's stuff in it. my $cell = Gtk2::CellRendererText->new; $combo_box->pack_start ($cell, TRUE); $combo_box->set_attributes ($cell, text => 0); my $window = Gtk2::Window->new; $window->add ($combo_box); $combo_box->show; $window->show; $combo_box->popup; $combo_box->popdown; $combo_box->set_wrap_width (1); $combo_box->set_row_span_column (1); $combo_box->set_column_span_column (1); is ($combo_box->get_wrap_width, 1); is ($combo_box->get_row_span_column, 1); is ($combo_box->get_column_span_column, 1); # setting undef for no model is allowed $combo_box->set_model (undef); is ($combo_box->get_model, undef, 'set_model() of undef giving undef'); } SKIP: { skip "new api in gtk+ 2.10", 1 unless Gtk2->CHECK_VERSION (2, 10, 0); $combo_box->set_title ("whee"); is ($combo_box->get_title, "whee"); } SKIP: { skip 'new 2.14 stuff', 1 unless Gtk2->CHECK_VERSION(2, 14, 0); my $combo_box = Gtk2::ComboBox->new; $combo_box->set_button_sensitivity ('auto'); is ($combo_box->get_button_sensitivity, 'auto'); } __END__ Copyright (C) 2003-2006, 2010 by the gtk2-perl team (see the file AUTHORS for the full list). See LICENSE for more information. vim: set ft=perl : Gtk2-1.24992/t/GtkEntryBuffer.t0000644000175000017500000000326413076462676014500 0ustar lacklack#!/usr/bin/perl -w # vim: set filetype=perl expandtab shiftwidth=2 softtabstop=2 : use utf8; use Gtk2::TestHelper tests => 21, at_least_version => [ 2, 18, 0 ]; my $buffer = Gtk2::EntryBuffer->new(); isa_ok( $buffer, 'Gtk2::EntryBuffer' ); is( $buffer->get_text(), '' ); is( $buffer->get_bytes(), 0 ); is( $buffer->get_length(), 0 ); my $text = "Lorem ipsum dolor sit amet, consectetur adipisicing elit"; $buffer = Gtk2::EntryBuffer->new($text); isnt( $buffer->get_text(), '' ); is( $buffer->get_length(), length($text) ); is( $buffer->get_bytes(), length($text) ); my $utf8_text = "♥ Lorem ipsum dolor sit amet, consectetur adipisicing elit"; $buffer->set_text($utf8_text); is( $buffer->get_length(), length($utf8_text) ); is( $buffer->get_bytes(), length($utf8_text) + 2 ); # ♥ == 0xE2 0x99 0xA5 is( $buffer->get_text(), $utf8_text ); $buffer = Gtk2::EntryBuffer->new(substr($utf8_text, 0, 5)); is( $buffer->get_text(), '♥ Lor' ); is( $buffer->get_length(), 5 ); is( $buffer->get_bytes(), 7 ); $buffer->insert_text(0, 'Do '); is( $buffer->get_text(), 'Do ♥ Lor' ); $buffer->insert_text(-1, 'em ipsum'); is( $buffer->get_text(), 'Do ♥ Lorem ipsum' ); $buffer->delete_text(10, -1); is( $buffer->get_text(), 'Do ♥ Lorem' ); $buffer->delete_text(); is( $buffer->get_bytes(), 0 ); $buffer->set_max_length(23); is( $buffer->get_max_length(), 23 ); $buffer->emit_inserted_text(0, 'Lorem', 5); $buffer->emit_deleted_text(0, 5); SKIP: { skip 'new stuff', 3 unless Gtk2->CHECK_VERSION(2, 18, 0); ok( defined Gtk2::GTK_ENTRY_BUFFER_MAX_SIZE() ); ok( eval <<__CODE__ ); package Tmp; use Gtk2 qw/GTK_ENTRY_BUFFER_MAX_SIZE/; Test::More::ok( defined GTK_ENTRY_BUFFER_MAX_SIZE() ); 1; __CODE__ } Gtk2-1.24992/t/GtkScale.t0000644000175000017500000000212413076462677013267 0ustar lacklack#!/usr/bin/perl -w use strict; use Gtk2::TestHelper tests => 7; # $Id$ my $adjustment = Gtk2::Adjustment -> new(0, 0, 100, 1, 5, 10); my $scale = Gtk2::HScale -> new($adjustment); isa_ok($scale, "Gtk2::Scale"); $scale -> set_digits(5); is($scale -> get_digits(), 5); $scale -> set_draw_value(1); is($scale -> get_draw_value(), 1); $scale -> set_value_pos("right"); is($scale -> get_value_pos(), "right"); SKIP: { skip("get_layout and get_layout_offsets are new in 2.4", 2) unless Gtk2->CHECK_VERSION (2, 4, 0); isa_ok($scale -> get_layout(), "Gtk2::Pango::Layout"); is(@{[$scale -> get_layout_offsets()]}, 2); } SKIP: { skip("gtk_scale_add_mark and gtk_scale_clear_marks are new in 2.16", 1) unless Gtk2->CHECK_VERSION (2, 16, 0); # no way to test it other than checking they don't crash $scale -> add_mark(50,'top','this is the middle'); $scale -> add_mark(80,'bottom',undef); $scale -> clear_marks; ok(1,"add_mark and clear_marks"); } __END__ Copyright (C) 2003,2010 by the gtk2-perl team (see the file AUTHORS for the full list). See LICENSE for more information. Gtk2-1.24992/t/PangoTypes.t0000644000175000017500000000206313076462677013665 0ustar lacklack#!/usr/bin/perl -w use strict; use Gtk2::TestHelper tests => 9, noinit => 1; # $Id$ SKIP: { skip("find_base_dir is new in 1.4", 1) unless (Gtk2::Pango -> CHECK_VERSION(1, 4, 0)); is(Gtk2::Pango -> find_base_dir("urgs"), "ltr"); } my $language = Gtk2::Pango::Language -> from_string("de_DE"); isa_ok($language, "Gtk2::Pango::Language"); is($language -> to_string(), "de-de"); is($language -> matches("*"), 1); SKIP: { skip "1.16 stuff", 5 unless Gtk2::Pango -> CHECK_VERSION(1, 16, 0); isa_ok(Gtk2::Pango::Language -> get_default(), "Gtk2::Pango::Language"); is(Gtk2::Pango::units_from_double(Gtk2::Pango::units_to_double(23)), 23); my $rect = {x => 1.0, y => 2.0, width => 23.0, height => 42.0}; my ($new_ink, $new_logical) = Gtk2::Pango::extents_to_pixels($rect, $rect); isa_ok($new_ink, "HASH"); isa_ok($new_logical, "HASH"); is_deeply([Gtk2::Pango::extents_to_pixels(undef, undef)], [undef, undef]); } __END__ Copyright (C) 2004-2007 by the gtk2-perl team (see the file AUTHORS for the full list). See LICENSE for more information. Gtk2-1.24992/t/GtkScrolledWindow.t0000644000175000017500000000261013076462677015177 0ustar lacklack#!/usr/bin/perl -w use strict; use Gtk2::TestHelper tests => 10; # $Id$ my $window = Gtk2::ScrolledWindow -> new(); isa_ok($window, "Gtk2::ScrolledWindow"); my $adjustment = Gtk2::Adjustment -> new(0, 0, 100, 1, 5, 10); $window -> set_hadjustment($adjustment); is($window -> get_hadjustment(), $adjustment); $window -> set_vadjustment($adjustment); is($window -> get_vadjustment(), $adjustment); $window = Gtk2::ScrolledWindow -> new(undef, undef); isa_ok($window, "Gtk2::ScrolledWindow"); my $label = Gtk2::Label -> new("Bla"); $window -> add_with_viewport($label); $window = Gtk2::ScrolledWindow -> new($adjustment, $adjustment); isa_ok($window, "Gtk2::ScrolledWindow"); $window -> set_policy("always", "automatic"); is_deeply([$window -> get_policy()], ["always", "automatic"]); $window -> set_placement("bottom-right"); is($window -> get_placement(), "bottom-right"); $window -> set_shadow_type("etched-in"); is($window -> get_shadow_type(), "etched-in"); SKIP: { skip("new 2.8 stuff", 2) unless Gtk2->CHECK_VERSION (2, 8, 0); isa_ok($window -> get_hscrollbar(), "Gtk2::Scrollbar"); isa_ok($window -> get_vscrollbar(), "Gtk2::Scrollbar"); } SKIP: { skip("new 2.10 stuff", 0) unless Gtk2->CHECK_VERSION (2, 10, 0); $window -> unset_placement(); } __END__ Copyright (C) 2003-2006 by the gtk2-perl team (see the file AUTHORS for the full list). See LICENSE for more information. Gtk2-1.24992/t/GtkCurve.t0000644000175000017500000000174713076462676013335 0ustar lacklack# # $Id$ # ######################### # GtkCurve Tests # - rm ######################### use Gtk2::TestHelper tests => 8; my $win = Gtk2::Window->new ("toplevel"); $win->set_default_size (100, 100); ok (my $curve = Gtk2::Curve->new (), 'Gtk2::Curve->new'); $win->add ($curve); $win->show_all; $curve->set_gamma (1.5); $curve->reset; my @vec = $curve->get_vector (4); is (scalar (@vec), 4, 'get_vector size'); @vec = $curve->get_vector (2); ok (eq_array (\@vec, [0, 1]), 'get_vector values'); $curve->set_range (0, 128, 0, 255); ok (eq_array ([$curve->get (qw/min-x max-x min-y max-y/)], [0, 128, 0, 255]), 'set_range'); $curve->set_vector (0, 255); @vec = $curve->get_vector (2); ok (eq_array (\@vec, [0, 255]), 'set_vector'); foreach (qw/linear spline free/) { $curve->set_curve_type ($_); is ($curve->get ('curve-type'), $_, "set_curve_type $_"); } __END__ Copyright (C) 2003 by the gtk2-perl team (see the file AUTHORS for the full list). See LICENSE for more information. Gtk2-1.24992/t/GtkInvisible.t0000644000175000017500000000113613076462677014166 0ustar lacklack#!/usr/bin/perl -w use strict; use Gtk2::TestHelper tests => 3; # $Id$ my $invisible = Gtk2::Invisible -> new(); isa_ok($invisible, "Gtk2::Invisible"); SKIP: { skip("GdkScreen is new in 2.2", 2) unless Gtk2->CHECK_VERSION (2, 2, 0); my $screen = Gtk2::Gdk::Screen -> get_default(); $invisible = Gtk2::Invisible -> new_for_screen($screen); isa_ok($invisible, "Gtk2::Invisible"); $invisible -> set_screen($screen); is($invisible -> get_screen(), $screen); } __END__ Copyright (C) 2003 by the gtk2-perl team (see the file AUTHORS for the full list). See LICENSE for more information. Gtk2-1.24992/t/GtkImage.t0000644000175000017500000001540413076462677013267 0ustar lacklack#!/usr/bin/perl # # $Id$ # ######################### # GtkImage Tests # - rm ######################### use Data::Dumper; use Gtk2::TestHelper tests => 45; # get some things ready to use below ########################################### # borrowed from xsane-icons.c my @pixbuf_data = ( " 20 20 4 1", " none", ". c #000000", "+ c #208020", "a c #ffffff", " ", " ................. ", " .+++++++++++++++. ", " .+ . +. ", " .+ ... +. ", " .+ . . . +. ", " .+ . +. ", " .+ . +. ", " .+ . . . +. ", " .+ . . . +. ", " .+.............+. ", " .+ . . . +. ", " .+ . . . +. ", " .+ . +. ", " .+ . . . +. ", " .+ ... +. ", " .+ . +. ", " .+++++++++++++++. ", " ................. ", " ", ); my $pixbuf = Gtk2::Gdk::Pixbuf->new_from_xpm_data (@pixbuf_data); my ($pixmap, $mask) = $pixbuf->render_pixmap_and_mask (255); my $iconset = Gtk2::IconSet->new_from_pixbuf ($pixbuf); # Plain old new ################################################################ ok (my $img = Gtk2::Image->new, 'Gtk2::Image->new'); ok (eq_array ([$img->get_icon_set], [undef, 'button']), 'get_icon_set empty'); is ($img->get_image, undef, 'get_image empty'); is ($img->get_pixbuf, undef, 'get_pixbuf empty'); is ($img->get_pixmap, undef, 'get_pixmap empty'); ok (eq_array ([$img->get_stock ()], [undef, 'button']), 'get_stock empty'); is ($img->get_animation, undef, 'get_animation empty'); is ($img->get_storage_type, 'empty', 'get_storage_type empty'); # new from stock ############################################################### ok ($img = Gtk2::Image->new_from_stock ('gtk-cancel', 'menu'), 'Gtk2::Image->new_from_stock'); is ($img->get_storage_type, 'stock', 'new_from_stock get_storage_type'); ok (eq_array ([$img->get_stock ()], ['gtk-cancel', 'menu']), 'new_from_stock get_stock'); # new from icon set ############################################################ ok ($img = Gtk2::Image->new_from_icon_set ($iconset, 'small-toolbar'), 'Gtk2::Image->new_from_icon_set'); my @ret = $img->get_icon_set; is (scalar (@ret), 2, 'new_from_icon_set get_icon_set num rets'); isa_ok ($ret[0], 'Gtk2::IconSet', 'new_from_icon_set get_icon_set icon_set'); is ($ret[1], 'small-toolbar', 'new_from_icon_set get_icon_set size'); # new from image ############################################################### ok ($img = Gtk2::Image->new_from_image (undef, undef), 'Gtk2::Image->new_from_pixbuf undef'); is ($img->get_image, undef, 'new_from_image get_image empty'); # TODO: from a valid image # new from pixbuf ############################################################## ok ($img = Gtk2::Image->new_from_pixbuf ($pixbuf), 'Gtk2::Image->new_from_pixbuf'); isa_ok ($img->get_pixbuf, 'Gtk2::Gdk::Pixbuf', 'new_from_pixbuf get_pixbuf'); # new from pixmap ############################################################## ok ($img = Gtk2::Image->new_from_pixmap (undef, undef), 'Gtk2::Image->new_from_pixbuf'); ok ($img = Gtk2::Image->new_from_pixmap ($pixmap, $mask), 'Gtk2::Image->new_from_pixbuf'); @ret = $img->get_pixmap; is (scalar(@ret), 2, 'new_from_pixmap get_pixmap num rets'); isa_ok ($ret[0], 'Gtk2::Gdk::Pixmap', 'new_from_pixmap get_pixbuf pixmap'); isa_ok ($ret[1], 'Gtk2::Gdk::Bitmap', 'new_from_pixmap get_pixbuf mask'); # set from stock ############################################################### $img->set_from_stock ('gtk-quit', 'dialog'); is ($img->get_storage_type, 'stock', 'set_from_stock get_storage_type'); ok (eq_array ([$img->get_stock ()], ['gtk-quit', 'dialog']), 'set_from_stock get_stock'); # set from icon set ############################################################ $img->set_from_icon_set ($iconset, 'small-toolbar'); @ret = $img->get_icon_set; is (scalar (@ret), 2, 'set_from_icon_set get_icon_set num rets'); isa_ok ($ret[0], 'Gtk2::IconSet', 'set_from_icon_set get_icon_set icon_set'); is ($ret[1], 'small-toolbar', 'set_from_icon_set get_icon_set size'); # set from image ############################################################### $img->set_from_image (undef, undef); is ($img->get_image, undef, 'set_from_image get_image empty'); # TODO: from a valid image # set from pixbuf ############################################################## $img->set_from_pixbuf (undef); $img->set_from_pixbuf ($pixbuf); isa_ok ($img->get_pixbuf, 'Gtk2::Gdk::Pixbuf', 'set_from_pixbuf get_pixbuf'); # set from pixmap ############################################################## $img->set_from_pixmap (undef, undef); $img->set_from_pixmap ($pixmap, $mask); @ret = $img->get_pixmap; is (scalar(@ret), 2, 'set_from_pixmap get_pixmap num rets'); isa_ok ($ret[0], 'Gtk2::Gdk::Pixmap', 'set_from_pixmap get_pixbuf pixmap'); isa_ok ($ret[1], 'Gtk2::Gdk::Bitmap', 'set_from_pixmap get_pixbuf mask'); # These require access to a file, so they may be skipped my $testfile = './gtk-demo/gnome-foot.png'; SKIP: { skip "unable to find test file, $testfile", 1 unless (-R $testfile); my $animation = Gtk2::Gdk::PixbufAnimation->new_from_file ($testfile); # new from file ################################################################ ok ($img = Gtk2::Image->new_from_file (undef), 'Gtk2::Image->new_from_file undef'); ok ($img = Gtk2::Image->new_from_file ($testfile), 'Gtk2::Image->new_from_file'); isa_ok ($img->get_pixbuf, 'Gtk2::Gdk::Pixbuf', 'new_from_file get_pixbuf'); # new from animation ########################################################### ok ($img = Gtk2::Image->new_from_animation ($animation), 'Gtk2::Image->new_from_animation'); isa_ok ($img->get_animation, 'Gtk2::Gdk::PixbufAnimation', 'new_from_animation get_animationf'); # set from file ################################################################ $img->set_from_file (undef); $img->set_from_file ($testfile); isa_ok ($img->get_pixbuf, 'Gtk2::Gdk::Pixbuf', 'set_from_file get_pixbuf'); # set from animation ########################################################### $img->set_from_animation ($animation); isa_ok ($img->get_animation, 'Gtk2::Gdk::PixbufAnimation', 'set_from_animation get_animationf'); } SKIP: { skip 'new stuff in 2.6', 4 unless Gtk2->CHECK_VERSION (2, 6, 0); $img = Gtk2::Image->new_from_icon_name ('gtk-ok', 'button'); isa_ok ($img, 'Gtk2::Image'); is_deeply ([$img->get_icon_name], ['gtk-ok', 'button']); $img->set_from_icon_name ('gtk-cancel', 'menu'); is_deeply ([$img->get_icon_name], ['gtk-cancel', 'menu']); $img->set_pixel_size (23); is ($img->get_pixel_size, 23); } SKIP: { skip 'new stuff in 2.8', 0 unless Gtk2->CHECK_VERSION (2, 8, 0); $img->clear; } __END__ Copyright (C) 2003-2005 by the gtk2-perl team (see the file AUTHORS for the full list). See LICENSE for more information. Gtk2-1.24992/t/GtkPaperSize.t0000644000175000017500000000314613076462677014147 0ustar lacklack#!/usr/bin/perl -w use strict; use Gtk2::TestHelper tests => 20, at_least_version => [2, 10, 0, "GtkPaperSize is new in 2.10"]; # $Id$ my $size = Gtk2::PaperSize -> new(undef); isa_ok($size, "Gtk2::PaperSize"); $size = Gtk2::PaperSize -> new_from_ppd("urgs?", "A4", 23, 42); isa_ok($size, "Gtk2::PaperSize"); is($size -> get_ppd_name(), "urgs?"); $size = Gtk2::PaperSize -> new_custom("bla", "Bla", 23, 42, "mm"); isa_ok($size, "Gtk2::PaperSize"); is($size -> get_width("mm"), 23); is($size -> get_height("mm"), 42); ok($size -> is_custom()); $size -> set_size(42, 23, "mm"); $size = Gtk2::PaperSize -> new("iso_a4"); isa_ok($size, "Gtk2::PaperSize"); ok($size -> is_equal($size)); is($size -> get_name(), "iso_a4"); is($size -> get_display_name(), "A4"); ok(defined $size -> get_default_top_margin("mm")); ok(defined $size -> get_default_bottom_margin("points")); ok(defined $size -> get_default_left_margin("inch")); ok(defined $size -> get_default_right_margin("mm")); ok(defined Gtk2::PaperSize -> get_default()); SKIP: { skip 'new 2.12 stuff', 4 unless Gtk2->CHECK_VERSION (2, 12, 0); my $key_file = Glib::KeyFile -> new(); my $group = 'bla'; $size -> to_key_file($key_file, $group); my $new_size; eval { $new_size = Gtk2::PaperSize -> new_from_key_file($key_file, $group); }; is($@, ''); isa_ok($new_size, 'Gtk2::PaperSize'); is($new_size -> get_name(), 'iso_a4'); my @sizes = Gtk2::PaperSize::get_paper_sizes(FALSE); isa_ok($sizes[0], 'Gtk2::PaperSize'); } __END__ Copyright (C) 2006 by the gtk2-perl team (see the file AUTHORS for the full list). See LICENSE for more information. Gtk2-1.24992/t/GtkAboutDialog.t0000644000175000017500000001100613076462676014430 0ustar lacklack# # $Id$ # ######################### # GtkAboutDialog Tests # - rm ######################### ######################### use strict; use warnings; use Gtk2::TestHelper tests => 34, at_least_version => [2, 6, 0, "GtkAboutDialog is new in 2.6"]; isa_ok (my $dialog = Gtk2::AboutDialog->new, 'Gtk2::AboutDialog', 'Gtk2::AboutDialog->new'); $dialog->set_program_name ('AboutDialog'); is ($dialog->get_program_name, 'AboutDialog', '$dialog->set|get_program_name'); $dialog->set_program_name (undef); # according to the docs, name falls back to g_get_application_name(). is ($dialog->get_program_name, Glib::get_application_name, 'fallback'); $dialog->set_version ('Ver: 1.2'); is ($dialog->get_version, 'Ver: 1.2', '$dialog->set|get_version'); $dialog->set_version (undef); is ($dialog->get_version, undef); $dialog->set_copyright ('2004'); is ($dialog->get_copyright, '2004', '$dialog->set|get_copyright'); $dialog->set_copyright (undef); is ($dialog->get_copyright, undef); $dialog->set_comments ('this is a comment'); is ($dialog->get_comments, 'this is a comment', '$dialog->set|get_comments'); $dialog->set_comments (undef); is ($dialog->get_comments, undef); $dialog->set_license ('LGPL'); is ($dialog->get_license, 'LGPL', '$dialog->set|get_license'); $dialog->set_license (undef); is ($dialog->get_license, undef); SKIP: { skip "new 2.8 stuff", 1 unless Gtk2->CHECK_VERSION (2, 8, 0); $dialog->set_wrap_license (TRUE); is ($dialog->get_wrap_license, TRUE); } $dialog->set_authors (qw/one two three/); ok (eq_array ([$dialog->get_authors], [qw/one two three/]), '$dialog->set|get_authors'); $dialog->set_documenters (qw/two three four/); ok (eq_array ([$dialog->get_documenters], [qw/two three four/]), '$dialog->set|get_documenters'); $dialog->set_artists (qw/three four five/); ok (eq_array ([$dialog->get_artists], [qw/three four five/]), '$dialog->set|get_artists'); $dialog->set_translator_credits ('people'); is ($dialog->get_translator_credits, 'people', '$dialog->set|get_translator_credits'); $dialog->set_translator_credits (undef); is ($dialog->get_translator_credits, undef); $dialog->set_logo (undef); is ($dialog->get_logo, undef, '$dialog->get_logo undef'); my $pb = Gtk2::Gdk::Pixbuf->new ('rgb', TRUE, 8, 61, 33); $dialog->set_logo ($pb); isa_ok ($dialog->get_logo, 'Gtk2::Gdk::Pixbuf', '$dialog->set|get_logo'); $dialog->set_logo_icon_name ('gtk-ok'); is ($dialog->get_logo_icon_name, 'gtk-ok', '$dialog->set|get_logo_icon_name'); SKIP: { skip "get_logo_icon_name is slightly broken in 2.6", 1 unless Gtk2->CHECK_VERSION (2, 6, 1); $dialog->set_logo_icon_name (undef); is ($dialog->get_logo_icon_name, undef); } $dialog->set_email_hook (sub { warn @_; }, "urgs"); $dialog->set_email_hook (sub { warn @_; }); $dialog->set_url_hook (sub { warn @_; }, "urgs"); $dialog->set_url_hook (sub { warn @_; }); $dialog->set_website_label ('website'); is ($dialog->get_website_label, 'website', '$dialog->set|get_website_label'); $dialog->set_website_label (undef); is ($dialog->get_website_label, undef); $dialog->set_website ('http://gtk2-perl.sourceforge.net/'); is ($dialog->get_website, 'http://gtk2-perl.sourceforge.net/', '$dialog->set|get_website'); $dialog->set_website (undef); is ($dialog->get_website, undef); # test out the Glib::Strv properties. this is partially to make sure these # work right for the dialog, and partially to test the functionality from # Glib (there's nothing that can really test them in gobject). $dialog->set (authors => 'me'); ok (eq_array ($dialog->get ('authors'), ['me']), 'authors property (scalar)'); my @authors = qw/me myself i/; $dialog->set (authors => \@authors); ok (eq_array ($dialog->get ('authors'), \@authors), 'authors property (array)'); $dialog->set (authors => undef); ok (!$dialog->get ('authors'), 'authors property (undef)'); $dialog->set (documenters => []); ok (!$dialog->get ('documenters'), 'documenters property (empty array)'); my @artists = qw/Leonardo Donatello Raphael Michelangelo/; $dialog->set (artists => \@artists); ok (eq_array ($dialog->get ('artists'), \@artists), 'artists property'); Gtk2->show_about_dialog (undef, program_name => 'Foo', version => '42', authors => [qw/me myself i/], ); SKIP: { skip 'new 2.12 stuff', 4 unless Gtk2->CHECK_VERSION (2, 12, 0); # Called 3 times $SIG{__WARN__} = sub { like shift, qr/Deprecation warning/; }; $dialog->set_name ('AboutDialogAbout'); is ($dialog->get_name, 'AboutDialogAbout', '$dialog->set|get_name'); Gtk2->show_about_dialog (Gtk2::Window->new, name => 'AboutFoo'); } Gtk2-1.24992/t/GtkNotebook.t0000644000175000017500000001064713076462677014031 0ustar lacklack#!/usr/bin/env perl ######################### # GtkNotbook Tests # - rm ######################### use Gtk2::TestHelper tests => 66; my $win = Gtk2::Window->new; ok( my $nb = Gtk2::Notebook->new ); $win->add($nb); ok(1); # just to make the lines shorter sub label { Gtk2::Label->new (shift) } is ($nb->prepend_page (label ('p1c'), label ('p1')), 0); is ($nb->append_page (label ('p2c'), label ('p2')), 1); my $child = label ('p1.5c'); is ($nb->insert_page ($child, label ('p1.5'), 1), 1); is ($nb->prepend_page_menu (label ('Page 1c'), undef, label ('Page 1 pop')), 0); is ($nb->append_page_menu (label ('Page 6c'), label ('Page 6l'), label ('Page 6 pop')), 4);; my $child2 = label ('Page 2c'); is ($nb->insert_page_menu ($child2, label ('Page 2 pop'), undef, 1), 1); is ($nb->insert_page (label ('remove'), label ('remove'), 7), 6); is ($nb->insert_page (label ('remove'), label ('remove'), 7), 7); is ($nb->insert_page (label ('remove'), label ('remove'), 0), 0); $nb->remove_page(7); ok(1); $nb->remove_page(0); ok(1); $nb->remove_page(-1); ok(1); foreach (qw/left right bottom top/) { $nb->set_tab_pos($_); ok(1); ok( $nb->get_tab_pos eq $_ ); } $nb->set_show_tabs(0); ok(1); ok( ! $nb->get_show_tabs ); $nb->set_show_tabs(1); ok(1); ok( $nb->get_show_tabs ); $nb->set_show_border(0); ok(1); ok( ! $nb->get_show_border ); $nb->set_show_border(1); ok(1); ok( $nb->get_show_border ); $nb->set_scrollable(1); ok(1); ok( $nb->get_scrollable ); $nb->set_scrollable(0); ok(1); $nb->popup_disable; ok(1); $nb->popup_enable; ok(1); ok( ! $nb->get_scrollable ); # in reality this one is only in gtk2.2+, but it's been implemented in # the xs wrapper since it's trivial anyway ok( $nb->get_n_pages == 6 ); $nb->set_menu_label($child2, Gtk2::Label->new('re-set')); ok(1); ok( $nb->get_menu_label($child2)->get_text eq 're-set'); $nb->set_menu_label_text($child2, 're-set2'); ok(1); ok( $nb->get_menu_label_text($child2) eq 're-set2'); $nb->set_tab_label($child, Gtk2::Label->new('re-set')); ok(1); ok( $nb->get_tab_label($child)->get_text eq 're-set' ); $nb->set_tab_label_text($child, 're-set2'); ok(1); ok( $nb->get_tab_label_text($child) eq 're-set2' ); ok( $nb->get_nth_page(1)->get_text eq 'Page 2c' ); is_deeply( [ $nb->query_tab_label_packing($child) ], [ FALSE, TRUE, 'start' ] ); $nb->set_tab_label_packing($child, 1, 0, 'end'); ok(1); is_deeply( [ $nb->query_tab_label_packing($child) ], [ TRUE, FALSE, 'end' ] ); SKIP: { skip "2.10 stuff", 3 unless Gtk2->CHECK_VERSION (2, 10, 0); $nb->set_group_id (23); is ($nb->get_group_id, 23); $nb->set_tab_reorderable ($child, TRUE); ok ($nb->get_tab_reorderable ($child)); $nb->set_tab_detachable ($child, TRUE); ok ($nb->get_tab_detachable ($child)); } SKIP: { skip "2.20 stuff", 1 unless Gtk2->CHECK_VERSION (2, 20, 0); my $button=Gtk2::Button->new("click me"); $nb->set_action_widget($button,'end'); is ($nb->get_action_widget('end'), $button, '[gs]et_action_widget'); } SKIP: { skip 'new 2.22 stuff', 2 unless Gtk2->CHECK_VERSION(2, 22, 0); ok (defined $nb->get_tab_hborder); ok (defined $nb->get_tab_vborder); } $win->show_all; ok(1); run_main sub { $nb->next_page; ok(1); $nb->prev_page; ok(1); ok( (my $index = $nb->page_num($child)) == 3 ); $nb->reorder_child($child, 0); ok(1); $nb->reorder_child($child, $index); ok( $nb->get_current_page == 0 ); $nb->next_page; ok(1); ok( $nb->get_current_page == 1 ); $nb->set_current_page(4); ok(1); ok( $nb->get_current_page == 4 ); }; ok(1); =comment Here's some interactive code for testing the window creation hook. my $w = Gtk2::Window->new; my $nb = Gtk2::Notebook->new; $nb->append_page (my $c = Gtk2::Label->new ('Test')); $nb->set_tab_detachable ($c, TRUE); Gtk2::Notebook->set_window_creation_hook ( sub { my ($notebook, $page, $x, $y, $data) = @_; my $new_window = Gtk2::Window->new; my $new_notebook = Gtk2::Notebook->new; $new_window->add ($new_notebook); $new_window->show_all; # Either do it manually and return undef, or ... #$notebook->remove ($page); #$new_notebook->append_page ($page); #return undef; # ... simply return the new notebook and let gtk+ do the work. return $new_notebook; }); $w->add ($nb); $w->signal_connect (destroy => sub { Gtk2->main_quit; }); $w->show_all; Gtk2->main; =cut __END__ Copyright (C) 2003-2006 by the gtk2-perl team (see the file AUTHORS for the full list). See LICENSE for more information. Gtk2-1.24992/t/GtkHScrollbar.t0000644000175000017500000000061113076462677014272 0ustar lacklack#!/usr/bin/perl -w use strict; use Gtk2::TestHelper tests => 2, noinit => 1; # $Id$ my $adjustment = Gtk2::Adjustment -> new(0, 0, 100, 1, 5, 10); my $bar = Gtk2::HScrollbar -> new($adjustment); isa_ok($bar, "Gtk2::Scrollbar"); isa_ok($bar, "Gtk2::HScrollbar"); __END__ Copyright (C) 2003 by the gtk2-perl team (see the file AUTHORS for the full list). See LICENSE for more information. Gtk2-1.24992/t/GdkKeys.t0000644000175000017500000000726513076462676013145 0ustar lacklack#!/usr/bin/perl -w use strict; use Gtk2::TestHelper tests => 46; # $Id$ use Gtk2::Gdk::Keysyms; my $map = Gtk2::Gdk::Keymap -> get_default(); isa_ok($map, "Gtk2::Gdk::Keymap"); SKIP: { skip("GdkDisplay is new in 2.2", 1) unless Gtk2->CHECK_VERSION (2, 2, 0); $map = Gtk2::Gdk::Keymap -> get_for_display (Gtk2::Gdk::Display -> get_default()); isa_ok($map, "Gtk2::Gdk::Keymap"); } my @keys = $map -> get_entries_for_keyval($Gtk2::Gdk::Keysyms{ Escape }); SKIP: { skip 'No key entries for Escape found in the keymap', 41 unless scalar @keys; isa_ok($keys[0], "HASH"); like($keys[0] -> { keycode }, qr/^\d+$/); like($keys[0] -> { group }, qr/^\d+$/); like($keys[0] -> { level }, qr/^\d+$/); @keys = Gtk2::Gdk::Keymap -> get_entries_for_keyval($Gtk2::Gdk::Keysyms{ Escape }); isa_ok($keys[0], "HASH"); like($keys[0] -> { keycode }, qr/^\d+$/); like($keys[0] -> { group }, qr/^\d+$/); like($keys[0] -> { level }, qr/^\d+$/); my ($keyval, $group, $level, $mods) = $map -> translate_keyboard_state($keys[0] -> { keycode }, [qw(shift-mask)], 0); like($keyval, qr/^\d+$/); like($group, qr/^\d+$/); like($level, qr/^\d+$/); isa_ok($mods, "Gtk2::Gdk::ModifierType"); SKIP: { skip("translate_keyboard_state is broken", 4) unless (Gtk2 -> CHECK_VERSION(2, 4, 1)); ($keyval, $group, $level, $mods) = Gtk2::Gdk::Keymap -> translate_keyboard_state($keys[0] -> { keycode }, [qw(shift-mask)], 0); like($keyval, qr/^\d+$/); like($group, qr/^\d+$/); like($level, qr/^\d+$/); isa_ok($mods, "Gtk2::Gdk::ModifierType"); } my $key = { keycode => $keys[0] -> { keycode }, group => $group, level => $level }; like($map -> lookup_key($key), qr/^\d+$/); like(Gtk2::Gdk::Keymap -> lookup_key($key), qr/^\d+$/); my @entries = $map -> get_entries_for_keycode($keys[0] -> { keycode }); isa_ok($entries[0], "HASH"); like($entries[0] -> { keyval }, qr/^\d+$/); isa_ok($entries[0] -> { key }, "HASH"); like($entries[0] -> { key } -> { keycode }, qr/^\d+$/); like($entries[0] -> { key } -> { group }, qr/^\d+$/); like($entries[0] -> { key } -> { level }, qr/^\d+$/); @entries = Gtk2::Gdk::Keymap -> get_entries_for_keycode($keys[0] -> { keycode }); isa_ok($entries[0], "HASH"); like($entries[0] -> { keyval }, qr/^\d+$/); isa_ok($entries[0] -> { key }, "HASH"); like($entries[0] -> { key } -> { keycode }, qr/^\d+$/); like($entries[0] -> { key } -> { group }, qr/^\d+$/); like($entries[0] -> { key } -> { level }, qr/^\d+$/); ok(defined($map -> get_direction())); ok(defined(Gtk2::Gdk::Keymap -> get_direction())); SKIP: { skip "new 2.12 stuff", 1 unless Gtk2 -> CHECK_VERSION(2, 12, 0); ok(defined($map -> have_bidi_layouts())); } SKIP: { skip "new 2.16 stuff", 1 unless Gtk2 -> CHECK_VERSION(2, 16, 0); ok(defined($map -> get_caps_lock_state), 'get_caps_lock_state'); } my $a = $Gtk2::Gdk::Keysyms{ a }; my $A = $Gtk2::Gdk::Keysyms{ A }; is(Gtk2::Gdk -> keyval_name($a), "a"); is(Gtk2::Gdk -> keyval_from_name("a"), $a); is_deeply([Gtk2::Gdk -> keyval_convert_case($a)], [$a, $A]); is(Gtk2::Gdk -> keyval_to_upper($a), $A); is(Gtk2::Gdk -> keyval_to_lower($A), $a); is(Gtk2::Gdk -> keyval_is_upper($A), 1); is(Gtk2::Gdk -> keyval_is_lower($a), 1); my $unicode = Gtk2::Gdk -> keyval_to_unicode($a); is(Gtk2::Gdk -> unicode_to_keyval($unicode), $a); } SKIP: { skip 'new 2.20 stuff', 2 unless Gtk2->CHECK_VERSION(2, 20, 0); my $map = Gtk2::Gdk::Keymap -> get_default(); ok(defined $map -> add_virtual_modifiers([qw/mod1-mask super-mask/])); my ($result, $new_state) = $map -> map_virtual_modifiers([qw/mod1-mask super-mask/]); ok(defined $result && defined $new_state); } __END__ Copyright (C) 2003 by the gtk2-perl team (see the file AUTHORS for the full list). See LICENSE for more information. Gtk2-1.24992/t/GtkToolItem.t0000644000175000017500000000553413076462677014004 0ustar lacklack#!/usr/bin/perl # # $Id$ # use Gtk2::TestHelper at_least_version => [2, 4, 0, "Action-based menus are new in 2.4"], tests => 24; my $tool_item = Gtk2::ToolItem->new; isa_ok ($tool_item, 'Gtk2::ToolItem'); $tool_item->set_homogeneous (TRUE); ok ($tool_item->get_homogeneous); $tool_item->set_homogeneous (FALSE); ok (!$tool_item->get_homogeneous); $tool_item->set_expand (TRUE); ok ($tool_item->get_expand); $tool_item->set_expand (FALSE); ok (!$tool_item->get_expand); my $tooltips = Gtk2::Tooltips->new; $tool_item->set_tooltip ($tooltips, 'tip_text', 'tip_private'); $tool_item->set_use_drag_window (TRUE); ok ($tool_item->get_use_drag_window); $tool_item->set_use_drag_window (FALSE); ok (!$tool_item->get_use_drag_window); $tool_item->set_visible_horizontal (TRUE); ok ($tool_item->get_visible_horizontal); $tool_item->set_visible_horizontal (FALSE); ok (!$tool_item->get_visible_horizontal); $tool_item->set_visible_vertical (TRUE); ok ($tool_item->get_visible_vertical); $tool_item->set_visible_vertical (FALSE); ok (!$tool_item->get_visible_vertical); $tool_item->set_is_important (TRUE); ok ($tool_item->get_is_important); $tool_item->set_is_important (FALSE); ok (!$tool_item->get_is_important); is ($tool_item->get_icon_size, 'large-toolbar'); is ($tool_item->get_orientation, 'horizontal'); is ($tool_item->get_toolbar_style, 'icons'); is ($tool_item->get_relief_style, 'none'); $tool_item->set_proxy_menu_item ("menu_item_id", undef); is ($tool_item->get_proxy_menu_item ("menu_item_id"), undef, 'set_proxy_menu_item() to undef'); my $menu_item = Gtk2::MenuItem->new; $tool_item->set_proxy_menu_item ("menu_item_id", $menu_item); is ($tool_item->retrieve_proxy_menu_item, $menu_item); is ($tool_item->get_proxy_menu_item ("menu_item_id"), $menu_item); SKIP: { skip 'new stuff in gtk+ 2.6', 0 unless Gtk2->CHECK_VERSION (2, 6, 0); $tool_item->rebuild_menu; } SKIP: { skip 'new 2.12 stuff', 0 unless Gtk2->CHECK_VERSION (2, 12, 0); $tool_item->set_tooltip_text ('Bla!'); $tool_item->set_tooltip_text (undef); $tool_item->set_tooltip_markup ('Bla!'); $tool_item->set_tooltip_markup (undef); } SKIP: { skip 'new 2.14 stuff', 0 unless Gtk2->CHECK_VERSION(2, 14, 0); $tool_item->toolbar_reconfigured; } SKIP: { skip 'new 2.20 stuff', 4 unless Gtk2->CHECK_VERSION(2, 20, 0); ok (defined $tool_item->get_ellipsize_mode); ok (defined $tool_item->get_text_alignment); ok (defined $tool_item->get_text_orientation); my $palette = Gtk2::ToolPalette->new; my $bar = Gtk2::ToolItemGroup->new ('Test'); $bar->add ($tool_item); $palette->add ($bar); isa_ok ($tool_item->get_text_size_group, 'Gtk2::SizeGroup'); } __END__ Copyright (C) 2003-2005, 2011 by the gtk2-perl team (see the file AUTHORS for the full list). See LICENSE for more information. Gtk2-1.24992/t/GtkTearoffMenuItem.t0000644000175000017500000000045113076462677015273 0ustar lacklack#!/usr/bin/perl -w use strict; use Gtk2::TestHelper tests => 1, noinit => 1; # $Id$ my $item = Gtk2::TearoffMenuItem -> new(); isa_ok($item, "Gtk2::TearoffMenuItem"); __END__ Copyright (C) 2003 by the gtk2-perl team (see the file AUTHORS for the full list). See LICENSE for more information. Gtk2-1.24992/t/GtkTextBufferRichText.t0000644000175000017500000002137413076462677016001 0ustar lacklack#!/usr/bin/perl -w # vim: set ft=perl : # # Copyright (c) 2006 by the gtk2-perl team (see the file AUTHORS) # # This library is free software; you can redistribute it and/or # modify it under the terms of the GNU Library General Public # License as published by the Free Software Foundation; either # version 2.1 of the License, or (at your option) any later version. # # This library is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU # Library General Public License for more details. # # You should have received a copy of the GNU Library General Public # License along with this library; if not, write to the # Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, # Boston, MA 02110-1301 USA. # # $Id$ # use strict; use Gtk2::TestHelper tests => 46, at_least_version => [2, 10, 0, "GtkTextBufferRichText is new in 2.10"]; sub dump_formats { for (my $i = 0 ; $i < @_ ; $i++) { print " $i ".$_[0]->name."\n"; } } sub serialize_func { my ($register_buffer, $content_buffer, $start_iter, $end_iter, $user_data) = @_; isa_ok ($register_buffer, 'Gtk2::TextBuffer'); isa_ok ($content_buffer, 'Gtk2::TextBuffer'); isa_ok ($start_iter, 'Gtk2::TextIter'); isa_ok ($end_iter, 'Gtk2::TextIter'); # should return a string. we'll do something silly like wrap the whole # text string in curly braces. return "{".$content_buffer->get_text ($start_iter, $end_iter, FALSE)."}"; } sub deserialize_func { my ($register_buffer, $content_buffer, $iter, $data, $create_tags, $user_data) = @_; isa_ok ($register_buffer, 'Gtk2::TextBuffer'); isa_ok ($content_buffer, 'Gtk2::TextBuffer'); isa_ok ($iter, 'Gtk2::TextIter'); ok ($data); ok (defined $create_tags); # our serialize func wrapped curly braces around the text. remove them. $data =~ s/^{//; $data =~ s/}$//; $content_buffer->insert ($iter, $data); # can croak on error, we should be able to trap it. } my $buffer = Gtk2::TextBuffer->new; my $content_buffer = Gtk2::TextBuffer->new; isa_ok ($buffer, 'Gtk2::TextBuffer'); isa_ok ($content_buffer, 'Gtk2::TextBuffer'); my $mime_type = "application/funky"; my $tagset_name = "funky"; # don't know if there are any preregistered formats, so let's register the # built-in gtk rich text one first. With no tagset_name, we get the full set. my $serialize_tagset_atom = $buffer->register_serialize_tagset (undef); ok ($serialize_tagset_atom); is ($serialize_tagset_atom->name, 'application/x-gtk-text-buffer-rich-text'); # check. my @serialize_formats = $buffer->get_serialize_formats (); is (scalar (@serialize_formats), 1); is ($serialize_formats[0]->name, $serialize_tagset_atom->name); # now register a custom serialization format... my $serialize_format_atom = $buffer->register_serialize_format ($mime_type, \&serialize_func); ok ($serialize_format_atom); @serialize_formats = $buffer->get_serialize_formats; is (scalar (@serialize_formats), 2); ok (scalar (grep { $_ == $serialize_format_atom } $buffer->get_serialize_formats)); # now the same for the deserialization formats. # With no tagset_name, we get the full set. my $deserialize_tagset_atom = $buffer->register_deserialize_tagset (undef); ok ($deserialize_tagset_atom); is ($deserialize_tagset_atom->name, 'application/x-gtk-text-buffer-rich-text'); my @deserialize_formats = $buffer->get_deserialize_formats (); is (scalar (@deserialize_formats), 1); # register a custom serialization format... my $deserialize_format_atom = $buffer->register_deserialize_format ($mime_type, \&deserialize_func); ok ($deserialize_format_atom); @deserialize_formats = $buffer->get_deserialize_formats; is (scalar (@deserialize_formats), 2); ok (scalar (grep { $_ == $deserialize_format_atom } $buffer->get_deserialize_formats)); # # misc. # $buffer->deserialize_set_can_create_tags ($deserialize_format_atom, FALSE); ok (!$buffer->deserialize_get_can_create_tags ($deserialize_format_atom)); $buffer->deserialize_set_can_create_tags ($deserialize_format_atom, TRUE); ok ($buffer->deserialize_get_can_create_tags ($deserialize_format_atom)); # # now the actual work. # my $text; { local $/ = undef; $text = ; } $content_buffer->insert ($content_buffer->get_start_iter, $text); # first, let's serialize to the gtk rich text stuff. my ($start, $end) = $content_buffer->get_bounds; my $data = $buffer->serialize ($content_buffer, $serialize_tagset_atom, $start, $end); ok ($data); # clear it out and try to deserialize. $content_buffer->delete ($content_buffer->get_bounds); ok (!$content_buffer->get_text ($content_buffer->get_bounds, FALSE)); $buffer->deserialize ($content_buffer, $deserialize_tagset_atom, $content_buffer->get_end_iter, $data); is ($content_buffer->get_text ($content_buffer->get_bounds, FALSE), $text); # fair enough. now try with our custom format. # first, let's serialize to the gtk rich text stuff. $data = $buffer->serialize ($content_buffer, $serialize_format_atom, $content_buffer->get_bounds); ok ($data); # clear it out and try to deserialize. $content_buffer->delete ($content_buffer->get_bounds); ok (!$content_buffer->get_text ($content_buffer->get_bounds, FALSE)); $buffer->deserialize ($content_buffer, $deserialize_format_atom, $content_buffer->get_end_iter, $data); is ($content_buffer->get_text ($content_buffer->get_bounds, FALSE), $text); # # now unregister. # $buffer->unregister_serialize_format ($serialize_format_atom); @serialize_formats = $buffer->get_serialize_formats (); is (scalar (@serialize_formats), 1); $buffer->unregister_deserialize_format ($deserialize_format_atom); @deserialize_formats = $buffer->get_deserialize_formats (); is (scalar (@deserialize_formats), 1); # # now let's make sure we handle exceptions in the deserialize callback. # for good measure, we'll check the user data passing, too. # my $format = $buffer->register_deserialize_format ("text/something-broken", sub { my ($register_buffer, $content_buffer, $iter, $data, $create_tags, $user_data) = @_; isa_ok ($user_data, 'HASH'); is ($user_data->{foo}, 'bar'); die "ouch"; }, { foo => 'bar' }); ok ($format); eval { $buffer->deserialize ($content_buffer, $format, $content_buffer->get_end_iter, $data); }; ok ($@); isa_ok ($@, 'Glib::Error'); like ($@->message, qr/ouch/); $buffer->unregister_deserialize_format ($format); # and, since we also have code to support passing Glib::Errors through # this machinery... $format = $buffer->register_deserialize_format ("text/something-else-broken", sub { Glib::File::Error->throw ('noent', 'ugh') }); ok ($format); eval { $buffer->deserialize ($content_buffer, $format, $content_buffer->get_end_iter, $data); }; ok ($@); isa_ok ($@, 'Glib::Error'); isa_ok ($@, 'Glib::File::Error'); is ($@->value, 'noent'); is ($@->message, 'ugh'); $buffer->unregister_deserialize_format ($format); # today's random input selection is "Bike", by Pink Floyd. __DATA__ I've got a bike You can ride it if you like It's got a basket A bell that rings And things to make it look good I'd give it to you if I could But I borrowed it You're the kind of girl that fits in with my world I'll give you anything Everything if you want things I've got a cloak It's a bit of a joke There's a tear up the front It's red and black I've had it for months If you think it could look good Then I guess it should You're the kind of girl that fits in with my world I'll give you anything Everything if you want things I know a mouse And he hasn't got a house I don't know why I call him Gerald He's getting rather old But he's a good mouse You're the kind of girl that fits in with my world I'll give you anything Everything if you want things I've got a clan of gingerbread men Here a man There a man Lots of gingerbread men Take a couple if you wish They're on the dish You're the kind of girl that fits in with my world I'll give you anything Everything if you want things I know a room full of musical tunes Some rhyme Some ching Most of them are clockwork Let's go into the other room and make them work Gtk2-1.24992/t/GdkImage.t0000644000175000017500000000543013076462676013244 0ustar lacklack#!/usr/bin/perl -w use strict; use Gtk2::TestHelper tests => 23; { my $visual = Gtk2::Gdk::Visual->get_system; my $image = Gtk2::Gdk::Image->new ('normal', $visual, 7, 8); is ($image->get_image_type, 'normal', "get_image_type()"); is ($image->get_visual, $visual, "get_visual()"); ok ($image->get_byte_order, "get_byte_order()"); is ($image->get_width, 7, "get_width()"); is ($image->get_height, 8, "get_height()"); is ($image->get_depth, $visual->depth, "get_depth()"); cmp_ok ($image->get_bytes_per_pixel, '>', 0, "get_bytes_per_pixel()"); cmp_ok ($image->get_bytes_per_line, '>', 0, "get_bytes_per_line()"); cmp_ok ($image->get_bytes_per_line, '>=', $image->get_bytes_per_pixel, "bytes_per_line >= bytes_per_pixel"); cmp_ok ($image->get_bits_per_pixel, '>', 0, "bits_per_pixel"); cmp_ok (8 * $image->get_bytes_per_pixel, '>=', $image->get_bits_per_pixel, "8 * bytes_per_pixel >= bits_per_pixel"); is ($image->get_colormap, undef, "no initial colormap"); my $new_colormap = Gtk2::Gdk::Colormap->new ($visual, 1); $image->set_colormap ($new_colormap); is ($image->get_colormap, $new_colormap, "get_colormap"); my $mem = $image->get_pixels; is (length($mem), $image->get_bytes_per_line * $image->get_height, "get_pixels() length"); } { require Scalar::Util; my $visual = Gtk2::Gdk::Visual->get_system; my $image = Gtk2::Gdk::Image->new ('normal', $visual, 10, 10); Scalar::Util::weaken ($image); is ($image, undef, 'image destroyed on weaken'); } { my $visual = Gtk2::Gdk::Visual->get_system; my $image = Gtk2::Gdk::Image->new ('normal', $visual, 10, 10); my $colormap1 = Gtk2::Gdk::Colormap->new ($visual, 1); my $colormap2 = Gtk2::Gdk::Colormap->new ($visual, 1); $image->set_colormap ($colormap1); is ($image->get_colormap, $colormap1, "get_colormap"); $image->set_colormap ($colormap2); is ($image->get_colormap, $colormap2, "get_colormap"); Scalar::Util::weaken ($image); is ($image, undef, 'image destroyed on weaken'); Scalar::Util::weaken ($colormap1); is ($image, undef, "colormap1 destroyed on weaken (image doesn't hang onto it)"); Scalar::Util::weaken ($colormap2); is ($image, undef, "colormap2 destroyed on weaken (image doesn't hang onto it)"); } { my $visual = Gtk2::Gdk::Visual->get_system; my $image = Gtk2::Gdk::Image->new ('normal', $visual, 10, 10); # pixel values 0 and 1 are always available, even on a depth==1 monochrome # visual $image->put_pixel (5,6, 0); is ($image->get_pixel(5,6), 0, "get_pixel"); $image->put_pixel (5,6, 1); is ($image->get_pixel(5,6), 1, "get_pixel"); $image->put_pixel (5,6, 0); is ($image->get_pixel(5,6), 0, "get_pixel"); } __END__ Copyright (C) 2010 by the gtk2-perl team (see the file AUTHORS for the full list). See LICENSE for more information. Gtk2-1.24992/t/GtkProgressBar.t0000644000175000017500000000204713076462677014475 0ustar lacklack# # $Id$ # ######################### # GtkProgressBar Tests # - rm ######################### use Gtk2::TestHelper tests => 35, noinit => 1; ok( my $vbox = Gtk2::VBox->new( 0, 5 ) ); my @ori = qw/left-to-right right-to-left top-to-bottom bottom-to-top/; my @prog; foreach (@ori) { ok( my $prog = Gtk2::ProgressBar->new ); isa_ok( $prog, 'Gtk2::Widget' ); $vbox->pack_start($prog, 0, 0, 0); $prog->set_orientation($_); is( $prog->get_orientation, $_ ); push @prog, $prog; } foreach (@prog) { $_->pulse; ok(1); $_->set_fraction(0.23); delta_ok( $_->get_fraction, 0.23 ); $_->set_text("Bla"); is( $_->get_text, "Bla" ); $_->set_text(undef); ok( ! $_->get_text ); $_->set_pulse_step(0.42); delta_ok( $_->get_pulse_step, 0.42 ); } ok(1); SKIP: { skip "[sg]et_ellipsize are new in 2.6", 1 unless Gtk2->CHECK_VERSION (2, 6, 0); $prog[0]->set_ellipsize ("middle"); is ($prog[0]->get_ellipsize, "middle"); } __END__ Copyright (C) 2003 by the gtk2-perl team (see the file AUTHORS for the full list). See LICENSE for more information. Gtk2-1.24992/t/GtkCombo.t0000644000175000017500000000315213076462676013300 0ustar lacklack# # $Id$ # # Pretty much complete # # TODO: # GtkList isn't really tested as it's deprecated, should we test it? # ######################### # GtkCombo Tests # - rm ######################### use Gtk2::TestHelper tests => 11; ok (my $combo = Gtk2::Combo->new, 'Gtk2::Combo->new'); $combo->set_popdown_strings (qw/str1 str2 str3 str4/); $combo->list->select_item (0); is ($combo->entry->get_text, 'str1', '$combo->list->select_item|entry->get_text, 1'); $combo->list->select_item (1); is ($combo->entry->get_text, 'str2', '$combo->list->select_item|entry->get_text, 2'); $combo->set_value_in_list (1, 0); $combo->set_use_arrows (0); is ($combo->get ('enable-arrow-keys'), 0, '$combo->use_arrows, false'); $combo->set_use_arrows (1); is ($combo->get ('enable-arrow-keys'), 1, '$combo->use_arrows, true'); $combo->set_use_arrows_always (0); is ($combo->get ('enable-arrows-always'), 0, '$combo->use_arrows_always, false'); $combo->set_use_arrows_always (1); is ($combo->get ('enable-arrows-always'), 1, '$combo->use_arrows_always, true'); $combo->set_case_sensitive (0); is ($combo->get ('case-sensitive'), 0, '$combo->set_case_sensitive, false'); $combo->set_case_sensitive (1); is ($combo->get ('case-sensitive'), 1, '$combo->set_case_sensitive, true'); $combo->set_case_sensitive (0); ok (my $item = Gtk2::ListItem->new_with_label ('test'), 'Gtk2::ListItem->new_with_label'); $combo->set_item_string ($item, 'test-text'); $item->select; $combo->disable_activate; ok (1, 'all complete'); __END__ Copyright (C) 2003 by the gtk2-perl team (see the file AUTHORS for the full list). See LICENSE for more information. Gtk2-1.24992/t/GtkInputDialog.t0000644000175000017500000000043013076462677014455 0ustar lacklack#!/usr/bin/perl -w use strict; use Gtk2::TestHelper tests => 1; # $Id$ my $dialog = Gtk2::InputDialog -> new(); isa_ok($dialog, "Gtk2::InputDialog"); __END__ Copyright (C) 2003 by the gtk2-perl team (see the file AUTHORS for the full list). See LICENSE for more information. Gtk2-1.24992/t/GtkUIManager.t0000644000175000017500000000431013076462677014047 0ustar lacklack# # $Id$ # use Gtk2::TestHelper at_least_version => [2, 4, 0, "GtkUIManager is new in 2.4"], tests => 14; my $ui_manager = Gtk2::UIManager->new; isa_ok ($ui_manager, 'Gtk2::UIManager'); $ui_manager->set_add_tearoffs (TRUE); ok ($ui_manager->get_add_tearoffs); $ui_manager->set_add_tearoffs (FALSE); ok (!$ui_manager->get_add_tearoffs); my $group_one = Gtk2::ActionGroup->new ("Barney"); my $group_two = Gtk2::ActionGroup->new ("Fred"); my @entries = ( [ "HelpMenu", undef, "_Help" ], [ "About", undef, "_About", "A", "About" ], [ "Help", undef, "_Help", "H", "Help" ], [ "License", undef, "_License", "L", "License" ], ); $group_one->add_actions (\@entries, undef); $ui_manager->insert_action_group ($group_one, 0); $ui_manager->insert_action_group ($group_two, 1); is_deeply ([$ui_manager->get_action_groups], [$group_one, $group_two]); $ui_manager->remove_action_group ($group_two); isa_ok ($ui_manager->get_accel_group, "Gtk2::AccelGroup"); my $ui_info = <<__EOD__; __EOD__ ok (my $id = $ui_manager->add_ui_from_string ($ui_info) != 0); ok (my $new_id = $ui_manager->new_merge_id != 0); $ui_manager->add_ui ($new_id, "/MenuBar/HelpMenu", "Help", "Help", qw(menuitem), 0); ok (my $new_new_id = $ui_manager->new_merge_id != 0); $ui_manager->add_ui ($new_new_id, "/MenuBar/HelpMenu/License", "License", "License", qw(menuitem), 1); $ui_manager->remove_ui ($new_new_id); $ui_manager->ensure_update; ok (defined ($ui_manager->get_ui)); isa_ok ($ui_manager->get_widget ("/MenuBar/HelpMenu/About"), "Gtk2::ImageMenuItem"); my @menubars = $ui_manager->get_toplevels ("menubar"); is (@menubars, 2); isa_ok ($menubars[0], "Gtk2::MenuBar"); isa_ok ($menubars[1], "Gtk2::MenuBar"); isa_ok ($ui_manager->get_action ("/MenuBar/HelpMenu/About"), "Gtk2::Action"); # FIXME: guint $ui_manager->add_ui_from_file (const gchar *filename); __END__ Copyright (C) 2003 by the gtk2-perl team (see the file AUTHORS for the full list). See LICENSE for more information. Gtk2-1.24992/t/GtkListStore.t0000644000175000017500000001700713076462677014176 0ustar lacklack#!/usr/bin/perl -w use Gtk2::TestHelper tests => 47; # $Id$ ############################################################################### my $model = Gtk2::ListStore -> new("Glib::String", "Glib::Int"); isa_ok($model, "Gtk2::ListStore"); ginterfaces_ok($model); $model -> set_column_types("Glib::String", "Glib::Int"); is($model -> get_column_type(0), "Glib::String"); is($model -> get_column_type(1), "Glib::Int"); foreach (qw(bla blee bliii bloooo)) { my $iter = $model -> append(); isa_ok($iter, "Gtk2::TreeIter"); $model -> set($iter, 0 => $_, 1 => length($_)); $model -> set_value($iter, 0 => $_, 1 => length($_)); } ############################################################################### my $path_model = Gtk2::TreePath -> new_from_string("0"); my $iter_model; # boolean return even in gtk 2.0.0 ok($model -> remove($model -> get_iter($path_model))); is($model -> get($model -> get_iter($path_model), 0), "blee"); $model -> clear(); $iter_model = $model -> prepend(); $model -> set($iter_model, 0 => "bla", 1 => 3); is($model -> get($iter_model, 0), "bla"); $iter_model = $model -> insert(1); $model -> set($iter_model, 0 => "ble", 1 => 3); is($model -> get($iter_model, 0), "ble"); $iter_model = $model -> insert_before($model -> get_iter_from_string("1")); $model -> set($iter_model, 0 => "bli", 1 => 3); is($model -> get($iter_model, 0), "bli"); $iter_model = $model -> insert_after($model -> get_iter_from_string("1")); $model -> set($iter_model, 0 => "blo", 1 => 3); is($model -> get($iter_model, 0), "blo"); ############################################################################### SKIP: { skip("swap, move_before, move_after and reorder are new in 2.2.x", 11) unless Gtk2->CHECK_VERSION (2, 2, 0); $model -> swap($model -> get_iter_from_string("1"), $model -> get_iter_from_string("2")); is($model -> get($model -> get_iter_from_string("1"), 0), "blo"); is($model -> get($model -> get_iter_from_string("2"), 0), "bli"); $model -> move_before($model -> get_iter_from_string("1"), $model -> get_iter_from_string("3")); is($model -> get($model -> get_iter_from_string("2"), 0), "blo"); $model -> move_after($model -> get_iter_from_string("3"), $model -> get_iter_from_string("0")); is($model -> get($model -> get_iter_from_string("1"), 0), "ble"); eval { $model -> reorder(3, 2, 1); }; like($@, qr/wrong number of positions passed/); my $tag = $model -> signal_connect(rows_reordered => sub { my $new_order = $_[3]; isa_ok($new_order, "ARRAY", "new index order"); is_deeply($new_order, [3, 2, 1, 0]); }); $model -> reorder(3, 2, 1, 0); $model -> signal_handler_disconnect ($tag); is($model -> get($model -> get_iter_from_string("0"), 0), "blo"); is($model -> get($model -> get_iter_from_string("1"), 0), "bli"); is($model -> get($model -> get_iter_from_string("2"), 0), "ble"); is($model -> get($model -> get_iter_from_string("3"), 0), "bla"); $model -> move_before($model -> get_iter_from_string("0"), undef); $model -> move_after($model -> get_iter_from_string("3"), undef); } ############################################################################### # Ross' 05.GtkListStore-etc.t. I did not have the heart to simply merge both # tests. my @cols = ( { title => 'Author', type => 'Glib::String', }, { title => 'Work', type => 'Glib::String', }, { title => 'Sold', type => 'Glib::Uint', }, { title => 'Print', type => 'Glib::Boolean', }, ); ok (my $store = Gtk2::ListStore->new (map {$_->{type}} @cols), 'new liststore'); $store->set_column_types (map {$_->{type}} @cols); ok (1, '$store->set_column_types'); my @data = ( { Author => 'John Doe', Work => 'Who am I', Sold => '32', Print => 0 }, { Author => 'John Doe', Work => 'Who am I', Sold => '44', Print => 1 }, ); foreach (@data) { my $iter = $store->append; $store->set($iter, 1, $_->{Work}, 0, $_->{Author}, 2, $_->{Sold}, 3, $_->{Print} ); ok (eq_array ([$store->get ($iter)], [$_->{Author}, $_->{Work}, $_->{Sold}, $_->{Print},]), '$store->set/get'); } my $iter; ok ($iter = $store->insert (0), '$store->insert (5)'); ok ($iter = $store->insert (0), '$store->insert (0)'); ok ($iter = $store->insert_before ($iter), '$store->insert_before'); ok ($iter = $store->insert_after ($iter), '$store->insert_after'); ok ($iter = $store->get_iter_first, '$store->get_iter_first, treemodel'); ok ($store->remove ($iter), '$store->remove 1'); ok ($iter = $store->prepend, '$store->prepend'); ok ($store->remove ($iter), '$store->remove 2'); SKIP: { # on RH8 with 2.0.6, i get a crash from pango xft, complaining that # there's no display. xft does require an x server... later versions # don't use xft and appear to be fine without a display. skip "can't create a treeview on 2.0.x without a display", 7 unless Gtk2->CHECK_VERSION (2, 2, 0) or Gtk2->init_check; ok (my $tree = Gtk2::TreeView->new_with_model($store), 'new treeview'); my $renderer; my $column; my $i = 0; foreach (@cols) { if( $_->{type} =~ /Glib::String/ ) { $renderer = Gtk2::CellRendererText->new; $column = Gtk2::TreeViewColumn->new_with_attributes( $_->{title}, $renderer, text => $i ); $tree->append_column($column); } elsif( $_->{type} =~ /Glib::Uint/ ) { $renderer = Gtk2::CellRendererText->new; $column = Gtk2::TreeViewColumn->new_with_attributes( $_->{title}, $renderer, text => $i ); $tree->append_column($column); } elsif( $_->{type} =~ /Glib::Boolean/ ) { $renderer = Gtk2::CellRendererToggle->new; $column = Gtk2::TreeViewColumn->new_with_attributes( $_->{title}, $renderer, active => $i ); $tree->append_column($column); } $i++; } run_main sub { SKIP: { skip 'function only in version > 2.2', 5 unless Gtk2->CHECK_VERSION (2, 2, 0); $store->reorder(4, 3, 2, 1, 0); $iter = $store->get_iter_first; ok ($store->iter_is_valid ($iter), '$store->iter_is_valid'); is_deeply ([$store->get ($iter), $store->get ($store->iter_next($iter))], ['John Doe', 'Who am I', 44, 1, 'John Doe', 'Who am I', 32, 0], '$store->reorder worked'); $store->swap ($iter, $store->iter_next($iter)); $iter = $store->get_iter_first; is_deeply ([$store->get ($iter), $store->get ($store->iter_next($iter))], ['John Doe', 'Who am I', 32, 0, 'John Doe', 'Who am I', 44, 1], '$store->swap worked'); $iter = $store->get_iter_first; $store->move_before ($iter, undef); is_deeply ([$store->get ($store->iter_nth_child(undef, 4))], ['John Doe', 'Who am I', 32, 0], '$store->move_before worked'); $store->move_after ($iter, $store->get_iter_first); is_deeply ([$store->get ($store->iter_nth_child(undef, 1))], ['John Doe', 'Who am I', 32, 0], '$store->move_after worked'); } $store->clear; ok ($store->iter_n_children == 0, '$store->clear/iter_n_children'); }; } SKIP: { skip "new stuff in gtk+ 2.6", 3 unless Gtk2->CHECK_VERSION (2, 6, 0); my $nrows_before = $store->iter_n_children; my $iter = $store->insert_with_values (-1); isa_ok ($iter, 'Gtk2::TreeIter', 'insert_with_values with no values'); $iter = $store->insert_with_values (-1, 0, 'foo', 3, TRUE, 2, 42); isa_ok ($iter, 'Gtk2::TreeIter', 'insert_with_values with values'); is ($store->iter_n_children, $nrows_before + 2, 'added expected number of rows'); } __END__ Copyright (C) 2003-2005, 2009 by the gtk2-perl team (see the file AUTHORS for the full list). See LICENSE for more information. Gtk2-1.24992/t/GtkIconFactory.t0000644000175000017500000000554313076462677014470 0ustar lacklack#!/usr/bin/perl -w use strict; use Gtk2::TestHelper tests => 24; # $Id$ my $pixbuf = Gtk2::Gdk::Pixbuf -> new("rgb", 0, 8, 10, 10); my $style = Gtk2::Style -> new(); my $button = Gtk2::Button -> new("Bla"); # my $settings = Gtk2::Settings -> get_default(); ############################################################################### my ($width, $height) = Gtk2::IconSize -> lookup("button"); like($width, qr/^\d+$/); like($height, qr/^\d+$/); SKIP: { skip "lookup_for_settings is new in 2.2.0", 2 unless Gtk2->CHECK_VERSION (2, 2, 0); my $settings = $button -> get_settings(); ($width, $height) = Gtk2::IconSize -> lookup_for_settings($settings, "button"); like($width, qr/^\d+$/); like($height, qr/^\d+$/); } is(Gtk2::IconSize -> register("answer", 23, 42), "answer"); Gtk2::IconSize -> register_alias("everything", "answer"); is(Gtk2::IconSize -> from_name("everything"), "answer"); ############################################################################### my $source = Gtk2::IconSource -> new(); isa_ok($source, "Gtk2::IconSource"); SKIP: { skip("[sg]et_icon_name are new in 2.4", 1) unless Gtk2->CHECK_VERSION (2, 4, 0); $source -> set_icon_name("gtk-save"); is($source -> get_icon_name(), "gtk-save"); } $source = Gtk2::IconSource -> new(); isa_ok($source, "Gtk2::IconSource"); $source -> set_direction("ltr"); is($source -> get_direction(), "ltr"); $source -> set_direction_wildcarded(1); is($source -> get_direction_wildcarded(), 1); $source -> set_filename("/tmp/bla"); is($source -> get_filename(), "/tmp/bla"); $source -> set_pixbuf($pixbuf); is($source -> get_pixbuf(), $pixbuf); $source -> set_size("button"); is($source -> get_size(), "button"); $source -> set_size_wildcarded(1); is($source -> get_size_wildcarded(), 1); $source -> set_state("prelight"); is($source -> get_state(), "prelight"); $source -> set_state_wildcarded(1); is($source -> get_state_wildcarded(), 1); ############################################################################### my $set = Gtk2::IconSet -> new(); isa_ok($set, "Gtk2::IconSet"); $set = Gtk2::IconSet -> new_from_pixbuf($pixbuf); isa_ok($set, "Gtk2::IconSet"); $set -> add_source($source); isa_ok($set -> render_icon($style, "rtl", "prelight", "button", $button), "Gtk2::Gdk::Pixbuf"); my %sizes = map { $_ => 1 } $set -> get_sizes(); is($sizes{ answer }, 1); ############################################################################### my $factory = Gtk2::IconFactory -> new(); isa_ok($factory, "Gtk2::IconFactory"); $factory -> add("kaffee-splatter", $set); isa_ok($factory -> lookup("kaffee-splatter"), "Gtk2::IconSet"); isa_ok($factory -> lookup_default("gtk-find-and-replace"), "Gtk2::IconSet"); $factory -> add_default(); $factory -> remove_default(); __END__ Copyright (C) 2003 by the gtk2-perl team (see the file AUTHORS for the full list). See LICENSE for more information. Gtk2-1.24992/t/GtkFileChooserWidget.t0000644000175000017500000000162113076462677015607 0ustar lacklack# # $Id$ # sub on_unthreaded_freebsd { if ($^O eq 'freebsd') { require Config; if ($Config::Config{ldflags} !~ m/-pthread\b/) { return 1; } } return 0; } use Gtk2::TestHelper at_least_version => [2, 4, 0, "GtkFileChooser is new in 2.4"], tests => 6, (on_unthreaded_freebsd () ? (skip_all => 'need a perl compiled with "-pthread" on freebsd') : ()); my $widget = Gtk2::FileChooserWidget->new ('save'); isa_ok ($widget, 'Gtk2::FileChooserWidget'); ginterfaces_ok($widget); is ($widget->get_action, 'save'); $widget = Gtk2::FileChooserWidget->new_with_backend ('open', 'backend'); isa_ok ($widget, 'Gtk2::FileChooserWidget'); isa_ok ($widget, 'Gtk2::FileChooser'); is ($widget->get_action, 'open'); __END__ Copyright (C) 2003 by the gtk2-perl team (see the file AUTHORS for the full list). See LICENSE for more information. Gtk2-1.24992/t/GtkTextView.t0000644000175000017500000001050613076462677014022 0ustar lacklack#!/usr/bin/perl -w use strict; use Gtk2::TestHelper tests => 48; # $Id$ my $window = Gtk2::Window -> new(); my $buffer = Gtk2::TextBuffer -> new(); $buffer -> insert($buffer -> get_start_iter(), join("", "Lore ipsem dolor. I think that is misspelled.\n" x 80)); my $view = Gtk2::TextView -> new_with_buffer($buffer); isa_ok($view, "Gtk2::TextView"); is($view -> get_buffer(), $buffer); $view = Gtk2::TextView -> new(); isa_ok($view, "Gtk2::TextView"); $window -> add($view); $window -> realize(); $view -> realize(); $view -> set_buffer($buffer); is($view -> get_buffer(), $buffer); my $iter = $buffer -> get_iter_at_offset(1000); my $mark = $buffer -> create_mark("bla", $iter, 1); $view -> scroll_to_mark($mark, 0.23, 1, 0.5, 0.5); $view -> scroll_mark_onscreen($mark); ok(!$view -> move_mark_onscreen($mark)); is($view -> scroll_to_iter($iter, 0.23, 1, 0.5, 0.5), 1); is($view -> place_cursor_onscreen(), 1); isa_ok($view -> get_visible_rect(), "Gtk2::Gdk::Rectangle"); isa_ok($view -> get_iter_location($iter), "Gtk2::Gdk::Rectangle"); my @y = $view -> get_line_at_y(100); isa_ok($y[0], "Gtk2::TextIter"); like($y[1], qr/^\d+$/); my @yrange = $view -> get_line_yrange($iter); like($yrange[0], qr/^\d+$/); like($yrange[1], qr/^\d+$/); isa_ok($view -> get_iter_at_location(23, 42), "Gtk2::TextIter"); my @window = $view -> buffer_to_window_coords("widget", 23, 42); like($window[0], qr/^-?\d+$/); like($window[1], qr/^-?\d+$/); my @buffer = $view -> window_to_buffer_coords("widget", @window); is($buffer[0], 23); is($buffer[1], 42); isa_ok($view -> get_window("text"), "Gtk2::Gdk::Window"); is($view -> get_window_type($view -> get_window("text")), "text"); $view -> set_border_window_size("bottom", 5); is($view -> get_border_window_size("bottom"), 5); is($view -> forward_display_line($iter), 1); is($view -> starts_display_line($iter), 1); is($view -> forward_display_line_end($iter), 1); is($view -> backward_display_line($iter), 1); is($view -> backward_display_line_start($iter), 1); is($view -> starts_display_line($iter), 1); is($view -> move_visually($iter, 5), 1); my $anchor = $buffer -> create_child_anchor($iter); my $button = Gtk2::Button -> new("Bla"); my $label = Gtk2::Label -> new("Bla"); $view -> add_child_at_anchor($button, $anchor); $view -> add_child_in_window($label, "text", 23, 42); $view -> move_child($label, 50, 50); $view -> set_wrap_mode("char"); is($view -> get_wrap_mode(), "char"); $view -> set_editable(1); is($view -> get_editable(), 1); $view -> set_cursor_visible(1); is($view -> get_cursor_visible(), 1); $view -> set_pixels_above_lines(5); is($view -> get_pixels_above_lines(), 5); $view -> set_pixels_below_lines(5); is($view -> get_pixels_below_lines(), 5); $view -> set_pixels_inside_wrap(5); is($view -> get_pixels_inside_wrap(), 5); $view -> set_justification("center"), is($view -> get_justification(), "center"); $view -> set_left_margin(5); is($view -> get_left_margin(), 5); $view -> set_right_margin(5); is($view -> get_right_margin(), 5); $view -> set_indent(5); is($view -> get_indent(), 5); $view -> set_tabs(Gtk2::Pango::TabArray -> new(8, 0)); isa_ok($view -> get_tabs(), "Gtk2::Pango::TabArray"); isa_ok($view -> get_default_attributes(), "Gtk2::TextAttributes"); SKIP: { skip("[sg]et_overwrite and [sg]et_accepts_tab are new in 2.4", 2) unless Gtk2->CHECK_VERSION (2, 4, 0); $view -> set_overwrite(1); is($view -> get_overwrite(), 1); $view -> set_accepts_tab(1); is($view -> get_accepts_tab(), 1); } SKIP: { skip("new stuff in 2.6", 3) unless Gtk2->CHECK_VERSION (2, 6, 0); my ($iter, $trailing) = $view->get_iter_at_position (10, 20); isa_ok ($iter, 'Gtk2::TextIter', 'get_iter_at_position in array context'); like ($trailing, qr/^\d+$/, 'trailing'); $iter = $view->get_iter_at_position (10, 20); isa_ok ($iter, 'Gtk2::TextIter', 'get_iter_at_position in scalar context'); } SKIP: { skip 'new 2.22 stuff', 3 unless Gtk2->CHECK_VERSION(2, 22, 0); my $event = Gtk2::Gdk::Event->new ('key-press'); $event->window ($view->window); ok (defined $view->im_context_filter_keypress ($event)); $view->reset_im_context; isa_ok ($view->get_hadjustment, 'Gtk2::Adjustment'); isa_ok ($view->get_vadjustment, 'Gtk2::Adjustment'); } __END__ Copyright (C) 2003-2005 by the gtk2-perl team (see the file AUTHORS for the full list). See LICENSE for more information. Gtk2-1.24992/t/GtkExpander.t0000644000175000017500000000271413076462677014013 0ustar lacklack#!/usr/bin/perl -w # $Id$ use Gtk2::TestHelper tests => 15, at_least_version => [2, 4, 0, "GtkExpander is new in 2.4"], ; my $expander = Gtk2::Expander->new; my $expander1 = Gtk2::Expander->new ('hi there'); my $expander2 = Gtk2::Expander->new_with_mnemonic ('_Hi there'); isa_ok ($expander, 'Gtk2::Expander'); isa_ok ($expander1, 'Gtk2::Expander'); isa_ok ($expander2, 'Gtk2::Expander'); $expander->set_expanded (FALSE); ok (!$expander->get_expanded); $expander->set_expanded (TRUE); ok ($expander->get_expanded); $expander->set_spacing (0); is ($expander->get_spacing, 0); $expander->set_spacing (6); is ($expander->get_spacing, 6); $expander->set_spacing (1); is ($expander->get_spacing, 1); $expander->set_label ('a different label'); is ($expander->get_label, 'a different label'); $expander->set_use_underline (TRUE); ok ($expander->get_use_underline); $expander->set_use_underline (FALSE); ok (!$expander->get_use_underline); $expander->set_use_markup (TRUE); ok ($expander->get_use_markup); $expander->set_use_markup (FALSE); ok (!$expander->get_use_markup); my $label = Gtk2::Label->new ('foo'); $expander->set_label_widget ($label); is ($expander->get_label_widget, $label); SKIP: { skip 'new 2.22 stuff', 1 unless Gtk2->CHECK_VERSION(2, 22, 0); $expander->set_label_fill (TRUE); ok ($expander->get_label_fill); } __END__ Copyright (C) 2003 by the gtk2-perl team (see the file AUTHORS for the full list). See LICENSE for more information. Gtk2-1.24992/t/GtkCellRendererToggle.t0000644000175000017500000000110013076462676015740 0ustar lacklack#!/usr/bin/perl -w use strict; use Gtk2::TestHelper tests => 4, noinit => 1; # $Id$ my $toggle = Gtk2::CellRendererToggle -> new(); isa_ok($toggle, "Gtk2::CellRendererToggle"); $toggle -> set_radio(1); is($toggle -> get_radio(), 1); $toggle -> set_active(1); is($toggle -> get_active(), 1); SKIP: { skip 'new 2.18 stuff', 1 unless Gtk2->CHECK_VERSION(2, 18, 0); $toggle -> set_activatable(TRUE); ok($toggle -> get_activatable()); } __END__ Copyright (C) 2003 by the gtk2-perl team (see the file AUTHORS for the full list). See LICENSE for more information. Gtk2-1.24992/t/GtkSimpleMenu.t0000644000175000017500000000740613076462677014326 0ustar lacklack# # $Id$ # ######################### # GtkSimpleMenu Tests # - rm ######################### use Gtk2::TestHelper tests => 43; require_ok( 'Gtk2::SimpleMenu' ); use Data::Dumper; our %callback_datas; sub callback { $callback_datas{$_[0]}++; ok(1) unless( $_[1] % 2 ); } sub default_callback { $callback_datas{$_[0]}++; ok(1) if( $_[1] % 2 ); } my $action = 0; my $menu_tree = [ _File => { item_type => '', children => [ _New => { callback => \&callback, callback_action => $action++, accelerator => 'N', }, _Save => { callback_action => $action++, callback_data => 'udata1', accelerator => 'S', }, 'Save _As' => { callback => \&callback, callback_action => $action++, accelerator => 'A', }, _Exit => { callback => sub { ok(1); }, callback_action => $action++, accelerator => 'E', }, ], }, _Edit => { item_type => '', children => [ _Copy => { callback => \&callback, callback_action => $action++, }, _Paste => { callback_action => $action++, }, ], }, _Tools => { item_type => '', children => [ _Tearoff => { item_type => '', }, _CheckItem => { callback => \&callback, callback_action => $action++, callback_data => 'udata2', item_type => '', }, _ToggleItem => { callback_action => $action++, callback_data => 'udata3', item_type => '', }, _StockItem => { callback => \&callback, callback_action => $action++, callback_data => 'udata4', item_type => '', extra_data => 'gtk-execute', }, _Radios => { item_type => '', children => [ 'Radio _1' => { callback_action => $action++, item_type => '', groupid => 1, }, 'Radio _2' => { callback => \&callback, callback_action => $action++, item_type => '', groupid => 1, }, 'Radio _3' => { callback_action => $action++, callback_data => 'udata5', item_type => '', groupid => 1, }, ], }, Separator => { item_type => '', }, # image menu item types are not supported at this point # _Image => { # callback => \&callback, # callback_action => $action++, # item_type => '', # }, ], }, _Help => { item_type => '', children => [ _Introduction => { callback => \&callback, callback_action => $action++, }, _About => { callback_action => $action++, } ], }, ]; ok( my $menu = Gtk2::SimpleMenu->new( menu_tree => $menu_tree, default_callback => \&default_callback, user_data => 'user data', keep_entries => 1, keep_menu_tree => 1, ) ); ok( $menu->{widget} ); ok( $menu->{accel_group} ); ok( $menu->{entries} ); ok( $menu->{menu_tree} ); ok( my $rdo = $menu->get_widget('/Tools/Radios/Radio 2') ); $rdo->set_active(1); my $win = Gtk2::Window->new; $win->add($menu->{widget}); ok(1); $win->add_accel_group($menu->{accel_group}); ok(1); my $tmp; foreach (@{$menu->{entries}}) { $tmp = $_->[4]; unless( $tmp eq '' or $tmp eq '' or $tmp eq '' ) { $tmp = $_->[0]; $tmp =~ s/_//g; if( $tmp ne '/File/Exit' ) { ok( $tmp = $menu->get_widget ($tmp) ); $tmp->activate; } } } ok( $tmp = $menu->get_widget ('/File/Exit') ); $tmp->activate; ok (eq_hash (\%callback_datas, { 'udata5' => 1, 'udata2' => 1, 'udata3' => 1, 'user data' => 13, 'udata4' => 1, 'udata1' => 1 }), 'correct callback user_data'); __END__ Copyright (C) 2003 by the gtk2-perl team (see the file AUTHORS for the full list). See LICENSE for more information. Gtk2-1.24992/t/GtkFileChooserButton.t0000644000175000017500000000273013076462677015641 0ustar lacklack#!/usr/bin/perl -w use strict; sub on_unthreaded_freebsd { if ($^O eq 'freebsd') { require Config; if ($Config::Config{ldflags} !~ m/-pthread\b/) { return 1; } } return 0; } use Gtk2::TestHelper tests => 9, at_least_version => [2, 6, 0, "GtkFileChooserButton is new in 2.6"], (on_unthreaded_freebsd () ? (skip_all => 'need a perl compiled with "-pthread" on freebsd') : ()); # $Id$ my $dialog = Gtk2::FileChooserDialog -> new("Urgs", undef, "open", "gtk-cancel" => "cancel", "gtk-ok" => "ok"); my $button = Gtk2::FileChooserButton -> new("Urgs", "open"); isa_ok($button, "Gtk2::FileChooserButton"); ginterfaces_ok($button); $button = Gtk2::FileChooserButton -> new_with_backend("Urgs", "open", "backend"); isa_ok($button, "Gtk2::FileChooserButton"); isa_ok($button, "Gtk2::FileChooser"); $button = Gtk2::FileChooserButton -> new_with_dialog($dialog); isa_ok($button, "Gtk2::FileChooserButton"); isa_ok($button, "Gtk2::FileChooser"); $button -> set_title("Urgs"); is($button -> get_title(), "Urgs"); $button -> set_width_chars(23); is($button -> get_width_chars(), 23); SKIP: { skip "new 2.10 stuff", 1 unless Gtk2 -> CHECK_VERSION(2, 10, 0); $button -> set_focus_on_click(TRUE); is($button -> get_focus_on_click(), TRUE); } __END__ Copyright (C) 2004-2006 by the gtk2-perl team (see the file AUTHORS for the full list). See LICENSE for more information. Gtk2-1.24992/t/version-checks.t0000644000175000017500000000051413076462677014516 0ustar lacklack#!/usr/bin/perl use strict; use warnings; use Test::More tests => 2; eval "use Gtk2 ':constants', 1.00;"; is ($@, ''); eval "use Gtk2 '-non-existent-flag', 10.00;"; like ($@, qr/this is only version/); __END__ Copyright (C) 2008 by the gtk2-perl team (see the file AUTHORS for the full list). See LICENSE for more information. Gtk2-1.24992/t/GtkFrame.t0000644000175000017500000000150213076462677013271 0ustar lacklack#!/usr/bin/perl -w use strict; use Gtk2::TestHelper tests => 9, noinit => 1; # $Id$ my $frame = Gtk2::Frame -> new(); isa_ok($frame, "Gtk2::Frame"); is($frame -> get_label(), undef); $frame = Gtk2::Frame -> new("Bla"); isa_ok($frame, "Gtk2::Frame"); is($frame -> get_label(), "Bla"); $frame -> set_label(); is($frame -> get_label(), undef); $frame -> set_label("Bla"); is($frame -> get_label(), "Bla"); $frame -> set_label_align(0.5, 0.5); is_deeply([$frame -> get_label_align()], [0.5, 0.5]); $frame -> set_shadow_type("etched-in"); is($frame -> get_shadow_type(), "etched-in"); my $label = Gtk2::Label -> new("Bla"); $frame -> set_label_widget($label); is($frame -> get_label_widget(), $label); __END__ Copyright (C) 2003 by the gtk2-perl team (see the file AUTHORS for the full list). See LICENSE for more information. Gtk2-1.24992/t/PangoContext.t0000644000175000017500000000352013076462677014204 0ustar lacklack#!/usr/bin/perl -w use strict; use Gtk2::TestHelper tests => 15; # $Id$ my $label = Gtk2::Label -> new("Bla"); my $context = $label -> create_pango_context(); isa_ok($context, "Gtk2::Pango::Context"); my @families = $context->list_families; ok (@families > 0, 'got a list of somethings'); isa_ok ($families[0], 'Gtk2::Pango::FontFamily'); my $font = Gtk2::Pango::FontDescription -> from_string("Sans 12"); my $language = Gtk2 -> get_default_language(); $context -> set_font_description($font); isa_ok($context -> get_font_description(), "Gtk2::Pango::FontDescription"); $context -> set_language($language); isa_ok($context -> get_language(), "Gtk2::Pango::Language"); $context -> set_base_dir("ltr"); is($context -> get_base_dir(), "ltr"); isa_ok($context -> load_font($font), "Gtk2::Pango::Font"); isa_ok($context -> load_fontset($font, $language), "Gtk2::Pango::Fontset"); isa_ok($context -> get_metrics($font, $language), "Gtk2::Pango::FontMetrics"); SKIP: { skip("[sg]et_matrix are new in 1.6", 2) unless (Gtk2::Pango -> CHECK_VERSION(1, 6, 0)); $context -> set_matrix(Gtk2::Pango::Matrix -> new()); isa_ok($context -> get_matrix(), "Gtk2::Pango::Matrix"); $context -> set_matrix(undef); is($context -> get_matrix(), undef); } SKIP: { skip("get_font_map is new in 1.6", 1) unless (Gtk2::Pango -> CHECK_VERSION(1, 6, 0)); isa_ok($context -> get_font_map(), "Gtk2::Pango::FontMap"); } SKIP: { skip("new 1.16 stuff", 3) unless (Gtk2::Pango -> CHECK_VERSION(1, 16, 0)); ok(defined $context -> get_gravity()); $context -> set_base_gravity("north"); is($context -> get_base_gravity(), "north"); $context -> set_gravity_hint("natural"); is($context -> get_gravity_hint(), "natural"); } __END__ Copyright (C) 2003-2004 by the gtk2-perl team (see the file AUTHORS for the full list). See LICENSE for more information. Gtk2-1.24992/t/GtkAccelMap.t0000644000175000017500000000327413076462676013713 0ustar lacklack#!/usr/bin/perl -w use strict; use Gtk2::TestHelper tests => 24; # $Id$ use Gtk2::Gdk::Keysyms; my $key = $Gtk2::Gdk::Keysyms{ KP_Enter }; my $mask = [qw(shift-mask)]; Gtk2::AccelMap -> add_entry("/Bla/Blub", $key, $mask); my @test = Gtk2::AccelMap -> lookup_entry("/Bla/Blub"); is($test[0], $key); is_deeply(\@{ $test[1] }, $mask); is($test[2], 0); is(Gtk2::AccelMap -> change_entry("/Bla/Blub", $key + 1, $mask, 0), 1); @test = Gtk2::AccelMap -> lookup_entry("/Bla/Blub"); is($test[0], $key + 1); is_deeply(\@{ $test[1] }, $mask); is($test[2], 0); # Gtk2::AccelMap -> save(...); # Gtk2::AccelMap -> load(...); Gtk2::AccelMap -> add_filter("/Ble"); Gtk2::AccelMap -> add_entry("/Ble", $key, $mask); is(Gtk2::AccelMap -> change_entry("/Ble", $key + 1, $mask, 0), 1); Gtk2::AccelMap -> foreach("bla", sub { is($_[0], "/Bla/Blub"); is($_[1], $key + 1); is_deeply(\@{ $_[2] }, $mask); is($_[3], 1); is($_[4], "bla"); }); Gtk2::AccelMap -> foreach_unfiltered("bla", sub { my $path = shift(); ok($path eq "/Bla/Blub" || $path eq "/Ble"); ok(shift() - $key <= 1); is_deeply(\@{ shift() }, $mask); is(shift(), 1); is(shift(), "bla"); }); SKIP: { skip "new stuff", 1 unless Gtk2 -> CHECK_VERSION(2, 4, 0); isa_ok(Gtk2::AccelMap -> get(), "Gtk2::AccelMap"); Gtk2::AccelMap -> lock_path("/Bla/Blub"); Gtk2::AccelMap -> unlock_path("/Bla/Blub"); } __END__ Copyright (C) 2003-2005 by the gtk2-perl team (see the file AUTHORS for the full list). See LICENSE for more information. Gtk2-1.24992/t/signal-chaining.t0000644000175000017500000000423413076462677014631 0ustar lacklack#!/usr/bin/perl use warnings; use strict; use Gtk2::TestHelper tests => 6; # Gtk2::Widget's size-request { package TestSizeRequestChain::Base; use strict; use warnings; use Gtk2; use Glib::Object::Subclass 'Gtk2::Widget', signals => { size_request => \&_do_size_request }; our $size_request_runs = 0; sub _do_size_request { my ($self, $req) = @_; $size_request_runs = 1; $req->width (123); $req->height (456); } package TestSizeRequestChain::Sub; use strict; use warnings; use Gtk2; use Glib::Object::Subclass 'TestSizeRequestChain::Base', signals => { size_request => \&_do_size_request }; our $size_request_runs = 0; sub _do_size_request { my ($self, $req) = @_; $size_request_runs = 1; $self->signal_chain_from_overridden ($req); } package main; my $widget = TestSizeRequestChain::Sub->new; my $req = $widget->size_request; ok ($TestSizeRequestChain::Sub::size_request_runs, 'TestSizeRequestChain::Sub size_request() runs'); ok ($TestSizeRequestChain::Base::size_request_runs, 'TestSizeRequestChain::Base size_request() runs'); is ($req->width, 123, 'TestSizeRequestChain width'); is ($req->height, 456, 'TestSizeRequestChain width'); } # Gtk2::TextBuffer's insert-text { package TestInsertTextChain; use strict; use warnings; use Gtk2; use Glib::Object::Subclass 'Gtk2::TextBuffer', signals => { insert_text => \&_do_insert_text }; our $insert_text_runs = 0; sub _do_insert_text { my ($self, $iter, $text, $length) = @_; $insert_text_runs++; $text =~ s/bla/blub/g; $self->signal_chain_from_overridden ($iter, $text, length($text)); } package main; my $tb = TestInsertTextChain->new; my $iter = $tb->get_start_iter; for (my $i = 0; $i < 10; $i++) { # reuse $iter here to test whether it is correctly updated by the custom # insert-text handler $tb->insert ($iter, 'bla'); } is ($TestInsertTextChain::insert_text_runs, 10, 'TestInsertTextChain insert_text() runs'); is ($tb->get_text ($tb->get_start_iter, $tb->get_end_iter, TRUE), 'blub' x 10, 'TestInsertTextChain buffer contents'); } Gtk2-1.24992/t/GtkGammaCurve.t0000644000175000017500000000107113076462677014267 0ustar lacklack# # $Id$ # ######################### # GtkGammaCurve Tests # - rm ######################### use Gtk2::TestHelper tests => 3; ok( my $win = Gtk2::Window->new("toplevel") ); ok( my $gamma = Gtk2::GammaCurve->new() ); $win->add($gamma); $gamma->curve->set_range(0, 255, 0, 255); $win->show_all; $gamma->curve->set_vector(0, 255); $gamma->curve->set_curve_type('spline'); ok( eq_array( [ $gamma->curve->get_vector(2) ], [ 0, 255 ] ) ); __END__ Copyright (C) 2003 by the gtk2-perl team (see the file AUTHORS for the full list). See LICENSE for more information. Gtk2-1.24992/t/GtkTreeSortable.t0000644000175000017500000000137713076462677014644 0ustar lacklack#!/usr/bin/perl -w use strict; use Gtk2::TestHelper tests => 5, noinit => 1; # $Id$ my $list = Gtk2::ListStore -> new("Glib::Int"); isa_ok($list, "Gtk2::TreeSortable"); my $tree = Gtk2::ListStore -> new("Glib::Int"); isa_ok($tree, "Gtk2::TreeSortable"); my $sort = Gtk2::TreeModelSort -> new_with_model($list); isa_ok($sort, "Gtk2::TreeSortable"); $sort -> sort_column_changed(); $sort -> set_sort_column_id(0, "ascending"); is_deeply([$sort -> get_sort_column_id()], [0, "ascending"]); $sort -> set_sort_func(0, sub { warn @_; }, 23); $sort -> set_default_sort_func(sub { warn @_; }, 23); is($sort -> has_default_sort_func(), 1); __END__ Copyright (C) 2003 by the gtk2-perl team (see the file AUTHORS for the full list). See LICENSE for more information. Gtk2-1.24992/t/GdkSelection.t0000644000175000017500000000431013076462676014143 0ustar lacklack#!/usr/bin/perl -w use strict; use Gtk2::TestHelper tests => 20; # $Id$ foreach (Gtk2::Gdk -> SELECTION_PRIMARY(), Gtk2::Gdk -> SELECTION_SECONDARY(), Gtk2::Gdk -> SELECTION_CLIPBOARD(), Gtk2::Gdk -> TARGET_BITMAP(), Gtk2::Gdk -> TARGET_COLORMAP(), Gtk2::Gdk -> TARGET_DRAWABLE(), Gtk2::Gdk -> TARGET_PIXMAP(), Gtk2::Gdk -> TARGET_STRING(), Gtk2::Gdk -> SELECTION_TYPE_ATOM(), Gtk2::Gdk -> SELECTION_TYPE_BITMAP(), Gtk2::Gdk -> SELECTION_TYPE_COLORMAP(), Gtk2::Gdk -> SELECTION_TYPE_DRAWABLE(), Gtk2::Gdk -> SELECTION_TYPE_INTEGER(), Gtk2::Gdk -> SELECTION_TYPE_PIXMAP(), Gtk2::Gdk -> SELECTION_TYPE_WINDOW(), Gtk2::Gdk -> SELECTION_TYPE_STRING()) { isa_ok($_, "Gtk2::Gdk::Atom"); } my $primary = Gtk2::Gdk -> SELECTION_PRIMARY(); my $target = Gtk2::Gdk -> TARGET_STRING(); my $property = Gtk2::Gdk -> SELECTION_TYPE_STRING(); my $window = Gtk2::Window -> new(); $window -> realize(); is(Gtk2::Gdk::Selection -> owner_set($window -> window(), $primary, 0, 0), 1); my $owner = Gtk2::Gdk::Selection -> owner_get($primary); SKIP: { skip 'owner_get returned undef', 1 unless defined $owner; is($owner, $window -> window()) }; Gtk2::Gdk::Selection -> convert($window -> window(), $primary, $target, 0); SKIP: { skip("GdkDisplay is new in 2.2", 2) unless Gtk2->CHECK_VERSION (2, 2, 0); my $display = Gtk2::Gdk::Display -> get_default(); is(Gtk2::Gdk::Selection -> owner_set_for_display($display, $window -> window(), $primary, 0, 0), 1); is(Gtk2::Gdk::Selection -> owner_get_for_display($display, $primary), $window -> window()); if ($window -> window() -> can("get_xid")) { Gtk2::Gdk::Selection -> send_notify_for_display( $display, $window -> window() -> get_xid(), $primary, $target, $property, 0); } } if ($window -> window() -> can("get_xid")) { Gtk2::Gdk::Selection -> send_notify( $window -> window() -> get_xid(), $primary, $target, $property, 0); } # FIXME: warn Gtk2::Gdk::Selection -> property_get($window -> window()); __END__ Copyright (C) 2003 by the gtk2-perl team (see the file AUTHORS for the full list). See LICENSE for more information. Gtk2-1.24992/t/GtkFileChooser.t0000644000175000017500000001311013076462677014437 0ustar lacklack# # $Id$ # use Gtk2::TestHelper at_least_version => [2, 4, 0, 'GtkFileChooser is new in 2.4'], tests => 43, skip_all => 'this test is unreliable', ; use File::Spec; use Cwd; sub update { Gtk2->main_iteration while Gtk2->events_pending; } my $file_chooser = Gtk2::FileChooserWidget->new ('save'); isa_ok ($file_chooser, 'Gtk2::FileChooser'); is ($file_chooser->get_action, 'save', 'mode option from construction'); # Filename manipulation # my $filename = 'something that may not exist'; my $cwd = cwd (); $file_chooser->set_current_name ($filename); update; is_idle (sub {$file_chooser->get_filename}, undef, 'set current name'); $filename = File::Spec->catfile ($cwd, 'gtk2perl.h'); ok ($file_chooser->set_filename ($filename), 'set filename to something that exists'); update; is_idle (sub {$file_chooser->get_filename}, $filename, 'set current name to something that does exist'); ok ($file_chooser->select_filename ($filename)); update; is_idle (sub {$file_chooser->get_filename}, $filename, 'select something'); my @list = $file_chooser->get_filenames; is (scalar (@list), 1, 'selected one thing'); is ($list[0], $filename, 'selected '.$filename); $file_chooser->select_all; @list = $file_chooser->get_filenames; ok (scalar (@list)); $file_chooser->unselect_all; my $folder = File::Spec->catfile ($cwd, 't'); ok ($file_chooser->set_current_folder ($folder)); update; is_idle (sub{$file_chooser->get_current_folder}, $folder); ok ($file_chooser->set_current_folder ($cwd)); update; is_idle (sub{$file_chooser->get_current_folder}, $cwd); # URI manipulation # my $uri = Glib::filename_to_uri (File::Spec->rel2abs ($0), undef); ok ($file_chooser->set_uri ($uri)); update; is_idle (sub {$file_chooser->get_uri}, $uri, 'uri'); ok ($file_chooser->select_uri ($uri)); update; ok_idle (sub {scalar ($file_chooser->get_uris)}, 'selected a uri'); $file_chooser->unselect_uri ($uri); # need to get the file off the end for these $uri =~ s{/GtkFileChooser.t$}{}; ok ($file_chooser->set_current_folder_uri ($uri)); is ($file_chooser->get_current_folder_uri, $uri); # Preview widget # my $preview_widget = Gtk2::Frame->new ('whee'); $file_chooser->set_preview_widget ($preview_widget); is ($file_chooser->get_preview_widget, $preview_widget); $file_chooser->set_preview_widget_active (TRUE); ok ($file_chooser->get_preview_widget_active); $file_chooser->set_preview_widget_active (TRUE); ok ($file_chooser->get_preview_widget_active); $file_chooser->set_use_preview_label (TRUE); is ($file_chooser->get_use_preview_label, TRUE); $file_chooser->set_current_folder ($cwd); $filename = File::Spec->catfile ($cwd, 'gtk2perl.h'); ok ($file_chooser->select_filename ($filename)); TODO: { local $TODO = 'GtkFileChooser trouble'; update; is_idle (sub {$file_chooser->get_preview_filename}, $filename, 'get_preview_filename'); is_idle (sub {$file_chooser->get_preview_uri}, 'file://'.$filename, 'get_preview_uri'); } # Extra widget # my $extra_widget = Gtk2::Frame->new ('extra widget'); $file_chooser->set_extra_widget ($extra_widget); is ($file_chooser->get_extra_widget, $extra_widget); # List of user selectable filters # my $filter = Gtk2::FileFilter->new; $filter->set_name ('fred'); $filter->add_mime_type ('text/plain'); $file_chooser->add_filter ($filter); @list = $file_chooser->list_filters; is (scalar (@list), 1, 'list_filters after adding one filter'); $file_chooser->remove_filter ($filter); @list = $file_chooser->list_filters; is (scalar (@list), 0, 'list_filters after removing one filter'); # Current filter # $file_chooser->set_filter ($filter); is ($filter, $file_chooser->get_filter); # Per-application shortcut folders # eval { $file_chooser->add_shortcut_folder ($cwd); $file_chooser->add_shortcut_folder_uri ("file://$cwd/t"); update; run_main sub { is_deeply ([$file_chooser->list_shortcut_folders], [$cwd, "$cwd/t"]); is_deeply ([$file_chooser->list_shortcut_folder_uris], ["file://$cwd", "file://$cwd/t"]); }; $file_chooser->remove_shortcut_folder ($cwd); $file_chooser->remove_shortcut_folder_uri ("file://$cwd/t"); }; is ($@, '', 'no shortcut error'); # Options # $file_chooser->set_local_only (TRUE); ok ($file_chooser->get_local_only, 'local files only'); $file_chooser->set_local_only (FALSE); ok (!$file_chooser->get_local_only, 'not only local files'); # apparently it likes to complain about setting this back. $file_chooser->set_select_multiple (FALSE); ok (!$file_chooser->get_select_multiple, 'not select multiple'); $file_chooser->set_action ('open'); is ($file_chooser->get_action, 'open', 'change action to open'); $file_chooser->set_select_multiple (TRUE); ok ($file_chooser->get_select_multiple, 'select multiple'); $file_chooser->set_select_multiple (FALSE); ok (!$file_chooser->get_select_multiple, 'not select multiple'); SKIP: { skip('[sg]et_show_hidden are new in 2.6', 1) unless Gtk2->CHECK_VERSION (2, 6, 0); $file_chooser->set_show_hidden (TRUE); is ($file_chooser->get_show_hidden, TRUE); } SKIP: { skip('new 2.8 stuff', 1) unless Gtk2->CHECK_VERSION (2, 8, 0); $file_chooser->set_do_overwrite_confirmation (TRUE); is ($file_chooser->get_do_overwrite_confirmation, TRUE); } SKIP: { skip('new 2.18 stuff', 1) unless Gtk2->CHECK_VERSION (2, 18, 0); $file_chooser->set_create_folders (FALSE); is ($file_chooser->get_create_folders, FALSE, '[gs]et_create_folders'); } __END__ Copyright (C) 2003-2005 by the gtk2-perl team (see the file AUTHORS for the full list). See LICENSE for more information. Gtk2-1.24992/t/GtkMenuBar.t0000644000175000017500000000103213076462677013566 0ustar lacklack#!/usr/bin/perl -w use strict; use Gtk2::TestHelper tests => 3, noinit => 1; # $Id$ my $bar = Gtk2::MenuBar -> new(); isa_ok($bar, "Gtk2::MenuBar"); SKIP: { skip("new 2.8 stuff", 2) unless Gtk2->CHECK_VERSION (2, 8, 0); $bar -> set_child_pack_direction("ltr"); is($bar -> get_child_pack_direction(), "ltr"); $bar -> set_pack_direction("rtl"); is($bar -> get_pack_direction(), "rtl"); } __END__ Copyright (C) 2003-2005 by the gtk2-perl team (see the file AUTHORS for the full list). See LICENSE for more information. Gtk2-1.24992/t/GtkScaleButton.t0000644000175000017500000000220213076462677014460 0ustar lacklack#!/usr/bin/perl use strict; use warnings; use Gtk2::TestHelper tests => 9, at_least_version => [2, 12, 0, 'GtkScaleButton appeared in 2.12']; # $Id$ my $button; $button = Gtk2::ScaleButton->new ('menu', 0, 100, 2); is ($button->get ('icons'), undef); $button = Gtk2::ScaleButton->new ('menu', 0, 100, 2, 'gtk-ok', 'gtk-cancel'); is_deeply ($button->get ('icons'), ['gtk-ok', 'gtk-cancel']); $button->set_icons ('gtk-cancel', 'gtk-ok'); is_deeply ($button->get ('icons'), ['gtk-cancel', 'gtk-ok']); $button->set_value (50); is ($button->get_value, 50); my $adj = Gtk2::Adjustment->new (50, 0, 100, 2, 10, 20); $button->set_adjustment ($adj); is ($button->get_adjustment, $adj); SKIP: { skip 'new 2.14 stuff', 4 unless Gtk2->CHECK_VERSION(2, 14, 0); isa_ok ($button->get_popup (), 'Gtk2::Widget'); isa_ok ($button->get_plus_button (), 'Gtk2::Widget'); isa_ok ($button->get_minus_button (), 'Gtk2::Widget'); $button->set_orientation ('horizontal'); is ($button->get_orientation (), 'horizontal'); } __END__ Copyright (C) 2007 by the gtk2-perl team (see the file AUTHORS for the full list). See LICENSE for more information. Gtk2-1.24992/t/GtkRecentManager.t0000644000175000017500000001127013076462677014755 0ustar lacklack#!/usr/bin/perl # # $Id$ # ######################### # GtkRecentManager Tests # - ebassi ######################### ######################### use strict; use warnings; use File::Basename qw(basename); use File::Temp qw(tempdir); my $dir = tempdir(CLEANUP => 1); sub on_unthreaded_freebsd { if ($^O eq 'freebsd') { require Config; if ($Config::Config{ldflags} !~ m/-pthread\b/) { return 1; } } return 0; } use Gtk2::TestHelper tests => 36, at_least_version => [2, 10, 0, "GtkRecentManager is new in 2.10"], (on_unthreaded_freebsd () ? (skip_all => 'need a perl compiled with "-pthread" on freebsd') : ()), ; my $manager = Gtk2::RecentManager->get_default; isa_ok($manager, 'Gtk2::RecentManager', 'get_default'); $manager = Gtk2::RecentManager->new; isa_ok($manager, 'Gtk2::RecentManager', 'new'); $manager = Gtk2::RecentManager->get_for_screen(Gtk2::Gdk::Screen->get_default); isa_ok($manager, 'Gtk2::RecentManager', 'get_for_screen'); $manager->set_screen(Gtk2::Gdk::Screen->get_default); # tests should not change or modify the global recently used files # list, so we use the 'filename' constructor only property of the # GtkRecentManager object to create our own test storage file. this # also gives us a better controlled environment. -- ebassi $manager = Glib::Object::new('Gtk2::RecentManager', filename => "$dir/test.xbel"); isa_ok($manager, 'Gtk2::RecentManager'); # purge existing items. $manager->purge_items; # use this silly trick to get a file my $icon_theme = Gtk2::IconTheme->get_default; my $icon_info = $icon_theme->lookup_icon('stock_edit', 24, 'use-builtin'); SKIP: { skip "add_item; theme icon not found", 32 unless defined $icon_info; my $icon_file = $icon_info->get_filename; my $icon_uri = 'file://' . $icon_file; $manager->add_item($icon_uri); # add_item() is asynchronous, so let the main loop spin for a while Gtk2->main_iteration while !$manager->get_items; ok($manager->has_item($icon_uri), 'check add item'); $manager->move_item($icon_uri, $icon_uri . '.bak'); $manager->move_item($icon_uri . '.bak', $icon_uri,); $manager->set_limit(23); is ($manager->get_limit, 23, 'limit'); sleep(1); # gross hack to allow the timestamp to be different $manager->add_full($icon_uri, { display_name => 'Stock edit', description => 'GTK+ stock icon for edit', mime_type => 'image/png', app_name => 'Eog', app_exec => 'eog %u', is_private => 1, groups => ['Group I', 'Group II'], }); ok($manager->has_item($icon_uri), 'check add full'); my $recent_info = $manager->lookup_item($icon_uri); isa_ok($recent_info, 'Gtk2::RecentInfo', 'check recent_info'); is($recent_info->get_uri, $icon_uri, 'check URI' ); is($recent_info->get_display_name, 'Stock edit', 'check name'); is($recent_info->get_description, 'GTK+ stock icon for edit', 'check description'); is($recent_info->get_mime_type, 'image/png', 'check MIME'); is($recent_info->get_short_name, basename $icon_file, 'check short name'); ok(defined $recent_info->get_uri_display, 'check display uri'); ok(defined $recent_info->get_age, 'check age'); ok($recent_info->is_local, 'check local'); ok($recent_info->exists, 'check exists'); ok($recent_info->match($recent_info), 'check match'); ok(defined $recent_info->get_added, 'check added stamp'); ok($recent_info->has_application('Eog'), 'check app/1'); ok(!$recent_info->has_application('Dummy Test'), 'check app/2'); ok($recent_info->is_local, 'check is local'); is($recent_info->last_application, 'Eog', 'check last application'); my @app_info = $recent_info->get_application_info('Eog'); is(@app_info, 3, 'check app info'); my ($exec, $count, $stamp) = @app_info; is($exec, 'eog ' . $icon_uri, 'check exec' ); is($count, 1, 'check count'); is($stamp, $recent_info->get_modified, 'check stamp'); my @apps = $recent_info->get_applications; is(scalar @apps, 2, 'check applications'); # $0 + 'Eog' is_deeply([$recent_info->get_groups], ['Group I', 'Group II'], 'check groups/1'); ok($recent_info->has_group('Group I'), 'check groups/2'); isa_ok($recent_info->get_icon('24'), 'Gtk2::Gdk::Pixbuf'); is($recent_info->get_private_hint, 1, 'check is private'); my @items = $manager->get_items; is(@items, 1, 'check get_items'); is($items[0]->get_uri, $icon_uri); $manager->remove_item($icon_uri); ok(!$manager->has_item($icon_uri), 'check remove item'); is($manager->purge_items, 0, 'check purge items'); } __END__ Copyright (C) 2006, 2013 by the gtk2-perl team (see the file AUTHORS for the full list). See LICENSE for more information. Gtk2-1.24992/t/PangoGravity.t0000644000175000017500000000113113076462677014201 0ustar lacklack#!/usr/bin/perl -w use strict; use Gtk2::TestHelper tests => 4, noinit => 1; # $Id$ SKIP: { skip "PangoGravity", 4 unless Gtk2::Pango->CHECK_VERSION (1, 16, 0); is (Gtk2::Pango::Gravity::to_rotation ('south'), 0.0); ok (!Gtk2::Pango::Gravity::is_vertical ('south')); my $matrix = Gtk2::Pango::Matrix->new; is (Gtk2::Pango::Gravity::get_for_matrix ($matrix), 'south'); is (Gtk2::Pango::Gravity::get_for_script ('common', 'south', 'strong'), 'south'); } __END__ Copyright (C) 2007 by the gtk2-perl team (see the file AUTHORS for the full list). See LICENSE for more information. Gtk2-1.24992/t/GtkRecentChooserDialog.t0000644000175000017500000000342013076462677016123 0ustar lacklack#!/usr/bin/perl -w use strict; sub on_unthreaded_freebsd { if ($^O eq 'freebsd') { require Config; if ($Config::Config{ldflags} !~ m/-pthread\b/) { return 1; } } return 0; } use Gtk2::TestHelper tests => 14, at_least_version => [2, 10, 0, "GtkRecentChooserDialog"], (on_unthreaded_freebsd () ? (skip_all => 'need a perl compiled with "-pthread" on freebsd') : ()); # $Id$ my $window = Gtk2::Window -> new(); my $manager = Gtk2::RecentManager -> new(); my $chooser = Gtk2::RecentChooserDialog -> new("Test", $window); isa_ok($chooser, "Gtk2::RecentChooser"); isa_ok($chooser, "Gtk2::RecentChooserDialog"); $chooser = Gtk2::RecentChooserDialog -> new("Test", undef); isa_ok($chooser, "Gtk2::RecentChooser"); isa_ok($chooser, "Gtk2::RecentChooserDialog"); $chooser = Gtk2::RecentChooserDialog -> new_for_manager("Test", $window, $manager); isa_ok($chooser, "Gtk2::RecentChooser"); isa_ok($chooser, "Gtk2::RecentChooserDialog"); $chooser = Gtk2::RecentChooserDialog -> new_for_manager("Test", undef, $manager); isa_ok($chooser, "Gtk2::RecentChooser"); isa_ok($chooser, "Gtk2::RecentChooserDialog"); $chooser = Gtk2::RecentChooserDialog -> new("Test", $window, "gtk-ok" => "ok"); isa_ok($chooser, "Gtk2::RecentChooser"); isa_ok($chooser, "Gtk2::RecentChooserDialog"); my @buttons = $chooser -> action_area -> get_children(); is(scalar @buttons, 1); $chooser = Gtk2::RecentChooserDialog -> new_for_manager("Test", $window, $manager, "gtk-ok" => "ok", "gtk-cancel" => "cancel"); isa_ok($chooser, "Gtk2::RecentChooser"); isa_ok($chooser, "Gtk2::RecentChooserDialog"); @buttons = $chooser -> action_area -> get_children(); is(scalar @buttons, 2); __END__ Copyright (C) 2006 by the gtk2-perl team (see the file AUTHORS for the full list). See LICENSE for more information. Gtk2-1.24992/t/GtkFileFilter.t0000644000175000017500000000223513076462677014270 0ustar lacklack# # $Id$ # use Gtk2::TestHelper at_least_version => [2, 4, 0, "GtkFileChooser is new in 2.4"], tests => 4, noinit => 1; my $filter_info = { contains => ['display-name'], #filename => '', #uri => '', display_name => 'Frobnicated files', mime_type => 'text/html', }; #$filter_info->{contains} #$filter_info->{filename} #$filter_info->{uri} #$filter_info->{display_name} #$filter_info->{mime_type} sub filter_func { my ($info, $data) = @_; isa_ok ($info, 'HASH'); return TRUE; } my $file_filter = Gtk2::FileFilter->new; isa_ok ($file_filter, 'Gtk2::FileFilter'); $file_filter->set_name ('fred'); is ($file_filter->get_name, 'fred'); $file_filter->add_mime_type ('text/plain'); $file_filter->add_pattern ('*.pl'); $file_filter->add_custom (['filename', 'mime-type'], \&filter_func); ok ($file_filter->get_needed >= ['filename', 'mime-type']); ok (!$file_filter->filter ($filter_info)); SKIP: { skip 'add_pixbuf_formats is new in 2.6', 0 unless Gtk2->CHECK_VERSION (2, 6, 0); $file_filter->add_pixbuf_formats; } __END__ Copyright (C) 2003 by the gtk2-perl team (see the file AUTHORS for the full list). See LICENSE for more information. Gtk2-1.24992/t/GtkMisc.t0000644000175000017500000000064713076462677013143 0ustar lacklack#!/usr/bin/perl -w use strict; use Gtk2::TestHelper tests => 2, noinit => 1; # $Id$ my $misc = Gtk2::Misc -> new(Gtk2::Label::); $misc -> set_alignment(0.5, 0.5); is_deeply([$misc -> get_alignment()], [0.5, 0.5]); $misc -> set_padding(23, 42); is_deeply([$misc -> get_padding()], [23, 42]); __END__ Copyright (C) 2003 by the gtk2-perl team (see the file AUTHORS for the full list). See LICENSE for more information. Gtk2-1.24992/t/GtkToolItemGroup.t0000644000175000017500000000217513076462677015017 0ustar lacklack#!/usr/bin/env perl use Gtk2::TestHelper tests => 10, at_least_version => [2, 20, 0, "Gtk2::ToolItemGroup is new in 2.20"]; my $group = Gtk2::ToolItemGroup->new ('Test'); isa_ok ($group, 'Gtk2::ToolItemGroup'); my $item = Gtk2::ToolItem->new; $group->insert ($item, 0); $group->set_item_position ($item, 0); my $window = Gtk2::Window->new; $window->add ($group); $window->show_all; my $drop_item = $group->get_drop_item (10, 10); ok ((defined $drop_item && $drop_item->isa ('Gtk2::ToolItem')) || !defined $drop_item); $group->set_collapsed (TRUE); ok ($group->get_collapsed); $group->set_ellipsize ('none'); is ($group->get_ellipsize, 'none'); $group->set_label ('Test'); is ($group->get_label, 'Test'); my $label = Gtk2::Label->new ('Test'); $group->set_label_widget ($label); is ($group->get_label_widget, $label); is ($group->get_item_position ($item), 0); is ($group->get_n_items, 1); is ($group->get_nth_item (0), $item); $group->set_header_relief ('normal'); is ($group->get_header_relief, 'normal'); __END__ Copyright (C) 2010 by the gtk2-perl team (see the file AUTHORS for the full list). See LICENSE for more information. Gtk2-1.24992/t/GtkToolbar.t0000644000175000017500000001733213076462677013651 0ustar lacklack# # $Id$ # use Gtk2::TestHelper tests => 52; use strict; use warnings; # # the new 2.4 API and the pre-2.4 API cannot be used on the same widget, # so we create completely separate toolbars for the two APIs. # SKIP: { skip "new and improved 2.4 toolbar API", 21 unless Gtk2->CHECK_VERSION (2, 4, 0); my $toolbar = Gtk2::Toolbar->new; isa_ok ($toolbar, 'Gtk2::Toolbar'); my @toolitems = map { Gtk2::ToolButton->new (undef, "$_") } 0..9; foreach (@toolitems) { $toolbar->insert ($_, -1); } is ($toolbar->get_n_items, scalar(@toolitems)); is ($toolbar->get_item_index ($toolitems[4]), 4); is ($toolbar->get_nth_item (-1), undef, "get_nth_item -1"); for (0..12) { is ($toolbar->get_nth_item ($_), $toolitems[$_], "get_nth_item $_"); } $toolbar->set_show_arrow (FALSE); ok (!$toolbar->get_show_arrow); $toolbar->set_show_arrow (TRUE); ok ($toolbar->get_show_arrow); my $reliefstyle = $toolbar->get_relief_style; ok (defined $reliefstyle); # this assumes that 0,0 will get the first item in the toolbar. # i hope that this isn't subject to theme borders and the like. is (0, $toolbar->get_drop_index (0, 0)); # can't use an item with a parent... $toolbar->set_drop_highlight_item (Gtk2::ToolButton->new (undef, ''), 3); # turn off the highlighting $toolbar->set_drop_highlight_item (undef, 0); } # # just about everything from here to the end is deprecated as of 2.4.0, # but will not be disabled because it wasn't deprecated in 2.0.x and 2.2.x. # my $toolbar = Gtk2::Toolbar->new; my $widget; # text tooltip private icon callback data for ([ '', '', '', 'Gtk2::Image', sub {1}, [] ], [ '', undef, undef, undef ], # test default params ) { my $icontype = $_->[3]; $_->[3] = new $icontype if defined $icontype; $widget = $toolbar->append_item (@$_); isa_ok ($widget, 'Gtk2::Widget'); $_->[3] = new $icontype if defined $icontype; $widget = $toolbar->prepend_item (@$_); isa_ok ($widget, 'Gtk2::Widget'); $_->[3] = new $icontype if defined $icontype; $widget = $toolbar->insert_item ($_->[0], # text $_->[1], # tooltip_text $_->[2], # tooltip_private_text $_->[3], # icon $_->[4], # callback $_->[5], # user_data 1); # position isa_ok ($widget, 'Gtk2::Widget'); $widget = $toolbar->insert_stock ('gtk-open', # stock-id $_->[1], # tooltip_text $_->[2], # tooltip_private_text $_->[4], # callback $_->[5], # user_data 2); # position isa_ok ($widget, 'Gtk2::Widget'); } # # this is highly obnoxious, but we need to test prepend, insert, and append # with multiple sets of arguments to ensure that we get the marshaling right. # unfortunately, there's not really any good way to loop this, so the code # is quite repetitive. (and wide.) # # GtkToolbarChildType # space a space in the style of the toolbar's GtkToolbarSpaceStyle. # button a GtkButton. # togglebutton a GtkToggleButton. # radiobutton a GtkRadioButton. # widget a standard GtkWidget. # #$widget = $toolbar->prepend_element (type, widget, text, tooltip_text, tooltip_private_text, icon, callback=NULL, user_data=NULL) # $widget = $toolbar->prepend_element ('space', undef, undef, undef, undef, undef); is ($widget, undef, 'prepend_element with a space'); $widget = $toolbar->prepend_element ('button', undef, '', undef, undef, undef, sub {1}); isa_ok ($widget, 'Gtk2::Widget', 'prepend_element with a button and a callback'); $widget = $toolbar->prepend_element ('togglebutton', undef, '', undef, undef, undef); isa_ok ($widget, 'Gtk2::Widget', 'prepend_element with a togglebutton'); $widget = $toolbar->prepend_element ('radiobutton', undef, '', undef, undef, undef); isa_ok ($widget, 'Gtk2::Widget', 'prepend_element with a radiobutton'); # with radiobutton, the widget is used to determine the group. $widget = $toolbar->prepend_element ('radiobutton', $widget, '', undef, undef, undef); isa_ok ($widget, 'Gtk2::Widget', 'prepend_element with a radiobutton'); my $entry = Gtk2::Entry->new; $widget = $toolbar->prepend_element ('widget', $entry, undef, undef, undef, undef); is ($widget, $entry, 'prepend_element with a widget'); # #$widget = $toolbar->insert_element (type, widget, text, tooltip_text, tooltip_private_text, icon, callback, user_data, position) # $widget = $toolbar->insert_element ('space', undef, undef, undef, undef, undef, undef, undef, -1); is ($widget, undef, 'insert_element with a space'); $widget = $toolbar->insert_element ('button', undef, '', undef, undef, undef, sub {1}, undef, 0); isa_ok ($widget, 'Gtk2::Widget', 'insert_element with a button and a callback'); $widget = $toolbar->insert_element ('togglebutton', undef, '', undef, undef, undef, undef, undef, 1); isa_ok ($widget, 'Gtk2::Widget', 'insert_element with a togglebutton'); $widget = $toolbar->insert_element ('radiobutton', undef, '', undef, undef, undef, undef, undef, 2); isa_ok ($widget, 'Gtk2::Widget', 'insert_element with a radiobutton'); # with radiobutton, the widget is used to determine the group. $widget = $toolbar->insert_element ('radiobutton', $widget, '', undef, undef, undef, undef, undef, 3); isa_ok ($widget, 'Gtk2::Widget', 'insert_element with a radiobutton'); $entry = Gtk2::Entry->new; $widget = $toolbar->insert_element ('widget', $entry, undef, undef, undef, undef, undef, undef, 4); is ($widget, $entry, 'insert_element with a widget'); # #$widget = $toolbar->append_element (type, widget, text, tooltip_text, tooltip_private_text, icon, callback=NULL, user_data=NULL) # $widget = $toolbar->append_element ('space', undef, undef, undef, undef, undef); is ($widget, undef, 'append_element with a space'); $widget = $toolbar->append_element ('button', undef, '', undef, undef, undef, sub {1}); isa_ok ($widget, 'Gtk2::Widget', 'append_element with a button and a callback'); $widget = $toolbar->append_element ('togglebutton', undef, '', undef, undef, undef); isa_ok ($widget, 'Gtk2::Widget', 'append_element with a togglebutton'); $widget = $toolbar->append_element ('radiobutton', undef, '', undef, undef, undef); isa_ok ($widget, 'Gtk2::Widget', 'append_element with a radiobutton'); # with radiobutton, the widget is used to determine the group. $widget = $toolbar->append_element ('radiobutton', $widget, '', undef, undef, undef); isa_ok ($widget, 'Gtk2::Widget', 'append_element with a radiobutton'); $entry = Gtk2::Entry->new; $widget = $toolbar->append_element ('widget', $entry, undef, undef, undef, undef); is ($widget, $entry, 'append_element with a widget'); $toolbar->prepend_widget (Gtk2::Image->new, 'tooltip', 'tooltip_private'); $toolbar->prepend_widget (Gtk2::Image->new, undef, undef); $toolbar->insert_widget (Gtk2::Image->new, 'tooltip', 'tooltip_private', -1); $toolbar->insert_widget (Gtk2::Image->new, undef, undef, 1); $toolbar->append_widget (Gtk2::Image->new, 'tooltip', 'tooltip_private'); $toolbar->append_widget (Gtk2::Image->new, undef, undef); $toolbar->prepend_space; $toolbar->remove_space (0); $toolbar->insert_space (-1); $toolbar->insert_space (1); $toolbar->append_space; # GtkToolbarStyle # GTK_TOOLBAR_ICONS # GTK_TOOLBAR_TEXT # GTK_TOOLBAR_BOTH # GTK_TOOLBAR_BOTH_HORIZ $toolbar->set_style ('icons'); is ('icons', $toolbar->get_style, '[sg]et_style'); $toolbar->set_style ('both'); is ('both', $toolbar->get_style, '[sg]et_style'); $toolbar->unset_style; $toolbar->set_icon_size ('small-toolbar'); is ('small-toolbar', $toolbar->get_icon_size, '[sg]et_icon_size'); $toolbar->unset_icon_size; $toolbar->set_tooltips (TRUE); ok ($toolbar->get_tooltips, '[sg]et_tooltips'); $toolbar->set_orientation ('vertical'); is ('vertical', $toolbar->get_orientation, '[sg]et_orientation'); __END__ Copyright (C) 2003-2004 by the gtk2-perl team (see the file AUTHORS for the full list). See LICENSE for more information. Gtk2-1.24992/t/GtkHButtonBox.t0000644000175000017500000000067613076462677014306 0ustar lacklack#!/usr/bin/perl -w use strict; use Gtk2::TestHelper tests => 3, noinit => 1; # $Id$ my $box = Gtk2::HButtonBox -> new(); isa_ok($box, "Gtk2::HButtonBox"); $box -> set_layout_default("spread"); is($box -> get_layout_default(), "spread"); $box -> set_spacing_default(23); is($box -> get_spacing_default(), 23); __END__ Copyright (C) 2003-2006 by the gtk2-perl team (see the file AUTHORS for the full list). See LICENSE for more information. Gtk2-1.24992/t/GtkPaned.t0000644000175000017500000001034213076462677013270 0ustar lacklack#!/usr/bin/perl use Gtk2::TestHelper tests => 10; # $Id$ my $window = Gtk2::Window->new; my $hpaned = Gtk2::HPaned->new; my $vpaned = Gtk2::VPaned->new; my $hframe = Gtk2::Frame->new; my $vframe1 = Gtk2::Frame->new; my $vframe2 = Gtk2::Frame->new; $hframe->modify_bg ('normal', Gtk2::Gdk::Color->parse ('red')); $vframe1->modify_bg ('normal', Gtk2::Gdk::Color->parse ('green')); $vframe2->modify_bg ('normal', Gtk2::Gdk::Color->parse ('blue')); $window->add ($hpaned); $hpaned->add ($hframe); $hpaned->pack2 ($vpaned, TRUE, FALSE); $vpaned->add1 ($vframe1); $vpaned->add2 ($vframe2); $vpaned->remove ($vframe1); $vpaned->remove ($vframe2); $vpaned->pack1 ($vframe1, TRUE, FALSE); $vpaned->pack2 ($vframe2, FALSE, FALSE); is ($vpaned->child1, $vframe1); is ($vpaned->child2, $vframe2); is ($vpaned->get_child1, $vframe1); is ($vpaned->get_child2, $vframe2); $vpaned->set_position (23); is ($vpaned->get_position, 23); ok (defined $hpaned->child1_resize); ok (defined $hpaned->child2_resize); ok (defined $vpaned->child1_shrink); ok (defined $vpaned->child2_shrink); $hpaned->child1_resize (23); $hpaned->child2_resize (42); $vpaned->child1_shrink (23); $vpaned->child2_shrink (42); $hpaned->compute_position (23, 10, 10); SKIP: { skip 'new 2.20 stuff', 1 unless Gtk2->CHECK_VERSION(2, 20, 0); my $window = Gtk2::Window->new; my $paned = Gtk2::HPaned->new; $window->add ($paned); $paned->realize; isa_ok ($paned->get_handle_window, 'Gtk2::Gdk::Window'); } __END__ # The following 50 tests are disabled because they proved unreliable. print "hpaned 1 -> ".$hpaned->child1_resize."\n"; print "hpaned 2 -> ".$hpaned->child2_resize."\n"; print "vpaned 1 -> ".$vpaned->child1_resize."\n"; print "vpaned 2 -> ".$vpaned->child2_resize."\n"; $window->show_all; $window->show_now; $hframe->set_size_request (50,50); $vframe1->set_size_request (50,50); $vframe2->set_size_request (50,50); my $pad; if (Gtk2->CHECK_VERSION (2, 2, 0)) { $pad = $hpaned->style_get ('handle-size'); } else { # crap. we didn't have a way to query style property information # until 2.2, so we can't implement gtk_wigdet_style_get () here. # we have to improvise. $pad = $window->allocation->height - $vframe1->allocation->height - $vframe2->allocation->height; } print "handle-size $pad\n"; my @windowprops = ( [ FALSE, TRUE, TRUE, FALSE, 300, 400 ], [ FALSE, TRUE, TRUE, FALSE, 400, 300 ], [ FALSE, FALSE, FALSE, FALSE, 100, 100 ], [ FALSE, FALSE, FALSE, FALSE, 300, 400 ], [ FALSE, FALSE, FALSE, FALSE, 400, 300 ], [ TRUE, FALSE, FALSE, TRUE, 100, 100 ], [ TRUE, FALSE, FALSE, TRUE, 300, 400 ], [ TRUE, FALSE, FALSE, TRUE, 400, 300 ], [ TRUE, FALSE, FALSE, TRUE, 100, 100 ], ); my @framesizes = ( [ 4, 8+$pad, 4, 4, 4, 4 ], [ 50, 400+$pad, 250, 350, 250, 50 ], [ 50, 300+$pad, 350, 250, 350, 50 ], [ 50, 100+$pad, 50, 50, 50, 50 ], [ 150, 400+$pad, 150, 200, 150, 200 ], [ 200, 300+$pad, 200, 150, 200, 150 ], [ 50, 100+$pad, 50, 50, 50, 50 ], [ 250, 400+$pad, 50, 50, 50, 350 ], [ 350, 300+$pad, 50, 50, 50, 250 ], [ 50, 100+$pad, 50, 50, 50, 50 ], ); # use Data::Dumper; my $i = 0; $window->signal_connect (size_allocate => sub { my ($w, $h); my $this; $this = shift @framesizes; if ($i++) { # don't validate the first wave -- the window probably # hasn't had time to get properly sized. ($w, $h) = sizeof ($hframe); is ($w, $this->[0]); is ($h, $this->[1]); my @foo = ($w, $h); ($w, $h) = sizeof ($vframe1); is ($w, $this->[2]); is ($h, $this->[3]); push @foo, $w, $h; ($w, $h) = sizeof ($vframe2); is ($w, $this->[4]); is ($h, $this->[5]); push @foo, $w, $h; print join(" ", "[", @foo, "]\n"); } $this = shift @windowprops; if ($this) { $hpaned->child1_resize ($this->[0]); $hpaned->child2_resize ($this->[1]); $vpaned->child1_resize ($this->[2]); $vpaned->child2_resize ($this->[3]); $window->resize ($this->[4] + $pad, $this->[5] + $pad); 1; } else { Gtk2->main_quit; } }); Gtk2->main; sub sizeof { my $allocation = shift->allocation; return ($allocation->width, $allocation->height); } __END__ Copyright (C) 2003-2005 by the gtk2-perl team (see the file AUTHORS for the full list). See LICENSE for more information. Gtk2-1.24992/t/GtkButton.t0000644000175000017500000000471513076462676013522 0ustar lacklack# # $Id$ # ######################### # GtkButton Tests # - rm ######################### ######################### use Gtk2::TestHelper tests => 40; ok( my $button = Gtk2::Button->new("Not Yet") ); ok(1); ok( $button = Gtk2::Button->new_with_label("Not Yet") ); ok(1); ok( $button = Gtk2::Button->new_with_mnemonic("_Not Yet") ); ok(1); $button->signal_connect( "clicked" , sub { if( $_[0]->get_label eq 'Click _Me' ) { $_[0]->set_label("Next"); ok(1); ok( $_[0]->get_label eq 'Next' ); } } ); ok(1); foreach (qw/normal half none/) { $button->set_relief($_); ok(1); ok( $button->get_relief eq $_ ); } $button->set_label('Click _Me'); ok(1); ok( $button->get_label eq 'Click _Me' ); ok( my $button_stock = Gtk2::Button->new_from_stock('gtk-apply') ); $button_stock->show; ok(1); $button_stock->set_use_underline(1); ok(1); ok( $button_stock->get_use_underline ); SKIP: { skip("[sg]et_focus_on_click and [sg]et_alignment are new in 2.4", 4) unless Gtk2->CHECK_VERSION (2, 4, 0); $button_stock->set_focus_on_click(0); ok(1); ok( ! $button_stock->get_focus_on_click() ); $button_stock->set_alignment(0.7, 0.3); ok(1); # avoid precision issues, only compare one decimal place. is_deeply([map {sprintf '%.1f', $_} $button_stock->get_alignment()], [0.7, 0.3]); } ok( my $button3 = Gtk2::Button->new('gtk-quit') ); $button3->signal_connect( "clicked" , sub { ok(1); } ); $button3->set_use_stock(1); ok(1); ok( $button3->get_use_stock ); $button->pressed; ok(1); $button->released; ok(1); $button->clicked; ok(1); $button->enter; ok(1); $button->leave; ok(1); $button->clicked; ok(1); $button3->clicked; ok(1); SKIP: { skip("[sg]et_image are new in 2.6", 2) unless Gtk2->CHECK_VERSION (2, 6, 0); my $widget = Gtk2::Label->new ("Bla"); $button->set_image ($widget); is ($button->get_image, $widget); $button->set_image (undef); is ($button->get_image, undef); } SKIP: { skip("[sg]et_image_position are new in 2.10", 1) unless Gtk2->CHECK_VERSION (2, 10, 0); $button->set_image_position ("left"); is ($button->get_image_position, "left"); } SKIP: { skip 'new 2.22 stuff', 1 unless Gtk2->CHECK_VERSION(2, 22, 0); my $button = Gtk2::Button->new ('gtk-quit'); my $window = Gtk2::Window->new; $window->add ($button); $button->realize; isa_ok ($button->get_event_window, 'Gtk2::Gdk::Window'); } __END__ Copyright (C) 2003-2006 by the gtk2-perl team (see the file AUTHORS for the full list). See LICENSE for more information. Gtk2-1.24992/t/GdkColor.t0000644000175000017500000000312113076462676013273 0ustar lacklack# # $Id$ # ######################### # GdkColor Tests # - muppet ######################### use Gtk2::TestHelper tests => 18; my $cmap = Gtk2::Gdk::Colormap->get_system; ok ($cmap, 'system colormap'); my $visual = $cmap->get_visual; ok ($visual, 'got a visual'); my $tmp_cmap = Gtk2::Gdk::Colormap->new ($visual, 1); ok ($tmp_cmap, 'new colormap'); SKIP: { skip 'get_screen is new in 2.2', 1 unless Gtk2->CHECK_VERSION (2, 2, 0); ok ($cmap->get_screen, 'got a screen'); } # ten random colors my @colors = map { Gtk2::Gdk::Color->new (rand (65535), rand (65535), rand (65535)) } 0..9; is ($colors[0]->pixel, 0, 'before alloc_color, pixel is 0'); $cmap->alloc_color ($colors[0], 0, 1); ok ($colors[0]->pixel > 0, 'alloc_color allocated a color'); my @success = $cmap->alloc_colors (0, 1, @colors); is (@success, @colors, 'same number of status values as input colors'); ok ($colors[1]->pixel > 0, 'alloc_colors allocated a color'); my $c = $cmap->query_color ($colors[0]->pixel); ok($c, 'query_color does something'); $cmap->free_colors (@colors); ok (1, 'free_colors didn\'t coredump'); my $black = Gtk2::Gdk::Color->parse("Black"); ok ($black, 'Black parsed ok'); ok ($black->equal($black), 'Black == Black'); is ($black->hash, 0, 'Black\'s hash == 0'); like($black->pixel, qr/^\d+$/); is($black->red, 0); is($black->green, 0); is($black->blue, 0); SKIP: { skip 'new 2.12 stuff', 1 unless Gtk2 -> CHECK_VERSION(2, 12, 0); is($black->to_string, '#000000000000'); } __END__ Copyright (C) 2003 by the gtk2-perl team (see the file AUTHORS for the full list). See LICENSE for more information. Gtk2-1.24992/t/GdkInput.t0000644000175000017500000000344213076462676013322 0ustar lacklack#!/usr/bin/perl -w use strict; use Gtk2::TestHelper tests => 20; # $Id$ use Gtk2::Gdk::Keysyms; my @devices = Gtk2::Gdk -> devices_list(); isa_ok($devices[0], "Gtk2::Gdk::Device"); my $device = Gtk2::Gdk::Device -> get_core_pointer(); isa_ok($device, "Gtk2::Gdk::Device"); is($device -> name, "Core Pointer"); is($device -> source, "mouse"); is($device -> mode, "screen"); is($device -> has_cursor, 1); my @axes = $device -> axes; is(@axes, 2); my $axis = $axes[0]; isa_ok($axis, "HASH"); is($axis -> { use }, "x"); like($axis -> { min }, qr/^\d+$/); like($axis -> { max }, qr/^\d+$/); # FIXME: # warn $device -> keys; # $device -> set_key(0, $Gtk2::Gdk::Keysyms{ Escape }, [qw/shift-mask/]); $device -> set_source("mouse"); $device -> set_mode("screen"); $device -> set_axis_use(1, "x"); my $window = Gtk2::Window -> new(); $window -> realize(); my ($mask, @positions) = $device -> get_state($window -> window()); isa_ok($mask, "Gtk2::Gdk::ModifierType"); is(scalar @positions, 2); # FIXME: warn $device -> get_history($window -> window(), 0, time()); delta_ok($device -> get_axis("x", 1.23, 2, 3, 4), 1.23); Gtk2::Gdk::Input -> set_extension_events($window -> window(), [qw/pointer-motion-mask/], "all"); SKIP: { skip 'new 2.22 stuff', 6 unless Gtk2->CHECK_VERSION(2, 22, 0); my $device = Gtk2::Gdk::Device -> get_core_pointer(); ok(defined $device->get_axis_use(0)); ok(defined $device->get_mode()); ok(defined $device->get_name()); ok(defined $device->get_n_axes()); ok(defined $device->get_source()); skip 'no keys on device', 1 unless $device -> keys(); my ($keyval, $modifiers) = $device->get_key(0); ok(defined $keyval && defined $modifiers); } __END__ Copyright (C) 2003 by the gtk2-perl team (see the file AUTHORS for the full list). See LICENSE for more information. Gtk2-1.24992/maps-2.100000644000175000017500000000535413076462676012412 0ustar lacklackGTK_TYPE_ASSISTANT GtkAssistant GtkObject Gtk2::Assistant GTK_TYPE_ASSISTANT_PAGE_TYPE GtkAssistantPageType GEnum Gtk2::AssistantPageType GTK_TYPE_CELL_RENDERER_ACCEL GtkCellRendererAccel GtkObject Gtk2::CellRendererAccel GTK_TYPE_CELL_RENDERER_ACCEL_MODE GtkCellRendererAccelMode GEnum Gtk2::CellRendererAccelMode GTK_TYPE_CELL_RENDERER_SPIN GtkCellRendererSpin GtkObject Gtk2::CellRendererSpin GTK_TYPE_LINK_BUTTON GtkLinkButton GtkObject Gtk2::LinkButton GTK_PRINT_ERROR GTK_TYPE_PRINT_ERROR GError Gtk2::PrintError GTK_TYPE_PAGE_ORIENTATION GtkPageOrientation GEnum Gtk2::PageOrientation GTK_TYPE_PAGE_SET GtkPageSet GEnum Gtk2::PageSet GTK_TYPE_PAGE_SETUP GtkPageSetup GObject Gtk2::PageSetup GTK_TYPE_PAPER_SIZE GtkPaperSize GBoxed Gtk2::PaperSize GTK_TYPE_PRINT_CONTEXT GtkPrintContext GObject Gtk2::PrintContext GTK_TYPE_PRINT_DUPLEX GtkPrintDuplex GEnum Gtk2::PrintDuplex GTK_TYPE_PRINT_OPERATION GtkPrintOperation GObject Gtk2::PrintOperation GTK_TYPE_PRINT_OPERATION_ACTION GtkPrintOperationAction GEnum Gtk2::PrintOperationAction GTK_TYPE_PRINT_OPERATION_PREVIEW GtkPrintOperationPreview GInterface Gtk2::PrintOperationPreview GTK_TYPE_PRINT_OPERATION_RESULT GtkPrintOperationResult GEnum Gtk2::PrintOperationResult GTK_TYPE_PRINT_PAGES GtkPrintPages GEnum Gtk2::PrintPages GTK_TYPE_PRINT_QUALITY GtkPrintQuality GEnum Gtk2::PrintQuality GTK_TYPE_PRINT_SETTINGS GtkPrintSettings GObject Gtk2::PrintSettings GTK_TYPE_PRINT_STATUS GtkPrintStatus GEnum Gtk2::PrintStatus GTK_RECENT_CHOOSER_ERROR GTK_TYPE_RECENT_CHOOSER_ERROR GError Gtk2::RecentChooser::Error GTK_RECENT_MANAGER_ERROR GTK_TYPE_RECENT_MANAGER_ERROR GError Gtk2::RecentManager::Error GTK_TYPE_RECENT_CHOOSER GtkRecentChooser GInterface Gtk2::RecentChooser GTK_TYPE_RECENT_CHOOSER_DIALOG GtkRecentChooserDialog GtkObject Gtk2::RecentChooserDialog GTK_TYPE_RECENT_CHOOSER_MENU GtkRecentChooserMenu GtkObject Gtk2::RecentChooserMenu GTK_TYPE_RECENT_CHOOSER_WIDGET GtkRecentChooserWidget GtkObject Gtk2::RecentChooserWidget GTK_TYPE_RECENT_FILTER GtkRecentFilter GtkObject Gtk2::RecentFilter GTK_TYPE_RECENT_FILTER_FLAGS GtkRecentFilterFlags GFlags Gtk2::RecentFilterFlags GTK_TYPE_RECENT_INFO GtkRecentInfo GBoxed Gtk2::RecentInfo GTK_TYPE_RECENT_MANAGER GtkRecentManager GObject Gtk2::RecentManager GTK_TYPE_RECENT_SORT_TYPE GtkRecentSortType GEnum Gtk2::RecentSortType GTK_TYPE_SENSITIVITY_TYPE GtkSensitivityType GEnum Gtk2::SensitivityType GTK_TYPE_STATUS_ICON GtkStatusIcon GObject Gtk2::StatusIcon GTK_TYPE_TARGET_LIST GtkTargetList GBoxed Gtk2::TargetList GTK_TYPE_TREE_VIEW_GRID_LINES GtkTreeViewGridLines GEnum Gtk2::TreeViewGridLines GTK_TYPE_UNIT GtkUnit GEnum Gtk2::Unit Gtk2-1.24992/xs_files-2.120000644000175000017500000000016613076462677013265 0ustar lacklackxs/GtkBuildable.xs xs/GtkBuilder.xs xs/GtkRecentAction.xs xs/GtkScaleButton.xs xs/GtkTooltip.xs xs/GtkVolumeButton.xs Gtk2-1.24992/maps_pango-1.180000644000175000017500000000023413076462676013575 0ustar lacklack# # this file defines mappings only for types that existed in pango 1.18.x # PANGO_TYPE_CAIRO_FONT PangoCairoFont GInterfaceAlias Gtk2::Pango::Cairo::Font Gtk2-1.24992/maps-2.120000644000175000017500000000064413076462676012411 0ustar lacklackGTK_TYPE_BUILDABLE GtkBuildable GInterface Gtk2::Buildable GTK_TYPE_BUILDER GtkBuilder GObject Gtk2::Builder GTK_TYPE_DRAG_RESULT GtkDragResult GEnum Gtk2::DragResult GTK_TYPE_RECENT_ACTION GtkRecentAction GObject Gtk2::RecentAction GTK_TYPE_SCALE_BUTTON GtkScaleButton GtkObject Gtk2::ScaleButton GTK_TYPE_TOOLTIP GtkTooltip GObject Gtk2::Tooltip GTK_TYPE_VOLUME_BUTTON GtkVolumeButton GtkObject Gtk2::VolumeButton Gtk2-1.24992/maps-2.60000644000175000017500000000143513076462676012333 0ustar lacklack# # type mapping definitions for stuff new in 2.6.0 # GDK_TYPE_OWNER_CHANGE GdkOwnerChange GEnum Gtk2::Gdk::OwnerChange GDK_TYPE_PIXBUF_ROTATION GdkPixbufRotation GEnum Gtk2::Gdk::PixbufRotation GTK_TYPE_ABOUT_DIALOG GtkAboutDialog GtkObject Gtk2::AboutDialog GTK_TYPE_CELL_RENDERER_COMBO GtkCellRendererCombo GtkObject Gtk2::CellRendererCombo GTK_TYPE_CELL_RENDERER_PROGRESS GtkCellRendererProgress GtkObject Gtk2::CellRendererProgress GTK_TYPE_CELL_VIEW GtkCellView GtkObject Gtk2::CellView GTK_TYPE_FILE_CHOOSER_BUTTON GtkFileChooserButton GtkObject Gtk2::FileChooserButton GTK_TYPE_ICON_VIEW GtkIconView GtkObject Gtk2::IconView GTK_TYPE_MENU_TOOL_BUTTON GtkMenuToolButton GtkObject Gtk2::MenuToolButton GDK_TYPE_PANGO_RENDERER GdkPangoRenderer GObject Gtk2::Gdk::PangoRenderer Gtk2-1.24992/xs_files-2.80000644000175000017500000000005113076462677013203 0ustar lacklackxs/GdkCairo.xs xs/GdkPixbufSimpleAnim.xs Gtk2-1.24992/xs_files-2.100000644000175000017500000000065713076462677013270 0ustar lacklackxs/GtkAssistant.xs xs/GtkCellRendererAccel.xs xs/GtkCellRendererSpin.xs xs/GtkLinkButton.xs xs/GtkPageSetup.xs xs/GtkPaperSize.xs xs/GtkPrintContext.xs xs/GtkPrintOperation.xs xs/GtkPrintOperationPreview.xs xs/GtkPrintSettings.xs xs/GtkRecentChooser.xs xs/GtkRecentChooserDialog.xs xs/GtkRecentChooserMenu.xs xs/GtkRecentChooserWidget.xs xs/GtkRecentFilter.xs xs/GtkRecentManager.xs xs/GtkStatusIcon.xs xs/GtkTextBufferRichText.xs Gtk2-1.24992/maps-2.140000644000175000017500000000025313076462676012407 0ustar lacklackGTK_TYPE_HSV GtkHSV GtkObject Gtk2::HSV GTK_TYPE_NUMBER_UP_LAYOUT GtkNumberUpLayout GEnum Gtk2::NumberUpLayout GTK_TYPE_TOOL_SHELL GtkToolShell GInterface Gtk2::ToolShell Gtk2-1.24992/perl-Gtk2.doap0000644000175000017500000000162213076462676013557 0ustar lacklack Gtk2 Perl bindings for gtk+ 2.x muppet sarringt Torsten Schönfeld tsch Gtk2-1.24992/maps-2.180000644000175000017500000000017713076462676012420 0ustar lacklackGTK_TYPE_INFO_BAR GtkInfoBar GtkObject Gtk2::InfoBar GTK_TYPE_ENTRY_BUFFER GtkEntryBuffer GObject Gtk2::EntryBuffer Gtk2-1.24992/META.json0000644000175000017500000000277513076464135012566 0ustar lacklack{ "abstract" : "Perl interface to the 2.x series of the Gimp Toolkit library", "author" : [ "gtk2-perl Team " ], "dynamic_config" : 1, "generated_by" : "ExtUtils::MakeMaker version 6.66, CPAN::Meta::Converter version 2.120921", "license" : [ "lgpl_2_1" ], "meta-spec" : { "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", "version" : "2" }, "name" : "Gtk2", "no_index" : { "directory" : [ "t", "inc", "tools", "xs" ], "file" : [ "Makefile.PL", "gtk-demo/main.pl" ] }, "prereqs" : { "configure" : { "requires" : { "Cairo" : "1.000", "ExtUtils::Depends" : "0.300", "ExtUtils::PkgConfig" : "1.030", "Glib" : "1.280", "Pango" : "1.220" } } }, "release_status" : "stable", "resources" : { "bugtracker" : { "mailto" : "bug-Gtk2 [at] rt.cpan.org", "web" : "http://rt.cpan.org/Public/Dist/Display.html?Name=Gtk2" }, "homepage" : "http://gtk2-perl.sourceforge.net", "license" : [ "http://www.gnu.org/licenses/lgpl-2.1.html" ], "repository" : { "type" : "git", "url" : "git://git.gnome.org/perl-Gtk2", "web" : "http://git.gnome.org/browse/perl-Gtk2" }, "x_MailingList" : "https://mail.gnome.org/mailman/listinfo/gtk-perl-list" }, "version" : "1.24992" } Gtk2-1.24992/maps-2.20000644000175000017500000000206213076462676012324 0ustar lacklack# Copyright (C) 2003 by the gtk2-perl team (see the file AUTHORS for the full # list) # # This library is free software; you can redistribute it and/or modify it under # the terms of the GNU Library General Public License as published by the Free # Software Foundation; either version 2.1 of the License, or (at your option) # any later version. # # This library is distributed in the hope that it will be useful, but WITHOUT # ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS # FOR A PARTICULAR PURPOSE. See the GNU Library General Public License for # more details. # # You should have received a copy of the GNU Library General Public License # along with this library; if not, write to the Free Software Foundation, Inc., # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. # # $Id$ # GDK_TYPE_DISPLAY GdkDisplay GObject Gtk2::Gdk::Display GDK_TYPE_DISPLAY_MANAGER GdkDisplayManager GObject Gtk2::Gdk::DisplayManager GDK_TYPE_SCREEN GdkScreen GObject Gtk2::Gdk::Screen GTK_TYPE_CLIPBOARD GtkClipboard GObject Gtk2::Clipboard Gtk2-1.24992/LICENSE0000644000175000017500000006350213076463142012142 0ustar lacklack GNU LESSER GENERAL PUBLIC LICENSE Version 2.1, February 1999 Copyright (C) 1991, 1999 Free Software Foundation, Inc. 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA Everyone is permitted to copy and distribute verbatim copies of this license document, but changing it is not allowed. [This is the first released version of the Lesser GPL. It also counts as the successor of the GNU Library Public License, version 2, hence the version number 2.1.] Preamble The licenses for most software are designed to take away your freedom to share and change it. By contrast, the GNU General Public Licenses are intended to guarantee your freedom to share and change free software--to make sure the software is free for all its users. This license, the Lesser General Public License, applies to some specially designated software packages--typically libraries--of the Free Software Foundation and other authors who decide to use it. You can use it too, but we suggest you first think carefully about whether this license or the ordinary General Public License is the better strategy to use in any particular case, based on the explanations below. When we speak of free software, we are referring to freedom of use, not price. Our General Public Licenses are designed to make sure that you have the freedom to distribute copies of free software (and charge for this service if you wish); that you receive source code or can get it if you want it; that you can change the software and use pieces of it in new free programs; and that you are informed that you can do these things. To protect your rights, we need to make restrictions that forbid distributors to deny you these rights or to ask you to surrender these rights. These restrictions translate to certain responsibilities for you if you distribute copies of the library or if you modify it. For example, if you distribute copies of the library, whether gratis or for a fee, you must give the recipients all the rights that we gave you. You must make sure that they, too, receive or can get the source code. If you link other code with the library, you must provide complete object files to the recipients, so that they can relink them with the library after making changes to the library and recompiling it. And you must show them these terms so they know their rights. We protect your rights with a two-step method: (1) we copyright the library, and (2) we offer you this license, which gives you legal permission to copy, distribute and/or modify the library. To protect each distributor, we want to make it very clear that there is no warranty for the free library. Also, if the library is modified by someone else and passed on, the recipients should know that what they have is not the original version, so that the original author's reputation will not be affected by problems that might be introduced by others. Finally, software patents pose a constant threat to the existence of any free program. We wish to make sure that a company cannot effectively restrict the users of a free program by obtaining a restrictive license from a patent holder. Therefore, we insist that any patent license obtained for a version of the library must be consistent with the full freedom of use specified in this license. Most GNU software, including some libraries, is covered by the ordinary GNU General Public License. This license, the GNU Lesser General Public License, applies to certain designated libraries, and is quite different from the ordinary General Public License. We use this license for certain libraries in order to permit linking those libraries into non-free programs. When a program is linked with a library, whether statically or using a shared library, the combination of the two is legally speaking a combined work, a derivative of the original library. The ordinary General Public License therefore permits such linking only if the entire combination fits its criteria of freedom. The Lesser General Public License permits more lax criteria for linking other code with the library. We call this license the "Lesser" General Public License because it does Less to protect the user's freedom than the ordinary General Public License. It also provides other free software developers Less of an advantage over competing non-free programs. These disadvantages are the reason we use the ordinary General Public License for many libraries. However, the Lesser license provides advantages in certain special circumstances. For example, on rare occasions, there may be a special need to encourage the widest possible use of a certain library, so that it becomes a de-facto standard. To achieve this, non-free programs must be allowed to use the library. A more frequent case is that a free library does the same job as widely used non-free libraries. In this case, there is little to gain by limiting the free library to free software only, so we use the Lesser General Public License. In other cases, permission to use a particular library in non-free programs enables a greater number of people to use a large body of free software. For example, permission to use the GNU C Library in non-free programs enables many more people to use the whole GNU operating system, as well as its variant, the GNU/Linux operating system. Although the Lesser General Public License is Less protective of the users' freedom, it does ensure that the user of a program that is linked with the Library has the freedom and the wherewithal to run that program using a modified version of the Library. The precise terms and conditions for copying, distribution and modification follow. Pay close attention to the difference between a "work based on the library" and a "work that uses the library". The former contains code derived from the library, whereas the latter must be combined with the library in order to run. GNU LESSER GENERAL PUBLIC LICENSE TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION 0. This License Agreement applies to any software library or other program which contains a notice placed by the copyright holder or other authorized party saying it may be distributed under the terms of this Lesser General Public License (also called "this License"). Each licensee is addressed as "you". A "library" means a collection of software functions and/or data prepared so as to be conveniently linked with application programs (which use some of those functions and data) to form executables. The "Library", below, refers to any such software library or work which has been distributed under these terms. A "work based on the Library" means either the Library or any derivative work under copyright law: that is to say, a work containing the Library or a portion of it, either verbatim or with modifications and/or translated straightforwardly into another language. (Hereinafter, translation is included without limitation in the term "modification".) "Source code" for a work means the preferred form of the work for making modifications to it. For a library, complete source code means all the source code for all modules it contains, plus any associated interface definition files, plus the scripts used to control compilation and installation of the library. Activities other than copying, distribution and modification are not covered by this License; they are outside its scope. The act of running a program using the Library is not restricted, and output from such a program is covered only if its contents constitute a work based on the Library (independent of the use of the Library in a tool for writing it). Whether that is true depends on what the Library does and what the program that uses the Library does. 1. You may copy and distribute verbatim copies of the Library's complete source code as you receive it, in any medium, provided that you conspicuously and appropriately publish on each copy an appropriate copyright notice and disclaimer of warranty; keep intact all the notices that refer to this License and to the absence of any warranty; and distribute a copy of this License along with the Library. You may charge a fee for the physical act of transferring a copy, and you may at your option offer warranty protection in exchange for a fee. 2. You may modify your copy or copies of the Library or any portion of it, thus forming a work based on the Library, and copy and distribute such modifications or work under the terms of Section 1 above, provided that you also meet all of these conditions: a) The modified work must itself be a software library. b) You must cause the files modified to carry prominent notices stating that you changed the files and the date of any change. c) You must cause the whole of the work to be licensed at no charge to all third parties under the terms of this License. d) If a facility in the modified Library refers to a function or a table of data to be supplied by an application program that uses the facility, other than as an argument passed when the facility is invoked, then you must make a good faith effort to ensure that, in the event an application does not supply such function or table, the facility still operates, and performs whatever part of its purpose remains meaningful. (For example, a function in a library to compute square roots has a purpose that is entirely well-defined independent of the application. Therefore, Subsection 2d requires that any application-supplied function or table used by this function must be optional: if the application does not supply it, the square root function must still compute square roots.) These requirements apply to the modified work as a whole. If identifiable sections of that work are not derived from the Library, and can be reasonably considered independent and separate works in themselves, then this License, and its terms, do not apply to those sections when you distribute them as separate works. But when you distribute the same sections as part of a whole which is a work based on the Library, the distribution of the whole must be on the terms of this License, whose permissions for other licensees extend to the entire whole, and thus to each and every part regardless of who wrote it. Thus, it is not the intent of this section to claim rights or contest your rights to work written entirely by you; rather, the intent is to exercise the right to control the distribution of derivative or collective works based on the Library. In addition, mere aggregation of another work not based on the Library with the Library (or with a work based on the Library) on a volume of a storage or distribution medium does not bring the other work under the scope of this License. 3. You may opt to apply the terms of the ordinary GNU General Public License instead of this License to a given copy of the Library. To do this, you must alter all the notices that refer to this License, so that they refer to the ordinary GNU General Public License, version 2, instead of to this License. (If a newer version than version 2 of the ordinary GNU General Public License has appeared, then you can specify that version instead if you wish.) Do not make any other change in these notices. Once this change is made in a given copy, it is irreversible for that copy, so the ordinary GNU General Public License applies to all subsequent copies and derivative works made from that copy. This option is useful when you wish to copy part of the code of the Library into a program that is not a library. 4. You may copy and distribute the Library (or a portion or derivative of it, under Section 2) in object code or executable form under the terms of Sections 1 and 2 above provided that you accompany it with the complete corresponding machine-readable source code, which must be distributed under the terms of Sections 1 and 2 above on a medium customarily used for software interchange. If distribution of object code is made by offering access to copy from a designated place, then offering equivalent access to copy the source code from the same place satisfies the requirement to distribute the source code, even though third parties are not compelled to copy the source along with the object code. 5. A program that contains no derivative of any portion of the Library, but is designed to work with the Library by being compiled or linked with it, is called a "work that uses the Library". Such a work, in isolation, is not a derivative work of the Library, and therefore falls outside the scope of this License. However, linking a "work that uses the Library" with the Library creates an executable that is a derivative of the Library (because it contains portions of the Library), rather than a "work that uses the library". The executable is therefore covered by this License. Section 6 states terms for distribution of such executables. When a "work that uses the Library" uses material from a header file that is part of the Library, the object code for the work may be a derivative work of the Library even though the source code is not. Whether this is true is especially significant if the work can be linked without the Library, or if the work is itself a library. The threshold for this to be true is not precisely defined by law. If such an object file uses only numerical parameters, data structure layouts and accessors, and small macros and small inline functions (ten lines or less in length), then the use of the object file is unrestricted, regardless of whether it is legally a derivative work. (Executables containing this object code plus portions of the Library will still fall under Section 6.) Otherwise, if the work is a derivative of the Library, you may distribute the object code for the work under the terms of Section 6. Any executables containing that work also fall under Section 6, whether or not they are linked directly with the Library itself. 6. As an exception to the Sections above, you may also combine or link a "work that uses the Library" with the Library to produce a work containing portions of the Library, and distribute that work under terms of your choice, provided that the terms permit modification of the work for the customer's own use and reverse engineering for debugging such modifications. You must give prominent notice with each copy of the work that the Library is used in it and that the Library and its use are covered by this License. You must supply a copy of this License. If the work during execution displays copyright notices, you must include the copyright notice for the Library among them, as well as a reference directing the user to the copy of this License. Also, you must do one of these things: a) Accompany the work with the complete corresponding machine-readable source code for the Library including whatever changes were used in the work (which must be distributed under Sections 1 and 2 above); and, if the work is an executable linked with the Library, with the complete machine-readable "work that uses the Library", as object code and/or source code, so that the user can modify the Library and then relink to produce a modified executable containing the modified Library. (It is understood that the user who changes the contents of definitions files in the Library will not necessarily be able to recompile the application to use the modified definitions.) b) Use a suitable shared library mechanism for linking with the Library. A suitable mechanism is one that (1) uses at run time a copy of the library already present on the user's computer system, rather than copying library functions into the executable, and (2) will operate properly with a modified version of the library, if the user installs one, as long as the modified version is interface-compatible with the version that the work was made with. c) Accompany the work with a written offer, valid for at least three years, to give the same user the materials specified in Subsection 6a, above, for a charge no more than the cost of performing this distribution. d) If distribution of the work is made by offering access to copy from a designated place, offer equivalent access to copy the above specified materials from the same place. e) Verify that the user has already received a copy of these materials or that you have already sent this user a copy. For an executable, the required form of the "work that uses the Library" must include any data and utility programs needed for reproducing the executable from it. However, as a special exception, the materials to be distributed need not include anything that is normally distributed (in either source or binary form) with the major components (compiler, kernel, and so on) of the operating system on which the executable runs, unless that component itself accompanies the executable. It may happen that this requirement contradicts the license restrictions of other proprietary libraries that do not normally accompany the operating system. Such a contradiction means you cannot use both them and the Library together in an executable that you distribute. 7. You may place library facilities that are a work based on the Library side-by-side in a single library together with other library facilities not covered by this License, and distribute such a combined library, provided that the separate distribution of the work based on the Library and of the other library facilities is otherwise permitted, and provided that you do these two things: a) Accompany the combined library with a copy of the same work based on the Library, uncombined with any other library facilities. This must be distributed under the terms of the Sections above. b) Give prominent notice with the combined library of the fact that part of it is a work based on the Library, and explaining where to find the accompanying uncombined form of the same work. 8. You may not copy, modify, sublicense, link with, or distribute the Library except as expressly provided under this License. Any attempt otherwise to copy, modify, sublicense, link with, or distribute the Library is void, and will automatically terminate your rights under this License. However, parties who have received copies, or rights, from you under this License will not have their licenses terminated so long as such parties remain in full compliance. 9. You are not required to accept this License, since you have not signed it. However, nothing else grants you permission to modify or distribute the Library or its derivative works. These actions are prohibited by law if you do not accept this License. Therefore, by modifying or distributing the Library (or any work based on the Library), you indicate your acceptance of this License to do so, and all its terms and conditions for copying, distributing or modifying the Library or works based on it. 10. Each time you redistribute the Library (or any work based on the Library), the recipient automatically receives a license from the original licensor to copy, distribute, link with or modify the Library subject to these terms and conditions. You may not impose any further restrictions on the recipients' exercise of the rights granted herein. You are not responsible for enforcing compliance by third parties with this License. 11. If, as a consequence of a court judgment or allegation of patent infringement or for any other reason (not limited to patent issues), conditions are imposed on you (whether by court order, agreement or otherwise) that contradict the conditions of this License, they do not excuse you from the conditions of this License. If you cannot distribute so as to satisfy simultaneously your obligations under this License and any other pertinent obligations, then as a consequence you may not distribute the Library at all. For example, if a patent license would not permit royalty-free redistribution of the Library by all those who receive copies directly or indirectly through you, then the only way you could satisfy both it and this License would be to refrain entirely from distribution of the Library. If any portion of this section is held invalid or unenforceable under any particular circumstance, the balance of the section is intended to apply, and the section as a whole is intended to apply in other circumstances. It is not the purpose of this section to induce you to infringe any patents or other property right claims or to contest validity of any such claims; this section has the sole purpose of protecting the integrity of the free software distribution system which is implemented by public license practices. Many people have made generous contributions to the wide range of software distributed through that system in reliance on consistent application of that system; it is up to the author/donor to decide if he or she is willing to distribute software through any other system and a licensee cannot impose that choice. This section is intended to make thoroughly clear what is believed to be a consequence of the rest of this License. 12. If the distribution and/or use of the Library is restricted in certain countries either by patents or by copyrighted interfaces, the original copyright holder who places the Library under this License may add an explicit geographical distribution limitation excluding those countries, so that distribution is permitted only in or among countries not thus excluded. In such case, this License incorporates the limitation as if written in the body of this License. 13. The Free Software Foundation may publish revised and/or new versions of the Lesser General Public License from time to time. Such new versions will be similar in spirit to the present version, but may differ in detail to address new problems or concerns. Each version is given a distinguishing version number. If the Library specifies a version number of this License which applies to it and "any later version", you have the option of following the terms and conditions either of that version or of any later version published by the Free Software Foundation. If the Library does not specify a license version number, you may choose any version ever published by the Free Software Foundation. 14. If you wish to incorporate parts of the Library into other free programs whose distribution conditions are incompatible with these, write to the author to ask for permission. For software which is copyrighted by the Free Software Foundation, write to the Free Software Foundation; we sometimes make exceptions for this. Our decision will be guided by the two goals of preserving the free status of all derivatives of our free software and of promoting the sharing and reuse of software generally. NO WARRANTY 15. BECAUSE THE LIBRARY IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY FOR THE LIBRARY, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES PROVIDE THE LIBRARY "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE LIBRARY IS WITH YOU. SHOULD THE LIBRARY PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION. 16. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR REDISTRIBUTE THE LIBRARY AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE LIBRARY (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A FAILURE OF THE LIBRARY TO OPERATE WITH ANY OTHER SOFTWARE), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES. END OF TERMS AND CONDITIONS How to Apply These Terms to Your New Libraries If you develop a new library, and you want it to be of the greatest possible use to the public, we recommend making it free software that everyone can redistribute and change. You can do so by permitting redistribution under these terms (or, alternatively, under the terms of the ordinary General Public License). To apply these terms, attach the following notices to the library. It is safest to attach them to the start of each source file to most effectively convey the exclusion of warranty; and each file should have at least the "copyright" line and a pointer to where the full notice is found. Copyright (C) This library is free software; you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License as published by the Free Software Foundation; either version 2.1 of the License, or (at your option) any later version. This library is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for more details. You should have received a copy of the GNU Lesser General Public License along with this library; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA Also add information on how to contact you by electronic and paper mail. You should also get your employer (if you work as a programmer) or your school, if any, to sign a "copyright disclaimer" for the library, if necessary. Here is a sample; alter the names: Yoyodyne, Inc., hereby disclaims all copyright interest in the library `Frob' (a library for tweaking knobs) written by James Random Hacker. , 1 April 1990 Ty Coon, President of Vice That's all there is to it! Gtk2-1.24992/xt/0000755000175000017500000000000013076464135011565 5ustar lacklackGtk2-1.24992/xt/GtkSocket-GtkPlug.t0000644000175000017500000000363413076462677015242 0ustar lacklack#!/usr/bin/perl # # $Id$ # # ...despite patches that have been around for a long time, no win32 use Gtk2::TestHelper tests => 12, nowin32 => 1; SKIP: { skip "blib can't be found", 6 unless -d "blib"; ok( my $win = Gtk2::Window->new ); ok( my $socket = Gtk2::Socket->new ); $win->add($socket); ok( my $id = $socket->get_id ); SKIP: { skip 'new 2.14 stuff', 2 unless Gtk2->CHECK_VERSION(2, 14, 0); is( $socket->get_plug_window, undef ); $socket->signal_connect (plug_added => sub { isa_ok( $socket->get_plug_window, 'Gtk2::Gdk::Window' ); }); } my $pid = fork; skip 'fork failed', 2 unless defined $pid && $pid >= 0; if( $pid == 0 ) { exec("$^X -Mblib -e 'my \$id = $id;\n\n" . <init; my \$plug = Gtk2::Plug->new($id); my \$btn = Gtk2::Button->new("gtk-quit"); \$btn->signal_connect("clicked" => sub { Gtk2->main_quit; 1; }); \$plug->add(\$btn); \$plug->show_all; Glib::Idle->add(sub { \$btn->clicked; 0; }); Gtk2->main;' EOL exit 0; } else { $socket->signal_connect('plug-removed' => sub { Gtk2->main_quit; 1; }); $win->show_all; Gtk2->main; ok( waitpid($pid, 0) ); } } # Standalone GtkPlug tests. SKIP: { my $id = 23; my $display = Gtk2::Gdk::Display->get_default; # Backwards compatibility tests my $plug = Gtk2::Plug->new($id); isa_ok( $plug, 'Gtk2::Plug' ); $plug->construct($id); $plug->construct_for_display($display, $id); ok( defined $plug->get_id ); skip 'new 2.14 stuff', 2 unless Gtk2->CHECK_VERSION(2, 14, 0); is( $plug->get_embedded, FALSE ); is( $plug->get_socket_window, undef ); } # Backwards compatibility tests. { my $id = 23; my $display = Gtk2::Gdk::Display->get_default; isa_ok( Gtk2::Plug::new_for_display($display, $id), 'Gtk2::Plug' ); isa_ok( Gtk2::Plug->new_for_display($display, $id), 'Gtk2::Plug' ); } __END__ Copyright (C) 2003 by the gtk2-perl team (see the file AUTHORS for the full list). See LICENSE for more information. Gtk2-1.24992/xt/GdkDnd.t0000644000175000017500000000724713076462677013130 0ustar lacklack#!/usr/bin/perl -w use strict; use Gtk2::TestHelper tests => 26; # $Id$ my $window = Gtk2::Window -> new(); $window -> realize(); $window -> show_now; ############################################################################### my $context = Gtk2::Gdk::DragContext -> new(); isa_ok($context, "Gtk2::Gdk::DragContext"); my @targets = (Gtk2::Gdk::Atom -> new("target-string"), Gtk2::Gdk::Atom -> new("target-bitmap")); $context = Gtk2::Gdk::DragContext -> begin($window -> window(), @targets); isa_ok($context, "Gtk2::Gdk::DragContext"); my ($destination, $protocol); SKIP: { skip("GdkScreen is new in 2.2", 2) unless Gtk2 -> CHECK_VERSION(2, 2, 0); ($destination, $protocol) = $context -> find_window_for_screen($window -> window(), Gtk2::Gdk::Screen -> get_default(), 0, 0); ok(not defined $destination or ref $destination eq "Gtk2::Gdk::Window"); ok(not defined $destination or $protocol); } $context -> abort(0); ############################################################################### $context = Gtk2::Gdk::DragContext -> begin($window -> window(), @targets); isa_ok($context, "Gtk2::Gdk::DragContext"); ok($context -> protocol()); is($context -> is_source(), 1); is($context -> source_window(), $window -> window()); is_deeply([map { $_ -> name() } $context -> targets()], [map { $_ -> name() } @targets]); isa_ok(($context -> targets())[0], "Gtk2::Gdk::Atom"); ($destination, $protocol) = $context -> find_window($window -> window(), 0, 0); ok(not defined $destination or ref $destination eq "Gtk2::Gdk::Window"); ok(not defined $destination or $protocol); SKIP: { skip "find_window returned no destination window, skipping the tests that need one", 9 unless defined $destination; # FIXME: what about the return value? $context -> motion($destination, $protocol, 100, 100, [qw(copy)], [qw(copy move)], 0); ok($context -> actions() == [qw(copy move)]); ok($context -> suggested_action() == qw(copy)); is($context -> start_time(), 0); SKIP: { skip "can't do x11 stuff on this platform", 2 if $^O eq 'MSWin32'; is_deeply([Gtk2::Gdk::DragContext -> get_protocol($destination -> get_xid())], [$destination -> get_xid(), $protocol]); skip("get_protocol_for_display is new in 2.2", 1) unless Gtk2->CHECK_VERSION (2, 2, 0); is_deeply([Gtk2::Gdk::DragContext -> get_protocol_for_display(Gtk2::Gdk::Display -> get_default(), $destination -> get_xid())], [$destination -> get_xid(), $protocol]); } is($context -> dest_window(), $destination); my $selection = $context -> get_selection(); SKIP: { skip "selection test: get_selection returned undef", 1 unless defined $selection; isa_ok($selection, "Gtk2::Gdk::Atom"); } $context -> status(qw(move), 0); ok($context -> action() == qw(move)); $context -> status([], 0); $context -> drop_reply(1, 0); $context -> drop_finish(1, 0); SKIP: { skip "new 2.6 stuff", 1 unless Gtk2 -> CHECK_VERSION(2, 6, 0); like($context -> drag_drop_succeeded(), qr/^(?:1|)$/); } $context -> drop(0); $context -> abort(0); } SKIP: { skip 'new 2.22 stuff', 5 unless Gtk2->CHECK_VERSION(2, 22, 0); my $context = Gtk2::Gdk::DragContext -> begin($window -> window(), @targets); ok(defined $context -> get_actions()); ok(defined $context -> get_selected_action()); ok(defined $context -> get_suggested_action()); is($context -> get_source_window(), $window -> window()); is_deeply([map { $_ -> name() } $context -> list_targets()], [map { $_ -> name() } @targets]); } __END__ Copyright (C) 2003 by the gtk2-perl team (see the file AUTHORS for the full list). See LICENSE for more information. Gtk2-1.24992/xt/GtkDnd.t0000644000175000017500000000725413076462677013146 0ustar lacklack#!/usr/bin/perl -w use strict; use Gtk2::TestHelper tests => 6; # $Id$ my $button = Gtk2::Button -> new("Bla"); my $window = Gtk2::Window -> new(); $window -> add($button); $window -> realize(); $button -> realize(); # Dest ######################################################################## $button -> drag_dest_set("all", "copy", { target => "BITMAP", info => 23 }, { target => "STRING", flags => ["same-app", "same-widget"], info => 42 } ); my $list = $button -> drag_dest_get_target_list(); $button -> drag_dest_set_target_list(undef); $button -> drag_dest_set_target_list($list); is($list -> find(Gtk2::Gdk -> TARGET_BITMAP), 23); is($list -> find(Gtk2::Gdk -> TARGET_STRING), 42); my $pixbuf = Gtk2::Gdk::Pixbuf -> new("rgb", 0, 8, 10, 10); my $event = Gtk2::Gdk::Event -> new("button-press"); my $context = Gtk2::Drag -> begin($button, $list, "default", 1, $event); SKIP: { skip "context test", 1 unless defined $context; isa_ok($context, "Gtk2::Gdk::DragContext"); } $context = $button -> drag_begin($list, "default", 1, $event); SKIP: { skip "context test", 1 unless defined $context; isa_ok($context, "Gtk2::Gdk::DragContext"); } if (defined($context)) { # warn $button -> drag_dest_find_target($context, $list); # $context -> finish(1, 0, 0); # $button -> drag_get_data($context, Gtk2::Gdk -> TARGET_STRING, 0); # warn $context -> get_source_widget(); $context -> set_icon_widget($window, 5, 5); my $pixmap = Gtk2::Gdk::Pixmap->new ($window->window, 16, 16, -1); $context -> set_icon_pixmap($pixmap->get_colormap, $pixmap, undef, 5, 5); my $mask = Gtk2::Gdk::Pixmap->new ($window->window, 16, 16, 1); $context -> set_icon_pixmap($pixmap->get_colormap, $pixmap, $mask, 5, 5); $context -> set_icon_pixbuf($pixbuf, 5, 5); $context -> set_icon_stock("gtk-add", 5, 5); $context -> set_icon_default(); SKIP: { skip "new 2.8 stuff", 0 unless Gtk2 -> CHECK_VERSION(2, 8, 0); $context -> set_icon_name("gtk-add", 5, 5); } } is($button -> drag_check_threshold(5, 5, 100, 100), 1); $button -> drag_highlight(); $button -> drag_unhighlight(); $button -> drag_dest_set_proxy($window -> window(), "xdnd", 0); SKIP: { skip("2.6 stuff", 0) unless Gtk2 -> CHECK_VERSION(2, 6, 0); $button -> drag_dest_add_text_targets(); $button -> drag_dest_add_image_targets(); $button -> drag_dest_add_uri_targets(); } SKIP: { skip("2.10 stuff", 1) unless Gtk2 -> CHECK_VERSION(2, 10, 0); $button -> drag_dest_set_track_motion(FALSE); ok(!$button -> drag_dest_get_track_motion()); } $button -> drag_dest_unset(); # Source ###################################################################### $button -> drag_source_set("shift-mask", "copy", { target => "BITMAP", info => 23 }, { target => "STRING", flags => ["same-app", "same-widget"], info => 42 } ); # $button -> drag_source_set_icon(...); $button -> drag_source_set_icon_pixbuf($pixbuf); $button -> drag_source_set_icon_stock("gtk-quit"); SKIP: { skip("drag_source_[sg]et_target_list is new in 2.4", 0) unless Gtk2->CHECK_VERSION (2, 4, 0); $list = $button -> drag_source_get_target_list(); $button -> drag_source_set_target_list(undef); $button -> drag_source_set_target_list($list); } SKIP: { skip("2.6 stuff", 0) unless Gtk2 -> CHECK_VERSION(2, 6, 0); $button -> drag_source_add_text_targets(); $button -> drag_source_add_image_targets(); $button -> drag_source_add_uri_targets(); } SKIP: { skip("2.8 stuff", 0) unless Gtk2 -> CHECK_VERSION(2, 8, 0); $button -> drag_source_set_icon_name("gtk-ok"); } $button -> drag_source_unset(); __END__ Copyright (C) 2003-2006 by the gtk2-perl team (see the file AUTHORS for the full list). See LICENSE for more information. Gtk2-1.24992/maps-2.40000644000175000017500000000526513076462676012336 0ustar lacklack# # type mapping definitions for stuff new in 2.4.0 # # Error domains # domain enum type base type package GTK_FILE_CHOOSER_ERROR GTK_TYPE_FILE_CHOOSER_ERROR GError Gtk2::FileChooser::Error GTK_ICON_THEME_ERROR GTK_TYPE_ICON_THEME_ERROR GError Gtk2::IconTheme::Error # the rest of the types # typemacro C type name base type package GTK_TYPE_COMBO_BOX_ENTRY GtkComboBoxEntry GtkObject Gtk2::ComboBoxEntry GTK_TYPE_COMBO_BOX GtkComboBox GtkObject Gtk2::ComboBox GTK_TYPE_CELL_LAYOUT GtkCellLayout GInterface Gtk2::CellLayout GTK_TYPE_COLOR_BUTTON GtkColorButton GtkObject Gtk2::ColorButton GTK_TYPE_FONT_BUTTON GtkFontButton GtkObject Gtk2::FontButton GTK_TYPE_ENTRY_COMPLETION GtkEntryCompletion GObject Gtk2::EntryCompletion GTK_TYPE_EXPANDER GtkExpander GtkObject Gtk2::Expander GTK_TYPE_FILE_CHOOSER GtkFileChooser GInterface Gtk2::FileChooser GTK_TYPE_FILE_CHOOSER_ACTION GtkFileChooserAction GEnum Gtk2::FileChooserAction GTK_TYPE_FILE_CHOOSER_ERROR GtkFileChooserError GEnum Gtk2::FileChooserError GTK_TYPE_FILE_CHOOSER_DIALOG GtkFileChooserDialog GtkObject Gtk2::FileChooserDialog GTK_TYPE_FILE_CHOOSER_WIDGET GtkFileChooserWidget GtkObject Gtk2::FileChooserWidget GTK_TYPE_FILE_FILTER GtkFileFilter GtkObject Gtk2::FileFilter GTK_TYPE_FILE_FILTER_INFO GtkFileFilterInfo GBoxed Gtk2::FileFilterInfo GTK_TYPE_FILE_FILTER_FLAGS GtkFileFilterFlags GFlags Gtk2::FileFilterFlags GTK_TYPE_ICON_THEME GtkIconTheme GObject Gtk2::IconTheme GTK_TYPE_ICON_THEME_ERROR GtkIconThemeError GEnum Gtk2::IconThemeError GTK_TYPE_ICON_INFO GtkIconInfo GBoxed Gtk2::IconInfo GTK_TYPE_ICON_LOOKUP_FLAGS GtkIconLookupFlags GFlags Gtk2::IconLookupFlags GTK_TYPE_TREE_MODEL_FILTER GtkTreeModelFilter GObject Gtk2::TreeModelFilter GTK_TYPE_UI_MANAGER GtkUIManager GObject Gtk2::UIManager GTK_TYPE_UI_MANAGER_ITEM_TYPE GtkUIManagerItemType GFlags Gtk2::UIManagerItemType GTK_TYPE_ACTION_GROUP GtkActionGroup GObject Gtk2::ActionGroup GTK_TYPE_ACTION GtkAction GObject Gtk2::Action GTK_TYPE_TOGGLE_ACTION GtkToggleAction GObject Gtk2::ToggleAction GTK_TYPE_RADIO_ACTION GtkRadioAction GObject Gtk2::RadioAction GTK_TYPE_ACTION_ENTRY GtkActionEntry GBoxed Gtk2::ActionEntry GTK_TYPE_TOGGLE_ACTION_ENTRY GtkToggleActionEntry GBoxed Gtk2::ToggleActionEntry GTK_TYPE_RADIO_ACTION_ENTRY GtkRadioActionEntry GBoxed Gtk2::RadioActionEntry GTK_TYPE_TOOL_ITEM GtkToolItem GtkObject Gtk2::ToolItem GTK_TYPE_TOOL_BUTTON GtkToolButton GtkObject Gtk2::ToolButton GTK_TYPE_TOGGLE_TOOL_BUTTON GtkToggleToolButton GtkObject Gtk2::ToggleToolButton GTK_TYPE_RADIO_TOOL_BUTTON GtkRadioToolButton GtkObject Gtk2::RadioToolButton GTK_TYPE_SEPARATOR_TOOL_ITEM GtkSeparatorToolItem GtkObject Gtk2::SeparatorToolItem GTK_TYPE_ACCEL_MAP GtkAccelMap GObject Gtk2::AccelMap Gtk2-1.24992/TODO0000644000175000017500000000103713076462677011634 0ustar lacklack$Id$ give a better name to the entry point for gtk-demo make gtk-demo not show the 2.2 stuff when running on 2.0 should example programs be installed? there are plenty of unbound apis, either because of lack of interest or lack of need -- these should be audited. no typemap (and therefore no bindings) for GdkRgbCmap GScanner <- i'd consider this to be internal PangoEngineShape PangoCoverage PangoLayoutLine what about decorated window stuff? foreach callbacks (and possibly other types) need some doc on the callback api/params. Gtk2-1.24992/README0000644000175000017500000000620013076462676012020 0ustar lacklackGtk2 ==== Perl bindings to the 2.x series of the Gtk+ graphical user interface library. This module allows you to write graphical user interfaces in a Perlish and object-oriented way, freeing you from the casting and memory management in C, yet remaining very close in spirit to original API. Find out more about Gtk+ at http://www.gtk.org. The GTK+ Reference Manual [ http://developer.gnome.org/doc/API/2.0/gtk/ ] is also a handy companion when writing Gtk programs in any language. The Perl bindings follow the C API very closely, and the C reference should be considered the canonical documentation. Be sure to check out the example programs in the "examples" and "gtk-demo" directories. To discuss gtk2-perl, ask questions and flame/praise the authors, join gtk-perl-list@gnome.org at lists.gnome.org. Also have a look at the gtk2-perl website and sourceforge project page, http://gtk2-perl.sourceforge.net INSTALLATION ------------ To install this module type the following: perl Makefile.PL make make test make install To avoid installing to a system directory, since this is a beta release, you can change the installation prefix at Makefile.PL time with perl Makefile.PL PREFIX=/some/other/place This will install the module to the subdirectory lib/perl5 under the given prefix. If this is not already in perl's include path, you'll need to tell perl how to get to this library directory so you can use it; there are three ways: in your environment (the easiest): # assuming a bourne-style shell PERL5LIB=/some/other/place/lib/perl5/site_perl export PERL5LIB on the perl command line: perl -I /some/other/place/lib/perl5/site_perl yourscript in the code of your perl script: use lib '/some/other/place/lib/perl5/site_perl'; DEPENDENCIES ------------ This module requires these other modules and libraries: perl >= 5.8.0 Glib >= 1.280 (Perl module) Pango >= 1.220 (Perl module) GTK+ > 2.x (C library) If GTK+ is as new or newer as 2.8, the Cairo module is also required: Cairo >= 1.00 (Perl module) In order to build it from source, you'll also need ExtUtils::Depends >= 0.300 ExtUtils::PkgConfig >= 1.030 BUG REPORTS ----------- Please report bugs to the gnome-perl product in GNOME's Bugzilla: COPYRIGHT AND LICENSE --------------------- Copyright (C) 2003-2012 by the gtk2-perl team (see the file AUTHORS for the full list) This library is free software; you can redistribute it and/or modify it under the terms of the GNU Library General Public License as published by the Free Software Foundation; either version 2.1 of the License, or (at your option) any later version. This library is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Library General Public License for more details. You should have received a copy of the GNU Library General Public License along with this library; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. # $Id$ Gtk2-1.24992/xs/0000755000175000017500000000000013076464135011564 5ustar lacklackGtk2-1.24992/xs/GtkCellRendererText.xs0000644000175000017500000000250713076462677016036 0ustar lacklack/* * Copyright (c) 2003 by the gtk2-perl team (see the file AUTHORS) * * This library is free software; you can redistribute it and/or * modify it under the terms of the GNU Library General Public * License as published by the Free Software Foundation; either * version 2.1 of the License, or (at your option) any later version. * * This library is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU * Library General Public License for more details. * * You should have received a copy of the GNU Library General Public * License along with this library; if not, write to the * Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, * Boston, MA 02110-1301 USA. * * $Id$ */ #include "gtk2perl.h" MODULE = Gtk2::CellRendererText PACKAGE = Gtk2::CellRendererText PREFIX = gtk_cell_renderer_text_ ##GtkWidget* gtk_cell_renderer_text_new (void); GtkCellRenderer * gtk_cell_renderer_text_new (class) C_ARGS: /* void */ ## void gtk_cell_renderer_text_set_fixed_height_from_font (GtkCellRendererText *renderer, gint number_of_rows) void gtk_cell_renderer_text_set_fixed_height_from_font (renderer, number_of_rows) GtkCellRendererText * renderer gint number_of_rows Gtk2-1.24992/xs/GdkPango.xs0000644000175000017500000001061613076462677013647 0ustar lacklack/* * Copyright (c) 2005-2006 by the gtk2-perl team (see the file AUTHORS) * * Licensed under the LGPL, see LICENSE file for more information. * * $Id$ */ #include "gtk2perl.h" #define GTK2PERL_PANGO_ATTR_REGISTER_CUSTOM_TYPE(attr, package) \ { \ static gboolean type_registered_already = FALSE; \ if (!type_registered_already) { \ gtk2perl_pango_attribute_register_custom_type \ ((attr)->klass->type, package); \ type_registered_already = TRUE; \ } \ } #define GTK2PERL_PANGO_ATTR_STORE_INDICES(offset, attr) \ if (items == offset + 2) { \ guint start = SvUV (ST (offset)); \ guint end = SvUV (ST (offset + 1)); \ attr->start_index = start; \ attr->end_index = end; \ } MODULE = Gtk2::Gdk::Pango PACKAGE = Gtk2::Gdk::PangoRenderer PREFIX = gdk_pango_renderer_ # We own the reference. # PangoRenderer *gdk_pango_renderer_new (GdkScreen *screen); PangoRenderer_noinc * gdk_pango_renderer_new (class, screen) GdkScreen *screen C_ARGS: screen # gtk+ owns the reference. # PangoRenderer *gdk_pango_renderer_get_default (GdkScreen *screen); PangoRenderer * gdk_pango_renderer_get_default (class, screen) GdkScreen *screen C_ARGS: screen void gdk_pango_renderer_set_drawable (GdkPangoRenderer *gdk_renderer, GdkDrawable_ornull *drawable); void gdk_pango_renderer_set_gc (GdkPangoRenderer *gdk_renderer, GdkGC_ornull *gc); void gdk_pango_renderer_set_stipple (GdkPangoRenderer *gdk_renderer, PangoRenderPart part, GdkBitmap_ornull *stipple); void gdk_pango_renderer_set_override_color (GdkPangoRenderer *gdk_renderer, PangoRenderPart part, const GdkColor_ornull *color); # FIXME: Do we need this? The docs say to use gtk_widget_get_pango_context() # instead. # PangoContext *gdk_pango_context_get_for_screen (GdkScreen *screen); # FIXME: How to bind these? Class static method or function? # GdkRegion *gdk_pango_layout_line_get_clip_region (PangoLayoutLine *line, gint x_origin, gint y_origin, gint *index_ranges, gint n_ranges); # GdkRegion *gdk_pango_layout_get_clip_region (PangoLayout *layout, gint x_origin, gint y_origin, gint *index_ranges, gint n_ranges); # --------------------------------------------------------------------------- # MODULE = Gtk2::Gdk::Pango PACKAGE = Gtk2::Gdk::Pango::AttrStipple PREFIX = gdk_pango_attr_stipple_ BOOT: gperl_set_isa ("Gtk2::Gdk::Pango::AttrStipple", "Gtk2::Pango::Attribute"); PangoAttribute_own * gdk_pango_attr_stipple_new (class, GdkBitmap_ornull *stipple, ...); C_ARGS: stipple POSTCALL: GTK2PERL_PANGO_ATTR_REGISTER_CUSTOM_TYPE (RETVAL, "Gtk2::Gdk::Pango::AttrStipple"); GTK2PERL_PANGO_ATTR_STORE_INDICES (2, RETVAL); GdkBitmap_noinc * stipple (PangoAttribute * attr, ...) CODE: RETVAL = ((GdkPangoAttrStipple*) attr)->stipple; if (items > 1) ((GdkPangoAttrStipple*) attr)->stipple = g_object_ref (SvGdkBitmap_ornull (ST (1))); OUTPUT: RETVAL # --------------------------------------------------------------------------- # MODULE = Gtk2::Gdk::Pango PACKAGE = Gtk2::Gdk::Pango::AttrEmbossed PREFIX = gdk_pango_attr_embossed_ BOOT: gperl_set_isa ("Gtk2::Gdk::Pango::AttrEmbossed", "Gtk2::Pango::Attribute"); PangoAttribute_own * gdk_pango_attr_embossed_new (class, gboolean embossed, ...); C_ARGS: embossed POSTCALL: GTK2PERL_PANGO_ATTR_REGISTER_CUSTOM_TYPE (RETVAL, "Gtk2::Gdk::Pango::AttrEmbossed"); GTK2PERL_PANGO_ATTR_STORE_INDICES (2, RETVAL); gboolean embossed (PangoAttribute * attr, ...) CODE: RETVAL = ((GdkPangoAttrEmbossed*) attr)->embossed; if (items > 1) ((GdkPangoAttrEmbossed*) attr)->embossed = SvTRUE (ST (1)); OUTPUT: RETVAL # --------------------------------------------------------------------------- # #if GTK_CHECK_VERSION (2, 12, 0) MODULE = Gtk2::Gdk::Pango PACKAGE = Gtk2::Gdk::Pango::AttrEmbossColor PREFIX = gdk_pango_attr_emboss_color_ BOOT: gperl_set_isa ("Gtk2::Gdk::Pango::AttrEmbossColor", "Gtk2::Pango::Attribute"); PangoAttribute_own * gdk_pango_attr_emboss_color_new (class, const GdkColor *color, ...); C_ARGS: color POSTCALL: GTK2PERL_PANGO_ATTR_REGISTER_CUSTOM_TYPE (RETVAL, "Gtk2::Gdk::Pango::AttrEmbossColor"); GTK2PERL_PANGO_ATTR_STORE_INDICES (2, RETVAL); PangoColor * color (PangoAttribute * attr, ...) PREINIT: PangoColor color; CODE: color = ((GdkPangoAttrEmbossColor*) attr)->color; RETVAL = &color; if (items > 1) ((GdkPangoAttrEmbossColor*) attr)->color = *((PangoColor *) SvPangoColor (ST (1))); OUTPUT: RETVAL #endif Gtk2-1.24992/xs/GtkLayout.xs0000644000175000017500000000616713076462677014106 0ustar lacklack/* * Copyright (c) 2003 by the gtk2-perl team (see the file AUTHORS) * * This library is free software; you can redistribute it and/or * modify it under the terms of the GNU Library General Public * License as published by the Free Software Foundation; either * version 2.1 of the License, or (at your option) any later version. * * This library is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU * Library General Public License for more details. * * You should have received a copy of the GNU Library General Public * License along with this library; if not, write to the * Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, * Boston, MA 02110-1301 USA. * * $Id$ */ #include "gtk2perl.h" MODULE = Gtk2::Layout PACKAGE = Gtk2::Layout PREFIX = gtk_layout_ =for apidoc bin_window __hide__ =cut ## GdkWindow* gtk_layout_get_bin_window (GtkLayout *layout) GdkWindow_ornull * get_bin_window (layout) GtkLayout * layout ALIAS: bin_window = 1 CODE: PERL_UNUSED_VAR (ix); #if GTK_CHECK_VERSION (2, 14, 0) RETVAL = gtk_layout_get_bin_window (layout); #else RETVAL = layout->bin_window; #endif /* 2.14 */ OUTPUT: RETVAL ## GtkWidget* gtk_layout_new (GtkAdjustment *hadjustment, GtkAdjustment *vadjustment) GtkWidget * gtk_layout_new (class, hadjustment=NULL, vadjustment=NULL) GtkAdjustment_ornull * hadjustment GtkAdjustment_ornull * vadjustment C_ARGS: hadjustment, vadjustment ## void gtk_layout_put (GtkLayout *layout, GtkWidget *child_widget, gint x, gint y) void gtk_layout_put (layout, child_widget, x, y) GtkLayout * layout GtkWidget * child_widget gint x gint y ## void gtk_layout_move (GtkLayout *layout, GtkWidget *child_widget, gint x, gint y) void gtk_layout_move (layout, child_widget, x, y) GtkLayout * layout GtkWidget * child_widget gint x gint y ## void gtk_layout_set_size (GtkLayout *layout, guint width, guint height) void gtk_layout_set_size (layout, width, height) GtkLayout * layout guint width guint height ## void gtk_layout_get_size (GtkLayout *layout, guint *width, guint *height) void gtk_layout_get_size (GtkLayout * layout, OUTLIST guint width, OUTLIST guint height) ## GtkAdjustment* gtk_layout_get_hadjustment (GtkLayout *layout) GtkAdjustment * gtk_layout_get_hadjustment (layout) GtkLayout * layout ## GtkAdjustment* gtk_layout_get_vadjustment (GtkLayout *layout) GtkAdjustment * gtk_layout_get_vadjustment (layout) GtkLayout * layout ## void gtk_layout_set_hadjustment (GtkLayout *layout, GtkAdjustment *adjustment) void gtk_layout_set_hadjustment (layout, adjustment) GtkLayout * layout GtkAdjustment * adjustment ## void gtk_layout_set_vadjustment (GtkLayout *layout, GtkAdjustment *adjustment) void gtk_layout_set_vadjustment (layout, adjustment) GtkLayout * layout GtkAdjustment * adjustment ## void gtk_layout_thaw (GtkLayout *layout) void gtk_layout_thaw (layout) GtkLayout * layout ##void gtk_layout_freeze (GtkLayout *layout) void gtk_layout_freeze (layout) GtkLayout * layout Gtk2-1.24992/xs/GtkColorSelection.xs0000644000175000017500000001423313076462677015546 0ustar lacklack/* * Copyright (c) 2003 by the gtk2-perl team (see the file AUTHORS) * * This library is free software; you can redistribute it and/or * modify it under the terms of the GNU Library General Public * License as published by the Free Software Foundation; either * version 2.1 of the License, or (at your option) any later version. * * This library is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU * Library General Public License for more details. * * You should have received a copy of the GNU Library General Public * License along with this library; if not, write to the * Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, * Boston, MA 02110-1301 USA. * * $Id$ */ #include "gtk2perl.h" MODULE = Gtk2::ColorSelection PACKAGE = Gtk2::ColorSelection PREFIX = gtk_color_selection_ GtkWidget * gtk_color_selection_new (class) C_ARGS: /* void */ ## gboolean gtk_color_selection_get_has_opacity_control (GtkColorSelection *colorsel) gboolean gtk_color_selection_get_has_opacity_control (colorsel) GtkColorSelection * colorsel ## void gtk_color_selection_set_has_opacity_control (GtkColorSelection *colorsel, gboolean has_opacity) void gtk_color_selection_set_has_opacity_control (colorsel, has_opacity) GtkColorSelection * colorsel gboolean has_opacity ## gboolean gtk_color_selection_get_has_palette (GtkColorSelection *colorsel) gboolean gtk_color_selection_get_has_palette (colorsel) GtkColorSelection * colorsel ## void gtk_color_selection_set_has_palette (GtkColorSelection *colorsel, gboolean has_palette) void gtk_color_selection_set_has_palette (colorsel, has_palette) GtkColorSelection * colorsel gboolean has_palette ## void gtk_color_selection_set_current_color (GtkColorSelection *colorsel, GdkColor *color) void gtk_color_selection_set_current_color (colorsel, color) GtkColorSelection * colorsel GdkColor * color # void gtk_color_selection_set_current_alpha (GtkColorSelection *colorsel, guint16 alpha) void gtk_color_selection_set_current_alpha (colorsel, alpha) GtkColorSelection * colorsel guint16 alpha ## void gtk_color_selection_get_current_color (GtkColorSelection *colorsel, GdkColor *color) GdkColor_copy * gtk_color_selection_get_current_color (colorsel) GtkColorSelection * colorsel PREINIT: GdkColor color; CODE: gtk_color_selection_get_current_color (colorsel, &color); RETVAL = &color; OUTPUT: RETVAL # guint16 gtk_color_selection_get_current_alpha (GtkColorSelection *colorsel) guint16 gtk_color_selection_get_current_alpha (colorsel) GtkColorSelection * colorsel ## void gtk_color_selection_set_previous_color (GtkColorSelection *colorsel, GdkColor *color) void gtk_color_selection_set_previous_color (colorsel, color) GtkColorSelection * colorsel GdkColor * color # void gtk_color_selection_set_previous_alpha (GtkColorSelection *colorsel, guint16 alpha) void gtk_color_selection_set_previous_alpha (colorsel, alpha) GtkColorSelection * colorsel guint16 alpha ## void gtk_color_selection_get_previous_color (GtkColorSelection *colorsel, GdkColor *color) GdkColor_copy * gtk_color_selection_get_previous_color (colorsel) GtkColorSelection * colorsel PREINIT: GdkColor color; CODE: gtk_color_selection_get_previous_color (colorsel, &color); RETVAL = &color; OUTPUT: RETVAL # guint16 gtk_color_selection_get_previous_alpha (GtkColorSelection *colorsel) guint16 gtk_color_selection_get_previous_alpha (colorsel) GtkColorSelection * colorsel ## gboolean gtk_color_selection_is_adjusting (GtkColorSelection *colorsel) gboolean gtk_color_selection_is_adjusting (colorsel) GtkColorSelection * colorsel ## gboolean gtk_color_selection_palette_from_string (const gchar *str, GdkColor **colors, gint *n_colors) =for apidoc Returns a list of Gtk2::Gdk::color's. =cut void gtk_color_selection_palette_from_string (class, string) gchar * string PREINIT: GdkColor * colors; gint n_colors; int i; PPCODE: if (!gtk_color_selection_palette_from_string (string, &colors, &n_colors)) XSRETURN_EMPTY; EXTEND (SP, n_colors); for (i = 0; i < n_colors; i++) PUSHs (sv_2mortal (newSVGdkColor_copy (&(colors[i])))); g_free (colors); ## gchar* gtk_color_selection_palette_to_string (const GdkColor *colors, gint n_colors) =for apidoc =for signature (string) = Gtk::ColorSelection->palette_to_string (...) =for arg ... of Gtk2::Gdk::Color's for the palette Encodes a palette as a string, useful for persistent storage. =cut SV * gtk_color_selection_palette_to_string (class, ...) PREINIT: GdkColor * colors; gint n_colors; gchar * string; int i; CODE: n_colors = items - 1; for (i = 0 ; i < n_colors ; i++) { /* this will croak if any of the items are not valid */ gperl_get_boxed_check (ST (i+1), GDK_TYPE_COLOR); } /* now that we know we won't croak, it's safe to alloc some memory. */ colors = g_new0 (GdkColor, n_colors); for (i = 0 ; i < n_colors ; i++) { GdkColor * c = gperl_get_boxed_check (ST (i+1), GDK_TYPE_COLOR); colors[i] = *c; } string = gtk_color_selection_palette_to_string (colors, n_colors); RETVAL = newSVpv (string, 0); g_free (colors); g_free (string); OUTPUT: RETVAL # TODO: GtkColorSelectionChangePaletteFunc not in typemap (that's a mouthfull) ## GtkColorSelectionChangePaletteFunc gtk_color_selection_set_change_palette_hook (GtkColorSelectionChangePaletteFunc func) #GtkColorSelectionChangePaletteFunc #gtk_color_selection_set_change_palette_hook (func) # GtkColorSelectionChangePaletteFunc func # TODO: no marshaller for GtkColorSelectionChangePaletteWithScreenFunc either ## GtkColorSelectionChangePaletteWithScreenFunc gtk_color_selection_set_change_palette_with_screen_hook (GtkColorSelectionChangePaletteWithScreenFunc func) # deprecated ## void gtk_color_selection_get_color (GtkColorSelection *colorsel, gdouble *color) # deprecated ## void gtk_color_selection_set_update_policy (GtkColorSelection *colorsel, GtkUpdateType policy) # deprecated #void gtk_color_selection_set_color (GtkColorSelection *colorsel, gdouble *color) #GtkType gtk_color_selection_get_type (void) G_GNUC_CONST Gtk2-1.24992/xs/GtkFileSelection.xs0000644000175000017500000001074613076462677015354 0ustar lacklack/* * Copyright (c) 2003 by the gtk2-perl team (see the file AUTHORS) * * This library is free software; you can redistribute it and/or * modify it under the terms of the GNU Library General Public * License as published by the Free Software Foundation; either * version 2.1 of the License, or (at your option) any later version. * * This library is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU * Library General Public License for more details. * * You should have received a copy of the GNU Library General Public * License along with this library; if not, write to the * Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, * Boston, MA 02110-1301 USA. * * $Id$ */ #include "gtk2perl.h" MODULE = Gtk2::FileSelection PACKAGE = Gtk2::FileSelection PREFIX = gtk_file_selection_ =for deprecated_by Gtk2::FileChooserDialog =cut GtkWidget * dir_list (fs) GtkFileSelection* fs ALIAS: Gtk2::FileSelection::file_list = 1 Gtk2::FileSelection::selection_entry = 2 Gtk2::FileSelection::selection_text = 3 Gtk2::FileSelection::main_vbox = 4 Gtk2::FileSelection::ok_button = 5 Gtk2::FileSelection::cancel_button = 6 Gtk2::FileSelection::help_button = 7 Gtk2::FileSelection::history_pulldown = 8 Gtk2::FileSelection::history_menu = 9 Gtk2::FileSelection::fileop_dialog = 10 Gtk2::FileSelection::fileop_entry = 11 Gtk2::FileSelection::fileop_c_dir = 12 Gtk2::FileSelection::fileop_del_file = 13 Gtk2::FileSelection::fileop_ren_file = 14 Gtk2::FileSelection::button_area = 15 Gtk2::FileSelection::action_area = 16 CODE: switch (ix) { case 0: RETVAL = fs->dir_list; break; case 1: RETVAL = fs->file_list; break; case 2: RETVAL = fs->selection_entry; break; case 3: RETVAL = fs->selection_text; break; case 4: RETVAL = fs->main_vbox; break; case 5: RETVAL = fs->ok_button; break; case 6: RETVAL = fs->cancel_button; break; case 7: RETVAL = fs->help_button; break; case 8: RETVAL = fs->history_pulldown; break; case 9: RETVAL = fs->history_menu; break; case 10: RETVAL = fs->fileop_dialog; break; case 11: RETVAL = fs->fileop_entry; break; case 12: RETVAL = fs->fileop_c_dir; break; case 13: RETVAL = fs->fileop_del_file; break; case 14: RETVAL = fs->fileop_ren_file; break; case 15: RETVAL = fs->button_area; break; case 16: RETVAL = fs->action_area; break; default: RETVAL = NULL; g_assert_not_reached (); } OUTPUT: RETVAL gchar * fileop_file (fs) GtkFileSelection* fs CODE: RETVAL = fs->fileop_file; OUTPUT: RETVAL ## GtkWidget* gtk_file_selection_new (const gchar *title) GtkWidget * gtk_file_selection_new (class, title) const gchar * title C_ARGS: title ## void gtk_file_selection_set_filename (GtkFileSelection *filesel, const gchar *filename) void gtk_file_selection_set_filename (filesel, filename) GtkFileSelection * filesel GPerlFilename filename ## void gtk_file_selection_complete (GtkFileSelection *filesel, const gchar *pattern) void gtk_file_selection_complete (filesel, pattern) GtkFileSelection * filesel const gchar * pattern ## void gtk_file_selection_show_fileop_buttons (GtkFileSelection *filesel) void gtk_file_selection_show_fileop_buttons (filesel) GtkFileSelection * filesel ## void gtk_file_selection_hide_fileop_buttons (GtkFileSelection *filesel) void gtk_file_selection_hide_fileop_buttons (filesel) GtkFileSelection * filesel ## void gtk_file_selection_set_select_multiple (GtkFileSelection *filesel, gboolean select_multiple) void gtk_file_selection_set_select_multiple (filesel, select_multiple) GtkFileSelection * filesel gboolean select_multiple ## gboolean gtk_file_selection_get_select_multiple (GtkFileSelection *filesel) gboolean gtk_file_selection_get_select_multiple (filesel) GtkFileSelection * filesel ## gtk_file_selection_get_filename returns a statically allocated string GPerlFilename_const gtk_file_selection_get_filename (filesel) GtkFileSelection * filesel =for apidoc Returns the list of file name(s) selected. =cut void gtk_file_selection_get_selections (filesel) GtkFileSelection * filesel PREINIT: int i; gchar ** rets; PPCODE: rets = gtk_file_selection_get_selections(filesel); for (i = 0; rets[i] != NULL; i++) XPUSHs (sv_2mortal (gperl_sv_from_filename (rets[i]))); g_strfreev(rets); Gtk2-1.24992/xs/GtkSelection.xs0000644000175000017500000004347613076462677014562 0ustar lacklack/* * Copyright (c) 2003-2006, 2009 by the gtk2-perl team (see the file AUTHORS) * * This library is free software; you can redistribute it and/or * modify it under the terms of the GNU Library General Public * License as published by the Free Software Foundation; either * version 2.1 of the License, or (at your option) any later version. * * This library is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU * Library General Public License for more details. * * You should have received a copy of the GNU Library General Public * License along with this library; if not, write to the * Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, * Boston, MA 02110-1301 USA. * * $Id$ */ #include "gtk2perl.h" #if !GTK_CHECK_VERSION (2, 16, 0) # define gtk_selection_data_get_selection(d) ((d)->selection) #endif /* 2.16 */ #if !GTK_CHECK_VERSION (2, 14, 0) # define gtk_selection_data_get_target(d) ((d)->target) # define gtk_selection_data_get_data_type(d) ((d)->type) # define gtk_selection_data_get_data(d) ((d)->data) # define gtk_selection_data_get_format(d) ((d)->format) # define gtk_selection_data_get_length(d) ((d)->length) # define gtk_selection_data_get_display(d) ((d)->display) #endif /* 2.14 */ SV * newSVGtkTargetEntry (GtkTargetEntry * e) { HV * h; SV * r; if (!e) return &PL_sv_undef; h = newHV (); r = newRV_noinc ((SV*)h); gperl_hv_take_sv_s (h, "target", e->target ? newSVpv (e->target, 0) : newSVsv (&PL_sv_undef)); gperl_hv_take_sv_s (h, "flags", newSVGtkTargetFlags (e->flags)); gperl_hv_take_sv_s (h, "info", newSViv (e->info)); return r; } GtkTargetEntry * SvGtkTargetEntry (SV * sv) { GtkTargetEntry * entry = gperl_alloc_temp (sizeof (GtkTargetEntry)); gtk2perl_read_gtk_target_entry (sv, entry); return entry; } void gtk2perl_read_gtk_target_entry (SV * sv, GtkTargetEntry * e) { HV * h; AV * a; SV ** s; STRLEN len; if (gperl_sv_is_hash_ref (sv)) { h = (HV*) SvRV (sv); if ((s=hv_fetch (h, "target", 6, 0)) && gperl_sv_is_defined (*s)) e->target = SvPV (*s, len); if ((s=hv_fetch (h, "flags", 5, 0)) && gperl_sv_is_defined (*s)) e->flags = SvGtkTargetFlags (*s); if ((s=hv_fetch (h, "info", 4, 0)) && gperl_sv_is_defined (*s)) e->info = SvUV (*s); } else if (gperl_sv_is_array_ref (sv)) { a = (AV*)SvRV (sv); if ((s=av_fetch (a, 0, 0)) && gperl_sv_is_defined (*s)) e->target = SvPV (*s, len); if ((s=av_fetch (a, 1, 0)) && gperl_sv_is_defined (*s)) e->flags = SvGtkTargetFlags (*s); if ((s=av_fetch (a, 2, 0)) && gperl_sv_is_defined (*s)) e->info = SvUV (*s); } else { croak ("a target entry must be a reference to a hash " "containing the keys 'target', 'flags', and 'info', " "or a reference to a three-element list containing " "the information in the order target, flags, info"); } } /* gtk+ 2.10 introduces a boxed type for GtkTargetList. */ #if GTK_CHECK_VERSION (2, 10, 0) static GPerlBoxedWrapperClass *default_wrapper_class; static GPerlBoxedWrapperClass gtk_target_list_wrapper_class; static SV * gtk_target_list_wrap (GType gtype, const char *package, gpointer boxed, gboolean own) { /* To keep compatibility with the old wrappers, we always assume * ownership of the list. */ PERL_UNUSED_VAR (own); gtk_target_list_ref ((GtkTargetList *) boxed); return default_wrapper_class->wrap (gtype, package, boxed, TRUE); } #endif /* 2.10 */ SV * newSVGtkTargetList (GtkTargetList * list) { #if GTK_CHECK_VERSION (2, 9, 0) return gperl_new_boxed (list, GTK_TYPE_TARGET_LIST, TRUE); #else gtk_target_list_ref (list); return sv_setref_pv (newSV (0), "Gtk2::TargetList", list); #endif } GtkTargetList * SvGtkTargetList (SV * sv) { #if GTK_CHECK_VERSION (2, 9, 0) return gperl_get_boxed_check (sv, GTK_TYPE_TARGET_LIST); #else if (!gperl_sv_is_defined (sv) || !SvROK (sv) || !sv_derived_from (sv, "Gtk2::TargetList")) croak ("variable is not of type Gtk2::TargetList"); return INT2PTR (GtkTargetList*, SvUV (SvRV (sv))); #endif } MODULE = Gtk2::Selection PACKAGE = Gtk2::TargetEntry =for position SYNOPSIS =head1 SYNOPSIS # as a HASH $target_entry = { target => 'text/plain', # some string representing the drag type flags => [], # Gtk2::TargetFlags info => 42, # some app-defined integer identifier }; # as an ARRAY, for compactness $target_entry = [ $target, $flags, $info ]; =cut =for position DESCRIPTION =head1 DESCRIPTION A Gtk2::TargetEntry data structure represents a single type of data than can be supplied for by a widget for a selection or for supplied or received during drag-and-drop. It contains a string representing the drag type, a flags field (used only for drag and drop - see Gtk2::TargetFlags), and an application assigned integer ID. The integer ID will later be passed as a signal parameter for signals like "selection_get". It allows the application to identify the target type without extensive string compares. =cut =for flags GtkTargetFlags =cut =for see_also Gtk2::TargetList =cut MODULE = Gtk2::Selection PACKAGE = Gtk2::TargetList PREFIX = gtk_target_list_ BOOT: #if GTK_CHECK_VERSION (2, 9, 0) default_wrapper_class = gperl_default_boxed_wrapper_class (); gtk_target_list_wrapper_class = *default_wrapper_class; gtk_target_list_wrapper_class.wrap = gtk_target_list_wrap; gperl_register_boxed (GTK_TYPE_TARGET_LIST, "Gtk2::TargetList", >k_target_list_wrapper_class); #endif =for see_also Gtk2::TargetEntry =cut #if !GTK_CHECK_VERSION (2, 10, 0) void DESTROY (SV * list) CODE: gtk_target_list_unref (SvGtkTargetList (list)); #endif /* !2.10 */ ## GtkTargetList *gtk_target_list_new (const GtkTargetEntry *targets, guint ntargets) =for apidoc =for arg ... of Gtk2::TargetEntry's =cut GtkTargetList * gtk_target_list_new (class, ...) PREINIT: GtkTargetEntry *targets; guint ntargets; CODE: GTK2PERL_STACK_ITEMS_TO_TARGET_ENTRY_ARRAY (1, targets, ntargets); RETVAL = gtk_target_list_new (targets, ntargets); OUTPUT: RETVAL CLEANUP: gtk_target_list_unref (RETVAL); ## void gtk_target_list_add (GtkTargetList *list, GdkAtom target, guint flags, guint info) void gtk_target_list_add (list, target, flags, info) GtkTargetList *list GdkAtom target guint flags guint info ## void gtk_target_list_add_table (GtkTargetList *list, const GtkTargetEntry *targets, guint ntargets) =for apidoc =for arg ... of Gtk2::TargetEntry's =cut void gtk_target_list_add_table (GtkTargetList * list, ...) PREINIT: GtkTargetEntry *targets; guint ntargets; CODE: GTK2PERL_STACK_ITEMS_TO_TARGET_ENTRY_ARRAY (1, targets, ntargets); gtk_target_list_add_table (list, targets, ntargets); ## void gtk_target_list_remove (GtkTargetList *list, GdkAtom target) void gtk_target_list_remove (list, target) GtkTargetList *list GdkAtom target ## gboolean gtk_target_list_find (GtkTargetList *list, GdkAtom target, guint *info) guint gtk_target_list_find (list, target) GtkTargetList *list GdkAtom target CODE: if (!gtk_target_list_find (list, target, &RETVAL)) XSRETURN_UNDEF; OUTPUT: RETVAL #if GTK_CHECK_VERSION (2, 6, 0) void gtk_target_list_add_text_targets (GtkTargetList *list, guint info); void gtk_target_list_add_image_targets (GtkTargetList *list, guint info, gboolean writable); void gtk_target_list_add_uri_targets (GtkTargetList *list, guint info); #endif #if GTK_CHECK_VERSION (2, 10, 0) void gtk_target_list_add_rich_text_targets (GtkTargetList *list, guint info, gboolean deserializable, GtkTextBuffer * buffer); #endif MODULE = Gtk2::Selection PACKAGE = Gtk2::Selection PREFIX = gtk_selection_ ## gboolean gtk_selection_owner_set (GtkWidget *widget, GdkAtom selection, guint32 time_) gboolean gtk_selection_owner_set (class, widget, selection, time_) GtkWidget_ornull *widget GdkAtom selection guint32 time_ C_ARGS: widget, selection, time_ #if GTK_CHECK_VERSION(2,2,0) ## gboolean gtk_selection_owner_set_for_display (GdkDisplay *display, GtkWidget *widget, GdkAtom selection, guint32 time_) gboolean gtk_selection_owner_set_for_display (class, display, widget, selection, time_) GdkDisplay *display GtkWidget_ornull *widget GdkAtom selection guint32 time_ C_ARGS: display, widget, selection, time_ #endif /* >= 2.2.0 */ MODULE = Gtk2::Selection PACKAGE = Gtk2::Widget PREFIX = gtk_ =for see_also Gtk2::TargetEntry =cut ## void gtk_selection_add_target (GtkWidget *widget, GdkAtom selection, GdkAtom target, guint info) void gtk_selection_add_target (widget, selection, target, info) GtkWidget *widget GdkAtom selection GdkAtom target guint info ## void gtk_selection_add_targets (GtkWidget *widget, GdkAtom selection, const GtkTargetEntry *targets, guint ntargets) =for apidoc =for arg ... of Gtk2::TargetEntry's =cut void gtk_selection_add_targets (widget, selection, ...) GtkWidget *widget GdkAtom selection PREINIT: GtkTargetEntry *targets; guint ntargets; CODE: GTK2PERL_STACK_ITEMS_TO_TARGET_ENTRY_ARRAY (2, targets, ntargets); gtk_selection_add_targets (widget, selection, targets, ntargets); ## void gtk_selection_clear_targets (GtkWidget *widget, GdkAtom selection) void gtk_selection_clear_targets (widget, selection) GtkWidget *widget GdkAtom selection ## gboolean gtk_selection_convert (GtkWidget *widget, GdkAtom selection, GdkAtom target, guint32 time_) gboolean gtk_selection_convert (widget, selection, target, time_) GtkWidget *widget GdkAtom selection GdkAtom target guint32 time_ ## void gtk_selection_remove_all (GtkWidget *widget) void gtk_selection_remove_all (widget) GtkWidget *widget #if GTK_CHECK_VERSION (2, 10, 0) MODULE = Gtk2::Selection PACKAGE = Gtk2 PREFIX = gtk_ =for object Gtk2::Selection =cut gboolean gtk_targets_include_text (class, GdkAtom first_target_atom, ...) ALIAS: targets_include_uri = 1 PREINIT: GdkAtom * targets; gint n_targets; gint i; CODE: n_targets = items - 1; targets = g_new (GdkAtom, n_targets); targets[0] = first_target_atom; for (i = 2; i < items ; i++) targets[i-1] = SvGdkAtom (ST (i)); if (ix == 1) RETVAL = gtk_targets_include_uri (targets, n_targets); else RETVAL = gtk_targets_include_text (targets, n_targets); g_free (targets); OUTPUT: RETVAL gboolean gtk_targets_include_rich_text (class, GtkTextBuffer * buffer, GdkAtom first_target_atom, ...) PREINIT: GdkAtom * targets; gint n_targets; gint i; CODE: n_targets = items - 2; targets = g_new (GdkAtom, n_targets); targets[0] = first_target_atom; for (i = 3; i < items ; i++) targets[i-2] = SvGdkAtom (ST (i)); RETVAL = gtk_targets_include_rich_text (targets, n_targets, buffer); g_free (targets); OUTPUT: RETVAL gboolean gtk_targets_include_image (class, gboolean writable, GdkAtom first_target_atom, ...) PREINIT: GdkAtom * targets; gint n_targets; gint i; CODE: n_targets = items - 2; targets = g_new (GdkAtom, n_targets); targets[0] = first_target_atom; for (i = 3; i < items ; i++) targets[i-2] = SvGdkAtom (ST (i)); RETVAL = gtk_targets_include_image (targets, n_targets, writable); g_free (targets); OUTPUT: RETVAL #endif /* 2.10 */ MODULE = Gtk2::Selection PACKAGE = Gtk2::SelectionData PREFIX = gtk_selection_data_ =for apidoc Gtk2::SelectionData::selection __hide__ =cut =for apidoc Gtk2::SelectionData::target __hide__ =cut =for apidoc Gtk2::SelectionData::type __hide__ =cut =for apidoc Gtk2::SelectionData::format __hide__ =cut =for apidoc Gtk2::SelectionData::data __hide__ =cut =for apidoc Gtk2::SelectionData::length __hide__ =cut =for apidoc Gtk2::SelectionData::display __hide__ =cut # GdkAtom gtk_selection_data_get_target (GtkSelectionData *selection_data); # GdkAtom gtk_selection_data_get_data_type (GtkSelectionData *selection_data); # gint gtk_selection_data_get_format (GtkSelectionData *selection_data); # const guchar *gtk_selection_data_get_data (GtkSelectionData *selection_data, gint *length); # GdkDisplay *gtk_selection_data_get_display (GtkSelectionData *selection_data); SV * get_selection (d) GtkSelectionData * d ALIAS: Gtk2::SelectionData::selection = 1 Gtk2::SelectionData::get_target = 2 Gtk2::SelectionData::target = 3 Gtk2::SelectionData::get_data_type = 4 Gtk2::SelectionData::type = 5 Gtk2::SelectionData::get_format = 6 Gtk2::SelectionData::format = 7 Gtk2::SelectionData::get_data = 8 Gtk2::SelectionData::data = 9 Gtk2::SelectionData::get_length = 10 Gtk2::SelectionData::length = 11 Gtk2::SelectionData::get_display = 12 Gtk2::SelectionData::display = 13 CODE: switch (ix) { case 0: case 1: RETVAL = newSVGdkAtom (gtk_selection_data_get_selection (d)); break; case 2: case 3: RETVAL = newSVGdkAtom (gtk_selection_data_get_target (d)); break; case 4: case 5: RETVAL = newSVGdkAtom (gtk_selection_data_get_data_type (d)); break; case 6: case 7: RETVAL = newSViv (gtk_selection_data_get_format (d)); break; case 8: case 9: RETVAL = newSVpv ( (const gchar *) gtk_selection_data_get_data (d), gtk_selection_data_get_length (d) ); break; case 10: case 11: RETVAL = newSViv (gtk_selection_data_get_length (d)); break; #if GTK_CHECK_VERSION(2, 2, 0) case 12: case 13: RETVAL = newSVGdkDisplay (gtk_selection_data_get_display (d)); break; #endif /* 2.2 */ default: RETVAL = NULL; g_assert_not_reached (); } OUTPUT: RETVAL ## void gtk_selection_data_set (GtkSelectionData *selection_data, GdkAtom type, gint format, const guchar *data, gint length) void gtk_selection_data_set (selection_data, type, format, data) GtkSelectionData *selection_data GdkAtom type gint format const guchar *data C_ARGS: selection_data, type, format, data, sv_len (ST (3)) ## gboolean gtk_selection_data_set_text (GtkSelectionData *selection_data, const gchar *str, gint len) gboolean gtk_selection_data_set_text (selection_data, str, len=-1) GtkSelectionData *selection_data const gchar *str gint len ## guchar * gtk_selection_data_get_text (GtkSelectionData *selection_data) #guchar * gchar_own * gtk_selection_data_get_text (selection_data) GtkSelectionData *selection_data CODE: /* the C function returns guchar*, but the docs say it will return * a UTF-8 string or NULL. for our code to do the UTF-8 upgrade, * we need to use a gchar* typemap, so we'll cast to keep the compiler * happy. */ RETVAL = (gchar*) gtk_selection_data_get_text (selection_data); /* the docs say get_text will return NULL if there is no text or it * the text can't be converted to UTF-8. (why don't we have a * gchar_own_ornull typemap?) */ if (!RETVAL) XSRETURN_UNDEF; OUTPUT: RETVAL ## gboolean gtk_selection_data_get_targets (GtkSelectionData *selection_data, GdkAtom **targets, gint *n_atoms) =for apidoc Gets the contents of selection_data as an array of targets. This can be used to interpret the results of getting the standard TARGETS target that is always supplied for any selection. Returns a list of GdkAtoms, the targets. =cut void gtk_selection_data_get_targets (selection_data) GtkSelectionData *selection_data PREINIT: GdkAtom *targets; gint n_atoms, i; PPCODE: if (!gtk_selection_data_get_targets (selection_data, &targets, &n_atoms)) XSRETURN_EMPTY; EXTEND (SP, n_atoms); for (i = 0 ; i < n_atoms ; i++) PUSHs (sv_2mortal (newSVGdkAtom (targets[i]))); g_free (targets); ## gboolean gtk_selection_data_targets_include_text (GtkSelectionData *selection_data) gboolean gtk_selection_data_targets_include_text (selection_data) GtkSelectionData *selection_data # FIXME: This method is completely misbound, it can only be used as # Gtk2::SelectionData::gtk_selection_clear ($widget, $event). Additionally, it # has been deprecated since 31-Jan-03. So remove this whenever we get the # chance to break API. ## gboolean gtk_selection_clear (GtkWidget *widget, GdkEventSelection *event) =for apidoc __hide__ =cut gboolean gtk_selection_clear (widget, event) GtkWidget *widget GdkEvent *event C_ARGS: widget, (GdkEventSelection*)event #if GTK_CHECK_VERSION (2, 6, 0) gboolean gtk_selection_data_set_pixbuf (GtkSelectionData *selection_data, GdkPixbuf *pixbuf); GdkPixbuf_noinc_ornull * gtk_selection_data_get_pixbuf (GtkSelectionData *selection_data); ## gboolean gtk_selection_data_set_uris (GtkSelectionData *selection_data, gchar **uris); =for apidoc =for arg ... of strings =cut gboolean gtk_selection_data_set_uris (selection_data, ...); GtkSelectionData *selection_data PREINIT: gchar **uris = NULL; int i; CODE: /* uris is NULL-terminated. */ uris = g_new0 (gchar *, items); for (i = 1; i < items; i++) uris[i - 1] = SvGChar (ST (i)); RETVAL = gtk_selection_data_set_uris (selection_data, uris); g_free (uris); OUTPUT: RETVAL ## gchar ** gtk_selection_data_get_uris (GtkSelectionData *selection_data); void gtk_selection_data_get_uris (selection_data) GtkSelectionData *selection_data PREINIT: gchar **uris = NULL; int i; PPCODE: uris = gtk_selection_data_get_uris (selection_data); if (!uris) XSRETURN_EMPTY; for (i = 0; uris[i]; i++) XPUSHs (sv_2mortal (newSVGChar (uris[i]))); g_strfreev (uris); gboolean gtk_selection_data_targets_include_image (GtkSelectionData *selection_data, gboolean writable); #endif /* 2.6 */ #if GTK_CHECK_VERSION (2, 10, 0) gboolean gtk_selection_data_targets_include_rich_text (GtkSelectionData *selection_data, GtkTextBuffer * buffer) gboolean gtk_selection_data_targets_include_uri (GtkSelectionData *selection_data) #endif /* 2.10 */ Gtk2-1.24992/xs/GtkArrow.xs0000644000175000017500000000264513076462677013720 0ustar lacklack/* * Copyright (c) 2003 by the gtk2-perl team (see the file AUTHORS) * * This library is free software; you can redistribute it and/or * modify it under the terms of the GNU Library General Public * License as published by the Free Software Foundation; either * version 2.1 of the License, or (at your option) any later version. * * This library is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU * Library General Public License for more details. * * You should have received a copy of the GNU Library General Public * License along with this library; if not, write to the * Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, * Boston, MA 02110-1301 USA. * * $Id$ */ #include "gtk2perl.h" MODULE = Gtk2::Arrow PACKAGE = Gtk2::Arrow PREFIX = gtk_arrow_ =for enum GtkArrowType =cut =for enum GtkShadowType =cut ## GtkWidget* gtk_arrow_new (GtkArrowType arrow_type, GtkShadowType shadow_type) GtkWidget * gtk_arrow_new (class, arrow_type, shadow_type) GtkArrowType arrow_type GtkShadowType shadow_type C_ARGS: arrow_type, shadow_type ## void gtk_arrow_set (GtkArrow *arrow, GtkArrowType arrow_type, GtkShadowType shadow_type) void gtk_arrow_set (arrow, arrow_type, shadow_type) GtkArrow * arrow GtkArrowType arrow_type GtkShadowType shadow_type Gtk2-1.24992/xs/GtkTreeSelection.xs0000644000175000017500000002303013076462677015362 0ustar lacklack/* * Copyright (c) 2003 by the gtk2-perl team (see the file AUTHORS) * * This library is free software; you can redistribute it and/or * modify it under the terms of the GNU Library General Public * License as published by the Free Software Foundation; either * version 2.1 of the License, or (at your option) any later version. * * This library is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU * Library General Public License for more details. * * You should have received a copy of the GNU Library General Public * License along with this library; if not, write to the * Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, * Boston, MA 02110-1301 USA. * * $Id$ */ #include "gtk2perl.h" /* descended directly from GObject */ static GPerlCallback * gtk2perl_tree_selection_func_create (SV * func, SV * data) { GType param_types [4]; param_types[0] = GTK_TYPE_TREE_SELECTION; param_types[1] = GTK_TYPE_TREE_MODEL; param_types[2] = GTK_TYPE_TREE_PATH; param_types[3] = G_TYPE_BOOLEAN; return gperl_callback_new (func, data, G_N_ELEMENTS (param_types), param_types, G_TYPE_BOOLEAN); } static gboolean gtk2perl_tree_selection_func (GtkTreeSelection * selection, GtkTreeModel * model, GtkTreePath * path, gboolean path_currently_selected, gpointer data) { GPerlCallback * callback = (GPerlCallback*)data; GValue value = {0,}; gboolean retval; g_value_init (&value, callback->return_type); gperl_callback_invoke (callback, &value, selection, model, path, path_currently_selected); retval = g_value_get_boolean (&value); g_value_unset (&value); return retval; } static GPerlCallback * gtk2perl_tree_selection_foreach_func_create (SV * func, SV * data) { GType param_types [3]; param_types[0] = GTK_TYPE_TREE_MODEL; param_types[1] = GTK_TYPE_TREE_PATH; param_types[2] = GTK_TYPE_TREE_ITER; return gperl_callback_new (func, data, G_N_ELEMENTS (param_types), param_types, 0); } static void gtk2perl_tree_selection_foreach_func (GtkTreeModel * model, GtkTreePath * path, GtkTreeIter * iter, gpointer data) { gperl_callback_invoke ((GPerlCallback*)data, NULL, model, path, iter); } #if !GTK_CHECK_VERSION(2,2,0) /* selected_foreach callbacks to implement get_selected_rows and * count_selected_rows for gtk < 2.2 */ static void get_selected_rows (GtkTreeModel * model, GtkTreePath * path, GtkTreeIter * iter, GList ** paths) { *paths = g_list_append (*paths, gtk_tree_path_copy (path)); } static void count_selected_rows (GtkTreeModel * model, GtkTreePath * path, GtkTreeIter * iter, gint * n) { ++*n; } #endif /* <2.2.0 */ MODULE = Gtk2::TreeSelection PACKAGE = Gtk2::TreeSelection PREFIX = gtk_tree_selection_ ## void gtk_tree_selection_set_mode (GtkTreeSelection *selection, GtkSelectionMode type) void gtk_tree_selection_set_mode (selection, type) GtkTreeSelection *selection GtkSelectionMode type ## GtkSelectionMode gtk_tree_selection_get_mode (GtkTreeSelection *selection) GtkSelectionMode gtk_tree_selection_get_mode (selection) GtkTreeSelection *selection ### void gtk_tree_selection_set_select_function (GtkTreeSelection *selection, GtkTreeSelectionFunc func, gpointer data, GtkDestroyNotify destroy) void gtk_tree_selection_set_select_function (selection, func, data=NULL) GtkTreeSelection *selection SV * func SV * data PREINIT: GPerlCallback * callback; CODE: callback = gtk2perl_tree_selection_func_create (func, data); gtk_tree_selection_set_select_function (selection, gtk2perl_tree_selection_func, callback, (GDestroyNotify) gperl_callback_destroy); ## gpointer gtk_tree_selection_get_user_data (GtkTreeSelection *selection) SV * gtk_tree_selection_get_user_data (selection) GtkTreeSelection *selection PREINIT: GPerlCallback *callback = NULL; CODE: callback = (GPerlCallback *) gtk_tree_selection_get_user_data (selection); RETVAL = callback && gperl_sv_is_defined (callback->data) ? callback->data : &PL_sv_undef; OUTPUT: RETVAL ## GtkTreeView* gtk_tree_selection_get_tree_view (GtkTreeSelection *selection) GtkTreeView* gtk_tree_selection_get_tree_view (selection) GtkTreeSelection *selection ### gboolean gtk_tree_selection_get_selected (GtkTreeSelection *selection, GtkTreeModel **model, GtkTreeIter *iter) =for apidoc =for signature iter = $tree_selection->get_selected =for signature (model, iter) = $tree_selection->get_selected Since most of the time you are only interested in the iter, C returns only the iter in scalar context. =cut void gtk_tree_selection_get_selected (selection) GtkTreeSelection *selection PREINIT: GtkTreeModel * model; GtkTreeIter iter = {0, }; PPCODE: if (!gtk_tree_selection_get_selected (selection, &model, &iter)) XSRETURN_EMPTY; if (GIMME_V == G_ARRAY) XPUSHs (sv_2mortal (newSVGtkTreeModel (model))); XPUSHs (sv_2mortal (newSVGtkTreeIter_copy (&iter))); ## these two are generally useful and very slow to implement in perl, so ## we'll be really nice and provide implementations for people stuck on ## gtk < 2.2.x ## GList * gtk_tree_selection_get_selected_rows (GtkTreeSelection *selection, GtkTreeModel **model) =for apidoc =for signature @paths = $selection->get_selected_rows Returns the Gtk2::TreePath of each selected row, or an empty list if no rows are selected. The model is I returned, as documented in the C API reference. To get the model, try C<< $selection->get_tree_view->get_model >>. =cut void gtk_tree_selection_get_selected_rows (selection) GtkTreeSelection *selection PREINIT: #if GTK_CHECK_VERSION(2,2,0) GtkTreeModel * model = NULL; #else GtkTreeView * view; #endif GList * paths = NULL, * i; PPCODE: #if GTK_CHECK_VERSION(2,2,0) paths = gtk_tree_selection_get_selected_rows (selection, &model); #else view = gtk_tree_selection_get_tree_view (selection); gtk_tree_selection_selected_foreach (selection, (GtkTreeSelectionForeachFunc) get_selected_rows, &paths); #endif EXTEND (SP, (int)g_list_length (paths)); for (i = paths ; i != NULL ; i = i->next) PUSHs (sv_2mortal (newSVGtkTreePath_own ((GtkTreePath*)i->data))); g_list_free (paths); ## gint gtk_tree_selection_count_selected_rows (GtkTreeSelection *selection) gint gtk_tree_selection_count_selected_rows (selection) GtkTreeSelection *selection CODE: #if GTK_CHECK_VERSION(2,2,0) RETVAL = gtk_tree_selection_count_selected_rows (selection); #else RETVAL = 0; gtk_tree_selection_selected_foreach (selection, (GtkTreeSelectionForeachFunc) count_selected_rows, &RETVAL); #endif /* 2.2.0 */ OUTPUT: RETVAL ### void gtk_tree_selection_selected_foreach (GtkTreeSelection *selection, GtkTreeSelectionForeachFunc func, gpointer data) =for apidoc =for arg func (subroutine) Call I<$func> on every selected row in I<$selection>'s view. =cut void gtk_tree_selection_selected_foreach (selection, func, data=NULL) GtkTreeSelection *selection SV * func SV * data PREINIT: GPerlCallback * callback; CODE: callback = gtk2perl_tree_selection_foreach_func_create (func, data); gtk_tree_selection_selected_foreach (selection, gtk2perl_tree_selection_foreach_func, callback); gperl_callback_destroy (callback); ## void gtk_tree_selection_select_path (GtkTreeSelection *selection, GtkTreePath *path) void gtk_tree_selection_select_path (selection, path) GtkTreeSelection *selection GtkTreePath *path ## void gtk_tree_selection_unselect_path (GtkTreeSelection *selection, GtkTreePath *path) void gtk_tree_selection_unselect_path (selection, path) GtkTreeSelection *selection GtkTreePath *path ## void gtk_tree_selection_select_iter (GtkTreeSelection *selection, GtkTreeIter *iter) void gtk_tree_selection_select_iter (selection, iter) GtkTreeSelection *selection GtkTreeIter *iter ## void gtk_tree_selection_unselect_iter (GtkTreeSelection *selection, GtkTreeIter *iter) void gtk_tree_selection_unselect_iter (selection, iter) GtkTreeSelection *selection GtkTreeIter *iter ## gboolean gtk_tree_selection_path_is_selected (GtkTreeSelection *selection, GtkTreePath *path) gboolean gtk_tree_selection_path_is_selected (selection, path) GtkTreeSelection *selection GtkTreePath *path ## gboolean gtk_tree_selection_iter_is_selected (GtkTreeSelection *selection, GtkTreeIter *iter) gboolean gtk_tree_selection_iter_is_selected (selection, iter) GtkTreeSelection *selection GtkTreeIter *iter ## void gtk_tree_selection_select_all (GtkTreeSelection *selection) void gtk_tree_selection_select_all (selection) GtkTreeSelection *selection ## void gtk_tree_selection_unselect_all (GtkTreeSelection *selection) void gtk_tree_selection_unselect_all (selection) GtkTreeSelection *selection ## void gtk_tree_selection_select_range (GtkTreeSelection *selection, GtkTreePath *start_path, GtkTreePath *end_path) void gtk_tree_selection_select_range (selection, start_path, end_path) GtkTreeSelection *selection GtkTreePath *start_path GtkTreePath *end_path #if GTK_CHECK_VERSION(2,2,0) ## void gtk_tree_selection_unselect_range (GtkTreeSelection *selection, GtkTreePath *start_path, GtkTreePath *end_path) void gtk_tree_selection_unselect_range (selection, start_path, end_path) GtkTreeSelection *selection GtkTreePath *start_path GtkTreePath *end_path #endif /* >= 2.2.0 */ # gtk_tree_selection_get_select_function is unbindable since it returns a bare # function pointer Gtk2-1.24992/xs/GtkVScrollbar.xs0000644000175000017500000000307513076462677014675 0ustar lacklack/* * Copyright (c) 2003 by the gtk2-perl team (see the file AUTHORS) * * This library is free software; you can redistribute it and/or * modify it under the terms of the GNU Library General Public * License as published by the Free Software Foundation; either * version 2.1 of the License, or (at your option) any later version. * * This library is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU * Library General Public License for more details. * * You should have received a copy of the GNU Library General Public * License along with this library; if not, write to the * Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, * Boston, MA 02110-1301 USA. * * $Id$ */ #include "gtk2perl.h" MODULE = Gtk2::VScrollbar PACKAGE = Gtk2::VScrollbar PREFIX = gtk_vscrollbar_ ## GtkWidget* gtk_vscrollbar_new (GtkAdjustment *adjustment) GtkWidget * gtk_vscrollbar_new (class, adjustment=NULL) GtkAdjustment_ornull * adjustment ALIAS: Gtk2::VScrollBar::new = 1 C_ARGS: adjustment CLEANUP: PERL_UNUSED_VAR (ix); =for apidoc Gtk2::VScrollBar::new A typo in days long past resulted in the package names for Gtk2::VScrollbar and Gtk2::HScrollbar being misspelled with a capital C, despite the fact that only the proper name (with the small C) was actually registered with the Glib type system. For backward compatibility with Gtk2-1.00, Gtk2::VScrollBar->new calls Gtk2::VScrollbar->new without complaint. =cut Gtk2-1.24992/xs/GtkCellRendererToggle.xs0000644000175000017500000000377413076462677016342 0ustar lacklack/* * Copyright (c) 2003 by the gtk2-perl team (see the file AUTHORS) * * This library is free software; you can redistribute it and/or * modify it under the terms of the GNU Library General Public * License as published by the Free Software Foundation; either * version 2.1 of the License, or (at your option) any later version. * * This library is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU * Library General Public License for more details. * * You should have received a copy of the GNU Library General Public * License along with this library; if not, write to the * Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, * Boston, MA 02110-1301 USA. * * $Id$ */ #include "gtk2perl.h" MODULE = Gtk2::CellRendererToggle PACKAGE = Gtk2::CellRendererToggle PREFIX = gtk_cell_renderer_toggle_ GtkCellRenderer * gtk_cell_renderer_toggle_new (class) C_ARGS: /* void */ ## gboolean gtk_cell_renderer_toggle_get_radio (GtkCellRendererToggle *toggle) gboolean gtk_cell_renderer_toggle_get_radio (toggle) GtkCellRendererToggle * toggle ## void gtk_cell_renderer_toggle_set_radio (GtkCellRendererToggle *toggle, gboolean radio) void gtk_cell_renderer_toggle_set_radio (toggle, radio) GtkCellRendererToggle * toggle gboolean radio ## gboolean gtk_cell_renderer_toggle_get_active (GtkCellRendererToggle *toggle) gboolean gtk_cell_renderer_toggle_get_active (toggle) GtkCellRendererToggle * toggle ## void gtk_cell_renderer_toggle_set_active (GtkCellRendererToggle *toggle, gboolean setting) void gtk_cell_renderer_toggle_set_active (toggle, setting) GtkCellRendererToggle * toggle gboolean setting #if GTK_CHECK_VERSION (2, 18, 0) gboolean gtk_cell_renderer_toggle_get_activatable (GtkCellRendererToggle *toggle); void gtk_cell_renderer_toggle_set_activatable (GtkCellRendererToggle *toggle, gboolean setting); #endif /* 2.18 */ Gtk2-1.24992/xs/GtkRuler.xs0000644000175000017500000000361613076462677013716 0ustar lacklack/* * Copyright (c) 2003 by the gtk2-perl team (see the file AUTHORS) * * This library is free software; you can redistribute it and/or * modify it under the terms of the GNU Library General Public * License as published by the Free Software Foundation; either * version 2.1 of the License, or (at your option) any later version. * * This library is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU * Library General Public License for more details. * * You should have received a copy of the GNU Library General Public * License along with this library; if not, write to the * Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, * Boston, MA 02110-1301 USA. * * $Id$ */ #include "gtk2perl.h" MODULE = Gtk2::Ruler PACKAGE = Gtk2::Ruler PREFIX = gtk_ruler_ ## void gtk_ruler_set_metric (GtkRuler *ruler, GtkMetricType metric) void gtk_ruler_set_metric (ruler, metric) GtkRuler * ruler GtkMetricType metric ## void gtk_ruler_set_range (GtkRuler *ruler, gdouble lower, gdouble upper, gdouble position, gdouble max_size) void gtk_ruler_set_range (ruler, lower, upper, position, max_size) GtkRuler * ruler gdouble lower gdouble upper gdouble position gdouble max_size ## void gtk_ruler_draw_ticks (GtkRuler *ruler) void gtk_ruler_draw_ticks (ruler) GtkRuler * ruler ## void gtk_ruler_draw_pos (GtkRuler *ruler) void gtk_ruler_draw_pos (ruler) GtkRuler * ruler ## GtkMetricType gtk_ruler_get_metric (GtkRuler *ruler) GtkMetricType gtk_ruler_get_metric (ruler) GtkRuler * ruler ## void gtk_ruler_get_range (GtkRuler *ruler, gdouble *lower, gdouble *upper, gdouble *position, gdouble *max_size) void gtk_ruler_get_range (GtkRuler * ruler, OUTLIST gdouble lower, OUTLIST gdouble upper, OUTLIST gdouble position, OUTLIST gdouble max_size) Gtk2-1.24992/xs/GtkLinkButton.xs0000644000175000017500000000565213076462677014720 0ustar lacklack/* * Copyright (c) 2006 by the gtk2-perl team (see the file AUTHORS) * * This library is free software; you can redistribute it and/or * modify it under the terms of the GNU Library General Public * License as published by the Free Software Foundation; either * version 2.1 of the License, or (at your option) any later version. * * This library is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU * Library General Public License for more details. * * You should have received a copy of the GNU Library General Public * License along with this library; if not, write to the * Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, * Boston, MA 02110-1301 USA. * * $Id$ */ #include "gtk2perl.h" static GPerlCallback * gtk2perl_link_button_uri_func_create (SV * func, SV * data) { GType param_types[2]; param_types[0] = GTK_TYPE_LINK_BUTTON; param_types[1] = G_TYPE_STRING; return gperl_callback_new (func, data, G_N_ELEMENTS (param_types), param_types, G_TYPE_NONE); } static void gtk2perl_link_button_uri_func (GtkLinkButton *button, const gchar *link, gpointer user_data) { GPerlCallback * callback = (GPerlCallback*) user_data; gperl_callback_invoke (callback, NULL, button, link); } MODULE = Gtk2::LinkButton PACKAGE = Gtk2::LinkButton PREFIX = gtk_link_button_ GtkWidget * gtk_link_button_new (class, const gchar *url, const gchar *label=NULL) ALIAS: new_with_label = 1 CODE: PERL_UNUSED_VAR (ix); if (label) RETVAL = gtk_link_button_new_with_label (url, label); else RETVAL = gtk_link_button_new (url); OUTPUT: RETVAL const gchar *gtk_link_button_get_uri (GtkLinkButton *link_button); void gtk_link_button_set_uri (GtkLinkButton *link_button, const gchar *uri); =for apidoc Pass undef for I to unset the URI hook. Note that the current implementation does B return the old hook function. This means that there is no way to restore an old hook once you overwrote it. =cut ## GtkLinkButtonUriFunc gtk_link_button_set_uri_hook (GtkLinkButtonUriFunc func, gpointer data, GDestroyNotify destroy); void gtk_link_button_set_uri_hook (class, SV *func, SV *data=NULL) CODE: if (!gperl_sv_is_defined (func)) { gtk_link_button_set_uri_hook (NULL, NULL, NULL); } else { GPerlCallback * callback; callback = gtk2perl_link_button_uri_func_create (func, data); gtk_link_button_set_uri_hook (gtk2perl_link_button_uri_func, callback, (GDestroyNotify) gperl_callback_destroy); } #if GTK_CHECK_VERSION (2, 14, 0) gboolean gtk_link_button_get_visited (GtkLinkButton *link_button); void gtk_link_button_set_visited (GtkLinkButton *link_button, gboolean visited); #endif /* 2.14 */ Gtk2-1.24992/xs/GtkAdjustment.xs0000644000175000017500000001254513076462677014744 0ustar lacklack/* * Copyright (c) 2003, 2009 by the gtk2-perl team (see the file AUTHORS) * * This library is free software; you can redistribute it and/or * modify it under the terms of the GNU Library General Public * License as published by the Free Software Foundation; either * version 2.1 of the License, or (at your option) any later version. * * This library is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU * Library General Public License for more details. * * You should have received a copy of the GNU Library General Public * License along with this library; if not, write to the * Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, * Boston, MA 02110-1301 USA. * * $Id$ */ #include "gtk2perl.h" MODULE = Gtk2::Adjustment PACKAGE = Gtk2::Adjustment PREFIX = gtk_adjustment_ =for apidoc Gtk2::Adjustment::value =for signature double = $adjustment->value =for signature double = $adjustment->value ($newval) =for signature double = $adjustment->lower =for signature double = $adjustment->lower ($newval) =for signature double = $adjustment->upper =for signature double = $adjustment->upper ($newval) =for signature double = $adjustment->step_increment =for signature double = $adjustment->step_increment ($newval) =for signature double = $adjustment->page_increment =for signature double = $adjustment->page_increment ($newval) =for signature double = $adjustment->page_size =for signature double = $adjustment->page_size ($newval) Get or set the six fields of a Gtk2::Adjustment. The setter functions store $newval and return the old value. Note that they don't emit any signals; it's up to you to emit "notify" (because the fields are also properties) and "changed" or "value-changed", when you're ready. =cut =for apidoc value __hide__ =cut =for apidoc lower __hide__ =cut =for apidoc upper __hide__ =cut =for apidoc step_increment __hide__ =cut =for apidoc page_increment __hide__ =cut =for apidoc page_size __hide__ =cut gdouble value (GtkAdjustment *adjustment, gdouble newval = 0) ALIAS: lower = 1 upper = 2 step_increment = 3 page_increment = 4 page_size = 5 CODE: switch (ix) { case 0: RETVAL = adjustment->value; if (items > 1) adjustment->value = newval; break; case 1: RETVAL = adjustment->lower; if (items > 1) adjustment->lower = newval; break; case 2: RETVAL = adjustment->upper; if (items > 1) adjustment->upper = newval; break; case 3: RETVAL = adjustment->step_increment; if (items > 1) adjustment->step_increment = newval; break; case 4: RETVAL = adjustment->page_increment; if (items > 1) adjustment->page_increment = newval; break; case 5: RETVAL = adjustment->page_size; if (items > 1) adjustment->page_size = newval; break; default: RETVAL = 0.0; g_assert_not_reached (); } OUTPUT: RETVAL GtkObject* gtk_adjustment_new (class, value, lower, upper, step_increment, page_increment, page_size) gdouble value gdouble lower gdouble upper gdouble step_increment gdouble page_increment gdouble page_size C_ARGS: value, lower, upper, step_increment, page_increment, page_size void gtk_adjustment_changed (adjustment) GtkAdjustment *adjustment void gtk_adjustment_value_changed (adjustment) GtkAdjustment *adjustment void gtk_adjustment_clamp_page (adjustment, lower, upper) GtkAdjustment *adjustment gdouble lower gdouble upper gdouble gtk_adjustment_get_value (adjustment) GtkAdjustment *adjustment void gtk_adjustment_set_value (adjustment, value) GtkAdjustment *adjustment gdouble value #if GTK_CHECK_VERSION (2, 14, 0) void gtk_adjustment_configure (adjustment, value, lower, upper, step_increment, page_increment, page_size) GtkAdjustment *adjustment gdouble value gdouble lower gdouble upper gdouble step_increment gdouble page_increment gdouble page_size =for apidoc Gtk2::Adjustment::set_lower =for signature $adjustment->set_lower ($newval) =for signature $adjustment->set_page_increment ($newval) =for signature $adjustment->set_page_size ($newval) =for signature $adjustment->set_step_increment ($newval) =for signature $adjustment->set_upper ($newval) These functions differ from the plain C<< ->lower >> etc setters in that they emit C and C signals if C<$newval> is different from the current value. The corresponding C etc are not wrapped because they're the same as the C etc field accessors above. =cut =for apidoc set_lower __hide__ =cut =for apidoc set_page_increment __hide__ =cut =for apidoc set_page_size __hide__ =cut =for apidoc set_step_increment __hide__ =cut =for apidoc set_upper __hide__ =cut void set_lower (GtkAdjustment *adjustment, gdouble newval) ALIAS: set_page_increment = 1 set_page_size = 2 set_step_increment = 3 set_upper = 4 CODE: switch (ix) { case 0: gtk_adjustment_set_lower (adjustment, newval); break; case 1: gtk_adjustment_set_page_increment (adjustment, newval); break; case 2: gtk_adjustment_set_page_size (adjustment, newval); break; case 3: gtk_adjustment_set_step_increment (adjustment, newval); break; case 4: gtk_adjustment_set_upper (adjustment, newval); break; } #endif /* 2.14 */ Gtk2-1.24992/xs/GtkInputDialog.xs0000644000175000017500000000203513076462677015036 0ustar lacklack/* * Copyright (c) 2003 by the gtk2-perl team (see the file AUTHORS) * * This library is free software; you can redistribute it and/or * modify it under the terms of the GNU Library General Public * License as published by the Free Software Foundation; either * version 2.1 of the License, or (at your option) any later version. * * This library is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU * Library General Public License for more details. * * You should have received a copy of the GNU Library General Public * License along with this library; if not, write to the * Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, * Boston, MA 02110-1301 USA. * * $Id$ */ #include "gtk2perl.h" MODULE = Gtk2::InputDialog PACKAGE = Gtk2::InputDialog PREFIX = gtk_input_dialog_ ## GtkWidget* gtk_input_dialog_new (void) GtkWidget * gtk_input_dialog_new (class) C_ARGS: /* void */ Gtk2-1.24992/xs/GtkInfoBar.xs0000644000175000017500000001506013076462677014141 0ustar lacklack/* * Copyright 2010 by the gtk2-perl team (see the file AUTHORS) * * This library is free software; you can redistribute it and/or * modify it under the terms of the GNU Library General Public * License as published by the Free Software Foundation; either * version 2.1 of the License, or (at your option) any later version. * * This library is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU * Library General Public License for more details. * * You should have received a copy of the GNU Library General Public * License along with this library; if not, see . */ #include "gtk2perl.h" #include "gtk2perl-private.h" /* for the custom response id handling */ MODULE = Gtk2::InfoBar PACKAGE = Gtk2::InfoBar PREFIX = gtk_info_bar_ BOOT: gperl_signal_set_marshaller_for (GTK_TYPE_INFO_BAR, "response", gtk2perl_dialog_response_marshal); =for position post_signals Note that currently in a Perl subclass of C a class closure, ie. class default signal handler, for the C signal will be called with the response ID just as an integer, it's not turned into an enum string like C<"ok"> the way a handler setup with C receives. Hopefully this will change in the future, so don't count on it. In the interim the easiest thing to do is install your default handler in C with a C. (The subtleties of what order handlers are called in will differ, but often that doesn't matter.) =cut =for enum GtkResponseType The response type is somewhat abnormal as far as gtk2-perl enums go. In C, this enum lists named, predefined integer values for a field that is other composed of whatever integer values you like. In Perl, we allow this to be either one of the string constants listed here or any positive integer value. For example, 'ok', 'cancel', 4, and 42 are all valid response ids. You cannot use arbitrary string values, they must be integers. Be careful, because unknown string values tend to be mapped to 0. =cut =for apidoc Gtk2::InfoBar::new_with_buttons =for signature $widget = Gtk2::InfoBar->new_with_buttons (...) =for arg ... of button-text => response-id pairs. Alias for the multi-argument version of C<< Gtk2::InfoBar->new >>. =cut =for apidoc =for signature $widget = Gtk2::InfoBar->new; =for signature $widget = Gtk2::InfoBar->new (...) =for arg ... of button-text => response-id pairs. The multi-argument form takes the same list of text => response-id pairs as C<< $infobar->add_buttons >>. Do not pack widgets directly into the infobar; add them to C<< $infobar->get_content_area () >>. Here's a simple example: $infobar = Gtk2::InfoBar->new ('gtk-ok' => 'accept', 'gtk-cancel' => 'reject'); =cut GtkWidget * gtk_info_bar_new (class, ...) ALIAS: Gtk2::InfoBar::new_with_buttons = 1 PREINIT: int i; GtkWidget * info_bar; CODE: PERL_UNUSED_VAR (ix); if (items == 1) { /* the easy way out... */ info_bar = gtk_info_bar_new (); } else if ( !(items % 2) ) { croak ("USAGE: Gtk2::InfoBar->new ()\n" " or Gtk2::InfoBar->new (...)\n" " where ... is a series of button text and response id pairs"); } else { /* we can't really pass on a varargs call (at least, i don't * know how to convert from perl stack to C va_list), so we * have to duplicate a bit of the functionality of the C * version. luckily it's nothing too intense. */ info_bar = gtk_info_bar_new (); for (i = 1; i < items; i += 2) { gchar * text = SvGChar (ST (i)); int response_id = gtk2perl_dialog_response_id_from_sv (ST (i+1)); gtk_info_bar_add_button (GTK_INFO_BAR (info_bar), text, response_id); } } RETVAL = info_bar; OUTPUT: RETVAL GtkWidget * gtk_info_bar_add_button (info_bar, button_text, response_id) GtkInfoBar * info_bar const gchar * button_text SV * response_id CODE: RETVAL = gtk_info_bar_add_button (info_bar, button_text, gtk2perl_dialog_response_id_from_sv ( response_id)); OUTPUT: RETVAL =for apidoc =for arg ... of button-text => response-id pairs Like calling C<< $infobar->add_button >> repeatedly, except you don't get the created widgets back. The buttons go from left to right, so the first button added will be the left-most one. =cut void gtk_info_bar_add_buttons (info_bar, ...) GtkInfoBar * info_bar PREINIT: int i; CODE: if (!(items % 2)) croak("gtk_info_bar_add_buttons: odd number of parameters"); /* we can't make var args, so we'll call add_button for each */ for (i = 1; i < items; i += 2) gtk_info_bar_add_button (info_bar, SvGChar (ST (i)), gtk2perl_dialog_response_id_from_sv ( ST (i+1))); =for apidoc =for arg response_id (GtkResponseType) =cut void gtk_info_bar_add_action_widget (info_bar, child, response_id) GtkInfoBar * info_bar GtkWidget * child SV * response_id CODE: gtk_info_bar_add_action_widget (info_bar, child, gtk2perl_dialog_response_id_from_sv ( response_id)); =for apidoc =for arg response_id (GtkResponseType) Enable or disable an action button by its I<$response_id>. =cut void gtk_info_bar_set_response_sensitive (info_bar, response_id, setting) GtkInfoBar * info_bar SV * response_id gboolean setting CODE: gtk_info_bar_set_response_sensitive ( info_bar, gtk2perl_dialog_response_id_from_sv (response_id), setting); =for apidoc =for arg response_id (GtkResponseType) =cut void gtk_info_bar_set_default_response (info_bar, response_id) GtkInfoBar * info_bar SV * response_id CODE: gtk_info_bar_set_default_response (info_bar, gtk2perl_dialog_response_id_from_sv ( response_id)); =for apidoc =for arg response_id (GtkResponseType) =cut void gtk_info_bar_response (info_bar, response_id) GtkInfoBar * info_bar SV * response_id C_ARGS: info_bar, gtk2perl_dialog_response_id_from_sv (response_id) void gtk_info_bar_set_message_type (info_bar, type); GtkInfoBar * info_bar GtkMessageType type GtkMessageType gtk_info_bar_get_message_type (info_bar); GtkInfoBar * info_bar GtkWidget * gtk_info_bar_get_action_area (info_bar) GtkInfoBar * info_bar GtkWidget * gtk_info_bar_get_content_area (info_bar) GtkInfoBar * info_bar Gtk2-1.24992/xs/GtkHSV.xs0000644000175000017500000000177513076462677013271 0ustar lacklack/* * Copyright (c) 2010 by the gtk2-perl team (see the file AUTHORS) * * Licensed under the LGPL, see LICENSE file for more information. * * $Id$ */ #include "gtk2perl.h" MODULE = Gtk2::HSV PACKAGE = Gtk2::HSV PREFIX = gtk_hsv_ GtkWidget * gtk_hsv_new (class) C_ARGS: /* void */ void gtk_hsv_set_color (GtkHSV *hsv, double h, double s, double v); void gtk_hsv_get_color (GtkHSV *hsv, OUTLIST gdouble h, OUTLIST gdouble s, OUTLIST gdouble v); void gtk_hsv_set_metrics (GtkHSV *hsv, gint size, gint ring_width); void gtk_hsv_get_metrics (GtkHSV *hsv, OUTLIST gint size, OUTLIST gint ring_width); gboolean gtk_hsv_is_adjusting (GtkHSV *hsv); MODULE = Gtk2::HSV PACKAGE = Gtk2 PREFIX = gtk_ =for object Gtk2::HSV =cut =for apidoc __function__ =cut void gtk_hsv_to_rgb (gdouble h, gdouble s, gdouble v, OUTLIST gdouble r, OUTLIST gdouble g, OUTLIST gdouble b); =for apidoc __function__ =cut void gtk_rgb_to_hsv (gdouble r, gdouble g, gdouble b, OUTLIST gdouble h, OUTLIST gdouble s, OUTLIST gdouble v); Gtk2-1.24992/xs/GtkEntryBuffer.xs0000644000175000017500000000544513076462677015062 0ustar lacklack/* * Copyright (c) 2010 by the gtk2-perl team (see the file AUTHORS) * * This library is free software; you can redistribute it and/or * modify it under the terms of the GNU Library General Public * License as published by the Free Software Foundation; either * version 2.1 of the License, or (at your option) any later version. * * This library is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU * Library General Public License for more details. * * You should have received a copy of the GNU Library General Public * License along with this library. If not, see http://www.gnu.org/licenses/ */ #include "gtk2perl.h" MODULE = Gtk2::EntryBuffer PACKAGE = Gtk2::EntryBuffer PREFIX = gtk_entry_buffer_ =for apidoc =for position DESCRIPTION The B class contains the actual text displayed in a L widget. A single Gtk2::EntryBuffer object can be shared by multiple Gtk2::Entry widgets which will then share the same text content, but not the cursor position, visibility attributes, icon etc. Gtk2::EntryBuffer may be derived from. Such a derived class might allow text to be stored in an alternate location, such as non-pageable memory, useful in the case of important passwords. Or a derived class could integrate with an application's concept of undo/redo. =cut =for apidoc =for signature entrybuffer = Gtk2::EntryBuffer->new ($initial_chars=undef) =for arg initial_chars (string) =cut GtkEntryBuffer_noinc * gtk_entry_buffer_new (class, const gchar_utf8_length *initial_chars=NULL, gint length(initial_chars)) CODE: if (initial_chars == NULL) { RETVAL = gtk_entry_buffer_new (NULL, 0); } else { RETVAL = gtk_entry_buffer_new (initial_chars, XSauto_length_of_initial_chars); } OUTPUT: RETVAL gsize gtk_entry_buffer_get_bytes (GtkEntryBuffer *buffer); guint gtk_entry_buffer_get_length (GtkEntryBuffer *buffer); const gchar * gtk_entry_buffer_get_text (GtkEntryBuffer *buffer); void gtk_entry_buffer_set_text (GtkEntryBuffer *buffer, const gchar_utf8_length *chars, gint length(chars)); void gtk_entry_buffer_set_max_length (GtkEntryBuffer *buffer, gint max_length); gint gtk_entry_buffer_get_max_length (GtkEntryBuffer *buffer); void gtk_entry_buffer_insert_text (GtkEntryBuffer *buffer, guint position, const gchar_utf8_length *chars, gint length(chars)); guint gtk_entry_buffer_delete_text (GtkEntryBuffer *buffer, guint position=0, gint n_chars=-1); void gtk_entry_buffer_emit_inserted_text (GtkEntryBuffer *buffer, guint position, const gchar *chars, guint n_chars); void gtk_entry_buffer_emit_deleted_text (GtkEntryBuffer *buffer, guint position, guint n_chars); Gtk2-1.24992/xs/GtkTreeModelSort.xs0000644000175000017500000001102713076462677015350 0ustar lacklack/* * Copyright (c) 2003-2005 by the gtk2-perl team (see the file AUTHORS) * * This library is free software; you can redistribute it and/or * modify it under the terms of the GNU Library General Public * License as published by the Free Software Foundation; either * version 2.1 of the License, or (at your option) any later version. * * This library is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU * Library General Public License for more details. * * You should have received a copy of the GNU Library General Public * License along with this library; if not, write to the * Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, * Boston, MA 02110-1301 USA. * * $Id$ */ #include "gtk2perl.h" MODULE = Gtk2::TreeModelSort PACKAGE = Gtk2::TreeModelSort PREFIX = gtk_tree_model_sort_ # gperl_prepend_isa ("Gtk2::TreeModelSort", "Gtk2::TreeModel") should be here # but isn't and can't be added now since that'd break compatibility. Instead, # we handle get() at runtime in Gtk2.pm. GtkTreeModelSort_noinc * gtk_tree_model_sort_new_with_model (class, child_model) GtkTreeModel * child_model CODE: RETVAL = (GtkTreeModelSort *) gtk_tree_model_sort_new_with_model (child_model); OUTPUT: RETVAL =for apidoc =for signature treemodel = Gtk2::TreeModelSort->new ($child_model) =for signature treemodel = Gtk2::TreeModelSort->new (model => $child_model) =for arg ... (__hide__) =for arg child_model (GtkTreeModel*) The tree model to proxy. Aliases for C. Before Gtk2 1.120, C resolved to C, which would allow creation of an invalid object if the required property C was not supplied. =cut GtkTreeModelSort_noinc * gtk_tree_model_sort_new (class, ...) PREINIT: GtkTreeModel * child_model = NULL; CODE: if (items == 2) /* called as Gtk2::TreeModelSort->new ($model) */ child_model = SvGtkTreeModel (ST (1)); else if (items == 3) /* called as Gtk2::TreeModelSort->new (model => $model) */ child_model = SvGtkTreeModel (ST (2)); else croak ("Usage: $sort = Gtk2::TreeModelSort->new ($child_model)\n" " or $sort = Gtk2::TreeModelSort->new (model => $child_model)\n" " "); RETVAL = (GtkTreeModelSort *) gtk_tree_model_sort_new_with_model (child_model); OUTPUT: RETVAL GtkTreeModel * gtk_tree_model_sort_get_model (tree_model) GtkTreeModelSort * tree_model GtkTreePath_own_ornull* gtk_tree_model_sort_convert_child_path_to_path (tree_model_sort, child_path) GtkTreeModelSort * tree_model_sort GtkTreePath * child_path GtkTreePath_own_ornull* gtk_tree_model_sort_convert_path_to_child_path (tree_model_sort, sorted_path) GtkTreeModelSort * tree_model_sort GtkTreePath * sorted_path ## void gtk_tree_model_sort_convert_child_iter_to_iter (GtkTreeModelSort *tree_model_sort, GtkTreeIter *sort_iter, GtkTreeIter *child_iter) ## C version initializes an existing iter for you; ## perl version returns a new iter. GtkTreeIter_copy * gtk_tree_model_sort_convert_child_iter_to_iter (tree_model_sort, child_iter) GtkTreeModelSort *tree_model_sort GtkTreeIter *child_iter PREINIT: GtkTreeIter sort_iter; CODE: gtk_tree_model_sort_convert_child_iter_to_iter (tree_model_sort, &sort_iter, child_iter); RETVAL = &sort_iter; OUTPUT: RETVAL ## void gtk_tree_model_sort_convert_iter_to_child_iter (GtkTreeModelSort *tree_model_sort, GtkTreeIter *child_iter, GtkTreeIter *sorted_iter) ## C version initializes an existing iter for you; ## perl version returns a new iter. GtkTreeIter_copy * gtk_tree_model_sort_convert_iter_to_child_iter (tree_model_sort, sorted_iter) GtkTreeModelSort *tree_model_sort GtkTreeIter *sorted_iter PREINIT: GtkTreeIter child_iter; CODE: gtk_tree_model_sort_convert_iter_to_child_iter (tree_model_sort, &child_iter, sorted_iter); RETVAL = &child_iter; OUTPUT: RETVAL void gtk_tree_model_sort_reset_default_sort_func (tree_model_sort) GtkTreeModelSort *tree_model_sort void gtk_tree_model_sort_clear_cache (tree_model_sort) GtkTreeModelSort *tree_model_sort #if GTK_CHECK_VERSION(2,2,0) ## API docs say to use this only for testing/debugging purposes gboolean gtk_tree_model_sort_iter_is_valid (tree_model_sort, iter) GtkTreeModelSort *tree_model_sort GtkTreeIter *iter #endif Gtk2-1.24992/xs/GtkToolItemGroup.xs0000644000175000017500000000327113076462677015373 0ustar lacklack/* * Copyright (c) 2010 by the gtk2-perl team (see the file AUTHORS) * * Licensed under the LGPL, see LICENSE file for more information. * * $Id$ */ #include "gtk2perl.h" MODULE = Gtk2::ToolItemGroup PACKAGE = Gtk2::ToolItemGroup PREFIX = gtk_tool_item_group_ GtkWidget * gtk_tool_item_group_new (class, const gchar *label) C_ARGS: label gboolean gtk_tool_item_group_get_collapsed (GtkToolItemGroup *group); GtkToolItem* gtk_tool_item_group_get_drop_item (GtkToolItemGroup *group, gint x, gint y); PangoEllipsizeMode gtk_tool_item_group_get_ellipsize (GtkToolItemGroup *group); gint gtk_tool_item_group_get_item_position (GtkToolItemGroup *group, GtkToolItem *item); guint gtk_tool_item_group_get_n_items (GtkToolItemGroup *group); const gchar* gtk_tool_item_group_get_label (GtkToolItemGroup *group); GtkWidget * gtk_tool_item_group_get_label_widget (GtkToolItemGroup *group); GtkToolItem* gtk_tool_item_group_get_nth_item (GtkToolItemGroup *group, guint index); GtkReliefStyle gtk_tool_item_group_get_header_relief (GtkToolItemGroup *group); void gtk_tool_item_group_insert (GtkToolItemGroup *group, GtkToolItem *item, gint position); void gtk_tool_item_group_set_collapsed (GtkToolItemGroup *group, gboolean collapsed); void gtk_tool_item_group_set_ellipsize (GtkToolItemGroup *group, PangoEllipsizeMode ellipsize); void gtk_tool_item_group_set_item_position (GtkToolItemGroup *group, GtkToolItem *item, gint position); void gtk_tool_item_group_set_label (GtkToolItemGroup *group, const gchar *label); void gtk_tool_item_group_set_label_widget (GtkToolItemGroup *group, GtkWidget *label_widget); void gtk_tool_item_group_set_header_relief (GtkToolItemGroup *group, GtkReliefStyle style); Gtk2-1.24992/xs/GtkCellLayout.xs0000644000175000017500000003425713076462677014707 0ustar lacklack/* * Copyright (c) 2003 by the gtk2-perl team (see the file AUTHORS) * * Licensed under the LGPL, see LICENSE file for more information. * * $Id$ */ #include "gtk2perl.h" /* typedef void (* GtkCellLayoutDataFunc) (GtkCellLayout *cell_layout, GtkCellRenderer *cell, GtkTreeModel *tree_model, GtkTreeIter *iter, gpointer data); */ static void gtk2perl_cell_layout_data_func (GtkCellLayout *cell_layout, GtkCellRenderer *cell, GtkTreeModel *tree_model, GtkTreeIter *iter, gpointer data) { GPerlCallback * callback = (GPerlCallback *) data; gperl_callback_invoke (callback, NULL, cell_layout, cell, tree_model, iter); } /* GInterface support */ #define GET_METHOD(obj, name) \ HV * stash = gperl_object_stash_from_type (G_OBJECT_TYPE (obj)); \ GV * slot = gv_fetchmethod (stash, name); #define METHOD_EXISTS (slot && GvCV (slot)) #define GET_METHOD_OR_DIE(obj, name) \ GET_METHOD (obj, name); \ if (!METHOD_EXISTS) \ die ("No implementation for %s::%s", \ gperl_package_from_type (G_OBJECT_TYPE (obj)), name); #define PREP(obj) \ dSP; \ ENTER; \ SAVETMPS; \ PUSHMARK (SP) ; \ PUSHs (sv_2mortal (newSVGObject (G_OBJECT (obj)))); #define CALL \ PUTBACK; \ call_sv ((SV *) GvCV (slot), G_VOID | G_DISCARD); #define FINISH \ FREETMPS; \ LEAVE; static void gtk2perl_cell_layout_pack_start (GtkCellLayout *cell_layout, GtkCellRenderer *cell, gboolean expand) { GET_METHOD_OR_DIE (cell_layout, "PACK_START"); { PREP (cell_layout); XPUSHs (sv_2mortal (newSVGtkCellRenderer (cell))); XPUSHs (sv_2mortal (boolSV (expand))); CALL; FINISH; } } static void gtk2perl_cell_layout_pack_end (GtkCellLayout *cell_layout, GtkCellRenderer *cell, gboolean expand) { GET_METHOD_OR_DIE (cell_layout, "PACK_END"); { PREP (cell_layout); XPUSHs (sv_2mortal (newSVGtkCellRenderer (cell))); XPUSHs (sv_2mortal (boolSV (expand))); CALL; FINISH; } } static void gtk2perl_cell_layout_clear (GtkCellLayout *cell_layout) { GET_METHOD_OR_DIE (cell_layout, "CLEAR"); { PREP (cell_layout); CALL; FINISH; } } static void gtk2perl_cell_layout_add_attribute (GtkCellLayout *cell_layout, GtkCellRenderer *cell, const gchar *attribute, gint column) { GET_METHOD_OR_DIE (cell_layout, "ADD_ATTRIBUTE"); { PREP (cell_layout); XPUSHs (sv_2mortal (newSVGtkCellRenderer (cell))); XPUSHs (sv_2mortal (newSVGChar (attribute))); XPUSHs (sv_2mortal (newSViv (column))); CALL; FINISH; } } /* The strategy for passing the function pointer to Perl land is the same as * the one used in GtkTreeSortable.xs. */ typedef struct { GtkCellLayoutDataFunc func; gpointer data; GtkDestroyNotify destroy; } Gtk2PerlCellLayoutDataFunc; static void create_callback (GtkCellLayoutDataFunc func, gpointer data, GtkDestroyNotify destroy, SV **code_return, SV **data_return) { HV *stash; SV *code_sv, *data_sv; Gtk2PerlCellLayoutDataFunc *wrapper; wrapper = g_new0 (Gtk2PerlCellLayoutDataFunc, 1); wrapper->func = func; wrapper->data = data; wrapper->destroy = destroy; data_sv = newSViv (PTR2IV (wrapper)); stash = gv_stashpv ("Gtk2::CellLayout::DataFunc", TRUE); code_sv = sv_bless (newRV (data_sv), stash); *code_return = code_sv; *data_return = data_sv; } static void gtk2perl_cell_layout_set_cell_data_func (GtkCellLayout *cell_layout, GtkCellRenderer *cell, GtkCellLayoutDataFunc func, gpointer func_data, GDestroyNotify destroy) { GET_METHOD_OR_DIE (cell_layout, "SET_CELL_DATA_FUNC"); { SV *code_sv, *data_sv; PREP (cell_layout); XPUSHs (sv_2mortal (newSVGtkCellRenderer (cell))); if (func) { create_callback (func, func_data, destroy, &code_sv, &data_sv); XPUSHs (sv_2mortal (code_sv)); XPUSHs (sv_2mortal (data_sv)); } CALL; FINISH; } } static void gtk2perl_cell_layout_clear_attributes (GtkCellLayout *cell_layout, GtkCellRenderer *cell) { GET_METHOD_OR_DIE (cell_layout, "CLEAR_ATTRIBUTES"); { PREP (cell_layout); XPUSHs (sv_2mortal (newSVGtkCellRenderer (cell))); CALL; FINISH; } } static void gtk2perl_cell_layout_reorder (GtkCellLayout *cell_layout, GtkCellRenderer *cell, gint position) { GET_METHOD_OR_DIE (cell_layout, "REORDER"); { PREP (cell_layout); XPUSHs (sv_2mortal (newSVGtkCellRenderer (cell))); XPUSHs (sv_2mortal (newSViv (position))); CALL; FINISH; } } #if GTK_CHECK_VERSION (2, 12, 0) static GList* gtk2perl_cell_layout_get_cells (GtkCellLayout *cell_layout) { GList * cells = NULL; GET_METHOD (cell_layout, "GET_CELLS"); if (METHOD_EXISTS) { int count; PREP (cell_layout); PUTBACK; count = call_sv ((SV *) GvCV (slot), G_ARRAY); SPAGAIN; while (count > 0) { SV * sv = POPs; cells = g_list_prepend (cells, SvGtkCellRenderer (sv)); count--; } PUTBACK; FINISH; } return cells; } #endif static void gtk2perl_cell_layout_init (GtkCellLayoutIface * iface) { iface->pack_start = gtk2perl_cell_layout_pack_start; iface->pack_end = gtk2perl_cell_layout_pack_end; iface->clear = gtk2perl_cell_layout_clear; iface->add_attribute = gtk2perl_cell_layout_add_attribute; iface->set_cell_data_func = gtk2perl_cell_layout_set_cell_data_func; iface->clear_attributes = gtk2perl_cell_layout_clear_attributes; iface->reorder = gtk2perl_cell_layout_reorder; #if GTK_CHECK_VERSION (2, 12, 0) iface->get_cells = gtk2perl_cell_layout_get_cells; #endif } MODULE = Gtk2::CellLayout PACKAGE = Gtk2::CellLayout PREFIX = gtk_cell_layout_ =for position SYNOPSIS =head1 SYNOPSIS # This is an abstract interface; the CellLayout interface is # implemented by concrete classes like ComboBox and TreeViewColumn. # See the discussion for details on creating your own CellLayout. # This synopsis assumes you already have an instance in $cell_layout. # Add a cell renderer that shows the pixbuf in column 2 of the # associated TreeModel. It will take up only the necessary space # ("expand" => FALSE). my $cell = Gtk2::CellRendererPixbuf->new (); $cell_layout->pack_start ($cell, FALSE); $cell_layout->add_attribute ($cell, pixbuf => 2); # Add another cell renderer that gets the "text" property from # column 3 of the associated TreeModel, and takes up all remaining # horizontal space ("expand" => TRUE). my $cell = Gtk2::CellRendererText->new (); $cell_layout->pack_start ($cell, TRUE); $cell_layout->add_attribute ($cell, text => 3); =cut =for position DESCRIPTION =head1 DESCRIPTION Gtk2::CellLayout is an interface to be implemented by all objects which want to provide a Gtk2::TreeViewColumn-like API for packing cells, setting attributes and data funcs. =cut =for position post_methods =head1 CREATING A CUSTOM CELL LAYOUT GTK+ provides several CellLayout implementations, such as Gtk2::TreeViewColumn and Gtk2::ComboBox. To create your own object that implements the CellLayout interface and therefore can be used to display CellRenderers, you need to add Gtk2::CellLayout to your class's "interfaces" list, like this: package MyLayout; use Gtk2; use Glib::Object::Subclass Gtk2::Widget::, interfaces => [ Gtk2::CellLayout:: ], ; This will cause perl to call several virtual methods with ALL_CAPS_NAMES when GTK+ attempts to perform certain actions. You simply provide (or override) those methods with perl code. The methods map rather directly to the object interface, so it should be easy to figure out what they should do. Those methods are: =over =item PACK_START ($cell_layout, $cell, $expand) =item PACK_END ($cell_layout, $cell, $expand) =item CLEAR ($cell_layout) =item ADD_ATTRIBUTE ($cell_layout, $cell, $attribute, $column) =item SET_CELL_DATA_FUNC ($cell_layout, $cell, $func, $data) =item CLEAR_ATTRIBUTES ($cell_layout, $cell) =item REORDER ($cell_layout, $cell, $position) =item list = GET_CELLS ($cell_layout) =back =cut =for apidoc __hide__ =cut void _ADD_INTERFACE (class, const char * target_class) CODE: { static const GInterfaceInfo iface_info = { (GInterfaceInitFunc) gtk2perl_cell_layout_init, (GInterfaceFinalizeFunc) NULL, (gpointer) NULL }; GType gtype = gperl_object_type_from_package (target_class); g_type_add_interface_static (gtype, GTK_TYPE_CELL_LAYOUT, &iface_info); } =for apidoc Packs I<$cell> into the beginning of I<$cell_layout>. If I<$expand> is false, then I<$cell> is allocated no more space than it needs. Any unused space is divided evenly between cells for which I<$expand> is true. =cut void gtk_cell_layout_pack_start (GtkCellLayout *cell_layout, GtkCellRenderer *cell, gboolean expand); =for apidoc Like C, but adds from the end of the layout instead of the beginning. =cut void gtk_cell_layout_pack_end (GtkCellLayout *cell_layout, GtkCellRenderer *cell, gboolean expand); =for apidoc Unsets all the mappings on all renderers on I<$cell_layout> and removes all renderers attached to it. =cut void gtk_cell_layout_clear (GtkCellLayout *cell_layout); =for apidoc =for arg ... list of property name and column number pairs. Sets the pairs in the I<...> list as the attributes of I<$cell_layout>, as with repeated calls to C. All existing attributes are removed, and replaced with the new attributes. =cut void gtk_cell_layout_set_attributes (GtkCellLayout *cell_layout, GtkCellRenderer *cell, ...); PREINIT: gint i; CODE: if (items < 2 || 0 != (items - 2) % 2) croak ("usage: $cell_layout->set_attributes ($cell, name => column, ...)\n" " expecting a list of name => column pairs"); gtk_cell_layout_clear_attributes (cell_layout, cell); for (i = 2 ; i < items ; i+=2) { gtk_cell_layout_add_attribute (cell_layout, cell, SvPV_nolen (ST (i)), SvIV (ST (i+1))); } =for apidoc Adds an attribute mapping to the list in I<$cell_layout>. The I<$column> is the column of the model from which to get a value, and the I<$attribute> is the property of I<$cell> to be set from the value. So, for example, if column 2 of the model contains strings, you could have the "text" attribute of a Gtk2::CellRendererText get its values from column 2. =cut void gtk_cell_layout_add_attribute (GtkCellLayout *cell_layout, GtkCellRenderer *cell, const gchar *attribute, gint column); =for apidoc Sets up I<$cell_layout> to call I<$func> to set up attributes of I<$cell>, instead of the standard attribute mapping. I<$func> may be undef to remove an older callback. I<$func> will receive these parameters: =over =item $cell_layout The cell layout instance =item $cell The cell renderer to set up =item $model The tree model =item $iter TreeIter of the row for which to set the values =item $data The I<$func_data> passed to C =back =cut void gtk_cell_layout_set_cell_data_func (GtkCellLayout *cell_layout, GtkCellRenderer *cell, SV * func, SV * func_data=NULL); CODE: if (gperl_sv_is_defined (func)) { GType param_types[4]; GPerlCallback * callback; param_types[0] = GTK_TYPE_CELL_LAYOUT; param_types[1] = GTK_TYPE_CELL_RENDERER; param_types[2] = GTK_TYPE_TREE_MODEL; param_types[3] = GTK_TYPE_TREE_ITER; callback = gperl_callback_new (func, func_data, 4, param_types, G_TYPE_NONE); gtk_cell_layout_set_cell_data_func (cell_layout, cell, gtk2perl_cell_layout_data_func, callback, (GDestroyNotify) gperl_callback_destroy); } else gtk_cell_layout_set_cell_data_func (cell_layout, cell, NULL, NULL, NULL); =for apidoc Clears all existing attributes previously set with for I<$cell> with C or C. =cut void gtk_cell_layout_clear_attributes (GtkCellLayout *cell_layout, GtkCellRenderer *cell); =for apidoc Re-insert I<$cell> at I<$position>. I<$cell> must already be packed into I<$cell_layout>. =cut void gtk_cell_layout_reorder (GtkCellLayout *cell_layout, GtkCellRenderer *cell, gint position) #if GTK_CHECK_VERSION (2, 12, 0) =for apidoc Fetch all of the cell renderers which have been added to I<$cell_layout>. Note that if there are no cells this functions returns 'undef' instead of an empty list. =cut void gtk_cell_layout_get_cells (GtkCellLayout *cell_layout) PREINIT: GList *result, *i; PPCODE: PUTBACK; result = gtk_cell_layout_get_cells (cell_layout); SPAGAIN; if (!result) /* can happen if the widget doesn't implement get_cells */ XSRETURN_UNDEF; for (i = result; i != NULL; i = i->next) XPUSHs (sv_2mortal (newSVGtkCellRenderer (i->data))); g_list_free (result); #endif MODULE = Gtk2::CellLayout PACKAGE = Gtk2::CellLayout::DataFunc =for apidoc __hide__ =cut void invoke (SV *code, GtkCellLayout *cell_layout, GtkCellRenderer *cell, GtkTreeModel *tree_model, GtkTreeIter *iter, data) PREINIT: Gtk2PerlCellLayoutDataFunc *wrapper; CODE: wrapper = INT2PTR (Gtk2PerlCellLayoutDataFunc*, SvIV (SvRV (code))); if (!wrapper || !wrapper->func) croak ("Invalid reference encountered in cell data func"); wrapper->func (cell_layout, cell, tree_model, iter, wrapper->data); void DESTROY (SV *code) PREINIT: Gtk2PerlCellLayoutDataFunc *wrapper; CODE: if (!gperl_sv_is_defined (code) || !SvROK (code)) return; wrapper = INT2PTR (Gtk2PerlCellLayoutDataFunc*, SvIV (SvRV (code))); if (wrapper && wrapper->destroy) wrapper->destroy (wrapper->data); if (wrapper) g_free (wrapper); Gtk2-1.24992/xs/GtkOffscreenWindow.xs0000644000175000017500000000111313076462677015715 0ustar lacklack/* * Copyright (c) 2010 by the gtk2-perl team (see the file AUTHORS) * * Licensed under the LGPL, see LICENSE file for more information. * * $Id$ */ #include "gtk2perl.h" MODULE = Gtk2::OffscreenWindow PACKAGE = Gtk2::OffscreenWindow PREFIX = gtk_offscreen_window_ GtkWidget * gtk_offscreen_window_new (class) C_ARGS: /* void */ # Docs say we don't own the pixmap. GdkPixmap_ornull * gtk_offscreen_window_get_pixmap (GtkOffscreenWindow *offscreen); # Docs say we do own the pixbuf GdkPixbuf_noinc_ornull * gtk_offscreen_window_get_pixbuf (GtkOffscreenWindow *offscreen); Gtk2-1.24992/xs/GtkRecentFilter.xs0000644000175000017500000001027413076462677015211 0ustar lacklack/* * Copyright (c) 2006, 2013 by the gtk2-perl team (see the file AUTHORS) * * Licensed under the LGPL, see LICENSE file for more information. * * $Id$ */ #include "gtk2perl.h" /* For gtk2perl_sv_to_strv and gtk2perl_sv_from_strv. */ #include "gtk2perl-private.h" /* struct _GtkRecentFilterInfo { GtkRecentFilterFlags contains; const gchar *uri; const gchar *display_name; const gchar *mime_type; const gchar **applications; const gchar **groups; gint age; }; */ static SV * newSVGtkRecentFilterInfo (const GtkRecentFilterInfo *info) { HV *hv; if (!info) return &PL_sv_undef; hv = newHV (); gperl_hv_take_sv_s (hv, "contains", newSVGtkRecentFilterFlags (info->contains)); if (info->uri) gperl_hv_take_sv_s (hv, "uri", newSVpv (info->uri, 0)); if (info->display_name) gperl_hv_take_sv_s (hv, "display_name", newSVGChar (info->display_name)); if (info->mime_type) gperl_hv_take_sv_s (hv, "mime_type", newSVGChar (info->mime_type)); if (info->applications) gperl_hv_take_sv_s (hv, "applications", gtk2perl_sv_from_strv (info->applications)); if (info->groups) gperl_hv_take_sv_s (hv, "groups", gtk2perl_sv_from_strv (info->groups)); gperl_hv_take_sv_s (hv, "age", newSViv (info->age)); return newRV_noinc ((SV *) hv); } static GtkRecentFilterInfo * SvGtkRecentFilterInfo (SV *sv) { HV *hv; SV **svp; GtkRecentFilterInfo *info; if (!gperl_sv_is_hash_ref (sv)) croak ("invalid recent filter info - expecting a hash reference"); hv = (HV *) SvRV (sv); info = gperl_alloc_temp (sizeof (GtkRecentFilterInfo)); if ((svp = hv_fetch (hv, "contains", 8, 0))) info->contains = SvGtkRecentFilterFlags (*svp); if ((svp = hv_fetch (hv, "uri", 3, 0))) info->uri = SvPV_nolen (*svp); if ((svp = hv_fetch (hv, "display_name", 12, 0))) info->display_name = SvGChar (*svp); if ((svp = hv_fetch (hv, "mime_type", 9, 0))) info->mime_type = SvGChar (*svp); if ((svp = hv_fetch (hv, "applications", 12, 0))) info->applications = gtk2perl_sv_to_strv (*svp); if ((svp = hv_fetch (hv, "groups", 6, 0))) info->groups = gtk2perl_sv_to_strv (*svp); if ((svp = hv_fetch (hv, "age", 3, 0))) info->age = SvIV (*svp); return info; } static gboolean gtk2perl_recent_filter_func (const GtkRecentFilterInfo *filter_info, gpointer user_data) { GPerlCallback *callback = (GPerlCallback *) user_data; GValue value = { 0, }; gboolean retval; SV *sv; g_value_init (&value, G_TYPE_BOOLEAN); sv = newSVGtkRecentFilterInfo (filter_info); gperl_callback_invoke (callback, &value, sv); retval = g_value_get_boolean (&value); SvREFCNT_dec (sv); g_value_unset (&value); return retval; } MODULE = Gtk2::RecentFilter PACKAGE = Gtk2::RecentFilter PREFIX = gtk_recent_filter_ GtkRecentFilter * gtk_recent_filter_new (class) C_ARGS: /* void */ void gtk_recent_filter_set_name (GtkRecentFilter *filter, const gchar *name) const gchar *gtk_recent_filter_get_name (GtkRecentFilter *filter) void gtk_recent_filter_add_mime_type (GtkRecentFilter *filter, const gchar *mime_type) void gtk_recent_filter_add_pattern (GtkRecentFilter *filter, const gchar *pattern) void gtk_recent_filter_add_pixbuf_formats (GtkRecentFilter *filter) void gtk_recent_filter_add_application (GtkRecentFilter *filter, const gchar *application) void gtk_recent_filter_add_group (GtkRecentFilter *filter, const gchar *group) void gtk_recent_filter_add_age (GtkRecentFilter *filter, gint days) void gtk_recent_filter_add_custom (filter, needed, func, data=NULL) GtkRecentFilter *filter GtkRecentFilterFlags needed SV *func SV *data PREINIT: GType param_types[1]; GPerlCallback *callback; CODE: param_types[0] = GPERL_TYPE_SV; callback = gperl_callback_new (func, data, 1, param_types, G_TYPE_BOOLEAN); gtk_recent_filter_add_custom (filter, needed, gtk2perl_recent_filter_func, callback, (GDestroyNotify) gperl_callback_destroy); GtkRecentFilterFlags gtk_recent_filter_get_needed (GtkRecentFilter *filter) gboolean gtk_recent_filter_filter (filter, filter_info) GtkRecentFilter *filter SV *filter_info C_ARGS: filter, SvGtkRecentFilterInfo (filter_info) Gtk2-1.24992/xs/GtkPrintOperation.xs0000644000175000017500000001303113076462677015572 0ustar lacklack/* * Copyright (c) 2006 by the gtk2-perl team (see the file AUTHORS) * * Licensed under the LGPL, see LICENSE file for more information. * * $Id$ */ #include "gtk2perl.h" static GPerlCallback * gtk2perl_page_setup_done_func_create (SV * func, SV * data) { GType param_types [1]; param_types[0] = GTK_TYPE_PAGE_SETUP; return gperl_callback_new (func, data, G_N_ELEMENTS (param_types), param_types, 0); } static void gtk2perl_page_setup_done_func (GtkPageSetup *page_setup, gpointer data) { gperl_callback_invoke ((GPerlCallback *) data, NULL, page_setup); /* The callback is always called exactly once, so free it now. */ gperl_callback_destroy ((GPerlCallback *) data); } MODULE = Gtk2::PrintOperation PACKAGE = Gtk2::PrintOperation PREFIX = gtk_print_operation_ # GtkPrintOperation * gtk_print_operation_new (void); GtkPrintOperation_noinc * gtk_print_operation_new (class) C_ARGS: /* void */ void gtk_print_operation_set_default_page_setup (GtkPrintOperation *op, GtkPageSetup_ornull *default_page_setup); GtkPageSetup_ornull * gtk_print_operation_get_default_page_setup (GtkPrintOperation *op); void gtk_print_operation_set_print_settings (GtkPrintOperation *op, GtkPrintSettings_ornull *print_settings); GtkPrintSettings_ornull * gtk_print_operation_get_print_settings (GtkPrintOperation *op); void gtk_print_operation_set_job_name (GtkPrintOperation *op, const gchar *job_name); void gtk_print_operation_set_n_pages (GtkPrintOperation *op, gint n_pages); void gtk_print_operation_set_current_page (GtkPrintOperation *op, gint current_page); void gtk_print_operation_set_use_full_page (GtkPrintOperation *op, gboolean full_page); void gtk_print_operation_set_unit (GtkPrintOperation *op, GtkUnit unit); void gtk_print_operation_set_export_filename (GtkPrintOperation *op, const gchar *filename); void gtk_print_operation_set_track_print_status (GtkPrintOperation *op, gboolean track_status); void gtk_print_operation_set_show_progress (GtkPrintOperation *op, gboolean show_progress); void gtk_print_operation_set_allow_async (GtkPrintOperation *op, gboolean allow_async); void gtk_print_operation_set_custom_tab_label (GtkPrintOperation *op, const gchar *label); =for apidoc __gerror__ =cut # GtkPrintOperationResult gtk_print_operation_run (GtkPrintOperation *op, GtkPrintOperationAction action, GtkWindow *parent, GError **error); GtkPrintOperationResult gtk_print_operation_run (GtkPrintOperation *op, GtkPrintOperationAction action, GtkWindow_ornull *parent) PREINIT: GError *error = NULL; CODE: RETVAL = gtk_print_operation_run (op, action, parent, &error); if (error) gperl_croak_gerror (NULL, error); OUTPUT: RETVAL # FIXME: Does it makes sense to wrap it like this? # void gtk_print_operation_get_error (GtkPrintOperation *op, GError **error); SV * gtk_print_operation_get_error (GtkPrintOperation *op) PREINIT: GError *error = NULL; CODE: gtk_print_operation_get_error (op, &error); RETVAL = gperl_sv_from_gerror (error); OUTPUT: RETVAL GtkPrintStatus gtk_print_operation_get_status (GtkPrintOperation *op); const gchar * gtk_print_operation_get_status_string (GtkPrintOperation *op); gboolean gtk_print_operation_is_finished (GtkPrintOperation *op); void gtk_print_operation_cancel (GtkPrintOperation *op); #if GTK_CHECK_VERSION (2, 16, 0) =for apidoc =for signature $op->draw_page_finish () The method draw_page_finish() can only be called if the method set_defer_drawing() has been called previously otherwise a segmentation fault will occur. This means that the application will crash and even an eval will not be able to recover from that error. =cut void gtk_print_operation_draw_page_finish (GtkPrintOperation *op); =for apidoc =for signature $op->set_defer_drawing () The method set_defer_drawing() can only be called from the callback C<'draw-page'>. =cut void gtk_print_operation_set_defer_drawing (GtkPrintOperation *op); #endif /* 2.16 */ #if GTK_CHECK_VERSION (2, 18, 0) void gtk_print_operation_set_embed_page_setup (GtkPrintOperation *op, gboolean embed); gboolean gtk_print_operation_get_embed_page_setup (GtkPrintOperation *op); void gtk_print_operation_set_support_selection (GtkPrintOperation *op, gboolean support_selection); gboolean gtk_print_operation_get_support_selection (GtkPrintOperation *op); void gtk_print_operation_set_has_selection (GtkPrintOperation *op, gboolean has_selection); gboolean gtk_print_operation_get_has_selection (GtkPrintOperation *op); gint gtk_print_operation_get_n_pages_to_print (GtkPrintOperation *op); #endif /* 2.18 */ MODULE = Gtk2::PrintOperation PACKAGE = Gtk2::Print PREFIX = gtk_print_ # GtkPageSetup * gtk_print_run_page_setup_dialog (GtkWindow *parent, GtkPageSetup *page_setup, GtkPrintSettings *settings); GtkPageSetup_noinc * gtk_print_run_page_setup_dialog (class, GtkWindow_ornull *parent, GtkPageSetup_ornull *page_setup, GtkPrintSettings *settings) C_ARGS: parent, page_setup, settings # void gtk_print_run_page_setup_dialog_async (GtkWindow_ornull *parent, GtkPageSetup_ornull *page_setup, GtkPrintSettings *settings, GtkPageSetupDoneFunc done_cb, gpointer data); void gtk_print_run_page_setup_dialog_async (class, GtkWindow_ornull *parent, GtkPageSetup_ornull *page_setup, GtkPrintSettings *settings, SV *func, SV *data=NULL) PREINIT: GPerlCallback *callback; CODE: callback = gtk2perl_page_setup_done_func_create (func, data); gtk_print_run_page_setup_dialog_async ( parent, page_setup, settings, gtk2perl_page_setup_done_func, callback); /* Since it's always called exactly once, the callback is destroyed * directly in the marshaller. */ Gtk2-1.24992/xs/GtkAction.xs0000644000175000017500000001115313076462677014035 0ustar lacklack/* * Copyright (c) 2003-2006, 2009 by the gtk2-perl team (see the file AUTHORS) * * Licensed under the LGPL, see LICENSE file for more information. * * $Id$ */ #include "gtk2perl.h" MODULE = Gtk2::Action PACKAGE = Gtk2::Action PREFIX = gtk_action_ =for position post_interfaces =head1 CONSTRUCTOR =head2 action = Gtk2::Action->B (key=>value,...) Create and return a new action object. Note that this is the C of L, not C. Eg. Gtk2::Action->new (name => 'open-foo', stock_id => 'gtk-open', tooltip => 'Start a foo'); The keyword/value style is more flexible and a little clearer than the four direct arguments of C (and also works better for subclasses). =cut const gchar* gtk_action_get_name (GtkAction *action); void gtk_action_activate (GtkAction *action); gboolean gtk_action_is_sensitive (GtkAction *action); gboolean gtk_action_get_sensitive (GtkAction *action); gboolean gtk_action_is_visible (GtkAction *action); gboolean gtk_action_get_visible (GtkAction *action); GtkWidget* gtk_action_create_icon (GtkAction *action, GtkIconSize icon_size); GtkWidget* gtk_action_create_menu_item (GtkAction *action); #if GTK_CHECK_VERSION (2, 12, 0) GtkWidget* gtk_action_create_menu (GtkAction *action); #endif GtkWidget* gtk_action_create_tool_item (GtkAction *action); void gtk_action_connect_proxy (GtkAction *action, GtkWidget *proxy); void gtk_action_disconnect_proxy (GtkAction *action, GtkWidget *proxy); void gtk_action_get_proxies (GtkAction *action); PREINIT: GSList * i; PPCODE: for (i = gtk_action_get_proxies (action) ; i != NULL ; i = i->next) /* We can't use newSVGtkWidget here because it always sinks the * widget. gtk_action_get_proxies might return floating * widgets though, and with newSVGtkWidget we would end up * owning them. When the SV wrapper then goes out of scope, * the widgets would be destroyed -- and GtkAction would hold * on to dangling pointers. */ XPUSHs (sv_2mortal (gperl_new_object (G_OBJECT (i->data), FALSE))); void gtk_action_connect_accelerator (GtkAction *action); void gtk_action_disconnect_accelerator (GtkAction *action); ## /* protected ... for use by child actions */ void gtk_action_block_activate_from (GtkAction *action, GtkWidget *proxy); void gtk_action_unblock_activate_from (GtkAction *action, GtkWidget *proxy); ## /* protected ... for use by action groups */ void gtk_action_set_accel_path (GtkAction *action, const gchar *accel_path); void gtk_action_set_accel_group (GtkAction *action, GtkAccelGroup_ornull *accel_group); #if GTK_CHECK_VERSION (2, 6, 0) void gtk_action_set_sensitive (GtkAction *action, gboolean sensitive); void gtk_action_set_visible (GtkAction *action, gboolean visible); const gchar* gtk_action_get_accel_path (GtkAction *action); #endif #if GTK_CHECK_VERSION (2, 16, 0) void gtk_action_set_label (GtkAction *action, const gchar *label); const gchar_ornull * gtk_action_get_label (GtkAction *action); void gtk_action_set_short_label (GtkAction *action, const gchar *short_label); const gchar_ornull * gtk_action_get_short_label (GtkAction *action); void gtk_action_set_tooltip (GtkAction *action, const gchar_ornull *tooltip); const gchar_ornull * gtk_action_get_tooltip (GtkAction *action); void gtk_action_set_stock_id (GtkAction *action,const gchar_ornull *stock_id); const gchar_ornull * gtk_action_get_stock_id (GtkAction *action); void gtk_action_set_icon_name (GtkAction *action, const gchar_ornull *icon_name); const gchar_ornull * gtk_action_get_icon_name (GtkAction *action); void gtk_action_set_visible_horizontal (GtkAction *action, gboolean visible_horizontal); gboolean gtk_action_get_visible_horizontal (GtkAction *action); void gtk_action_set_visible_vertical (GtkAction *action, gboolean visible_vertical); gboolean gtk_action_get_visible_vertical (GtkAction *action); void gtk_action_set_is_important (GtkAction *action, gboolean is_important); gboolean gtk_action_get_is_important (GtkAction *action); # FIXME GIcon not in typemap # void gtk_action_set_gicon (GtkAction *action, GIcon *icon); # # GIcon * gtk_action_get_gicon (GtkAction *action); void gtk_action_block_activate (GtkAction *action); void gtk_action_unblock_activate (GtkAction *action); #endif #if GTK_CHECK_VERSION (2, 20, 0) gboolean gtk_action_get_always_show_image (GtkAction *action); void gtk_action_set_always_show_image (GtkAction *action, gboolean always_show); #endif /* 2.20 */ #if GTK_CHECK_VERSION (2, 10, 0) MODULE = Gtk2::Action PACKAGE = Gtk2::Widget PREFIX = gtk_widget_ GtkAction_ornull * gtk_widget_get_action (GtkWidget *widget); #endif Gtk2-1.24992/xs/GtkFileChooser.xs0000644000175000017500000001517213076462677015027 0ustar lacklack/* * Copyright (c) 2003-2005 by the gtk2-perl team (see the file AUTHORS) * * Licensed under the LGPL, see LICENSE file for more information. * * $Id$ */ #include "gtk2perl.h" MODULE = Gtk2::FileChooser PACKAGE = Gtk2::FileChooser PREFIX = gtk_file_chooser_ =for enum GtkFileChooserAction =cut =for enum GtkFileChooserError =cut ## Configuration ## void gtk_file_chooser_set_action (GtkFileChooser *chooser, GtkFileChooserAction action); GtkFileChooserAction gtk_file_chooser_get_action (GtkFileChooser *chooser); void gtk_file_chooser_set_local_only (GtkFileChooser *chooser, gboolean files_only); gboolean gtk_file_chooser_get_local_only (GtkFileChooser *chooser); void gtk_file_chooser_set_select_multiple (GtkFileChooser *chooser, gboolean select_multiple); gboolean gtk_file_chooser_get_select_multiple (GtkFileChooser *chooser); ## Filename manipulation ## void gtk_file_chooser_set_current_name (GtkFileChooser *chooser, const gchar *name); gchar_own * gtk_file_chooser_get_filename (GtkFileChooser *chooser); gboolean gtk_file_chooser_set_filename (GtkFileChooser *chooser, const char *filename); gboolean gtk_file_chooser_select_filename (GtkFileChooser *chooser, const char *filename); void gtk_file_chooser_unselect_filename (GtkFileChooser *chooser, const char *filename); void gtk_file_chooser_select_all (GtkFileChooser *chooser); void gtk_file_chooser_unselect_all (GtkFileChooser *chooser); void gtk_file_chooser_get_filenames (GtkFileChooser *chooser); PREINIT: GSList * names, * i; PPCODE: names = gtk_file_chooser_get_filenames (chooser); for (i = names ; i != NULL ; i = i->next) { XPUSHs (sv_2mortal (newSVGChar (i->data))); g_free (i->data); } g_slist_free (names); gboolean gtk_file_chooser_set_current_folder (GtkFileChooser *chooser, const gchar *filename); gchar_own *gtk_file_chooser_get_current_folder (GtkFileChooser *chooser); ## URI manipulation ## gchar_own * gtk_file_chooser_get_uri (GtkFileChooser *chooser); gboolean gtk_file_chooser_set_uri (GtkFileChooser *chooser, const char *uri); gboolean gtk_file_chooser_select_uri (GtkFileChooser *chooser, const char *uri); void gtk_file_chooser_unselect_uri (GtkFileChooser *chooser, const char *uri); void gtk_file_chooser_get_uris (GtkFileChooser *chooser); PREINIT: GSList * uris, * i; PPCODE: uris = gtk_file_chooser_get_uris (chooser); for (i = uris ; i != NULL ; i = i->next) { XPUSHs (sv_2mortal (newSVGChar (i->data))); g_free (i->data); } g_slist_free (uris); gboolean gtk_file_chooser_set_current_folder_uri (GtkFileChooser *chooser, const gchar *uri); gchar_own *gtk_file_chooser_get_current_folder_uri (GtkFileChooser *chooser); ## Preview widget ## void gtk_file_chooser_set_preview_widget (GtkFileChooser *chooser, GtkWidget *preview_widget); GtkWidget *gtk_file_chooser_get_preview_widget (GtkFileChooser *chooser); void gtk_file_chooser_set_preview_widget_active (GtkFileChooser *chooser, gboolean active); gboolean gtk_file_chooser_get_preview_widget_active (GtkFileChooser *chooser); ## char *gtk_file_chooser_get_preview_filename (GtkFileChooser *file_chooser); GPerlFilename_own gtk_file_chooser_get_preview_filename (GtkFileChooser *file_chooser); CODE: RETVAL = gtk_file_chooser_get_preview_filename (file_chooser); if (!RETVAL) XSRETURN_UNDEF; OUTPUT: RETVAL ## char *gtk_file_chooser_get_preview_uri (GtkFileChooser *file_chooser); gchar_own *gtk_file_chooser_get_preview_uri (GtkFileChooser *file_chooser); CODE: RETVAL = gtk_file_chooser_get_preview_uri (file_chooser); if (!RETVAL) XSRETURN_UNDEF; OUTPUT: RETVAL void gtk_file_chooser_set_use_preview_label (GtkFileChooser *chooser, gboolean use_label); gboolean gtk_file_chooser_get_use_preview_label (GtkFileChooser *chooser); ## Extra widget ## void gtk_file_chooser_set_extra_widget (GtkFileChooser *chooser, GtkWidget *extra_widget); GtkWidget *gtk_file_chooser_get_extra_widget (GtkFileChooser *chooser); ## List of user selectable filters ## void gtk_file_chooser_add_filter (GtkFileChooser *chooser, GtkFileFilter *filter); void gtk_file_chooser_remove_filter (GtkFileChooser *chooser, GtkFileFilter *filter); void gtk_file_chooser_list_filters (GtkFileChooser *chooser); PREINIT: GSList * filters, * i; PPCODE: filters = gtk_file_chooser_list_filters (chooser); for (i = filters ; i != NULL ; i = i->next) XPUSHs (sv_2mortal (newSVGtkFileFilter (i->data))); g_slist_free (filters); ## Current filter ## void gtk_file_chooser_set_filter (GtkFileChooser *chooser, GtkFileFilter *filter); GtkFileFilter *gtk_file_chooser_get_filter (GtkFileChooser *chooser); ## Per-application shortcut folders =for apidoc __gerror__ =cut void gtk_file_chooser_add_shortcut_folder (GtkFileChooser *chooser, const char *folder); ALIAS: add_shortcut_folder = 0 remove_shortcut_folder = 1 add_shortcut_folder_uri = 2 remove_shortcut_folder_uri = 3 PREINIT: GError * error = NULL; gboolean ret = FALSE; CODE: switch (ix) { case 0: ret = gtk_file_chooser_add_shortcut_folder (chooser, folder, &error); break; case 1: ret = gtk_file_chooser_remove_shortcut_folder (chooser, folder, &error); break; case 2: ret = gtk_file_chooser_add_shortcut_folder_uri (chooser, folder, &error); break; case 3: ret = gtk_file_chooser_remove_shortcut_folder_uri (chooser, folder, &error); break; default: g_assert_not_reached (); } if (!ret) gperl_croak_gerror (NULL, error); ## GSList *gtk_file_chooser_list_shortcut_folders (GtkFileChooser *chooser); ## GSList *gtk_file_chooser_list_shortcut_folder_uris (GtkFileChooser *chooser); void gtk_file_chooser_list_shortcut_folders (GtkFileChooser *chooser); ALIAS: list_shortcut_folders = 0 list_shortcut_folder_uris = 1 PREINIT: GSList * slist, * i; PPCODE: if (ix == 0) slist = gtk_file_chooser_list_shortcut_folders (chooser); else slist = gtk_file_chooser_list_shortcut_folder_uris (chooser); for (i = slist ; i != NULL ; i = i->next) { XPUSHs (sv_2mortal (newSVGChar (i->data))); g_free (i->data); } g_slist_free (slist); #if GTK_CHECK_VERSION (2, 6, 0) void gtk_file_chooser_set_show_hidden (GtkFileChooser *chooser, gboolean show_hidden) gboolean gtk_file_chooser_get_show_hidden (GtkFileChooser *chooser) #endif #if GTK_CHECK_VERSION (2, 8, 0) void gtk_file_chooser_set_do_overwrite_confirmation (GtkFileChooser *chooser, gboolean do_overwrite_confirmation); gboolean gtk_file_chooser_get_do_overwrite_confirmation (GtkFileChooser *chooser); #endif #if GTK_CHECK_VERSION (2, 18, 0) void gtk_file_chooser_set_create_folders (GtkFileChooser *chooser, gboolean create_folders); gboolean gtk_file_chooser_get_create_folders (GtkFileChooser *chooser); #endif Gtk2-1.24992/xs/GtkTooltips.xs0000644000175000017500000000677013076462677014446 0ustar lacklack/* * Copyright (c) 2003, 2013 by the gtk2-perl team (see the file AUTHORS) * * This library is free software; you can redistribute it and/or * modify it under the terms of the GNU Library General Public * License as published by the Free Software Foundation; either * version 2.1 of the License, or (at your option) any later version. * * This library is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU * Library General Public License for more details. * * You should have received a copy of the GNU Library General Public * License along with this library; if not, write to the * Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, * Boston, MA 02110-1301 USA. * * $Id$ */ #include "gtk2perl.h" MODULE = Gtk2::Tooltips PACKAGE = Gtk2::Tooltips PREFIX = gtk_tooltips_ ## GtkTooltips* gtk_tooltips_new (void) GtkTooltips * gtk_tooltips_new (class) C_ARGS: /* void */ ## void gtk_tooltips_enable (GtkTooltips *tooltips) void gtk_tooltips_enable (tooltips) GtkTooltips * tooltips ## void gtk_tooltips_disable (GtkTooltips *tooltips) void gtk_tooltips_disable (tooltips) GtkTooltips * tooltips ## void gtk_tooltips_set_tip (GtkTooltips *tooltips, GtkWidget *widget, const gchar *tip_text, const gchar *tip_private) void gtk_tooltips_set_tip (tooltips, widget, tip_text, tip_private=NULL) GtkTooltips * tooltips GtkWidget * widget const gchar * tip_text SV * tip_private PREINIT: const gchar * real_tip_private = NULL; CODE: if (gperl_sv_is_defined (tip_private)) real_tip_private = SvGChar (tip_private); gtk_tooltips_set_tip (tooltips, widget, tip_text, real_tip_private); /* gtk+'s widgets do not hold a reference on the tooltips object, * as you might expect; in fact, it's the other way around. * let's use a weakref on the widget to keep the tooltips object * alive as long as the widget is alive. */ g_object_ref (G_OBJECT (tooltips)); g_object_weak_ref (G_OBJECT (widget), (GWeakNotify)g_object_unref, tooltips); ## GtkTooltipsData* gtk_tooltips_data_get (GtkWidget *widget) =for apidoc =for signature hash_ref = $tooltips->data_get ($widget) Returns a hash reference with the keys: tooptips, widget, tip_text, and tip_private. tooltips is the GtkTooltips group that this tooltip belongs to. widget is the GtkWidget that this tooltip data is associated with. tip_text is a string containing the tooltip message itself. tip_private is a string that is not shown as the default tooltip. Instead, this message may be more informative and go towards forming a context-sensitive help system for your application. =cut void gtk_tooltips_data_get (class, widget) GtkWidget * widget PREINIT: GtkTooltipsData * ret = NULL; HV * hv; PPCODE: ret = gtk_tooltips_data_get(widget); if( !ret ) XSRETURN_UNDEF; hv = newHV(); if (ret->tooltips) gperl_hv_take_sv_s(hv, "tooltips", newSVGtkTooltips(ret->tooltips)); if (ret->widget) gperl_hv_take_sv_s(hv, "widget", newSVGtkWidget(GTK_WIDGET(ret->widget))); if (ret->tip_text) gperl_hv_take_sv_s(hv, "tip_text", newSVpv(ret->tip_text, 0)); if (ret->tip_private) gperl_hv_take_sv_s(hv, "tip_private", newSVpv(ret->tip_private, 0)); XPUSHs(sv_2mortal(newRV_noinc((SV*)hv))); ## void gtk_tooltips_force_window (GtkTooltips *tooltips) void gtk_tooltips_force_window (tooltips) GtkTooltips * tooltips ## void _gtk_tooltips_toggle_keyboard_mode (GtkWidget *widget) Gtk2-1.24992/xs/GdkVisual.xs0000644000175000017500000001101613076462677014041 0ustar lacklack/* * Copyright (c) 2004 by the gtk2-perl team (see the file AUTHORS) * * Licensed under the LGPL, see LICENSE file for more information. * * $Id$ */ #include "gtk2perl.h" MODULE = Gtk2::Gdk::Visual PACKAGE = Gtk2::Gdk PREFIX = gdk_ =for apidoc Returns a list of depths. =cut ## void gdk_query_depths (gint **depths, gint *count) void gdk_query_depths (class) PREINIT: gint *depths = NULL; gint i, count = 0; PPCODE: gdk_query_depths (&depths, &count); if (count <= 0 || depths == NULL) XSRETURN_EMPTY; EXTEND (sp, count); for (i = 0; i < count; i++) PUSHs (sv_2mortal (newSViv (depths[i]))); ## void gdk_query_visual_types (GdkVisualType **visual_types, gint *count) void gdk_query_visual_types (class) PREINIT: GdkVisualType *visual_types = NULL; gint i, count = 0; PPCODE: gdk_query_visual_types (&visual_types, &count); if (count <= 0 || visual_types == NULL) XSRETURN_EMPTY; EXTEND (sp, count); for (i = 0; i < count; i++) PUSHs (sv_2mortal (newSVGdkVisualType (visual_types[i]))); ## GList* gdk_list_visuals (void) void gdk_list_visuals (class) PREINIT: GList *i, *visuals = NULL; PPCODE: PERL_UNUSED_VAR (ax); visuals = gdk_list_visuals (); for (i = visuals; i != NULL; i = i->next) XPUSHs (sv_2mortal (newSVGdkVisual (i->data))); g_list_free (visuals); MODULE = Gtk2::Gdk::Visual PACKAGE = Gtk2::Gdk::Visual PREFIX = gdk_visual_ ## gint gdk_visual_get_best_depth (void) gint gdk_visual_get_best_depth (class) C_ARGS: /* void */ ## GdkVisualType gdk_visual_get_best_type (void) GdkVisualType gdk_visual_get_best_type (class) C_ARGS: /* void */ ## GdkVisual* gdk_visual_get_system (void) GdkVisual* gdk_visual_get_system (class) C_ARGS: /* void */ ## GdkVisual* gdk_visual_get_best (void) GdkVisual* gdk_visual_get_best (class) C_ARGS: /* void */ ## GdkVisual* gdk_visual_get_best_with_depth (gint depth) GdkVisual_ornull* gdk_visual_get_best_with_depth (class, depth) gint depth C_ARGS: depth ## GdkVisual* gdk_visual_get_best_with_type (GdkVisualType visual_type) GdkVisual_ornull* gdk_visual_get_best_with_type (class, visual_type) GdkVisualType visual_type C_ARGS: visual_type ## GdkVisual* gdk_visual_get_best_with_both (gint depth, GdkVisualType visual_type) GdkVisual_ornull* gdk_visual_get_best_with_both (class, depth, visual_type) gint depth GdkVisualType visual_type C_ARGS: depth, visual_type #if GTK_CHECK_VERSION(2, 2, 0) ## GdkScreen* gdk_visual_get_screen (GdkVisual *visual) GdkScreen* gdk_visual_get_screen (visual) GdkVisual *visual #endif # --------------------------------------------------------------------------- # GdkVisualType type (visual) GdkVisual *visual CODE: RETVAL = visual->type; OUTPUT: RETVAL GdkByteOrder byte_order (visual) GdkVisual *visual CODE: RETVAL = visual->byte_order; OUTPUT: RETVAL gint depth (visual) GdkVisual *visual ALIAS: colormap_size = 1 bits_per_rgb = 2 red_shift = 3 red_prec = 4 green_shift = 5 green_prec = 6 blue_shift = 7 blue_prec = 8 CODE: RETVAL = 0; /* -W */ switch (ix) { case 0: RETVAL = visual->depth; break; case 1: RETVAL = visual->colormap_size; break; case 2: RETVAL = visual->bits_per_rgb; break; case 3: RETVAL = visual->red_shift; break; case 4: RETVAL = visual->red_prec; break; case 5: RETVAL = visual->green_shift; break; case 6: RETVAL = visual->green_prec; break; case 7: RETVAL = visual->blue_shift; break; case 8: RETVAL = visual->blue_prec; break; default: g_assert_not_reached (); } OUTPUT: RETVAL guint32 red_mask (visual) GdkVisual *visual ALIAS: green_mask = 1 blue_mask = 2 CODE: RETVAL = 0; /* -W */ switch (ix) { case 0: RETVAL = visual->red_mask; break; case 1: RETVAL = visual->green_mask; break; case 2: RETVAL = visual->blue_mask; break; default: g_assert_not_reached(); } OUTPUT: RETVAL #if GTK_CHECK_VERSION (2, 22, 0) void gdk_visual_get_blue_pixel_details (GdkVisual *visual, OUTLIST guint32 mask, OUTLIST gint shift, OUTLIST gint precision); void gdk_visual_get_green_pixel_details (GdkVisual *visual, OUTLIST guint32 mask, OUTLIST gint shift, OUTLIST gint precision); void gdk_visual_get_red_pixel_details (GdkVisual *visual, OUTLIST guint32 mask, OUTLIST gint shift, OUTLIST gint precision); gint gdk_visual_get_bits_per_rgb (GdkVisual *visual); GdkByteOrder gdk_visual_get_byte_order (GdkVisual *visual); gint gdk_visual_get_colormap_size (GdkVisual *visual); gint gdk_visual_get_depth (GdkVisual *visual); GdkVisualType gdk_visual_get_visual_type (GdkVisual *visual); #endif /* 2.22 */ Gtk2-1.24992/xs/GtkTextChildAnchor.xs0000644000175000017500000000321713076462677015645 0ustar lacklack/* * Copyright (c) 2003 by the gtk2-perl team (see the file AUTHORS) * * This library is free software; you can redistribute it and/or * modify it under the terms of the GNU Library General Public * License as published by the Free Software Foundation; either * version 2.1 of the License, or (at your option) any later version. * * This library is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU * Library General Public License for more details. * * You should have received a copy of the GNU Library General Public * License along with this library; if not, write to the * Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, * Boston, MA 02110-1301 USA. * * $Id$ */ #include "gtk2perl.h" MODULE = Gtk2::TextChildAnchor PACKAGE = Gtk2::TextChildAnchor PREFIX = gtk_text_child_anchor_ ## GtkTextChildAnchor* gtk_text_child_anchor_new (void) GtkTextChildAnchor_noinc * gtk_text_child_anchor_new (class) C_ARGS: /* void */ ## GList* gtk_text_child_anchor_get_widgets (GtkTextChildAnchor *anchor) =for apidoc Returns a list of Gtk2::Widgets. =cut void gtk_text_child_anchor_get_widgets (anchor) GtkTextChildAnchor *anchor PREINIT: GList *widgets, *i; PPCODE: widgets = gtk_text_child_anchor_get_widgets (anchor); for (i = widgets; i != NULL; i = i->next) XPUSHs (sv_2mortal (newSVGtkWidget (i->data))); g_list_free (widgets); ## gboolean gtk_text_child_anchor_get_deleted (GtkTextChildAnchor *anchor) gboolean gtk_text_child_anchor_get_deleted (anchor) GtkTextChildAnchor *anchor Gtk2-1.24992/xs/GtkImage.xs0000644000175000017500000001333513076462677013646 0ustar lacklack/* * Copyright (c) 2003-2005 by the gtk2-perl team (see the file AUTHORS) * * This library is free software; you can redistribute it and/or * modify it under the terms of the GNU Library General Public * License as published by the Free Software Foundation; either * version 2.1 of the License, or (at your option) any later version. * * This library is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU * Library General Public License for more details. * * You should have received a copy of the GNU Library General Public * License along with this library; if not, write to the * Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, * Boston, MA 02110-1301 USA. * * $Id$ */ #include "gtk2perl.h" MODULE = Gtk2::Image PACKAGE = Gtk2::Image PREFIX = gtk_image_ GtkWidget* gtk_image_new (class) C_ARGS: /*void*/ ## GtkWidget* gtk_image_new_from_pixmap (GdkPixmap *pixmap, GdkBitmap *mask) GtkWidget* gtk_image_new_from_pixmap (class, pixmap, mask) GdkPixmap_ornull * pixmap GdkBitmap_ornull * mask C_ARGS: pixmap, mask ## GtkWidget* gtk_image_new_from_image (GdkImage *image, GdkBitmap *mask) GtkWidget* gtk_image_new_from_image (class, image, mask) GdkImage_ornull *image GdkBitmap_ornull *mask C_ARGS: image, mask GtkWidget* gtk_image_new_from_file (class, filename) GPerlFilename_ornull filename C_ARGS: filename ## GtkWidget* gtk_image_new_from_pixbuf (GdkPixbuf *pixbuf) GtkWidget* gtk_image_new_from_pixbuf (class, pixbuf) GdkPixbuf_ornull * pixbuf C_ARGS: pixbuf GtkWidget* gtk_image_new_from_stock (class, stock_id, size) const gchar *stock_id GtkIconSize size C_ARGS: stock_id, size ## GtkWidget* gtk_image_new_from_icon_set (GtkIconSet *icon_set, GtkIconSize size) GtkWidget* gtk_image_new_from_icon_set (class, icon_set, size) GtkIconSet *icon_set GtkIconSize size C_ARGS: icon_set, size ## GtkWidget* gtk_image_new_from_animation (GdkPixbufAnimation *animation) GtkWidget* gtk_image_new_from_animation (class, GdkPixbufAnimation *animation) C_ARGS: animation ## void gtk_image_set_from_pixmap (GtkImage *image, GdkPixmap *pixmap, GdkBitmap *mask) void gtk_image_set_from_pixmap (image, pixmap, mask) GtkImage * image GdkPixmap_ornull * pixmap GdkBitmap_ornull * mask void gtk_image_set_from_image (image, gdk_image, mask) GtkImage *image GdkImage_ornull *gdk_image GdkBitmap_ornull *mask void gtk_image_set_from_file (image, filename) GtkImage *image GPerlFilename_ornull filename void gtk_image_set_from_pixbuf (image, pixbuf) GtkImage *image GdkPixbuf_ornull *pixbuf void gtk_image_set_from_stock (image, stock_id, size) GtkImage *image const gchar *stock_id GtkIconSize size void gtk_image_set_from_icon_set (image, icon_set, size) GtkImage *image GtkIconSet *icon_set GtkIconSize size void gtk_image_set_from_animation (GtkImage *image, GdkPixbufAnimation *animation) GtkImageType gtk_image_get_storage_type (image) GtkImage *image ## void gtk_image_get_pixmap (GtkImage *image, GdkPixmap **pixmap, GdkBitmap **mask) void gtk_image_get_pixmap (GtkImage *image) PREINIT: GdkPixmap * pixmap = NULL; GdkBitmap * mask = NULL; PPCODE: gtk_image_get_pixmap (image, &pixmap, &mask); EXTEND (SP, 2); PUSHs (sv_2mortal (newSVGdkPixmap (pixmap))); PUSHs (sv_2mortal (newSVGdkBitmap (mask))); ## void gtk_image_get_image (GtkImage *image, GdkImage **gdk_image, GdkBitmap **mask) void gtk_image_get_image (GtkImage *image) PREINIT: GdkImage * gdk_image = NULL; GdkBitmap * mask = NULL; PPCODE: gtk_image_get_image (image, &gdk_image, &mask); EXTEND (SP, 2); PUSHs (sv_2mortal (newSVGdkImage (gdk_image))); PUSHs (sv_2mortal (newSVGdkBitmap (mask))); GdkPixbuf* gtk_image_get_pixbuf (image) GtkImage *image =for apidoc =for signature (stock_id, icon_size) = $image->get_stock =cut void gtk_image_get_stock (image) GtkImage * image PREINIT: gchar * stock_id; GtkIconSize size; PPCODE: gtk_image_get_stock (image, &stock_id, &size); EXTEND (SP, 2); PUSHs (sv_2mortal (stock_id ? newSVpv (stock_id, 0) : newSVsv(&PL_sv_undef))); PUSHs (sv_2mortal (newSVGtkIconSize (size))); ## void gtk_image_get_icon_set (GtkImage *image, GtkIconSet **icon_set, GtkIconSize *size) void gtk_image_get_icon_set (GtkImage *image) PREINIT: GtkIconSet *icon_set = NULL; GtkIconSize size; PPCODE: gtk_image_get_icon_set (image, &icon_set, &size); EXTEND (SP, 2); PUSHs (sv_2mortal (newSVGtkIconSet (icon_set))); PUSHs (sv_2mortal (newSVGtkIconSize (size))); GdkPixbufAnimation* gtk_image_get_animation (GtkImage *image) # deprecated ## void gtk_image_get (GtkImage *image, GdkImage **val, GdkBitmap **mask) ##void gtk_image_set (GtkImage *image, GdkImage *val, GdkBitmap *mask) #if GTK_CHECK_VERSION (2, 6, 0) ## GtkWidget * gtk_image_new_from_icon_name (const gchar *icon_name, GtkIconSize size) GtkWidget * gtk_image_new_from_icon_name (class, icon_name, size) const gchar *icon_name GtkIconSize size C_ARGS: icon_name, size void gtk_image_set_from_icon_name (GtkImage *image, const gchar *icon_name, GtkIconSize size) # void gtk_image_get_icon_name (GtkImage *image, const gchar **icon_name, GtkIconSize *size) void gtk_image_get_icon_name (GtkImage *image) PREINIT: const gchar *icon_name = NULL; GtkIconSize size; PPCODE: gtk_image_get_icon_name (image, &icon_name, &size); EXTEND (SP, 2); PUSHs (sv_2mortal (newSVGChar (icon_name))); PUSHs (sv_2mortal (newSVGtkIconSize (size))); void gtk_image_set_pixel_size (GtkImage *image, gint pixel_size) gint gtk_image_get_pixel_size (GtkImage *image) #endif #if GTK_CHECK_VERSION (2, 8, 0) void gtk_image_clear (GtkImage *image); #endif Gtk2-1.24992/xs/GtkCellRendererPixbuf.xs0000644000175000017500000000202713076462677016344 0ustar lacklack/* * Copyright (c) 2003 by the gtk2-perl team (see the file AUTHORS) * * This library is free software; you can redistribute it and/or * modify it under the terms of the GNU Library General Public * License as published by the Free Software Foundation; either * version 2.1 of the License, or (at your option) any later version. * * This library is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU * Library General Public License for more details. * * You should have received a copy of the GNU Library General Public * License along with this library; if not, write to the * Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, * Boston, MA 02110-1301 USA. * * $Id$ */ #include "gtk2perl.h" MODULE = Gtk2::CellRendererPixbuf PACKAGE = Gtk2::CellRendererPixbuf PREFIX = gtk_cell_renderer_pixbuf_ GtkCellRenderer * gtk_cell_renderer_pixbuf_new (class) C_ARGS: /* void */ Gtk2-1.24992/xs/GtkScrolledWindow.xs0000644000175000017500000001062513076462677015562 0ustar lacklack/* * Copyright (c) 2003-2006 by the gtk2-perl team (see the file AUTHORS) * * This library is free software; you can redistribute it and/or * modify it under the terms of the GNU Library General Public * License as published by the Free Software Foundation; either * version 2.1 of the License, or (at your option) any later version. * * This library is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU * Library General Public License for more details. * * You should have received a copy of the GNU Library General Public * License along with this library; if not, write to the * Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, * Boston, MA 02110-1301 USA. * * $Id$ */ #include "gtk2perl.h" MODULE = Gtk2::ScrolledWindow PACKAGE = Gtk2::ScrolledWindow PREFIX = gtk_scrolled_window_ ## GtkWidget* gtk_scrolled_window_new (GtkAdjustment *hadjustment, GtkAdjustment *vadjustment) GtkWidget * gtk_scrolled_window_new (class, hadjustment=NULL, vadjustment=NULL) GtkAdjustment_ornull * hadjustment GtkAdjustment_ornull * vadjustment C_ARGS: hadjustment, vadjustment ## void gtk_scrolled_window_set_hadjustment (GtkScrolledWindow *scrolled_window, GtkAdjustment *hadjustment) void gtk_scrolled_window_set_hadjustment (scrolled_window, hadjustment) GtkScrolledWindow * scrolled_window GtkAdjustment * hadjustment ## void gtk_scrolled_window_set_vadjustment (GtkScrolledWindow *scrolled_window, GtkAdjustment *hadjustment) void gtk_scrolled_window_set_vadjustment (scrolled_window, hadjustment) GtkScrolledWindow * scrolled_window GtkAdjustment * hadjustment ## GtkAdjustment* gtk_scrolled_window_get_hadjustment (GtkScrolledWindow *scrolled_window) GtkAdjustment * gtk_scrolled_window_get_hadjustment (scrolled_window) GtkScrolledWindow * scrolled_window ## GtkAdjustment* gtk_scrolled_window_get_vadjustment (GtkScrolledWindow *scrolled_window) GtkAdjustment * gtk_scrolled_window_get_vadjustment (scrolled_window) GtkScrolledWindow * scrolled_window ## void gtk_scrolled_window_set_policy (GtkScrolledWindow *scrolled_window, GtkPolicyType hscrollbar_policy, GtkPolicyType vscrollbar_policy) void gtk_scrolled_window_set_policy (scrolled_window, hscrollbar_policy, vscrollbar_policy) GtkScrolledWindow * scrolled_window GtkPolicyType hscrollbar_policy GtkPolicyType vscrollbar_policy ## void gtk_scrolled_window_get_policy (GtkScrolledWindow *scrolled_window, GtkPolicyType *hscrollbar_policy, GtkPolicyType *vscrollbar_policy) void gtk_scrolled_window_get_policy (GtkScrolledWindow * scrolled_window) PREINIT: GtkPolicyType hscrollbar_policy; GtkPolicyType vscrollbar_policy; PPCODE: gtk_scrolled_window_get_policy (scrolled_window, &hscrollbar_policy, &vscrollbar_policy); EXTEND (SP, 2); PUSHs (sv_2mortal (newSVGtkPolicyType (hscrollbar_policy))); PUSHs (sv_2mortal (newSVGtkPolicyType (vscrollbar_policy))); ## void gtk_scrolled_window_set_placement (GtkScrolledWindow *scrolled_window, GtkCornerType window_placement) void gtk_scrolled_window_set_placement (scrolled_window, window_placement) GtkScrolledWindow * scrolled_window GtkCornerType window_placement ## GtkCornerType gtk_scrolled_window_get_placement (GtkScrolledWindow *scrolled_window) GtkCornerType gtk_scrolled_window_get_placement (scrolled_window) GtkScrolledWindow * scrolled_window ## void gtk_scrolled_window_set_shadow_type (GtkScrolledWindow *scrolled_window, GtkShadowType type) void gtk_scrolled_window_set_shadow_type (scrolled_window, type) GtkScrolledWindow * scrolled_window GtkShadowType type ## GtkShadowType gtk_scrolled_window_get_shadow_type (GtkScrolledWindow *scrolled_window) GtkShadowType gtk_scrolled_window_get_shadow_type (scrolled_window) GtkScrolledWindow * scrolled_window ## void gtk_scrolled_window_add_with_viewport (GtkScrolledWindow *scrolled_window, GtkWidget *child) void gtk_scrolled_window_add_with_viewport (scrolled_window, child) GtkScrolledWindow * scrolled_window GtkWidget * child #if GTK_CHECK_VERSION (2, 8, 0) GtkWidget_ornull* gtk_scrolled_window_get_hscrollbar (GtkScrolledWindow *scrolled_window); GtkWidget_ornull* gtk_scrolled_window_get_vscrollbar (GtkScrolledWindow *scrolled_window); #endif #if GTK_CHECK_VERSION (2, 10, 0) void gtk_scrolled_window_unset_placement (GtkScrolledWindow *scrolled_window); #endif Gtk2-1.24992/xs/GtkMenu.xs0000644000175000017500000002171413076462677013530 0ustar lacklack/* * Copyright (c) 2003-2005, 2010 by the gtk2-perl team (see the file AUTHORS) * * This library is free software; you can redistribute it and/or * modify it under the terms of the GNU Library General Public * License as published by the Free Software Foundation; either * version 2.1 of the License, or (at your option) any later version. * * This library is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU * Library General Public License for more details. * * You should have received a copy of the GNU Library General Public * License along with this library; if not, write to the * Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, * Boston, MA 02110-1301 USA. * * $Id$ */ #include "gtk2perl.h" #include /* * yet another special case that isn't appropriate for either * GPerlClosure or GPerlCallback --- the menu position function has * mostly output parameters, so we need to change the callbacks's * signature for perl, getting multiple return values from the stack. * this one's easy, though. */ /* this is public so that other extensions which use GtkMenuPosFunc (e.g. * libgnomeui) don't need to reimplement it. */ void gtk2perl_menu_position_func (GtkMenu * menu, gint * x, gint * y, gboolean * push_in, GPerlCallback * callback) { int n; dGPERL_CALLBACK_MARSHAL_SP; GPERL_CALLBACK_MARSHAL_INIT (callback); ENTER; SAVETMPS; PUSHMARK (SP); EXTEND (SP, 3); PUSHs (sv_2mortal (newSVGtkMenu (menu))); PUSHs (sv_2mortal (newSViv (*x))); PUSHs (sv_2mortal (newSViv (*y))); if (callback->data) XPUSHs (sv_2mortal (newSVsv (callback->data))); /* A die() from callback->func is suspected to be bad or very bad. Circa Gtk 2.18 a jump out of $menu->popup seems to leave an X grab with no way to get rid of it (no keyboard Esc, and no mouse click handlers). The position func can also be called later for things like resizing or move to a different GdkScreen, and such a call might come straight from the main loop, where a die() would jump out of Gtk2->main. */ PUTBACK; n = call_sv (callback->func, G_ARRAY | G_EVAL); SPAGAIN; if (SvTRUE (ERRSV)) { g_warning ("menu position callback ignoring error: %s", SvPVutf8_nolen (ERRSV)); } else if (n < 2 || n > 3) { g_warning ("menu position callback must return two integers " "(x, and y) or two integers and a boolean " "(x, y, and push_in)"); } else { /* POPs and POPi take things off the *end* of the stack! */ if (n > 2) { SV *sv = POPs; *push_in = sv_2bool (sv); } if (n > 1) *y = POPi; if (n > 0) *x = POPi; } PUTBACK; FREETMPS; LEAVE; } static GPerlCallback * gtk2perl_menu_detach_func_create (SV *func, SV *data) { GType param_types [2]; param_types[0] = GTK_TYPE_WIDGET; param_types[1] = GTK_TYPE_MENU; return gperl_callback_new (func, data, G_N_ELEMENTS (param_types), param_types, 0); } static void gtk2perl_menu_detach_func (GtkWidget *attach_widget, GtkMenu *menu) { GPerlCallback *callback; callback = g_object_get_data (G_OBJECT (attach_widget), "__gtk2perl_menu_detach_func__"); if (callback) { gperl_callback_invoke (callback, NULL, attach_widget, menu); /* free the handler after it's been called */ g_object_set_data (G_OBJECT (attach_widget), "__gtk2perl_menu_detach_func__", NULL); } } MODULE = Gtk2::Menu PACKAGE = Gtk2::Menu PREFIX = gtk_menu_ GtkWidget* gtk_menu_new (class) C_ARGS: /* void */ =for apidoc If C<$menu_pos_func> is not C it's called as ($x, $y, $push_in) = &$menu_pos_func ($menu, $x, $y, $data) C<$x>,C<$y> inputs are a proposed position based on the mouse pointer (not actually documented in the Gtk manuals). The return should be a desired C<$x>,C<$y>, and an optional C<$push_in> flag. If C<$push_in> is true then Gtk will adjust C<$x>,C<$y> if necessary so the menu is fully visible in the screen width and height. C<$menu_pos_func> and C<$data> are stored in C<$menu> and may be called again later for a C<< $menu->reposition >> or some obscure things like a changed C while torn-off. A further C<< $menu->popup >> call replaces C<$menu_pos_func> and C<$data>. =cut void gtk_menu_popup (menu, parent_menu_shell, parent_menu_item, menu_pos_func, data, button, activate_time) GtkMenu * menu GtkWidget_ornull * parent_menu_shell GtkWidget_ornull * parent_menu_item SV * menu_pos_func SV * data guint button guint activate_time ###guint32 activate_time CODE: if (!gperl_sv_is_defined (menu_pos_func)) { gtk_menu_popup (menu, parent_menu_shell, parent_menu_item, NULL, NULL, button, activate_time); g_object_set_data (G_OBJECT(menu), "_gtk2perl_menu_pos_callback", NULL); } else { GPerlCallback * callback; /* we don't need to worry about the callback arg types since * we already have to marshall this callback ourselves. */ callback = gperl_callback_new (menu_pos_func, data, 0, NULL, 0); gtk_menu_popup (menu, parent_menu_shell, parent_menu_item, (GtkMenuPositionFunc) gtk2perl_menu_position_func, callback, button, activate_time); /* The menu will store the callback we give it, and can * conceivably invoke the callback multiple times * (repositioning, changing screens, etc). Each call to * gtk_menu_popup() replaces the function pointer. So, * if we use a weak reference, we can leak multiple callbacks; * if we use object data, we can clean up the ones we install * and reinstall. Not likely, of course, but there are * pathological programmers out there. */ g_object_set_data_full (G_OBJECT (menu), "_gtk2perl_menu_pos_callback", callback, (GDestroyNotify) gperl_callback_destroy); } void gtk_menu_reposition (menu) GtkMenu * menu void gtk_menu_popdown (menu) GtkMenu *menu GtkWidget * gtk_menu_get_active (menu) GtkMenu *menu void gtk_menu_set_active (menu, index) GtkMenu *menu guint index void gtk_menu_set_accel_group (menu, accel_group) GtkMenu * menu GtkAccelGroup * accel_group GtkAccelGroup* gtk_menu_get_accel_group (menu) GtkMenu *menu void gtk_menu_set_accel_path (menu, accel_path) GtkMenu *menu const gchar *accel_path =for apidoc Attach C<$menu> to C<$attach_widget>. C<$menu> must not be currently attached to any other widget, including not a submenu of a C. If C<$menu> is later detached from the widget with C<< $menu->detach >> then the C<$detach_func> is called as &$detach_func ($attach_widget, $menu) =cut void gtk_menu_attach_to_widget (menu, attach_widget, detach_func) GtkMenu *menu GtkWidget *attach_widget SV *detach_func PREINIT: GPerlCallback *callback; CODE: callback = gtk2perl_menu_detach_func_create (detach_func, NULL); g_object_set_data_full (G_OBJECT (attach_widget), "__gtk2perl_menu_detach_func__", callback, (GDestroyNotify) gperl_callback_destroy); gtk_menu_attach_to_widget (menu, attach_widget, gtk2perl_menu_detach_func); void gtk_menu_detach (menu) GtkMenu *menu GtkWidget * gtk_menu_get_attach_widget (menu) GtkMenu * menu void gtk_menu_set_tearoff_state (menu, torn_off) GtkMenu *menu gboolean torn_off gboolean gtk_menu_get_tearoff_state (menu) GtkMenu *menu void gtk_menu_set_title (menu, title) GtkMenu * menu const gchar * title ## void gtk_menu_reorder_child (GtkMenu *menu, GtkWidget *child, gint position) void gtk_menu_reorder_child (menu, child, position) GtkMenu *menu GtkWidget *child gint position ##gchar * gtk_menu_get_title (GtkMenu *menu) const gchar * gtk_menu_get_title (menu) GtkMenu * menu #if GTK_CHECK_VERSION(2,2,0) ##void gtk_menu_set_screen (GtkMenu *menu, GdkScreen *screen) void gtk_menu_set_screen (menu, screen) GtkMenu * menu GdkScreen_ornull * screen #endif #if GTK_CHECK_VERSION(2,4,0) void gtk_menu_attach (GtkMenu *menu, GtkWidget *child, guint left_attach, guint right_attach, guint top_attach, guint bottom_attach); void gtk_menu_set_monitor (GtkMenu *menu, gint monitor_num); #endif #if GTK_CHECK_VERSION(2,6,0) ## GList* gtk_menu_get_for_attach_widget (GtkWidget *widget); void gtk_menu_get_for_attach_widget (class, widget) GtkWidget *widget PREINIT: GList *list, *i; PPCODE: list = gtk_menu_get_for_attach_widget (widget); for (i = list; i; i = i->next) XPUSHs (sv_2mortal (newSVGtkMenu (i->data))); #endif #if GTK_CHECK_VERSION (2, 14, 0) const gchar* gtk_menu_get_accel_path (GtkMenu *menu); gint gtk_menu_get_monitor (GtkMenu *menu); #endif /* 2.14 */ #if GTK_CHECK_VERSION (2, 18, 0) void gtk_menu_set_reserve_toggle_size (GtkMenu *menu, gboolean reserve_toggle_size); gboolean gtk_menu_get_reserve_toggle_size (GtkMenu *menu); #endif Gtk2-1.24992/xs/GtkPlug.xs0000644000175000017500000000503513076462677013531 0ustar lacklack/* * Copyright (c) 2003 by the gtk2-perl team (see the file AUTHORS) * * This library is free software; you can redistribute it and/or * modify it under the terms of the GNU Library General Public * License as published by the Free Software Foundation; either * version 2.1 of the License, or (at your option) any later version. * * This library is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU * Library General Public License for more details. * * You should have received a copy of the GNU Library General Public * License along with this library; if not, write to the * Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, * Boston, MA 02110-1301 USA. * * $Id$ */ #include "gtk2perl.h" MODULE = Gtk2::Plug PACKAGE = Gtk2::Plug PREFIX = gtk_plug_ ## no plug/socket on non-X11 despite patches exist for years. #ifdef GDK_WINDOWING_X11 ## void gtk_plug_construct (GtkPlug *plug, GdkNativeWindow socket_id) void gtk_plug_construct (plug, socket_id) GtkPlug * plug GdkNativeWindow socket_id # for 2.2 compat this function needs to be updated to include # the for_display version ## GtkWidget* gtk_plug_new (GdkNativeWindow socket_id) GtkWidget * gtk_plug_new (class, socket_id) GdkNativeWindow socket_id C_ARGS: socket_id #if GTK_CHECK_VERSION(2,2,0) ##GtkWidget * gtk_plug_new_for_display (GdkDisplay *display, GdkNativeWindow socket_id) GtkWidget * gtk_plug_new_for_display (...) CODE: if (items == 2) { RETVAL = gtk_plug_new_for_display ( SvGdkDisplay (ST (0)), SvUV (ST (1))); } else if (items == 3) { RETVAL = gtk_plug_new_for_display ( SvGdkDisplay (ST (1)), SvUV (ST (2))); } else { RETVAL = NULL; croak ("Usage: Gtk2::Plug->new_for_display(display, socket_id)"); } OUTPUT: RETVAL ## void gtk_plug_construct_for_disaplay (GtkPlug *plug, GdkDisplay * display, GdkNativeWindow socket_id) void gtk_plug_construct_for_display (plug, display, socket_id) GtkPlug * plug GdkDisplay * display GdkNativeWindow socket_id #endif ## GdkNativeWindow gtk_plug_get_id (GtkPlug *plug) GdkNativeWindow gtk_plug_get_id (plug) GtkPlug * plug #if GTK_CHECK_VERSION (2, 14, 0) gboolean gtk_plug_get_embedded (GtkPlug *plug); GdkWindow_ornull* gtk_plug_get_socket_window (GtkPlug *plug); #endif /* 2.14 */ ## void _gtk_plug_add_to_socket (GtkPlug *plug, GtkSocket *socket) ## void _gtk_plug_remove_from_socket (GtkPlug *plug, GtkSocket *socket) #endif Gtk2-1.24992/xs/GtkItem.xs0000644000175000017500000000223613076462677013520 0ustar lacklack/* * Copyright (c) 2003 by the gtk2-perl team (see the file AUTHORS) * * This library is free software; you can redistribute it and/or * modify it under the terms of the GNU Library General Public * License as published by the Free Software Foundation; either * version 2.1 of the License, or (at your option) any later version. * * This library is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU * Library General Public License for more details. * * You should have received a copy of the GNU Library General Public * License along with this library; if not, write to the * Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, * Boston, MA 02110-1301 USA. * * $Id$ */ #include "gtk2perl.h" MODULE = Gtk2::Item PACKAGE = Gtk2::Item PREFIX = gtk_item_ ## void gtk_item_select (GtkItem *item) void gtk_item_select (item) GtkItem * item ## void gtk_item_deselect (GtkItem *item) void gtk_item_deselect (item) GtkItem * item ## void gtk_item_toggle (GtkItem *item) void gtk_item_toggle (item) GtkItem * item Gtk2-1.24992/xs/GtkToolShell.xs0000644000175000017500000000170313076462677014525 0ustar lacklack/* * Copyright (c) 2008 by the gtk2-perl team (see the file AUTHORS) * * Licensed under the LGPL, see LICENSE file for more information. * * $Id$ */ #include "gtk2perl.h" MODULE = Gtk2::ToolShell PACKAGE = Gtk2::ToolShell PREFIX = gtk_tool_shell_ GtkIconSize gtk_tool_shell_get_icon_size (GtkToolShell *shell); GtkOrientation gtk_tool_shell_get_orientation (GtkToolShell *shell); GtkReliefStyle gtk_tool_shell_get_relief_style (GtkToolShell *shell); GtkToolbarStyle gtk_tool_shell_get_style (GtkToolShell *shell); void gtk_tool_shell_rebuild_menu (GtkToolShell *shell); #if GTK_CHECK_VERSION (2, 20, 0) PangoEllipsizeMode gtk_tool_shell_get_ellipsize_mode (GtkToolShell *shell); gfloat gtk_tool_shell_get_text_alignment (GtkToolShell *shell); GtkOrientation gtk_tool_shell_get_text_orientation (GtkToolShell *shell); GtkSizeGroup_ornull * gtk_tool_shell_get_text_size_group (GtkToolShell *shell); #endif /* 2.20 */ Gtk2-1.24992/xs/GtkHRuler.xs0000644000175000017500000000200113076462677014011 0ustar lacklack/* * Copyright (c) 2003 by the gtk2-perl team (see the file AUTHORS) * * This library is free software; you can redistribute it and/or * modify it under the terms of the GNU Library General Public * License as published by the Free Software Foundation; either * version 2.1 of the License, or (at your option) any later version. * * This library is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU * Library General Public License for more details. * * You should have received a copy of the GNU Library General Public * License along with this library; if not, write to the * Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, * Boston, MA 02110-1301 USA. * * $Id$ */ #include "gtk2perl.h" MODULE = Gtk2::HRuler PACKAGE = Gtk2::HRuler PREFIX = gtk_hruler_ ## GtkWidget* gtk_hruler_new (void) GtkWidget * gtk_hruler_new (class) C_ARGS: /* void */ Gtk2-1.24992/xs/GtkSeparatorMenuItem.xs0000644000175000017500000000207613076462677016230 0ustar lacklack/* * Copyright (c) 2003 by the gtk2-perl team (see the file AUTHORS) * * This library is free software; you can redistribute it and/or * modify it under the terms of the GNU Library General Public * License as published by the Free Software Foundation; either * version 2.1 of the License, or (at your option) any later version. * * This library is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU * Library General Public License for more details. * * You should have received a copy of the GNU Library General Public * License along with this library; if not, write to the * Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, * Boston, MA 02110-1301 USA. * * $Id$ */ #include "gtk2perl.h" MODULE = Gtk2::SeparatorMenuItem PACKAGE = Gtk2::SeparatorMenuItem PREFIX = gtk_separator_menu_item_ ## GtkWidget* gtk_separator_menu_item_new (void) GtkWidget * gtk_separator_menu_item_new (class) C_ARGS: /* void */ Gtk2-1.24992/xs/GtkVButtonBox.xs0000644000175000017500000000313013076462677014666 0ustar lacklack/* * Copyright (c) 2003 by the gtk2-perl team (see the file AUTHORS) * * This library is free software; you can redistribute it and/or * modify it under the terms of the GNU Library General Public * License as published by the Free Software Foundation; either * version 2.1 of the License, or (at your option) any later version. * * This library is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU * Library General Public License for more details. * * You should have received a copy of the GNU Library General Public * License along with this library; if not, write to the * Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, * Boston, MA 02110-1301 USA. * * $Id$ */ #include "gtk2perl.h" MODULE = Gtk2::VButtonBox PACKAGE = Gtk2::VButtonBox PREFIX = gtk_vbutton_box_ ## GtkWidget* gtk_vbutton_box_new (void) GtkWidget * gtk_vbutton_box_new (class) C_ARGS: /*void*/ ## void gtk_vbutton_box_set_spacing_default (gint spacing) void gtk_vbutton_box_set_spacing_default (class, gint spacing) C_ARGS: spacing ## GtkButtonBoxStyle gtk_vbutton_box_get_layout_default (void) GtkButtonBoxStyle gtk_vbutton_box_get_layout_default (class) C_ARGS: /*void*/ ## void gtk_vbutton_box_set_layout_default (GtkButtonBoxStyle layout) void gtk_vbutton_box_set_layout_default (class, GtkButtonBoxStyle layout) C_ARGS: layout ##gint gtk_vbutton_box_get_spacing_default (void) gint gtk_vbutton_box_get_spacing_default (class) C_ARGS: /*void*/ Gtk2-1.24992/xs/GtkTextIter.xs0000644000175000017500000004025013076462677014370 0ustar lacklack/* * Copyright (c) 2003-2005 by the gtk2-perl team (see the file AUTHORS) * * Licensed under the LGPL, see LICENSE file for more information. * * $Id$ */ #include "gtk2perl.h" #include static GPerlCallback * create_text_char_predicate_callback (SV * func, SV * data) { return gperl_callback_new (func, data, 0, NULL, G_TYPE_BOOLEAN); } static gboolean gtk2perl_text_char_predicate (gunichar ch, gpointer user_data) { GPerlCallback * callback = (GPerlCallback *) user_data; gboolean ret; SV * svch; gchar temp[6]; gint length; dGPERL_CALLBACK_MARSHAL_SP; GPERL_CALLBACK_MARSHAL_INIT (callback); ENTER; SAVETMPS; PUSHMARK (SP); length = g_unichar_to_utf8 (ch, temp); svch = newSVpv (temp, length); SvUTF8_on (svch); XPUSHs (sv_2mortal (svch)); if (callback->data) XPUSHs (callback->data); PUTBACK; call_sv (callback->func, G_SCALAR); SPAGAIN; ret = POPi; PUTBACK; FREETMPS; LEAVE; return ret; } MODULE = Gtk2::TextIter PACKAGE = Gtk2::TextIter PREFIX = gtk_text_iter_ GtkTextBuffer* gtk_text_iter_get_buffer (iter) GtkTextIter * iter # boxed wrapper support taken care of by Glib::Boxed ## GtkTextIter* gtk_text_iter_copy (const GtkTextIter *iter); ## void gtk_text_iter_free (GtkTextIter *iter); ## gint gtk_text_iter_get_offset (const GtkTextIter *iter) gint gtk_text_iter_get_offset (iter) GtkTextIter *iter ## gint gtk_text_iter_get_line (const GtkTextIter *iter) gint gtk_text_iter_get_line (iter) GtkTextIter *iter ## gint gtk_text_iter_get_line_offset (const GtkTextIter *iter) gint gtk_text_iter_get_line_offset (iter) GtkTextIter *iter ## gint gtk_text_iter_get_line_index (const GtkTextIter *iter) gint gtk_text_iter_get_line_index (iter) GtkTextIter *iter ## gint gtk_text_iter_get_visible_line_offset (const GtkTextIter *iter) gint gtk_text_iter_get_visible_line_offset (iter) GtkTextIter *iter ## gint gtk_text_iter_get_visible_line_index (const GtkTextIter *iter) gint gtk_text_iter_get_visible_line_index (iter) GtkTextIter *iter ## gunichar gtk_text_iter_get_char (const GtkTextIter *iter) gunichar gtk_text_iter_get_char (iter) GtkTextIter *iter gchar_own * gtk_text_iter_get_slice (start, end) GtkTextIter * start GtkTextIter * end gchar_own * gtk_text_iter_get_text (start, end) GtkTextIter * start GtkTextIter * end gchar_own * gtk_text_iter_get_visible_slice (GtkTextIter *start, GtkTextIter *end) gchar_own * gtk_text_iter_get_visible_text (GtkTextIter *start, GtkTextIter *end) ## GdkPixbuf* gtk_text_iter_get_pixbuf (const GtkTextIter *iter) GdkPixbuf_ornull* gtk_text_iter_get_pixbuf (iter) GtkTextIter *iter ## GSList * gtk_text_iter_get_marks (const GtkTextIter *iter) =for apidoc Returns a list of all Gtk2::TextMark at this location. Because marks are not iterable (they don't take up any "space" in the buffer, they are just marks in between iterable locations), multiple marks can exist in the same place. The returned list is not in any meaningful order. =cut void gtk_text_iter_get_marks (GtkTextIter *iter) PREINIT: GSList * marks, * i; PPCODE: marks = gtk_text_iter_get_marks (iter); for (i = marks ; i != NULL ; i = i->next) XPUSHs (sv_2mortal (newSVGtkTextMark (i->data))); g_slist_free (marks); ## GSList* gtk_text_iter_get_toggled_tags (const GtkTextIter *iter, gboolean toggled_on) =for apidoc Returns a list of Gtk2::TextTag that are toggled on or off at this point. (If toggled_on is TRUE, the list contains tags that are toggled on.) If a tag is toggled on at iter, then some non-empty range of characters following iter has that tag applied to it. If a tag is toggled off, then some non-empty range following iter does not have the tag applied to it. =cut void gtk_text_iter_get_toggled_tags (GtkTextIter * iter, gboolean toggled_on) PREINIT: GSList * tags, * i; PPCODE: tags = gtk_text_iter_get_toggled_tags (iter, toggled_on); for (i = tags ; i != NULL ; i = i->next) XPUSHs (sv_2mortal (newSVGtkTextTag (i->data))); g_slist_free (tags); ## GtkTextChildAnchor* gtk_text_iter_get_child_anchor (const GtkTextIter *iter) GtkTextChildAnchor_ornull* gtk_text_iter_get_child_anchor (iter) GtkTextIter *iter ## gboolean gtk_text_iter_begins_tag (const GtkTextIter *iter, GtkTextTag *tag) gboolean gtk_text_iter_begins_tag (iter, tag) GtkTextIter *iter GtkTextTag_ornull *tag ## gboolean gtk_text_iter_ends_tag (const GtkTextIter *iter, GtkTextTag *tag) gboolean gtk_text_iter_ends_tag (iter, tag) GtkTextIter *iter GtkTextTag_ornull *tag ## gboolean gtk_text_iter_toggles_tag (const GtkTextIter *iter, GtkTextTag *tag) gboolean gtk_text_iter_toggles_tag (iter, tag) GtkTextIter *iter GtkTextTag_ornull *tag ## gboolean gtk_text_iter_has_tag (const GtkTextIter *iter, GtkTextTag *tag) gboolean gtk_text_iter_has_tag (iter, tag) GtkTextIter *iter GtkTextTag *tag ### GSList* gtk_text_iter_get_tags (const GtkTextIter *iter) =for apidoc Returns a list of tags that apply to iter, in ascending order of priority (highest-priority tags are last). =cut void gtk_text_iter_get_tags (GtkTextIter *iter) PREINIT: GSList* slist, *i; PPCODE: slist = gtk_text_iter_get_tags (iter); for (i = slist ; i != NULL ; i = i->next) XPUSHs (sv_2mortal (newSVGtkTextTag (i->data))); g_slist_free (slist); ## gboolean gtk_text_iter_editable (const GtkTextIter *iter, gboolean default_setting) gboolean gtk_text_iter_editable (iter, default_setting) GtkTextIter *iter gboolean default_setting ## gboolean gtk_text_iter_can_insert (const GtkTextIter *iter, gboolean default_editability) gboolean gtk_text_iter_can_insert (iter, default_editability) GtkTextIter *iter gboolean default_editability ## gboolean gtk_text_iter_starts_word (const GtkTextIter *iter) gboolean gtk_text_iter_starts_word (iter) GtkTextIter *iter ## gboolean gtk_text_iter_ends_word (const GtkTextIter *iter) gboolean gtk_text_iter_ends_word (iter) GtkTextIter *iter ## gboolean gtk_text_iter_inside_word (const GtkTextIter *iter) gboolean gtk_text_iter_inside_word (iter) GtkTextIter *iter ## gboolean gtk_text_iter_starts_sentence (const GtkTextIter *iter) gboolean gtk_text_iter_starts_sentence (iter) GtkTextIter *iter ## gboolean gtk_text_iter_ends_sentence (const GtkTextIter *iter) gboolean gtk_text_iter_ends_sentence (iter) GtkTextIter *iter ## gboolean gtk_text_iter_inside_sentence (const GtkTextIter *iter) gboolean gtk_text_iter_inside_sentence (iter) GtkTextIter *iter ## gboolean gtk_text_iter_starts_line (const GtkTextIter *iter) gboolean gtk_text_iter_starts_line (iter) GtkTextIter *iter ## gboolean gtk_text_iter_ends_line (const GtkTextIter *iter) gboolean gtk_text_iter_ends_line (iter) GtkTextIter *iter ## gboolean gtk_text_iter_is_cursor_position (const GtkTextIter *iter) gboolean gtk_text_iter_is_cursor_position (iter) GtkTextIter *iter ## gint gtk_text_iter_get_chars_in_line (const GtkTextIter *iter) gint gtk_text_iter_get_chars_in_line (iter) GtkTextIter *iter ## gint gtk_text_iter_get_bytes_in_line (const GtkTextIter *iter) gint gtk_text_iter_get_bytes_in_line (iter) GtkTextIter *iter ### gboolean gtk_text_iter_get_attributes (const GtkTextIter *iter, GtkTextAttributes *values) GtkTextAttributes_copy* gtk_text_iter_get_attributes (GtkTextIter *iter) PREINIT: GtkTextAttributes values; CODE: if (!gtk_text_iter_get_attributes (iter, &values)) XSRETURN_UNDEF; RETVAL = &values; OUTPUT: RETVAL # i think the returned value should NOT be owned ## PangoLanguage* gtk_text_iter_get_language (const GtkTextIter *iter) PangoLanguage* gtk_text_iter_get_language (iter) GtkTextIter *iter ## gboolean gtk_text_iter_is_end (const GtkTextIter *iter) gboolean gtk_text_iter_is_end (iter) GtkTextIter *iter ## gboolean gtk_text_iter_is_start (const GtkTextIter *iter) gboolean gtk_text_iter_is_start (iter) GtkTextIter *iter ## gboolean gtk_text_iter_forward_char (GtkTextIter *iter) gboolean gtk_text_iter_forward_char (iter) GtkTextIter *iter ## gboolean gtk_text_iter_backward_char (GtkTextIter *iter) gboolean gtk_text_iter_backward_char (iter) GtkTextIter *iter ## gboolean gtk_text_iter_forward_chars (GtkTextIter *iter, gint count) gboolean gtk_text_iter_forward_chars (iter, count) GtkTextIter *iter gint count ## gboolean gtk_text_iter_backward_chars (GtkTextIter *iter, gint count) gboolean gtk_text_iter_backward_chars (iter, count) GtkTextIter *iter gint count ## gboolean gtk_text_iter_forward_line (GtkTextIter *iter) gboolean gtk_text_iter_forward_line (iter) GtkTextIter *iter ## gboolean gtk_text_iter_backward_line (GtkTextIter *iter) gboolean gtk_text_iter_backward_line (iter) GtkTextIter *iter ## gboolean gtk_text_iter_forward_lines (GtkTextIter *iter, gint count) gboolean gtk_text_iter_forward_lines (iter, count) GtkTextIter *iter gint count ## gboolean gtk_text_iter_backward_lines (GtkTextIter *iter, gint count) gboolean gtk_text_iter_backward_lines (iter, count) GtkTextIter *iter gint count ## gboolean gtk_text_iter_forward_word_end (GtkTextIter *iter) gboolean gtk_text_iter_forward_word_end (iter) GtkTextIter *iter ## gboolean gtk_text_iter_backward_word_start (GtkTextIter *iter) gboolean gtk_text_iter_backward_word_start (iter) GtkTextIter *iter ## gboolean gtk_text_iter_forward_word_ends (GtkTextIter *iter, gint count) gboolean gtk_text_iter_forward_word_ends (iter, count) GtkTextIter *iter gint count ## gboolean gtk_text_iter_backward_word_starts (GtkTextIter *iter, gint count) gboolean gtk_text_iter_backward_word_starts (iter, count) GtkTextIter *iter gint count #if GTK_CHECK_VERSION(2,4,0) gboolean gtk_text_iter_forward_visible_word_end (GtkTextIter *iter); gboolean gtk_text_iter_backward_visible_word_start (GtkTextIter *iter); gboolean gtk_text_iter_forward_visible_word_ends (GtkTextIter *iter, gint count); gboolean gtk_text_iter_backward_visible_word_starts (GtkTextIter *iter, gint count); #endif ## gboolean gtk_text_iter_forward_sentence_end (GtkTextIter *iter) gboolean gtk_text_iter_forward_sentence_end (iter) GtkTextIter *iter ## gboolean gtk_text_iter_backward_sentence_start (GtkTextIter *iter) gboolean gtk_text_iter_backward_sentence_start (iter) GtkTextIter *iter ## gboolean gtk_text_iter_forward_sentence_ends (GtkTextIter *iter, gint count) gboolean gtk_text_iter_forward_sentence_ends (iter, count) GtkTextIter *iter gint count ## gboolean gtk_text_iter_backward_sentence_starts (GtkTextIter *iter, gint count) gboolean gtk_text_iter_backward_sentence_starts (iter, count) GtkTextIter *iter gint count ## gboolean gtk_text_iter_forward_cursor_position (GtkTextIter *iter) gboolean gtk_text_iter_forward_cursor_position (iter) GtkTextIter *iter ## gboolean gtk_text_iter_backward_cursor_position (GtkTextIter *iter) gboolean gtk_text_iter_backward_cursor_position (iter) GtkTextIter *iter ## gboolean gtk_text_iter_forward_cursor_positions (GtkTextIter *iter, gint count) gboolean gtk_text_iter_forward_cursor_positions (iter, count) GtkTextIter *iter gint count ## gboolean gtk_text_iter_backward_cursor_positions (GtkTextIter *iter, gint count) gboolean gtk_text_iter_backward_cursor_positions (iter, count) GtkTextIter *iter gint count #if GTK_CHECK_VERSION(2,4,0) gboolean gtk_text_iter_forward_visible_cursor_position (GtkTextIter *iter); gboolean gtk_text_iter_backward_visible_cursor_position (GtkTextIter *iter); gboolean gtk_text_iter_forward_visible_cursor_positions (GtkTextIter *iter, gint count); gboolean gtk_text_iter_backward_visible_cursor_positions (GtkTextIter *iter, gint count); #endif ## void gtk_text_iter_set_offset (GtkTextIter *iter, gint char_offset) void gtk_text_iter_set_offset (iter, char_offset) GtkTextIter *iter gint char_offset ## void gtk_text_iter_set_line (GtkTextIter *iter, gint line_number) void gtk_text_iter_set_line (iter, line_number) GtkTextIter *iter gint line_number ## void gtk_text_iter_set_line_offset (GtkTextIter *iter, gint char_on_line) void gtk_text_iter_set_line_offset (iter, char_on_line) GtkTextIter *iter gint char_on_line ## void gtk_text_iter_set_line_index (GtkTextIter *iter, gint byte_on_line) void gtk_text_iter_set_line_index (iter, byte_on_line) GtkTextIter *iter gint byte_on_line ## void gtk_text_iter_forward_to_end (GtkTextIter *iter) void gtk_text_iter_forward_to_end (iter) GtkTextIter *iter ## gboolean gtk_text_iter_forward_to_line_end (GtkTextIter *iter) gboolean gtk_text_iter_forward_to_line_end (iter) GtkTextIter *iter ## void gtk_text_iter_set_visible_line_offset (GtkTextIter *iter, gint char_on_line) void gtk_text_iter_set_visible_line_offset (iter, char_on_line) GtkTextIter *iter gint char_on_line ## void gtk_text_iter_set_visible_line_index (GtkTextIter *iter, gint byte_on_line) void gtk_text_iter_set_visible_line_index (iter, byte_on_line) GtkTextIter *iter gint byte_on_line ## gboolean gtk_text_iter_forward_to_tag_toggle (GtkTextIter *iter, GtkTextTag *tag) gboolean gtk_text_iter_forward_to_tag_toggle (iter, tag) GtkTextIter * iter GtkTextTag_ornull * tag ## gboolean gtk_text_iter_backward_to_tag_toggle (GtkTextIter *iter, GtkTextTag *tag) gboolean gtk_text_iter_backward_to_tag_toggle (iter, tag) GtkTextIter * iter GtkTextTag_ornull * tag ## gboolean gtk_text_iter_forward_find_char (GtkTextIter *iter, GtkTextCharPredicate pred, gpointer user_data, const GtkTextIter *limit) ## gboolean gtk_text_iter_backward_find_char (GtkTextIter *iter, GtkTextCharPredicate pred, gpointer user_data, const GtkTextIter *limit) gboolean gtk_text_iter_forward_find_char (iter, pred, user_data=NULL, limit=NULL) GtkTextIter *iter SV * pred SV * user_data GtkTextIter_ornull *limit ALIAS: backward_find_char = 1 PREINIT: GPerlCallback * callback; CODE: callback = create_text_char_predicate_callback (pred, user_data); if (ix == 1) RETVAL = gtk_text_iter_backward_find_char (iter, gtk2perl_text_char_predicate, callback, limit); else RETVAL = gtk_text_iter_forward_find_char (iter, gtk2perl_text_char_predicate, callback, limit); gperl_callback_destroy (callback); OUTPUT: RETVAL ## gboolean gtk_text_iter_forward_search (const GtkTextIter *iter, const gchar *str, GtkTextSearchFlags flags, GtkTextIter *match_start, GtkTextIter *match_end, const GtkTextIter *limit) #### gboolean gtk_text_iter_backward_search (const GtkTextIter *iter, const gchar *str, GtkTextSearchFlags flags, GtkTextIter *match_start, GtkTextIter *match_end, const GtkTextIter *limit) =for apidoc backward_search =for signature (match_start, match_end) = $iter->backward_search ($str, $flags, $limit=NULL) =cut =for apidoc =for signature (match_start, match_end) = $iter->forward_search ($str, $flags, $limit=NULL) =cut void gtk_text_iter_forward_search (iter, str, flags, limit=NULL) const GtkTextIter *iter const gchar *str GtkTextSearchFlags flags GtkTextIter_ornull *limit ALIAS: backward_search = 1 PREINIT: GtkTextIter match_start; GtkTextIter match_end; gboolean (*searchfunc) (const GtkTextIter*, const gchar*, GtkTextSearchFlags, GtkTextIter*, GtkTextIter*, const GtkTextIter*); PPCODE: searchfunc = ix == 1 ? gtk_text_iter_backward_search : gtk_text_iter_forward_search; if (! searchfunc (iter, str, flags, &match_start, &match_end, limit)) XSRETURN_EMPTY; EXTEND (SP, 2); PUSHs (sv_2mortal (newSVGtkTextIter_copy (&match_start))); PUSHs (sv_2mortal (newSVGtkTextIter_copy (&match_end))); ## gboolean gtk_text_iter_equal (const GtkTextIter *lhs, const GtkTextIter *rhs) gboolean gtk_text_iter_equal (lhs, rhs) GtkTextIter *lhs GtkTextIter *rhs ## gint gtk_text_iter_compare (const GtkTextIter *lhs, const GtkTextIter *rhs) gint gtk_text_iter_compare (lhs, rhs) GtkTextIter *lhs GtkTextIter *rhs ## gboolean gtk_text_iter_in_range (const GtkTextIter *iter, const GtkTextIter *start, const GtkTextIter *end) gboolean gtk_text_iter_in_range (iter, start, end) GtkTextIter *iter GtkTextIter *start GtkTextIter *end ## void gtk_text_iter_order (GtkTextIter *first, GtkTextIter *second) void gtk_text_iter_order (first, second) GtkTextIter *first GtkTextIter *second #if GTK_CHECK_VERSION (2, 8, 0) gboolean gtk_text_iter_forward_visible_line (GtkTextIter *iter); gboolean gtk_text_iter_backward_visible_line (GtkTextIter *iter); gboolean gtk_text_iter_forward_visible_lines (GtkTextIter *iter, gint count); gboolean gtk_text_iter_backward_visible_lines (GtkTextIter *iter, gint count); #endif Gtk2-1.24992/xs/GtkOrientable.xs0000644000175000017500000000221613076462677014704 0ustar lacklack/* * Copyright (c) 2009 by the gtk2-perl team (see the file AUTHORS) * * This library is free software; you can redistribute it and/or * modify it under the terms of the GNU Library General Public * License as published by the Free Software Foundation; either * version 2.1 of the License, or (at your option) any later version. * * This library is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU * Library General Public License for more details. * * You should have received a copy of the GNU Library General Public * License along with this library; if not, write to the * Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, * Boston, MA 02110-1301 USA. */ #include "gtk2perl.h" MODULE = Gtk2::Orientable PACKAGE = Gtk2::Orientable PREFIX = gtk_orientable_ =for object Gtk2::Orientable - Interface for flippable widgets =cut GtkOrientation gtk_orientable_get_orientation (GtkOrientable *orientable); void gtk_orientable_set_orientation (GtkOrientable *orientable, GtkOrientation orientation); Gtk2-1.24992/xs/GtkVSeparator.xs0000644000175000017500000000202513076462677014704 0ustar lacklack/* * Copyright (c) 2003 by the gtk2-perl team (see the file AUTHORS) * * This library is free software; you can redistribute it and/or * modify it under the terms of the GNU Library General Public * License as published by the Free Software Foundation; either * version 2.1 of the License, or (at your option) any later version. * * This library is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU * Library General Public License for more details. * * You should have received a copy of the GNU Library General Public * License along with this library; if not, write to the * Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, * Boston, MA 02110-1301 USA. * * $Id$ */ #include "gtk2perl.h" MODULE = Gtk2::VSeparator PACKAGE = Gtk2::VSeparator PREFIX = gtk_vseparator_ ## GtkWidget* gtk_vseparator_new (void) GtkWidget * gtk_vseparator_new (class) C_ARGS: /* void */ Gtk2-1.24992/xs/GtkTextBuffer.xs0000644000175000017500000004263013076462677014702 0ustar lacklack/* * Copyright (c) 2003-2006 by the gtk2-perl team (see the file AUTHORS) * * This library is free software; you can redistribute it and/or * modify it under the terms of the GNU Library General Public * License as published by the Free Software Foundation; either * version 2.1 of the License, or (at your option) any later version. * * This library is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU * Library General Public License for more details. * * You should have received a copy of the GNU Library General Public * License along with this library; if not, write to the * Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, * Boston, MA 02110-1301 USA. * * $Id$ */ #include "gtk2perl.h" /* is a GObject */ MODULE = Gtk2::TextBuffer PACKAGE = Gtk2::TextBuffer PREFIX = gtk_text_buffer_ GtkTextBuffer_noinc* gtk_text_buffer_new (class, tagtable=NULL) GtkTextTagTable_ornull * tagtable C_ARGS: tagtable gint gtk_text_buffer_get_line_count (buffer) GtkTextBuffer *buffer gint gtk_text_buffer_get_char_count (buffer) GtkTextBuffer *buffer GtkTextTagTable* gtk_text_buffer_get_tag_table (buffer) GtkTextBuffer *buffer void gtk_text_buffer_insert (GtkTextBuffer * buffer, GtkTextIter * iter, const gchar_length * text, int length(text)) void gtk_text_buffer_insert_at_cursor (GtkTextBuffer *buffer, const gchar_length *text, int length(text)) gboolean gtk_text_buffer_insert_interactive (GtkTextBuffer *buffer, GtkTextIter *iter, const gchar_length *text, int length(text), gboolean default_editable) gboolean gtk_text_buffer_insert_interactive_at_cursor (GtkTextBuffer *buffer, const gchar_length *text, int length(text), gboolean default_editable) ## void gtk_text_buffer_insert_range (GtkTextBuffer *buffer, GtkTextIter *iter, const GtkTextIter *start, const GtkTextIter *end) void gtk_text_buffer_insert_range (buffer, iter, start, end) GtkTextBuffer *buffer GtkTextIter *iter GtkTextIter *start GtkTextIter *end ## gboolean gtk_text_buffer_insert_range_interactive (GtkTextBuffer *buffer, GtkTextIter *iter, const GtkTextIter *start, const GtkTextIter *end, gboolean default_editable) gboolean gtk_text_buffer_insert_range_interactive (buffer, iter, start, end, default_editable) GtkTextBuffer *buffer GtkTextIter *iter GtkTextIter *start GtkTextIter *end gboolean default_editable #### void gtk_text_buffer_insert_with_tags (GtkTextBuffer *buffer, GtkTextIter *iter, const gchar *text, gint len, GtkTextTag *first_tag, ...) =for apidoc =for arg ... of Gtk2::TextTag's =cut void gtk_text_buffer_insert_with_tags (buffer, iter, text, ...) GtkTextBuffer *buffer GtkTextIter *iter const gchar *text PREINIT: int i; gint start_offset; GtkTextIter start; CODE: start_offset = gtk_text_iter_get_offset (iter); gtk_text_buffer_insert (buffer, iter, text, -1); gtk_text_buffer_get_iter_at_offset (buffer, &start, start_offset); for (i = 3 ; i < items ; i++) { gtk_text_buffer_apply_tag (buffer, SvGtkTextTag (ST (i)), &start, iter); } ## void gtk_text_buffer_insert_with_tags_by_name (GtkTextBuffer *buffer, GtkTextIter *iter, const gchar *text, gint len, const gchar *first_tag_name, ...) =for apidoc =for arg ... of strings, tag names =cut void gtk_text_buffer_insert_with_tags_by_name (buffer, iter, text, ...) GtkTextBuffer *buffer GtkTextIter *iter const gchar *text PREINIT: int i; gint start_offset; GtkTextTagTable * tag_table; GtkTextIter start; CODE: start_offset = gtk_text_iter_get_offset (iter); gtk_text_buffer_insert (buffer, iter, text, -1); tag_table = gtk_text_buffer_get_tag_table (buffer); gtk_text_buffer_get_iter_at_offset (buffer, &start, start_offset); for (i = 3 ; i < items ; i++) { char * tag_name; GtkTextTag * tag; tag_name = SvGChar (ST (i)); tag = gtk_text_tag_table_lookup (tag_table, tag_name); if (!tag) warn ("no tag with name %s", tag_name); else gtk_text_buffer_apply_tag (buffer, tag, &start, iter); } ## void gtk_text_buffer_delete (GtkTextBuffer *buffer, GtkTextIter *start, GtkTextIter *end) void gtk_text_buffer_delete (buffer, start, end) GtkTextBuffer *buffer GtkTextIter *start GtkTextIter *end ## gboolean gtk_text_buffer_delete_interactive (GtkTextBuffer *buffer, GtkTextIter *start_iter, GtkTextIter *end_iter, gboolean default_editable) gboolean gtk_text_buffer_delete_interactive (buffer, start_iter, end_iter, default_editable) GtkTextBuffer *buffer GtkTextIter *start_iter GtkTextIter *end_iter gboolean default_editable void gtk_text_buffer_set_text (GtkTextBuffer *buffer, const gchar_length *text, int length(text)) gchar_own * gtk_text_buffer_get_text (GtkTextBuffer *buffer, GtkTextIter * start, GtkTextIter* end, gboolean include_hidden_chars) gchar_own * gtk_text_buffer_get_slice (GtkTextBuffer *buffer, GtkTextIter *start, GtkTextIter *end, gboolean include_hidden_chars); ## void gtk_text_buffer_insert_pixbuf (GtkTextBuffer *buffer, GtkTextIter *iter, GdkPixbuf *pixbuf) void gtk_text_buffer_insert_pixbuf (buffer, iter, pixbuf) GtkTextBuffer *buffer GtkTextIter *iter GdkPixbuf *pixbuf ## void gtk_text_buffer_insert_child_anchor (GtkTextBuffer *buffer, GtkTextIter *iter, GtkTextChildAnchor *anchor) void gtk_text_buffer_insert_child_anchor (buffer, iter, anchor) GtkTextBuffer *buffer GtkTextIter *iter GtkTextChildAnchor *anchor GtkTextMark* gtk_text_buffer_create_mark (GtkTextBuffer *buffer, const gchar_ornull *mark_name, GtkTextIter *where, gboolean left_gravity); ## void gtk_text_buffer_move_mark (GtkTextBuffer *buffer, GtkTextMark *mark, const GtkTextIter *where) void gtk_text_buffer_move_mark (buffer, mark, where) GtkTextBuffer *buffer GtkTextMark *mark GtkTextIter *where ## void gtk_text_buffer_delete_mark (GtkTextBuffer *buffer, GtkTextMark *mark) void gtk_text_buffer_delete_mark (buffer, mark) GtkTextBuffer *buffer GtkTextMark *mark ## GtkTextMark* gtk_text_buffer_get_mark (GtkTextBuffer *buffer, const gchar *name) GtkTextMark_ornull* gtk_text_buffer_get_mark (buffer, name) GtkTextBuffer *buffer const gchar *name ## void gtk_text_buffer_move_mark_by_name (GtkTextBuffer *buffer, const gchar *name, const GtkTextIter *where) void gtk_text_buffer_move_mark_by_name (buffer, name, where) GtkTextBuffer *buffer const gchar *name GtkTextIter *where ## void gtk_text_buffer_delete_mark_by_name (GtkTextBuffer *buffer, const gchar *name) void gtk_text_buffer_delete_mark_by_name (buffer, name) GtkTextBuffer *buffer const gchar *name ## GtkTextMark* gtk_text_buffer_get_insert (GtkTextBuffer *buffer) GtkTextMark* gtk_text_buffer_get_insert (buffer) GtkTextBuffer *buffer ## GtkTextMark* gtk_text_buffer_get_selection_bound (GtkTextBuffer *buffer) GtkTextMark* gtk_text_buffer_get_selection_bound (buffer) GtkTextBuffer *buffer ## void gtk_text_buffer_place_cursor (GtkTextBuffer *buffer, const GtkTextIter *where) void gtk_text_buffer_place_cursor (buffer, where) GtkTextBuffer *buffer GtkTextIter *where #if GTK_CHECK_VERSION(2,4,0) ## void gtk_text_buffer_select_range (GtkTextBuffer *buffer, const GtkTextIter *ins, const GtkTextIter *bound); void gtk_text_buffer_select_range (GtkTextBuffer *buffer, GtkTextIter *ins, GtkTextIter *bound); #endif ## void gtk_text_buffer_apply_tag (GtkTextBuffer *buffer, GtkTextTag *tag, const GtkTextIter *start, const GtkTextIter *end) void gtk_text_buffer_apply_tag (buffer, tag, start, end) GtkTextBuffer *buffer GtkTextTag *tag GtkTextIter *start GtkTextIter *end ## void gtk_text_buffer_remove_tag (GtkTextBuffer *buffer, GtkTextTag *tag, const GtkTextIter *start, const GtkTextIter *end) void gtk_text_buffer_remove_tag (buffer, tag, start, end) GtkTextBuffer *buffer GtkTextTag *tag GtkTextIter *start GtkTextIter *end ## void gtk_text_buffer_apply_tag_by_name (GtkTextBuffer *buffer, const gchar *name, const GtkTextIter *start, const GtkTextIter *end) void gtk_text_buffer_apply_tag_by_name (buffer, name, start, end) GtkTextBuffer *buffer const gchar *name GtkTextIter *start GtkTextIter *end ## void gtk_text_buffer_remove_tag_by_name (GtkTextBuffer *buffer, const gchar *name, const GtkTextIter *start, const GtkTextIter *end) void gtk_text_buffer_remove_tag_by_name (buffer, name, start, end) GtkTextBuffer *buffer const gchar *name GtkTextIter *start GtkTextIter *end ## void gtk_text_buffer_remove_all_tags (GtkTextBuffer *buffer, const GtkTextIter *start, const GtkTextIter *end) void gtk_text_buffer_remove_all_tags (buffer, start, end) GtkTextBuffer *buffer GtkTextIter *start GtkTextIter *end ##GtkTextTag* gtk_text_buffer_create_tag (GtkTextBuffer *buffer, ## const gchar *tag_name, ## const gchar *first_property_name, ## ...); ## tag_name may be NULL. ## The returned tag is owned by the buffer's tag table! do not use _noinc! =for apidoc =for arg property_name1 (string) the first property name =for arg property_value1 (string) the first property value =for arg ... pairs of names and values =cut GtkTextTag * gtk_text_buffer_create_tag (buffer, tag_name, property_name1, property_value1, ...) GtkTextBuffer * buffer const gchar_ornull * tag_name PREINIT: GtkTextTagTable * tag_table; int i; CODE: if ((items - 2) % 2) croak ("expecting tag name followed by name=>value pairs"); /* * since we can't really pass on the varargs call from perl to C, * we'll have to reimplement this convenience function ourselves. */ RETVAL = gtk_text_tag_new (tag_name); tag_table = gtk_text_buffer_get_tag_table (buffer); gtk_text_tag_table_add (tag_table, RETVAL); g_object_unref (RETVAL); /* the tag table owns the object now */ for (i = 2 ; i < items ; i+= 2) { GValue gvalue = {0, }; GParamSpec * pspec; const gchar * propname = SvGChar (ST (i)); pspec = g_object_class_find_property (G_OBJECT_GET_CLASS (RETVAL), propname); if (!pspec) warn (" unknown property %s for class %s", propname, G_OBJECT_TYPE_NAME (RETVAL)); else { g_value_init (&gvalue, pspec->value_type); gperl_value_from_sv (&gvalue, ST (i+1)); g_object_set_property (G_OBJECT (RETVAL), propname, &gvalue); g_value_unset (&gvalue); } } OUTPUT: RETVAL #### void gtk_text_buffer_get_iter_at_line_offset (GtkTextBuffer *buffer, GtkTextIter *iter, gint line_number, gint char_offset) GtkTextIter_copy * gtk_text_buffer_get_iter_at_line_offset (buffer, line_number, char_offset) GtkTextBuffer *buffer gint line_number gint char_offset PREINIT: GtkTextIter iter; CODE: gtk_text_buffer_get_iter_at_line_offset (buffer, &iter, line_number, char_offset); RETVAL = &iter; OUTPUT: RETVAL #### void gtk_text_buffer_get_iter_at_line_index (GtkTextBuffer *buffer, GtkTextIter *iter, gint line_number, gint byte_index) GtkTextIter_copy * gtk_text_buffer_get_iter_at_line_index (buffer, line_number, byte_index) GtkTextBuffer *buffer gint line_number gint byte_index PREINIT: GtkTextIter iter; CODE: gtk_text_buffer_get_iter_at_line_index (buffer, &iter, line_number, byte_index); RETVAL = &iter; OUTPUT: RETVAL #### void gtk_text_buffer_get_iter_at_offset (GtkTextBuffer *buffer, GtkTextIter *iter, gint char_offset) GtkTextIter_copy * gtk_text_buffer_get_iter_at_offset (buffer, char_offset) GtkTextBuffer *buffer gint char_offset PREINIT: GtkTextIter iter; CODE: gtk_text_buffer_get_iter_at_offset (buffer, &iter, char_offset); RETVAL = &iter; OUTPUT: RETVAL #### void gtk_text_buffer_get_iter_at_line (GtkTextBuffer *buffer, GtkTextIter *iter, gint line_number) GtkTextIter_copy * gtk_text_buffer_get_iter_at_line (buffer, line_number) GtkTextBuffer *buffer gint line_number PREINIT: GtkTextIter iter; CODE: gtk_text_buffer_get_iter_at_line (buffer, &iter, line_number); RETVAL = &iter; OUTPUT: RETVAL #### void gtk_text_buffer_get_start_iter (GtkTextBuffer *buffer, GtkTextIter *iter) #### void gtk_text_buffer_get_end_iter (GtkTextBuffer *buffer, GtkTextIter *iter) GtkTextIter_copy * gtk_text_buffer_get_start_iter (buffer) GtkTextBuffer *buffer ALIAS: Gtk2::TextBuffer::get_end_iter = 1 PREINIT: GtkTextIter iter; CODE: if (ix == 1) gtk_text_buffer_get_end_iter (buffer, &iter); else gtk_text_buffer_get_start_iter (buffer, &iter); RETVAL = &iter; OUTPUT: RETVAL #### void gtk_text_buffer_get_bounds (GtkTextBuffer *buffer, GtkTextIter *start, GtkTextIter *end) =for apidoc =for signature (start, end) = $buffer->get_bounds Retrieves the first and last iterators in the buffer, i.e. the entire buffer lies within the range (start,end). =cut void gtk_text_buffer_get_bounds (buffer) GtkTextBuffer *buffer PREINIT: GtkTextIter start = {0, }; GtkTextIter end = {0, }; PPCODE: gtk_text_buffer_get_bounds (buffer, &start, &end); EXTEND (SP, 2); PUSHs (sv_2mortal (newSVGtkTextIter_copy (&start))); PUSHs (sv_2mortal (newSVGtkTextIter_copy (&end))); #### void gtk_text_buffer_get_iter_at_mark (GtkTextBuffer *buffer, GtkTextIter *iter, GtkTextMark *mark) GtkTextIter_copy * gtk_text_buffer_get_iter_at_mark (buffer, mark) GtkTextBuffer * buffer GtkTextMark * mark PREINIT: GtkTextIter iter; CODE: gtk_text_buffer_get_iter_at_mark (buffer, &iter, mark); RETVAL = &iter; OUTPUT: RETVAL #### void gtk_text_buffer_get_iter_at_child_anchor (GtkTextBuffer *buffer, GtkTextIter *iter, GtkTextChildAnchor *anchor) GtkTextIter_copy * gtk_text_buffer_get_iter_at_child_anchor (buffer, anchor) GtkTextBuffer * buffer GtkTextChildAnchor * anchor PREINIT: GtkTextIter iter; CODE: gtk_text_buffer_get_iter_at_child_anchor (buffer, &iter, anchor); RETVAL = &iter; OUTPUT: RETVAL ## gboolean gtk_text_buffer_get_modified (GtkTextBuffer *buffer) gboolean gtk_text_buffer_get_modified (buffer) GtkTextBuffer *buffer ## void gtk_text_buffer_set_modified (GtkTextBuffer *buffer, gboolean setting) void gtk_text_buffer_set_modified (buffer, setting) GtkTextBuffer *buffer gboolean setting #if GTK_CHECK_VERSION(2,2,0) ## void gtk_text_buffer_add_selection_clipboard (GtkTextBuffer *buffer, GtkClipboard *clipboard) void gtk_text_buffer_add_selection_clipboard (buffer, clipboard) GtkTextBuffer *buffer GtkClipboard *clipboard ## void gtk_text_buffer_remove_selection_clipboard (GtkTextBuffer *buffer, GtkClipboard *clipboard) void gtk_text_buffer_remove_selection_clipboard (buffer, clipboard) GtkTextBuffer *buffer GtkClipboard *clipboard ## void gtk_text_buffer_cut_clipboard (GtkTextBuffer *buffer, GtkClipboard *clipboard, gboolean default_editable) void gtk_text_buffer_cut_clipboard (buffer, clipboard, default_editable) GtkTextBuffer *buffer GtkClipboard *clipboard gboolean default_editable ## void gtk_text_buffer_copy_clipboard (GtkTextBuffer *buffer, GtkClipboard *clipboard) void gtk_text_buffer_copy_clipboard (buffer, clipboard) GtkTextBuffer *buffer GtkClipboard *clipboard ## void gtk_text_buffer_paste_clipboard (GtkTextBuffer *buffer, GtkClipboard *clipboard, GtkTextIter *override_location, gboolean default_editable) void gtk_text_buffer_paste_clipboard (buffer, clipboard, override_location, default_editable) GtkTextBuffer *buffer GtkClipboard *clipboard GtkTextIter_ornull *override_location gboolean default_editable #endif /* defined GTK_TYPE_CLIPBOARD */ ## gboolean gtk_text_buffer_get_selection_bounds (GtkTextBuffer *buffer, GtkTextIter *start, GtkTextIter *end) ## returns empty list if there is no selection =for apidoc =for signature (start, end) = $buffer->get_selection_bounds Returns start and end if some text is selected, empty otherwise; places the bounds of the selection in start and end (if the selection has length 0, then start and end are filled in with the same value). start and end will be in ascending order. =cut void gtk_text_buffer_get_selection_bounds (buffer) GtkTextBuffer *buffer PREINIT: GtkTextIter start; GtkTextIter end; PPCODE: if (!gtk_text_buffer_get_selection_bounds (buffer, &start, &end)) XSRETURN_EMPTY; EXTEND (SP, 2); PUSHs (sv_2mortal (newSVGtkTextIter_copy (&start))); PUSHs (sv_2mortal (newSVGtkTextIter_copy (&end))); ## gboolean gtk_text_buffer_delete_selection (GtkTextBuffer *buffer, gboolean interactive, gboolean default_editable) gboolean gtk_text_buffer_delete_selection (buffer, interactive, default_editable) GtkTextBuffer *buffer gboolean interactive gboolean default_editable ## void gtk_text_buffer_begin_user_action (GtkTextBuffer *buffer) void gtk_text_buffer_begin_user_action (buffer) GtkTextBuffer *buffer ## void gtk_text_buffer_end_user_action (GtkTextBuffer *buffer) void gtk_text_buffer_end_user_action (buffer) GtkTextBuffer *buffer ##GtkTextChildAnchor * gtk_text_buffer_create_child_anchor (GtkTextBuffer *buffer, GtkTextIter *iter) GtkTextChildAnchor * gtk_text_buffer_create_child_anchor (buffer, iter) GtkTextBuffer * buffer GtkTextIter * iter #if GTK_CHECK_VERSION (2, 6, 0) gboolean gtk_text_buffer_backspace (GtkTextBuffer *buffer, GtkTextIter *iter, gboolean interactive, gboolean default_editable); #endif #if GTK_CHECK_VERSION (2, 10, 0) gboolean gtk_text_buffer_get_has_selection (GtkTextBuffer *buffer); GtkTargetList* gtk_text_buffer_get_copy_target_list (GtkTextBuffer *buffer); GtkTargetList* gtk_text_buffer_get_paste_target_list (GtkTextBuffer *buffer); #endif /* 2.10 */ #if GTK_CHECK_VERSION (2, 12, 0) void gtk_text_buffer_add_mark (GtkTextBuffer *buffer, GtkTextMark *mark, GtkTextIter *where); #endif Gtk2-1.24992/xs/GdkCairo.xs0000644000175000017500000001037713076462677013644 0ustar lacklack/* * Copyright (c) 2005, 2011 by the gtk2-perl team (see the file AUTHORS) * * Licensed under the LGPL, see LICENSE file for more information. * * $Id$ */ #include "gtk2perl.h" #include MODULE = Gtk2::Gdk::Cairo PACKAGE = Gtk2::Gdk::Cairo::Context PREFIX = gdk_cairo_ =for position SYNOPSIS =head1 HIERARCHY Cairo::Context +---- Gtk2::Gdk::Cairo::Context (Perl subclass) =head1 DESCRIPTION This is some inter-operation between Cairo (see L) and Gdk things. A C lets Cairo draw on a Gdk drawable (window or pixmap). It's a Perl-level subclass of C and the various functions below can be used as methods on it. The methods can also be used on other C as plain functions. For example C can setup to draw from a C to any Cairo context, my $cr = Cairo::Context->create ($surface); Gtk2::Gdk::Cairo::Context::set_source_pixbuf ($cr, $pixbuf, $x,$y); $cr->paint; =cut BOOT: gperl_set_isa ("Gtk2::Gdk::Cairo::Context", "Cairo::Context"); # cairo_t *gdk_cairo_create (GdkDrawable *drawable); =for signature gdkcr = Gtk2::Gdk::Cairo::Context->create ($drawable) =cut SV * gdk_cairo_create (class, GdkDrawable *drawable) PREINIT: cairo_t *cr; CODE: /* We own cr. */ cr = gdk_cairo_create (drawable); RETVAL = newSV (0); sv_setref_pv (RETVAL, "Gtk2::Gdk::Cairo::Context", (void *) cr); OUTPUT: RETVAL =for signature $gdkcr->set_source_color ($color) =for signature Gtk2::Gdk::Cairo::Context::set_source_color ($anycr, $color) =cut void gdk_cairo_set_source_color (cairo_t *cr, GdkColor *color); =for signature $gdkcr->set_source_pixbuf ($pixbuf, $pixbuf_x, $pixbuf_y) =for signature Gtk2::Gdk::Cairo::Context::set_source_pixbuf ($anycr, $pixbuf, $pixbuf_x, $pixbuf_y) =cut void gdk_cairo_set_source_pixbuf (cairo_t *cr, GdkPixbuf *pixbuf, double pixbuf_x, double pixbuf_y); # void gdk_cairo_rectangle (cairo_t *cr, GdkRectangle *rectangle); =for apidoc =for signature $gdkcr->rectangle ($rectangle) =for signature $gdkcr->rectangle ($x, $y, $width, $height) =for signature Gtk2::Gdk::Cairo::Context::rectangle ($anycr, $rectangle) =for arg rectangle (Gtk2::Gdk::Rectangle) =for arg cr (__hide__) =for arg ... (__hide__) The 4-argument x,y,width,height is the base L style. This extends to also take a C. =cut void gdk_cairo_rectangle (cairo_t *cr, ...) CODE: if (items == 2) { GdkRectangle *rect = SvGdkRectangle (ST (1)); gdk_cairo_rectangle (cr, rect); } else if (items == 5) { double x = SvNV (ST(1)); double y = SvNV (ST(2)); double width = SvNV (ST(3)); double height = SvNV (ST(4)); cairo_rectangle (cr, x, y, width, height); } else { croak ("Usage: Gtk2::Gdk::Cairo::Context::rectangle (cr, rectangle)"); } =for signature $gdkcr->region ($region) =for signature Gtk2::Gdk::Cairo::Context::region ($anycr, $region) =cut void gdk_cairo_region (cairo_t *cr, GdkRegion *region); #if GTK_CHECK_VERSION (2, 10, 0) =for signature $gdkcr->set_source_pixmap ($pixmap, $pixmap_x, $pixmap_y) =for signature Gtk2::Gdk::Cairo::Context::set_source_pixmap ($anycr, $pixmap, $pixmap_x, $pixmap_y) =cut void gdk_cairo_set_source_pixmap (cairo_t *cr, GdkPixmap *pixmap, double pixmap_x, double pixmap_y); #endif #if GTK_CHECK_VERSION (2, 18, 0) =for signature $gdkcr->reset_clip ($drawable) =for signature Gtk2::Gdk::Cairo::Context::reset_clip ($anycr, $drawable) =cut void gdk_cairo_reset_clip (cairo_t *cr, GdkDrawable *drawable); #endif # ---------------------------------------------------------------------------- # #if GTK_CHECK_VERSION (2, 10, 0) MODULE = Gtk2::Gdk::Cairo PACKAGE = Gtk2::Gdk::Screen PREFIX = gdk_screen_ const cairo_font_options_t_ornull* gdk_screen_get_font_options (GdkScreen *screen); void gdk_screen_set_font_options (GdkScreen *screen, const cairo_font_options_t_ornull *options); #endif # ---------------------------------------------------------------------------- # MODULE = Gtk2::Gdk::Cairo PACKAGE = Gtk2::Gdk::Window PREFIX = gdk_window_ #if GTK_CHECK_VERSION (2, 22, 0) cairo_surface_t * gdk_window_create_similar_surface (GdkWindow *window, cairo_content_t content, int width, int height); cairo_pattern_t * gdk_window_get_background_pattern (GdkWindow *window); #endif Gtk2-1.24992/xs/GtkScale.xs0000644000175000017500000000454213076462677013653 0ustar lacklack/* * Copyright (c) 2003 by the gtk2-perl team (see the file AUTHORS) * * This library is free software; you can redistribute it and/or * modify it under the terms of the GNU Library General Public * License as published by the Free Software Foundation; either * version 2.1 of the License, or (at your option) any later version. * * This library is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU * Library General Public License for more details. * * You should have received a copy of the GNU Library General Public * License along with this library; if not, write to the * Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, * Boston, MA 02110-1301 USA. * * $Id$ */ #include "gtk2perl.h" MODULE = Gtk2::Scale PACKAGE = Gtk2::Scale PREFIX = gtk_scale_ ## void gtk_scale_set_digits (GtkScale *scale, gint digits) void gtk_scale_set_digits (scale, digits) GtkScale * scale gint digits ## gint gtk_scale_get_digits (GtkScale *scale) gint gtk_scale_get_digits (scale) GtkScale * scale ## void gtk_scale_set_draw_value (GtkScale *scale, gboolean draw_value) void gtk_scale_set_draw_value (scale, draw_value) GtkScale * scale gboolean draw_value ## gboolean gtk_scale_get_draw_value (GtkScale *scale) gboolean gtk_scale_get_draw_value (scale) GtkScale * scale ## void gtk_scale_set_value_pos (GtkScale *scale, GtkPositionType pos) void gtk_scale_set_value_pos (scale, pos) GtkScale * scale GtkPositionType pos ## GtkPositionType gtk_scale_get_value_pos (GtkScale *scale) GtkPositionType gtk_scale_get_value_pos (scale) GtkScale * scale ## void _gtk_scale_get_value_size (GtkScale *scale, gint *width, gint *height) #if GTK_CHECK_VERSION (2, 4, 0) ## PangoLayout* gtk_scale_get_layout (GtkScale *scale) PangoLayout * gtk_scale_get_layout (scale) GtkScale *scale void gtk_scale_get_layout_offsets (GtkScale *scale, OUTLIST gint x, OUTLIST gint y) #endif #if GTK_CHECK_VERSION (2, 16, 0) ## void gtk_scale_add_mark (GtkScale *scale, gdouble value, GtkPositionType position, const gchar *markup) void gtk_scale_add_mark (scale, value, position, markup) GtkScale *scale gdouble value GtkPositionType position const gchar_ornull *markup void gtk_scale_clear_marks (GtkScale *scale) #endif Gtk2-1.24992/xs/GtkTable.xs0000644000175000017500000001017213076462677013647 0ustar lacklack/* * Copyright (c) 2003 by the gtk2-perl team (see the file AUTHORS) * * This library is free software; you can redistribute it and/or * modify it under the terms of the GNU Library General Public * License as published by the Free Software Foundation; either * version 2.1 of the License, or (at your option) any later version. * * This library is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU * Library General Public License for more details. * * You should have received a copy of the GNU Library General Public * License along with this library; if not, write to the * Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, * Boston, MA 02110-1301 USA. * * $Id$ */ #include "gtk2perl.h" /* #define GTK_TYPE_TABLE (gtk_table_get_type ()) #define GTK_TABLE(obj) (GTK_CHECK_CAST ((obj), GTK_TYPE_TABLE, GtkTable)) #define GTK_TABLE_CLASS(klass) (GTK_CHECK_CLASS_CAST ((klass), GTK_TYPE_TABLE, GtkTableClass)) #define GTK_IS_TABLE(obj) (GTK_CHECK_TYPE ((obj), GTK_TYPE_TABLE)) #define GTK_IS_TABLE_CLASS(klass) (GTK_CHECK_CLASS_TYPE ((klass), GTK_TYPE_TABLE)) #define GTK_TABLE_GET_CLASS(obj) (GTK_CHECK_GET_CLASS ((obj), GTK_TYPE_TABLE, GtkTableClass)) typedef struct _GtkTable GtkTable; typedef struct _GtkTableClass GtkTableClass; typedef struct _GtkTableChild GtkTableChild; typedef struct _GtkTableRowCol GtkTableRowCol; struct _GtkTable { GtkContainer container; GList *children; GtkTableRowCol *rows; GtkTableRowCol *cols; guint16 nrows; guint16 ncols; guint16 column_spacing; guint16 row_spacing; guint homogeneous : 1; }; struct _GtkTableClass { GtkContainerClass parent_class; }; struct _GtkTableChild { GtkWidget *widget; guint16 left_attach; guint16 right_attach; guint16 top_attach; guint16 bottom_attach; guint16 xpadding; guint16 ypadding; guint xexpand : 1; guint yexpand : 1; guint xshrink : 1; guint yshrink : 1; guint xfill : 1; guint yfill : 1; }; struct _GtkTableRowCol { guint16 requisition; guint16 allocation; guint16 spacing; guint need_expand : 1; guint need_shrink : 1; guint expand : 1; guint shrink : 1; guint empty : 1; }; */ MODULE = Gtk2::Table PACKAGE = Gtk2::Table PREFIX = gtk_table_ GtkWidget * gtk_table_new (class, rows, columns, homogeneous=FALSE) guint rows guint columns gboolean homogeneous C_ARGS: rows, columns, homogeneous void gtk_table_resize (table, rows, columns) GtkTable * table guint rows guint columns void gtk_table_attach (table, child, left_attach, right_attach, top_attach, bottom_attach, xoptions, yoptions, xpadding, ypadding) GtkTable *table GtkWidget *child guint left_attach guint right_attach guint top_attach guint bottom_attach GtkAttachOptions xoptions GtkAttachOptions yoptions guint xpadding guint ypadding void gtk_table_attach_defaults (table, widget, left_attach, right_attach, top_attach, bottom_attach) GtkTable *table GtkWidget *widget guint left_attach guint right_attach guint top_attach guint bottom_attach void gtk_table_set_row_spacing (table, row, spacing) GtkTable * table guint row guint spacing guint gtk_table_get_row_spacing (table, row) GtkTable * table guint row void gtk_table_set_col_spacing (table, column, spacing) GtkTable *table guint column guint spacing guint gtk_table_get_col_spacing (table, column) GtkTable *table guint column void gtk_table_set_row_spacings (table, spacing) GtkTable *table guint spacing guint gtk_table_get_default_row_spacing (table) GtkTable *table void gtk_table_set_col_spacings (table, spacing) GtkTable * table guint spacing guint gtk_table_get_default_col_spacing (table) GtkTable * table void gtk_table_set_homogeneous (table, homogeneous) GtkTable * table gboolean homogeneous gboolean gtk_table_get_homogeneous (table) GtkTable * table #if GTK_CHECK_VERSION (2, 22, 0) void gtk_table_get_size (GtkTable *table, OUTLIST guint rows, OUTLIST guint columns); #endif /* 2.22 */ Gtk2-1.24992/xs/GtkStyle.xs0000644000175000017500000005115513076462677013726 0ustar lacklack/* * Copyright (c) 2003-2009 by the gtk2-perl team (see the file AUTHORS) * * This library is free software; you can redistribute it and/or * modify it under the terms of the GNU Library General Public * License as published by the Free Software Foundation; either * version 2.1 of the License, or (at your option) any later version. * * This library is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU * Library General Public License for more details. * * You should have received a copy of the GNU Library General Public * License along with this library; if not, write to the * Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, * Boston, MA 02110-1301 USA. * * $Id$ */ #include "gtk2perl.h" MODULE = Gtk2::Style PACKAGE = Gtk2::Style PREFIX = gtk_style_ BOOT: /* theme engines can provide subclasses on GtkStyle which may have * any name they like, and will not be registered with the gperl * bindings type subsystem. any time a user has the theme set to * anything other than the default, one of these unregistered * styles comes through. set this to keep gperl_get_object from * spewing harmless and unavoidable warnings all over stderr. */ gperl_object_set_no_warn_unreg_subclass (GTK_TYPE_STYLE, TRUE); SV * black (style) GtkStyle * style ALIAS: Gtk2::Style::white = 1 Gtk2::Style::font_desc = 2 Gtk2::Style::xthickness = 3 Gtk2::Style::ythickness = 4 Gtk2::Style::black_gc = 5 Gtk2::Style::white_gc = 6 CODE: switch (ix) { case 0: RETVAL = newSVGdkColor (&(style->black)); break; case 1: RETVAL = newSVGdkColor (&(style->white)); break; case 2: RETVAL = newSVPangoFontDescription_copy (style->font_desc); break; case 3: RETVAL = newSViv (style->xthickness); break; case 4: RETVAL = newSViv (style->ythickness); break; case 5: RETVAL = newSVGdkGC (style->black_gc); break; case 6: RETVAL = newSVGdkGC (style->white_gc); break; default: RETVAL = NULL; g_assert_not_reached (); } OUTPUT: RETVAL GdkColor * fg (style, state) GtkStyle * style GtkStateType state ALIAS: Gtk2::Style::bg = 1 Gtk2::Style::light = 2 Gtk2::Style::dark = 3 Gtk2::Style::mid = 4 Gtk2::Style::text = 5 Gtk2::Style::base = 6 Gtk2::Style::text_aa = 7 CODE: switch (ix) { case 0: RETVAL = &(style->fg[state]); break; case 1: RETVAL = &(style->bg[state]); break; case 2: RETVAL = &(style->light[state]); break; case 3: RETVAL = &(style->dark[state]); break; case 4: RETVAL = &(style->mid[state]); break; case 5: RETVAL = &(style->text[state]); break; case 6: RETVAL = &(style->base[state]); break; case 7: RETVAL = &(style->text_aa[state]); break; default: RETVAL = NULL; g_assert_not_reached (); } OUTPUT: RETVAL # legitimate reference, not a copy GdkGC * fg_gc (style, state) GtkStyle * style GtkStateType state ALIAS: Gtk2::Style::bg_gc = 1 Gtk2::Style::light_gc = 2 Gtk2::Style::dark_gc = 3 Gtk2::Style::mid_gc = 4 Gtk2::Style::text_gc = 5 Gtk2::Style::base_gc = 6 Gtk2::Style::text_aa_gc = 7 CODE: switch (ix) { case 0: RETVAL = style->fg_gc[state]; break; case 1: RETVAL = style->bg_gc[state]; break; case 2: RETVAL = style->light_gc[state]; break; case 3: RETVAL = style->dark_gc[state]; break; case 4: RETVAL = style->mid_gc[state]; break; case 5: RETVAL = style->text_gc[state]; break; case 6: RETVAL = style->base_gc[state]; break; case 7: RETVAL = style->text_aa_gc[state]; break; default: RETVAL = NULL; g_assert_not_reached (); } OUTPUT: RETVAL # legitimate reference, not a copy GdkPixmap * bg_pixmap (style, state, pixmap=NULL) GtkStyle * style GtkStateType state GdkPixmap_ornull * pixmap CODE: RETVAL = style->bg_pixmap[state]; if (items > 2 && style->bg_pixmap[state] != pixmap) { if (style->bg_pixmap[state]) g_object_unref (style->bg_pixmap[state]); style->bg_pixmap[state] = pixmap; if (pixmap) g_object_ref (pixmap); } OUTPUT: RETVAL ## GtkStyle* gtk_style_new (void) GtkStyle_noinc* gtk_style_new (class) C_ARGS: /* void */ ## GtkStyle* gtk_style_copy (GtkStyle *style) GtkStyle_noinc* gtk_style_copy (style) GtkStyle *style gboolean gtk_style_attached (style) GtkStyle *style CODE: RETVAL = GTK_STYLE_ATTACHED (style); OUTPUT: RETVAL ## GtkStyle* gtk_style_attach (GtkStyle *style, GdkWindow *window) GtkStyle * gtk_style_attach (style, window) GtkStyle *style GdkWindow *window CLEANUP: if (RETVAL != style) /* claim ownership of new object */ g_object_unref (RETVAL); ## void gtk_style_detach (GtkStyle *style) void gtk_style_detach (style) GtkStyle *style # deprecated ## GtkStyle* gtk_style_ref (GtkStyle *style) ## void gtk_style_unref (GtkStyle *style) ## void gtk_style_set_background (GtkStyle *style, GdkWindow *window, GtkStateType state_type) void gtk_style_set_background (style, window, state_type) GtkStyle *style GdkWindow *window GtkStateType state_type ## void gtk_style_apply_default_background (GtkStyle *style, GdkWindow *window, gboolean set_bg, GtkStateType state_type, GdkRectangle *area, gint x, gint y, gint width, gint height) void gtk_style_apply_default_background (style, window, set_bg, state_type, area, x, y, width, height) GtkStyle *style GdkWindow *window gboolean set_bg GtkStateType state_type GdkRectangle_ornull *area gint x gint y gint width gint height ## GtkIconSet* gtk_style_lookup_icon_set (GtkStyle *style, const gchar *stock_id) GtkIconSet* gtk_style_lookup_icon_set (style, stock_id) GtkStyle *style const gchar *stock_id ## GdkPixbuf* gtk_style_render_icon (GtkStyle *style, const GtkIconSource *source, GtkTextDirection direction, GtkStateType state, GtkIconSize size, GtkWidget *widget, const gchar *detail) GdkPixbuf_noinc* gtk_style_render_icon (style, source, direction, state, size, widget, detail=NULL) GtkStyle *style GtkIconSource *source GtkTextDirection direction GtkStateType state GtkIconSize size GtkWidget_ornull *widget const gchar_ornull *detail MODULE = Gtk2::Style PACKAGE = Gtk2::Style PREFIX = gtk_ ## void gtk_paint_flat_box (GtkStyle *style, GdkWindow *window, GtkStateType state_type, GtkShadowType shadow_type, GdkRectangle *area, GtkWidget *widget, const gchar *detail, gint x, gint y, gint width, gint height) void gtk_paint_flat_box (style, window, state_type, shadow_type, area, widget, detail, x, y, width, height) GtkStyle *style GdkDrawable *window GtkStateType state_type GtkShadowType shadow_type GdkRectangle_ornull *area GtkWidget_ornull *widget const gchar_ornull *detail gint x gint y gint width gint height ## void gtk_paint_hline (GtkStyle *style, GdkWindow *window, GtkStateType state_type, GdkRectangle *area, GtkWidget *widget, const gchar *detail, gint x1, gint x2, gint y) void gtk_paint_hline (style, window, state_type, area, widget, detail, x1, x2, y) GtkStyle *style GdkDrawable *window GtkStateType state_type GdkRectangle_ornull *area GtkWidget_ornull *widget const gchar_ornull *detail gint x1 gint x2 gint y ## void gtk_paint_vline (GtkStyle *style, GdkWindow *window, GtkStateType state_type, GdkRectangle *area, GtkWidget *widget, const gchar *detail, gint y1_, gint y2_, gint x) void gtk_paint_vline (style, window, state_type, area, widget, detail, y1_, y2_, x) GtkStyle *style GdkDrawable *window GtkStateType state_type GdkRectangle_ornull *area GtkWidget_ornull *widget const gchar_ornull *detail gint y1_ gint y2_ gint x ## void gtk_paint_shadow (GtkStyle *style, GdkWindow *window, GtkStateType state_type, GtkShadowType shadow_type, GdkRectangle *area, GtkWidget *widget, const gchar *detail, gint x, gint y, gint width, gint height) void gtk_paint_shadow (style, window, state_type, shadow_type, area, widget, detail, x, y, width, height) GtkStyle *style GdkDrawable *window GtkStateType state_type GtkShadowType shadow_type GdkRectangle_ornull *area GtkWidget_ornull *widget const gchar_ornull *detail gint x gint y gint width gint height ## void gtk_paint_polygon (GtkStyle *style, GdkWindow *window, GtkStateType state_type, GtkShadowType shadow_type, GdkRectangle *area, GtkWidget *widget, const gchar *detail, GdkPoint *points, gint npoints, gboolean fill) =for apidoc =for arg x1 (gint) x coordinate of the first vertex =for arg y1 (gint) y coordinate of the first vertex =for arg ... pairs of x and y coordinates =cut void gtk_paint_polygon (style, window, state_type, shadow_type, area, widget, detail, fill, x1, y1, ...) GtkStyle *style GdkDrawable *window GtkStateType state_type GtkShadowType shadow_type GdkRectangle_ornull *area GtkWidget_ornull *widget const gchar_ornull *detail gboolean fill PREINIT: GdkPoint *points; gint npoints, i; CODE: #define first 8 npoints = (items - first) / 2; points = g_new (GdkPoint, npoints); for (i = 0 ; i < npoints ; i++) { points[i].x = SvIV (ST (first + 2*i)); points[i].y = SvIV (ST (first + 2*i + 1)); } gtk_paint_polygon (style, window, state_type, shadow_type, area, widget, detail, points, npoints, fill); g_free (points); #undef first ## void gtk_paint_arrow (GtkStyle *style, GdkWindow *window, GtkStateType state_type, GtkShadowType shadow_type, GdkRectangle *area, GtkWidget *widget, const gchar *detail, GtkArrowType arrow_type, gboolean fill, gint x, gint y, gint width, gint height) void gtk_paint_arrow (style, window, state_type, shadow_type, area, widget, detail, arrow_type, fill, x, y, width, height) GtkStyle *style GdkDrawable *window GtkStateType state_type GtkShadowType shadow_type GdkRectangle_ornull *area GtkWidget_ornull *widget const gchar_ornull *detail GtkArrowType arrow_type gboolean fill gint x gint y gint width gint height ## void gtk_paint_diamond (GtkStyle *style, GdkWindow *window, GtkStateType state_type, GtkShadowType shadow_type, GdkRectangle *area, GtkWidget *widget, const gchar *detail, gint x, gint y, gint width, gint height) void gtk_paint_diamond (style, window, state_type, shadow_type, area, widget, detail, x, y, width, height) GtkStyle *style GdkDrawable *window GtkStateType state_type GtkShadowType shadow_type GdkRectangle_ornull *area GtkWidget_ornull *widget const gchar_ornull *detail gint x gint y gint width gint height ## void gtk_paint_box (GtkStyle *style, GdkWindow *window, GtkStateType state_type, GtkShadowType shadow_type, GdkRectangle *area, GtkWidget *widget, const gchar *detail, gint x, gint y, gint width, gint height) void gtk_paint_box (style, window, state_type, shadow_type, area, widget, detail, x, y, width, height) GtkStyle *style GdkDrawable *window GtkStateType state_type GtkShadowType shadow_type GdkRectangle_ornull *area GtkWidget_ornull *widget const gchar_ornull *detail gint x gint y gint width gint height ## void gtk_paint_check (GtkStyle *style, GdkWindow *window, GtkStateType state_type, GtkShadowType shadow_type, GdkRectangle *area, GtkWidget *widget, const gchar *detail, gint x, gint y, gint width, gint height) void gtk_paint_check (style, window, state_type, shadow_type, area, widget, detail, x, y, width, height) GtkStyle *style GdkDrawable *window GtkStateType state_type GtkShadowType shadow_type GdkRectangle_ornull *area GtkWidget *widget const gchar_ornull *detail gint x gint y gint width gint height ## void gtk_paint_option (GtkStyle *style, GdkWindow *window, GtkStateType state_type, GtkShadowType shadow_type, GdkRectangle *area, GtkWidget *widget, const gchar *detail, gint x, gint y, gint width, gint height) void gtk_paint_option (style, window, state_type, shadow_type, area, widget, detail, x, y, width, height) GtkStyle *style GdkDrawable *window GtkStateType state_type GtkShadowType shadow_type GdkRectangle_ornull *area GtkWidget *widget const gchar_ornull *detail gint x gint y gint width gint height ## void gtk_paint_tab (GtkStyle *style, GdkWindow *window, GtkStateType state_type, GtkShadowType shadow_type, GdkRectangle *area, GtkWidget *widget, const gchar *detail, gint x, gint y, gint width, gint height) void gtk_paint_tab (style, window, state_type, shadow_type, area, widget, detail, x, y, width, height) GtkStyle *style GdkDrawable *window GtkStateType state_type GtkShadowType shadow_type GdkRectangle_ornull *area GtkWidget *widget const gchar_ornull *detail gint x gint y gint width gint height ## void gtk_paint_shadow_gap (GtkStyle *style, GdkWindow *window, GtkStateType state_type, GtkShadowType shadow_type, GdkRectangle *area, GtkWidget *widget, gchar *detail, gint x, gint y, gint width, gint height, GtkPositionType gap_side, gint gap_x, gint gap_width) void gtk_paint_shadow_gap (style, window, state_type, shadow_type, area, widget, detail, x, y, width, height, gap_side, gap_x, gap_width) GtkStyle *style GdkDrawable *window GtkStateType state_type GtkShadowType shadow_type GdkRectangle_ornull *area GtkWidget_ornull *widget gchar_ornull *detail gint x gint y gint width gint height GtkPositionType gap_side gint gap_x gint gap_width ## void gtk_paint_box_gap (GtkStyle *style, GdkWindow *window, GtkStateType state_type, GtkShadowType shadow_type, GdkRectangle *area, GtkWidget *widget, gchar *detail, gint x, gint y, gint width, gint height, GtkPositionType gap_side, gint gap_x, gint gap_width) void gtk_paint_box_gap (style, window, state_type, shadow_type, area, widget, detail, x, y, width, height, gap_side, gap_x, gap_width) GtkStyle *style GdkDrawable *window GtkStateType state_type GtkShadowType shadow_type GdkRectangle_ornull *area GtkWidget_ornull *widget gchar_ornull *detail gint x gint y gint width gint height GtkPositionType gap_side gint gap_x gint gap_width ## void gtk_paint_extension (GtkStyle *style, GdkWindow *window, GtkStateType state_type, GtkShadowType shadow_type, GdkRectangle *area, GtkWidget *widget, gchar *detail, gint x, gint y, gint width, gint height, GtkPositionType gap_side) void gtk_paint_extension (style, window, state_type, shadow_type, area, widget, detail, x, y, width, height, gap_side) GtkStyle *style GdkDrawable *window GtkStateType state_type GtkShadowType shadow_type GdkRectangle_ornull *area GtkWidget_ornull *widget gchar_ornull *detail gint x gint y gint width gint height GtkPositionType gap_side ## void gtk_paint_focus (GtkStyle *style, GdkWindow *window, GtkStateType state_type, GdkRectangle *area, GtkWidget *widget, const gchar *detail, gint x, gint y, gint width, gint height) void gtk_paint_focus (style, window, state_type, area, widget, detail, x, y, width, height) GtkStyle *style GdkDrawable *window GtkStateType state_type GdkRectangle_ornull *area GtkWidget_ornull *widget const gchar_ornull *detail gint x gint y gint width gint height ## void gtk_paint_slider (GtkStyle *style, GdkWindow *window, GtkStateType state_type, GtkShadowType shadow_type, GdkRectangle *area, GtkWidget *widget, const gchar *detail, gint x, gint y, gint width, gint height, GtkOrientation orientation) void gtk_paint_slider (style, window, state_type, shadow_type, area, widget, detail, x, y, width, height, orientation) GtkStyle *style GdkDrawable *window GtkStateType state_type GtkShadowType shadow_type GdkRectangle_ornull *area GtkWidget_ornull *widget const gchar_ornull *detail gint x gint y gint width gint height GtkOrientation orientation ## void gtk_paint_handle (GtkStyle *style, GdkWindow *window, GtkStateType state_type, GtkShadowType shadow_type, GdkRectangle *area, GtkWidget *widget, const gchar *detail, gint x, gint y, gint width, gint height, GtkOrientation orientation) void gtk_paint_handle (style, window, state_type, shadow_type, area, widget, detail, x, y, width, height, orientation) GtkStyle *style GdkDrawable *window GtkStateType state_type GtkShadowType shadow_type GdkRectangle_ornull *area GtkWidget_ornull *widget const gchar *detail gint x gint y gint width gint height GtkOrientation orientation ## void gtk_paint_expander (GtkStyle *style, GdkWindow *window, GtkStateType state_type, GdkRectangle *area, GtkWidget *widget, const gchar *detail, gint x, gint y, GtkExpanderStyle expander_style) void gtk_paint_expander (style, window, state_type, area, widget, detail, x, y, expander_style) GtkStyle *style GdkDrawable *window GtkStateType state_type GdkRectangle_ornull *area GtkWidget *widget const gchar_ornull *detail gint x gint y GtkExpanderStyle expander_style ## void gtk_paint_layout (GtkStyle *style, GdkWindow *window, GtkStateType state_type, gboolean use_text, GdkRectangle *area, GtkWidget *widget, const gchar *detail, gint x, gint y, PangoLayout *layout) void gtk_paint_layout (style, window, state_type, use_text, area, widget, detail, x, y, layout) GtkStyle *style GdkDrawable *window GtkStateType state_type gboolean use_text GdkRectangle_ornull *area GtkWidget_ornull *widget const gchar_ornull *detail gint x gint y PangoLayout *layout ## void gtk_paint_resize_grip (GtkStyle *style, GdkWindow *window, GtkStateType state_type, GdkRectangle *area, GtkWidget *widget, const gchar *detail, GdkWindowEdge edge, gint x, gint y, gint width, gint height) void gtk_paint_resize_grip (style, window, state_type, area, widget, detail, edge, x, y, width, height) GtkStyle *style GdkDrawable *window GtkStateType state_type GdkRectangle_ornull *area GtkWidget_ornull *widget const gchar_ornull *detail GdkWindowEdge edge gint x gint y gint width gint height #if GTK_CHECK_VERSION (2, 20, 0) void gtk_paint_spinner (GtkStyle *style, GdkWindow *window, GtkStateType state_type, const GdkRectangle_ornull *area, GtkWidget_ornull *widget, const gchar_ornull *detail, guint step, gint x, gint y, gint width, gint height); #endif /* 2.20 */ MODULE = Gtk2::Style PACKAGE = Gtk2 PREFIX = gtk_ #if GTK_CHECK_VERSION (2, 4, 0) =for object Gtk2::Style =cut void gtk_draw_insertion_cursor (class, widget, drawable, area, location, is_primary, direction, draw_arrow) GtkWidget *widget GdkDrawable *drawable GdkRectangle *area GdkRectangle *location gboolean is_primary GtkTextDirection direction gboolean draw_arrow C_ARGS: widget, drawable, area, location, is_primary, direction, draw_arrow #endif MODULE = Gtk2::Style PACKAGE = Gtk2::Style PREFIX = gtk_style_ #if GTK_CHECK_VERSION (2, 10, 0) GdkColor_copy * gtk_style_lookup_color (GtkStyle *style, const gchar *color_name) PREINIT: GdkColor color; CODE: if (!gtk_style_lookup_color (style, color_name, &color)) XSRETURN_UNDEF; RETVAL = &color; OUTPUT: RETVAL #endif #if GTK_CHECK_VERSION (2, 16, 0) =for apidoc =for signature list = $style->get (widget_package, ...) =for signature list = $style->get_style_property (widget_package, ...) =for arg widget_package (string) widget package name (ex: 'Gtk2::TreeView') =for arg ... (list) list of property names Fetch and return the values for the style properties named in I<...> for a widget of type I. I is an alias for I. my $size = $style->get_style_property ("expander-size"); B: The I method shadows I (see L). This shouldn't be a problem since I defines no properties (as of gtk+ 2.16). If you have a class that's derived from Gtk2::Style and adds a property or if a new version of gtk+ adds a property to I then the property can be accessed with I. =cut void gtk_style_get (style, widget_package, ...) GtkStyle *style const char *widget_package ALIAS: get_style_property = 1 PREINIT: int i; GType widget_type; gpointer class; CODE: /* Use CODE: instead of PPCODE: so we can handle the stack ourselves in * order to avoid that xsubs called by gtk_style_get_style_property * overwrite what we put on the stack. */ PERL_UNUSED_VAR (ix); widget_type = gperl_type_from_package (widget_package); if (widget_type == 0) croak ("package %s is not registered with GPerl", widget_package); if (! g_type_is_a (widget_type, GTK_TYPE_WIDGET)) croak ("%s is not a subclass of Gtk2::Widget", widget_package); class = g_type_class_ref (widget_type); if (class == NULL) croak ("can't find type class for type %s", widget_package); for (i = 2 ; i < items ; i++) { GValue value = {0, }; gchar *name = SvGChar (ST (i)); GParamSpec *pspec = gtk_widget_class_find_style_property (class, name); if (pspec) { g_value_init (&value, G_PARAM_SPEC_VALUE_TYPE (pspec)); gtk_style_get_style_property (style, widget_type, name, &value); ST (i - 2) = sv_2mortal (gperl_sv_from_value (&value)); g_value_unset (&value); } else { g_type_class_unref (class); croak ("type %s does not support style property '%s'", widget_package, name); } } g_type_class_unref (class); XSRETURN (items - 2); #endif Gtk2-1.24992/xs/GtkListStore.xs0000644000175000017500000002536313076462677014560 0ustar lacklack/* * Copyright (c) 2003, 2009 by the gtk2-perl team (see the file AUTHORS) * * This library is free software; you can redistribute it and/or * modify it under the terms of the GNU Library General Public * License as published by the Free Software Foundation; either * version 2.1 of the License, or (at your option) any later version. * * This library is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU * Library General Public License for more details. * * You should have received a copy of the GNU Library General Public * License along with this library; if not, write to the * Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, * Boston, MA 02110-1301 USA. * * $Id$ */ #include "gtk2perl.h" MODULE = Gtk2::ListStore PACKAGE = Gtk2::ListStore PREFIX = gtk_list_store_ BOOT: /* must prepend TreeModel in the hierarchy so that * Gtk2::TreeModel::get isn't masked by Glib::Object::get. * should we change the api to something unique, instead? */ gperl_prepend_isa ("Gtk2::ListStore", "Gtk2::TreeModel"); ## GtkListStore* gtk_list_store_new (gint n_columns, ...); =for apidoc =for arg ... of strings =cut GtkListStore_noinc* gtk_list_store_new (class, ...) PREINIT: GArray * typearray; CODE: GTK2PERL_STACK_ITEMS_TO_GTYPE_ARRAY (typearray, 1, items-1); RETVAL = gtk_list_store_newv (typearray->len, (GType*)typearray->data); g_array_free (typearray, TRUE); OUTPUT: RETVAL # for initializing GListStores derived in perl ## void gtk_list_store_set_column_types (GtkListStore *list_store, gint n_columns, GType *types) =for apidoc =for arg ... of strings =cut void gtk_list_store_set_column_types (list_store, ...) GtkListStore *list_store PREINIT: GArray * typearray; CODE: GTK2PERL_STACK_ITEMS_TO_GTYPE_ARRAY (typearray, 1, items-1); gtk_list_store_set_column_types (list_store, typearray->len, (GType*)(typearray->data)); g_array_free (typearray, TRUE); ## void gtk_list_store_set (GtkListStore *list_store, GtkTreeIter *iter, ...) =for apidoc Gtk2::ListStore::set_value =for signature $list_store->set_value ($iter, $col, $val) =for arg col (integer) =for arg val (scalar) =for arg col1 (__hide__) =for arg val1 (__hide__) =for arg ... (__hide__) =cut =for apidoc =for arg col1 (integer) the first column number =for arg val1 (scalar) the first value =for arg ... pairs of column numbers and values =cut void gtk_list_store_set (list_store, iter, col1, val1, ...) GtkListStore *list_store GtkTreeIter *iter ALIAS: Gtk2::ListStore::set_value = 1 PREINIT: int i, ncols; CODE: PERL_UNUSED_VAR (ix); /* require at least one pair --- that means there needs to be * four items on the stack. also require that the stack has an * even number of items on it. */ if (items < 4 || 0 != (items % 2)) { /* caller didn't specify an even number of parameters... */ croak ("Usage: $liststore->set ($iter, column1, value1, column2, value2, ...)\n" " there must be a value for every column number"); } ncols = gtk_tree_model_get_n_columns (GTK_TREE_MODEL (list_store)); for (i = 2 ; i < items ; i+= 2) { gint column; GValue gvalue = {0, }; if (!looks_like_number (ST (i))) croak ("Usage: $liststore->set ($iter, column1, value1, column2, value2, ...)\n" " the first value in each pair must be a column number"); column = SvIV (ST (i)); /* warn (" %d %d %s\n", i, column, SvPV_nolen (ST (i+1))); */ if (column >= 0 && column < ncols) { g_value_init (&gvalue, gtk_tree_model_get_column_type (GTK_TREE_MODEL (list_store), column)); /* gperl_value_from_sv either succeeds or croaks. */ gperl_value_from_sv (&gvalue, ST (i+1)); gtk_list_store_set_value (GTK_LIST_STORE (list_store), iter, column, &gvalue); g_value_unset (&gvalue); } else { warn ("can't set value for column %d, model only has %d columns", column, ncols); } } ## see Gtk2::ListStore::set ## void gtk_list_store_set_valist (GtkListStore *list_store, GtkTreeIter *iter, va_list var_args) ### we're trying to hide things like GValue from the perl level! ### void gtk_list_store_set_value (GtkListStore *list_store, GtkTreeIter *iter, gint column, GValue *value) ## gboolean gtk_list_store_remove (GtkListStore *list_store, GtkTreeIter *iter) =for apidoc The return is always a boolean in the style of Gtk 2.2.x and up, even when running on Gtk 2.0.x. =cut gboolean gtk_list_store_remove (list_store, iter) GtkListStore *list_store GtkTreeIter *iter CODE: #if GTK_CHECK_VERSION(2,2,0) RETVAL = gtk_list_store_remove (list_store, iter); #else /* void return in 2.0.x; look for stamp is zapped to 0 if no more * rows, to emulate the return value of 2.2 and up */ gtk_list_store_remove (list_store, iter); RETVAL = (iter->stamp != 0); #endif OUTPUT: RETVAL ## void gtk_list_store_insert (GtkListStore *list_store, GtkTreeIter *iter, gint position) GtkTreeIter_copy * gtk_list_store_insert (list_store, position) GtkListStore *list_store gint position PREINIT: GtkTreeIter iter = {0,}; CODE: gtk_list_store_insert (list_store, &iter, position); RETVAL = &iter; /* the _copy on the return type means we'll copy * this before the function returns. */ OUTPUT: RETVAL ## void gtk_list_store_insert_before (GtkListStore *list_store, GtkTreeIter *iter, GtkTreeIter *sibling) ## void gtk_list_store_insert_after (GtkListStore *list_store, GtkTreeIter *iter, GtkTreeIter *sibling) GtkTreeIter_copy * gtk_list_store_insert_before (list_store, sibling) GtkListStore * list_store GtkTreeIter_ornull * sibling ALIAS: Gtk2::ListStore::insert_after = 1 PREINIT: GtkTreeIter iter; CODE: if (ix == 0) gtk_list_store_insert_before (list_store, &iter, sibling); else gtk_list_store_insert_after (list_store, &iter, sibling); RETVAL = &iter; OUTPUT: RETVAL #if GTK_CHECK_VERSION (2, 6, 0) ## void gtk_list_store_insert_with_values (GtkListStore *list_store, GtkTreeIter *iter, gint position, ...); =for apidoc =for arg position position to insert the new row =for arg ... pairs of column numbers and values Like doing insert followed by set, except that insert_with_values emits only the row-inserted signal, rather than row-inserted, row-changed, and, if the store is sorted, rows-reordered as in the multiple-operation case. Since emitting the rows-reordered signal repeatedly can affect the performance of the program, insert_with_values should generally be preferred when inserting rows in a sorted list store. =cut GtkTreeIter_copy * gtk_list_store_insert_with_values (GtkListStore *list_store, gint position, ...); PREINIT: gint n_cols, i; GtkTreeIter iter; gint * columns = NULL; GValue * values = NULL; gint n_values; const char * errfmt = "Usage: $iter = $liststore->insert_with_values ($position, column1, value1, ...)\n %s"; CODE: if (items < 2 || 0 != (items % 2)) croak (errfmt, "There must be a value for every column number"); /* * we could jump through hoops to prevent leaking arrays and * initialized GValues here on column validation croaks, but * since gperl_value_from_sv() croaks (and we can't catch it * without major work), and since column index validatio errors * mean there's a programming error anyway, we won't worry about * any of that. */ n_cols = gtk_tree_model_get_n_columns (GTK_TREE_MODEL (list_store)); n_values = (items - 2) / 2; if (n_values > 0) { columns = gperl_alloc_temp (sizeof (gint) * n_values); /* gperl_alloc_temp() calls memset(), so we don't need to do * anything else special to prepare these GValues. */ values = gperl_alloc_temp (sizeof (GValue) * n_values); for (i = 0 ; i < n_values ; i ++) { if (! looks_like_number (ST (2 + i*2))) croak (errfmt, "The first value in each pair must be a column index number"); columns[i] = SvIV (ST (2 + i*2)); if (! (columns[i] >= 0 && columns[i] < n_cols)) croak (errfmt, form ("Bad column index %d, model only has %d columns", columns[i], n_cols)); g_value_init (values + i, gtk_tree_model_get_column_type (GTK_TREE_MODEL (list_store), columns[i])); gperl_value_from_sv (values + i, ST (2 + i*2 + 1)); } } gtk_list_store_insert_with_valuesv (list_store, &iter, position, columns, values, n_values); for (i = 0 ; i < n_values ; i++) g_value_unset (values + i); RETVAL = &iter; OUTPUT: RETVAL #endif ## void gtk_list_store_prepend (GtkListStore *list_store, GtkTreeIter *iter) ## void gtk_list_store_append (GtkListStore *list_store, GtkTreeIter *iter) GtkTreeIter_copy * gtk_list_store_prepend (list_store) GtkListStore *list_store ALIAS: Gtk2::ListStore::append = 1 PREINIT: GtkTreeIter iter; CODE: if (ix == 0) gtk_list_store_prepend (list_store, &iter); else gtk_list_store_append (list_store, &iter); RETVAL = &iter; OUTPUT: RETVAL ## void gtk_list_store_clear (GtkListStore *list_store) void gtk_list_store_clear (list_store) GtkListStore *list_store #if GTK_CHECK_VERSION(2,2,0) ## warning, slow, use only for debugging ## gboolean gtk_list_store_iter_is_valid (GtkListStore *list_store, GtkTreeIter *iter) gboolean gtk_list_store_iter_is_valid (list_store, iter) GtkListStore *list_store GtkTreeIter *iter ## void gtk_list_store_reorder (GtkListStore *store, gint *new_order) =for apidoc =for arg ... of integers the reordered posistions Reorders store to follow the order indicated by new_order. Note that this function only works with unsorted stores. A list of position should be passed, one for each item in the list. =cut void gtk_list_store_reorder (store, ...) GtkListStore * store PREINIT: gint * new_order; CODE: if( (items-1) != store->length ) croak("xs: gtk_list_store_reorder: wrong number of " "positions passed"); items--; new_order = (gint*)g_new(gint, items); for( ; items > 0; items-- ) new_order[items-1] = SvIV(ST(items)); gtk_list_store_reorder(store, new_order); g_free(new_order); ## void gtk_list_store_swap (GtkListStore *store, GtkTreeIter *a, GtkTreeIter *b) void gtk_list_store_swap (store, a, b) GtkListStore * store GtkTreeIter * a GtkTreeIter * b ## void gtk_list_store_move_after (GtkListStore *store, GtkTreeIter *iter, GtkTreeIter *position) void gtk_list_store_move_after (store, iter, position) GtkListStore * store GtkTreeIter * iter GtkTreeIter_ornull * position ## void gtk_list_store_move_before (GtkListStore *store, GtkTreeIter *iter, GtkTreeIter *position) void gtk_list_store_move_before (store, iter, position) GtkListStore * store GtkTreeIter * iter GtkTreeIter_ornull * position #endif /* >= 2.2.0 */ Gtk2-1.24992/xs/GtkTreeModel.xs0000644000175000017500000012124513076462677014504 0ustar lacklack/* * Copyright (c) 2003-2005, 2010, 2012 by the gtk2-perl team (see the file * AUTHORS) * * Licensed under the LGPL, see LICENSE file for more information. * * $Id$ */ #include "gtk2perl.h" #include /* this is just an interface */ static gboolean gtk2perl_tree_model_foreach_func (GtkTreeModel *model, GtkTreePath *path, GtkTreeIter *iter, gpointer data) { GPerlCallback * callback = (GPerlCallback*)data; GValue value = {0,}; gboolean retval; g_value_init (&value, callback->return_type); gperl_callback_invoke (callback, &value, model, path, iter); retval = g_value_get_boolean (&value); g_value_unset (&value); return retval; } static void gtk2perl_tree_model_rows_reordered_marshal (GClosure * closure, GValue * return_value, guint n_param_values, const GValue * param_values, gpointer invocation_hint, gpointer marshal_data) { AV * av; gint * new_order; GtkTreeModel * model; GtkTreeIter * iter; int n_children, i; dGPERL_CLOSURE_MARSHAL_ARGS; /* If model is a Perl object then gtk_tree_model_iter_n_children() will call out to ITER_N_CHILDREN in the class, so do that before trying to build the stack here. */ model = g_value_get_object (param_values); iter = g_value_get_boxed (param_values+2); n_children = gtk_tree_model_iter_n_children (model, iter); GPERL_CLOSURE_MARSHAL_INIT (closure, marshal_data); PERL_UNUSED_VAR (return_value); PERL_UNUSED_VAR (n_param_values); PERL_UNUSED_VAR (invocation_hint); ENTER; SAVETMPS; PUSHMARK (SP); /* instance */ GPERL_CLOSURE_MARSHAL_PUSH_INSTANCE (param_values); /* treepath */ XPUSHs (sv_2mortal (gperl_sv_from_value (param_values+1))); /* treeiter */ XPUSHs (sv_2mortal (gperl_sv_from_value (param_values+2))); /* gint * new_order */ new_order = g_value_get_pointer (param_values+3); av = newAV (); av_extend (av, n_children-1); for (i = 0; i < n_children; i++) av_store (av, i, newSViv (new_order[i])); XPUSHs (sv_2mortal (newRV_noinc ((SV*)av))); GPERL_CLOSURE_MARSHAL_PUSH_DATA; PUTBACK; GPERL_CLOSURE_MARSHAL_CALL (G_DISCARD); /* * clean up */ FREETMPS; LEAVE; } /* * GtkTreeModelIface */ /* * Signals - these have class closures, so we can override them "normally" * (for gtk2-perl, that is) * * row_changed * row_inserted * row_has_child_toggled * row_deleted * rows_reordered */ /* * Virtual Table - things for which we must provide overrides */ static SV * find_func (GtkTreeModel * tree_model, const char * method_name) { HV * stash = gperl_object_stash_from_type (G_OBJECT_TYPE (tree_model)); return (SV*) gv_fetchmethod (stash, method_name); } #define PREP(model) \ dSP; \ ENTER; \ SAVETMPS; \ PUSHMARK (SP); \ PUSHs (sv_2mortal (newSVGObject (G_OBJECT (model)))); #define CALL(name, flags) \ PUTBACK; \ call_method (name, flags); \ SPAGAIN; #define FINISH \ PUTBACK; \ FREETMPS; \ LEAVE; static GtkTreeModelFlags gtk2perl_tree_model_get_flags (GtkTreeModel *tree_model) { GtkTreeModelFlags ret; PREP (tree_model); CALL ("GET_FLAGS", G_SCALAR); ret = SvGtkTreeModelFlags (POPs); FINISH; return ret; } static gint gtk2perl_tree_model_get_n_columns (GtkTreeModel *tree_model) { int ret; PREP (tree_model); CALL ("GET_N_COLUMNS", G_SCALAR); ret = POPi; FINISH; return ret; } static GType gtk2perl_tree_model_get_column_type (GtkTreeModel *tree_model, gint index_) { GType ret; SV * svret; PREP (tree_model); XPUSHs (sv_2mortal (newSViv (index_))); CALL ("GET_COLUMN_TYPE", G_SCALAR); svret = POPs; PUTBACK; ret = gperl_type_from_package (SvPV_nolen (svret)); if (!ret) croak ("package %s is not registered with GPerl\n", SvPV_nolen (svret)); FREETMPS; LEAVE; return ret; } static SV * sv_from_iter (GtkTreeIter * iter) { AV * av; if (!iter) return &PL_sv_undef; av = newAV (); av_push (av, newSVuv (iter->stamp)); av_push (av, newSViv (PTR2IV (iter->user_data))); av_push (av, iter->user_data2 ? newRV (iter->user_data2) : &PL_sv_undef); av_push (av, iter->user_data3 ? newRV (iter->user_data3) : &PL_sv_undef); return newRV_noinc ((SV*)av); } static gboolean iter_from_sv (GtkTreeIter * iter, SV * sv) { /* we allow undef as the sentinel from the perl vfuncs to tell us * to return FALSE from the C vfuncs. for anything else, it *must* * be an array reference or we croak with an informative message * (since that would be caused by a programming bug). */ if (gperl_sv_is_defined (sv)) { SV ** svp; AV * av; if (!gperl_sv_is_array_ref (sv)) croak ("expecting a reference to an ARRAY to describe " "a tree iter, not a %s", sv_reftype (SvRV (sv), 0)); av = (AV*) SvRV (sv); if ((svp = av_fetch (av, 0, FALSE))) iter->stamp = SvUV (*svp); if ((svp = av_fetch (av, 1, FALSE)) && gperl_sv_is_defined (*svp)) iter->user_data = INT2PTR (gpointer, SvIV (*svp)); else iter->user_data = NULL; if ((svp = av_fetch (av, 2, FALSE)) && gperl_sv_is_ref (*svp)) iter->user_data2 = SvRV (*svp); else iter->user_data2 = NULL; if ((svp = av_fetch (av, 3, FALSE)) && gperl_sv_is_ref (*svp)) iter->user_data3 = SvRV (*svp); else iter->user_data3 = NULL; return TRUE; } else { iter->stamp = 0; iter->user_data = 0; iter->user_data2 = 0; iter->user_data3 = 0; return FALSE; } } static gboolean gtk2perl_tree_model_get_iter (GtkTreeModel *tree_model, GtkTreeIter *iter, GtkTreePath *path) { gboolean ret; PREP (tree_model); XPUSHs (sv_2mortal (path ? newSVGtkTreePath (path) : &PL_sv_undef)); CALL ("GET_ITER", G_SCALAR); ret = iter_from_sv (iter, POPs); FINISH; return ret; } static GtkTreePath * gtk2perl_tree_model_get_path (GtkTreeModel *tree_model, GtkTreeIter *iter) { GtkTreePath * ret = NULL; SV * sv; PREP (tree_model); XPUSHs (sv_2mortal (sv_from_iter (iter))); CALL ("GET_PATH", G_SCALAR); sv = POPs; /* restore the stack before parsing the output, since SvGtkTreePath * might croak. FREETMPS will destroy the path, though, so we need * to copy it, first. */ PUTBACK; if (gperl_sv_is_defined (sv)) ret = gtk_tree_path_copy (SvGtkTreePath (sv)); FREETMPS; LEAVE; return ret; } static void gtk2perl_tree_model_get_value (GtkTreeModel *tree_model, GtkTreeIter *iter, gint column, GValue *value) { g_value_init (value, gtk2perl_tree_model_get_column_type (tree_model, column)); { PREP (tree_model); XPUSHs (sv_2mortal (sv_from_iter (iter))); XPUSHs (sv_2mortal (newSViv (column))); CALL ("GET_VALUE", G_SCALAR); gperl_value_from_sv (value, POPs); FINISH; } } static gboolean gtk2perl_tree_model_iter_next (GtkTreeModel *tree_model, GtkTreeIter *iter) { gboolean ret; PREP (tree_model); XPUSHs (sv_2mortal (sv_from_iter (iter))); CALL ("ITER_NEXT", G_SCALAR); ret = iter_from_sv (iter, POPs); FINISH; return ret; } static gboolean gtk2perl_tree_model_iter_children (GtkTreeModel *tree_model, GtkTreeIter *iter, GtkTreeIter *parent) { gboolean ret; PREP (tree_model); XPUSHs (sv_2mortal (sv_from_iter (parent))); CALL ("ITER_CHILDREN", G_SCALAR); ret = iter_from_sv (iter, POPs); FINISH; return ret; } static gboolean gtk2perl_tree_model_iter_has_child (GtkTreeModel *tree_model, GtkTreeIter *iter) { SV *sv; gboolean ret; PREP (tree_model); XPUSHs (sv_2mortal (sv_from_iter (iter))); CALL ("ITER_HAS_CHILD", G_SCALAR); sv = POPs; ret = sv_2bool (sv); FINISH; return ret; } static gint gtk2perl_tree_model_iter_n_children (GtkTreeModel *tree_model, GtkTreeIter *iter) { gint ret; PREP (tree_model); XPUSHs (sv_2mortal (sv_from_iter (iter))); CALL ("ITER_N_CHILDREN", G_SCALAR); ret = POPi; FINISH; return ret; } static gboolean gtk2perl_tree_model_iter_nth_child (GtkTreeModel *tree_model, GtkTreeIter *iter, GtkTreeIter *parent, gint n) { gboolean ret; PREP (tree_model); XPUSHs (sv_2mortal (sv_from_iter (parent))); XPUSHs (sv_2mortal (newSViv (n))); CALL ("ITER_NTH_CHILD", G_SCALAR); ret = iter_from_sv (iter, POPs); FINISH; return ret; } static gboolean gtk2perl_tree_model_iter_parent (GtkTreeModel *tree_model, GtkTreeIter *iter, GtkTreeIter *child) { gboolean ret; PREP (tree_model); XPUSHs (sv_2mortal (sv_from_iter (child))); CALL ("ITER_PARENT", G_SCALAR); ret = iter_from_sv (iter, POPs); FINISH; return ret; } static void gtk2perl_tree_model_ref_node (GtkTreeModel *tree_model, GtkTreeIter *iter) { SV * func = find_func (tree_model, "REF_NODE"); if (func) { PREP (tree_model); XPUSHs (sv_2mortal (sv_from_iter (iter))); PUTBACK; call_sv (func, G_VOID|G_DISCARD); FINISH; } } static void gtk2perl_tree_model_unref_node (GtkTreeModel *tree_model, GtkTreeIter *iter) { SV * func = find_func (tree_model, "UNREF_NODE"); if (func) { PREP (tree_model); XPUSHs (sv_2mortal (sv_from_iter (iter))); PUTBACK; call_sv (func, G_VOID|G_DISCARD); FINISH; } } static void gtk2perl_tree_model_init (GtkTreeModelIface * iface) { iface->get_flags = gtk2perl_tree_model_get_flags; iface->get_n_columns = gtk2perl_tree_model_get_n_columns; iface->get_column_type = gtk2perl_tree_model_get_column_type; iface->get_iter = gtk2perl_tree_model_get_iter; iface->get_path = gtk2perl_tree_model_get_path; iface->get_value = gtk2perl_tree_model_get_value; iface->iter_next = gtk2perl_tree_model_iter_next; iface->iter_children = gtk2perl_tree_model_iter_children; iface->iter_has_child = gtk2perl_tree_model_iter_has_child; iface->iter_n_children = gtk2perl_tree_model_iter_n_children; iface->iter_nth_child = gtk2perl_tree_model_iter_nth_child; iface->iter_parent = gtk2perl_tree_model_iter_parent; iface->ref_node = gtk2perl_tree_model_ref_node; iface->unref_node = gtk2perl_tree_model_unref_node; } MODULE = Gtk2::TreeModel PACKAGE = Gtk2::TreeModel =for flags GtkTreeModelFlags =cut =for position SYNOPSIS =head1 SYNOPSIS # Three ways of getting the iter pointing to the location 3:2:5 # get the iterator from a string $iter = $model->get_iter_from_string ("3:2:5"); # get the iterator from a path $path = Gtk2::TreePath->new_from_string ("3:2:5"); $iter = $model->get_iter ($path); # walk the tree to find the iterator $iter = $model->iter_nth_child (undef, 3); $iter = $model->iter_nth_child ($iter, 2); $iter = $model->iter_nth_child ($iter, 5); # getting and setting values # assuming a model with these columns use constant STRING_COLUMN => 0; use constant INT_COLUMN => 1; # set values $model->set ($iter, STRING_COLUMN, $new_string_value, INT_COLUMN, $new_int_value); # and get values ($int, $str) = $model->get ($iter, INT_COLUMN, STRING_COLUMN); # if you don't specify a list of column numbers, # you get all of them. @values = $model->get ($iter); =cut =for position DESCRIPTION =head1 DESCRIPTION The Gtk2::TreeModel provides a generic tree interface for use by the Gtk2::TreeView widget. It is an abstract interface, designed to be usable with any appropriate data structure. The model is represented as a hierarchical tree of strongly-typed, columned data. In other words, the model can be seen as a tree where every node has different values depending on which column is being queried. The type of data found in a column is determined by using the GType system (i.e. package names like Glib::Int, Gtk2::Button, Glib::Scalar, etc). The types are homogeneous per column across all nodes. It is important to note that this interface only provides a way of examining a model and observing changes. The implementation of each individual model decides how and if changes are made. In order to make life simpler for programmers who do not need to write their own specialized model, two generic models are provided - the Gtk2::TreeStore and the Gtk2::ListStore. To use these, the developer simply pushes data into these models as necessary. These models provide the data structure as well as all appropriate tree interfaces. As a result, implementing drag and drop, sorting, and storing data is trivial. For the vast majority of trees and lists, these two models are sufficient. For information on how to implement your own model in Perl, see L. Models are accessed on a node/column level of granularity. One can query for the value of a model at a certain node and a certain column on that node. There are two structures used to reference a particular node in a model: the Gtk2::TreePath and the Gtk2::TreeIter (short for "iterator"). Most of the interface consists of operations on a Gtk2::TreeIter. A path is essentially a potential node. It is a location on a model that may or may not actually correspond to a node on a specific model. The Gtk2::TreePath object can be converted into either an array of unsigned integers or a string. The string form is a list of numbers separated by a colon. Each number refers to the offset at that level. Thus, the path '0' refers to the root node and the path '2:4' refers to the fifth child of the third node. By contrast, a Gtk2::TreeIter is a reference to a specific node on a specific model. To the user of a model, the iter is merely an opaque object. One can convert a path to an iterator by calling C. These iterators are the primary way of accessing a model and are similar to the iterators used by Gtk2::TextBuffer. The model interface defines a set of operations using them for navigating the model. The iterators are generally used only for a short time, and their behaviour is different to that suggested by the Gtk+ documentation. They are not valid when the model is changed, even though get_flags returns 'iters-persist'. Iterators obtained within a GtkTreeModelForeachFunc are also invalid after the foreach terminates. There may be other such cases. In the foreach case, and perhaps others, a persistent iterator may be obtained by copying it (see Glib::Boxed->copy). (The preceding description and most of the method descriptions have been adapted directly from the Gtk+ C API reference.) =cut ## ## ## =for position post_methods =head1 CREATING A CUSTOM TREE MODEL GTK+ provides two model implementations, Gtk2::TreeStore and Gtk2::ListStore, which should be sufficient in most cases. For some cases, however, it is advantageous to provide a custom tree model implementation. It is possible to create custom tree models in Perl, because we're cool like that. To do this, you create a Glib::Object derivative which implements the Gtk2::TreeModel interface; this is gtk2-perl-speak for "you have to add a special key when you register your object type." For example: package MyModel; use Gtk2; use Glib::Object::Subclass Glib::Object::, interfaces => [ Gtk2::TreeModel:: ], ; This will cause perl to call several virtual methods with ALL_CAPS_NAMES when Gtk+ attempts to perform certain actions on the model. You simply provide (or override) those methods. =head2 TREE ITERS Gtk2::TreeIter is normally an opaque object, but on the implementation side of a Gtk2::TreeModel, you have to define what's inside. The virtual methods described below deal with iters as a reference to an array containing four values: =over =item o stamp (integer) A number unique to this model. =item o user_data (integer) An arbitrary integer value. =item o user_data2 (scalar) An arbitrary reference. Will not persist. May be undef. =item o user_data3 (scalar) An arbitrary reference. Will not persist. May be undef. =back The two references, if used, will generally be to data within the model, like a row array, or a node object in a tree or linked list. Keeping the things referred to alive is the model's responsibility. An iter doesn't make them persist, and if the things are destroyed then any iters still containing them will become invalid (and result in memory corruption if used). An iter only has to remain valid until the model contents change, so generally anything internal to the model is fine. =head2 VIRTUAL METHODS An implementation of =over =item treemodelflags = GET_FLAGS ($model) =item integer = GET_N_COLUMNS ($model) =item string = GET_COLUMN_TYPE ($model, $index) =item ARRAYREF = GET_ITER ($model, $path) See above for a description of what goes in the returned array reference. =item treepath = GET_PATH ($model, ARRAYREF) =item scalar = GET_VALUE ($model, ARRAYREF, $column) Implements $treemodel->get(). =item ARRAYREF = ITER_NEXT ($model, ARRAYREF) =item ARRAYREF = ITER_CHILDREN ($model, ARRAYREF) =item boolean = ITER_HAS_CHILD ($model, ARRAYREF) =item integer = ITER_N_CHILDREN ($model, ARRAYREF) =item ARRAYREF = ITER_NTH_CHILD ($model, ARRAYREF, $n) =item ARRAYREF = ITER_PARENT ($model, ARRAYREF) =item REF_NODE ($model, ARRAYREF) Optional. =item UNREF_NODE ($model, ARRAYREF) Optional. =back =cut =for position post_signals Note that currently in a Perl subclass of an object implementing C, the class closure, ie. class default signal handler, for the C signal is called only with an integer address for the reorder array parameter, not a Perl arrayref like a handler installed with C receives. It works to C with the address, but it's otherwise fairly useless and will likely change in the future. =cut =for apidoc __hide__ =cut void _ADD_INTERFACE (class, const char * target_class) CODE: { static const GInterfaceInfo iface_info = { (GInterfaceInitFunc) gtk2perl_tree_model_init, (GInterfaceFinalizeFunc) NULL, (gpointer) NULL }; GType gtype = gperl_object_type_from_package (target_class); g_type_add_interface_static (gtype, GTK_TYPE_TREE_MODEL, &iface_info); } MODULE = Gtk2::TreeModel PACKAGE = Gtk2::TreePath PREFIX = gtk_tree_path_ =for apidoc Create a new path. For convenience, if you pass a value for I<$path>, this is just an alias for C. =cut GtkTreePath_own_ornull * gtk_tree_path_new (class, path=NULL) const gchar * path ALIAS: new_from_string = 1 CODE: PERL_UNUSED_VAR (ix); if (path) RETVAL = gtk_tree_path_new_from_string (path); else RETVAL = gtk_tree_path_new (); OUTPUT: RETVAL ## GtkTreePath * gtk_tree_path_new_from_indices (gint first_index, ...) =for apidoc =for arg first_index (integer) a non-negative index value =for arg ... of zero or more index values The C API reference docs for this function say to mark the end of the list with a -1, but Perl doesn't need list terminators, so don't do that. This is specially implemented to be available for all gtk+ versions. =cut GtkTreePath_own_ornull * gtk_tree_path_new_from_indices (class, first_index, ...) PREINIT: gint i; GtkTreePath *path; CODE: path = gtk_tree_path_new (); for (i = 1 ; i < items ; i++) { gint index = SvIV (ST (i)); if (index < 0) croak ("Gtk2::TreePath->new_from_indices takes index" " values from the argument stack and therefore" " does not use a -1 terminator value like its" " C counterpart; negative index values are" " not allowed"); gtk_tree_path_append_index (path, index); } RETVAL = path; OUTPUT: RETVAL gchar_own * gtk_tree_path_to_string (path) GtkTreePath * path GtkTreePath_own * gtk_tree_path_new_first (class) C_ARGS: /* void */ ## gtk_tree_path_new_root is deprecated in 2.2.0 void gtk_tree_path_append_index (path, index_) GtkTreePath *path gint index_ void gtk_tree_path_prepend_index (path, index_) GtkTreePath *path gint index_ gint gtk_tree_path_get_depth (path) GtkTreePath *path # gint * gtk_tree_path_get_indices_with_depth (GtkTreePath *path, gint *depth); =for apidoc Returns a list of integers describing the current indices of I<$path>. =cut void gtk_tree_path_get_indices (path) GtkTreePath * path PREINIT: gint * indices; gint depth; gint i; PPCODE: depth = gtk_tree_path_get_depth (path); indices = gtk_tree_path_get_indices (path); EXTEND (SP, depth); for (i = 0 ; i < depth ; i++) PUSHs (sv_2mortal (newSViv (indices[i]))); ## boxed wrapper stuff handled by Glib::Boxed ## GtkTreePath * gtk_tree_path_copy (GtkTreePath *path) ## void gtk_tree_path_free (GtkTreePath *path) =for apidoc Compares two paths. If I<$a> appears before I<$b> in the three, returns -1. If I<$b> appears before I<$a>, returns 1. If the nodes are equal, returns 0. =cut gint gtk_tree_path_compare (a, b) GtkTreePath *a GtkTreePath *b =for apidoc Moves I<$path> to point to the next node at the current depth. =cut void gtk_tree_path_next (path) GtkTreePath *path =for apidoc Moves I<$path> to point to the previous node at the current depth, if it exists. Returns true if there is a previous node and I<$path> was modified. =cut gboolean gtk_tree_path_prev (path) GtkTreePath *path =for apidoc Moves I<$path> to point to its parent node; returns false if there is no parent. =cut gboolean gtk_tree_path_up (path) GtkTreePath *path =for apidoc Moves I<$path> to point to the first child of the current path. =cut void gtk_tree_path_down (path) GtkTreePath *path gboolean gtk_tree_path_is_ancestor (path, descendant) GtkTreePath *path GtkTreePath *descendant gboolean gtk_tree_path_is_descendant (path, ancestor) GtkTreePath *path GtkTreePath *ancestor MODULE = Gtk2::TreeModel PACKAGE = Gtk2::TreeRowReference PREFIX = gtk_tree_row_reference_ ## ## there doesn't seem to be a GType for GtkTreeRowReference in 2.0.x... ## #ifdef GTK_TYPE_TREE_ROW_REFERENCE ##GtkTreeRowReference* gtk_tree_row_reference_new (GtkTreeModel *model, GtkTreePath *path); # $row_ref_or_undef = Gtk2::TreeRowReference->new ($model, $path) GtkTreeRowReference_own_ornull* gtk_tree_row_reference_new (class, GtkTreeModel *model, GtkTreePath *path) C_ARGS: model, path ## mmmm, the docs say "you do not need to use this function" ##GtkTreeRowReference* gtk_tree_row_reference_new_proxy (GObject *proxy, GtkTreeModel *model, GtkTreePath *path); GtkTreePath_own_ornull * gtk_tree_row_reference_get_path (GtkTreeRowReference *reference); ## gboolean gtk_tree_row_reference_valid (GtkTreeRowReference *reference) gboolean gtk_tree_row_reference_valid (reference) GtkTreeRowReference *reference #### boxed wrapper stuff handled by Glib::Boxed #### GtkTreeRowReference* gtk_tree_row_reference_copy (GtkTreeRowReference *reference); #### void gtk_tree_row_reference_free (GtkTreeRowReference *reference) ## i gather that you only need these if you created the row reference with ## gtk_tree_row_reference_new_proxy... but they recommend you don't use ## the proxy stuff. i'll hold off until somebody asks for it. #### void gtk_tree_row_reference_inserted (GObject *proxy, GtkTreePath *path) ##void ##gtk_tree_row_reference_inserted (proxy, path) ## GObject *proxy ## GtkTreePath *path ## #### void gtk_tree_row_reference_deleted (GObject *proxy, GtkTreePath *path) ##void ##gtk_tree_row_reference_deleted (proxy, path) ## GObject *proxy ## GtkTreePath *path ## #### void gtk_tree_row_reference_reordered (GObject *proxy, GtkTreePath *path, GtkTreeIter *iter, gint *new_order) ##void ##gtk_tree_row_reference_reordered (proxy, path, iter, new_order) ## GObject *proxy ## GtkTreePath *path ## GtkTreeIter *iter ## gint *new_order ## #if GTK_CHECK_VERSION (2, 8, 0) GtkTreeModel_ornull * gtk_tree_row_reference_get_model (GtkTreeRowReference *reference); #endif #endif /* defined GTK_TYPE_TREE_ROW_REFERENCE */ MODULE = Gtk2::TreeModel PACKAGE = Gtk2::TreeIter PREFIX = gtk_tree_iter_ =for see_also Gtk2::TreeModel =cut =head1 SYNOPSIS package MyCustomListStore; use Glib::Object::Subclass Glib::Object::, interfaces => [ Gtk2::TreeModel:: ], ; ... sub set { my $list = shift; my $iter = shift; # a Gtk2::TreeIter # this method needs access to the internal representation # of the iter, as the model implementation sees it: my $arrayref = $iter->to_arrayref ($list->{stamp}); ... } =head1 DESCRIPTION The methods described here are only of use in custom Gtk2::TreeModel implementations; they are not safe to be used on generic iters or in application code. See L for more information. =cut =for apidoc Convert a boxed Gtk2::TreeIter reference into the "internal" array reference representation used by custom Gtk2::TreeModel implementations. This is necessary when you need to get to the data inside your iters in methods which are not the vfuncs of the Gtk2::TreeModelIface interface. The stamp must match; this protects the binding code from potential memory faults when attempting to convert an iter that doesn't actually belong to your model. See L for more information. =cut SV* to_arrayref (GtkTreeIter * iter, IV stamp) CODE: if (iter->stamp != stamp) croak ("invalid iter -- stamp %d does not match " "requested %" IVdf, iter->stamp, stamp); RETVAL = sv_from_iter (iter); OUTPUT: RETVAL =for apidoc Create a new Gtk2::TreeIter from the "internal" array reference representation used by custom Gtk2::TreeModel implementations. This is the complement to Gtk2::TreeIter::to_arrayref(), and is used when you need to create and return a new iter from a method that is not one of the Gtk2::TreeModelIface interface vfuncs. See L for more information. =cut GtkTreeIter_copy * new_from_arrayref (class, SV * sv_iter) PREINIT: GtkTreeIter iter = {0, }; CODE: if (!iter_from_sv (&iter, sv_iter)) XSRETURN_UNDEF; RETVAL = &iter; OUTPUT: RETVAL ## we get this from Glib::Boxed::copy ## GtkTreeIter * gtk_tree_iter_copy (GtkTreeIter * iter) ## we get this from Glib::Boxed::DESTROY ## void gtk_tree_iter_free (GtkTreeIter *iter) =for apidoc Set the contents of $iter. $from can be either another Gtk2::TreeIter or an "internal" arrayref form as above. Often you create a new iter instead of modifying an existing one, but C lets you to implement things in the style of the C method of Gtk2::ListStore and Gtk2::TreeStore. A set can also explicitly invalidate an iter by zapping its stamp, so nobody can accidentally use it again. $iter->set ([0,0,undef,undef]); =cut void set (GtkTreeIter *iter, SV *from) CODE: if (gperl_sv_is_array_ref (from)) { iter_from_sv (iter, from); } else { GtkTreeIter *from_iter = SvGtkTreeIter (from); memcpy (iter, from_iter, sizeof(*iter)); } MODULE = Gtk2::TreeModel PACKAGE = Gtk2::TreeModel PREFIX = gtk_tree_model_ BOOT: gperl_signal_set_marshaller_for (GTK_TYPE_TREE_MODEL, "rows_reordered", gtk2perl_tree_model_rows_reordered_marshal); =for flags GtkTreeModelFlags =cut ## GtkTreeModelFlags gtk_tree_model_get_flags (GtkTreeModel *tree_model) GtkTreeModelFlags gtk_tree_model_get_flags (tree_model) GtkTreeModel *tree_model ## gint gtk_tree_model_get_n_columns (GtkTreeModel *tree_model) gint gtk_tree_model_get_n_columns (tree_model) GtkTreeModel *tree_model ## GType gtk_tree_model_get_column_type (GtkTreeModel *tree_model, gint index_) ### we hide GType from the perl level. return the corresponding ### package instead. =for apidoc Returns the type of column I<$index_> as a package name. =cut const gchar * gtk_tree_model_get_column_type (tree_model, index_) GtkTreeModel *tree_model gint index_ PREINIT: GType t; CODE: t = gtk_tree_model_get_column_type (tree_model, index_); RETVAL = gperl_package_from_type (t); if (!RETVAL) croak ("internal -- type of column %d, %s (%d), is not registered with GPerl", index_, g_type_name (t), t); OUTPUT: RETVAL ## gboolean gtk_tree_model_get_iter (GtkTreeModel *tree_model, GtkTreeIter *iter, GtkTreePath *path) =for Returns a new Gtk2::TreeIter corresponding to I<$path>. =cut GtkTreeIter_copy * gtk_tree_model_get_iter (tree_model, path) GtkTreeModel *tree_model GtkTreePath *path PREINIT: GtkTreeIter iter = {0, }; CODE: if (!gtk_tree_model_get_iter (tree_model, &iter, path)) XSRETURN_UNDEF; RETVAL = &iter; OUTPUT: RETVAL ##### FIXME couldn't we combine get_iter and get_iter_from_string, since we'll ##### be able to tell at runtime whether the arg is a GtkTreePath or a ##### plain old string? ## gboolean gtk_tree_model_get_iter_from_string (GtkTreeModel *tree_model, GtkTreeIter *iter, const gchar *path_string) =for apidoc Returns a new iter pointing to the node described by I<$path_string>, or undef if the path does not exist. =cut GtkTreeIter_copy * gtk_tree_model_get_iter_from_string (tree_model, path_string) GtkTreeModel *tree_model const gchar *path_string PREINIT: GtkTreeIter iter = {0, }; CODE: if (!gtk_tree_model_get_iter_from_string (tree_model, &iter, path_string)) XSRETURN_UNDEF; RETVAL = &iter; OUTPUT: RETVAL #if GTK_CHECK_VERSION(2,2,0) ## gchar * gtk_tree_model_get_string_from_iter (GtkTreeModel *tree_model, GtkTreeIter *iter) =for apidoc Generates a string representation of the iter. This string is a ':' separated list of numbers. For example, "4:10:0:3" would be an acceptable return value for this string. =cut gchar_own * gtk_tree_model_get_string_from_iter (tree_model, iter) GtkTreeModel *tree_model GtkTreeIter *iter #endif /* 2.2.0 */ ## gboolean gtk_tree_model_get_iter_first (GtkTreeModel *tree_model, GtkTreeIter *iter) =for apidoc Return a new iter pointing to the first node in the tree (the one at path "0"), or undef if the tree is empty. =cut GtkTreeIter_copy * gtk_tree_model_get_iter_first (tree_model) GtkTreeModel *tree_model PREINIT: GtkTreeIter iter = {0, }; CODE: if (!gtk_tree_model_get_iter_first (tree_model, &iter)) XSRETURN_UNDEF; RETVAL = &iter; OUTPUT: RETVAL ### gtk_tree_model_get_iter_root is deprecated ## GtkTreePath * gtk_tree_model_get_path (GtkTreeModel *tree_model, GtkTreeIter *iter) =for apidoc Return a new Gtk2::TreePath corresponding to I<$iter>. =cut GtkTreePath_own * gtk_tree_model_get_path (tree_model, iter) GtkTreeModel *tree_model GtkTreeIter *iter ## void gtk_tree_model_get (GtkTreeModel *tree_model, GtkTreeIter *iter, ...) ## void gtk_tree_model_get_value (GtkTreeModel *tree_model, GtkTreeIter *iter, gint column, GValue *value) =for apidoc get_value =for arg ... of column indices Alias for LB ($iter, ...)">. =cut =for apidoc =for arg ... of column indices Fetch and return the model's values in the row pointed to by I<$iter>. If you specify no column indices, it returns the values for all of the columns, otherwise, returns just those columns' values (in order). This overrides overrides Glib::Object's C, so you'll want to use C<< $object->get_property >> to get object properties. =cut void gtk_tree_model_get (tree_model, iter, ...) GtkTreeModel *tree_model GtkTreeIter *iter ALIAS: get_value = 1 PREINIT: int i; CODE: /* we use CODE: instead of PPCODE: so we can handle the stack * ourselves. */ PERL_UNUSED_VAR (ix); #define OFFSET 2 if (items > OFFSET) { /* if column id's were passed, just return those columns */ /* the stack is big enough already due to the input arguments, * so we don't need to extend it. nor do we need to care about * xsubs called by gtk_tree_model_get_value overwriting the * stuff we put on the stack. */ for (i = OFFSET ; i < items ; i++) { GValue gvalue = {0, }; gtk_tree_model_get_value (tree_model, iter, SvIV (ST (i)), &gvalue); ST (i - OFFSET) = sv_2mortal (gperl_sv_from_value (&gvalue)); g_value_unset (&gvalue); } XSRETURN (items - OFFSET); } #undef OFFSET else { /* otherwise return all of the columns */ int n_columns = gtk_tree_model_get_n_columns (tree_model); /* extend the stack so it can handle 'n_columns' items in * total. the stack already contains 'items' elements so if * 'items' < 'n_columns', make room for 'n_columns - items' * more. then move our local stack pointer forward to the new * end, and update the global stack pointer. leave 'ax' * unchanged though, so that ST still refers to the start of * the stack allocated to us. this way, xsubs called by * gtk_tree_model_get_value don't overwrite what we put on the * stack. */ SPAGAIN; if (n_columns > items) EXTEND (SP, n_columns - items); SP += n_columns - items; PUTBACK; for (i = 0; i < n_columns; i++) { GValue gvalue = {0, }; gtk_tree_model_get_value (tree_model, iter, i, &gvalue); ST (i) = sv_2mortal (gperl_sv_from_value (&gvalue)); g_value_unset (&gvalue); } XSRETURN (n_columns); } ## va_list means nothing to a perl developer, it's a c-specific thing. #### void gtk_tree_model_get_valist (GtkTreeModel *tree_model, GtkTreeIter *iter, va_list var_args) ## ## gboolean gtk_tree_model_iter_next (GtkTreeModel *tree_model, GtkTreeIter *iter) =for apidoc Return a new iter pointing to node following I<$iter> at the current level, or undef if there is no next node. I<$iter> is unaltered. (Note: this is different from the C version, which modifies the iter.) =cut GtkTreeIter_own * gtk_tree_model_iter_next (tree_model, iter) GtkTreeModel *tree_model GtkTreeIter *iter CODE: /* the C version modifies the iter we pass; to make this fit more * with the rest of our Perl interface, we want *not* to modify * the one passed and instead return the modified iter... which * means we have to copy *first*. */ RETVAL = gtk_tree_iter_copy (iter); if (!gtk_tree_model_iter_next (tree_model, RETVAL)) { gtk_tree_iter_free (RETVAL); XSRETURN_UNDEF; } OUTPUT: RETVAL #### gboolean gtk_tree_model_iter_children (GtkTreeModel *tree_model, GtkTreeIter *iter, GtkTreeIter *parent) =for apidoc Returns undef if I<$parent> has no children, otherwise, returns a new iter to the first child of I<$parent>. I<$parent> is unaltered. If I<$parent> is undef, this is equivalent to C. =cut GtkTreeIter_copy * gtk_tree_model_iter_children (tree_model, parent) GtkTreeModel *tree_model GtkTreeIter_ornull *parent PREINIT: GtkTreeIter iter; CODE: if (!gtk_tree_model_iter_children (tree_model, &iter, parent)) XSRETURN_UNDEF; RETVAL = &iter; OUTPUT: RETVAL ## gboolean gtk_tree_model_iter_has_child (GtkTreeModel *tree_model, GtkTreeIter *iter) =for apidoc Returns true if I<$iter> has child nodes. =cut gboolean gtk_tree_model_iter_has_child (tree_model, iter) GtkTreeModel *tree_model GtkTreeIter *iter ## gint gtk_tree_model_iter_n_children (GtkTreeModel *tree_model, GtkTreeIter *iter) =for apidoc Returns the number of children I<$iter> has. If I<$iter> is undef (or omitted) then returns the number of toplevel nodes. =cut gint gtk_tree_model_iter_n_children (tree_model, iter=NULL) GtkTreeModel *tree_model GtkTreeIter_ornull *iter ## gboolean gtk_tree_model_iter_nth_child (GtkTreeModel *tree_model, GtkTreeIter *iter, GtkTreeIter *parent, gint n) =for apidoc Returns an iter to the child of I<$parent> at index I<$n>, or undef if there is no such child. I<$parent> is unaltered. =cut GtkTreeIter_copy * gtk_tree_model_iter_nth_child (tree_model, parent, n) GtkTreeModel *tree_model GtkTreeIter_ornull *parent gint n PREINIT: GtkTreeIter iter; CODE: if (!gtk_tree_model_iter_nth_child (tree_model, &iter, parent, n)) XSRETURN_UNDEF; RETVAL = &iter; OUTPUT: RETVAL ## gboolean gtk_tree_model_iter_parent (GtkTreeModel *tree_model, GtkTreeIter *iter, GtkTreeIter *child) =for apidoc Returns a new iter pointing to I<$child>'s parent node, or undef if I<$child> doesn't have a parent. I<$child> is unaltered. =cut GtkTreeIter_copy * gtk_tree_model_iter_parent (tree_model, child) GtkTreeModel *tree_model GtkTreeIter *child PREINIT: GtkTreeIter iter; CODE: if (! gtk_tree_model_iter_parent (tree_model, &iter, child)) XSRETURN_UNDEF; RETVAL = &iter; OUTPUT: RETVAL ## void gtk_tree_model_ref_node (GtkTreeModel *tree_model, GtkTreeIter *iter) =for apidoc Lets the tree ref the node. This is an optional method for models to implement. To be more specific, models may ignore this call as it exists primarily for performance reasons. This function is primarily meant as a way for views to let caching model know when nodes are being displayed (and hence, whether or not to cache that node.) For example, a file-system based model would not want to keep the entire file-hierarchy in memory, just the sections that are currently being displayed by every current view. A model should be expected to be able to get an iter independent of its reffed state. =cut void gtk_tree_model_ref_node (tree_model, iter) GtkTreeModel *tree_model GtkTreeIter *iter ## void gtk_tree_model_unref_node (GtkTreeModel *tree_model, GtkTreeIter *iter) =for apidoc Lets the tree unref the node. This is an optional method for models to implement. To be more specific, models may ignore this call as it exists primarily for performance reasons. For more information on what this means, see C. Please note that nodes that are deleted are not unreffed. =cut void gtk_tree_model_unref_node (tree_model, iter) GtkTreeModel *tree_model GtkTreeIter *iter ## void gtk_tree_model_foreach (GtkTreeModel *model, GtkTreeModelForeachFunc func, gpointer user_data) =for apidoc =for arg func (subroutine) Call I<$func> on each row in I<$model> as bool = &$func ($model, $path, $iter, $user_data) If I<$func> returns true, the tree ceases to be walked, and C<< $treemodel->foreach >> returns. =cut void gtk_tree_model_foreach (model, func, user_data=NULL) GtkTreeModel *model SV * func SV * user_data PREINIT: GPerlCallback * callback; GType types[3]; CODE: types[0] = GTK_TYPE_TREE_MODEL; types[1] = GTK_TYPE_TREE_PATH; types[2] = GTK_TYPE_TREE_ITER; callback = gperl_callback_new (func, user_data, G_N_ELEMENTS (types), types, G_TYPE_BOOLEAN); gtk_tree_model_foreach (model, gtk2perl_tree_model_foreach_func, callback); gperl_callback_destroy (callback); ## void gtk_tree_model_row_changed (GtkTreeModel *tree_model, GtkTreePath *path, GtkTreeIter *iter) =for apidoc Emits the "row_changed" signal on I<$tree_model>. =cut void gtk_tree_model_row_changed (tree_model, path, iter) GtkTreeModel *tree_model GtkTreePath *path GtkTreeIter *iter ## void gtk_tree_model_row_inserted (GtkTreeModel *tree_model, GtkTreePath *path, GtkTreeIter *iter) =for apidoc Emits the "row_inserted" signal on I<$tree_model>. =cut void gtk_tree_model_row_inserted (tree_model, path, iter) GtkTreeModel *tree_model GtkTreePath *path GtkTreeIter *iter ## void gtk_tree_model_row_has_child_toggled (GtkTreeModel *tree_model, GtkTreePath *path, GtkTreeIter *iter) =for apidoc Emits the "row_has_child_toggled" signal on I<$tree_model>. This should be called by models after the child state of a node changes. =cut void gtk_tree_model_row_has_child_toggled (tree_model, path, iter) GtkTreeModel *tree_model GtkTreePath *path GtkTreeIter *iter ## void gtk_tree_model_row_deleted (GtkTreeModel *tree_model, GtkTreePath *path) =for apidoc Emits the "row_deleted" signal on I<$tree_model>. This should be called by models after a row has been removed. The location pointed to by I<$path> should be the removed row's old location. It may not be a valid location anymore. =cut void gtk_tree_model_row_deleted (tree_model, path) GtkTreeModel *tree_model GtkTreePath *path #### void gtk_tree_model_rows_reordered (GtkTreeModel *tree_model, GtkTreePath *path, GtkTreeIter *iter, gint *new_order) =for apidoc =for arg path the tree node whose children have been reordered =for arg iter the tree node whose children have been reordered =for arg ... (list) list of integers mapping the current position of each child to its old position before the re-ordering, i.e. $new_order[$newpos] = $oldpos. There should be as many elements in this list as there are rows in I<$tree_model>. Emits the "rows-reordered" signal on I<$tree_model>/ This should be called by models with their rows have been reordered. =cut void gtk_tree_model_rows_reordered (tree_model, path, iter, ...) GtkTreeModel *tree_model GtkTreePath *path GtkTreeIter_ornull *iter PREINIT: gint *new_order; int n, i; CODE: n = gtk_tree_model_iter_n_children (tree_model, iter); if (items - 3 != n) croak ("rows_reordered expects a list of as many indices" " as the selected node of the model has children\n" " got %d, expected %d", (int) (items - 3), n); new_order = g_new (gint, n); for (i = 0 ; i < n ; i++) new_order[i] = SvIV (ST (3+i)); gtk_tree_model_rows_reordered (tree_model, path, iter, new_order); g_free (new_order); Gtk2-1.24992/xs/GtkInvisible.xs0000644000175000017500000000301513076462677014542 0ustar lacklack/* * Copyright (c) 2003 by the gtk2-perl team (see the file AUTHORS) * * This library is free software; you can redistribute it and/or * modify it under the terms of the GNU Library General Public * License as published by the Free Software Foundation; either * version 2.1 of the License, or (at your option) any later version. * * This library is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU * Library General Public License for more details. * * You should have received a copy of the GNU Library General Public * License along with this library; if not, write to the * Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, * Boston, MA 02110-1301 USA. * * $Id$ */ #include "gtk2perl.h" MODULE = Gtk2::Invisible PACKAGE = Gtk2::Invisible PREFIX = gtk_invisible_ ## GtkWidget* gtk_invisible_new (void) GtkWidget * gtk_invisible_new (class) C_ARGS: /* void */ #if GTK_CHECK_VERSION(2,2,0) ##GtkWidget * gtk_invisible_new_for_screen (GdkScreen *screen) GtkWidget * gtk_invisible_new_for_screen (class, screen) GdkScreen *screen C_ARGS: screen ##void gtk_invisible_set_screen (GtkInvisible *invisible, GdkScreen *screen) void gtk_invisible_set_screen (invisible, screen) GtkInvisible *invisible GdkScreen *screen ##GdkScreen * gtk_invisible_get_screen (GtkInvisible *invisible) GdkScreen * gtk_invisible_get_screen (invisible) GtkInvisible *invisible #endif Gtk2-1.24992/xs/GtkHPaned.xs0000644000175000017500000000173613076462677013765 0ustar lacklack/* * Copyright (c) 2003 by the gtk2-perl team (see the file AUTHORS) * * This library is free software; you can redistribute it and/or * modify it under the terms of the GNU Library General Public * License as published by the Free Software Foundation; either * version 2.1 of the License, or (at your option) any later version. * * This library is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU * Library General Public License for more details. * * You should have received a copy of the GNU Library General Public * License along with this library; if not, write to the * Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, * Boston, MA 02110-1301 USA. * * $Id$ */ #include "gtk2perl.h" MODULE = Gtk2::HPaned PACKAGE = Gtk2::HPaned PREFIX = gtk_hpaned_ GtkWidget * gtk_hpaned_new (class) C_ARGS: /* void */ Gtk2-1.24992/xs/GtkTextTag.xs0000644000175000017500000000432013076462677014176 0ustar lacklack/* * Copyright (c) 2003 by the gtk2-perl team (see the file AUTHORS) * * This library is free software; you can redistribute it and/or * modify it under the terms of the GNU Library General Public * License as published by the Free Software Foundation; either * version 2.1 of the License, or (at your option) any later version. * * This library is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU * Library General Public License for more details. * * You should have received a copy of the GNU Library General Public * License along with this library; if not, write to the * Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, * Boston, MA 02110-1301 USA. * * $Id$ */ #include "gtk2perl.h" MODULE = Gtk2::TextTag PACKAGE = Gtk2::TextTag PREFIX = gtk_text_tag_ GtkTextTag_noinc * gtk_text_tag_new (class, name=NULL) const gchar_ornull * name C_ARGS: name gint gtk_text_tag_get_priority (tag) GtkTextTag *tag void gtk_text_tag_set_priority (tag, priority) GtkTextTag *tag gint priority ## gboolean gtk_text_tag_event (GtkTextTag *tag, GObject *event_object, GdkEvent *event, const GtkTextIter *iter) gboolean gtk_text_tag_event (tag, event_object, event, iter) GtkTextTag *tag GObject *event_object GdkEvent *event GtkTextIter *iter MODULE = Gtk2::TextTag PACKAGE = Gtk2::TextAttributes PREFIX = gtk_text_attributes_ ## GtkTextAttributes* gtk_text_attributes_new (void) GtkTextAttributes_own * gtk_text_attributes_new (class) C_ARGS: /* void */ ## void gtk_text_attributes_copy_values (GtkTextAttributes *src, GtkTextAttributes *dest) ### swapping the order of these, because i think the method is pulling the ### parameters from another object; as a method, you modify yourself, not ### somebody else. void gtk_text_attributes_copy_values (dest, src) GtkTextAttributes *dest GtkTextAttributes *src C_ARGS: src, dest ### taken care of by Glib::Boxed #### GtkTextAttributes * gtk_text_attributes_copy (GtkTextAttributes *src) #### void gtk_text_attributes_unref (GtkTextAttributes *values) #### void gtk_text_attributes_ref (GtkTextAttributes *values) Gtk2-1.24992/xs/GdkImage.xs0000644000175000017500000001563313076462677013631 0ustar lacklack/* * Copyright (c) 2010 by the gtk2-perl team (see the file AUTHORS) * * This library is free software; you can redistribute it and/or * modify it under the terms of the GNU Library General Public * License as published by the Free Software Foundation; either * version 2.1 of the License, or (at your option) any later version. * * This library is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU * Library General Public License for more details. * * You should have received a copy of the GNU Library General Public * License along with this library; if not, write to the * Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, * Boston, MA 02110-1301 USA. */ #include "gtk2perl.h" #if ! GTK_CHECK_VERSION (2, 22, 0) /* plain fields before the accessor funcs of course the plain fields are better :-( */ #define gdk_image_get_bits_per_pixel(image) ((image)->bits_per_pixel) #define gdk_image_get_bytes_per_pixel(image) ((image)->bpp) #define gdk_image_get_bytes_per_line(image) ((image)->bpl) #define gdk_image_get_byte_order(image) ((image)->byte_order) #define gdk_image_get_depth(image) ((image)->depth) #define gdk_image_get_height(image) ((image)->height) #define gdk_image_get_image_type(image) ((image)->type) #define gdk_image_get_visual(image) ((image)->visual) #define gdk_image_get_width(image) ((image)->width) #define gdk_image_get_pixels(image) ((image)->mem) #endif MODULE = Gtk2::Gdk::Image PACKAGE = Gtk2::Gdk::Image PREFIX = gdk_image_ =for position DESCRIPTION =head1 DESCRIPTION A C is a 2-D array of pixel values in client-side memory. It can optionally use shared memory with the X server for fast copying to or from a window or pixmap. If you're thinking of using this then look at C first. GdkPixbuf has many more features, in particular file read and write (PNG, JPEG, etc). But a GdkImage lets you work directly in pixel values instead of expanding to RGB components. See L for C, C and C methods to draw or fetch images to or from a window or pixmap. The various C methods are Gtk 2.22 style. For previous versions they're direct field access. =cut GdkImage_noinc_ornull * gdk_image_new (class, type, visual, width, height) GdkImageType type GdkVisual *visual gint width gint height C_ARGS: type, visual, width, height # #ifndef GDK_DISABLE_DEPRECATED ## now called gdk_drawable_get_image(), for no discernible reason # GdkImage* gdk_image_get (GdkDrawable *drawable, # gint x, # gint y, # gint width, # gint height); ## not needed # GdkImage * gdk_image_ref (GdkImage *image); # void gdk_image_unref (GdkImage *image); # #endif /* GDK_DISABLE_DEPRECATED */ void gdk_image_put_pixel (image, x, y, pixel) GdkImage *image gint x gint y guint32 pixel guint32 gdk_image_get_pixel (image, x, y) GdkImage *image gint x gint y void gdk_image_set_colormap (image, colormap) GdkImage *image GdkColormap *colormap GdkColormap* gdk_image_get_colormap (image) GdkImage *image ## This looks like a perfectly good function, and a good way to get ## bitmap or whatever data into an image. It seems to be declared ## "broken" because it happens to have used malloc() instead of ## g_malloc(), and/or takes over the block of memory it was handed, ## which are pretty minor matters really ... :-( #ifdef GDK_ENABLE_BROKEN ## Untested, probably should look at the visual bytes-per-whatever for ## the SV length check. ## ## =for arg data (string) ## =cut ## GdkImage_noinc * ## gdk_image_new_bitmap (class, visual, data, width, height) ## GdkVisual *visual ## SV *data ## gint width ## gint height ## PREINIT: ## char *malloced_data, *data_ptr; ## size_t want_len; ## STRLEN data_len; ## CODE: ## want_len = (height * (int) ((width + 7) / 8)); ## data_ptr = SvPVbyte (data, data_len); ## if (data_len != want_len) { ## croak ("Bitmap data length %u should be %u", ## data_len, want_len); ## } ## malloced_data = malloc (want_len); ## if (malloced_data == NULL) { ## croak ("Cannot malloc memory"); ## } ## RETVAL = gdk_image_new_bitmap (visual, data, width, height); #endif /* GDK_ENABLE_BROKEN */ ## not needed # #ifndef GDK_DISABLE_DEPRECATED # #define gdk_image_destroy g_object_unref # #endif /* GDK_DISABLE_DEPRECATED */ ##----------------------------------------------------------------------------- ## Field accessors GdkImageType gdk_image_get_image_type (image) GdkImage *image GdkVisual * gdk_image_get_visual (image) GdkImage *image GdkByteOrder gdk_image_get_byte_order (image) GdkImage *image gint gdk_image_get_bytes_per_pixel (image) GdkImage *image ALIAS: get_bytes_per_line = 1 get_bits_per_pixel = 2 get_depth = 3 get_width = 4 get_height = 5 CODE: /* the guint16 fields expand to gint for RETVAL */ switch (ix) { case 0: RETVAL = gdk_image_get_bytes_per_pixel(image); break; case 1: RETVAL = gdk_image_get_bytes_per_line(image); break; case 2: RETVAL = gdk_image_get_bits_per_pixel(image); break; case 3: RETVAL = gdk_image_get_depth(image); break; case 4: RETVAL = gdk_image_get_width(image); break; default: /* case 5 */ RETVAL = gdk_image_get_height(image); break; } OUTPUT: RETVAL =for signature string = $image->get_pixels() =for apidoc Return a copy of the raw pixel data memory from C<$image>. This is C many bytes. =cut ## This is a copy similar to the way C C ## copies. Perhaps in the future some sort of C could ## get just part of it, or C or 4-arg substr write to part of it, ## as an alternative to individual C / C. ## ## A magic sv which could be read and written to modify the image data ## might be cute, but is probably more trouble than its worth. substr ## fetch/store funcs would make it clearer what's being done. ## ## If a magic scalar held a reference then there's a gremlin in Perl ## 5.10 lvalue C where such an sv gets kept alive in the ## function scratchpad, risking the underlying GdkImage kept alive ## longer than it should be. Or if it didn't hold a reference you'd ## have to rely on the application to keep the GdkImage alive while ## the raw memory was being manipulated. ## SV * gdk_image_get_pixels (image) GdkImage *image CODE: /* Crib note: memory block size is "bytes_per_line * height" per the shmget() or malloc() in _gdk_image_new_for_depth() of gdkimage-x11.c */ RETVAL = newSVpv ((char *) image->mem, image->bpl * image->height); OUTPUT: RETVAL Gtk2-1.24992/xs/GtkColorButton.xs0000644000175000017500000000267413076462677015102 0ustar lacklack/* * Copyright (c) 2003 by the gtk2-perl team (see the file AUTHORS) * * Licensed under the LGPL, see LICENSE file for more information. * * $Id$ */ #include "gtk2perl.h" MODULE = Gtk2::ColorButton PACKAGE = Gtk2::ColorButton PREFIX = gtk_color_button_ ## GtkWidget *gtk_color_button_new (void); ## GtkWidget *gtk_color_button_new_with_color (GdkColor *color); GtkWidget * gtk_color_button_new (class, GdkColor*color=NULL) ALIAS: new_with_color = 1 CODE: PERL_UNUSED_VAR (ix); if (items == 2) RETVAL = gtk_color_button_new_with_color (color); else RETVAL = gtk_color_button_new (); OUTPUT: RETVAL void gtk_color_button_set_color (GtkColorButton *color_button, GdkColor *color); void gtk_color_button_set_alpha (GtkColorButton *color_button, guint16 alpha); ## void gtk_color_button_get_color (GtkColorButton *color_button, GdkColor *color); GdkColor_copy * gtk_color_button_get_color (GtkColorButton *color_button) PREINIT: GdkColor color; CODE: gtk_color_button_get_color (color_button, &color); RETVAL = &color; OUTPUT: RETVAL guint16 gtk_color_button_get_alpha (GtkColorButton *color_button); void gtk_color_button_set_use_alpha (GtkColorButton *color_button, gboolean use_alpha); gboolean gtk_color_button_get_use_alpha (GtkColorButton *color_button); void gtk_color_button_set_title (GtkColorButton *color_button, const gchar *title); const gchar *gtk_color_button_get_title (GtkColorButton *color_button); Gtk2-1.24992/xs/GtkRc.xs0000644000175000017500000001630513076462677013170 0ustar lacklack/* * Copyright (c) 2003 by the gtk2-perl team (see the file AUTHORS) * * This library is free software; you can redistribute it and/or * modify it under the terms of the GNU Library General Public * License as published by the Free Software Foundation; either * version 2.1 of the License, or (at your option) any later version. * * This library is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU * Library General Public License for more details. * * You should have received a copy of the GNU Library General Public * License along with this library; if not, write to the * Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, * Boston, MA 02110-1301 USA. * * $Id$ */ #include "gtk2perl.h" MODULE = Gtk2::Rc PACKAGE = Gtk2::Rc PREFIX = gtk_rc_ ## void _gtk_rc_init (void) ## void gtk_rc_add_default_file (const gchar *filename) void gtk_rc_add_default_file (class, filename) GPerlFilename filename C_ARGS: filename =for apidoc Returns the list of files that GTK+ will read at the end of Gtk2->init. =cut ## gchar** gtk_rc_get_default_files (void) void gtk_rc_get_default_files (class) PREINIT: gchar **filenames = NULL; int i; PPCODE: PERL_UNUSED_VAR (ax); filenames = gtk_rc_get_default_files (); if (filenames) for (i = 0; filenames[i]; i++) XPUSHs (sv_2mortal (gperl_sv_from_filename (filenames[i]))); ## void gtk_rc_set_default_files (gchar **filenames) =for apidoc =for signature Gtk2::Rc->set_default_files (file1, ...) =for arg file1 (GPerlFilename) =for arg ... of strings, the rc files to be parsed Sets the list of files that GTK+ will read at the end of Gtk2->init. =cut void gtk_rc_set_default_files (class, ...) PREINIT: gchar **filenames = NULL; int i; CODE: filenames = g_new0(gchar*, items); for( i = 1; i < items; i++ ) filenames[i - 1] = gperl_filename_from_sv (ST(i)); gtk_rc_set_default_files(filenames); g_free(filenames); ## GtkStyle* gtk_rc_get_style (GtkWidget *widget) GtkStyle* gtk_rc_get_style (class, widget) GtkWidget *widget C_ARGS: widget ## GtkStyle* gtk_rc_get_style_by_paths (GtkSettings *settings, const char *widget_path, const char *class_path, GType type) GtkStyle * gtk_rc_get_style_by_paths (class, settings, widget_path, class_path, package) GtkSettings *settings const char * widget_path const char * class_path const char * package PREINIT: GType gtype = {0,}; CODE: gtype = gperl_object_type_from_package (package); RETVAL = gtk_rc_get_style_by_paths (settings, widget_path, class_path, gtype); OUTPUT: RETVAL ## gboolean gtk_rc_reparse_all_for_settings (GtkSettings *settings, gboolean force_load) gboolean gtk_rc_reparse_all_for_settings (class, settings, force_load) GtkSettings *settings gboolean force_load C_ARGS: settings, force_load #if GTK_CHECK_VERSION (2, 4, 0) ## void gtk_rc_reset_styles (GtkSettings *settings) void gtk_rc_reset_styles (class, settings) GtkSettings *settings C_ARGS: settings #endif # TODO: GScanner * not in typemap ## gchar* gtk_rc_find_pixmap_in_path (GtkSettings *settings, GScanner *scanner, const gchar *pixmap_file) #gchar* #gtk_rc_find_pixmap_in_path (settings, scanner, pixmap_file) # GtkSettings *settings # GScanner *scanner # const gchar *pixmap_file ## void gtk_rc_parse (const gchar *filename) void gtk_rc_parse (class, filename) GPerlFilename filename C_ARGS: filename ## void gtk_rc_parse_string (const gchar *rc_string) void gtk_rc_parse_string (class, rc_string) const gchar * rc_string C_ARGS: rc_string ## gboolean gtk_rc_reparse_all (void) gboolean gtk_rc_reparse_all (class) C_ARGS: /* void */ # API docs: "This function is not useful for applications and should not be used." ### gchar* gtk_rc_find_module_in_path (const gchar *module_file) #gchar_own * #gtk_rc_find_module_in_path (class, module_file) # const gchar * module_file # C_ARGS: # module_file ## gchar* gtk_rc_get_theme_dir (void) gchar_own * gtk_rc_get_theme_dir (class) C_ARGS: /* void */ ## gchar* gtk_rc_get_module_dir (void) gchar_own * gtk_rc_get_module_dir (class) C_ARGS: /* void */ ## gchar* gtk_rc_get_im_module_path (void) gchar_own * gtk_rc_get_im_module_path (class) C_ARGS: /* void */ ## gchar* gtk_rc_get_im_module_file (void) gchar_own * gtk_rc_get_im_module_file (class) C_ARGS: /* void */ MODULE = Gtk2::Rc PACKAGE = Gtk2::RcStyle PREFIX = gtk_rc_style_ SV * name (style, new=NULL) GtkRcStyle *style SV *new ALIAS: font_desc = 1 xthickness = 2 ythickness = 3 CODE: switch (ix) { case 0: RETVAL = newSVGChar (style->name); break; case 1: RETVAL = newSVPangoFontDescription (style->font_desc); break; case 2: RETVAL = newSViv (style->xthickness); break; case 3: RETVAL = newSViv (style->ythickness); break; default: RETVAL = NULL; g_assert_not_reached (); } if (items == 2) { switch (ix) { case 0: if (style->name) g_free (style->name); style->name = gperl_sv_is_defined (new) ? g_strdup (SvGChar (new)) : NULL; break; case 1: if (style->font_desc) pango_font_description_free (style->font_desc); style->font_desc = gperl_sv_is_defined (new) ? SvPangoFontDescription (new) : NULL; if (style->font_desc) style->font_desc = pango_font_description_copy (style->font_desc); break; case 2: style->xthickness = SvIV (new); break; case 3: style->ythickness = SvIV (new); break; default: g_assert_not_reached (); } } OUTPUT: RETVAL SV * bg_pixmap_name (style, state, new=NULL) GtkRcStyle *style GtkStateType state gchar_ornull *new CODE: RETVAL = style->bg_pixmap_name[state] ? newSVGChar (style->bg_pixmap_name[state]) : NULL; if (items == 3) { if (style->bg_pixmap_name[state]) g_free (style->bg_pixmap_name[state]); style->bg_pixmap_name[state] = new ? g_strdup (new) : NULL; } OUTPUT: RETVAL GtkRcFlags color_flags (style, state, new=0) GtkRcStyle *style GtkStateType state GtkRcFlags new CODE: RETVAL = style->color_flags[state]; if (items == 3) style->color_flags[state] = new; OUTPUT: RETVAL GdkColor_copy * fg (style, state, new=NULL) GtkRcStyle *style GtkStateType state GdkColor_ornull *new ALIAS: bg = 1 text = 2 base = 3 CODE: switch (ix) { case 0: RETVAL = &(style->fg[state]); break; case 1: RETVAL = &(style->bg[state]); break; case 2: RETVAL = &(style->text[state]); break; case 3: RETVAL = &(style->base[state]); break; default: RETVAL = NULL; g_assert_not_reached (); } if (items == 3) { switch (ix) { case 0: style->fg[state] = *new; break; case 1: style->bg[state] = *new; break; case 2: style->text[state] = *new; break; case 3: style->base[state] = *new; break; default: g_assert_not_reached (); } } OUTPUT: RETVAL ## GtkRcStyle* gtk_rc_style_new (void) GtkRcStyle_noinc * gtk_rc_style_new (class) C_ARGS: /*void*/ # GtkRcStyle* gtk_rc_style_copy (GtkRcStyle *orig) GtkRcStyle_noinc * gtk_rc_style_copy (orig) GtkRcStyle * orig # should happen automagically ## void gtk_rc_style_ref (GtkRcStyle *rc_style) ## void gtk_rc_style_unref (GtkRcStyle *rc_style) Gtk2-1.24992/xs/GtkAspectFrame.xs0000644000175000017500000000364313076462677015017 0ustar lacklack/* * Copyright (c) 2003, 2010 by the gtk2-perl team (see the file AUTHORS) * * This library is free software; you can redistribute it and/or * modify it under the terms of the GNU Library General Public * License as published by the Free Software Foundation; either * version 2.1 of the License, or (at your option) any later version. * * This library is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU * Library General Public License for more details. * * You should have received a copy of the GNU Library General Public * License along with this library; if not, write to the * Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, * Boston, MA 02110-1301 USA. * * $Id$ */ #include "gtk2perl.h" MODULE = Gtk2::AspectFrame PACKAGE = Gtk2::AspectFrame PREFIX = gtk_aspect_frame_ ## GtkWidget* gtk_aspect_frame_new (const gchar *label, gfloat xalign, gfloat yalign, gfloat ratio, gboolean obey_child) # label can be NULL for no label, as per gtk_frame_set_label() etc, # though not actually in the gtk_aspect_frame_new() docs as of Gtk 2.20 GtkWidget * gtk_aspect_frame_new (class, label, xalign, yalign, ratio, obey_child) const gchar_ornull * label gfloat xalign gfloat yalign gfloat ratio gboolean obey_child C_ARGS: label, xalign, yalign, ratio, obey_child ## void gtk_aspect_frame_set (GtkAspectFrame *aspect_frame, gfloat xalign, gfloat yalign, gfloat ratio, gboolean obey_child) ### NOTE: renamed to avoid clashing with Glib::Object->set void gtk_aspect_frame_set_params (aspect_frame, xalign, yalign, ratio, obey_child) GtkAspectFrame * aspect_frame gfloat xalign gfloat yalign gfloat ratio gboolean obey_child CODE: gtk_aspect_frame_set (aspect_frame, xalign, yalign, ratio, obey_child); Gtk2-1.24992/xs/GtkExpander.xs0000644000175000017500000000301713076462677014366 0ustar lacklack/* * Copyright (c) 2003 by the gtk2-perl team (see the file AUTHORS) * * Licensed under the LGPL, see LICENSE file for more information. * * $Id$ */ #include "gtk2perl.h" MODULE = Gtk2::Expander PACKAGE = Gtk2::Expander PREFIX = gtk_expander_ GtkWidget *gtk_expander_new (class, const gchar_ornull *label=NULL); C_ARGS: label GtkWidget *gtk_expander_new_with_mnemonic (class, const gchar *label); C_ARGS: label void gtk_expander_set_expanded (GtkExpander *expander, gboolean expanded); gboolean gtk_expander_get_expanded (GtkExpander *expander); ###/* Spacing between the expander/label and the child */ void gtk_expander_set_spacing (GtkExpander *expander, gint spacing); gint gtk_expander_get_spacing (GtkExpander *expander); void gtk_expander_set_label (GtkExpander *expander, const gchar *label); ## G_CONST_RETURN const gchar *gtk_expander_get_label (GtkExpander *expander); void gtk_expander_set_use_underline (GtkExpander *expander, gboolean use_underline); gboolean gtk_expander_get_use_underline (GtkExpander *expander); void gtk_expander_set_use_markup (GtkExpander *expander, gboolean use_markup) gboolean gtk_expander_get_use_markup (GtkExpander *expander) void gtk_expander_set_label_widget (GtkExpander *expander, GtkWidget *label_widget); GtkWidget *gtk_expander_get_label_widget (GtkExpander *expander); #if GTK_CHECK_VERSION (2, 22, 0) void gtk_expander_set_label_fill (GtkExpander *expander, gboolean label_fill); gboolean gtk_expander_get_label_fill (GtkExpander *expander); #endif /* 2.22 */ Gtk2-1.24992/xs/GtkCellView.xs0000644000175000017500000000352313076462677014334 0ustar lacklack/* * Copyright (c) 2004 by the gtk2-perl team (see the file AUTHORS) * * Licensed under the LGPL, see LICENSE file for more information. * * $Id$ */ #include "gtk2perl.h" MODULE = Gtk2::CellView PACKAGE = Gtk2::CellView PREFIX = gtk_cell_view_ GtkWidget * gtk_cell_view_new (class) C_ARGS: /* void */ GtkWidget * gtk_cell_view_new_with_text (class, text) const gchar * text C_ARGS: text GtkWidget * gtk_cell_view_new_with_markup (class, markup) const gchar * markup C_ARGS: markup GtkWidget * gtk_cell_view_new_with_pixbuf (class, pixbuf) GdkPixbuf * pixbuf C_ARGS: pixbuf void gtk_cell_view_set_model (GtkCellView * cell_view, GtkTreeModel_ornull * model); void gtk_cell_view_set_displayed_row (GtkCellView * cell_view, GtkTreePath * path); GtkTreePath_own * gtk_cell_view_get_displayed_row (GtkCellView * cell_view); ## gboolean gtk_cell_view_get_size_of_row (GtkCellView * cell_view, GtkTreePath * path, GtkRequisition * requisition); GtkRequisition_copy * gtk_cell_view_get_size_of_row (GtkCellView * cell_view, GtkTreePath * path) PREINIT: GtkRequisition requisition; CODE: gtk_cell_view_get_size_of_row (cell_view, path, &requisition); RETVAL = &requisition; OUTPUT: RETVAL void gtk_cell_view_set_background_color (GtkCellView * cell_view, const GdkColor * color); ## GList * gtk_cell_view_get_cell_renderers (GtkCellView * cellview); void gtk_cell_view_get_cell_renderers (GtkCellView * cellview); PREINIT: GList * list; PPCODE: list = gtk_cell_view_get_cell_renderers (cellview); if (list) { GList * curr; for (curr = list; curr; curr = g_list_next (curr)) XPUSHs (sv_2mortal (newSVGtkCellRenderer (curr->data))); g_list_free (list); } else XSRETURN_EMPTY; #if GTK_CHECK_VERSION (2, 16, 0) GtkTreeModel_ornull * gtk_cell_view_get_model (GtkCellView * cellview); #endif /* 2.16 */ Gtk2-1.24992/xs/GtkHandleBox.xs0000644000175000017500000000472413076462677014472 0ustar lacklack/* * Copyright (c) 2003 by the gtk2-perl team (see the file AUTHORS) * * This library is free software; you can redistribute it and/or * modify it under the terms of the GNU Library General Public * License as published by the Free Software Foundation; either * version 2.1 of the License, or (at your option) any later version. * * This library is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU * Library General Public License for more details. * * You should have received a copy of the GNU Library General Public * License along with this library; if not, write to the * Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, * Boston, MA 02110-1301 USA. * * $Id$ */ #include "gtk2perl.h" MODULE = Gtk2::HandleBox PACKAGE = Gtk2::HandleBox PREFIX = gtk_handle_box_ =for enum GtkPositionType =cut =for enum GtkShadowType =cut ## GtkWidget* gtk_handle_box_new (void) GtkWidget * gtk_handle_box_new (class) C_ARGS: /* void */ ## void gtk_handle_box_set_shadow_type (GtkHandleBox *handle_box, GtkShadowType type) void gtk_handle_box_set_shadow_type (handle_box, type) GtkHandleBox * handle_box GtkShadowType type ## GtkShadowType gtk_handle_box_get_shadow_type (GtkHandleBox *handle_box) GtkShadowType gtk_handle_box_get_shadow_type (handle_box) GtkHandleBox * handle_box ## void gtk_handle_box_set_handle_position (GtkHandleBox *handle_box, GtkPositionType position) void gtk_handle_box_set_handle_position (handle_box, position) GtkHandleBox * handle_box GtkPositionType position ## GtkPositionType gtk_handle_box_get_handle_position(GtkHandleBox *handle_box) GtkPositionType gtk_handle_box_get_handle_position (handle_box) GtkHandleBox * handle_box ## void gtk_handle_box_set_snap_edge (GtkHandleBox *handle_box, GtkPositionType edge) void gtk_handle_box_set_snap_edge (handle_box, edge) GtkHandleBox * handle_box GtkPositionType edge ## GtkPositionType gtk_handle_box_get_snap_edge (GtkHandleBox *handle_box) GtkPositionType gtk_handle_box_get_snap_edge (handle_box) GtkHandleBox * handle_box ## Added to have an accessor for child_detached. gboolean gtk_handle_box_get_child_detached (handle_box) GtkHandleBox * handle_box CODE: #if GTK_CHECK_VERSION (2, 14, 0) RETVAL = gtk_handle_box_get_child_detached (handle_box); #else RETVAL = handle_box->child_detached; #endif /* 2.14 */ OUTPUT: RETVAL Gtk2-1.24992/xs/GtkCellRendererSpinner.xs0000644000175000017500000000055713076462677016533 0ustar lacklack/* * Copyright (c) 2010 by the gtk2-perl team (see the file AUTHORS) * * Licensed under the LGPL, see LICENSE file for more information. * * $Id$ */ #include "gtk2perl.h" MODULE = Gtk2::CellRendererSpinner PACKAGE = Gtk2::CellRendererSpinner PREFIX = gtk_cell_renderer_spinner_ GtkCellRenderer * gtk_cell_renderer_spinner_new (class) C_ARGS: /* void */ Gtk2-1.24992/xs/GtkBox.xs0000644000175000017500000000463213076462677013354 0ustar lacklack/* * Copyright (c) 2003 by the gtk2-perl team (see the file AUTHORS) * * This library is free software; you can redistribute it and/or * modify it under the terms of the GNU Library General Public * License as published by the Free Software Foundation; either * version 2.1 of the License, or (at your option) any later version. * * This library is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU * Library General Public License for more details. * * You should have received a copy of the GNU Library General Public * License along with this library; if not, write to the * Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, * Boston, MA 02110-1301 USA. * * $Id$ */ #include "gtk2perl.h" MODULE = Gtk2::Box PACKAGE = Gtk2::Box PREFIX = gtk_box_ void gtk_box_pack_start (box, child, expand, fill, padding) GtkBox *box GtkWidget *child gboolean expand gboolean fill guint padding void gtk_box_pack_end (box, child, expand, fill, padding) GtkBox *box GtkWidget *child gboolean expand gboolean fill guint padding void gtk_box_pack_start_defaults (box, widget) GtkBox *box GtkWidget *widget void gtk_box_pack_end_defaults (box, widget) GtkBox *box GtkWidget *widget void gtk_box_set_homogeneous (box, homogeneous) GtkBox *box gboolean homogeneous gboolean gtk_box_get_homogeneous (box) GtkBox *box void gtk_box_set_spacing (box, spacing) GtkBox *box gint spacing gint gtk_box_get_spacing (box) GtkBox *box void gtk_box_reorder_child (box, child, position) GtkBox *box GtkWidget *child gint position # void gtk_box_query_child_packing (GtkBox * box, GtkWidget * child, gboolean &expand, gboolean &fill, guint &padding, GtkPackType &pack_type) void gtk_box_query_child_packing (GtkBox * box, GtkWidget * child) PREINIT: gboolean expand; gboolean fill; guint padding; GtkPackType pack_type; PPCODE: gtk_box_query_child_packing (box, child, &expand, &fill, &padding, &pack_type); EXTEND (SP, 4); PUSHs (sv_2mortal (boolSV (expand))); PUSHs (sv_2mortal (boolSV (fill))); PUSHs (sv_2mortal (newSVuv (padding))); PUSHs (sv_2mortal (newSVGtkPackType (pack_type))); void gtk_box_set_child_packing (box, child, expand, fill, padding, pack_type) GtkBox *box GtkWidget *child gboolean expand gboolean fill guint padding GtkPackType pack_type Gtk2-1.24992/xs/GdkSelection.xs0000644000175000017500000001335613076462677014534 0ustar lacklack/* * Copyright (c) 2003 by the gtk2-perl team (see the file AUTHORS) * * This library is free software; you can redistribute it and/or * modify it under the terms of the GNU Library General Public * License as published by the Free Software Foundation; either * version 2.1 of the License, or (at your option) any later version. * * This library is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU * Library General Public License for more details. * * You should have received a copy of the GNU Library General Public * License along with this library; if not, write to the * Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, * Boston, MA 02110-1301 USA. * * $Id$ */ #include "gtk2perl.h" MODULE = Gtk2::Gdk::Selection PACKAGE = Gtk2::Gdk GdkAtom SELECTION_PRIMARY (class) ALIAS: Gtk2::Gdk::SELECTION_SECONDARY = 1 Gtk2::Gdk::SELECTION_CLIPBOARD = 2 Gtk2::Gdk::TARGET_BITMAP = 3 Gtk2::Gdk::TARGET_COLORMAP = 4 Gtk2::Gdk::TARGET_DRAWABLE = 5 Gtk2::Gdk::TARGET_PIXMAP = 6 Gtk2::Gdk::TARGET_STRING = 7 Gtk2::Gdk::SELECTION_TYPE_ATOM = 8 Gtk2::Gdk::SELECTION_TYPE_BITMAP = 9 Gtk2::Gdk::SELECTION_TYPE_COLORMAP = 10 Gtk2::Gdk::SELECTION_TYPE_DRAWABLE = 11 Gtk2::Gdk::SELECTION_TYPE_INTEGER = 12 Gtk2::Gdk::SELECTION_TYPE_PIXMAP = 13 Gtk2::Gdk::SELECTION_TYPE_WINDOW = 14 Gtk2::Gdk::SELECTION_TYPE_STRING = 15 CODE: switch (ix) { case 0: RETVAL = GDK_SELECTION_PRIMARY; break; case 1: RETVAL = GDK_SELECTION_SECONDARY; break; case 2: RETVAL = GDK_SELECTION_CLIPBOARD; break; case 3: RETVAL = GDK_TARGET_BITMAP; break; case 4: RETVAL = GDK_TARGET_COLORMAP; break; case 5: RETVAL = GDK_TARGET_DRAWABLE; break; case 6: RETVAL = GDK_TARGET_PIXMAP; break; case 7: RETVAL = GDK_TARGET_STRING; break; case 8: RETVAL = GDK_SELECTION_TYPE_ATOM; break; case 9: RETVAL = GDK_SELECTION_TYPE_BITMAP; break; case 10: RETVAL = GDK_SELECTION_TYPE_COLORMAP; break; case 11: RETVAL = GDK_SELECTION_TYPE_DRAWABLE; break; case 12: RETVAL = GDK_SELECTION_TYPE_INTEGER; break; case 13: RETVAL = GDK_SELECTION_TYPE_PIXMAP; break; case 14: RETVAL = GDK_SELECTION_TYPE_WINDOW; break; case 15: RETVAL = GDK_SELECTION_TYPE_STRING; break; default: RETVAL = 0; g_assert_not_reached (); } OUTPUT: RETVAL MODULE = Gtk2::Gdk::Selection PACKAGE = Gtk2::Gdk::Selection PREFIX = gdk_selection_ ## since owner can be NULL, i interpret this to be a class method rather ## than an object method. ## gboolean gdk_selection_owner_set (GdkWindow *owner, GdkAtom selection, guint32 time_, gboolean send_event) gboolean gdk_selection_owner_set (class, owner, selection, time_, send_event) GdkWindow_ornull *owner GdkAtom selection guint32 time_ gboolean send_event C_ARGS: owner, selection, time_, send_event ## GdkWindow* gdk_selection_owner_get (GdkAtom selection) GdkWindow_ornull* gdk_selection_owner_get (class, selection) GdkAtom selection C_ARGS: selection #if GTK_CHECK_VERSION(2,2,0) ## gboolean gdk_selection_owner_set_for_display (GdkDisplay *display, GdkWindow *owner, GdkAtom selection, guint32 time_, gboolean send_event) gboolean gdk_selection_owner_set_for_display (class, display, owner, selection, time_, send_event) GdkDisplay *display GdkWindow *owner GdkAtom selection guint32 time_ gboolean send_event C_ARGS: display, owner, selection, time_, send_event ## GdkWindow *gdk_selection_owner_get_for_display (GdkDisplay *display, GdkAtom selection) GdkWindow_ornull * gdk_selection_owner_get_for_display (class, display, selection) GdkDisplay *display GdkAtom selection C_ARGS: display, selection #endif /* >=2.2.0 */ ## void gdk_selection_convert (GdkWindow *requestor, GdkAtom selection, GdkAtom target, guint32 time_) void gdk_selection_convert (class, requestor, selection, target, time_) GdkWindow *requestor GdkAtom selection GdkAtom target guint32 time_ C_ARGS: requestor, selection, target, time_ ## docs do not say deprecated, but recommend the use of GtkClipboard instead ## gboolean gdk_selection_property_get (GdkWindow *requestor, guchar **data, GdkAtom *prop_type, gint *prop_format) =for apidoc =for signature (data, prop_type, prop_format) = Gtk2::Gdk::Selection->property_get ($requestor) Use Gtk2::Clipboard instead. =cut void gdk_selection_property_get (class, requestor) GdkWindow *requestor PREINIT: guchar * data; GdkAtom prop_type; gint prop_format; PPCODE: if (!gdk_selection_property_get (requestor, &data, &prop_type, &prop_format)) XSRETURN_EMPTY; EXTEND (SP, 3); PUSHs (sv_2mortal (newSVpv ((gchar *) data, 0))); PUSHs (sv_2mortal (newSVGdkAtom (prop_type))); PUSHs (sv_2mortal (newSViv (prop_format))); g_free (data); ## void gdk_selection_send_notify (guint32 requestor, GdkAtom selection, GdkAtom target, GdkAtom property, guint32 time_) void gdk_selection_send_notify (class, requestor, selection, target, property, time_) guint32 requestor GdkAtom selection GdkAtom target GdkAtom property guint32 time_ C_ARGS: requestor, selection, target, property, time_ #if GTK_CHECK_VERSION(2,2,0) ## void gdk_selection_send_notify_for_display (GdkDisplay *display, guint32 requestor, GdkAtom selection, GdkAtom target, GdkAtom property, guint32 time_) void gdk_selection_send_notify_for_display (class, display, requestor, selection, target, property, time_) GdkDisplay *display guint32 requestor GdkAtom selection GdkAtom target GdkAtom property guint32 time_ C_ARGS: display, requestor, selection, target, property, time_ #endif /* >=2.2.0 */ Gtk2-1.24992/xs/GtkTreeSortable.xs0000644000175000017500000003224413076462677015217 0ustar lacklack/* * Copyright (c) 2003 by the gtk2-perl team (see the file AUTHORS) * * This library is free software; you can redistribute it and/or * modify it under the terms of the GNU Library General Public * License as published by the Free Software Foundation; either * version 2.1 of the License, or (at your option) any later version. * * This library is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU * Library General Public License for more details. * * You should have received a copy of the GNU Library General Public * License along with this library; if not, write to the * Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, * Boston, MA 02110-1301 USA. * * $Id$ */ #include "gtk2perl.h" /* ------------------------------------------------------------------------- */ #define PREP \ dSP; \ ENTER; \ SAVETMPS; \ PUSHMARK (SP); \ PUSHs (sv_2mortal (newSVGObject (G_OBJECT (sortable)))); #define CALL \ PUTBACK; \ call_sv ((SV *)GvCV (slot), G_VOID|G_DISCARD); #define FINISH \ FREETMPS; \ LEAVE; #define GET_METHOD(method) \ HV * stash = gperl_object_stash_from_type (G_OBJECT_TYPE (sortable)); \ GV * slot = gv_fetchmethod (stash, method); #define METHOD_EXISTS (slot && GvCV (slot)) /* ------------------------------------------------------------------------- */ static gboolean gtk2perl_tree_sortable_get_sort_column_id (GtkTreeSortable *sortable, gint *sort_column_id, GtkSortType *order) { gboolean retval = FALSE; gint real_sort_column_id; GtkSortType real_order; GET_METHOD ("GET_SORT_COLUMN_ID"); if (METHOD_EXISTS) { PREP; PUTBACK; if (3 != call_sv ((SV *) GvCV (slot), G_ARRAY)) croak ("GET_SORT_COLUMN_ID must return a boolean " "indicating whether the column is not special, " "the sort column id and the sort order"); SPAGAIN; real_order = SvGtkSortType (POPs); real_sort_column_id = POPi; retval = POPu; PUTBACK; FINISH; if (sort_column_id) *sort_column_id = real_sort_column_id; if (order) *order = real_order; } return retval; } /* ------------------------------------------------------------------------- */ static void gtk2perl_tree_sortable_set_sort_column_id (GtkTreeSortable *sortable, gint sort_column_id, GtkSortType order) { GET_METHOD ("SET_SORT_COLUMN_ID"); if (METHOD_EXISTS) { PREP; XPUSHs (sv_2mortal (newSViv (sort_column_id))); XPUSHs (sv_2mortal (newSVGtkSortType (order))); CALL; FINISH; } } /* ------------------------------------------------------------------------- */ /* The strategy: Put the given function pointer, user data and destruction * notification pointer into a struct. Make an IV SV pointing to that struct. * Create a blessed reference around this SV which has &{} overloading. When * the Perl programmer then invokes this SV, we recreate every necessary bit in * the invoke handler and call the C function. */ typedef struct { GtkTreeIterCompareFunc func; gpointer data; GtkDestroyNotify destroy; } Gtk2PerlTreeIterCompareFunc; static void create_callback (GtkTreeIterCompareFunc func, gpointer data, GtkDestroyNotify destroy, SV **code_return, SV **data_return) { HV *stash; SV *code_sv, *data_sv; Gtk2PerlTreeIterCompareFunc *stuff; stuff = g_new0 (Gtk2PerlTreeIterCompareFunc, 1); stuff->func = func; stuff->data = data; stuff->destroy = destroy; data_sv = newSViv (PTR2IV (stuff)); stash = gv_stashpv ("Gtk2::TreeSortable::IterCompareFunc", TRUE); code_sv = sv_bless (newRV (data_sv), stash); *code_return = code_sv; *data_return = data_sv; } static void gtk2perl_tree_sortable_set_sort_func (GtkTreeSortable *sortable, gint sort_column_id, GtkTreeIterCompareFunc func, gpointer data, GtkDestroyNotify destroy) { GET_METHOD ("SET_SORT_FUNC"); if (METHOD_EXISTS) { SV *code, *my_data; PREP; create_callback (func, data, destroy, &code, &my_data); XPUSHs (sv_2mortal (newSViv (sort_column_id))); XPUSHs (sv_2mortal (code)); XPUSHs (sv_2mortal (my_data)); CALL; FINISH; } } static void gtk2perl_tree_sortable_set_default_sort_func (GtkTreeSortable *sortable, GtkTreeIterCompareFunc func, gpointer data, GtkDestroyNotify destroy) { GET_METHOD ("SET_DEFAULT_SORT_FUNC"); if (METHOD_EXISTS) { SV *code, *my_data; PREP; create_callback (func, data, destroy, &code, &my_data); XPUSHs (sv_2mortal (newSVsv (code))); XPUSHs (sv_2mortal (newSVsv (my_data))); CALL; FINISH; } } /* ------------------------------------------------------------------------- */ static gboolean gtk2perl_tree_sortable_has_default_sort_func (GtkTreeSortable *sortable) { gboolean retval = FALSE; GET_METHOD ("HAS_DEFAULT_SORT_FUNC"); if (METHOD_EXISTS) { PREP; PUTBACK; if (1 != call_sv ((SV *) GvCV (slot), G_SCALAR)) croak ("HAS_DEFAULT_SORT_FUNC must return a boolean"); SPAGAIN; retval = POPu; PUTBACK; FINISH; } return retval; } /* ------------------------------------------------------------------------- */ static void gtk2perl_tree_sortable_init (GtkTreeSortableIface * iface) { iface->get_sort_column_id = gtk2perl_tree_sortable_get_sort_column_id; iface->set_sort_column_id = gtk2perl_tree_sortable_set_sort_column_id; iface->set_sort_func = gtk2perl_tree_sortable_set_sort_func; iface->set_default_sort_func = gtk2perl_tree_sortable_set_default_sort_func; iface->has_default_sort_func = gtk2perl_tree_sortable_has_default_sort_func; } /* ------------------------------------------------------------------------- */ static GPerlCallback * new_sort_func (SV * sort_func, SV * user_data) { GType param_types[3]; param_types[0] = GTK_TYPE_TREE_MODEL; param_types[1] = GTK_TYPE_TREE_ITER; param_types[2] = GTK_TYPE_TREE_ITER; return gperl_callback_new (sort_func, user_data, 3, param_types, G_TYPE_INT); } static gint gtk2perl_tree_iter_compare_func (GtkTreeModel *model, GtkTreeIter *a, GtkTreeIter *b, gpointer user_data) { gint ret; GValue retval = {0,}; GPerlCallback * callback = (GPerlCallback*) user_data; g_value_init (&retval, callback->return_type); gperl_callback_invoke (callback, &retval, model, a, b); ret = g_value_get_int (&retval); g_value_unset (&retval); return ret; } /* ------------------------------------------------------------------------- */ MODULE = Gtk2::TreeSortable PACKAGE = Gtk2::TreeSortable PREFIX = gtk_tree_sortable_ =for position post_methods =head1 IMPLEMENTING THE I INTERACE If you want your custom tree model to be sortable, you need to implement the I interface. Just like with other interfaces, this boils down to announcing that your subclass implements the interface and providing a few virtual methods. The former is achieved by adding C to the C key. For example: package MyModel; use Gtk2; use Glib::Object::Subclass Glib::Object::, interfaces => [ Gtk2::TreeModel::, Gtk2::TreeSortable:: ], ; The virtual methods you need to implement are listed below. =head2 VIRTUAL METHODS These virtual methods are called by perl when gtk+ attempts to modify the sorting behavior of your model. Implement them in your model's package. Note that we don't provide a wrapper for I because there is a signal for it, which means you can use the normal signal overriding mechanism documented in L. =over =item (is_not_special, id, order) = GET_SORT_COLUMN_ID ($model) Returns a boolean indicating whether the column is a special or normal one, its id and its sorting order. =item SET_SORT_COLUMN_ID ($list, $id, $order) Sets the sort column to the one specified by I<$id> and the sorting order to I<$order>. =item SET_SORT_FUNC ($list, $id, $func, $data) Sets the function that is to be used for sorting the column I<$id>. =item SET_DEFAULT_SORT_FUNC ($list, $func, $data) Sets the function that is to be used for sorting columns that don't have a sorting function attached to them. The I<$func> and I<$data> arguments passed to these two methods should be treated as blackboxes. They are generic containers for some callback that is to be invoked whenever you want to compare two tree iters. When you call them, make sure to always pass I<$data>. For example: $retval = $func->($list, $a, $b, $data); =item bool = HAS_DEFAULT_SORT_FUNC ($list) Returns a bool indicating whether I<$list> has a default sorting function. =back =cut =for apidoc __hide__ =cut void _ADD_INTERFACE (class, const char * target_class) CODE: { static const GInterfaceInfo iface_info = { (GInterfaceInitFunc) gtk2perl_tree_sortable_init, (GInterfaceFinalizeFunc) NULL, (gpointer) NULL }; GType gtype = gperl_object_type_from_package (target_class); g_type_add_interface_static (gtype, GTK_TYPE_TREE_SORTABLE, &iface_info); } ## void gtk_tree_sortable_sort_column_changed (GtkTreeSortable *sortable) void gtk_tree_sortable_sort_column_changed (sortable) GtkTreeSortable *sortable # FIXME: This is incorrectly bound. The boolean return value is meant to # indicate whether sort_column_id is a regular column or the default or an # invalid one. It says nothing about whether sort_column_id and order were # set. I don't see how we could fix this without breaking API compatibility. #### gboolean gtk_tree_sortable_get_sort_column_id (GtkTreeSortable *sortable, gint *sort_column_id, GtkSortType *order) =for apidoc =for signature (sort_column_id, order) = $sortable->get_sort_column_id Returns sort_column_id, an integer and order, a Gtk2::SortType. =cut void gtk_tree_sortable_get_sort_column_id (sortable) GtkTreeSortable *sortable PREINIT: gint sort_column_id; GtkSortType order; PPCODE: PUTBACK; if (!gtk_tree_sortable_get_sort_column_id (sortable, &sort_column_id, &order)) XSRETURN_EMPTY; SPAGAIN; EXTEND (SP, 2); PUSHs (sv_2mortal (newSViv (sort_column_id))); PUSHs (sv_2mortal (newSVGtkSortType (order))); ## void gtk_tree_sortable_set_sort_column_id (GtkTreeSortable *sortable, gint sort_column_id, GtkSortType order) void gtk_tree_sortable_set_sort_column_id (sortable, sort_column_id, order) GtkTreeSortable *sortable gint sort_column_id GtkSortType order #### void gtk_tree_sortable_set_sort_func (GtkTreeSortable *sortable, gint sort_column_id, GtkTreeIterCompareFunc sort_func, gpointer user_data, GtkDestroyNotify destroy) void gtk_tree_sortable_set_sort_func (sortable, sort_column_id, sort_func, user_data=NULL) GtkTreeSortable *sortable gint sort_column_id SV * sort_func SV * user_data CODE: gtk_tree_sortable_set_sort_func (sortable, sort_column_id, gtk2perl_tree_iter_compare_func, new_sort_func (sort_func, user_data), (GtkDestroyNotify) gperl_callback_destroy); #### void gtk_tree_sortable_set_default_sort_func (GtkTreeSortable *sortable, GtkTreeIterCompareFunc sort_func, gpointer user_data, GtkDestroyNotify destroy) void gtk_tree_sortable_set_default_sort_func (sortable, sort_func, user_data=NULL) GtkTreeSortable *sortable SV * sort_func SV * user_data CODE: if (!gperl_sv_is_defined (sort_func)) { gtk_tree_sortable_set_default_sort_func (sortable, NULL, NULL, NULL); } else { gtk_tree_sortable_set_default_sort_func (sortable, gtk2perl_tree_iter_compare_func, new_sort_func (sort_func, user_data), (GtkDestroyNotify) gperl_callback_destroy); } ## gboolean gtk_tree_sortable_has_default_sort_func (GtkTreeSortable *sortable) gboolean gtk_tree_sortable_has_default_sort_func (sortable) GtkTreeSortable *sortable MODULE = Gtk2::TreeSortable PACKAGE = Gtk2::TreeSortable::IterCompareFunc =for apidoc __hide__ =cut gint invoke (code, model, a, b, data) SV *code GtkTreeModel *model GtkTreeIter *a GtkTreeIter *b PREINIT: Gtk2PerlTreeIterCompareFunc *stuff; CODE: stuff = INT2PTR (Gtk2PerlTreeIterCompareFunc*, SvIV (SvRV (code))); if (!stuff || !stuff->func) croak ("Invalid reference encountered in iter compare func"); RETVAL = stuff->func (model, a, b, stuff->data); OUTPUT: RETVAL void DESTROY (code) SV *code PREINIT: Gtk2PerlTreeIterCompareFunc *stuff; CODE: if (!gperl_sv_is_defined (code) || !SvROK (code)) return; stuff = INT2PTR (Gtk2PerlTreeIterCompareFunc*, SvIV (SvRV (code))); if (stuff && stuff->destroy) stuff->destroy (stuff->data); if (stuff) g_free (stuff); Gtk2-1.24992/xs/GtkRecentChooserDialog.xs0000644000175000017500000000371513076462677016510 0ustar lacklack/* * Copyright (c) 2006 by the gtk2-perl team (see the file AUTHORS) * * Licensed under the LGPL, see LICENSE file for more information. * * $Id$ */ #include "gtk2perl.h" MODULE = Gtk2::RecentChooserDialog PACKAGE = Gtk2::RecentChooserDialog PREFIX = gtk_recent_chooser_dialog_ BOOT: gperl_prepend_isa ("Gtk2::RecentChooserDialog", "Gtk2::RecentChooser"); =for apidoc Gtk2::RecentChooserDialog::new_for_manager =for signature widget = Gtk2::RecentChooserDialog->new_for_manager ($title, $parent, $manager, ...) =for arg manager (Gtk2::RecentManager) =for arg ... (list) list of button-text => response-id pairs =cut =for apidoc Gtk2::RecentChooserDialog::new =for arg ... list of button-text => response-id pairs =cut GtkWidget * gtk_recent_chooser_dialog_new (class, gchar *title, GtkWindow_ornull *parent, ...) ALIAS: Gtk2::RecentChooserDialog::new_for_manager = 1 PREINIT: gint i, first_index; GtkRecentManager *manager; CODE: if (ix == 1) { first_index = 4; manager = SvGtkRecentManager (ST (3)); } else { first_index = 3; manager = NULL; } if (0 != (items - first_index) % 2) { if (ix == 1) { croak ("Usage: Gtk2::RecentChooserDialog->new_for_manager (title, parent, manager, button-text => response-id, ...)\n" " expecting list of button-text => response-id pairs"); } else { croak ("Usage: Gtk2::RecentChooserDialog->new (title, parent, button-text => response-id, ...)\n" " expecting list of button-text => response-id pairs"); } } RETVAL = g_object_new (GTK_TYPE_RECENT_CHOOSER_DIALOG, "title", title, "recent-manager", manager, NULL); if (parent) gtk_window_set_transient_for (GTK_WINDOW (RETVAL), parent); for (i = first_index; i < items; i += 2) { gchar *button_text = SvGChar (ST (i)); gint response_id = SvGtkResponseType (ST (i + 1)); gtk_dialog_add_button (GTK_DIALOG (RETVAL), button_text, response_id); } OUTPUT: RETVAL Gtk2-1.24992/xs/GtkViewport.xs0000644000175000017500000000470113076462677014440 0ustar lacklack/* * Copyright (c) 2003, 2010 by the gtk2-perl team (see the file AUTHORS) * * This library is free software; you can redistribute it and/or * modify it under the terms of the GNU Library General Public * License as published by the Free Software Foundation; either * version 2.1 of the License, or (at your option) any later version. * * This library is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU * Library General Public License for more details. * * You should have received a copy of the GNU Library General Public * License along with this library; if not, write to the * Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, * Boston, MA 02110-1301 USA. * * $Id$ */ #include "gtk2perl.h" MODULE = Gtk2::Viewport PACKAGE = Gtk2::Viewport PREFIX = gtk_viewport_ ## GtkWidget* gtk_viewport_new (GtkAdjustment *hadjustment, GtkAdjustment *vadjustment) GtkWidget * gtk_viewport_new (class, hadjustment=NULL, vadjustment=NULL) GtkAdjustment_ornull * hadjustment GtkAdjustment_ornull * vadjustment C_ARGS: hadjustment, vadjustment ## GtkAdjustment* gtk_viewport_get_hadjustment (GtkViewport *viewport) GtkAdjustment * gtk_viewport_get_hadjustment (viewport) GtkViewport * viewport ## GtkAdjustment* gtk_viewport_get_vadjustment (GtkViewport *viewport) GtkAdjustment * gtk_viewport_get_vadjustment (viewport) GtkViewport * viewport ## void gtk_viewport_set_hadjustment (GtkViewport *viewport, GtkAdjustment *adjustment) void gtk_viewport_set_hadjustment (viewport, adjustment) GtkViewport * viewport GtkAdjustment * adjustment ## void gtk_viewport_set_vadjustment (GtkViewport *viewport, GtkAdjustment *adjustment) void gtk_viewport_set_vadjustment (viewport, adjustment) GtkViewport * viewport GtkAdjustment * adjustment ## void gtk_viewport_set_shadow_type (GtkViewport *viewport, GtkShadowType type) void gtk_viewport_set_shadow_type (viewport, type) GtkViewport * viewport GtkShadowType type ## GtkShadowType gtk_viewport_get_shadow_type (GtkViewport *viewport) GtkShadowType gtk_viewport_get_shadow_type (viewport) GtkViewport * viewport #if GTK_CHECK_VERSION (2, 20, 0) GdkWindow_ornull* gtk_viewport_get_bin_window (GtkViewport *viewport) #endif /* 2.20 */ #if GTK_CHECK_VERSION (2, 22, 0) GdkWindow_ornull * gtk_viewport_get_view_window (GtkViewport *viewport); #endif /* 2.22 */ Gtk2-1.24992/xs/GdkX11.xs0000644000175000017500000001277313076462677013162 0ustar lacklack/* * Copyright (c) 2003-2005, 2009 by the gtk2-perl team (see the file AUTHORS) * * This library is free software; you can redistribute it and/or * modify it under the terms of the GNU Library General Public * License as published by the Free Software Foundation; either * version 2.1 of the License, or (at your option) any later version. * * This library is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU * Library General Public License for more details. * * You should have received a copy of the GNU Library General Public * License along with this library; if not, write to the * Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, * Boston, MA 02110-1301 USA. * * $Id$ */ #include "gtk2perl.h" #ifdef GDK_WINDOWING_X11 # include #endif /* GDK_WINDOWING_X11 */ /* * there is no typemap for Display*, Screen*, etc, and indeed no perl-side * functions to manipulate them, so they are out for the time being. * * XID/XWINDOW/XATOM is treated as UV. * * all XS blocks are wrapped in #ifdef GDK_WINDOWING_X11 to make sure this * stuff doesn't exist when wrapping gdk compiled for other backends. */ /* ------------------------------------------------------------------------- */ MODULE = Gtk2::Gdk::X11 PACKAGE = Gtk2::Gdk::Drawable PREFIX = gdk_x11_drawable_ #ifdef GDK_WINDOWING_X11 ###define GDK_WINDOW_XID(win) (gdk_x11_drawable_get_xid (win)) ###define GDK_WINDOW_XWINDOW(win) (gdk_x11_drawable_get_xid (win)) ###define GDK_PIXMAP_XID(win) (gdk_x11_drawable_get_xid (win)) ###define GDK_DRAWABLE_XID(win) (gdk_x11_drawable_get_xid (win)) ##XID gdk_x11_drawable_get_xid (GdkDrawable *drawable); UV gdk_x11_drawable_get_xid (GdkDrawable *drawable) ALIAS: XID = 1 XWINDOW = 2 CLEANUP: PERL_UNUSED_VAR (ix); #endif /* GDK_WINDOWING_X11 */ # --------------------------------------------------------------------------- # MODULE = Gtk2::Gdk::X11 PACKAGE = Gtk2::Gdk::X11 PREFIX = gdk_x11_ #ifdef GDK_WINDOWING_X11 guint32 gdk_x11_get_server_time (class, GdkWindow *window) C_ARGS: window #ifndef GDK_MULTIHEAD_SAFE gboolean net_wm_supports (class, GdkAtom property) CODE: RETVAL = gdk_net_wm_supports (property); OUTPUT: RETVAL void gdk_x11_grab_server (class) C_ARGS: /* void */ void gdk_x11_ungrab_server (class) C_ARGS: /* void */ gint gdk_x11_get_default_screen (class) C_ARGS: /* void */ # FIXME? ## GdkVisual* gdkx_visual_get (VisualID xvisualid); #endif /* GDK_MULTIHEAD_SAFE */ #endif /* GDK_WINDOWING_X11 */ # --------------------------------------------------------------------------- # MODULE = Gtk2::Gdk::X11 PACKAGE = Gtk2::Gdk::Display PREFIX = gdk_x11_display_ #### GdkDisplay didn't exist before 2.2.x #if defined(GDK_WINDOWING_X11) && defined(GDK_TYPE_DISPLAY) void gdk_x11_display_grab (GdkDisplay *display); void gdk_x11_display_ungrab (GdkDisplay *display); #if GTK_CHECK_VERSION (2, 4, 0) # Even though the naming doesn't suggest it, this seems to be a GdkDisplay # method. ##void gdk_x11_register_standard_event_type (GdkDisplay *display, gint event_base, gint n_events); void register_standard_event_type (GdkDisplay *display, gint event_base, gint n_events) CODE: gdk_x11_register_standard_event_type (display, event_base, n_events); #endif /* 2.4.0 */ #if GTK_CHECK_VERSION (2, 8, 0) void gdk_x11_display_set_cursor_theme (GdkDisplay *display, const gchar *theme, gint size); guint32 gdk_x11_display_get_user_time (GdkDisplay *display); #endif /* 2.8.0 */ #if GTK_CHECK_VERSION (2, 12, 0) # FIXME: gdk_x11_display_broadcast_startup_message const gchar *gdk_x11_display_get_startup_notification_id (GdkDisplay *display); #endif #endif /* GDK_WINDOWING_X11, GDK_TYPE_DISPLAY */ # --------------------------------------------------------------------------- # MODULE = Gtk2::Gdk::X11 PACKAGE = Gtk2::Gdk::Window PREFIX = gdk_x11_window_ #ifdef GDK_WINDOWING_X11 #if GTK_CHECK_VERSION (2, 6, 0) void gdk_x11_window_set_user_time (GdkWindow *window, guint32 timestamp); #endif /* 2.6.0 */ #if GTK_CHECK_VERSION (2, 8, 0) void gdk_x11_window_move_to_current_desktop (GdkWindow *window); #endif /* 2.8.0 */ #endif /* GDK_WINDOWING_X11 */ # --------------------------------------------------------------------------- # MODULE = Gtk2::Gdk::X11 PACKAGE = Gtk2::Gdk::Screen PREFIX = gdk_x11_screen_ #ifdef GDK_WINDOWING_X11 #if GTK_CHECK_VERSION (2, 2, 0) int gdk_x11_screen_get_screen_number (GdkScreen *screen); const char* gdk_x11_screen_get_window_manager_name (GdkScreen *screen); # FIXME? ##GdkVisual* gdk_x11_screen_lookup_visual (GdkScreen *screen, VisualID xvisualid); gboolean gdk_x11_screen_supports_net_wm_hint (GdkScreen *screen, GdkAtom property); #endif /* 2.2.0 */ #if GTK_CHECK_VERSION (2, 14, 0) UV gdk_x11_screen_get_monitor_output (GdkScreen *screen, gint monitor_num); #endif /* 2.14.0 */ #endif /* GDK_WINDOWING_X11 */ # --------------------------------------------------------------------------- # MODULE = Gtk2::Gdk::X11 PACKAGE = Gtk2::Gdk::Atom PREFIX = gdk_x11_atom_ #ifdef GDK_WINDOWING_X11 #if GTK_CHECK_VERSION (2, 2, 0) UV to_xatom_for_display (GdkAtom atom, GdkDisplay *display) CODE: RETVAL = gdk_x11_atom_to_xatom_for_display(display, atom); OUTPUT: RETVAL #endif /* 2.2.0 */ #ifndef GDK_MULTIHEAD_SAFE UV gdk_x11_atom_to_xatom (GdkAtom atom); #endif /* GDK_MULTIHEAD_SAFE */ #endif /* GDK_WINDOWING_X11 */ Gtk2-1.24992/xs/GtkHScrollbar.xs0000644000175000017500000000307613076462677014660 0ustar lacklack/* * Copyright (c) 2003 by the gtk2-perl team (see the file AUTHORS) * * This library is free software; you can redistribute it and/or * modify it under the terms of the GNU Library General Public * License as published by the Free Software Foundation; either * version 2.1 of the License, or (at your option) any later version. * * This library is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU * Library General Public License for more details. * * You should have received a copy of the GNU Library General Public * License along with this library; if not, write to the * Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, * Boston, MA 02110-1301 USA. * * $Id$ */ #include "gtk2perl.h" MODULE = Gtk2::HScrollbar PACKAGE = Gtk2::HScrollbar PREFIX = gtk_hscrollbar_ ## GtkWidget* gtk_hscrollbar_new (GtkAdjustment *adjustment) GtkWidget * gtk_hscrollbar_new (class, adjustment=NULL) GtkAdjustment_ornull * adjustment ALIAS: Gtk2::HScrollBar::new = 1 C_ARGS: adjustment CLEANUP: PERL_UNUSED_VAR (ix); =for apidoc Gtk2::HScrollBar::new A typo in days long past resulted in the package names for Gtk2::HScrollbar and Gtk2::VScrollbar being misspelled with a capital C, despite the fact that only the proper name (with the small C) was actually registered with the Glib type system. For backward compatibility with Gtk2-1.00, Gtk2::HScrollBar->new calls Gtk2::HScrollbar->new without complaint. =cut Gtk2-1.24992/xs/GtkSocket.xs0000644000175000017500000000323113076462677014046 0ustar lacklack/* * Copyright (c) 2003 by the gtk2-perl team (see the file AUTHORS) * * This library is free software; you can redistribute it and/or * modify it under the terms of the GNU Library General Public * License as published by the Free Software Foundation; either * version 2.1 of the License, or (at your option) any later version. * * This library is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU * Library General Public License for more details. * * You should have received a copy of the GNU Library General Public * License along with this library; if not, write to the * Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, * Boston, MA 02110-1301 USA. * * $Id$ */ #include "gtk2perl.h" MODULE = Gtk2::Socket PACKAGE = Gtk2::Socket PREFIX = gtk_socket_ ## no plug/socket on non-X11 despite patches exist for years. #ifdef GDK_WINDOWING_X11 ## GtkWidget* gtk_socket_new (void) GtkWidget * gtk_socket_new (class) C_ARGS: /* void */ ## void gtk_socket_add_id (GtkSocket *socket, GdkNativeWindow window_id) void gtk_socket_add_id (socket, window_id) GtkSocket * socket GdkNativeWindow window_id ## GdkNativeWindow gtk_socket_get_id (GtkSocket *socket) GdkNativeWindow gtk_socket_get_id (socket) GtkSocket * socket ## void gtk_socket_steal (GtkSocket *socket, GdkNativeWindow wid) void gtk_socket_steal (socket, wid) GtkSocket * socket GdkNativeWindow wid #if GTK_CHECK_VERSION (2, 14, 0) GdkWindow_ornull * gtk_socket_get_plug_window (GtkSocket *socket_); #endif /* 2.14 */ #endif Gtk2-1.24992/xs/GtkScaleButton.xs0000644000175000017500000000377613076462677015057 0ustar lacklack/* * Copyright (c) 2007 by the gtk2-perl team (see the file AUTHORS) * * Licensed under the LGPL, see LICENSE file for more information. * * $Id$ */ #include "gtk2perl.h" #define ICONS_FROM_STACK(offset, icons) \ if (items > offset) { \ int i; \ /* icons is supposed to be NULL-terminated */ \ icons = g_new0 (gchar *, items - offset + 1); \ for (i = offset; i < items; i++) { \ icons[i - offset] = SvPV_nolen (ST (i)); \ } \ } \ MODULE = Gtk2::ScaleButton PACKAGE = Gtk2::ScaleButton PREFIX = gtk_scale_button_ # GtkWidget * gtk_scale_button_new (GtkIconSize size, gdouble min, gdouble max, gdouble step, const gchar **icons); GtkWidget * gtk_scale_button_new (class, GtkIconSize size, gdouble min, gdouble max, gdouble step, ...) PREINIT: gchar **icons = NULL; CODE: ICONS_FROM_STACK (5, icons); RETVAL = gtk_scale_button_new (size, min, max, step, (const gchar **) icons); g_free (icons); /* NULL-safe */ OUTPUT: RETVAL # void gtk_scale_button_set_icons (GtkScaleButton *button, const gchar **icons); void gtk_scale_button_set_icons (GtkScaleButton *button, ...) PREINIT: gchar **icons = NULL; CODE: ICONS_FROM_STACK (1, icons); gtk_scale_button_set_icons (button, (const gchar **) icons); g_free (icons); /* NULL-safe */ gdouble gtk_scale_button_get_value (GtkScaleButton *button); void gtk_scale_button_set_value (GtkScaleButton *button, gdouble value); GtkAdjustment * gtk_scale_button_get_adjustment (GtkScaleButton *button); void gtk_scale_button_set_adjustment (GtkScaleButton *button, GtkAdjustment *adjustment); #if GTK_CHECK_VERSION (2, 14, 0) GtkWidget * gtk_scale_button_get_popup (GtkScaleButton *button); GtkWidget * gtk_scale_button_get_plus_button (GtkScaleButton *button); GtkWidget * gtk_scale_button_get_minus_button (GtkScaleButton *button); void gtk_scale_button_set_orientation (GtkScaleButton *button, GtkOrientation orientation); GtkOrientation gtk_scale_button_get_orientation (GtkScaleButton *button); #endif /* 2.14 */ Gtk2-1.24992/xs/GtkHScale.xs0000644000175000017500000000243613076462677013763 0ustar lacklack/* * Copyright (c) 2003 by the gtk2-perl team (see the file AUTHORS) * * This library is free software; you can redistribute it and/or * modify it under the terms of the GNU Library General Public * License as published by the Free Software Foundation; either * version 2.1 of the License, or (at your option) any later version. * * This library is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU * Library General Public License for more details. * * You should have received a copy of the GNU Library General Public * License along with this library; if not, write to the * Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, * Boston, MA 02110-1301 USA. * * $Id$ */ #include "gtk2perl.h" MODULE = Gtk2::HScale PACKAGE = Gtk2::HScale PREFIX = gtk_hscale_ ## GtkWidget* gtk_hscale_new (GtkAdjustment *adjustment) GtkWidget * gtk_hscale_new (class, adjustment=NULL) GtkAdjustment_ornull * adjustment C_ARGS: adjustment ## GtkWidget* gtk_hscale_new_with_range (gdouble min, gdouble max, gdouble step) GtkWidget * gtk_hscale_new_with_range (class, min, max, step) gdouble min gdouble max gdouble step C_ARGS: min, max, step Gtk2-1.24992/xs/GdkDnd.xs0000644000175000017500000002046413076462677013312 0ustar lacklack/* * Copyright (c) 2003 by the gtk2-perl team (see the file AUTHORS) * * This library is free software; you can redistribute it and/or * modify it under the terms of the GNU Library General Public * License as published by the Free Software Foundation; either * version 2.1 of the License, or (at your option) any later version. * * This library is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU * Library General Public License for more details. * * You should have received a copy of the GNU Library General Public * License along with this library; if not, write to the * Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, * Boston, MA 02110-1301 USA. * * $Id$ */ #include "gtk2perl.h" MODULE = Gtk2::Gdk::Dnd PACKAGE = Gtk2::Gdk::DragContext PREFIX = gdk_drag_context_ SV * protocol (dc) GdkDragContext * dc ALIAS: Gtk2::Gdk::DragContext::is_source = 1 Gtk2::Gdk::DragContext::source_window = 2 Gtk2::Gdk::DragContext::dest_window = 3 Gtk2::Gdk::DragContext::actions = 5 Gtk2::Gdk::DragContext::suggested_action = 6 Gtk2::Gdk::DragContext::action = 7 Gtk2::Gdk::DragContext::start_time = 8 CODE: switch (ix) { case 0: RETVAL = newSVGdkDragProtocol (dc->protocol); break; case 1: RETVAL = newSViv (dc->is_source); break; case 2: RETVAL = newSVGdkWindow (dc->source_window); break; case 3: RETVAL = newSVGdkWindow (dc->dest_window); break; /* must use get_targets to access targets */ case 5: RETVAL = newSVGdkDragAction (dc->actions); break; case 6: RETVAL = newSVGdkDragAction (dc->suggested_action); break; case 7: RETVAL = newSVGdkDragAction (dc->action); break; case 8: RETVAL = newSVuv (dc->start_time); break; default: RETVAL = NULL; g_assert_not_reached (); } OUTPUT: RETVAL =for apidoc Returns a list of Gtk2::Gdk::Atom's, the targets. =cut void targets (dc) GdkDragContext * dc PREINIT: GList * i; PPCODE: for (i = dc->targets; i != NULL ; i = i->next) XPUSHs (sv_2mortal (newSVGdkAtom ((GdkAtom)i->data))); ## GdkDragContext * gdk_drag_context_new (void) GdkDragContext_noinc * gdk_drag_context_new (class) C_ARGS: /* void */ # deprecated ## void gdk_drag_context_ref (GdkDragContext *context) ## void gdk_drag_context_unref (GdkDragContext *context) #if GTK_CHECK_VERSION (2, 22, 0) GdkDragAction gdk_drag_context_get_actions (GdkDragContext *context); GdkDragAction gdk_drag_context_get_selected_action (GdkDragContext *context); GdkDragAction gdk_drag_context_get_suggested_action (GdkDragContext *context); # GList * gdk_drag_context_list_targets (GdkDragContext *context); void gdk_drag_context_list_targets (GdkDragContext *context) PREINIT: GList * i; PPCODE: for (i = gdk_drag_context_list_targets (context); i != NULL ; i = i->next) XPUSHs (sv_2mortal (newSVGdkAtom ((GdkAtom)i->data))); GdkWindow * gdk_drag_context_get_source_window (GdkDragContext *context); #endif /* 2.22 */ # --------------------------------------------------------------------------- # MODULE = Gtk2::Gdk::Dnd PACKAGE = Gtk2::Gdk::DragContext PREFIX = gdk_drag_ ## void gdk_drag_status (GdkDragContext *context, GdkDragAction action, guint32 time_) void gdk_drag_status (context, action, time_=GDK_CURRENT_TIME) GdkDragContext *context GdkDragAction action guint32 time_ ## GdkAtom gdk_drag_get_selection (GdkDragContext *context) GdkAtom gdk_drag_get_selection (context) GdkDragContext *context ## GdkDragContext * gdk_drag_begin (GdkWindow *window, GList *targets) =for apidoc =for arg ... of Gtk2::Gdk::Atom's =cut GdkDragContext_noinc * gdk_drag_begin (class, window, ...) GdkWindow *window PREINIT: GList *targets = NULL; int i; CODE: for (i = items - 1 ; i >= 2 ; i--) targets = g_list_prepend (targets, GUINT_TO_POINTER (SvGdkAtom (ST (i)))); /* the Gdk source code uses GUINT_TO_POINTER * when storing atoms in hashes. */ RETVAL = gdk_drag_begin (window, targets); OUTPUT: RETVAL CLEANUP: g_list_free (targets); #if GTK_CHECK_VERSION(2,2,0) ## guint32 gdk_drag_get_protocol_for_display (GdkDisplay *display, guint32 xid, GdkDragProtocol *protocol) =for apidoc =for signature (ret, protocol) = Gtk2::Gdk::DragContext->get_protocol_for_display ($display, $xid) =cut void gdk_drag_get_protocol_for_display (class, display, xid) GdkDisplay *display guint32 xid PREINIT: GdkDragProtocol protocol; guint32 ret; PPCODE: ret = gdk_drag_get_protocol_for_display (display, xid, &protocol); XPUSHs (sv_2mortal (newSVuv (ret))); XPUSHs (sv_2mortal (ret ? newSVGdkDragProtocol (protocol) : newSVsv (&PL_sv_undef))); ## void gdk_drag_find_window_for_screen (GdkDragContext *context, GdkWindow *drag_window, GdkScreen *screen, gint x_root, gint y_root, GdkWindow **dest_window, GdkDragProtocol *protocol) =for apidoc =for signature (dest_window, protocol) = $context->find_window_for_screen ($drag_window, $screen, $x_root, $y_root) =cut void gdk_drag_find_window_for_screen (context, drag_window, screen, x_root, y_root) GdkDragContext *context GdkWindow *drag_window GdkScreen *screen gint x_root gint y_root PREINIT: GdkWindow *dest_window = NULL; GdkDragProtocol protocol; PPCODE: gdk_drag_find_window_for_screen (context, drag_window, screen, x_root, y_root, &dest_window, &protocol); XPUSHs (sv_2mortal (newSVGdkWindow (dest_window))); XPUSHs (sv_2mortal ((dest_window ? newSVGdkDragProtocol (protocol) : newSVsv (&PL_sv_undef)))); #endif /* >= 2.2.0 */ ## guint32 gdk_drag_get_protocol (guint32 xid, GdkDragProtocol *protocol) =for apidoc =for signature (ret, protocol) = Gtk2::Gdk::DragContext->get_protocol ($xid) =cut void gdk_drag_get_protocol (class, xid) guint32 xid PREINIT: GdkDragProtocol protocol; guint32 ret; PPCODE: ret = gdk_drag_get_protocol (xid, &protocol); XPUSHs (sv_2mortal (newSVuv (ret))); XPUSHs (sv_2mortal (newSVGdkDragProtocol (protocol))); ## void gdk_drag_find_window (GdkDragContext *context, GdkWindow *drag_window, gint x_root, gint y_root, GdkWindow **dest_window, GdkDragProtocol *protocol) =for apidoc =for signature (dest_window, protocol) = $context->find_window ($drag_window, $x_root, $y_root) =cut void gdk_drag_find_window (context, drag_window, x_root, y_root) GdkDragContext *context GdkWindow *drag_window gint x_root gint y_root PREINIT: GdkWindow *dest_window; GdkDragProtocol protocol; PPCODE: gdk_drag_find_window (context, drag_window, x_root, y_root, &dest_window, &protocol); XPUSHs (sv_2mortal (newSVGdkWindow_ornull (dest_window))); XPUSHs (sv_2mortal (dest_window ? newSVGdkDragProtocol (protocol) : newSVsv (&PL_sv_undef))); ## gboolean gdk_drag_motion (GdkDragContext *context, GdkWindow *dest_window, GdkDragProtocol protocol, gint x_root, gint y_root, GdkDragAction suggested_action, GdkDragAction possible_actions, guint32 time_) gboolean gdk_drag_motion (context, dest_window, protocol, x_root, y_root, suggested_action, possible_actions, time_) GdkDragContext *context GdkWindow *dest_window GdkDragProtocol protocol gint x_root gint y_root GdkDragAction suggested_action GdkDragAction possible_actions guint32 time_ ## void gdk_drag_drop (GdkDragContext *context, guint32 time_) void gdk_drag_drop (context, time_) GdkDragContext *context guint32 time_ ## void gdk_drag_abort (GdkDragContext *context, guint32 time_) void gdk_drag_abort (context, time_) GdkDragContext *context guint32 time_ # --------------------------------------------------------------------------- # MODULE = Gtk2::Gdk::Dnd PACKAGE = Gtk2::Gdk::DragContext PREFIX = gdk_ ## void gdk_drop_reply (GdkDragContext *context, gboolean ok, guint32 time_) void gdk_drop_reply (context, ok, time_=GDK_CURRENT_TIME) GdkDragContext *context gboolean ok guint32 time_ ## void gdk_drop_finish (GdkDragContext *context, gboolean success, guint32 time_) void gdk_drop_finish (context, success, time_=GDK_CURRENT_TIME) GdkDragContext *context gboolean success guint32 time_ #if GTK_CHECK_VERSION (2, 6, 0) gboolean gdk_drag_drop_succeeded (GdkDragContext *context); #endif Gtk2-1.24992/xs/GtkEntry.xs0000644000175000017500000002243213076462677013723 0ustar lacklack/* * Copyright (c) 2003-2006 by the gtk2-perl team (see the file AUTHORS) * * This library is free software; you can redistribute it and/or * modify it under the terms of the GNU Library General Public * License as published by the Free Software Foundation; either * version 2.1 of the License, or (at your option) any later version. * * This library is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU * Library General Public License for more details. * * You should have received a copy of the GNU Library General Public * License along with this library; if not, write to the * Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, * Boston, MA 02110-1301 USA. * * $Id$ */ #include "gtk2perl.h" static GPerlBoxedWrapperClass gtk_border_wrapper_class; static SV * gtk2perl_border_wrap (GType gtype, const char * package, gpointer boxed, gboolean own) { GtkBorder *border = boxed; HV *hv; PERL_UNUSED_VAR (gtype); PERL_UNUSED_VAR (package); if (!border) return &PL_sv_undef; hv = newHV (); gperl_hv_take_sv_s (hv, "left", newSViv (border->left)); gperl_hv_take_sv_s (hv, "right", newSViv (border->right)); gperl_hv_take_sv_s (hv, "top", newSViv (border->top)); gperl_hv_take_sv_s (hv, "bottom", newSViv (border->bottom)); if (own) gtk_border_free (border); return newRV_noinc ((SV *) hv); } /* This uses gperl_alloc_temp so make sure you don't hold on to pointers * returned by SvGtkBorder for too long. */ static gpointer gtk2perl_border_unwrap (GType gtype, const char * package, SV * sv) { HV *hv; SV **value; GtkBorder *border; PERL_UNUSED_VAR (gtype); PERL_UNUSED_VAR (package); if (!gperl_sv_is_defined (sv) || !SvRV (sv)) return NULL; if (!gperl_sv_is_hash_ref (sv)) croak ("GtkBorder must be a hash reference with four keys: " "left, right, top, bottom"); hv = (HV *) SvRV (sv); border = gperl_alloc_temp (sizeof (GtkBorder)); value = hv_fetch (hv, "left", 4, 0); if (value && gperl_sv_is_defined (*value)) border->left = SvIV (*value); value = hv_fetch (hv, "right", 5, 0); if (value && gperl_sv_is_defined (*value)) border->right = SvIV (*value); value = hv_fetch (hv, "top", 3, 0); if (value && gperl_sv_is_defined (*value)) border->top = SvIV (*value); value = hv_fetch (hv, "bottom", 6, 0); if (value && gperl_sv_is_defined (*value)) border->bottom = SvIV (*value); return border; } MODULE = Gtk2::Entry PACKAGE = Gtk2::Entry PREFIX = gtk_entry_ BOOT: gperl_prepend_isa ("Gtk2::Entry", "Gtk2::CellEditable"); gperl_prepend_isa ("Gtk2::Entry", "Gtk2::Editable"); gtk_border_wrapper_class = * gperl_default_boxed_wrapper_class (); gtk_border_wrapper_class.wrap = gtk2perl_border_wrap; gtk_border_wrapper_class.unwrap = gtk2perl_border_unwrap; gperl_register_boxed (GTK_TYPE_BORDER, "Gtk2::Border", >k_border_wrapper_class); GtkWidget* gtk_entry_new (class) C_ARGS: /* void */ ##GtkWidget* gtk_entry_new_with_max_length (gint max) GtkWidget * gtk_entry_new_with_max_length (class, max) gint max C_ARGS: max void gtk_entry_set_visibility (entry, visible) GtkEntry *entry gboolean visible gboolean gtk_entry_get_visibility (entry) GtkEntry *entry ## void gtk_entry_set_invisible_char (GtkEntry *entry, gunichar ch) void gtk_entry_set_invisible_char (entry, ch) GtkEntry *entry gunichar ch ## gunichar gtk_entry_get_invisible_char (GtkEntry *entry) gunichar gtk_entry_get_invisible_char (entry) GtkEntry *entry void gtk_entry_set_has_frame (entry, setting) GtkEntry *entry gboolean setting gboolean gtk_entry_get_has_frame (entry) GtkEntry *entry void gtk_entry_set_max_length (entry, max) GtkEntry *entry gint max gint gtk_entry_get_max_length (entry) GtkEntry *entry void gtk_entry_set_activates_default (entry, setting) GtkEntry *entry gboolean setting gboolean gtk_entry_get_activates_default (entry) GtkEntry *entry void gtk_entry_set_width_chars (entry, n_chars) GtkEntry *entry gint n_chars gint gtk_entry_get_width_chars (entry) GtkEntry *entry void gtk_entry_set_text (entry, text) GtkEntry *entry const gchar *text # had G_CONST_RETURN const gchar* gtk_entry_get_text (entry) GtkEntry *entry PangoLayout* gtk_entry_get_layout (entry) GtkEntry *entry ## void gtk_entry_get_layout_offsets (GtkEntry *entry, gint *x, gint *y) void gtk_entry_get_layout_offsets (GtkEntry *entry, OUTLIST gint x, OUTLIST gint y) #if GTK_CHECK_VERSION(2,4,0) void gtk_entry_set_completion (GtkEntry *entry, GtkEntryCompletion_ornull *completion); GtkEntryCompletion_ornull *gtk_entry_get_completion (GtkEntry *entry); void gtk_entry_set_alignment (GtkEntry *entry, gfloat xalign); gfloat gtk_entry_get_alignment (GtkEntry *entry); #endif #if GTK_CHECK_VERSION(2, 6, 0) gint gtk_entry_layout_index_to_text_index (GtkEntry *entry, gint layout_index) gint gtk_entry_text_index_to_layout_index (GtkEntry *entry, gint text_index) #endif #if GTK_CHECK_VERSION(2, 10, 0) void gtk_entry_set_inner_border (GtkEntry *entry, const GtkBorder_ornull *border); const GtkBorder_ornull * gtk_entry_get_inner_border (GtkEntry *entry); #endif #if GTK_CHECK_VERSION(2, 12, 0) void gtk_entry_set_cursor_hadjustment (GtkEntry *entry, GtkAdjustment_ornull *adjustment); GtkAdjustment_ornull* gtk_entry_get_cursor_hadjustment (GtkEntry *entry); #endif #if GTK_CHECK_VERSION (2, 14, 0) void gtk_entry_set_overwrite_mode (GtkEntry *entry, gboolean overwrite); gboolean gtk_entry_get_overwrite_mode (GtkEntry *entry); guint16 gtk_entry_get_text_length (GtkEntry *entry); #endif /* 2.14 */ #if GTK_CHECK_VERSION (2, 16, 0) # # FIXME: Missing typemap, actually I don't think that gio is available through Perl # # GIcon_ornull* gtk_entry_get_gicon (GtkEntry *entry, GtkEntryIconPosition icon_pos); # void gtk_entry_set_icon_from_gicon (GtkEntry *entry, GtkEntryIconPosition icon_pos, GIcon_ornull *icon); # gboolean gtk_entry_get_icon_activatable (GtkEntry *entry, GtkEntryIconPosition icon_pos); gint gtk_entry_get_icon_at_pos (GtkEntry *entry, gint x, gint y); const gchar_ornull* gtk_entry_get_icon_name (GtkEntry *entry, GtkEntryIconPosition icon_pos); gboolean gtk_entry_get_icon_sensitive (GtkEntry *entry, GtkEntryIconPosition icon_pos); GdkPixbuf_ornull* gtk_entry_get_icon_pixbuf (GtkEntry *entry, GtkEntryIconPosition icon_pos); gdouble gtk_entry_get_progress_fraction (GtkEntry *entry); gdouble gtk_entry_get_progress_pulse_step (GtkEntry *entry); void gtk_entry_progress_pulse (GtkEntry *entry); const gchar_ornull* gtk_entry_get_icon_stock (GtkEntry *entry, GtkEntryIconPosition icon_pos); GtkImageType gtk_entry_get_icon_storage_type (GtkEntry *entry, GtkEntryIconPosition icon_pos); void gtk_entry_set_icon_activatable (GtkEntry *entry, GtkEntryIconPosition icon_pos, gboolean activatable); void gtk_entry_set_icon_from_icon_name (GtkEntry *entry, GtkEntryIconPosition icon_pos, const gchar_ornull *icon_name); void gtk_entry_set_icon_from_pixbuf (GtkEntry *entry, GtkEntryIconPosition icon_pos, GdkPixbuf_ornull *pixbuf); void gtk_entry_set_icon_from_stock (GtkEntry *entry, GtkEntryIconPosition icon_pos, const gchar_ornull *stock_id); void gtk_entry_set_icon_sensitive (GtkEntry *entry, GtkEntryIconPosition icon_pos, gboolean sensitive); void gtk_entry_set_icon_tooltip_markup (GtkEntry *entry, GtkEntryIconPosition icon_pos, const gchar_ornull *tooltip); gchar_own_ornull * gtk_entry_get_icon_tooltip_markup (GtkEntry *entry, GtkEntryIconPosition icon_pos); void gtk_entry_set_icon_tooltip_text (GtkEntry *entry, GtkEntryIconPosition icon_pos, const gchar_ornull *tooltip); gchar_own_ornull * gtk_entry_get_icon_tooltip_text (GtkEntry *entry, GtkEntryIconPosition icon_pos); void gtk_entry_set_progress_fraction (GtkEntry *entry, gdouble fraction); void gtk_entry_set_progress_pulse_step (GtkEntry *entry, gdouble fraction); void gtk_entry_unset_invisible_char (GtkEntry *entry); void gtk_entry_set_icon_drag_source (GtkEntry *entry, GtkEntryIconPosition icon_pos, GtkTargetList *target_list, GdkDragAction actions); gint gtk_entry_get_current_icon_drag_source (GtkEntry *entry); #endif /* 2.16 */ #if GTK_CHECK_VERSION (2, 18, 0) GtkWidget *gtk_entry_new_with_buffer (class, GtkEntryBuffer *buffer) C_ARGS: buffer GtkEntryBuffer *gtk_entry_get_buffer (GtkEntry *entry); void gtk_entry_set_buffer (GtkEntry *entry, GtkEntryBuffer *buffer); #endif /* 2.18 */ #if GTK_CHECK_VERSION (2, 20, 0) GdkWindow * gtk_entry_get_icon_window (GtkEntry *entry, GtkEntryIconPosition icon_pos); GdkWindow * gtk_entry_get_text_window (GtkEntry *entry); #endif /* 2.20 */ #if GTK_CHECK_VERSION (2, 22, 0) gboolean gtk_entry_im_context_filter_keypress (GtkEntry *entry, GdkEvent *event); C_ARGS: entry, (GdkEventKey *) event void gtk_entry_reset_im_context (GtkEntry *entry); #endif /* 2.22 */ ## ## hey, these are deprecated! is that new as of 2.3.x? ## void gtk_entry_append_text (entry, text) GtkEntry * entry const gchar * text void gtk_entry_prepend_text (entry, text) GtkEntry * entry const gchar * text void gtk_entry_set_position (entry, position) GtkEntry * entry gint position void gtk_entry_select_region (entry, start, end) GtkEntry * entry gint start gint end void gtk_entry_set_editable (entry, editable) GtkEntry * entry gboolean editable Gtk2-1.24992/xs/GtkRadioAction.xs0000644000175000017500000000373213076462677015020 0ustar lacklack/* * Copyright (c) 2003-2006, 2010 by the gtk2-perl team (see the file AUTHORS) * * Licensed under the LGPL, see LICENSE file for more information. * * $Id$ */ #include "gtk2perl.h" MODULE = Gtk2::RadioAction PACKAGE = Gtk2::RadioAction PREFIX = gtk_radio_action_ =for position SYNOPSIS =head1 SYNOPSIS my $action = Gtk2::RadioAction->new (name => 'one', tooltip => 'One', value => 23); Note that the constructor slightly deviates from the convenience constructor in the C API. Instead of passing in a list of values for name, label, tooltip, stock-id and value, you just use key => value pairs like with Glib::Object::new. =cut ## GSList *gtk_radio_action_get_group (GtkRadioAction *action); AV * gtk_radio_action_get_group (GtkRadioAction *action) PREINIT: GSList * group, * i; CODE: group = gtk_radio_action_get_group (action); RETVAL = newAV(); sv_2mortal ((SV*) RETVAL); /* typemap expects RETVAL mortalized */ for (i = group ; i != NULL ; i = i->next) av_push (RETVAL, newSVGtkRadioAction (i->data)); OUTPUT: RETVAL ## void gtk_radio_action_set_group (GtkRadioAction *action, GSList *group); void gtk_radio_action_set_group (GtkRadioAction *action, SV *member_or_listref); PREINIT: GSList * group = NULL; CODE: if (member_or_listref && SvTRUE (member_or_listref)) { GtkRadioAction * member = NULL; if (gperl_sv_is_array_ref (member_or_listref)) { AV * av = (AV*) SvRV (member_or_listref); SV ** svp = av_fetch (av, 0, 0); if (svp && gperl_sv_is_defined (*svp)) member = SvGtkRadioAction (*svp); } else member = SvGtkRadioAction_ornull (member_or_listref); if (member) group = gtk_radio_action_get_group (member); } gtk_radio_action_set_group (action, group); gint gtk_radio_action_get_current_value (GtkRadioAction *action); #if GTK_CHECK_VERSION (2, 10, 0) void gtk_radio_action_set_current_value (GtkRadioAction *action, gint value); #endif Gtk2-1.24992/xs/GtkMisc.xs0000644000175000017500000000240713076462677013515 0ustar lacklack/* * Copyright (c) 2003 by the gtk2-perl team (see the file AUTHORS) * * This library is free software; you can redistribute it and/or * modify it under the terms of the GNU Library General Public * License as published by the Free Software Foundation; either * version 2.1 of the License, or (at your option) any later version. * * This library is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU * Library General Public License for more details. * * You should have received a copy of the GNU Library General Public * License along with this library; if not, write to the * Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, * Boston, MA 02110-1301 USA. * * $Id$ */ #include "gtk2perl.h" MODULE = Gtk2::Misc PACKAGE = Gtk2::Misc PREFIX = gtk_misc_ void gtk_misc_set_alignment (misc, xalign, yalign) GtkMisc * misc gfloat xalign gfloat yalign void gtk_misc_get_alignment (GtkMisc * misc, OUTLIST gfloat xalign, OUTLIST gfloat yalign) void gtk_misc_set_padding (misc, xpad, ypad) GtkMisc * misc gint xpad gint ypad void gtk_misc_get_padding (GtkMisc * misc, OUTLIST gint xpad, OUTLIST gint ypad) Gtk2-1.24992/xs/GdkProperty.xs0000644000175000017500000002624213076462677014431 0ustar lacklack/* * Copyright (c) 2003, 2013 by the gtk2-perl team (see the file AUTHORS) * * This library is free software; you can redistribute it and/or * modify it under the terms of the GNU Library General Public * License as published by the Free Software Foundation; either * version 2.1 of the License, or (at your option) any later version. * * This library is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU * Library General Public License for more details. * * You should have received a copy of the GNU Library General Public * License along with this library; if not, write to the * Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, * Boston, MA 02110-1301 USA. * * $Id$ */ #include "gtk2perl.h" /* ------------------------------------------------------------------------- */ #define GDK2PERL_TEXT_LIST_DECLARE \ guchar *real_text = NULL; \ STRLEN length; \ gchar **list = NULL; \ int i, elements = 0; #define GDK2PERL_TEXT_LIST_FETCH \ real_text = (guchar *) SvPV (text, length); #define GDK2PERL_TEXT_LIST_STORE \ if (elements == 0) \ XSRETURN_EMPTY; \ \ EXTEND (sp, elements); \ \ for (i = 0; i < elements; i++) \ PUSHs (sv_2mortal (newSVpv (list[i], 0))); /* ------------------------------------------------------------------------- */ #define GDK2PERL_TEXT_CONVERSION_DECALRE \ GdkAtom encoding; \ gint format; \ guchar *ctext = NULL; \ gint length; #define GDK2PERL_TEXT_CONVERSION_STORE \ EXTEND (sp, 3); \ PUSHs (sv_2mortal (newSVGdkAtom (encoding))); \ PUSHs (sv_2mortal (newSViv (format))); \ PUSHs (sv_2mortal (newSVpv ((gchar *) ctext, length))); /* ------------------------------------------------------------------------- */ MODULE = Gtk2::Gdk::Property PACKAGE = Gtk2::Gdk::Atom PREFIX = gdk_atom_ =for apidoc ne __hide__ =cut ## for easy comparisons of atoms =for apidoc __hide__ =cut gboolean eq (left, right, swap=FALSE) GdkAtom left GdkAtom right ALIAS: ne = 1 CODE: switch (ix) { case 0: RETVAL = left == right; break; case 1: RETVAL = left != right; break; default: croak ("incorrect alias value encountered"); RETVAL = FALSE; } OUTPUT: RETVAL ## GdkAtom gdk_atom_intern (const gchar *atom_name, gboolean only_if_exists) GdkAtom gdk_atom_intern (class, atom_name, only_if_exists=FALSE) const gchar *atom_name gboolean only_if_exists ALIAS: Gtk2::Gdk::Atom::new = 1 C_ARGS: atom_name, only_if_exists CLEANUP: PERL_UNUSED_VAR (ix); ## 2.10 adds gdk_atom_intern_static_string(). This isn't useful from perl. ## gchar* gdk_atom_name (GdkAtom atom) gchar_own * gdk_atom_name (atom) GdkAtom atom # --------------------------------------------------------------------------- # MODULE = Gtk2::Gdk::Property PACKAGE = Gtk2::Gdk::Window PREFIX = gdk_ ### the docs warn us not to use this one, but don't say it's deprecated. ## gboolean gdk_property_get (GdkWindow *window, GdkAtom property, GdkAtom type, gulong offset, gulong length, gint pdelete, GdkAtom *actual_property_type, gint *actual_format, gint *actual_length, guchar **data) =for apidoc =for signature (property_type, format, data) = $window->property_get ($property, $type, $offset, $length, $pdelete) See I for an explanation of the meaning of I. =cut void gdk_property_get (window, property, type, offset, length, pdelete) GdkWindow *window GdkAtom property GdkAtom type gulong offset gulong length gint pdelete PREINIT: GdkAtom actual_property_type; gint actual_format; gint actual_length; guchar *data; guint i; PPCODE: if (! gdk_property_get (window, property, type, offset, length, pdelete, &actual_property_type, &actual_format, &actual_length, &data)) XSRETURN_EMPTY; EXTEND (SP, 2); PUSHs (sv_2mortal (newSVGdkAtom (actual_property_type))); PUSHs (sv_2mortal (newSViv (actual_format))); if (data) { switch (actual_format) { case 8: { gchar *char_data = (gchar *) data; XPUSHs (sv_2mortal (newSVpv (char_data, actual_length))); break; } case 16: { gushort *short_data = (gushort *) data; for (i = 0; i < (actual_length / sizeof (gushort)); i++) XPUSHs (sv_2mortal (newSVuv (short_data[i]))); break; } case 32: { gulong *long_data = (gulong *) data; for (i = 0; i < (actual_length / sizeof (gulong)); i++) XPUSHs (sv_2mortal (newSVuv (long_data[i]))); break; } default: warn ("Unhandled format value %d in gdk_property_get, should not happen", actual_format); } g_free (data); } ### nelements is the number of elements in the data, not the number of bytes. ## void gdk_property_change (GdkWindow *window, GdkAtom property, GdkAtom type, gint format, GdkPropMode mode, const guchar *data, gint nelements) =for apidoc =for arg ... property value(s) Depending on the value of I, the property value(s) can be: +--------------------+------------------------------------+ | format | value | +--------------------+------------------------------------+ | Gtk2::Gdk::CHARS | a string | | Gtk2::Gdk::USHORTS | one or more unsigned short numbers | | Gtk2::Gdk::ULONGS | one or more unsigned long numbers | +--------------------+------------------------------------+ =cut void gdk_property_change (window, property, type, format, mode, ...) GdkWindow *window GdkAtom property GdkAtom type gint format GdkPropMode mode PREINIT: guchar *data = NULL; int i; int first_index = 5; STRLEN nelements; CODE: switch (format) { case 8: { SV *sv = ST (first_index); /* need to use sv_len here because \0's are allowed. */ data = (guchar *) SvPV (sv, nelements); break; } case 16: { gushort *short_data = gperl_alloc_temp (sizeof (gushort) * (items - first_index)); for (i = first_index; i < items; i++) short_data[i - first_index] = (gushort) SvUV (ST (i)); data = (guchar *) short_data; nelements = items - first_index; break; } case 32: { gulong *long_data = gperl_alloc_temp (sizeof (gulong) * (items - first_index)); for (i = first_index; i < items; i++) long_data[i - first_index] = (gulong) SvUV (ST (i)); data = (guchar *) long_data; nelements = items - first_index; break; } default: croak ("Illegal format value %d used; should be either 8, 16 or 32", format); } gdk_property_change (window, property, type, format, mode, data, nelements); ## void gdk_property_delete (GdkWindow *window, GdkAtom property) void gdk_property_delete (window, property) GdkWindow *window GdkAtom property # --------------------------------------------------------------------------- # MODULE = Gtk2::Gdk::Property PACKAGE = Gtk2::Gdk PREFIX = gdk_ =for apidoc Returns a list of strings. =cut ## gint gdk_text_property_to_text_list (GdkAtom encoding, gint format, const guchar *text, gint length, gchar ***list) void gdk_text_property_to_text_list (class, encoding, format, text) GdkAtom encoding gint format SV *text PREINIT: GDK2PERL_TEXT_LIST_DECLARE; PPCODE: GDK2PERL_TEXT_LIST_FETCH; elements = gdk_text_property_to_text_list (encoding, format, real_text, length, &list); GDK2PERL_TEXT_LIST_STORE; gdk_free_text_list (list); =for apidoc Returns a list of strings. =cut ## gint gdk_text_property_to_utf8_list (GdkAtom encoding, gint format, const guchar *text, gint length, gchar ***list) void gdk_text_property_to_utf8_list (class, encoding, format, text) GdkAtom encoding gint format SV *text PREINIT: GDK2PERL_TEXT_LIST_DECLARE; PPCODE: GDK2PERL_TEXT_LIST_FETCH; elements = gdk_text_property_to_utf8_list (encoding, format, real_text, length, &list); GDK2PERL_TEXT_LIST_STORE; g_strfreev (list); =for apidoc Returns a list of strings. =cut ## gint gdk_string_to_compound_text (const gchar *str, GdkAtom *encoding, gint *format, guchar **ctext, gint *length) void gdk_string_to_compound_text (class, str) const gchar *str PREINIT: GDK2PERL_TEXT_CONVERSION_DECALRE; PPCODE: if (0 != gdk_string_to_compound_text (str, &encoding, &format, &ctext, &length)) XSRETURN_EMPTY; GDK2PERL_TEXT_CONVERSION_STORE; gdk_free_compound_text (ctext); =for apidoc Returns a list of strings. =cut ## gboolean gdk_utf8_to_compound_text (const gchar *str, GdkAtom *encoding, gint *format, guchar **ctext, gint *length) void gdk_utf8_to_compound_text (class, str) const gchar *str PREINIT: GDK2PERL_TEXT_CONVERSION_DECALRE; PPCODE: if (! gdk_utf8_to_compound_text (str, &encoding, &format, &ctext, &length)) XSRETURN_EMPTY; GDK2PERL_TEXT_CONVERSION_STORE; gdk_free_compound_text (ctext); #if GTK_CHECK_VERSION (2, 2, 0) =for apidoc Returns a list of strings. =cut ## gint gdk_text_property_to_text_list_for_display (GdkDisplay *display, GdkAtom encoding, gint format, const guchar *text, gint length, gchar ***list) void gdk_text_property_to_text_list_for_display (class, display, encoding, format, text) GdkDisplay *display GdkAtom encoding gint format SV *text PREINIT: GDK2PERL_TEXT_LIST_DECLARE; PPCODE: GDK2PERL_TEXT_LIST_FETCH; elements = gdk_text_property_to_text_list_for_display (display, encoding, format, real_text, length, &list); GDK2PERL_TEXT_LIST_STORE; gdk_free_text_list (list); =for apidoc Returns a list of strings. =cut ## gint gdk_text_property_to_utf8_list_for_display (GdkDisplay *display, GdkAtom encoding, gint format, const guchar *text, gint length, gchar ***list) void gdk_text_property_to_utf8_list_for_display (class, display, encoding, format, text) GdkDisplay *display GdkAtom encoding gint format SV *text PREINIT: GDK2PERL_TEXT_LIST_DECLARE; PPCODE: GDK2PERL_TEXT_LIST_FETCH; elements = gdk_text_property_to_utf8_list_for_display (display, encoding, format, real_text, length, &list); GDK2PERL_TEXT_LIST_STORE; g_strfreev (list); =for apidoc Returns a list of strings. =cut ## gint gdk_string_to_compound_text_for_display (GdkDisplay *display, const gchar *str, GdkAtom *encoding, gint *format, guchar **ctext, gint *length) void gdk_string_to_compound_text_for_display (class, display, str) GdkDisplay *display const gchar *str PREINIT: GDK2PERL_TEXT_CONVERSION_DECALRE; PPCODE: if (0 != gdk_string_to_compound_text_for_display (display, str, &encoding, &format, &ctext, &length)) XSRETURN_EMPTY; GDK2PERL_TEXT_CONVERSION_STORE; gdk_free_compound_text (ctext); =for apidoc Returns a list of strings. =cut ## gboolean gdk_utf8_to_compound_text_for_display (GdkDisplay *display, const gchar *str, GdkAtom *encoding, gint *format, guchar **ctext, gint *length) void gdk_utf8_to_compound_text_for_display (class, display, str) GdkDisplay *display const gchar *str PREINIT: GDK2PERL_TEXT_CONVERSION_DECALRE; PPCODE: if (! gdk_utf8_to_compound_text_for_display (display, str, &encoding, &format, &ctext, &length)) XSRETURN_EMPTY; GDK2PERL_TEXT_CONVERSION_STORE; gdk_free_compound_text (ctext); #endif /* 2.2.0 */ =for apidoc Returns a list of strings. =cut ## gchar *gdk_utf8_to_string_target (const gchar *str) gchar_ornull * gdk_utf8_to_string_target (class, str) const gchar *str C_ARGS: str Gtk2-1.24992/xs/GtkRecentChooser.xs0000644000175000017500000001250613076462677015366 0ustar lacklack/* * Copyright (c) 2006 by the gtk2-perl team (see the file AUTHORS) * * Licensed under the LGPL, see LICENSE file for more information. * * $Id$ */ #include "gtk2perl.h" static gint gtk2perl_recent_sort_func (GtkRecentInfo *a, GtkRecentInfo *b, gpointer user_data) { GPerlCallback *callback = (GPerlCallback *) user_data; GValue value = { 0, }; gint retval; g_value_init (&value, callback->return_type); gperl_callback_invoke (callback, &value, a, b); retval = g_value_get_int (&value); g_value_unset (&value); return retval; } static GPerlCallback * gtk2perl_recent_sort_func_create (SV *func, SV *data) { GType param_types[2]; param_types[0] = GTK_TYPE_RECENT_INFO; param_types[1] = GTK_TYPE_RECENT_INFO; return gperl_callback_new (func, data, G_N_ELEMENTS (param_types), param_types, G_TYPE_INT); } MODULE = Gtk2::RecentChooser PACKAGE = Gtk2::RecentChooser PREFIX = gtk_recent_chooser_ =for enum GtkRecentSortType =cut =for enum GtkRecentChooserError =cut # # Configuration # void gtk_recent_chooser_set_show_private (GtkRecentChooser *chooser, gboolean show_private) gboolean gtk_recent_chooser_get_show_private (GtkRecentChooser *chooser) void gtk_recent_chooser_set_show_not_found (GtkRecentChooser *chooser, gboolean show_not_found) gboolean gtk_recent_chooser_get_show_not_found (GtkRecentChooser *chooser) void gtk_recent_chooser_set_select_multiple (GtkRecentChooser *chooser, gboolean select_multiple) gboolean gtk_recent_chooser_get_select_multiple (GtkRecentChooser *chooser) void gtk_recent_chooser_set_limit (GtkRecentChooser *chooser, gint limit) gint gtk_recent_chooser_get_limit (GtkRecentChooser *chooser) void gtk_recent_chooser_set_local_only (GtkRecentChooser *chooser, gboolean local_only) gboolean gtk_recent_chooser_get_local_only (GtkRecentChooser *chooser) void gtk_recent_chooser_set_show_tips (GtkRecentChooser *chooser, gboolean show_tips) gboolean gtk_recent_chooser_get_show_tips (GtkRecentChooser *chooser) # these are a gtk mistake, and we should not bind them. ##void ##gtk_recent_chooser_set_show_numbers (GtkRecentChooser *chooser, gboolean show_numbers) ## ##gboolean ##gtk_recent_chooser_get_show_numbers (GtkRecentChooser *chooser) void gtk_recent_chooser_set_show_icons (GtkRecentChooser *chooser, gboolean show_icons) gboolean gtk_recent_chooser_get_show_icons (GtkRecentChooser *chooser) void gtk_recent_chooser_set_sort_type (GtkRecentChooser *chooser, GtkRecentSortType sort_type) GtkRecentSortType gtk_recent_chooser_get_sort_type (GtkRecentChooser *chooser) void gtk_recent_chooser_set_sort_func (chooser, sort_func, sort_data=NULL) GtkRecentChooser *chooser SV *sort_func SV *sort_data PREINIT: GPerlCallback *func; CODE: func = gtk2perl_recent_sort_func_create (sort_func, sort_data); gtk_recent_chooser_set_sort_func (chooser, gtk2perl_recent_sort_func, func, (GDestroyNotify) gperl_callback_destroy); # # Items handling # =for apidoc __gerror__ =cut void gtk_recent_chooser_set_current_uri (GtkRecentChooser *chooser, const gchar *uri) PREINIT: GError *error = NULL; CODE: gtk_recent_chooser_set_current_uri (chooser, uri, &error); if (error) gperl_croak_gerror (NULL, error); gchar_own * gtk_recent_chooser_get_current_uri (GtkRecentChooser *chooser) GtkRecentInfo * gtk_recent_chooser_get_current_item (GtkRecentChooser *chooser) =for apidoc __gerror__ =cut void gtk_recent_chooser_select_uri (GtkRecentChooser *chooser, const gchar *uri) PREINIT: GError *error = NULL; CODE: gtk_recent_chooser_select_uri (chooser, uri, &error); if (error) gperl_croak_gerror (NULL, error); void gtk_recent_chooser_unselect_uri (GtkRecentChooser *chooser, const gchar *uri) void gtk_recent_chooser_select_all (GtkRecentChooser *chooser) void gtk_recent_chooser_unselect_all (GtkRecentChooser *chooser) =for apidoc =for signature (list) = $chooser->get_items =cut void gtk_recent_chooser_get_items (GtkRecentChooser *chooser) PREINIT: GList *items, *l; PPCODE: items = gtk_recent_chooser_get_items (chooser); for (l = items; l != NULL; l = l->next) XPUSHs (sv_2mortal (newSVGtkRecentInfo_own (l->data))); g_list_free (items); =for apidoc =for signature (list) = $chooser->get_uris =cut void gtk_recent_chooser_get_uris (GtkRecentChooser *chooser) PREINIT: gchar **uris; gsize length, i; PPCODE: uris = gtk_recent_chooser_get_uris (chooser, &length); if (length == 0) XSRETURN_EMPTY; EXTEND (SP, length); for (i = 0; i < length; i++) PUSHs (sv_2mortal (newSVGChar (uris[i]))); g_strfreev (uris); # # Filters # void gtk_recent_chooser_add_filter (GtkRecentChooser *chooser, GtkRecentFilter *filter) void gtk_recent_chooser_remove_filter (GtkRecentChooser *chooser, GtkRecentFilter *filter) =for apidoc =for signature (filters) = $chooser->list_filters =cut void gtk_recent_chooser_list_filters (GtkRecentChooser *chooser) PREINIT: GSList *filters, *i; PPCODE: filters = gtk_recent_chooser_list_filters (chooser); for (i = filters; i != NULL; i = i->next) XPUSHs (sv_2mortal (newSVGtkRecentFilter (i->data))); g_slist_free (filters); void gtk_recent_chooser_set_filter (GtkRecentChooser *chooser, GtkRecentFilter *filter) GtkRecentFilter * gtk_recent_chooser_get_filter (GtkRecentChooser *chooser) Gtk2-1.24992/xs/GtkCellRendererAccel.xs0000644000175000017500000000250013076462677016112 0ustar lacklack/* * Copyright (c) 2006 by the gtk2-perl team (see the file AUTHORS) * * This library is free software; you can redistribute it and/or * modify it under the terms of the GNU Library General Public * License as published by the Free Software Foundation; either * version 2.1 of the License, or (at your option) any later version. * * This library is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU * Library General Public License for more details. * * You should have received a copy of the GNU Library General Public * License along with this library; if not, write to the * Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, * Boston, MA 02110-1301 USA. * * $Id$ */ #include "gtk2perl.h" MODULE = Gtk2::CellRendererAccel PACKAGE = Gtk2::CellRendererAccel PREFIX = gtk_cell_renderer_accel_ ##struct _GtkCellRendererAccel ##{ ## GtkCellRendererText parent; ## ## /*< private >*/ ## guint accel_key; ## GdkModifierType accel_mods; ## guint keycode; ## GtkCellRendererAccelMode accel_mode; ## ## GtkWidget *edit_widget; ## GtkWidget *grab_widget; ## GtkWidget *sizing_label; ##}; GtkCellRenderer *gtk_cell_renderer_accel_new (class); C_ARGS: /*void*/ Gtk2-1.24992/xs/GtkItemFactory.xs0000644000175000017500000003051113076462677015045 0ustar lacklack/* * Copyright (c) 2003 by the gtk2-perl team (see the file AUTHORS) * * This library is free software; you can redistribute it and/or * modify it under the terms of the GNU Library General Public * License as published by the Free Software Foundation; either * version 2.1 of the License, or (at your option) any later version. * * This library is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU * Library General Public License for more details. * * You should have received a copy of the GNU Library General Public * License along with this library; if not, write to the * Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, * Boston, MA 02110-1301 USA. * * $Id$ */ #include "gtk2perl.h" /* ------------------------------------------------------------------------- */ /* * a custom marshaler for the item factory callbacks */ static void gtk2perl_item_factory_item_activate (gpointer data, guint callback_action, GtkWidget * widget) { SV * callback_sv; SV * callback_data; dSP; /* the callback out of the widget */ callback_sv = (SV *) g_object_get_data ( G_OBJECT (widget), "_gtk2perl_item_factory_callback_sv"); callback_data = (SV *) data; ENTER; SAVETMPS; PUSHMARK (SP); /* put the parameters on the stack (we're always type 1) */ EXTEND (SP, 3); PUSHs (sv_2mortal (newSVsv (callback_data ? callback_data : &PL_sv_undef))); PUSHs (sv_2mortal (newSViv (callback_action))); PUSHs (sv_2mortal (newSVGtkWidget (widget))); PUTBACK; /* call the code in sv */ call_sv (callback_sv, G_DISCARD); FREETMPS; LEAVE; } /* ------------------------------------------------------------------------- */ GPerlCallback * gtk2perl_translate_func_create (SV * func, SV * data) { GType param_types[1]; param_types[0] = G_TYPE_STRING; return gperl_callback_new (func, data, G_N_ELEMENTS (param_types), param_types, G_TYPE_STRING); } gchar * gtk2perl_translate_func (const gchar *path, gpointer data) { GPerlCallback * callback = (GPerlCallback*)data; GValue value = {0,}; SV * tempsv = NULL; gchar * retval; g_value_init (&value, callback->return_type); gperl_callback_invoke (callback, &value, path); retval = (gchar *) g_value_get_string (&value); /* g_value_unset() will free the string to which retval points. * we will need to keep a copy; let's use a mortal scalar to keep * it around long enough to be useful to the C callers. */ if (retval) tempsv = sv_2mortal (newSVGChar (retval)); g_value_unset (&value); /* using SvPV rather than SvGChar because we used newSVGChar to create * it above, so we're assured that it's been upgraded to utf8 already. * this avoids uncertainty about whether SvGChar may vivify the mortal * value. (i'm paranoid.) */ return tempsv ? SvPV_nolen (tempsv) : NULL; } /* ------------------------------------------------------------------------- */ #define HV_FETCH_AND_CHECK(_member, _sv) \ if (hv_exists (hv, #_member, strlen (#_member))) { \ value = hv_fetch (hv, #_member, strlen (#_member), FALSE); \ if (value && gperl_sv_is_defined (*value)) \ entry->_member = _sv; \ } #define AV_FETCH_AND_CHECK(_index, _member, _sv) \ value = av_fetch (av, _index, 0); \ if (value && gperl_sv_is_defined (*value)) \ entry->_member = _sv; GtkItemFactoryEntry * SvGtkItemFactoryEntry (SV *data, SV **callback) { GtkItemFactoryEntry *entry = gperl_alloc_temp (sizeof (GtkItemFactoryEntry)); memset (entry, 0, sizeof (GtkItemFactoryEntry)); if (!gperl_sv_is_defined (data)) return entry; /* fail silently if undef */ if (gperl_sv_is_hash_ref (data)) { HV *hv = (HV *) SvRV (data); SV **value; HV_FETCH_AND_CHECK (path, SvGChar (*value)); HV_FETCH_AND_CHECK (accelerator, SvGChar (*value)); if (hv_exists (hv, "callback", 8)) { value = hv_fetch (hv, "callback", 8, FALSE); if (callback && value && gperl_sv_is_defined (*value)) { *callback = *value; entry->callback = gtk2perl_item_factory_item_activate; } } HV_FETCH_AND_CHECK (callback_action, SvIV (*value)); HV_FETCH_AND_CHECK (item_type, SvGChar (*value)); HV_FETCH_AND_CHECK (extra_data, SvPOK (*value) ? SvGChar (*value) : NULL); } else if (gperl_sv_is_array_ref (data)) { AV *av = (AV *) SvRV (data); SV **value; AV_FETCH_AND_CHECK (0, path, SvGChar (*value)); AV_FETCH_AND_CHECK (1, accelerator, SvGChar (*value)); value = av_fetch (av, 2, 0); if (callback && value && gperl_sv_is_defined (*value)) { *callback = *value; entry->callback = gtk2perl_item_factory_item_activate; } AV_FETCH_AND_CHECK (3, callback_action, SvIV (*value)); AV_FETCH_AND_CHECK (4, item_type, SvGChar (*value)); AV_FETCH_AND_CHECK (5, extra_data, SvPOK (*value) ? SvGChar (*value) : NULL); } else { croak ("badly formed GtkItemFactoryEntry; use either list or hash form:\n" " list form:\n" " [ path, accel, callback, action, type ]\n" " hash form:\n" " {\n" " path => $path,\n" " accelerator => $accel, # optional\n" " callback => $callback,\n" " callback_action => $action,\n" " item_type => $type, # optional\n" " extra_data => $extra, # optional\n" " }\n" " "); } return entry; } static void gtk2perl_item_factory_create_item_helper (GtkItemFactory *ifactory, SV *entry_ref, SV *callback_data) { GtkItemFactoryEntry *entry; gchar *clean_path; GtkWidget *widget = NULL; SV *callback_sv = NULL, *tmp_defsv; SV * real_data = callback_data ? gperl_sv_copy (callback_data) : NULL; entry = SvGtkItemFactoryEntry (entry_ref, &callback_sv); /* remove all those underscores that gtk+ turns into accelerators to * get a clean path that can later be used for item retrieval */ tmp_defsv = newSVsv (DEFSV); sv_setsv (DEFSV, sv_2mortal (newSVGChar (entry->path))); eval_pv ("s/_(?!_+)//g; s/_+/_/g;", 1); clean_path = SvGChar (sv_2mortal (newSVsv (DEFSV))); sv_setsv (DEFSV, tmp_defsv); /* create the item in the normal manner now */ gtk_item_factory_create_item (ifactory, entry, real_data, 1); /* get the widget that was created by create_item (this is why * we needed clean_path) */ widget = gtk_item_factory_get_item (ifactory, clean_path); if (widget) { /* put the sv we need to call into the widget */ g_object_set_data_full (G_OBJECT (widget), "_gtk2perl_item_factory_callback_sv", gperl_sv_copy (callback_sv), (GtkDestroyNotify) gperl_sv_free); if (real_data) g_object_set_data_full (G_OBJECT (widget), "_gtk2perl_item_factory_callback_data", real_data, (GtkDestroyNotify) gperl_sv_free); } else { if (real_data) gperl_sv_free (real_data); croak("ItemFactory couldn't retrieve widget it just created"); } } /* ------------------------------------------------------------------------- */ MODULE = Gtk2::ItemFactory PACKAGE = Gtk2::ItemFactory PREFIX = gtk_item_factory_ =for deprecated_by Gtk2::UIManager =cut ## GtkItemFactory* gtk_item_factory_new (GType container_type, const gchar *path, GtkAccelGroup *accel_group) GtkItemFactory* gtk_item_factory_new (class, container_type_package, path, accel_group=NULL) char * container_type_package const gchar *path GtkAccelGroup_ornull *accel_group PREINIT: GType container_type; CODE: container_type = gperl_type_from_package (container_type_package); RETVAL = gtk_item_factory_new (container_type, path, accel_group); OUTPUT: RETVAL ### deprecated ## void gtk_item_factory_add_foreign (GtkWidget *accel_widget, const gchar *full_path, GtkAccelGroup *accel_group, guint keyval, GdkModifierType modifiers) GtkItemFactory_ornull* gtk_item_factory_from_widget (class, widget) GtkWidget *widget C_ARGS: widget const gchar* gtk_item_factory_path_from_widget (class, widget) GtkWidget *widget C_ARGS: widget GtkWidget_ornull* gtk_item_factory_get_item (ifactory, path) GtkItemFactory *ifactory const gchar *path GtkWidget_ornull* gtk_item_factory_get_widget (ifactory, path) GtkItemFactory *ifactory const gchar *path GtkWidget_ornull* gtk_item_factory_get_widget_by_action (ifactory, action) GtkItemFactory *ifactory guint action GtkWidget_ornull* gtk_item_factory_get_item_by_action (ifactory, action) GtkItemFactory *ifactory guint action =for apidoc =for arg entry_ref GtkItemFactoryEntry =cut void gtk_item_factory_create_item (ifactory, entry_ref, callback_data=NULL) GtkItemFactory *ifactory SV *entry_ref SV *callback_data CODE: gtk2perl_item_factory_create_item_helper (ifactory, entry_ref, callback_data); =for apidoc =for arg ... GtkItemFactoryEntry's =cut void gtk_item_factory_create_items (ifactory, callback_data, ...) GtkItemFactory *ifactory SV *callback_data PREINIT: int i; CODE: for (i = 2; i < items; i++) gtk2perl_item_factory_create_item_helper (ifactory, ST (i), callback_data); void gtk_item_factory_delete_item (ifactory, path) GtkItemFactory *ifactory const gchar *path =for apidoc =for arg entry_ref GtkItemFactoryEntry =cut void gtk_item_factory_delete_entry (ifactory, entry_ref) GtkItemFactory *ifactory SV *entry_ref PREINIT: GtkItemFactoryEntry *entry; CODE: entry = SvGtkItemFactoryEntry (entry_ref, NULL); gtk_item_factory_delete_entry (ifactory, entry); =for apidoc =for arg ... GtkItemFactoryEntry's =cut void gtk_item_factory_delete_entries (ifactory, ...) GtkItemFactory *ifactory PREINIT: int i; GtkItemFactoryEntry *entry; CODE: for (i = 1; i < items; i++) { entry = SvGtkItemFactoryEntry (ST (i), NULL); gtk_item_factory_delete_entry (ifactory, entry); } ## void gtk_item_factory_popup (GtkItemFactory *ifactory, guint x, guint y, guint mouse_button, guint32 time_) ## void gtk_item_factory_popup_with_data(GtkItemFactory *ifactory, gpointer popup_data, GtkDestroyNotify destroy, guint x, guint y, guint mouse_button, guint32 time_) ### combination of gtk_item_factory_popup and gtk_item_factory_popup_with_data void gtk_item_factory_popup (ifactory, x, y, mouse_button, time_, popup_data=NULL) GtkItemFactory *ifactory guint x guint y guint mouse_button guint32 time_ SV * popup_data PREINIT: SV * real_popup_data = NULL; CODE: if (gperl_sv_is_defined (popup_data)) real_popup_data = gperl_sv_copy (popup_data); gtk_item_factory_popup_with_data (ifactory, real_popup_data, real_popup_data ? (GDestroyNotify)gperl_sv_free : NULL, x, y, mouse_button, time_); SV * gtk_item_factory_popup_data (ifactory) GtkItemFactory *ifactory CODE: RETVAL = (SV *) gtk_item_factory_popup_data (ifactory); if (RETVAL) { RETVAL = gperl_sv_copy (RETVAL); } else { RETVAL = &PL_sv_undef; } OUTPUT: RETVAL SV * gtk_item_factory_popup_data_from_widget (class, widget) GtkWidget *widget CODE: RETVAL = (SV *) gtk_item_factory_popup_data_from_widget (widget); if (RETVAL) { RETVAL = gperl_sv_copy (RETVAL); } else { RETVAL = &PL_sv_undef; } OUTPUT: RETVAL void gtk_item_factory_set_translate_func (ifactory, func, data=NULL) GtkItemFactory *ifactory SV *func SV *data PREINIT: GPerlCallback *callback; CODE: callback = gtk2perl_translate_func_create (func, data); gtk_item_factory_set_translate_func (ifactory, gtk2perl_translate_func, callback, (GtkDestroyNotify) gperl_callback_destroy); ## ## deprecated ## ## void gtk_item_factory_create_items_ac (GtkItemFactory *ifactory, guint n_entries, GtkItemFactoryEntry *entries, gpointer callback_data, guint callback_type) ## GtkItemFactory* gtk_item_factory_from_path (const gchar *path) ## void gtk_item_factory_create_menu_entries (guint n_entries, GtkMenuEntry *entries) ## void gtk_item_factories_path_delete (const gchar *ifactory_path, const gchar *path) Gtk2-1.24992/xs/GtkActivatable.xs0000644000175000017500000000145513076462677015043 0ustar lacklack/* * Copyright (c) 2010 by the gtk2-perl team (see the file AUTHORS) * * Licensed under the LGPL, see LICENSE file for more information. * * $Id$ */ #include "gtk2perl.h" MODULE = Gtk2::Activatable PACKAGE = Gtk2::Activatable PREFIX = gtk_activatable_ void gtk_activatable_do_set_related_action (GtkActivatable *activatable, GtkAction *action); GtkAction_ornull * gtk_activatable_get_related_action (GtkActivatable *activatable); gboolean gtk_activatable_get_use_action_appearance (GtkActivatable *activatable); void gtk_activatable_sync_action_properties (GtkActivatable *activatable, GtkAction *action); void gtk_activatable_set_related_action (GtkActivatable *activatable, GtkAction *action); void gtk_activatable_set_use_action_appearance (GtkActivatable *activatable, gboolean use_appearance); Gtk2-1.24992/xs/GtkRange.xs0000644000175000017500000001003513076462677013652 0ustar lacklack/* * Copyright (c) 2003-2006 by the gtk2-perl team (see the file AUTHORS) * * This library is free software; you can redistribute it and/or * modify it under the terms of the GNU Library General Public * License as published by the Free Software Foundation; either * version 2.1 of the License, or (at your option) any later version. * * This library is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU * Library General Public License for more details. * * You should have received a copy of the GNU Library General Public * License along with this library; if not, write to the * Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, * Boston, MA 02110-1301 USA. * * $Id$ */ #include "gtk2perl.h" MODULE = Gtk2::Range PACKAGE = Gtk2::Range PREFIX = gtk_range_ ## void gtk_range_set_update_policy (GtkRange *range, GtkUpdateType policy) void gtk_range_set_update_policy (range, policy) GtkRange * range GtkUpdateType policy ## GtkUpdateType gtk_range_get_update_policy (GtkRange *range) GtkUpdateType gtk_range_get_update_policy (range) GtkRange * range ## void gtk_range_set_adjustment (GtkRange *range, GtkAdjustment *adjustment) void gtk_range_set_adjustment (range, adjustment) GtkRange * range GtkAdjustment * adjustment ## GtkAdjustment* gtk_range_get_adjustment (GtkRange *range) GtkAdjustment* gtk_range_get_adjustment (range) GtkRange * range ## void gtk_range_set_inverted (GtkRange *range, gboolean setting) void gtk_range_set_inverted (range, setting) GtkRange * range gboolean setting ## gboolean gtk_range_get_inverted (GtkRange *range) gboolean gtk_range_get_inverted (range) GtkRange * range ## void gtk_range_set_increments (GtkRange *range, gdouble step, gdouble page) void gtk_range_set_increments (range, step, page) GtkRange * range gdouble step gdouble page ## void gtk_range_set_range (GtkRange *range, gdouble min, gdouble max) void gtk_range_set_range (range, min, max) GtkRange * range gdouble min gdouble max ## void gtk_range_set_value (GtkRange *range, gdouble value) void gtk_range_set_value (range, value) GtkRange * range gdouble value ## gdouble gtk_range_get_value (GtkRange *range) gdouble gtk_range_get_value (range) GtkRange * range #if GTK_CHECK_VERSION (2, 10, 0) GtkSensitivityType gtk_range_get_lower_stepper_sensitivity (GtkRange *range); void gtk_range_set_lower_stepper_sensitivity (GtkRange *range, GtkSensitivityType sensitivity); GtkSensitivityType gtk_range_get_upper_stepper_sensitivity (GtkRange *range); void gtk_range_set_upper_stepper_sensitivity (GtkRange *range, GtkSensitivityType sensitivity); #endif #if GTK_CHECK_VERSION (2, 12, 0) void gtk_range_set_show_fill_level (GtkRange *range, gboolean show_fill_level); gboolean gtk_range_get_show_fill_level (GtkRange *range); void gtk_range_set_restrict_to_fill_level (GtkRange *range, gboolean restrict_to_fill_level); gboolean gtk_range_get_restrict_to_fill_level (GtkRange *range); void gtk_range_set_fill_level (GtkRange *range, gdouble fill_level); gdouble gtk_range_get_fill_level (GtkRange *range); #endif #if GTK_CHECK_VERSION (2, 18, 0) gboolean gtk_range_get_flippable (GtkRange *range); void gtk_range_set_flippable (GtkRange *range, gboolean flippable); #endif #if GTK_CHECK_VERSION (2, 20, 0) void gtk_range_set_min_slider_size (GtkRange *range, gboolean min_size); gint gtk_range_get_min_slider_size (GtkRange *range); # void gtk_range_get_range_rect (GtkRange *range, GdkRectangle *range_rect) GdkRectangle_copy * gtk_range_get_range_rect (GtkRange *range) PREINIT: GdkRectangle range_rect; CODE: gtk_range_get_range_rect (range, &range_rect); RETVAL = &range_rect; OUTPUT: RETVAL void gtk_range_get_slider_range (GtkRange *range, OUTLIST gint slider_start, OUTLIST gint slider_end); void gtk_range_set_slider_size_fixed (GtkRange *range, gboolean size_fixed); gboolean gtk_range_get_slider_size_fixed (GtkRange *range); #endif /* 2.20 */ Gtk2-1.24992/xs/GtkClipboard.xs0000644000175000017500000004605713076462677014532 0ustar lacklack/* * Copyright (c) 2003-2006 by the gtk2-perl team (see the file AUTHORS) * * This library is free software; you can redistribute it and/or * modify it under the terms of the GNU Library General Public * License as published by the Free Software Foundation; either * version 2.1 of the License, or (at your option) any later version. * * This library is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU * Library General Public License for more details. * * You should have received a copy of the GNU Library General Public * License along with this library; if not, write to the * Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, * Boston, MA 02110-1301 USA. * * $Id$ */ #include "gtk2perl.h" /* * this entire object didn't exist in the original 2.0.0 release. hrm. */ #ifdef GTK_TYPE_CLIPBOARD #define DEFINE_QUARK(stem) \ static GQuark \ stem ## _quark (void) \ { \ static GQuark q = 0; \ if (q == 0) \ q = g_quark_from_static_string ("gtk2perl_" #stem ); \ return q; \ } DEFINE_QUARK (clipboard_get) DEFINE_QUARK (clipboard_clear) DEFINE_QUARK (clipboard_user_data) static void gtk2perl_clipboard_received_func (GtkClipboard *clipboard, GtkSelectionData *selection_data, gpointer data) { GPerlCallback * callback = (GPerlCallback*) data; gperl_callback_invoke (callback, NULL, clipboard, selection_data); gperl_callback_destroy (callback); } static void gtk2perl_clipboard_text_received_func (GtkClipboard *clipboard, const gchar *text, gpointer data) { GPerlCallback * callback = (GPerlCallback*) data; gperl_callback_invoke (callback, NULL, clipboard, text); gperl_callback_destroy (callback); } #if GTK_CHECK_VERSION(2, 4, 0) static void gtk2perl_clipboard_targets_received_func (GtkClipboard *clipboard, GdkAtom * targets, gint n_targets, gpointer data) { SV * targetlist; AV * av; int i; GPerlCallback * callback = (GPerlCallback*) data; av = newAV (); for (i = 0 ; i < n_targets ; i++) av_push (av, newSVGdkAtom (targets[i])); targetlist = sv_2mortal (newRV_noinc ((SV*) av)); gperl_callback_invoke (callback, NULL, clipboard, targetlist); gperl_callback_destroy (callback); } #endif #if GTK_CHECK_VERSION(2, 6, 0) static void gtk2perl_clipboard_image_received_func (GtkClipboard *clipboard, GdkPixbuf *pixbuf, gpointer data) { GPerlCallback * callback = (GPerlCallback*) data; gperl_callback_invoke (callback, NULL, clipboard, pixbuf); gperl_callback_destroy (callback); } #endif static void gtk2perl_clipboard_get_func (GtkClipboard *clipboard, GtkSelectionData *selection_data, guint info, gpointer user_data_or_owner) { GPerlCallback * callback = (GPerlCallback*) g_object_get_qdata (G_OBJECT (clipboard), clipboard_get_quark()); gperl_callback_invoke (callback, NULL, clipboard, selection_data, info, user_data_or_owner); } static void gtk2perl_clipboard_clear_func (GtkClipboard *clipboard, gpointer user_data_or_owner) { GPerlCallback * callback = (GPerlCallback*) g_object_get_qdata (G_OBJECT (clipboard), clipboard_clear_quark()); gperl_callback_invoke (callback, NULL, clipboard, user_data_or_owner); } #if GTK_CHECK_VERSION (2, 10, 0) static void gtk2perl_clipboard_rich_text_received_func (GtkClipboard *clipboard, GdkAtom format, const guint8 *text, gsize length, gpointer data) { gperl_callback_invoke ((GPerlCallback*) data, NULL, clipboard, sv_2mortal (newSVGdkAtom (format)), sv_2mortal (newSVpvn ((const char *) text, length))); } #endif /* 2.10 */ #if GTK_CHECK_VERSION (2, 14, 0) static void gtk2perl_clipboard_uri_received_func (GtkClipboard *clipboard, gchar **uris, gpointer data) { /* uris is not owned by us */ gperl_callback_invoke ((GPerlCallback*) data, NULL, clipboard, uris); } #endif /* 2.14 */ #endif /* defined GTK_TYPE_CLIPBOARD */ MODULE = Gtk2::Clipboard PACKAGE = Gtk2::Clipboard PREFIX = gtk_clipboard_ #ifdef GTK_TYPE_CLIPBOARD ## GtkClipboard *gtk_clipboard_get (GdkAtom selection) GtkClipboard * gtk_clipboard_get (class, selection) GdkAtom selection C_ARGS: selection #if GTK_CHECK_VERSION(2,2,0) ## GtkClipboard *gtk_clipboard_get_for_display (GdkDisplay *display, GdkAtom selection) GtkClipboard * gtk_clipboard_get_for_display (class, display, selection) GdkDisplay *display GdkAtom selection C_ARGS: display, selection ## GdkDisplay *gtk_clipboard_get_display (GtkClipboard *clipboard) GdkDisplay * gtk_clipboard_get_display (clipboard) GtkClipboard *clipboard #endif /* >=2.2.0 */ #### gboolean gtk_clipboard_set_with_data (GtkClipboard *clipboard, const GtkTargetEntry *targets, guint n_targets, GtkClipboardGetFunc get_func, GtkClipboardClearFunc clear_func, gpointer user_data) =for apidoc =for arg ... of Gtk2::TargetEntry's =cut gboolean gtk_clipboard_set_with_data (clipboard, get_func, clear_func, user_data, ...) GtkClipboard *clipboard SV * get_func SV * clear_func SV * user_data PREINIT: GtkTargetEntry *targets = NULL; guint n_targets; GPerlCallback * get_callback; GType get_param_types[4]; GPerlCallback * clear_callback; GType clear_param_types[2]; SV * real_user_data; CODE: get_param_types[0] = GTK_TYPE_CLIPBOARD; get_param_types[1] = GTK_TYPE_SELECTION_DATA; get_param_types[2] = G_TYPE_UINT; /* since we're on the _data one */ get_param_types[3] = GPERL_TYPE_SV; clear_param_types[0] = GTK_TYPE_CLIPBOARD; /* since we're on the _data one */ clear_param_types[1] = GPERL_TYPE_SV; GTK2PERL_STACK_ITEMS_TO_TARGET_ENTRY_ARRAY (4, targets, n_targets); /* WARNING: since we're piggybacking on the same callback for * the _with_data and _with_owner forms, the user_data arg * will go through the standard GSignal user data, and thus * we'll pass NULL to gperl_callback_new's user_data parameter. * this is not typical usage. */ get_callback = gperl_callback_new (get_func, NULL, 4, get_param_types, G_TYPE_NONE); clear_callback = gperl_callback_new (clear_func, NULL, 2, clear_param_types, G_TYPE_NONE); real_user_data = newSVsv (user_data); RETVAL = gtk_clipboard_set_with_data (clipboard, targets, n_targets, gtk2perl_clipboard_get_func, gtk2perl_clipboard_clear_func, real_user_data); if (!RETVAL) { gperl_callback_destroy (get_callback); gperl_callback_destroy (clear_callback); SvREFCNT_dec (real_user_data); } else { g_object_set_qdata_full (G_OBJECT (clipboard), clipboard_get_quark(), get_callback, (GDestroyNotify) gperl_callback_destroy); g_object_set_qdata_full (G_OBJECT (clipboard), clipboard_clear_quark(), clear_callback, (GDestroyNotify) gperl_callback_destroy); g_object_set_qdata_full (G_OBJECT (clipboard), clipboard_user_data_quark (), real_user_data, (GDestroyNotify) gperl_sv_free); } OUTPUT: RETVAL ## gboolean gtk_clipboard_set_with_owner (GtkClipboard *clipboard, const GtkTargetEntry *targets, guint n_targets, GtkClipboardGetFunc get_func, GtkClipboardClearFunc clear_func, GObject *owner) =for apidoc =for arg ... of Gtk2::TargetEntry's =cut gboolean gtk_clipboard_set_with_owner (clipboard, get_func, clear_func, owner, ...) GtkClipboard *clipboard SV * get_func SV * clear_func GObject *owner PREINIT: GtkTargetEntry *targets = NULL; guint n_targets = 0; GPerlCallback * get_callback; GType get_param_types[4]; GPerlCallback * clear_callback; GType clear_param_types[2]; CODE: get_param_types[0] = GTK_TYPE_CLIPBOARD; get_param_types[1] = GTK_TYPE_SELECTION_DATA; get_param_types[2] = G_TYPE_UINT; /* since we're on the _owner one */ get_param_types[3] = G_TYPE_OBJECT; clear_param_types[0] = GTK_TYPE_CLIPBOARD; /* since we're on the _owner one */ clear_param_types[1] = G_TYPE_OBJECT; GTK2PERL_STACK_ITEMS_TO_TARGET_ENTRY_ARRAY (4, targets, n_targets); /* WARNING: since we're piggybacking on the same callback for * the _with_data and _with_owner forms, the owner arg * will go through the standard GSignal user data, and thus * we'll pass NULL to gperl_callback_new's user_data parameter. * this is not typical usage. * * you may be thinking that i should just use the same function * for both forms, like with signal_connect in Glib. the * difference here is that gtk will treat the owner differently -- * you can query the owner -- so we have to call the proper one. * of course, we could put both of these in the same perl wrapper... */ get_callback = gperl_callback_new (get_func, NULL, 4, get_param_types, G_TYPE_NONE); clear_callback = gperl_callback_new (clear_func, NULL, 2, clear_param_types, G_TYPE_NONE); RETVAL = gtk_clipboard_set_with_owner (clipboard, targets, n_targets, gtk2perl_clipboard_get_func, gtk2perl_clipboard_clear_func, owner); if (!RETVAL) { gperl_callback_destroy (get_callback); gperl_callback_destroy (clear_callback); } else { g_object_set_qdata_full (G_OBJECT (clipboard), clipboard_get_quark(), get_callback, (GDestroyNotify) gperl_callback_destroy); g_object_set_qdata_full (G_OBJECT (clipboard), clipboard_clear_quark(), clear_callback, (GDestroyNotify) gperl_callback_destroy); } OUTPUT: RETVAL ## GObject *gtk_clipboard_get_owner (GtkClipboard *clipboard) ###GObject_ornull * GObject * gtk_clipboard_get_owner (clipboard) GtkClipboard *clipboard ## void gtk_clipboard_clear (GtkClipboard *clipboard) void gtk_clipboard_clear (clipboard) GtkClipboard *clipboard void gtk_clipboard_set_text (GtkClipboard *clipboard, const gchar_length *text, int length(text)) ## void gtk_clipboard_request_contents (GtkClipboard *clipboard, GdkAtom target, GtkClipboardReceivedFunc callback, gpointer user_data) void gtk_clipboard_request_contents (clipboard, target, callback, user_data=NULL) GtkClipboard *clipboard GdkAtom target SV * callback SV * user_data PREINIT: GPerlCallback * real_callback; GType param_types[2]; CODE: param_types[0] = GTK_TYPE_CLIPBOARD; param_types[1] = GTK_TYPE_SELECTION_DATA; real_callback = gperl_callback_new (callback, user_data, 2, param_types, G_TYPE_NONE); gtk_clipboard_request_contents (clipboard, target, gtk2perl_clipboard_received_func, real_callback); ## void gtk_clipboard_request_text (GtkClipboard *clipboard, GtkClipboardTextReceivedFunc callback, gpointer user_data) void gtk_clipboard_request_text (clipboard, callback, user_data=NULL) GtkClipboard *clipboard SV * callback SV * user_data PREINIT: GPerlCallback * real_callback; GType param_types[2]; CODE: param_types[0] = GTK_TYPE_CLIPBOARD; param_types[1] = G_TYPE_STRING; real_callback = gperl_callback_new (callback, user_data, 2, param_types, G_TYPE_NONE); gtk_clipboard_request_text (clipboard, gtk2perl_clipboard_text_received_func, real_callback); ## GtkSelectionData *gtk_clipboard_wait_for_contents (GtkClipboard *clipboard, GdkAtom target) GtkSelectionData_own_ornull * gtk_clipboard_wait_for_contents (clipboard, target) GtkClipboard *clipboard GdkAtom target ## gchar * gtk_clipboard_wait_for_text (GtkClipboard *clipboard) gchar * gtk_clipboard_wait_for_text (clipboard) GtkClipboard *clipboard CLEANUP: g_free (RETVAL); ## gboolean gtk_clipboard_wait_is_text_available (GtkClipboard *clipboard) gboolean gtk_clipboard_wait_is_text_available (clipboard) GtkClipboard *clipboard #if GTK_CHECK_VERSION (2, 4, 0) ## void gtk_clipboard_request_targets (GtkClipboard *clipboard, GtkClipboardTargetsReceivedFunc callback, gpointer user_data); void gtk_clipboard_request_targets (GtkClipboard *clipboard, SV * callback, SV * user_data=NULL) PREINIT: GType param_types[2]; GPerlCallback * real_callback; CODE: param_types[0] = GTK_TYPE_CLIPBOARD; param_types[1] = GPERL_TYPE_SV; real_callback = gperl_callback_new (callback, user_data, 2, param_types, G_TYPE_NONE); gtk_clipboard_request_targets (clipboard, gtk2perl_clipboard_targets_received_func, real_callback); =for apidoc Returns a list of GdkAtom's. =cut ## gboolean gtk_clipboard_wait_for_targets (GtkClipboard *clipboard, GdkAtom **targets, gint *n_targets); void gtk_clipboard_wait_for_targets (GtkClipboard *clipboard) PREINIT: GdkAtom *targets = NULL; gint n_targets, i; PPCODE: if (!gtk_clipboard_wait_for_targets (clipboard, &targets, &n_targets)) XSRETURN_EMPTY; if (targets) { EXTEND (SP, n_targets); for (i = 0 ; i < n_targets ; i++) PUSHs (sv_2mortal (newSVGdkAtom (targets[i]))); g_free (targets); } #endif /* 2.4.0 */ #if GTK_CHECK_VERSION (2, 6, 0) void gtk_clipboard_set_image (GtkClipboard *clipboard, GdkPixbuf *pixbuf); GdkPixbuf_noinc_ornull * gtk_clipboard_wait_for_image (GtkClipboard *clipboard); gboolean gtk_clipboard_wait_is_image_available (GtkClipboard *clipboard); ## void gtk_clipboard_request_image (GtkClipboard *clipboard, GtkClipboardImageReceivedFunc callback, gpointer user_data); void gtk_clipboard_request_image (GtkClipboard *clipboard, SV *callback, SV *user_data=NULL) PREINIT: GType param_types[2]; GPerlCallback *real_callback; CODE: param_types[0] = GTK_TYPE_CLIPBOARD; param_types[1] = GDK_TYPE_PIXBUF; real_callback = gperl_callback_new (callback, user_data, 2, param_types, G_TYPE_NONE); gtk_clipboard_request_image (clipboard, gtk2perl_clipboard_image_received_func, real_callback); ## void gtk_clipboard_set_can_store (GtkClipboard *clipboard, const GtkTargetEntry *targets, gint n_targets); =for apidoc =for arg ... of Gtk2::TargetEntry's =cut void gtk_clipboard_set_can_store (clipboard, ...); GtkClipboard *clipboard PREINIT: GtkTargetEntry *targets = NULL; guint n_targets; CODE: GTK2PERL_STACK_ITEMS_TO_TARGET_ENTRY_ARRAY (1, targets, n_targets); gtk_clipboard_set_can_store (clipboard, targets, (gint) n_targets); void gtk_clipboard_store (GtkClipboard *clipboard); gboolean gtk_clipboard_wait_is_target_available (GtkClipboard *clipboard, GdkAtom target); #endif /* 2.6.0 */ #if GTK_CHECK_VERSION (2, 10, 0) ##void ##gtk_clipboard_request_rich_text (GtkClipboard *clipboard, ## GtkTextBuffer *buffer, ## GtkClipboardRichTextReceivedFunc callback, ## gpointer user_data) void gtk_clipboard_request_rich_text (clipboard, buffer, callback, user_data=NULL) GtkClipboard * clipboard GtkTextBuffer * buffer SV * callback SV * user_data PREINIT: GPerlCallback * real_callback; GType param_types[3]; CODE: param_types[0] = GTK_TYPE_CLIPBOARD; param_types[1] = GPERL_TYPE_SV; /* there is no GDK_TYPE_ATOM */ /* The real callback gets string and length parameters, but * perl scalars know their own length, so we won't expose that. * The string may have embedded nuls, so we use an SV. */ param_types[2] = GPERL_TYPE_SV; real_callback = gperl_callback_new (callback, user_data, G_N_ELEMENTS (param_types), param_types, G_TYPE_NONE); gtk_clipboard_request_rich_text (clipboard, buffer, gtk2perl_clipboard_rich_text_received_func, real_callback); ##guint8 * ##gtk_clipboard_wait_for_rich_text (GtkClipboard *clipboard, ## GtkTextBuffer *buffer, ## GdkAtom *format, ## gsize *length) void gtk_clipboard_wait_for_rich_text (clipboard, buffer) GtkClipboard *clipboard GtkTextBuffer *buffer PREINIT: GdkAtom format; gsize length; guint8 *text; PPCODE: text = gtk_clipboard_wait_for_rich_text (clipboard, buffer, &format, &length); if (text) { EXTEND (SP, 2); PUSHs (sv_2mortal (newSVpvn ((const char *) text, length))); PUSHs (sv_2mortal (newSVGdkAtom (format))); g_free (text); } gboolean gtk_clipboard_wait_is_rich_text_available (GtkClipboard *clipboard, GtkTextBuffer *buffer) #endif /* 2.10.0 */ #if GTK_CHECK_VERSION (2, 14, 0) # void gtk_clipboard_request_uris (GtkClipboard *clipboard, GtkClipboardURIReceivedFunc callback, gpointer user_data); void gtk_clipboard_request_uris (GtkClipboard *clipboard, SV *func, SV *data=NULL) PREINIT: GPerlCallback * callback; GType param_types[2]; CODE: param_types[0] = GTK_TYPE_CLIPBOARD; param_types[1] = G_TYPE_STRV; callback = gperl_callback_new (func, data, G_N_ELEMENTS (param_types), param_types, G_TYPE_NONE); gtk_clipboard_request_uris (clipboard, gtk2perl_clipboard_uri_received_func, callback); # gchar** gtk_clipboard_wait_for_uris (GtkClipboard *clipboard); SV * gtk_clipboard_wait_for_uris (GtkClipboard *clipboard) PREINIT: gchar **strv; CODE: strv = gtk_clipboard_wait_for_uris (clipboard); RETVAL = gperl_new_boxed (strv, G_TYPE_STRV, TRUE); /* we own the strv */ OUTPUT: RETVAL gboolean gtk_clipboard_wait_is_uris_available (GtkClipboard *clipboard); #endif /* 2.14 */ #endif /* defined GTK_TYPE_CLIPBOARD */ Gtk2-1.24992/xs/GtkWindow.xs0000644000175000017500000005456613076462677014106 0ustar lacklack/* * Copyright (c) 2003-2006, 2009 by the gtk2-perl team (see the file AUTHORS) * * This library is free software; you can redistribute it and/or * modify it under the terms of the GNU Library General Public * License as published by the Free Software Foundation; either * version 2.1 of the License, or (at your option) any later version. * * This library is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU * Library General Public License for more details. * * You should have received a copy of the GNU Library General Public * License along with this library; if not, write to the * Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, * Boston, MA 02110-1301 USA. * * $Id$ */ #include "gtk2perl.h" MODULE = Gtk2::Window PACKAGE = Gtk2::Window PREFIX = gtk_window_ =for position DESCRIPTION =head1 DESCRIPTION A Gtk2::Window is a top-level window displayed on the root window and interacting (or not) with the window manager. It can be an application's main window, a dialog, or a temporary such as a popup splash window. =head2 Delete Event and Destroy The default action for a C (normally from the window manager close button) is to destroy the window with C<< $window->destroy >>. In your main window you might want to exit the main loop when that happens. $toplevel->signal_connect (destroy => sub { Gtk2->main_quit }); If you install a handler for C and return true, meaning "don't propagate", you can do something other than destroy the window. For example $toplevel->signal_connect (delete_event => sub { if (any_unsaved_documents()) { popup_ask_save_before_exit_dialog(); return Gtk2::EVENT_STOP; # don't go to default destroy } else { return Gtk2::EVENT_PROPAGATE; } }); In a dialog or secondary app window you might not want to destroy but instead just hide ready for later re-use. $dialog->signal_connect (delete_event => \&Gtk2::Widget::hide_on_delete); The choice between destroying or hiding is normally just a matter of memory saved against the time to re-create, and how likely the dialog might be needed again. (However if you build windows with Glade it's not particularly easy to re-create them there, so you'll mostly want to just hide in that case.) A hidden toplevel window is still in C<< Gtk2::Window->list_toplevels >> and that's a good place to search for an existing window of a desired type to C<< $window->present >> again. =cut =for enum GtkWindowPosition =cut =for enum GtkWindowType =cut ## GtkWidget* gtk_window_new (GtkWindowType type) GtkWidget * gtk_window_new (class, type=GTK_WINDOW_TOPLEVEL) GtkWindowType type C_ARGS: type ## void gtk_window_set_title (GtkWindow *window, const gchar *title) void gtk_window_set_title (window, title=NULL) GtkWindow * window const gchar_ornull * title ## void gtk_window_set_wmclass (GtkWindow *window, const gchar *wmclass_name, const gchar *wmclass_class) void gtk_window_set_wmclass (window, wmclass_name, wmclass_class) GtkWindow * window const gchar * wmclass_name const gchar * wmclass_class ## void gtk_window_set_role (GtkWindow *window, const gchar *role) void gtk_window_set_role (window, role) GtkWindow * window const gchar * role ##G_CONST_RETURN gchar* gtk_window_get_role (GtkWindow *window) const gchar * gtk_window_get_role (window) GtkWindow *window ## void gtk_window_add_accel_group (GtkWindow *window, GtkAccelGroup *accel_group) void gtk_window_add_accel_group (window, accel_group) GtkWindow * window GtkAccelGroup * accel_group ## void gtk_window_remove_accel_group (GtkWindow *window, GtkAccelGroup *accel_group) void gtk_window_remove_accel_group (window, accel_group) GtkWindow * window GtkAccelGroup * accel_group ## void gtk_window_set_position (GtkWindow *window, GtkWindowPosition position) void gtk_window_set_position (window, position) GtkWindow * window GtkWindowPosition position ## gboolean gtk_window_activate_focus (GtkWindow *window) gboolean gtk_window_activate_focus (window) GtkWindow * window ## GtkWidget * gtk_window_get_focus (GtkWindow *window) GtkWidget_ornull * gtk_window_get_focus (window) GtkWindow * window ## void gtk_window_set_focus (GtkWindow *window, GtkWidget *focus) void gtk_window_set_focus (window, focus=NULL) GtkWindow * window GtkWidget_ornull * focus ## void gtk_window_set_default (GtkWindow *window, GtkWidget *default_widget) void gtk_window_set_default (window, default_widget) GtkWindow * window GtkWidget_ornull * default_widget ## gboolean gtk_window_activate_default (GtkWindow *window) gboolean gtk_window_activate_default (window) GtkWindow * window ## void gtk_window_set_default_size (GtkWindow *window, gint width, gint height) void gtk_window_set_default_size (window, width, height) GtkWindow * window gint width gint height ## void gtk_window_set_modal (GtkWindow *window, gboolean modal) void gtk_window_set_modal (window, modal) GtkWindow * window gboolean modal ## void gtk_window_set_transient_for (GtkWindow *window, GtkWindow *parent) void gtk_window_set_transient_for (window, parent) GtkWindow * window GtkWindow_ornull * parent ## void gtk_window_set_type_hint (GtkWindow *window, GdkWindowTypeHint hint) void gtk_window_set_type_hint (window, hint) GtkWindow * window GdkWindowTypeHint hint ## G_CONST_RETURN gchar* gtk_window_get_title (GtkWindow *window) const gchar * gtk_window_get_title (window) GtkWindow * window ## GtkWindow* gtk_window_get_transient_for (GtkWindow *window) GtkWindow_ornull * gtk_window_get_transient_for (window) GtkWindow * window ## GdkWindowTypeHint gtk_window_get_type_hint (GtkWindow *window) GdkWindowTypeHint gtk_window_get_type_hint (window) GtkWindow * window #if GTK_CHECK_VERSION(2, 4, 0) gboolean gtk_window_get_accept_focus (GtkWindow *window) void gtk_window_set_accept_focus (GtkWindow *window, gboolean setting) #endif ## void gtk_window_set_destroy_with_parent (GtkWindow *window, gboolean setting) void gtk_window_set_destroy_with_parent (window, setting) GtkWindow * window gboolean setting ## gboolean gtk_window_get_destroy_with_parent (GtkWindow *window) gboolean gtk_window_get_destroy_with_parent (window) GtkWindow * window ## void gtk_window_set_resizable (GtkWindow *window, gboolean resizable) void gtk_window_set_resizable (window, resizable) GtkWindow * window gboolean resizable ## gboolean gtk_window_get_resizable (GtkWindow *window) gboolean gtk_window_get_resizable (window) GtkWindow * window ## void gtk_window_set_gravity (GtkWindow *window, GdkGravity gravity) void gtk_window_set_gravity (window, gravity) GtkWindow * window GdkGravity gravity ## GdkGravity gtk_window_get_gravity (GtkWindow *window) GdkGravity gtk_window_get_gravity (window) GtkWindow * window =for apidoc =for signature $window->set_geometry_hints ($geometry_widget, $geometry) =for signature $window->set_geometry_hints ($geometry_widget, $geometry, $geom_mask) =for arg geometry_ref (__hide__) =for arg geom_mask_sv (__hide__) =for arg geometry (scalar) Gtk2::Gdk::Geometry or hashref =for arg geom_mask (Gtk2::Gdk::WindowHints) optional, usually inferred from I<$geometry> See L|Gtk2::Gdk::Window/$window-EB ($geometry)> on the $geometry and $geom_mask arguments. =cut ## void gtk_window_set_geometry_hints (GtkWindow *window, GtkWidget *geometry_widget, GdkGeometry *geometry, GdkWindowHints geom_mask) void gtk_window_set_geometry_hints (window, geometry_widget, geometry_ref, geom_mask_sv=NULL) GtkWindow * window GtkWidget * geometry_widget SV * geometry_ref SV * geom_mask_sv PREINIT: GdkGeometry *geometry; GdkWindowHints geom_mask; CODE: if (!gperl_sv_is_defined (geom_mask_sv)) { geometry = SvGdkGeometryReal (geometry_ref, &geom_mask); } else { geometry = SvGdkGeometry (geometry_ref); geom_mask = SvGdkWindowHints (geom_mask_sv); } gtk_window_set_geometry_hints (window, geometry_widget, geometry, geom_mask); ## gboolean gtk_window_get_has_frame (GtkWindow *window) gboolean gtk_window_get_has_frame (window) GtkWindow * window ## void gtk_window_set_frame_dimensions (GtkWindow *window, gint left, gint top, gint right, gint bottom) void gtk_window_set_frame_dimensions (window, left, top, right, bottom) GtkWindow * window gint left gint top gint right gint bottom ## void gtk_window_get_frame_dimensions (GtkWindow *window, gint *left, gint *top, gint *right, gint *bottom) void gtk_window_get_frame_dimensions (GtkWindow * window, OUTLIST gint left, OUTLIST gint top, OUTLIST gint right, OUTLIST gint bottom) ## void gtk_window_set_decorated (GtkWindow *window, gboolean setting) void gtk_window_set_decorated (window, setting) GtkWindow * window gboolean setting ## gboolean gtk_window_get_decorated (GtkWindow *window) gboolean gtk_window_get_decorated (window) GtkWindow * window ## void gtk_window_set_icon_list (GtkWindow *window, GList *list) =for apidoc =for arg ... of Gtk2::Gdk::Pixbuf's Sets up the icon representing a Gtk2::Window. The icon is used when the window is minimized (also known as iconified). Some window managers or desktop environments may also place it in the window frame, or display it in other contexts. LB (...)"> allows you to pass in the same icon in several hand-drawn sizes. The list should contain the natural sizes your icon is available in; that is, don't scale the image before passing it to GTK+. Scaling is postponed until the last minute, when the desired final size is known, to allow best quality. By passing several sizes, you may improve the final image quality of the icon, by reducing or eliminating automatic image scaling. Recommended sizes to provide: 16x16, 32x32, 48x48 at minimum, and larger images (64x64, 128x128) if you have them. =cut void gtk_window_set_icon_list (window, ...) GtkWindow * window PREINIT: GList * list = NULL; CODE: for( items--; items > 0; items-- ) list = g_list_prepend(list, SvGdkPixbuf(ST(items))); if( list ) { gtk_window_set_icon_list(window, list); g_list_free(list); } # GList* gtk_window_get_icon_list (GtkWindow *window) =for apidoc Retrieves the list of icons set by LB (...)">. =cut void gtk_window_get_icon_list (window) GtkWindow * window PREINIT: GList * list, * i; PPCODE: list = gtk_window_get_icon_list (window); if (!list) XSRETURN_EMPTY; for (i = list ; i != NULL ; i = i->next) XPUSHs (sv_2mortal (newSVGdkPixbuf (i->data))); g_list_free (list); ## void gtk_window_set_icon (GtkWindow *window, GdkPixbuf *icon) void gtk_window_set_icon (window, icon) GtkWindow * window GdkPixbuf_ornull * icon #if GTK_CHECK_VERSION(2,2,0) #gboolean gtk_window_set_icon_from_file (GtkWindow *window, const gchar *filename, GError **err) =for apidoc __gerror__ =cut void gtk_window_set_icon_from_file (window, filename) GtkWindow * window GPerlFilename filename PREINIT: GError *error = NULL; CODE: gtk_window_set_icon_from_file(window, filename, &error); if (error) gperl_croak_gerror (filename, error); #gboolean gtk_window_set_default_icon_from_file (GtkWindow *window, const gchar *filename, GError **err) =for apidoc __gerror__ =for signature Gtk2::Window->set_default_icon_from_file ($filename) =for signature $window->set_default_icon_from_file ($filename) =cut void gtk_window_set_default_icon_from_file (class_or_instance, filename) GPerlFilename filename PREINIT: GError *error = NULL; CODE: gtk_window_set_default_icon_from_file(filename, &error); if (error) gperl_croak_gerror (filename, error); #endif #if GTK_CHECK_VERSION(2,4,0) void gtk_window_set_default_icon (class, GdkPixbuf * icon) C_ARGS: icon #endif ## GdkPixbuf* gtk_window_get_icon (GtkWindow *window) GdkPixbuf_ornull * gtk_window_get_icon (window) GtkWindow * window ## void gtk_window_set_default_icon_list (GList *list) =for apidoc =for signature $window->set_default_icon_list ($pixbuf1, ...) =for arg pixbuf (__hide__) =for arg pixbuf1 (GdkPixbuf) =cut void gtk_window_set_default_icon_list (class, pixbuf, ...) PREINIT: int i; GList * list = NULL; CODE: for (i = 1; i < items ; i++) list = g_list_append (list, SvGdkPixbuf (ST (i))); gtk_window_set_default_icon_list (list); g_list_free (list); ## GList* gtk_window_get_default_icon_list (void) =for apidoc Gets the value set by L<$window-Eset_default_icon_list>. =cut void gtk_window_get_default_icon_list (class) PREINIT: GList * list, * tmp; PPCODE: list = gtk_window_get_default_icon_list (); for (tmp = list ; tmp != NULL ; tmp = tmp->next) XPUSHs (sv_2mortal (newSVGdkPixbuf (tmp->data))); g_list_free (list); PERL_UNUSED_VAR (ax); ## gboolean gtk_window_get_modal (GtkWindow *window) gboolean gtk_window_get_modal (window) GtkWindow * window ## GList* gtk_window_list_toplevels (void) =for apidoc Returns a list of all existing toplevel windows. =cut void gtk_window_list_toplevels (class) PREINIT: GList * toplvls, * i; PPCODE: toplvls = gtk_window_list_toplevels (); for (i = toplvls; i != NULL; i = i->next) XPUSHs (sv_2mortal (newSVGtkWindow (i->data))); /* documentation doesn't mention it, but according to the source, * it's on us to free this! */ g_list_free (toplvls); PERL_UNUSED_VAR (ax); ## void gtk_window_add_mnemonic (GtkWindow *window, guint keyval, GtkWidget *target) void gtk_window_add_mnemonic (window, keyval, target) GtkWindow * window guint keyval GtkWidget * target ## void gtk_window_remove_mnemonic (GtkWindow *window, guint keyval, GtkWidget *target) void gtk_window_remove_mnemonic (window, keyval, target) GtkWindow * window guint keyval GtkWidget * target ## gboolean gtk_window_mnemonic_activate (GtkWindow *window, guint keyval, GdkModifierType modifier) gboolean gtk_window_mnemonic_activate (window, keyval, modifier) GtkWindow * window guint keyval GdkModifierType modifier ## void gtk_window_set_has_frame (GtkWindow *window, gboolean setting) void gtk_window_set_has_frame (window, setting) GtkWindow * window gboolean setting ## void gtk_window_set_mnemonic_modifier (GtkWindow *window, GdkModifierType modifier) void gtk_window_set_mnemonic_modifier (window, modifier) GtkWindow * window GdkModifierType modifier ## GdkModifierType gtk_window_get_mnemonic_modifier (GtkWindow *window) GdkModifierType gtk_window_get_mnemonic_modifier (window) GtkWindow * window ## void gtk_window_present (GtkWindow *window) void gtk_window_present (window) GtkWindow * window ## void gtk_window_iconify (GtkWindow *window) void gtk_window_iconify (window) GtkWindow * window ## void gtk_window_deiconify (GtkWindow *window) void gtk_window_deiconify (window) GtkWindow * window ## void gtk_window_stick (GtkWindow *window) void gtk_window_stick (window) GtkWindow * window ## void gtk_window_unstick (GtkWindow *window) void gtk_window_unstick (window) GtkWindow * window ## void gtk_window_maximize (GtkWindow *window) void gtk_window_maximize (window) GtkWindow * window ## void gtk_window_unmaximize (GtkWindow *window) void gtk_window_unmaximize (window) GtkWindow * window ## void gtk_window_begin_resize_drag (GtkWindow *window, GdkWindowEdge edge, gint button, gint root_x, gint root_y, guint32 timestamp) void gtk_window_begin_resize_drag (window, edge, button, root_x, root_y, timestamp) GtkWindow * window GdkWindowEdge edge gint button gint root_x gint root_y guint32 timestamp ## void gtk_window_begin_move_drag (GtkWindow *window, gint button, gint root_x, gint root_y, guint32 timestamp) void gtk_window_begin_move_drag (window, button, root_x, root_y, timestamp) GtkWindow * window gint button gint root_x gint root_y guint32 timestamp ## void gtk_window_get_default_size (GtkWindow *window, gint *width, gint *height) void gtk_window_get_default_size (GtkWindow * window, OUTLIST gint width, OUTLIST gint height) ## void gtk_window_resize (GtkWindow *window, gint width, gint height) void gtk_window_resize (window, width, height) GtkWindow * window gint width gint height ## void gtk_window_get_size (GtkWindow *window, gint *width, gint *height) void gtk_window_get_size (GtkWindow * window, OUTLIST gint width, OUTLIST gint height) ## void gtk_window_move (GtkWindow *window, gint x, gint y) void gtk_window_move (window, x, y) GtkWindow * window gint x gint y ## void gtk_window_get_position (GtkWindow *window, gint *root_x, gint *root_y) void gtk_window_get_position (GtkWindow * window, OUTLIST gint root_x, OUTLIST gint root_y) ## gboolean gtk_window_parse_geometry (GtkWindow *window, const gchar *geometry) gboolean gtk_window_parse_geometry (window, geometry) GtkWindow * window const gchar * geometry ## void gtk_window_remove_embedded_xid (GtkWindow *window, guint xid) void gtk_window_remove_embedded_xid (window, xid) GtkWindow * window guint xid ## void gtk_window_add_embedded_xid (GtkWindow *window, guint xid) void gtk_window_add_embedded_xid (window, xid) GtkWindow * window guint xid ##void gtk_window_reshow_with_initial_size (GtkWindow *window) void gtk_window_reshow_with_initial_size (window) GtkWindow * window #if GTK_CHECK_VERSION(2,2,0) ##void gtk_window_set_screen (GtkWindow *window, GdkScreen *screen) void gtk_window_set_screen (window, screen) GtkWindow * window GdkScreen * screen ##GdkScreen * gtk_window_get_screen (GtkWindow *window) GdkScreen * gtk_window_get_screen (window) GtkWindow * window void gtk_window_fullscreen (window) GtkWindow * window void gtk_window_unfullscreen (window) GtkWindow * window #if GTK_CHECK_VERSION(2,4,0) void gtk_window_set_keep_above (GtkWindow *window, gboolean setting); void gtk_window_set_keep_below (GtkWindow *window, gboolean setting); gboolean gtk_window_is_active (GtkWindow *window); gboolean gtk_window_has_toplevel_focus (GtkWindow *window); #endif void gtk_window_set_skip_taskbar_hint (window, setting) GtkWindow * window gboolean setting void gtk_window_set_skip_pager_hint (window, setting) GtkWindow * window gboolean setting gboolean gtk_window_get_skip_taskbar_hint (window) GtkWindow * window gboolean gtk_window_get_skip_pager_hint (window) GtkWindow * window void gtk_window_set_auto_startup_notification (class, setting) gboolean setting C_ARGS: setting #endif #if GTK_CHECK_VERSION(2,4,0) =for apidoc =for arg event (Gtk2::Gdk::Event::Key) =cut gboolean gtk_window_activate_key (window, event) GtkWindow *window GdkEvent *event C_ARGS: window, (GdkEventKey *) event =for apidoc =for arg event (Gtk2::Gdk::Event::Key) =cut gboolean gtk_window_propagate_key_event (window, event) GtkWindow *window GdkEvent *event C_ARGS: window, (GdkEventKey *) event #endif #if GTK_CHECK_VERSION (2, 6, 0) void gtk_window_set_focus_on_map (GtkWindow *window, gboolean setting); gboolean gtk_window_get_focus_on_map (GtkWindow *window); void gtk_window_set_icon_name (GtkWindow *window, const gchar *name); const gchar_ornull * gtk_window_get_icon_name (GtkWindow *window); ## void gtk_window_set_default_icon_name (const gchar *name); void gtk_window_set_default_icon_name (class, name) const gchar_ornull *name C_ARGS: name #endif #if GTK_CHECK_VERSION (2, 8, 0) void gtk_window_set_urgency_hint (GtkWindow *window, gboolean setting); gboolean gtk_window_get_urgency_hint (GtkWindow *window); void gtk_window_present_with_time (GtkWindow *window, guint32 timestamp); #endif #if GTK_CHECK_VERSION (2, 10, 0) void gtk_window_set_deletable (GtkWindow *window, gboolean setting); gboolean gtk_window_get_deletable (GtkWindow *window); GtkWindowGroup_ornull * gtk_window_get_group (GtkWindow *window); #endif #if GTK_CHECK_VERSION (2, 12, 0) void gtk_window_set_startup_id (GtkWindow *window, const gchar *startup_id); void gtk_window_set_opacity (GtkWindow *window, gdouble opacity); gdouble gtk_window_get_opacity (GtkWindow *window); #endif #if GTK_CHECK_VERSION (2, 14, 0) GtkWidget_ornull * gtk_window_get_default_widget (GtkWindow *window); #endif /* 2.14 */ #if GTK_CHECK_VERSION (2, 16, 0) =for apidoc Gets the value set by C<< Gtk2::Window->set_default_icon_name >>. =cut ## gchar * gtk_window_get_icon_name (void) const gchar_ornull * gtk_window_get_default_icon_name (class); C_ARGS: /* void */ #endif /* 2.16 */ #if GTK_CHECK_VERSION (2, 20, 0) GtkWindowType gtk_window_get_window_type (GtkWindow *window); void gtk_window_set_mnemonics_visible (GtkWindow *window, gboolean setting); gboolean gtk_window_get_mnemonics_visible (GtkWindow *window); #endif /* 2.20 */ #if GTK_CHECK_VERSION (2, 22, 0) gboolean gtk_window_has_group (GtkWindow *window); #endif /* 2.22 */ MODULE = Gtk2::Window PACKAGE = Gtk2::WindowGroup PREFIX = gtk_window_group_ ## GtkWindowGroup * gtk_window_group_new (void) GtkWindowGroup * gtk_window_group_new (class) C_ARGS: /*void*/ ## void gtk_window_group_add_window (GtkWindowGroup *window_group, GtkWindow *window) void gtk_window_group_add_window (window_group, window) GtkWindowGroup * window_group GtkWindow * window ## void gtk_window_group_remove_window (GtkWindowGroup *window_group, GtkWindow *window) void gtk_window_group_remove_window (window_group, window) GtkWindowGroup * window_group GtkWindow * window #if GTK_CHECK_VERSION (2, 14, 0) # GList * gtk_window_group_list_windows (GtkWindowGroup *window_group) void gtk_window_group_list_windows (GtkWindowGroup *window_group) PREINIT: GList *i, *list; PPCODE: list = gtk_window_group_list_windows (window_group); for (i = list; i != NULL; i = i->next) { XPUSHs (sv_2mortal (newSVGtkWindow (i->data))); } g_list_free (list); #endif /* 2.14 */ #if GTK_CHECK_VERSION (2, 22, 0) GtkWidget * gtk_window_group_get_current_grab (GtkWindowGroup *window_group); #endif /* 2.22 */ ## er... dunno about these. ## ##void ##gtk_decorated_window_init (window) ## GtkWindow * window ## ##void ##gtk_decorated_window_calculate_frame_size (window) ## GtkWindow * window ## ##void ##gtk_decorated_window_set_title (window, title) ## GtkWindow * window ## const gchar * title ## ##void ##gtk_decorated_window_move_resize_window (window, x, y, width, height) ## GtkWindow * window ## gint x ## gint y ## gint width ## gint height ## Gtk2-1.24992/xs/GtkHButtonBox.xs0000644000175000017500000000315113076462677014653 0ustar lacklack/* * Copyright (c) 2003 by the gtk2-perl team (see the file AUTHORS) * * This library is free software; you can redistribute it and/or * modify it under the terms of the GNU Library General Public * License as published by the Free Software Foundation; either * version 2.1 of the License, or (at your option) any later version. * * This library is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU * Library General Public License for more details. * * You should have received a copy of the GNU Library General Public * License along with this library; if not, write to the * Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, * Boston, MA 02110-1301 USA. * * $Id$ */ #include "gtk2perl.h" MODULE = Gtk2::HButtonBox PACKAGE = Gtk2::HButtonBox PREFIX = gtk_hbutton_box_ ## GtkWidget* gtk_hbutton_box_new (void) GtkWidget * gtk_hbutton_box_new (class) C_ARGS: /*void*/ ## GtkButtonBoxStyle gtk_hbutton_box_get_layout_default (void) GtkButtonBoxStyle gtk_hbutton_box_get_layout_default (class) C_ARGS: /*void*/ ## void gtk_hbutton_box_set_spacing_default (gint spacing) void gtk_hbutton_box_set_spacing_default (class, spacing) gint spacing C_ARGS: spacing ## void gtk_hbutton_box_set_layout_default (GtkButtonBoxStyle layout) void gtk_hbutton_box_set_layout_default (class, layout) GtkButtonBoxStyle layout C_ARGS: layout ##gint gtk_hbutton_box_get_spacing_default (void) gint gtk_hbutton_box_get_spacing_default (class) C_ARGS: /*void*/ Gtk2-1.24992/xs/GtkVBox.xs0000644000175000017500000000203413076462677013474 0ustar lacklack/* * Copyright (c) 2003 by the gtk2-perl team (see the file AUTHORS) * * This library is free software; you can redistribute it and/or * modify it under the terms of the GNU Library General Public * License as published by the Free Software Foundation; either * version 2.1 of the License, or (at your option) any later version. * * This library is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU * Library General Public License for more details. * * You should have received a copy of the GNU Library General Public * License along with this library; if not, write to the * Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, * Boston, MA 02110-1301 USA. * * $Id$ */ #include "gtk2perl.h" MODULE = Gtk2::VBox PACKAGE = Gtk2::VBox PREFIX = gtk_vbox_ GtkWidget* gtk_vbox_new (class, homogeneous=0, spacing=5) gboolean homogeneous gint spacing C_ARGS: homogeneous, spacing Gtk2-1.24992/xs/GdkPixbufSimpleAnim.xs0000644000175000017500000000261413076462677016016 0ustar lacklack/* * Copyright (c) 2005 by the gtk2-perl team (see the file AUTHORS) * * This library is free software; you can redistribute it and/or * modify it under the terms of the GNU Library General Public * License as published by the Free Software Foundation; either * version 2.1 of the License, or (at your option) any later version. * * This library is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU * Library General Public License for more details. * * You should have received a copy of the GNU Library General Public * License along with this library; if not, write to the * Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, * Boston, MA 02110-1301 USA. * * $Id$ */ #include "gtk2perl.h" MODULE = Gtk2::Gdk::PixbufSimpleAnim PACKAGE = Gtk2::Gdk::PixbufSimpleAnim PREFIX = gdk_pixbuf_simple_anim_ GdkPixbufSimpleAnim_noinc * gdk_pixbuf_simple_anim_new (class, gint width, gint height, gfloat rate) C_ARGS: width, height, rate void gdk_pixbuf_simple_anim_add_frame (GdkPixbufSimpleAnim *animation, GdkPixbuf *pixbuf) #if GTK_CHECK_VERSION (2, 18, 0) void gdk_pixbuf_simple_anim_set_loop (GdkPixbufSimpleAnim *animation, gboolean loop); gboolean gdk_pixbuf_simple_anim_get_loop (GdkPixbufSimpleAnim *animation); #endif /* 2.18 */ Gtk2-1.24992/xs/GtkGammaCurve.xs0000644000175000017500000000221113076462677014642 0ustar lacklack/* * Copyright (c) 2003 by the gtk2-perl team (see the file AUTHORS) * * This library is free software; you can redistribute it and/or * modify it under the terms of the GNU Library General Public * License as published by the Free Software Foundation; either * version 2.1 of the License, or (at your option) any later version. * * This library is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU * Library General Public License for more details. * * You should have received a copy of the GNU Library General Public * License along with this library; if not, write to the * Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, * Boston, MA 02110-1301 USA. * * $Id$ */ #include "gtk2perl.h" MODULE = Gtk2::GammaCurve PACKAGE = Gtk2::GammaCurve PREFIX = gtk_gamma_curve_ ## GtkWidget* gtk_gamma_curve_new (void) GtkWidget * gtk_gamma_curve_new (class) C_ARGS: /* void */ GtkCurve * curve (gamma) GtkGammaCurve * gamma CODE: RETVAL = (GtkCurve*)gamma->curve; OUTPUT: RETVAL Gtk2-1.24992/xs/GtkShow.xs0000644000175000017500000000116113076462677013536 0ustar lacklack/* * Copyright (c) 2008 by the gtk2-perl team (see the file AUTHORS) * * Licensed under the LGPL, see LICENSE file for more information. * * $Id$ */ #include "gtk2perl.h" MODULE = Gtk2::Show PACKAGE = Gtk2 PREFIX = gtk_ =for object Gtk2::main =cut =for apidoc __function__ =cut # gboolean gtk_show_uri (GdkScreen *screen, const gchar *uri, guint32 timestamp, GError **error); void gtk_show_uri (GdkScreen_ornull *screen, const gchar *uri, guint32 timestamp=GDK_CURRENT_TIME) PREINIT: GError *error = NULL; CODE: if (!gtk_show_uri (screen, uri, timestamp, &error)) { gperl_croak_gerror (NULL, error); } Gtk2-1.24992/xs/GtkToolButton.xs0000644000175000017500000000302713076462677014732 0ustar lacklack/* * Copyright (c) 2003-2005 by the gtk2-perl team (see the file AUTHORS) * * Licensed under the LGPL, see LICENSE file for more information. * * $Id$ */ #include "gtk2perl.h" MODULE = Gtk2::ToolButton PACKAGE = Gtk2::ToolButton PREFIX = gtk_tool_button_ GtkToolItem *gtk_tool_button_new (class, GtkWidget_ornull *icon_widget, const gchar_ornull *label); C_ARGS: icon_widget, label GtkToolItem *gtk_tool_button_new_from_stock (class, const gchar *stock_id); C_ARGS: stock_id void gtk_tool_button_set_label (GtkToolButton *button, const gchar_ornull *label); ##G_CONST_RETURN const gchar_ornull *gtk_tool_button_get_label (GtkToolButton *button); void gtk_tool_button_set_use_underline (GtkToolButton *button, gboolean use_underline); gboolean gtk_tool_button_get_use_underline (GtkToolButton *button); void gtk_tool_button_set_stock_id (GtkToolButton *button, const gchar_ornull *stock_id); ##G_CONST_RETURN const gchar *gtk_tool_button_get_stock_id (GtkToolButton *button); void gtk_tool_button_set_icon_widget (GtkToolButton *button, GtkWidget_ornull *icon_widget); GtkWidget_ornull * gtk_tool_button_get_icon_widget (GtkToolButton *button); void gtk_tool_button_set_label_widget (GtkToolButton *button, GtkWidget_ornull *label_widget); GtkWidget_ornull * gtk_tool_button_get_label_widget (GtkToolButton *button); #if GTK_CHECK_VERSION (2, 8, 0) void gtk_tool_button_set_icon_name (GtkToolButton *button, const gchar_ornull *icon_name); const gchar_ornull* gtk_tool_button_get_icon_name (GtkToolButton *button); #endif Gtk2-1.24992/xs/GtkRadioButton.xs0000644000175000017500000001430213076462677015051 0ustar lacklack/* * Copyright (c) 2003, 2010 by the gtk2-perl team (see the file AUTHORS) * * This library is free software; you can redistribute it and/or * modify it under the terms of the GNU Library General Public * License as published by the Free Software Foundation; either * version 2.1 of the License, or (at your option) any later version. * * This library is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU * Library General Public License for more details. * * You should have received a copy of the GNU Library General Public * License along with this library; if not, write to the * Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, * Boston, MA 02110-1301 USA. * * $Id$ */ #include "gtk2perl.h" MODULE = Gtk2::RadioButton PACKAGE = Gtk2::RadioButton PREFIX = gtk_radio_button_ =for position SYNOPSIS =head1 SYNOPSIS # first group $foo1 = Gtk2::RadioButton->new (undef, 'Foo One'); $foo2 = Gtk2::RadioButton->new ($foo1, 'Foo Two'); $foo3 = Gtk2::RadioButton->new ($foo2, 'Foo Three'); # second group, using the group reference $bar1 = Gtk2::RadioButton->new (undef, 'Bar One'); $group = $bar1->get_group; $bar2 = Gtk2::RadioButton->new ($group, 'Bar Two'); $bar3 = Gtk2::RadioButton->new ($group, 'Bar Three'); # move bar3 from the bar group to the foo group. $bar->set_group ($foo->get_group); # iterate over the widgets in the group $group = $foo1->get_group; foreach my $r (@$group) { $r->set_sensitive ($whatever); } =cut =for position DESCRIPTION =head1 DESCRIPTION A single radio button performs the same basic function as a Gtk2::CheckButton, as its position in the object hierarchy reflects. It is only when multiple radio buttons are grouped together that they become a different user interface component in their own right. Every radio button is a member of some group of radio buttons. When one is selected, all other radio buttons in the same group are deselected. A Gtk2::RadioButton is one way of giving the user a choice from many options; Gtk2::OptionMenu and Gtk2::ComboBox (added in gtk+ 2.4) are alternatives. Each constructor can take either a group or widget from that group where the group is wanted; this is an enhancement over the C API. Nevertheless, the _from_widget forms are provided for completeness. =cut =for apidoc Gtk2::RadioButton::new_with_mnemonic =for arg member_or_listref reference to radiobutton group or a Gtk2::RadioButton belonging to that group. Create a radio button with a mnemonic; this is an alias for C. =cut =for apidoc Gtk2::RadioButton::new_with_label =for arg member_or_listref reference to radiobutton group or a Gtk2::RadioButton belonging to that group. Create a radio button with a plain text label, which will not be interpreted as a mnemonic. =cut =for apidoc =for arg member_or_listref reference to radiobutton group or a Gtk2::RadioButton belonging to that group. Create a radio button. If I<$label> is provided, it will be interpreted as a mnemonic. If I<$member_or_listref> is undef, the radio button will be created in a new group. =cut GtkWidget * gtk_radio_button_new (class, member_or_listref=NULL, label=NULL) SV * member_or_listref const gchar * label ALIAS: Gtk2::RadioButton::new_with_mnemonic = 1 Gtk2::RadioButton::new_with_label = 2 PREINIT: GSList * group = NULL; GtkRadioButton * member = NULL; CODE: if( gperl_sv_is_defined (member_or_listref) && SvROK (member_or_listref) && SvRV (member_or_listref) != &PL_sv_undef ) { if( gperl_sv_is_array_ref (member_or_listref) ) { AV * av = (AV*)SvRV(member_or_listref); SV ** svp = av_fetch(av, 0, 0); if( svp && gperl_sv_is_defined(*svp) ) member = SvGtkRadioButton(*svp); } else member = SvGtkRadioButton_ornull(member_or_listref); if( member ) group = member->group; } if (label) { if (ix == 2) RETVAL = gtk_radio_button_new_with_label (group, label); else RETVAL = gtk_radio_button_new_with_mnemonic (group, label); } else RETVAL = gtk_radio_button_new (group); OUTPUT: RETVAL GtkWidget * gtk_radio_button_new_from_widget (class, group, label=NULL) GtkRadioButton_ornull * group const gchar * label ALIAS: Gtk2::RadioButton::new_with_mnemonic_from_widget = 1 Gtk2::RadioButton::new_with_label_from_widget = 2 CODE: if (label) { if (ix == 2) RETVAL = gtk_radio_button_new_with_label_from_widget (group, label); else RETVAL = gtk_radio_button_new_with_mnemonic_from_widget (group, label); } else RETVAL = gtk_radio_button_new_from_widget (group); OUTPUT: RETVAL =for apidoc =for arg member_or_listref reference to the group or a Gtk2::RadioButton belonging to that group. Assign I<$radio_button> to a new group. =cut void gtk_radio_button_set_group (radio_button, member_or_listref) GtkRadioButton * radio_button SV * member_or_listref PREINIT: GSList * group = NULL; GtkRadioButton * member = NULL; CODE: if( gperl_sv_is_defined (member_or_listref) ) { if( gperl_sv_is_array_ref (member_or_listref) ) { AV * av = (AV*)SvRV(member_or_listref); SV ** svp = av_fetch(av, 0, 0); if( svp && gperl_sv_is_defined(*svp) ) { member = SvGtkRadioButton(*svp); } } else member = SvGtkRadioButton_ornull(member_or_listref); if( member ) group = member->group; } gtk_radio_button_set_group(radio_button, group); # GSList * gtk_radio_button_get_group (GtkRadioButton *radio_button) =for apidoc Return a reference to the radio group to which I<$radio_button> belongs. The group is a reference to an array of widget references; the array is B magical, that is, it will not be updated automatically if the group changes; call C each time you want to use the group. =cut AV * gtk_radio_button_get_group (radio_button) GtkRadioButton * radio_button PREINIT: GSList * group; GSList * i; CODE: group = gtk_radio_button_get_group (radio_button); RETVAL = newAV(); sv_2mortal ((SV*) RETVAL); /* typemap expects RETVAL mortalized */ for( i = group; i ; i = i->next ) { av_push(RETVAL, newSVGtkRadioButton(GTK_RADIO_BUTTON(i->data))); } OUTPUT: RETVAL Gtk2-1.24992/xs/GtkFileChooserWidget.xs0000644000175000017500000000142413076462677016166 0ustar lacklack/* * Copyright (c) 2003 by the gtk2-perl team (see the file AUTHORS) * * Licensed under the LGPL, see LICENSE file for more information. * * $Id$ */ #include "gtk2perl.h" MODULE = Gtk2::FileChooserWidget PACKAGE = Gtk2::FileChooserWidget PREFIX = gtk_file_chooser_widget_ BOOT: /* GtkFileChooserWidget implements the GtkFileChooserIface */ gperl_prepend_isa ("Gtk2::FileChooserWidget", "Gtk2::FileChooser"); /* apparently private, but still in list_interfaces gperl_set_isa ("Gtk2::FileChooserWidget", "Gtk2::FileChooserEmbed"); */ GtkWidget *gtk_file_chooser_widget_new (class, GtkFileChooserAction action); C_ARGS: action GtkWidget *gtk_file_chooser_widget_new_with_backend (class, GtkFileChooserAction action, const gchar *backend); C_ARGS: action, backend Gtk2-1.24992/xs/GdkGC.xs0000644000175000017500000003027513076462677013077 0ustar lacklack/* * Copyright (c) 2003 by the gtk2-perl team (see the file AUTHORS) * * This library is free software; you can redistribute it and/or * modify it under the terms of the GNU Library General Public * License as published by the Free Software Foundation; either * version 2.1 of the License, or (at your option) any later version. * * This library is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU * Library General Public License for more details. * * You should have received a copy of the GNU Library General Public * License along with this library; if not, write to the * Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, * Boston, MA 02110-1301 USA. * * $Id$ */ #include "gtk2perl.h" /* * GdkGCValues code ported from Gtk-Perl 0.7009. There's no boxed type * support for this structure, but since it's only used in a couple of * functions in this file, we can scrape by without typemaps. */ SV * newSVGdkGCValues (GdkGCValues * v) { HV * h; SV * r; if (!v) return newSVsv (&PL_sv_undef); h = newHV (); r = newRV_noinc ((SV*)h); gperl_hv_take_sv_s (h, "foreground", newSVGdkColor_copy (&v->foreground)); gperl_hv_take_sv_s (h, "background", newSVGdkColor_copy (&v->background)); if (v->font) gperl_hv_take_sv_s (h, "font", newSVGdkFont (v->font)); gperl_hv_take_sv_s (h, "function", newSVGdkFunction (v->function)); gperl_hv_take_sv_s (h, "fill", newSVGdkFill (v->fill)); if (v->tile) gperl_hv_take_sv_s (h, "tile", newSVGdkPixmap (v->tile)); if (v->stipple) gperl_hv_take_sv_s (h, "stipple", newSVGdkPixmap (v->stipple)); if (v->clip_mask) gperl_hv_take_sv_s (h, "clip_mask", newSVGdkPixmap (v->clip_mask)); gperl_hv_take_sv_s (h, "subwindow_mode", newSVGdkSubwindowMode (v->subwindow_mode)); gperl_hv_take_sv_s (h, "ts_x_origin", newSViv (v->ts_x_origin)); gperl_hv_take_sv_s (h, "ts_y_origin", newSViv (v->ts_y_origin)); gperl_hv_take_sv_s (h, "clip_x_origin", newSViv (v->clip_x_origin)); gperl_hv_take_sv_s (h, "clip_y_origin", newSViv (v->clip_y_origin)); gperl_hv_take_sv_s (h, "graphics_exposures", newSViv (v->graphics_exposures)); gperl_hv_take_sv_s (h, "line_width", newSViv (v->line_width)); gperl_hv_take_sv_s (h, "line_style", newSVGdkLineStyle (v->line_style)); gperl_hv_take_sv_s (h, "cap_style", newSVGdkCapStyle (v->cap_style)); gperl_hv_take_sv_s (h, "join_style", newSVGdkJoinStyle (v->join_style)); return r; } void SvGdkGCValues (SV * data, GdkGCValues * v, GdkGCValuesMask * m) { HV * h; SV ** s; GdkGCValuesMask mask = 0; if (!gperl_sv_is_hash_ref (data)) return; h = (HV*) SvRV (data); if (!v) v = gperl_alloc_temp (sizeof(GdkGCValues)); if ((s=hv_fetch (h, "foreground", 10, 0)) && gperl_sv_is_defined (*s)) { v->foreground = *((GdkColor*) SvGdkColor (*s)); mask |= GDK_GC_FOREGROUND; } if ((s=hv_fetch (h, "background", 10, 0)) && gperl_sv_is_defined (*s)) { v->background = *((GdkColor*) SvGdkColor (*s)); mask |= GDK_GC_BACKGROUND; } if ((s=hv_fetch (h, "font", 4, 0)) && gperl_sv_is_defined (*s)) { v->font = SvGdkFont (*s); mask |= GDK_GC_FONT; } if ((s=hv_fetch (h, "function", 8, 0)) && gperl_sv_is_defined (*s)) { v->function = SvGdkFunction (*s); mask |= GDK_GC_FUNCTION; } if ((s=hv_fetch (h, "fill", 4, 0)) && gperl_sv_is_defined (*s)) { v->fill = SvGdkFill (*s); mask |= GDK_GC_FILL; } if ((s=hv_fetch (h, "tile", 4, 0)) && gperl_sv_is_defined (*s)) { v->tile = SvGdkPixmap (*s); mask |= GDK_GC_TILE; } if ((s=hv_fetch (h, "stipple", 7, 0)) && gperl_sv_is_defined (*s)) { v->stipple = SvGdkPixmap (*s); mask |= GDK_GC_STIPPLE; } if ((s=hv_fetch (h, "clip_mask", 9, 0)) && gperl_sv_is_defined (*s)) { v->clip_mask = SvGdkPixmap (*s); mask |= GDK_GC_CLIP_MASK; } if ((s=hv_fetch (h, "subwindow_mode", 14, 0)) && gperl_sv_is_defined (*s)) { v->subwindow_mode = SvGdkSubwindowMode (*s); mask |= GDK_GC_SUBWINDOW; } if ((s=hv_fetch (h, "ts_x_origin", 11, 0)) && gperl_sv_is_defined (*s)) { v->ts_x_origin = SvIV (*s); mask |= GDK_GC_TS_X_ORIGIN; } if ((s=hv_fetch (h, "ts_y_origin", 11, 0)) && gperl_sv_is_defined (*s)) { v->ts_y_origin = SvIV (*s); mask |= GDK_GC_TS_Y_ORIGIN; } if ((s=hv_fetch (h, "clip_x_origin", 13, 0)) && gperl_sv_is_defined (*s)) { v->clip_x_origin = SvIV (*s); mask |= GDK_GC_CLIP_X_ORIGIN; } if ((s=hv_fetch (h, "clip_y_origin", 13, 0)) && gperl_sv_is_defined (*s)) { v->clip_y_origin = SvIV (*s); mask |= GDK_GC_CLIP_Y_ORIGIN; } if ((s=hv_fetch (h, "graphics_exposures", 18, 0)) && gperl_sv_is_defined (*s)) { v->graphics_exposures = SvIV (*s); mask |= GDK_GC_EXPOSURES; } if ((s=hv_fetch (h, "line_width", 10, 0)) && gperl_sv_is_defined (*s)) { v->line_width= SvIV (*s); mask |= GDK_GC_LINE_WIDTH; } if ((s=hv_fetch (h, "line_style", 10, 0)) && gperl_sv_is_defined (*s)) { v->line_style= SvGdkLineStyle (*s); mask |= GDK_GC_LINE_STYLE; } if ((s=hv_fetch (h, "cap_style", 9, 0)) && gperl_sv_is_defined (*s)) { v->cap_style = SvGdkCapStyle (*s); mask |= GDK_GC_CAP_STYLE; } if ((s=hv_fetch (h, "join_style", 10, 0)) && gperl_sv_is_defined (*s)) { v->join_style = SvGdkJoinStyle (*s); mask |= GDK_GC_JOIN_STYLE; } if (m) *m = mask; } MODULE = Gtk2::Gdk::GC PACKAGE = Gtk2::Gdk::GC PREFIX = gdk_gc_ BOOT: /* the gdk backends override the public GdkGC with private, * back-end-specific types. tell gperl_get_object not to * complain about them. */ gperl_object_set_no_warn_unreg_subclass (GDK_TYPE_GC, TRUE); ## taken care of by typemaps ## void gdk_gc_unref (GdkGC *gc) ##GdkGC * gdk_gc_new (GdkDrawable * drawable); ##GdkGC * gdk_gc_new_with_values (GdkDrawable * drawable, GdkGCValues * values); =for apidoc Create and return a new GC. C<$drawable> is used for the depth and the display (C) for the GC. The GC can then be used with any drawable of the same depth on that display. C<$values> is a hashref containing some of the following keys, foreground Gtk2::Gdk::Color background Gtk2::Gdk::Color font Gtk2::Gdk::Font function Gtk2::Gdk::Function enum fill Gtk2::Gdk::Fill enum tile Gtk2::Gdk::Pixmap stipple Gtk2::Gdk::Pixmap clip_mask Gtk2::Gdk::Pixmap subwindow_mode Gtk2::Gdk::SubwindowMode enum ts_x_origin integer ts_y_origin integer clip_x_origin integer clip_y_origin integer graphics_exposures boolean integer 1 or 0 line_width integer line_style Gtk2::Gdk::LineStyle enum cap_style Gtk2::Gdk::CapStyle enum join_style Gtk2::Gdk::JoinStyle enum Keys not given get default values. For the C and C colour objects only the C field is used; the red, green and blue are ignored. For example my $pixel = 0x123456; my $color = Gtk2::Gdk::Color->new (0,0,0, $pixel); my $gc = Gtk2::Gdk::GC->new_with_values ($win, { foreground => $color, line_style => 'on_off_dash' }); =cut GdkGC_noinc* gdk_gc_new (class, GdkDrawable * drawable, SV * values=NULL) ALIAS: new_with_values = 1 CODE: if (gperl_sv_is_defined (values)) { GdkGCValuesMask m; GdkGCValues v; SvGdkGCValues (values, &v, &m); RETVAL = gdk_gc_new_with_values (drawable, &v, m); } else { if (ix == 1) warn ("passed empty values to new_with_values"); RETVAL = gdk_gc_new (drawable); } OUTPUT: RETVAL # ## void gdk_gc_get_values (GdkGC *gc, GdkGCValues *values) =for apidoc Return the attributes of C<$gc> in the form of a hashref with keys and values as described with C above. In the C and C colour objects returned only the C fields are set; the red, green and blue fields are garbage. =cut SV * gdk_gc_get_values (gc) GdkGC *gc PREINIT: GdkGCValues values; CODE: gdk_gc_get_values (gc, &values); RETVAL = newSVGdkGCValues (&values); OUTPUT: RETVAL ## void gdk_gc_set_values (GdkGC *gc, GdkGCValues *values, GdkGCValuesMask values_mask) =for apidoc Set some of the attributes of C<$gc>. C<$values> is a hashref of keys and values as described for C and C above. Fields not present in C<$values> are left unchanged. =cut void gdk_gc_set_values (gc, values) GdkGC *gc SV *values PREINIT: GdkGCValues v; GdkGCValuesMask m; CODE: SvGdkGCValues (values, &v, &m); gdk_gc_set_values (gc, &v, m); ## void gdk_gc_set_foreground (GdkGC *gc, GdkColor *color) void gdk_gc_set_foreground (gc, color) GdkGC *gc GdkColor *color ## void gdk_gc_set_background (GdkGC *gc, GdkColor *color) void gdk_gc_set_background (gc, color) GdkGC *gc GdkColor *color ## void gdk_gc_set_font (GdkGC *gc, GdkFont *font) void gdk_gc_set_font (gc, font) GdkGC *gc GdkFont *font ## void gdk_gc_set_function (GdkGC *gc, GdkFunction function) void gdk_gc_set_function (gc, function) GdkGC *gc GdkFunction function ## void gdk_gc_set_fill (GdkGC *gc, GdkFill fill) void gdk_gc_set_fill (gc, fill) GdkGC *gc GdkFill fill ## void gdk_gc_set_tile (GdkGC *gc, GdkPixmap *tile) void gdk_gc_set_tile (gc, tile) GdkGC *gc GdkPixmap *tile ## void gdk_gc_set_stipple (GdkGC *gc, GdkPixmap *stipple) void gdk_gc_set_stipple (gc, stipple) GdkGC *gc GdkPixmap *stipple ## void gdk_gc_set_ts_origin (GdkGC *gc, gint x, gint y) void gdk_gc_set_ts_origin (gc, x, y) GdkGC *gc gint x gint y ## void gdk_gc_set_clip_origin (GdkGC *gc, gint x, gint y) void gdk_gc_set_clip_origin (gc, x, y) GdkGC *gc gint x gint y ## void gdk_gc_set_clip_mask (GdkGC *gc, GdkBitmap *mask) void gdk_gc_set_clip_mask (gc, mask) GdkGC *gc SV *mask CODE: gdk_gc_set_clip_mask (gc, SvGdkBitmap_ornull (mask)); ## void gdk_gc_set_clip_rectangle (GdkGC *gc, GdkRectangle *rectangle) void gdk_gc_set_clip_rectangle (gc, rectangle) GdkGC *gc GdkRectangle_ornull *rectangle ## void gdk_gc_set_clip_region (GdkGC *gc, GdkRegion *region) void gdk_gc_set_clip_region (gc, region) GdkGC *gc GdkRegion_ornull *region ## void gdk_gc_set_subwindow (GdkGC *gc, GdkSubwindowMode mode) void gdk_gc_set_subwindow (gc, mode) GdkGC *gc GdkSubwindowMode mode ## void gdk_gc_set_exposures (GdkGC *gc, gboolean exposures) void gdk_gc_set_exposures (gc, exposures) GdkGC *gc gboolean exposures ## void gdk_gc_set_line_attributes (GdkGC *gc, gint line_width, GdkLineStyle line_style, GdkCapStyle cap_style, GdkJoinStyle join_style) void gdk_gc_set_line_attributes (gc, line_width, line_style, cap_style, join_style) GdkGC *gc gint line_width GdkLineStyle line_style GdkCapStyle cap_style GdkJoinStyle join_style ## void gdk_gc_set_dashes (GdkGC *gc, gint dash_offset, gint8 dash_list[], gint n) =for apidoc =for arg ... of integers, the length of the dash segments Sets the way dashed-lines are drawn. Lines will be drawn with alternating on and off segments of the lengths specified in list of dashes. The manner in which the on and off segments are drawn is determined by the line_style value of the GC. =cut void gdk_gc_set_dashes (gc, dash_offset, ...) GdkGC * gc gint dash_offset PREINIT: gint8 * dash_list; gint n; CODE: n = --items-1; dash_list = g_new(gint8, n); for( ; items > 1; items-- ) dash_list[items-2] = (gint8) SvIV(ST(items)); gdk_gc_set_dashes(gc, dash_offset, dash_list, n); g_free(dash_list); ## void gdk_gc_offset (GdkGC *gc, gint x_offset, gint y_offset) void gdk_gc_offset (gc, x_offset, y_offset) GdkGC *gc gint x_offset gint y_offset ## void gdk_gc_copy (GdkGC *dst_gc, GdkGC *src_gc) void gdk_gc_copy (dst_gc, src_gc) GdkGC *dst_gc GdkGC *src_gc ## void gdk_gc_set_colormap (GdkGC *gc, GdkColormap *colormap) void gdk_gc_set_colormap (gc, colormap) GdkGC *gc GdkColormap *colormap ## GdkColormap *colormap gdk_gc_get_colormap (GdkGC *gc) GdkColormap * gdk_gc_get_colormap (gc) GdkGC *gc ## void gdk_gc_set_rgb_fg_color (GdkGC *gc, GdkColor *color) void gdk_gc_set_rgb_fg_color (gc, color) GdkGC *gc GdkColor *color ## void gdk_gc_set_rgb_bg_color (GdkGC *gc, GdkColor *color) void gdk_gc_set_rgb_bg_color (gc, color) GdkGC *gc GdkColor *color #if GTK_CHECK_VERSION(2,2,0) ## GdkScreen * gdk_gc_get_screen (GdkGC *gc) GdkScreen * gdk_gc_get_screen (gc) GdkGC *gc #endif /* have GdkScreen */ Gtk2-1.24992/xs/GtkSpinner.xs0000644000175000017500000000062213076462677014235 0ustar lacklack/* * Copyright (c) 2010 by the gtk2-perl team (see the file AUTHORS) * * Licensed under the LGPL, see LICENSE file for more information. * * $Id$ */ #include "gtk2perl.h" MODULE = Gtk2::Spinner PACKAGE = Gtk2::Spinner PREFIX = gtk_spinner_ GtkWidget * gtk_spinner_new (class) C_ARGS: /* void */ void gtk_spinner_start (GtkSpinner *spinner); void gtk_spinner_stop (GtkSpinner *spinner); Gtk2-1.24992/xs/GtkStock.xs0000644000175000017500000001110513076462677013700 0ustar lacklack/* * Copyright (c) 2003-2005 by the gtk2-perl team (see the file AUTHORS) * * This library is free software; you can redistribute it and/or * modify it under the terms of the GNU Library General Public * License as published by the Free Software Foundation; either * version 2.1 of the License, or (at your option) any later version. * * This library is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU * Library General Public License for more details. * * You should have received a copy of the GNU Library General Public * License along with this library; if not, write to the * Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, * Boston, MA 02110-1301 USA. * * $Id$ */ #include "gtk2perl.h" #include "gtk2perl-private.h" /* For the translate callback. */ /* struct GtkStockItem { gchar *stock_id; gchar *label; GdkModifierType modifier; guint keyval; gchar *translation_domain; }; */ static SV * newSVGtkStockItem (GtkStockItem * item) { HV * hv = newHV(); gperl_hv_take_sv_s (hv, "stock_id", newSVGChar (item->stock_id)); gperl_hv_take_sv_s (hv, "label", newSVGChar (item->label)); gperl_hv_take_sv_s (hv, "modifier", newSVGdkModifierType (item->modifier)); gperl_hv_take_sv_s (hv, "keyval", newSVuv (item->keyval)); if (item->translation_domain) gperl_hv_take_sv_s (hv, "translation_domain", newSVGChar (item->translation_domain)); return newRV_noinc ((SV *) hv); } /* * returns a pointer to a temp stock item you can use until control returns * to perl. */ static GtkStockItem * SvGtkStockItem (SV * sv) { HV * hv; SV ** svp; GtkStockItem * item; if (!gperl_sv_is_hash_ref (sv)) croak ("malformed stock item; use a reference to a hash as a stock item"); hv = (HV*) SvRV (sv); item = gperl_alloc_temp (sizeof (GtkStockItem)); svp = hv_fetch (hv, "stock_id", 8, FALSE); if (svp) item->stock_id = SvGChar (*svp); svp = hv_fetch (hv, "label", 5, FALSE); if (svp) item->label = SvGChar (*svp); svp = hv_fetch (hv, "modifier", 8, FALSE); if (svp) item->modifier = SvGdkModifierType (*svp); svp = hv_fetch (hv, "keyval", 6, FALSE); if (svp) item->keyval = SvUV (*svp); svp = hv_fetch (hv, "translation_domain", 18, FALSE); if (svp) item->translation_domain = SvGChar (*svp); return item; } MODULE = Gtk2::Stock PACKAGE = Gtk2::Stock PREFIX = gtk_stock_ =head1 Gtk2::StockItem When a Gtk2::StockItem is returned from a function or required as a parameter a hash reference with the following key/value pairs will be required/returned. { stock_id => (string), label => (string), modifier => (Gtk2::Gdk::ModifierType), keyval => (integer), translation_domain => (string), } =cut =for include build/stock_items.podi =cut ### void gtk_stock_add (const GtkStockItem *items, guint n_items) =for apidoc =for arg ... of Gtk2::StockItem's to be added =cut void gtk_stock_add (class, ...) PREINIT: int i; CODE: for (i = 1 ; i < items ; i++) gtk_stock_add (SvGtkStockItem (ST (i)), 1); ## you don't really ever get static memory from perl, so this is irrelevant. ### void gtk_stock_add_static (const GtkStockItem *items, guint n_items) ## gboolean gtk_stock_lookup (const gchar *stock_id, GtkStockItem *item) =for apidoc Returns a hash reference, a L. =cut SV * gtk_stock_lookup (class, stock_id) const gchar *stock_id PREINIT: GtkStockItem item; CODE: if (! gtk_stock_lookup (stock_id, &item)) XSRETURN_UNDEF; RETVAL = newSVGtkStockItem (&item); OUTPUT: RETVAL ## GSList* gtk_stock_list_ids (void) =for apidoc Returns a list of strings, the stock-ids. =cut void gtk_stock_list_ids (class) PREINIT: GSList * ids, * i; PPCODE: ids = gtk_stock_list_ids (); for (i = ids ; i != NULL ; i = i->next) { XPUSHs (sv_2mortal (newSVpv ((char*)(i->data), 0))); g_free (i->data); } g_slist_free (ids); PERL_UNUSED_VAR (ax); #if GTK_CHECK_VERSION (2, 8, 0) void gtk_stock_set_translate_func (class, domain, func, data=NULL) const gchar *domain SV *func SV *data PREINIT: GPerlCallback *callback; CODE: callback = gtk2perl_translate_func_create (func, data); gtk_stock_set_translate_func (domain, gtk2perl_translate_func, callback, (GtkDestroyNotify) gperl_callback_destroy); #endif ## Boxed type support ### GtkStockItem *gtk_stock_item_copy (const GtkStockItem *item) ### void gtk_stock_item_free (GtkStockItem *item) Gtk2-1.24992/xs/GtkBin.xs0000644000175000017500000000206313076462677013330 0ustar lacklack/* * Copyright (c) 2003 by the gtk2-perl team (see the file AUTHORS) * * This library is free software; you can redistribute it and/or * modify it under the terms of the GNU Library General Public * License as published by the Free Software Foundation; either * version 2.1 of the License, or (at your option) any later version. * * This library is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU * Library General Public License for more details. * * You should have received a copy of the GNU Library General Public * License along with this library; if not, write to the * Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, * Boston, MA 02110-1301 USA. * * $Id$ */ #include "gtk2perl.h" MODULE = Gtk2::Bin PACKAGE = Gtk2::Bin PREFIX = gtk_bin_ GtkWidget * child (bin) GtkBin * bin CODE: RETVAL = gtk_bin_get_child (bin); OUTPUT: RETVAL GtkWidget * gtk_bin_get_child (bin) GtkBin * bin Gtk2-1.24992/xs/GtkIMMulticontext.xs0000644000175000017500000000251713076462677015551 0ustar lacklack/* * Copyright (c) 2006 by the gtk2-perl team (see the file AUTHORS) * * This library is free software; you can redistribute it and/or * modify it under the terms of the GNU Library General Public * License as published by the Free Software Foundation; either * version 2.1 of the License, or (at your option) any later version. * * This library is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU * Library General Public License for more details. * * You should have received a copy of the GNU Library General Public * License along with this library; if not, write to the * Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, * Boston, MA 02110-1301 USA. * * $Id$ */ #include "gtk2perl.h" MODULE = Gtk2::IMMultiContext PACKAGE = Gtk2::IMMulticontext PREFIX = gtk_im_multicontext_ GtkIMContext_noinc * gtk_im_multicontext_new (class) C_ARGS: /*void*/ void gtk_im_multicontext_append_menuitems (GtkIMMulticontext *context, GtkMenuShell *menushell); #if GTK_CHECK_VERSION (2, 16, 0) void gtk_im_multicontext_set_context_id (GtkIMMulticontext *context, const char *context_id); const char* gtk_im_multicontext_get_context_id (GtkIMMulticontext *context); #endif /* 2.16 */ Gtk2-1.24992/xs/GtkVRuler.xs0000644000175000017500000000200113076462677014027 0ustar lacklack/* * Copyright (c) 2003 by the gtk2-perl team (see the file AUTHORS) * * This library is free software; you can redistribute it and/or * modify it under the terms of the GNU Library General Public * License as published by the Free Software Foundation; either * version 2.1 of the License, or (at your option) any later version. * * This library is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU * Library General Public License for more details. * * You should have received a copy of the GNU Library General Public * License along with this library; if not, write to the * Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, * Boston, MA 02110-1301 USA. * * $Id$ */ #include "gtk2perl.h" MODULE = Gtk2::VRuler PACKAGE = Gtk2::VRuler PREFIX = gtk_vruler_ ## GtkWidget* gtk_vruler_new (void) GtkWidget * gtk_vruler_new (class) C_ARGS: /* void */ Gtk2-1.24992/xs/GtkRecentChooserWidget.xs0000644000175000017500000000107713076462677016533 0ustar lacklack/* * Copyright (c) 2006 by the gtk2-perl team (see the file AUTHORS) * * Licensed under the LGPL, see LICENSE file for more information. * * $Id$ */ #include "gtk2perl.h" MODULE = Gtk2::RecentChooserWidget PACKAGE = Gtk2::RecentChooserWidget PREFIX = gtk_recent_chooser_widget_ BOOT: gperl_prepend_isa ("Gtk2::RecentChooserWidget", "Gtk2::RecentChooser"); GtkWidget * gtk_recent_chooser_widget_new (class) C_ARGS: /* void */ GtkWidget * gtk_recent_chooser_widget_new_for_manager (class, manager) GtkRecentManager *manager C_ARGS: manager Gtk2-1.24992/xs/GtkAboutDialog.xs0000644000175000017500000002422413076462677015015 0ustar lacklack /* * Copyright (c) 2004-2005, 2010 by the gtk2-perl team (see the file AUTHORS) * * Licensed under the LGPL, see LICENSE file for more information. * * $Id$ */ #include "gtk2perl.h" #define GETTER(into) \ { \ if (!(into)) \ XSRETURN_EMPTY; \ for (i = 0; (into)[i] != NULL; i++) \ XPUSHs (sv_2mortal (newSVGChar ((into)[i]))); \ } #define SETTER(outof) \ { \ gint num = items - 1; \ (outof) = g_new0 (gchar *, num + 1); \ for (i = 0; i < num; i++) \ (outof)[i] = SvGChar (ST (1 + i)); \ } static GPerlCallback * gtk2perl_about_dialog_activate_link_func_create (SV * func, SV * data) { GType param_types [2]; param_types[0] = GTK_TYPE_ABOUT_DIALOG; param_types[1] = G_TYPE_STRING; return gperl_callback_new (func, data, G_N_ELEMENTS (param_types), param_types, 0); } static void gtk2perl_about_dialog_activate_link_func (GtkAboutDialog *about, const gchar *link, gpointer data) { gperl_callback_invoke ((GPerlCallback*)data, NULL, about, link); } MODULE = Gtk2::AboutDialog PACKAGE = Gtk2 PREFIX = gtk_ =for object Gtk2::AboutDialog =cut =for position post_methods =head1 URL AND EMAIL HOOKS When setting the website and email hooks for the Gtk2::AboutDialog widget, you should remember that the order is important: you should set the hook functions B setting the website and email URL properties, like this: $about_dialog->set_url_hook(\&launch_web_browser); $about_dialog->set_website($app_website); otherwise the AboutDialog will not display the website and the email addresses as clickable. =cut =for apidoc =for arg first_property_name (string) =for arg ... the rest of a list of name=>property value pairs. A convenience function for showing an application's about box. The constructed dialog is "transient for" C<$parent> and associated with that widget so it's reused for future invocations. The dialog is non-modal and hidden by any response. (This is implemented as a rewrite of C since it's not easy to construct a varargs call to that actual function. The intention is to behave the same though.) =cut void gtk_show_about_dialog (class, GtkWindow_ornull * parent, first_property_name, ...); PREINIT: static GtkWidget * global_about_dialog = NULL; GtkWidget * dialog = NULL; CODE: if (parent) dialog = g_object_get_data (G_OBJECT (parent), "gtk-about-dialog"); else dialog = global_about_dialog; if (!dialog) { int i; dialog = gtk_about_dialog_new (); g_object_ref (dialog); gtk_object_sink (GTK_OBJECT (dialog)); g_signal_connect (dialog, "delete_event", G_CALLBACK (gtk_widget_hide_on_delete), NULL); /* See http://svn.gnome.org/viewcvs/gtk%2B?revision=14919&view=revision . * We can't actually do this fully correctly, because the * license and credits subdialogs are private. */ g_signal_connect (dialog, "response", G_CALLBACK (gtk_widget_hide), NULL); for (i = 2; i < items ; i+=2) { GParamSpec * pspec; char * name = SvPV_nolen (ST (i)); SV * sv = ST (i + 1); /* Evil swizzling for #345822 */ if (gtk_major_version > 2 || (gtk_major_version == 2 && gtk_minor_version >= 12)) { /* map name to program-name. */ if (strEQ (name, "name")) { warn ("Deprecation warning: Use the " "\"program-name\" property instead " "of \"name\""); name = "program-name"; } } else { /* older gtk+; allow modern code. */ if (gperl_str_eq (name, "program-name")) name = "name"; } pspec = g_object_class_find_property (G_OBJECT_GET_CLASS (dialog), name); if (! pspec) { const char * classname = gperl_object_package_from_type (G_OBJECT_TYPE (dialog)); croak ("type %s does not support property '%s'", classname, name); } else { GValue value = {0, }; g_value_init (&value, G_PARAM_SPEC_VALUE_TYPE (pspec)); gperl_value_from_sv (&value, sv); g_object_set_property (G_OBJECT (dialog), name, &value); g_value_unset (&value); } } if (parent) { gtk_window_set_transient_for ( GTK_WINDOW (dialog), parent); gtk_window_set_destroy_with_parent ( GTK_WINDOW (dialog), TRUE); g_object_set_data_full (G_OBJECT (parent), "gtk-about-dialog", dialog, g_object_unref); } else { global_about_dialog = dialog; } } gtk_window_present (GTK_WINDOW (dialog)); MODULE = Gtk2::AboutDialog PACKAGE = Gtk2::AboutDialog PREFIX = gtk_about_dialog_ GtkWidget * gtk_about_dialog_new (class) C_ARGS: /* void */ =for apidoc get_name __hide__ =cut const gchar_ornull * gtk_about_dialog_get_program_name (GtkAboutDialog * about) ALIAS: get_name = 1 CODE: if (ix == 1) { warn ("Deprecation warning: use " "Gtk2::AboutDialog::get_program_name instead of " "get_name"); } #if GTK_CHECK_VERSION (2, 12, 0) RETVAL = gtk_about_dialog_get_program_name (about); #else RETVAL = gtk_about_dialog_get_name (about); #endif OUTPUT: RETVAL =for apidoc set_name __hide__ =cut void gtk_about_dialog_set_program_name (GtkAboutDialog * about, const gchar_ornull * name) ALIAS: set_name = 1 CODE: if (ix == 1) { warn ("Deprecation warning: use " "Gtk2::AboutDialog::set_program_name instead of " "set_name"); } #if GTK_CHECK_VERSION (2, 12, 0) gtk_about_dialog_set_program_name (about, name); #else gtk_about_dialog_set_name (about, name); #endif const gchar_ornull * gtk_about_dialog_get_version (GtkAboutDialog * about); void gtk_about_dialog_set_version (GtkAboutDialog * about, const gchar_ornull * version); const gchar_ornull * gtk_about_dialog_get_copyright (GtkAboutDialog * about); void gtk_about_dialog_set_copyright (GtkAboutDialog * about, const gchar_ornull * copyright); const gchar_ornull * gtk_about_dialog_get_comments (GtkAboutDialog * about); void gtk_about_dialog_set_comments (GtkAboutDialog * about, const gchar_ornull * comments); const gchar_ornull * gtk_about_dialog_get_license (GtkAboutDialog * about); void gtk_about_dialog_set_license (GtkAboutDialog * about, const gchar_ornull * license); #if GTK_CHECK_VERSION (2, 8, 0) gboolean gtk_about_dialog_get_wrap_license (GtkAboutDialog *about); void gtk_about_dialog_set_wrap_license (GtkAboutDialog *about, gboolean wrap_license); #endif const gchar_ornull * gtk_about_dialog_get_website (GtkAboutDialog * about); void gtk_about_dialog_set_website (GtkAboutDialog * about, const gchar_ornull * website); const gchar_ornull * gtk_about_dialog_get_website_label (GtkAboutDialog * about); void gtk_about_dialog_set_website_label (GtkAboutDialog * about, const gchar_ornull * website_label); ##const gchar * const * gtk_about_dialog_get_authors (GtkAboutDialog * about); void gtk_about_dialog_get_authors (GtkAboutDialog * about) PREINIT: gint i; const gchar * const * authors = NULL; PPCODE: authors = gtk_about_dialog_get_authors (about); GETTER (authors); ##void gtk_about_dialog_set_authors (GtkAboutDialog * about, gchar ** authors); =for apidoc =arg author1 (string) =cut void gtk_about_dialog_set_authors (about, author1, ...) GtkAboutDialog * about PREINIT: gint i; gchar ** authors; CODE: SETTER (authors); gtk_about_dialog_set_authors (about, (const gchar **) authors); g_free (authors); ##const gchar * const * gtk_about_dialog_get_documenters (GtkAboutDialog * about); void gtk_about_dialog_get_documenters (GtkAboutDialog * about) PREINIT: gint i; const gchar * const * documenters = NULL; PPCODE: documenters = gtk_about_dialog_get_documenters (about); GETTER (documenters); ##void gtk_about_dialog_set_documenters (GtkAboutDialog * about, gchar ** documenters); =for apidoc =arg documenter1 (string) =cut void gtk_about_dialog_set_documenters (about, documenter1, ...) GtkAboutDialog * about PREINIT: gint i; gchar ** documenters; CODE: SETTER (documenters); gtk_about_dialog_set_documenters (about, (const gchar **) documenters); g_free (documenters); ##const gchar * const * gtk_about_dialog_get_artists (GtkAboutDialog * about); void gtk_about_dialog_get_artists (GtkAboutDialog * about) PREINIT: gint i; const gchar * const * artists = NULL; PPCODE: artists = gtk_about_dialog_get_artists (about); GETTER (artists); ##void gtk_about_dialog_set_artists (GtkAboutDialog * about, gchar ** artists); =for apidoc =arg artist1 (string) =cut void gtk_about_dialog_set_artists (about, artist1, ...); GtkAboutDialog * about PREINIT: gint i; gchar ** artists; CODE: SETTER (artists); gtk_about_dialog_set_artists (about, (const gchar **) artists); g_free (artists); const gchar_ornull * gtk_about_dialog_get_translator_credits (GtkAboutDialog * about); void gtk_about_dialog_set_translator_credits (GtkAboutDialog * about, const gchar_ornull *translator_credits); GdkPixbuf_ornull * gtk_about_dialog_get_logo (GtkAboutDialog * about); void gtk_about_dialog_set_logo (GtkAboutDialog * about, GdkPixbuf_ornull * logo); const gchar_ornull * gtk_about_dialog_get_logo_icon_name (GtkAboutDialog * about); void gtk_about_dialog_set_logo_icon_name (GtkAboutDialog * about, const gchar_ornull * icon_name); ##GtkAboutDialogActivateLinkFunc gtk_about_dialog_set_email_hook (GtkAboutDialogActivateLinkFunc func, gpointer data, GDestroyNotify destroy); void gtk_about_dialog_set_email_hook (class, func, data = NULL) SV * func SV * data PREINIT: GPerlCallback *callback; CODE: callback = gtk2perl_about_dialog_activate_link_func_create (func, data); gtk_about_dialog_set_email_hook ( (GtkAboutDialogActivateLinkFunc) gtk2perl_about_dialog_activate_link_func, callback, (GDestroyNotify) gperl_callback_destroy); ##GtkAboutDialogActivateLinkFunc gtk_about_dialog_set_url_hook (GtkAboutDialogActivateLinkFunc func, gpointer data, GDestroyNotify destroy); void gtk_about_dialog_set_url_hook (class, func, data = NULL) SV * func SV * data PREINIT: GPerlCallback *callback; CODE: callback = gtk2perl_about_dialog_activate_link_func_create (func, data); gtk_about_dialog_set_url_hook ( (GtkAboutDialogActivateLinkFunc) gtk2perl_about_dialog_activate_link_func, callback, (GDestroyNotify) gperl_callback_destroy); Gtk2-1.24992/xs/GdkRegion.xs0000644000175000017500000002044313076462677014025 0ustar lacklack/* * Copyright (c) 2003, 2010 by the gtk2-perl team (see the file AUTHORS) * * This library is free software; you can redistribute it and/or * modify it under the terms of the GNU Library General Public * License as published by the Free Software Foundation; either * version 2.1 of the License, or (at your option) any later version. * * This library is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU * Library General Public License for more details. * * You should have received a copy of the GNU Library General Public * License along with this library; if not, write to the * Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, * Boston, MA 02110-1301 USA. * * $Id$ */ #include "gtk2perl.h" #include "gperl_marshal.h" /* ------------------------------------------------------------------------- */ GType gtk2perl_gdk_region_get_type (void) { static GType t = 0; if (!t) t = g_boxed_type_register_static ("GdkRegion", (GBoxedCopyFunc) gdk_region_copy, (GBoxedFreeFunc) gdk_region_destroy); return t; } /* ------------------------------------------------------------------------- */ static void gtk2perl_gdk_span_func (GdkSpan *span, GPerlCallback *callback) { dGPERL_CALLBACK_MARSHAL_SP; GPERL_CALLBACK_MARSHAL_INIT (callback); ENTER; SAVETMPS; PUSHMARK (SP); EXTEND (SP, 3); PUSHs (sv_2mortal (newSViv (span->x))); PUSHs (sv_2mortal (newSViv (span->y))); PUSHs (sv_2mortal (newSViv (span->width))); if (callback->data) XPUSHs (sv_2mortal (newSVsv (callback->data))); PUTBACK; call_sv (callback->func, G_DISCARD); FREETMPS; LEAVE; } /* ------------------------------------------------------------------------- */ MODULE = Gtk2::Gdk::Region PACKAGE = Gtk2::Gdk::Region PREFIX = gdk_region_ ## GdkRegion *gdk_region_new (void) GdkRegion_own * gdk_region_new (class) C_ARGS: /* void */ ## GdkRegion *gdk_region_polygon (GdkPoint *points, gint npoints, GdkFillRule fill_rule) GdkRegion_own * gdk_region_polygon (class, points_ref, fill_rule) SV * points_ref GdkFillRule fill_rule PREINIT: GdkPoint *points = NULL; gint npoints, i; AV *array; SV **value; CODE: if (!gperl_sv_is_array_ref (points_ref)) croak ("point list has to be a reference to an array"); array = (AV *) SvRV (points_ref); npoints = (av_len (array) + 1) / 2; points = g_new0 (GdkPoint, npoints); for (i = 0; i < npoints; i++) { if ((value = av_fetch (array, 2*i, 0)) && gperl_sv_is_defined (*value)) points[i].x = SvIV (*value); if ((value = av_fetch (array, 2*i + 1, 0)) && gperl_sv_is_defined (*value)) points[i].y = SvIV (*value); } RETVAL = gdk_region_polygon (points, npoints, fill_rule); g_free (points); OUTPUT: RETVAL ## GdkRegion *gdk_region_copy (GdkRegion *region) ## GdkRegion *gdk_region_rectangle (GdkRectangle *rectangle) GdkRegion_own * gdk_region_rectangle (class, rectangle) GdkRectangle *rectangle C_ARGS: rectangle ## void gdk_region_destroy (GdkRegion *region) ## void gdk_region_get_clipbox (GdkRegion *region, GdkRectangle *rectangle) GdkRectangle_copy * gdk_region_get_clipbox (region) GdkRegion *region PREINIT: GdkRectangle rectangle; CODE: gdk_region_get_clipbox (region, &rectangle); RETVAL = &rectangle; OUTPUT: RETVAL ## void gdk_region_get_rectangles (GdkRegion *region, GdkRectangle **rectangles, gint *n_rectangles) =for apidoc Returns a list of rectangles (Gtk2::Gdk::Rectangle's), the area covered by the region. =cut void gdk_region_get_rectangles (region) GdkRegion *region PREINIT: GdkRectangle *rectangles = NULL; gint n_rectangles; int i; PPCODE: gdk_region_get_rectangles (region, &rectangles, &n_rectangles); EXTEND (SP, n_rectangles); for (i = 0 ; i < n_rectangles ; i++) PUSHs (sv_2mortal (newSVGdkRectangle_copy (rectangles + i))); g_free (rectangles); ## gboolean gdk_region_empty (GdkRegion *region) gboolean gdk_region_empty (region) GdkRegion *region ## gboolean gdk_region_equal (GdkRegion *region1, GdkRegion *region2) gboolean gdk_region_equal (region1, region2) GdkRegion *region1 GdkRegion *region2 ## gboolean gdk_region_point_in (GdkRegion *region, int x, int y) gboolean gdk_region_point_in (region, x, y) GdkRegion *region int x int y ## GdkOverlapType gdk_region_rect_in (GdkRegion *region, GdkRectangle *rect) GdkOverlapType gdk_region_rect_in (region, rect) GdkRegion *region GdkRectangle *rect ## void gdk_region_offset (GdkRegion *region, gint dx, gint dy) void gdk_region_offset (region, dx, dy) GdkRegion *region gint dx gint dy ## void gdk_region_shrink (GdkRegion *region, gint dx, gint dy) void gdk_region_shrink (region, dx, dy) GdkRegion *region gint dx gint dy ## void gdk_region_union_with_rect (GdkRegion *region, GdkRectangle *rect) void gdk_region_union_with_rect (region, rect) GdkRegion *region GdkRectangle *rect ## void gdk_region_intersect (GdkRegion *source1, GdkRegion *source2) void gdk_region_intersect (source1, source2) GdkRegion *source1 GdkRegion *source2 ## void gdk_region_union (GdkRegion *source1, GdkRegion *source2) void gdk_region_union (source1, source2) GdkRegion *source1 GdkRegion *source2 ## void gdk_region_subtract (GdkRegion *source1, GdkRegion *source2) void gdk_region_subtract (source1, source2) GdkRegion *source1 GdkRegion *source2 ## void gdk_region_xor (GdkRegion *source1, GdkRegion *source2) void gdk_region_xor (source1, source2) GdkRegion *source1 GdkRegion *source2 ## void gdk_region_spans_intersect_foreach (GdkRegion *region, GdkSpan *spans, int n_spans, gboolean sorted, GdkSpanFunc function, gpointer data) =for arg spans_ref (scalar) arrayref of triples [$x1,$y1,$width1, $x2,$y2,$width2, ...] =for apidoc Call C<$function> for horizontal lines which intersect C<$region>. C<$spans_ref> is an arrayref of x,y,width horizontal lines. If C<$sorted> is true then they're assumed to be sorted by increasing y coordinate (allowing a single pass across the region rectangles). C<$function> is called &$function ($x, $y, $width, $data) for each portion of a span which intersects C<$region>. C<$function> must not change C<$region>. $region->spans_intersect_foreach ([ 0,0,50, 20,20,100, 0,10,50 ], 0, # spans not sorted by y \&my_callback, 'hello'); # userdata sub my_callback { my ($x, $y, $width, $userdata) = @_; print "$userdata: $x, $y, $width\n"; } =cut void gdk_region_spans_intersect_foreach (region, spans_ref, sorted, func, data=NULL) GdkRegion *region SV * spans_ref gboolean sorted SV * func SV * data PREINIT: GdkSpan *spans = NULL; int n_spans, i; AV *array; SV **value; GPerlCallback * callback; CODE: if (!gperl_sv_is_array_ref (spans_ref)) croak ("span list must be an arrayref of triples [ $x,$y,$width,$x,$y,$width,...]"); array = (AV *) SvRV (spans_ref); n_spans = av_len (array) + 1; if ((n_spans % 3) != 0) croak ("span list not a multiple of 3"); n_spans /= 3; /* gdk_region_spans_intersect_foreach() is happy to take n_spans==0 and do nothing, but it doesn't like spans==NULL (as of Gtk 2.20), and NULL is what g_new0() gives for a count of 0. So explicit skip if n_spans==0. */ if (n_spans != 0) { spans = g_new0 (GdkSpan, n_spans); for (i = 0; i < n_spans; i++) { if ((value = av_fetch (array, 3*i, 0)) && gperl_sv_is_defined (*value)) spans[i].x = SvIV (*value); if ((value = av_fetch (array, 3*i + 1, 0)) && gperl_sv_is_defined (*value)) spans[i].y = SvIV (*value); if ((value = av_fetch (array, 3*i + 2, 0)) && gperl_sv_is_defined (*value)) spans[i].width = SvIV (*value); } callback = gperl_callback_new (func, data, 0, NULL, 0); gdk_region_spans_intersect_foreach (region, spans, n_spans, sorted, (GdkSpanFunc) gtk2perl_gdk_span_func, callback); gperl_callback_destroy (callback); g_free (spans); } #if GTK_CHECK_VERSION (2, 18, 0) gboolean gdk_region_rect_equal (const GdkRegion *region, const GdkRectangle *rectangle); #endif Gtk2-1.24992/xs/GtkMenuShell.xs0000644000175000017500000000566713076462677014531 0ustar lacklack/* * Copyright (c) 2003-2005 by the gtk2-perl team (see the file AUTHORS) * * This library is free software; you can redistribute it and/or * modify it under the terms of the GNU Library General Public * License as published by the Free Software Foundation; either * version 2.1 of the License, or (at your option) any later version. * * This library is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU * Library General Public License for more details. * * You should have received a copy of the GNU Library General Public * License along with this library; if not, write to the * Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, * Boston, MA 02110-1301 USA. * * $Id$ */ #include "gtk2perl.h" MODULE = Gtk2::MenuShell PACKAGE = Gtk2::MenuShell PREFIX = gtk_menu_shell_ ## void gtk_menu_shell_append (GtkMenuShell *menu_shell, GtkWidget *child) void gtk_menu_shell_append (menu_shell, child) GtkMenuShell * menu_shell GtkWidget * child ## void gtk_menu_shell_prepend (GtkMenuShell *menu_shell, GtkWidget *child) void gtk_menu_shell_prepend (menu_shell, child) GtkMenuShell * menu_shell GtkWidget * child ## void gtk_menu_shell_insert (GtkMenuShell *menu_shell, GtkWidget *child, gint position) void gtk_menu_shell_insert (menu_shell, child, position) GtkMenuShell * menu_shell GtkWidget * child gint position ## void gtk_menu_shell_deactivate (GtkMenuShell *menu_shell) void gtk_menu_shell_deactivate (menu_shell) GtkMenuShell * menu_shell ## void gtk_menu_shell_select_item (GtkMenuShell *menu_shell, GtkWidget *menu_item) void gtk_menu_shell_select_item (menu_shell, menu_item) GtkMenuShell * menu_shell GtkWidget * menu_item ## void gtk_menu_shell_deselect (GtkMenuShell *menu_shell) void gtk_menu_shell_deselect (menu_shell) GtkMenuShell * menu_shell ## void gtk_menu_shell_activate_item (GtkMenuShell *menu_shell, GtkWidget *menu_item, gboolean force_deactivate) void gtk_menu_shell_activate_item (menu_shell, menu_item, force_deactivate) GtkMenuShell * menu_shell GtkWidget * menu_item gboolean force_deactivate #if GTK_CHECK_VERSION(2, 2, 0) void gtk_menu_shell_select_first (GtkMenuShell *menu_shell, gboolean search_sensitive) #endif /* >= 2.2.0 */ #if GTK_CHECK_VERSION(2, 4, 0) void gtk_menu_shell_cancel (GtkMenuShell *menu_shell); #endif #if GTK_CHECK_VERSION (2, 8, 0) gboolean gtk_menu_shell_get_take_focus (GtkMenuShell *menu_shell); void gtk_menu_shell_set_take_focus (GtkMenuShell *menu_shell, gboolean take_focus); #endif # __PRIVATE__ ## void _gtk_menu_shell_select_first (GtkMenuShell *menu_shell, gboolean search_sensitive) ## void _gtk_menu_shell_select_last (GtkMenuShell *menu_shell, gboolean search_sensitive) ## void _gtk_menu_shell_activate (GtkMenuShell *menu_shell) ## gint _gtk_menu_shell_get_popup_delay (GtkMenuShell *menu_shell) Gtk2-1.24992/xs/GdkDrawable.xs0000644000175000017500000002455413076462677014332 0ustar lacklack/* * Copyright (c) 2003-2005, 2009, 2010 by the gtk2-perl team (see the file AUTHORS) * * This library is free software; you can redistribute it and/or * modify it under the terms of the GNU Library General Public * License as published by the Free Software Foundation; either * version 2.1 of the License, or (at your option) any later version. * * This library is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU * Library General Public License for more details. * * You should have received a copy of the GNU Library General Public * License along with this library; if not, write to the * Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, * Boston, MA 02110-1301 USA. * * $Id$ */ #include "gtk2perl.h" #ifndef G_LIKELY /* new in glib 2.2 */ #define G_LIKELY(cond) (cond) /* fallback */ #endif /* NOTE: GdkDrawable descends directly from GObject, so be sure to use GdkDrawable_noinc for functions that return brand-new objects! (i don't think there are any, but there are several functions in other modules returning GdkDrawable subclasses) */ MODULE = Gtk2::Gdk::Drawable PACKAGE = Gtk2::Gdk::Drawable PREFIX = gdk_drawable_ ## deprecated ## GdkDrawable* gdk_drawable_ref (GdkDrawable *drawable) ## deprecated ## void gdk_drawable_unref (GdkDrawable *drawable) ## deprecated ## gpointer gdk_drawable_get_data (GdkDrawable *drawable, const gchar *key) ## void gdk_drawable_get_size (GdkDrawable *drawable, gint *width, gint *height) void gdk_drawable_get_size (GdkDrawable *drawable, OUTLIST gint width, OUTLIST gint height) ## void gdk_drawable_set_colormap (GdkDrawable *drawable, GdkColormap *colormap) void gdk_drawable_set_colormap (drawable, colormap) GdkDrawable *drawable GdkColormap *colormap ## GdkColormap* gdk_drawable_get_colormap (GdkDrawable *drawable) GdkColormap_ornull * gdk_drawable_get_colormap (drawable) GdkDrawable *drawable ## GdkVisual* gdk_drawable_get_visual (GdkDrawable *drawable) GdkVisual* gdk_drawable_get_visual (drawable) GdkDrawable *drawable ## gint gdk_drawable_get_depth (GdkDrawable *drawable) gint gdk_drawable_get_depth (drawable) GdkDrawable *drawable #if GTK_CHECK_VERSION(2,2,0) ## GdkScreen* gdk_drawable_get_screen (GdkDrawable *drawable) GdkScreen* gdk_drawable_get_screen (drawable) GdkDrawable *drawable ## GdkDisplay* gdk_drawable_get_display (GdkDrawable *drawable) GdkDisplay* gdk_drawable_get_display (drawable) GdkDrawable *drawable #endif ## GdkRegion* gdk_drawable_get_clip_region (GdkDrawable *drawable) GdkRegion_own* gdk_drawable_get_clip_region (drawable) GdkDrawable *drawable ## GdkRegion* gdk_drawable_get_visible_region (GdkDrawable *drawable) GdkRegion_own* gdk_drawable_get_visible_region (drawable) GdkDrawable *drawable MODULE = Gtk2::Gdk::Drawable PACKAGE = Gtk2::Gdk::Drawable PREFIX = gdk_ ## void gdk_draw_line (GdkDrawable *drawable, GdkGC *gc, gint x1_, gint y1_, gint x2_, gint y2_) void gdk_draw_line (drawable, gc, x1_, y1_, x2_, y2_) GdkDrawable *drawable GdkGC *gc gint x1_ gint y1_ gint x2_ gint y2_ ## void gdk_draw_rectangle (GdkDrawable *drawable, GdkGC *gc, gboolean filled, gint x, gint y, gint width, gint height) void gdk_draw_rectangle (drawable, gc, filled, x, y, width, height) GdkDrawable *drawable GdkGC *gc gboolean filled gint x gint y gint width gint height ## void gdk_draw_arc (GdkDrawable *drawable, GdkGC *gc, gboolean filled, gint x, gint y, gint width, gint height, gint angle1, gint angle2) void gdk_draw_arc (drawable, gc, filled, x, y, width, height, angle1, angle2) GdkDrawable *drawable GdkGC *gc gboolean filled gint x gint y gint width gint height gint angle1 gint angle2 ## void gdk_draw_polygon (GdkDrawable *drawable, GdkGC *gc, gboolean filled, GdkPoint *points, gint npoints) =for apidoc =for arg x1 (integer) the x coordinate of the first point =for arg y1 (integer) the y coordinate of the first point =for arg ... pairs of x and y coordinates =cut void gdk_draw_polygon (drawable, gc, filled, x1, y1, ...) GdkDrawable *drawable GdkGC *gc gboolean filled PREINIT: GdkPoint * points; gint npoints; gint i, j; CODE: npoints = (items-3)/2; points = g_new (GdkPoint, npoints); for (i = 0, j = 3; i < npoints ; i++, j+=2) { points[i].x = SvIV (ST (j)); points[i].y = SvIV (ST (j+1)); } gdk_draw_polygon (drawable, gc, filled, points, npoints); g_free (points); ## void gdk_draw_drawable (GdkDrawable *drawable, GdkGC *gc, GdkDrawable *src, gint xsrc, gint ysrc, gint xdest, gint ydest, gint width, gint height) void gdk_draw_drawable (drawable, gc, src, xsrc, ysrc, xdest, ydest, width, height) GdkDrawable *drawable GdkGC *gc GdkDrawable *src gint xsrc gint ysrc gint xdest gint ydest gint width gint height ## void gdk_draw_image (GdkDrawable *drawable, GdkGC *gc, GdkImage *image, gint xsrc, gint ysrc, gint xdest, gint ydest, gint width, gint height) void gdk_draw_image (drawable, gc, image, xsrc, ysrc, xdest, ydest, width, height) GdkDrawable *drawable GdkGC *gc GdkImage *image gint xsrc gint ysrc gint xdest gint ydest gint width gint height ## void gdk_draw_point (GdkDrawable *drawable, GdkGC *gc, gint x, gint y) void gdk_draw_point (drawable, gc, x, y) GdkDrawable *drawable GdkGC *gc gint x gint y ## void gdk_draw_points (GdkDrawable *drawable, GdkGC *gc, GdkPoint *points, gint npoints) ## void gdk_draw_lines (GdkDrawable *drawable, GdkGC *gc, GdkPoint *points, gint npoints) =for apidoc Gtk2::Gdk::Drawable::draw_lines =for arg ... integer x,y coordinates (possibly none) For example $win->draw_lines ($gc, 0,0, 20,30, 40,20); =cut =for apidoc =for arg ... integer x,y coordinates (possibly none) For example three points $win->draw_points ($gc, 0,0, 10,10, 20,20); =cut void gdk_draw_points (drawable, gc, ...) GdkDrawable *drawable GdkGC *gc ALIAS: Gtk2::Gdk::Drawable::draw_lines = 1 PREINIT: GdkPoint * points; gint npoints; gint i, j; CODE: npoints = (items-2)/2; /* gdk_draw_points() and gdk_draw_lines() both accept npoints==0 but can skip entirely with a couple of bytes of code. */ if (G_LIKELY (npoints != 0)) { points = g_new (GdkPoint, npoints); for (i = 0, j = 2; i < npoints ; i++, j+=2) { points[i].x = SvIV (ST (j)); points[i].y = SvIV (ST (j+1)); } if (ix == 1) gdk_draw_lines (drawable, gc, points, npoints); else gdk_draw_points (drawable, gc, points, npoints); g_free (points); } #### void gdk_draw_segments (GdkDrawable *drawable, GdkGC *gc, GdkSegment *segs, gint nsegs) =for apidoc =for arg ... quads of x1,y1,x2,y2 coordinates For example to draw two diagonal line segments, $drawable->draw_segments($gc, 0,0,100,100, 200,200,300,300); =cut void gdk_draw_segments (drawable, gc, ...) GdkDrawable *drawable GdkGC *gc PREINIT: GdkSegment * segs; gint nsegs; gint i, j; CODE: nsegs = (items-2)/4; segs = g_new (GdkSegment, nsegs); for (i = 0, j = 2; i < nsegs ; i++, j+=4) { segs[i].x1 = SvIV (ST (j+0)); segs[i].y1 = SvIV (ST (j+1)); segs[i].x2 = SvIV (ST (j+2)); segs[i].y2 = SvIV (ST (j+3)); } gdk_draw_segments (drawable, gc, segs, nsegs); g_free (segs); #if GTK_CHECK_VERSION(2,2,0) ## void gdk_draw_pixbuf (GdkDrawable *drawable, GdkGC *gc, GdkPixbuf *pixbuf, gint src_x, gint src_y, gint dest_x, gint dest_y, gint width, gint height, GdkRgbDither dither, gint x_dither, gint y_dither) void gdk_draw_pixbuf (drawable, gc, pixbuf, src_x, src_y, dest_x, dest_y, width, height, dither, x_dither, y_dither) GdkDrawable *drawable GdkGC_ornull *gc GdkPixbuf *pixbuf gint src_x gint src_y gint dest_x gint dest_y gint width gint height GdkRgbDither dither gint x_dither gint y_dither #endif # FIXME need a way to retrieve a PangoGlyphString ## ## void gdk_draw_glyphs (GdkDrawable *drawable, GdkGC *gc, PangoFont *font, gint x, gint y, PangoGlyphString *glyphs) ##void ##gdk_draw_glyphs (drawable, gc, font, x, y, glyphs) ## GdkDrawable *drawable ## GdkGC *gc ## PangoFont *font ## gint x ## gint y ## PangoGlyphString *glyphs # FIXME: gdk_draw_glyphs_transformed ## void gdk_draw_layout_line (GdkDrawable *drawable, GdkGC *gc, gint x, gint y, PangoLayoutLine *line) void gdk_draw_layout_line (drawable, gc, x, y, line) GdkDrawable *drawable GdkGC *gc gint x gint y PangoLayoutLine *line ## void gdk_draw_layout (GdkDrawable *drawable, GdkGC *gc, gint x, gint y, PangoLayout *layout) void gdk_draw_layout (drawable, gc, x, y, layout) GdkDrawable *drawable GdkGC *gc gint x gint y PangoLayout *layout ## void gdk_draw_layout_line_with_colors (GdkDrawable *drawable, GdkGC *gc, gint x, gint y, PangoLayoutLine *line, GdkColor *foreground, GdkColor *background) void gdk_draw_layout_line_with_colors (drawable, gc, x, y, line, foreground, background) GdkDrawable *drawable GdkGC *gc gint x gint y PangoLayoutLine *line GdkColor_ornull *foreground GdkColor_ornull *background ## void gdk_draw_layout_with_colors (GdkDrawable *drawable, GdkGC *gc, gint x, gint y, PangoLayout *layout, GdkColor *foreground, GdkColor *background) void gdk_draw_layout_with_colors (drawable, gc, x, y, layout, foreground, background) GdkDrawable *drawable GdkGC *gc gint x gint y PangoLayout *layout GdkColor_ornull *foreground GdkColor_ornull *background ## The docs say that "[t]his is low level functionality used internally to ## implement rotated underlines and backgrouds when rendering a PangoLayout ## and is likely not useful for applications." ## void gdk_draw_trapezoids (GdkDrawable *drawable, GdkGC *gc, GdkTrapezoid *trapezoids, gint n_trapezoids); MODULE = Gtk2::Gdk::Drawable PACKAGE = Gtk2::Gdk::Drawable PREFIX = gdk_drawable_ ## GdkImage* gdk_drawable_get_image (GdkDrawable *drawable, gint x, gint y, gint width, gint height) ## The return is a non-floating refcount==1, hence _noinc. GdkImage_noinc * gdk_drawable_get_image (drawable, x, y, width, height) GdkDrawable *drawable gint x gint y gint width gint height #if GTK_CHECK_VERSION(2, 4, 0) GdkImage * gdk_drawable_copy_to_image (drawable, image, src_x, src_y, dest_x, dest_y, width, height) GdkDrawable * drawable GdkImage_ornull * image gint src_x gint src_y gint dest_x gint dest_y gint width gint height CLEANUP: /* if the return value has been allocated anew, * the caller will own it. */ if (!image) g_object_unref (RETVAL); #endif Gtk2-1.24992/xs/GtkPageSetup.xs0000644000175000017500000000775713076462677014534 0ustar lacklack/* * Copyright (c) 2006 by the gtk2-perl team (see the file AUTHORS) * * Licensed under the LGPL, see LICENSE file for more information. * * $Id$ */ #include "gtk2perl.h" MODULE = Gtk2::PageSetup PACKAGE = Gtk2::PageSetup PREFIX = gtk_page_setup_ # GtkPageSetup * gtk_page_setup_new (void); GtkPageSetup_noinc * gtk_page_setup_new (class) C_ARGS: /* void */ # FIXME: needed? # GtkPageSetup * gtk_page_setup_copy (GtkPageSetup *other); GtkPageOrientation gtk_page_setup_get_orientation (GtkPageSetup *setup); void gtk_page_setup_set_orientation (GtkPageSetup *setup, GtkPageOrientation orientation); # setup still owns the size object GtkPaperSize * gtk_page_setup_get_paper_size (GtkPageSetup *setup); # setup takes a copy of the size object void gtk_page_setup_set_paper_size (GtkPageSetup *setup, GtkPaperSize *size); gdouble gtk_page_setup_get_top_margin (GtkPageSetup *setup, GtkUnit unit); void gtk_page_setup_set_top_margin (GtkPageSetup *setup, gdouble margin, GtkUnit unit); gdouble gtk_page_setup_get_bottom_margin (GtkPageSetup *setup, GtkUnit unit); void gtk_page_setup_set_bottom_margin (GtkPageSetup *setup, gdouble margin, GtkUnit unit); gdouble gtk_page_setup_get_left_margin (GtkPageSetup *setup, GtkUnit unit); void gtk_page_setup_set_left_margin (GtkPageSetup *setup, gdouble margin, GtkUnit unit); gdouble gtk_page_setup_get_right_margin (GtkPageSetup *setup, GtkUnit unit); void gtk_page_setup_set_right_margin (GtkPageSetup *setup, gdouble margin, GtkUnit unit); # setup takes a copy of the size object void gtk_page_setup_set_paper_size_and_default_margins (GtkPageSetup *setup, GtkPaperSize *size); gdouble gtk_page_setup_get_paper_width (GtkPageSetup *setup, GtkUnit unit); gdouble gtk_page_setup_get_paper_height (GtkPageSetup *setup, GtkUnit unit); gdouble gtk_page_setup_get_page_width (GtkPageSetup *setup, GtkUnit unit); gdouble gtk_page_setup_get_page_height (GtkPageSetup *setup, GtkUnit unit); #if GTK_CHECK_VERSION (2, 12, 0) # GtkPageSetup * gtk_page_setup_new_from_file (const gchar *file_name, GError **error); =for apidoc __gerror__ =cut GtkPageSetup_noinc * gtk_page_setup_new_from_file (class, GPerlFilename file_name) PREINIT: GError *error = NULL; CODE: RETVAL = gtk_page_setup_new_from_file (file_name, &error); if (error) gperl_croak_gerror (NULL, error); OUTPUT: RETVAL # gboolean gtk_page_setup_to_file (GtkPageSetup *setup, const char *file_name, GError **error); =for apidoc __gerror__ =cut void gtk_page_setup_to_file (GtkPageSetup *setup, GPerlFilename file_name) PREINIT: GError *error = NULL; CODE: if (!gtk_page_setup_to_file (setup, file_name, &error)) gperl_croak_gerror (NULL, error); # GtkPageSetup * gtk_page_setup_new_from_key_file (GKeyFile *key_file, const gchar *group_name, GError **error); =for apidoc __gerror__ =cut GtkPageSetup_noinc * gtk_page_setup_new_from_key_file (class, GKeyFile *key_file, const gchar_ornull *group_name) PREINIT: GError *error = NULL; CODE: RETVAL = gtk_page_setup_new_from_key_file (key_file, group_name, &error); if (error) gperl_croak_gerror (NULL, error); OUTPUT: RETVAL void gtk_page_setup_to_key_file (GtkPageSetup *setup, GKeyFile *key_file, const gchar_ornull *group_name); #endif #if GTK_CHECK_VERSION (2, 14, 0) =for apidoc __gerror__ =cut # gboolean gtk_page_setup_load_file (GtkPageSetup *setup, const char *file_name, GError **error); void gtk_page_setup_load_file (GtkPageSetup *setup, const char *file_name) PREINIT: GError *error = NULL; CODE: if (!gtk_page_setup_load_file (setup, file_name, &error)) gperl_croak_gerror (NULL, error); =for apidoc __gerror__ =cut # gboolean gtk_page_setup_load_key_file (GtkPageSetup *setup, GKeyFile *key_file, const gchar *group_name, GError **error); void gtk_page_setup_load_key_file (GtkPageSetup *setup, GKeyFile *key_file, const gchar_ornull *group_name) PREINIT: GError *error = NULL; CODE: if (!gtk_page_setup_load_key_file (setup, key_file, group_name, &error)) gperl_croak_gerror (NULL, error); #endif /* 2.14 */ Gtk2-1.24992/xs/GtkFileFilter.xs0000644000175000017500000000720513076462677014650 0ustar lacklack/* * Copyright (c) 2003, 2013 by the gtk2-perl team (see the file AUTHORS) * * Licensed under the LGPL, see LICENSE file for more information. * * $Id$ */ #include "gtk2perl.h" /* struct _GtkFileFilterInfo { GtkFileFilterFlags contains; const gchar *filename; const gchar *uri; const gchar *display_name; const gchar *mime_type; }; */ static SV * newSVGtkFileFilterInfo (const GtkFileFilterInfo * info) { HV * hv; if (!info) return &PL_sv_undef; hv = newHV (); gperl_hv_take_sv_s (hv, "contains", newSVGtkFileFilterFlags (info->contains)); if (info->filename) gperl_hv_take_sv_s (hv, "filename", gperl_sv_from_filename (info->filename)); if (info->uri) gperl_hv_take_sv_s (hv, "uri", newSVpv (info->uri, 0)); if (info->display_name) gperl_hv_take_sv_s (hv, "display_name", newSVGChar (info->display_name)); if (info->mime_type) gperl_hv_take_sv_s (hv, "mime_type", newSVGChar (info->mime_type)); return newRV_noinc ((SV*) hv); } static GtkFileFilterInfo * SvGtkFileFilterInfo (SV * sv) { HV * hv; SV ** svp; GtkFileFilterInfo * info; if (!gperl_sv_is_hash_ref (sv)) croak ("invalid file filter info - expecting a hash reference"); hv = (HV*) SvRV (sv); info = gperl_alloc_temp (sizeof (GtkFileFilterInfo)); if ((svp = hv_fetch (hv, "contains", 8, 0))) info->contains = SvGtkFileFilterFlags (*svp); if ((svp = hv_fetch (hv, "filename", 8, 0))) info->filename = gperl_filename_from_sv (*svp); if ((svp = hv_fetch (hv, "uri", 3, 0))) info->uri = SvPV_nolen (*svp); if ((svp = hv_fetch (hv, "display_name", 12, 0))) info->display_name = SvGChar (*svp); if ((svp = hv_fetch (hv, "mime_type", 9, 0))) info->mime_type = SvGChar (*svp); return info; } static gboolean gtk2perl_file_filter_func (const GtkFileFilterInfo *filter_info, gpointer data) { GPerlCallback * callback = (GPerlCallback*) data; GValue value = {0,}; gboolean retval; SV * sv; g_value_init (&value, G_TYPE_BOOLEAN); sv = newSVGtkFileFilterInfo (filter_info); gperl_callback_invoke (callback, &value, sv); retval = g_value_get_boolean (&value); SvREFCNT_dec (sv); g_value_unset (&value); return retval; } MODULE = Gtk2::FileFilter PACKAGE = Gtk2::FileFilter PREFIX = gtk_file_filter_ GtkFileFilter * gtk_file_filter_new (class); C_ARGS: /*void*/ void gtk_file_filter_set_name (GtkFileFilter *filter, const gchar *name); const gchar *gtk_file_filter_get_name (GtkFileFilter *filter); void gtk_file_filter_add_mime_type (GtkFileFilter *filter, const gchar *mime_type); void gtk_file_filter_add_pattern (GtkFileFilter *filter, const gchar *pattern); ### /* there appears to be no boxed type support for GtkFileFilterInfo */ void gtk_file_filter_add_custom (GtkFileFilter *filter, GtkFileFilterFlags needed, SV * func, SV * data=NULL); PREINIT: GType param_types[1]; GPerlCallback * callback; CODE: param_types[0] = GPERL_TYPE_SV; callback = gperl_callback_new (func, data, 1, param_types, G_TYPE_BOOLEAN); gtk_file_filter_add_custom (filter, needed, gtk2perl_file_filter_func, callback, (GDestroyNotify)gperl_callback_destroy); GtkFileFilterFlags gtk_file_filter_get_needed (GtkFileFilter *filter); ###gboolean gtk_file_filter_filter (GtkFileFilter *filter, const GtkFileFilterInfo *filter_info); gboolean gtk_file_filter_filter (GtkFileFilter *filter, SV *filter_info); C_ARGS: filter, SvGtkFileFilterInfo (filter_info) #if GTK_CHECK_VERSION (2, 6, 0) void gtk_file_filter_add_pixbuf_formats (GtkFileFilter *filter) #endif Gtk2-1.24992/xs/GtkBuildable.xs0000644000175000017500000006653513076462677014521 0ustar lacklack/* * Copyright (c) 2007, 2010 by the gtk2-perl team (see the file AUTHORS) * * Licensed under the LGPL, see LICENSE file for more information. * * $Id$ */ #include "gtk2perl.h" /* Since perl already has a metric ton of XML parsers, Glib doesn't wrap GMarkupParser. This is a miniature binding of just the bits of GMarkupParser that GtkBuildable needs. The GMarkupParseContext is blessed as a Gtk2::Builder::ParseContext, and has only the user-usable methods bound. (Should it happen that we need to bind GMarkupParseContext in Glib in the future, we can just move those methods to Glib, and have Gtk2::Builder::ParseContext inherit from Glib::Markup::ParseContext.) Builder doesn't use passthrough() and error(), but they were easy to implement and will be there if and when Builder does start to use them. */ static SV * newSVGtkBuildableParseContext (GMarkupParseContext * context) { return sv_setref_pv (newSV (0), "Gtk2::Buildable::ParseContext", context); } static GMarkupParseContext * SvGtkBuildableParseContext (SV * sv) { if (! gperl_sv_is_defined (sv) || ! SvROK (sv)) croak ("expected a blessed reference"); if (! sv_derived_from (sv, "Gtk2::Buildable::ParseContext")) croak ("%s is not of type Gtk2::Buildable::ParseContext", gperl_format_variable_for_output (sv)); return INT2PTR (GMarkupParseContext *, SvIV (SvRV (sv))); } static SV * check_parser (gpointer user_data) { SV * sv = user_data; if (! gperl_sv_is_defined (sv) || ! SvROK (sv)) croak ("parser object is not an object"); return sv; } /* * Treat parser as an SV object, and call method on it in void context, with * the extra args from the va list. You are expected to do any necessary * sv_2mortal() and such on those. An exception will be converted to a GError. */ static void call_parser_method (GError ** error, gpointer parser, GMarkupParseContext * context, const char * method, int n_args, ...) { va_list ap; dSP; ENTER; SAVETMPS; PUSHMARK (SP); EXTEND (SP, 2 + n_args); PUSHs (check_parser (parser)); PUSHs (sv_2mortal (newSVGtkBuildableParseContext (context))); va_start (ap, n_args); while (n_args-- > 0) { SV * sv = va_arg (ap, SV *); PUSHs (sv); } va_end (ap); PUTBACK; call_method (method, G_VOID | G_DISCARD | G_EVAL); SPAGAIN; if (gperl_sv_is_defined (ERRSV) && SvTRUE (ERRSV)) { if (SvROK (ERRSV) && sv_derived_from (ERRSV, "Glib::Error")) { gperl_gerror_from_sv (ERRSV, error); } else { /* g_error_new_literal() won't let us pass 0 for * the domain... */ g_set_error (error, 0, 0, "%s", SvPV_nolen (ERRSV)); } } FREETMPS; LEAVE; } /* Called for open tags */ static void gtk2perl_buildable_parser_start_element (GMarkupParseContext *context, const gchar *element_name, const gchar **attribute_names, const gchar **attribute_values, gpointer user_data, GError **error) { HV * hv; SV * attrs; int i; hv = newHV (); attrs = newRV_noinc ((SV *) hv); for (i = 0; attribute_names[i] != NULL ; i++) gperl_hv_take_sv ( hv, attribute_names[i], strlen (attribute_names[i]), newSVGChar (attribute_values[i])); call_parser_method (error, user_data, context, "START_ELEMENT", 2, sv_2mortal (newSVGChar (element_name)), sv_2mortal (attrs)); } /* Called for close tags */ static void gtk2perl_buildable_parser_end_element (GMarkupParseContext *context, const gchar *element_name, gpointer user_data, GError **error) { call_parser_method (error, user_data, context, "END_ELEMENT", 1, sv_2mortal (newSVGChar (element_name))); } /* Called for character data */ /* text is not nul-terminated */ static void gtk2perl_buildable_parser_text (GMarkupParseContext *context, const gchar *text, gsize text_len, gpointer user_data, GError **error) { SV * text_sv; text_sv = newSVpv (text, text_len); SvUTF8_on (text_sv); call_parser_method (error, user_data, context, "TEXT", 1, sv_2mortal (text_sv)); } /* Called for strings that should be re-saved verbatim in this same * position, but are not otherwise interpretable. At the moment * this includes comments and processing instructions. */ /* text is not nul-terminated. */ static void gtk2perl_buildable_parser_passthrough (GMarkupParseContext *context, const gchar *passthrough_text, gsize text_len, gpointer user_data, GError **error) { SV * text_sv; text_sv = newSVpv (passthrough_text, text_len); SvUTF8_on (text_sv); call_parser_method (error, user_data, context, "PASSTHROUGH", 1, sv_2mortal (text_sv)); } /* Called on error, including one set by other * methods in the vtable. The GError should not be freed. */ static void gtk2perl_buildable_parser_error (GMarkupParseContext *context, GError *error, gpointer user_data) { dSP; ENTER; SAVETMPS; PUSHMARK (SP); EXTEND (SP, 2); PUSHs (check_parser (user_data)); PUSHs (sv_2mortal (newSVGtkBuildableParseContext (context))); PUSHs (sv_2mortal (gperl_sv_from_gerror (error))); PUTBACK; call_method ("ERROR", G_VOID | G_DISCARD); SPAGAIN; FREETMPS; LEAVE; PERL_UNUSED_VAR (context); } static const GMarkupParser mini_markup_parser = { gtk2perl_buildable_parser_start_element, gtk2perl_buildable_parser_end_element, gtk2perl_buildable_parser_text, gtk2perl_buildable_parser_passthrough, gtk2perl_buildable_parser_error }; /* * Now, support for GtkBuildableIface. */ #define GET_METHOD(object, name) \ HV * stash = gperl_object_stash_from_type (G_OBJECT_TYPE (object)); \ GV * slot = gv_fetchmethod (stash, name); #define METHOD_EXISTS (slot && GvCV (slot)) #define GET_METHOD_OR_DIE(obj, name) \ GET_METHOD (obj, name); \ if (! METHOD_EXISTS) \ die ("No implementation for %s::%s\n", \ gperl_package_from_type (G_OBJECT_TYPE (obj)), name); #define PREP(obj) \ dSP; \ ENTER; \ SAVETMPS; \ PUSHMARK (SP) ; \ PUSHs (sv_2mortal (newSVGObject (G_OBJECT (obj)))); #define CALL_VOID \ PUTBACK; \ call_sv ((SV *) GvCV (slot), G_VOID | G_DISCARD); #define CALL_SCALAR(sv) \ PUTBACK; \ (void) call_sv ((SV *) GvCV (slot), G_SCALAR); \ SPAGAIN; \ sv = POPs; \ PUTBACK; #define FINISH \ FREETMPS; \ LEAVE; static void gtk2perl_buildable_set_name (GtkBuildable *buildable, const gchar *name) { GET_METHOD (buildable, "SET_NAME"); if (METHOD_EXISTS) { PREP (buildable); XPUSHs (sv_2mortal (newSVGChar (name))); CALL_VOID; FINISH; } else { /* Convenient fallback for mere mortals who need nothing complicated. This is the same as in the upstream implementation. */ g_object_set_data_full (G_OBJECT (buildable), "gtk-builder-name", g_strdup (name), g_free); } } static const gchar * gtk2perl_buildable_get_name (GtkBuildable *buildable) { const gchar * name; GET_METHOD (buildable, "GET_NAME"); if (METHOD_EXISTS) { SV * sv; PREP (buildable); CALL_SCALAR (sv); /* * the interface wants us to return a const pointer, which * means this needs to stay alive. Unfortunately, we can't * guarantee that the scalar will still be around by the * time the string is used. My first thought here was to * use gperl_alloc_temp(), but that suffered the same * lifetime issue, because the string was immediately * returned to perl code, which meant that the temp was * cleaned up an reused before the string was read. * So, we'll go a little nuts and store a malloc'd copy * of the string until the next call. In theory, some * code might be crazy enough to return a different name * on the second call, so we won't bother with real caching. */ name = g_strdup (SvGChar (sv)); g_object_set_data_full (G_OBJECT (buildable), "gtk-perl-builder-name", g_strdup (name), g_free); FINISH; } else { /* Convenient fallback for mere mortals who need nothing complicated. This is the same as in the upstream implementation. */ name = (const gchar *) g_object_get_data (G_OBJECT (buildable), "gtk-builder-name"); } return name; } static void gtk2perl_buildable_add_child (GtkBuildable *buildable, GtkBuilder *builder, GObject *child, const gchar *type) { GET_METHOD_OR_DIE (buildable, "ADD_CHILD"); { PREP (buildable); XPUSHs (sv_2mortal (newSVGtkBuilder (builder))); XPUSHs (sv_2mortal (newSVGObject (child))); XPUSHs (sv_2mortal (newSVGChar (type))); CALL_VOID; FINISH; } } static void gtk2perl_buildable_set_buildable_property (GtkBuildable *buildable, GtkBuilder *builder, const gchar *name, const GValue *value) { GET_METHOD (buildable, "SET_BUILDABLE_PROPERTY"); if (METHOD_EXISTS) { PREP (buildable); XPUSHs (sv_2mortal (newSVGtkBuilder (builder))); XPUSHs (sv_2mortal (newSVGChar (name))); XPUSHs (sv_2mortal (gperl_sv_from_value (value))); CALL_VOID; FINISH; } else g_object_set_property (G_OBJECT (buildable), name, value); } /* Nobody should really ever need this one; it's a special case for * GtkUIManager... but, just in case. */ static GObject * gtk2perl_buildable_construct_child (GtkBuildable *buildable, GtkBuilder *builder, const gchar *name) { GObject * child; GET_METHOD_OR_DIE (buildable, "CONSTRUCT_CHILD"); { SV * sv; PREP (buildable); XPUSHs (sv_2mortal (newSVGtkBuilder (builder))); XPUSHs (sv_2mortal (newSVGChar (name))); CALL_SCALAR (sv); child = SvGObject (sv); FINISH; } return child; } static gboolean gtk2perl_buildable_custom_tag_start (GtkBuildable *buildable, GtkBuilder *builder, GObject *child, const gchar *tagname, GMarkupParser *parser, gpointer *data) { gboolean ret = FALSE; GET_METHOD_OR_DIE (buildable, "CUSTOM_TAG_START"); *data = NULL; memset (parser, 0, sizeof (*parser)); { SV * sv; PREP (buildable); XPUSHs (sv_2mortal (newSVGtkBuilder (builder))); XPUSHs (sv_2mortal (newSVGObject (child))); XPUSHs (sv_2mortal (newSVGChar (tagname))); CALL_SCALAR (sv); if (gperl_sv_is_defined (sv)) { ret = TRUE; /* keep it... we'll destroy it in custom-finished, * below, regardless of whether the perl code * actually does anything with it. */ *data = newSVsv (sv); *parser = mini_markup_parser; } FINISH; } return ret; } static void gtk2perl_buildable_custom_tag_end (GtkBuildable *buildable, GtkBuilder *builder, GObject *child, const gchar *tagname, gpointer *data) { GET_METHOD (buildable, "CUSTOM_TAG_END"); if (METHOD_EXISTS) { SV * parser = gperl_sv_is_defined ((SV *) data) ? (SV *) data : &PL_sv_undef; PREP (buildable); XPUSHs (sv_2mortal (newSVGtkBuilder (builder))); XPUSHs (sv_2mortal (newSVGObject (child))); XPUSHs (sv_2mortal (newSVGChar (tagname))); XPUSHs (parser); CALL_VOID; FINISH; } } static void gtk2perl_buildable_custom_finished (GtkBuildable *buildable, GtkBuilder *builder, GObject *child, const gchar *tagname, gpointer data) { SV * parser = gperl_sv_is_defined ((SV *) data) ? (SV *) data : &PL_sv_undef; GET_METHOD (buildable, "CUSTOM_FINISHED"); if (METHOD_EXISTS) { PREP (buildable); XPUSHs (sv_2mortal (newSVGtkBuilder (builder))); XPUSHs (sv_2mortal (newSVGObject (child))); XPUSHs (sv_2mortal (newSVGChar (tagname))); XPUSHs (parser); CALL_VOID; FINISH; } if (parser != &PL_sv_undef) /* No further use for this. */ SvREFCNT_dec (parser); } static void gtk2perl_buildable_parser_finished (GtkBuildable *buildable, GtkBuilder *builder) { GET_METHOD (buildable, "PARSER_FINISHED"); if (METHOD_EXISTS) { PREP (buildable); XPUSHs (sv_2mortal (newSVGtkBuilder (builder))); CALL_VOID; FINISH; } } static GObject * gtk2perl_buildable_get_internal_child (GtkBuildable *buildable, GtkBuilder *builder, const gchar *childname) { GObject * child = NULL; GET_METHOD (buildable, "GET_INTERNAL_CHILD"); if (METHOD_EXISTS) { SV * sv; PREP (buildable); XPUSHs (sv_2mortal (newSVGtkBuilder (builder))); XPUSHs (sv_2mortal (newSVGChar (childname))); CALL_SCALAR (sv); child = SvGObject_ornull (sv); FINISH; } return child; } static void gtk2perl_buildable_init (GtkBuildableIface * iface) { iface->set_name = gtk2perl_buildable_set_name; iface->get_name = gtk2perl_buildable_get_name; iface->add_child = gtk2perl_buildable_add_child; iface->set_buildable_property = gtk2perl_buildable_set_buildable_property; iface->construct_child = gtk2perl_buildable_construct_child; iface->custom_tag_start = gtk2perl_buildable_custom_tag_start; iface->custom_tag_end = gtk2perl_buildable_custom_tag_end; iface->custom_finished = gtk2perl_buildable_custom_finished; iface->parser_finished = gtk2perl_buildable_parser_finished; iface->get_internal_child = gtk2perl_buildable_get_internal_child; } MODULE = Gtk2::Buildable PACKAGE = Gtk2::Buildable PREFIX = gtk_buildable_ =for object Gtk2::Buildable - Interface for objects that can be built by Gtk2::Builder =cut =for apidoc __hide__ =cut void _ADD_INTERFACE (class, const char * target_class) CODE: { static const GInterfaceInfo iface_info = { (GInterfaceInitFunc) gtk2perl_buildable_init, (GInterfaceFinalizeFunc) NULL, (gpointer) NULL }; GType gtype = gperl_object_type_from_package (target_class); g_type_add_interface_static (gtype, GTK_TYPE_BUILDABLE, &iface_info); } # # NOTE: The interface methods here really aren't useful in perl code, # since they are meant to be called by GtkBuilder. I find it # highly improbable that anyone would want to go to the trouble # to reimplement GtkBuilder in perl, though i guess it's # technically possible... Since these were part of the 1.160 # stable release, they can't be removed. Instead, we'll just # hide all of them, so we can focus the docs on how to implement # a buildable, instead of on how to use one. # # These two theoretically collide with Gtk2::Widget::set_name and get_name when # dealing with Gtk2::Widgets. Fortunately though, GtkWidget maps these vfuncs # to gtk_widget_set_name and _get_name anyway. =for apidoc __hide__ =cut void gtk_buildable_set_name (GtkBuildable *buildable, const gchar *name); =for apidoc __hide__ =cut const gchar * gtk_buildable_get_name (GtkBuildable *buildable); =for apidoc __hide__ =cut void gtk_buildable_add_child (GtkBuildable *buildable, GtkBuilder *builder, GObject *child, const gchar_ornull *type); # void gtk_buildable_set_buildable_property (GtkBuildable *buildable, GtkBuilder *builder, const gchar *name, const GValue *value); =for apidoc __hide__ =for signature $buildable->set_buildable_property ($builder, key => $value, ...) =for arg ... (__hide__) =cut void gtk_buildable_set_buildable_property (GtkBuildable *buildable, GtkBuilder *builder, ...) PREINIT: GValue value = {0,}; int i; CODE: #define OFFSET 2 if (0 != ((items - OFFSET) % 2)) croak ("set_property expects name => value pairs " "(odd number of arguments detected)"); for (i = OFFSET; i < items; i += 2) { gchar *name = SvGChar (ST (i)); SV *newval = ST (i + 1); GParamSpec *pspec = g_object_class_find_property (G_OBJECT_GET_CLASS (buildable), name); if (!pspec) { const char *classname = gperl_object_package_from_type (G_OBJECT_TYPE (buildable)); if (!classname) classname = G_OBJECT_TYPE_NAME (buildable); croak ("type %s does not support property '%s'", classname, name); } g_value_init (&value, G_PARAM_SPEC_VALUE_TYPE (pspec)); gperl_value_from_sv (&value, newval); gtk_buildable_set_buildable_property (buildable, builder, name, &value); g_value_unset (&value); } #undef OFFSET # The caller will take ownership of the child. =for apidoc __hide__ =cut GObject_noinc * gtk_buildable_construct_child (GtkBuildable *buildable, GtkBuilder *builder, const gchar *name); # # We should not need to expose these, as they are used by GtkBuilder to # allow the Buildable to handle its own tags during parsing. Unless somebody # wants to reimplement GtkBuilder in perl code, these won't be useful. # Besides, the dependency on GMarkupParser is a bit problematic. # # gboolean gtk_buildable_custom_tag_start (GtkBuildable *buildable, GtkBuilder *builder, GObject *child, const gchar *tagname, GMarkupParser *parser, gpointer *data); # void gtk_buildable_custom_tag_end (GtkBuildable *buildable, GtkBuilder *builder, GObject *child, const gchar *tagname, gpointer *data); # void gtk_buildable_custom_finished (GtkBuildable *buildable, GtkBuilder *builder, GObject *child, const gchar *tagname, gpointer data); =for apidoc __hide__ =cut void gtk_buildable_parser_finished (GtkBuildable *buildable, GtkBuilder *builder); =for apidoc __hide__ =cut GObject * gtk_buildable_get_internal_child (GtkBuildable *buildable, GtkBuilder *builder, const gchar *childname); MODULE = Gtk2::Buildable PACKAGE = Gtk2::Buildable::ParseContext PREFIX = g_markup_parse_context_ # # NOTE: This is a minimal binding for the parts of GMarkupParseContext # a user would need from the Buildable custom tag handlers. # Should GMarkupParseContext be bound in Glib, remove these methods # and have Gtk2::Builder::ParseContext inherit them from Glib. # =for object Gtk2::Buildable::ParseContext =head1 DESCRIPTION This object contains context of the XML subset parser used by Gtk2::Builder. Objects of this type will be passed to the methods invoked on the parser returned from your Gtk2::Buildable's C. You should use these methods to create useful error messages, as necessary. =cut =for see_also Gtk2::Buildable =cut =for apidoc =for signature string = $parse_context->get_element Return the name of the currently open element. =cut const gchar * g_markup_parse_context_get_element (SV * sv); C_ARGS: SvGtkBuildableParseContext (sv) #if GLIB_CHECK_VERSION(2, 16, 0) =for apidoc =for signature list = $parse_context->get_element_stack Returns the element stack; the first item is the currently-open tag (which would be returned by C), and the next item is its immediate parent. =cut void g_markup_parse_context_get_element_stack (SV * sv); PREINIT: const GSList * list; PPCODE: list = g_markup_parse_context_get_element_stack (SvGtkBuildableParseContext (sv)); while (list) { XPUSHs (sv_2mortal (newSVGChar (list->data))); list = list->next; } #endif =for apidoc =for signature (line_number, char_number) = $parse_context->get_position =cut void g_markup_parse_context_get_position (SV * sv) PREINIT: int line_number; int char_number; PPCODE: g_markup_parse_context_get_position (SvGtkBuildableParseContext (sv), &line_number, &char_number); EXTEND (SP, 2); PUSHs (sv_2mortal (newSViv (line_number))); PUSHs (sv_2mortal (newSViv (char_number))); MODULE = Gtk2::Buildable PACKAGE = Gtk2::Buildable =for position SYNOPSIS =head1 SYNOPSIS package Thing; use Gtk2; use Glib::Object::Subclass Glib::Object::, # Some signals and properties on the object... signals => { exploderize => {}, }, properties => [ Glib::ParamSpec->int ('force', 'Force', 'Explosive force, in megatons', 0, 1000000, 5, ['readable', 'writable']), ], ; sub exploderize { my $self = shift; $self->signal_emit ('exploderize'); } # We can accept all defaults for Buildable; see the description # for details on custom XML. package main; use Gtk2 -init; my $builder = Gtk2::Builder->new (); $builder->add_from_string (' 50 '); $builder->connect_signals (); my $thing = $builder->get_object ('thing1'); $thing->exploderize (); sub do_explode { my $thing = shift; printf "boom * %d!\n", $thing->get ('force'); } # This program prints "boom * 50!" on stdout. =cut =head1 DESCRIPTION The Gtk2::Buildable interface allows objects and widgets to have C<< >> objects, special property settings, or extra custom tags in a Gtk2::Builder UI description (L). The main user of the Gtk2::Buildable interface is Gtk2::Builder, so there should be very little need for applications to call any of the Gtk2::Buildable methods. So this documentation deals with implementing a buildable object. Gtk2::Builder already supports plain Glib::Object or Gtk2::Widget with C<< >> construction and C<< >> settings, so often the C interface is not needed. The only thing to note is that an object or widget implemented in Perl must be loaded before building. =head1 OVERRIDING BUILDABLE INTERFACE METHODS The buildable interface can be added to a Perl code object or widget subclass by putting C in the interfaces list and implementing the following methods. In current Gtk2-Perl the custom tags code doesn't chain up to any buildable interfaces in superclasses. This means for instance if you implement Gtk2::Buildable on a new widget subclass then you lose the and tags normally available from Gtk2::Widget. This will likely change in the future, probably by chaining up by default for unhandled tags, maybe with a way to ask deliberately not to chain. =over =item SET_NAME ($self, $name) =over =item * $name (string) =back This method should store I<$name> in I<$self> somehow. For example, Gtk2::Widget maps this to the Gtk2::Widget's C property. If you don't implement this method, the name will be attached in object data down in C code. Implement this method if your object has some notion of "name" and it makes sense to map the XML name attribute to that. =item string = GET_NAME ($self) If you implement C, you need to implement this method to retrieve that name. =item ADD_CHILD ($self, $builder, $child, $type) =over =item * $builder (Gtk2::Builder) =item * $child (Glib::Object or undef) =item * $type (string) =back C will be called to add I<$child> to I<$self>. I<$type> can be used to determine the kind of child. For example, Gtk2::Container implements this method to add a child widget to the container, and Gtk2::Notebook uses I<$type> to distinguish between "page-label" and normal children. The value of I<$type> comes directly from the C attribute of the XML C tag. =item SET_BUILDABLE_PROPERTY ($self, $builder, $name, $value) =over =item * $builder (Gtk2::Builder) =item * $name (string) =item * $value (scalar) =back This will be called to set the object property I<$name> on I<$self>, directly from the C XML tag. It is not normally necessary to implement this method, as the fallback simply calls C. Gtk2::Window implements this method to delay showing itself (i.e., setting the "visible" property) until the whole interface is created. You can also use this to handle properties that are not wired up through the Glib::Object property system (though simply creating the property is easier). =item parser or undef = CUSTOM_TAG_START ($self, $builder, $child, $tagname) =over =item * $builder (Gtk2::Builder) =item * $child (Glib::Object or undef) =item * $tagname (string) =back When Gtk2::Builder encounters an unknown tag while parsing the definition of I<$self>, it will call C to give your code a chance to do something with it. If I<$tagname> was encountered inside a C tag, the corresponding object will be passed in I<$child>; otherwise, I<$child> will be C. Your C method should decide whether it supports I<$tagname>. If not, return C. If you do support it, return a blessed perl object that implements three special methods to be used to parse that tag. (These methods are defined by GLib's GMarkupParser, which is a simple SAX-style setup.) =over =item START_ELEMENT ($self, $context, $element_name, $attributes) =over =item * $context (Gtk2::Buildable::ParseContext) =item * $element_name (string) =item * $attributes (hash reference) Dictionary of all attributes of this tag. =back =item TEXT ($self, $context, $text) =over =item * $context (Gtk2::Buildable::ParseContext) =item * $text (string) The text contained in the tag. =back =item END_ELEMENT ($self, $context, $element_name) =over =item * $context (Gtk2::Buildable::ParseContext) =item * $element_name (string) =back =back Any blessed perl object that implements these methods is valid as a parser. (Ain't duck-typing great?) Gtk2::Builder will hang on to this object until the parsing is complete, and will pass it to C and C, so you shouldn't have to worry about its lifetime. =item CUSTOM_TAG_END ($self, $builder, $child, $tagname, $parser) =over =item * $builder (Gtk2::Builder) =item * $child (Glib::Object or undef) =item * $tagname (string) =item * $parser (some perl object) as returned from C =back This method will be called (if it exists) when the close tag for I<$tagname> is encountered. I<$parser> will be the object you returned from C. I<$child> is the same object-or-undef as passed to C. =item CUSTOM_FINISHED ($self, $builder, $child, $tagname, $parser) =over =item * $builder (Gtk2::Builder) =item * $child (Glib::Object or undef) =item * $tagname (string) =item * $parser (some perl object) as returned from C =back This method will be called (if it exists) when the parser finishes dealing with the custom tag I<$tagname>. I<$parser> will be the object you returned from C. I<$child> is the same object-or-undef as passed to C. =item PARSER_FINISHED ($self, $builder) =over =item * $builder (Gtk2::Builder) =back If this method exists, it will be invoked when the builder finishes parsing the description data. This method is handy if you need to defer any object initialization until all of the rest of the input is parsed, most likely because you need to refer to an object that is declared after I<$self> or you need to perform special cleanup actions. It is not normally necessary to implement this method. =item object or undef = GET_INTERNAL_CHILD ($self, $builder, $childname) =over =item * $builder (Gtk2::Builder) =item * $childname (string) =back This will be called to fetch an internal child of I<$self>. Implement this method if your buildable has internal children that need to be accessed from a UI definition. For example, Gtk2::Dialog implements this to give access to its internal vbox child. If I<$childname> is unknown then return C. (The builder will then generally report a GError for the UI description referring to an unknown child.) =back =cut =for see_also http://library.gnome.org/devel/gtk/unstable/GtkBuilder.html#BUILDER-UI =cut =for see_also Gtk2::Buildable::ParseContext =cut Gtk2-1.24992/xs/GtkCellRenderer.xs0000644000175000017500000006676713076462677015213 0ustar lacklack/* * Copyright (c) 2003-2004, 2009 by the gtk2-perl team (see the file AUTHORS) * * This library is free software; you can redistribute it and/or * modify it under the terms of the GNU Library General Public * License as published by the Free Software Foundation; either * version 2.1 of the License, or (at your option) any later version. * * This library is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU * Library General Public License for more details. * * You should have received a copy of the GNU Library General Public * License along with this library; if not, write to the * Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, * Boston, MA 02110-1301 USA. * * $Id$ */ #include "gtk2perl.h" static void warn_deprecated (const char * old_and_busted, const char * new_hotness) { static int debugging_on = -1; if (debugging_on < 0) { HV * env = get_hv ("::ENV", FALSE); SV ** v = hv_fetch (env, "GTK2PERL_DEBUG", 14, 0); debugging_on = (v && SvTRUE (*v)); } if (debugging_on) { if (new_hotness) warn ("%s is deprecated, use %s instead", old_and_busted, new_hotness); else warn ("%s is deprecated", old_and_busted); } } #define newSVGChar_ornull(s) \ ((s) ? newSVGChar(s) : newSVsv (&PL_sv_undef)) static void gtk2perl_cell_renderer_class_init (GtkCellRendererClass * class); static void gtk2perl_cell_renderer_get_size (GtkCellRenderer * cell, GtkWidget * widget, GdkRectangle * cell_area, gint * x_offset, gint * y_offset, gint * width, gint * height); static void gtk2perl_cell_renderer_render (GtkCellRenderer * cell, #if GTK_CHECK_VERSION(2,4,0) GdkDrawable * window, #else GdkWindow * window, #endif GtkWidget * widget, GdkRectangle * background_area, GdkRectangle * cell_area, GdkRectangle * expose_area, GtkCellRendererState flags); static gboolean gtk2perl_cell_renderer_activate (GtkCellRenderer * cell, GdkEvent * event, GtkWidget * widget, const gchar * path, GdkRectangle * background_area, GdkRectangle * cell_area, GtkCellRendererState flags); static GtkCellEditable * gtk2perl_cell_renderer_start_editing (GtkCellRenderer * cell, GdkEvent * event, GtkWidget * widget, const gchar * path, GdkRectangle * background_area, GdkRectangle * cell_area, GtkCellRendererState flags); /* * this mangles a CellRendererClass to call the local marshallers. * you should only ever call this on a new subclass of CellRenderer, never * directly on a preexisting CellRendererClass. */ static void gtk2perl_cell_renderer_class_init (GtkCellRendererClass * class) { class->get_size = gtk2perl_cell_renderer_get_size; class->render = gtk2perl_cell_renderer_render; class->activate = gtk2perl_cell_renderer_activate; class->start_editing = gtk2perl_cell_renderer_start_editing; } /* * the following functions look for WHATEVER in the package belonging * to a cell. this is our custom override, since CellRenderer does not * have signals for these virtual methods. */ #define GET_METHOD(cell, method, fallback) \ HV * stash = gperl_object_stash_from_type (G_OBJECT_TYPE (cell)); \ GV * slot = gv_fetchmethod (stash, fallback); \ \ if (slot && GvCV (slot)) \ warn_deprecated (fallback, method); \ else \ slot = gv_fetchmethod (stash, method); static void gtk2perl_cell_renderer_get_size (GtkCellRenderer * cell, GtkWidget * widget, GdkRectangle * cell_area, gint * x_offset, gint * y_offset, gint * width, gint * height) { GET_METHOD (cell, "GET_SIZE", "on_get_size"); if (slot && GvCV (slot)) { int count, i; dSP; ENTER; SAVETMPS; PUSHMARK (SP); EXTEND (SP, 3); PUSHs (sv_2mortal (newSVGtkCellRenderer (cell))); PUSHs (sv_2mortal (newSVGtkWidget (widget))); PUSHs (sv_2mortal (newSVGdkRectangle_ornull (cell_area))); PUTBACK; count = call_sv ((SV *)GvCV (slot), G_ARRAY); SPAGAIN; if (count != 4) croak ("GET_SIZE must return four values -- " "the x_offset, y_offset, width, and height"); i = POPi; if (height) *height = i; i = POPi; if (width) *width = i; i = POPi; if (y_offset) *y_offset = i; i = POPi; if (x_offset) *x_offset = i; PUTBACK; FREETMPS; LEAVE; } } static void gtk2perl_cell_renderer_render (GtkCellRenderer * cell, #if GTK_CHECK_VERSION(2,4,0) GdkDrawable * drawable, #else GdkWindow * drawable, #endif GtkWidget * widget, GdkRectangle * background_area, GdkRectangle * cell_area, GdkRectangle * expose_area, GtkCellRendererState flags) { GET_METHOD (cell, "RENDER", "on_render"); if (slot && GvCV (slot)) { dSP; ENTER; SAVETMPS; PUSHMARK (SP); EXTEND (SP, 7); PUSHs (sv_2mortal (newSVGtkCellRenderer (cell))); PUSHs (sv_2mortal (newSVGdkDrawable_ornull (drawable))); PUSHs (sv_2mortal (newSVGtkWidget_ornull (widget))); PUSHs (sv_2mortal (newSVGdkRectangle_ornull (background_area))); PUSHs (sv_2mortal (newSVGdkRectangle_ornull (cell_area))); PUSHs (sv_2mortal (newSVGdkRectangle_ornull (expose_area))); PUSHs (sv_2mortal (newSVGtkCellRendererState (flags))); PUTBACK; call_sv ((SV *)GvCV (slot), G_VOID|G_DISCARD); FREETMPS; LEAVE; } } static gboolean gtk2perl_cell_renderer_activate (GtkCellRenderer * cell, GdkEvent * event, GtkWidget * widget, const gchar * path, GdkRectangle * background_area, GdkRectangle * cell_area, GtkCellRendererState flags) { gboolean retval = FALSE; GET_METHOD (cell, "ACTIVATE", "on_activate"); if (slot && GvCV (slot)) { dSP; ENTER; SAVETMPS; PUSHMARK (SP); XPUSHs (sv_2mortal (newSVGtkCellRenderer (cell))); XPUSHs (sv_2mortal (newSVGdkEvent_ornull (event))); XPUSHs (sv_2mortal (newSVGtkWidget_ornull (widget))); XPUSHs (sv_2mortal (newSVGChar_ornull (path))); XPUSHs (sv_2mortal (newSVGdkRectangle_ornull (background_area))); XPUSHs (sv_2mortal (newSVGdkRectangle_ornull (cell_area))); XPUSHs (sv_2mortal (newSVGtkCellRendererState (flags))); PUTBACK; call_sv ((SV*) GvCV (slot), G_SCALAR); SPAGAIN; retval = POPi; PUTBACK; FREETMPS; LEAVE; } return retval; } static GtkCellEditable * gtk2perl_cell_renderer_start_editing (GtkCellRenderer * cell, GdkEvent * event, GtkWidget * widget, const gchar * path, GdkRectangle * background_area, GdkRectangle * cell_area, GtkCellRendererState flags) { GtkCellEditable * editable = NULL; GET_METHOD (cell, "START_EDITING", "on_start_editing"); if (slot && GvCV (slot)) { SV * sv; dSP; ENTER; SAVETMPS; PUSHMARK (SP); EXTEND (SP, 7); PUSHs (sv_2mortal (newSVGtkCellRenderer (cell))); PUSHs (sv_2mortal (newSVGdkEvent_ornull (event))); PUSHs (sv_2mortal (newSVGtkWidget_ornull (widget))); PUSHs (sv_2mortal (newSVGChar_ornull (path))); PUSHs (sv_2mortal (newSVGdkRectangle_ornull (background_area))); PUSHs (sv_2mortal (newSVGdkRectangle_ornull (cell_area))); PUSHs (sv_2mortal (newSVGtkCellRendererState (flags))); PUTBACK; call_sv ((SV*) GvCV (slot), G_SCALAR); SPAGAIN; sv = POPs; if (gperl_sv_is_defined (sv)) { editable = SvGtkCellEditable (sv); #if GLIB_CHECK_VERSION (2, 10, 0) /* (*start_editing)() is basically a constructor and * as such should return an object with a floating * reference for the caller to take over. * * For GtkTreeView and GtkIconView for example that * ref is sunk when gtk_tree_view_put() or * gtk_icon_view_put() call gtk_widget_set_parent() * to add "editable" as one of their container * children. (Eventually to be dereffed in the * usual way by gtk_container_remove() from * gtk_tree_view_remove_widget() or * gtk_icon_view_remove_widget() at the end of * editing.) * * Perl code constructors like Gtk2::Foo->new or * Glib::Object->new sink any initial floating * reference when making the wrapper (either if * constructing in the START_EDITING code or from * something made or wrapped previously). So must * explicitly add a floating ref for GtkTreeView etc * to take over. * * If START_EDITING code gives a new object in "sv" * and it's used nowhere else then FREETMPS below * will SvREFCNT_dec it to zero and send it to the * usual Glib::Object::DESTROY. If there wasn't a * floating ref added here on the GObject then that * GObject would be destroyed before we ever got to * return it. With the extra floating ref the * wrapper converts to undead (ie. unused from perl * for the time being) and the GObject has a * refcount of 1 and the floating flag set. * * It's conceivable there could be a floating ref * already at this point. That was the case in the * past from chained-up perl SUPER::START_EDITING * for instance. Though it's abnormal let's assume * any floating ref here is meant for the caller to * take over and therefore should be left unchanged. */ if (! g_object_is_floating (editable)) { g_object_ref (editable); g_object_force_floating (G_OBJECT (editable)); } #else if (! GTK_OBJECT_FLOATING (editable)) { gtk_object_ref (GTK_OBJECT (editable)); GTK_OBJECT_SET_FLAGS (editable, GTK_FLOATING); } #endif } else { editable = NULL; } PUTBACK; FREETMPS; LEAVE; } return editable; } MODULE = Gtk2::CellRenderer PACKAGE = Gtk2::CellRenderer PREFIX = gtk_cell_renderer_ =for object Gtk2::CellRenderer - An object that renders a single cell onto a Gtk2::Gdk::Drawable =cut =for position DESCRIPTION =head1 DESCRIPTION The Gtk2::CellRenderer is the base class for objects which render cells onto drawables. These objects are used primarily by the Gtk2::TreeView, though they aren't tied to them in any specific way. Typically, one cell renderer is used to draw many cells onto the screen. Thus, the cell renderer doesn't keep state; instead, any state is set immediately prior to use through the object property system. The cell is measured with C, and then renderered with C. =cut =for position post_enums =head1 DERIVING NEW CELL RENDERERS Gtk+ provides three cell renderers: Gtk2::CellRendererText, Gtk2::CellRendererToggle, and Gtk2::CellRendererPixbuf. You may derive a new renderer from any of these, or directly from Gtk2::CellRenderer itself. There are a number of rules that must be followed when writing a new cell renderer. First and foremost, it's important that a certain set of properties always yields a cell of the same size, barring a Gtk2::Style change. The cell renderer also has a number of generic properties that are expected to be honored by all children. The new renderer must be a GObject, so you must follow the normal procedure for creating a new Glib::Object (i.e., either Glib::Object::Subclass or Glib::Type::register_object). The new subclass can customize the object's behavior by providing new implementations of these four methods: =over =item (x_offset, y_offset, width, height) = GET_SIZE ($cell, $widget, $cell_area) =over =item o $cell (Gtk2::CellRenderer) =item o $widget (Gtk2::Widget) widget to which I<$cell> is rendering =item o $cell_area (Gtk2::Gdk::Rectangle or undef) The area a cell will be allocated, or undef. =back Return Values: =over =item - x_offset - x offset of cell relative to I<$cell_area> =item - y_offset - y offset of cell relative to I<$cell_area> =item - width - width needed to render cell =item - height - height needed to render cell =back This is called to calculate the size of the cell for display, taking into account the padding and alignment properties of the parent. This one will be called very often. If you need to know your cell's data, then get it from the appropriate object properties, which will be set accordingly before this method is called. =item RENDER ($cell, $drawable, $widget, $background_area, $cell_area, $expose_area, $flags) =over =item o $cell (Gtk2::CellRenderer) =item o $drawable (Gtk2::Gdk::Drawable) window on which to draw =item o $widget (Gtk2::Widget) widget owning I<$drawable> =item o $background_area (Gtk2::Gdk::Rectangle) entire cell area (including tree expanders and maybe padding on the sides) =item o $cell_area (Gtk2::Gdk::Rectangle) area normally rendered by a cell renderer =item o $expose_area (Gtk2::Gdk::Rectangle) area that actually needs updating =item o $flags (Gtk2::CellRendererState) flags that affect rendering =back This is called to render the cell onto the screen. As with GET_SIZE, the data for the cell comes from object properties. In general, you'll want to make use of Gtk2::Style methods for drawing anything fancy. The three passed-in rectangles are areas of I<$drawable>. Most renderers draw within I<$cell_area>; the xalign, yalign, xpad, and ypad fields of the cell renderer should be honored with respect to I<$cell_area>. I<$background_area> includes the blank space around the cell, and also the area containing the tree expander; so the I<$background_area> rectangles for all cells cover the entire I<$drawable>. I<$expose_area> is a clip rectangle. =item boolean = ACTIVATE ($cell, $event, $widget, $path, $background_area, $cell_area, $flags) =over =item o $cell (Gtk2::CellRenderer) =item o $event (Gtk2::Gdk::Event) =item o $widget (Gtk2::Widget) widget that received the event =item o $path (string) widget-dependent string representation of the event location; e.g. for a Gtk2::TreeView, a string representation of a Gtk2::TreePath. =item o $background_area (Gtk2::Gdk::Rectangle) background area as passed to C. =item o $cell_area (Gtk2::Gdk::Rectangle) cell area as passed to C. =item o $flags (Gtk2::CellRendererState) render flags =back This method is called when an event occurs on a cell. Implementing it is not mandatory. The return value should be TRUE if the event was consumed/handled. =item celleditable or undef = START_EDITING ($cell, $event, $widget, $path, $background_area, $cell_area, $flags) =over =item o $cell (Gtk2::CellRenderer) =item o $event (Gtk2::Gdk::Event) =item o $widget (Gtk2::Widget) widget that received the event =item o $path (string) widget-dependent string representation of the event location; e.g. for a Gtk2::TreeView, a string representation of a Gtk2::TreePath. =item o $background_area (Gtk2::Gdk::Rectangle) background area as passed to C. =item o $cell_area (Gtk2::Gdk::Rectangle) cell area as passed to C. =item o $flags (Gtk2::CellRendererState) render flags =back For cells that are editable, this is called to put the cell into editing mode. If the return value is an object is a Gtk2::CellEditable, that widget will be used to edit the value; the calling code takes care of sizing, placing, and showing the editable, you just need to return it. If the return value is undef, the editing is aborted. =back Note: for backward compatibility, the bizarre and non-standard scheme used for this in 1.02x is still supported, but is deprecated and should not be used in new code, and since i don't want people to use it any more i will not document it here. =cut =for flags GtkCellRendererState =cut =for enum GtkCellRendererMode =cut ## void gtk_cell_renderer_set_fixed_size (GtkCellRenderer *cell, gint width, gint height) =for apidoc Set the renderer's size explicitly, independent of object properties. A value of -1 means "don't use a fixed size for this dimension." =cut void gtk_cell_renderer_set_fixed_size (cell, width, height) GtkCellRenderer * cell gint width gint height ## void gtk_cell_renderer_get_fixed_size (GtkCellRenderer *cell, gint *width, gint *height) =for apidoc Fetch the fixed size if I<$cell>. Values of -1 mean "this dimension is not fixed." =cut void gtk_cell_renderer_get_fixed_size (GtkCellRenderer * cell, OUTLIST gint width, OUTLIST gint height) ## void gtk_cell_renderer_get_size (GtkCellRenderer *cell, GtkWidget *widget, GdkRectangle *cell_area, gint *x_offset, gint *y_offset, gint *width, gint *height) =for apidoc =for signature (x_offset, y_offset, width, height) = $cell->get_size ($widget, $cell_area) =cut void gtk_cell_renderer_get_size (cell, widget, cell_area) GtkCellRenderer * cell GtkWidget * widget GdkRectangle_ornull * cell_area PREINIT: gint x_offset; gint y_offset; gint width; gint height; PPCODE: PUTBACK; gtk_cell_renderer_get_size(cell, widget, cell_area, &x_offset, &y_offset, &width, &height); SPAGAIN; EXTEND(SP,4); PUSHs(sv_2mortal(newSViv(x_offset))); PUSHs(sv_2mortal(newSViv(y_offset))); PUSHs(sv_2mortal(newSViv(width))); PUSHs(sv_2mortal(newSViv(height))); ## void gtk_cell_renderer_render (GtkCellRenderer *cell, GdkWindow *window, GtkWidget *widget, GdkRectangle *background_area, GdkRectangle *cell_area, GdkRectangle *expose_area, GtkCellRendererState flags) void gtk_cell_renderer_render (cell, drawable, widget, background_area, cell_area, expose_area, flags) GtkCellRenderer * cell GdkDrawable * drawable GtkWidget * widget GdkRectangle * background_area GdkRectangle * cell_area GdkRectangle * expose_area GtkCellRendererState flags ## gboolean gtk_cell_renderer_activate (GtkCellRenderer *cell, GdkEvent *event, GtkWidget *widget, const gchar *path, GdkRectangle *background_area, GdkRectangle *cell_area, GtkCellRendererState flags) gboolean gtk_cell_renderer_activate (cell, event, widget, path, background_area, cell_area, flags) GtkCellRenderer * cell GdkEvent * event GtkWidget * widget const gchar * path GdkRectangle * background_area GdkRectangle * cell_area GtkCellRendererState flags ## gtk_cell_renderer_start_editing() is normally a constructor, ## returning a widget with a floating ref ready for the caller to take ## over. But the generated typemap for "interface" objects like ## GtkCellEditable only treats it as GObject and doesn't sink when ## making the perl wrapper, so cast up to GtkWidget to get that. ## GtkWidget is a requirement of GtkCellEditable, so "editable" is ## certain to be a widget. ## ## The returned widget is normally about to be put in a container ## anyway, which sinks any floating ref, but sink it now to follow the ## general rule that wrapped widgets at the perl level don't have a ## floating ref left. In particular this means if you start_editing() ## and then strike an error or otherwise never add it to a container ## it won't be a memory leak. ## ##GtkCellEditable* gtk_cell_renderer_start_editing (GtkCellRenderer *cell, GdkEvent *event, GtkWidget *widget, const gchar *path, GdkRectangle *background_area, GdkRectangle *cell_area, GtkCellRendererState flags) =for apidoc =for signature celleditable or undef = $cell->start_editing ($event, $widget, $path, $background_area, $cell_area, $flags) =cut GtkWidget_ornull * gtk_cell_renderer_start_editing (cell, event, widget, path, background_area, cell_area, flags) GtkCellRenderer * cell GdkEvent * event GtkWidget * widget const gchar * path GdkRectangle * background_area GdkRectangle * cell_area GtkCellRendererState flags CODE: RETVAL = GTK_WIDGET (gtk_cell_renderer_start_editing (cell, event, widget, path, background_area, cell_area, flags)); OUTPUT: RETVAL #if GTK_CHECK_VERSION (2, 4, 0) ## void gtk_cell_renderer_editing_canceled (GtkCellRenderer *cell) void gtk_cell_renderer_editing_canceled (cell) GtkCellRenderer *cell #endif #if GTK_CHECK_VERSION (2, 6, 0) void gtk_cell_renderer_stop_editing (GtkCellRenderer *cell, gboolean canceled) #endif #if GTK_CHECK_VERSION (2, 18, 0) gboolean gtk_cell_renderer_get_visible (GtkCellRenderer *cell); void gtk_cell_renderer_set_visible (GtkCellRenderer *cell, gboolean visible); gboolean gtk_cell_renderer_get_sensitive (GtkCellRenderer *cell); void gtk_cell_renderer_set_sensitive (GtkCellRenderer *cell, gboolean sensitive); void gtk_cell_renderer_get_alignment (GtkCellRenderer *cell, OUTLIST gfloat xalign, OUTLIST gfloat yalign); void gtk_cell_renderer_set_alignment (GtkCellRenderer *cell, gfloat xalign, gfloat yalign); void gtk_cell_renderer_get_padding (GtkCellRenderer *cell, OUTLIST gint xpad, OUTLIST gint ypad); void gtk_cell_renderer_set_padding (GtkCellRenderer *cell, gint xpad, gint ypad); #endif /* 2.18 */ ## ## Modify the underlying GObjectClass structure for the given package ## to call Perl methods as virtual overrides for the get_size, render, ## activate, and start_editing vfuncs. The overrides will look for ## methods with all-caps versions of the vfunc names. ## ## This is called automatically by Glib::Type::register_object. ## ## For backward compatibility, we support being called directly as ## _install_overrides; this is deprecated, however. ## =for apidoc Gtk2::CellRenderer::_INSTALL_OVERRIDES __hide__ =cut =for apidoc Gtk2::CellRenderer::_install_overrides __hide__ =cut void _INSTALL_OVERRIDES (const char * package) ALIAS: Gtk2::CellRenderer::_install_overrides = 1 PREINIT: GType gtype; GtkCellRendererClass * class; CODE: PERL_UNUSED_VAR (ix); gtype = gperl_object_type_from_package (package); if (!gtype) croak ("package '%s' is not registered with Gtk2-Perl", package); if (! g_type_is_a (gtype, GTK_TYPE_CELL_RENDERER)) croak ("%s(%s) is not a GtkCellRenderer", package, g_type_name (gtype)); /* peek should suffice, as the bindings should keep this class * alive for us. */ class = g_type_class_peek (gtype); if (! class) croak ("internal problem: can't peek at type class for %s(%d)", g_type_name (gtype), gtype); gtk2perl_cell_renderer_class_init (class); ## ## here we provide a hokey way to chain up from one of the overrides we ## installed above. since the class of an object is determined by looking ## at the bottom of the chain, we can't rely on that to give us the ## class of the parent; so we rely on the package returned by caller(). ## if caller returns nothing useful, then we assume we need to call the ## base method. ## ## For backward compatibility, we support the old parent_foo syntax, although ## the actual call semantics are slightly different. ## =for apidoc Gtk2::CellRenderer::GET_SIZE __hide__ =cut =for apidoc Gtk2::CellRenderer::RENDER __hide__ =cut =for apidoc Gtk2::CellRenderer::ACTIVATE __hide__ =cut =for apidoc Gtk2::CellRenderer::START_EDITING __hide__ =cut =for apidoc Gtk2::CellRenderer::parent_get_size __hide__ =cut =for apidoc Gtk2::CellRenderer::parent_render __hide__ =cut =for apidoc Gtk2::CellRenderer::parent_activate __hide__ =cut =for apidoc Gtk2::CellRenderer::parent_start_editing __hide__ =cut void GET_SIZE (GtkCellRenderer * cell, ...) ALIAS: Gtk2::CellRenderer::RENDER = 1 Gtk2::CellRenderer::ACTIVATE = 2 Gtk2::CellRenderer::START_EDITING = 3 Gtk2::CellRenderer::parent_get_size = 4 Gtk2::CellRenderer::parent_render = 5 Gtk2::CellRenderer::parent_activate = 6 Gtk2::CellRenderer::parent_start_editing = 7 PREINIT: GtkCellRendererClass *parent_class = NULL; GType this, parent; PPCODE: /* look up the parent. * * FIXME: this approach runs into an endless loop with a hierarchy * where a Perl class inherits from a C class which inherits from a * Perl class. Like this: * * ... * +- GtkCellRenderer * +- Foo::RendererOne (Perl subclass) * +- FooRendererTwo (C subclass) * +- Foo::RendererThree (Perl subclass) * * yes, this is contrived. but possible! */ this = G_OBJECT_TYPE (cell); while ((parent = g_type_parent (this))) { if (! g_type_is_a (parent, GTK_TYPE_CELL_RENDERER)) croak ("parent of %s is not a GtkCellRenderer", g_type_name (this)); parent_class = g_type_class_peek (parent); /* check if this class isn't actually one of ours. if it is a * Perl class, then we must not chain up to it: if it had a sub * defined for the current vfunc, we wouldn't be in this * fallback one here since perl's method resolution machinery * would have found and called the sub. so chaining up would * result in the fallback being called again. this will lead * to an endless loop. * * so, if it's not a Perl class, we're done. if it is, * continue in the while loop to the next parent. */ if (parent_class->get_size != gtk2perl_cell_renderer_get_size) { break; } this = parent; } /* the ancestry will always contain GtkCellRenderer, so parent and * parent_class should never be NULL. */ assert (parent != 0 && parent_class != NULL); switch (ix) { case 4: /* deprecated parent_get_size */ case 0: /* GET_SIZE */ if (parent_class->get_size) { gint x_offset, y_offset, width, height; parent_class->get_size (cell, SvGtkWidget (ST (1)), SvGdkRectangle_ornull (ST (2)), &x_offset, &y_offset, &width, &height); EXTEND (SP, 4); PUSHs (sv_2mortal (newSViv (x_offset))); PUSHs (sv_2mortal (newSViv (y_offset))); PUSHs (sv_2mortal (newSViv (width))); PUSHs (sv_2mortal (newSViv (height))); } break; case 5: /* deprecated parent_render */ case 1: /* RENDER */ if (parent_class->render) parent_class->render (cell, SvGdkDrawable_ornull (ST (1)), /* drawable */ SvGtkWidget_ornull (ST (2)), /* widget */ SvGdkRectangle_ornull (ST (3)), /* background_area */ SvGdkRectangle_ornull (ST (4)), /* cell_area */ SvGdkRectangle_ornull (ST (5)), /* expose_area */ SvGtkCellRendererState (ST (6))); /* flags */ break; case 6: /* deprecated parent_activate */ case 2: /* ACTIVATE */ if (parent_class->activate) { gboolean ret; ret = parent_class->activate (cell, SvGdkEvent (ST (1)), SvGtkWidget (ST (2)), SvGChar (ST (3)), SvGdkRectangle_ornull (ST (4)), SvGdkRectangle_ornull (ST (5)), SvGtkCellRendererState (ST (6))); EXTEND (SP, 1); PUSHs (sv_2mortal (newSViv (ret))); } break; case 7: /* deprecated parent_start_editing */ case 3: /* START_EDITING */ if (parent_class->start_editing) { GtkCellEditable * editable; editable = parent_class->start_editing (cell, SvGdkEvent_ornull (ST (1)), SvGtkWidget (ST (2)), SvGChar (ST (3)), SvGdkRectangle_ornull (ST (4)), SvGdkRectangle_ornull (ST (5)), SvGtkCellRendererState (ST (6))); EXTEND (SP, 1); /* Note newSVGtkWidget here instead of * newSVGtkCellEditable so as to take ownership of * any floating ref. See comments with * gtk_cell_renderer_start_editing() above. */ PUSHs (sv_2mortal (newSVGtkWidget_ornull (GTK_WIDGET (editable)))); } break; default: g_assert_not_reached (); } Gtk2-1.24992/xs/GtkSeparatorToolItem.xs0000644000175000017500000000100313076462677016226 0ustar lacklack/* * Copyright (c) 2003 by the gtk2-perl team (see the file AUTHORS) * * Licensed under the LGPL, see LICENSE file for more information. * * $Id$ */ #include "gtk2perl.h" MODULE = Gtk2::SeparatorToolItem PACKAGE = Gtk2::SeparatorToolItem PREFIX = gtk_separator_tool_item_ GtkToolItem *gtk_separator_tool_item_new (class); C_ARGS: /*void*/ gboolean gtk_separator_tool_item_get_draw (GtkSeparatorToolItem *item); void gtk_separator_tool_item_set_draw (GtkSeparatorToolItem *tool_item, gboolean draw); Gtk2-1.24992/xs/GtkEntryCompletion.xs0000644000175000017500000001052313076462677015753 0ustar lacklack/* * Copyright (c) 2003-2005 by the gtk2-perl team (see the file AUTHORS) * * Licensed under the LGPL, see LICENSE file for more information. * * $Id$ */ #include "gtk2perl.h" /* typedef gboolean (* GtkEntryCompletionMatchFunc) (GtkEntryCompletion *completion, const gchar *key, GtkTreeIter *iter, gpointer user_data); */ static gboolean gtk2perl_entry_completion_match_func (GtkEntryCompletion *completion, const gchar *key, GtkTreeIter *iter, gpointer user_data) { GPerlCallback * callback = (GPerlCallback*)user_data; GValue value = {0,}; gboolean ret; g_value_init (&value, G_TYPE_BOOLEAN); gperl_callback_invoke (callback, &value, completion, key, iter); ret = g_value_get_boolean (&value); g_value_unset (&value); return ret; } MODULE = Gtk2::EntryCompletion PACKAGE = Gtk2::EntryCompletion PREFIX = gtk_entry_completion_ # GtkEntryCompletion is a direct GObject descendent, so we need _noinc. GtkEntryCompletion_noinc *gtk_entry_completion_new (class) C_ARGS: /*void*/ GtkWidget *gtk_entry_completion_get_entry (GtkEntryCompletion *entry); void gtk_entry_completion_set_model (GtkEntryCompletion *completion, GtkTreeModel_ornull *model); GtkTreeModel *gtk_entry_completion_get_model (GtkEntryCompletion *completion); ## void gtk_entry_completion_set_match_func (GtkEntryCompletion *completion, GtkEntryCompletionMatchFunc func, gpointer func_data, GDestroyNotify func_notify); void gtk_entry_completion_set_match_func (GtkEntryCompletion *completion, SV * func, SV * func_data=NULL) PREINIT: GType param_types[3]; GPerlCallback * callback; CODE: param_types[0] = GTK_TYPE_ENTRY_COMPLETION; param_types[1] = G_TYPE_STRING; param_types[2] = GTK_TYPE_TREE_ITER; callback = gperl_callback_new (func, func_data, 3, param_types, G_TYPE_BOOLEAN); gtk_entry_completion_set_match_func (completion, gtk2perl_entry_completion_match_func, callback, (GDestroyNotify) gperl_callback_destroy); void gtk_entry_completion_set_minimum_key_length (GtkEntryCompletion *completion, gint length); gint gtk_entry_completion_get_minimum_key_length (GtkEntryCompletion *completion); void gtk_entry_completion_complete (GtkEntryCompletion *completion); void gtk_entry_completion_insert_action_text (GtkEntryCompletion *completion, gint index, const gchar *text); void gtk_entry_completion_insert_action_markup (GtkEntryCompletion *completion, gint index, const gchar *markup); void gtk_entry_completion_delete_action (GtkEntryCompletion *completion, gint index); ## ## /* convenience */ ## void gtk_entry_completion_set_text_column (GtkEntryCompletion *completion, gint column); #if GTK_CHECK_VERSION (2, 6, 0) gint gtk_entry_completion_get_text_column (GtkEntryCompletion *completion); void gtk_entry_completion_insert_prefix (GtkEntryCompletion *completion); void gtk_entry_completion_set_inline_completion (GtkEntryCompletion *completion, gboolean inline_completion); gboolean gtk_entry_completion_get_inline_completion (GtkEntryCompletion *completion); void gtk_entry_completion_set_popup_completion (GtkEntryCompletion *completion, gboolean popup_completion); gboolean gtk_entry_completion_get_popup_completion (GtkEntryCompletion *completion); #endif #if GTK_CHECK_VERSION(2, 8, 0) void gtk_entry_completion_set_popup_set_width (GtkEntryCompletion *completion, gboolean popup_set_width); gboolean gtk_entry_completion_get_popup_set_width (GtkEntryCompletion *completion); void gtk_entry_completion_set_popup_single_match (GtkEntryCompletion *completion, gboolean popup_single_match); gboolean gtk_entry_completion_get_popup_single_match (GtkEntryCompletion *completion); #endif #if GTK_CHECK_VERSION(2, 12, 0) void gtk_entry_completion_set_inline_selection (GtkEntryCompletion *completion, gboolean inline_selection); gboolean gtk_entry_completion_get_inline_selection (GtkEntryCompletion *completion); const gchar_ornull *gtk_entry_completion_get_completion_prefix (GtkEntryCompletion *completion); #endif Gtk2-1.24992/xs/GdkEvent.xs0000644000175000017500000013250113076462677013662 0ustar lacklack/* * Copyright (c) 2003-2006 by the gtk2-perl team (see the file AUTHORS) * * This library is free software; you can redistribute it and/or * modify it under the terms of the GNU Library General Public * License as published by the Free Software Foundation; either * version 2.1 of the License, or (at your option) any later version. * * This library is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU * Library General Public License for more details. * * You should have received a copy of the GNU Library General Public * License along with this library; if not, write to the * Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, * Boston, MA 02110-1301 USA. * * $Id$ */ #include "gtk2perl.h" /* since the GdkEvent is a union, it behaves like a polymorphic structure. gdk provides a couple of functions to return some common values regardless of the type of event, but we need to provide access to pretty much all of the members. thus, i've created a bit of hierarchy within the GdkEvent itself. specialized event types inherit evreything else from Gtk2::Gdk::Event, but add their own methods to provide access to the struct members. by the way, we do everything as opaque types and methods instead of creating a hash like gtk-perl in order to avoid the performance hit of always creating a hash that maybe 20% of client code will ever actually use. */ static const char * gdk_event_get_package (GType gtype, GdkEvent * event) { PERL_UNUSED_VAR (gtype); switch (event->type) { case GDK_NOTHING: case GDK_DELETE: case GDK_DESTROY: case GDK_MAP: case GDK_UNMAP: return "Gtk2::Gdk::Event"; case GDK_EXPOSE: #if GTK_CHECK_VERSION (2, 14, 0) case GDK_DAMAGE: #endif return "Gtk2::Gdk::Event::Expose"; case GDK_MOTION_NOTIFY: return "Gtk2::Gdk::Event::Motion"; case GDK_BUTTON_PRESS: case GDK_2BUTTON_PRESS: case GDK_3BUTTON_PRESS: case GDK_BUTTON_RELEASE: return "Gtk2::Gdk::Event::Button"; case GDK_KEY_PRESS: case GDK_KEY_RELEASE: return "Gtk2::Gdk::Event::Key"; case GDK_ENTER_NOTIFY: case GDK_LEAVE_NOTIFY: return "Gtk2::Gdk::Event::Crossing"; case GDK_FOCUS_CHANGE: return "Gtk2::Gdk::Event::Focus"; case GDK_CONFIGURE: return "Gtk2::Gdk::Event::Configure"; case GDK_PROPERTY_NOTIFY: return "Gtk2::Gdk::Event::Property"; case GDK_SELECTION_CLEAR: case GDK_SELECTION_REQUEST: case GDK_SELECTION_NOTIFY: return "Gtk2::Gdk::Event::Selection"; case GDK_PROXIMITY_IN: case GDK_PROXIMITY_OUT: return "Gtk2::Gdk::Event::Proximity"; case GDK_DRAG_ENTER: case GDK_DRAG_LEAVE: case GDK_DRAG_MOTION: case GDK_DRAG_STATUS: case GDK_DROP_START: case GDK_DROP_FINISHED: return "Gtk2::Gdk::Event::DND"; case GDK_CLIENT_EVENT: return "Gtk2::Gdk::Event::Client"; case GDK_VISIBILITY_NOTIFY: return "Gtk2::Gdk::Event::Visibility"; case GDK_NO_EXPOSE: return "Gtk2::Gdk::Event::NoExpose"; case GDK_SCROLL: return "Gtk2::Gdk::Event::Scroll"; case GDK_WINDOW_STATE: return "Gtk2::Gdk::Event::WindowState"; case GDK_SETTING: return "Gtk2::Gdk::Event::Setting"; #if GTK_CHECK_VERSION (2, 6, 0) case GDK_OWNER_CHANGE: return "Gtk2::Gdk::Event::OwnerChange"; #endif #if GTK_CHECK_VERSION (2, 8, 0) case GDK_GRAB_BROKEN: return "Gtk2::Gdk::Event::GrabBroken"; #endif default: { GEnumClass * class = g_type_class_ref (GDK_TYPE_EVENT_TYPE); GEnumValue * value = g_enum_get_value (class, event->type); if (value) warn ("Unhandled event type %s (%d) in event->type", value->value_name, event->type); else warn ("Unknown value %d in event->type", event->type); g_type_class_unref (class); } return "Gtk2::Gdk::Event"; /* limp along */ } } static void gtk2perl_gdk_event_set_state (GdkEvent * event, GdkModifierType newstate) { if (event) { switch (event->type) { case GDK_MOTION_NOTIFY: event->motion.state = newstate; break; case GDK_BUTTON_PRESS: case GDK_2BUTTON_PRESS: case GDK_3BUTTON_PRESS: case GDK_BUTTON_RELEASE: event->button.state = newstate; break; case GDK_SCROLL: event->scroll.state = newstate; break; case GDK_KEY_PRESS: case GDK_KEY_RELEASE: event->key.state = newstate; break; case GDK_ENTER_NOTIFY: case GDK_LEAVE_NOTIFY: event->crossing.state = newstate; break; case GDK_PROPERTY_NOTIFY: event->property.state = newstate; break; case GDK_VISIBILITY_NOTIFY: /* visibility state is something else. */ case GDK_CLIENT_EVENT: case GDK_NO_EXPOSE: case GDK_CONFIGURE: case GDK_FOCUS_CHANGE: case GDK_SELECTION_CLEAR: case GDK_SELECTION_REQUEST: case GDK_SELECTION_NOTIFY: case GDK_PROXIMITY_IN: case GDK_PROXIMITY_OUT: case GDK_DRAG_ENTER: case GDK_DRAG_LEAVE: case GDK_DRAG_MOTION: case GDK_DRAG_STATUS: case GDK_DROP_START: case GDK_DROP_FINISHED: case GDK_NOTHING: case GDK_DELETE: case GDK_DESTROY: case GDK_EXPOSE: case GDK_MAP: case GDK_UNMAP: case GDK_WINDOW_STATE: case GDK_SETTING: #if GTK_CHECK_VERSION (2, 6, 0) case GDK_OWNER_CHANGE: #endif #if GTK_CHECK_VERSION (2, 8, 0) case GDK_GRAB_BROKEN: #endif #if GTK_CHECK_VERSION (2, 14, 0) case GDK_DAMAGE: #endif /* no state field */ break; } } } static void gtk2perl_gdk_event_set_time (GdkEvent * event, guint32 newtime) { if (event) { switch (event->type) { case GDK_MOTION_NOTIFY: event->motion.time = newtime; break; case GDK_BUTTON_PRESS: case GDK_2BUTTON_PRESS: case GDK_3BUTTON_PRESS: case GDK_BUTTON_RELEASE: event->button.time = newtime; break; case GDK_SCROLL: event->scroll.time = newtime; break; case GDK_KEY_PRESS: case GDK_KEY_RELEASE: event->key.time = newtime; break; case GDK_ENTER_NOTIFY: case GDK_LEAVE_NOTIFY: event->crossing.time = newtime; break; case GDK_PROPERTY_NOTIFY: event->property.time = newtime; break; case GDK_SELECTION_CLEAR: case GDK_SELECTION_REQUEST: case GDK_SELECTION_NOTIFY: event->selection.time = newtime; break; case GDK_PROXIMITY_IN: case GDK_PROXIMITY_OUT: event->proximity.time = newtime; break; case GDK_DRAG_ENTER: case GDK_DRAG_LEAVE: case GDK_DRAG_MOTION: case GDK_DRAG_STATUS: case GDK_DROP_START: case GDK_DROP_FINISHED: event->dnd.time = newtime; break; #if GTK_CHECK_VERSION (2, 6, 0) case GDK_OWNER_CHANGE: event->owner_change.time = newtime; #endif case GDK_CLIENT_EVENT: case GDK_VISIBILITY_NOTIFY: case GDK_NO_EXPOSE: case GDK_CONFIGURE: case GDK_FOCUS_CHANGE: case GDK_NOTHING: case GDK_DELETE: case GDK_DESTROY: case GDK_EXPOSE: case GDK_MAP: case GDK_UNMAP: case GDK_WINDOW_STATE: case GDK_SETTING: #if GTK_CHECK_VERSION (2, 8, 0) case GDK_GRAB_BROKEN: #endif #if GTK_CHECK_VERSION (2, 14, 0) case GDK_DAMAGE: #endif /* no time */ break; } } } /* initialized in the boot section. */ static GPerlBoxedWrapperClass gdk_event_wrapper_class; static GPerlBoxedWrapperClass * default_wrapper_class; static SV * gdk_event_wrap (GType gtype, const char * package, GdkEvent * event, gboolean own) { HV * stash; SV * sv; sv = default_wrapper_class->wrap (gtype, package, event, own); /* we don't really care about the registered package, override it. */ package = gdk_event_get_package (gtype, event); stash = gv_stashpv (package, TRUE); return sv_bless (sv, stash); } static GdkEvent * gdk_event_unwrap (GType gtype, const char * package, SV * sv) { GdkEvent * event = default_wrapper_class->unwrap (gtype, package, sv); /* we don't really care about the registered package, override it. */ package = gdk_event_get_package (gtype, event); if (!sv_derived_from (sv, package)) croak ("%s is not of type %s", gperl_format_variable_for_output (sv), package); return event; } #if !GTK_CHECK_VERSION (2, 2, 0) # define gdk_event_new gtk2perl_gdk_event_new static GdkEvent * gtk2perl_gdk_event_new (GdkEventType type) { GdkEvent ev; memset (&ev, 0, sizeof (GdkEvent)); ev.any.type = type; return gdk_event_copy (&ev); } #endif static void gtk2perl_event_func (GdkEvent *event, gpointer data) { gperl_callback_invoke ((GPerlCallback *) data, NULL, event); } MODULE = Gtk2::Gdk::Event PACKAGE = Gtk2::Gdk PREFIX = gdk_ ## gboolean gdk_events_pending (void) gboolean gdk_events_pending (class) C_ARGS: /*void*/ MODULE = Gtk2::Gdk::Event PACKAGE = Gtk2::Gdk::Event PREFIX = gdk_event_ =head1 EVENT TYPES =over =item * L =item * L =item * L =item * L =item * L =item * L =item * L =item * L =item * L =item * L =item * L =item * L =item * L =item * L =item * L =item * L =item * L =item * L (since gtk+ 2.6) =item * L (since gtk+ 2.8) =back =cut =for enum GdkEventType =cut BOOT: /* GdkEvent is a polymorphic structure, whose actual package * depends on the type member's value. instead of trying to make * a perl developer know about this, we'll bless it into the proper * subclass by overriding the default wrapper behavior. * * note that we expressly wish to keep the GdkEvent as an opaque * type in gtk2-perl for efficiency; converting an event to a * hash is an expensive operation that is usually wasted (based on * experience with gtk-perl). */ default_wrapper_class = gperl_default_boxed_wrapper_class (); gdk_event_wrapper_class = * default_wrapper_class; gdk_event_wrapper_class.wrap = (GPerlBoxedWrapFunc)gdk_event_wrap; gdk_event_wrapper_class.unwrap = (GPerlBoxedUnwrapFunc)gdk_event_unwrap; gperl_register_boxed (GDK_TYPE_EVENT, "Gtk2::Gdk::Event", &gdk_event_wrapper_class); ## GdkEvent* gdk_event_get (void) ## GdkEvent* gdk_event_peek (void) ## caller must free GdkEvent_own_ornull* gdk_event_get (class) ALIAS: peek = 1 C_ARGS: /*void*/ CLEANUP: PERL_UNUSED_VAR (ix); ## GdkEvent* gdk_event_get_graphics_expose (GdkWindow *window) GdkEvent_own_ornull* gdk_event_get_graphics_expose (class, window) GdkWindow *window C_ARGS: window ## void gdk_event_put (GdkEvent *event) ## call as Gtk2::Gdk::Event->put ($event) void gdk_event_put (class, event) GdkEvent *event C_ARGS: event # this didn't actually exist until 2.2.0, when there were some private # things added in Gdk; we provide a custom one on 2.0.x, because we're # nice guys. ## GdkEvent* gdk_event_new (GdkEventType type) ## caller must free GdkEvent_own* gdk_event_new (class, type) GdkEventType type C_ARGS: type ## GdkEvent* gdk_event_copy (GdkEvent *event) GdkEvent_own* gdk_event_copy (event) GdkEvent *event # automatic ## void gdk_event_free (GdkEvent *event) ## guint32 gdk_event_get_time (GdkEvent *event) =for apidoc Gtk2::Gdk::Event::set_time =for signature $event->set_time ($newtime) =for arg ... (hide) =for arg newtime (integer) timestamp =cut # we'll doc this one below with get_time =for apidoc Gtk2::Gdk::Event::time __hide__ =cut =for apidoc =for signature $timestamp = $event->get_time =for signature $timestamp = $event->time =for arg ... (hide) Get I<$event>'s time. If that event type doesn't have a time, or if I<$event> is undef, returns GDK_CURRENT_TIME, which is 0. =cut guint gdk_event_get_time (event, ...) GdkEvent_ornull *event ALIAS: Gtk2::Gdk::Event::time = 1 Gtk2::Gdk::Event::set_time = 2 CODE: if (ix == 0 && items != 1) croak ("Usage: Gtk2::Gdk::Event::get_time (event)"); if (ix == 2 && items != 2) croak ("Usage: Gtk2::Gdk::Event::set_time (event, newtime)"); RETVAL = gdk_event_get_time (event); if (items == 2 || ix == 2) { /* set */ gtk2perl_gdk_event_set_time (event, SvIV (ST (1))); } OUTPUT: RETVAL ## gboolean gdk_event_get_state (GdkEvent *event, GdkModifierType *state) =for apidoc Gtk2::Gdk::Event::set_state =for signature $event->set_state ($newstate) =for arg ... (hide) =for arg newstate (GdkModifierType) =cut # we'll doc this one below with get_state =for apidoc Gtk2::Gdk::Event::state __hide__ =cut =for apidoc =for signature $modifiertype = $event->get_state =for signature $modifiertype = $event->state =for arg ... (hide) Get I<$event>'s state. Croaks if that event type doesn't have a state. =cut GdkModifierType gdk_event_get_state (event, ...) GdkEvent *event ALIAS: Gtk2::Gdk::Event::state = 1 Gtk2::Gdk::Event::set_state = 2 CODE: if (ix == 0 && items != 1) croak ("Usage: Gtk2::Gdk::Event::get_state (event)"); if (ix == 2 && items != 2) croak ("Usage: Gtk2::Gdk::Event::set_state (event, newstate)"); if (items == 2 || ix == 2) { /* set; return old value. */ if (!gdk_event_get_state (event, &RETVAL)) { /* Use pass_unknown to prevent getting the rather * unhelpful "invalid enum value" exception here for * events added in newer gdks than that for which we * were built. If we're going to throw an exception, * it should at least be somewhat meaningful. */ SV * s = gperl_convert_back_enum_pass_unknown (GDK_TYPE_EVENT_TYPE, event->type); croak ("events of type %s have no state member", SvPV_nolen (s)); } gtk2perl_gdk_event_set_state (event, SvGdkModifierType (ST (1))); } else { /* just get */ if (!gdk_event_get_state (event, &RETVAL)) XSRETURN_UNDEF; } OUTPUT: RETVAL =for apidoc Gtk2::Gdk::Event::get_coords =for signature ($x, $y) = $event->get_coords =cut =for apidoc Gtk2::Gdk::Event::coords =for signature ($x, $y) = $event->coords =cut ## gboolean gdk_event_get_coords (GdkEvent *event, gdouble *x_win, gdouble *y_win) void gdk_event_get_coords (event) GdkEvent *event ALIAS: Gtk2::Gdk::Event::coords = 1 PREINIT: gdouble x; gdouble y; PPCODE: if (!gdk_event_get_coords (event, &x, &y)) XSRETURN_EMPTY; PERL_UNUSED_VAR (ix); EXTEND (SP, 2); PUSHs (sv_2mortal (newSVnv (x))); PUSHs (sv_2mortal (newSVnv (y))); =for apidoc Gtk2::Gdk::Event::get_root_coords =for signature ($x_root, $y_root) = $event->get_root_coords =cut =for apidoc Gtk2::Gdk::Event::root_coords =for signature ($x_root, $y_root) = $event->root_coords =cut =for apidoc Gtk2::Gdk::Event::x_root =for signature integer = $event->x_root =cut =for apidoc Gtk2::Gdk::Event::y_root =for signature integer = $event->y_root =cut ## gboolean gdk_event_get_root_coords (GdkEvent *event, gdouble *x_root, gdouble *y_root) void gdk_event_get_root_coords (event) GdkEvent *event ALIAS: Gtk2::Gdk::Event::root_coords = 1 Gtk2::Gdk::Event::x_root = 2 Gtk2::Gdk::Event::y_root = 3 PREINIT: gdouble x_root; gdouble y_root; PPCODE: if (!gdk_event_get_root_coords (event, &x_root, &y_root)) XSRETURN_EMPTY; switch (ix) { case 2: /* x */ PUSHs (sv_2mortal (newSVnv (x_root))); break; case 3: /* y */ PUSHs (sv_2mortal (newSVnv (y_root))); break; default: EXTEND (SP, 2); PUSHs (sv_2mortal (newSVnv (x_root))); PUSHs (sv_2mortal (newSVnv (y_root))); } ## gboolean gdk_event_get_axis (GdkEvent *event, GdkAxisUse axis_use, gdouble *value) gdouble gdk_event_get_axis (event, axis_use) GdkEvent *event GdkAxisUse axis_use ALIAS: Gtk2::Gdk::Event::axis = 1 CODE: PERL_UNUSED_VAR (ix); if (!gdk_event_get_axis (event, axis_use, &RETVAL)) XSRETURN_UNDEF; OUTPUT: RETVAL ## void gdk_event_handler_set (GdkEventFunc func, gpointer data, GDestroyNotify notify) =for apidoc =for arg func (subroutine) function to get called for each event. Set the function that handles all events from GDK. GTK+ uses this to dispatch events, and as such this is rarely of use to applications, unless you are implementing completely custom event dispatching (unlikely) or preprocess events somehow and then pass them on to C. As a special case, if I is undef, we "reset" the handler by passing the actual C function gtk_main_do_event to GDK, to bypass the Perl marshaling (and take things back up to full speed). =cut void gdk_event_handler_set (class, func, data=NULL) SV * func SV * data PREINIT: GPerlCallback *callback; GType params[1]; CODE: params[0] = GDK_TYPE_EVENT; if (gperl_sv_is_defined (func)) { callback = gperl_callback_new (func, data, G_N_ELEMENTS (params), params, 0); gdk_event_handler_set (gtk2perl_event_func, callback, (GDestroyNotify) gperl_callback_destroy); } else { /* reset to gtk+'s event handler. */ gdk_event_handler_set ((GdkEventFunc) gtk_main_do_event, NULL, NULL); } #if GTK_CHECK_VERSION (2,2,0) void gdk_event_set_screen (event, screen) GdkEvent * event GdkScreen * screen GdkScreen * gdk_event_get_screen (event) GdkEvent * event #endif /* have GdkScreen */ ## since we're overriding the package names, Glib::Boxed::DESTROY won't ## be able to find the right destructor, because these new names don't ## correspond to GTypes, and Glib::Boxed::DESTROY tries to find the GType ## from the package into which the SV is blessed. we'll have to explicitly ## tell perl what destructor to use. void DESTROY (sv) SV * sv ALIAS: Gtk2::Gdk::Event::Expose::DESTROY = 1 Gtk2::Gdk::Event::NoExpose::DESTROY = 2 Gtk2::Gdk::Event::Visibility::DESTROY = 3 Gtk2::Gdk::Event::Motion::DESTROY = 4 Gtk2::Gdk::Event::Button::DESTROY = 5 Gtk2::Gdk::Event::Scroll::DESTROY = 6 Gtk2::Gdk::Event::Key::DESTROY = 7 Gtk2::Gdk::Event::Crossing::DESTROY = 8 Gtk2::Gdk::Event::Focus::DESTROY = 9 Gtk2::Gdk::Event::Configure::DESTROY = 10 Gtk2::Gdk::Event::Property::DESTROY = 11 Gtk2::Gdk::Event::Selection::DESTROY = 12 Gtk2::Gdk::Event::Proximity::DESTROY = 13 Gtk2::Gdk::Event::Client::DESTROY = 14 Gtk2::Gdk::Event::Setting::DESTROY = 15 Gtk2::Gdk::Event::WindowState::DESTROY = 16 Gtk2::Gdk::Event::DND::DESTROY = 17 Gtk2::Gdk::Event::OwnerChange::DESTROY = 18 Gtk2::Gdk::Event::GrabBroken::DESTROY = 19 CODE: PERL_UNUSED_VAR (ix); default_wrapper_class->destroy (sv); ## Event types. ## Nothing: No event occurred. ## Delete: A window delete event was sent by the window manager. ## The specified window should be deleted. ## Destroy: A window has been destroyed. ## Expose: Part of a window has been uncovered. ## NoExpose: Same as expose, but no expose event was generated. ## VisibilityNotify: A window has become fully/partially/not obscured. ## MotionNotify: The mouse has moved. ## ButtonPress: A mouse button was pressed. ## ButtonRelease: A mouse button was release. ## KeyPress: A key was pressed. ## KeyRelease: A key was released. ## EnterNotify: A window was entered. ## LeaveNotify: A window was exited. ## FocusChange: The focus window has changed. (The focus window gets ## keyboard events). ## Resize: A window has been resized. ## Map: A window has been mapped. (It is now visible on the screen). ## Unmap: A window has been unmapped. (It is no longer visible on ## the screen). ## Scroll: A mouse wheel was scrolled either up or down. ## OwnerChange: The owner of a clipboard/selection changed. # struct _GdkEventAny # { # GdkEventType type; # GdkWindow *window; # gint8 send_event; # }; GdkEventType type (event) GdkEvent * event CODE: RETVAL = event->any.type; OUTPUT: RETVAL GdkWindow_ornull * window (GdkEvent * event, GdkWindow_ornull * newvalue=NULL) CODE: RETVAL = event->any.window; if (RETVAL) g_object_ref (event->any.window); if (items == 2 && newvalue != event->any.window) { if (event->any.window) g_object_unref (event->any.window); if (newvalue) g_object_ref (newvalue); event->any.window = newvalue; } OUTPUT: RETVAL CLEANUP: if (RETVAL) g_object_unref (RETVAL); gint8 send_event (GdkEvent * event, gint8 newvalue=0) CODE: RETVAL = event->any.send_event; if (items == 2) event->any.send_event = newvalue; OUTPUT: RETVAL MODULE = Gtk2::Gdk::Event PACKAGE = Gtk2::Gdk::Event::Expose =for position post_hierarchy =head1 HIERARCHY Gtk2::Gdk::Event +----Gtk2::Gdk::Event::Expose =cut BOOT: gperl_set_isa ("Gtk2::Gdk::Event::Expose", "Gtk2::Gdk::Event"); #struct _GdkEventExpose #{ #// GdkEventType type; <- GdkEventAny #// GdkWindow *window; <- GdkEventAny #// gint8 send_event; <- GdkEventAny # GdkRectangle area; # GdkRegion *region; # gint count; /* If non-zero, how many more events follow. */ #}; GdkRectangle* area (GdkEvent * eventexpose, GdkRectangle * newvalue=NULL) CODE: RETVAL = &(eventexpose->expose.area); if (items == 2) { eventexpose->expose.area.x = newvalue->x; eventexpose->expose.area.y = newvalue->y; eventexpose->expose.area.width = newvalue->width; eventexpose->expose.area.height = newvalue->height; } OUTPUT: RETVAL GdkRegion_own_ornull * region (GdkEvent * eventexpose, GdkRegion_ornull * newvalue=NULL) CODE: RETVAL = NULL; if (eventexpose->expose.region) RETVAL = gdk_region_copy (eventexpose->expose.region); if (items == 2 && newvalue != eventexpose->expose.region) { if (eventexpose->expose.region) gdk_region_destroy (eventexpose->expose.region); if (newvalue) eventexpose->expose.region = gdk_region_copy (newvalue); else eventexpose->expose.region = NULL; } OUTPUT: RETVAL gint count (GdkEvent * eventexpose, guint newvalue=0) CODE: RETVAL = eventexpose->expose.count; if (items == 2) eventexpose->expose.count = newvalue; OUTPUT: RETVAL MODULE = Gtk2::Gdk::Event PACKAGE = Gtk2::Gdk::Event::NoExpose =for position post_hierarchy =head1 HIERARCHY Gtk2::Gdk::Event +----Gtk2::Gdk::Event::NoExpose =cut BOOT: gperl_set_isa ("Gtk2::Gdk::Event::NoExpose", "Gtk2::Gdk::Event"); #struct _GdkEventNoExpose #{ #// GdkEventType type; <- GdkEventAny #// GdkWindow *window; <- GdkEventAny #// gint8 send_event; <- GdkEventAny #}; MODULE = Gtk2::Gdk::Event PACKAGE = Gtk2::Gdk::Event::Visibility =for position post_hierarchy =head1 HIERARCHY Gtk2::Gdk::Event +----Gtk2::Gdk::Event::Visibility =cut BOOT: gperl_set_isa ("Gtk2::Gdk::Event::Visibility", "Gtk2::Gdk::Event"); #struct _GdkEventVisibility #{ #// GdkEventType type; <- GdkEventAny #// GdkWindow *window; <- GdkEventAny #// gint8 send_event; <- GdkEventAny # GdkVisibilityState state; #}; # different return type, override Gtk2::Gdk::Event::state GdkVisibilityState state (GdkEvent * eventvisibility, GdkVisibilityState newvalue=0) CODE: RETVAL = eventvisibility->visibility.state; if (items == 2) eventvisibility->visibility.state = newvalue; OUTPUT: RETVAL MODULE = Gtk2::Gdk::Event PACKAGE = Gtk2::Gdk::Event::Motion =for position post_hierarchy =head1 HIERARCHY Gtk2::Gdk::Event +----Gtk2::Gdk::Event::Motion =cut BOOT: gperl_set_isa ("Gtk2::Gdk::Event::Motion", "Gtk2::Gdk::Event"); #struct _GdkEventMotion #{ #// GdkEventType type; <- GdkEventAny #// GdkWindow *window; <- GdkEventAny #// gint8 send_event; <- GdkEventAny #// guint32 time; <- gdk_event_get_time # gdouble x; # gdouble y; #// gdouble *axes; <- get_axes #// guint state; <- get_state # gint16 is_hint; # GdkDevice *device; #// gdouble x_root, y_root; <- get_root_coords #}; guint is_hint (GdkEvent * eventmotion, guint newvalue=0) CODE: RETVAL = eventmotion->motion.is_hint; if (items == 2) eventmotion->motion.is_hint = newvalue; OUTPUT: RETVAL GdkDevice_ornull * device (GdkEvent * eventmotion, GdkDevice_ornull * newvalue=NULL) CODE: RETVAL = eventmotion->motion.device; if (items == 2) eventmotion->motion.device = newvalue; OUTPUT: RETVAL gdouble x (GdkEvent * event, gdouble newvalue=0.0) CODE: RETVAL = event->motion.x; if (items == 2) event->motion.x = newvalue; OUTPUT: RETVAL gdouble y (GdkEvent * event, gdouble newvalue=0.0) CODE: RETVAL = event->motion.y; if (items == 2) event->motion.y = newvalue; OUTPUT: RETVAL #if GTK_CHECK_VERSION (2, 12, 0) # void gdk_event_request_motions (GdkEventMotion *event); void request_motions (GdkEvent *event) CODE: gdk_event_request_motions ((GdkEventMotion *) event); #endif MODULE = Gtk2::Gdk::Event PACKAGE = Gtk2::Gdk::Event::Button =for position post_hierarchy =head1 HIERARCHY Gtk2::Gdk::Event +----Gtk2::Gdk::Event::Button =cut BOOT: gperl_set_isa ("Gtk2::Gdk::Event::Button", "Gtk2::Gdk::Event"); #struct _GdkEventButton #{ #// GdkEventType type; <- GdkEventAny #// GdkWindow *window; <- GdkEventAny #// gint8 send_event; <- GdkEventAny #// guint32 time; <- gdk_event_get_time # gdouble x; # gdouble y; #// gdouble *axes; <- get_axes #// guint state; <- get_state # guint button; # GdkDevice *device; #// gdouble x_root, y_root; <- get_root_coords #}; guint button (GdkEvent * eventbutton, guint newvalue=0) CODE: RETVAL = eventbutton->button.button; if (items == 2) eventbutton->button.button = newvalue; OUTPUT: RETVAL GdkDevice_ornull * device (GdkEvent * eventbutton, GdkDevice_ornull * newvalue=NULL) CODE: RETVAL = eventbutton->button.device; if (items == 2) eventbutton->button.device = newvalue; OUTPUT: RETVAL gdouble x (GdkEvent * event, gdouble newvalue=0.0) CODE: RETVAL = event->button.x; if (items == 2) event->button.x = newvalue; OUTPUT: RETVAL gdouble y (GdkEvent * event, gdouble newvalue=0.0) CODE: RETVAL = event->button.y; if (items == 2) event->button.y = newvalue; OUTPUT: RETVAL MODULE = Gtk2::Gdk::Event PACKAGE = Gtk2::Gdk::Event::Scroll =for position post_hierarchy =head1 HIERARCHY Gtk2::Gdk::Event +----Gtk2::Gdk::Event::Scroll =cut BOOT: gperl_set_isa ("Gtk2::Gdk::Event::Scroll", "Gtk2::Gdk::Event"); #struct _GdkEventScroll #{ #// GdkEventType type; <- GdkEventAny #// GdkWindow *window; <- GdkEventAny #// gint8 send_event; <- GdkEventAny #// guint32 time; <- gdk_event_get_time # gdouble x; # gdouble y; #// guint state; <- get_state # GdkScrollDirection direction; # GdkDevice *device; #// gdouble x_root, y_root; <- get_root_coords #}; GdkScrollDirection direction (GdkEvent * eventscroll, GdkScrollDirection newvalue=0) CODE: RETVAL = eventscroll->scroll.direction; if (items == 2) eventscroll->scroll.direction = newvalue; OUTPUT: RETVAL GdkDevice_ornull * device (GdkEvent * eventscroll, GdkDevice_ornull * newvalue=NULL) CODE: RETVAL = eventscroll->scroll.device; if (items == 2) eventscroll->scroll.device = newvalue; OUTPUT: RETVAL gdouble x (GdkEvent * event, gdouble newvalue=0.0) CODE: RETVAL = event->scroll.x; if (items == 2) event->scroll.x = newvalue; OUTPUT: RETVAL gdouble y (GdkEvent * event, gdouble newvalue=0.0) CODE: RETVAL = event->scroll.y; if (items == 2) event->scroll.y = newvalue; OUTPUT: RETVAL MODULE = Gtk2::Gdk::Event PACKAGE = Gtk2::Gdk::Event::Key =for position post_hierarchy =head1 HIERARCHY Gtk2::Gdk::Event +----Gtk2::Gdk::Event::Key =cut BOOT: gperl_set_isa ("Gtk2::Gdk::Event::Key", "Gtk2::Gdk::Event"); #struct _GdkEventKey #{ #// GdkEventType type; <- GdkEventAny #// GdkWindow *window; <- GdkEventAny #// gint8 send_event; <- GdkEventAny #// guint32 time; <- gdk_event_get_time #// guint state; <- get_state # guint keyval; #// gint length; deprecated #// gchar *string; deprecated # guint16 hardware_keycode; # guint8 group; #}; guint keyval (GdkEvent * eventkey, guint newvalue=0) CODE: RETVAL = eventkey->key.keyval; if (items == 2) eventkey->key.keyval = newvalue; OUTPUT: RETVAL guint16 hardware_keycode (GdkEvent * eventkey, guint16 newvalue=0) CODE: RETVAL = eventkey->key.hardware_keycode; if (items == 2) eventkey->key.hardware_keycode = newvalue; OUTPUT: RETVAL guint8 group (GdkEvent * eventkey, guint8 newvalue=0) CODE: RETVAL = eventkey->key.group; if (items == 2) eventkey->key.group = newvalue; OUTPUT: RETVAL MODULE = Gtk2::Gdk::Event PACKAGE = Gtk2::Gdk::Event::Crossing =for position post_hierarchy =head1 HIERARCHY Gtk2::Gdk::Event +----Gtk2::Gdk::Event::Crossing =cut BOOT: gperl_set_isa ("Gtk2::Gdk::Event::Crossing", "Gtk2::Gdk::Event"); #struct _GdkEventCrossing #{ #// GdkEventType type; <- GdkEventAny #// GdkWindow *window; <- GdkEventAny #// gint8 send_event; <- GdkEventAny # GdkWindow *subwindow; #// guint32 time; <- gdk_event_get_time # gdouble x; # gdouble y; #// gdouble x_root; <- get_root_coords #// gdouble y_root; <- get_root_coords # GdkCrossingMode mode; # GdkNotifyType detail; # gboolean focus; #// guint state; <- get_state #}; GdkWindow_ornull * subwindow (GdkEvent * event, GdkWindow_ornull * newvalue=NULL) CODE: RETVAL = event->crossing.subwindow; if (RETVAL) g_object_ref (RETVAL); if (items == 2 && newvalue != event->crossing.subwindow) { if (event->crossing.subwindow) g_object_unref (event->crossing.subwindow); if (newvalue) g_object_ref (newvalue); event->crossing.subwindow = newvalue; } OUTPUT: RETVAL CLEANUP: if (RETVAL) g_object_unref (RETVAL); GdkCrossingMode mode (GdkEvent * eventcrossing, GdkCrossingMode newvalue=0) CODE: RETVAL = eventcrossing->crossing.mode; if (items == 2) eventcrossing->crossing.mode = newvalue; OUTPUT: RETVAL GdkNotifyType detail (GdkEvent * eventcrossing, GdkNotifyType newvalue=0) CODE: RETVAL = eventcrossing->crossing.detail; if (items == 2) eventcrossing->crossing.detail = newvalue; OUTPUT: RETVAL gboolean focus (GdkEvent * eventcrossing, gboolean newvalue=0) CODE: RETVAL = eventcrossing->crossing.focus; if (items == 2) eventcrossing->crossing.focus = newvalue; OUTPUT: RETVAL gdouble x (GdkEvent * event, gdouble newvalue=0.0) CODE: RETVAL = event->crossing.x; if (items == 2) event->crossing.x = newvalue; OUTPUT: RETVAL gdouble y (GdkEvent * event, gdouble newvalue=0.0) CODE: RETVAL = event->crossing.y; if (items == 2) event->crossing.y = newvalue; OUTPUT: RETVAL MODULE = Gtk2::Gdk::Event PACKAGE = Gtk2::Gdk::Event::Focus =for position post_hierarchy =head1 HIERARCHY Gtk2::Gdk::Event +----Gtk2::Gdk::Event::Focus =cut BOOT: gperl_set_isa ("Gtk2::Gdk::Event::Focus", "Gtk2::Gdk::Event"); #struct _GdkEventFocus #{ #// GdkEventType type; <- GdkEventAny #// GdkWindow *window; <- GdkEventAny #// gint8 send_event; <- GdkEventAny # gint16 in; #}; gint16 in (GdkEvent * eventfocus, gint16 newvalue=0) CODE: RETVAL = eventfocus->focus_change.in; if (items == 2) eventfocus->focus_change.in = newvalue; OUTPUT: RETVAL MODULE = Gtk2::Gdk::Event PACKAGE = Gtk2::Gdk::Event::Configure =for position post_hierarchy =head1 HIERARCHY Gtk2::Gdk::Event +----Gtk2::Gdk::Event::Configure =cut BOOT: gperl_set_isa ("Gtk2::Gdk::Event::Configure", "Gtk2::Gdk::Event"); #struct _GdkEventConfigure #{ #// GdkEventType type; <- GdkEventAny #// GdkWindow *window; <- GdkEventAny #// gint8 send_event; <- GdkEventAny # gint x, y; # gint width; # gint height; #}; gint width (GdkEvent * eventconfigure, gint newvalue=0) ALIAS: Gtk2::Gdk::Event::Configure::height = 1 CODE: switch (ix) { case 0: RETVAL = eventconfigure->configure.width; break; case 1: RETVAL = eventconfigure->configure.height; break; default: RETVAL = 0; g_assert_not_reached (); } if (items == 2) { switch (ix) { case 0: eventconfigure->configure.width = newvalue; break; case 1: eventconfigure->configure.height = newvalue; break; default: g_assert_not_reached (); } } OUTPUT: RETVAL gint x (GdkEvent * event, gint newvalue=0) CODE: RETVAL = event->configure.x; if (items == 2) event->configure.x = newvalue; OUTPUT: RETVAL gint y (GdkEvent * event, gint newvalue=0) CODE: RETVAL = event->configure.y; if (items == 2) event->configure.y = newvalue; OUTPUT: RETVAL MODULE = Gtk2::Gdk::Event PACKAGE = Gtk2::Gdk::Event::Property =for position post_hierarchy =head1 HIERARCHY Gtk2::Gdk::Event +----Gtk2::Gdk::Event::Property =cut BOOT: gperl_set_isa ("Gtk2::Gdk::Event::Property", "Gtk2::Gdk::Event"); #struct _GdkEventProperty #{ #// GdkEventType type; <- GdkEventAny #// GdkWindow *window; <- GdkEventAny #// gint8 send_event; <- GdkEventAny # GdkAtom atom; #// guint32 time; <- gdk_event_get_time # guint state; #}; GdkAtom atom (GdkEvent * eventproperty, GdkAtom newvalue=0) CODE: RETVAL = eventproperty->property.atom; if (items == 2) eventproperty->property.atom = newvalue; OUTPUT: RETVAL guint state (GdkEvent * eventproperty, guint newvalue=0) CODE: RETVAL = eventproperty->property.state; if (items == 2) eventproperty->property.state = newvalue; OUTPUT: RETVAL MODULE = Gtk2::Gdk::Event PACKAGE = Gtk2::Gdk::Event::Selection =for position post_hierarchy =head1 HIERARCHY Gtk2::Gdk::Event +----Gtk2::Gdk::Event::Selection =cut BOOT: gperl_set_isa ("Gtk2::Gdk::Event::Selection", "Gtk2::Gdk::Event"); #struct _GdkEventSelection #{ #// GdkEventType type; <- GdkEventAny #// GdkWindow *window; <- GdkEventAny #// gint8 send_event; <- GdkEventAny # GdkAtom selection; # GdkAtom target; # GdkAtom property; #// guint32 time; <- gdk_event_get_time # GdkNativeWindow requestor; #}; GdkAtom selection (GdkEvent * eventselection, GdkAtom newvalue=0) CODE: RETVAL = eventselection->selection.selection; if (items == 2) eventselection->selection.selection = newvalue; OUTPUT: RETVAL GdkAtom target (GdkEvent * eventselection, GdkAtom newvalue=0) CODE: RETVAL = eventselection->selection.target; if (items == 2) eventselection->selection.target = newvalue; OUTPUT: RETVAL GdkAtom property (GdkEvent * eventselection, GdkAtom newvalue=0) CODE: RETVAL = eventselection->selection.property; if (items == 2) eventselection->selection.property = newvalue; OUTPUT: RETVAL GdkNativeWindow requestor (GdkEvent * eventselection, GdkNativeWindow newvalue=0) CODE: RETVAL = eventselection->selection.requestor; if (items == 2) eventselection->selection.requestor = newvalue; OUTPUT: RETVAL MODULE = Gtk2::Gdk::Event PACKAGE = Gtk2::Gdk::Event::Proximity =for position post_hierarchy =head1 HIERARCHY Gtk2::Gdk::Event +----Gtk2::Gdk::Event::Proximity =cut BOOT: gperl_set_isa ("Gtk2::Gdk::Event::Proximity", "Gtk2::Gdk::Event"); #/* This event type will be used pretty rarely. It only is important # for XInput aware programs that are drawing their own cursor */ #struct _GdkEventProximity #{ #// GdkEventType type; <- GdkEventAny #// GdkWindow *window; <- GdkEventAny #// gint8 send_event; <- GdkEventAny #// guint32 time; <- gdk_event_get_time # GdkDevice *device; #}; GdkDevice_ornull * device (GdkEvent * eventproximity, GdkDevice_ornull * newvalue=NULL) CODE: RETVAL = eventproximity->motion.device; if (items == 2) eventproximity->motion.device = newvalue; OUTPUT: RETVAL MODULE = Gtk2::Gdk::Event PACKAGE = Gtk2::Gdk::Event::Client =for position post_hierarchy =head1 HIERARCHY Gtk2::Gdk::Event +----Gtk2::Gdk::Event::Client =cut BOOT: gperl_set_isa ("Gtk2::Gdk::Event::Client", "Gtk2::Gdk::Event"); #struct _GdkEventClient #{ #// GdkEventType type; <- GdkEventAny #// GdkWindow *window; <- GdkEventAny #// gint8 send_event; <- GdkEventAny # GdkAtom message_type; # gushort data_format; # union { # char b[20]; # short s[10]; # long l[5]; # } data; #}; GdkAtom message_type (GdkEvent * eventclient, GdkAtom newvalue=0) CODE: RETVAL = eventclient->client.message_type; if (items == 2) eventclient->client.message_type = newvalue; OUTPUT: RETVAL =for apidoc This should be set to either $Gtk2::Gdk::CHARS, $Gtk2::Gdk::SHORTS, or $Gtk2::Gdk::LONGS. See I for a full explanation. =cut gushort data_format (GdkEvent * eventclient, gushort newvalue=0) CODE: RETVAL = eventclient->client.data_format; if (items == 2) eventclient->client.data_format = newvalue; OUTPUT: RETVAL =for apidoc =for signature old_string = $eventclient->data (string) =for signature old_list = $eventclient->data (list of ten shorts) =for signature old_list = $eventclient->data (list of five longs) Depending on the value of I, I takes one of three different kinds of values: +-------------------+-----------------------+ | data_format | data | +-------------------+-----------------------+ | Gtk2::Gdk::CHARS | a string of length 20 | | Gtk2::Gdk::SHORTS | a list of ten shorts | | Gtk2::Gdk::LONGS | a list of five longs | +-------------------+-----------------------+ =cut void data (GdkEvent * eventclient, ...) PREINIT: int i, first_index = 1; PPCODE: switch (eventclient->client.data_format) { case 8: { if (items == first_index + 1) { char *data = SvPV_nolen (ST (first_index)); char old[20]; for (i = 0; i < 20; i++) { old[i] = eventclient->client.data.b[i]; eventclient->client.data.b[i] = data[i]; } XPUSHs (sv_2mortal (newSVpv (old, 20))); } else { XPUSHs (sv_2mortal (newSVpv (eventclient->client.data.b, 20))); } break; } case 16: { if (items == first_index + 10) { short old[10]; for (i = first_index; i < items; i++) { old[i - first_index] = eventclient->client.data.s[i - first_index]; eventclient->client.data.s[i - first_index] = (gint16) SvIV (ST (i)); } for (i = 0; i < 10; i++) XPUSHs (sv_2mortal (newSViv (old[i]))); } else { for (i = 0; i < 10; i++) XPUSHs (sv_2mortal (newSViv (eventclient->client.data.s[i]))); } break; } case 32: { if (items == first_index + 5) { long old[5]; for (i = first_index; i < items; i++) { old[i - first_index] = eventclient->client.data.l[i - first_index]; eventclient->client.data.l[i - first_index] = SvIV (ST (i)); } for (i = 0; i < 5; i++) XPUSHs (sv_2mortal (newSViv (old[i]))); } else { for (i = 0; i < 5; i++) XPUSHs (sv_2mortal (newSViv (eventclient->client.data.l[i]))); } break; } default: croak ("Illegal format value %d used; should be either 8, 16 or 32", eventclient->client.data_format); } MODULE = Gtk2::Gdk::Event PACKAGE = Gtk2::Gdk::Event::Setting =for position post_hierarchy =head1 HIERARCHY Gtk2::Gdk::Event +----Gtk2::Gdk::Event::Setting =cut BOOT: gperl_set_isa ("Gtk2::Gdk::Event::Setting", "Gtk2::Gdk::Event"); #struct _GdkEventSetting #{ #// GdkEventType type; <- GdkEventAny #// GdkWindow *window; <- GdkEventAny #// gint8 send_event; <- GdkEventAny # GdkSettingAction action; # char *name; #}; GdkSettingAction action (GdkEvent * eventsetting, GdkSettingAction newvalue=0) CODE: RETVAL = eventsetting->setting.action; if (items == 2) eventsetting->setting.action = newvalue; OUTPUT: RETVAL char_ornull * name (GdkEvent * eventsetting, char_ornull * newvalue=NULL) CODE: RETVAL = eventsetting->setting.name; if (items == 2) { if (eventsetting->setting.name) g_free (eventsetting->setting.name); if (newvalue) eventsetting->setting.name = g_strdup (newvalue); else eventsetting->setting.name = NULL; } OUTPUT: RETVAL MODULE = Gtk2::Gdk::Event PACKAGE = Gtk2::Gdk::Event::WindowState =for position post_hierarchy =head1 HIERARCHY Gtk2::Gdk::Event +----Gtk2::Gdk::Event::WindowState =cut BOOT: gperl_set_isa ("Gtk2::Gdk::Event::WindowState", "Gtk2::Gdk::Event"); #struct _GdkEventWindowState #{ #// GdkEventType type; <- GdkEventAny #// GdkWindow *window; <- GdkEventAny #// gint8 send_event; <- GdkEventAny # GdkWindowState changed_mask; # GdkWindowState new_window_state; #}; GdkWindowState changed_mask (GdkEvent * eventwindowstate, GdkWindowState newvalue=0) CODE: RETVAL = eventwindowstate->window_state.changed_mask; if (items == 2) eventwindowstate->window_state.changed_mask = newvalue; OUTPUT: RETVAL GdkWindowState new_window_state (GdkEvent * eventwindowstate, GdkWindowState newvalue=0) CODE: RETVAL = eventwindowstate->window_state.new_window_state; if (items == 2) eventwindowstate->window_state.new_window_state = newvalue; OUTPUT: RETVAL MODULE = Gtk2::Gdk::Event PACKAGE = Gtk2::Gdk::Event::DND =for position post_hierarchy =head1 HIERARCHY Gtk2::Gdk::Event +----Gtk2::Gdk::Event::DND =cut BOOT: gperl_set_isa ("Gtk2::Gdk::Event::DND", "Gtk2::Gdk::Event"); #/* Event types for DND */ #struct _GdkEventDND { #// GdkEventType type; <- GdkEventAny #// GdkWindow *window; <- GdkEventAny #// gint8 send_event; <- GdkEventAny # GdkDragContext *context; #// guint32 time; <- gdk_event_get_time #// gshort x_root, y_root; <- get_root_coords #}; GdkDragContext_ornull * context (GdkEvent * eventdnd, GdkDragContext_ornull * newvalue=NULL) CODE: RETVAL = eventdnd->dnd.context; if (RETVAL) g_object_ref (RETVAL); if (items == 2 && newvalue != eventdnd->dnd.context) { if (eventdnd->dnd.context) g_object_unref (eventdnd->dnd.context); if (newvalue) g_object_ref (newvalue); eventdnd->dnd.context = newvalue; } OUTPUT: RETVAL CLEANUP: if (RETVAL) g_object_unref (RETVAL); #if GTK_CHECK_VERSION (2, 6, 0) MODULE = Gtk2::Gdk::Event PACKAGE = Gtk2::Gdk::Event::OwnerChange =for position post_hierarchy =head1 HIERARCHY Gtk2::Gdk::Event +----Gtk2::Gdk::Event::OwnerChange =cut BOOT: gperl_set_isa ("Gtk2::Gdk::Event::OwnerChange", "Gtk2::Gdk::Event"); # struct _GdkEventOwnerChange # { # GdkEventType type; <- GdkEventAny # GdkWindow *window; <- GdkEventAny # gint8 send_event; <- GdkEventAny # GdkNativeWindow owner; # GdkOwnerChange reason; # GdkAtom selection; # guint32 time; <- gdk_event_get_time # guint32 selection_time; # }; GdkNativeWindow owner (GdkEvent * event, GdkNativeWindow newvalue=0) CODE: RETVAL = event->owner_change.owner; if (items == 2 && newvalue != RETVAL) { event->owner_change.owner = newvalue; } OUTPUT: RETVAL GdkOwnerChange reason (GdkEvent * event, GdkOwnerChange newvalue=0) CODE: RETVAL = event->owner_change.reason; if (items == 2 && newvalue != RETVAL) { event->owner_change.reason = newvalue; } OUTPUT: RETVAL GdkAtom selection (GdkEvent * event, GdkAtom newvalue=0) CODE: RETVAL = event->owner_change.selection; if (items == 2 && newvalue != RETVAL) { event->owner_change.selection = newvalue; } OUTPUT: RETVAL guint32 selection_time (GdkEvent * event, guint32 newvalue=0) CODE: RETVAL = event->owner_change.selection_time; if (items == 2 && newvalue != RETVAL) { event->owner_change.selection_time = newvalue; } OUTPUT: RETVAL #endif # --------------------------------------------------------------------------- # #if GTK_CHECK_VERSION (2, 8, 0) MODULE = Gtk2::Gdk::Event PACKAGE = Gtk2::Gdk::Event::GrabBroken =for position post_hierarchy =head1 HIERARCHY Gtk2::Gdk::Event +----Gtk2::Gdk::Event::GrabBroken =cut BOOT: gperl_set_isa ("Gtk2::Gdk::Event::GrabBroken", "Gtk2::Gdk::Event"); gboolean keyboard (GdkEvent * event, gboolean newvalue=0) CODE: RETVAL = event->grab_broken.keyboard; if (items == 2 && newvalue != RETVAL) event->grab_broken.keyboard = newvalue; OUTPUT: RETVAL gboolean implicit (GdkEvent * event, gboolean newvalue=0) CODE: RETVAL = event->grab_broken.implicit; if (items == 2 && newvalue != RETVAL) event->grab_broken.implicit = newvalue; OUTPUT: RETVAL =for apidoc When you set a window into a GrabBroken event make sure you keep a reference to it for as long as that event object or any copies exist, because the event doesn't add its own reference. =cut GdkWindow_ornull * grab_window (GdkEvent * event, GdkWindow_ornull * newvalue=NULL) CODE: RETVAL = event->grab_broken.grab_window; /* GdkEventGrabBroken doesn't hold a ref on grab_window, so * just plonk the new value in, unlike for any.window above. */ if (items == 2 && newvalue != RETVAL) event->grab_broken.grab_window = newvalue; OUTPUT: RETVAL #endif # --------------------------------------------------------------------------- # MODULE = Gtk2::Gdk::Event PACKAGE = Gtk2::Gdk PREFIX = gdk_ # these are of limited usefulness, as you must have compiled GTK+ # with debugging turned on. void gdk_set_show_events (class, show_events) gboolean show_events C_ARGS: show_events gboolean gdk_get_show_events (class) C_ARGS: /*void*/ # FIXME needs a callback ## void gdk_add_client_message_filter (GdkAtom message_type, GdkFilterFunc func, gpointer data) ##void ##gdk_add_client_message_filter (message_type, func, data) ## GdkAtom message_type ## GdkFilterFunc func ## gpointer data ## gboolean gdk_setting_get (const gchar *name, GValue *value) SV * gdk_setting_get (class, name) const gchar *name PREINIT: GValue value = {0,}; CODE: g_value_init (&value, G_TYPE_INT); if (!gdk_setting_get (name, &value)) XSRETURN_UNDEF; RETVAL = gperl_sv_from_value (&value); g_value_unset (&value); OUTPUT: RETVAL Gtk2-1.24992/xs/GtkRecentManager.xs0000644000175000017500000002504113076462677015334 0ustar lacklack/* * Copyright (C) 2006, 2010 by the gtk2-perl team (see the file AUTHORS for a * complete listing) * * This library is free software; you can redistribute it and/or * modify it under the terms of the GNU Lesser General Public * License as published by the Free Software Foundation; either * version 2 of the License, or (at your option) any later version. * * This library is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU * Lesser General Public License for more details. * * You should have received a copy of the GNU Lesser General Public * License along with this library; if not, write to the * Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, * Boston, MA 02110-1301, USA. */ #include "gtk2perl.h" /* Also used in GtkRecentFilter.xs */ const gchar ** gtk2perl_sv_to_strv (SV *sv) { AV *av; SV **svp; int i; gchar **retval; if (!gperl_sv_is_array_ref (sv)) croak ("invalid groups value - expecting an array reference"); av = (AV *) SvRV (sv); retval = gperl_alloc_temp (sizeof (gchar*) * (av_len (av) + 2)); for (i = 0; i <= av_len (av); i++) if ((svp = av_fetch (av, i, 0))) retval[i] = SvGChar (*svp); retval[i] = NULL; return (const gchar **) retval; } /* Used in GtkRecentFilter.xs */ SV * gtk2perl_sv_from_strv (const gchar **strv) { AV *av; int i; av = newAV (); i = 0; while (strv[i]) av_push (av, newSVGChar (strv[i++])); return newRV_noinc ((SV *) av); } /* struct _GtkRecentData { gchar *display_name; gchar *description; gchar *mime_type; gchar *app_name; gchar *app_exec; gchar **groups; gboolean is_private; }; */ static GtkRecentData * SvGtkRecentData (SV *sv) { GtkRecentData *data; HV *hv; SV **svp; if (!gperl_sv_is_hash_ref (sv)) croak ("invalid recent data - expecting a hash reference"); hv = (HV *) SvRV (sv); data = gperl_alloc_temp (sizeof (GtkRecentData)); if ((svp = hv_fetch (hv, "display_name", 12, 0))) data->display_name = SvGChar (*svp); if ((svp = hv_fetch (hv, "description", 11, 0))) data->description = SvGChar (*svp); if ((svp = hv_fetch (hv, "mime_type", 9, 0))) data->mime_type = SvGChar (*svp); if ((svp = hv_fetch (hv, "app_name", 8, 0))) data->app_name = SvGChar (*svp); if ((svp = hv_fetch (hv, "app_exec", 8, 0))) data->app_exec = SvGChar (*svp); if ((svp = hv_fetch (hv, "is_private", 10, 0))) data->is_private = SvIV (*svp); if ((svp = hv_fetch (hv, "groups", 6, 0))) data->groups = (gchar **) gtk2perl_sv_to_strv (*svp); return data; } MODULE = Gtk2::RecentManager PACKAGE = Gtk2::RecentManager PREFIX = gtk_recent_manager_ =for enum GtkRecentManagerError =cut GtkRecentManager_noinc * gtk_recent_manager_new (class) C_ARGS: /* void */ GtkRecentManager * gtk_recent_manager_get_default (class) C_ARGS: /* void */ GtkRecentManager * gtk_recent_manager_get_for_screen (class, GdkScreen *screen) C_ARGS: screen void gtk_recent_manager_set_screen (GtkRecentManager *manager, GdkScreen *screen) =for apidoc Add I<$uri> to the list of recently used documents. The Gtk2::RecentManager object will try to guess the meta-data of the document from its URI, but if you know it you should use C above. =cut gboolean gtk_recent_manager_add_item (GtkRecentManager *manager, const gchar *uri) =for apidoc Add I<$uri> to the list of recently used documents. Instead of letting the Gtk2::RecentManager object guess the meta-data, use I<$data> to supply it. I<$data> is a hash reference with these keys: =over =item display_name The name to be used when displaying the document inside the recently used documents list. =item description A short description of the document. =item mime_type The MIME type of the document. [Mandatory] =item app_name The name of the application that is registering the document. You might use the same name you used in C (see L). =item app_exec The command line needed to launch the application with the document. You can use the variable C<"%u">, which will be expanded to the document's URI, or the variable C<"%f"> which will be expanded to the document's canonical full path. =item groups An array reference, containing the group names the document belongs to. =item is_private Whether the document should be visible only to the applications and groups that have registered it. =back =cut gboolean gtk_recent_manager_add_full (GtkRecentManager *manager, const gchar *uri, SV *data) C_ARGS: manager, uri, SvGtkRecentData (data) =for apidoc __gerror__ =cut void gtk_recent_manager_remove_item (GtkRecentManager *manager, const gchar *uri) PREINIT: GError *error = NULL; CODE: gtk_recent_manager_remove_item (manager, uri, &error); if (error) gperl_croak_gerror (NULL, error); =for apidoc __gerror__ =cut GtkRecentInfo * gtk_recent_manager_lookup_item (GtkRecentManager *manager, const gchar *uri) PREINIT: GError *error = NULL; CODE: RETVAL = gtk_recent_manager_lookup_item (manager, uri, &error); if (error) gperl_croak_gerror (NULL, error); OUTPUT: RETVAL gboolean gtk_recent_manager_has_item (GtkRecentManager *manager, const gchar *uri) =for apidoc __gerror__ =cut void gtk_recent_manager_move_item (manager, old_uri, new_uri) GtkRecentManager *manager const gchar *old_uri const gchar_ornull *new_uri PREINIT: GError *error = NULL; CODE: gtk_recent_manager_move_item (manager, old_uri, new_uri, &error); if (error) gperl_croak_gerror (NULL, error); void gtk_recent_manager_set_limit (GtkRecentManager *manager, gint limit) gint gtk_recent_manager_get_limit (GtkRecentManager *manager) =for apidoc =for signature (items) = $manager->get_items =cut void gtk_recent_manager_get_items (GtkRecentManager *manager) PREINIT: GList *items, *l; PPCODE: items = gtk_recent_manager_get_items (manager); for (l = items; l != NULL; l = l->next) XPUSHs (sv_2mortal (newSVGtkRecentInfo_own (l->data))); g_list_free (items); =for apidoc __gerror__ =cut gint gtk_recent_manager_purge_items (GtkRecentManager *manager) PREINIT: GError *error = NULL; CODE: RETVAL = gtk_recent_manager_purge_items (manager, &error); if (error) gperl_croak_gerror (NULL, error); OUTPUT: RETVAL # # GtkRecentInfo # MODULE = Gtk2::RecentManager PACKAGE = Gtk2::RecentInfo PREFIX = gtk_recent_info_ # not needed ##GtkRecentInfo *gtk_recent_info_ref (GtkRecentInfo *info); ##void gtk_recent_info_unref (GtkRecentInfo *info); =for apidoc Gtk2::RecentInfo::get_uri =for signature string = $info->get_uri =cut =for apidoc Gtk2::RecentInfo::get_display_name =for signature string = $info->get_display_name =cut =for apidoc Gtk2::RecentInfo::get_description =for signature string = $info->get_description =cut =for apidoc Gtk2::RecentInfo::get_mime_type =for signature string = $info->get_mime_type =cut const gchar * get_uri (GtkRecentInfo *info) ALIAS: Gtk2::RecentInfo::get_uri = 0 Gtk2::RecentInfo::get_display_name = 1 Gtk2::RecentInfo::get_description = 2 Gtk2::RecentInfo::get_mime_type = 3 CODE: switch (ix) { case 0: RETVAL = gtk_recent_info_get_uri (info); break; case 1: RETVAL = gtk_recent_info_get_display_name (info); break; case 2: RETVAL = gtk_recent_info_get_description (info); break; case 3: RETVAL = gtk_recent_info_get_mime_type (info); break; default: RETVAL = NULL; g_assert_not_reached (); } OUTPUT: RETVAL =for apidoc Gtk2::RecentInfo::get_added =for signature timestamp = $info->get_added; cut =for apidoc Gtk2::RecentInfo::get_modified =for signature timestamp = $info->get_modified; cut =for apidoc Gtk2::RecentInfo::get_visited =for signature timestamp = $info->get_visited; =cut time_t get_added (GtkRecentInfo *info) ALIAS: Gtk2::RecentInfo::get_added = 0 Gtk2::RecentInfo::get_modified = 1 Gtk2::RecentInfo::get_visited = 2 CODE: switch (ix) { case 0: RETVAL = gtk_recent_info_get_added (info); break; case 1: RETVAL = gtk_recent_info_get_modified (info); break; case 2: RETVAL = gtk_recent_info_get_visited (info); break; default: RETVAL = (time_t) -1; g_assert_not_reached (); } OUTPUT: RETVAL gboolean gtk_recent_info_get_private_hint (GtkRecentInfo *info) =for apidoc =for signature (exec, count, timestamp) = $info->get_application_info ($app_name) =cut void gtk_recent_info_get_application_info (info, app_name) GtkRecentInfo *info const gchar *app_name PREINIT: const gchar *app_exec; guint count; time_t timestamp; gboolean res; PPCODE: res = gtk_recent_info_get_application_info (info, app_name, &app_exec, &count, ×tamp); if (!res) XSRETURN_EMPTY; EXTEND (SP, 3); PUSHs (sv_2mortal (newSVGChar (app_exec))); PUSHs (sv_2mortal (newSVuv (count))); PUSHs (sv_2mortal (newSViv (timestamp))); =for apidoc =for signature (applications) = $info->get_applications =cut void gtk_recent_info_get_applications (GtkRecentInfo *info) PREINIT: gchar **apps; gsize length, i; PPCODE: apps = gtk_recent_info_get_applications (info, &length); if (length > 0) { EXTEND (SP, length); for (i = 0; i < length; i++) { if (apps[i]) PUSHs (sv_2mortal (newSVGChar (apps[i]))); } g_strfreev (apps); } else XSRETURN_EMPTY; gchar_own * gtk_recent_info_last_application (GtkRecentInfo *info) gboolean gtk_recent_info_has_application (GtkRecentInfo *info, const gchar *app_name) =for apidoc =for signature (groups) = $info->get_groups =cut void gtk_recent_info_get_groups (GtkRecentInfo *info) PREINIT: gchar **groups; gsize length, i; PPCODE: groups = gtk_recent_info_get_groups (info, &length); if (length > 0) { EXTEND (SP, length); for (i = 0; i < length; i++) { if (groups[i]) PUSHs (sv_2mortal (newSVGChar (groups[i]))); } g_strfreev (groups); } else XSRETURN_EMPTY; gboolean gtk_recent_info_has_group (GtkRecentInfo *info, const gchar *group_name) GdkPixbuf_noinc * gtk_recent_info_get_icon (GtkRecentInfo *info, gint size) gchar_own * gtk_recent_info_get_short_name (GtkRecentInfo *info) gchar_own * gtk_recent_info_get_uri_display (GtkRecentInfo *info) gint gtk_recent_info_get_age (GtkRecentInfo *info) gboolean gtk_recent_info_is_local (GtkRecentInfo *info) gboolean gtk_recent_info_exists (GtkRecentInfo *info) gboolean gtk_recent_info_match (GtkRecentInfo *info, GtkRecentInfo *other_info) Gtk2-1.24992/xs/GtkDrawingArea.xs0000644000175000017500000000235013076462677015003 0ustar lacklack/* * Copyright (c) 2003 by the gtk2-perl team (see the file AUTHORS) * * This library is free software; you can redistribute it and/or * modify it under the terms of the GNU Library General Public * License as published by the Free Software Foundation; either * version 2.1 of the License, or (at your option) any later version. * * This library is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU * Library General Public License for more details. * * You should have received a copy of the GNU Library General Public * License along with this library; if not, write to the * Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, * Boston, MA 02110-1301 USA. * * $Id$ */ #include "gtk2perl.h" MODULE = Gtk2::DrawingArea PACKAGE = Gtk2::DrawingArea PREFIX = gtk_drawing_area_ ## GtkWidget* gtk_drawing_area_new (void) GtkWidget * gtk_drawing_area_new (class) C_ARGS: /* void */ ## void gtk_drawing_area_size (GtkDrawingArea *darea, gint width, gint height) void gtk_drawing_area_size (darea, width, height) GtkDrawingArea * darea gint width gint height Gtk2-1.24992/xs/GtkEventBox.xs0000644000175000017500000000255013076462677014353 0ustar lacklack/* * Copyright (c) 2003 by the gtk2-perl team (see the file AUTHORS) * * This library is free software; you can redistribute it and/or * modify it under the terms of the GNU Library General Public * License as published by the Free Software Foundation; either * version 2.1 of the License, or (at your option) any later version. * * This library is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU * Library General Public License for more details. * * You should have received a copy of the GNU Library General Public * License along with this library; if not, write to the * Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, * Boston, MA 02110-1301 USA. * * $Id$ */ #include "gtk2perl.h" MODULE = Gtk2::EventBox PACKAGE = Gtk2::EventBox PREFIX = gtk_event_box_ ## GtkWidget* gtk_event_box_new (void) GtkWidget * gtk_event_box_new (class) C_ARGS: /* void */ #if GTK_CHECK_VERSION(2,4,0) gboolean gtk_event_box_get_visible_window (GtkEventBox *event_box); void gtk_event_box_set_visible_window (GtkEventBox *event_box, gboolean visible_window); gboolean gtk_event_box_get_above_child (GtkEventBox *event_box); void gtk_event_box_set_above_child (GtkEventBox *event_box, gboolean above_child); #endif Gtk2-1.24992/xs/GtkIconTheme.xs0000644000175000017500000002040613076462677014474 0ustar lacklack/* * Copyright (C) 2003 by the gtk2-perl team (see the file AUTHORS for a * complete listing) * * This library is free software; you can redistribute it and/or * modify it under the terms of the GNU Lesser General Public * License as published by the Free Software Foundation; either * version 2 of the License, or (at your option) any later version. * * This library is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU * Lesser General Public License for more details. * * You should have received a copy of the GNU Lesser General Public * License along with this library; if not, write to the * Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, * Boston, MA 02110-1301, USA. */ #include "gtk2perl.h" MODULE = Gtk2::IconTheme PACKAGE = Gtk2::IconTheme PREFIX = gtk_icon_theme_ =for flags GtkIconLookupFlags =cut =for enum GtkIconThemeError =cut GtkIconTheme_noinc * gtk_icon_theme_new (class) C_ARGS: /*void*/ GtkIconTheme *gtk_icon_theme_get_default (class) C_ARGS: /*void*/ GtkIconTheme * gtk_icon_theme_get_for_screen (class, GdkScreen *screen) C_ARGS: screen void gtk_icon_theme_set_screen (GtkIconTheme *icon_theme, GdkScreen *screen); ## void gtk_icon_theme_set_search_path (GtkIconTheme *icon_theme, const gchar *path[], gint n_elements); void gtk_icon_theme_set_search_path (GtkIconTheme *icon_theme, ...) PREINIT: const gchar ** path = NULL; gint n_elements, i; CODE: n_elements = items - 1; path = gperl_alloc_temp (sizeof (gchar*) * n_elements + 1); for (i = 0 ; i < n_elements ; i++) path[i] = gperl_filename_from_sv (ST (i + 1)); gtk_icon_theme_set_search_path (icon_theme, path, n_elements); ## void gtk_icon_theme_get_search_path (GtkIconTheme *icon_theme, gchar **path[], gint *n_elements); void gtk_icon_theme_get_search_path (GtkIconTheme *icon_theme) PREINIT: gchar ** path = NULL; gint n_elements, i; PPCODE: gtk_icon_theme_get_search_path (icon_theme, &path, &n_elements); EXTEND (SP, n_elements); for (i = 0; i < n_elements; i++) PUSHs (sv_2mortal (gperl_sv_from_filename (path[i]))); g_strfreev (path); ## void gtk_icon_theme_append_search_path (GtkIconTheme *icon_theme, const gchar *path); void gtk_icon_theme_append_search_path (GtkIconTheme *icon_theme, GPerlFilename_const path); ## void gtk_icon_theme_prepend_search_path (GtkIconTheme *icon_theme, const gchar *path); void gtk_icon_theme_prepend_search_path (GtkIconTheme *icon_theme, GPerlFilename_const path); =for apidoc Cannot be used on a C returned by Gtk2::IconTheme->get_default or Gtk2::IconTheme->get_for_screen. =cut void gtk_icon_theme_set_custom_theme (GtkIconTheme *icon_theme, const gchar_ornull *theme_name); gboolean gtk_icon_theme_has_icon (GtkIconTheme *icon_theme, const gchar *icon_name); GtkIconInfo_own_ornull * gtk_icon_theme_lookup_icon (GtkIconTheme *icon_theme, const gchar *icon_name, gint size, GtkIconLookupFlags flags); ## GdkPixbuf * gtk_icon_theme_load_icon (GtkIconTheme *icon_theme, const gchar *icon_name, gint size, GtkIconLookupFlags flags, GError **error); =for apidoc __gerror__ =cut GdkPixbuf_noinc_ornull * gtk_icon_theme_load_icon (GtkIconTheme *icon_theme, const gchar *icon_name, gint size, GtkIconLookupFlags flags) PREINIT: GError * error = NULL; CODE: RETVAL = gtk_icon_theme_load_icon (icon_theme, icon_name, size, flags, &error); if (!RETVAL) gperl_croak_gerror (NULL, error); OUTPUT: RETVAL ## GList * gtk_icon_theme_list_icons (GtkIconTheme *icon_theme, const gchar *context); void gtk_icon_theme_list_icons (GtkIconTheme * icon_theme, const gchar_ornull * context) PREINIT: GList * list, * i; PPCODE: list = gtk_icon_theme_list_icons (icon_theme, context); for (i = list ; i != NULL ; i = i->next) { XPUSHs (sv_2mortal (newSVGChar (i->data))); g_free (i->data); } g_list_free (list); ## char * gtk_icon_theme_get_example_icon_name (GtkIconTheme *icon_theme); gchar_own_ornull * gtk_icon_theme_get_example_icon_name (GtkIconTheme *icon_theme); gboolean gtk_icon_theme_rescan_if_needed (GtkIconTheme *icon_theme); void gtk_icon_theme_add_builtin_icon (class, const gchar *icon_name, gint size, GdkPixbuf *pixbuf); C_ARGS: icon_name, size, pixbuf #if GTK_CHECK_VERSION (2, 6, 0) ## gint * gtk_icon_theme_get_icon_sizes (GtkIconTheme *icon_theme, const gchar *icon_name); void gtk_icon_theme_get_icon_sizes (GtkIconTheme *icon_theme, const gchar *icon_name); PREINIT: gint *result = NULL, *shadow = NULL; gint size; PPCODE: shadow = result = gtk_icon_theme_get_icon_sizes (icon_theme, icon_name); if (result) { /* The list is 0-terminated, so we loop over it until we get a 0. */ while (0 != (size = *(result++))) XPUSHs (sv_2mortal (newSViv (size))); g_free (shadow); } #endif #if GTK_CHECK_VERSION (2, 12, 0) # GList * gtk_icon_theme_list_contexts (GtkIconTheme *icon_theme); void gtk_icon_theme_list_contexts (GtkIconTheme *icon_theme) PREINIT: GList *list, *i; PPCODE: list = gtk_icon_theme_list_contexts (icon_theme); for (i = list; i != NULL; i = i->next) { XPUSHs (sv_2mortal (newSVGChar (i->data))); g_free (i->data); } g_list_free (list); # GtkIconInfo * gtk_icon_theme_choose_icon (GtkIconTheme *icon_theme, const gchar *icon_names[], gint size, GtkIconLookupFlags flags); GtkIconInfo_own_ornull * gtk_icon_theme_choose_icon (GtkIconTheme *icon_theme, SV *icon_names, gint size, GtkIconLookupFlags flags) PREINIT: gchar **names; AV *av; int length, i; CODE: if (!gperl_sv_is_array_ref (icon_names)) croak ("icon_names must be an array reference of icon names"); av = (AV *) SvRV (icon_names); length = av_len (av) + 1; names = g_new0 (gchar *, length + 1); for (i = 0; i < length; i++) { SV **sv = av_fetch (av, i, 0); names[i] = sv && gperl_sv_is_defined (*sv) ? SvPV_nolen (*sv) : ""; } names[length] = NULL; RETVAL = gtk_icon_theme_choose_icon ( icon_theme, (const char **) names, size, flags); g_free (names); OUTPUT: RETVAL #endif MODULE = Gtk2::IconTheme PACKAGE = Gtk2::IconInfo PREFIX = gtk_icon_info_ ## don't need to bind these -- they are automagical ## GType gtk_icon_info_get_type (void); ## GtkIconInfo *gtk_icon_info_copy (GtkIconInfo *icon_info); ## void gtk_icon_info_free (GtkIconInfo *icon_info); gint gtk_icon_info_get_base_size (GtkIconInfo *icon_info); const gchar_ornull *gtk_icon_info_get_filename (GtkIconInfo *icon_info); GdkPixbuf_ornull * gtk_icon_info_get_builtin_pixbuf (GtkIconInfo *icon_info); ## GdkPixbuf * gtk_icon_info_load_icon (GtkIconInfo *icon_info, GError **error); =for apidoc __gerror__ =cut GdkPixbuf_noinc_ornull * gtk_icon_info_load_icon (GtkIconInfo *icon_info) PREINIT: GError *error = NULL; CODE: RETVAL = gtk_icon_info_load_icon (icon_info, &error); if (!RETVAL) gperl_croak_gerror (NULL, error); OUTPUT: RETVAL void gtk_icon_info_set_raw_coordinates (GtkIconInfo *icon_info, gboolean raw_coordinates); ## gboolean gtk_icon_info_get_embedded_rect (GtkIconInfo *icon_info, GdkRectangle *rectangle); GdkRectangle_copy * gtk_icon_info_get_embedded_rect (GtkIconInfo *icon_info) PREINIT: GdkRectangle rectangle; CODE: if (!gtk_icon_info_get_embedded_rect (icon_info, &rectangle)) XSRETURN_UNDEF; RETVAL = &rectangle; OUTPUT: RETVAL ## gboolean gtk_icon_info_get_attach_points (GtkIconInfo *icon_info, GdkPoint **points, gint *n_points); =for apidoc Returns the attach points as an interleaved list of x and y coordinates. =cut void gtk_icon_info_get_attach_points (GtkIconInfo *icon_info) PREINIT: GdkPoint *points = NULL; gint n_points; PPCODE: if (gtk_icon_info_get_attach_points (icon_info, &points, &n_points)) { int i; EXTEND (SP, n_points * 2); for (i = 0 ; i < n_points ; i++) { PUSHs (sv_2mortal (newSViv (points[i].x))); PUSHs (sv_2mortal (newSViv (points[i].y))); } g_free (points); } const gchar_ornull *gtk_icon_info_get_display_name (GtkIconInfo *icon_info); #if GTK_CHECK_VERSION (2, 14, 0) ## GtkIconInfo* gtk_icon_info_new_for_pixbuf (GtkIconTheme *icon_theme, GdkPixbuf *pixbuf) GtkIconInfo_own * gtk_icon_info_new_for_pixbuf (class, GtkIconTheme *icon_theme, GdkPixbuf *pixbuf) C_ARGS: icon_theme, pixbuf #endif /* 2.14 */ Gtk2-1.24992/xs/GtkListItem.xs0000644000175000017500000000421713076462677014355 0ustar lacklack/* * Copyright (c) 2003 by the gtk2-perl team (see the file AUTHORS) * * This library is free software; you can redistribute it and/or * modify it under the terms of the GNU Library General Public * License as published by the Free Software Foundation; either * version 2.1 of the License, or (at your option) any later version. * * This library is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU * Library General Public License for more details. * * You should have received a copy of the GNU Library General Public * License along with this library; if not, write to the * Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, * Boston, MA 02110-1301 USA. * * $Id$ * * NOTE: GtkList and GtkListItem are deprecated and only included b/c GtkCombo * still makes use of them, they are subject to removal at any point so you * should not utilize them unless absolutly necessary.) * */ #include "gtk2perl.h" MODULE = Gtk2::ListItem PACKAGE = Gtk2::ListItem PREFIX = gtk_list_item_ =for position DESCRIPTION =head1 DESCRIPTION Gtk2::ListItem is the widget used for each item in a Gtk2::List. Gtk2::List and Gtk2::ListItem are deprecated; use Gtk2::TreeView and a Gtk2::ListStore instead. Gtk2::ListItem is included in Gtk2-Perl only because Gtk2::Combo contains a Gtk2::List, and Gtk2::Combo's replacement, Gtk2::ComboBox, didn't appear in gtk+ until 2.4.0. =cut #ifdef GTK_TYPE_LIST_ITEM ## GtkWidget* gtk_list_item_new (void) ## GtkWidget* gtk_list_item_new_with_label (const gchar *label) GtkWidget * gtk_list_item_new (class, label=NULL) gchar * label ALIAS: Gtk2::ListItem::new_with_label = 1 CODE: PERL_UNUSED_VAR (ix); if( label ) RETVAL = gtk_list_item_new_with_label(label); else RETVAL = gtk_list_item_new(); OUTPUT: RETVAL ## void gtk_list_item_select (GtkListItem *list_item) void gtk_list_item_select (list_item) GtkListItem * list_item ## void gtk_list_item_deselect (GtkListItem *list_item) void gtk_list_item_deselect (list_item) GtkListItem * list_item #endif Gtk2-1.24992/xs/GdkPixbufLoader.xs0000644000175000017500000000775113076462677015175 0ustar lacklack/* * Copyright (c) 2003 by the gtk2-perl team (see the file AUTHORS) * * This library is free software; you can redistribute it and/or * modify it under the terms of the GNU Library General Public * License as published by the Free Software Foundation; either * version 2.1 of the License, or (at your option) any later version. * * This library is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU * Library General Public License for more details. * * You should have received a copy of the GNU Library General Public * License along with this library; if not, write to the * Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, * Boston, MA 02110-1301 USA. * * $Id$ */ #include "gtk2perl.h" MODULE = Gtk2::Gdk::PixbufLoader PACKAGE = Gtk2::Gdk::PixbufLoader PREFIX = gdk_pixbuf_loader_ ## GdkPixbufLoader * gdk_pixbuf_loader_new (void) GdkPixbufLoader_noinc * gdk_pixbuf_loader_new (class) C_ARGS: /* void */ ## GdkPixbufLoader * gdk_pixbuf_loader_new_with_type (const char *image_type, GError **error) =for apidoc __gerror__ =for signature pixbufloader = Gtk2::Gdk::PixbufLoader->new_with_type ($image_type) =cut GdkPixbufLoader_noinc * gdk_pixbuf_loader_new_with_type (...) PREINIT: const char *image_type; GError * error = NULL; CODE: if (items == 1) image_type = SvPV_nolen (ST (0)); else if (items == 2) image_type = SvPV_nolen (ST (1)); else croak ("Usage: Gtk2::Gdk::PixbufLoader::new_with_type (class, image_type)"); RETVAL = gdk_pixbuf_loader_new_with_type (image_type, &error); if (!RETVAL) gperl_croak_gerror (NULL, error); OUTPUT: RETVAL #if GTK_CHECK_VERSION(2,4,0) ## GdkPixbufLoader * gdk_pixbuf_loader_new_with_mime_type (const char *mime_type, GError **error); =for apidoc __gerror__ =for signature pixbufloader = Gtk2::Gdk::PixbufLoader->new_with_mime_type ($mime_type) =cut GdkPixbufLoader_noinc * gdk_pixbuf_loader_new_with_mime_type (...) PREINIT: const char *mime_type; GError * error = NULL; CODE: if (items == 1) mime_type = SvPV_nolen (ST (0)); else if (items == 2) mime_type = SvPV_nolen (ST (1)); else croak ("Usage: Gtk2::Gdk::PixbufLoader::new_with_mime_type (class, mime_type)"); RETVAL = gdk_pixbuf_loader_new_with_mime_type (mime_type, &error); if (!RETVAL) gperl_croak_gerror (NULL, error); OUTPUT: RETVAL #endif #if GTK_CHECK_VERSION(2,2,0) ## void gdk_pixbuf_loader_set_size (GdkPixbufLoader *loader, int width, int height) void gdk_pixbuf_loader_set_size (loader, width, height) GdkPixbufLoader *loader int width int height #endif /* >= 2.2.0 */ ## gboolean gdk_pixbuf_loader_write (GdkPixbufLoader *loader, const guchar *buf, gsize count, GError **error) =for apidoc __gerror__ =cut gboolean gdk_pixbuf_loader_write (loader, buf) GdkPixbufLoader *loader SV * buf PREINIT: GError * error = NULL; STRLEN length; const guchar *data = (const guchar *) SvPVbyte (buf, length); CODE: RETVAL = gdk_pixbuf_loader_write (loader, data, length, &error); if (!RETVAL) gperl_croak_gerror (NULL, error); OUTPUT: RETVAL ## GdkPixbuf * gdk_pixbuf_loader_get_pixbuf (GdkPixbufLoader *loader) GdkPixbuf * gdk_pixbuf_loader_get_pixbuf (loader) GdkPixbufLoader *loader ## GdkPixbufAnimation * gdk_pixbuf_loader_get_animation (GdkPixbufLoader *loader) GdkPixbufAnimation_ornull * gdk_pixbuf_loader_get_animation (loader) GdkPixbufLoader *loader ## gboolean gdk_pixbuf_loader_close (GdkPixbufLoader *loader, GError **error) =for apidoc __gerror__ =cut void gdk_pixbuf_loader_close (loader) GdkPixbufLoader *loader PREINIT: GError * error = NULL; CODE: if (!gdk_pixbuf_loader_close (loader, &error)) gperl_croak_gerror (NULL, error); #if GTK_CHECK_VERSION(2,2,0) ## GdkPixbufFormat *gdk_pixbuf_loader_get_format (GdkPixbufLoader *loader) GdkPixbufFormat * gdk_pixbuf_loader_get_format (loader) GdkPixbufLoader *loader #endif /* >= 2.2.0 */ Gtk2-1.24992/xs/GtkOptionMenu.xs0000644000175000017500000000270613076462677014721 0ustar lacklack/* * Copyright (c) 2003 by the gtk2-perl team (see the file AUTHORS) * * This library is free software; you can redistribute it and/or * modify it under the terms of the GNU Library General Public * License as published by the Free Software Foundation; either * version 2.1 of the License, or (at your option) any later version. * * This library is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU * Library General Public License for more details. * * You should have received a copy of the GNU Library General Public * License along with this library; if not, write to the * Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, * Boston, MA 02110-1301 USA. * * $Id$ */ #include "gtk2perl.h" MODULE = Gtk2::OptionMenu PACKAGE = Gtk2::OptionMenu PREFIX = gtk_option_menu_ =for deprecated_by Gtk2::ComboBox =cut GtkWidget * gtk_option_menu_new (class) C_ARGS: /* void */ GtkWidget * gtk_option_menu_get_menu (option_menu) GtkOptionMenu * option_menu void gtk_option_menu_set_menu (option_menu, menu) GtkOptionMenu * option_menu GtkWidget * menu void gtk_option_menu_remove_menu (option_menu) GtkOptionMenu *option_menu gint gtk_option_menu_get_history (option_menu) GtkOptionMenu *option_menu void gtk_option_menu_set_history (option_menu, index) GtkOptionMenu *option_menu guint index Gtk2-1.24992/xs/GtkTreeView.xs0000644000175000017500000007237013076462677014362 0ustar lacklack/* * Copyright (c) 2003-2006 by the gtk2-perl team (see the file AUTHORS) * * This library is free software; you can redistribute it and/or * modify it under the terms of the GNU Library General Public * License as published by the Free Software Foundation; either * version 2.1 of the License, or (at your option) any later version. * * This library is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU * Library General Public License for more details. * * You should have received a copy of the GNU Library General Public * License along with this library; if not, write to the * Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, * Boston, MA 02110-1301 USA. * * $Id$ */ #include "gtk2perl.h" /* handlers for GtkTreeCellDataFunc, defined in GtkTreeViewColumn.xs */ GPerlCallback * gtk2perl_tree_cell_data_func_create (SV * func, SV *data); void gtk2perl_tree_cell_data_func (GtkTreeViewColumn * tree_column, GtkCellRenderer * cell, GtkTreeModel * tree_model, GtkTreeIter * iter, gpointer data); static GPerlCallback * gtk2perl_tree_view_column_drop_func_create (SV * func, SV *data) { GType param_types [4]; param_types[0] = GTK_TYPE_TREE_VIEW; param_types[1] = GTK_TYPE_TREE_VIEW_COLUMN; param_types[2] = GTK_TYPE_TREE_VIEW_COLUMN; param_types[3] = GTK_TYPE_TREE_VIEW_COLUMN; return gperl_callback_new (func, data, G_N_ELEMENTS (param_types), param_types, G_TYPE_BOOLEAN); } static gboolean gtk2perl_tree_view_column_drop_func (GtkTreeView * tree_view, GtkTreeViewColumn * column, GtkTreeViewColumn * prev_column, GtkTreeViewColumn * next_column, gpointer data) { GPerlCallback * callback = (GPerlCallback*)data; GValue value = {0,}; gboolean retval; g_value_init (&value, callback->return_type); gperl_callback_invoke (callback, &value, tree_view, column, prev_column, next_column); retval = g_value_get_boolean (&value); g_value_unset (&value); return retval; } static GPerlCallback * gtk2perl_tree_view_mapping_func_create (SV * func, SV *data) { GType param_types [2]; param_types[0] = GTK_TYPE_TREE_VIEW; param_types[1] = GTK_TYPE_TREE_PATH; return gperl_callback_new (func, data, G_N_ELEMENTS (param_types), param_types, 0); } static void gtk2perl_tree_view_mapping_func (GtkTreeView * tree_view, GtkTreePath * tree_path, gpointer data) { gperl_callback_invoke ((GPerlCallback*)data, NULL, tree_view, tree_path); } static GPerlCallback * gtk2perl_tree_view_search_equal_func_create (SV * func, SV *data) { GType param_types [4]; param_types[0] = GTK_TYPE_TREE_MODEL; param_types[1] = GTK_TYPE_INT; param_types[2] = G_TYPE_STRING; param_types[3] = GTK_TYPE_TREE_ITER; return gperl_callback_new (func, data, G_N_ELEMENTS (param_types), param_types, G_TYPE_BOOLEAN); } static gboolean gtk2perl_tree_view_search_equal_func (GtkTreeModel * model, gint column, const gchar * key, GtkTreeIter * iter, gpointer data) { GPerlCallback * callback = (GPerlCallback*)data; GValue value = {0,}; gboolean retval; g_value_init (&value, callback->return_type); gperl_callback_invoke (callback, &value, model, column, key, iter); retval = g_value_get_boolean (&value); g_value_unset (&value); return retval; } #if 0 /* see commentary above gtk_tree_view_set_destroy_count_func() for details on * why this is commented out. */ static GPerlCallback * gtk2perl_tree_view_destroy_count_func_create (SV * func, SV *data) { GType param_types[3]; param_types[0] = GTK_TYPE_TREE_VIEW; param_types[1] = GTK_TYPE_TREE_PATH; param_types[2] = GTK_TYPE_INT; return gperl_callback_new (func, data, G_N_ELEMENTS(param_types), param_types, 0); } static void gtk2perl_tree_view_destroy_count_func (GtkTreeView * tree_view, GtkTreePath * path, gint children, gpointer data) { gperl_callback_invoke ((GPerlCallback*)data, NULL, tree_view, path, children); } #endif #if GTK_CHECK_VERSION (2, 6, 0) /* Also used in GtkComboBox.xs. */ GPerlCallback * gtk2perl_tree_view_row_separator_func_create (SV * func, SV * data) { GType param_types[2]; param_types[0] = GTK_TYPE_TREE_MODEL; param_types[1] = GTK_TYPE_TREE_ITER; return gperl_callback_new (func, data, G_N_ELEMENTS (param_types), param_types, G_TYPE_BOOLEAN); } gboolean gtk2perl_tree_view_row_separator_func (GtkTreeModel *model, GtkTreeIter *iter, gpointer data) { GPerlCallback * callback = (GPerlCallback *) data; GValue value = {0, }; gboolean retval; g_value_init (&value, callback->return_type); gperl_callback_invoke (callback, &value, model, iter); retval = g_value_get_boolean (&value); g_value_unset (&value); return retval; } #endif /* 2.6.0 */ #if GTK_CHECK_VERSION (2, 10, 0) static GPerlCallback * gtk2perl_tree_view_search_position_func_create (SV * func, SV * data) { GType param_types[2]; param_types[0] = GTK_TYPE_TREE_VIEW; param_types[1] = GTK_TYPE_WIDGET; return gperl_callback_new (func, data, G_N_ELEMENTS (param_types), param_types, G_TYPE_NONE); } static void gtk2perl_tree_view_search_position_func (GtkTreeView *tree_view, GtkWidget *search_dialog, gpointer user_data) { gperl_callback_invoke ((GPerlCallback *) user_data, NULL, tree_view, search_dialog); } #endif /* 2.10 */ MODULE = Gtk2::TreeView PACKAGE = Gtk2::TreeView PREFIX = gtk_tree_view_ =for enum GtkTreeViewDropPosition =cut BOOT: /* gperl_set_isa ("Gtk2::TreeView", "Gtk2::Atk::ImplementorIface"); */ GtkWidget * gtk_tree_view_new (class, model=NULL) GtkTreeModel * model CODE: if (model) RETVAL = gtk_tree_view_new_with_model (model); else RETVAL = gtk_tree_view_new (); OUTPUT: RETVAL GtkWidget * gtk_tree_view_new_with_model (class, model) GtkTreeModel * model C_ARGS: model GtkTreeModel_ornull * gtk_tree_view_get_model (tree_view) GtkTreeView * tree_view void gtk_tree_view_set_model (tree_view, model) GtkTreeView *tree_view GtkTreeModel_ornull *model GtkTreeSelection* gtk_tree_view_get_selection (tree_view) GtkTreeView * tree_view GtkAdjustment_ornull * gtk_tree_view_get_hadjustment (tree_view) GtkTreeView *tree_view GtkAdjustment_ornull * gtk_tree_view_get_vadjustment (tree_view) GtkTreeView *tree_view void gtk_tree_view_set_hadjustment (tree_view, adjustment) GtkTreeView *tree_view GtkAdjustment_ornull *adjustment void gtk_tree_view_set_vadjustment (tree_view, adjustment) GtkTreeView *tree_view GtkAdjustment_ornull *adjustment gboolean gtk_tree_view_get_headers_visible (tree_view) GtkTreeView *tree_view void gtk_tree_view_set_headers_visible (tree_view, headers_visible) GtkTreeView *tree_view gboolean headers_visible void gtk_tree_view_columns_autosize (tree_view) GtkTreeView *tree_view void gtk_tree_view_set_headers_clickable (tree_view, setting) GtkTreeView *tree_view gboolean setting void gtk_tree_view_set_rules_hint (tree_view, setting) GtkTreeView *tree_view gboolean setting gboolean gtk_tree_view_get_rules_hint (tree_view) GtkTreeView *tree_view gint gtk_tree_view_append_column (tree_view, column) GtkTreeView *tree_view GtkTreeViewColumn *column gint gtk_tree_view_remove_column (tree_view, column) GtkTreeView *tree_view GtkTreeViewColumn *column gint gtk_tree_view_insert_column (tree_view, column, position) GtkTreeView *tree_view GtkTreeViewColumn *column gint position ## gint gtk_tree_view_insert_column_with_attributes (GtkTreeView *tree_view, gint position, const gchar *title, GtkCellRenderer *cell, ...) ### this is implemented in GtkTreeViewColumn.xs so it can get access to ### a static helper function used to parse the stack for attributes. #### gint gtk_tree_view_insert_column_with_data_func (GtkTreeView *tree_view, gint position, const gchar *title, GtkCellRenderer *cell, GtkTreeCellDataFunc func, gpointer data, GDestroyNotify dnotify) =for apidoc =for arg func (subroutine) Insert a column that calls I<$func> every time it needs to fetch the data for a cell. I<$func> will get a cell renderer, the tree model, and the iter of the row in question, and should set the proper value into the cell renderer. =cut gint gtk_tree_view_insert_column_with_data_func (tree_view, position, title, cell, func, data=NULL) GtkTreeView *tree_view gint position const gchar *title GtkCellRenderer *cell SV * func SV * data PREINIT: GPerlCallback * callback; CODE: callback = gtk2perl_tree_cell_data_func_create (func, data); RETVAL = gtk_tree_view_insert_column_with_data_func (tree_view, position, title, cell, gtk2perl_tree_cell_data_func, callback, (GDestroyNotify) gperl_callback_destroy); OUTPUT: RETVAL GtkTreeViewColumn * gtk_tree_view_get_column (tree_view, n) GtkTreeView * tree_view gint n =for apidoc Returns an array of columns. =cut void gtk_tree_view_get_columns (tree_view) GtkTreeView * tree_view PREINIT: GList * columns, * i; PPCODE: columns = gtk_tree_view_get_columns (tree_view); if (!columns) XSRETURN_EMPTY; EXTEND (SP, (int) g_list_length (columns)); for (i = columns ; i ; i = i->next) PUSHs (sv_2mortal (newSVGtkTreeViewColumn (GTK_TREE_VIEW_COLUMN (i->data)))); g_list_free (columns); void gtk_tree_view_move_column_after (tree_view, column, base_column) GtkTreeView *tree_view GtkTreeViewColumn *column GtkTreeViewColumn_ornull *base_column void gtk_tree_view_set_expander_column (tree_view, column) GtkTreeView *tree_view GtkTreeViewColumn_ornull *column GtkTreeViewColumn_ornull * gtk_tree_view_get_expander_column (tree_view) GtkTreeView *tree_view #### void gtk_tree_view_set_column_drag_function (GtkTreeView *tree_view, GtkTreeViewColumnDropFunc func, gpointer user_data, GtkDestroyNotify destroy) void gtk_tree_view_set_column_drag_function (tree_view, func, data=NULL) GtkTreeView *tree_view SV * func SV * data PREINIT: GtkTreeViewColumnDropFunc real_func; gpointer real_data; GtkDestroyNotify destroy; CODE: if (gperl_sv_is_defined (func)) { real_func = gtk2perl_tree_view_column_drop_func; real_data = gtk2perl_tree_view_column_drop_func_create (func, data); destroy = (GDestroyNotify) gperl_callback_destroy; } else { real_func = real_data = destroy = NULL; } gtk_tree_view_set_column_drag_function (tree_view, real_func, real_data, destroy); #### also allow undef instead of -1 to specify no scrolling ## void gtk_tree_view_scroll_to_point (GtkTreeView *tree_view, gint tree_x, gint tree_y) void gtk_tree_view_scroll_to_point (tree_view, tree_x, tree_y) GtkTreeView *tree_view SV * tree_x SV * tree_y PREINIT: gint real_tree_x = -1; gint real_tree_y = -1; CODE: /* can't do SvTRUE, because 0 is defined but not true. */ real_tree_x = gperl_sv_is_defined (tree_x) && looks_like_number (tree_x) ? SvIV (tree_x) : -1; real_tree_y = gperl_sv_is_defined (tree_y) && looks_like_number (tree_y) ? SvIV (tree_y) : -1; gtk_tree_view_scroll_to_point (tree_view, real_tree_x, real_tree_y); void gtk_tree_view_scroll_to_cell (tree_view, path, column=NULL, use_align=FALSE, row_align=0.0, col_align=0.0) GtkTreeView *tree_view GtkTreePath_ornull *path GtkTreeViewColumn_ornull *column gboolean use_align gfloat row_align gfloat col_align void gtk_tree_view_row_activated (tree_view, path, column) GtkTreeView *tree_view GtkTreePath *path GtkTreeViewColumn *column void gtk_tree_view_expand_all (tree_view) GtkTreeView *tree_view void gtk_tree_view_collapse_all (tree_view) GtkTreeView *tree_view #if GTK_CHECK_VERSION(2,2,0) void gtk_tree_view_expand_to_path (tree_view, path) GtkTreeView *tree_view GtkTreePath *path #endif /* >= 2.2.0 */ gboolean gtk_tree_view_expand_row (tree_view, path, open_all) GtkTreeView *tree_view GtkTreePath *path gboolean open_all gboolean gtk_tree_view_collapse_row (tree_view, path) GtkTreeView *tree_view GtkTreePath *path #### void gtk_tree_view_map_expanded_rows (GtkTreeView *tree_view, GtkTreeViewMappingFunc func, gpointer data) void gtk_tree_view_map_expanded_rows (tree_view, func, data=NULL) GtkTreeView *tree_view SV * func SV * data PREINIT: GPerlCallback * callback; CODE: callback = gtk2perl_tree_view_mapping_func_create (func, data); gtk_tree_view_map_expanded_rows (tree_view, gtk2perl_tree_view_mapping_func, callback); gperl_callback_destroy (callback); gboolean gtk_tree_view_row_expanded (tree_view, path) GtkTreeView *tree_view GtkTreePath *path void gtk_tree_view_set_reorderable (tree_view, reorderable) GtkTreeView *tree_view gboolean reorderable gboolean gtk_tree_view_get_reorderable (tree_view) GtkTreeView *tree_view void gtk_tree_view_set_cursor (tree_view, path, focus_column=NULL, start_editing=FALSE) GtkTreeView *tree_view GtkTreePath *path GtkTreeViewColumn_ornull *focus_column gboolean start_editing #if GTK_CHECK_VERSION(2,2,0) void gtk_tree_view_set_cursor_on_cell (tree_view, path, focus_column, focus_cell, start_editing) GtkTreeView *tree_view GtkTreePath *path GtkTreeViewColumn_ornull *focus_column GtkCellRenderer_ornull *focus_cell gboolean start_editing #endif /* >= 2.2.0 */ ## void gtk_tree_view_get_cursor (GtkTreeView *tree_view, GtkTreePath **path, GtkTreeViewColumn **focus_column) =for apidoc =for signature (path, focus_column) = $tree_view->get_cursor Returns the Gtk2::TreePath and Gtk2::TreeViewColumn of the cell with the keyboard focus cursor. Either may be undef. =cut void gtk_tree_view_get_cursor (tree_view) GtkTreeView *tree_view PREINIT: GtkTreePath *path = NULL; GtkTreeViewColumn *focus_column = NULL; PPCODE: gtk_tree_view_get_cursor (tree_view, &path, &focus_column); EXTEND (SP, 2); PUSHs (sv_2mortal (newSVGtkTreePath_own_ornull (path))); PUSHs (sv_2mortal (newSVGtkTreeViewColumn_ornull (focus_column))); #### gboolean gtk_tree_view_get_path_at_pos (GtkTreeView *tree_view, gint x, gint y, GtkTreePath **path, GtkTreeViewColumn **column, gint *cell_x, gint *cell_y) =for apidoc =for signature path = $tree_view->get_path_at_pos ($x, $y) =for signature (path, column, cell_x, cell_y) = $tree_view->get_path_at_pos ($x, $y) Finds the path at the point (I<$x>, I<$y>), relative to widget coordinates. That is, I<$x> and I<$y> are relative to an event's coordinates. I<$x> and I<$y> must come from an event on the I<$tree_view> only where C<$event-Ewindow == $tree_view-Eget_bin_window>. It is primarily for things like popup menus. In scalar context, returns the Gtk2::TreePath, in array context, adds the Gtk2::TreeViewColumn, and I<$x> and I<$y> translated to be relative to the cell. This function is only meaningful if I<$tree_view> is realized. =cut void gtk_tree_view_get_path_at_pos (tree_view, x, y) GtkTreeView *tree_view gint x gint y PREINIT: GtkTreePath *path; GtkTreeViewColumn *column; gint cell_x; gint cell_y; PPCODE: if (!gtk_tree_view_get_path_at_pos (tree_view, x, y, &path, &column, &cell_x, &cell_y)) XSRETURN_EMPTY; XPUSHs (sv_2mortal (newSVGtkTreePath_own (path))); if (GIMME_V == G_ARRAY) { XPUSHs (sv_2mortal (newSVGtkTreeViewColumn (column))); XPUSHs (sv_2mortal (newSViv (cell_x))); XPUSHs (sv_2mortal (newSViv (cell_y))); } ### void gtk_tree_view_get_cell_area (GtkTreeView *tree_view, GtkTreePath *path, GtkTreeViewColumn *column, GdkRectangle *rect) GdkRectangle_copy * gtk_tree_view_get_cell_area (tree_view, path, column) GtkTreeView *tree_view GtkTreePath_ornull *path GtkTreeViewColumn_ornull *column PREINIT: GdkRectangle rect; CODE: gtk_tree_view_get_cell_area (tree_view, path, column, &rect); RETVAL = ▭ OUTPUT: RETVAL ### void gtk_tree_view_get_background_area (GtkTreeView *tree_view, GtkTreePath *path, GtkTreeViewColumn *column, GdkRectangle *rect) GdkRectangle_copy * gtk_tree_view_get_background_area (tree_view, path, column) GtkTreeView *tree_view GtkTreePath_ornull *path GtkTreeViewColumn_ornull *column PREINIT: GdkRectangle rect; CODE: gtk_tree_view_get_background_area (tree_view, path, column, &rect); RETVAL = ▭ OUTPUT: RETVAL ### void gtk_tree_view_get_visible_rect (GtkTreeView *tree_view, GdkRectangle *visible_rect) GdkRectangle_copy * gtk_tree_view_get_visible_rect (tree_view) GtkTreeView *tree_view PREINIT: GdkRectangle visible_rect; CODE: gtk_tree_view_get_visible_rect (tree_view, &visible_rect); RETVAL = &visible_rect; OUTPUT: RETVAL ### GdkWindow* gtk_tree_view_get_bin_window (GtkTreeView *tree_view); GdkWindow * gtk_tree_view_get_bin_window (tree_view) GtkTreeView *tree_view #### void gtk_tree_view_widget_to_tree_coords (GtkTreeView *tree_view, gint wx, gint wy, gint *tx, gint *ty) void gtk_tree_view_widget_to_tree_coords (GtkTreeView *tree_view, gint wx, gint wy, OUTLIST gint tx, OUTLIST gint ty) #### void gtk_tree_view_tree_to_widget_coords (GtkTreeView *tree_view, gint tx, gint ty, gint *wx, gint *wy) void gtk_tree_view_tree_to_widget_coords (GtkTreeView *tree_view, gint tx, gint ty, OUTLIST gint wx, OUTLIST gint wy) GdkPixmap * gtk_tree_view_create_row_drag_icon (GtkTreeView * tree_view, GtkTreePath * path); #### void gtk_tree_view_enable_model_drag_source (GtkTreeView *tree_view, GdkModifierType start_button_mask, const GtkTargetEntry *targets, gint n_targets, GdkDragAction actions) =for apidoc =for arg ... of Gtk2::TargetEntry's =cut void gtk_tree_view_enable_model_drag_source (tree_view, start_button_mask, actions, ...) GtkTreeView *tree_view GdkModifierType start_button_mask GdkDragAction actions PREINIT: GtkTargetEntry * targets = NULL; gint n_targets, i; CODE: #define FIRST_TARGET 3 n_targets = items - FIRST_TARGET; targets = g_new (GtkTargetEntry, n_targets); for (i = 0 ; i < n_targets ; i++) gtk2perl_read_gtk_target_entry (ST (i+FIRST_TARGET), targets+i); gtk_tree_view_enable_model_drag_source (tree_view, start_button_mask, targets, n_targets, actions); #undef FIRST_TARGET CLEANUP: g_free (targets); #### void gtk_tree_view_enable_model_drag_dest (GtkTreeView *tree_view, const GtkTargetEntry *targets, gint n_targets, GdkDragAction actions) =for apidoc =for arg ... of Gtk2::TargetEntry's =cut void gtk_tree_view_enable_model_drag_dest (tree_view, actions, ...) GtkTreeView *tree_view GdkDragAction actions PREINIT: GtkTargetEntry * targets = NULL; gint n_targets, i; CODE: #define FIRST_TARGET 2 n_targets = items - FIRST_TARGET; targets = g_new (GtkTargetEntry, n_targets); for (i = 0 ; i < n_targets ; i++) gtk2perl_read_gtk_target_entry (ST (i+FIRST_TARGET), targets+i); gtk_tree_view_enable_model_drag_dest (tree_view, targets, n_targets, actions); #undef FIRST_TARGET CLEANUP: g_free (targets); #### void gtk_tree_view_unset_rows_drag_source (GtkTreeView *tree_view) void gtk_tree_view_unset_rows_drag_source (tree_view) GtkTreeView *tree_view #### void gtk_tree_view_unset_rows_drag_dest (GtkTreeView *tree_view) void gtk_tree_view_unset_rows_drag_dest (tree_view) GtkTreeView *tree_view #### void gtk_tree_view_set_drag_dest_row (GtkTreeView *tree_view, GtkTreePath *path, GtkTreeViewDropPosition pos) void gtk_tree_view_set_drag_dest_row (tree_view, path, pos) GtkTreeView *tree_view GtkTreePath_ornull *path GtkTreeViewDropPosition pos #### void gtk_tree_view_get_drag_dest_row (GtkTreeView *tree_view, GtkTreePath **path, GtkTreeViewDropPosition *pos) =for apidoc =for signature (path, dropposition) = $tree_view->get_drag_dest_row =cut void gtk_tree_view_get_drag_dest_row (tree_view) GtkTreeView *tree_view PREINIT: GtkTreePath *path; GtkTreeViewDropPosition pos; PPCODE: gtk_tree_view_get_drag_dest_row (tree_view, &path, &pos); EXTEND (SP, 2); PUSHs (sv_2mortal (newSVGtkTreePath_own (path))); PUSHs (sv_2mortal (newSVGtkTreeViewDropPosition (pos))); #### gboolean gtk_tree_view_get_dest_row_at_pos (GtkTreeView *tree_view, gint drag_x, gint drag_y, GtkTreePath **path, GtkTreeViewDropPosition *pos) =for apidoc =for signature (path, dropposition) = $tree_view->get_dest_row_at_pos ($drag_x, $drag_y) =cut void gtk_tree_view_get_dest_row_at_pos (tree_view, drag_x, drag_y) GtkTreeView *tree_view gint drag_x gint drag_y PREINIT: GtkTreePath *path; GtkTreeViewDropPosition pos; PPCODE: if (!gtk_tree_view_get_dest_row_at_pos (tree_view, drag_x, drag_y, &path, &pos)) XSRETURN_EMPTY; EXTEND (SP, 2); PUSHs (sv_2mortal (newSVGtkTreePath_own (path))); PUSHs (sv_2mortal (newSVGtkTreeViewDropPosition (pos))); ## void gtk_tree_view_set_enable_search (GtkTreeView *tree_view, gboolean enable_search) void gtk_tree_view_set_enable_search (tree_view, enable_search) GtkTreeView *tree_view gboolean enable_search ## gboolean gtk_tree_view_get_enable_search (GtkTreeView *tree_view) gboolean gtk_tree_view_get_enable_search (tree_view) GtkTreeView *tree_view ## gint gtk_tree_view_get_search_column (GtkTreeView *tree_view) gint gtk_tree_view_get_search_column (tree_view) GtkTreeView *tree_view ## void gtk_tree_view_set_search_column (GtkTreeView *tree_view, gint column) void gtk_tree_view_set_search_column (tree_view, column) GtkTreeView *tree_view gint column # there are issues of major badness with this. if you come up with a # solution that won't be rickety and dangerous, go for it. #### GtkTreeViewSearchEqualFunc gtk_tree_view_get_search_equal_func (GtkTreeView *tree_view) ##GtkTreeViewSearchEqualFunc ##gtk_tree_view_get_search_equal_func (tree_view) ## GtkTreeView *tree_view #### void gtk_tree_view_set_search_equal_func (GtkTreeView *tree_view, GtkTreeViewSearchEqualFunc search_equal_func, gpointer search_user_data, GtkDestroyNotify search_destroy) =for apidoc =for arg func (subroutine) =cut void gtk_tree_view_set_search_equal_func (tree_view, func, data=NULL) GtkTreeView *tree_view SV * func SV * data PREINIT: GPerlCallback * callback; CODE: callback = gtk2perl_tree_view_search_equal_func_create (func, data); gtk_tree_view_set_search_equal_func (tree_view, gtk2perl_tree_view_search_equal_func, callback, (GDestroyNotify) gperl_callback_destroy); #### according to the documentation, this function "should almost never be #### used", and is exported for ATK. i'll leave it out. ###### void gtk_tree_view_set_destroy_count_func (GtkTreeView *tree_view, GtkTreeDestroyCountFunc func, gpointer data, GtkDestroyNotify destroy) ##void ##gtk_tree_view_set_destroy_count_func (tree_view, func, data=NULL) ## GtkTreeView *tree_view ## SV * func ## SV * data ## PREINIT: ## GPerlCallback * callback; ## CODE: ## callback = gtk2perl_tree_view_destroy_count_func_create (func, data); ## gtk_tree_view_set_destroy_count_func (tree_view, ## gtk2perl_tree_view_destroy_count_func, ## callback, ## (GDestroyNotify) gperl_callback_destroy); #if GTK_CHECK_VERSION(2, 6, 0) void gtk_tree_view_set_fixed_height_mode (GtkTreeView *treeview, gboolean enable); gboolean gtk_tree_view_get_fixed_height_mode (GtkTreeView *treeview); void gtk_tree_view_set_hover_selection (GtkTreeView *treeview, gboolean hover); gboolean gtk_tree_view_get_hover_selection (GtkTreeView *treeview); void gtk_tree_view_set_hover_expand (GtkTreeView *treeview, gboolean expand); gboolean gtk_tree_view_get_hover_expand (GtkTreeView *treeview); # XXX this won't be easy to implement; how do you handle non-binding # functions, and where will we store the GPerlCallback?: #GtkTreeViewRowSeparatorFunc gtk_tree_view_get_row_separator_func (GtkTreeView *tree_view); #void gtk_tree_view_set_row_separator_func (GtkTreeView *tree_view, GtkTreeViewRowSeparatorFunc func, gpointer data, GtkDestroyNotify destroy); void gtk_tree_view_set_row_separator_func (GtkTreeView *tree_view, SV * func, SV * data=NULL); PREINIT: GtkTreeViewRowSeparatorFunc real_func; gpointer real_data; GtkDestroyNotify destroy; CODE: if (gperl_sv_is_defined (func)) { real_func = gtk2perl_tree_view_row_separator_func; real_data = gtk2perl_tree_view_row_separator_func_create ( func, data); destroy = (GtkDestroyNotify) gperl_callback_destroy; } else { real_func = real_data = destroy = NULL; } gtk_tree_view_set_row_separator_func ( tree_view, real_func, real_data, destroy); #endif #if GTK_CHECK_VERSION (2, 8, 0) #gboolean gtk_tree_view_get_visible_range (GtkTreeView *tree_view, GtkTreePath **start_path, GtkTreePath **end_path); =for apidoc =for signature (start_path, end_path) = $tree_view->get_visible_range =cut void gtk_tree_view_get_visible_range (tree_view) GtkTreeView *tree_view PREINIT: GtkTreePath *start_path, *end_path; PPCODE: if (!gtk_tree_view_get_visible_range (tree_view, &start_path, &end_path)) XSRETURN_EMPTY; EXTEND (sp, 2); PUSHs (sv_2mortal (newSVGtkTreePath_own (start_path))); PUSHs (sv_2mortal (newSVGtkTreePath_own (end_path))); #endif #if GTK_CHECK_VERSION (2, 10, 0) gboolean gtk_tree_view_get_headers_clickable (GtkTreeView *tree_view); void gtk_tree_view_set_search_entry (GtkTreeView *tree_view, GtkEntry_ornull *entry); GtkEntry_ornull * gtk_tree_view_get_search_entry (GtkTreeView *tree_view); =for apidoc Pass undef for the I to restore the default search position function. =cut void gtk_tree_view_set_search_position_func (GtkTreeView *tree_view, SV *func, SV *user_data=NULL) PREINIT: GtkTreeViewSearchPositionFunc real_func; gpointer real_data; GDestroyNotify destroy; CODE: if (SvTRUE (func)) { real_func = gtk2perl_tree_view_search_position_func; real_data = gtk2perl_tree_view_search_position_func_create (func, user_data); destroy = (GDestroyNotify) gperl_callback_destroy; } else { real_func = real_data = destroy = NULL; } gtk_tree_view_set_search_position_func (tree_view, real_func, real_data, destroy); ### allowing restoration of the old function is rather fragile and not done at ### this point. ### gtk_tree_view_get_search_position_func #endif #if GTK_CHECK_VERSION (2, 10, 0) void gtk_tree_view_set_rubber_banding (GtkTreeView *tree_view, gboolean enable); gboolean gtk_tree_view_get_rubber_banding (GtkTreeView *tree_view); GtkTreeViewGridLines gtk_tree_view_get_grid_lines (GtkTreeView *tree_view); void gtk_tree_view_set_grid_lines (GtkTreeView *tree_view, GtkTreeViewGridLines grid_lines); gboolean gtk_tree_view_get_enable_tree_lines (GtkTreeView *tree_view); void gtk_tree_view_set_enable_tree_lines (GtkTreeView *tree_view, gboolean enabled); #endif /* 2.10 */ #if GTK_CHECK_VERSION (2, 12, 0) void gtk_tree_view_set_show_expanders (GtkTreeView *tree_view, gboolean enabled); gboolean gtk_tree_view_get_show_expanders (GtkTreeView *tree_view); void gtk_tree_view_set_level_indentation (GtkTreeView *tree_view, gint indentation); gint gtk_tree_view_get_level_indentation (GtkTreeView *tree_view); void gtk_tree_view_convert_widget_to_tree_coords (GtkTreeView *tree_view, gint wx, gint wy, OUTLIST gint tx, OUTLIST gint ty); void gtk_tree_view_convert_tree_to_widget_coords (GtkTreeView *tree_view, gint tx, gint ty, OUTLIST gint wx, OUTLIST gint wy); void gtk_tree_view_convert_widget_to_bin_window_coords (GtkTreeView *tree_view, gint wx, gint wy, OUTLIST gint bx, OUTLIST gint by); void gtk_tree_view_convert_bin_window_to_widget_coords (GtkTreeView *tree_view, gint bx, gint by, OUTLIST gint wx, OUTLIST gint wy); void gtk_tree_view_convert_tree_to_bin_window_coords (GtkTreeView *tree_view, gint tx, gint ty, OUTLIST gint bx, OUTLIST gint by); void gtk_tree_view_convert_bin_window_to_tree_coords (GtkTreeView *tree_view, gint bx, gint by, OUTLIST gint tx, OUTLIST gint ty); gboolean gtk_tree_view_is_rubber_banding_active (GtkTreeView *tree_view); void gtk_tree_view_set_tooltip_row (GtkTreeView *tree_view, GtkTooltip *tooltip, GtkTreePath *path); void gtk_tree_view_set_tooltip_cell (GtkTreeView *tree_view, GtkTooltip *tooltip, GtkTreePath *path, GtkTreeViewColumn *column, GtkCellRenderer *cell); # gboolean gtk_tree_view_get_tooltip_context (GtkTreeView *tree_view, gint *x, gint *y, gboolean keyboard_tip, GtkTreeModel **model, GtkTreePath **path, GtkTreeIter *iter); =for apidoc =for signature (x, y, model, path, iter) = $treeview->get_tooltip_context ($x, $y, $keyboard_tip) =cut void gtk_tree_view_get_tooltip_context (GtkTreeView *tree_view, gint x, gint y, gboolean keyboard_tip) PREINIT: GtkTreeModel *model = NULL; GtkTreePath *path = NULL; GtkTreeIter iter = {0, }; PPCODE: /* PUTBACK/SPAGAIN because gtk_tree_view_get_tooltip_context() calls out to its model get_iter(), which may be perl */ PUTBACK; if (! gtk_tree_view_get_tooltip_context (tree_view, &x, &y, keyboard_tip, &model, &path, &iter)) XSRETURN_EMPTY; SPAGAIN; EXTEND (sp, 5); PUSHs (sv_2mortal (newSViv (x))); PUSHs (sv_2mortal (newSViv (y))); PUSHs (sv_2mortal (newSVGtkTreeModel (model))); PUSHs (sv_2mortal (newSVGtkTreePath_own (path))); PUSHs (sv_2mortal (newSVGtkTreeIter_copy (&iter))); void gtk_tree_view_set_tooltip_column (GtkTreeView *tree_view, gint column); gint gtk_tree_view_get_tooltip_column (GtkTreeView *tree_view); #endif /* 2.12 */ Gtk2-1.24992/xs/GtkFileChooserButton.xs0000644000175000017500000000321213076462677016213 0ustar lacklack/* * Copyright (c) 2004-2006 by the gtk2-perl team (see the file AUTHORS) * * Licensed under the LGPL, see LICENSE file for more information. * * $Id$ */ #include "gtk2perl.h" MODULE = Gtk2::FileChooserButton PACKAGE = Gtk2::FileChooserButton PREFIX = gtk_file_chooser_button_ BOOT: gperl_prepend_isa ("Gtk2::FileChooserButton", "Gtk2::FileChooser"); ## GtkWidget * gtk_file_chooser_button_new (const gchar *title, GtkFileChooserAction action) GtkWidget * gtk_file_chooser_button_new (class, title, action) const gchar *title GtkFileChooserAction action C_ARGS: title, action ## GtkWidget * gtk_file_chooser_button_new_with_backend (const gchar *title, GtkFileChooserAction action, const gchar *backend) GtkWidget * gtk_file_chooser_button_new_with_backend (class, title, action, backend) const gchar *title GtkFileChooserAction action const gchar *backend C_ARGS: title, action, backend ## GtkWidget * gtk_file_chooser_button_new_with_dialog (GtkWidget *dialog) GtkWidget * gtk_file_chooser_button_new_with_dialog (class, dialog) GtkWidget *dialog C_ARGS: dialog const gchar *gtk_file_chooser_button_get_title (GtkFileChooserButton *button); void gtk_file_chooser_button_set_title (GtkFileChooserButton *button, const gchar *title); gint gtk_file_chooser_button_get_width_chars (GtkFileChooserButton *button); void gtk_file_chooser_button_set_width_chars (GtkFileChooserButton *button, gint n_chars); #if GTK_CHECK_VERSION (2, 10, 0) void gtk_file_chooser_button_set_focus_on_click (GtkFileChooserButton *button, gboolean focus_on_click) gboolean gtk_file_chooser_button_get_focus_on_click (GtkFileChooserButton *button) #endif Gtk2-1.24992/xs/GtkTreeDnd.xs0000644000175000017500000001664513076462677014160 0ustar lacklack/* * Copyright (c) 2003 by the gtk2-perl team (see the file AUTHORS) * * This library is free software; you can redistribute it and/or * modify it under the terms of the GNU Library General Public * License as published by the Free Software Foundation; either * version 2.1 of the License, or (at your option) any later version. * * This library is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU * Library General Public License for more details. * * You should have received a copy of the GNU Library General Public * License along with this library; if not, write to the * Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, * Boston, MA 02110-1301 USA. * * $Id$ */ #include "gtk2perl.h" #define PREP_BOOL(object, path) \ gboolean ret; \ dSP; \ ENTER; \ SAVETMPS; \ PUSHMARK (SP); \ PUSHs (sv_2mortal (newSVGObject (G_OBJECT (object)))); \ XPUSHs (sv_2mortal (newSVGtkTreePath (path))); #define CALL_AND_RETURN_BOOL(name) \ PUTBACK; \ call_method (name, G_SCALAR); \ SPAGAIN; \ /* SvTRUE evaluates its arg more than once */ \ { \ SV * sv_ret = POPs; \ ret = SvTRUE (sv_ret); \ } \ PUTBACK; \ FREETMPS; \ LEAVE; \ return ret; static gboolean gtk2perl_tree_drag_source_row_draggable (GtkTreeDragSource *drag_source, GtkTreePath *path) { PREP_BOOL (drag_source, path); CALL_AND_RETURN_BOOL ("ROW_DRAGGABLE"); } static gboolean gtk2perl_tree_drag_source_drag_data_get (GtkTreeDragSource *drag_source, GtkTreePath *path, GtkSelectionData *selection_data) { PREP_BOOL (drag_source, path); XPUSHs (sv_2mortal (newSVGtkSelectionData (selection_data))); CALL_AND_RETURN_BOOL ("DRAG_DATA_GET"); } static gboolean gtk2perl_tree_drag_source_drag_data_delete (GtkTreeDragSource *drag_source, GtkTreePath *path) { PREP_BOOL (drag_source, path); CALL_AND_RETURN_BOOL ("DRAG_DATA_DELETE"); } static gboolean gtk2perl_tree_drag_dest_drag_data_received (GtkTreeDragDest *drag_dest, GtkTreePath *dest, GtkSelectionData *selection_data) { PREP_BOOL (drag_dest, dest); XPUSHs (sv_2mortal (newSVGtkSelectionData (selection_data))); CALL_AND_RETURN_BOOL ("DRAG_DATA_RECEIVED"); } static gboolean gtk2perl_tree_drag_dest_row_drop_possible (GtkTreeDragDest *drag_dest, GtkTreePath *dest_path, GtkSelectionData *selection_data) { PREP_BOOL (drag_dest, dest_path); XPUSHs (sv_2mortal (newSVGtkSelectionData (selection_data))); CALL_AND_RETURN_BOOL ("ROW_DROP_POSSIBLE"); } static void gtk2perl_tree_drag_source_iface_init (GtkTreeDragSourceIface * iface) { iface->row_draggable = gtk2perl_tree_drag_source_row_draggable; iface->drag_data_get = gtk2perl_tree_drag_source_drag_data_get; iface->drag_data_delete = gtk2perl_tree_drag_source_drag_data_delete; } static void gtk2perl_tree_drag_dest_iface_init (GtkTreeDragDestIface * iface) { iface->drag_data_received = gtk2perl_tree_drag_dest_drag_data_received; iface->row_drop_possible = gtk2perl_tree_drag_dest_row_drop_possible; } MODULE = Gtk2::TreeDnd PACKAGE = Gtk2::TreeDragSource PREFIX = gtk_tree_drag_source_ =for apidoc __hide__ =cut void _ADD_INTERFACE (class, const char * target_class) CODE: { static const GInterfaceInfo iface_info = { (GInterfaceInitFunc) gtk2perl_tree_drag_source_iface_init, (GInterfaceFinalizeFunc) NULL, (gpointer) NULL }; GType gtype = gperl_object_type_from_package (target_class); g_type_add_interface_static (gtype, GTK_TYPE_TREE_DRAG_SOURCE, &iface_info); } ## gboolean gtk_tree_drag_source_row_draggable (GtkTreeDragSource *drag_source, GtkTreePath *path) gboolean gtk_tree_drag_source_row_draggable (drag_source, path) GtkTreeDragSource *drag_source GtkTreePath *path ## gboolean gtk_tree_drag_source_drag_data_delete (GtkTreeDragSource *drag_source, GtkTreePath *path) gboolean gtk_tree_drag_source_drag_data_delete (drag_source, path) GtkTreeDragSource *drag_source GtkTreePath *path =for apidoc =for signature selection_data = $drag_source->drag_data_get ($path, $selection_data) Get selection data from a drag source. The data is written to $selection_data, or if $selection_data is not given then to a newly created Gtk2::SelectionData object with target type C. On success the return is the given or new object, or on failure the return is undef. =cut ### gboolean gtk_tree_drag_source_drag_data_get (GtkTreeDragSource *drag_source, GtkTreePath *path, GtkSelectionData *selection_data) void gtk_tree_drag_source_drag_data_get (GtkTreeDragSource *drag_source, GtkTreePath *path, GtkSelectionData *selection_data = NULL) PREINIT: SV *ret = &PL_sv_undef; CODE: if (selection_data) { if (gtk_tree_drag_source_drag_data_get (drag_source, path, selection_data)) ret = ST(2); } else { GtkSelectionData new_selection_data = { 0, }; new_selection_data.target = gdk_atom_intern ("GTK_TREE_MODEL_ROW", FALSE); new_selection_data.length = -1; if (gtk_tree_drag_source_drag_data_get (drag_source, path, &new_selection_data)) ret = sv_2mortal (newSVGtkSelectionData_copy (&new_selection_data)); } ST(0) = ret; XSRETURN(1); MODULE = Gtk2::TreeDnd PACKAGE = Gtk2::TreeDragDest PREFIX = gtk_tree_drag_dest_ =for apidoc __hide__ =cut void _ADD_INTERFACE (class, const char * target_class) CODE: { static const GInterfaceInfo iface_info = { (GInterfaceInitFunc) gtk2perl_tree_drag_dest_iface_init, (GInterfaceFinalizeFunc) NULL, (gpointer) NULL }; GType gtype = gperl_object_type_from_package (target_class); g_type_add_interface_static (gtype, GTK_TYPE_TREE_DRAG_DEST, &iface_info); } ## gboolean gtk_tree_drag_dest_drag_data_received (GtkTreeDragDest *drag_dest, GtkTreePath *dest, GtkSelectionData *selection_data) gboolean gtk_tree_drag_dest_drag_data_received (drag_dest, dest, selection_data) GtkTreeDragDest *drag_dest GtkTreePath *dest GtkSelectionData *selection_data ## gboolean gtk_tree_drag_dest_row_drop_possible (GtkTreeDragDest *drag_dest, GtkTreePath *dest_path, GtkSelectionData *selection_data) gboolean gtk_tree_drag_dest_row_drop_possible (drag_dest, dest_path, selection_data) GtkTreeDragDest *drag_dest GtkTreePath *dest_path GtkSelectionData *selection_data MODULE = Gtk2::TreeDnd PACKAGE = Gtk2::SelectionData PREFIX = gtk_tree_ ## gboolean gtk_tree_set_row_drag_data (GtkSelectionData *selection_data, GtkTreeModel *tree_model, GtkTreePath *path) gboolean gtk_tree_set_row_drag_data (selection_data, tree_model, path) GtkSelectionData *selection_data GtkTreeModel *tree_model GtkTreePath *path ## gboolean gtk_tree_get_row_drag_data (GtkSelectionData *selection_data, GtkTreeModel **tree_model, GtkTreePath **path) =for apidoc If $selection_data is not of target type GTK_TREE_MODEL_ROW then the return is an empty list. =for signature (tree_model, path) = $selection_data->get_row_drag_data =cut void gtk_tree_get_row_drag_data (selection_data) GtkSelectionData *selection_data PREINIT: GtkTreeModel *tree_model; GtkTreePath *path; PPCODE: if (! gtk_tree_get_row_drag_data (selection_data, &tree_model, &path)) XSRETURN_EMPTY; EXTEND (SP, 2); PUSHs (sv_2mortal (newSVGtkTreeModel (tree_model))); PUSHs (sv_2mortal (newSVGtkTreePath_own (path))); Gtk2-1.24992/xs/GtkStatusIcon.xs0000644000175000017500000001251113076462677014713 0ustar lacklack/* * Copyright (c) 2006 by the gtk2-perl team (see the file AUTHORS) * * Licensed under the LGPL, see LICENSE file for more information. * * $Id$ */ #include "gtk2perl.h" MODULE = Gtk2::StatusIcon PACKAGE = Gtk2::StatusIcon PREFIX = gtk_status_icon_ GtkStatusIcon_noinc *gtk_status_icon_new (class); C_ARGS: /*void*/ GtkStatusIcon_noinc *gtk_status_icon_new_from_pixbuf (class, GdkPixbuf *pixbuf); C_ARGS: pixbuf GtkStatusIcon_noinc *gtk_status_icon_new_from_file (class, GPerlFilename_const filename); C_ARGS: filename GtkStatusIcon_noinc *gtk_status_icon_new_from_stock (class, const gchar *stock_id); C_ARGS: stock_id GtkStatusIcon_noinc *gtk_status_icon_new_from_icon_name (class, const gchar *icon_name); C_ARGS: icon_name void gtk_status_icon_set_from_pixbuf (GtkStatusIcon *status_icon, GdkPixbuf_ornull *pixbuf); ##void gtk_status_icon_set_from_file (GtkStatusIcon *status_icon, const gchar *filename); void gtk_status_icon_set_from_file (GtkStatusIcon *status_icon, GPerlFilename_const filename); void gtk_status_icon_set_from_stock (GtkStatusIcon *status_icon, const gchar *stock_id); void gtk_status_icon_set_from_icon_name (GtkStatusIcon *status_icon, const gchar *icon_name); GtkImageType gtk_status_icon_get_storage_type (GtkStatusIcon *status_icon); GdkPixbuf_ornull *gtk_status_icon_get_pixbuf (GtkStatusIcon *status_icon); const gchar_ornull *gtk_status_icon_get_stock (GtkStatusIcon *status_icon); const gchar_ornull *gtk_status_icon_get_icon_name (GtkStatusIcon *status_icon); gint gtk_status_icon_get_size (GtkStatusIcon *status_icon); void gtk_status_icon_set_tooltip (GtkStatusIcon *status_icon, const gchar_ornull *tooltip_text); void gtk_status_icon_set_visible (GtkStatusIcon *status_icon, gboolean visible); gboolean gtk_status_icon_get_visible (GtkStatusIcon *status_icon); void gtk_status_icon_set_blinking (GtkStatusIcon *status_icon, gboolean blinking); gboolean gtk_status_icon_get_blinking (GtkStatusIcon *status_icon); gboolean gtk_status_icon_is_embedded (GtkStatusIcon *status_icon); =for apidoc =for signature (x, y, push_in) = Gtk2::StatusIcon::position_menu (menu, icon) =for signature (x, y, push_in) = Gtk2::StatusIcon::position_menu (menu, x, y, icon) =for arg menu (Gtk2::Menu) =for arg x (integer) =for arg y (integer) =for arg icon (Gtk2::StatusIcon) This function takes four arguments so that it may be passed directly as the menu position callback to Gtk2::Menu::popup(), which passes in initial x and y values for historical reasons. Otherwise, you need only pass two arguments. This function can be used as the I argument to I. =cut void gtk_status_icon_position_menu (GtkMenu *menu, ...) PREINIT: gboolean push_in; gint x, y; GtkStatusIcon *icon; PPCODE: if (items == 4) { /* Compatibility mode */ x = SvIV (ST (1)); y = SvIV (ST (2)); icon = SvGtkStatusIcon (ST (3)); } else icon = SvGtkStatusIcon (ST (1)); /* PUTBACK/SPAGAIN because gtk_status_icon_position_menu() calls out to menu->size_request, which may be a perl class closure */ PUTBACK; gtk_status_icon_position_menu (menu, &x, &y, &push_in, icon); SPAGAIN; EXTEND (sp, 3); PUSHs (sv_2mortal (newSViv (x))); PUSHs (sv_2mortal (newSViv (y))); PUSHs (sv_2mortal (newSVuv (push_in))); # gboolean gtk_status_icon_get_geometry (GtkStatusIcon *status_icon, GdkScreen **screen, GdkRectangle *area, GtkOrientation *orientation); void gtk_status_icon_get_geometry (GtkStatusIcon *status_icon) PREINIT: GdkScreen *screen; GdkRectangle area; GtkOrientation orientation; PPCODE: if (!gtk_status_icon_get_geometry (status_icon, &screen, &area, &orientation)) XSRETURN_EMPTY; EXTEND (sp, 3); PUSHs (sv_2mortal (newSVGdkScreen (screen))); PUSHs (sv_2mortal (newSVGdkRectangle_copy (&area))); PUSHs (sv_2mortal (newSVGtkOrientation (orientation))); #if GTK_CHECK_VERSION (2, 12, 0) void gtk_status_icon_set_screen (GtkStatusIcon *status_icon, GdkScreen *screen); GdkScreen *gtk_status_icon_get_screen (GtkStatusIcon *status_icon); #endif #if GTK_CHECK_VERSION (2, 14, 0) guint32 gtk_status_icon_get_x11_window_id (GtkStatusIcon *status_icon); #endif /* 2.14 */ #if GTK_CHECK_VERSION (2, 16, 0) void gtk_status_icon_set_has_tooltip (GtkStatusIcon *status_icon, gboolean has_tooltip); gboolean gtk_status_icon_get_has_tooltip (GtkStatusIcon *status_icon); gchar_own_ornull *gtk_status_icon_get_tooltip_markup (GtkStatusIcon *status_icon); gchar_own_ornull *gtk_status_icon_get_tooltip_text (GtkStatusIcon *status_icon); #Unlike the corresponding methods in GtkWidget, these setters use plain char instead of gchar. #However I expect that is an error or oversight and the char and gchar types are supposedly #equivalent anyway. Also using gchar lets me use the _ornull. void gtk_status_icon_set_tooltip_text (GtkStatusIcon *status_icon, const gchar_ornull *text); void gtk_status_icon_set_tooltip_markup (GtkStatusIcon *status_icon, const gchar_ornull *markup); #endif /* 2.16 */ #if GTK_CHECK_VERSION (2, 18, 0) void gtk_status_icon_set_title (GtkStatusIcon *status_icon, const gchar *title); const gchar * gtk_status_icon_get_title (GtkStatusIcon *status_icon); #endif /* 2.18 */ #if GTK_CHECK_VERSION (2, 20, 0) void gtk_status_icon_set_name (GtkStatusIcon *status_icon, const gchar *name); #endif /* 2.20 */ Gtk2-1.24992/xs/GtkIMContextSimple.xs0000644000175000017500000000264013076462677015645 0ustar lacklack/* * Copyright (c) 2006 by the gtk2-perl team (see the file AUTHORS) * * This library is free software; you can redistribute it and/or * modify it under the terms of the GNU Library General Public * License as published by the Free Software Foundation; either * version 2.1 of the License, or (at your option) any later version. * * This library is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU * Library General Public License for more details. * * You should have received a copy of the GNU Library General Public * License along with this library; if not, write to the * Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, * Boston, MA 02110-1301 USA. * * $Id$ */ #include "gtk2perl.h" MODULE = Gtk2::IMContextSimple PACKAGE = Gtk2::IMContextSimple PREFIX = gtk_im_context_simple_ GtkIMContext_noinc * gtk_im_context_simple_new (class) C_ARGS: /*void*/ ### This just copies the pointer value, so we'd have to keep that memory alive; ### likely attached to the object. ##void gtk_im_context_simple_add_table (GtkIMContextSimple *context_simple, ## guint16 *data, ## gint max_seq_len, ## gint n_seqs); Gtk2-1.24992/xs/GtkDnd.xs0000644000175000017500000002024513076462677013327 0ustar lacklack/* * Copyright (c) 2003-2006 by the gtk2-perl team (see the file AUTHORS) * * This library is free software; you can redistribute it and/or * modify it under the terms of the GNU Library General Public * License as published by the Free Software Foundation; either * version 2.1 of the License, or (at your option) any later version. * * This library is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU * Library General Public License for more details. * * You should have received a copy of the GNU Library General Public * License along with this library; if not, write to the * Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, * Boston, MA 02110-1301 USA. * * $Id$ */ #include "gtk2perl.h" MODULE = Gtk2::Dnd PACKAGE = Gtk2::Gdk::DragContext PREFIX = gtk_drag_ ## void gtk_drag_finish (GdkDragContext *context, gboolean success, gboolean del, guint32 time_) void gtk_drag_finish (context, success, del, time_) GdkDragContext *context gboolean success gboolean del guint32 time_ ## GtkWidget *gtk_drag_get_source_widget (GdkDragContext *context) GtkWidget * gtk_drag_get_source_widget (context) GdkDragContext *context ## void gtk_drag_set_icon_widget (GdkDragContext *context, GtkWidget *widget, gint hot_x, gint hot_y) void gtk_drag_set_icon_widget (context, widget, hot_x, hot_y) GdkDragContext *context GtkWidget *widget gint hot_x gint hot_y ## void gtk_drag_set_icon_pixmap (GdkDragContext *context, GdkColormap *colormap, GdkPixmap *pixmap, GdkBitmap *mask, gint hot_x, gint hot_y) void gtk_drag_set_icon_pixmap (context, colormap, pixmap, mask, hot_x, hot_y) GdkDragContext *context GdkColormap *colormap GdkPixmap *pixmap GdkBitmap_ornull *mask gint hot_x gint hot_y ## void gtk_drag_set_icon_pixbuf (GdkDragContext *context, GdkPixbuf *pixbuf, gint hot_x, gint hot_y) void gtk_drag_set_icon_pixbuf (context, pixbuf, hot_x, hot_y) GdkDragContext *context GdkPixbuf *pixbuf gint hot_x gint hot_y ## void gtk_drag_set_icon_stock (GdkDragContext *context, const gchar *stock_id, gint hot_x, gint hot_y) void gtk_drag_set_icon_stock (context, stock_id, hot_x, hot_y) GdkDragContext *context const gchar *stock_id gint hot_x gint hot_y #if GTK_CHECK_VERSION (2, 8, 0) void gtk_drag_set_icon_name (GdkDragContext *context, const gchar *icon_name, gint hot_x, gint hot_y) #endif ## void gtk_drag_set_icon_default (GdkDragContext *context) void gtk_drag_set_icon_default (context) GdkDragContext *context MODULE = Gtk2::Dnd PACKAGE = Gtk2::Drag PREFIX = gtk_drag_ ## GdkDragContext *gtk_drag_begin (GtkWidget *widget, GtkTargetList *targets, GdkDragAction actions, gint button, GdkEvent *event) GdkDragContext_noinc * gtk_drag_begin (class, widget, targets, actions, button, event) GtkWidget *widget GtkTargetList *targets GdkDragAction actions gint button GdkEvent *event C_ARGS: widget, targets, actions, button, event MODULE = Gtk2::Dnd PACKAGE = Gtk2::Widget PREFIX = gtk_ ## GdkDragContext *gtk_drag_begin (GtkWidget *widget, GtkTargetList *targets, GdkDragAction actions, gint button, GdkEvent *event) GdkDragContext_noinc * gtk_drag_begin (widget, targets, actions, button, event) GtkWidget *widget GtkTargetList *targets GdkDragAction actions gint button GdkEvent *event ## void gtk_drag_get_data (GtkWidget *widget, GdkDragContext *context, GdkAtom target, guint32 time_) void gtk_drag_get_data (widget, context, target, time_) GtkWidget *widget GdkDragContext *context GdkAtom target guint32 time_ ## void gtk_drag_highlight (GtkWidget *widget) void gtk_drag_highlight (widget) GtkWidget *widget ## void gtk_drag_unhighlight (GtkWidget *widget) void gtk_drag_unhighlight (widget) GtkWidget *widget #### void gtk_drag_dest_set (GtkWidget *widget, GtkDestDefaults flags, const GtkTargetEntry *targets, gint n_targets, GdkDragAction actions) =for apidoc =for arg ... of Gtk2::TargetEntry's =cut void gtk_drag_dest_set (widget, flags, actions, ...) GtkWidget *widget GtkDestDefaults flags GdkDragAction actions PREINIT: GtkTargetEntry * targets = NULL; gint n_targets, i; CODE: #define FIRST_TARGET 3 n_targets = items - FIRST_TARGET; targets = g_new (GtkTargetEntry, n_targets); for (i = 0 ; i < n_targets ; i++) gtk2perl_read_gtk_target_entry (ST (i+FIRST_TARGET), targets+i); gtk_drag_dest_set (widget, flags, targets, n_targets, actions); #undef FIRST_TARGET CLEANUP: g_free (targets); ## void gtk_drag_dest_set_proxy (GtkWidget *widget, GdkWindow *proxy_window, GdkDragProtocol protocol, gboolean use_coordinates) void gtk_drag_dest_set_proxy (widget, proxy_window, protocol, use_coordinates) GtkWidget *widget GdkWindow *proxy_window GdkDragProtocol protocol gboolean use_coordinates ## void gtk_drag_dest_unset (GtkWidget *widget) void gtk_drag_dest_unset (widget) GtkWidget *widget ## GdkAtom gtk_drag_dest_find_target (GtkWidget *widget, GdkDragContext *context, GtkTargetList *target_list) GdkAtom gtk_drag_dest_find_target (widget, context, target_list) GtkWidget *widget GdkDragContext *context GtkTargetList_ornull *target_list ## GtkTargetList* gtk_drag_dest_get_target_list (GtkWidget *widget) GtkTargetList_ornull* gtk_drag_dest_get_target_list (widget) GtkWidget *widget ## void gtk_drag_dest_set_target_list (GtkWidget *widget, GtkTargetList *target_list) void gtk_drag_dest_set_target_list (widget, target_list) GtkWidget *widget GtkTargetList_ornull *target_list #### void gtk_drag_source_set (GtkWidget *widget, GdkModifierType start_button_mask, const GtkTargetEntry *targets, gint n_targets, GdkDragAction actions) =for apidoc =for arg ... of Gtk2::TargetEntry's =cut void gtk_drag_source_set (widget, start_button_mask, actions, ...) GtkWidget *widget GdkModifierType start_button_mask GdkDragAction actions PREINIT: GtkTargetEntry * targets = NULL; gint n_targets, i; CODE: #define FIRST_TARGET 3 n_targets = items - FIRST_TARGET; targets = g_new (GtkTargetEntry, n_targets); for (i = 0 ; i < n_targets ; i++) gtk2perl_read_gtk_target_entry (ST (i+FIRST_TARGET), targets+i); gtk_drag_source_set (widget, start_button_mask, targets, n_targets, actions); #undef FIRST_TARGET CLEANUP: g_free (targets); ## void gtk_drag_source_unset (GtkWidget *widget) void gtk_drag_source_unset (widget) GtkWidget *widget ## void gtk_drag_source_set_icon (GtkWidget *widget, GdkColormap *colormap, GdkPixmap *pixmap, GdkBitmap *mask) void gtk_drag_source_set_icon (widget, colormap, pixmap, mask) GtkWidget *widget GdkColormap_ornull *colormap GdkPixmap_ornull *pixmap GdkBitmap_ornull *mask ## void gtk_drag_source_set_icon_pixbuf (GtkWidget *widget, GdkPixbuf *pixbuf) void gtk_drag_source_set_icon_pixbuf (widget, pixbuf) GtkWidget *widget GdkPixbuf_ornull *pixbuf ## void gtk_drag_source_set_icon_stock (GtkWidget *widget, const gchar *stock_id) void gtk_drag_source_set_icon_stock (widget, stock_id) GtkWidget *widget const gchar *stock_id ## gboolean gtk_drag_check_threshold (GtkWidget *widget, gint start_x, gint start_y, gint current_x, gint current_y) gboolean gtk_drag_check_threshold (widget, start_x, start_y, current_x, current_y) GtkWidget *widget gint start_x gint start_y gint current_x gint current_y #if GTK_CHECK_VERSION(2,4,0) GtkTargetList_ornull * gtk_drag_source_get_target_list (widget) GtkWidget *widget void gtk_drag_source_set_target_list (widget, target_list) GtkWidget *widget GtkTargetList_ornull *target_list #endif #if GTK_CHECK_VERSION(2,6,0) void gtk_drag_dest_add_text_targets (GtkWidget *widget); void gtk_drag_dest_add_image_targets (GtkWidget *widget); void gtk_drag_dest_add_uri_targets (GtkWidget *widget); void gtk_drag_source_add_text_targets (GtkWidget *widget); void gtk_drag_source_add_image_targets (GtkWidget *widget); void gtk_drag_source_add_uri_targets (GtkWidget *widget); #endif #if GTK_CHECK_VERSION(2,8,0) void gtk_drag_source_set_icon_name (GtkWidget *widget, const gchar *icon_name); #endif #if GTK_CHECK_VERSION (2,10,0) void gtk_drag_dest_set_track_motion (GtkWidget *widget, gboolean track_motion); gboolean gtk_drag_dest_get_track_motion (GtkWidget *widget); #endif Gtk2-1.24992/xs/GtkMenuToolButton.xs0000644000175000017500000000237613076462677015565 0ustar lacklack/* * Copyright (c) 2004 by the gtk2-perl team (see the file AUTHORS) * * Licensed under the LGPL, see LICENSE file for more information. * * $Id$ */ #include "gtk2perl.h" MODULE = Gtk2::MenuToolButton PACKAGE = Gtk2::MenuToolButton PREFIX = gtk_menu_tool_button_ ## GtkToolItem * gtk_menu_tool_button_new (GtkWidget *icon_widget, const gchar *label) GtkToolItem * gtk_menu_tool_button_new (class, icon_widget, label) GtkWidget_ornull *icon_widget const gchar_ornull *label C_ARGS: icon_widget, label ## GtkToolItem * gtk_menu_tool_button_new_from_stock (const gchar *stock_id) GtkToolItem * gtk_menu_tool_button_new_from_stock (class, stock_id) const gchar *stock_id C_ARGS: stock_id void gtk_menu_tool_button_set_menu (GtkMenuToolButton *button, GtkWidget_ornull *menu); GtkWidget_ornull * gtk_menu_tool_button_get_menu (GtkMenuToolButton *button); void gtk_menu_tool_button_set_arrow_tooltip (GtkMenuToolButton *button, GtkTooltips *tooltips, const gchar *tip_text, const gchar *tip_private); #if GTK_CHECK_VERSION(2, 12, 0) void gtk_menu_tool_button_set_arrow_tooltip_text (GtkMenuToolButton *button, const gchar_ornull *text); void gtk_menu_tool_button_set_arrow_tooltip_markup (GtkMenuToolButton *button, const gchar_ornull *markup); #endif Gtk2-1.24992/xs/GtkMenuItem.xs0000644000175000017500000001220713076462677014344 0ustar lacklack/* * Copyright (c) 2003, 2010 by the gtk2-perl team (see the file AUTHORS) * * This library is free software; you can redistribute it and/or * modify it under the terms of the GNU Library General Public * License as published by the Free Software Foundation; either * version 2.1 of the License, or (at your option) any later version. * * This library is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU * Library General Public License for more details. * * You should have received a copy of the GNU Library General Public * License along with this library; if not, write to the * Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, * Boston, MA 02110-1301 USA. * * $Id$ */ #include "gtk2perl.h" #include /* void (* toggle_size_request) (GtkMenuItem *menu_item, gint *requisition); */ static void gtk2perl_menu_item_toggle_size_request_marshal (GClosure * closure, GValue * return_value, guint n_param_values, const GValue * param_values, gpointer invocation_hint, gpointer marshal_data) { gint * requisition; dGPERL_CLOSURE_MARSHAL_ARGS; GPERL_CLOSURE_MARSHAL_INIT (closure, marshal_data); PERL_UNUSED_VAR (return_value); PERL_UNUSED_VAR (n_param_values); PERL_UNUSED_VAR (invocation_hint); ENTER; SAVETMPS; PUSHMARK (SP); GPERL_CLOSURE_MARSHAL_PUSH_INSTANCE (param_values); requisition = g_value_get_pointer (param_values+1); GPERL_CLOSURE_MARSHAL_PUSH_DATA; PUTBACK; GPERL_CLOSURE_MARSHAL_CALL (G_SCALAR); if (count == 1) { *requisition = POPi; } else { /* NOTE: croaking here can cause bad things to happen to the * app, because croaking in signal handlers is bad juju. */ croak ("an toggle-size-request signal handler must return one " "item (the requisition), but the callback returned %d " "items", count); } PUTBACK; FREETMPS; LEAVE; } MODULE = Gtk2::MenuItem PACKAGE = Gtk2::MenuItem PREFIX = gtk_menu_item_ =for position DESCRIPTION =head1 DESCRIPTION If a MenuItem is created with a C<$label> string, or if the C