[Jifty-commit] r6181 - in Template-Declare/branches/markapl-syntax: . lib/Template/Declare
Jifty commits
jifty-commit at lists.jifty.org
Wed Dec 24 22:20:44 EST 2008
Author: gugod
Date: Wed Dec 24 22:20:44 2008
New Revision: 6181
Added:
Template-Declare/branches/markapl-syntax/lib/Template/Declare/TagCompiler.pm
Template-Declare/branches/markapl-syntax/t/markapl-syntax-xul-tagset.t
Template-Declare/branches/markapl-syntax/t/markapl-syntax.t
Modified:
Template-Declare/branches/markapl-syntax/ (props changed)
Template-Declare/branches/markapl-syntax/lib/Template/Declare/Tags.pm
Log:
r9509 at yra: gugod | 2008-12-23 22:28:10 +0800
First of all ... basically copy over markapl code to here for a quick
start. The list of tags are given by T:D:TagSet::* so HTML and XUL
both work now.
Added: Template-Declare/branches/markapl-syntax/lib/Template/Declare/TagCompiler.pm
==============================================================================
--- (empty file)
+++ Template-Declare/branches/markapl-syntax/lib/Template/Declare/TagCompiler.pm Wed Dec 24 22:20:44 2008
@@ -0,0 +1,157 @@
+package Template::Declare::TagCompiler;
+
+use strict;
+use warnings;
+use Devel::Declare ();
+
+our $VERSION = 0.02;
+
+our ($Declarator, $Offset);
+
+sub skip_declarator {
+ $Offset += Devel::Declare::toke_move_past_token($Offset);
+}
+
+sub skipspace {
+ $Offset += Devel::Declare::toke_skipspace($Offset);
+}
+
+sub strip_name {
+ skipspace;
+ if (my $len = Devel::Declare::toke_scan_word($Offset, 1)) {
+ my $linestr = Devel::Declare::get_linestr();
+ my $name = substr($linestr, $Offset, $len);
+ substr($linestr, $Offset, $len) = '';
+ Devel::Declare::set_linestr($linestr);
+ return $name;
+ }
+ return;
+}
+
+sub strip_proto {
+ skipspace;
+
+ my $linestr = Devel::Declare::get_linestr();
+ if (substr($linestr, $Offset, 1) eq '(') {
+ my $length = Devel::Declare::toke_scan_str($Offset);
+ my $proto = Devel::Declare::get_lex_stuff();
+ Devel::Declare::clear_lex_stuff();
+ $linestr = Devel::Declare::get_linestr();
+ substr($linestr, $Offset, $length) = '';
+ Devel::Declare::set_linestr($linestr);
+ return $proto;
+ }
+ return;
+}
+
+sub shadow {
+ my $pack = Devel::Declare::get_curstash_name;
+ Devel::Declare::shadow_sub("${pack}::${Declarator}", $_[0]);
+}
+
+sub make_proto_unwrap {
+ my ($proto) = @_;
+ return (defined($proto) && length($proto)) ? "($proto);" : "";
+}
+
+sub inject_if_block {
+ my $inject = shift;
+ skipspace;
+ my $linestr = Devel::Declare::get_linestr;
+ if (substr($linestr, $Offset, 1) eq '{') {
+ substr($linestr, $Offset+1, 0) = $inject;
+ Devel::Declare::set_linestr($linestr);
+ }
+}
+
+sub inject_before_block {
+ my $inject = shift;
+ skipspace;
+ my $linestr = Devel::Declare::get_linestr;
+ if (substr($linestr, $Offset, 1) eq '{') {
+ substr($linestr, $Offset, 0) = $inject;
+ Devel::Declare::set_linestr($linestr);
+ }
+}
+
+my %alt = (
+ 'cell' => 'td',
+ 'row' => 'tr',
+ 'html_base' => 'base',
+ 'html_link' => 'link',
+ 'html_map' => 'map',
+ 'html_q' => 'q',
+ 'html_s' => 's',
+ 'html_sub' => 'sub',
+ 'html_tr' => 'tr',
+);
+
+sub tag_parser_for {
+ my ($tag) = @_;
+ $tag = $alt{$tag} if defined($alt{$tag});
+
+ return sub {
+ local ($Declarator, $Offset) = @_;
+
+ my $offset_before = $Offset;
+ skip_declarator;
+
+ # This means that current declarator is in a hash key.
+ # Don't shadow sub in this case
+ return if $Offset == $offset_before;
+
+ my $name = strip_name;
+ my $proto = strip_proto;
+
+ if (defined($proto)) {
+ inject_before_block("$proto, sub");
+ }
+ else {
+ inject_before_block("sub");
+ }
+
+ shadow(
+ sub {
+ my $block = pop;
+ my @attr = @_;
+
+ my $attr = "";
+
+ if (@attr == 1) {
+ my $css = $attr[0];
+ while ($css =~ /([\#\.])(\w+)/g) {
+ if ($1 eq '#') {
+ $attr .= qq{ id="$2"};
+ } else {
+ $attr .= qq{ class="$2"};
+ }
+ }
+ } else {
+ my ($k, $v) = (shift @attr, shift @attr);
+ while ($k && $v) {
+ $attr .= " $k=\"$v\"";
+ ($k, $v) = (shift @attr, shift @attr);
+ }
+ }
+
+ my $buf = "<${tag}${attr}>";
+
+ Template::Declare->new_buffer_frame;
+
+ Template::Declare->buffer->append( $block->() )
+ if defined $block && ref($block) eq 'CODE';
+
+ $buf .= Template::Declare->end_buffer_frame->data || "";
+
+ $buf .= "</$tag>";
+
+ Template::Declare->buffer->append( $buf );
+
+ return '';
+ }
+ );
+
+ }
+}
+
+1;
Modified: Template-Declare/branches/markapl-syntax/lib/Template/Declare/Tags.pm
==============================================================================
--- Template-Declare/branches/markapl-syntax/lib/Template/Declare/Tags.pm (original)
+++ Template-Declare/branches/markapl-syntax/lib/Template/Declare/Tags.pm Wed Dec 24 22:20:44 2008
@@ -13,6 +13,8 @@
use base 'Exporter';
use Carp qw(carp croak);
use Symbol 'qualify_to_ref';
+use Devel::Declare ();
+use Template::Declare::TagCompiler;
our @EXPORT
= qw( with template private show show_page attr outs
@@ -65,8 +67,24 @@
### TagSet options: $opts
my $tagset = $module->new($opts);
my $tag_list = $tagset->get_tag_list;
- Template::Declare::Tags::install_tag($_, $tagset)
- for @$tag_list;
+
+ my $config = {};
+ my $code_str = "package $opts->{package};";
+ foreach my $tag (@$tag_list) {
+
+ my $alternative = $tagset->get_alternate_spelling($tag);
+ if ( defined $alternative ) {
+ $tag = $alternative;
+ }
+
+ print STDERR "Will install $tag\n";
+ $code_str .= qq{sub $tag (&);};
+ $config->{$tag} = {
+ const => Template::Declare::TagCompiler::tag_parser_for($tag)
+ }
+ }
+ eval $code_str;
+ Devel::Declare->setup_for($opts->{package}, $config);
}
__PACKAGE__->export_to_level(1, $self);
}
@@ -454,9 +472,10 @@
return Template::Declare->end_buffer_frame->data;
}
+
=head2 get_current_attr
-Help! I'm deprecated/
+Help! I am deprecated!
=cut
Added: Template-Declare/branches/markapl-syntax/t/markapl-syntax-xul-tagset.t
==============================================================================
--- (empty file)
+++ Template-Declare/branches/markapl-syntax/t/markapl-syntax-xul-tagset.t Wed Dec 24 22:20:44 2008
@@ -0,0 +1,38 @@
+#!/usr/bin/env perl -w
+use strict;
+
+package TestView;
+use base 'Template::Declare';
+use Template::Declare::Tags 'XUL';
+
+template 'main' => sub {
+ groupbox {
+ caption(label => "Colors") {
+ radiogroup {
+ for my $id ( qw< orange violet yellow > ) {
+ radio(id => $id, label => ucfirst($id), $id eq 'violet' ? (selected => 'true') : ());
+ }
+ }
+ }
+ }
+};
+
+1;
+
+package main;
+
+Template::Declare->init(roots => [ 'TestView']);
+
+use Test::More tests => 1;
+
+my $out = (Template::Declare->show("main"));
+diag($out);
+
+# like($out, qr{<div(\s+id="id")?>\s*<p>.+?</p>\s*</div>});
+pass;
+
+
+
+
+
+
Added: Template-Declare/branches/markapl-syntax/t/markapl-syntax.t
==============================================================================
--- (empty file)
+++ Template-Declare/branches/markapl-syntax/t/markapl-syntax.t Wed Dec 24 22:20:44 2008
@@ -0,0 +1,45 @@
+#!/usr/bin/env perl -w
+use strict;
+
+package TestView;
+use base 'Template::Declare';
+use Template::Declare::Tags;
+
+template t1 => sub {
+ div(id => "id") {
+ p { "This is my content" }
+ }
+};
+
+template t2 => sub {
+ div("#id") {
+ p { "This is my content" }
+ }
+};
+
+template t3 => sub {
+ div {
+ p { "This is my content" }
+ }
+};
+
+
+package main;
+
+Template::Declare->init(roots => [ 'TestView']);
+
+1;
+
+use Test::More tests => 3;
+
+for(1..3) {
+ my $out = (Template::Declare->show("t$_"));
+ diag $out;
+ like($out, qr{<div(\s+id="id")?>\s*<p>.+?</p>\s*</div>});
+}
+
+
+
+
+
+
More information about the Jifty-commit
mailing list