Gtk2.pm 13.8 KB
Newer Older
1
#
Brian Manning's avatar
Brian Manning committed
2
# Copyright (C) 2003-2013 by the gtk2-perl team (see the file AUTHORS for
3
# the full list)
Torsten Schönfeld's avatar
Torsten Schönfeld committed
4
#
x-rwmcfa1's avatar
x-rwmcfa1 committed
5
6
7
8
# 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.
Torsten Schönfeld's avatar
Torsten Schönfeld committed
9
#
x-rwmcfa1's avatar
x-rwmcfa1 committed
10
11
12
13
# 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.
Torsten Schönfeld's avatar
Torsten Schönfeld committed
14
#
x-rwmcfa1's avatar
x-rwmcfa1 committed
15
16
17
18
# 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.,
# 59 Temple Place - Suite 330, Boston, MA  02111-1307  USA.
#
19
# $Id$
20
21
#

x-gthyni's avatar
x-gthyni committed
22
23
package Gtk2;

Scott Arrington's avatar
Scott Arrington committed
24
25
# Gtk uses unicode strings; thus we require perl>=5.8.x,
# which is unicode internally.
x-gthyni's avatar
x-gthyni committed
26
27
28
29
use 5.008;
use strict;
use warnings;

x-rwmcfa1's avatar
G->Glib    
x-rwmcfa1 committed
30
use Glib;
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
use Pango;

# Backwards compatibility: create Gtk2::Pango aliases for everything in Pango
# that was originally in Gtk2::Pango.
{
  no strict 'refs';
  my @pango_keys = qw(
    AttrBackground:: AttrColor:: AttrFallback:: AttrFamily:: AttrFontDesc::
    AttrForeground:: AttrGravity:: AttrGravityHint:: Attribute:: AttrInt::
    AttrIterator:: AttrLanguage:: AttrLetterSpacing:: AttrList:: AttrRise::
    AttrScale:: AttrShape:: AttrSize:: AttrStretch:: AttrStrikethrough::
    AttrStrikethroughColor:: AttrString:: AttrStyle:: AttrUnderline::
    AttrUnderlineColor:: AttrVariant:: AttrWeight:: Cairo:: Color:: Context::
    Font:: FontDescription:: FontFace:: FontFamily:: FontMap:: FontMask::
    FontMetrics:: Fontset:: GlyphString:: Gravity:: Language:: Layout::
    LayoutIter:: LayoutLine:: Matrix:: Renderer:: Script:: ScriptIter::
    TabArray::

    extents_to_pixels find_base_dir parse_markup pixels scale scale_large
    scale_medium scale_small scale_x_large scale_x_small scale_xx_large
    scale_xx_small units_from_double units_to_double

    PANGO_PIXELS

    CHECK_VERSION GET_VERSION_INFO VERSION

    ISA
  );
  foreach my $key (@pango_keys) {
60
61
62
63
64
    # Avoid warnings about names that are used only once by checking for
    # definedness here.
    if (defined *{'Pango::' . $key}) {
      *{'Gtk2::Pango::' . $key} = *{'Pango::' . $key};
    }
65
66
  }
}
x-gthyni's avatar
x-gthyni committed
67

68
69
70
# if the gtk+ we've been compiled against is at 2.8.0 or newer or if pango is
# at 1.10.0 or newer, we need to import the Cairo module for the cairo glue in
# gtk+ and pango.
71
72
eval "use Cairo;";

73
use Exporter;
x-gthyni's avatar
x-gthyni committed
74
75
require DynaLoader;

Brian Manning's avatar
Brian Manning committed
76
our $VERSION = '1.2491';
x-gthyni's avatar
x-gthyni committed
77

78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
our @ISA = qw(DynaLoader Exporter);

# this is critical -- tell dynaloader to load the module so that its
# symbols are available to all other modules.  without this, nobody
# else can use important functions like gtk2perl_new_object!
#
# hrm.  win32 doesn't really use this, because we have to link the whole
# thing at compile time to ensure all the symbols are defined.
#
# on darwin, at least with the particular 5.8.0 binary i'm using, perl
# complains "Can't make loaded symbols global on this platform" when this
# is set to 0x01, but goes on to work fine.  returning 0 here avoids the
# warning and doesn't appear to break anything.
sub dl_load_flags { $^O eq 'darwin' ? 0x00 : 0x01 }

# now load the XS code.
Gtk2->bootstrap ($VERSION);

# %Gtk2::EXPORT_TAGS is filled from the constants-x.y files by the generated XS
# code in build/constants.xs
our @EXPORT_OK = map { @$_ } values %Gtk2::EXPORT_TAGS;
$Gtk2::EXPORT_TAGS{all} = \@EXPORT_OK;
x-gthyni's avatar
x-gthyni committed
100

101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
# Compatibility with perl 5.20 and non-dot locales.  Wrap all functions that
# might end up calling setlocale() such that POSIX::setlocale() is also called
# to ensure perl knows about the current locale.  See the discussion in
# <https://rt.perl.org//Public/Bug/Display.html?id=121930>,
# <https://rt.perl.org/Public/Bug/Display.html?id=121317>,
# <https://rt.perl.org/Public/Bug/Display.html?id=120723>.
if ($^V ge v5.20.0) {
  require POSIX;
  no strict 'refs';
  no warnings 'redefine';

  my $disable_setlocale = 0;
  my $orig = \&Gtk2::disable_setlocale;
  *{Gtk2::disable_setlocale} = sub {
    $disable_setlocale = 1;
    $orig->(@_);
  };

  # gtk_init_with_args is not wrapped.
  foreach my $function (qw/Gtk2::init Gtk2::init_check Gtk2::parse_args/) {
    my $orig = \&{$function};
    *{$function} = sub {
      if (!$disable_setlocale) {
        POSIX::setlocale (POSIX::LC_ALL (), '');
      }
      $orig->(@_);
    };
  }
}

131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
# Names "STOP" and "PROPAGATE" here are per the GtkWidget event signal
# descriptions.  In some other flavours of signals the jargon is "handled"
# instead of "stop".  "Handled" matches g_signal_accumulator_true_handled(),
# though that function doesn't rate a mention in the Gtk docs.  There's
# nothing fixed in the idea of "true means cease emission" (whether it's
# called "stop" or "handled").  You can just as easily have false for cease
# (the way the underlying GSignalAccumulator func in fact operates).  The
# upshot being don't want to attempt to be too universal with the names
# here; "EVENT" is meant to hint at the context or signal flavour they're
# for use with.
use constant {
  EVENT_STOP      => 1,
  EVENT_PROPAGATE => !1,
};

146
sub import {
147
	my $class = shift;
148
149
150
151
152
153
154

	# threads' init needs to be called before the main init and we don't
	# want to force the order those options are passed to us so we need to
	# cache the choices in booleans and (optionally) do them in the corect
	# order afterwards
	my $init = 0;
	my $threads_init = 0;
Torsten Schönfeld's avatar
Torsten Schönfeld committed
155

156
	my @unknown_args = ($class);
157
158
	foreach (@_) {
		if (/^-?init$/) {
159
160
161
			$init = 1;
		} elsif (/-?threads-init$/) {
			$threads_init = 1;
162
		} else {
163
			push @unknown_args, $_;
164
		}
165
	}
166
167
168

	Gtk2::Gdk::Threads->init if ($threads_init);
	Gtk2->init if ($init);
x-gthyni's avatar
x-gthyni committed
169

170
171
172
173
	# call into Exporter for the unrecognized arguments; handles exporting
	# and version checking
	Gtk2->export_to_level (1, @unknown_args);
}
x-gthyni's avatar
x-gthyni committed
174
175
176

# Preloaded methods go here.

177
178
179
180
181
182
183
184
185
package Gtk2::Gdk;

sub CHARS { 8 };
sub SHORTS { 16 };
sub LONGS { 32 };

sub USHORTS { 16 };
sub ULONGS { 32 };

Scott Arrington's avatar
Scott Arrington committed
186
package Gtk2::Gdk::Atom;
187

Scott Arrington's avatar
Scott Arrington committed
188
189
use overload
	'==' => \&Gtk2::Gdk::Atom::eq,
190
	'!=' => \&Gtk2::Gdk::Atom::ne,
Scott Arrington's avatar
Scott Arrington committed
191
	fallback => 1;
192
193
194
195

package Gtk2::CellLayout::DataFunc;

use overload
196
197
198
199
	'&{}' => sub {
                   my ($func) = @_;
                   return sub { Gtk2::CellLayout::DataFunc::invoke($func, @_) }
                 },
200
	fallback => 1;
201

202
203
204
package Gtk2::TreeSortable::IterCompareFunc;

use overload
205
206
207
208
	'&{}' => sub {
                   my ($func) = @_;
                   return sub { Gtk2::TreeSortable::IterCompareFunc::invoke($func, @_) };
                 },
209
210
	fallback => 1;

211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
package Gtk2::TreeModelSort;

# We forgot to prepend Gtk2::TreeModel to @Gtk2::TreeModelSort::ISA.  So this
# hack is here to make sure that $model_sort->get resolves to
# Gtk2::TreeModel::get when appropriate and to Glib::Object::get otherwise, so
# we stay backwards compatible.
sub get {
	if (@_ > 1 and ref $_[1] eq 'Gtk2::TreeIter') {
		# called as $model->get ($iter, columns...);
		return Gtk2::TreeModel::get (@_);
	} else {
		# called as $model->get (names...);
		return Glib::Object::get (@_);
	}
}

227
228
229
230
231
232
233
234
235
236
package Gtk2::Builder;

sub _do_connect {
  my ($object,
      $signal_name,
      $user_data,
      $connect_object,
      $flags,
      $handler) = @_;

237
  my $func = ($flags & 'after') ? 'signal_connect_after' : 'signal_connect';
238
239
240
241
242
243
244
245
246

  # we get connect_object when we're supposed to call
  # signal_connect_object, which ensures that the data (an object)
  # lives as long as the signal is connected.  the bindings take
  # care of that for us in all cases, so we only have signal_connect.
  # if we get a connect_object, just use that instead of user_data.
  $object->$func($signal_name => $handler,
                 $connect_object ? $connect_object : $user_data);
}
247

248
249
250
251
252
253
254
255
sub connect_signals {
  my $builder = shift;
  my $user_data = shift;

  # $builder->connect_signals ($user_data)
  # $builder->connect_signals ($user_data, $package)
  if ($#_ <= 0) {
    my $package = shift;
256
    $package = caller unless defined $package;
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302

    $builder->connect_signals_full(sub {
      my ($builder,
          $object,
          $signal_name,
          $handler_name,
          $connect_object,
          $flags) = @_;

      no strict qw/refs/;

      my $handler = $handler_name;
      if (ref $package) {
        $handler = sub { $package->$handler_name(@_) };
      } else {
        if ($package && $handler !~ /::/) {
          $handler = $package.'::'.$handler_name;
        }
      }

      _do_connect ($object, $signal_name, $user_data, $connect_object,
                   $flags, $handler);
    });
  }

  # $builder->connect_signals ($user_data, %handlers)
  else {
    my %handlers = @_;

    $builder->connect_signals_full(sub {
      my ($builder,
          $object,
          $signal_name,
          $handler_name,
          $connect_object,
          $flags) = @_;

      return unless exists $handlers{$handler_name};

      _do_connect ($object, $signal_name, $user_data, $connect_object,
                   $flags, $handlers{$handler_name});
    });
  }
}

package Gtk2;
303

x-gthyni's avatar
x-gthyni committed
304
305
1;
__END__
Scott Arrington's avatar
Scott Arrington committed
306
# documentation is a good thing.
x-gthyni's avatar
x-gthyni committed
307
308
309
310
311
312
313

=head1 NAME

Gtk2 - Perl interface to the 2.x series of the Gimp Toolkit library

=head1 SYNOPSIS

314
315
  use Gtk2 -init;
  # Gtk2->init; works if you didn't use -init on use
x-gthyni's avatar
x-gthyni committed
316
317
318
319
320
321
322
323
324
  my $window = Gtk2::Window->new ('toplevel');
  my $button = Gtk2::Button->new ('Quit');
  $button->signal_connect (clicked => sub { Gtk2->main_quit });
  $window->add ($button);
  $window->show_all;
  Gtk2->main;

=head1 ABSTRACT

325
Perl bindings to the 2.x series of the Gtk+ widget set.  This module
326
allows you to write graphical user interfaces in a Perlish and
327
328
object-oriented way, freeing you from the casting and memory management
in C, yet remaining very close in spirit to original API.
x-gthyni's avatar
x-gthyni committed
329
330
331

=head1 DESCRIPTION

332
The Gtk2 module allows a Perl developer to use the Gtk+ graphical user
x-gthyni's avatar
x-gthyni committed
333
334
335
336
interface library.  Find out more about Gtk+ at http://www.gtk.org.

The GTK+ Reference Manual is also a handy companion when writing Gtk
programs in any language.  http://developer.gnome.org/doc/API/2.0/gtk/
337
The Perl bindings follow the C API very closely, and the C reference
x-gthyni's avatar
x-gthyni committed
338
339
340
documentation should be considered the canonical source.

To discuss gtk2-perl, ask questions and flame/praise the authors,
x-rwmcfa1's avatar
x-rwmcfa1 committed
341
join gtk-perl-list@gnome.org at lists.gnome.org.
x-gthyni's avatar
x-gthyni committed
342

Scott Arrington's avatar
Scott Arrington committed
343
344
Also have a look at the gtk2-perl website and sourceforge project page,
http://gtk2-perl.sourceforge.net
x-gthyni's avatar
x-gthyni committed
345

346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
=head1 INITIALIZATION

  use Gtk2 qw/-init/;
  use Gtk2 qw/-init -threads-init/;

=over

=item -init

Equivalent to Gtk2->init, called to initialize GLIB and GTK+. Just about every
Gtk2-Perl script should do "use Gtk2 -init"; This initialization should take
place before using any other Gtk2 functions in your GUI applications. It will
initialize everything needed to operate the toolkit and parses some standard
command line options. @ARGV is adjusted accordingly so your own code will never
see those standard arguments.

=item -threads-init

Equivalent to Gtk2::Gdk::Threads->init, called to initialze/enable gdk's thread
safety mechanisms so that gdk can be accessed from multiple threads when used
in conjunction with Gtk2::Gdk::Threads->enter and Gtk2::Gdk::Threads->leave. If
invoked as Gtk2::Gdk::Threads->init it should be done before Gtk2->init is
called, if done by "use Gtk2 -init -threads-init" order does not matter.

=back

372
373
374
375
376
377
378
379
380
=head1 EXPORTS

Gtk2 exports nothing by default, but some constants are available upon request.

=over

=item Tag: constants

  GTK_PRIORITY_RESIZE
381
382
383
384
385
386
387
388

  GTK_PATH_PRIO_LOWEST
  GTK_PATH_PRIO_GTK
  GTK_PATH_PRIO_APPLICATION
  GTK_PATH_PRIO_THEME
  GTK_PATH_PRIO_RC
  GTK_PATH_PRIO_HIGHEST

389
390
  GDK_PRIORITY_EVENTS
  GDK_PRIORITY_REDRAW
391
  GDK_CURRENT_TIME
392
393
394
395
396

=back

See L<Glib> for other standard priority levels.

x-gthyni's avatar
x-gthyni committed
397
398
=head1 SEE ALSO

Torsten Schönfeld's avatar
Torsten Schönfeld committed
399
L<perl>(1), L<Glib>(3pm), L<Pango>(3pm).
x-gthyni's avatar
x-gthyni committed
400

401
L<Gtk2::Gdk::Keysyms>(3pm) contains a hash of key codes, culled from
402
403
gdk/gdkkeysyms.h

404
405
L<Gtk2::api>(3pm) describes how to map the C API into Perl, and some of the
important differences in the Perl bindings.
Scott Arrington's avatar
Scott Arrington committed
406

407
L<Gtk2::Helper>(3pm) contains stuff that makes writing Gtk2 programs
Scott Arrington's avatar
Scott Arrington committed
408
409
a little easier.

410
L<Gtk2::SimpleList>(3pm) makes the GtkListStore and GtkTreeModel a I<lot>
Scott Arrington's avatar
Scott Arrington committed
411
412
easier to use.

413
414
L<Gtk2::Pango>(3pm) exports various little-used but important constants you
may need to work with pango directly.
415

Scott Arrington's avatar
Scott Arrington committed
416
417
418
L<Gtk2::index>(3pm) lists the autogenerated api documentation pod files
for Gtk2.

419
Gtk2 also provides code to make it relatively painless to create Perl
420
wrappers for other GLib/Gtk-based libraries.  See L<Gtk2::CodeGen>,
x-rwmcfa1's avatar
x-rwmcfa1 committed
421
L<ExtUtils::PkgConfig>, and L<ExtUtils::Depends>.  If you're writing bindings,
422
423
you'll probably also be interested in L<Gtk2::devel>, which is a supplement
to L<Glib::devel> and L<Glib::xsapi>.  The Binding Howto, at
Scott Arrington's avatar
Scott Arrington committed
424
425
http://gtk2-perl.sourceforge.net/doc/binding_howto.pod.html, ties it all
together.
Scott Arrington's avatar
Scott Arrington committed
426
427

=head1 AUTHORS
x-gthyni's avatar
x-gthyni committed
428

Torsten Schönfeld's avatar
Torsten Schönfeld committed
429
430
=encoding utf8

431
432
The gtk2-perl team:

433
434
435
436
437
438
439
440
 muppet <scott at asofyet dot org>
 Ross McFarland <rwmcfa1 at neces dot com>
 Torsten Schoenfeld <kaffeetisch at web dot de>
 Marc Lehmann <pcg at goof dot com>
 Göran Thyni <gthyni at kirra dot net>
 Jörn Reder <joern at zyn dot de>
 Chas Owens <alas at wilma dot widomaker dot com>
 Guillaume Cottenceau <gc at mandrakesoft dot com>
x-gthyni's avatar
x-gthyni committed
441
442
443

=head1 COPYRIGHT AND LICENSE

Torsten Schönfeld's avatar
Torsten Schönfeld committed
444
Copyright 2003-2011 by the gtk2-perl team.
445
446
447
448
449
450
451
452
453
454

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 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.
x-gthyni's avatar
x-gthyni committed
455

456
You should have received a copy of the GNU Library General Public
Torsten Schönfeld's avatar
Torsten Schönfeld committed
457
458
License along with this library; if not, write to the
Free Software Foundation, Inc., 59 Temple Place - Suite 330,
459
Boston, MA  02111-1307  USA.
x-gthyni's avatar
x-gthyni committed
460
461

=cut