# strip everything before this # cd to your version of Tk-804.025_beta13 # and feed this file to /bin/sh # # touch t/listvar.t chmod 0444 t/listvar.t touch demos/demos/widget_lib/virtevents1.pl chmod 0444 demos/demos/widget_lib/virtevents1.pl touch pod/804delta.pod chmod 0444 pod/804delta.pod touch demos/demos/widget_lib/keysyms.pl chmod 0444 demos/demos/widget_lib/keysyms.pl patch -p1 -N <<'__END_OF_PATCH__' Index: Canvas/Canvas.pm --- Tk-804.025_beta13/Canvas/Canvas.pm 2003-12-21 14:20:15.000000000 +0000 +++ Tk-804.025_beta14/Canvas/Canvas.pm 2003-12-29 16:32:54.000000000 +0000 @@ -1,6 +1,6 @@ package Tk::Canvas; use vars qw($VERSION); -$VERSION = sprintf '4.%03d', q$Revision: #8 $ =~ /\D(\d+)\s*$/; +$VERSION = sprintf '4.%03d', q$Revision: #9 $ =~ /\D(\d+)\s*$/; use Tk qw($XS_VERSION); @@ -1124,7 +1124,7 @@ # if {[catch {format %04X [scan $enc %c]} hexcode]} {set hexcode {}} my $ch = chr($i+$j); my $hexcode = sprintf("%04X",ord($ch)); - $result .= '/'.((exists $psglyphs{$hexcode}) ? $psglyphs{$hexcode} : 'space'); + $result .= '/'.((exists $Tk::psglyphs->{$hexcode}) ? $Tk::psglyphs->{$hexcode} : 'space'); } $result .= "\n"; } @@ -1139,7 +1139,7 @@ 50 dict begin % This is a standard prolog for Postscript generated by Tk's canvas % widget. -% RCS: @(#) $Id: //depot/Tkutf8/Canvas/Canvas.pm#8 $ +% RCS: @(#) $Id: //depot/Tkutf8/Canvas/Canvas.pm#9 $ % The definitions below just define all of the variables used in % any of the procedures here. This is needed for obscure reasons Index: Change.log --- Tk-804.025_beta13/Change.log 2003-12-23 23:00:25.000000000 +0000 +++ Tk-804.025_beta14/Change.log 2004-01-12 21:38:49.000000000 +0000 @@ -1,3 +1,103 @@ +Change 3124 on 2004/01/12 by nick@camel + + Auto generated files for device context debug + +Change 3123 on 2004/01/12 by nick@camel + + Fix tix Pixmap image type leaking device contexts + and color maps on Win32. (the t/pixmap.t issue) + Leave debugging hooks in place. + +Change 3122 on 2004/01/11 by nick@camel + + On Win32 Pixmap/Bitmap are distinct so + we need to see what kind of thing we are using as + an icon to free it. (Botched merge of imageicon stuff.) + Note on XP still not getting the icon... + +Change 3121 on 2004/01/11 by nick@camel + + Win32's abort() doesn't do backtrace, + so have Tcl_Panic de-ref NULL to get one. + +Change 3120 on 2004/01/10 by nick@llama + + Slaven's fix for BUG: dlineinfo returns a scalar + +Change 3119 on 2004/01/10 by nick@llama + + Move use 5.007 above use open IO => ':bytes' to get + better error messages on perl5.6 (as suggested by Slaven) + +Change 3118 on 2004/01/10 by nick@llama + + Win32Drop fix as requested by + John Cavanaugh + +Change 3117 on 2004/01/10 by nick@llama + + eventGenerate batch from newsgroup via Steve. + +Change 3099 on 2004/01/02 by nick@llama + + Tk-804.025_beta14 Release Preparation + +Change 3098 on 2004/01/02 by nick@llama + + Steve's patch for new demos + extra t/button.t + +Change 3089 on 2003/12/30 by nick@llama + + Copy in Jack version of Text.pod + with some text from "Mastering Perl/Tk" used with permission. + +Change 3088 on 2003/12/30 by nick@llama + + Alternate way to honour iccm timestamp for WM_TAKE_FOCUS + ClientMessage-s - reverts change 3013. tkUnixWm.c takes timestamp + from message as lastEventTime. (No point for tkWinWm as timestamps + are faked anyway.) Then tkUnixFocus.c uses TkCurrentTime() to + set focus. + +Change 3087 on 2003/12/30 by nick@llama + + More PNG configure stuff: + try and match $^O to scripts/makefile.* + +Change 3084 on 2003/12/29 by nick@llama + + Slaven's fix for text in canvas postscript + +Change 3083 on 2003/12/29 by nick@llama + + Slaven's compound addition to menu demo + +Change 3082 on 2003/12/29 by nick@llama + + More tests which now seem to work. + +Change 3081 on 2003/12/29 by nick@llama + + Tk::GetCwd muddle - C now calls Cwd::getcwd and Tk.pm + makes sure it is loaded. + +Change 3080 on 2003/12/29 by nick@llama + + Spinbox fast-click fix from Slaven + +Change 3079 on 2003/12/29 by nick@llama + + Start of -listvar fix + +Change 3078 on 2003/12/24 by nick@llama + + Add Slaven's 804delta.pod + +Change 3077 on 2003/12/23 by nick@llama + + Tk-804.025_beta13 Release Preparation + Change 3076 on 2003/12/23 by nick@llama Generated file out of date Index: DragDrop/Win32Site/Win32Site.pm --- Tk-804.025_beta13/DragDrop/Win32Site/Win32Site.pm 2003-12-14 19:44:50.000000000 +0000 +++ Tk-804.025_beta14/DragDrop/Win32Site/Win32Site.pm 2004-01-10 17:48:14.000000000 +0000 @@ -1,7 +1,7 @@ package Tk::DragDrop::Win32Site; use vars qw($VERSION); -$VERSION = sprintf '4.%03d', q$Revision: #6 $ =~ /\D(\d+)\s*$/; +$VERSION = sprintf '4.%03d', q$Revision: #7 $ =~ /\D(\d+)\s*$/; use Tk qw($XS_VERSION); require DynaLoader; @@ -32,6 +32,7 @@ my ($w,$site,$msg,$wParam,$lParam) = @_; my ($x,$y,@files) = DropInfo($wParam); my $cb = $site->{'-dropcommand'}; + $site->Apply(-entercommand => $x, $y, 0); if ($cb) { foreach my $file (@files) @@ -42,6 +43,7 @@ $cb->Call('CLIPBOARD',$x,$y); } } + $site->Apply(-entercommand => $x, $y, 1); return 0; } Index: Event/Event.xs --- Tk-804.025_beta13/Event/Event.xs 2003-12-07 13:28:21.000000000 +0000 +++ Tk-804.025_beta14/Event/Event.xs 2004-01-12 21:31:32.000000000 +0000 @@ -75,6 +75,13 @@ PerlIO_vprintf(PerlIO_stderr(), fmt, ap); PerlIO_putc(PerlIO_stderr(),'\n'); va_end(ap); +#if defined(WIN32) && defined(DEBUGGING) + { + int *p = 0; + if (*p) + abort(); + } +#endif abort(); croak("Tcl_Panic"); } Index: MANIFEST --- Tk-804.025_beta13/MANIFEST 2003-12-23 18:35:48.000000000 +0000 +++ Tk-804.025_beta14/MANIFEST 2004-01-02 18:41:44.000000000 +0000 @@ -130,6 +130,7 @@ demos/demos/widget_lib/image1.pl demos/demos/widget_lib/image2.pl demos/demos/widget_lib/items.pl +demos/demos/widget_lib/keysyms.pl demos/demos/widget_lib/labframe.pl demos/demos/widget_lib/labelframe.pl demos/demos/widget_lib/labels.pl @@ -162,6 +163,7 @@ demos/demos/widget_lib/transtile.pl demos/demos/widget_lib/twind.pl demos/demos/widget_lib/unicodeout.pl +demos/demos/widget_lib/virtevents1.pl demos/demos/widget_lib/vscale.pl demos/demos/widget_lib/WidgetDemo.pm demos/demos/widtrib/Gedi.pl @@ -796,6 +798,7 @@ PNG/zlib/zlib.html PNG/zlib/zutil.c PNG/zlib/zutil.h +pod/804delta.pod pod/Adjuster.pod pod/after.pod pod/Animation.pod @@ -1853,6 +1856,7 @@ t/leak.t t/list.t t/listbox.t +t/listvar.t t/magic.t t/mega.t t/mwm.t Index: Makefile.PL --- Tk-804.025_beta13/Makefile.PL 2003-12-22 13:06:25.000000000 +0000 +++ Tk-804.025_beta14/Makefile.PL 2004-01-10 17:48:50.000000000 +0000 @@ -1,5 +1,5 @@ -use open IO => ':bytes'; use 5.007; +use open IO => ':bytes'; use Cwd; use Config; no lib '.'; Index: PNG/libpng/Makefile.maybe --- Tk-804.025_beta13/PNG/libpng/Makefile.maybe 2003-11-29 11:39:29.000000000 +0000 +++ Tk-804.025_beta14/PNG/libpng/Makefile.maybe 2003-12-30 10:46:06.000000000 +0000 @@ -1,7 +1,7 @@ #!perl +use strict; use Config; use File::Copy; -my $file; chmod(0666,'Makefile'); my $file; @@ -23,15 +23,23 @@ } else { - if ($Config{'cc'} =~ /gcc/) + if ($Config{'gccversion'}) { $file = 'scripts/makefile.gcc'; } else { - warn "If make fails read libpng/INSTALL\n"; $file = 'scripts/makefile.std'; + my %makefiles = map { /makefile\.(.*)/ && ($1 => $_) } glob('scripts/makefile.*'); + foreach my $arch (sort keys %makefiles) + { + if ($^O =~ /$arch/i) + { + $file = $makefiles{$arch}; + } + } } + warn "Using $file for $^O\nIf make fails read PNG/libpng/INSTALL\n"; } copy($file,"Makefile") Index: PNG/zlib/Makefile.maybe --- Tk-804.025_beta13/PNG/zlib/Makefile.maybe 2003-12-23 10:56:27.000000000 +0000 +++ Tk-804.025_beta14/PNG/zlib/Makefile.maybe 2003-12-30 10:43:43.000000000 +0000 @@ -2,7 +2,7 @@ use Cwd; use Config; use File::Copy; -warn __FILE__." in ".getcwd()."\n"; +#warn __FILE__." in ".getcwd()."\n"; if ($^O eq 'MSWin32') { my $file; Index: README --- Tk-804.025_beta13/README 2003-12-21 12:26:54.000000000 +0000 +++ Tk-804.025_beta14/README 2004-01-12 21:38:31.000000000 +0000 @@ -1,6 +1,6 @@ Tk is a Graphical User Interface ToolKit. -Copyright (c) 1995-2003 Nick Ing-Simmons. All rights reserved. +Copyright (c) 1995-2004 Nick Ing-Simmons. All rights reserved. This package is free software; you can redistribute it and/or modify it under the same terms as Perl itself, with the exception of all the files in the pTk sub-directory which have separate terms Index: Tk.pm --- Tk-804.025_beta13/Tk.pm 2003-12-23 23:00:25.000000000 +0000 +++ Tk-804.025_beta14/Tk.pm 2004-01-12 21:38:50.000000000 +0000 @@ -1,7 +1,7 @@ # # Copyright (c) 1992-1994 The Regents of the University of California. # Copyright (c) 1994 Sun Microsystems, Inc. -# Copyright (c) 1995-2003 Nick Ing-Simmons. All rights reserved. +# Copyright (c) 1995-2004 Nick Ing-Simmons. All rights reserved. # This program is free software; you can redistribute it and/or # modify it under the same terms as Perl itself, subject @@ -13,6 +13,7 @@ use Tk::Event (); use AutoLoader qw(AUTOLOAD); use DynaLoader; +use Cwd(); use base qw(Exporter DynaLoader); *fileevent = \&Tk::Event::IO::fileevent; @@ -61,7 +62,7 @@ use Carp; # Record author's perforce depot record -$Tk::CHANGE = q$Change: 3077 $; +$Tk::CHANGE = q$Change: 3125 $; # $tk_version and $tk_patchLevel are reset by pTk when a mainwindow # is created, $VERSION is checked by bootstrap Index: Tk/Spinbox.pm --- Tk-804.025_beta13/Tk/Spinbox.pm 2003-08-24 09:50:05.000000000 +0100 +++ Tk-804.025_beta14/Tk/Spinbox.pm 2004-01-02 19:02:36.000000000 +0000 @@ -2,7 +2,7 @@ use strict; use vars qw($VERSION); -$VERSION = sprintf '4.%03d',q$Revision: #4 $ =~ /#(\d+)/; +$VERSION = sprintf '4.%03d',q$Revision: #6 $ =~ /#(\d+)/; use base 'Tk::Entry'; @@ -100,7 +100,7 @@ my $elem = $w->{_element}; if (defined($elem) && $elem ne 'entry') { - my $repeated = delete $w->{_repeated}; + my $repeated = $w->{_repeated}; if (defined($repeated) && !$repeated) { $w->invoke($elem); Index: demos/demos/widget_lib/keysyms.pl --- /dev/null 2003-09-23 18:59:22.000000000 +0100 +++ Tk-804.025_beta14/demos/demos/widget_lib/keysyms.pl 2004-01-02 18:41:47.000000000 +0000 @@ -0,0 +1,20 @@ +use strict; + +sub keysyms { + + my( $demo ) = @_; + + my $mw = $MW->WidgetDemo( + -name => $demo, + -text => 'This demonstration displays the keysym for any keyboard character.', + -title => 'Display Keysyms', + -iconname => 'keysyms', + ); + + $mw->Label( qw/ -relief solid -width 20 /, -textvariable => \my $k )->pack; + + $mw->bind( '' => sub { + $k = sprintf( "%s", $Tk::event->K ); + }); + +} # end keysyms Index: demos/demos/widget_lib/mega.pl --- Tk-804.025_beta13/demos/demos/widget_lib/mega.pl 2003-12-22 18:30:10.000000000 +0000 +++ Tk-804.025_beta14/demos/demos/widget_lib/mega.pl 2004-01-02 18:41:54.000000000 +0000 @@ -74,7 +74,7 @@ my($self, $args) = @_; $self->SUPER::Populate($args); $self->Advertise(); # advertise subwidgets - $self->Callback(); # create -command callbacks + $self->Callback(); # invoke -command callbacks $self->Component(); # define a subwidget component $self->ConfigSpecs(); # define cget() / configure() options $self->Delegates(); # how methods are delegated to subwidgets Index: demos/demos/widget_lib/menus.pl --- Tk-804.025_beta13/demos/demos/widget_lib/menus.pl 2003-08-28 20:42:51.000000000 +0100 +++ Tk-804.025_beta14/demos/demos/widget_lib/menus.pl 2003-12-29 16:29:25.000000000 +0000 @@ -39,8 +39,10 @@ } my $f = $menubar->cascade(-label => '~File', -tearoff => 0); - $f->command(-label => 'Open ...', -command => [\&menus_error, 'Open']); - $f->command(-label => 'New', -command => [\&menus_error, 'New']); + $f->command(-label => 'Open ...', -command => [\&menus_error, 'Open'], + -image => $toplevel->Getimage("openfile"), -compound => "left"); + $f->command(-label => 'New', -command => [\&menus_error, 'New'], + -image => $toplevel->Getimage("file"), -compound => "left"); $f->command(-label => 'Save', -command => [\&menus_error, 'Save']); $f->command(-label => 'Save As ...', -command => [\&menus_error, 'Save As']); $f->separator; Index: demos/demos/widget_lib/menus2.pl --- Tk-804.025_beta13/demos/demos/widget_lib/menus2.pl 2003-08-28 20:42:51.000000000 +0100 +++ Tk-804.025_beta14/demos/demos/widget_lib/menus2.pl 2003-12-29 16:29:27.000000000 +0000 @@ -40,8 +40,14 @@ my $f = $menubar->Cascade(qw/-label ~File -tearoff 0 -menuitems/ => [ - [Button => 'Open ...', -command => [\&menus_error2, 'Open']], - [Button => 'New', -command => [\&menus_error2, 'New']], + [Button => 'Open ...', -command => [\&menus_error2, 'Open'], + -image => $toplevel->Getimage("openfile"), + -compound=> "left", + ], + [Button => 'New', -command => [\&menus_error2, 'New'], + -image => $toplevel->Getimage("file"), + -compound=> "left", + ], [Button => 'Save', -command => [\&menus_error2, 'Save']], [Button => 'Save As ...', -command => [\&menus_error2, 'Save As']], [Separator => ''], Index: demos/demos/widget_lib/virtevents1.pl --- /dev/null 2003-09-23 18:59:22.000000000 +0100 +++ Tk-804.025_beta14/demos/demos/widget_lib/virtevents1.pl 2004-01-02 18:41:54.000000000 +0000 @@ -0,0 +1,59 @@ +use strict; + +sub virtevents1 { + + my( $demo ) = @_; + + my $mw = $MW->WidgetDemo( + -name => $demo, + -text => [ "This demonstration shows how you can use keysyms (keyboard symbols) to programmatically synthesize events that simulate a person typing on the keyboard. To learn about keyboard keysyms, run to previous demonstration, \"Show keyboard symbols\". + +A virtual event named <> is defined that is activated by pressing the \"caps lock\" key (go ahead, press \"caps lock\"). A callback is bound to that virtual event - the callback synthesizes physicals events that \"type\" into the Entry widget displayed below. Pressing the \"Synthesize\" Button calls eventGenerate(), which synthesizes the virtual event <> directly. + +Warning: it's easy to make this demonstration recurse indefinitely because synthesized physical events behave just like the real thing. So, it's possible for the <> callback to eventGenerate() the keysym that activates the <> virtual event, which invokes the <> callback to eventGenerate() the keysym that activates the <> virtual event, which ...", -wraplength => '6i' ], + -title => 'Simulate KeyPress events.', + -iconname => 'vevents1', + ); + + # Define a virtual event - <> - that is activated when + # the physical event - pressing the "caps lock" key - occurs. + + $mw->eventAdd( qw/ <> / ); + + # Alphabetics are their own keysyms. The %keysyms hash maps other + # characters to their keysym string. To see the keysyms associated + # with keyboard characters run the previous widget demonstration. + + my %keysyms = (' ' => 'space', '/' => 'slash', '!' => 'exclam' ); + + # Create an Entry widget for a person or this program to type into. + # The Button explicitly generates the virtual event. + + my $e = $mw->Entry->pack; + my $b = $mw->Button( + -command => sub { $mw->eventGenerate( '<>' ) }, + -text => 'Synthesize <>', + )->pack; + + # Now bind the virtual event to a callback that "types" for us. + + $mw->bind( qw/ <> / => sub { + + # This subroutine is invoked whenever the "caps lock" key is + # pressed or the virtual event <> is programatically + # generated via eventGenerate. + + $e->focus; + $mw->update; + my $string_to_type = 'Perl/Tk rules!'; + + foreach ( split '', $string_to_type ) { + $_ = $keysyms{$_} if exists $keysyms{$_}; + $e->eventGenerate( '', -keysym => $_ ); + $mw->idletasks; + $mw->after( 100 ); + + } # end sub type characters + } ); + +} # end virtevents1 Index: demos/widget --- Tk-804.025_beta13/demos/widget 2003-12-22 18:30:20.000000000 +0000 +++ Tk-804.025_beta14/demos/widget 2004-01-02 18:42:02.000000000 +0000 @@ -1,6 +1,7 @@ #!/usr/local/bin/perl -w use 5.008; +use Config; use Tk 804.000; use lib Tk->findINC( 'demos/widget_lib' ); use Tk::widgets qw/ DialogBox ErrorDialog LabEntry ROText /; @@ -250,6 +251,8 @@ 'dialog2' => 'A dialog box with a global grab', 'trace1' => 'Trace a variable\'s value', 'progress' => 'Various ProgressBar widgets', + 'keysyms' => 'Show keyboard symbols', + 'virtevents1' => 'Synthesizing events', ); $T->insert('end', "\n", '', "User Contributed Demonstrations\n", 'title'); @@ -307,13 +310,13 @@ my $df = $dialog->add( 'Labelframe', -text => ' 2004 - Jan - 02 ' ); $df->pack( qw/ -fill both -expand 1 / ); my( $change ) = $Tk::CHANGE =~ /Change:\s+(.*)/; - my( $tk ) = "$Tk::VERSION, change $change"; + my( $tk ) = "$Tk::VERSION, change $change (based on Tcl/Tk ${Tk::version}.x)"; foreach my $item ( - [ 'Perl', $] ], - [ 'Tk', $tk ], - [ 'Platform', $Tk::platform ], - [ 'Library', $Tk::library ], + [ 'Perl', "$], $Config{cf_time}" ], + [ 'Tk', $tk ], + [ 'Platform', $Tk::platform ], + [ 'Library', $Tk::library ], ) { my $l = $item->[0] . ':'; my $le = $df->LabEntry( Index: objGlue.c --- Tk-804.025_beta13/objGlue.c 2003-12-21 19:44:25.000000000 +0000 +++ Tk-804.025_beta14/objGlue.c 2003-12-29 14:33:45.000000000 +0000 @@ -1372,7 +1372,7 @@ TclObjMagic_t *info = (TclObjMagic_t *)SvPVX(mg->mg_obj); LangDebug("%s %p %s\n",__FUNCTION__,sv,info->type->name); #endif - sv_unmagic(sv,'~'); /* sv_unmagic calls free proc */ + sv_unmagic(sv,PERL_MAGIC_ext); /* sv_unmagic calls free proc */ return 0; } @@ -1393,7 +1393,7 @@ TclObjMagic_t *info = (TclObjMagic_t *)SvPVX(mg->mg_obj); LangDebug("%s %p %s\n",__FUNCTION__,sv,info->type->name); #endif - sv_unmagic(sv,'~'); /* sv_unmagic calls free proc */ + sv_unmagic(sv,PERL_MAGIC_ext); /* sv_unmagic calls free proc */ return 0; } @@ -1410,7 +1410,7 @@ Tcl_ObjMagic(Tcl_Obj *obj,int add) { dTHX; - MAGIC *mg = (SvTYPE(obj) >= SVt_PVMG) ? mg_find(obj,'~') : NULL; + MAGIC *mg = (SvTYPE(obj) >= SVt_PVMG) ? mg_find(obj,PERL_MAGIC_ext) : NULL; SV *data = NULL; TclObjMagic_t *iv; if (mg) @@ -1438,10 +1438,10 @@ if (rdonly) SvREADONLY_off(obj); sv_upgrade(obj,SVt_PVMG); - sv_magic(obj,data,'~',NULL,0); + sv_magic(obj,data,PERL_MAGIC_ext,NULL,0); SvREFCNT_dec(data); SvRMAGICAL_off(obj); - mg = mg_find(obj,'~'); + mg = mg_find(obj,PERL_MAGIC_ext); if (mg->mg_obj != data) abort(); mg->mg_virtual = &TclObj_vtab; @@ -1480,7 +1480,7 @@ { abort(); } - if (!object && SvROK(src) && SvTYPE(SvRV(src)) == SVt_PVAV) + else if (!object && SvROK(src) && SvTYPE(SvRV(src)) == SVt_PVAV) { AV *av = (AV *) SvRV(src); IV max = av_len(av); @@ -1618,7 +1618,7 @@ if (sv) { dTHX; - MAGIC *mg = (SvTYPE(sv) >= SVt_PVMG) ? mg_find(sv,'~') : NULL; + MAGIC *mg = (SvTYPE(sv) >= SVt_PVMG) ? mg_find(sv,PERL_MAGIC_ext) : NULL; if (mg && mg->mg_virtual == &TclObj_vtab) { return Tcl_DuplicateObj(sv); Index: pTk/mTk/generic/tk.h --- Tk-804.025_beta13/pTk/mTk/generic/tk.h 2003-12-23 18:38:43.000000000 +0000 +++ Tk-804.025_beta14/pTk/mTk/generic/tk.h 2004-01-12 21:31:32.000000000 +0000 @@ -1834,6 +1834,9 @@ KeySym keySym, int *numPtr, int *isNum, int *type, int num_size, char *numStorage)); +extern void LangCheckDC _ANSI_ARGS_((const char *file, int line)); + + #undef TCL_STORAGE_CLASS #define TCL_STORAGE_CLASS DLLIMPORT Index: pTk/mTk/generic/tkBind.c --- Tk-804.025_beta13/pTk/mTk/generic/tkBind.c 2003-12-19 11:54:51.000000000 +0000 +++ Tk-804.025_beta14/pTk/mTk/generic/tkBind.c 2004-01-10 17:40:54.000000000 +0000 @@ -3875,6 +3875,8 @@ synch = 1; warp = 0; pos = TCL_QUEUE_TAIL; + event.xkey.x_root = -1; + event.xkey.y_root = -1; for (i = 2; i < objc; i += 2) { Tcl_Obj *optionPtr, *valuePtr; int index; @@ -4242,7 +4244,10 @@ rootX += number; if (flags & (KEY_BUTTON_MOTION_VIRTUAL|CROSSING)) { event.xkey.x = number; - event.xkey.x_root = rootX; + if ( event.xkey.x_root == -1 ) { + event.xkey.x_root = rootX; + } + } else if (flags & EXPOSE) { event.xexpose.x = number; } else if (flags & (CREATE|CONFIG|GRAVITY)) { @@ -4265,7 +4270,9 @@ rootY += number; if (flags & (KEY_BUTTON_MOTION_VIRTUAL|CROSSING)) { event.xkey.y = number; - event.xkey.y_root = rootY; + if ( event.xkey.y_root == -1 ) { + event.xkey.y_root = rootY; + } } else if (flags & EXPOSE) { event.xexpose.y = number; } else if (flags & (CREATE|CONFIG|GRAVITY)) { Index: pTk/mTk/generic/tkText.c --- Tk-804.025_beta13/pTk/mTk/generic/tkText.c 2003-12-19 11:54:55.000000000 +0000 +++ Tk-804.025_beta14/pTk/mTk/generic/tkText.c 2004-01-10 17:51:31.000000000 +0000 @@ -740,9 +740,18 @@ if (TkTextDLineInfo(textPtr, &index1, &x, &y, &width, &height, &base) == 0) { char buf[TCL_INTEGER_SPACE * 5]; + Tcl_Obj *el; + el = Tcl_GetObjResult(interp); + Tcl_ListObjAppendElement(interp,el,Tcl_NewIntObj(x)); + Tcl_ListObjAppendElement(interp,el,Tcl_NewIntObj(y)); + Tcl_ListObjAppendElement(interp,el,Tcl_NewIntObj(width)); + Tcl_ListObjAppendElement(interp,el,Tcl_NewIntObj(height)); + Tcl_ListObjAppendElement(interp,el,Tcl_NewIntObj(base)); + /* sprintf(buf, "%d %d %d %d %d", x, y, width, height, base); Tcl_SetResult(interp, buf, TCL_VOLATILE); + */ } } else if ((c == 'e') && (strncmp(argv[1], "edit", length) == 0)) { result = TextEditCmd(textPtr, interp, argc, argv); Index: pTk/mTk/tixWin/tixWinXpm.c --- Tk-804.025_beta13/pTk/mTk/tixWin/tixWinXpm.c 2003-07-27 17:45:25.000000000 +0100 +++ Tk-804.025_beta14/pTk/mTk/tixWin/tixWinXpm.c 2004-01-12 21:31:32.000000000 +0000 @@ -226,7 +226,7 @@ BitBlt(bitmapDC, 0, 0, w, h, maskDC, 0, 0, SRCAND); BitBlt(maskDC, 0, 0, w, h, maskDC, 0, 0, NOTSRCCOPY); - TkWinReleaseDrawableDC(instancePtr->pixmap, dc, &dcState); + dataPtr->maskDC = maskDC; dataPtr->maskBm = maskBm; dataPtr->maskBmOld = maskBmOld; @@ -236,6 +236,7 @@ dataPtr->bitmapDC = bitmapDC; dataPtr->bitmap = bitmap; dataPtr->bitmapOld = bitmapOld; + TkWinReleaseDrawableDC(instancePtr->pixmap, dc, &dcState); } void Index: pTk/mTk/unix/tkUnixFocus.c --- Tk-804.025_beta13/pTk/mTk/unix/tkUnixFocus.c 2003-12-19 11:55:03.000000000 +0000 +++ Tk-804.025_beta14/pTk/mTk/unix/tkUnixFocus.c 2003-12-30 12:09:57.000000000 +0000 @@ -1,4 +1,4 @@ -/* +/* * tkUnixFocus.c -- * * This file contains platform specific procedures that manage @@ -48,8 +48,8 @@ { TkDisplay *dispPtr = winPtr->dispPtr; Tk_ErrorHandler errHandler; - Window window, root, parent, *children; - unsigned int numChildren, serial; + Window window, root, parent, *children; + unsigned int numChildren, serial; TkWindow *winPtr2; int dummy; @@ -117,8 +117,13 @@ if (winPtr->window == None) { panic("ChangeXFocus got null X window"); } + /* Use TkCurrentTime so we can get timestamp from WM_PROTOCOL + client messages etc. If doing a force focus fallback + to CurrentTime + */ + XSetInputFocus(dispPtr->display, winPtr->window, RevertToParent, - CurrentTime); + TkCurrentTime(dispPtr,force)); Tk_DeleteErrorHandler(errHandler); /* Index: pTk/mTk/unix/tkUnixWm.c --- Tk-804.025_beta13/pTk/mTk/unix/tkUnixWm.c 2003-12-19 11:55:03.000000000 +0000 +++ Tk-804.025_beta14/pTk/mTk/unix/tkUnixWm.c 2003-12-30 11:52:17.000000000 +0000 @@ -5480,7 +5480,8 @@ Tcl_Preserve((ClientData) protPtr); interp = protPtr->interp; Tcl_Preserve((ClientData) interp); - result = LangDoCallback(protPtr->interp, protPtr->command, 0, 1, "%ld", eventPtr->xclient.data.l[1]); + winPtr->dispPtr->lastEventTime = (Time) eventPtr->xclient.data.l[1]; + result = LangDoCallback(protPtr->interp, protPtr->command, 0, 0); if (result != TCL_OK) { Tcl_AddErrorInfo(interp, "\n (command for \""); Tcl_AddErrorInfo(interp, protocolName); Index: pTk/mTk/win/tkWinDraw.c --- Tk-804.025_beta13/pTk/mTk/win/tkWinDraw.c 2003-12-19 11:55:04.000000000 +0000 +++ Tk-804.025_beta14/pTk/mTk/win/tkWinDraw.c 2004-01-12 21:31:32.000000000 +0000 @@ -174,6 +174,7 @@ } state->palette = TkWinSelectPalette(dc, cmap); state->bkmode = GetBkMode(dc); + LangNoteDC(dc,1); return dc; } @@ -208,6 +209,7 @@ } else if (twdPtr->type == TWD_BITMAP) { DeleteDC(dc); } + LangNoteDC(dc,-1); } /* Index: pTk/mTk/win/tkWinInt.h --- Tk-804.025_beta13/pTk/mTk/win/tkWinInt.h 2003-12-19 11:55:04.000000000 +0000 +++ Tk-804.025_beta14/pTk/mTk/win/tkWinInt.h 2004-01-12 21:31:32.000000000 +0000 @@ -202,5 +202,7 @@ extern Tcl_Encoding TkWinGetKeyInputEncoding _ANSI_ARGS_((void)); extern Tcl_Encoding TkWinGetUnicodeEncoding _ANSI_ARGS_((void)); +extern void LangNoteDC _ANSI_ARGS_((HDC dc,int inc)); + #endif /* _TKWININT */ Index: pTk/mTk/win/tkWinWm.c --- Tk-804.025_beta13/pTk/mTk/win/tkWinWm.c 2003-12-19 11:55:05.000000000 +0000 +++ Tk-804.025_beta14/pTk/mTk/win/tkWinWm.c 2004-01-12 21:31:33.000000000 +0000 @@ -2306,12 +2306,6 @@ if (wmPtr->iconName != NULL) { ckfree(wmPtr->iconName); } - if (wmPtr->hints.flags & IconPixmapHint) { - Tk_FreeBitmap(winPtr->display, wmPtr->hints.icon_pixmap); - } - if (wmPtr->hints.flags & IconMaskHint) { - Tk_FreeBitmap(winPtr->display, wmPtr->hints.icon_mask); - } /* Now pixmap and possibly its associated image */ if (wmPtr->hints.flags & IconPixmapHint) { if (wmPtr->iconImage) { @@ -2321,6 +2315,9 @@ Tk_FreeBitmap(winPtr->display, wmPtr->hints.icon_pixmap); } } + if (wmPtr->hints.flags & IconMaskHint) { + Tk_FreeBitmap(winPtr->display, wmPtr->hints.icon_mask); + } if (wmPtr->leaderName != NULL) { ckfree(wmPtr->leaderName); } @@ -5674,7 +5671,7 @@ Tcl_Preserve((ClientData) protPtr); interp = protPtr->interp; Tcl_Preserve((ClientData) interp); - result = LangDoCallback(protPtr->interp, protPtr->command, 0, 1, "%ld", eventPtr->xclient.data.l[1]); + result = LangDoCallback(protPtr->interp, protPtr->command, 0, 0); if (result != TCL_OK) { Tcl_AddErrorInfo(interp, "\n (command for \""); Tcl_AddErrorInfo(interp, name); Index: pTk/tk.m --- Tk-804.025_beta13/pTk/tk.m 2003-12-23 18:38:51.000000000 +0000 +++ Tk-804.025_beta14/pTk/tk.m 2004-01-12 21:33:01.000000000 +0000 @@ -2,6 +2,10 @@ #define _TK_VM #include "tk_f.h" #ifndef NO_VTABLES +#ifndef LangCheckDC +# define LangCheckDC (*TkVptr->V_LangCheckDC) +#endif + #ifndef LangEventCallback # define LangEventCallback (*TkVptr->V_LangEventCallback) #endif Index: pTk/tk.t --- Tk-804.025_beta13/pTk/tk.t 2003-12-23 18:38:51.000000000 +0000 +++ Tk-804.025_beta14/pTk/tk.t 2004-01-12 21:33:01.000000000 +0000 @@ -1,4 +1,10 @@ #ifdef _TK +#ifndef LangCheckDC +#ifndef RC_INVOKED +VFUNC(void,LangCheckDC,V_LangCheckDC,_ANSI_ARGS_((const char *file, int line))) +#endif /* #ifndef RC_INVOKED */ +#endif /* #ifndef LangCheckDC */ + #ifndef LangEventCallback #ifndef RC_INVOKED VFUNC(int,LangEventCallback,V_LangEventCallback,_ANSI_ARGS_((ClientData, Tcl_Interp *,XEvent *,Tk_Window,KeySym))) Index: pod/804delta.pod --- /dev/null 2003-09-23 18:59:22.000000000 +0100 +++ Tk-804.025_beta14/pod/804delta.pod 2003-12-24 09:24:27.000000000 +0000 @@ -0,0 +1,99 @@ +=head1 NAME + +Tk::804delta - what is new for perl/Tk 804 + +=head1 DESCRIPTION + +This document describes differences between the Tk800 series and the +Tk804 series. + +=head1 Incompatible Changes + +Tk804 will only work with perl 5.8.0 and above. For older perl +versions look for Tk800.025. + +B of B now returns an array reference in +scalar context. This means you have to write + + my(@selected) = $listbox->curselection + +or + + my(@selected) = @{ $listbox->curselection } + +now. + +The B method now returns the pixel value instead of the +point value for B<-size>. Pixel values are expressed as negative +numbers. + +Some enhancements from the EdashE patches are lost for now +(i.e. B<-tile>, B<-troughtile> ...). + +The B<-state> option is not available anymore for B tags. +Use B<-elide> instead. + +=head1 Enhancements + +Tk804 is Unicode-aware. + +It is possible to build Tk with Xft support on X11. This is strongly +recommened if you are planning to make use of Unicode rendering +capabilities of Tk. It also gives anti-aliased fonts for regular text +(if you have TrueType or Type1 fonts and they are in your fontconfig +config file). + +The new method B is available as a standard directory +selector. + +B and B are bundled now with the perl/Tk +distribution, providing support for the image formats B and +B. + +Improvements to B: new option B<-activestyle>, new +methods B and B, new virtual event B<<< +<> >>>. + +More tests. + +=head1 New Widgets + +=over + +=item Tk::Labelframe + +An alternative to B. + +=item Tk::Panedwindow + +An alternative to B. + +=item Tk::Spinbox + +An alternative to the CPAN module B. + +=back + +=head1 Selected Bug Fixes + +=head1 Changed Internals + +=head1 Platform Specific Problems + +=head1 Future Directions + +=head1 Reporting Bugs + +If you find what you think is a bug, you might check the articles +recently posted to the comp.lang.perl.tk newsgroup. + +If you believe you have an unreported bug, please send a mail to and/or . Be sure to trim your bug down +to a tiny but sufficient test case. + +=head1 SEE ALSO + +L. + +=cut + + Index: pod/Text.pod --- Tk-804.025_beta13/pod/Text.pod 2003-09-28 12:09:57.000000000 +0100 +++ Tk-804.025_beta14/pod/Text.pod 2003-12-30 12:38:04.000000000 +0000 @@ -1,5 +1,6 @@ # Copyright (c) 1992 The Regents of the University of California. # Copyright (c) 1994-1996 Sun Microsystems, Inc. +# Copyright (c) 2002 O'Reilly & Associates Inc. # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # @@ -167,7 +168,7 @@ text, called tags, marks, embedded windows or embedded images. Tags allow different portions of the text to be displayed with different fonts and colors. -In addition, L can be associated with tags so +In addition, L can be associated with tags so that scripts are invoked when particular actions such as keystrokes and mouse button presses occur in particular ranges of the text. See L<"TAGS"> below for more details. @@ -829,10 +830,18 @@ The widget also inherits all the methods provided by the generic L class. -The following additional methods are available for text widgets: +The following additional methods are available for text widgets. +In addition, the extended text widget methods as documented +in I<"Mastering Perl/Tk"> are included in this pod (with +permission from the publisher, B). =over 4 +=item I<$text>-EB + +Moves the end point of the selection and anchor point to the +mouse pointer location. + =item I<$text>-EB(I) Returns a list of four elements describing the screen area @@ -846,6 +855,22 @@ If the character is not visible on the screen then the return value is an empty list. +=item I<$text>-EB + +Performs a rectangular copy of the currently selected text with +basic compensation for tab characters. + +=item I<$text>-EB + +Performs a rectangular cut of the currently selected text with +basic compensation for tab characters. + +=item I<$text>-EB + +Performs a rectangular paste of the text in the clipboard. The +upper-left corner is specified by the current position of the +insert mark with basic compensation for tab characters. + =item I<$text>-EB(I) Compares the indices given by I and I according @@ -857,6 +882,13 @@ refers to an earlier character in the text than I, and so on. +=item I<$text>-EB(I?) + +Query or change the entire contents of the text widget. If no +arguments are given, the entire contents of the text widget are +returned. If any arguments are given, the entire contents of the +text widget are deleted and replaced by the argument list. + =item I<$text>-EB(?I?) If I is specified, then it must have one of the true or @@ -888,6 +920,18 @@ the text without a newline as the last character. The command returns an empty string. +=item I<$text>-EB + +Delete the currently selected text. + +=item I<$text>-EB(I) + +Delete the text tagged with the I parameter. + +=item I<$text>-EB + +Delete from the insert mark location to the end of line. + =item I<$text>-EB(I) Returns a list with five elements describing the area occupied @@ -971,6 +1015,57 @@ In this case an empty string is returned, and you must query the window by its index position to get more information. +=item I<$text>-EB(I) + +Removes any current selections and then performs a global text +search. All matches are tagged with the B tag. + +I can be be B<-exact> or B<-regexp>. See the B command +for more information + +I can be B<-nocase> or B<-case>. See the B command +for more information + +I is an exact string to match if I is B<-exact> or a +regular expression if the match I is B<-regexp>. + + +=item I<$text>-EB(I) + +Same as the B method, however additionally substitutes the +matched text with the characters I. + +=item I<$text>-EB + +Creates a find-and-replace popup window if one does not already exist. +If there is currently selected text, then the 'find' field will be +'pre-filled' with the selection. + +=item I<$text>-EB(I) + +Removes any current selections and then performs a forward or reverse +text search. All matches are tagged with the B tag. I +can be B<-forward> or B<-reverse>. I and I are +as for the B method. + +=item I<$text>-EB + +Creates a find popup, if one does not yet exist. If there is currently +selected text, then the 'find' field will be 'pre-filled' with the +selection. + +=item I<$text>-EB + +Gets the currently selected text and removes all selections. It then +finds the next exact, case-sensitive string that matches in a forward +direction and selects the text and makes the new selection visible. + +=item I<$text>-EB + +Gets the currently selected text and removes all selections. It then +finds the next exact, case-sensitive string that matches in a reverse +direction and selects the text and makes the new selection visible. + =item I<$text>-EB(I?I?) Return a range of characters from the text. @@ -986,6 +1081,24 @@ If the specified range contains embedded windows, no information about them is included in the returned string. +=item I<$text>-EB + +Return the currently selected text. + +=item I<$text>-EB(I) + +Return the text tagged with the I parameter. + +=item I<$text>-EB(I) + +Set the insert mark to I and ensures the line is +visible. + +=item I<$text>-EB(I) + +Displays a popup, pre-filling it with selected numeric text +(if any), or the line number from B (if any). + =item I<$text>-EB(I