summaryrefslogtreecommitdiff
path: root/macros/texinfo/texinfo/tp/Texinfo/Convert/TexinfoSXML.pm
blob: 2166664e8986bf21ec35bc5095e48be51832c8a3 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
# TexinfoSXML.pm: output tree as Texinfo SXML.
#
# Copyright 2013, 2014, 2015, 2016, 2017, 2018 Free Software Foundation, Inc.
# 
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 3 of the License,
# or (at your option) any later version.
# 
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
# 
# You should have received a copy of the GNU General Public License
# along with this program.  If not, see <http://www.gnu.org/licenses/>.
# 
# Original author: Patrice Dumas <pertusus@free.fr>
#
# This is a simple subclass of Texinfo::Convert::TexinfoXML that overrides
# format specific functions.

package Texinfo::Convert::TexinfoSXML;

use 5.00405;
use strict;

use Texinfo::Convert::TexinfoXML;
use Carp qw(cluck);

require Exporter;
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
@ISA = qw(Exporter Texinfo::Convert::TexinfoXML);

%EXPORT_TAGS = ( 'all' => [ qw(
  convert
  convert_tree
  output
) ] );

@EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );

@EXPORT = qw(
);

$VERSION = '6.7';

# SXML specific
my %defaults = (
  'ENABLE_ENCODING'      => 0,
  'SHOW_MENU'            => 1,
  'EXTENSION'            => 'sxml',
  #'output_perl_encoding' => 'utf8',
  'OUTPUT_ENCODING_NAME' => 'utf-8',
  'TEXINFO_DTD_VERSION'  => '5.0',
  'OUTFILE'              => undef,
  'SUBDIR'               => undef,
  'output_format'        => 'texinfosxml',
  'SPLIT'                => 0,
  'documentlanguage'     => 'en',
);

sub converter_defaults($$)
{
  return %defaults;
}

# format specific.  Used in few places where plain text is used outside
# of attributes.
sub protect_text($$)
{
  my $self = shift;
  my $string = shift;
  $string =~ s/\\/\\\\/g;
  $string =~ s/"/\\"/g;
  return $string;
}

sub sxml_attributes($$)
{
  my $self = shift;
  my $attributes = shift;
  if (ref($attributes) ne 'ARRAY') {
    cluck "attributes not an array($attributes).";
  }
  my $result = '(@';
  for (my $i = 0; $i < scalar(@$attributes); $i += 2) {
    $result .= " ($attributes->[$i] \"".$self->protect_text($attributes->[$i+1])."\")";
  }
  return $result . ')';
}

# format specific
sub element($$$)
{
  my $self = shift;
  my $element_name = shift;
  my $attributes = shift;
  my $result = '('.$element_name." ";
  $attributes = [] if (!defined($attributes));
  $result .= $self->sxml_attributes($attributes);
  $result .= ')';
  return $result;
}

# format specific
sub open_element($$$)
{
  my $self = shift;
  my $element_name = shift;
  my $attributes = shift;
  my $result = '('.$element_name." ";
  $attributes = [] if (!defined($attributes));
  $result .= $self->sxml_attributes($attributes);
  $result .= " ";
  return $result;
}

# format specific
sub close_element($$)
{
  my $self = shift;
  my $element_name = shift;
  my $result= ')';
  return $result;
}

my %commands_formatting = %Texinfo::Convert::TexinfoXML::commands_formatting;

# format specific
sub format_atom($$)
{
  my $self = shift;
  my $atom = shift;
  if ($commands_formatting{$atom} ne '') {
    return '('.$commands_formatting{$atom}.' (@))';
  } else {
    return '';
  }
}

# format specific
#FIXME
sub format_comment($$)
{
  my $self = shift;
  my $string = shift;

  return '';
}

# format specific
sub format_text($$)
{
  my $self = shift;
  my $root = shift;
  my $result = $self->protect_text($root->{'text'});
  if (! defined($root->{'type'}) or $root->{'type'} ne 'raw') {
    if (!$self->{'document_context'}->[-1]->{'monospace'}->[-1]) {
      $result =~ s/``/" (textldquo (@)) "/g;
      $result =~ s/\'\'/" (textrdquo (@)) "/g;
      $result =~ s/---/" (textmdash (@)) "/g;
      $result =~ s/--/" (textndash (@)) "/g;
      $result =~ s/'/" (textrsquo (@)) "/g;
      $result =~ s/`/" (textlsquo (@)) "/g;
    }
  }
  return '"'.$result.'" ';
}

# output format specific
sub format_header($)
{
  my $self = shift;
  my $header = '';
  my $encoding = '';
  if ($self->get_conf('OUTPUT_ENCODING_NAME')
      and $self->get_conf('OUTPUT_ENCODING_NAME') ne 'utf-8') {
    $encoding = $self->get_conf('OUTPUT_ENCODING_NAME');
  }
  if ($self->{'output_file'} ne '') {
    my $output_filename = $self->{'output_filename'};
  }
  return $header;
}