# Arch Perl library, Copyright (C) 2005 Mikhael Goikhman, Enno Cramer
#
# 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 2 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, write to the Free Software
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA

use 5.006;
use strict;
use warnings;

package ArchWay::Widget::Text;

use Glib qw(TRUE FALSE);
use Gtk2;
use Gtk2::Pango;

use Arch::FileHighlighter;

use base qw(Gtk2::TextView);

sub new ($) {
	my $class = shift;

	my $buffer = ArchWay::Widget::Text::Buffer->new;
	my $self = bless Gtk2::TextView->new_with_buffer($buffer), $class;

	$self->_init;

	return $self;
}

sub _blend ($$$$) {
	my ($c1, $w1, $c2, $w2) = @_;

	my $r = $c1->red * $w1 + $c2->red * $w2;
	my $g = $c1->green * $w1 + $c2->green * $w2;
	my $b = $c1->blue * $w1 + $c2->blue * $w2;

	return sprintf('#%02x%02x%02x', $r / 257, $g / 257, $b / 257);
}

sub _init ($) {
	my $self = shift;

	# default textview settings
	$self->set_editable(FALSE);
	$self->set_cursor_visible(FALSE);

	$self->set_wrap_mode('none');

	my $fd = Gtk2::Pango::FontDescription->new;
	$fd->set_family('monospace');
	$self->modify_font($fd);

	# generate real zebra
	my $style = $self->get_property('style');
	my $table = $self->get_buffer->get_tag_table;
	my $tag;

	$tag = $table->lookup('annotate_zebra0');
	$tag->set_property(
		'background',
		_blend($style->bg('selected'), 0.3, $style->bg('normal'), 0.7),
	);
	$tag->set_property(
		'foreground',
		_blend($style->text('selected'), 0.0, $style->text('normal'), 1.0),
	);

	$tag = $table->lookup('annotate_zebra1');
	$tag->set_property(
		'background',
		_blend($style->bg('selected'), 0.1, $style->bg('normal'), 0.9),
	);
	$tag->set_property(
		'foreground',
		_blend($style->text('selected'), 0.0, $style->text('normal'), 1.0),
	);
}

sub clear ($) {
	my $self = shift;

	$self->get_buffer->set_text('');
}

sub show ($$) {
	my $self = shift;
	my $markup = shift;

	$self->clear;

	return unless defined $markup;

	my $buffer = $self->get_buffer;
	my $iter = $buffer->get_iter_at_offset(0);
	$buffer->insert_markup($iter, $markup);
}

package ArchWay::Widget::Text::Buffer;

use base qw(Gtk2::TextBuffer);

my %TAGS = (
	patch_new   => { background => '#b0b0b0' },
	patch_old   => { background => '#b0b0b0' },
	patch_lines => { background => '#f0f0a0' },
	patch_add   => { background => '#90f090' },
	patch_del   => { background => '#f09090' },
	patch_mod   => { background => '#f0f090' },

	# bold: 700 (see pango/pango-font.h)
	syntax_comment => {
		foreground => '#303080',
		style      => 'italic',
	},
	syntax_keyword => {
		foreground => '#740000',
		weight     => 700,
	},
	syntax_builtin => {
		foreground => '#a000a0',
		weight     => 700,
	},
	syntax_string => {
		foreground => '#107474',
	},
	syntax_special => {
		foreground => '#108030',
	},
	syntax_funcdef => {
		foreground => '#2040d0',
		weight     => 700,
	},
	syntax_vartype => {
		foreground => '#942060',
		weight     => 700,
	},
	syntax_constant => {
		foreground  => '#c08000',
	},

	annotate_zebra0     => {
		foreground => '#606060',
		background => '#e0e0e0',
	},
	annotate_zebra1     => {
		foreground => '#606060',
		background => '#c0c0c0',
	},
);

sub new ($) {
	my $class = shift;

	my $self = bless Gtk2::TextBuffer->new, $class;

	$self->_init;

	return $self;
}

sub _init ($) {
	my $self = shift;

	# default tags
	foreach my $tag (keys %TAGS) {
		$self->create_tag($tag, %{$TAGS{$tag}});
	}
}

sub overwrite_tag ($$@) {
	my $self = shift;
	my ($tag, @props) = @_;

	my $table = $self->get_buffer->get_tag_table;
	my $texttag = $table->lookup($tag);
	$table->remove($texttag);
	$self->get_buffer->create_tag($tag, @props);
}

sub insert_markup ($$$) {
	my $self = shift;
	my ($iter, $markup) = @_;

	my @stack;

	while (length $markup) {
		if ($markup =~ s,^<span class=\"([^\"]+)\">,,) {
			push @stack, [ $self->create_mark(undef, $iter, 1), $1 ];


		} elsif ($markup =~ s,^</span>,,) {
			unless (@stack) {
				warn "Unmatched closing span in markup, ";
				next;
			}

			my ($from, $tag) = @{pop @stack};
			$self->apply_tag_by_name(
				$tag, $self->get_iter_at_mark($from), $iter
			);
			$self->delete_mark($from);

		} elsif ($markup =~ s,^[^<]+,,) {
			$self->insert($iter, Arch::FileHighlighter::dehtmlize($&));

		} else {
			die "Invalid markup: '" . substr($markup, 0, 20) . "'\n";
		}
	}

	warn "Unmatched opening span in markup, "
		if @stack;
}

1;

__END__
