Tickit-DSL

 view release on metacpan or  search on metacpan

lib/Tickit/DSL.pm  view on Meta::CPAN

245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
Defers a block of code.
 
 later {
  print "this happened later\n";
 };
 
Will run the code after the next round of I/O events.
 
=cut
 
sub later(&) {
    my $code = shift;
    tickit->later($code)
}
 
=head2 timer
 
Sets up a timer to run a block of code later.
 
 timer {
  print "about a second has passed\n";

lib/Tickit/DSL.pm  view on Meta::CPAN

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
303
304
305
306
307
 
 timer {
  print "about a minute has passed\n";
 } at => time + 60;
 
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);
}
 
=head2 add_widgets
 
Adds some widgets under an existing widget.
 
 my $some_widget = vbox { };
 add_widgets {
  vbox { ... };
  hbox { ... };
 } under => $some_widget;
 
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);
    $PARENT;
}
 
=head1 FUNCTIONS - Layout

lib/Tickit/DSL.pm  view on Meta::CPAN

319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
 
 vbox {
   ...
 } class => 'some_vbox';
 vbox {
   ...
 } 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;
        $code->($w);
    }
    local @WIDGET_ARGS = (@WIDGET_ARGS, %parent_args);
    apply_widget($w);
}

lib/Tickit/DSL.pm  view on Meta::CPAN

349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
 
 vsplit {
   ...
 } class => 'some_vsplit';
 vsplit {
   ...
 } 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;
        $code->();
        Tickit::Widget::VSplit->new(
            left_child  => $PENDING_CHILD[0],
            right_child => $PENDING_CHILD[1],
            %args,

lib/Tickit/DSL.pm  view on Meta::CPAN

380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
 
Any additional parameters will be passed to the new L<Tickit::Widget::Frame>
instance:
 
 frame {
   ...
 } 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;
        $code->($w);
    }
    local @WIDGET_ARGS = (@WIDGET_ARGS, %parent_args);
    apply_widget($w);
}

lib/Tickit/DSL.pm  view on Meta::CPAN

411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
Any additional parameters will be passed to the new L<Tickit::Widget::GridBox>
instance:
 
 gridbox {
   gridrow { static 'left'; static 'right' };
   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;
        local $GRID_COL = 0;
        local $GRID_ROW = 0;
        $code->($w);
    }
    local @WIDGET_ARGS = (@WIDGET_ARGS, %parent_args);
    apply_widget($w);
}
 
=head2 gridrow
 
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;
}
 
=head2 hbox
 
Creates a L<Tickit::Widget::HBox>. This is a container, so the first

lib/Tickit/DSL.pm  view on Meta::CPAN

458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
 
 hbox {
   ...
 } class => 'some_hbox';
 hbox {
   ...
 } 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;
        $code->($w);
    }
    local @WIDGET_ARGS = (@WIDGET_ARGS, %parent_args);
    apply_widget($w);
}

lib/Tickit/DSL.pm  view on Meta::CPAN

488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
 
 hsplit {
   ...
 } class => 'some_hsplit';
 hsplit {
   ...
 } 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;
        $code->();
        Tickit::Widget::HSplit->new(
            top_child    => $PENDING_CHILD[0],
            bottom_child => $PENDING_CHILD[1],
            %args

lib/Tickit/DSL.pm  view on Meta::CPAN

522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
  my $txt = static 'a static widget', 'parent:label' => 'static';
  entry {
   $txt->set_text($_[1])
  } 'parent:label' => 'entry widget',
    'parent:left' => 1,
    '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 {
            local @WIDGET_ARGS;
            local $PARENT = $w;
            $code->($w);
        });
    }

lib/Tickit/DSL.pm  view on Meta::CPAN

545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
        apply_widget($w);
    }
}
 
=head2 relative
 
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;
        local $PARENT = $w;
        $code->($w);
    }
    {
        local @WIDGET_ARGS = (@WIDGET_ARGS, %parent_args);
        apply_widget($w);
    }
}
 
=head2 pane
 
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);
    }
}
 
=head1 FUNCTIONS - Scrolling

lib/Tickit/DSL.pm  view on Meta::CPAN

595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
 
Any additional parameters will be passed to the new L<Tickit::Widget::ScrollBox>
instance:
 
 scrollbox {
   ...
 } 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;
        $code->();
 
        Tickit::Widget::ScrollBox->new(
            child => $PENDING_CHILD[0],
            %args

lib/Tickit/DSL.pm  view on Meta::CPAN

629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
 };
 
Passes any additional args to the constructor:
 
 scroller {
   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;
        $code->($w);
    }
    local @WIDGET_ARGS = (@WIDGET_ARGS, %parent_args);
    apply_widget($w);
}

lib/Tickit/DSL.pm  view on Meta::CPAN

692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
although a future version may provide C< console_tab >
as a helper function for adding tabs to an existing
console.
 
Note that this will attempt to load L<Tickit::Console>
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
    );
    local @WIDGET_ARGS = (@WIDGET_ARGS, %parent_args);
    apply_widget($w);
    $w
}

lib/Tickit/DSL.pm  view on Meta::CPAN

768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
 
 tabbed {
   static 'some text' 'parent:label' => 'first tab';
   static 'other text' 'parent:label' => 'second tab';
 } ribbon_class => 'Some::Ribbon::Class', tab_position => 'top';
 
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;
        $code->($w);
    }
    local @WIDGET_ARGS = (@WIDGET_ARGS, %parent_args);
    apply_widget($w);
}

lib/Tickit/DSL.pm  view on Meta::CPAN

798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
   button {
    float {
     static 'this is a float'
    } lines => 3, top => -1, left => '-50%';
   } 'Show';
  }
 }
 
=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;
        $code->($w);
    }
    local @WIDGET_ARGS = (@WIDGET_ARGS, %parent_args);
    apply_widget($w);
}

lib/Tickit/DSL.pm  view on Meta::CPAN

827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
   button {
    float {
     static 'this is a float'
    } lines => 3, top => -1, left => '-50%';
   } 'Show';
  }
 }
 
=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
    my $floatbox = delete($args{container}) || $PARENT;
    while($floatbox && !$floatbox->isa('Tickit::Widget::FloatBox')) {
        $floatbox = $floatbox->parent;
    }
    die "No floatbox found for this float" unless $floatbox;

lib/Tickit/DSL.pm  view on Meta::CPAN

858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
        $code->($float);
    };
}
 
=head2 statusbar
 
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;
        $code->($w);
    }
    local @WIDGET_ARGS = (@WIDGET_ARGS, %parent_args);
    apply_widget($w);
}

lib/Tickit/DSL.pm  view on Meta::CPAN

928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
=head2 entry
 
A L<Tickit::Widget::Entry> input field. Takes a coderef as the first parameter
since the C<on_enter> handler seems like an important feature.
 
 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
    );
    local @WIDGET_ARGS = (@WIDGET_ARGS, %parent_args);
    apply_widget($w);
}
 
=head2 checkbox
 
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
    );
    local @WIDGET_ARGS = (@WIDGET_ARGS, %parent_args);
    apply_widget($w);
}
 
=head2 radiobutton
 
 radiogroup {
  radiobutton { } 'one';
  radiobutton { } 'two';
  radiobutton { } 'three';
 };
 
=cut
 
sub radiobutton(&@) {
    my $code = shift;
    die "need a radiogroup" unless $RADIOGROUP;
    my %args = (
        group => $RADIOGROUP,
        label => @_
    );
    my %parent_args = map {; $_ => delete $args{'parent:' . $_} } map /^parent:(.*)/ ? $1 : (), keys %args;
    my $w = Tickit::Widget::RadioButton->new(%args);
    $w->set_on_toggle($code);
    {

lib/Tickit/DSL.pm  view on Meta::CPAN

986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
        apply_widget($w);
    }
}
 
=head2 radiogroup
 
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};
    {
        local $RADIOGROUP = $group;
        $code->();
    }
}
 
=head2 button
 
A button. First parameter is the code to run when activated,
second parameter is the label:
 
 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;
    my $w = Tickit::Widget::Button->new(
        %args
    );
    $w->set_on_click(sub {
        local $PARENT = $w->parent;

lib/Tickit/DSL.pm  view on Meta::CPAN

1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
    node2 => [
        qw(more nodes in this one),
        and => [
            qw(this has a few child nodes too)
        ]
    ],
 ];
 
=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
    );
    local @WIDGET_ARGS = (@WIDGET_ARGS, %parent_args);
    apply_widget($w);
    $w
}

lib/Tickit/DSL.pm  view on Meta::CPAN

1074
1075
1076
1077
1078
1079
1080
1081
1082
1083
1084
1085
1086
1087
1088
1089
1090
1091
1092
1093
 } data => [
  [ 1, 'first line' ],
  [ 2, 'second line' ],
 ], columns => [
  { label => 'ID', width => 9, align => 'right' },
  { 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
    );
    local @WIDGET_ARGS = (@WIDGET_ARGS, %parent_args);
    apply_widget($w);
    $w
}

lib/Tickit/DSL.pm  view on Meta::CPAN

1096
1097
1098
1099
1100
1101
1102
1103
1104
1105
1106
1107
1108
1109
1110
1111
1112
1113
1114
1115
 
Provides a "breadcrumb trail".
 
 my $bc = breadcrumb {
  warn "crumb selected: @_";
 };
 $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
    );
    local @WIDGET_ARGS = (@WIDGET_ARGS, %parent_args);
    apply_widget($w);
    $w
}

lib/Tickit/DSL.pm  view on Meta::CPAN

1165
1166
1167
1168
1169
1170
1171
1172
1173
1174
1175
1176
1177
1178
1179
1180
1181
1182
1183
1184
1185
 
=head2 fileviewer
 
File viewer. Takes a code block and a file name. The code block is currently unused,
but eventually will be called when the current line is activated in the widget.
 
 fileviewer { } 'somefile.txt';
 
=cut
 
sub fileviewer(&;@) {
    my ($code, $file) = splice @_, 0, 2;
    my %args = (
        @_,
        file => $file
    );
    my %parent_args = map {; $_ => delete $args{'parent:' . $_} } map /^parent:(.*)/ ? $1 : (), keys %args;
 
    my $w = Tickit::Widget::FileViewer->new(
        %args
    );

lib/Tickit/DSL.pm  view on Meta::CPAN

1222
1223
1224
1225
1226
1227
1228
1229
1230
1231
1232
1233
1234
1235
1236
1237
1238
1239
1240
1241
1242
    };
   };
   static 'plain text under the menubar';
  }
 };
 
=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;
    {
        local $PARENT = $w;
        $code->($w);
    }
    local @WIDGET_ARGS = (@WIDGET_ARGS, %parent_args);
    apply_widget($w);

lib/Tickit/DSL.pm  view on Meta::CPAN

1309
1310
1311
1312
1313
1314
1315
1316
1317
1318
1319
1320
1321
1322
1323
1324
1325
1326
1327
1328
as widget arguments, see L</widget> for details.
 
 customwidget {
  my $tbl = Tickit::Widget::Table::Paged->new;
  $tbl->add_column(...);
  $tbl;
 } expand => 1;
 
=cut
 
sub customwidget(&@) {
    my ($code, @args) = @_;
    my %args = @args;
    local $PARENT = delete($args{parent}) || $PARENT;
    my $w = $code->($PARENT);
    {
        local @WIDGET_ARGS = (@WIDGET_ARGS, %args);
        apply_widget($w);
    }
}

lib/Tickit/DSL.pm  view on Meta::CPAN

1350
1351
1352
1353
1354
1355
1356
1357
1358
1359
1360
1361
1362
1363
1364
1365
1366
1367
1368
1369
o the widgets themselves - the above example would
thus be:
 
 vbox {
   static => '33%' 'parent:expand' => 1;
   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);
    }
}
 
=head2 apply_widget