From: Robert M. <rob...@us...> - 2006-06-11 16:51:54
|
Update of /cvsroot/perl-win32-gui/Win32-GUI/Win32-GUI-Scintilla In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv26402 Modified Files: Changes Makefile.PL Perl.pm Scintilla.xs Typemap Added Files: Scintilla.PL Scintilla.pod ScintillaRC.PL TODO Removed Files: MANIFEST README Scintilla.html Scintilla.pm Scintilla.pm.begin Scintilla.pm.end Log Message: Merge Scintilla into core distribution Index: Makefile.PL =================================================================== RCS file: /cvsroot/perl-win32-gui/Win32-GUI/Win32-GUI-Scintilla/Makefile.PL,v retrieving revision 1.1 retrieving revision 1.2 diff -C2 -d -r1.1 -r1.2 *** Makefile.PL 1 Nov 2005 10:36:51 -0000 1.1 --- Makefile.PL 11 Jun 2006 16:51:44 -0000 1.2 *************** *** 1,38 **** use ExtUtils::MakeMaker; ! # See lib/ExtUtils/MakeMaker.pm for details of how to influence ! # the contents of the Makefile that is written. ! WriteMakefile( ! 'NAME' => 'Win32::GUI::Scintilla', ! 'VERSION_FROM' => 'Scintilla.pm.begin', # finds $VERSION ! 'PREREQ_PM' => {}, # e.g., Module::Name => 1.1 ! 'PM' => { ! 'Scintilla.pm' => '$(INST_LIBDIR)/Scintilla.pm', ! 'Perl.pm' => '$(INST_LIBDIR)/Scintilla/Perl.pm', ! }, ! ($] >= 5.005 ? ## Add these new keywords supported since 5.005 ! (ABSTRACT => 'Add Scintilla control to Win32::GUI', ! AUTHOR => 'ROCHER Laurent (lr...@cp...)') : ()), ! 'LIBS' => [''], # e.g., '-lm' ! 'DEFINE' => '', # e.g., '-DHAVE_SOMETHING' ! # Insert -I. if you add *.h files later: ! 'INC' => '', # e.g., '-I/usr/include/other' ! # Un-comment this if you add C files to link with later: ! # 'OBJECT' => '$(O_FILES)', # link all the C files too ); ! sub MY::postamble { ! return <<'MAKE_FRAG'; ! Scintilla.pm : Scintilla.pm.begin Scintilla.pm.end include/Scintilla.iface include/autogen.pl ! $(PERL) ./include/autogen.pl ! config :: $(INST_ARCHAUTODIR)/SciLexer.dll ! @$(NOOP) ! $(INST_ARCHAUTODIR)/SciLexer.dll : include/SciLexer.dll ! $(CP) ./include/SciLexer.dll $(INST_ARCHAUTODIR)/SciLexer.dll ! MAKE_FRAG } --- 1,70 ---- + #!perl -w + use strict; + use warnings; + + # Makefile.PL for Win32::GUI::Scintilla + # $Id$ + + use 5.006; + use Config; use ExtUtils::MakeMaker; + use File::Find(); ! my @demos; ! File::Find::find(sub { push @demos, $File::Find::name if $File::Find::name =~ /\.pl$/ }, 'demos'); ! ! my %config = ( ! NAME => 'Win32::GUI::Scintilla', ! VERSION_FROM => 'Scintilla.PL', ! ABSTRACT_FROM => 'Scintilla.pod', ! AUTHOR => 'ROCHER Laurent (lr...@cp...)', ! PM => {'Scintilla.pod' => '$(INST_LIBDIR)/Scintilla.pod', ! 'Perl.pm' => '$(INST_LIBDIR)/Scintilla/Perl.pm', ! 'Include/SciLexer.dll' => '$(INST_ARCHAUTODIR)/SciLexer.dll', }, ! PL_FILES => {'Scintilla.PL' => '$(INST_LIBDIR)/Scintilla.pm', ! 'ScintillaRC.PL' => '$(BASEEXT).rc', }, ! OBJECT => '$(BASEEXT)$(OBJ_EXT) $(BASEEXT).res', ! macro => {RC => 'rc.exe', ! RCFLAGS => '', ! INST_DEMODIR => '$(INST_LIB)/Win32/GUI/demos/$(BASEEXT)', ! DEMOS => "@demos", }, ! depend => {'Scintilla.pm' => 'Include/Scintilla.iface', }, ! clean => {FILES => '*.rc *.res', }, ); ! # if building using gcc (MinGW or cygwin) use windres ! # as the resource compiler ! if($Config{cc} =~ /gcc/i) { ! $config{macro}->{RC} = 'windres'; ! $config{macro}->{RCFLAGS} = '-O coff -o $*.res'; ! } ! WriteMakefile(%config); ! package MY; ! # Add rule for .rc to .res conversion ! # Add rules to install demo scripts ! sub postamble { ! return <<'__POSTAMBLE'; ! # Win32::GUI::Scintilla RC section ! .rc.res: ! $(RC) $(RCFLAGS) $< ! ! # Win32::GUI::Scintilla demo script section ! ! pure_all :: demo_to_blib ! $(NOECHO) $(NOOP) ! ! demo_to_blib: $(DEMOS) ! $(NOECHO) $(MKPATH) $(INST_DEMODIR) ! $(CP) $? $(INST_DEMODIR) ! $(NOECHO) $(TOUCH) demo_to_blib ! ! clean :: ! -$(RM_F) demo_to_blib ! ! __POSTAMBLE } --- NEW FILE: Scintilla.pod --- =head1 NAME Win32::GUI::Scintilla - Add Scintilla edit control to Win32::GUI =head1 SYNOPSIS use Win32::GUI; use Win32::GUI::Scintilla; # main Window $Window = new Win32::GUI::Window ( -name => "Window", -title => "Scintilla test", -pos => [100, 100], -size => [400, 400], ) or die "new Window"; # Create Scintilla Edit Window [...2344 lines suppressed...] Win32::GUI - L<http://perl-win32-gui.sourceforge.net/> Scintilla - L<http:/www.scintilla.org/> =head1 SEE ALSO L<Win32::GUI|Win32::GUI> =head1 AUTHOR Laurent Rocher (lr...@cp...) =head1 COPYRIGHT AND LICENCE Copyright 2003 by Laurent Rocher (lr...@cp...). This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut --- NEW FILE: ScintillaRC.PL --- #!perl -w use strict; use warnings; use ExtUtils::MakeMaker; # $Id: ScintillaRC.PL,v 1.1 2006/06/11 16:51:48 robertemay Exp $ # perl script to produce the RC file for # Win32::GUI::Scintilla create Resource # file with a VERSIONINFO section # The variables: my %info = ( Version => MM->parse_version('Scintilla.PL'), Dllname => 'SCintilla.dll', Years => '2003..2006', Win32GUIVersion => MM->parse_version('../GUI.pm'), ); # Open the target file if ( @ARGV > 0 ) { my $file = $ARGV[0]; open(my $fh, '>', $file) or die qq(Failed to open '$file': $!); select $fh; } { my $fileVersion = $info{Version}; $fileVersion .= "_00" unless $fileVersion =~ m/_/; $info{FileVersion} = sprintf("%02d,%02d,%02d,00", $fileVersion =~ m/^(.*)\.([^_]*)_?(.*)$/); my $prodVersion = $info{Win32GUIVersion}; $prodVersion .= "_00" unless $prodVersion =~ m/_/; $info{ProductVersion} = sprintf("%02d,%02d,%02d,00", $prodVersion =~ m/^(.*)\.([^_]*)_?(.*)$/); } print <<"__RC"; #include "Winver.h" 1 VERSIONINFO FILEVERSION $info{FileVersion} PRODUCTVERSION $info{ProductVersion} FILEOS VOS__WINDOWS32 FILETYPE VFT_DLL { BLOCK "StringFileInfo" { BLOCK "040904E4" { VALUE "Comments" , "Win32::GUI::Scintilla, part of the perl Win32::GUI module." VALUE "CompanyName" , "perl-win32-gui.sourceforge.net" VALUE "FileDescription" , "Win32::GUI::Scintilla perl extension" VALUE "FileVersion" , "$info{Version}" VALUE "InternalName" , "$info{Dllname}" VALUE "LegalCopyright" , "Copyright © Laurent Rocher $info{Years}" VALUE "LegalTrademarks" , "GNU and Artistic licences" VALUE "OriginalFilename" , "$info{Dllname}" VALUE "ProductName" , "Win32::GUI perl extension" VALUE "ProductVersion" , "$info{Win32GUIVersion}" } } BLOCK "VarFileInfo" { VALUE "Translation", 0x0409, 0x04E4 } } __RC exit(0); __END__ --- Scintilla.pm.begin DELETED --- --- Scintilla.pm DELETED --- --- NEW FILE: Scintilla.PL --- #! perl -w use strict; use warnings; use File::Basename; use File::Path; # $Id: Scintilla.PL,v 1.1 2006/06/11 16:51:45 robertemay Exp $ # 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 (lr...@cp...) #------------------------------------------------------------------------ #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.1 2006/06/11 16:51:45 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.80_01; 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_PATH; for my $path (@INC) { $SCILEXER_PATH = $path . '\auto\Win32\GUI\Scintilla\SciLexer.dll'; last if -f $SCILEXER_PATH; undef $SCILEXER_PATH; } my $SCINTILLA_DLL = Win32::GUI::LoadLibrary($SCILEXER_PATH) if $SCILEXER_PATH; $SCINTILLA_DLL = Win32::GUI::LoadLibrary('SciLexer') unless $SCINTILLA_DLL; #TODO: Fail is we fail to load SciLexer.dll Win32::GUI::Scintilla::_Initialise(); END { # Free Scintilla DLL Win32::GUI::Scintilla::_UnInitialise(); #Win32::GUI::FreeLibrary($SCINTILLA_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 ( <F> ) { $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, "<" , "Include/Scintilla.iface" or die "Failed to open 'Include/Scintilla.iface' for reading: $!"; while ( <$fh> ) { #--- 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__ --- README DELETED --- Index: Changes =================================================================== RCS file: /cvsroot/perl-win32-gui/Win32-GUI/Win32-GUI-Scintilla/Changes,v retrieving revision 1.2 retrieving revision 1.3 diff -C2 -d -r1.2 -r1.3 *** Changes 5 Dec 2005 10:37:56 -0000 1.2 --- Changes 11 Jun 2006 16:51:44 -0000 1.3 *************** *** 1,4 **** --- 1,13 ---- Revision history for Perl extension Scintilla. + 1.90 24/05/2006 + - Merge into Win32::GUI Core codebase + - refactor build process + - new loading mechanism for SciLexer.dll - find using @INC + - Use Scintilla 1.68 + - add basic tests + - stop using deprecated -style option for window creation + - split pod into seperate Scintilla.pod file + 1.8 05/12/2005 - Fixed bugs which caused crashes and no events firing in perl 5.8.x --- Scintilla.html DELETED --- Index: Scintilla.xs =================================================================== RCS file: /cvsroot/perl-win32-gui/Win32-GUI/Win32-GUI-Scintilla/Scintilla.xs,v retrieving revision 1.2 retrieving revision 1.3 diff -C2 -d -r1.2 -r1.3 *** Scintilla.xs 5 Dec 2005 10:37:56 -0000 1.2 --- Scintilla.xs 11 Jun 2006 16:51:48 -0000 1.3 *************** *** 8,12 **** //we will need/use ! #include "../Win32-GUI/GUI.h" #include "./include/Scintilla.h" --- 8,12 ---- //we will need/use ! #include "../GUI.h" #include "./include/Scintilla.h" *************** *** 67,71 **** if(perl_get_cv(Name, FALSE) != NULL) { dSP; ! dTARG; ENTER; SAVETMPS; --- 67,71 ---- if(perl_get_cv(Name, FALSE) != NULL) { dSP; ! /* dTARG; */ ENTER; SAVETMPS; *************** *** 164,168 **** if(perl_get_cv(Name, FALSE) != NULL) { dSP; ! dTARG; ENTER; SAVETMPS; --- 164,168 ---- if(perl_get_cv(Name, FALSE) != NULL) { dSP; ! /* dTARG; */ ENTER; SAVETMPS; *************** *** 261,264 **** --- 261,266 ---- MODULE = Win32::GUI::Scintilla PACKAGE = Win32::GUI::Scintilla + PROTOTYPES: ENABLE + ########################################################################### # _Initialise() (internal) *************** *** 297,300 **** --- 299,317 ---- ########################################################################### + # SendMessagePN : Posts a message to a window + # Take WPARAM as LPVOID and LPARAM as int + + LRESULT + SendMessagePN(handle,msg,wparam,lparam) + HWND handle + UINT msg + LPVOID wparam + int lparam + CODE: + RETVAL = SendMessage(handle, msg, (WPARAM) wparam, (LPARAM) lparam); + OUTPUT: + RETVAL + + ########################################################################### # SendMessagePP : Posts a message to a window # Take WPARAM and LPARAM as a LPVOID Index: Perl.pm =================================================================== RCS file: /cvsroot/perl-win32-gui/Win32-GUI/Win32-GUI-Scintilla/Perl.pm,v retrieving revision 1.1 retrieving revision 1.2 diff -C2 -d -r1.1 -r1.2 *** Perl.pm 1 Nov 2005 10:36:51 -0000 1.1 --- Perl.pm 11 Jun 2006 16:51:44 -0000 1.2 *************** *** 1,6 **** =head1 NAME ! Win32::GUI::Scintilla::Perl -- Scintilla control with Perl ! awareness. =head1 SYNOPSIS --- 1,14 ---- + package Win32::GUI::Scintilla::Perl; + + # $Id$ + + use strict; + use warnings; + + use Win32::GUI::Scintilla(); + =head1 NAME ! Win32::GUI::Scintilla::Perl -- Scintilla control with Perl awareness. =head1 SYNOPSIS *************** *** 23,30 **** =cut - package Win32::GUI::Scintilla::Perl; - - use strict; - use Win32::GUI::Scintilla; =head1 METHODS --- 31,34 ---- --- MANIFEST DELETED --- --- NEW FILE: TODO --- - Scintilla.PL should be re-written to be more generic when parsing scintilla.iface - Generate the majority of Scintilla.pod from scintilla.iface - More subclasses for syntax high-lighting other languages - use Scintilla; should fail gracefully if we fail to load SciLexer.dll - find a way to make Scintilla (SciLexer.dll) play nicely with PAR Index: Typemap =================================================================== RCS file: /cvsroot/perl-win32-gui/Win32-GUI/Win32-GUI-Scintilla/Typemap,v retrieving revision 1.1 retrieving revision 1.2 diff -C2 -d -r1.1 -r1.2 *** Typemap 1 Nov 2005 10:36:51 -0000 1.1 --- Typemap 11 Jun 2006 16:51:49 -0000 1.2 *************** *** 1,19 **** TYPEMAP HWND T_HANDLE - HTREEITEM T_IV - LONG T_IV - LPCTSTR T_PV - LPTSTR T_PV - DWORD T_IV UINT T_IV - BOOL T_IV WPARAM T_IV - LPARAM T_IV - LRESULT T_IV - HINSTANCE T_IV - COLORREF T_COLOR - LPCSTR T_PV - FLOAT T_FLOAT LPVOID T_PV ################################################################################ --- 1,8 ---- TYPEMAP HWND T_HANDLE UINT T_IV WPARAM T_IV LPVOID T_PV + LRESULT T_IV ################################################################################ *************** *** 21,28 **** T_HANDLE if(SvROK($arg)) { ! if(hv_fetch((HV*)SvRV($arg), \"-handle\", 7, 0) != NULL) ! $var = ($type) SvIV(*(hv_fetch((HV*)SvRV($arg), \"-handle\", 7, 0))); else $var = NULL; } else ! $var = ($type) SvIV($arg); --- 10,18 ---- T_HANDLE if(SvROK($arg)) { ! SV** out=hv_fetch((HV*)SvRV($arg), \"-handle\", 7, 0); ! if(out != NULL) ! $var = INT2PTR($type,SvIV(*out)); else $var = NULL; } else ! $var = INT2PTR($type,SvIV($arg)); --- Scintilla.pm.end DELETED --- |