Commits

Herbert Breunung committed fce2a88

fixed docbar and improved IOUnit a bit

Comments (0)

Files changed (5)

lib/Kephra/App/Bar/Document.pm

 
 sub remove_page {
 	my ($self, $internal_position) = @_;
+
 	$self->DeletePage( $internal_position );
 	my $visual_position = $self->{'internal_page_order'}[$internal_position];
 	my $visual = $self->{'visual_page_order'};
 	splice @$visual, $visual_position, 1;
-	for (@$visual) {$_-- if $_ > $internal_position}
+	for (@$visual) {$_-- if $_ >= $internal_position}
 	$self->{'visual_page_order'} = $visual;
 	$self->refresh_internal_page_order;
 }

lib/Kephra/App/Editor.pm

 	#Wx::Event::EVT_STC_CHANGE       ($self, -1, sub {&$trigger('document.text.change')} );
 	Wx::Event::EVT_KEY_DOWN ($self, sub {
 		my ($ed, $event) = @_;
-		my $key = $event->GetKeyCode + 1000 * 
-			( $event->ShiftDown
-			+ $event->ControlDown * 2 
-			+ $event->AltDown     * 4);
+		my $key = Kephra::App::Util::keycode_from_event($event);
 		Kephra::App::Panel::IOUnit::output('log',"pressed key $key\n");
 		if    ($key ==  &Wx::WXK_UP + 2000)  {$self->ParaUp() }
 		elsif ($key ==  &Wx::WXK_UP + 3000)  {$self->ParaUpExtend() }

lib/Kephra/App/Panel/Editor.pm

 	return unless ref $doc and $doc->isa('Kephra::Document');
 	my $main_doc_bar = active_docbar();
 	if ($main_doc_bar->GetPageCount > 1) {
-		$main_doc_bar->remove_page( $main_doc_bar->GetPageIndex( $doc->editor ) );
+		$main_doc_bar->remove_page( $main_doc_bar->GetPageIndex( $doc->panel ) );
 		Kephra::DocumentStash::del($doc);
 	} else {
 		$doc->editor->ClearAll;
 		$doc->assign_file('');
-		$main_doc_bar->set_title(0, '');
+		$main_doc_bar->set_page_title(0, '');
 	}
+	Kephra::API::widget('win')->refresh_title();
 }
 
 sub raise_document {

lib/Kephra/App/Panel/IOUnit.pm

 
 my ($input, $output, %outputtext);
 my @slot_name = qw/drum log perl output shell all/;
+my $active_slot = 'drum';
 
 sub new {
 	my( $class, $parent) = @_;
 	my $self = $class->SUPER::new($parent, -1);
 
-	$input = Wx::RichTextCtrl->new($self, -1, '', [-1,-1], [-1, 29]);
+	$input = Wx::TextCtrl->new($self, -1, '', [-1,-1], [-1, -1], &Wx::wxTE_PROCESS_ENTER );
 	$output = Wx::AuiNotebook->new(
 		$self, -1, [-1,-1], [-1, -1],
 	&Wx::wxAUI_NB_TOP | &Wx::wxAUI_NB_TAB_MOVE
 	);
 	for my $slot (@slot_name) {
-		$outputtext{ $slot } = Wx::TextCtrl->new(
+		$outputtext{ $slot } = Wx::RichTextCtrl->new(
 			$output, -1, '', [-1,-1], [-1,-1],
 			&Wx::wxTE_MULTILINE | &Wx::wxTE_READONLY
 		);
 
 	Wx::Event::EVT_AUINOTEBOOK_BEGIN_DRAG  ( $output, -1, sub { });
 	Wx::Event::EVT_AUINOTEBOOK_END_DRAG    ( $output, -1, sub { });
-	Wx::Event::EVT_AUINOTEBOOK_PAGE_CHANGED( $output, -1, sub { });
-	Wx::Event::EVT_TEXT_ENTER($input, -1, sub {});
+	Wx::Event::EVT_AUINOTEBOOK_PAGE_CHANGED( $output, -1, sub {
+		my ($nb, $event ) = @_;
+		$active_slot = $nb->GetPageText( $event->GetSelection );
+	});
+	Wx::Event::EVT_TEXT_ENTER($input, -1, sub {
+		my ($txt, $event ) = @_;
+		$input->Clear;
+	});
 	Wx::Event::EVT_KEY_DOWN ($input, sub {
 		my ($ed, $event) = @_;
-		my $key = $event->GetKeyCode + 1000 * 
-			( $event->ShiftDown
-			+ $event->ControlDown * 2 
-			+ $event->AltDown     * 4);
+		my $key = Kephra::App::Util::keycode_from_event($event);
+
 		if    ($key ==  0)  { }
 		#elsif ($key ==  &Wx::WXK_PAGEUP + 2000){Kephra::App::Panel::Editor::select_tab_left()}
 		#elsif ($key ==  &Wx::WXK_PAGEUP + 3000){Kephra::App::Panel::Editor::select_tab_leftmost()  }
 		#print " $key- \n";
 	});
 
-
 	my $sizer = Wx::BoxSizer->new( &Wx::wxVERTICAL );
 	$sizer->Add( $output, 1, &Wx::wxGROW);
 	$sizer->Add( $input,  0, &Wx::wxGROW);
 	return $self;
 }
 
+sub output_and_activate {
+	my ($slot, $msg) = @_;
+	return unless defined $outputtext{$slot};
+	$output->SetSelection( $output->GetPageIndex( $outputtext{$slot} ) );
+	output(@_);
+}
 sub output {
 	my ($slot, $msg) = @_;
 	return unless defined $outputtext{$slot};

lib/Kephra/App/Util.pm

 package Kephra::App::Util;
 
 sub get {
-    my ($ref, @method_ref);
-    die unless @_;
-    for my $subname (@_){
-        eval { $ref = \&{__PACKAGE__ . "::$subname"} };
-        if ($@) { die "__PACKAGE__::get : no $subname sub in this Module." }
-        else    { push @method_ref, $ref }
-    }
-    if (wantarray){ return @method_ref }
-    else          { return $method_ref[0] }
+	my ($ref, @method_ref);
+	die unless @_;
+	for my $subname (@_){
+		eval { $ref = \&{__PACKAGE__ . "::$subname"} };
+		if ($@) { die "__PACKAGE__::get : no $subname sub in this Module." }
+		else    { push @method_ref, $ref }
+	}
+	if (wantarray){ return @method_ref }
+	else          { return $method_ref[0] }
 }
 
 sub is_object { ( ref $_[0] and index(ref $_[0], '=') == -1) ? 1 : 0 }
 sub is_color  { ( is_object( $_[0] ) and $_[0]->isa('Wx::Colour') and $_[0]->IsOk ) ? 1 : 0 }
 
 sub make_color {
-    my ($r, $g, $b, $t ) = @_;
-    my $name = __PACKAGE__ . '::make_color';
-    my $usage = "$name takes 1 parameter (hex-'12345f' or dec-'0,0,1' or name) or 3 parameters (R, G, B)";
-    die "not enough parmaters\n$usage" unless defined $r;
-    unless (defined $g){
-        # handle hex format like in HTML: #234567
-        if ( $r =~ /^#?([0-9a-f]{2})([0-9a-f]{2})([0-9a-f]{2})$/i ) {
-            ($r,$g,$b) = ( hex $1, hex $2, hex $3 );
-        }
-        # handle comma-seperated format: 0,0,125
-        elsif ( $r =~ /^(\d+),\s*(\d+),\s*(\d+)$/ ) {
-            ($r,$g,$b) = ( $1+0, $2+0, $3+0 );
-        } else {
-            my %color = (
-                'white' => [255, 255, 255],
-                'red'   => [255,   0,   0],
-                'orange'=> [255, 127,   0],
-                'yellow'=> [255, 255,   0],
-                'green' => [  0, 255,   0],
-                'cyan'  => [  0, 255, 255],
-                'blue'  => [  0,   0, 255],
-                'purple'=> [255,   0, 255],
-                'violet'=> [255,   0, 255],
-                'grey'  => [180, 180, 180],
-                'black' => [  0,   0,   0],
-            );
-            if ( exists $color{lc $r} ) {  ( $r, $g, $b ) = @{ $color{lc $r} }  }
-            else {
-                my $c = Wx::ColourDatabase::Find( $r );
-                return $c if is_color( $c );
-            }
-            unless (defined $g) {
-                my @clist = ( (keys %color),
-                    'AQUAMARINE', 'BLACK', 'BLUE', 'BLUE VIOLET', 'BROWN',
-                    'CADET BLUE', 'CORAL', 'CORNFLOWER BLUE', 'CYAN', 'DARK GREY',
-                    'DARK GREEN', 'DARK OLIVE GREEN', 'DARK ORCHID', 'DARK SLATE BLUE',
-                    'DARK SLATE GREY', 'DARK TURQUOISE, DIM GREY, FIREBRICK',
-                    'FOREST GREEN', 'GOLD', 'GOLDENROD', 'GREY, GREEN', 'GREEN YELLOW',
-                    'INDIAN RED', 'KHAKI', 'LIGHT BLUE', 'LIGHT GREY', 'LIGHT STEEL BLUE',
-                    'LIME GREEN', 'MAGENTA', 'MAROON', 'MEDIUM AQUAMARINE', 'MEDIUM BLUE',
-                    'MEDIUM FOREST GREEN', 'MEDIUM GOLDENROD', 'MEDIUM ORCHID', 
-                    'MEDIUM SEA GREEN', 'MEDIUM SLATE BLUE', 'MEDIUM SPRING GREEN',
-                    'MEDIUM TURQUOISE', 'MEDIUM VIOLET RED', 'MIDNIGHT BLUE, NAVY',
-                    'ORANGE', 'ORANGE RED', 'ORCHID', 'PALE GREEN', 'PINK', 'PLUM',
-                    'PURPLE', 'RED, SALMON', 'SEA GREEN', 'SIENNA', 'SKY BLUE',
-                    'SLATE BLUE', 'SPRING GREEN', 'STEEL BLUE', 'TAN', 'THISTLE',
-                    'TURQUOISE', 'VIOLET', 'VIOLET RED', 'WHEAT', 'WHITE', 'YELLOW',
-                    'YELLOW GREEN',
-                );
-                die "$r is an unknow color name, just know @clist";
-            }
-        }
-    }
-    die "not enough parmaters or bad format\n$usage" unless defined $b;
-    die "too much parmaters\n$usage" if defined $t;
-    die "red definition is outside of 0..255" unless int $r == $r && $r>=0 && $r<=255;
-    die "green definition is outside of 0..255" unless int $g == $g && $g>=0 && $g<=255;
-    die "blue definition is outside of 0..255" unless int $b == $b && $b>=0 && $b<=255;
-    return Wx::Colour->new($r, $g, $b);
+	my ($r, $g, $b, $t ) = @_;
+	my $name = __PACKAGE__ . '::make_color';
+	my $usage = "$name takes 1 parameter (hex-'12345f' or dec-'0,0,1' or name) or 3 parameters (R, G, B)";
+	die "not enough parmaters\n$usage" unless defined $r;
+	unless (defined $g){
+		# handle hex format like in HTML: #234567
+		if ( $r =~ /^#?([0-9a-f]{2})([0-9a-f]{2})([0-9a-f]{2})$/i ) {
+			($r,$g,$b) = ( hex $1, hex $2, hex $3 );
+		}
+		# handle comma-seperated format: 0,0,125
+		elsif ( $r =~ /^(\d+),\s*(\d+),\s*(\d+)$/ ) {
+			($r,$g,$b) = ( $1+0, $2+0, $3+0 );
+		} else {
+			my %color = (
+				'white' => [255, 255, 255],
+				'red'   => [255,   0,   0],
+				'orange'=> [255, 127,   0],
+				'yellow'=> [255, 255,   0],
+				'green' => [  0, 255,   0],
+				'cyan'  => [  0, 255, 255],
+				'blue'  => [  0,   0, 255],
+				'purple'=> [255,   0, 255],
+				'violet'=> [255,   0, 255],
+				'grey'  => [180, 180, 180],
+				'black' => [  0,   0,   0],
+			);
+			if ( exists $color{lc $r} ) {  ( $r, $g, $b ) = @{ $color{lc $r} }  }
+			else {
+				my $c = Wx::ColourDatabase::Find( $r );
+				return $c if is_color( $c );
+			}
+			unless (defined $g) {
+				my @clist = ( (keys %color),
+					'AQUAMARINE', 'BLACK', 'BLUE', 'BLUE VIOLET', 'BROWN',
+					'CADET BLUE', 'CORAL', 'CORNFLOWER BLUE', 'CYAN', 'DARK GREY',
+					'DARK GREEN', 'DARK OLIVE GREEN', 'DARK ORCHID', 'DARK SLATE BLUE',
+					'DARK SLATE GREY', 'DARK TURQUOISE, DIM GREY, FIREBRICK',
+					'FOREST GREEN', 'GOLD', 'GOLDENROD', 'GREY, GREEN', 'GREEN YELLOW',
+					'INDIAN RED', 'KHAKI', 'LIGHT BLUE', 'LIGHT GREY', 'LIGHT STEEL BLUE',
+					'LIME GREEN', 'MAGENTA', 'MAROON', 'MEDIUM AQUAMARINE', 'MEDIUM BLUE',
+					'MEDIUM FOREST GREEN', 'MEDIUM GOLDENROD', 'MEDIUM ORCHID', 
+					'MEDIUM SEA GREEN', 'MEDIUM SLATE BLUE', 'MEDIUM SPRING GREEN',
+					'MEDIUM TURQUOISE', 'MEDIUM VIOLET RED', 'MIDNIGHT BLUE, NAVY',
+					'ORANGE', 'ORANGE RED', 'ORCHID', 'PALE GREEN', 'PINK', 'PLUM',
+					'PURPLE', 'RED, SALMON', 'SEA GREEN', 'SIENNA', 'SKY BLUE',
+					'SLATE BLUE', 'SPRING GREEN', 'STEEL BLUE', 'TAN', 'THISTLE',
+					'TURQUOISE', 'VIOLET', 'VIOLET RED', 'WHEAT', 'WHITE', 'YELLOW',
+					'YELLOW GREEN',
+				);
+				die "$r is an unknow color name, just know @clist";
+			}
+		}
+	}
+	die "not enough parmaters or bad format\n$usage" unless defined $b;
+	die "too much parmaters\n$usage" if defined $t;
+	die "red definition is outside of 0..255" unless int $r == $r && $r>=0 && $r<=255;
+	die "green definition is outside of 0..255" unless int $g == $g && $g>=0 && $g<=255;
+	die "blue definition is outside of 0..255" unless int $b == $b && $b>=0 && $b<=255;
+	return Wx::Colour->new($r, $g, $b);
+}
+
+sub keycode_from_event {
+	my $event = shift;
+	die __PACKAGE__ . '::keycode_from_event got no event, but: ' . $event
+		unless $event and $event->isa('Wx::Event');
+	$event->GetKeyCode + 1000 * 
+		( $event->ShiftDown
+		+ $event->ControlDown * 2 
+		+ $event->AltDown     * 4);
 }
 
 1;
 
 __END__
 
-    #my $normal_font = Wx::Font->new (
-        #12, 
-        #&Wx::wxFONTFAMILY_DEFAULT,
-        #&Wx::wxFONTSTYLE_NORMAL,
-        #&Wx::wxFONTWEIGHT_NORMAL,
-        #0,
-    #);
-    #my $highlight_font = Wx::Font->new (
-        #12, 
-        #&Wx::wxFONTFAMILY_TELETYPE,
-        #&Wx::wxFONTSTYLE_NORMAL,
-        #&Wx::wxFONTWEIGHT_BOLD,
-        #1,
-    #);
+	#my $normal_font = Wx::Font->new (
+		#12, 
+		#&Wx::wxFONTFAMILY_DEFAULT,
+		#&Wx::wxFONTSTYLE_NORMAL,
+		#&Wx::wxFONTWEIGHT_NORMAL,
+		#0,
+	#);
+	#my $highlight_font = Wx::Font->new (
+		#12, 
+		#&Wx::wxFONTFAMILY_TELETYPE,
+		#&Wx::wxFONTSTYLE_NORMAL,
+		#&Wx::wxFONTWEIGHT_BOLD,
+		#1,
+	#);