richter 01/05/07 23:29:45
Modified: . Tag: Embperl2c epcomp.c epdom.c test.pl
Embperl/Syntax Tag: Embperl2c RTF.pm
test/cmp Tag: Embperl2c rtffull.asc
Log:
Embperl 2 - RTF cont
Revision Changes Path
No revision
No revision
1.4.2.51 +16 -1 embperl/Attic/epcomp.c
Index: epcomp.c
===================================================================
RCS file: /home/cvs/embperl/Attic/epcomp.c,v
retrieving revision 1.4.2.50
retrieving revision 1.4.2.51
diff -u -r1.4.2.50 -r1.4.2.51
--- epcomp.c 2001/05/06 12:39:03 1.4.2.50
+++ epcomp.c 2001/05/08 06:29:38 1.4.2.51
@@ -9,7 +9,7 @@
# IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
# WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
#
-# $Id: epcomp.c,v 1.4.2.50 2001/05/06 12:39:03 richter Exp $
+# $Id: epcomp.c,v 1.4.2.51 2001/05/08 06:29:38 richter Exp $
#
###################################################################################*/
@@ -1361,6 +1361,21 @@
if ((rc = embperl_CompileNode (r, pDomTree, pDomTree -> xDocument,
&bCheckpointPending)) != ok)
return rc ;
+#if 0
+ if (bCheckpointPending)
+ {
+ int l ;
+ char buf [80] ;
+
+ l = sprintf (buf, " _ep_cp(%d) ;\n", -1) ; // xNode) ;
+ StringAdd (r -> pProg, buf, l) ;
+
+ if (pCurrReq -> bDebug & dbgParse)
+ lprintf (pCurrReq, "[%d]EPCOMP: #%d L%s Checkpoint\n", pCurrReq -> nPid,
-1, "end") ;
+
+ }
+#endif
+
return ok ;
}
1.4.2.36 +30 -5 embperl/Attic/epdom.c
Index: epdom.c
===================================================================
RCS file: /home/cvs/embperl/Attic/epdom.c,v
retrieving revision 1.4.2.35
retrieving revision 1.4.2.36
diff -u -r1.4.2.35 -r1.4.2.36
--- epdom.c 2001/05/06 12:39:04 1.4.2.35
+++ epdom.c 2001/05/08 06:29:39 1.4.2.36
@@ -9,7 +9,7 @@
# IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
# WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
#
-# $Id: epdom.c,v 1.4.2.35 2001/05/06 12:39:04 richter Exp $
+# $Id: epdom.c,v 1.4.2.36 2001/05/08 06:29:39 richter Exp $
#
###################################################################################*/
@@ -2293,8 +2293,10 @@
char * pNodeName = Node_selfNodeName (pNode) ;
char * pNodeStart ;
char * pNodeEnd ;
+ char * p ;
int nNodeStartLen ;
int nNodeEndLen ;
+ int nNodeNameLen ;
int nLastLen ;
if (*pNodeName)
@@ -2320,6 +2322,14 @@
}
if (*pNodeName == ':')
pNodeName++ ;
+
+ nNodeNameLen = 0 ;
+ p = pNodeName ;
+ while (*p && *p != ':')
+ {
+ p++ ;
+ nNodeNameLen++ ;
+ }
}
else
{
@@ -2327,6 +2337,7 @@
pNodeEnd = ">" ;
nNodeStartLen = 1 ;
nNodeEndLen = 1 ;
+ nNodeNameLen = strlen (pNodeName) ;
}
@@ -2334,7 +2345,7 @@
pLastStartTag = pNode ;
owrite (r, pNodeStart, nNodeStartLen) ;
- oputs (r, pNodeName) ;
+ owrite (r, pNodeName, nNodeNameLen) ;
if (*pNodeName)
nLastLen = 1 ;
else
@@ -2450,9 +2461,23 @@
if (pNode -> nType == ntypStartTag && (pNode -> bFlags & nflgIgnore)
== 0 &&
(pNextNode == NULL || (pNextNode -> bFlags & nflgCheckpoint) == 0
|| pDomTree -> pOrder[nOrderNdx].xFromNode == pNextNode -> xNdx))
{
- oputs (r, "</") ;
- oputs (r, Node_selfNodeName (pNode)) ;
- oputc (r, '>') ;
+ char * pNodeName = Node_selfNodeName (pNode) ;
+
+ if (*pNodeName == ':')
+ {
+ int i = 4 ;
+ while (i > 0 && *pNodeName)
+ if (*pNodeName++ == ':')
+ i-- ;
+ if (*pNodeName)
+ oputs (r, pNodeName) ;
+ }
+ else
+ {
+ oputs (r, "</") ;
+ oputs (r, Node_selfNodeName (pNode)) ;
+ oputc (r, '>') ;
+ }
pLastStartTag = Node_selfParentNode (pDomTree,
pNextNode?pNextNode:pNode) ;
}
}
1.70.4.56 +13 -2 embperl/test.pl
Index: test.pl
===================================================================
RCS file: /home/cvs/embperl/test.pl,v
retrieving revision 1.70.4.55
retrieving revision 1.70.4.56
diff -u -r1.70.4.55 -r1.70.4.56
--- test.pl 2001/05/07 11:48:27 1.70.4.55
+++ test.pl 2001/05/08 06:29:40 1.70.4.56
@@ -11,7 +11,7 @@
# IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
# WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
#
-# $Id: test.pl,v 1.70.4.55 2001/05/07 11:48:27 richter Exp $
+# $Id: test.pl,v 1.70.4.56 2001/05/08 06:29:40 richter Exp $
#
###################################################################################
@@ -585,6 +585,17 @@
'syntax' => 'RTF',
'param' => { 'Nachname' => 'Richter', Vorname => 'Gerald' },
},
+ 'rtf/rtfloop.asc' => {
+ 'version' => 2,
+ 'syntax' => 'RTF',
+ 'param' => [
+ { 'Kunde' => 'blabla', Kurs => 'blubblub', 'Nachname' =>
'Richter', Vorname => 'Gerald' },
+ { 'Kunde' => 'blabla', Kurs => 'blubblub', 'Nachname' =>
'Richter2', Vorname => 'Gerald2' },
+ { 'Kunde' => 'blabla', Kurs => 'blubblub', 'Nachname' =>
'Richter3', Vorname => 'Gerald3' },
+ { 'Kunde' => 'blabla', Kurs => 'blubblub', 'Nachname' =>
'Richter4', Vorname => 'Gerald4' },
+ { 'Kunde' => 'blabla', Kurs => 'blubblub', 'Nachname' =>
'Richter5', Vorname => 'Gerald5' },
+ ]
+ },
) ;
for ($i = 0 ; $i < @testdata; $i += 2)
@@ -1341,7 +1352,7 @@
@testargs = ( '-o', $outfile ,
'-l', $logfile,
'-d', $debug,
- ($test->{param}?('-p', $test->{param}):()),
+ ($test->{param}?(ref ($test->{param}) eq 'ARRAY'?map {
('-p', $_) } @{$test->{param}}:('-p', $test->{param})):()),
$page, $test -> {query_info} || '') ;
unshift (@testargs, 'dbgbreak') if ($opt_dbgbreak) ;
No revision
No revision
1.1.2.7 +33 -30 embperl/Embperl/Syntax/Attic/RTF.pm
Index: RTF.pm
===================================================================
RCS file: /home/cvs/embperl/Embperl/Syntax/Attic/RTF.pm,v
retrieving revision 1.1.2.6
retrieving revision 1.1.2.7
diff -u -r1.1.2.6 -r1.1.2.7
--- RTF.pm 2001/05/07 11:48:46 1.1.2.6
+++ RTF.pm 2001/05/08 06:29:43 1.1.2.7
@@ -10,7 +10,7 @@
# IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
# WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
#
-# $Id: RTF.pm,v 1.1.2.6 2001/05/07 11:48:46 richter Exp $
+# $Id: RTF.pm,v 1.1.2.7 2001/05/08 06:29:43 richter Exp $
#
###################################################################################
@@ -22,7 +22,7 @@
use HTML::Embperl::Syntax::EmbperlBlocks ;
use strict ;
-use vars qw{@ISA %Block %BlockInside %FieldStart %CmdStart %Var %Spaces} ;
+use vars qw{@ISA %Para %Block %BlockInside %FieldStart %CmdStart %Var %Spaces} ;
@@ -50,12 +50,12 @@
if (!$self -> {-rtfBlocks})
{
- $self -> {-rtfBlocks} = $self -> CloneHash (\%Block) ;
+ $self -> {-rtfBlocks} = $self -> CloneHash (\%Para) ;
$self -> AddToRoot ($self -> {-rtfBlocks}) ;
#$self -> {-rtfCmds} = $self -> {-rtfBlocks}{'RTF field'}{'follow'}{'RTF
fieldstart'}{'follow'}{'RTF block cmd'}{'follow'} ;
- $self -> {-rtfCmds} = $self -> {-rtfBlocks}{'RTF field'}{'inside'}{'RTF
fieldstart'}{'inside'}{'RTF block cmd'}{'inside'} ;
+ $self -> {-rtfCmds} = $self -> {-rtfBlocks}{'RTF first
paragraph'}{'inside'}{'RTF field'}{'inside'}{'RTF fieldstart'}{'inside'}{'RTF block
cmd'}{'inside'} ;
Init ($self) ;
}
@@ -154,6 +154,8 @@
{
my ($self) = @_ ;
+ $self -> AddInitCode (undef, '$_ep_rtf_ndx=0;$_ep_rtf_max=@param;', undef) ;
+
$self -> AddRTFCmd ('DOCVARIABLE',
{
perlcode => '_ep_rp(%$x%,scalar(join(\'\',',
@@ -179,10 +181,10 @@
$self -> AddRTFCmd ('NEXT',
{
- perlcode => '# record',
+ perlcode => '$_ep_rtf_ndx++;',
},
{
- 'nodename' => '',
+ 'removenode' => 1,
'cdatatype' => 0,
}) ;
@@ -308,7 +310,7 @@
{
my $var = shift ;
my @parts = split (/\./, $var) ;
- my $code = '$param[0]' ;
+ my $code = '$param[$_ep_rtf_ndx]' ;
foreach (@parts)
{
@@ -346,26 +348,6 @@
},
) ;
-%Spaces = (
- 'Spaces2' =>
- {
- 'cdatatype' => 0,
- 'text' => ' ',
- 'nodename' => ':: ',
- },
- 'Spaces3' =>
- {
- 'cdatatype' => 0,
- 'text' => ' ',
- 'nodename' => ':: ',
- },
- 'Spaces4' =>
- {
- 'cdatatype' => 0,
- 'text' => ' ',
- 'nodename' => ':: ',
- },
- ) ;
# Start of commands
@@ -378,7 +360,7 @@
'unescape' => 1,
'cdatatype' => ntypAttrValue,
'nodename' => ':',
- 'inside' => {}, #\%Spaces,
+ 'inside' => {},
},
) ;
@@ -408,9 +390,30 @@
},
) ;
+
+# Finds the first paragraph
+
+%Para = (
+ '-lsearch' => 1,
+ 'RTF first paragraph' => {
+ 'text' => '\pard',
+ 'end' => '}',
+ 'nodename' => ':::\pard:}',
+ 'nodetype' => ntypStartTag,
+ 'inside' => \%Block,
+ 'procinfo' => {
+ 'embperl' => {
+ perlcode => q[ do { ],
+ perlcodeend => q[ $_ep_rtf_ndx;} while ($_ep_rtf_ndx <
$_ep_rtf_max) ; ],
+ mayjump => 1,
+ },
+ },
+ },
+ ) ;
+
# Basic definition of Block in a RTF file
-%Block = (
+my %Blockx = (
'-lsearch' => 1,
'RTF field' => {
'text' => '{\field',
@@ -421,7 +424,7 @@
},
) ;
-my %Blockx = (
+%Block = (
'-lsearch' => 1,
'RTF block' => {
'text' => '{',
No revision
No revision
1.1.2.2 +1 -1 embperl/test/cmp/Attic/rtffull.asc
Index: rtffull.asc
===================================================================
RCS file: /home/cvs/embperl/test/cmp/Attic/rtffull.asc,v
retrieving revision 1.1.2.1
retrieving revision 1.1.2.2
diff -u -r1.1.2.1 -r1.1.2.2
--- rtffull.asc 2001/05/07 11:48:57 1.1.2.1
+++ rtffull.asc 2001/05/08 06:29:44 1.1.2.2
@@ -8,7 +8,7 @@
\deftab708\widowctrl\ftnbj\aenddoc\hyphhotz425\noxlattoyen\expshrtn\noultrlspc\dntblnsbdb\nospaceforul\formshade\viewkind1\viewscale50\pgbrdrhead\pgbrdrfoot
\fet0\sectd
\lndscpsxn\psz9\linex0\headery709\footery709\colsx709\endnhere\sectdefaultcl
{\*\pnseclvl1\pnucrm\pnstart1\pnindent720\pnhang{\pntxta
.}}{\*\pnseclvl2\pnucltr\pnstart1\pnindent720\pnhang{\pntxta
.}}{\*\pnseclvl3\pndec\pnstart1\pnindent720\pnhang{\pntxta
.}}{\*\pnseclvl4\pnlcltr\pnstart1\pnindent720\pnhang{\pntxta )}}{\*\pnseclvl5
\pndec\pnstart1\pnindent720\pnhang{\pntxtb (}{\pntxta
)}}{\*\pnseclvl6\pnlcltr\pnstart1\pnindent720\pnhang{\pntxtb (}{\pntxta
)}}{\*\pnseclvl7\pnlcrm\pnstart1\pnindent720\pnhang{\pntxtb (}{\pntxta
)}}{\*\pnseclvl8\pnlcltr\pnstart1\pnindent720\pnhang
-{\pntxtb (}{\pntxta )}}{\*\pnseclvl9\pnlcrm\pnstart1\pnindent720\pnhang{\pntxtb
(}{\pntxta )}}\trowd \trrh-10199\trkeep \clvertalt\cltxtbrl
\cellx3986\clvertalt\cltxbtlr \cellx7973\clvertalt\cltxtbrl
\cellx11959\clvertalt\cltxbtlr \cellx15946\pard\plain
+{\pntxtb (}{\pntxta )}}{\*\pnseclvl9\pnlcrm\pnstart1\pnindent720\pnhang{\pntxtb
(}{\pntxta )}}\trowd \trrh-10199\trkeep \clvertalt\cltxtbrl
\cellx3986\clvertalt\cltxbtlr \cellx7973\clvertalt\cltxtbrl
\cellx11959\clvertalt\cltxbtlr \cellx15946\pard \plain
\li113\ri113\widctlpar\intbl\adjustright \fs20\lang1031\cgrid {\b\f1\fs80
\par }\pard \li2124\ri113\widctlpar\intbl\adjustright {\b\f1\fs80 Dr.
}{\b\f1\fs80\lang1036 Gerald}{\b\f1\fs80\lang1036 }{\b\f1\fs80\lang1036
Richter}{\b\f1\fs80\lang1036 \cell }\pard \ri113\widctlpar\intbl\adjustright
{\b\f1\fs48\lang1036
\par }\pard \li2124\ri113\widctlpar\intbl\adjustright {\b\f1\fs80\lang1036
---------------------------------------------------------------------
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
