/[suikacvs]/markup/tool/mkdtds.pl
Suika

Diff of /markup/tool/mkdtds.pl

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.3 by wakaba, Tue Jan 13 11:17:20 2004 UTC revision 1.4 by wakaba, Sun Jun 20 04:54:27 2004 UTC
# Line 11  my $Info = {}; Line 11  my $Info = {};
11    
12  for my $src ($src->get_attribute ('ModuleSet')  for my $src ($src->get_attribute ('ModuleSet')
13            || $src->get_attribute ('DocumentType')) {            || $src->get_attribute ('DocumentType')) {
14    for (qw/ID Copyright BaseURI Description Version/) {    for (qw/Description/) {
15      $Info->{$_} = $src->get_attribute_value ($_);      $Info->{$_} = $src->get_attribute_value ($_);
16    }    }
17    $Info->{Name} = $src->get_attribute_value ('Name');    for (qw/Name ID Copyright BaseURI Version/) {
18        $Info->{$_} = normalize_wsp ($src->get_attribute_value ($_));
19      }
20      $Info->{realname} = $Info->{Name};
21    $Info->{Name} .= ' ' . $Info->{Version} if length $Info->{Version};    $Info->{Name} .= ' ' . $Info->{Version} if length $Info->{Version};
22    $Info->{ns} = $src->get_attribute ('Namespace');    $Info->{ns} = $src->get_attribute ('Namespace');
23  }  }
# Line 41  if (ref $src->get_attribute ('ModuleSet' Line 44  if (ref $src->get_attribute ('ModuleSet'
44  }  }
45  exit}  exit}
46    
47    sub normalize_wsp ($;%) {
48      my $s = shift;
49      $s =~ s/\s+/ /g;
50      $s =~ s/^ +//;
51      $s =~ s/ +$//;
52      $s;
53    }
54  sub make_paragraphs ($;%) {  sub make_paragraphs ($;%) {
55    my ($para, %opt) = @_;    my ($para, %opt) = @_;
56    join "\n\n", map {    join "\n\n", map {
# Line 298  sub dtd_driver_module_sets ($$) { Line 307  sub dtd_driver_module_sets ($$) {
307  ]]>  ]]>
308  <!ENTITY % $module_set->{ID}.xmlns.decl.attrib "">\n\n);  <!ENTITY % $module_set->{ID}.xmlns.decl.attrib "">\n\n);
309    }    }
310      $s .= <<EOH;
311    <!-- Declare a parameter entity %XSI.prefix as a prefix to use for
312         XML Schema Instance attributes. -->
313    <!ENTITY % XSI.prefix "xsi">
314    
315    <!ENTITY % XSI.pfx "%XSI.prefix;:">
316    
317    <!ENTITY % XSI.xmlns "http://www.w3.org/2001/XMLSchema-instance">
318    
319    <!-- Declare a parameter entity %XSI.xmlns.attrib as support for
320         the schemaLocation attribute. -->
321    <!ENTITY % XSI.xmlns.attrib
322            "xmlns:%XSI.prefix;     %URI.datatype;  #FIXED '%XSI.xmlns;'">
323    EOH
324    $s .= qq(\n<!ENTITY % NS.decl.attrib    $s .= qq(\n<!ENTITY % NS.decl.attrib
325          ").join ("\n\t", (map {qq(%$_->{ID}.xmlns.decl.attrib;)} @src),          ").join ("\n\t", (map {qq(%$_->{ID}.xmlns.decl.attrib;)} @src),
326                           map {qq(%$_->{ID}.xmlns.extra.attrib;)} @src).qq(">\n);                           map {qq(%$_->{ID}.xmlns.extra.attrib;)} @src)
327              .qq(\n\t%XSI.xmlns.attrib;">\n);
328    $s .= qq(\n);    $s .= qq(\n);
329    for my $module_set (@src) {    for my $module_set (@src) {
330      $s .= qq(<!ENTITY % $module_set->{ID}.xmlns.attrib "%NS.decl.attrib;">\n);      $s .= qq(<!ENTITY % $module_set->{ID}.xmlns.attrib "%NS.decl.attrib;">\n);
# Line 404  sub qname_module ($$) { Line 428  sub qname_module ($$) {
428    
429  <!-- Section A: XML Namespace Framework :::::::::::::::::::::::::: -->  <!-- Section A: XML Namespace Framework :::::::::::::::::::::::::: -->
430    
431  <!-- 1. Declare conditional section keyword, used to activate namespace  <!-- 1. Declare a %$ID.prefixed; conditional section keyword, used
432          prefixing. -->          to activate namespace prefixing. -->
433  <!ENTITY % $ID.prefixed "@{[$ns->get_attribute_value ('UsePrefix')==1?  <!ENTITY % $ID.prefixed "@{[$ns->get_attribute_value ('UsePrefix')==1?
434                              q(INCLUDE):                              q(INCLUDE):
435                              $ns->get_attribute_value ('UsePrefix')==-1?                              $ns->get_attribute_value ('UsePrefix')==-1?
436                              q(IGNORE):                              q(IGNORE):
437                              q(%NS.prefixed;)]}">                              q(%NS.prefixed;)]}">
438    
439  <!-- 2. Declare a parameter entity containing the namespace name. -->  <!ENTITY % $ID.global.attrs.prefixed "@{[$ns->get_attribute_value ('UsePrefix')==1?
440                                q(INCLUDE):
441                                $ns->get_attribute_value ('UsePrefix')==-1?
442                                q(IGNORE):
443                                q(%NS.prefixed;)]}">
444    
445    <!ENTITY % $ID.xsi.attrs "INCLUDE">
446    
447    <!-- 2. Declare a parameter entity %$ID.xmlns; containing
448            the URI reference used to identity the namespace. -->
449  <!ENTITY % $ID.xmlns "@{[$ns->get_attribute_value ('Name')]}">  <!ENTITY % $ID.xmlns "@{[$ns->get_attribute_value ('Name')]}">
450    
451  <!-- 3. Declare parameter entities containing the default namespace prefix  <!-- 3. Declare parameter entity %$ID.prefix; containing
452          string to use when prefixing is enabled. -->          the default namespace prefix string to use when prefixing
453            is enabled. This may be overridden in the DTD driver or the
454            internal subset of a document instance.
455            
456            NOTE: As specified in XML Namespace speficications, the namespace
457            prefix serves as a proxy for the URI reference, and is not in itself
458            significant. -->
459  <!ENTITY % $ID.prefix "@{[$ns->get_attribute_value ('DefaultPrefix')]}">  <!ENTITY % $ID.prefix "@{[$ns->get_attribute_value ('DefaultPrefix')]}">
460    
461  <!-- 4. Declare parameter entities containing the colonized prefix  <!-- 4. Declare parameter entity %$ID.pfx; containing the
462          used when prefixing is active, an empty string when it is not. -->          colonized prefix (e.g, '%$ID.prefix;:') used when
463            prefixing is active, an empty string when it is not. -->
464  <![%$ID.prefixed;[  <![%$ID.prefixed;[
465  <!ENTITY % $ID.pfx "%$ID.prefix;:">  <!ENTITY % $ID.pfx "%$ID.prefix;:">
466  ]]>  ]]>
467  <!ENTITY % $ID.pfx "">  <!ENTITY % $ID.pfx "">
468    
469  <!-- declare qualified name extensions here -->  <!-- declare qualified name extensions here ............ -->
470  <!ENTITY % ${ID}-qname-extra.mod "">  <!ENTITY % ${ID}-qname-extra.mod "">
471  %${ID}-qname-extra.mod;  %${ID}-qname-extra.mod;
472    
473  <!-- 5. This parameter entity may be redeclared to contain any foreign  <!-- 5. The parameter entity %$ID.xmlns.extra.attrib; may be
474          namespace declaration attributes for namespaces embedded. -->          redeclared to contain any foreign namespace declaration
475            attributes for namespaces embedded.  The default
476            is an empty string. -->
477  <!ENTITY % $ID.xmlns.extra.attrib "">  <!ENTITY % $ID.xmlns.extra.attrib "">
478    
479    <!-- The parameter entity %URI.datatype; should already be defined in
480         Datatype module. -->
481    <!ENTITY % URI.datatype; "CDATA">
482    
483  <![%$ID.prefixed;[  <![%$ID.prefixed;[
484  <!ENTITY % $ID.xmlns.decl.attrib  <!ENTITY % $ID.xmlns.decl.attrib
485          "xmlns:%$ID.prefix;     %URI.datatype;  #FIXED '%$ID.xmlns;'">          "xmlns:%$ID.prefix;     %URI.datatype;  #FIXED '%$ID.xmlns;'">
# Line 441  sub qname_module ($$) { Line 487  sub qname_module ($$) {
487  <!ENTITY % $ID.xmlns.decl.attrib  <!ENTITY % $ID.xmlns.decl.attrib
488          "xmlns  %URI.datatype;  #FIXED '%$ID.xmlns;'">          "xmlns  %URI.datatype;  #FIXED '%$ID.xmlns;'">
489    
490    <!-- Declare a parameter entity %XSI.prefix as a prefix to use for
491         XML Schema Instance attributes. -->
492    <!ENTITY % XSI.prefix "xsi">
493    
494    <!ENTITY % XSI.pfx "%XSI.prefix;:">
495    
496    <!ENTITY % XSI.xmlns "http://www.w3.org/2001/XMLSchema-instance">
497    
498    <!-- Declare a parameter entity %XSI.xmlns.attrib as support for
499         the schemaLocation attribute. -->
500    <!ENTITY % XSI.xmlns.attrib
501            "xmlns:%XSI.prefix;     %URI.datatype;  #FIXED '%XSI.xmlns;'">
502    
503  <![%$ID.prefixed;[  <![%$ID.prefixed;[
504  <!ENTITY % NS.decl.attrib  <!ENTITY % NS.decl.attrib
505          "%$ID.xmlns.decl.attrib;          "%$ID.xmlns.decl.attrib;
506          %$ID.xmlns.extra.attrib;">          %$ID.xmlns.extra.attrib;
507            %XSI.xmlns.attrib;">
508  ]]>  ]]>
509  <!ENTITY % NS.decl.attrib  <!ENTITY % NS.decl.attrib
510          "%$ID.xmlns.extra.attrib;">          "%$ID.xmlns.extra.attrib;
511            %XSI.xmlns.attrib;">
512    
513  <!-- Declare a parameter entity containing all XML namespace declaration  <!-- Declare a parameter entity containing all XML namespace declaration
514       attributes used, including a default xmlns declaration when prefixing       attributes used, including a default xmlns declaration when prefixing
# Line 460  sub qname_module ($$) { Line 521  sub qname_module ($$) {
521          "%$ID.xmlns.decl.attrib;          "%$ID.xmlns.decl.attrib;
522          %NS.decl.attrib;">          %NS.decl.attrib;">
523    
524  <!-- Section B: Qualified Names :::::::::::::::::::::::::::::::::: -->  <!-- @{[dot_padding qq(Section B: $Info->{realname} Qualified Names ),
525                   length => 71-9, dot => q(:)]} -->
526    
527  <!-- placeholder for qualified name redeclarations -->  <!-- placeholder for qualified name redeclarations -->
528  <!ENTITY % ${ID}-qname-extra.mod "">  <!ENTITY % ${ID}-qname.redecl "">
529  %${ID}-qname-extra.mod;  %${ID}-qname.redecl;
530    
531  <!-- 6. Declare parameter entities used to provide namespace-qualified  <!-- 6. This section declare parameter entities used to provide
532          names for all element types and global attribute names. -->          namespace-qualified names for all element types and global
533            attribute names. -->
534  EOH  EOH
535    for my $lname (sort keys %{$Info->{QName}}) {    for my $lname (sort keys %{$Info->{QName}}) {
536      $s .= qq(<!ENTITY % )      $s .= qq(<!ENTITY % )
# Line 551  sub get_adefault ($$) { Line 614  sub get_adefault ($$) {
614    
615  sub get_desc ($$;%) {  sub get_desc ($$;%) {
616    my ($src, $Info, %opt) = @_;    my ($src, $Info, %opt) = @_;
617        my $desc = $src->get_attribute_value ('Description');    my $desc = $src->get_attribute_value ('Description');
618        $desc =~ s/\n/\n     /g;    $desc =~ s/\n/\n     /g;
619    if (length $desc) {    if (length $desc) {
620      $desc = qq($opt{prefix}$desc);      $desc = qq($opt{prefix}$desc);
621      $desc .= q( ) if $opt{padding_length};      $desc .= q( ) if $opt{padding_length};
622      $desc = q(<!-- ).(dot_padding $desc, length => $opt{padding_length},      $desc = q(<!-- ).(dot_padding $desc, length => $opt{padding_length},
623                                           dot => $opt{padding_dot}).qq( -->\n);                                           dot => $opt{padding_dot}).qq( -->\n);
624      } elsif (length $opt{default}) {
625        $desc = $opt{default};
626        $desc .= q( ) if $opt{padding_length};
627        $desc = q(<!-- ).(dot_padding $desc, length => $opt{padding_length},
628                                             dot => $opt{padding_dot}).qq( -->\n);
629    }    }
630    $desc;    $desc;
631  }  }
# Line 637  sub attrib_REF ($$) { Line 705  sub attrib_REF ($$) {
705      'xml:base'  => q<xml:base   %URI.datatype;  #IMPLIED>,      'xml:base'  => q<xml:base   %URI.datatype;  #IMPLIED>,
706      'xml:lang'  => q<xml:lang   %LanguageCode.datatype; #IMPLIED>,      'xml:lang'  => q<xml:lang   %LanguageCode.datatype; #IMPLIED>,
707      'xml:space' => q<xml:space  (default|preserve)      #IMPLIED>,      'xml:space' => q<xml:space  (default|preserve)      #IMPLIED>,
708        'xsi:nil'   => q<%XSI.prefix;:nil (true|false|1|0) #IMPLIED>,
709        'xsi:noNamespaceSchemaLocation'     => q<%XSI.prefix;:noNamespaceSchemaLocation CDATA #IMPLIED>,
710        'xsi:schemaLocation'        => q<%XSI.prefix;:schemaLocation CDATA #IMPLIED>,
711        'xsi:type'  => q<%XSI.prefix;:type NMTOKEN #IMPLIED>,
712    }->{$src->value};    }->{$src->value};
713  }  }
714    
# Line 696  sub element_def ($$) { Line 768  sub element_def ($$) {
768      $short_name = $1;      $short_name = $1;
769    }    }
770    my $s = get_desc $src, $Info, prefix => qq($short_name: ),    my $s = get_desc $src, $Info, prefix => qq($short_name: ),
771                     padding_length => 51, padding_dot => q(.);                     padding_length => 51, padding_dot => q(.),
772                       default => qq($short_name);
773    $s .= "\n";    $s .= "\n";
774    $s .= xml_parameter_ENTITY qq($mname.element), value => 'INCLUDE';    $s .= xml_parameter_ENTITY qq($mname.element), value => 'INCLUDE';
775    $s .= xml_condition_section (qq($mname.element) =>    $s .= xml_condition_section (qq($mname.element) =>
# Line 797  sub make_module ($$$$;%) { Line 870  sub make_module ($$$$;%) {
870       }]} -->       }]} -->
871  <!-- file: $Info->{ID}-$id.mod  <!-- file: $Info->{ID}-$id.mod
872            
873       $Info->{Description}  @{[make_paragraphs [$Info->{Description}], indent => q<     >]}
874        
875       Copyright @{[(gmtime)[5]+1900]} $Info->{Copyright}, All Rights Reserved.       Copyright @{[(gmtime)[5]+1900]} $Info->{Copyright}, All Rights Reserved.
876        
877         Permission to use, copy, modify and distribute this DTD and its
878         accompanying documentation for any purpose and without fee is hereby
879         granted in perpetuity, provided that the above copyright notice and
880         this paragraph appear in all copies.  The copyright holders make no
881         representation about the suitability of the DTD for any purpose.
882        
883         It is provided "as is" without expressed or implied warranty.
884        
885       Revision: @{[sprintf '%04d-%02d-%02dT%02d:%02d:%02d+00:00',       Revision: @{[sprintf '%04d-%02d-%02dT%02d:%02d:%02d+00:00',
886                            (gmtime)[5]+1900, (gmtime)[4]+1, (gmtime)[3,2,1,0]                            (gmtime)[5]+1900, (gmtime)[4]+1, (gmtime)[3,2,1,0]
887                 ]} (Generated by $SCRIPT_NAME/$VERSION)                 ]} (Generated by $SCRIPT_NAME/$VERSION)
# Line 859  EOH Line 942  EOH
942                }->{$id}, $src->get_attribute_value ('Description'));                }->{$id}, $src->get_attribute_value ('Description'));
943    unshift @para, '  '.join ', ', sort @{$Info->{elements}||[]} if @{$Info->{elements}||[]};    unshift @para, '  '.join ', ', sort @{$Info->{elements}||[]} if @{$Info->{elements}||[]};
944    if (@para) {    if (@para) {
945        $name = qq($Info->{realname} QName (Qualified Name) Module)
946          if $id eq 'qname';
947      $r .= <<EOH;      $r .= <<EOH;
948  <!-- $name  <!-- $name
949    
# Line 891  sub make_dtd ($$$$) { Line 976  sub make_dtd ($$$$) {
976    
977  <!-- $Info->{Name} DTD  <!-- $Info->{Name} DTD
978    
979       $Info->{Description}  @{[make_paragraphs [$Info->{Description}], indent => q<     >]}
980    
981       Copyright @{[(gmtime)[5]+1900]} $Info->{Copyright}, All Rights Reserved.       Copyright @{[(gmtime)[5]+1900]} $Info->{Copyright}, All Rights Reserved.
982    

Legend:
Removed from v.1.3  
changed lines
  Added in v.1.4

admin@suikawiki.org
ViewVC Help
Powered by ViewVC 1.1.24