My Quick 'n' Dirty Editor in GTK4

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

Yes, there are bugs. There are always bugs. Can anyone help me fix them?

In the interest of getting more help with the colorizations, I've golfed the tag application routines to something that doesn't use any of the GTK code. You can find it here:

my $content;

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 regex method-call  {
 '.' <[\w_-]>+ '('
    [
      <.ws>              |
      <argument>+ % <cs> |
      <argument> <.ws>
    ]
  ')'
}

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

my %colors = (
  dc          => { b => 200},
  word        => { b => 128, g => 156},
  pair        => { b => 90},
  key         => { g => 190},
  string      => { g => 190},
  int         => { g => 190},
  num         => { g => 190},
  method-call => { r => 128, b => 128}
);

multi sub apply-color-tag ($n, $m) {
  for $m[] {
    if %colors{$n}:exists {
      say "Applying { $n } from { .from } - { .to }";
    }
    say "P: { .keys }";
    apply-color-tag(.key, .value) for .pairs;
  }
}

sub colorize-initially ($*tv) {
  for @top-rules {
    if $content.match( ::('&' ~ $_), :g) -> $m is copy {
      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;
  colorize-initially($t);
}

Can someone tell me why the key and value rules are not being applied (there should be a message saying they are in the output).

Thanks!

P: word dc
Applying word from 1581 - 1583
P: 
Applying word from 1585 - 1589
P: 
Applying dc from 1583 - 1585
P: 
Applying pair from 898 - 906
P: key value
Applying pair from 928 - 936
P: value key
Applying pair from 938 - 946
P: key value
Applying pair from 968 - 975
P: key value
Applying pair from 997 - 1005
P: key value
Applying pair from 1027 - 1035
P: key value
Applying pair from 1057 - 1065
P: key value
Applying pair from 1087 - 1095
P: key value
Applying pair from 1117 - 1125
P: key value
Applying pair from 1127 - 1135
P: key value

that's the input I got.

OK, that's correct.

Now, I'm wondering why "Applying key from x - y" or "Applying value from x - y" aren't there. They are supposed to show up since that's what the "P: key value" mean.