Commits

Herbert Breunung  committed 13ba05f

new commandlist API not complete but actually works and has lot of sane checks

  • Participants
  • Parent commits 6dc3725

Comments (0)

Files changed (7)

File lib/Kephra.pm

 
 package Kephra;
 our $NAME     = __PACKAGE__;    # name of entire application
-our $VERSION  = '0.4.5.6';      # version of ..
+our $VERSION  = '0.4.5.7';      # version of ..
 
 our @external_dependencies = (
 	qw/Benchmark Encode Encode::Guess Cwd/,

File lib/Kephra/API.pm

 use Kephra::CommandList;
 use Kephra::DocumentStash;
 
-Kephra::CommandList::register_object_switch_var({
-	'$app'    => 'app()',
-	'$doc'    => 'document()',
-	'$docbar' => 'docbar()',
-	'$editor' => 'editor()',
+Kephra::CommandList::register_switch_var({
+	'$app'    => 'app',
+	'$doc'    => 'document',
+	'$docbar' => 'docbar',
+	'$editor' => 'editor',
 });
 
 sub app             { $Kephra::App::_ref }

File lib/Kephra/App.pm

 our $_ref;
 
 Kephra::CommandList::register_cmd({
-	'app-close-save' => 
-		{ sub => 'Kephra::API::app()->close_save()', label => 'Exit', keys  => 'Alt + Q',
-		 help => ''},
+	'app-close-save' => {
+		sub => 'Kephra::API::app()->close_save()',
+		label => 'Exit', keys  => 'Alt + Q',
+		help => ''},
 });
 
 sub OnInit {

File lib/Kephra/App/Bar/Document.pm

 package Kephra::App::Bar::Document;
 our @ISA = 'Wx::AuiNotebook';
 
-Kephra::CommandList::register_cmd_namespace('app-docbar');
-Kephra::CommandList::register_object_switch_var('Kepra::API::active_docbar()');
+Kephra::CommandList::register_cmd_namespace('doc');
+Kephra::CommandList::register_switch_var('Kepra::API::docbar');
 Kephra::CommandList::register_cmd({
-	'doc-select-left'=> { sub => '$_->select_page_left()', label => 'Previous Tab',
+	'-select-left'    => { sub => '$_->select_page_left()', label => 'Previous Tab',
 						help => ''},
-	'doc-select-right' => { sub => '$_->select_page_right()', label => 'Next Tab',
+	'-select-right'   => { sub => '$_->select_page_right()', label => 'Next Tab',
+						help => ''},
+	'-select-leftmost'=> { sub => '$_->select_page_leftmost()', label => 'First Tab',
+						help => ''},
+	'-select-rightmost' => { sub => '$_->select_page_rightmost()', label => 'Last Tab',
+						help => ''},
+	'-move-left'      => { sub => '$_->move_page_left()', label => 'Move Left',
+						help => ''},
+	'-move-right'     => { sub => '$_->move_page_right()', label => 'Move Right',
+						help => ''},
+	'-move-leftmost'  => { sub => '$_->move_page_leftmost()', label => 'Move Leftmost',
+						help => ''},
+	'-move-rightmost' => { sub => '$_->move_page_rightmost()', label => 'Move Rightmost',
 						help => ''},
 });
 

File lib/Kephra/App/Keymap.pm

 
 package Kephra::App::Keymap;
 
-my %map;
+my %data;
+my %compiled;
 
 sub apply {}
 sub build {}
 sub copy {}
 
+sub overlay {}
+
 1;

File lib/Kephra/CommandList.pm

 use strict;
 use warnings;
+use Kephra::Config::Default;
 use Kephra::Log;
 
 package Kephra::CommandList;
 
-my %list;
+
+my %list = %{ Kephra::Config::Default::commandlist() };
 my %namespace;
-my %object_alias;
+my %switch     = ( 'name' => {}, 'package' => {} );
+
 
 # register means: to be called before init-on compile/module block execution time
-sub register_object_switch_var {
-	return unless $_[0] and ref $_[0] eq ref {};
-	my %alias = %{$_[0]};
-	for my $var ( keys %alias ){
+sub register_switch_var {
+	my $var = shift;
+	my $calling_module = (caller)[0];
+	if (ref $var eq ref {}){
+		no strict 'refs';
+		#return Kephra::Log::error #("register_object_switch_var: $- already registered as ".$switch{'name'}{$_}) #if exists $switch{'name'}{$_};
+		for my $name (keys %$var){
+			$var->{$name} = $calling_module . '::' . $var->{$name}
+				if index($var->{$name}, '::') == -1 and $calling_module;
+			$switch{'name'}{$name} = $var->{$name}
+				if $var->{$name} and defined &{ $var->{$name} };
+		}
+	}
+	elsif (not ref $var and $var) {
+		$var = "$calling_module::" . $var if index($var, '::') == -1;
+		$switch{'package'}{$calling_module} = $var 
+	}
+	else {
 		return Kephra::Log::error
-			("register_object_switch_var: $var already registered as ".$object_alias{$var})
-				if exists $object_alias{$var};
-		my $switch = $alias{$var};
-		$switch = (caller)[0] . '::' . $switch if index($switch, '::') == -1;
-		$object_alias{$var} = $switch;
+			("register_switch_var: need a sub name string or of a var => sub hash");
 	}
 }
 sub register_cmd_namespace {
+	my $name = shift;
+	my $calling_module = (caller)[0];
 	return Kephra::Log::error
-		("register_cmd_namespace: called without value from ". (caller)[0] )
-			unless $_[0];
-	$namespace{ (caller)[0] } = $_[0];
+		("register_cmd_namespace: called without value from $calling_module") unless $name;
+	$namespace{ $calling_module } = $name;
 }
 sub register_cmd {
 	my $cmd = shift;
-	return Kephra::Log::warning( 'register_cmd: "$cmd" has to be a hash ref')
-			unless ref $cmd eq ref {};
+	return Kephra::Log::error( 'register_cmd: "$cmd" has to be a hash ref')
+		unless ref $cmd eq ref {};
 	my $calling_module = (caller)[0];
+	my $cmd_namespace = $namespace{ $calling_module } ; 
 	for my $ID (keys %$cmd) {
+		my $fullID = substr($ID,0,1) eq '-' ? $cmd_namespace . $ID : $ID ;
+		Kephra::Log::warning
+			( "register_cmd: $cmd lacks command namespace to prefix"), next
+				if $fullID ne $ID and not $cmd_namespace;
 		Kephra::Log::warning( "register_cmd: $cmd already registered to do " .
-			cmd_property($ID, 'sub') . " by " .
-			cmd_property($ID, 'source')  ), next
-				if cmd_exists( $ID );
-		#for (qw/sub options state event label help keys icon/){} filter input
-		$list{$ID}           = $cmd->{$ID};
-		$list{$ID}{'source'} = $calling_module;
+			cmd_property($fullID, 'sub') . " by " .
+			cmd_property($fullID, 'source')  ), next
+				if cmd_exists( $fullID );
+		#for (qw/sub options state event label help keys icon/){} filter input later
+		$list{$fullID}           = $cmd->{$ID};
+		$list{$fullID}{'source'} = $calling_module;
 	}
 }
 
 sub init {
-	%list = %{ Kephra::Config::Default::commandlist() };
-	for (values %list){
-		$_->{'coderef'} = $_->{'sub'};
-		$_->{'coderef'} = $_{'source'} . $_->{'coderef'}
-			if substr($_->{'sub'},0,2 eq '::');
-		$_->{'coderef'} = eval 'sub {'. $_->{'coderef'}.'}';
+	#%list = %{ Kephra::Config::Default::commandlist() };
+	for my $cmd (keys %list) {
+		my $data = $list{$cmd};
+		my $call = $data->{'sub'};
+		Kephra::Log::warning( "init: $cmd lacks sub value"), next unless $call;
+		if (substr($call, 0, 1) eq '$'){
+			if (substr($call, 1, 1) eq '_'){
+				Kephra::Log::warning
+					( "init: $cmd lacks switch declared by ".$data->{'source'}), next
+						unless $switch{'package'}{ $data->{'source'} };
+				$call = $switch{'package'}{ $data->{'source'} }.'()'.substr($call, 2);
+			}
+			else {
+				my $vl = index($call,'->');
+				$call = $switch{'name'}{ substr($call, 0, $vl) }.'()'.
+						substr($call, $vl) ;
+			}
+		}
+		else {
+			$call = $data->{'source'}.'::'.$call if index($call,'::') == -1;
+		}
+print $cmd," $call \n";
+		$data->{'coderef'} = eval "sub { $call }";
 	}
 }
-sub prepare_cmd {}
+sub compile_cmd {}
 
 sub call {
 	my $cmd = shift;
 	$cmd = [$cmd] unless ref $cmd eq ref [];
-	for (@$cmd) { $list{$_}{'callref'}->() if exists $list{$_} }
+	for (@$cmd) { $list{$_}{'coderef'}->() if exists $list{$_} }
 }
 
 sub cmd_exists          { 1 if defined $_[0]     and exists $list{ $_[0] }          }
 __END__
 
 cmd_ID => {
-	coderef   => # compiled function with maybe one option
+	coderef   => compiled from sub, source and option, saves state
 	sub       => 'Kephra::File::new',
 	options   => [],
-	source    => # module file where function is located
-	state     => '',
+	source    => package that registered that cmd
+	state     => return value of the call or antother coderef
 	event     => '',
 	label     => 'New',
 	help      => '',

File lib/Kephra/Config/Default/CommandList.pm

 			keys  => 'Ctrl + Q',
 			icon  => '',
 		},
-		'app-close-save' => {
-			sub   => 'Kephra::App::close_save',
-			label => 'Exit',
-			help  => '',
-			keys  => 'Alt + Q',
-			icon  => '',
-		},
-		'edit-select-all' => {
-			sub   => '',
-			label => 'Select All',
-			help  => '',
-			keys  => 'Ctrl + A',
-		},
-		'edit-select-block' => {
-			sub   => '',
-			label => '',
-			help  => '',
-			keys  => '',
-		},
-		'edit-select-block-up' => {
-			sub   => '',
-			label => '',
-			help  => '',
-			keys  => '',
-		},
-		'edit-select-block-down' => {
-			sub   => '',
-			label => '',
-			help  => '',
-			keys  => '',
-		},
+		#'app-close-save' => {
+			#label => 'Exit',
+			#help  => '',
+			#keys  => 'Alt + Q',
+			#icon  => '',
+		#},
 		'document-select-leftmost' => {
 			sub   => 'Kephra::App::Panel::Editor::select_tab_leftmost',
 			label => '',