2-test_emacs_syntax_coloring.t

#!/usr/bin/perl
# 2-test_emacs_syntax_coloring.t                   doom@kzsu.stanford.edu
#                                                   23 Sep 2007

use warnings;
use strict;
$|=1;
our $VERSION = 0.01;
use Test::More qw(no_plan);

use Data::Dumper;

use File::Path     qw(mkpath);
use File::Basename qw(fileparse basename dirname);

# use Fatal          qw( open close mkpath copy move );
use Cwd            qw( cwd abs_path );

use Image::Magick;
my ($err);

use Env qw(HOME);
use FindBin qw( $Bin );
use lib "$Bin/../../lib/perl";
use Run::Emacs qw( emacs_version );

use Getopt::Long;
my %opt = ();
GetOptions( \%opt, "debug|d" );
my $DEBUG = $opt{debug} || 0;

my $prog = basename($0);

my $tempdir = "$Bin/tmp";
mkpath( $tempdir );

# size of child emacs window: width and height in columns
my $cols = 80;
my $rows = 30;
my $cols_by_rows = $cols . 'x' . $rows;
my $geom = "$cols_by_rows+0+0";

# width and height in pixels, with 9x15 font
#  ("each character nine pixels wide and fifteen pixels high.")
my $width  = 80 * 9;
my $height = 20 * 15;

my $target = "/home/doom/End/Cave/GuiTest/bin/testes-syntax_colors";

# my $emacs_cmd = "emacs -q --font=9x15 --geometry=$geom --no-splash $target";
# my $emacs_cmd = "emacs -q --font=9x15 --no-splash --geometry=$geom $target -f font-lock-fontify-buffer";
# my $emacs_cmd = "emacs -q --font=9x15 --geometry=$geom $target -f font-lock-fontify-buffer";
# my $emacs_cmd = "cvs_emacs -q --font=9x15 --no-splash --geometry=$geom $target -f font-lock-fontify-buffer";

# Without -q, my .emacs stuff overrides the --geometry.
# The eval folderol here applies the geometry settings after my initializations
# Note, needs height in rows, and width in columns.

my $geom_elisp =<<"END_ELISP";
 (progn
  (set-frame-height   (selected-frame)  $rows )
  (set-frame-width    (selected-frame)  $cols )
  (set-frame-position (selected-frame) 0 0))
END_ELISP

my $emacs_cmd;
if (emacs_version() < 22) {
  $emacs_cmd =

    "emacs --font=9x15 $target " .
      "-f font-lock-fontify-buffer " .
        "--eval '$geom_elisp' ";
} else {

  $emacs_cmd =
    "emacs --font=9x15 --no-splash $target " .
      "-f font-lock-fontify-buffer " .
        "--eval '$geom_elisp' ";
}

### TODO the crop params used should change for the above case.

($DEBUG) && print STDERR "emacs_cmd: $emacs_cmd\n";

my $capture = "$tempdir/capture.png";

my $pid = fork;
if (not (defined( $pid ) ) ) {

  die "Failed to fork";

} elsif ($pid == 0) {

  print "I am the child.  About to exec:\n  $emacs_cmd\n";
  exec($emacs_cmd);  # replaces the child perl process with a new emacs:
                     # no change in pid

} elsif ($pid) {

  print "I am the parent: $$\n";
  print "The child is: $pid\n";

  print "Wait a moment... about to take a picture of the child\n";
  sleep 5; # need to sleep so the child has time to put up the window

  # capture the entire screen image
  my $import_cmd = "import -window root -quality 50 $capture";
  ($DEBUG) && print STDERR "import_cmd: $import_cmd\n";
  system($import_cmd);

  print "Death to the child\n";
  kill 9, $pid;

  my $imh = Image::Magick->new;
  $err = $imh->Read($capture);
  warn "$err" if "$err";

  my $crop_geom = $width . 'x' . $height;
  $err = $imh->Crop( geometry=>$crop_geom);
  warn "$err" if "$err";

  # save a copy of just the generated emacs window
  # my $output_file = "$tempdir/capture_cropped.png";
  (my $output_file = $capture) =~ s{ ^ (.*?) \. (png) $ }
                                   {$1-cropped.$2}x;
  $err = $imh->Write($output_file);
  warn "$err" if "$err";

  # trim the image (chop off the decorations)
  # crop from x1: 20 y1: 80 to lower right corner
  my $new_x_zero = 20;
  my $new_width = $width - $new_x_zero;
  my $new_y_zero = 80;
  my $new_height = $height - $new_y_zero;
  $crop_geom = $new_width  . 'x' . $new_height . '+' .
               $new_x_zero . '+' . $new_y_zero;

  $err = $imh->Crop( geometry=>$crop_geom);
  warn "$err" if "$err";

  # save a copy of capture sans window decorations
  $output_file =~ s{ \b cropped \. png $ }
                   {no_decor.png}x;
  $err = $imh->Write($output_file);
  warn "$err" if "$err";

  # get the number of colors in use: enough to tell if syntax coloring is on
  my $color_count = $imh->Get('colors');
  ($DEBUG) && print STDERR "color_count: $color_count\n";

  my $color_threshold = 7;
  cmp_ok( $color_count, '>', $color_threshold, "Testing that there are more syntax colors visible than $color_threshold");


}

__END__

=head1 NAME

2-test_emacs_syntax_coloring.t - forking off an emacs to take a screenshot

=head1 SYNOPSIS

  2-test_emacs_syntax_coloring.t [options] [arguments ...]

=head1 DESCRIPTION

B<2-test_emacs_syntax_coloring.t> is a script that demos a
techique to test whether emacs syntax coloring is working.

It works by forking off an emacs as a child process, running an
"import" command to take a snapshot of it, and then getting rid
of it later (the parent kills the child).

It then looks at the captured image and using ImageMagick
manipulations to determine the number of colors used in
the display.

The intention is to use this to automate tests of emacs code,
to look for obscure conflicts that impact syntax-coloring.


=head1 IMPLEMENTATION

=head2 import

There's a form of the import command that's supposed to capture
just a portion of the screen using the "crop" parameter:

  #   import -window root -crop 512x256-0+0 -quality 90 corner.png
  my $crop = $width . 'x' . $height . '-0+0';
  my $cmd2 = "import root -crop $crop -quality 10 $capture";

This doesn't appear to work right: it demands a mouse click to
get it to take the import, when it's supposed to work
automatically.

So instead I use import to capture the whole screen image,
and then Image::Magick manipulations to crop it to the
emacs window.

Then I do a second crop to get rid of the window decorations.

(But of course, it would be neater to have perl code (using
Image::Magick?) to directly capture the image off the screen,
rather than shell out to import.)

=head2 sleep

Note, it appears to unavoidable necessity to sleep for a few
seconds to give the child window time to render, at least
in the general case.  An emacs trick might be used to have
the child communicate with the parent and tell it when it's
ready to have it's picture taken, but that would be emacs-
specific and I'm interested in more general test technique.



=head2 TODO

  o For demonstration purposes, increase the sleep so
    the audience can see what's happening.

  o How to capture an image without shelling out to import?

  o generous (i.e. wrong) crop parameters are okay,
    provided they're generous on all sides.  If we
    snag some of the background, it screws things up.
    Establish a bland background?


=head1 NOTES

o This is the import feature that doesn't work as advertised:

   /usr/share/doc/imagemagick/www/import.html

   To capture the 512x256 area at the upper right corner of the X server
   screen in the PNG image format in a well-compressed file entitled
   corner.png, without using the mouse, use:
    import -window root -crop 512x256-0+0 -quality 90 corner.png


o  --no-splash is required for emacs 22, but it can not be used at
   all with emacs 21.  I love changes in interface like that,
   don't you?



=head1 AUTHOR

Joseph Brenner, Edoom@kzsu.stanford.eduE

=head1 COPYRIGHT AND LICENSE

Copyright (C) 2007 by Joseph Brenner

This program is free software; you can redistribute it and/or modify
it under the same terms as Perl itself, either Perl version 5.8.2 or,
at your option, any later version of Perl 5 you may have available.

=head1 BUGS

None reported... yet.

=cut