Update of /cvsroot/perl-win32-gui/Win32-GUI-Scintilla
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv23874
Added Files:
Changes MANIFEST Makefile.PL Perl.pm README Scintilla.html
Scintilla.pm Scintilla.pm.begin Scintilla.pm.end Scintilla.xs
Typemap
Log Message:
Added to repository
--- NEW FILE: Makefile.PL ---
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 ([EMAIL PROTECTED])') : ()),
'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
}
--- NEW FILE: Scintilla.pm.begin ---
#------------------------------------------------------------------------
# Scintilla control for Win32::GUI
# by Laurent ROCHER ([EMAIL PROTECTED])
#------------------------------------------------------------------------
#perl2exe_bundle 'SciLexer.dll'
package Win32::GUI::Scintilla;
use vars qw($ABSTRACT $VERSION @ISA @EXPORT @EXPORT_OK $AUTOLOAD);
use Win32::GUI;
use Config;
require Exporter;
require DynaLoader;
require AutoLoader;
@ISA = qw(Exporter DynaLoader Win32::GUI::Window);
$VERSION = '1.7';
bootstrap Win32::GUI::Scintilla $VERSION;
#------------------------------------------------------------------------
# Load Scintilla DLL from perl directory or standard LoadLibrary search
my $SCILEXER_PATH = $Config{'installsitelib'} .
'\auto\Win32\GUI\Scintilla\SciLexer.DLL';
my $SCINTILLA_DLL = Win32::GUI::LoadLibrary($SCILEXER_PATH) ||
Win32::GUI::LoadLibrary('SciLexer.DLL');
Win32::GUI::Scintilla::_Initialise();
END {
# Free Scintilla DLL
Win32::GUI::FreeLibrary($SCINTILLA_DLL);
Win32::GUI::Scintilla::_UnInitialise();
}
#------------------------------------------------------------------------
#
# 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::constant("WIN32__GUI__STATIC", 0);
$out{-style} = WS_CLIPCHILDREN;
$out{-class} = "Scintilla";
### Window style
$out{-style} |= WS_TABSTOP unless exists $in{-tabstop} && $in{-tabstop} == 0;
#Default to -tabstop => 1
$out{-style} |= WS_VISIBLE unless exists $in{-visible} && $in{-visible} == 0;
#Default to -visible => 1
$out{-style} |= WS_HSCROLL if exists $in{-hscroll} && $in{-hscroll} == 1;
$out{-style} |= WS_VSCROLL if exists $in{-vscroll} && $in{-vscroll} == 1;
my $self = Win32::GUI->_new($constant, $class, %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
#------------------------------------------------------------------------
--- NEW FILE: Scintilla.html ---
<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN"
"http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd";>
<html xmlns="http://www.w3.org/1999/xhtml";>
<head>
<title>Win32::GUI::Scintilla - Add Scintilla edit control to Win32::GUI</title>
<link rev="made" href="mailto:"; />
</head>
<body style="background-color: white">
<p><a name="__index__"></a></p>
<!-- INDEX BEGIN -->
<ul>
<li><a href="#name">NAME</a></li>
<li><a href="#synopsis">SYNOPSIS</a></li>
<li><a href="#description">DESCRIPTION</a></li>
<ul>
[...3150 lines suppressed...]
See comment for relation between Lexer language and lexer constante.</pre>
</dd>
</dl>
<p>
</p>
<hr />
<h1><a name="author">AUTHOR</a></h1>
<pre>
Laurent Rocher ([EMAIL PROTECTED])
HomePage :<a
href="http://perso.club-internet.fr/rocherl/Win32GUI.html";>http://perso.club-internet.fr/rocherl/Win32GUI.html</a></pre>
<p>
</p>
<hr />
<h1><a name="see_also">SEE ALSO</a></h1>
<pre>
Win32::GUI</pre>
</body>
</html>
--- NEW FILE: Perl.pm ---
=head1 NAME
Win32::GUI::Scintilla::Perl -- Scintilla control with Perl
awareness.
=head1 SYNOPSIS
use Win32::GUI::Scintilla::Perl;
my $win = #Create window here
my $sciViewer = $winMain->AddScintillaPerl (
-name => "sciViewer",
-left => 0,
-top => 30,
-width => 400,
-height => 240,
-addexstyle => WS_EX_CLIENTEDGE,
);
#Change look and feel to your liking here.
=cut
package Win32::GUI::Scintilla::Perl;
use strict;
use Win32::GUI::Scintilla;
=head1 METHODS
=head2 new(%hOption)
Create a Win32::GUI::Scintilla control which is in "Perl
mode". Other than this, it's a regular Scintilla object.
You can override any setting afterward.
=cut
my %hFontFace = (
'times' => 'Times New Roman',
'mono' => 'Courier New',
'helv' => 'Lucida Console',
'lucida' => 'Lucida Console',
'other' => 'Comic Sans MS',
'size' => '10',
'size2' => '9',
'backcol'=> '#FFFFFF',
);
my $keywordPerl = q{
NULL __FILE__ __LINE__ __PACKAGE__ __DATA__ __END__ AUTOLOAD
BEGIN CORE DESTROY END EQ GE GT INIT LE LT NE CHECK abs accept
alarm and atan2 bind binmode bless caller chdir chmod chomp chop
chown chr chroot close closedir cmp connect continue cos crypt
dbmclose dbmopen defined delete die do dump each else elsif endgrent
endhostent endnetent endprotoent endpwent endservent eof eq eval
exec exists exit exp fcntl fileno flock for foreach fork format
formline ge getc getgrent getgrgid getgrnam gethostbyaddr gethostbyname
gethostent getlogin getnetbyaddr getnetbyname getnetent getpeername
getpgrp getppid getpriority getprotobyname getprotobynumber getprotoent
getpwent getpwnam getpwuid getservbyname getservbyport getservent
getsockname getsockopt glob gmtime goto grep gt hex if index
int ioctl join keys kill last lc lcfirst le length link listen
local localtime lock log lstat lt m map mkdir msgctl msgget msgrcv
msgsnd my ne next no not oct open opendir or ord our pack package
pipe pop pos print printf prototype push q qq qr quotemeta qu
qw qx rand read readdir readline readlink readpipe recv redo
ref rename require reset return reverse rewinddir rindex rmdir
s scalar seek seekdir select semctl semget semop send setgrent
sethostent setnetent setpgrp setpriority setprotoent setpwent
setservent setsockopt shift shmctl shmget shmread shmwrite shutdown
sin sleep socket socketpair sort splice split sprintf sqrt srand
stat study sub substr symlink syscall sysopen sysread sysseek
system syswrite tell telldir tie tied time times tr truncate
uc ucfirst umask undef unless unlink unpack unshift untie until
use utime values vec wait waitpid wantarray warn while write
x xor y
};
sub new {
my $pkg = shift;
$pkg = ref($pkg) || $pkg;
my $sci = Win32::GUI::Scintilla->new(@_) or return(undef);
SetupPerl($sci) or return(undef);
return($sci);
}
=head1 ROUTINES
=head2 SetupPerl($sciControl)
Setup $sciControl in Perl mode.
Return 1 on success, else 0.
=cut
sub SetupPerl {
my ($sci) = @_;
# Set Perl Lexer
$sci->SetLexer(Win32::GUI::Scintilla::SCLEX_PERL);
# Set Perl Keyword
$sci->SetKeyWords(0, $keywordPerl);
# Folder ????
$sci->SetProperty("fold", "1");
$sci->SetProperty("tab.timmy.whinge.level", "1");
# Indenetation
$sci->SetIndentationGuides(1);
$sci->SetUseTabs(1);
$sci->SetTabWidth(4);
$sci->SetIndent(4);
# Edge Mode
$sci->SetEdgeMode(Win32::GUI::Scintilla::EDGE_LINE);
#Win32::GUI::Scintilla::EDGE_BACKGROUND
$sci->SetEdgeColumn(80);
# Define margin
# $sci->SetMargins(0,0);
$sci->SetMarginTypeN(1, Win32::GUI::Scintilla::SC_MARGIN_NUMBER);
$sci->SetMarginWidthN(1, 25);
$sci->SetMarginTypeN(2, Win32::GUI::Scintilla::SC_MARGIN_SYMBOL);
$sci->SetMarginMaskN(2, Win32::GUI::Scintilla::SC_MASK_FOLDERS);
$sci->SetMarginSensitiveN(2, 1);
$sci->SetMarginWidthN(2, 12);
# Define marker
$sci->MarkerDefine(Win32::GUI::Scintilla::SC_MARKNUM_FOLDEREND,
Win32::GUI::Scintilla::SC_MARK_BOXPLUSCONNECTED);
$sci->MarkerSetFore(Win32::GUI::Scintilla::SC_MARKNUM_FOLDEREND, '#FFFFFF');
$sci->MarkerSetBack(Win32::GUI::Scintilla::SC_MARKNUM_FOLDEREND, '#000000');
$sci->MarkerDefine(Win32::GUI::Scintilla::SC_MARKNUM_FOLDEROPENMID,
Win32::GUI::Scintilla::SC_MARK_BOXMINUSCONNECTED);
$sci->MarkerSetFore(Win32::GUI::Scintilla::SC_MARKNUM_FOLDEROPENMID,
'#FFFFFF');
$sci->MarkerSetBack(Win32::GUI::Scintilla::SC_MARKNUM_FOLDEROPENMID,
'#000000');
$sci->MarkerDefine(Win32::GUI::Scintilla::SC_MARKNUM_FOLDERMIDTAIL,
Win32::GUI::Scintilla::SC_MARK_TCORNER);
$sci->MarkerSetFore(Win32::GUI::Scintilla::SC_MARKNUM_FOLDERMIDTAIL,
'#FFFFFF');
$sci->MarkerSetBack(Win32::GUI::Scintilla::SC_MARKNUM_FOLDERMIDTAIL,
'#000000');
$sci->MarkerDefine(Win32::GUI::Scintilla::SC_MARKNUM_FOLDERTAIL,
Win32::GUI::Scintilla::SC_MARK_LCORNER);
$sci->MarkerSetFore(Win32::GUI::Scintilla::SC_MARKNUM_FOLDERTAIL, '#FFFFFF');
$sci->MarkerSetBack(Win32::GUI::Scintilla::SC_MARKNUM_FOLDERTAIL, '#000000');
$sci->MarkerDefine(Win32::GUI::Scintilla::SC_MARKNUM_FOLDERSUB,
Win32::GUI::Scintilla::SC_MARK_VLINE);
$sci->MarkerSetFore(Win32::GUI::Scintilla::SC_MARKNUM_FOLDERSUB, '#FFFFFF');
$sci->MarkerSetBack(Win32::GUI::Scintilla::SC_MARKNUM_FOLDERSUB, '#000000');
$sci->MarkerDefine(Win32::GUI::Scintilla::SC_MARKNUM_FOLDER,
Win32::GUI::Scintilla::SC_MARK_BOXPLUS);
$sci->MarkerSetFore(Win32::GUI::Scintilla::SC_MARKNUM_FOLDER, '#FFFFFF');
$sci->MarkerSetBack(Win32::GUI::Scintilla::SC_MARKNUM_FOLDER, '#000000');
$sci->MarkerDefine(Win32::GUI::Scintilla::SC_MARKNUM_FOLDEROPEN,
Win32::GUI::Scintilla::SC_MARK_BOXMINUS);
$sci->MarkerSetFore(Win32::GUI::Scintilla::SC_MARKNUM_FOLDEROPEN, '#FFFFFF');
$sci->MarkerSetBack(Win32::GUI::Scintilla::SC_MARKNUM_FOLDEROPEN, '#000000');
# Define Style
$sci->StyleClearAll();
# Global default styles for all languages
$sci->StyleSetSpec(Win32::GUI::Scintilla::STYLE_DEFAULT,
"face:$hFontFace{'mono'},size:$hFontFace{'size'}");
$sci->StyleSetSpec(Win32::GUI::Scintilla::STYLE_LINENUMBER,
"back:#C0C0C0,face:$hFontFace{mono}");
$sci->StyleSetSpec(Win32::GUI::Scintilla::STYLE_CONTROLCHAR,
"face:$hFontFace{mono}");
$sci->StyleSetSpec(Win32::GUI::Scintilla::STYLE_BRACELIGHT,
"fore:#FFFFFF,back:#0000FF,bold");
$sci->StyleSetSpec(Win32::GUI::Scintilla::STYLE_BRACEBAD,
"fore:#000000,back:#FF0000,bold");
# White space
$sci->StyleSetSpec (Win32::GUI::Scintilla::SCE_PL_DEFAULT,
"fore:#808080,face:$hFontFace{'mono'}");
# Error
$sci->StyleSetSpec (Win32::GUI::Scintilla::SCE_PL_ERROR , "fore:#0000FF");
# Comment
$sci->StyleSetSpec (Win32::GUI::Scintilla::SCE_PL_COMMENTLINE,
"fore:#007F00");
# POD: = at beginning of line
$sci->StyleSetSpec (Win32::GUI::Scintilla::SCE_PL_POD,
"fore:#004000,back:#E0FFE0,eolfilled");
# Number
$sci->StyleSetSpec (Win32::GUI::Scintilla::SCE_PL_NUMBER, "fore:#007F7F");
# Keyword
$sci->StyleSetSpec (Win32::GUI::Scintilla::SCE_PL_WORD , "fore:#00007F,bold");
# Double quoted string
$sci->StyleSetSpec (Win32::GUI::Scintilla::SCE_PL_STRING,
"fore:#7F007F,face:$hFontFace{'mono'},italic");
# Single quoted string
$sci->StyleSetSpec (Win32::GUI::Scintilla::SCE_PL_CHARACTER,
"fore:#7F0000,face:$hFontFace{'mono'},italic");
# Symbols / Punctuation. Currently not used by LexPerl.
$sci->StyleSetSpec (Win32::GUI::Scintilla::SCE_PL_PUNCTUATION,
"fore:#00007F,bold");
# Preprocessor. Currently not used by LexPerl.
$sci->StyleSetSpec (Win32::GUI::Scintilla::SCE_PL_PREPROCESSOR,
"fore:#00007F,bold");
# Operators
$sci->StyleSetSpec (Win32::GUI::Scintilla::SCE_PL_OPERATOR , "bold");
# Identifiers (functions, etc.)
$sci->StyleSetSpec (Win32::GUI::Scintilla::SCE_PL_IDENTIFIER ,
"fore:#000000");
# Scalars: $var
$sci->StyleSetSpec (Win32::GUI::Scintilla::SCE_PL_SCALAR,
"fore:#000000,back:#FFE0E0");
# Array: @var
$sci->StyleSetSpec (Win32::GUI::Scintilla::SCE_PL_ARRAY,
"fore:#000000,back:#FFFFE0");
# Hash: %var
$sci->StyleSetSpec (Win32::GUI::Scintilla::SCE_PL_HASH,
"fore:#000000,back:#FFE0FF");
# Symbol table: *var
$sci->StyleSetSpec (Win32::GUI::Scintilla::SCE_PL_SYMBOLTABLE,
"fore:#000000,back:#E0E0E0");
# Regex: /re/ or m{re}
$sci->StyleSetSpec (Win32::GUI::Scintilla::SCE_PL_REGEX,
"fore:#000000,back:#A0FFA0");
# Substitution: s/re/ore/
$sci->StyleSetSpec (Win32::GUI::Scintilla::SCE_PL_REGSUBST,
"fore:#000000,back:#F0E080");
# Long Quote (qq, qr, qw, qx) -- obsolete: replaced by qq, qx, qr, qw
$sci->StyleSetSpec (Win32::GUI::Scintilla::SCE_PL_LONGQUOTE,
"fore:#FFFF00,back:#8080A0");
# Back Ticks
$sci->StyleSetSpec (Win32::GUI::Scintilla::SCE_PL_BACKTICKS,
"fore:#FFFF00,back:#A08080");
# Data Section: __DATA__ or __END__ at beginning of line
$sci->StyleSetSpec (Win32::GUI::Scintilla::SCE_PL_DATASECTION,
"#600000,back:#FFF0D8,eolfilled");
# Here-doc (delimiter)
$sci->StyleSetSpec (Win32::GUI::Scintilla::SCE_PL_HERE_DELIM,
"fore:#000000,back:#DDD0DD");
# Here-doc (single quoted, q)
$sci->StyleSetSpec (Win32::GUI::Scintilla::SCE_PL_HERE_Q,
"fore:#7F007F,back:#DDD0DD,eolfilled,notbold");
# Here-doc (double quoted, qq)
$sci->StyleSetSpec (Win32::GUI::Scintilla::SCE_PL_HERE_QQ,
"fore:#7F007F,back:#DDD0DD,eolfilled,bold");
# Here-doc (back ticks, qx)
$sci->StyleSetSpec (Win32::GUI::Scintilla::SCE_PL_HERE_QX,
"fore:#7F007F,back:#DDD0DD,eolfilled,italics");
# Single quoted string, generic
$sci->StyleSetSpec (Win32::GUI::Scintilla::SCE_PL_STRING_Q,
"fore:#7F007F,notbold");
# qq = Double quoted string
$sci->StyleSetSpec (Win32::GUI::Scintilla::SCE_PL_STRING_QQ,
"fore:#7F007F,italic");
# qx = Back ticks
$sci->StyleSetSpec (Win32::GUI::Scintilla::SCE_PL_STRING_QX,
"fore:#FFFF00,back:#A08080");
# qr = Regex
$sci->StyleSetSpec (Win32::GUI::Scintilla::SCE_PL_STRING_QR,
"fore:#000000,back:#A0FFA0");
# qw = Array
$sci->StyleSetSpec (Win32::GUI::Scintilla::SCE_PL_STRING_QW,
"fore:#000000,back:#FFFFE0");
return(1);
}
=head1 Win32::GUI::Window methods
=head2 AddScintillaPerl
Create and add a Win32::GUI::Scintilla::Perl control to this
window.
=cut
sub Win32::GUI::Window::AddScintillaPerl {
my $parent = shift;
return Win32::GUI::Scintilla::Perl->new (-parent => $parent, @_);
}
1;
=head1 AUTHOR
Laurent Rocher (the hard work) and Johan Lindström (subclassing).
Same license as Perl.
=cut
__END__
--- NEW FILE: README ---
Win32::GUI::Scintilla version 1.7
=================================
Win32::GUI::Scintilla - Add Scintilla edit control to Win32::GUI
INSTALLATION
To install this module type the following:
perl Makefile.PL
make
make install
Makefile.pl notes:
- Scintilla.pm is create by /include/autogen.pl by Makefile.PL.
it use Scintilla.iface, Scintilla.pm.begin and Scintilla.pm.end.
- Makefile.pl copy ./include/SciLexer.dll to
.\blib\arch\auto\Win32\GUI\Scintilla\SciLexer.dll
DEPENDENCIES
This module requires these other modules and libraries:
Win32::GUI
Scintilla (http:/www.scintilla.org/)
WEB PAGE AND PPM REPOSITORY
See: http://perso.club-internet.fr/rocherl/Win32GUI.html
COPYRIGHT AND LICENCE
Copyright 2003 by Laurent Rocher ([EMAIL PROTECTED]).
This program is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.
See <http://www.perl.com/perl/misc/Artistic.html>.
--- NEW FILE: Scintilla.pm ---
#------------------------------------------------------------------------
# Scintilla control for Win32::GUI
# by Laurent ROCHER ([EMAIL PROTECTED])
#------------------------------------------------------------------------
#perl2exe_bundle 'SciLexer.dll'
package Win32::GUI::Scintilla;
use vars qw($ABSTRACT $VERSION @ISA @EXPORT @EXPORT_OK $AUTOLOAD);
use Win32::GUI;
use Config;
require Exporter;
require DynaLoader;
require AutoLoader;
@ISA = qw(Exporter DynaLoader Win32::GUI::Window);
$VERSION = '1.7';
[...5864 lines suppressed...]
=item C<Lexer constant>
See Scintilla.pm
SCLEX_* contante for lexer language.
SCE_* for lexer constante.
See comment for relation between Lexer language and lexer constante.
=head1 AUTHOR
Laurent Rocher ([EMAIL PROTECTED])
HomePage :http://perso.club-internet.fr/rocherl/Win32GUI.html
=head1 SEE ALSO
Win32::GUI
=cut
--- NEW FILE: Scintilla.xs ---
/**********************************************************************/
/* S c i n t i l l a . x s */
/**********************************************************************/
#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"
#include <windows.h>
#include "./include/Scintilla.h"
/*====================================================================*/
/* W I N 3 2 : : G U I */
/*====================================================================*/
#define MAX_WINDOW_NAME 128
/*
* Various definitions to accomodate the different Perl versions around
*/
#ifdef PERL_OBJECT
# ifdef _INC_WIN32_PERL5
# pragma message( "\n*** Using the 5.005 Perl Object CPerlObj class.\n" )
# define NOTXSPROC CPerlObj *pPerl,
# define NOTXSCALL pPerl,
# define CPerl CPerlObj
# else // not _INC_WIN32_PERL5
# pragma message( "\n*** Using the 5.004 Perl Object CPerl class.\n" )
# define NOTXSPROC CPerl *pPerl,
# define NOTXSCALL pPerl,
# endif // _INC_WIN32_PERL5
#else
# pragma message( "\n*** Using a non-Object Core Perl.\n" )
# define NOTXSPROC
# define NOTXSCALL
#endif
/*
* what we'll store in GWL_USERDATA
*/
typedef struct tagPERLWIN32GUI_USERDATA {
DWORD dwSize;
// struct size (our signature)
#ifdef PERL_OBJECT
CPerl *pPerl;
// a pointer to the Perl Object
#endif
SV* svSelf;
// a pointer to ourself
char szWindowName[MAX_WINDOW_NAME]; // our -name
BOOL fDialogUI;
// are we to intercept dialog messages?
int iClass;
// our (Perl) class
HACCEL hAcc;
// our accelerator table
HWND hTooltip;
HCURSOR hCursor;
DWORD dwPlStyle;
int iMinWidth;
int iMaxWidth;
int iMinHeight;
int iMaxHeight;
COLORREF clrForeground;
COLORREF clrBackground;
HBRUSH hBackgroundBrush;
WNDPROC wndprocPreContainer;
WNDPROC wndprocPreNEM;
int iEventModel;
HV* hvEvents;
DWORD dwEventMask;
HWND Modal;
} PERLWIN32GUI_USERDATA, *LPPERLWIN32GUI_USERDATA;
BOOL ProcessEventError(NOTXSPROC char *Name, int* PerlResult) {
if(strncmp(Name, "main::", 6) == 0) Name += 6;
if(SvTRUE(ERRSV)) {
MessageBeep(MB_ICONASTERISK);
*PerlResult = MessageBox(
NULL,
SvPV_nolen(ERRSV),
Name,
MB_ICONERROR | MB_OKCANCEL
);
if(*PerlResult == IDCANCEL) {
*PerlResult = -1;
}
return TRUE;
} else {
return FALSE;
}
}
/*====================================================================*/
/* H O O K F U N C T I O N */
/*====================================================================*/
typedef struct SCNotification * pSCNotification;
/*
struct SCNotification {
struct NotifyHeader nmhdr;
int position; // SCN_STYLENEEDED, SCN_MODIFIED, SCN_DWELLSTART,
SCN_DWELLEND
int ch; // SCN_CHARADDED, SCN_KEY
int modifiers; // SCN_KEY
int modificationType; // SCN_MODIFIED
const char *text; // SCN_MODIFIED
int length; // SCN_MODIFIED
int linesAdded; // SCN_MODIFIED
int message; // SCN_MACRORECORD
uptr_t wParam; // SCN_MACRORECORD
sptr_t lParam; // SCN_MACRORECORD
int line; // SCN_MODIFIED
int foldLevelNow; // SCN_MODIFIED
int foldLevelPrev; // SCN_MODIFIED
int margin; // SCN_MARGINCLICK
int listType; // SCN_USERLISTSELECTION
int x; // SCN_DWELLSTART, SCN_DWELLEND
int y; // SCN_DWELLSTART, SCN_DWELLEND
};
*/
int DoEvent (NOTXSPROC char *Name, UINT code, pSCNotification evt) {
int PerlResult;
int count;
PerlResult = 1;
if(perl_get_cv(Name, FALSE) != NULL) {
dSP;
dTARG;
ENTER;
SAVETMPS;
PUSHMARK(SP);
XPUSHs(sv_2mortal(newSVpv("-code", 0)));
XPUSHs(sv_2mortal(newSViv(code)));
if (code == SCN_STYLENEEDED || code == SCN_MODIFIED || code ==
SCN_DWELLSTART ||
code == SCN_DWELLEND || code == SCN_MARGINCLICK ||
code == SCN_HOTSPOTCLICK || code == SCN_HOTSPOTDOUBLECLICK ||
code == SCN_CALLTIPCLICK)
{
XPUSHs(sv_2mortal(newSVpv("-position", 0)));
XPUSHs(sv_2mortal(newSViv(evt->position)));
}
if (code == SCN_CHARADDED || code == SCN_KEY)
{
XPUSHs(sv_2mortal(newSVpv("-ch", 0)));
XPUSHs(sv_2mortal(newSViv(evt->ch)));
}
if (code == SCN_KEY || code == SCN_MARGINCLICK ||
code == SCN_HOTSPOTCLICK || code == SCN_HOTSPOTDOUBLECLICK)
{
XPUSHs(sv_2mortal(newSVpv("-modifiers", 0)));
XPUSHs(sv_2mortal(newSViv(evt->modifiers)));
XPUSHs(sv_2mortal(newSVpv("-shift", 0)));
XPUSHs(sv_2mortal(newSViv(evt->modifiers & SCMOD_SHIFT)));
XPUSHs(sv_2mortal(newSVpv("-control", 0)));
XPUSHs(sv_2mortal(newSViv(evt->modifiers & SCMOD_CTRL)));
XPUSHs(sv_2mortal(newSVpv("-alt", 0)));
XPUSHs(sv_2mortal(newSViv(evt->modifiers & SCMOD_ALT)));
}
if (code == SCN_MODIFIED )
{
XPUSHs(sv_2mortal(newSVpv("-modificationType", 0)));
XPUSHs(sv_2mortal(newSViv(evt->modificationType)));
// XPUSHs(sv_2mortal(newSVpv("-text", 0)));
// XPUSHs(sv_2mortal(newSVpv(evt->text, 0)));
XPUSHs(sv_2mortal(newSVpv("-length", 0)));
XPUSHs(sv_2mortal(newSViv(evt->length)));
XPUSHs(sv_2mortal(newSVpv("-linesAdded", 0)));
XPUSHs(sv_2mortal(newSViv(evt->linesAdded)));
XPUSHs(sv_2mortal(newSVpv("-line", 0)));
XPUSHs(sv_2mortal(newSViv(evt->line)));
XPUSHs(sv_2mortal(newSVpv("-foldLevelNow", 0)));
XPUSHs(sv_2mortal(newSViv(evt->foldLevelNow)));
XPUSHs(sv_2mortal(newSVpv("-foldLevelPrev", 0)));
XPUSHs(sv_2mortal(newSViv(evt->foldLevelPrev)));
}
if (code == SCN_MACRORECORD)
{
XPUSHs(sv_2mortal(newSVpv("-message", 0)));
XPUSHs(sv_2mortal(newSViv(evt->message)));
}
if (code == SCN_MARGINCLICK)
{
XPUSHs(sv_2mortal(newSVpv("-margin", 0)));
XPUSHs(sv_2mortal(newSViv(evt->margin)));
}
if (code == SCN_USERLISTSELECTION)
{
XPUSHs(sv_2mortal(newSVpv("-listType", 0)));
XPUSHs(sv_2mortal(newSViv((int) evt->wParam))); // ???
// XPUSHs(sv_2mortal(newSViv(evt->listType)));
// XPUSHs(sv_2mortal(newSVpv("-text", 0)));
// XPUSHs(sv_2mortal(newSVpv(evt->text, 0)));
}
if (code == SCN_DWELLSTART || code == SCN_DWELLEND)
{
XPUSHs(sv_2mortal(newSVpv("-x", 0)));
XPUSHs(sv_2mortal(newSViv(evt->x)));
XPUSHs(sv_2mortal(newSVpv("-y", 0)));
XPUSHs(sv_2mortal(newSViv(evt->y)));
}
PUTBACK;
count = perl_call_pv(Name, G_EVAL|G_ARRAY);
SPAGAIN;
if(!ProcessEventError(NOTXSCALL Name, &PerlResult)) {
if(count > 0) PerlResult = POPi;
}
PUTBACK;
FREETMPS;
LEAVE;
}
return PerlResult;
}
int DoEvent_Generic(NOTXSPROC char *Name)
{
int PerlResult;
int count;
PerlResult = 1;
if(perl_get_cv(Name, FALSE) != NULL) {
dSP;
dTARG;
ENTER;
SAVETMPS;
PUSHMARK(SP);
PUTBACK;
count = perl_call_pv(Name, G_EVAL|G_NOARGS);
SPAGAIN;
if(!ProcessEventError(NOTXSCALL Name, &PerlResult))
{
if(count > 0) PerlResult = POPi;
}
PUTBACK;
FREETMPS;
LEAVE;
}
return PerlResult;
}
HHOOK hhook;
LRESULT WINAPI CallWndProc(int nCode, WPARAM wParam, LPARAM lParam)
{
CWPSTRUCT * msg = (CWPSTRUCT *) lParam;
if (nCode >= 0 && msg->message == WM_NOTIFY)
{
NMHDR *lpnmhdr = (LPNMHDR) msg->lParam;
char Name [255];
// Read Sender Class
GetClassName (lpnmhdr->hwndFrom, Name, 255);
if (memcmp (Name, "Scintilla", 9) == 0)
{
// Perl contexte
#ifdef PERL_OBJECT
CPerl *pPerl;
#endif
LPPERLWIN32GUI_USERDATA perlud = (LPPERLWIN32GUI_USERDATA)
GetWindowLong(lpnmhdr->hwndFrom, GWL_USERDATA);
if (perlud != NULL)
{
#ifdef PERL_OBJECT
pPerl = perlud->pPerl;
#endif
// Build name
strcpy(Name, "main::");
strcat(Name, (char *) perlud->szWindowName);
strcat(Name, "_Notify");
DoEvent(NOTXSCALL Name, lpnmhdr->code, (pSCNotification) msg->lParam);
}
}
}
else if (nCode >= 0 && msg->message == WM_COMMAND && msg->lParam != 0)
{
char Name [255];
// Read Sender Class
GetClassName ((HWND) msg->lParam, Name, 255);
if (memcmp (Name, "Scintilla", 9) == 0)
{
// Perl contexte
#ifdef PERL_OBJECT
CPerl *pPerl;
#endif
LPPERLWIN32GUI_USERDATA perlud = (LPPERLWIN32GUI_USERDATA)
GetWindowLong((HWND) msg->lParam, GWL_USERDATA);
if (perlud != NULL)
{
#ifdef PERL_OBJECT
pPerl = perlud->pPerl;
#endif
// Build name
strcpy(Name, "main::");
strcat(Name, (char *) perlud->szWindowName);
switch (HIWORD(msg->wParam))
{
case SCEN_CHANGE :
strcat(Name, "_Change");
DoEvent_Generic (NOTXSCALL Name);
break;
case SCEN_SETFOCUS :
strcat(Name, "_GotFocus");
DoEvent_Generic (NOTXSCALL Name);
break;
case SCEN_KILLFOCUS :
strcat(Name, "_LostFocus");
DoEvent_Generic (NOTXSCALL Name);
break;
}
}
}
}
return CallNextHookEx(hhook, nCode, wParam, lParam);
}
/*====================================================================*/
/* Win32::GUI::Scintilla package */
/*====================================================================*/
MODULE = Win32::GUI::Scintilla PACKAGE = Win32::GUI::Scintilla
###########################################################################
# _Initialise() (internal)
# Install Hook function
void
_Initialise()
PREINIT:
CODE:
hhook = SetWindowsHookEx(WH_CALLWNDPROC, CallWndProc, (HINSTANCE) NULL,
GetCurrentThreadId());
###########################################################################
# _UnInitialise() (internal)
# Release Hook function
void
_UnInitialise()
PREINIT:
CODE:
UnhookWindowsHookEx (hhook);
###########################################################################
# SendMessageNP : Posts a message to a window
# Take WPARAM as int and LPARAM as a LPVOID
LRESULT
SendMessageNP(handle,msg,wparam,lparam)
HWND handle
UINT msg
WPARAM wparam
LPVOID 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
LRESULT
SendMessagePP(handle,msg,wparam,lparam)
HWND handle
UINT msg
LPVOID wparam
LPVOID lparam
CODE:
RETVAL = SendMessage(handle, msg, (WPARAM) wparam, (LPARAM) lparam);
OUTPUT:
RETVAL
--- NEW FILE: MANIFEST ---
Changes
Makefile.PL
MANIFEST
README
Scintilla.pm
Scintilla.xs
Scintilla.pm.begin
Scintilla.pm.end
Perl.pm
Typemap
Include/autogen.pl
Include/Readme.txt
Include/Scintilla.iface
Include/Scintilla.h
Include/SciLexer.dll
Samples/test.pl
Samples/test2.pl
Samples/Editor.pl
--- NEW FILE: Changes ---
Revision history for Perl extension Scintilla.
1.7 28/02/2004
- Use Scintilla 1.59
1.6 30/11/2003
- Use Scintilla 1.57
- Rewrite Makefile.pl
1.5 28/10/2003
- Use Scintilla 1.56
1.4 28/09/2003
- Correct -visible and -tabstop option (thank to Johan Lindström)
- Use Scintilla 1.55
1.3 27/05/2003
- [UPDATE] Add Perl2Exe support (Automaticly add Scilexer.dll from
current directory)
Copy SciLexer.dll in script directory before run perl2exe.
1.2 26/05/2003
- [BUG] Correct some bugs (thank to Jeremy White again)
- Add Win32::GUI::Scintilla::Perl (thank to Johan Lindström)
- Add FindAndSelect method for simplify text search.
- Add Perl2Exe support (Automaticly add Scilexer.dll from current
directory)
- Use Scintilla 1.53
1.1 14/03/2003
- [BUG] Correct LineLength call (thank to Jeremy White)
- Add Change, LostFocus and GotFocus Events.
- Use Scintilla 1.51
1.0 24/01/2003
- First release
--- NEW FILE: Typemap ---
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
################################################################################
INPUT
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);
--- NEW FILE: Scintilla.pm.end ---
#------------------------------------------------------------------------
# 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();
[...2435 lines suppressed...]
=item C<Lexer constant>
See Scintilla.pm
SCLEX_* contante for lexer language.
SCE_* for lexer constante.
See comment for relation between Lexer language and lexer constante.
=head1 AUTHOR
Laurent Rocher ([EMAIL PROTECTED])
HomePage :http://perso.club-internet.fr/rocherl/Win32GUI.html
=head1 SEE ALSO
Win32::GUI
=cut
