File: C:/Ruby27-x64/msys64/usr/share/texinfo/init/highlight_syntax.pm
# highlight_syntax.pm: interface to source-highlight for syntax highlighting
#
# Copyright (C) 2021 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/>.
require 5.0;
use strict;
use File::Spec;
# FIXME does not seems to be needed in latex2html.pm?
use Texinfo::Common;
use Texinfo::Convert::Text;
use Texinfo::Convert::NodeNameNormalization;
my %languages_name_mapping = (
'C++' => 'C',
);
my %languages_extensions = (
'texinfo' => 'texi',
);
texinfo_add_valid_option('HIGHLIGHT_SYNTAX_DEFAULT');
texinfo_register_handler('structure', \&highlight_process);
texinfo_register_command_formatting('example', \&highlight_preformatted_command);
# the end of a string were randomly generated once for all.
my $range_separator = '_______________________________________ highlight texinfo _GT Haib0aik zei4YieH';
my %languages = ();
my %commands = ();
my $highlight_out_dir;
my %highlighted_languages_list;
sub _get_highlighted_languages($)
{
my $self = shift;
my $cmd = 'source-highlight --lang-list';
if (not(open(HIGHLIGHT_LANG_LIST, '-|', $cmd))) {
$self->document_warn(sprintf(__(
'highlight_syntax.pm: command failed: %s'), $cmd));
return 0;
}
my $line;
while (defined($line = <HIGHLIGHT_LANG_LIST>)) {
chomp($line);
if ($line =~ /^([A-Za-z0-9_\-]+) =/) {
my $language = $1;
$highlighted_languages_list{$language} = 1;
} else {
$self->document_warn(sprintf(__(
'highlight_syntax.pm: %s: %s: cannot parse language line'),
$cmd, $line));
}
}
close(HIGHLIGHT_LANG_LIST);
return 1;
}
sub _get_language($$$)
{
my $self = shift;
my $cmdname = shift;
my $command = shift;
my $language;
my $converted_language;
if ($cmdname eq 'example') {
if ($command->{'args'} and scalar(@{$command->{'args'}}) > 0) {
$converted_language = Texinfo::Convert::NodeNameNormalization::convert($command->{'args'}->[0]);
if ($converted_language eq '') {
$converted_language = undef;
}
}
}
if (not defined($converted_language) and defined($self)) {
my $default_highlight_language = $self->get_conf('HIGHLIGHT_SYNTAX_DEFAULT');
if (defined($default_highlight_language)) {
$converted_language = $default_highlight_language;
}
}
if (defined($converted_language) and defined($languages_name_mapping{$converted_language})) {
$language = $languages_name_mapping{$converted_language};
} else {
$language = $converted_language;
}
if ($highlighted_languages_list{$language}) {
return $language;
} else {
return undef;
}
}
sub highlight_process($$)
{
my $self = shift;
my $document_root = shift;
return 1 if (defined($self->get_conf('OUTFILE'))
and $Texinfo::Common::null_device_file{$self->get_conf('OUTFILE')});
return 0 if (not _get_highlighted_languages($self));
my $document_name = $self->{'document_name'};
my $highlight_basename = "${document_name}_highlight";
$highlight_out_dir = $self->{'destination_directory'};
my @highlighted_commands = ('example');
my $collected_commands = Texinfo::Common::collect_commands_in_tree($document_root, \@highlighted_commands);
foreach my $cmdname (@highlighted_commands) {
if (scalar(@{$collected_commands->{$cmdname}}) > 0) {
foreach my $root (@{$collected_commands->{$cmdname}}) {
my $language = _get_language($self, $cmdname, $root);
if (defined($language)) {
if (not exists($languages{$language})) {
$languages{$language} = {
'counter' => 0.,
};
}
$languages{$language}->{'counter'}++;
my $counter = $languages{$language}->{'counter'};
$languages{$language}->{'commands'}->[$counter-1] = [$root, $cmdname];
$commands{$cmdname}->{'input_counter'}++;
}
}
}
}
foreach my $language (keys(%languages)) {
my $suffix;
if (defined($languages_extensions{$language})) {
$suffix = $languages_extensions{$language};
} else {
$suffix = $language
}
my $language_base = ${highlight_basename} . "_${language}";
$languages{$language}->{'basefile'} = $language_base . "_input.$suffix";
$languages{$language}->{'html_file'} = $language_base . '_output.html';
$languages{$language}->{'rfile'} = File::Spec->catfile($highlight_out_dir,
$languages{$language}->{'basefile'});
$languages{$language}->{'r_html_file'} = File::Spec->catfile($highlight_out_dir,
$languages{$language}->{'html_file'});
# expand @example texts in an input file for highlight source
# program
my $rfile = $languages{$language}->{'rfile'};
unless (open (HIGHLIGHT_LANG_IN, ">$rfile")) {
$self->document_warn(sprintf(__("highlight_syntax.pm: could not open %s: %s"),
$rfile, $!));
return 0;
}
print HIGHLIGHT_LANG_IN "Automatically generated\n\n";
my $highlight_lang_in_line_nr = 2;
my $counter = 0;
foreach my $root_command (@{$languages{$language}->{'commands'}}) {
my $root = $root_command->[0];
my $tree = {'contents' => [@{$root->{'contents'}}]};
if ($tree->{'contents'}->[0]
and $tree->{'contents'}->[0]->{'type'}
and $tree->{'contents'}->[0]->{'type'} eq 'empty_line_after_command') {
shift @{$tree->{'contents'}};
}
if ($tree->{'contents'}->[-1]->{'cmdname'}
and $tree->{'contents'}->[-1]->{'cmdname'} eq 'end') {
pop @{$tree->{'contents'}};
}
my $text = Texinfo::Convert::Text::convert($tree, {'code' => 1,
Texinfo::Common::_convert_text_options($self)});
# make sure that the text ends with a newline
chomp ($text);
$text .= "\n";
# count the number of record separator $/
my $buffer = $text;
my $text_lines_nr = ( $buffer =~ s|$/||g );
print HIGHLIGHT_LANG_IN "_______________________ $counter\n";
print HIGHLIGHT_LANG_IN $text;
print HIGHLIGHT_LANG_IN "_______________________ $counter\n";
$languages{$language}->{'line_ranges'}->[$counter] = [$highlight_lang_in_line_nr+1 +1, $highlight_lang_in_line_nr + $text_lines_nr+1];
$highlight_lang_in_line_nr += 2 + $text_lines_nr;
$counter ++;
}
close(HIGHLIGHT_LANG_IN);
# call source highlighting program
my $html_result_file = $languages{$language}->{'r_html_file'};
my @option_line_ranges = ();
foreach my $line_range (@{$languages{$language}->{'line_ranges'}}) {
push @option_line_ranges, '"'.$line_range->[0].'-'.$line_range->[1].'"';
}
my $option_line_range_str = join(',', @option_line_ranges);
my $cmd = "source-highlight --src-lang=$language --out-format=html5 -i '$rfile' -o '$html_result_file' --line-range=$option_line_range_str --range-separator='$range_separator'";
if (system($cmd)) {
$self->document_error(sprintf(__("highlight_syntax.pm: command did not succeed: %s"),
$cmd));
return 0;
}
my $language_fragments_nr = $languages{$language}->{'counter'};
# extract highlighted fragments
unless (open (HIGHLIGHT_LANG_OUT, $html_result_file)) {
$self->document_warn(sprintf(__("highlight_syntax.pm: could not open %s: %s"),
$html_result_file, $!));
return 0;
}
my $got_count = 0;
my $line;
my $text;
my $separators_count = 0;
while ($line = <HIGHLIGHT_LANG_OUT>) {
#print STDERR "$html_result_file: while $line";
if ($line =~ /$range_separator/) {
$separators_count++;
if (defined($text)) {
$got_count++;
my $root_command = $languages{$language}->{'commands'}->[$got_count-1];
my $root = $root_command->[0];
my $command = $root_command->[1];
$commands{$command}->{'results'}->{$root} = $text;
$text = undef;
}
#print STDERR "$language $got_count $language_fragments_nr \n";
if ($got_count < $language_fragments_nr) {
$text = '';
}
} else {
if (defined($text)) {
$text .= $line;
}
}
}
if ($separators_count != $language_fragments_nr +1) {
$self->document_warn(sprintf(__(
"highlight_syntax.pm: %s: %d separators; expected %d, the number of fragments +1"),
$language, $separators_count, $language_fragments_nr+1));
}
if (defined($text) and $text ne '') {
my $root_command = $languages{$language}->{'commands'}->[$got_count-1];
my $root = $root_command->[0];
my $command = $root_command->[1];
$self->document_warn(sprintf(__(
"highlight_syntax.pm: %s: end of \@%s item %d not found"),
$language, $command, $got_count));
}
if ($got_count != $languages{$language}->{'counter'}) {
$self->document_warn(sprintf(__(
"highlight_syntax.pm: %s: processing produced %d items in HTML; expected %d, the number found in the document"),
$language, $got_count, $language_fragments_nr));
}
close (HIGHLIGHT_LANG_OUT);
}
return 1;
}
sub highlight_preformatted_command($$)
{
my $self = shift;
my $cmdname = shift;;
my $command = shift;
my $content = shift;
my $language = _get_language($self, $cmdname, $command);
if (exists ($commands{$cmdname}->{'results'}->{$command})
and defined($commands{$cmdname}->{'results'}->{$command})) {
if (not defined($language)) {
$self->document_warn(sprintf(__(
"highlight_syntax.pm: output has HTML item for \@%s but no language %s"),
$cmdname, $command));
} else {
$commands{$cmdname}->{'output_counter'}++;
if ($self->in_string()) {
return $content;
}
# need to do all the formatting done for content inside
# of @example as it is discarded. So need to do the preformatted
# type formatting, from _convert_preformatted_type() and _preformatted_class()
my $pre_class;
my @pre_classes = $self->preformatted_classes_stack();
foreach my $class (@pre_classes) {
# FIXME maybe add or $pre_class eq 'menu-preformatted' to override
# 'menu-preformatted' with 'menu-comment'?
$pre_class = $class unless ($pre_class
and $Texinfo::Common::preformatted_code_commands{$pre_class}
and !($Texinfo::Common::preformatted_code_commands{$class}
or $class eq 'menu-preformatted'));
}
# FIXME not clear on that. What to do with @example arguments?
my $extra_classes;
if ($cmdname eq 'example' and $command->{'args'}) {
$extra_classes = [];
for my $example_arg (@{$command->{'args'}}) {
# convert or remove all @-commands, using simple ascii and unicode
# characters
my $converted_arg = Texinfo::Convert::NodeNameNormalization::convert($example_arg);
if ($converted_arg ne '') {
push @$extra_classes, $converted_arg;
}
}
}
my $result_content = $commands{$cmdname}->{'results'}->{$command};
$result_content =~ s/^\n/\n\n/; # a newline immediately after a <pre> is ignored.
my $preformatted_result_content = $self->_attribute_class('pre', $pre_class).">".$result_content."</pre>";
return $self->_attribute_class('div', $cmdname, $extra_classes).">\n".$preformatted_result_content.'</div>'."\n";
}
} elsif (defined($language)) {
$self->document_warn(sprintf(__(
"highlight_syntax.pm: output has no HTML item for \@%s %s %s"),
$cmdname, $language, $command));
#print STDERR "$content\n";
}
return &{$self->default_commands_conversion($cmdname)}($self, $cmdname, $command, $content);
}
1;