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...@locus.apache.org on 2000/05/30 16:12:40 UTC
cvs commit: embperl/test/html table.htm
richter 00/05/30 07:12:36
Modified: . Tag: Embperl2 epcomp.c epdom.c epdom.h
Embperl Tag: Embperl2 Syntax.pm
test/cmp Tag: Embperl2 error.htm
test/html Tag: Embperl2 table.htm
Log:
Embperl 2 - Tables
Revision Changes Path
No revision
No revision
1.1.2.18 +35 -20 embperl/Attic/epcomp.c
Index: epcomp.c
===================================================================
RCS file: /home/cvs/embperl/Attic/epcomp.c,v
retrieving revision 1.1.2.17
retrieving revision 1.1.2.18
diff -u -r1.1.2.17 -r1.1.2.18
--- epcomp.c 2000/05/29 14:22:08 1.1.2.17
+++ epcomp.c 2000/05/30 14:12:32 1.1.2.18
@@ -24,13 +24,16 @@
int bPopStack ;
int numPerlCode ;
int bRemoveNode ;
- int bMayJump ;
+ int bPerlCodeRemove ;
+ const char * sMayJump ;
} ;
typedef struct tEmbperlCmd tEmbperlCmd ;
char * pProg = NULL ;
+int nLabelCnt ;
+
tStringIndex nMaxEmbperlCmd ;
struct tEmbperlCmd * pEmbperlCmds ;
@@ -111,8 +114,9 @@
pEmbperlCmds[nNodeName].sStackName = GetHashValueStr (pHash, "stackname", NULL) ;
pEmbperlCmds[nNodeName].sPushStack = GetHashValueStr (pHash, "push", NULL) ;
pEmbperlCmds[nNodeName].bRemoveNode = GetHashValueInt (pHash, "removenode", 0) ;
- pEmbperlCmds[nNodeName].bMayJump = GetHashValueInt (pHash, "mayjump", 0) ;
+ pEmbperlCmds[nNodeName].sMayJump = GetHashValueStr (pHash, "mayjump", NULL) ;
pEmbperlCmds[nNodeName].bPopStack = GetHashValueInt (pHash, "pop", 0) ;
+ pEmbperlCmds[nNodeName].bPerlCodeRemove = GetHashValueInt (pHash, "perlcoderemove", 0) ;
if (r -> bDebug & dbgParse)
@@ -485,6 +489,12 @@
int l = sprintf (s, "$_ep_DomTree,%u", pNode -> xNdx) ;
StringAdd (ppCode, s, l) ;
}
+ else if (*p == 'l')
+ {
+ char s [20] ;
+ int l = sprintf (s, "%u", pNode -> xNdx) ;
+ StringAdd (ppCode, s, l) ;
+ }
}
sPerlCode = q + 1 ;
@@ -526,7 +536,7 @@
int nAttr = 0 ;
char * pCode = NULL ;
char * sStackValue = NULL ;
-
+ int nStartCodeOffset = 0 ;
if (*bCheckpointPending && (pNode -> nType == ntypText || pNode -> nType == ntypCDATA) && pNode -> bFlags && (pNode -> bFlags & nflgIgnore) == 0)
{
@@ -534,7 +544,7 @@
char buf [80] ;
pNode -> bFlags |= nflgCheckpoint ;
- l = sprintf (buf, "_ep_cp($_ep_DomTree,%d) ;\n", pNode -> xNdx) ;
+ l = sprintf (buf, "_ep_cp($_ep_DomTree,%d) ;\n", *bCheckpointPending<0?pNode -> xNdx:*bCheckpointPending) ;
StringAdd (&pProg, buf, l) ;
*bCheckpointPending = 0 ;
}
@@ -571,6 +581,8 @@
if (pCode)
{
int l = ArrayGetSize (pCode) ;
+ if (pCmd -> bPerlCodeRemove)
+ nStartCodeOffset = StringAdd (&pProg, " ", 1) ;
if (l)
StringAdd (&pProg, pCode, l) ;
StringAdd (&pProg, "\n", 1) ;
@@ -604,8 +616,12 @@
}
}
- if (pCmd -> bMayJump)
- *bCheckpointPending = 1 ;
+ if (pCmd -> sMayJump)
+ if (embperl_CompileToPerlCode (pDomTree, pNode, pCmd -> sMayJump, &sStackValue))
+ {
+ *bCheckpointPending = -1 ;
+ }
+
if (pCmd -> bRemoveNode & 1)
Node_selfRemoveChild(pDomTree, -1, pNode) ;
else if (pCmd -> bRemoveNode & 8)
@@ -624,18 +640,6 @@
else
pCmd = NULL ;
- /*
- if (*bCheckpointPending && pNode -> bFlags && (pNode -> bFlags & nflgIgnore) == 0)
- {
- int l ;
- char buf [80] ;
-
- pNode -> bFlags |= nflgCheckpoint ;
- l = sprintf (buf, "_ep_cp($_ep_DomTree,%d) ;\n", pNode -> xNdx) ;
- StringAdd (&pProg, buf, l) ;
- *bCheckpointPending = 0 ;
- }
- */
xChildNode = pNode -> bFlags?Node_firstChild (pDomTree, xNode):0 ;
while (xChildNode)
@@ -657,8 +661,18 @@
StringAdd (&pProg, "\n", 1) ;
}
}
- if (pCmd -> sPerlCodeEnd && pCmd -> bMayJump)
- *bCheckpointPending = 1 ;
+ else
+ {
+ if (pCmd -> bPerlCodeRemove && nStartCodeOffset)
+ {
+ pProg[nStartCodeOffset] = '#' ;
+ }
+ }
+ if (pCmd -> sPerlCodeEnd && pCmd -> sMayJump)
+ if (embperl_CompileToPerlCode (pDomTree, pNode, pCmd -> sMayJump, &sStackValue))
+ {
+ *bCheckpointPending = -1 ;
+ }
if (pCmd -> sStackName && pCmd -> sPushStack)
{
embperl_CompilePopStack (pDomTree, pCmd -> sStackName) ;
@@ -723,6 +737,7 @@
StringAdd (&pProg, "my $_ep_DomTree = $_[1];\nmy $_ep_EscMask = 5;\n*_ep_rp=\\&XML::Embperl::DOM::Node_replaceChildWithCDATA;\n*_ep_rpurl=\\&XML::Embperl::DOM::Node_replaceChildWithUrlDATA;\n*_ep_cp=\\&XML::Embperl::DOM::DomTree_checkpoint;\n ", 0) ;
pDomTree -> pSV = (SV *)newHV () ;
+ nLabelCnt = 1 ;
while (xNode)
{
1.1.2.22 +37 -7 embperl/Attic/epdom.c
Index: epdom.c
===================================================================
RCS file: /home/cvs/embperl/Attic/epdom.c,v
retrieving revision 1.1.2.21
retrieving revision 1.1.2.22
diff -u -r1.1.2.21 -r1.1.2.22
--- epdom.c 2000/05/29 14:22:08 1.1.2.21
+++ epdom.c 2000/05/30 14:12:33 1.1.2.22
@@ -278,7 +278,7 @@
/* ------------------------------------------------------------------------ */
-void StringAdd (/*in*/ char * * pArray,
+int StringAdd (/*in*/ char * * pArray,
/*in*/ const char * sAdd,
/*in*/ int nLen)
@@ -292,6 +292,7 @@
memcpy ((*pArray)+nIndex, sAdd, nLen) ;
+ return nIndex ;
}
@@ -1169,6 +1170,7 @@
int nOrderNdx = *pOrderNdx ;
tNodeData * pNextNode ;
tNodeData * pSavedNode = NULL ;
+ tNodeData * pLastStartTag = NULL ;
struct tNodeData * pNode = Node_self (pDomTree, xNode) ;
@@ -1193,12 +1195,35 @@
if ((xNextNode = pDomTree -> pOrder[nOrderNdx]) != pNode -> xNdx)
{
tNodeData * pNewNode ;
+ tNodeData * pNewParent ;
+ tNodeData * pParent ;
if (pCurrReq -> bDebug & dbgParse)
lprintf (r, "[%d]toString: Skip Node=%d to Node=%d\n", r -> nPid, pNode -> xNdx, xNextNode) ;
pSavedNode = NULL ;
- pNode = Node_self (pDomTree, xNextNode) ;
- }
+ pNewNode = Node_self (pDomTree, xNextNode) ;
+ pNewParent = Node_selfParentNode (pDomTree, pNewNode) ;
+ if (pParent = pLastStartTag)
+ {
+ while (pNewParent != pParent)
+ {
+ if (pParent)
+ {
+ oputs (r, "</") ;
+ oputs (r, Node_selfNodeName (pParent)) ;
+ oputc (r, '>') ;
+ }
+ else
+ {
+ lprintf (r, "[%d]WARN: unstructured jump\n", r -> nPid) ;
+ break ;
+ }
+ pParent = Node_selfParentNode (pDomTree, pParent) ;
+ }
+ }
+ pLastStartTag = NULL ;
+ pNode = pNewNode ;
+ }
nOrderNdx++ ;
}
if (pSavedNode)
@@ -1214,6 +1239,9 @@
int n = pNode -> numAttr ;
struct tAttrData * pAttr = (struct tAttrData *)(pNode + 1) ;
+ if (pNode -> nType == ntypStartTag)
+ pLastStartTag = pNode ;
+
oputc (r, '<') ;
oputs (r, Node_selfNodeName (pNode)) ;
@@ -1285,14 +1313,16 @@
return ;
}
- if (pNextNode -> nType == ntypStartTag && (pNextNode -> bFlags & nflgIgnore) == 0)
+ pNode = pNextNode ;
+ pNextNode = Node_selfNextSibling (pDomTree, pNextNode) ;
+ if (pNode -> nType == ntypStartTag && (pNode -> bFlags & nflgIgnore) == 0 &&
+ ((pNextNode -> bFlags & nflgCheckpoint) == 0 || pDomTree -> pOrder[nOrderNdx] == pNextNode -> xNdx))
{
oputs (r, "</") ;
- oputs (r, Node_selfNodeName (pNextNode)) ;
+ oputs (r, Node_selfNodeName (pNode)) ;
oputc (r, '>') ;
+ pLastStartTag = Node_selfParentNode (pDomTree, pNextNode) ;
}
- pNode = pNextNode ;
- pNextNode = Node_selfNextSibling (pDomTree, pNextNode) ;
}
}
pSavedNode = NULL ;
1.1.2.18 +1 -1 embperl/Attic/epdom.h
Index: epdom.h
===================================================================
RCS file: /home/cvs/embperl/Attic/epdom.h,v
retrieving revision 1.1.2.17
retrieving revision 1.1.2.18
diff -u -r1.1.2.17 -r1.1.2.18
--- epdom.h 2000/05/29 14:22:10 1.1.2.17
+++ epdom.h 2000/05/30 14:12:33 1.1.2.18
@@ -185,7 +185,7 @@
void StringFree (/*in*/ char * * pArray) ;
-void StringAdd (/*in*/ char * * pArray,
+int StringAdd (/*in*/ char * * pArray,
/*in*/ const char * sAdd,
/*in*/ int nLen) ;
No revision
No revision
1.1.2.12 +56 -36 embperl/Embperl/Attic/Syntax.pm
Index: Syntax.pm
===================================================================
RCS file: /home/cvs/embperl/Embperl/Attic/Syntax.pm,v
retrieving revision 1.1.2.11
retrieving revision 1.1.2.12
diff -u -r1.1.2.11 -r1.1.2.12
--- Syntax.pm 2000/05/29 14:22:35 1.1.2.11
+++ Syntax.pm 2000/05/30 14:12:33 1.1.2.12
@@ -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.2.11 2000/05/29 14:22:35 richter Exp $
+# $Id: Syntax.pm,v 1.1.2.12 2000/05/30 14:12:33 richter Exp $
#
###################################################################################
@@ -92,10 +92,12 @@
embperl => {
perlcode =>
[
- 'if (!defined (_ep_rp(%$n%,scalar(do{%#~0:$row|$col|$cnt%})))) { last ; } %^*-htmltable%',
+ 'if (!defined (_ep_rp(%$n%,scalar(do{%#~0:$col%})))) { last l%^*htmlrow% ; }',
+ 'if (!defined (_ep_rp(%$n%,scalar(do{%#~0:$row%})))) { last l%^*htmltable% ; }',
'_ep_rp(%$n%,scalar(do{%#0%}));',
],
removenode => 4,
+ mayjump => '%#~0:$col|$row|$cnt% %?*htmlrow% %?*htmltable%'
}
},
},
@@ -284,10 +286,12 @@
%HtmlTagsStd,
'procinfo' => {
embperl => {
- perlcode => 'for (my $col = 0; $col < $maxcol; $col++) {' ,
- perlcodeend => '}' ,
- stackname => 'htmltable',
- push => '1',
+ perlcode => 'l%$l%: for (my $col = 0; $col < $maxcol; $col++) {' ,
+ perlcodeend => '} %?*-htmlrow%' ,
+ perlcoderemove => 1,
+ stackname => 'htmlrow',
+ push => '%$l%',
+ mayjump => 1,
}
},
},
@@ -302,10 +306,12 @@
%HtmlTagsStd,
'procinfo' => {
embperl => {
- perlcode => 'for (my $row = 0; $row < $maxrow; $row++) {' ,
- perlcodeend => '}' ,
+ perlcode => 'l%$l%: for (my $row = 0; $row < $maxrow; $row++) {' ,
+ perlcodeend => '} %?*-htmltable%' ,
+ perlcoderemove => 1,
stackname => 'htmltable',
- push => '1',
+ push => '%$l%',
+ mayjump => 1,
}
},
},
@@ -621,7 +627,7 @@
Type of nodes for data inside this node.
-=item endtag
+=item 'endtag'
Name of the tag that marks the end of a block.
@@ -658,55 +664,72 @@
=over 4
-=item %#N%
+=item %#<N>%
-Text of childnode number N (starting with zero)
+Text of childnode number <N> (starting with zero)
-=item %#*N%
+=item %&<attr>%
-Value of attribute <attr>. Attrbute must exist.
+Value of attribute <attr>.
+
+=item %^<stackname>%
-=item %#!N%
+Stringvalue of given stack
-Text of childnode number N (starting with zero). Child must not exist.
+=item %?<stackname>%
-=item %#=N:<value1>|<value2>|<value3>%
+Set if stackvalue was used
-Text of childnode number N (starting with zero). Child must have the value = <value1> or <value2> etc.
+=item %$n%
-=item %#~N:<value1>|<value2>|<value3>%
+Node number.
-Text of childnode number N (starting with zero). Child must contain the substring <value1> or <value2> etc.
+=item %$l%
-=item %&<attr>%
+Unique label
-Value of attribute <attr>.
+=item %$l+%
-=item %&*<attr>%
+Unique label and increment to next label
-Value of attribute <attr>. Attrbute must exist.
+=back
-=item %&!<attr>%
-Value of attribute <attr>. Attribute must not exist.
+All of the above special values (expect those start with $) allows the following
+modifiers:
-=item %&=<attr>:<value1>|<value2>|<value3>%
+=over 4
-Value of attribute <attr>. Attribute must have the value = <value1> or <value2> etc.
+=item %<X>B<*><N>%
-=item %&~<attr>:<value1>|<value2>|<value3>%
+Attribute/Child etc. must exist.
-Value of attribute <attr>. Attribute must contain the substring <value1> or <value2> etc.
+=item %<X>B<!><N>%
-=item %$n%
+Attribute/Child etc. must not exist.
-Node number.
+=item %<X>B<=><N>:<value1>|<value2>|<value3>%
+Attribute/Child etc. must have the value = <value1> or <value2> etc.
+
+=item %<X>B<~><N>:<value1>|<value2>|<value3>%
+
+Attribute/Child etc. must contain the substring <value1> or <value2> etc.
+
=back
writing a minus sign (-) after * ! = or ~ will cause the child/attribute
not to be included, but the condition is evaluated.
+=item perlcodeend => <string>
+
+Code to generate at the end of the block.
+
+=item perlcoderemove => 0/1
+
+Remove perlcode if perlcodeend condition is not met.
+
+
=item removenode => <removelevel>
Remove node after compiling. <removelevel> could be one of the following,
@@ -733,14 +756,11 @@
=back
-=item perlendcode => <string>
-
-Code to generate at the end of the block.
-
=item mayjump => 0/1
If set, tells the compiler that this code may jump to another programm location.
(e.g. if, while, goto etc.).
+
=back
No revision
No revision
1.5.2.3 +1 -1 embperl/test/cmp/error.htm
Index: error.htm
===================================================================
RCS file: /home/cvs/embperl/test/cmp/error.htm,v
retrieving revision 1.5.2.2
retrieving revision 1.5.2.3
diff -u -r1.5.2.2 -r1.5.2.3
--- error.htm 2000/05/29 14:23:14 1.5.2.2
+++ error.htm 2000/05/30 14:12:34 1.5.2.3
@@ -11,7 +11,7 @@
^<br> syntax error at test/html/error.htm line \d+, near "\$error is here "
^<br> syntax error at test/html/error.htm line \d+, near "}
^<br> _ep_cp"
-^<br> syntax error at test/html/error.htm line \d+, near "}
+^<br> syntax error at test/html/error.htm line \d+, near "
^<br>
^<br> }"<p>
^\[.*?\]ERR: 24: Line \d+: Error in Perl code: <p>
No revision
No revision
1.4.2.2 +58 -17 embperl/test/html/table.htm
Index: table.htm
===================================================================
RCS file: /home/cvs/embperl/test/html/table.htm,v
retrieving revision 1.4.2.1
retrieving revision 1.4.2.2
diff -u -r1.4.2.1 -r1.4.2.2
--- table.htm 2000/05/29 14:23:44 1.4.2.1
+++ table.htm 2000/05/30 14:12:35 1.4.2.2
@@ -5,23 +5,6 @@
<body>
-<table>
- <tr>
- <td>[+ $c[$row] +] </td>
- </tr>
-</table>
-<table>
- <tr>
- <td>[+ $c[$col] +] </td>
- </tr>
-</table>
-[#
-<table>
- <tr>
- <td>[+ $c[$row][$col] +] </td>
- </tr>
-</table>
-
<p> $tabmode = default <p>
@@ -56,6 +39,64 @@
$a[2][[2] = '3/3' ;<BR>
<P>$tabmode = default <P>
+
+
+<table>
+ <tr>
+ <td>[+ $a[$row][0] +]</td>
+ </tr>
+</table>
+<table>
+ <tr>
+ <td>[+ $a[2][$col] +]</td>
+ </tr>
+</table>
+
+
+<table>
+ <tr>
+ <td>before[+ $a[$row][0] +]</td>
+ </tr>
+</table>
+<table>
+ <tr>
+ <td>before[+ $a[2][$col] +]</td>
+ </tr>
+</table>
+
+<table>
+ <tr>
+ <td>[+ $a[$row][0] +]after</td>
+ </tr>
+</table>
+<table>
+ <tr>
+ <td>[+ $a[2][$col] +]after</td>
+ </tr>
+</table>
+<table>
+ <tr>
+ <td>before[+ $a[$row][0] +]after</td>
+ </tr>
+</table>
+<table>
+ <tr>
+ <td>before[+ $a[2][$col] +]after</td>
+ </tr>
+</table>
+
+<table>
+ <tr>
+ <td>[+ $c[$row] +]</td>
+ </tr>
+</table>
+<table>
+ <tr>
+ <td>[+ $c[$col] +]</td>
+ </tr>
+</table>
+
+[#
<table border="2" width="100%">
<tr>