Update of /cvsroot/perl-win32-gui/Win32-GUI
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv32668
Modified Files:
CHANGELOG GUI.h GUI.pm GUI.xs GUI_Helpers.cpp Textfield.xs
Tooltip.xs
Log Message:
Bug Fixes
Index: GUI.xs
===================================================================
RCS file: /cvsroot/perl-win32-gui/Win32-GUI/GUI.xs,v
retrieving revision 1.63
retrieving revision 1.64
diff -C2 -d -r1.63 -r1.64
*** GUI.xs 31 Oct 2006 22:24:15 -0000 1.63
--- GUI.xs 20 Jan 2007 17:09:22 -0000 1.64
***************
*** 5094,5097 ****
--- 5094,5099 ----
# -printeronly => 0/1 (default 0)
# only enable printers to be selected
+ # -directory => PATH
+ # the default start directory for browsing
# -root => PATH or CONSTANT
# the root directory for browsing; this can be either a
Index: GUI.pm
===================================================================
RCS file: /cvsroot/perl-win32-gui/Win32-GUI/GUI.pm,v
retrieving revision 1.58
retrieving revision 1.59
diff -C2 -d -r1.58 -r1.59
*** GUI.pm 5 Nov 2006 20:04:49 -0000 1.58
--- GUI.pm 20 Jan 2007 17:09:22 -0000 1.59
***************
*** 20,24 ****
# STATIC OBJECT PROPERTIES
#
! $VERSION = "1.05"; # For MakeMaker
$XS_VERSION = $VERSION; # For dynaloader
$VERSION = eval $VERSION; # For Perl (see perldoc perlmodstyle)
--- 20,24 ----
# STATIC OBJECT PROPERTIES
#
! $VERSION = "1.05_01"; # For MakeMaker
$XS_VERSION = $VERSION; # For dynaloader
$VERSION = eval $VERSION; # For Perl (see perldoc perlmodstyle)
***************
*** 2670,2674 ****
# unlikely event of someone doing PARENT->{Timer name} = undef;
my $window = Win32::GUI::GetWindowObject($self->{-handle});
! if(defined $window) {
# Remove id from -timers hash
delete $window->{-timers}->{$self->{-id}};
--- 2670,2674 ----
# unlikely event of someone doing PARENT->{Timer name} = undef;
my $window = Win32::GUI::GetWindowObject($self->{-handle});
! if(defined $window && tied %$window) {
# Remove id from -timers hash
delete $window->{-timers}->{$self->{-id}};
***************
*** 2937,2941 ****
# unlikely event of someone doing PARENT->{NotifyIcon name} = undef;
my $window = Win32::GUI::GetWindowObject($self->{-handle});
! if(defined $window) {
# Remove id from -notifyicons hash
delete $window->{-notifyicons}->{$self->{-id}} if defined
$window->{-notifyicons};
--- 2937,2941 ----
# unlikely event of someone doing PARENT->{NotifyIcon name} = undef;
my $window = Win32::GUI::GetWindowObject($self->{-handle});
! if(defined $window && tied %$window) {
# Remove id from -notifyicons hash
delete $window->{-notifyicons}->{$self->{-id}} if defined
$window->{-notifyicons};
Index: CHANGELOG
===================================================================
RCS file: /cvsroot/perl-win32-gui/Win32-GUI/CHANGELOG,v
retrieving revision 1.106
retrieving revision 1.107
diff -C2 -d -r1.106 -r1.107
*** CHANGELOG 5 Nov 2006 20:04:49 -0000 1.106
--- CHANGELOG 20 Jan 2007 17:09:22 -0000 1.107
***************
*** 6,9 ****
--- 6,18 ----
Win32-GUI ChangeLog
===================
+ + [Robert May] : 20 January 2007 - Bug Fixes
+ - Tooltip.xs - SetTitle method had warning and info icons
+ swapped. [Brian Millham]
+ - GUI_Helpers.cpp, GUI.pm - fix deleting from parent during global
+ destruction.
+ - Textfield.xs - re-write GetLine() to fix truncation caused by
+ line number being used as a character index, and to correctly
+ return zero lenght lines
+
+ [Robert May] : 5 November 2006 - 1.05 Release
- docs/GUI.pod - update references to v1.05 to v1.06, and v1.06
Index: Textfield.xs
===================================================================
RCS file: /cvsroot/perl-win32-gui/Win32-GUI/Textfield.xs,v
retrieving revision 1.8
retrieving revision 1.9
diff -C2 -d -r1.8 -r1.9
*** Textfield.xs 23 Jun 2006 23:08:07 -0000 1.8
--- Textfield.xs 20 Jan 2007 17:09:22 -0000 1.9
***************
*** 265,269 ****
###########################################################################
# (@)METHOD:GetLine(LINE)
! # Return line of text.
void
GetLine(handle, line)
--- 265,273 ----
###########################################################################
# (@)METHOD:GetLine(LINE)
! # Get a line of text.
! # LINE: zero based index to the line to be retrieved
! #
! # Returns the text of the line. Returns undef if LINE is
! # greater than the number of lines in the Textfied.
void
GetLine(handle, line)
***************
*** 273,295 ****
Win32::GUI::RichEdit::GetLine = 1
CODE:
! UINT size = SendMessage(handle, EM_LINELENGTH, line, 0);
! if (size > 0) {
! char * pBuf = (char *) safemalloc(size + 16);
! *((short*) pBuf) = size + 8;
! size = SendMessage(handle, EM_GETLINE, line, (LPARAM) pBuf);
! if (size > 0) {
! pBuf[size] = '\0';
! EXTEND(SP, 1);
! XST_mPV(0, pBuf);
! safefree(pBuf);
! XSRETURN(1);
! }
! else {
! safefree(pBuf);
! XSRETURN_UNDEF;
! }
! }
! else
XSRETURN_UNDEF;
###########################################################################
--- 277,328 ----
Win32::GUI::RichEdit::GetLine = 1
CODE:
! LONG index;
! WORD size;
! LPTSTR pBuf;
!
! index = (LONG)SendMessage(handle, EM_LINEINDEX, line, 0);
! if (index < 0) { /* -1 if line greater than number of lines in control */
XSRETURN_UNDEF;
+ }
+
+ size = (WORD)SendMessage(handle, EM_LINELENGTH, (WPARAM)index, 0);
+ /* we don't check the error condition of size == 0, as we have
+ * already checked the return value from EM_LINEINDEX, and have a valid
+ * index. A return value of zero means we have an empty line, and
+ * should return that.
+ */
+
+ /* ensure buffer is big enough to hold a WORD */
+ if (size < sizeof(WORD) ) {
+ size = (sizeof(WORD)/sizeof(TCHAR));
+ }
+ /* allocate buffer, adding one for the NUL termination */
+ /* TODO: The strategy used here results in the buffer being
+ * copied twice: once from the textfield to pBuf, and then
+ * a second time from pBuf into the SV. We should create
+ * an SV of the correct size, and pass the pointer to it's
+ * buffer to EM_GETLINE
+ */
+ New(0, pBuf, (int)(size+1), TCHAR);
+
+ /* put the size into the first word of the buffer */
+ *((WORD*)pBuf) = size;
+
+ /* get the text */
+ size = (WORD)SendMessage(handle, EM_GETLINE, line, (LPARAM)pBuf);
+ /* Again, we don't check the error condition of size == 0, as we have
+ * already checked the return value from EM_LINEINDEX, and have a valid
+ * line. A return value of zero means we have an empty line, and
+ * should return that.
+ */
+
+ /* ensure we are NUL terminated - this is NOT done by EM_GETLINE */
+ pBuf[size] = 0;
+
+ /* return the text */
+ EXTEND(SP, 1);
+ XST_mPV(0, pBuf);
+ Safefree(pBuf);
+ XSRETURN(1);
###########################################################################
Index: Tooltip.xs
===================================================================
RCS file: /cvsroot/perl-win32-gui/Win32-GUI/Tooltip.xs,v
retrieving revision 1.9
retrieving revision 1.10
diff -C2 -d -r1.9 -r1.10
*** Tooltip.xs 30 Aug 2006 21:57:58 -0000 1.9
--- Tooltip.xs 20 Jan 2007 17:09:22 -0000 1.10
***************
*** 1105,1111 ****
if(strcmp(icon, "error") == 0) {
i = 3;
- } else if(strcmp(icon, "info") == 0) {
- i = 2;
} else if(strcmp(icon, "warning") == 0) {
i = 1;
} else if(strcmp(icon, "none") == 0) {
--- 1105,1111 ----
if(strcmp(icon, "error") == 0) {
i = 3;
} else if(strcmp(icon, "warning") == 0) {
+ i = 2;
+ } else if(strcmp(icon, "info") == 0) {
i = 1;
} else if(strcmp(icon, "none") == 0) {
Index: GUI_Helpers.cpp
===================================================================
RCS file: /cvsroot/perl-win32-gui/Win32-GUI/GUI_Helpers.cpp,v
retrieving revision 1.22
retrieving revision 1.23
diff -C2 -d -r1.22 -r1.23
*** GUI_Helpers.cpp 30 Aug 2006 21:57:58 -0000 1.22
--- GUI_Helpers.cpp 20 Jan 2007 17:09:22 -0000 1.23
***************
*** 93,97 ****
SV* SvParent = SV_SELF_FROM_WINDOW(parent);
if (SvParent != NULL && SvROK(SvParent)) {
! hv_delete((HV*) SvRV(SvParent), perlud->szWindowName,
strlen(perlud->szWindowName), G_DISCARD);
}
}
--- 93,109 ----
SV* SvParent = SV_SELF_FROM_WINDOW(parent);
if (SvParent != NULL && SvROK(SvParent)) {
! /* During global destruction it is possible that the
! * underlying object supporting our tied hash is
! * destroyed before the object itself, this results in
! * fatal errors "(during cleanup) Can't call method
! * "DELETE" on an undefined value" - so we check that
! * the tied magic is still there before we try to
! * delete from the parent
! */
! MAGIC* mg;
! if ( (mg = mg_find(SvRV(SvParent), PERL_MAGIC_tied))
&& SvROK(mg->mg_obj) ) {
! hv_delete((HV*) SvRV(SvParent),
perlud->szWindowName,
! strlen(perlud->szWindowName),
G_DISCARD);
! }
}
}
Index: GUI.h
===================================================================
RCS file: /cvsroot/perl-win32-gui/Win32-GUI/GUI.h,v
retrieving revision 1.30
retrieving revision 1.31
diff -C2 -d -r1.30 -r1.31
*** GUI.h 30 Aug 2006 21:57:58 -0000 1.30
--- GUI.h 20 Jan 2007 17:09:22 -0000 1.31
***************
*** 368,371 ****
--- 368,375 ----
#endif
+ #ifndef PERL_MAGIC_tied
+ # define PERL_MAGIC_tied 'P' /* Tied array or hash */
+ #endif
+
/*
* other useful things
