#! perl -w use strict; use warnings; use File::Basename; use File::Path; # $Id: Scintilla.PL,v 1.5 2006/10/15 14:07:46 robertemay Exp $ my $iface_file = "Include/Scintilla.iface"; # MakeMaker provides the output filename as the first argument on the # command line, we need to ensure the directory exists before opening # the file: if ( @ARGV > 0 ) { my $file = $ARGV[0]; my $path = dirname($file); unless (-d $path) { mkpath($path, 1) or die qq(Failed to create '$path': $!); } open(my $fh, '>', $file) or die qq(Failed to open '$file': $!); select $fh; } # Preamble # Was scintilla.pm.begin print <<'PREAMBLE'; #------------------------------------------------------------------------ # Scintilla control for Win32::GUI # by Laurent ROCHER (lrocher@cpan.org) #------------------------------------------------------------------------ #perl2exe_bundle 'SciLexer.dll' # This file created by the build process from Scintilla.PL # change made here will be lost. Edit Scintilla.PL instead. # $Id: Scintilla.PL,v 1.5 2006/10/15 14:07:46 robertemay Exp $ package Win32::GUI::Scintilla; use strict; use warnings; use Win32::GUI qw(WS_CLIPCHILDREN WS_TABSTOP WS_VISIBLE WS_HSCROLL WS_VSCROLL); require DynaLoader; our @ISA = qw(DynaLoader Win32::GUI::Window); our $VERSION = "1.90"; our $XS_VERSION = $VERSION; $VERSION = eval $VERSION; bootstrap Win32::GUI::Scintilla $XS_VERSION; #------------------------------------------------------------------------ # Load Scintilla DLL from somewhere on @INC or standard LoadLibrary search my ($SCILEXER_FILE,$SCILEXER_DLL); for my $path (@INC) { my $lexer_file = $path . '/auto/Win32/GUI/Scintilla/SciLexer.dll'; if (-f $lexer_file) { $SCILEXER_FILE = $lexer_file; last; } } if ($SCILEXER_FILE) { $SCILEXER_DLL = Win32::GUI::LoadLibrary($SCILEXER_FILE); warn qq(Failed to load SciLexer.dll from "$SCILEXER_FILE") unless $SCILEXER_DLL; } unless ($SCILEXER_DLL) { warn qq(Final attempt to find SciLexer.dll in PATH); $SCILEXER_DLL = Win32::GUI::LoadLibrary('SciLexer'); } die qq(Failed to load 'SciLexer.dll') unless $SCILEXER_DLL; Win32::GUI::Scintilla::_Initialise(); END { # Free Scintilla DLL Win32::GUI::Scintilla::_UnInitialise(); #Win32::GUI::FreeLibrary($SCILEXER_DLL); #The above line causes some scripts to crash - such as test2.pl in the samples when running under 5.8.7 } #------------------------------------------------------------------------ # # Notify event code # use constant SCN_STYLENEEDED => 2000; use constant SCN_CHARADDED => 2001; use constant SCN_SAVEPOINTREACHED => 2002; use constant SCN_SAVEPOINTLEFT => 2003; use constant SCN_MODIFYATTEMPTRO => 2004; use constant SCN_KEY => 2005; use constant SCN_DOUBLECLICK => 2006; use constant SCN_UPDATEUI => 2007; use constant SCN_MODIFIED => 2008; use constant SCN_MACRORECORD => 2009; use constant SCN_MARGINCLICK => 2010; use constant SCN_NEEDSHOWN => 2011; use constant SCN_PAINTED => 2013; use constant SCN_USERLISTSELECTION => 2014; use constant SCN_URIDROPPED => 2015; use constant SCN_DWELLSTART => 2016; use constant SCN_DWELLEND => 2017; use constant SCN_ZOOM => 2018; use constant SCN_HOTSPOTCLICK => 2019; use constant SCN_HOTSPOTDOUBLECLICK => 2020; use constant SCN_CALLTIPCLICK => 2021; #------------------------------------------------------------------------ # # New scintilla control # sub new { my $class = shift; my (%in) = @_; my %out; ### Filtering option for my $option qw( -name -parent -left -top -width -height -pos -size -pushstyle -addstyle -popstyle -remstyle -notstyle -negstyle -exstyle -pushexstyle -addexstyle -popexstyle -remexstyle -notexstyle ) { $out{$option} = $in{$option} if exists $in{$option}; } ### Default window my $constant = ($Win32::GUI::VERSION < 1.0303 ? Win32::GUI::constant("WIN32__GUI__STATIC",0) : Win32::GUI::_constant("WIN32__GUI__STATIC")); $out{-addstyle} = WS_CLIPCHILDREN; $out{-class} = "Scintilla"; ### Window style $out{-addstyle} |= WS_TABSTOP unless exists $in{-tabstop} && $in{-tabstop} == 0; #Default to -tabstop => 1 $out{-addstyle} |= WS_VISIBLE unless exists $in{-visible} && $in{-visible} == 0; #Default to -visible => 1 $out{-addstyle} |= WS_HSCROLL if exists $in{-hscroll} && $in{-hscroll} == 1; $out{-addstyle} |= WS_VSCROLL if exists $in{-vscroll} && $in{-vscroll} == 1; my $self = Win32::GUI->_new($constant, $class, -remstyle => 0xFFFFFFFF, %out); if (defined ($self)) { # Option Text : $self->SetText($in{-text}) if exists $in{-text}; $self->SetReadOnly($in{-readonly}) if exists $in{-readonly}; } return $self; } # # Win32 shortcut # sub Win32::GUI::Window::AddScintilla { my $parent = shift; return Win32::GUI::Scintilla->new (-parent => $parent, @_); } #------------------------------------------------------------------------ # Miscolous function #------------------------------------------------------------------------ # # Clear Scintilla Text # sub NewFile { my $self = shift; $self->ClearAll(); $self->EmptyUndoBuffer(); $self->SetSavePoint(); } # # Load text file to Scintilla # sub LoadFile { my ($self, $file) = @_; $self->ClearAll(); $self->Cancel(); $self->SetUndoCollection(0); open F, "<$file" or return 0; while ( ) { $self->AppendText($_); } close F; $self->SetUndoCollection(1); $self->EmptyUndoBuffer(); $self->SetSavePoint(); $self->GotoPos(0); return 1; } # # Save Scintilla text to file # sub SaveFile { my ($self, $file) = @_; open F, ">$file" or return 0; for my $i (0..$self->GetLineCount()) { print F $self->GetLine ($i); } close F; $self->SetSavePoint(); return 1; } # # Help routine for StyleSet # sub StyleSetSpec { my ($self, $style, $textstyle) = @_; foreach my $prop (split (/,/, $textstyle)) { my ($key, $value) = split (/:/, $prop); $self->StyleSetFore($style, $value) if $key eq 'fore'; $self->StyleSetBack($style, $value) if $key eq 'back'; $self->StyleSetFont($style, $value) if $key eq 'face'; $self->StyleSetSize($style, int ($value) ) if $key eq 'size'; $self->StyleSetBold($style, 1) if $key eq 'bold'; $self->StyleSetBold($style, 0) if $key eq 'notbold'; $self->StyleSetItalic($style, 1) if $key eq 'italic'; $self->StyleSetItalic($style, 0) if $key eq 'notitalic'; $self->StyleSetUnderline($style, 1) if $key eq 'underline'; $self->StyleSetUnderline($style, 0) if $key eq 'notunderline'; $self->StyleSetEOLFilled ($style, 1) if $key eq 'eolfilled'; $self->StyleSetEOLFilled ($style, 0) if $key eq 'noteolfilled'; } } #------------------------------------------------------------------------ # Begin Autogenerate #------------------------------------------------------------------------ PREAMBLE # Autogenerate the contents from Include\Scintilla.iface # Build Scintilla interface open my $fh, "<" , $iface_file or die "Failed to open '$iface_file' for reading: $!"; while ( <$fh> ) { #chomp; s/\r?\n$//; # throw away line endings - chomp on cygwin only removes '\n' # done this way in case dos2unix didn't get run on this file # - Scintilla.iface probably didn't get dealt with as a text file? #--- Constant --- if (/^val (.*)=(.*)$/) { print "use constant $1 => $2 ;\n"; } #--- Get --- elsif (/^get colour (.*)=(.*)\(,\)$/ ) { print "sub $1 {\n my \$self = shift;\n my \$colour = \$self->SendMessage ($2, 0, 0);\n \$colour = sprintf ('#%x', \$colour);\n \$colour =~ s/(.)(..)(..)(..)/\$1\$4\$3\$2/;\n return \$colour;\n}\n"; } elsif (/^get colour (.*)=(.*)\(int (.*),\)$/ ) { print "sub $1 {\n my (\$self, \$$3) = \@_;\n my \$colour = \$self->SendMessage ($2, \$$3, 0);\n \$colour = sprintf ('#%x', \$colour);\n \$colour =~ s/(.)(..)(..)(..)/\$1\$4\$3\$2/;\n return \$colour;\n}"; } elsif (/^get (.*) (.*)=(.*)\(,\)$/ ) { print "sub $2 {\n my \$self = shift;\n return \$self->SendMessage ($3, 0, 0);\n}\n"; } elsif (/^get int GetCharAt=2007\(position pos,\)$/ ) { print "sub GetCharAt {\n my (\$self, \$pos) = \@_;\n return chr \$self->SendMessage (2007, \$pos, 0);\n}\n"; } elsif (/^get int GetPropertyInt=4010\(string key,\)$/ ) { print "sub GetPropertyInt {\n my (\$self, \$key) = \@_;\n return \$self->SendMessagePP (4010, \$key, '');\n}\n"; } elsif (/^get (.*) (.*)=(.*)\(position (.*),\)$/ ) { print "sub $2 {\n my (\$self, \$$4) = \@_;\n return \$self->SendMessage ($3, \$$4, 0);\n}\n"; } elsif (/^get (.*) (.*)=(.*)\(int (.*),\)$/ ) { print "sub $2 {\n my (\$self, \$$4) = \@_;\n return \$self->SendMessage ($3, \$$4, 0);\n}\n"; } elsif (/^get (.*) (.*)=(.*)\(int (.*), int (.*)\)$/ ) { print "sub $2 {\n my (\$self, \$$4, \$$5) = \@_;\n return \$self->SendMessage ($3, \$$4, \$$5);\n}\n"; } #--- Set --- elsif (/^set (.*) (.*)=(.*)\(,\)$/ ) { print "sub $2 {\n my \$self = shift;\n return \$self->SendMessage ($3, 0, 0);\n}\n"; } elsif (/^set (.*) (.*)=(.*)\(bool (.*),\)$/ ) { print "sub $2 {\n my (\$self, \$$4) = \@_;\n return \$self->SendMessage ($3, \$$4, 0);\n}\n"; } elsif (/^set (.*) (.*)=(.*)\(int (.*),\)$/ ) { print "sub $2 {\n my (\$self, \$$4) = \@_;\n return \$self->SendMessage ($3, \$$4, 0);\n}\n"; } elsif (/^set (.*) (.*)=(.*)\(position (.*),\)$/ ) { print "sub $2 {\n my (\$self, \$$4) = \@_;\n return \$self->SendMessage ($3, \$$4, 0);\n}\n"; } elsif (/^set (.*) (.*)=(.*)\(colour (.*),\)$/ ) { print "sub $2 {\n my (\$self, \$$4) = \@_;\n \$$4 =~ s/.(..)(..)(..)/\$3\$2\$1/;\n return \$self->SendMessage ($3, int hex \$$4, 0);\n}\n"; } elsif (/^set (.*) (.*)=(.*)\(int (.*), int (.*)\)$/ ) { print "sub $2 {\n my (\$self, \$$4, \$$5) = \@_;\n return \$self->SendMessage ($3, \$$4, \$$5);\n}\n"; } elsif (/^set (.*) (.*)=(.*)\(int (.*), bool (.*)\)$/ ) { print "sub $2 {\n my (\$self, \$$4, \$$5) = \@_;\n return \$self->SendMessage ($3, \$$4, \$$5);\n}\n"; } elsif (/^set (.*) (.*)=(.*)\(bool (.*), colour (.*)\)$/ ) { print "sub $2 {\n my (\$self, \$$4, \$$5) = \@_;\n \$$5 =~ s/.(..)(..)(..)/\$3\$2\$1/;\n return \$self->SendMessage ($3, \$$4, int hex \$$5);\n}\n"; } elsif (/^set (.*) (.*)=(.*)\(int (.*), colour (.*)\)$/ ) { print "sub $2 {\n my (\$self, \$$4, \$$5) = \@_;\n \$$5 =~ s/.(..)(..)(..)/\$3\$2\$1/;\n return \$self->SendMessage ($3, \$$4, int hex \$$5);\n}\n"; } elsif (/^set (.*) (.*)=(.*)\(int (.*), string (.*)\)$/ ) { print "sub $2 {\n my (\$self, \$$4, \$$5) = \@_;\n return \$self->SendMessageNP ($3, \$$4, \$$5);\n}\n"; } elsif (/^set (.*) (.*)=(.*)\(string (.*), string (.*)\)$/ ) { print "sub $2 {\n my (\$self, \$$4, \$$5) = \@_;\n return \$self->SendMessagePP ($3, \$$4, \$$5);\n}\n"; } elsif (/^set (.*) (.*)=(.*)\(, string (.*)\)$/ ) { print "sub $2 {\n my (\$self, \$$4) = \@_;\n return \$self->SendMessageNP ($3, 0, \$$4);\n}\n"; } elsif (/^set (.*) (.*)=(.*)\(,\s?int (.*)\)$/ ) { print "sub $2 {\n my (\$self, \$$4) = \@_;\n return \$self->SendMessage ($3, 0, \$$4);\n}\n"; } #--- Special Function --- # AddText, ReplaceTarget, ReplaceTargetRE, SearchInTarget, AppendText, CopyText elsif (/^fun (.*) (.*)=(.*)\(int length, string text\)$/ ) { print "# $2(text)\n"; print "sub $2 {\n"; print ' my ($self, $text) = @_;', "\n"; print ' my $length = length $text;', "\n"; print " return \$self->SendMessageNP ($3, \$length, \$text);\n"; print '}', "\n"; } # AddStyledText elsif (/^fun void AddStyledText=2002\(int length, cells c\)$/ ) { print '# AddStyledText(styledtext)', "\n"; print 'sub AddStyledText {', "\n"; print ' my ($self, $text) = @_;', "\n"; print ' my $length = length $text;', "\n"; print ' return $self->SendMessageNP (2002, $length, $text);', "\n"; print '}', "\n"; } # GetStyledText and GetTextRange elsif (/^fun (.*) (.*)=(.*)\(, textrange (.*)\)$/ ) { print "sub $2 {\n my \$self = shift;\n my \$start = shift || 0;\n my \$end = shift || \$self->GetLength();\n\n"; print " return undef if \$start >= \$end;\n\n"; if ( $2 eq 'GetStyledText') { print " my \$text = \" \" x ((\$end - \$start + 1)*2);\n"; } else { print " my \$text = \" \" x (\$end - \$start + 1);\n"; } print " my \$textrange = pack(\"LLp\", \$start, \$end, \$text);\n"; print " \$self->SendMessageNP ($3, 0, \$textrange);\n"; print " return \$text;\n}\n"; } # GetCurLine elsif (/^fun int GetCurLine=2027\(int length, stringresult text\)$/) { print '# GetCurline () : Return curent line Text', "\n"; print 'sub GetCurLine {', "\n"; print ' my ($self) = @_;',"\n"; print ' my $line = $self->GetLineFromPosition ($self->GetCurrentPos());',"\n"; print ' my $lenght = $self->LineLength($line);',"\n"; print ' my $text = " " x ($lenght+1);',"\n\n"; print ' if ($self->SendMessageNP (2027, $lenght, $text)) {',"\n"; print ' return $text;',"\n"; print ' } else {',"\n"; print ' return undef;',"\n"; print ' }',"\n"; print '}',"\n"; } # GetLine elsif (/^fun int GetLine=2153\(int line, stringresult text\)/) { print '# Getline (line)', "\n"; print 'sub GetLine {', "\n"; print ' my ($self, $line) = @_;', "\n"; print ' my $lenght = $self->LineLength($line);', "\n"; print ' my $text = " " x ($lenght + 1);', "\n\n"; print ' if ($self->SendMessageNP (2153, $line, $text)) {', "\n"; print ' return $text;', "\n"; print ' } else {', "\n"; print ' return undef;', "\n"; print ' }', "\n"; print '}', "\n"; } # GetSelText elsif (/^fun int GetSelText=2161\(, stringresult text\)/) { print '# GetSelText() : Return selected text', "\n"; print 'sub GetSelText {', "\n"; print ' my $self = shift;', "\n"; print ' my $start = $self->GetSelectionStart();', "\n"; print ' my $end = $self->GetSelectionEnd();', "\n\n"; print ' return undef if $start >= $end;', "\n"; print ' my $text = " " x ($end - $start + 1);', "\n\n"; print ' $self->SendMessageNP (2161, 0, $text);', "\n"; print ' return $text;', "\n"; print '}', "\n"; } # TargetAsUTF8 elsif (/^fun int TargetAsUTF8=2447\(, stringresult s\)/) { print '# TargetAsUTF8() :', "\n"; print '# Returns the target converted to UTF8.',"\n"; print 'sub TargetAsUTF8 {', "\n"; print ' my $self = shift;', "\n"; print ' my $len = $self->SendMessage(2447,0,0);',"\n"; print ' my $text = " " x $len;', "\n\n"; print ' $self->SendMessageNP (2447, 0, $text);', "\n"; print ' return $text;', "\n"; print '}', "\n"; } # EncodeFromUTF8 elsif (/^fun int EncodedFromUTF8=2449\(string utf8, stringresult encoded\)/) { print '# EncodedFromUTF8() :', "\n"; print '# Translates a UTF8 string into the document encoding.',"\n"; print '# Return the length of the result in bytes.',"\n"; print '# On error return 0.',"\n"; print 'sub EncodedFromUTF8 {', "\n"; print ' my ($self, $src) = @_;', "\n"; print ' my $len = $self->SendMessagePN(2449,$src,0);',"\n"; print ' my $text = " " x $len;', "\n\n"; print ' if($self->SendMessagePP (2449, $src, $text)) {', "\n"; print ' return $text;', "\n"; print ' }', "\n"; print ' else {', "\n"; print ' return undef;', "\n"; print ' }', "\n"; print '}', "\n"; } # GetText : elsif (/^fun int GetText=2182\(int length, stringresult text\)/) { print '# GetText() : Return all text', "\n"; print 'sub GetText {', "\n"; print ' my $self = shift;', "\n"; print ' my $lenght = $self->GetTextLength() + 1;', "\n"; print ' my $text = " " x ($lenght+1);', "\n\n"; print ' if ($self->SendMessageNP (2182, $lenght, $text)) {', "\n"; print ' return $text;', "\n"; print ' } else {', "\n"; print ' return undef;', "\n"; print ' }', "\n"; print '}', "\n"; } # FindText : elsif (/^fun position FindText=2150\(int flags, findtext ft\)/) { print '# FindText (textToFind, start=0, end=GetLength(), flag = SCFIND_WHOLEWORD)', "\n"; print 'sub FindText {', "\n"; print ' my $self = shift;', "\n"; print ' my $text = shift;', "\n"; print ' my $start = shift || 0;', "\n"; print ' my $end = shift || $self->GetLength();', "\n"; print ' my $flag = shift || SCFIND_WHOLEWORD;', "\n\n"; print ' return undef if $start >= $end;', "\n\n"; print ' my $texttofind = pack("LLpLL", $start, $end, $text, 0, 0);', "\n"; print ' my $pos = $self->SendMessageNP (2150, $flag, $texttofind);', "\n"; print ' return $pos unless defined wantarray;', "\n"; print ' my @res = unpack("LLpLL", $texttofind);', "\n"; print ' return ($res[3], $res[4]); # pos , lenght', "\n"; print '}', "\n"; } # GetProperty and GetPropertyExpanded : elsif (/^fun int (.+)=(\d+)\(string key, stringresult buf\)/) { print '# GetProperty(): Retrieve a "property" value previously set with SetProperty.',"\n"; print '# GetPropertyExpanded() with "$()" variable replacement on returned buffer.',"\n"; print 'sub '.$1.' {', "\n"; print ' my ($self, $key) = @_;', "\n"; print ' my $len = $self->SendMessagePN('.$2.', $key, 0);', "\n"; print ' my $text = " " x $len;', "\n\n"; print ' $self->SendMessagePP ('.$2.', $key, $text);', "\n"; print ' return $text;', "\n"; print '}', "\n"; } # GetPropertyExpanded : elsif (/^fun int GetPropertyExpanded=4008\(string key, stringresult buf\)/) { print '# GetPropertyExpanded(): Retrieve a "property" value previously set with SetProperty.',"\n"; print 'sub GetProperty {', "\n"; print ' my ($self, $key) = @_;', "\n"; print ' my $len = $self->SendMessagePN(4008, $key, 0);', "\n"; print ' my $text = " " x $len;', "\n\n"; print ' $self->SendMessagePP (4008, $key, $text);', "\n"; print ' return $text;', "\n"; print '}', "\n"; } # FindRange : elsif (/^fun position FormatRange=2151\(bool draw, formatrange fr\)/) { print '# FormatRange (start=0, end=GetLength(), draw=1)', "\n"; print 'sub FormatRange {', "\n"; print ' my $self = shift;', "\n"; print ' my $start = shift || 0;', "\n"; print ' my $end = shift || $self->GetLength();', "\n"; print ' my $draw = shift || 1;', "\n"; print ' return undef if $start >= $end;', "\n\n"; print ' my $formatrange = pack("LL", $start, $end);', "\n"; print ' return $self->SendMessageNP (2151, $draw, $formatrange);', "\n"; print '}', "\n"; } #--- Function --- elsif (/^fun (.*) (.*)=(.*)\(,\)$/ ) { print "sub $2 {\n my \$self = shift;\n return \$self->SendMessage ($3, 0, 0);\n}\n"; } elsif (/^fun (.*) (.*)=(.*)\(bool (.*),\)$/ ) { print "sub $2 {\n my (\$self, \$$4) = \@_;\n return \$self->SendMessage ($3, \$$4, 0);\n}\n"; } elsif (/^fun (.*) (.*)=(.*)\(int (.*),\)$/ ) { print "sub $2 {\n my (\$self, \$$4) = \@_;\n return \$self->SendMessage ($3, \$$4, 0);\n}\n"; } elsif (/^fun (.*) (.*)=(.*)\(position (.*),\)$/ ) { print "sub $2 {\n my (\$self, \$$4) = \@_;\n return \$self->SendMessage ($3, \$$4, 0);\n}\n"; } elsif (/^fun (.*) (.*)=(.*)\(, position (.*)\)$/ ) { print "sub $2 {\n my (\$self, \$$4) = \@_;\n return \$self->SendMessage ($3, 0, \$$4);\n}\n"; } elsif (/^fun (.*) (.*)=(.*)\(int (.*), int (.*)\)$/ ) { print "sub $2 {\n my (\$self, \$$4, \$$5) = \@_;\n return \$self->SendMessage ($3, \$$4, \$$5);\n}\n"; } elsif (/^fun (.*) (.*)=(.*)\(int (.*), colour (.*)\)$/ ) { print "sub $2 {\n my (\$self, \$$4, \$$5) = \@_;\n \$$5 =~ s/.(..)(..)(..)/\$3\$2\$1/;\n return \$self->SendMessage ($3, \$$4, int hex \$$5);\n}\n"; } elsif (/^fun (.*) (.*)=(.*)\(int (.*), string (.*)\)$/ ) { print "sub $2 {\n my (\$self, \$$4, \$$5) = \@_;\n return \$self->SendMessageNP ($3, \$$4, \$$5);\n}\n"; } elsif (/^fun (.*) (.*)=(.*)\(, string (.*)\)$/ ) { print "sub $2 {\n my (\$self, \$$4) = \@_;\n return \$self->SendMessageNP ($3, 0, \$$4);\n}\n"; } elsif (/^fun (.*) (.*)=(.*)\(, int (.*)\)$/ ) { print "sub $2 {\n my (\$self, \$$4) = \@_;\n return \$self->SendMessage ($3, 0, \$$4);\n}\n"; } elsif (/^fun (.*) (.*)=(.*)\(position (.*), string (.*)\)$/ ) { print "sub $2 {\n my (\$self, \$$4, \$$5) = \@_;\n return \$self->SendMessageNP ($3, \$$4, \$$5);\n}\n"; } elsif (/^fun (.*) (.*)=(.*)\(position (.*), bool (.*)\)$/ ) { print "sub $2 {\n my (\$self, \$$4, \$$5) = \@_;\n return \$self->SendMessage ($3, \$$4, \$$5);\n}\n"; } elsif (/^fun (.*) (.*)=(.*)\(position (.*), int (.*)\)$/ ) { print "sub $2 {\n my (\$self, \$$4, \$$5) = \@_;\n return \$self->SendMessage ($3, \$$4, \$$5);\n}\n"; } elsif (/^fun (.*) (.*)=(.*)\(position (.*), position (.*)\)$/ ) { print "sub $2 {\n my (\$self, \$$4, \$$5) = \@_;\n return \$self->SendMessage ($3, \$$4, \$$5);\n}\n"; } elsif (/^fun (.*) (.*)=(.*)\(bool (.*), colour (.*)\)$/ ) { print "sub $2 {\n my (\$self, \$$4, \$$5) = \@_;\n \$$5 =~ s/.(..)(..)(..)/\$3\$2\$1/;\n return \$self->SendMessage ($3, \$$4, int hex \$$5);\n}\n"; } elsif (/^fun (.*) (.*)=(.*)\(int (.*), cells (.*)\)$/ ) { print "sub $2 {\n my (\$self, \$$4, \$$5) = \@_;\n return \$self->SendMessageNP ($3, \$$4, \$$5);\n}\n"; } elsif (/^fun (.*) (.*)=(.*)\(keymod (.*),\)$/ ) { print "sub $2 {\n my (\$self, \$key, \$modifiers) = \@_;\n"; print " my \$param = pack ('ss', \$key, \$modifiers);\n"; print " return \$self->SendMessage ($3, \$param, 0);\n}\n"; } elsif (/^fun (.*) (.*)=(.*)\(keymod (.*), int (.*)\)$/ ) { print "sub $2 {\n my (\$self, \$key, \$modifiers, \$$5) = \@_;\n"; print " my \$param = pack ('ss', \$key, \$modifiers);\n"; print " return \$self->SendMessage ($3, \$param, \$$5);\n}\n"; } #--- Comment --- elsif (/^\#\s(.*)$/) { print "# $1\n"; } elsif (/^lex (.*)$/) { print "# $1\n"; } #--- Error ---- elsif (/^fun (.*)$/) { print STDERR "===> Function = $1\n"; } elsif (/^set (.*)$/) { print STDERR "===> Set = $1\n"; } elsif (/^get (.*)$/) { print STDERR "===> Get = $1\n"; } } close $fh; # Add Postamble # was: scintilla.pm.end print <<'POSTAMBLE'; #------------------------------------------------------------------------ # End Autogenerate #------------------------------------------------------------------------ # Code Here because need constant #------------------------------------------------------------------------ # BraceHighEvent Management #------------------------------------------------------------------------ sub BraceHighEvent { my $self = shift; my $braces = shift || "[]{}()"; my $braceAtCaret = -1; my $braceOpposite = -1; my $caretPos = $self->GetCurrentPos(); if ($caretPos > 0) { my $charBefore = $self->GetCharAt($caretPos - 1); $braceAtCaret = $caretPos - 1 if (index ($braces, $charBefore) >= 0 ); } if ($braceAtCaret < 0) { my $charAfter = $self->GetCharAt($caretPos); my $styleAfter = $self->GetCharAt($caretPos); $braceAtCaret = $caretPos if (index ($braces, $charAfter) >= 0); } $braceOpposite = $self->BraceMatch($braceAtCaret) if ($braceAtCaret >= 0); if ($braceAtCaret != -1 and $braceOpposite == -1) { $self->BraceBadLight($braceAtCaret); } else { $self->BraceHighlight($braceAtCaret, $braceOpposite); } } #------------------------------------------------------------------------ # Folder Management #------------------------------------------------------------------------ # Folder Event call # If Shift and Control are pressed, open or close all folder # Otherwise # if shift is pressed, Toggle 1 level of current folder # else if control is pressed, expand all subfolder of current folder # else Toggle current folder sub FolderEvent { my $self = shift; my (%evt) = @_; if ($evt{-shift} and $evt{-control}) { $self->FolderAll(); } else { my $lineClicked = $self->LineFromPosition($evt{-position}); if ($self->GetFoldLevel($lineClicked) & Win32::GUI::Scintilla::SC_FOLDLEVELHEADERFLAG) { if ($evt{-shift}) { $self->SetFoldExpanded($lineClicked, 1); $self->FolderExpand($lineClicked, 1, 1, 1); } elsif ($evt{-control}) { if ($self->GetFoldExpanded($lineClicked)) { $self->SetFoldExpanded($lineClicked, 0); $self->FolderExpand($lineClicked, 0, 1, 0); } else { $self->SetFoldExpanded($lineClicked, 1); $self->FolderExpand($lineClicked, 1, 1, 100); } } else { $self->ToggleFold($lineClicked); } } } } # Open All Folder sub FolderAll { my $self = shift; my $lineCount = $self->GetLineCount(); my $expanding = 1; my $lineNum; # find out if we are folding or unfolding for $lineNum (1..$lineCount) { if ($self->GetFoldLevel($lineNum) & Win32::GUI::Scintilla::SC_FOLDLEVELHEADERFLAG) { $expanding = not $self->GetFoldExpanded($lineNum); last; } } $lineNum = 0; while ($lineNum < $lineCount) { my $level = $self->GetFoldLevel($lineNum); if (($level & Win32::GUI::Scintilla::SC_FOLDLEVELHEADERFLAG) and ($level & Win32::GUI::Scintilla::SC_FOLDLEVELNUMBERMASK) == Win32::GUI::Scintilla::SC_FOLDLEVELBASE) { if ($expanding) { $self->SetFoldExpanded($lineNum, 1); $lineNum = $self->FolderExpand($lineNum, 1); $lineNum--; } else { my $lastChild = $self->GetLastChild($lineNum, -1); $self->SetFoldExpanded($lineNum, 0); $self->HideLines($lineNum+1, $lastChild) if ($lastChild > $lineNum); } } $lineNum++; } } # Expand folder sub FolderExpand { my $self = shift; my $line = shift; my $doExpand = shift; my $force = shift || 0; my $visLevels= shift || 0; my $level = shift || -1; my $lastChild = $self->GetLastChild($line, $level); $line++; while ($line <= $lastChild) { if ($force) { if ($visLevels > 0) { $self->ShowLines($line, $line); } else { $self->HideLines($line, $line); } } else { $self->ShowLines($line, $line) if ($doExpand); } $level = $self->GetFoldLevel($line) if ($level == -1); if ($level & Win32::GUI::Scintilla::SC_FOLDLEVELHEADERFLAG) { if ($force) { if ($visLevels > 1) { $self->SetFoldExpanded($line, 1); } else { $self->SetFoldExpanded($line, 0); } $line = $self->FolderExpand($line, $doExpand, $force, $visLevels-1); } else { if ($doExpand and $self->GetFoldExpanded($line)) { $line = $self->FolderExpand($line, 1, $force, $visLevels-1); } else { $line = $self->FolderExpand($line, 0, $force, $visLevels-1); } } } else { $line ++; } } return $line; } #------------------------------------------------------------------------ # Find Management #------------------------------------------------------------------------ sub FindAndSelect { my $self = shift; my $text = shift; my $flag = shift || Win32::GUI::Scintilla::SCFIND_WHOLEWORD; my $direction = shift || 1; my $wrap = shift || 1; my ($start, $end); # Set Search target if ($direction >= 0) { $start = $self->GetSelectionEnd (); $end = $self->GetLength(); } else { $start = $self->GetSelectionStart() - 1; $end = 0; } $self->SetTargetStart ($start); $self->SetTargetEnd ($end); $self->SetSearchFlags ($flag); # Find text my $pos = $self->SearchInTarget($text); # Not found and Wrap mode if ($pos == -1 and $wrap == 1) { # New search target if ($direction >= 0) { $start = 0; $end = $self->GetLength(); } else { $start = $self->GetLength(); $end = 0; } $self->SetTargetStart ($start); $self->SetTargetEnd ($end); # Find Text $pos = $self->SearchInTarget($text); } # Select and visible unless ($pos == -1) { # GetTarget $start = $self->GetTargetStart(); $end = $self->GetTargetEnd(); # Ensure range visible my ($lstart, $lend); if ($start <= $end) { $lstart = $self->LineFromPosition($start); $lend = $self->LineFromPosition($end); } else { $lstart = $self->LineFromPosition($end); $lend = $self->LineFromPosition($start); } for my $i ($lstart .. $lend) { $self->EnsureVisible ($i); } # Select Target $self->SetSel ($start, $end); } else { $self->SetSelectionStart ($self->GetSelectionEnd()); } return $pos; } 1; # End of Scintilla.pm __END__ POSTAMBLE __END__