Xliff/Gtk4Editor.md

## Gtk4Editor.md

      
    Raw
  

              Gtk4Editor.md
            
          
    I wrote up a quick and dirty editor as a test case for some my GTK4 work.
Heres a sample screenie:

And here's what the code looks like:
use v6.c;

use GDK::RGBA;
use GTK::Application;
use GTK::CssProvider;
use GTK::Box;
use GTK::ScrolledWindow;
use GTK::Text::View;
use GTK::Text::Tag;
use GTK::Text::Tag::Table;

my $content;

role TagNotApplied { }

multi sub trait_mod:<is> (Routine $m, :$not-applied is required) {
  $m does TagNotApplied;
}

my token word         { \w+                               }
my token dc           { '::'                              }
my token cs           { <.ws> ',' <.ws>?                  }
my token class-name   { <word> ** 2..* % <dc>             }
my token string       { "'" .+? "'" | '"' .+? '"'         }
my token int          { <digit>+                          }
my token num          { <digit> '.' <digit>+              }
my token value        { <num> | <int> | <string>          }
my token key          { \w+                               }
my token pair         { <key> <.ws> '=>' <.ws> <value>    }
my token argument     { <num> | <int> | <string> | <pair> }

my token method-call  {
 '.('
    [
      <.ws>              |
      <argument>+ % <cs> |
      <argument> <.ws>
    ]
  ')'
}

my @top-rules = <class-name method-call>;

sub apply-color-tag ($n, $m) {
  next if $m ~~ TagNotApplied;
  apply-color-tag(.key, .value) for $m.pairs;
  if $*tv.buffer.tag-table.lookup($n) {
    # cw: Apply colorizations from the bottom-up
    for $m[] {
      say "Applying { $n } from { .from } - { .to }";
      $*tv.buffer.applyTagAtIndexes($n, .from, .to, :tag)
    }
  }
}

sub colorize-initially ($*tv) {
  my %colors = (
    dc          => GDK::RGBA.new(b => 200),
    word        => GDK::RGBA.new(b => 128, g => 156),
    argument    => GDK::RGBA.new(g => 190),
    method-call => GDK::RGBA.new(r => 128, b => 128)
  );

  for <dc word argument method-call> {
    my $tag = GTK::Text::Tag.new($_);
    $tag.weight = 800;
    $tag.foreground-rgba = %colors{$_} if %colors{$_};
    $*tv.buffer.tag-table.add($tag);
  }

  for @top-rules {
    if $content.match( ::('&' ~ $_), :g) -> $m is copy {
      $m.gist.say;
      apply-color-tag($_, $m);
    }
  }
}

sub MAIN (
  :$font,
  :$file  is copy = $*PROGRAM
) {
  unless $file ~~ IO::Path {
    die "File '$file' does not exist!" unless $file.IO.r;
    $file .= IO;
  }
  $content = $file.slurp;

  my $a = GTK::Application.new(
    title  => 'org.genex.textview.colors',
  );

  $a.Activate.tap( -> *@a {
    my $css = GTK::CssProvider.new( pod => $=pod );

    my $box = GTK::Box.new-vbox(4);
    $a.window.child = $box;

    my $sw = GTK::ScrolledWindow.new;
    $sw.min-content-size = (800, 400);

    my $t = GTK::Text::View.new( text => $content );
    ($sw.child, $t.expand, $t.name) = ($t, True, 'prog');

    $box.append($sw);
    $t.margins = 15;

    $t.font-description = Pango::FontDescription.new-from-string($font)
      if $font;

    colorize-initially($t);

    $a.window.present;
  });

  $a.run;
}

=begin css
#prog text {
  color: #999;
}
=end css