^sub \w+\(& results from the CPAN

220
221
222
223
224
225
226
227
228
229
230     label => $name,
  });
}
 
# around CODE
sub around(&) {
  my $package = caller;
  my $code = pop;
  if (ref($code) ne 'CODE') {
    Carp::croak "expected subroutine reference as last argument";
  }

view all matches for this distribution

Test-Stream

7 results

lib/Test/Stream/Plugin/Capture.pm view on Meta::CPAN

7
8
9
10
11
12
13
14
15
16
17  
use Test::Stream::Exporter qw/import default_exports/;
default_exports qw/capture/;
no Test::Stream::Exporter;
 
sub capture(&) {
    my $code = shift;
 
    my ($err, $out) = ("", "");
 
    my ($ok, $e);

view all matches for this distribution

Test-StructuredObject

1 match

lib/Test/StructuredObject.pm view on Meta::CPAN

26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41  
};
 
## no critic ( ProhibitSubroutinePrototypes, RequireArgUnpacking )
 
sub test(&;@) {
  my $code = shift;
  return Test::StructuredObject::Test->new( code => $code ), @_;
}
 
sub step(&;@) {
  my $code = shift;
  return Test::StructuredObject::NonTest->new( code => $code ), @_;
}
 
sub testsuite(@) {

view all matches for this distribution

Test-Tail-Multi

1 match

lib/Test/Tail/Multi.pm view on Meta::CPAN

59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74   my($file, $comment) = @_;
  push @monitored, File::Tail->new($file);
  $Test->diag($comment) if defined $comment;
}
 
sub contents_like(&$;$) {
  my ($coderef, $pattern, $comment) = @_;
  _execute($coderef, $pattern, sub { $Test->like(@_) }, $comment);
}
 
sub contents_unlike(&$;$) {
  my ($coderef, $pattern, $comment) = @_;
  _execute($coderef, $pattern, sub { $Test->unlike(@_) }, $comment);
}
 
sub _execute {

view all matches for this distribution

Test-Time

1 match

260
261
262
263
264
265
266
267
268
269
270         ok $actual eq $expected,
           $name . "\n" . Text::Diff::diff(\$expected, \$actual);
    }
}
 
sub run(&;$) {
    (my ($self), @_) = find_my_self(@_);
    my $callback = shift;
    for my $block (@{$self->block_list}) {
        $block->run_filters unless $block->is_filtered;
        &{$callback}($block);

view all matches for this distribution

Test-TinyMocker

1 match

lib/Test/TinyMocker.pm view on Meta::CPAN

13
14
15
16
17
18
19
20
21
22  
@EXPORT = qw(mock unmock should method methods);
 
sub method($)  {@_}
sub methods($) {@_}
sub should(&)  {@_}
 
sub mock {
    croak 'useless use of mock with one or less parameter'
      if scalar @_ < 2;

view all matches for this distribution

Test-Trap

4 results

t/03-files.pl view on Meta::CPAN

50
51
52
53
54
55
56
57
58
59
60   diag $msg;
  die $msg;
}
 
my ($noise, $noisecounter) = ('', 0);
sub runtests(&@) { # runs the trap and performs 6 tests
  my($code, $return, $warn, $stdout, $stderr, $desc) = @_;
  my $n = ++$noisecounter . $/;
  warn $n or diagdie "Cannot warn()!";
  STDERR->flush or diagdie "Cannot flush STDERR!";
  print STDERR $n or diagdie "Cannot print on STDERR!";

view all matches for this distribution

Test-Warnings

2 results

lib/Test/Warnings.pm view on Meta::CPAN

104
105
106
107
108
109
110
111
112
113
114     };
    $code->();
    @warnings;
}
 
sub warning(&) {
    my @warnings = &warnings(@_);
    return @warnings == 1 ? $warnings[0] : \@warnings;
}
 
# check for any forbidden warnings, and record that we have done so

view all matches for this distribution

Test2-Harness-UI

1 match

t/HashBase.t view on Meta::CPAN

2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20 use warnings;
 
use Test::More;
 
 
sub warnings(&) {
    my $code = shift;
    my @warnings;
    local $SIG{__WARN__} = sub { push @warnings => @_ };
    $code->();
    return \@warnings;
}
 
sub exception(&) {
    my $code = shift;
    local ($@, $!, $SIG{__DIE__});
    my $ok = eval { $code->(); 1 };
    my $error = $@ || 'SQUASHED ERROR';
    return $ok ? undef : $error;

view all matches for this distribution

Test2-Harness

1 match

t/HashBase.t view on Meta::CPAN

2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20 use warnings;
 
use Test::More;
 
 
sub warnings(&) {
    my $code = shift;
    my @warnings;
    local $SIG{__WARN__} = sub { push @warnings => @_ };
    $code->();
    return \@warnings;
}
 
sub exception(&) {
    my $code = shift;
    local ($@, $!, $SIG{__DIE__});
    my $ok = eval { $code->(); 1 };
    my $error = $@ || 'SQUASHED ERROR';
    return $ok ? undef : $error;

view all matches for this distribution

Test2-Suite

5 results

lib/Test2/Tools/Compare.pm view on Meta::CPAN

200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216  
    $ctx->release;
    return $delta ? 1 : 0;
}
 
sub meta(&)       { build('Test2::Compare::Meta',          @_) }
sub meta_check(&) { build('Test2::Compare::Meta',          @_) }
sub hash(&)       { build('Test2::Compare::Hash',          @_) }
sub array(&)      { build('Test2::Compare::Array',         @_) }
sub bag(&)        { build('Test2::Compare::Bag',           @_) }
sub object(&)     { build('Test2::Compare::Object',        @_) }
sub subset(&)     { build('Test2::Compare::OrderedSubset', @_) }
 
sub U() {
    my @caller = caller;
    Test2::Compare::Custom->new(
        code => sub { defined $_ ? 0 : 1 }, name => 'UNDEFINED', operator => '!DEFINED()',

lib/Test2/Tools/Compare.pm view on Meta::CPAN

467
468
469
470
471
472
473
474
475
476         input => $class_name,
        @args,
    );
}
 
sub filter_items(&) {
    defined( my $build = get_build() ) or croak "No current build!";
 
    croak "'$build' does not support filters"
        unless $build->can('add_filter');

view all matches for this distribution

Test2-Tools-Process

1 match

lib/Test/Exec.pm view on Meta::CPAN

15
16
17
18
19
20
21
22
23
24 our @EXPORT = qw( exec_arrayref never_exec_ok );
 
 
my $last;
 
sub exec_arrayref(&)
{
  my($code) = @_;
 
  undef $last;

view all matches for this distribution

Text-Bayon

1 match

262
263
264
265
266
267
268
269
270
271
272         ok $actual eq $expected,
           $name . "\n" . Text::Diff::diff(\$expected, \$actual);
    }
}
 
sub run(&;$) {
    (my ($self), @_) = find_my_self(@_);
    my $callback = shift;
    for my $block (@{$self->block_list}) {
        $block->run_filters unless $block->is_filtered;
        &{$callback}($block);

view all matches for this distribution

Text-CSV-Flatten

1 match

lib/Text/CSV/Flatten.pm view on Meta::CPAN

135
136
137
138
139
140
141
142
143
144
145     return join "\n", @result;
}
 
# utility function to iterate over key => value pairs with the added
# bonus that it also works for arrays
sub _foreach(&$) {
    my ($codeblock, $it)= @_;
 
    if(!defined $it || !ref $it) {
        return;
    } elsif('ARRAY' eq ref $it) {

view all matches for this distribution

Text-CSV-Unicode

1 match

t/unicode.t view on Meta::CPAN

69
70
71
72
73
74
75
76
77
78
79 ok( $csv->version(), 'inheritted version() works');
 
ok( $csv->isa('Text::CSV::Unicode'), 'creates a Text::CSV::Unicode object' );
 
my $warn;
sub _warning(&) {
    my $sub = shift;
    local $SIG{__WARN__} = sub { $warn .= $_[0]; };
    $warn = q{};
    return $sub->();
}

view all matches for this distribution

Text-CSV_PP-Simple

1 match

261
262
263
264
265
266
267
268
269
270
271         ok $actual eq $expected,
           $name . "\n" . Text::Diff::diff(\$expected, \$actual);
    }
}
 
sub run(&;$) {
    (my ($self), @_) = find_my_self(@_);
    my $callback = shift;
    for my $block (@{$self->block_list}) {
        $block->run_filters unless $block->is_filtered;
        &{$callback}($block);

view all matches for this distribution

Text-Glob-DWIW

1 match

lib/Text/Glob/DWIW.pm view on Meta::CPAN

267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283 #~ forester
sub _flatten (@) { map { _reft($_) ? &_flatten(_deref $_) : $_ } @_ }
sub _markflt (@) { join'',map { _reft($_) ? '('.&_markflt(_deref$_).')' : $_ } @_ }#4capture
sub _treejoin($) { join'',&_flatten } # fixed ''
sub _forestjoin  { map { join'',_flatten $_ } @_ }
sub _treemap(&@) { my$f=shift; map{ _reft($_)?_doref &_treemap($f,_deref $_):$f->($_) } @_}
sub _forestmap(&@) {my$f=shift; map [&_treemap($f,@$_)], @_ }
sub _treefor1(&@){ my $f=shift; for (@_) { my$t=_reft $_; !$t ? $f->($_) :
                   &_treefor1($f,'ARRAY'eq$t?@$_:$t=~/SCAL|REF/?$$_:$_) } }
# ^- was: ...&_treefor1($f,_deref $_).. with _deref :lvalue but this bail out under 5.10
#         with "Bizarre copy of ARRAY in sassign at line 25 or in overload::Method ...."
sub _treefirst(&@) { my $f=shift; my $t=_reft $_[0]; !$t ? do{$f->($_[0])for$_[0]} :
                     &_treefirst($f, 'ARRAY'eq$t ? $_[0][0] : ${$_[0]}) }
sub _drop_anchor ($;$$) # rm outside anchors
{ my ($v,$xaa,$xae)=@_; return unless $xaa||$xae; my($A,$a,$e,$pos)=(0,0,0,0);
  while ($pos<@$v)
  { if (_reft $v->[$pos]) { ($a,$e)=&_drop_anchor($v->[$pos],$xaa,$xae); $A||=$a }

view all matches for this distribution

Text-MacroScript

10 results

t/expand_file.t view on Meta::CPAN

13
14
15
16
17
18
19
20
21
22
23  
use_ok 'Text::MacroScript';
push @INC, path($0)->dirname;
require_ok 'mytests.pl';
 
sub void(&) { $_[0]->(); () }
 
my $ms;
my $fh;
my($out,$err,@res);
my $file = "test~";

view all matches for this distribution

Text-MicroMason-SafeServerPages

1 match

255
256
257
258
259
260
261
262
263
264
265         ok $actual eq $expected,
           $name . "\n" . Text::Diff::diff(\$expected, \$actual);
    }
}
 
sub run(&;$) {
    (my ($self), @_) = find_my_self(@_);
    my $callback = shift;
    for my $block (@{$self->block_list}) {
        $block->run_filters unless $block->is_filtered;
        &{$callback}($block);

view all matches for this distribution

Text-MicroTemplate-Extended

1 match

260
261
262
263
264
265
266
267
268
269
270         ok $actual eq $expected,
           $name . "\n" . Text::Diff::diff(\$expected, \$actual);
    }
}
 
sub run(&;$) {
    (my ($self), @_) = find_my_self(@_);
    my $callback = shift;
    for my $block (@{$self->block_list}) {
        $block->run_filters unless $block->is_filtered;
        &{$callback}($block);

view all matches for this distribution

Text-Reform

1 match

t/reform.t view on Meta::CPAN

12
13
14
15
16
17
18
19
20
21
22 BEGIN {
  use_ok( 'Text::Reform', qw{ form tag break_at break_wrap break_with });
}
#my $testnum = 1;
#use Data::Dumper 'Dumper';
sub teststr(&$;$) # (&sub, $retval)
{
        do { #$testnum++;
             my $res = &{$_[0]};
             my $exp = $_[1];
             my $message=$_[2];

view all matches for this distribution

Text-Table-Boxed

1 match

t/t_TestCommon.pm view on Meta::CPAN

391
392
393
394
395
396
397
398
399
400
401   open($orig_stdERR, ">&", \*STDERR) or die "dup STDERR: $!";
  close STDERR;
  open(STDERR, ">", \$inmem_stdERR) or die "redir STDERR: $!";
  binmode(STDERR); binmode(STDERR, ":utf8");
}
sub silent(&) {
  my $wantarray = wantarray;
  my $code = shift;
  _start_silent();
  my @result = do{
    if (defined $wantarray) {

t/t_TestCommon.pm view on Meta::CPAN

772
773
774
775
776
777
778
779
780
781
782   my ($fn, $lno) = (caller(0))[1,2];
#use Data::Dumper::Interp; say dvis '###insert_loc_in_evalstr $fn $lno';
  "# line $lno \"$fn\"\n".$orig
}
 
sub timed_run(&$@) {
  my ($code, $maxcpusecs, @codeargs) = @_;
 
  my $getcpu = eval {do{
    require Time::HiRes;
    () = (&Time::HiRes::clock());

t/t_TestCommon.pm view on Meta::CPAN

818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836   # to the cwd!
  $str =~ s/The media is write protected\S*\R//gs;
  $str
}
 
sub my_capture(&) {
  my ($out, $err, @results) = &capture($_[0]);
  return( clean_capture_output($out), clean_capture_output($err), @results );
}
sub my_capture_merged(&) {
  my ($merged, @results) = &capture_merged($_[0]);
  return( clean_capture_output($merged), @results );
}
sub my_tee_merged(&) {
  my ($merged, @results) = &tee_merged($_[0]);
  return( clean_capture_output($merged), @results );
}
 
1;

view all matches for this distribution

Text-Table-Read-RelationOn-Tiny

1 match

t/03-errorcases.t view on Meta::CPAN

6
7
8
9
10
11
12
13
14
15
16
17  
use Text::Table::Read::RelationOn::Tiny;
 
use constant RELATION_ON => "Text::Table::Read::RelationOn::Tiny"; # to make calls shorter.
 
sub err_like(&$);
sub no_err(&);
 
{
  note("Constructor args");
  err_like {RELATION_ON->new(1)}                        qr/^Odd number of arguments/;
  err_like {RELATION_ON->new(foo => 1)}                 qr/^foo\b.*unexpected argument/;

t/03-errorcases.t view on Meta::CPAN

361
362
363
364
365
366
367
368
369
370
371 #
# err_like CODEREF, MSGREGEX
#
# Check if CODEREF fails with error message matching MSGREGEX.
#
sub err_like(&$) {
  my ($sub, $re) = @_;
  local $Test::Builder::Level = $Test::Builder::Level + 1;
  eval {$sub->()};
  if ($@) {
    (my $err = $@) =~ s/\n.*//s;  ## Important: cut off stacktrace

t/03-errorcases.t view on Meta::CPAN

374
375
376
377
378
379
380
381
382
383
384     fail("Code did not produce error");
    return "";
  }
}
 
sub no_err(&) {
  my ($sub) = @_;
  local $Test::Builder::Level = $Test::Builder::Level + 1;
  eval {$sub->()};
  ok(!$@, "Code did not produce an error $@");
}

view all matches for this distribution

Text-TestBase

1 match

lib/Test/Base/Less.pm view on Meta::CPAN

79
80
81
82
83
84
85
86
87
88
89         }
    }
    return @retval;
}
 
sub run(&) {
    my $code = shift;
 
    for my $block (_get_blocks(scalar(caller(0)))) {
        __PACKAGE__->builder->subtest($block->name || 'L: ' . $block->get_lineno, sub {
            $code->($block);

view all matches for this distribution

Text-Xatena

1 match

260
261
262
263
264
265
266
267
268
269
270         ok $actual eq $expected,
           $name . "\n" . Text::Diff::diff(\$expected, \$actual);
    }
}
 
sub run(&;$) {
    (my ($self), @_) = find_my_self(@_);
    my $callback = shift;
    for my $block (@{$self->block_list}) {
        $block->run_filters unless $block->is_filtered;
        &{$callback}($block);

view all matches for this distribution

Text-Xslate

3 results

t/030_kolon/033_ov_forloop.t view on Meta::CPAN

13
14
15
16
17
18
19
20
21
22
23  
    package _str;
    use overload '""' => sub { 'foo' };
}
 
sub defer(&) {
    my($coderef) = @_;
    return bless $coderef, '_defer';
}
 
my $tx = Text::Xslate->new(verbose => 0);

view all matches for this distribution

ThaiSchema

1 match

t/01_types.t view on Meta::CPAN

5
6
7
8
9
10
11
12
13
14
15
16
17
18
19 use ThaiSchema;
use JSON ();
 
BEGIN { *describe = *context = *it = *Test::More::subtest }
 
sub strict_context(&) {
    local $ThaiSchema::STRICT = 1;
    $_[0]->();
}
sub normal_context(&) {
    local $ThaiSchema::STRICT = 0;
    $_[0]->();
}
 
describe 'int' => sub {

view all matches for this distribution

TheSchwartz-Simple

1 match

261
262
263
264
265
266
267
268
269
270
271         ok $actual eq $expected,
           $name . "\n" . Text::Diff::diff(\$expected, \$actual);
    }
}
 
sub run(&;$) {
    (my ($self), @_) = find_my_self(@_);
    my $callback = shift;
    for my $block (@{$self->block_list}) {
        $block->run_filters unless $block->is_filtered;
        &{$callback}($block);

view all matches for this distribution

Tickit-DSL

1 match

250
251
252
253
254
255
256
257
258
259
260  
Will run the code after the next round of I/O events.
 
=cut
 
sub later(&) {
    my $code = shift;
    tickit->later($code)
}
 
=head2 timer

272
273
274
275
276
277
278
279
280
281
282 Takes a codeblock and either C<at> or C<after> definitions. Passing
anything other than a single definition will cause an exception.
 
=cut
 
sub timer(&@) {
    my $code = shift;
    my %args = @_;
    die 'when did you want to run the code?' unless 1 == grep exists $args{$_}, qw(at after);
    tickit->timer(%args, $code);
}

293
294
295
296
297
298
299
300
301
302
303  
Returns the widget we added the new widgets under (i.e. the C< under > parameter).
 
=cut
 
sub add_widgets(&@) {
    my $code = shift;
    my %args = @_;
    local $PARENT = delete $args{under} or die 'expected add_widgets { ... } under => $some_widget;';
    local @WIDGET_ARGS = (@WIDGET_ARGS, %args);
    $code->($PARENT);

324
325
326
327
328
329
330
331
332
333
334    ...
 } classes => [qw(other vbox)], style => { fg => 'green' };
 
=cut
 
sub vbox(&@) {
    my ($code, %args) = @_;
    my %parent_args = map {; $_ => delete $args{'parent:' . $_} } map /^parent:(.*)/ ? $1 : (), keys %args;
    my $w = Tickit::Widget::VBox->new(%args);
    {
        local $PARENT = $w;

354
355
356
357
358
359
360
361
362
363
364    ...
 } classes => [qw(other vsplit)], style => { fg => 'green' };
 
=cut
 
sub vsplit(&@) {
    my ($code, %args) = @_;
    my %parent_args = map {; $_ => delete $args{'parent:' . $_} } map /^parent:(.*)/ ? $1 : (), keys %args;
    my $w = do {
        local $PARENT = 'Tickit::Widget::VSplit';
        local @PENDING_CHILD;

385
386
387
388
389
390
391
392
393
394
395    ...
 } title => 'some frame', title_align => 0.5;
 
=cut
 
sub frame(&@) {
    my ($code, %args) = @_;
    my %parent_args = map {; $_ => delete $args{'parent:' . $_} } map /^parent:(.*)/ ? $1 : (), keys %args;
    my $w = Tickit::Widget::Frame->new(%args);
    {
        local $PARENT = $w;

416
417
418
419
420
421
422
423
424
425
426    gridrow { static 'BL'; static 'BR' };
 } style => { col_spacing => 1, row_spacing => 1 };
 
=cut
 
sub gridbox(&@) {
    my ($code, %args) = @_;
    my %parent_args = map {; $_ => delete $args{'parent:' . $_} } map /^parent:(.*)/ ? $1 : (), keys %args;
    my $w = Tickit::Widget::GridBox->new(%args);
    {
        local $PARENT = $w;

437
438
439
440
441
442
443
444
445
446
447 Marks a separate row in an existing L<Tickit::Widget::GridBox>. This behaves
something like a container, see L</gridbox> for details.
 
=cut
 
sub gridrow(&@) {
    my ($code) = @_;
    die "Grid rows must be in a gridbox" unless $PARENT->isa('Tickit::Widget::GridBox');
    $code->($PARENT);
    $GRID_COL = 0;
    ++$GRID_ROW;

463
464
465
466
467
468
469
470
471
472
473    ...
 } classes => [qw(other hbox)], style => { fg => 'green' };
 
=cut
 
sub hbox(&@) {
    my ($code, %args) = @_;
    my %parent_args = map {; $_ => delete $args{'parent:' . $_} } map /^parent:(.*)/ ? $1 : (), keys %args;
    my $w = Tickit::Widget::HBox->new(%args);
    {
        local $PARENT = $w;

493
494
495
496
497
498
499
500
501
502
503    ...
 } classes => [qw(other hsplit)], style => { fg => 'green' };
 
=cut
 
sub hsplit(&@) {
    my ($code, %args) = @_;
    my %parent_args = map {; $_ => delete $args{'parent:' . $_} } map /^parent:(.*)/ ? $1 : (), keys %args;
    my $w = do {
        local $PARENT = 'Tickit::Widget::HSplit';
        local @PENDING_CHILD;

527
528
529
530
531
532
533
534
535
536
537     'parent:top' => 1;
 };
 
=cut
 
sub desktop(&@) {
    my ($code, %args) = @_;
    my %parent_args = map {; $_ => delete $args{'parent:' . $_} } map /^parent:(.*)/ ? $1 : (), keys %args;
    my $w = Tickit::Widget::Layout::Desktop->new(%args);
    {
        tickit->later(sub {

550
551
552
553
554
555
556
557
558
559
560  
See L</pane> for the details.
 
=cut
 
sub relative(&@) {
    my ($code, %args) = @_;
    my %parent_args = map {; $_ => delete $args{'parent:' . $_} } map /^parent:(.*)/ ? $1 : (), keys %args;
    my $w = Tickit::Widget::Layout::Relative->new(%args);
    {
        local @WIDGET_ARGS;

571
572
573
574
575
576
577
578
579
580
581  
A pane in a L</relative> layout.
 
=cut
 
sub pane(&@) {
    my ($code, %args) = @_;
    die "pane should be used within a relative { ... } item" unless $PARENT->isa('Tickit::Widget::Layout::Relative');
    {
        local @WIDGET_ARGS = (@WIDGET_ARGS, %args);
        $code->($PARENT);

600
601
602
603
604
605
606
607
608
609
610    ...
 } class => 'some_hsplit';
 
=cut
 
sub scrollbox(&@) {
    my ($code, %args) = @_;
    my %parent_args = map {; $_ => delete $args{'parent:' . $_} } map /^parent:(.*)/ ? $1 : (), keys %args;
    my $w = do {
        local $PARENT = 'Tickit::Widget::ScrollBox';
        local @PENDING_CHILD;

634
635
636
637
638
639
640
641
642
643
644    scroller_text 'line ' . $_ for 1..100;
 } gravity => 'bottom';
 
=cut
 
sub scroller(&@) {
    my ($code, %args) = @_;
    my %parent_args = map {; $_ => delete $args{'parent:' . $_} } map /^parent:(.*)/ ? $1 : (), keys %args;
    my $w = Tickit::Widget::Scroller->new(%args);
    {
        local $PARENT = $w;

697
698
699
700
701
702
703
704
705
706
707 at runtime, so it may throw an exception if it is not
already installed.
 
=cut
 
sub console(&@) {
    require "Tickit" . "/Console.pm";
    my %args = (on_line => @_);
    my %parent_args = map {; $_ => delete $args{'parent:' . $_} } map /^parent:(.*)/ ? $1 : (), keys %args;
    my $w = Tickit::Console->new(
        %args

773
774
775
776
777
778
779
780
781
782
783  
The C<ribbon_class> parameter may be undocumented.
 
=cut
 
sub tabbed(&@) {
    my ($code, %args) = @_;
    my %parent_args = map {; $_ => delete $args{'parent:' . $_} } map /^parent:(.*)/ ? $1 : (), keys %args;
    my $w = Tickit::Widget::Tabbed->new(%args);
    {
        local $PARENT = $w;

803
804
805
806
807
808
809
810
811
812
813   }
 }
 
=cut
 
sub floatbox(&@) {
    my ($code, %args) = @_;
    my %parent_args = map {; $_ => delete $args{'parent:' . $_} } map /^parent:(.*)/ ? $1 : (), keys %args;
    my $w = Tickit::Widget::FloatBox->new(%args);
    {
        local $PARENT = $w;

832
833
834
835
836
837
838
839
840
841
842   }
 }
 
=cut
 
sub float(&@) {
    my ($code, %args) = @_;
    my %parent_args = map {; $_ => delete $args{'parent:' . $_} } map /^parent:(.*)/ ? $1 : (), keys %args;
 
    # Work out which container to use - either the least-distant ancestor,
    # or a specific floatbox if one was provided

863
864
865
866
867
868
869
870
871
872
873  
A L<Tickit::Widget::Statusbar>. Not very exciting.
 
=cut
 
sub statusbar(&@) {
    my ($code, %args) = @_;
    my %parent_args = map {; $_ => delete $args{'parent:' . $_} } map /^parent:(.*)/ ? $1 : (), keys %args;
    my $w = Tickit::Widget::Statusbar->new(%args);
    {
        local $PARENT = $w;

933
934
935
936
937
938
939
940
941
942
943  my $rslt = static 'result here';
 entry { shift; $rslt->set_text(eval shift) } text => '1 + 3';
 
=cut
 
sub entry(&@) {
    my %args = (on_enter => @_);
    my %parent_args = map {; $_ => delete $args{'parent:' . $_} } map /^parent:(.*)/ ? $1 : (), keys %args;
    my $w = Tickit::Widget::Entry->new(
        %args
    );

949
950
951
952
953
954
955
956
957
958
959  
Checkbox (or checkbutton).
 
=cut
 
sub checkbox(&@) {
    my %args = (on_toggle => @_);
    my %parent_args = map {; $_ => delete $args{'parent:' . $_} } map /^parent:(.*)/ ? $1 : (), keys %args;
    my $w = Tickit::Widget::CheckButton->new(
        %args
    );

969
970
971
972
973
974
975
976
977
978
979   radiobutton { } 'three';
 };
 
=cut
 
sub radiobutton(&@) {
    my $code = shift;
    die "need a radiogroup" unless $RADIOGROUP;
    my %args = (
        group => $RADIOGROUP,
        label => @_

991
992
993
994
995
996
997
998
999
1000
1001  
See L</radiobutton>.
 
=cut
 
sub radiogroup(&@) {
    my $code = shift;
    my %args = @_;
    # my %parent_args = map {; $_ => delete $args{'parent:' . $_} } map /^parent:(.*)/ ? $1 : (), keys %args;
    my $group = Tickit::Widget::RadioButton::Group->new;
    $group->set_on_changed(delete $args{on_changed}) if exists $args{on_changed};

1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022  
 button { warn "Activated" } 'OK';
 
=cut
 
sub button(&@) {
    my $code = shift;
    my %args = (
        label => @_
    );
    my %parent_args = map {; $_ => delete $args{'parent:' . $_} } map /^parent:(.*)/ ? $1 : (), keys %args;

1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061     ],
 ];
 
=cut
 
sub tree(&@) {
    my %args = (on_activate => @_);
    my %parent_args = map {; $_ => delete $args{'parent:' . $_} } map /^parent:(.*)/ ? $1 : (), keys %args;
 
    my $w = Tickit::Widget::Tree->new(
        %args

1079
1080
1081
1082
1083
1084
1085
1086
1087
1088
1089   { label => 'Description' },
 ];
 
=cut
 
sub table(&@) {
    my %args = (on_activate => @_);
    my %parent_args = map {; $_ => delete $args{'parent:' . $_} } map /^parent:(.*)/ ? $1 : (), keys %args;
    my $w = Tickit::Widget::Table->new(
        %args
    );

1101
1102
1103
1104
1105
1106
1107
1108
1109
1110
1111  };
 $bc->adapter->push([qw(some path here)]);
 
=cut
 
sub breadcrumb(&@) {
    my %args = (on_activate => @_);
    my %parent_args = map {; $_ => delete $args{'parent:' . $_} } map /^parent:(.*)/ ? $1 : (), keys %args;
    my $w = Tickit::Widget::Breadcrumb->new(
        %args
    );

1170
1171
1172
1173
1174
1175
1176
1177
1178
1179
1180  
 fileviewer { } 'somefile.txt';
 
=cut
 
sub fileviewer(&;@) {
    my ($code, $file) = splice @_, 0, 2;
    my %args = (
        @_,
        file => $file
    );

1227
1228
1229
1230
1231
1232
1233
1234
1235
1236
1237  
=cut
 
# haxx. A menubar has no link back to the container.
our $MENU_PARENT;
sub menubar(&@) {
    my ($code, %args) = @_;
    my %parent_args = map {; $_ => delete $args{'parent:' . $_} } map /^parent:(.*)/ ? $1 : (), keys %args;
    my $w = Tickit::Widget::MenuBar->new(%args);
    local $MENU_PARENT = $PARENT;
    {

1314
1315
1316
1317
1318
1319
1320
1321
1322
1323
1324   $tbl;
 } expand => 1;
 
=cut
 
sub customwidget(&@) {
    my ($code, @args) = @_;
    my %args = @args;
    local $PARENT = delete($args{parent}) || $PARENT;
    my $w = $code->($PARENT);
    {

1355
1356
1357
1358
1359
1360
1361
1362
1363
1364
1365    static => '66%' 'parent:expand' => 2;
 };
 
=cut
 
sub widget(&@) {
    my ($code, %args) = @_;
    local $PARENT = delete($args{parent}) || $PARENT;
    {
        local @WIDGET_ARGS = (@WIDGET_ARGS, %args);
        $code->($PARENT);

view all matches for this distribution

Tickit-Widget-Table

2 results