The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
use strict ;
use Win32 ;

package SmedPerl ;

Smed::AddCallBackCommand('GetToolTipInformation', 'SmedPerl::GetToolTipInformation()') ;

#Smed::RegisterPartialWordLookupClass("p_word") 
#Smed::AddLookupEntriesFromFile("p_word", "python\\python_partial_words.txt")  

Smed::RegisterWordLookupClass("perl_functions") ;
Smed::AddLookupEntriesFromFile("perl_functions", "perl\\db\\perl_functions.pl") ;
Smed::AddLookupEntriesFromFile("perl_functions", "perl\\db\\module_functions.pl") ;

Smed::AddCommand('C00SPACE', 'SmedPerl::CommandCompletion()') ;
Smed::AddCommand('CS0C', 'SmedPerl::FlipComment()') ;
Smed::AddCommand('CS0D', 'SmedPerl::DuplicateAndComment()') ;
Smed::AddCommand('C00C', 'SmedPerl::CommentAndCopy()') ;
Smed::AddCommand('CS0W', 'SmedPerl::DisplayAllPerlIdentifiers()') ;

Smed::AddCommand('C0AM', 'SmedPerl::MakeFileReadWrite()') ;

AddSkeleton() ;
LoadIdentifiersForCompletion() ;

#-------------------------------------------------------------------------------

sub MakeFileReadWrite
{
my $file_name = Smed::GetFileName() ;

use Fcntl ':mode';
chmod S_IRWXU|S_IRGRP|S_IXGRP|S_IROTH|S_IXOTH, $file_name ;
}

#-------------------------------------------------------------------------------

sub AddSkeleton
{
if($Smed::DOCUMENT_LOADED == Smed::WaitForDocumentToLoad(2000))
	{
	my $first_line = Smed::GetLineText(0) ;
	
	if(1 == Smed::GetNumberOfLines()&& 0 == length($first_line))
		{
		Smed::InsertAligned(<<'SKELETON') ;
# Nadim Khemir
#

use strict ;
use warnings ;

while(<>)
	{
	if(//)
		{
		print qq[\n] ;
		}
	else
		{
		}

	#print qq[\n] ;
	}

SKELETON

		Smed::SetModificationLine(2) ;
		Smed::SetModificationPosition(7) ;
		}
	}
else
	{
	print "Timed out !\n"
	}
}

#-------------------------------------------------------------------------------

sub GetToolTipInformation
{
my $current_word = Smed::GetCurrentWord() ;

if($current_word ne '')
	{
	my $word_list = Smed::GetLookupList("perl_functions", $current_word) ;
	$word_list =~ s/\ smed_separator\ //g ;
	
	if(length($word_list) != 0)
		{
		Smed::SetToolTipText($word_list) ;
		Smed::SetToolTipTextColor( 0, 0, 0) ;
		Smed::SetToolTipBackgroundColor( 255, 245, 238) ;
		}
	else
		{
		#display line and character insex in tooltip
		my $line = Smed::GetModificationLine() ;
		my $character = Smed::GetDisplayPosition($line, Smed::GetModificationPosition()) ;
		
		# adjust start index as lines are number from 1
		$line++ ;
		$character++ ;

		Smed::SetToolTipText("$line, $character") ;
		Smed::SetToolTipTextColor( 150, 150, 150) ;
		Smed::SetToolTipBackgroundColor( 235, 235, 235) ;
		}
	}
}

#-------------------------------------------------------------------------------

sub DuplicateAndComment
{
my $position = Smed::GetModificationPosition() ;
my @lines ;

my ($selection_start_line, $selection_end_line) = (0, 0) ;

if(0 == Smed::IsSelectionEmpty())
	{
	# save selection limits
	$selection_start_line = Smed::GetSelectionStartLine() ;
	$selection_end_line   = Smed::GetSelectionEndLine() ;
	
	if( 0 == Smed::GetSelectionEndCharacter())
		{
		$selection_end_line = $selection_end_line - 1 ;
		}

	# deselect
	Smed::ClearSelection() ;
	}
else
	{
	$selection_start_line = Smed::GetModificationLine() ;
	$selection_end_line = $selection_start_line ;
	}	

for(my $line_index = $selection_start_line ; $line_index <= $selection_end_line  ; $line_index++)
	{
	Smed::SetModificationLine($line_index) ;
	
	my $current_line_text = Smed::GetLineText($line_index) ;
	push @lines, $current_line_text ;
	
   next if $current_line_text =~ /^\s*$/ ; #ignore blank lines
   
	if($current_line_text =~ /^(\s*)\#~ /)
		{
		# uncomment
		Smed::SetModificationPosition(length($1)) ;
		Smed::Delete(3) ;
		}
	else
		{
		$current_line_text =~ /^(\s*)/ ;
		
		Smed::SetModificationPosition(length($1)) ; 
		Smed::Insert('#~ ') ;
		}
	}
	
Smed::SetModificationLine($selection_end_line) ;
Smed::MoveToEndOfLine() ;
Smed::Insert("\n" . join("\n", @lines)) ;
Smed::SetModificationPosition($position) ;
}

sub FlipComment
{
my ($selection_start_line, $selection_end_line) = (0, 0) ;

if(0 == Smed::IsSelectionEmpty())
	{
	# save selection limits
	$selection_start_line = Smed::GetSelectionStartLine() ;
	$selection_end_line = Smed::GetSelectionEndLine() ;
	
	if( 0 == Smed::GetSelectionEndCharacter())
		{
		$selection_end_line = $selection_end_line - 1 ;
		}

	# deselect
	Smed::ClearSelection() ;
	}
else
	{
	$selection_start_line = Smed::GetModificationLine() ;
	$selection_end_line = $selection_start_line ;
	}	

for(my $line_index = $selection_start_line ; $line_index <= $selection_end_line  ; $line_index++)
	{
	Smed::SetModificationLine($line_index) ;
	
	my $current_line_text = Smed::GetLineText($line_index) ;
   next if $current_line_text =~ /^\s*$/ ; #ignore blank lines
   
	if($current_line_text =~ /^(\s*)\#~ /)
		{
		# uncomment
		Smed::SetModificationPosition(length($1)) ;
		Smed::Delete(3) ;
		}
	else
		{
		$current_line_text =~ /^(\s*)/ ;
		
		Smed::SetModificationPosition(length($1)) ; 
		Smed::Insert('#~ ') ;
		}
	}

}

#-------------------------------------------------------------------------------
=comment
sub CommentAndCopy
{
my $current_position = Smed::GetModificationPosition() ; 
my ($selection_start_line, $selection_end_line) = (0, 0) ;

if(0 == Smed::IsSelectionEmpty())
	{
	Smed::SetSelectionAnchor(Smed::GetSelectionStartLine(), 0) ;
	
	# save selection limits
	$selection_start_line = Smed::GetSelectionStartLine() ;
	$selection_end_line = Smed::GetSelectionEndLine() ;
	
	if( 0 == Smed::GetSelectionEndCharacter())
		{
		$selection_end_line = $selection_end_line - 1 ;
		}

	# deselect
	Smed::ClearSelection() ;
	}
else
	{
	$selection_start_line = Smed::GetModificationLine() ;
	$selection_end_line = $selection_start_line ;
	}	
	

Smed:CopySelectionToClipboard_4
FlipComment() ;
goto end of selection
new line
Smed:InsertClipboardContents_4
place cursor
}
=cut

#-------------------------------------------------------------------------------

sub DisplayAllPerlIdentifiers
{
my @filter = shift || ('a' .. 'z', 'A' .. 'Z') ;

my $scalar_list ;
my $array_list ;
my $hash_list ;
my $bareword_list ;

for (@filter)
	{
	$scalar_list .= join ', ', sort split / smed_separator /, Smed::GetLookupList("identifiers", "\$$_") ;
	$scalar_list .= ', ' ;
	
	$array_list .= join ', ', sort split / smed_separator /, Smed::GetLookupList("identifiers", "\@$_") ;
	$array_list .= ', ' ;
	
	$hash_list .= join ', ', sort split / smed_separator /, Smed::GetLookupList("identifiers", "\%$_") ;
	$hash_list .= ', ' ;
	
	$bareword_list .= join ', ', sort split / smed_separator /, Smed::GetLookupList("identifiers", "$_") ;
	$bareword_list .= ', ' ;
	}
	
my $all_list = "$scalar_list\n\n$array_list\n\n$hash_list\n\n$bareword_list" ;
$all_list =~ s/, [, ]+/, /g ;
$all_list =~ s/\n, /\n/g ;
$all_list =~ s/, \n/\n/g ;
$all_list =~ s/\n{4}/\n\n/g ;
	
Win32::MsgBox($all_list, Win32::MB_ICONINFORMATION, "Identifiers") ;
}

#-------------------------------------------------------------------------------

sub LoadIdentifiersForCompletion
{
LoadPerlFunctionForCompletion() ;
LoadWxClassesAndMembersForCompletion() ;

if(Smed::GetFileName() =~ /\.spl/)
	{
	Smed::RegisterPartialWordLookupClass("global_identifiers") ;
	Smed::AddLookupEntriesFromFile("global_identifiers", "core\\db\\smed_identifiers.pl") ;
	}
#else
	# nothing to load

}

#-------------------------------------------------------------------------------

sub LoadPerlFunctionForCompletion
{
Smed::RegisterPartialWordLookupClass("global_identifiers") ;
Smed::AddLookupEntriesFromFile("global_identifiers", "perl\\db\\perl_identifiers.pl") ;
}

#-------------------------------------------------------------------------------

sub LoadWxClassesAndMembersForCompletion
{
Smed::RegisterPartialWordLookupClass("global_identifiers") ;
Smed::AddLookupEntriesFromFile("global_identifiers", "common\\wxWindows\\wx_keywords.lup") ;
}

#-------------------------------------------------------------------------------

1 ;