richter 01/03/06 04:33:54
Modified: . Tag: Embperl2c test.pl
Embperl Tag: Embperl2c Syntax.pm
Embperl/Syntax Tag: Embperl2c EmbperlBlocks.pm
EmbperlHTML.pm HTML.pm
Log:
Embperl 2 - multiple syntaxes
Revision Changes Path
No revision
No revision
1.70.4.28 +2 -0 embperl/test.pl
Index: test.pl
===================================================================
RCS file: /home/cvs/embperl/test.pl,v
retrieving revision 1.70.4.27
retrieving revision 1.70.4.28
diff -u -r1.70.4.27 -r1.70.4.28
--- test.pl 2001/02/27 07:42:26 1.70.4.27
+++ test.pl 2001/03/06 12:33:39 1.70.4.28
@@ -2,7 +2,9 @@
# Before `make install' is performed this script should be runnable with
# `make test'. After `make install' it should work as `perl test.pl'
+
use HTML::Embperl::Syntax::Embperl ;
+
$syn = HTML::Embperl::Syntax::Embperl -> new ;
No revision
No revision
1.1.4.18 +8 -3 embperl/Embperl/Attic/Syntax.pm
Index: Syntax.pm
===================================================================
RCS file: /home/cvs/embperl/Embperl/Attic/Syntax.pm,v
retrieving revision 1.1.4.17
retrieving revision 1.1.4.18
diff -u -r1.1.4.17 -r1.1.4.18
--- Syntax.pm 2001/03/03 14:45:57 1.1.4.17
+++ Syntax.pm 2001/03/06 12:33:43 1.1.4.18
@@ -10,7 +10,7 @@
# IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
# WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
#
-# $Id: Syntax.pm,v 1.1.4.17 2001/03/03 14:45:57 richter Exp $
+# $Id: Syntax.pm,v 1.1.4.18 2001/03/06 12:33:43 richter Exp $
#
###################################################################################
@@ -18,7 +18,11 @@
package HTML::Embperl::Syntax ;
+use strict ;
+use vars qw{@ISA @EXPORT_OK %EXPORT_TAGS %DocumentRoot} ;
+@ISA = qw{Exporter} ;
+
use constant ntypTag => 1 ;
use constant ntypStartTag => 1 + 0x20 ;
use constant ntypEndTag => 1 + 0x40 ;
@@ -57,9 +61,10 @@
-@EXPORT_TAGS = (
- types => @EXPORT_OK,
+%EXPORT_TAGS = (
+ types => \@EXPORT_OK,
) ;
+
###################################################################################
#
No revision
No revision
1.1.2.5 +48 -26 embperl/Embperl/Syntax/Attic/EmbperlBlocks.pm
Index: EmbperlBlocks.pm
===================================================================
RCS file: /home/cvs/embperl/Embperl/Syntax/Attic/EmbperlBlocks.pm,v
retrieving revision 1.1.2.4
retrieving revision 1.1.2.5
diff -u -r1.1.2.4 -r1.1.2.5
--- EmbperlBlocks.pm 2001/03/03 14:45:57 1.1.2.4
+++ EmbperlBlocks.pm 2001/03/06 12:33:48 1.1.2.5
@@ -10,7 +10,7 @@
# IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
# WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
#
-# $Id: EmbperlBlocks.pm,v 1.1.2.4 2001/03/03 14:45:57 richter Exp $
+# $Id: EmbperlBlocks.pm,v 1.1.2.5 2001/03/06 12:33:48 richter Exp $
#
###################################################################################
@@ -18,6 +18,13 @@
package HTML::Embperl::Syntax::EmbperlBlocks ;
+use HTML::Embperl::Syntax (':types') ;
+
+use strict ;
+use vars qw{@ISA %Blocks %BlocksOutput %BlocksOutputLink} ;
+
+
+
@ISA = qw(HTML::Embperl::Syntax) ;
@@ -36,11 +43,11 @@
sub new
{
- my $class = shift ;
+ my $self = shift ;
my $firsttime = !ref ($self) || !$self -> {-root}{'Embperl meta command'} ;
- my $self = HTML::Embperl::Syntax::new ($class) ;
+ $self = HTML::Embperl::Syntax::new ($self) ;
if ($firsttime)
{
@@ -119,12 +126,12 @@
$tag = $self -> AddMetaCmd ($cmdname, $procinfostart) ;
$tag -> {'endtag'} = $endname ;
- $pinfo = $starttag -> {'procinfo'} -> {$self -> {-procinfotype}} ;
+ $pinfo = $tag -> {'procinfo'} -> {$self -> {-procinfotype}} ;
$pinfo -> {'stackname'} = 'metacmd' ;
$pinfo -> {'push'} = $cmdname ;
$tag = $self -> AddMetaCmd ($endname, $procinfoend) ;
- $pinfo = $starttag -> {'procinfo'} -> {$self -> {-procinfotype}} ;
+ $pinfo = $tag -> {'procinfo'} -> {$self -> {-procinfotype}} ;
$pinfo -> {'stackname'} = 'metacmd' ;
$pinfo -> {'stackmatch'} = $cmdname ;
@@ -147,6 +154,8 @@
my $tag = $self -> HTML::Embperl::Syntax::HTML::AddTag (@_) ;
+ #### add the Embperl Block inside the new HTML Tag ####
+
$tag -> {inside} ||= {} ;
while (my ($k, $v) = each (%Blocks))
@@ -157,33 +166,46 @@
{
$tag -> {inside} -> {$k} = $v ;
}
+
if (!$self -> {-epbHTMLInit})
{
- $self -> {-epbHTMLInit} = 1 ;
-
- my $attr = $self -> {-htmlAssignAttr} ;
-
- while (my ($k, $v) = each (%Blocks))
- {
- $attr -> {inside} -> {$k} = $v ;
- }
- while (my ($k, $v) = each (%BlocksOutput))
- {
- $attr -> {inside} -> {$k} = $v ;
- }
+ #### if not already done add the Embperl Block inside the HTML Attributes
####
- my $attr = $self -> {-htmlAssignAttrLink} ;
+ $self -> {-epbHTMLInit} = 1 ;
- while (my ($k, $v) = each (%Blocks))
- {
- $attr -> {inside} -> {$k} = $v ;
- }
- while (my ($k, $v) = each (%BlocksOutputLink))
+ foreach ('-htmlAssignAttr', '-htmlAssignAttrLink')
{
- $attr -> {inside} -> {$k} = $v ;
+ my $attr = $self -> {$_} ;
+ while (my ($k1, $v1) = each %$attr)
+ {
+ if (!($k1 =~ /^-/) && ref ($v1) eq 'HASH')
+ {
+ my $follow = $v1 -> {follow} ;
+ if (ref($follow) eq 'HASH')
+ {
+ while (my ($k2, $v2) = each %$follow)
+ {
+ if (ref($v2) eq 'HASH')
+ {
+ $v2 -> {inside} ||= {} ;
+ my $inside = $v2 -> {inside} ;
+
+ while (my ($k, $v) = each (%Blocks))
+ {
+ $inside -> {$k} = $v ;
+ }
+ while (my ($k, $v) = each (%BlocksOutput))
+ {
+ $inside -> {$k} = $v ;
+ }
+ }
+ }
+ }
+ }
+ }
}
}
-
+ return $tag ;
}
@@ -425,7 +447,7 @@
'if (!defined (_ep_rpurl(%$n%,scalar(do{%#~0:$col%})))) {
_ep_dcp (%$t%,%^*htmlrow%) ; last l%^*htmlrow% ; }',
'if (!defined
(_ep_rpurl(%$n%,scalar($val3=do{%#~0:$row%;})))) { _ep_dcp (%$t%,%^*htmltable%) ;
last l%^*htmltable% ; }',
'_ep_rpurl(%$n%,scalar(do{%#0%}));',
- ] ;
+ ],
removenode => 4,
mayjump => '%#~0:$col|$row|$cnt% %?*htmlrow% %?*htmltable%',
compilechilds => 0,
1.1.2.3 +18 -1 embperl/Embperl/Syntax/Attic/EmbperlHTML.pm
Index: EmbperlHTML.pm
===================================================================
RCS file: /home/cvs/embperl/Embperl/Syntax/Attic/EmbperlHTML.pm,v
retrieving revision 1.1.2.2
retrieving revision 1.1.2.3
diff -u -r1.1.2.2 -r1.1.2.3
--- EmbperlHTML.pm 2001/03/03 14:45:57 1.1.2.2
+++ EmbperlHTML.pm 2001/03/06 12:33:49 1.1.2.3
@@ -10,7 +10,7 @@
# IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
# WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
#
-# $Id: EmbperlHTML.pm,v 1.1.2.2 2001/03/03 14:45:57 richter Exp $
+# $Id: EmbperlHTML.pm,v 1.1.2.3 2001/03/06 12:33:49 richter Exp $
#
###################################################################################
@@ -21,6 +21,9 @@
use HTML::Embperl::Syntax qw{:types} ;
use HTML::Embperl::Syntax::HTML ;
+use strict ;
+use vars qw{@ISA} ;
+
@ISA = qw(HTML::Embperl::Syntax::HTML) ;
@@ -88,6 +91,16 @@
'push' => '%$x%',
mayjump => 1,
}) ;
+
+ my %ProcInfoTable = (
+ perlcode => 'l%$x%: for (my $row = 0; $row < $maxrow; $row++) {'
,
+ perlcodeend => '} %?*-htmltable%' ,
+ perlcoderemove => 1,
+ stackname => 'htmltable',
+ 'push' => '%$x%',
+ mayjump => 1,
+ ) ;
+
$self -> AddTagBlock ('table', undef, undef, undef, \%ProcInfoTable) ;
$self -> AddTagBlock ('ol', undef, undef, undef, \%ProcInfoTable) ;
$self -> AddTagBlock ('ul', undef, undef, undef, \%ProcInfoTable) ;
@@ -129,6 +142,10 @@
$self -> AddTag ('form', undef, ['action'], undef, undef) ;
}
+
+
+
+
1;
1.1.2.5 +10 -10 embperl/Embperl/Syntax/Attic/HTML.pm
Index: HTML.pm
===================================================================
RCS file: /home/cvs/embperl/Embperl/Syntax/Attic/HTML.pm,v
retrieving revision 1.1.2.4
retrieving revision 1.1.2.5
diff -u -r1.1.2.4 -r1.1.2.5
--- HTML.pm 2001/03/03 14:45:57 1.1.2.4
+++ HTML.pm 2001/03/06 12:33:50 1.1.2.5
@@ -10,7 +10,7 @@
# IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
# WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
#
-# $Id: HTML.pm,v 1.1.2.4 2001/03/03 14:45:57 richter Exp $
+# $Id: HTML.pm,v 1.1.2.5 2001/03/06 12:33:50 richter Exp $
#
###################################################################################
@@ -18,8 +18,12 @@
package HTML::Embperl::Syntax::HTML ;
-use HTML::Embperl::Syntax qw{:types} ;
+use HTML::Embperl::Syntax (':types') ;
+use strict ;
+use vars qw{@ISA %Attr %AssignAttr %AssignAttrLink} ;
+
+
@ISA = qw(HTML::Embperl::Syntax) ;
@@ -38,11 +42,11 @@
sub new
{
- my $class = shift ;
+ my $self = shift ;
my $firsttime = !ref ($self) || !$self -> {-root}{'HTML Tag'} ;
- my $self = HTML::Embperl::Syntax::new ($class) ;
+ $self = HTML::Embperl::Syntax::new ($self) ;
if ($firsttime)
{
@@ -51,7 +55,6 @@
'HTML Tag' => {
'text' => '<',
'end' => '>',
- 'follow' => \%HtmlTags,
},
'HTML Comment' => {
'text' => '<!--',
@@ -169,11 +172,11 @@
my $tag = $self -> AddTag ($tagname, $attrs, $attrsurl, $attrsnoval, $procinfo)
;
- $tag -> {'nodetype'} = ntypStartTag ;
+ $tag -> {'nodetype'} = &ntypStartTag ;
$tag = $self -> AddTag ("/$tagname") ;
- $tag -> {'nodetype'} = ntypEndTag ;
+ $tag -> {'nodetype'} = &ntypEndTag ;
$tag -> {'starttag'} = $tagname ;
}
@@ -237,7 +240,6 @@
{
'text' => '"',
'end' => '"',
- 'inside' => \%Cmds,
'nodetype' => ntypAttr,
'cdatatype' => ntypAttrValue,
},
@@ -245,14 +247,12 @@
{
'text' => '\'',
'end' => '\'',
- 'inside' => \%Cmds,
'nodetype' => ntypAttr,
'cdatatype' => ntypAttrValue,
},
'Attribut alphanum' =>
{
'contains' =>
'abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ_0123456789',
- 'inside' => \%Cmds,
'nodetype' => ntypAttr,
'cdatatype' => ntypAttrValue,
}
---------------------------------------------------------------------
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
