/[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.5 by wakaba, Sun Jun 20 05:16:45 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 399  sub qname_module ($$) { Line 423  sub qname_module ($$) {
423    my $ID = $Info->{ID};    my $ID = $Info->{ID};
424    my $ns = $src->get_attribute ('Namespace');    my $ns = $src->get_attribute ('Namespace');
425    my $s = <<EOH;    my $s = <<EOH;
426    <!ENTITY % sgml.tag.minimizable "IGNORE">
427    
428  <!ENTITY % NS.prefixed "@{[$ns->get_attribute_value ('UsePrefix')==1?  <!ENTITY % NS.prefixed "@{[$ns->get_attribute_value ('UsePrefix')==1?
429                              q(INCLUDE):q(IGNORE)]}">                              q(INCLUDE):q(IGNORE)]}">
430    
431  <!-- Section A: XML Namespace Framework :::::::::::::::::::::::::: -->  <!-- Section A: XML Namespace Framework :::::::::::::::::::::::::: -->
432    
433  <!-- 1. Declare conditional section keyword, used to activate namespace  <!-- 1. Declare a %$ID.prefixed; conditional section keyword, used
434          prefixing. -->          to activate namespace prefixing. -->
435  <!ENTITY % $ID.prefixed "@{[$ns->get_attribute_value ('UsePrefix')==1?  <!ENTITY % $ID.prefixed "@{[$ns->get_attribute_value ('UsePrefix')==1?
436                              q(INCLUDE):                              q(INCLUDE):
437                              $ns->get_attribute_value ('UsePrefix')==-1?                              $ns->get_attribute_value ('UsePrefix')==-1?
438                              q(IGNORE):                              q(IGNORE):
439                              q(%NS.prefixed;)]}">                              q(%NS.prefixed;)]}">
440    
441  <!-- 2. Declare a parameter entity containing the namespace name. -->  <!ENTITY % $ID.global.attrs.prefixed "@{[$ns->get_attribute_value ('UsePrefix')==1?
442                                q(INCLUDE):
443                                $ns->get_attribute_value ('UsePrefix')==-1?
444                                q(IGNORE):
445                                q(%NS.prefixed;)]}">
446    
447    <!ENTITY % $ID.xsi.attrs "INCLUDE">
448    
449    <!-- 2. Declare a parameter entity %$ID.xmlns; containing
450            the URI reference used to identity the namespace. -->
451  <!ENTITY % $ID.xmlns "@{[$ns->get_attribute_value ('Name')]}">  <!ENTITY % $ID.xmlns "@{[$ns->get_attribute_value ('Name')]}">
452    
453  <!-- 3. Declare parameter entities containing the default namespace prefix  <!-- 3. Declare parameter entity %$ID.prefix; containing
454          string to use when prefixing is enabled. -->          the default namespace prefix string to use when prefixing
455            is enabled. This may be overridden in the DTD driver or the
456            internal subset of a document instance.
457            
458            NOTE: As specified in XML Namespace speficications, the namespace
459            prefix serves as a proxy for the URI reference, and is not in itself
460            significant. -->
461  <!ENTITY % $ID.prefix "@{[$ns->get_attribute_value ('DefaultPrefix')]}">  <!ENTITY % $ID.prefix "@{[$ns->get_attribute_value ('DefaultPrefix')]}">
462    
463  <!-- 4. Declare parameter entities containing the colonized prefix  <!-- 4. Declare parameter entity %$ID.pfx; containing the
464          used when prefixing is active, an empty string when it is not. -->          colonized prefix (e.g, '%$ID.prefix;:') used when
465            prefixing is active, an empty string when it is not. -->
466  <![%$ID.prefixed;[  <![%$ID.prefixed;[
467  <!ENTITY % $ID.pfx "%$ID.prefix;:">  <!ENTITY % $ID.pfx "%$ID.prefix;:">
468  ]]>  ]]>
469  <!ENTITY % $ID.pfx "">  <!ENTITY % $ID.pfx "">
470    
471  <!-- declare qualified name extensions here -->  <!-- declare qualified name extensions here ............ -->
472  <!ENTITY % ${ID}-qname-extra.mod "">  <!ENTITY % ${ID}-qname-extra.mod "">
473  %${ID}-qname-extra.mod;  %${ID}-qname-extra.mod;
474    
475  <!-- 5. This parameter entity may be redeclared to contain any foreign  <!-- 5. The parameter entity %$ID.xmlns.extra.attrib; may be
476          namespace declaration attributes for namespaces embedded. -->          redeclared to contain any foreign namespace declaration
477            attributes for namespaces embedded.  The default
478            is an empty string. -->
479  <!ENTITY % $ID.xmlns.extra.attrib "">  <!ENTITY % $ID.xmlns.extra.attrib "">
480    
481    <!-- The parameter entity %URI.datatype; should already be defined in
482         Datatype module. -->
483    <!ENTITY % URI.datatype; "CDATA">
484    
485  <![%$ID.prefixed;[  <![%$ID.prefixed;[
486  <!ENTITY % $ID.xmlns.decl.attrib  <!ENTITY % $ID.xmlns.decl.attrib
487          "xmlns:%$ID.prefix;     %URI.datatype;  #FIXED '%$ID.xmlns;'">          "xmlns:%$ID.prefix;     %URI.datatype;  #FIXED '%$ID.xmlns;'">
# Line 441  sub qname_module ($$) { Line 489  sub qname_module ($$) {
489  <!ENTITY % $ID.xmlns.decl.attrib  <!ENTITY % $ID.xmlns.decl.attrib
490          "xmlns  %URI.datatype;  #FIXED '%$ID.xmlns;'">          "xmlns  %URI.datatype;  #FIXED '%$ID.xmlns;'">
491    
492    <!-- Declare a parameter entity %XSI.prefix as a prefix to use for
493         XML Schema Instance attributes. -->
494    <!ENTITY % XSI.prefix "xsi">
495    
496    <!ENTITY % XSI.pfx "%XSI.prefix;:">
497    
498    <!ENTITY % XSI.xmlns "http://www.w3.org/2001/XMLSchema-instance">
499    
500    <!-- Declare a parameter entity %XSI.xmlns.attrib as support for
501         the schemaLocation attribute. -->
502    <!ENTITY % XSI.xmlns.attrib
503            "xmlns:%XSI.prefix;     %URI.datatype;  #FIXED '%XSI.xmlns;'">
504    
505  <![%$ID.prefixed;[  <![%$ID.prefixed;[
506  <!ENTITY % NS.decl.attrib  <!ENTITY % NS.decl.attrib
507          "%$ID.xmlns.decl.attrib;          "%$ID.xmlns.decl.attrib;
508          %$ID.xmlns.extra.attrib;">          %$ID.xmlns.extra.attrib;
509            %XSI.xmlns.attrib;">
510  ]]>  ]]>
511  <!ENTITY % NS.decl.attrib  <!ENTITY % NS.decl.attrib
512          "%$ID.xmlns.extra.attrib;">          "%$ID.xmlns.extra.attrib;
513            %XSI.xmlns.attrib;">
514    
515  <!-- Declare a parameter entity containing all XML namespace declaration  <!-- Declare a parameter entity containing all XML namespace declaration
516       attributes used, including a default xmlns declaration when prefixing       attributes used, including a default xmlns declaration when prefixing
# Line 460  sub qname_module ($$) { Line 523  sub qname_module ($$) {
523          "%$ID.xmlns.decl.attrib;          "%$ID.xmlns.decl.attrib;
524          %NS.decl.attrib;">          %NS.decl.attrib;">
525    
526  <!-- Section B: Qualified Names :::::::::::::::::::::::::::::::::: -->  <!-- @{[dot_padding qq(Section B: $Info->{realname} Qualified Names ),
527                   length => 71-9, dot => q(:)]} -->
528    
529  <!-- placeholder for qualified name redeclarations -->  <!-- placeholder for qualified name redeclarations -->
530  <!ENTITY % ${ID}-qname-extra.mod "">  <!ENTITY % ${ID}-qname.redecl "">
531  %${ID}-qname-extra.mod;  %${ID}-qname.redecl;
532    
533  <!-- 6. Declare parameter entities used to provide namespace-qualified  <!-- 6. This section declare parameter entities used to provide
534          names for all element types and global attribute names. -->          namespace-qualified names for all element types and global
535            attribute names. -->
536  EOH  EOH
537    for my $lname (sort keys %{$Info->{QName}}) {    for my $lname (sort keys %{$Info->{QName}}) {
538      $s .= qq(<!ENTITY % )      $s .= qq(<!ENTITY % )
# Line 551  sub get_adefault ($$) { Line 616  sub get_adefault ($$) {
616    
617  sub get_desc ($$;%) {  sub get_desc ($$;%) {
618    my ($src, $Info, %opt) = @_;    my ($src, $Info, %opt) = @_;
619        my $desc = $src->get_attribute_value ('Description');    my $desc = $src->get_attribute_value ('Description');
620        $desc =~ s/\n/\n     /g;    $desc =~ s/\n/\n     /g;
621    if (length $desc) {    if (length $desc) {
622      $desc = qq($opt{prefix}$desc);      $desc = qq($opt{prefix}$desc);
623      $desc .= q( ) if $opt{padding_length};      $desc .= q( ) if $opt{padding_length};
624      $desc = q(<!-- ).(dot_padding $desc, length => $opt{padding_length},      $desc = q(<!-- ).(dot_padding $desc, length => $opt{padding_length},
625                                           dot => $opt{padding_dot}).qq( -->\n);                                           dot => $opt{padding_dot}).qq( -->\n);
626      } elsif (length $opt{default}) {
627        $desc = $opt{default};
628        $desc .= q( ) if $opt{padding_length};
629        $desc = q(<!-- ).(dot_padding $desc, length => $opt{padding_length},
630                                             dot => $opt{padding_dot}).qq( -->\n);
631    }    }
632    $desc;    $desc;
633  }  }
# Line 637  sub attrib_REF ($$) { Line 707  sub attrib_REF ($$) {
707      'xml:base'  => q<xml:base   %URI.datatype;  #IMPLIED>,      'xml:base'  => q<xml:base   %URI.datatype;  #IMPLIED>,
708      'xml:lang'  => q<xml:lang   %LanguageCode.datatype; #IMPLIED>,      'xml:lang'  => q<xml:lang   %LanguageCode.datatype; #IMPLIED>,
709      'xml:space' => q<xml:space  (default|preserve)      #IMPLIED>,      'xml:space' => q<xml:space  (default|preserve)      #IMPLIED>,
710        'xsi:nil'   => q<%XSI.prefix;:nil (true|false|1|0) #IMPLIED>,
711        'xsi:noNamespaceSchemaLocation'     => q<%XSI.prefix;:noNamespaceSchemaLocation CDATA #IMPLIED>,
712        'xsi:schemaLocation'        => q<%XSI.prefix;:schemaLocation CDATA #IMPLIED>,
713        'xsi:type'  => q<%XSI.prefix;:type NMTOKEN #IMPLIED>,
714    }->{$src->value};    }->{$src->value};
715  }  }
716    
# Line 696  sub element_def ($$) { Line 770  sub element_def ($$) {
770      $short_name = $1;      $short_name = $1;
771    }    }
772    my $s = get_desc $src, $Info, prefix => qq($short_name: ),    my $s = get_desc $src, $Info, prefix => qq($short_name: ),
773                     padding_length => 51, padding_dot => q(.);                     padding_length => 51, padding_dot => q(.),
774                       default => qq($short_name);
775    $s .= "\n";    $s .= "\n";
776    $s .= xml_parameter_ENTITY qq($mname.element), value => 'INCLUDE';    $s .= xml_parameter_ENTITY qq($mname.element), value => 'INCLUDE';
777      my $cm = convert_content_model ($src, $Info, default => 'EMPTY');
778    $s .= xml_condition_section (qq($mname.element) =>    $s .= xml_condition_section (qq($mname.element) =>
779              xml_parameter_ENTITY              xml_parameter_ENTITY (qq($name.content), value => $cm)
               (qq($name.content),  
                value => convert_content_model ($src, $Info, default => 'EMPTY'))  
780            . xml_parameter_ENTITY (qq($name.qname), value => $short_name)            . xml_parameter_ENTITY (qq($name.qname), value => $short_name)
781            . qq(<!ELEMENT %$name.qname; %$name.content;>\n));            . xml_parameter_ENTITY (qq($name.tagmin.start), value => q<->)
782              . xml_parameter_ENTITY (qq($name.tagmin.end), value => $cm eq 'EMPTY' ? q<o> : q<->)
783              . xml_condition_section (qq(sgml.tag.minimizable) =>
784                  xml_parameter_ENTITY (qq($name.tagmin),
785                                        value => qq"%$name.tagmin.start; %$name.tagmin.end;"))
786              . xml_parameter_ENTITY (qq($name.tagmin), value => q"")
787              . qq(<!ELEMENT %$name.qname; %$name.tagmin; %$name.content;>\n));
788    $s .= "\n";    $s .= "\n";
789    $s .= attlist_def (scalar $src->get_attribute ('Attribute', make_new_node => 1), $Info, $mname);    $s .= attlist_def (scalar $src->get_attribute ('Attribute', make_new_node => 1), $Info, $mname);
790    $s;    $s;
# Line 797  sub make_module ($$$$;%) { Line 877  sub make_module ($$$$;%) {
877       }]} -->       }]} -->
878  <!-- file: $Info->{ID}-$id.mod  <!-- file: $Info->{ID}-$id.mod
879            
880       $Info->{Description}  @{[make_paragraphs [$Info->{Description}], indent => q<     >]}
881        
882       Copyright @{[(gmtime)[5]+1900]} $Info->{Copyright}, All Rights Reserved.       Copyright @{[(gmtime)[5]+1900]} $Info->{Copyright}, All Rights Reserved.
883        
884         Permission to use, copy, modify and distribute this DTD and its
885         accompanying documentation for any purpose and without fee is hereby
886         granted in perpetuity, provided that the above copyright notice and
887         this paragraph appear in all copies.  The copyright holders make no
888         representation about the suitability of the DTD for any purpose.
889        
890         It is provided "as is" without expressed or implied warranty.
891        
892       Revision: @{[sprintf '%04d-%02d-%02dT%02d:%02d:%02d+00:00',       Revision: @{[sprintf '%04d-%02d-%02dT%02d:%02d:%02d+00:00',
893                            (gmtime)[5]+1900, (gmtime)[4]+1, (gmtime)[3,2,1,0]                            (gmtime)[5]+1900, (gmtime)[4]+1, (gmtime)[3,2,1,0]
894                 ]} (Generated by $SCRIPT_NAME/$VERSION)                 ]} (Generated by $SCRIPT_NAME/$VERSION)
# Line 859  EOH Line 949  EOH
949                }->{$id}, $src->get_attribute_value ('Description'));                }->{$id}, $src->get_attribute_value ('Description'));
950    unshift @para, '  '.join ', ', sort @{$Info->{elements}||[]} if @{$Info->{elements}||[]};    unshift @para, '  '.join ', ', sort @{$Info->{elements}||[]} if @{$Info->{elements}||[]};
951    if (@para) {    if (@para) {
952        $name = qq($Info->{realname} QName (Qualified Name) Module)
953          if $id eq 'qname';
954      $r .= <<EOH;      $r .= <<EOH;
955  <!-- $name  <!-- $name
956    
# Line 891  sub make_dtd ($$$$) { Line 983  sub make_dtd ($$$$) {
983    
984  <!-- $Info->{Name} DTD  <!-- $Info->{Name} DTD
985    
986       $Info->{Description}  @{[make_paragraphs [$Info->{Description}], indent => q<     >]}
987    
988       Copyright @{[(gmtime)[5]+1900]} $Info->{Copyright}, All Rights Reserved.       Copyright @{[(gmtime)[5]+1900]} $Info->{Copyright}, All Rights Reserved.
989    
Legend:
Removed from v.1.3  
changed lines
  Added in v.1.5
admin@suikawiki.org
 ViewVC Help
Powered by ViewVC 1.1.24