Question

Using sub prototypes, we can define our own subs that look like map or grep. That is, the first coderef argument has shorter syntax than a normal anonymous sub. For example:

sub thunked (&) { $_[0] }

my $val = thunked { 2 * 4 };

Works great here, since the first argument is the coderef. For latter arguments however, it simple won’t parse properly.

I made a with sub designed to make writing GTK2 code cleaner. It’s meant to look like this (untested since it’s hypothetical code):

use 5.012;
use warnings;

use Gtk2 '-init';    

sub with ($&) {
    local $_ = $_[0];
    $_[1]->();
    $_;
}

for (Gtk2::Window->new('toplevel')) {
    $_->set_title('Test Application');
    $_->add(with Gtk2::VBox->new {
        my $box = $_;
        $box->add(Gtk2::Button->new("Button $_")) for (1..4);
    });
    $_->show_all;
}
Gtk2->main;

It doesn’t work because with needs to take the block as a first argument for the nice syntax to work. Is there any way to pull it off?

Answer 1

The module Devel::Declare contains tools for extending Perl’s syntax in a relatively safe way.

Using Devel::Declare you would create a hook on the with token, which will stop the parser when it reaches that word. From there, you have control over the parser and you can read ahead until you reach a { symbol. At that point, you have what you need to work with, so you rewrite it into valid Perl, and pass it back to the parser.

in the file With.pm:

package With;
use warnings;
use strict;
use Devel::Declare;

sub import {
    my $caller = caller;
    Devel::Declare->setup_for (
        $caller => {with => {const => \&parser}}
    );
    no strict 'refs';
    *{$caller.'::with'} = sub ($&) {
        $_[1]() for $_[0];
        $_[0]
    }
}

our $prefix = '';
sub get {substr Devel::Declare::get_linestr, length $prefix}
sub set {       Devel::Declare::set_linestr $prefix . $_[0]}

sub parser {
    local $prefix = substr get, 0, length($_[0]) + $_[1];
    my $with = strip_with();
    strip_space();
    set "scalar($with), sub " . get;
}

sub strip_space {
    my $skip = Devel::Declare::toke_skipspace length $prefix;
    set substr get, $skip;
}

sub strip_with {
    strip_space;
    my $with;
    until (get =~ /^\{/) {
        (my $line = get) =~ s/^([^{]+)//;
        $with .= $1;
        set $line;
        strip_space;
    }
    $with =~ s/\s+/ /g;
    $with
}

and to use it:

use With;

sub Window::add {say "window add: ", $_[1]->str}
sub Window::new {bless [] => 'Window'}
sub Box::new    {bless [] => 'Box'}
sub Box::add    {push @{$_[0]}, @_[1..$#_]}
sub Box::str    {"Box(@{$_[0]})"}
sub Button::new {"Button($_[1])"}

with Window->new {
    $_->add(with Box->new {
        for my $num (1 .. 4) {
            $_->add(Button->new($num))
        }
    })
};

Which prints:

window add: Box(Button(1) Button(2) Button(3) Button(4))

---

A completely different approach would be to skip the with keyword altogether and write a routine to generate constructor subroutines:

BEGIN {
    for my $name (qw(VBox)) { # and any others you want
        no strict 'refs';
        *$name = sub (&@) {
            use strict;
            my $code = shift;
            my $with = "Gtk2::$name"->new(@_);
            $code->() for $with;
            $with
        }
    }
}

and then your code could look like

for (Gtk2::Window->new('toplevel')) {
    $_->set_title('Test Application');
    $_->add(VBox {
        my $box = $_;
        $box->add(Gtk2::Button->new("Button $_")) for (1..4);
    });
    $_->show_all;
}