You are viewing a plain text version of this content. The canonical link for it is here.
Posted to embperl-cvs@perl.apache.org by ri...@apache.org on 2001/03/03 15:45:58 UTC
cvs commit: embperl/Embperl/Syntax Embperl.pm EmbperlBlocks.pm EmbperlHTML.pm HTML.pm
richter 01/03/03 06:45:58
Modified: . Tag: Embperl2c epcomp.c epparse.c
Embperl Tag: Embperl2c Syntax.pm
Embperl/Syntax Tag: Embperl2c Embperl.pm EmbperlBlocks.pm
EmbperlHTML.pm HTML.pm
Log:
Embperl 2 - multiple syntaxes
Revision Changes Path
No revision
No revision
1.4.2.36 +1 -1 embperl/Attic/epcomp.c
Index: epcomp.c
===================================================================
RCS file: /home/cvs/embperl/Attic/epcomp.c,v
retrieving revision 1.4.2.35
retrieving revision 1.4.2.36
diff -u -r1.4.2.35 -r1.4.2.36
--- epcomp.c 2001/02/25 22:04:42 1.4.2.35
+++ epcomp.c 2001/03/03 14:45:56 1.4.2.36
@@ -98,7 +98,7 @@
tEmbperlCompilerInfo * pInfo = (tEmbperlCompilerInfo *)*ppInfo ;
if (!pInfo)
- embperlCompileInit ((tEmbperlCompilerInfo * *)ppInfo) ;
+ embperl_CompileInit ((tEmbperlCompilerInfo * *)ppInfo) ;
pInfo = (tEmbperlCompilerInfo *)*ppInfo ;
1.4.2.8 +1 -2 embperl/Attic/epparse.c
Index: epparse.c
===================================================================
RCS file: /home/cvs/embperl/Attic/epparse.c,v
retrieving revision 1.4.2.7
retrieving revision 1.4.2.8
diff -u -r1.4.2.7 -r1.4.2.8
--- epparse.c 2001/02/25 22:04:42 1.4.2.7
+++ epparse.c 2001/03/03 14:45:57 1.4.2.8
@@ -341,8 +341,7 @@
if (r -> bDebug & dbgBuildToken)
- lprintf (r, "[%d]TOKEN: %s ... %s unesc=%d nodetype=%d, cdatatype=%d, nodename=%s\n", r -> nPid, p -> sText, p -> pContains?sContains:p -> sEndText, p -> bUnescape, p -> nNodeType, p -> nCDataType, p -> sNodeName?p -> sNodeName:"<nul
-l>") ;
+ lprintf (r, "[%d]TOKEN: %s ... %s unesc=%d nodetype=%d, cdatatype=%d, nodename=%s\n", r -> nPid, p -> sText, p -> pContains?sContains:p -> sEndText, p -> bUnescape, p -> nNodeType, p -> nCDataType, p -> sNodeName?p -> sNodeName:"<null>") ;
if (p -> sNodeName)
p -> nNodeName = String2Ndx (p -> sNodeName, strlen (p -> sNodeName)) ;
No revision
No revision
1.1.4.17 +10 -4 embperl/Embperl/Attic/Syntax.pm
Index: Syntax.pm
===================================================================
RCS file: /home/cvs/embperl/Embperl/Attic/Syntax.pm,v
retrieving revision 1.1.4.16
retrieving revision 1.1.4.17
diff -u -r1.1.4.16 -r1.1.4.17
--- Syntax.pm 2001/02/27 07:42:26 1.1.4.16
+++ Syntax.pm 2001/03/03 14:45:57 1.1.4.17
@@ -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.16 2001/02/27 07:42:26 richter Exp $
+# $Id: Syntax.pm,v 1.1.4.17 2001/03/03 14:45:57 richter Exp $
#
###################################################################################
@@ -78,10 +78,16 @@
{
my $class = shift ;
- my $self = { -root => { %DocumentRoot} } ;
+ my $self = $class ;
+ if (!ref $class)
+ {
+ $self = {
+ -root => { %DocumentRoot},
+ -procinfotype => 'embperl',
+ } ;
- bless $self, $class ;
-
+ bless $self, $class ;
+ }
return $self ;
}
No revision
No revision
1.1.2.2 +4 -4 embperl/Embperl/Syntax/Attic/Embperl.pm
Index: Embperl.pm
===================================================================
RCS file: /home/cvs/embperl/Embperl/Syntax/Attic/Embperl.pm,v
retrieving revision 1.1.2.1
retrieving revision 1.1.2.2
diff -u -r1.1.2.1 -r1.1.2.2
--- Embperl.pm 2001/02/27 07:42:27 1.1.2.1
+++ Embperl.pm 2001/03/03 14:45:57 1.1.2.2
@@ -10,7 +10,7 @@
# IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
# WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
#
-# $Id: Embperl.pm,v 1.1.2.1 2001/02/27 07:42:27 richter Exp $
+# $Id: Embperl.pm,v 1.1.2.2 2001/03/03 14:45:57 richter Exp $
#
###################################################################################
@@ -22,7 +22,7 @@
use HTML::Embperl::Syntax::EmbperlHTML ;
use HTML::Embperl::Syntax::EmbperlBlocks ;
-@ISA = (HTML::Embperl::Syntax::EmbperlBlocks, HTML::Embperl::Syntax::EmbperlHTML) ;
+@ISA = qw(HTML::Embperl::Syntax::EmbperlBlocks HTML::Embperl::Syntax::EmbperlHTML) ;
###################################################################################
@@ -45,8 +45,8 @@
my $self = HTML::Embperl::Syntax::EmbperlBlocks::new ($class) ;
HTML::Embperl::Syntax::EmbperlHTML::new ($self) ;
- HTML::Embperl::Syntax::EmbperlBlocks::Init ($self) ;
- HTML::Embperl::Syntax::EmbperlHTML::Init ($self) ;
+ #HTML::Embperl::Syntax::EmbperlBlocks::Init ($self) ;
+ #HTML::Embperl::Syntax::EmbperlHTML::Init ($self) ;
return $self ;
}
1.1.2.4 +100 -34 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.3
retrieving revision 1.1.2.4
diff -u -r1.1.2.3 -r1.1.2.4
--- EmbperlBlocks.pm 2001/02/27 07:42:27 1.1.2.3
+++ EmbperlBlocks.pm 2001/03/03 14:45:57 1.1.2.4
@@ -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.3 2001/02/27 07:42:27 richter Exp $
+# $Id: EmbperlBlocks.pm,v 1.1.2.4 2001/03/03 14:45:57 richter Exp $
#
###################################################################################
@@ -18,7 +18,7 @@
package HTML::Embperl::Syntax::EmbperlBlocks ;
-@ISA = (HTML::Embperl::Syntax) ;
+@ISA = qw(HTML::Embperl::Syntax) ;
###################################################################################
@@ -38,11 +38,17 @@
{
my $class = shift ;
- my $self = ref $class?$class:HTML::Embperl::Syntax::new ($class) ;
+ my $firsttime = !ref ($self) || !$self -> {-root}{'Embperl meta command'} ;
- $self -> AddToRoot (\%Blocks) ;
+ my $self = HTML::Embperl::Syntax::new ($class) ;
- Init ($self) ;
+ if ($firsttime)
+ {
+ $self -> AddToRoot (\%Blocks) ;
+ $self -> AddToRoot (\%BlocksOutput) ;
+
+ Init ($self) ;
+ }
return $self ;
}
@@ -62,16 +68,16 @@
my $tagtype = 'Embperl meta command' ;
my $ttref ;
die "'$tagtype' unknown" if (!($ttref = $self -> {-root}{$tagtype})) ;
- my$ttfollow = ($ttref -> {'follow'} ||= {}) ;
+ my $ttfollow = ($ttref -> {'follow'} ||= {}) ;
- my $tag = $ttfollow -> {$tagname} = {
- 'text' => $tagname,
+ my $tag = $ttfollow -> {$cmdname} = {
+ 'text' => $cmdname,
'nodetype' => ntypTag,
'cdatatype' => ntypAttrValue,
'forcetype' => 1,
'unescape' => 1,
- 'procinfo' => { $self -> {-procinfotype} => { $procinfo } },
} ;
+ $tag -> {'procinfo'} = { $self -> {-procinfotype} => $procinfo } if ($procinfo) ;
return $tag ;
}
@@ -139,7 +145,7 @@
{
my $self = shift ;
- my $tag = $self -> SUPER::AddTag (@_) ;
+ my $tag = $self -> HTML::Embperl::Syntax::HTML::AddTag (@_) ;
$tag -> {inside} ||= {} ;
@@ -147,6 +153,37 @@
{
$tag -> {inside} -> {$k} = $v ;
}
+ while (my ($k, $v) = each (%BlocksOutput))
+ {
+ $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 ;
+ }
+
+ my $attr = $self -> {-htmlAssignAttrLink} ;
+
+ while (my ($k, $v) = each (%Blocks))
+ {
+ $attr -> {inside} -> {$k} = $v ;
+ }
+ while (my ($k, $v) = each (%BlocksOutputLink))
+ {
+ $attr -> {inside} -> {$k} = $v ;
+ }
+ }
+
}
@@ -274,30 +311,6 @@
# 'follow' => \%MetaCmds,
'unescape' => 1,
},
- 'Embperl output code' => {
- 'text' => '[+',
- 'end' => '+]',
- 'unescape' => 1,
- 'procinfo' => {
- embperl => {
- perlcode =>
- [
- #'if (!defined (_ep_rp(%$n%,scalar(do{%#~0:$col%})))) %#~-0:$row% { if ($col == 0) { _ep_dcp (%$t%,%^*htmltable%) ; last l%^*htmltable% ; } else { _ep_dcp (%$t%,%^*htmlrow%) ; last l%^*htmlrow% ; }}',
- #'if (!defined (_ep_rp(%$n%,scalar(do{%#~0:$col%})))) { _ep_dcp (%$t%,%^*htmlrow%) ; last l%^*htmlrow% ; }',
- #'if (!defined (_ep_rp(%$n%,scalar(do{%#~0:$row%})))) { _ep_dcp (%$t%,%^*htmltable%) ; last l%^*htmltable% ; }',
- #'_ep_rp(%$n%,scalar(do{%#0%}));',
- #'_ep_rp(%$n%,scalar (%#0%));',
- 'if (!defined (_ep_rp(%$x%,scalar(%#~0:$col%)))) %#~-0:$row% { if ($col == 0) { _ep_dcp (%$t%,%^*htmltable%) ; last l%^*htmltable% ; } else { _ep_dcp (%$t%,%^*htmlrow%) ; last l%^*htmlrow% ; }}',
- 'if (!defined (_ep_rp(%$x%,scalar(%#~0:$col%)))) { _ep_dcp (%$t%,%^*htmlrow%) ; last l%^*htmlrow% ; }',
- 'if (!defined (_ep_rp(%$x%,scalar(%#~0:$row%)))) { _ep_dcp (%$t%,%^*htmltable%) ; last l%^*htmltable% ; }',
- '_ep_rp(%$x%,scalar(%#0%));',
- ],
- removenode => 4,
- mayjump => '%#~0:$col|$row|$cnt% %?*htmlrow% %?*htmltable%',
- compilechilds => 0,
- }
- },
- },
'Embperl code' => {
'text' => '[-',
'end' => '-]',
@@ -367,6 +380,59 @@
# 'inside' => \%MetaComment
# },
#) ;
+
+
+%BlocksOutput =
+ (
+ 'Embperl output code' => {
+ 'text' => '[+',
+ 'end' => '+]',
+ 'unescape' => 1,
+ 'procinfo' => {
+ embperl => {
+ perlcode =>
+ [
+ #'if (!defined (_ep_rp(%$n%,scalar(do{%#~0:$col%})))) %#~-0:$row% { if ($col == 0) { _ep_dcp (%$t%,%^*htmltable%) ; last l%^*htmltable% ; } else { _ep_dcp (%$t%,%^*htmlrow%) ; last l%^*htmlrow% ; }}',
+ #'if (!defined (_ep_rp(%$n%,scalar(do{%#~0:$col%})))) { _ep_dcp (%$t%,%^*htmlrow%) ; last l%^*htmlrow% ; }',
+ #'if (!defined (_ep_rp(%$n%,scalar(do{%#~0:$row%})))) { _ep_dcp (%$t%,%^*htmltable%) ; last l%^*htmltable% ; }',
+ #'_ep_rp(%$n%,scalar(do{%#0%}));',
+ #'_ep_rp(%$n%,scalar (%#0%));',
+ 'if (!defined (_ep_rp(%$x%,scalar(%#~0:$col%)))) %#~-0:$row% { if ($col == 0) { _ep_dcp (%$t%,%^*htmltable%) ; last l%^*htmltable% ; } else { _ep_dcp (%$t%,%^*htmlrow%) ; last l%^*htmlrow% ; }}',
+ 'if (!defined (_ep_rp(%$x%,scalar(%#~0:$col%)))) { _ep_dcp (%$t%,%^*htmlrow%) ; last l%^*htmlrow% ; }',
+ 'if (!defined (_ep_rp(%$x%,scalar(%#~0:$row%)))) { _ep_dcp (%$t%,%^*htmltable%) ; last l%^*htmltable% ; }',
+ '_ep_rp(%$x%,scalar(%#0%));',
+ ],
+ removenode => 4,
+ mayjump => '%#~0:$col|$row|$cnt% %?*htmlrow% %?*htmltable%',
+ compilechilds => 0,
+ }
+ },
+ },
+ ) ;
+
+%BlocksOutputLink =
+ (
+ 'Embperl output code URL' => {
+ 'text' => '[+',
+ 'nodename' => '[+url',
+ 'end' => '+]',
+ 'unescape' => 1,
+ 'procinfo' => {
+ embperl => {
+ perlcode =>
+ [
+ 'if (!defined (_ep_rpurl(%$n%,scalar(do{%#~0:$col%})))) %#~-0:$row% { if ($col == 0) { _ep_dcp (%$t%,%^*htmltable%) ; last l%^*htmltable% ; } else { _ep_dcp (%$t%,%^*htmlrow%) ; last l%^*htmlrow% ; }}',
+ '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.1.2.2 +4 -4 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.1
retrieving revision 1.1.2.2
diff -u -r1.1.2.1 -r1.1.2.2
--- EmbperlHTML.pm 2001/02/27 07:42:27 1.1.2.1
+++ EmbperlHTML.pm 2001/03/03 14:45:57 1.1.2.2
@@ -10,18 +10,18 @@
# IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
# WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
#
-# $Id: EmbperlHTML.pm,v 1.1.2.1 2001/02/27 07:42:27 richter Exp $
+# $Id: EmbperlHTML.pm,v 1.1.2.2 2001/03/03 14:45:57 richter Exp $
#
###################################################################################
-package HTML::Embperl::Syntax::HTML ;
+package HTML::Embperl::Syntax::EmbperlHTML ;
use HTML::Embperl::Syntax qw{:types} ;
use HTML::Embperl::Syntax::HTML ;
-@ISA = (HTML::Embperl::Syntax::HTML) ;
+@ISA = qw(HTML::Embperl::Syntax::HTML) ;
###################################################################################
@@ -41,7 +41,7 @@
{
my $class = shift ;
- my $self = ref $class?$class:HTML::Embperl::Syntax::HTML::new ($class) ;
+ my $self = HTML::Embperl::Syntax::HTML::new ($class) ;
Init ($self) ;
1.1.2.4 +16 -11 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.3
retrieving revision 1.1.2.4
diff -u -r1.1.2.3 -r1.1.2.4
--- HTML.pm 2001/02/27 07:42:27 1.1.2.3
+++ HTML.pm 2001/03/03 14:45:57 1.1.2.4
@@ -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.3 2001/02/27 07:42:27 richter Exp $
+# $Id: HTML.pm,v 1.1.2.4 2001/03/03 14:45:57 richter Exp $
#
###################################################################################
@@ -20,7 +20,7 @@
use HTML::Embperl::Syntax qw{:types} ;
-@ISA = (HTML::Embperl::Syntax) ;
+@ISA = qw(HTML::Embperl::Syntax) ;
###################################################################################
@@ -40,9 +40,13 @@
{
my $class = shift ;
- my $self = ref $class?$class:HTML::Embperl::Syntax::new ($class) ;
+ my $firsttime = !ref ($self) || !$self -> {-root}{'HTML Tag'} ;
+
+ my $self = HTML::Embperl::Syntax::new ($class) ;
- $self -> AddToRoot (
+ if ($firsttime)
+ {
+ $self -> AddToRoot (
{
'HTML Tag' => {
'text' => '<',
@@ -55,8 +59,9 @@
},
}) ;
- $self -> {-htmlAssignAttr} = { %AssignAttr} ;
- $self -> {-htmlAssignAttrLink} = { %AssignAttrLink} ;
+ $self -> {-htmlAssignAttr} = { %AssignAttr} ;
+ $self -> {-htmlAssignAttrLink} = { %AssignAttrLink} ;
+ }
return $self ;
}
@@ -77,13 +82,13 @@
my $ttref ;
die "'$tagtype' unknown" if (!($ttref = $self -> {-root}{$tagtype})) ;
- my$ttfollow = ($ttref -> {'follow'} ||= {}) ;
+ my $ttfollow = ($ttref -> {'follow'} ||= {}) ;
my $tag = $ttfollow -> {$tagname} = {
'text' => $tagname,
'unescape' => 1,
- 'procinfo' => { $self -> {-procinfotype} => $procinfo },
} ;
+ $tag -> {'procinfo'} = { $self -> {-procinfotype} => $procinfo } if ($procinfo) ;
my %inside ;
my $addinside = 0 ;
@@ -92,7 +97,7 @@
my $assignattr = $self -> {-htmlAssignAttr} ;
foreach (@$attrs)
{
- $inside {$_} => { 'text' => $_, 'nodename' => $_, follow => $assignattr },
+ $inside {$_} = { 'text' => $_, 'nodename' => $_, follow => $assignattr },
$addinside++ ;
}
}
@@ -101,7 +106,7 @@
my $assignattr = $self -> {-htmlAssignAttrLink} ;
foreach (@$attrsurl)
{
- $inside {$_} => { 'text' => $_, 'nodename' => $_, follow => $assignattr },
+ $inside {$_} = { 'text' => $_, 'nodename' => $_, follow => $assignattr },
$addinside++ ;
}
}
@@ -109,7 +114,7 @@
{
foreach (@$attrs)
{
- $inside {$_} => { 'text' => $_, 'nodename' => $_},
+ $inside {$_} = { 'text' => $_, 'nodename' => $_},
$addinside++ ;
}
}