Tickit-DSL

 view release on metacpan or  search on metacpan

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

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


 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


 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


 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


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

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


 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


 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

  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

        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


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

 };

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

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


 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

   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

   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

        $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

=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

        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

    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

 } 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


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


=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

    };
   };
   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

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

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



( run in 0.239 second using v1.01-cache-2.11-cpan-a9ef4e587e4 )