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/09/09 21:05:12 UTC
cvs commit: embperl/test/html/rtf rtfadv.asc
richter 01/09/09 12:05:12
Modified: . Tag: Embperl2c epcomp.c test.pl
Embperl Tag: Embperl2c Syntax.pm
Embperl/Syntax Tag: Embperl2c RTF.pm
test/cmp Tag: Embperl2c rtfadv.asc
test/html/rtf Tag: Embperl2c rtfadv.asc
Log:
Embperl 2 - RTF Syntax
Revision Changes Path
No revision
No revision
1.4.2.56 +22 -3 embperl/Attic/epcomp.c
Index: epcomp.c
===================================================================
RCS file: /home/cvs/embperl/Attic/epcomp.c,v
retrieving revision 1.4.2.55
retrieving revision 1.4.2.56
diff -u -r1.4.2.55 -r1.4.2.56
--- epcomp.c 2001/08/28 08:01:26 1.4.2.55
+++ epcomp.c 2001/09/09 19:05:11 1.4.2.56
@@ -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.55 2001/08/28 08:01:26 richter Exp $
+# $Id: epcomp.c,v 1.4.2.56 2001/09/09 19:05:11 richter Exp $
#
###################################################################################*/
@@ -930,10 +930,20 @@
if (pCTCode)
{
int l = ArrayGetSize (pCTCode) ;
+ int i = l ;
+ char *p = pCTCode ;
if (pCurrReq -> bDebug & dbgParse)
lprintf (pCurrReq, "[%d]EPCOMP: #%d L%d CompileTimeCode: %*.*s\n", pCurrReq -> nPid, pNode -> xNdx, pNode -> nLinenumber, l, l, pCTCode) ;
+ while (i--)
+ { /* keep everything on one line, to make linenumbers correct */
+ if (*p == '\r' || *p == '\n')
+ *p = ' ' ;
+ p++ ;
+ }
+
+
pSV = newSVpvf("package %s ;\n#line %d \"%s\"\n%*.*s",
pCurrReq -> Buf.sEvalPackage, pNode -> nLinenumber, sSourcefile, l,l, pCTCode) ;
args[0] = r -> pReqSV ;
@@ -1152,14 +1162,23 @@
int l = ArrayGetSize (pCTCode) ;
char * sSourcefile ;
int nSourcefile ;
+ int i = l ;
+ char * p = pCTCode ;
Ndx2StringLen (pDomTree -> xFilename, sSourcefile, nSourcefile) ;
-
-
if (pCurrReq -> bDebug & dbgParse)
lprintf (pCurrReq, "[%d]EPCOMP: #%d L%d CompileTimeCodeEnd: %*.*s\n", pCurrReq -> nPid, pNode -> xNdx, pNode -> nLinenumber, l, l, pCTCode) ;
+ while (i--)
+ { /* keep everything on one line, to make linenumbers correct */
+ if (*p == '\r' || *p == '\n')
+ *p = ' ' ;
+ p++ ;
+ }
+
+
+
pSV = newSVpvf("package %s ;\n#line %d \"%s\"\n%*.*s",
pCurrReq -> Buf.sEvalPackage, pNode -> nLinenumber, sSourcefile, l,l, pCTCode) ;
args[0] = r -> pReqSV ;
1.70.4.66 +2 -2 embperl/test.pl
Index: test.pl
===================================================================
RCS file: /home/cvs/embperl/test.pl,v
retrieving revision 1.70.4.65
retrieving revision 1.70.4.66
diff -u -r1.70.4.65 -r1.70.4.66
--- test.pl 2001/08/28 13:58:30 1.70.4.65
+++ test.pl 2001/09/09 19:05:11 1.70.4.66
@@ -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.65 2001/08/28 13:58:30 richter Exp $
+# $Id: test.pl,v 1.70.4.66 2001/09/09 19:05:11 richter Exp $
#
###################################################################################
@@ -607,7 +607,7 @@
'syntax' => 'RTF',
'offline' => 1,
'param' => [
- { 'adressen_anrede' => 'Herr', 'adressen_name' => 'Richter', 'adressen_vorname' => 'Gerald' },
+ { 'adressen_anrede' => 'Herr', 'adressen_name' => 'Richter', 'adressen_vorname' => 'Gerald', anschreiben_typ => 'Dienstadresse', adressen_dienststelle => 'adrdienst' },
{ 'adressen_anrede' => 'Frau', 'adressen_name' => 'Weis', 'adressen_vorname' => 'Ulrike' },
{ 'adressen_anrede' => 'Frau', 'adressen_name' => 'Weis', 'adressen_vorname' => 'Sarah' },
{ 'adressen_anrede' => 'Frau', 'adressen_name' => 'Weis', 'adressen_vorname' => 'Marissa' },
No revision
No revision
1.1.4.42 +10 -7 embperl/Embperl/Attic/Syntax.pm
Index: Syntax.pm
===================================================================
RCS file: /home/cvs/embperl/Embperl/Attic/Syntax.pm,v
retrieving revision 1.1.4.41
retrieving revision 1.1.4.42
diff -u -r1.1.4.41 -r1.1.4.42
--- Syntax.pm 2001/08/28 08:01:28 1.1.4.41
+++ Syntax.pm 2001/09/09 19:05:12 1.1.4.42
@@ -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.41 2001/08/28 08:01:28 richter Exp $
+# $Id: Syntax.pm,v 1.1.4.42 2001/09/09 19:05:12 richter Exp $
#
###################################################################################
@@ -223,21 +223,24 @@
return undef if (!$name) ;
return $Syntax{$name} if (exists ($Syntax{$name})) ;
- foreach (@names)
+ foreach my $n (@names)
{
- eval "require $_" ;
- warn $@ if ($@) ;
- return undef if ($@) ;
+ eval "require $n" ;
+ if ($@)
+ {
+ warn $@ ;
+ return undef ;
+ }
}
my $first = shift @names ;
my $self = $first -> new ;
- foreach (@names)
+ foreach my $n (@names)
{
no strict ;
- &{"${_}::new"}($self) ;
+ &{"${n}::new"}($self) ;
use strict ;
}
No revision
No revision
1.1.2.19 +79 -29 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.18
retrieving revision 1.1.2.19
diff -u -r1.1.2.18 -r1.1.2.19
--- RTF.pm 2001/08/29 09:48:39 1.1.2.18
+++ RTF.pm 2001/09/09 19:05:12 1.1.2.19
@@ -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.18 2001/08/29 09:48:39 richter Exp $
+# $Id: RTF.pm,v 1.1.2.19 2001/09/09 19:05:12 richter Exp $
#
###################################################################################
@@ -24,8 +24,8 @@
use strict ;
use vars qw{@ISA %Para %Block %BlockInside %FieldStart %CmdStart %Var %Spaces %Inside} ;
+require Text::ParseWords ;
-
@ISA = qw(HTML::Embperl::Syntax::EmbperlBlocks) ;
@@ -100,7 +100,7 @@
} ;
if ($procinfo)
{
- #$procinfo -> {compiletimeperlcode} = q[my $tmp = %#'0% ; $tmp =~ s/_ep_rp\(.*?\,/\$_ep_rtf_tmp .= (/, $_[0] -> Code ($tmp) ; ] ;
+ #$procinfo -> {compiletimeperlcode} = q[my $tmp = %#'0% ; $tmp =~ s/_ep_rp\(.*?\,/push \@_ep_rtf_tmp,(/, $_[0] -> Code ($tmp) ; ] ;
$tag -> {'procinfo'} = { $self -> {-procinfotype} => $procinfo } ;
}
$self -> {-rtfCmds2} -> {$cmdname} = $tag ;
@@ -179,7 +179,7 @@
{
perlcode => '_ep_rp(%$x%,scalar(esc(join(\'\',',
perlcodeend => '))));',
- compiletimeperlcode => q[if ($_ep_rtf_inside) { my $tmp = $_[0] -> Code () ; $tmp =~ s/_ep_rp\(.*?\,/\$_ep_rtf_tmp .= (/ ; $_[0] -> Code ($tmp) } ;],
+ compiletimeperlcode => q[if ($_ep_rtf_inside) { my $tmp = $_[0] -> Code () ; $tmp =~ s/_ep_rp\(.*?\,/push \@_ep_rtf_tmp,(/ ; $_[0] -> Code ($tmp) } ; $_ep_rtf_cmd = 1 ;],
},
{
'inside' => \%Var,
@@ -190,7 +190,7 @@
{
perlcode => '_ep_rp(%$x%,scalar(esc(join(\'\',',
perlcodeend => '))));',
- compiletimeperlcode => q[if ($_ep_rtf_inside) { my $tmp = $_[0] -> Code () ; $tmp =~ s/_ep_rp\(.*?\,/\$_ep_rtf_tmp .= (/ ; $_[0] -> Code ($tmp) } ;],
+ compiletimeperlcode => q[if ($_ep_rtf_inside) { my $tmp = $_[0] -> Code () ; $tmp =~ s/_ep_rp\(.*?\,/push \@_ep_rtf_tmp,(/ ; $_[0] -> Code ($tmp) } ; $_ep_rtf_cmd = 1 ;],
},
{
'inside' => \%Var,
@@ -219,7 +219,7 @@
'cdatatype' => 0,
},
{
- perlcode => '$_ep_rtf_tmp .= $_ep_rtf_ndx+1',
+ perlcode => 'push @_ep_rtf_tmp,$_ep_rtf_ndx+1',
},
) ;
@@ -233,14 +233,14 @@
'cdatatype' => 0,
},
{
- perlcode => '$_ep_rtf_tmp .= $_ep_rtf_ndx+1',
+ perlcode => 'push @_ep_rtf_tmp,$_ep_rtf_ndx+1',
},
) ;
$self -> AddRTFCmd ('IF',
{
- perlcode => '$_ep_rtf_tmp = \'\';',
- compiletimeperlcode => q[$_ep_rtf_inside = 1 ; $_ep_rtf_code = '_ep_rp($x, \'{\'.($_ep_rtf_tmp $op $cmp?$a:$b).\'}\');' ; ],
+ perlcode => '@_ep_rtf_tmp=();',
+ compiletimeperlcode => q[$_ep_rtf_inside = 1 ; $_ep_rtf_code = '_ep_rp($x, \'{\'.($true?$_ep_rtf_tmp[3]:$_ep_rtf_tmp[4]).\'}\');' ; $_ep_rtf_cmd = 1 ; ],
},
{
'nodename' => '::::IF',
@@ -251,8 +251,8 @@
$self -> AddRTFCmd ('NEXTIF',
{
- perlcode => '$_ep_rtf_tmp = \'\';',
- compiletimeperlcode => q[$_ep_rtf_inside = 1 ; $_ep_rtf_code = '$_ep_rtf_ndx++ if ($_ep_rtf_tmp $op $cmp); ' ; ],
+ perlcode => '@_ep_rtf_tmp=();',
+ compiletimeperlcode => q[$_ep_rtf_inside = 1 ; $_ep_rtf_code = '$_ep_rtf_ndx++ if ($true); ' ; $_ep_rtf_cmd = 1 ;],
},
{
'nodename' => '::::NEXTIF',
@@ -263,8 +263,8 @@
$self -> AddRTFCmd ('SKIPIF',
{
- perlcode => '$_ep_rtf_tmp = \'\';',
- compiletimeperlcode => q[$_ep_rtf_inside = 1 ; $_ep_rtf_code = '$_ep_rtf_ndx+=2 if ($_ep_rtf_tmp $op $cmp); ' ; ],
+ perlcode => '@_ep_rtf_tmp=();',
+ compiletimeperlcode => q[$_ep_rtf_inside = 1 ; $_ep_rtf_code = '$_ep_rtf_ndx+=2 if ($true); ' ; $_ep_rtf_cmd = 1 ; ],
},
{
'nodename' => '::::NEXTIF',
@@ -450,7 +450,13 @@
#'cdatatype' => ntypAttrValue,
'nodename' => '!:',
'inside' => {},
- 'procinfo' => {'embperl' => {}},
+ 'procinfo' => {
+ 'embperl' => {
+ compiletimeperlcodeend => q[ $_[0] -> Code ('') if (!$_ep_rtf_inside || $_ep_rtf_cmd) ; $_ep_rtf_cmd = 0 ;],
+ perlcodeend => q[ if (%#'0% =~ /\"\s*$/) { push @_ep_rtf_tmp, Text::ParseWords::quotewords('\s+', 0, %#'0%) } else { push @_ep_rtf_tmp,%#'0% } ],
+ },
+ },
+# 'procinfo' => {'embperl' => {}},
},
'RTF field' => {
'text' => '{\field',
@@ -578,22 +584,42 @@
if ($_ep_rtf_inside == 0)
{
my $x = $_[0] -> Code ;
- my ($op, $cmp, $a, $b) = XML::Embperl::DOM::Node::iChildsText (%$q%,%$x%,1) =~ /\:([=<>])+\s*\"(.*?)\"(?:\s*\"(.*?)\"\s*\"(.*?)\")?/ ;
- if ($op eq '=') { $op = 'eq' }
- elsif ($op eq '<') { $op = 'lt' }
- elsif ($op eq '>') { $op = 'gt' }
- elsif ($op eq '>=') { $op = 'ge' }
- elsif ($op eq '<=') { $op = 'le' }
-
- #print "op = $op cmp = $cmp a = $a b = $b code=$_ep_rtf_code tmp=$_ep_rtf_tmp 0=$param[0]{'adressen_anrede'} ndx=$_ep_rtf_ndx eval=qq[$_ep_rtf_code]\n" ;
- $_ep_rtf_code =~ s/\$a/q\[$a\]/g ;
- $_ep_rtf_code =~ s/\$b/q\[$b\]/g ;
- $_ep_rtf_code =~ s/\$cmp/q\[$cmp\]/g ;
- $_ep_rtf_code =~ s/\$op/$op/g ;
$_ep_rtf_code =~ s/\$x/$x/g ;
- #print "result=$_ep_rtf_code\n" ;
-
- $_[0] -> Code ($_ep_rtf_code) ;
+
+ $_[0] -> Code (q[
+ {
+
+ $_ep_rtf_tmp[0] =~ s/\\\\\\\\[0-9a-zA-Z]+\s*//g ;
+ $_ep_rtf_tmp[1] =~ s/\\\\\\\\[0-9a-zA-Z]+\s*//g ;
+ if ($_ep_rtf_tmp[0] =~ /^\s*(.+?)\s*(=|<|>)$/)
+ {
+ unshift @_ep_rtf_tmp, $1 ;
+ $_ep_rtf_tmp[1] = $2 ;
+ }
+ if ($_ep_rtf_tmp[1] =~ /^(=|<|>)\s*\"?\s*(.+?)\s*$/)
+ {
+ unshift @_ep_rtf_tmp, $_ep_rtf_tmp[0] ;
+ $_ep_rtf_tmp[1] = $1 ;
+ $_ep_rtf_tmp[2] = $2 ;
+ }
+
+ my $op = $_ep_rtf_tmp[1] ;
+ if ($op eq '=')
+ { $true = $_ep_rtf_tmp[0] eq $_ep_rtf_tmp[2] }
+ elsif ($op eq '<')
+ { $true = $_ep_rtf_tmp[0] lt $_ep_rtf_tmp[2] }
+ elsif ($op eq '>')
+ { $true = $_ep_rtf_tmp[0] gt $_ep_rtf_tmp[2] }
+ elsif ($op eq '<=')
+ { $true = $_ep_rtf_tmp[0] le $_ep_rtf_tmp[2] }
+ elsif ($op eq '>=')
+ { $true = $_ep_rtf_tmp[0] gt $_ep_rtf_tmp[2] }
+ elsif ($op eq '!=')
+ { $true = $_ep_rtf_tmp[0] ne $_ep_rtf_tmp[2] }
+ elsif ($op eq '<>')
+ { $true = $_ep_rtf_tmp[0] ne $_ep_rtf_tmp[2] }
+
+ ] . $_ep_rtf_code . '}') ;
}
}
else
@@ -604,6 +630,7 @@
},
},
},
+
'RTF escape open' => {
'text' => '\\{',
'nodename' => '\\{',
@@ -632,6 +659,29 @@
1;
+=pod
+ #$_[0] -> Code ($_ep_rtf_code) ;
+
+ my $x = $_[0] -> Code ;
+ my ($op, $cmp, $a, $b) = XML::Embperl::DOM::Node::iChildsText (%$q%,%$x%,1) =~ /\:([=<>])+\s*\"(.*?)\"(?:\s*\"(.*?)\"\s*\"(.*?)\")?/ ;
+
+ if ($op eq '=') { $op = 'eq' }
+ elsif ($op eq '<') { $op = 'lt' }
+ elsif ($op eq '>') { $op = 'gt' }
+ elsif ($op eq '>=') { $op = 'ge' }
+ elsif ($op eq '<=') { $op = 'le' }
+
+ print "\n#" . __LINE__ . " op = $op cmp = $cmp a = $a b = $b code=$_ep_rtf_code tmp=$_ep_rtf_tmp 0=$param[0]{'adressen_anrede'} ndx=$_ep_rtf_ndx eval=qq[$_ep_rtf_code]\n" ;
+ $_ep_rtf_code =~ s/\$a/q\[$a\]/g ;
+ $_ep_rtf_code =~ s/\$b/q\[$b\]/g ;
+ $_ep_rtf_code =~ s/\$cmp/q\[$cmp\]/g ;
+ $_ep_rtf_code =~ s/\$op/$op/g ;
+ $_ep_rtf_code =~ s/\$x/$x/g ;
+ print "result=$_ep_rtf_code\n" ;
+
+ warn "RTF IF syntax error. Missing operator" if (!$op) ;
+=cut
+
__END__
No revision
No revision
1.1.2.2 +10 -0 embperl/test/cmp/Attic/rtfadv.asc
Index: rtfadv.asc
===================================================================
RCS file: /home/cvs/embperl/test/cmp/Attic/rtfadv.asc,v
retrieving revision 1.1.2.1
retrieving revision 1.1.2.2
diff -u -r1.1.2.1 -r1.1.2.2
--- rtfadv.asc 2001/08/29 08:25:23 1.1.2.1
+++ rtfadv.asc 2001/09/09 19:05:12 1.1.2.2
@@ -3,6 +3,11 @@
{ }
{Herr}
{ }{Richter}
+
+{adrdienst}
+
+
+
{,
\par
\par dies ist ein Anschreiben
@@ -31,6 +36,11 @@
{ }
{Frau}
{ }{Weis}
+
+{}
+
+
+
{,
\par
\par dies ist ein Anschreiben
No revision
No revision
1.1.2.2 +19 -0 embperl/test/html/rtf/Attic/rtfadv.asc
Index: rtfadv.asc
===================================================================
RCS file: /home/cvs/embperl/test/html/rtf/Attic/rtfadv.asc,v
retrieving revision 1.1.2.1
retrieving revision 1.1.2.2
diff -u -r1.1.2.1 -r1.1.2.2
--- rtfadv.asc 2001/07/31 08:02:46 1.1.2.1
+++ rtfadv.asc 2001/09/09 19:05:12 1.1.2.2
@@ -4,6 +4,25 @@
{ }
{\field{\*\fldinst { MERGEFIELD adressen_anrede }}{\fldrslt {\lang1024 \'abadressen_anrede\'bb}}}
{ }{\field{\*\fldinst { MERGEFIELD adressen_name }}{\fldrslt {\lang1024 \'abadressen_name\'bb}}}
+
+{\field
+ {\*\fldinst
+ {\f1\fs22 IF }
+ {\field
+ {\*\fldinst
+ {\f1\fs22 MERGEFIELD anschreiben_typ }
+ }
+ {\fldrslt
+ {\f1\fs22\lang1024 Dienstadresse}
+ }
+ }
+ {\f1\fs22 = Dienstadresse }
+ {\field{\*\fldinst {\f1\fs22 MERGEFIELD adressen_dienststelle }}{\fldrslt {\f1\fs22\lang1024 Mittelrheinische Treuhand GmbH}}}
+ {\f1\fs22 "" }
+ }{\fldrslt {\f1\fs22\lang1024 Mittelrheinische Treuhand GmbH}}}
+
+
+
{,
\par
\par dies ist ein Anschreiben
---------------------------------------------------------------------
To unsubscribe, e-mail: embperl-cvs-unsubscribe@perl.apache.org
For additional commands, e-mail: embperl-cvs-help@perl.apache.org