richter 01/02/26 23:42:27
Modified: . Tag: Embperl2c MANIFEST test.pl
Embperl Tag: Embperl2c Syntax.pm
Embperl/Syntax Tag: Embperl2c EmbperlBlocks.pm HTML.pm
Added: Embperl/Syntax Tag: Embperl2c Embperl.pm EmbperlHTML.pm
Log:
Embperl 2 - multiple syntaxes
Revision Changes Path
No revision
No revision
1.50.4.12 +4 -0 embperl/MANIFEST
Index: MANIFEST
===================================================================
RCS file: /home/cvs/embperl/MANIFEST,v
retrieving revision 1.50.4.11
retrieving revision 1.50.4.12
diff -u -r1.50.4.11 -r1.50.4.12
--- MANIFEST 2000/12/21 09:37:49 1.50.4.11
+++ MANIFEST 2001/02/27 07:42:26 1.50.4.12
@@ -5,6 +5,10 @@
epcmd2.c
ep2.h
Embperl/Syntax.pm
+Embperl/Syntax/HTML.pm
+Embperl/Syntax/EmbperlHTML.pm
+Embperl/Syntax/EmbperlBlocks.pm
+Embperl/Syntax/Embperl.pm
README.v2
test/cmp2/errdoc2.htm
test/cmp2/error.htm
1.70.4.27 +4 -0 embperl/test.pl
Index: test.pl
===================================================================
RCS file: /home/cvs/embperl/test.pl,v
retrieving revision 1.70.4.26
retrieving revision 1.70.4.27
diff -u -r1.70.4.26 -r1.70.4.27
--- test.pl 2001/02/05 11:18:55 1.70.4.26
+++ test.pl 2001/02/27 07:42:26 1.70.4.27
@@ -2,6 +2,10 @@
# 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 ;
+
@testdata = (
'ascii' => { },
No revision
No revision
1.1.4.16 +145 -2 embperl/Embperl/Attic/Syntax.pm
Index: Syntax.pm
===================================================================
RCS file: /home/cvs/embperl/Embperl/Attic/Syntax.pm,v
retrieving revision 1.1.4.15
retrieving revision 1.1.4.16
diff -u -r1.1.4.15 -r1.1.4.16
--- Syntax.pm 2001/02/23 14:57:53 1.1.4.15
+++ Syntax.pm 2001/02/27 07:42:26 1.1.4.16
@@ -1,7 +1,7 @@
###################################################################################
#
-# Embperl - Copyright (c) 1997-2000 Gerald Richter / ECOS
+# Embperl - Copyright (c) 1997-2001 Gerald Richter / ECOS
#
# You may distribute under the terms of either the GNU General Public
# License or the Artistic License, as specified in the Perl README file.
@@ -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.15 2001/02/23 14:57:53 richter Exp $
+# $Id: Syntax.pm,v 1.1.4.16 2001/02/27 07:42:26 richter Exp $
#
###################################################################################
@@ -18,6 +18,7 @@
package HTML::Embperl::Syntax ;
+
use constant ntypTag => 1 ;
use constant ntypStartTag => 1 + 0x20 ;
use constant ntypEndTag => 1 + 0x40 ;
@@ -35,6 +36,148 @@
use constant ntypDocumentFraq => 11 ;
use constant ntypNotation => 12 ;
+
+@EXPORT_OK = qw{
+ntypTag
+ntypStartTag
+ntypEndTag
+ntypEndStartTag
+ntypAttr
+ntypAttrValue
+ntypText
+ntypCDATA
+ntypEntityRef
+ntypEntity
+ntypProcessingInstr
+ntypComment
+ntypDocument
+ntypDocumentType
+ntypDocumentFraq
+ntypNotation} ;
+
+
+
+@EXPORT_TAGS = (
+ types => @EXPORT_OK,
+ ) ;
+
+###################################################################################
+#
+# Methods
+#
+###################################################################################
+
+# ---------------------------------------------------------------------------------
+#
+# Create new Syntax Object
+#
+# ---------------------------------------------------------------------------------
+
+sub new
+
+ {
+ my $class = shift ;
+
+ my $self = { -root => { %DocumentRoot} } ;
+
+ bless $self, $class ;
+
+
+ return $self ;
+ }
+
+
+
+# ---------------------------------------------------------------------------------
+#
+# Add new elemets to root
+#
+# ---------------------------------------------------------------------------------
+
+
+sub AddToRoot
+
+ {
+ my ($self, $elements) = @_ ;
+
+ my $root = $self -> {-root} ;
+
+ while (my ($k, $v) = each (%$elements))
+ {
+ $root -> {$k} = $v ;
+ }
+ }
+
+
+
+
+%DocumentRoot = (
+ '-lsearch' => 1,
+
+ # The document node is generated always and is not parserd, but can be used to
include code
+ 'Document' => {
+ 'nodename' => 'Document',
+ 'nodetype' => ntypDocument,
+ 'procinfo' => {
+ embperl => {
+ perlcode => q{
+# any initialisation could be put here
+$DB::single = 1 ;
+},
+ compiletimeperlcode => q{
+use vars ('$_ep_DomTree') ;
+*_ep_rp=\\&XML::Embperl::DOM::Node::iReplaceChildWithCDATA;
+*_ep_rpurl=\\&XML::Embperl::DOM::Node::iReplaceChildWithUrlDATA;
+*_ep_cp=\\&XML::Embperl::DOM::Tree::iCheckpoint;
+*_ep_dcp=\\&XML::Embperl::DOM::Tree::iDiscardAfterCheckpoint;
+*_ep_opt=\\&HTML::Embperl::Cmd::Option;
+*_ep_hid=\\&HTML::Embperl::Cmd::Hidden;
+*_ep_ac=\\&XML::Embperl::DOM::Node::iAppendChild;
+*_ep_sa=\\&XML::Embperl::DOM::Element::iSetAttribut;
+},
+ perlcodeend => q{# Include here any cleanup code
+ $DB::single = 0 ;
+ },
+ stackname => 'metacmd',
+ stackmatch => 'Document',
+ 'push' => 'Document',
+ mayjump => 1,
+ }
+ },
+ },
+ # The document fraq node is generated always and is not parserd, but can be
used to include code
+ 'DocumentFraq' => {
+ 'nodename' => 'DocumentFraq',
+ 'nodetype' => ntypDocumentFraq,
+ 'procinfo' => {
+ embperl => {
+ perlcode => q{
+# any initialisation could be put here
+},
+ compiletimeperlcode => q{
+use vars ('$_ep_DomTree') ;
+*_ep_rp=\\&XML::Embperl::DOM::Node::iReplaceChildWithCDATA;
+*_ep_rpurl=\\&XML::Embperl::DOM::Node::iReplaceChildWithUrlDATA;
+*_ep_cp=\\&XML::Embperl::DOM::Tree::iCheckpoint;
+*_ep_dcp=\\&XML::Embperl::DOM::Tree::iDiscardAfterCheckpoint;
+*_ep_opt=\\&HTML::Embperl::Cmd::Option;
+*_ep_hid=\\&HTML::Embperl::Cmd::Hidden;
+*_ep_ac=\\&XML::Embperl::DOM::Node::iAppendChild;
+*_ep_sa=\\&XML::Embperl::DOM::Element::iSetAttribut;
+},
+ perlcodeend => '# Include here any cleanup code',
+ stackname => 'metacmd',
+ stackmatch => 'DocumentFraq',
+ 'push' => 'DocumentFraq',
+ mayjump => 1,
+ }
+ },
+ },
+ ) ;
+
+1;
+
+__END__
sub clonehash
{
No revision
No revision
1.1.2.3 +184 -223 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.2
retrieving revision 1.1.2.3
diff -u -r1.1.2.2 -r1.1.2.3
--- EmbperlBlocks.pm 2001/02/25 22:04:44 1.1.2.2
+++ EmbperlBlocks.pm 2001/02/27 07:42:27 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: EmbperlBlocks.pm,v 1.1.2.2 2001/02/25 22:04:44 richter Exp $
+# $Id: EmbperlBlocks.pm,v 1.1.2.3 2001/02/27 07:42:27 richter Exp $
#
###################################################################################
@@ -36,27 +36,15 @@
sub new
{
- my $self = SUPER::new ;
+ my $class = shift ;
- bless $self, 'HTML::Embperl::Syntax::EmbperlBlocks' ;
+ my $self = ref $class?$class:HTML::Embperl::Syntax::new ($class) ;
-
$self -> AddToRoot (\%Blocks) ;
-
- $self -> {-tagtype}
-
- $self -> AddMetaCmd ('if',
- {
- perlcode => 'if (%&<noname>%) { ',
- removenode => 10,
- mayjump => 1,
- stackname => 'metacmd',
- 'push' => 'if',
- }) ;
+ Init ($self) ;
-
-
+ return $self ;
}
# ---------------------------------------------------------------------------------
@@ -70,33 +58,97 @@
{
my ($self, $cmdname, $procinfo) = @_ ;
-
+ my $tagtype = 'Embperl meta command' ;
my $ttref ;
- die "'$tagtype' unknown" if (!($ttref = $self -> {-tagtype}{$tagtype})) ;
+ die "'$tagtype' unknown" if (!($ttref = $self -> {-root}{$tagtype})) ;
my$ttfollow = ($ttref -> {'follow'} ||= {}) ;
my $tag = $ttfollow -> {$tagname} = {
'text' => $tagname,
+ 'nodetype' => ntypTag,
'cdatatype' => ntypAttrValue,
+ 'forcetype' => 1,
'unescape' => 1,
- 'procinfo' => { $self -> {-procinfotype} =>
$procinfo },
+ 'procinfo' => { $self -> {-procinfotype} => {
$procinfo } },
} ;
- if ($attrs)
- {
- my %inside ;
- my $assignattr = $self -> {-tagtype}{AssignAttr} ;
- foreach (@$attrs)
- {
- $inside {$_} => { 'text' => $_, 'nodename' => $_, follow =>
$assignattr },
- }
- $tag -> {'inside'} = \%inside ;
- }
+ return $tag ;
+ }
+
+
+# ---------------------------------------------------------------------------------
+#
+# Add new meta command that has an corresponding end meta command
+#
+# ---------------------------------------------------------------------------------
+
+
+sub AddMetaCmdWithEnd
+
+ {
+ my ($self, $cmdname, $endname, $procinfo) = @_ ;
+
+ my $tag = $self -> AddMetaCmd ($cmdname, $procinfo) ;
+
+ $tag -> {'endtag'} = $endname ;
+
+ return $tag ;
+ }
+
+# ---------------------------------------------------------------------------------
+#
+# Add new meta command with start and end
+#
+# ---------------------------------------------------------------------------------
+
+
+sub AddMetaCmdBlock
+
+ {
+ my ($self, $cmdname, $endname, $procinfostart, $procinfoend) = @_ ;
+
+ my $tag ;
+ my $pinfo ;
+ $tag = $self -> AddMetaCmd ($cmdname, $procinfostart) ;
+ $tag -> {'endtag'} = $endname ;
+ $pinfo = $starttag -> {'procinfo'} -> {$self -> {-procinfotype}} ;
+ $pinfo -> {'stackname'} = 'metacmd' ;
+ $pinfo -> {'push'} = $cmdname ;
+
+ $tag = $self -> AddMetaCmd ($endname, $procinfoend) ;
+ $pinfo = $starttag -> {'procinfo'} -> {$self -> {-procinfotype}} ;
+ $pinfo -> {'stackname'} = 'metacmd' ;
+ $pinfo -> {'stackmatch'} = $cmdname ;
+
+
+ return $tag ;
}
+# ---------------------------------------------------------------------------------
+#
+# Add new simple html tag (override to add meta commands inside html tags)
+#
+# ---------------------------------------------------------------------------------
+
+
+sub AddTag
+
+ {
+ my $self = shift ;
+
+ my $tag = $self -> SUPER::AddTag (@_) ;
+
+ $tag -> {inside} ||= {} ;
+
+ while (my ($k, $v) = each (%Blocks))
+ {
+ $tag -> {inside} -> {$k} = $v ;
+ }
+ }
+
###################################################################################
@@ -105,233 +157,108 @@
#
###################################################################################
+sub Init
-%MetaCmds = (
- 'if' => {
- 'text' => 'if',
- 'nodetype' => ntypTag,
- 'forcetype' => 1,
- 'cdatatype' => ntypAttrValue,
- 'unescape' => 1,
- 'endtag' => 'endif',
- 'procinfo' => {
- embperl => {
- perlcode => 'if (%&<noname>%) { ',
- removenode => 10,
- mayjump => 1,
- stackname => 'metacmd',
- 'push' => 'if',
- }
- },
- },
- 'else' => {
- 'text' => 'else',
- 'nodetype' => ntypTag,
- 'forcetype' => 1,
- 'unescape' => 1,
- 'endtag' => 'endif',
- 'procinfo' => {
- embperl => {
- perlcode => '} else {',
- removenode => 10,
- mayjump => 1,
- stackname => 'metacmd',
- stackmatch => 'if',
- 'push' => 'if',
- }
- },
- },
- 'endif' => {
- 'text' => 'endif',
- 'nodetype' => ntypTag,
- 'forcetype' => 1,
- 'cdatatype' => 0,
- 'procinfo' => {
- embperl => {
- perlcode => '}',
- removenode => 10,
- mayjump => 1,
- stackname => 'metacmd',
- stackmatch => 'if',
- }
- },
- },
- 'elsif' => {
- 'text' => 'elsif',
- 'nodetype' => ntypTag,
- 'forcetype' => 1,
- 'cdatatype' => ntypAttrValue,
- 'unescape' => 1,
- 'endtag' => 'endif',
- 'procinfo' => {
- embperl => {
- perlcode => '} elsif (%&<noname>%) { ',
- removenode => 10,
- mayjump => 1,
- stackname => 'metacmd',
- stackmatch => 'if',
- 'push' => 'if',
- }
- },
- },
- 'while' => {
- 'text' => 'while',
- 'nodetype' => ntypTag,
- 'cdatatype' => ntypAttrValue,
- 'forcetype' => 1,
- 'unescape' => 1,
- 'endtag' => 'endwhile',
- 'procinfo' => {
- embperl => {
+ {
+ my ($self) = @_ ;
+
+ $self -> AddMetaCmdWithEnd ('if', 'endif',
+ {
+ perlcode => 'if (%&<noname>%) { ',
+ removenode => 10,
+ mayjump => 1,
+ stackname => 'metacmd',
+ 'push' => 'if',
+ }) ;
+
+ $self -> AddMetaCmdWithEnd ('else', 'endif',
+ {
+ perlcode => '} else {',
+ removenode => 10,
+ mayjump => 1,
+ stackname => 'metacmd',
+ stackmatch => 'if',
+ 'push' => 'if',
+ }) ;
+ $self -> AddMetaCmdWithEnd ('elsif', 'endif',
+ {
+ perlcode => '} elsif (%&<noname>%) { ',
+ removenode => 10,
+ mayjump => 1,
+ stackname => 'metacmd',
+ stackmatch => 'if',
+ 'push' => 'if',
+ }) ;
+ $self -> AddMetaCmd ('endif',
+ {
+ perlcode => '}',
+ removenode => 10,
+ mayjump => 1,
+ stackname => 'metacmd',
+ stackmatch => 'if',
+ }) ;
+ $self -> AddMetaCmdBlock ('while', 'endwhile',
+ {
perlcode => 'while (%&<noname>%) { ',
removenode => 10,
mayjump => 1,
- stackname => 'metacmd',
- 'push' => 'while',
- }
- },
- },
- 'endwhile' => {
- 'text' => 'endwhile',
- 'nodetype' => ntypTag,
- 'forcetype' => 1,
- 'cdatatype' => 0,
- 'procinfo' => {
- embperl => {
+ },
+ {
perlcode => '};',
removenode => 10,
mayjump => 1,
- stackname => 'metacmd',
- stackmatch => 'while',
- }
- },
- },
- 'foreach' => {
- 'text' => 'foreach',
- 'nodetype' => ntypTag,
- 'cdatatype' => ntypAttrValue,
- 'forcetype' => 1,
- 'unescape' => 1,
- 'endtag' => 'endforeach',
- 'procinfo' => {
- embperl => {
+ }) ;
+ $self -> AddMetaCmdBlock ('foreach', 'endforeach',
+ {
perlcode => 'foreach %&<noname>% { ',
removenode => 10,
mayjump => 1,
- stackname => 'metacmd',
- 'push' => 'foreach',
- }
- },
- },
- 'endforeach' => {
- 'text' => 'endforeach',
- 'nodetype' => ntypTag,
- 'forcetype' => 1,
- 'cdatatype' => 0,
- 'procinfo' => {
- embperl => {
+ },
+ {
perlcode => '};',
removenode => 10,
mayjump => 1,
- stackname => 'metacmd',
- stackmatch => 'foreach',
- }
- },
- },
- 'do' => {
- 'text' => 'do',
- 'nodetype' => ntypTag,
- 'cdatatype' => 0,
- 'forcetype' => 1,
- 'unescape' => 1,
- 'endtag' => 'until',
- 'procinfo' => {
- embperl => {
+ }) ;
+ $self -> AddMetaCmdBlock ('do', 'until',
+ {
perlcode => 'do { ',
removenode => 10,
mayjump => 1,
- stackname => 'metacmd',
- 'push' => 'do',
- }
- },
- },
- 'until' => {
- 'text' => 'until',
- 'nodetype' => ntypTag,
- 'forcetype' => 1,
- 'cdatatype' => ntypAttrValue,
- 'unescape' => 1,
- 'procinfo' => {
- embperl => {
+ },
+ {
perlcode => '} until (%&<noname>%) ; ',
removenode => 10,
mayjump => 1,
- stackname => 'metacmd',
- stackmatch => 'do',
- }
- },
- },
- 'var' => {
- 'text' => 'var',
- 'cdatatype' => ntypAttrValue,
- 'unescape' => 1,
- 'procinfo' => {
- embperl => {
+ }) ;
+ $self -> AddMetaCmd ('var',
+ {
compiletimeperlcode => 'use strict ; use vars qw{%%CLEANUP
%&<noname>%} ; map { $CLEANUP{substr($_,1)} = 1 } qw{%&<noname>%} ;',
perlcode => 'use strict ;',
removenode => 3,
- }
- },
- },
- 'hidden' => {
- 'text' => 'hidden',
- 'cdatatype' => ntypAttrValue,
- 'unescape' => 1,
- 'procinfo' => {
- embperl => {
+ }) ;
+ $self -> AddMetaCmd ('hidden',
+ {
perlcode => '_ep_hid(%$n%,%&\'<noname>%);',
removenode => 8,
- }
- },
- },
- 'sub' => {
- 'text' => 'sub',
- 'nodetype' => ntypTag,
- 'cdatatype' => ntypAttrValue,
- 'forcetype' => 1,
- 'unescape' => 1,
- 'endtag' => 'endsub',
- 'procinfo' => {
- embperl => {
+ }) ;
+ $self -> AddMetaCmdBlock ('sub', 'endsub',
+ {
perlcode => 'sub _ep_sub_%&<noname>% { ',
removenode => 10,
mayjump => 1,
- stackname => 'metacmd',
- 'push' => 'sub',
stackname2 => 'subname',
push2 => '%&<noname>%',
switchcodetype => 2,
- }
- },
- },
- 'endsub' => {
- 'text' => 'endsub',
- 'nodetype' => ntypTag,
- 'forcetype' => 1,
- 'cdatatype' => 0,
- 'procinfo' => {
- embperl => {
+ },
+ {
perlcode => '}; sub %^subname% { my @_ep_save ;
HTML::Embperl::Cmd::SubStart(\\$_ep_DomTree,%$q%,\\@_ep_save); my $_ep_ret =
_ep_sub_%^subname% (@_); HTML::Embperl::Cmd::SubEnd(\\@_ep_save); return $_ep_ret } ;
$_ep_req -> ExportHash -> {%^"subname%} = \&%^subname% ; ',
removenode => 10,
mayjump => 1,
- stackname => 'metacmd',
- stackmatch => 'sub',
pop2 => 'subname',
switchcodetype => 1,
- }
- },
- },
- ) ;
+ }) ;
+ }
+
%Blocks = (
@@ -344,7 +271,7 @@
'Embperl meta command' => {
'text' => '[$',
'end' => '$]',
- 'follow' => \%MetaCmds,
+# 'follow' => \%MetaCmds,
'unescape' => 1,
},
'Embperl output code' => {
@@ -441,5 +368,39 @@
# },
#) ;
+
+1;
+
+
+__END__
+
+=pod
+
+=head1 NAME
+
+HTML::Embperl::Syntax::EmbperlBlocks
+
+=head1 DESCRIPTION
+
+Class derived from HTML::Embperl::Syntax to define the syntax for
+Embperl Blocks and metacommands.
+
+=head1 SYNOPSIS
+
+=head2 new
+
+=head2 AddMetaCmd ($cmdname, $procinfo)
+
+=head2 AddMetaCmdWithEnd ($cmdname, $endname, $procinfo)
+
+=head2 AddMetaCmdBlock ($cmdname, $endname, $procinfostart, $procinfoend)
+
+=head1 Author
+
+G. Richter ([EMAIL PROTECTED])
+
+=head1 See Also
+
+HTML::Embperl::Syntax
1.1.2.3 +240 -42 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.2
retrieving revision 1.1.2.3
diff -u -r1.1.2.2 -r1.1.2.3
--- HTML.pm 2001/02/23 19:40:28 1.1.2.2
+++ HTML.pm 2001/02/27 07:42:27 1.1.2.3
@@ -1,9 +1,231 @@
+###################################################################################
+#
+# Embperl - Copyright (c) 1997-2001 Gerald Richter / ECOS
+#
+# You may distribute under the terms of either the GNU General Public
+# License or the Artistic License, as specified in the Perl README file.
+#
+# THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR
+# 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 $
+#
+###################################################################################
+
+
+
+package HTML::Embperl::Syntax::HTML ;
+
+use HTML::Embperl::Syntax qw{:types} ;
+
+@ISA = (HTML::Embperl::Syntax) ;
+
+
+###################################################################################
+#
+# Methods
+#
+###################################################################################
+
+# ---------------------------------------------------------------------------------
+#
+# Create new Syntax Object
+#
+# ---------------------------------------------------------------------------------
+sub new
+ {
+ my $class = shift ;
+
+ my $self = ref $class?$class:HTML::Embperl::Syntax::new ($class) ;
+
+ $self -> AddToRoot (
+ {
+ 'HTML Tag' => {
+ 'text' => '<',
+ 'end' => '>',
+ 'follow' => \%HtmlTags,
+ },
+ 'HTML Comment' => {
+ 'text' => '<!--',
+ 'end' => '-->',
+ },
+ }) ;
+
+ $self -> {-htmlAssignAttr} = { %AssignAttr} ;
+ $self -> {-htmlAssignAttrLink} = { %AssignAttrLink} ;
+
+ return $self ;
+ }
+
+
+# ---------------------------------------------------------------------------------
+#
+# Add new element
+#
+# ---------------------------------------------------------------------------------
+
+
+sub AddElement
+
+ {
+ my ($self, $tagtype, $tagname, $attrs, $attrsurl, $attrsnoval, $procinfo) = @_ ;
+
+
+ my $ttref ;
+ die "'$tagtype' unknown" if (!($ttref = $self -> {-root}{$tagtype})) ;
+ my$ttfollow = ($ttref -> {'follow'} ||= {}) ;
+
+ my $tag = $ttfollow -> {$tagname} = {
+ 'text' => $tagname,
+ 'unescape' => 1,
+ 'procinfo' => { $self -> {-procinfotype} =>
$procinfo },
+ } ;
+
+ my %inside ;
+ my $addinside = 0 ;
+ if ($attrs)
+ {
+ my $assignattr = $self -> {-htmlAssignAttr} ;
+ foreach (@$attrs)
+ {
+ $inside {$_} => { 'text' => $_, 'nodename' => $_, follow =>
$assignattr },
+ $addinside++ ;
+ }
+ }
+ if ($attrsurl)
+ {
+ my $assignattr = $self -> {-htmlAssignAttrLink} ;
+ foreach (@$attrsurl)
+ {
+ $inside {$_} => { 'text' => $_, 'nodename' => $_, follow =>
$assignattr },
+ $addinside++ ;
+ }
+ }
+ if ($attrsnoval)
+ {
+ foreach (@$attrs)
+ {
+ $inside {$_} => { 'text' => $_, 'nodename' => $_},
+ $addinside++ ;
+ }
+ }
+ $tag -> {'inside'} = \%inside if ($addinside) ;
+
+ return $tag ;
+ }
+
+# ---------------------------------------------------------------------------------
+#
+# Add new simple html tag
+#
+# ---------------------------------------------------------------------------------
+
+
+sub AddTag
+
+ {
+ my $self = shift ;
+
+ $self -> AddElement ('HTML Tag', @_) ;
+ }
+
+
+# ---------------------------------------------------------------------------------
+#
+# Add new html comment tag
+#
+# ---------------------------------------------------------------------------------
+
+
+sub AddComment
+
+ {
+ my $self = shift ;
+
+ $self -> AddElement ('HTML Comment', @_) ;
+ }
+
+# ---------------------------------------------------------------------------------
+#
+# Add new block html tag
+#
+# ---------------------------------------------------------------------------------
+
+
+sub AddTagBlock
+
+ {
+ my ($self, $tagname, $attrs, $attrsurl, $attrsnoval, $procinfo) = @_ ;
+
+
+ my $tag = $self -> AddTag ($tagname, $attrs, $attrsurl, $attrsnoval, $procinfo)
;
+
+ $tag -> {'nodetype'} = ntypStartTag ;
+
+ $tag = $self -> AddTag ("/$tagname") ;
+
+ $tag -> {'nodetype'} = ntypEndTag ;
+ $tag -> {'starttag'} = $tagname ;
+ }
+# ---------------------------------------------------------------------------------
+#
+# Add new html tag which is an optional end tag
+#
+# ---------------------------------------------------------------------------------
+
+sub AddTagWithStart
+
+ {
+ my ($self, $tagname, $starttag, $attrs, $attrsurl, $attrsnoval, $procinfo) = @_
;
+
+
+ my $tag = $self -> AddTag ($tagname, $attrs, $attrsurl, $attrsnoval, $procinfo)
;
+
+ $tag -> {'starttag'} = $starttag ;
+ }
+
+
+
+
+# ---------------------------------------------------------------------------------
+#
+#
+#
+# ---------------------------------------------------------------------------------
+
+
+
+sub AddInside
+
+ {
+ my ($self, $tagtype, $inside) = @_ ;
+
+ my $ttref ;
+ die "'$tagtype' unknown" if (!($ttref = $self -> {-tagtype}{$tagtype})) ;
+ my $ttinside = ($ttref -> {'inside'} ||= {}) ;
+
+ while (my ($k, $v) = each (%$inside))
+ {
+ $ttinside -> {$k} = $v ;
+ }
+
+ }
+
+
+###################################################################################
+#
+# Definitions for HTML attributs
+#
+###################################################################################
+
+
%Attr = (
'-lsearch' => 1,
'Attribut ""' =>
@@ -45,68 +267,44 @@
'Assign' =>
{
'text' => '=',
- 'follow' => \%AttrLink,
+ 'follow' => { %Attr },
}
) ;
-
+1;
+__END__
-sub AddSimpleTag
+=pod
- {
- my ($self, $tagtype, $tagname, $attrs, $procinfo) = @_ ;
-
-
- my $ttref ;
- die "'$tagtype' unknown" if (!($ttref = $self -> {-tagtype}{$tagtype})) ;
- my$ttfollow = ($ttref -> {'follow'} ||= {}) ;
-
- my $tag = $ttfollow -> {$tagname} = {
- 'text' => $tagname,
- 'cdatatype' => ntypAttrValue,
- 'unescape' => 1,
- 'procinfo' => { $self -> {-procinfotype} =>
$procinfo },
- } ;
-
- if ($attrs)
- {
- my %inside ;
- my $assignattr = $self -> {-tagtype}{AssignAttr} ;
- foreach (@$attrs)
- {
- $inside {$_} => { 'text' => $_, 'nodename' => $_, follow =>
$assignattr },
- }
- $tag -> {'inside'} = \%inside ;
- }
+=head1 NAME
- }
+HTML::Embperl::Syntax::HTML
+=head1 DESCRIPTION
-
-sub AddInside
+Class derived from HTML::Embperl::Syntax to define the syntax for HTML
- {
- my ($self, $tagtype, $inside) = @_ ;
+=head1 SYNOPSIS
- my $ttref ;
- die "'$tagtype' unknown" if (!($ttref = $self -> {-tagtype}{$tagtype})) ;
- my $ttinside = ($ttref -> {'inside'} ||= {}) ;
-
- while (my ($k, $v) = each (%$inside))
- {
- $ttinside -> {$k} = $v ;
- }
+=head2 new
- }
+=head2 AddTag ($tagname, $attrs, $attrsurl, $attrsnoval, $procinfo)
+=head2 AddComment ($tagname, $attrs, $attrsurl, $attrsnoval, $procinfo)
+=head2 AddTagBlock ($tagname, $attrs, $attrsurl, $attrsnoval, $procinfo)
+=head2 AddTagWithStart ($tagname, $startname, $attrs, $attrsurl, $attrsnoval,
$procinfo)
+=head1 Author
+G. Richter ([EMAIL PROTECTED])
+=head1 See Also
+HTML::Embperl::Syntax
No revision
No revision
1.1.2.1 +55 -0 embperl/Embperl/Syntax/Attic/Embperl.pm
1.1.2.1 +134 -0 embperl/Embperl/Syntax/Attic/EmbperlHTML.pm
---------------------------------------------------------------------
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
