HEX
Server: Apache
System: Windows NT MAGNETO-ARM 10.0 build 22000 (Windows 10) AMD64
User: Michel (0)
PHP: 7.4.7
Disabled: NONE
Upload Files
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;