# strip everything before this and feed to /bin/sh # # touch pTk/port.h chmod 0444 pTk/port.h touch pTk/mTk/additions/port.h chmod 0444 pTk/mTk/additions/port.h mkdir lib mkdir lib/Tie touch lib/Tie/Watch.pm chmod 0444 lib/Tie/Watch.pm touch pTk/deArg chmod 0555 pTk/deArg touch Tk/Trace.pm chmod 0444 Tk/Trace.pm touch pTk/mTk/additions/tkAppInit.c chmod 0444 pTk/mTk/additions/tkAppInit.c touch README.cygwin chmod 0444 README.cygwin patch -p1 -N <<'__END_OF_PATCH__' Index: DragDrop/Win32Site/Win32Site.xs --- Tk800.022/DragDrop/Win32Site/Win32Site.xs Tue Jul 27 19:20:04 1999 +++ Tk800.023/DragDrop/Win32Site/Win32Site.xs Sat Dec 30 16:12:37 2000 @@ -3,11 +3,12 @@ This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. */ -#ifndef __GNUC__ #include #include -#endif +#ifdef __CYGWIN__ +# undef WIN32 +#endif #include #include #include Index: DragDrop/site_test --- Tk800.022/DragDrop/site_test Sat Aug 21 21:03:26 1999 +++ Tk800.023/DragDrop/site_test Sat Dec 30 16:12:37 2000 @@ -3,7 +3,11 @@ use strict; use Tk::DropSite; use vars qw($kind $STRING $FILE_NAME); -BEGIN { $kind = ($^O eq 'MSWin32') ? ['Win32'] : ['Sun','XDND','KDE'] } +BEGIN +{ + $kind = ($^O eq 'MSWin32' or ($^O eq 'cygwin' and $Tk::platform eq 'MSWin32'))? + ['Win32'] : ['Sun','XDND','KDE'] +} use Tk::DropSite @$kind; use Tk::DragDrop @$kind; use Tk::Menubar; Index: Entry/Entry.pm --- Tk800.022/Entry/Entry.pm Thu Apr 27 15:41:04 2000 +++ Tk800.023/Entry/Entry.pm Sat Dec 30 16:12:37 2000 @@ -12,7 +12,7 @@ # This program is free software; you can redistribute it and/or use vars qw($VERSION); -$VERSION = '3.035'; # $Id: //depot/Tk8/Entry/Entry.pm#35 $ +$VERSION = '3.037'; # $Id: //depot/Tk8/Entry/Entry.pm#37 $ # modify it under the same terms as Perl itself, subject # to additional disclaimer in license.terms due to partial @@ -503,6 +503,8 @@ my $w = shift; return undef unless $w->selectionPresent; my $str = $w->get; + my $show = $w->cget('-show'); + $str = $show x length($str) if (defined $show); my $s = $w->index('sel.first'); my $e = $w->index('sel.last'); return substr($str,$s,$e+1-$s); Index: Event/Event.pm --- Tk800.022/Event/Event.pm Sat Apr 29 10:36:41 2000 +++ Tk800.023/Event/Event.pm Sat Dec 30 16:12:37 2000 @@ -1,8 +1,8 @@ package Tk::Event; use vars qw($VERSION $XS_VERSION @EXPORT_OK); END { CleanupGlue() } -$VERSION = '3.023'; # $Id: //depot/Tk8/Event/Event.pm#23 $ -$XS_VERSION = '800.022'; +$VERSION = '3.024'; # $Id: //depot/Tk8/Event/Event.pm#24 $ +$XS_VERSION = '800.023'; require DynaLoader; use base qw(Exporter DynaLoader); @EXPORT_OK = qw($XS_VERSION DONT_WAIT WINDOW_EVENTS FILE_EVENTS Index: Event/Event.xs --- Tk800.022/Event/Event.xs Sat Apr 15 17:36:41 2000 +++ Tk800.023/Event/Event.xs Sat Apr 7 17:24:02 2001 @@ -425,11 +425,18 @@ PerlIO *io = IoIFP(filePtr->io); if (io) { +#ifdef PERLIO_LAYERS + if (PerlIO_has_cntptr(io) && PerlIO_get_cnt(io) > 0) + { + filePtr->readyMask |= TCL_READABLE; + } +#else /* Turn this buffer stuff off for now */ - if (0 && PerlIO_has_cntptr(io) && PerlIO_get_cnt(io) > 0) + if (PerlIO_has_cntptr(io) && PerlIO_get_cnt(io) > 0) { filePtr->readyMask |= TCL_READABLE; } +#endif } } return (filePtr->readyMask & TCL_READABLE); @@ -492,7 +499,7 @@ } void -PerlIO_debug(filePtr,s) +TkPerlIO_debug(filePtr,s) PerlIOHandler *filePtr; char *s; { @@ -774,7 +781,7 @@ croak("Invalid handler type %d",mask); } } - return (cb) ? LangCallbackArg(cb) : &PL_sv_undef; + return (cb) ? LangCallbackObj(cb) : &PL_sv_undef; } void @@ -1106,14 +1113,18 @@ IV Const_ALL_EVENTS() -MODULE = Tk::Event PACKAGE = Tk::Event::IO PREFIX = PerlIO_ +MODULE = Tk::Event PACKAGE = Tk::Event::IO PREFIX = TkPerlIO_ PROTOTYPES: DISABLE void -PerlIO_debug(filePtr,s) +TkPerlIO_debug(filePtr,s) PerlIOHandler * filePtr char * s + +MODULE = Tk::Event PACKAGE = Tk::Event::IO PREFIX = PerlIO_ + +PROTOTYPES: DISABLE SV * PerlIO_TIEHANDLE(class,fh,mask = 0) Index: Event/pTkCallback.c --- Tk800.022/Event/pTkCallback.c Fri Apr 21 09:13:10 2000 +++ Tk800.023/Event/pTkCallback.c Sat Dec 30 16:12:37 2000 @@ -110,8 +110,8 @@ SvREFCNT_dec(sv); } -Arg -LangCallbackArg(sv) +Tcl_Obj * +LangCallbackObj(sv) SV *sv; { if (sv && !sv_isa(sv,"Tk::Callback")) @@ -119,7 +119,18 @@ warn("non-Callback arg"); sv_dump(sv); } - /* Do _NOT_ increment REFCNT - like Widgets, Fonts, etc. */ + return SvREFCNT_inc(sv); +} + +Arg +LangOldCallbackArg(sv,file,line) +SV *sv; +char *file; +int line; +{ + LangDebug("%s:%d: LangCallbackArg is deprecated\n",file,line); + sv = LangCallbackObj(sv); + SvREFCNT_dec(sv); return sv; } Index: IO/IO.xs --- Tk800.022/IO/IO.xs Sat Jul 31 10:45:19 1999 +++ Tk800.023/IO/IO.xs Sat Dec 30 16:12:37 2000 @@ -79,7 +79,7 @@ static int restore_mode _((PerlIO *f,int mode)); static int make_nonblock _((PerlIO *f,int *mode,int *newmode)); -#ifdef __WIN32__ +#if defined(__WIN32__) && !defined(__CYGWIN__) static int make_nonblock(f,mode,newmode) PerlIO *f; Index: MANIFEST --- Tk800.022/MANIFEST Mon May 1 21:14:25 2000 +++ Tk800.023/MANIFEST Sat Dec 30 16:12:37 2000 @@ -122,6 +122,7 @@ README.SCO README.SVR4 README.Solaris +README.cygwin README.linux README.os2 README.ultrix @@ -229,6 +230,7 @@ Tk/Tk.xbm Tk/Tk.xpm Tk/Toplevel.pm +Tk/Trace.pm Tk/Widget.pm Tk/Wm.pm Tk/X11Font.pm @@ -488,6 +490,7 @@ lbformat_demo leak_test lentry +lib/Tie/Watch.pm linux-progbar-toy local_demo ls_table @@ -545,6 +548,7 @@ pTk/config/Hstrtoul.c pTk/config/Xdummy.c pTk/counts +pTk/deArg pTk/defs pTk/fakeld pTk/findX @@ -585,6 +589,8 @@ pTk/mTk/additions/imgXBM.c pTk/mTk/additions/imgXPM.c pTk/mTk/additions/pTk.exc +pTk/mTk/additions/port.h +pTk/mTk/additions/tkAppInit.c pTk/mTk/generic/README pTk/mTk/generic/default.h pTk/mTk/generic/ks_names.h @@ -1125,6 +1131,7 @@ pTk/mkneed pTk/p4e pTk/patchlevel.h +pTk/port.h pTk/process_object pTk/ptkCanvGrid.c pTk/ptkCanvGroup.c Index: MANIFEST.SKIP --- Tk800.022/MANIFEST.SKIP Mon Mar 13 12:36:37 2000 +++ Tk800.023/MANIFEST.SKIP Sat Dec 30 16:12:37 2000 @@ -101,6 +101,7 @@ pTk/pkgd\.c$ pTk/pkge\.c$ pTk/pkgf\.c$ +pTk/port\.h$ pTk/regexp\.c$ pTk/samAppInit\.c$ pTk/stbDItem\.c$ Index: Makefile.PL --- Tk800.022/Makefile.PL Sat Apr 29 10:28:28 2000 +++ Tk800.023/Makefile.PL Sat Dec 30 16:12:37 2000 @@ -6,12 +6,12 @@ { $IsWin32 = ($^O eq 'MSWin32' || $Config{'ccflags'} =~ /-D_?WIN32_?/); - $VERSION = '800.022'; + $VERSION = '800.023'; $win_arch = shift @ARGV if @ARGV and $ARGV[0] =~ /^(open32|pm|x|MSWin32)$/; require('fix_4_os2.pl'), OS2_massage() if $^O eq 'os2'; - $win_arch = ($IsWin32) ? 'MSWin32' : 'x' + $win_arch = ($IsWin32 or $^O eq 'cygwin') ? 'MSWin32' : 'x' if not defined $win_arch; # Currently 'x', 'pm', 'open32', 'MSWin32' require "./myConfig"; @@ -107,6 +107,10 @@ 'pTk\\tkres$(OBJ_EXT)' : 'pTk\\tk.res'); } } + if ($win_arch eq 'MSWin32' and $^O eq 'cygwin') + { + push(@{$self->{'O_FILES'}}, 'pTk/tkres$(OBJ_EXT)'); + } $ret; } @@ -168,7 +172,7 @@ $(PERL) pTk/mkVFunc -m $(WINARCH) tkGlue.h $(MYEXTLIB) : config FORCE - cd pTk && $(MAKE) + cd pTk && $(MAKE) DEFINE="$(DEFINE)" perlmain.c : config Makefile Index: README --- Tk800.022/README Sat May 13 10:16:39 2000 +++ Tk800.023/README Sat Dec 30 16:12:37 2000 @@ -7,8 +7,10 @@ derived from those of the orignal Tix4.1.0 or Tk8.0 sources. See doc/license.html for details of this license. -Tk800.022 is supposed to be production worthy. -It has minimal changes from Tk800.021 apart from bug fixes. +Tk800.023 is supposed to be production worthy. +It has minimal changes from Tk800.022 apart from bug fixes. +In particular a rather nasty memory leak that afflicted Canvas rather +badly has been fixed. (Consider Tk800.016..Tk800.021 its beta releases, previous stable release being Tk800.015.) @@ -22,33 +24,33 @@ The perl code corresponding to Tix's Tcl code is not fully implemented. >>> TK IS KNOWN NOT TO WORK WITH perl5.005_63 <<< -But does work with perl5.6.0 - although this required a couple of work-rounds -for perl5.6.0 ->isa bug. +This Tk has special workrounds for perl-5.6.0 ->isa bug which are +only enabled for exactly that version. +Works with perl-5.7.0 and should work with most other "recent" perl releases. -This version (Tk800.022) requires perl5.005 or later on Win32 +This version (Tk800.023) requires perl5.005 or later on Win32 and 5.004_04 or later on UNIX. This version also contains re-worked Image code based on tcl/tk Img extension (version img1.2.3) by Jan Nijtmans: http://members1.chello.nl/~j.nijtmans/ Jan's "dash" patch is also merged. -Tk800.022 should build and run on Windows NT using Visual C++, Borland, +Tk800.023 should build and run on Windows NT using Visual C++, Borland, or with the Mingw32 port of GCC with perl5.005 or later. -Can be built using ActiveState's binrary distribution +Can be built using ActiveState's binary distribution (see README-ActiveState.txt). -The Mingw32 builds are stable now using older Mingw32s. -There are perl build issues with very new Mingw32 (2.95.*). +The Mingw32 builds are stable now using up-to-date gcc-2.95.2 version +of Mingw32. There are perl build issues though you need +to change 'fpos_t' to 'long long' in Mingw32/2.95.2's . I have not tried a Borland build recently. Author has built against: - Perl5.6.0 - Pentium Suse Linux-6.1 egcs-1.1.2 - - Perl5.6.0 (ithreads) - Pentium Suse Linux-6.1 egcs-1.1.2 + Perl5.7.0 + Pentium Suse Linux-6.4 gcc-2.95.2 + NT4.0 SP4 Mingw32 (gcc-2.95.2) Perl5.00503 SPARC Solaris2.6, gcc-2.8.1 @@ -56,7 +58,9 @@ Perl5.00502 NT4.0 SP4 VC++6.0 (with ActivePerl build 518) - NT4.0 SP3 egcs-1.2.1 Mingw32 + + Perl5.6.0 + NT4.0 SP4 VC++6.0 (with ActivePerl build 617) Perl5.00404 Pentium Suse Linux-6.1 egcs-1.1.2 Index: README.cygwin --- /dev/null Sat Dec 30 02:58:04 2000 +++ Tk800.023/README.cygwin Tue May 15 15:53:37 2001 @@ -0,0 +1,154 @@ + +This is a brief description of how to get the Tk module working with +Perl and Cygwin. + +CONFIGURE/BUILD + + Use native Win32 GUI calls: + + perl Makefile.PL + + Use X11 client libraries (and requires a X server): + + Precompiled X11 client libraries can be downloaded from + ftp://sourceware.cygnus.com/pub/cygwin/xfree/xc-4-binaries/ + xfree86-4.0-DLLs.tar.bz2 + xfree86-4.0-devel.tar.bz2 + + NOTE: Your DISPLAY must be 127.0.0.1:0.0 + Your PATH must include the DLL directory, /usr/X11R6/bin + + perl Makefile.PL x + + make + +TEST + + make test + perl -Mblib demos/widget + +INSTALL + + make install + +SIDE-BY-SIDE PORT COMPARISONS (demos/widget) + + X11 (Hummingbird/Exceed X Server, V6.1) + + + Motif look and feel + + Scroll wheel does not work with X11 (config?) + + Global grabs only affect X11 windows (config?) + + Menus, normal style + - Alt+x does not post menus (config?) + + $Tk::platform => unix + + Win32 + + + Windows look and feel + + Uses Win32 clipboard + + Help on menu bar not all the way to the right + + Tear-off menus placed at upper-left instead of near pointer + + Tile and Transparent, no tiled camels, third window not + transparent + + Menus, normal style + - File - "Error: unknown option "-label" at Tk.pm line 217 + + Menus, Perl/Tk style + - Menus do not drop as traverse with button press + - Alt+x does not post menus + + Native Win32 FileSelect dialog, FileSelect/FBox the same + + Native Win32 ChooseColor dialog + + Balls bouncing, when start restacked below widget demo window + (if bounce window not moved) + + Global grabs only affect current application + + IntelliMouse with IntelliEye (but ok with a trackball, setting?) + - Button-2 dragging/scanning does not work well + - Button-2 for copy/paste does not work well + (seems to flip into a scroll mode) + + $Tk::TkwinVtab, $Tk::TkwinintVtab variables + + $Tk::platform => MSWin32 + + Both + + Tear-off menus restack parent below widget demo window + + Meta-backspace, Meta-d not working (Meta config?) + + Menus, normal and Perl/Tk style + - Meta+x accelerators (Control+x okay) not working (config?) + + X11 (Cygwin) v X11 (Solaris) + + No differences that I could find! + + Win32 (Cygwin) v Win32 (MSWin32/ActiveState) + + + Menus, normal style + - Accelerators Win32 bound to Control, Cygwin bound to Meta + (see demos/demos/widget_lib/menus.pl, $^O eq 'MSWin32') + - Win32 ^A does not work (Meta+A with X11), ^H does + +PORTING NOTES + + + $Tk::platform is really the win_arch, where unix is x + (sometimes $^O eq 'MSWin32' is used instead of $Tk::platform + eq 'MSWin32' assuming they are equivalent and vice versa) + + #define distinctions + _WIN32 defined by gcc, if X11 need to undef + __WIN32__ win_arch MSWin32, also defined in pTk/Lang.h + WIN32 from #include + when precedes #include "perl.h" then need + a #undef WIN32 (otherwise tries to include + Win32 Perl things like win32.h, defined + by native Win32 port) + + With native Win32 GUI use Cygwin select() with /dev/windows + pseudo-device rather than using Win32 GetMessage() directly + + pTk/mTk/win/tkWinX.c, pTk/mTk/generic/tkPort.h part of core Tk, + which is ordinarily not touched by Tk Perl module? pTk/Tcl-pTk? + +FILES (with Cygwin references) + + README.cygwin MANIFEST + * documentation + + Makefile.PL Tk/MMutil.pm pTk/Makefile.PL + * make stuff + + pTk/mTk/win/tkWinX.c + * GetMessage() via select() on /dev/windows and callback + + Scrollbar/Scrollbar.xs tkWin32Dll.c + * defined(__WIN32__) && defined(__CYGWIN__) + + tkGlue.c + * refdef XS because __declspec(dllexport) incompatible with static + * defined(__WIN32__) && defined(__CYGWIN__) and pTk/tkWin.h + includes which defines WIN32 + + Tk.pm + * set $Tk::platform with help from $Tk::Config::win_arch + + DragDrop/site_test Tk/X11Font.pm t/create.t t/mwm.t + * $^O eq 'cygwin' and $Tk::platform eq 'MSWin32' + + DragDrop/Win32Site/Win32Site.xs + * #undef WIN32 from + + pTk/mTk/generic/tkPort.h + * resolve strcasecmp/stricmp #define mess + + pTk/Lang.h + * some defs ordinarily from tkUnixPort.h + + chnGlue.c + * Cygwin has O_BINARY + + IO/IO.xs + * Cygwin has O_NONBLOCK + +TODO + + + Any way to have X11 and native Win32 versions available + at the same time? Build with Xlib/Win32 emulator (see rxvt)? + + Fix gcc warnings, mostly in pTk win32 flavor? + + Test with cygwin-xfree X Server? + +Thu Aug 31 12:54:09 BST 2000 +Eric Fifer +efifer@dircon.co.uk Index: Scrollbar/Scrollbar.xs --- Tk800.022/Scrollbar/Scrollbar.xs Tue Jul 27 19:20:07 1999 +++ Tk800.023/Scrollbar/Scrollbar.xs Sat Dec 30 16:12:37 2000 @@ -12,7 +12,7 @@ #include "pTk/tkPort.h" #include "pTk/tkInt.h" -#ifdef WIN32 +#if defined(WIN32) || (defined(__WIN32__) && defined(__CYGWIN__)) #include "pTk/tkWin.h" #include "pTk/tkWinInt.h" #endif Index: Text/Text.pm --- Tk800.022/Text/Text.pm Sat May 6 13:32:02 2000 +++ Tk800.023/Text/Text.pm Sat Dec 30 16:12:37 2000 @@ -20,7 +20,7 @@ use Text::Tabs; use vars qw($VERSION); -$VERSION = '3.043'; # $Id: //depot/Tk8/Text/Text.pm#43 $ +$VERSION = '3.044'; # $Id: //depot/Tk8/Text/Text.pm#44 $ use Tk qw(Ev $XS_VERSION); use base qw(Tk::Clipboard Tk::Widget); @@ -339,6 +339,7 @@ sub B1_Motion { my ($w) = @_; + return unless defined $Tk::mouseMoved; my $Ev = $w->XEvent; $Tk::x = $Ev->x; $Tk::y = $Ev->y; Index: Tixish/BrowseEntry.pm --- Tk800.022/Tixish/BrowseEntry.pm Sat Apr 29 10:51:59 2000 +++ Tk800.023/Tixish/BrowseEntry.pm Sat Dec 30 16:12:37 2000 @@ -4,7 +4,7 @@ package Tk::BrowseEntry; use vars qw($VERSION); -$VERSION = '3.028'; # $Id: //depot/Tk8/Tixish/BrowseEntry.pm#28 $ +$VERSION = '3.030'; # $Id: //depot/Tk8/Tixish/BrowseEntry.pm#30 $ use Tk qw(Ev); use Carp; @@ -281,7 +281,7 @@ $w->insert( 'end', $val); $hash{$val} = 1; } - $old = $choices->[0] unless exists $hash{$old}; + $old = (@$choices) ? $choices->[0] : undef unless exists $hash{$old}; $$var = $old; } else Index: Tk.pm --- Tk800.022/Tk.pm Sat Apr 29 10:36:41 2000 +++ Tk800.023/Tk.pm Tue May 15 15:43:00 2001 @@ -17,7 +17,18 @@ *fileevent = \&Tk::Event::IO::fileevent; -BEGIN { $Tk::platform = ($^O eq 'MSWin32') ? $^O : 'unix' }; +BEGIN { + if($^O eq 'cygwin') + { + require Tk::Config; + $Tk::platform = $Tk::Config::win_arch; + $Tk::platform = 'unix' if $Tk::platform eq 'x'; + } + else + { + $Tk::platform = ($^O eq 'MSWin32') ? $^O : 'unix'; + } +}; $Tk::tearoff = 1 if ($Tk::platform eq 'unix'); @@ -42,7 +53,7 @@ # is created, $VERSION is checked by bootstrap $Tk::version = '8.0'; $Tk::patchLevel = '8.0'; -$Tk::VERSION = '800.022'; +$Tk::VERSION = '800.023'; $Tk::XS_VERSION = $Tk::VERSION; $Tk::strictMotif = 0; Index: Tk/Configure.pm --- Tk800.022/Tk/Configure.pm Sat Oct 2 17:44:27 1999 +++ Tk800.023/Tk/Configure.pm Sat Dec 30 16:12:37 2000 @@ -1,6 +1,6 @@ package Tk::Configure; use vars qw($VERSION); -$VERSION = '3.008'; # $Id: //depot/Tk8/Tk/Configure.pm#8 $ +$VERSION = '3.010'; # $Id: //depot/Tk8/Tk/Configure.pm#10 $ use Carp; use Tk::Pretty; @@ -25,8 +25,7 @@ croak('Wrong number of args to cget') unless (@_ == 2); my ($alias,$key) = @_; my ($set,$get,$widget,@args) = @$alias; - my @result = $widget->$get(@args); - return (wantarray) ? @result : $result[0]; + $widget->$get(@args); } sub configure @@ -34,10 +33,20 @@ my $alias = shift; shift if (@_); my ($set,$get,$widget,@args) = @$alias; - my @results; - eval { @results = $widget->$set(@args,@_) }; - croak($@) if $@; - return @results; + if (wantarray) + { + my @results; + eval { @results = $widget->$set(@args,@_) }; + croak($@) if $@; + return @results; + } + else + { + my $results; + eval { $results = $widget->$set(@args,@_) }; + croak($@) if $@; + return $results; + } } *TIESCALAR = \&new; Index: Tk/Frame.pm --- Tk800.022/Tk/Frame.pm Thu Apr 27 15:41:04 2000 +++ Tk800.023/Tk/Frame.pm Sat Dec 30 16:12:37 2000 @@ -14,7 +14,7 @@ use vars qw($VERSION); -$VERSION = '3.030'; # $Id: //depot/Tk8/Tk/Frame.pm#30 $ +$VERSION = '3.031'; # $Id: //depot/Tk8/Tk/Frame.pm#31 $ sub Tk_cmd { \&Tk::frame } @@ -130,7 +130,7 @@ require Tk::Label; $w = Tk::Label->new($cw,-textvariable => $cw->labelVariable); $cw->Advertise('label' => $w); - $cw->ConfigDelegate('label',qw(text textvariable)); + $cw->ConfigDelegate('label',qw(-text -textvariable)); } if (defined($val) && defined($w)) { Index: Tk/MMutil.pm --- Tk800.022/Tk/MMutil.pm Thu Mar 30 21:37:15 2000 +++ Tk800.023/Tk/MMutil.pm Sat Dec 30 16:12:37 2000 @@ -9,7 +9,7 @@ use File::Basename; use vars qw($VERSION); -$VERSION = '3.049'; # $Id: //depot/Tk8/Tk/MMutil.pm#49 $ +$VERSION = '3.050'; # $Id: //depot/Tk8/Tk/MMutil.pm#50 $ use Tk::MakeDepend; @@ -222,6 +222,19 @@ my @inc = split(/\s+/,$self->{'INC'}); my @def = split(/\s+/,$self->{'DEFINE'}); push(@def,qw(-DWIN32 -D__WIN32__)) if ($IsWin32); + if ($^O eq 'cygwin') + { + push(@def,qw(-D__CYGWIN__)); + if ($win_arch eq 'MSWin32') + { + push(@def,qw(-D__WIN32__)) unless $self->{'DEFINE'} =~ /-D__WIN32__/; + push(@def,qw(-DWIN32)) if $self->{'NAME'} eq 'Tk::pTk'; + } + elsif ($win_arch eq 'x') + { + push(@def,qw(-U_WIN32)); + } + } foreach (@inc) { s/\$\(TKDIR\)/$tk/g; @@ -486,6 +499,25 @@ my $extra = "-L$base -lcomdlg32 -lgdi32"; my $libs = $att{'LIBS'}->[0]; $att{'LIBS'}->[0] = "$extra $libs"; + } + if ($^O eq 'cygwin') + { + # NOTE: use gcc -shared instead of dllwrap (ld2), + # dllwrap tries to resolve all symbols, even those + # that are brought in from libraries like libpTk.a + push(@opt,'LD' => 'gcc -shared'); + if ($win_arch eq 'MSWin32') + { + my $extra = "-lcomdlg32 -lgdi32"; + my $libs = $att{'LIBS'}->[0]; + $att{'LIBS'}->[0] = "$extra $libs"; + $att{'DEFINE'} .= ' -D__WIN32__'; + $att{'DEFINE'} .= ' -DWIN32' if($att{'NAME'} eq 'Tk::pTk'); + } + elsif ($win_arch eq 'x') + { + $att{'DEFINE'} .= ' -U_WIN32'; + } } if (delete $att{'ptk_include'}) { Index: Tk/Optionmenu.pm --- Tk800.022/Tk/Optionmenu.pm Fri Apr 21 10:26:46 2000 +++ Tk800.023/Tk/Optionmenu.pm Sat Dec 30 16:12:37 2000 @@ -6,7 +6,7 @@ require Tk::Menu; use vars qw($VERSION); -$VERSION = '3.023'; # $Id: //depot/Tk8/Tk/Optionmenu.pm#23 $ +$VERSION = '3.025'; # $Id: //depot/Tk8/Tk/Optionmenu.pm#25 $ use base qw(Tk::Derived Tk::Menubutton); @@ -20,10 +20,6 @@ $w->SUPER::Populate($args); $args->{-indicatoron} = 1; my $var = delete $args->{-textvariable}; - if (!defined($var) && exists($args->{-variable})) - { - $var = $args->{-variable}; - } unless (defined $var) { my $gen = undef; Index: Tk/Trace.pm --- /dev/null Sat Dec 30 02:58:04 2000 +++ Tk800.023/Tk/Trace.pm Sat Dec 30 16:12:37 2000 @@ -0,0 +1,276 @@ +package Tk::Trace; + +use vars qw($VERSION); +$VERSION = '3.002'; # $Id: //depot/Tk8/Tk/Trace.pm#2 $ + +use Exporter; +use base qw/Exporter/; +@EXPORT = qw/traceVariable traceVdelete traceVinfo/; +use Tie::Watch; +use strict; + +my %trace; # watchpoints indexed by stringified ref +my %op = ( # map Tcl op to tie function + 'r' => ['-fetch', \&fetch], + 'w' => ['-store', \&store], + 'u' => ['-destroy', \&destroy], +); + +sub fetch { + + # fetch() wraps the user's callback with necessary tie() bookkeeping + # and invokes the callback with the proper arguments. It expects: + # + # $_[0] = Tie::Watch object + # $_[1] = undef for a scalar, an index/key for an array/hash + # + # The user's callback is passed these arguments: + # + # $_[0] = undef for a scalar, index/key for array/hash + # $_[1] = current value + # $_[2] = operation (r, w, or u) + # $_[3 .. $#_] = optional user callback arguments + # + # The user callback returns the final value to assign the variable. + + my $self = shift; # Tie::Watch object + my $val = $self->Fetch(@_); # get variable's current value + my $aref = $self->Args(-fetch); # argument reference + my $sub = shift @$aref; # user's callback + unshift @_, undef if scalar @_ == 0; # undef "index" for a scalar + my @args = @_; # save for post-callback work + $args[1] = &$sub(@_, $val, 'r', @$aref); # invoke user callback + shift @args unless defined $args[0]; # drop scalar "index" + $self->Store(@args); # update variable's value + +} # end fetch + +sub store { + + # store() wraps the user's callback with necessary tie() bookkeeping + # and invokes the callback with the proper arguments. It expects: + # + # $_[0] = Tie::Watch object + # $_[1] = new value for a scalar, index/key for an array/hash + # $_[2] = undef for a scalar, new value for an array/hash + # + # The user's callback is passed these arguments: + # + # $_[0] = undef for a scalar, index/key for array/hash + # $_[1] = new value + # $_[2] = operation (r, w, or u) + # $_[3 .. $#_] = optional user callback arguments + # + # The user callback returns the final value to assign the variable. + + my $self = shift; # Tie::Watch object + $self->Store(@_); # store variable's new value + my $aref = $self->Args(-store); # argument reference + my $sub = shift @$aref; # user's callback + unshift @_, undef if scalar @_ == 1; # undef "index" for a scalar + my @args = @_; # save for post-callback work + $args[1] = &$sub(@_, 'w', @$aref); # invoke user callback + shift @args unless defined $args[0]; # drop scalar "index" + $self->Store(@args); # update variable's value + +} # end store + +sub destroy { + my $self = shift; + my $aref = $self->Args(-destroy); # argument reference + my $sub = shift @$aref; # user's callback + my $val = $self->Fetch(@_); # get final value + &$sub(undef, $val, 'u', @$aref); # invoke user callback + $self->Destroy(@_); # destroy variable +} + +sub traceVariable { + my($parent, $vref, $op, $callback) = @_; + die "Illegal parent." unless ref $parent; + die "Illegal variable." unless ref $vref; + die "Illegal trace operation '$op'." unless $op; + die "Illegal trace operation '$op'." if $op =~ /[^rwu]/; + die "Illegal callback." unless $callback; + + # Need to add our internal callback to user's callback arg list + # so we can call it first, followed by the user's callback and + # any user arguments. + + my($fetch, $store, $destroy); + if (ref $callback eq 'CODE') { + $fetch = [\&fetch, $callback]; + $store = [\&store, $callback]; + $destroy = [\&destroy, $callback]; + } else { # assume [] form + $fetch = [\&fetch, @$callback]; + $store = [\&store, @$callback]; + $destroy = [\&destroy, @$callback]; + } + + my @wargs; + push @wargs, (-fetch => $fetch) if $op =~ /r/; + push @wargs, (-store => $store) if $op =~ /w/; + push @wargs, (-destroy => $destroy) if $op =~ /w/; + my $watch = Tie::Watch->new( + -variable => $vref, + @wargs, + ); + + $trace{$vref} = $watch; + +} # end traceVariable + +sub traceVdelete { + my($parent, $vref, $op_not_honored, $callabck_not_honored) = @_; + if (defined $trace{$vref}) { + $trace{$vref}->Unwatch; + delete $trace{$vref}; + } +} + +sub traceVinfo { + my($parent, $vref) = @_; + return (defined $trace{$vref}) ? $trace{$vref}->Info : undef; +} + +=head1 NAME + +Tk::Trace - emulate Tcl/Tk B functions. + +=head1 SYNOPSIS + + use Tk::Trace + + $mw->traceVariable(\$v, 'wru' => [\&update_meter, $scale]); + %vinfo = $mw->traceVinfo(\$v); + print "Trace info :\n ", join("\n ", @{$vinfo{-legible}}), "\n"; + $mw->traceVdelete(\$v); + +=head1 DESCRIPTION + +This class module emulates the Tcl/Tk B family of commands by +binding subroutines of your devising to Perl variables using simple +B features. + +Callback format is patterned after the Perl/Tk scheme: supply either a +code reference, or, supply an array reference and pass the callback +code reference in the first element of the array, followed by callback +arguments. + +User callbacks are passed these arguments: + + $_[0] = undef for a scalar, index/key for array/hash + $_[1] = variable's current (read), new (write), final (undef) value + $_[2] = operation (r, w, or u) + $_[3 .. $#_] = optional user callback arguments + +As a Trace user, you have an important responsibility when writing your +callback, since you control the final value assigned to the variable. +A typical callback might look like: + + sub callback { + my($index, $value, $op, @args) = @_; + return if $op eq 'u'; + # .... code which uses $value ... + return $value; # variable's final value + } + +Note that the callback's return value becomes the variable's final value, +for either read or write traces. + +For write operations, the variable is updated with its new value before +the callback is invoked. + +Only one callback can be attached to a variable, but read, write and undef +operations can be traced simultaneously. + +=head1 METHODS + +=over 4 + +=item $mw->traceVariable(varRef, op => callback); + +B is a reference to the scalar, array or hash variable you +wish to trace. B is the trace operation, and can be any combination +of B for read, B for write, and B for undef. B is a +standard Perl/Tk callback, and is invoked, depending upon the value of +B, whenever the variable is read, written, or destroyed. + +=item %vinfo = $mw->traceVinfo(varRef); + +Returns a hash detailing the internals of the Trace object, with these +keys: + + %vinfo = ( + -variable => varRef + -debug => '0' + -shadow => '1' + -value => 'HELLO SCALAR' + -destroy => callback + -fetch => callback + -store => callback + -legible => above data formatted as a list of string, for printing + ); + +For array and hash Trace objects, the B<-value> key is replaced with a +B<-ptr> key which is a reference to the parallel array or hash. +Additionally, for an array or hash, there are key/value pairs for +all the variable specific callbacks. + +=item $mw->traceVdelete(\$v); + +Stop tracing the variable. + +=back + +=head1 EXAMPLE + + use Tk; + + # Trace a Scale's variable and move a meter in unison. + + $pi = 3.1415926; + $mw = MainWindow->new; + $c = $mw->Canvas(qw/-width 200 -height 110 -bd 2 -relief sunken/)->grid; + $c->createLine(qw/100 100 10 100 -tag meter/); + $s = $mw->Scale(qw/-orient h -from 0 -to 100 -variable/ => \$v)->grid; + $mw->Label(-text => 'Slide Me for 5 Seconds')->grid; + + $mw->traceVariable(\$v, 'w' => [\&update_meter, $s]); + + $mw->after(5000 => sub { + print "Untrace time ...\n"; + %vinfo = $s->traceVinfo(\$v); + print "Watch info :\n ", join("\n ", @{$vinfo{-legible}}), "\n"; + $c->traceVdelete(\$v); + }); + + MainLoop; + + sub update_meter { + my($index, $value, $op, @args) = @_; + return if $op eq 'u'; + $min = $s->cget(-from); + $max = $s->cget(-to); + $pos = $value / abs($max - $min); + $x = 100.0 - 90.0 * (cos( $pos * $pi )); + $y = 100.0 - 90.0 * (sin( $pos * $pi )); + $c->coords(qw/meter 100 100/, $x, $y); + return $value; + } + +=head1 HISTORY + + Stephen.O.Lidie@Lehigh.EDU, Lehigh University Computing Center, 2000/08/01 + . Version 1.0, for Tk800.022. + +=head1 COPYRIGHT + +Copyright (C) 2000 - 2000 Stephen O. Lidie. All rights reserved. + +This program is free software; you can redistribute it and/or modify it under +the same terms as Perl itself. + +=cut + +1; Index: Tk/X11Font.pm --- Tk800.022/Tk/X11Font.pm Fri Dec 24 09:41:43 1999 +++ Tk800.023/Tk/X11Font.pm Sat Dec 30 16:12:37 2000 @@ -1,6 +1,6 @@ package Tk::X11Font; use vars qw($VERSION); -$VERSION = '3.012'; # $Id: //depot/Tk8/Tk/X11Font.pm#12 $ +$VERSION = '3.013'; # $Id: //depot/Tk8/Tk/X11Font.pm#13 $ require Tk::Widget; require Tk::Xlib; @@ -94,7 +94,7 @@ my $me = shift; my $max = wantarray ? shift || 128 : 1; - if ($^O eq 'MSWin32') + if ($^O eq 'MSWin32' or ($^O eq 'cygwin' and $Tk::platform eq 'MSWin32')) { my $name = $me->{Name}; if (!defined $name) Index: add_version --- Tk800.022/add_version Sat Jan 22 14:18:58 2000 +++ Tk800.023/add_version Sat Dec 30 16:12:37 2000 @@ -1,4 +1,4 @@ -#!/usr/local/bin/perl -w +#!/tools/local/perl -w use strict; use File::Find; use Getopt::Std; @@ -10,7 +10,7 @@ $path = getcwd(); my $dep; my $rel; -my $wh = `p4 where ./...`; +my ($wh) = `p4 where ./...`; if ($wh =~ m#^\s*(.*)/\.\.\.\s+(.*)/\.\.\.\s*$#) { Index: chnGlue.c --- Tk800.022/chnGlue.c Tue Jul 27 19:20:11 1999 +++ Tk800.023/chnGlue.c Sat Dec 30 16:12:37 2000 @@ -93,7 +93,7 @@ { if (strcmp(newValue,"binary") == 0) { -#if defined(WIN32) || defined(__EMX__) +#if defined(WIN32) || defined(__EMX__) || defined(__CYGWIN__) setmode(PerlIO_fileno(f), O_BINARY); #endif return TCL_OK; Index: cleanup --- Tk800.022/cleanup Tue Jul 27 19:20:11 1999 +++ Tk800.023/cleanup Wed Feb 21 18:27:16 2001 @@ -3,15 +3,15 @@ find(\&wanted,'.'); sub wanted -{ +{ return unless -f $_; - if ($_ eq 'core' || /(%|\.(bak|bck|old|undone|orig))$/) + if ($_ eq 'core' || /(%|~|\.(bak|bck|old|undone|orig))$/) { warn "$File::Find::name\n"; chmod(0666,$_) unless -w _; unlink($_) || warn "Cannot delete $File::Find::name\n"; } -} +} __END__ Index: demos/demos/widget_lib/style.pl --- Tk800.022/demos/demos/widget_lib/style.pl Tue Jul 27 19:20:17 1999 +++ Tk800.023/demos/demos/widget_lib/style.pl Sat Dec 30 16:12:37 2000 @@ -15,12 +15,11 @@ -iconname => 'style', ); - my $size = -18; - $TOP->fontCreate('C_normal',-family => 'courier', -size => $size); - $TOP->fontCreate('C_small',-family => 'courier', -size => int(12*$size/14)); - $TOP->fontCreate('C_bold',-family => 'courier', -weight => 'bold', -size => $size); - $TOP->fontCreate('C_big',-family => 'courier', -weight => 'bold', -size => int($size*18/14)); - $TOP->fontCreate('C_vbig',-family => 'helvetica', -weight => 'bold', -size => int($size*24/14)); + $TOP->fontCreate(qw/C_small -family courier -size 10/); + $TOP->fontCreate(qw/C_big -family courier -size 14 -weight bold/); + $TOP->fontCreate(qw/C_vbig -family helvetica -size 24 -weight bold/); + $TOP->fontCreate(qw/C_bold -family courier -size 12 -weight bold + -slant italic/); my $t = $TOP->Scrolled(qw/Text -setgrid true -width 70 -height 32 -font normal -wrap word -scrollbars e/); @@ -28,117 +27,123 @@ # Set up display styles. - $t->tag(qw/configure bold -font C_bold/); - $t->tag(qw/configure big -font C_big/); + $t->tag(qw/configure bold -font C_bold/); + $t->tag(qw/configure big -font C_big/); $t->tag(qw/configure verybig -font C_vbig/); if ($TOP->depth > 1) { $t->tag(qw/configure color1 -background/ => '#a0b7ce'); $t->tag(qw/configure color2 -foreground red/); - $t->tag(qw/configure raised -relief raised -borderwidth 3 -background/ => '#a0b7ce'); - $t->tag(qw/configure sunken -relief sunken -borderwidth 3 -background/ => '#a0b7ce'); + $t->tag(qw/configure raised -relief raised -borderwidth 1/); + $t->tag(qw/configure sunken -relief sunken -borderwidth 1/); } else { $t->tag(qw/configure color1 -background black -foreground white/); $t->tag(qw/configure color2 -background black -foreground white/); $t->tag(qw/configure raised -background white -relief raised -bd 1/); $t->tag(qw/configure sunken -background white -relief sunken -bd 1/); } - $t->tag(qw/configure bgstipple -background black -borderwidth 0 - -bgstipple gray25/); - $t->tag(qw/configure fgstipple -fgstipple gray50/); - $t->tag(qw/configure underline -underline on/); + $t->tag(qw/configure bgstipple -background black -borderwidth 0 + -bgstipple gray12/); + $t->tag(qw/configure fgstipple -fgstipple gray50/); + $t->tag(qw/configure underline -underline on/); $t->tag(qw/configure overstrike -overstrike on/); - $t->tag(qw/configure right -justify right/); - $t->tag(qw/configure center -justify center/); - $t->tag(qw/configure super -offset 4p -font C_small/); - $t->tag(qw/configure sub -offset -2p -font C_small/); - $t->tag(qw/configure margins -lmargin1 12m -lmargin2 6m -rmargin 10m/); - $t->tag(qw/configure spacing -spacing1 10p -spacing2 2p + $t->tag(qw/configure right -justify right/); + $t->tag(qw/configure center -justify center/); + $t->tag(qw/configure super -offset 4p -font C_small/); + $t->tag(qw/configure sub -offset -2p -font C_small/); + $t->tag(qw/configure margins -lmargin1 12m -lmargin2 6m -rmargin 10m/); + $t->tag(qw/configure spacing -spacing1 10p -spacing2 2p -lmargin1 12m -lmargin2 6m -rmargin 10m/); - $t->insert('0.0', -'Text widgets like this one allow you to display information in a variety of styles. Display styles are controlled using a mechanism called '); - inswt($t, 'tags', qw(bold)); - inswt($t, -'. Tags are just textual names that you can apply to one or more ranges of characters within a text widget. You can configure tags with various display styles. If you do this, then the tagged characters will be displayed with the styles you chose. The available display styles are: '); - inswt($t, "\n\n1. Font.", qw(big)); - inswt($t, ' You can choose any X font, '); - inswt($t, 'large', qw(verybig)); - inswt($t, ' or small.'); - inswt($t, "\n\n2. Color.", qw(big)); - inswt($t, ' You can change either the '); - inswt($t, 'background', qw(color1)); - inswt($t, ' or '); - inswt($t, 'foreground', qw(color2)); - inswt($t, "\ncolor, or "); - inswt($t, 'both', qw(color1 color2)); - inswt($t, '.'); - inswt($t, "\n\n3. Stippling.", qw(big)); - inswt($t, ' You can cause either the '); - inswt($t, 'background', qw(bgstipple)); - inswt($t, ' or '); - inswt($t, 'foreground', qw(fgstipple)); - inswt($t, "\ninformation to be drawn with a stipple fill instead of a solid fill."); - inswt($t, "\n\n4. Underlining.", qw(big)); - inswt($t, ' You can '); - inswt($t, 'underline', qw(underline)); - inswt($t, ' ranges of text.'); - inswt($t, "\n\n5. Overstrikes.", 'big'); - inswt($t, " You can "); - inswt($t, "draw lines through", 'overstrike'); - inswt($t, " ranges of text."); - inswt($t, "\n\n6. 3-D effects.", qw( big)); - inswt($t, " You can arrange for the background to be drawn "); - inswt($t, 'with a border that makes characters appear either '); - inswt($t, 'raised', qw(raised)); - inswt($t, ' or '); - inswt($t, 'sunken', qw(sunken)); - inswt($t, '.'); - inswt($t, "\n\n7. Justification.", 'big'); - inswt($t, " You can arrange for lines to be displayed\n"); - inswt($t, "left-justified,\n"); - inswt($t, "right-justified, or\n", 'right'); - inswt($t, "centered.", 'center'); - inswt($t, "\n\n8. Superscripts and subscripts." , 'big'); - inswt($t, " You can control the vertical "); - inswt($t, "position of text to generate superscript effects like 10"); - inswt($t, "n", 'super'); - inswt($t, " or subscript effects like X"); - inswt($t, "i", 'sub'); - inswt($t, "."); - inswt($t, "\n\n9. Margins.", 'big'); - inswt($t, " You can control the amount of extra space left"); - inswt($t, " on\neach side of the text:\n"); - inswt($t, "This paragraph is an example of the use of ", 'margins'); - inswt($t, "margins. It consists of a single line of text ", 'margins'); - inswt($t, "that wraps around on the screen. There are two ", 'margins'); - inswt($t, "separate left margin values, one for the first ", 'margins'); - inswt($t, "display line associated with the text line, ", 'margins'); - inswt($t, "and one for the subsequent display lines, which ", 'margins'); - inswt($t, "occur because of wrapping. There is also a ", 'margins'); - inswt($t, "separate specification for the right margin, ", 'margins'); - inswt($t, "which is used to choose wrap points for lines.", 'margins'); + $t->insert('0.0', 'Text widgets like this one allow you to display ' . + 'information in a variety of styles. Display styles are ' . + 'controlled using a mechanism called '); + $t->insert('insert', 'tags', 'bold'); + $t->insert('insert', '. Tags are just textual names that you can apply ' . + 'to one or more ranges of characters within a text widget. ' . + 'You can configure tags with various display styles. If ' . + 'you do this, then the tagged characters will be displayed ' . + 'with the styles you chose. The available display styles ' . + 'are: '); + $t->insert('insert', "\n\n1. Font.", 'big'); + $t->insert('insert', ' You can choose any X font, '); + $t->insert('insert', 'large', 'verybig'); + $t->insert('insert', ' or small.'); + $t->insert('insert', "\n\n2. Color.", 'big'); + $t->insert('insert', ' You can change either the '); + $t->insert('insert', 'background', 'color1'); + $t->insert('insert', ' or '); + $t->insert('insert', 'foreground', 'color2'); + $t->insert('insert', "\ncolor, or "); + $t->insert('insert', 'both', ['color1', 'color2']); + $t->insert('insert', '.'); + $t->insert('insert', "\n\n3. Stippling.", 'big'); + $t->insert('insert', ' You can cause either the '); + $t->insert('insert', 'background', 'bgstipple'); + $t->insert('insert', ' or '); + $t->insert('insert', 'foreground', 'fgstipple'); + $t->insert('insert', "\ninformation to be drawn with a stipple fill instead of a solid fill."); + $t->insert('insert', "\n\n4. Underlining.", 'big'); + $t->insert('insert', ' You can '); + $t->insert('insert', 'underline', 'underline'); + $t->insert('insert', ' ranges of text.'); + $t->insert('insert', "\n\n5. Overstrikes.", 'big'); + $t->insert('insert', " You can "); + $t->insert('insert', "draw lines through", 'overstrike'); + $t->insert('insert', " ranges of text."); + $t->insert('insert', "\n\n6. 3-D effects.", ' big'); + $t->insert('insert', " You can arrange for the background to be drawn "); + $t->insert('insert', 'with a border that makes characters appear either '); + $t->insert('insert', 'raised', 'raised'); + $t->insert('insert', ' or '); + $t->insert('insert', 'sunken', 'sunken'); + $t->insert('insert', '.'); + $t->insert('insert', "\n\n7. Justification.", 'big'); + $t->insert('insert', " You can arrange for lines to be displayed\n"); + $t->insert('insert', "left-justified,\n"); + $t->insert('insert', "right-justified, or\n", 'right'); + $t->insert('insert', "centered.", 'center'); + $t->insert('insert', "\n\n8. Superscripts and subscripts." , 'big'); + $t->insert('insert', " You can control the vertical "); + $t->insert('insert', "position of text to generate superscript effects " . + "like 10"); + $t->insert('insert', "n", 'super'); + $t->insert('insert', " or subscript effects like X"); + $t->insert('insert', "i", 'sub'); + $t->insert('insert', "."); + $t->insert('insert', "\n\n9. Margins.", 'big'); + $t->insert('insert', " You can control the amount of extra space left"); + $t->insert('insert', " on\neach side of the text:\n"); + $t->insert('insert', "This paragraph is an example of the use of ", 'margins'); + $t->insert('insert', "margins. It consists of a single line of text ", 'margins'); + $t->insert('insert', "that wraps around on the screen. There are two ", 'margins'); + $t->insert('insert', "separate left margin values, one for the first ", 'margins'); + $t->insert('insert', "display line associated with the text line, ", 'margins'); + $t->insert('insert', "and one for the subsequent display lines, which ", 'margins'); + $t->insert('insert', "occur because of wrapping. There is also a ", 'margins'); + $t->insert('insert', "separate specification for the right margin, ", 'margins'); + $t->insert('insert', "which is used to choose wrap points for lines.", 'margins'); - inswt($t, "\n\n10. Spacing.", 'big'); - inswt($t, " You can control the spacing of lines with three "); - inswt($t, "separate parameters. \"Spacing1\" tells how much "); - inswt($t, "extra space to leave\nabove a line, \"spacing3\" "); - inswt($t, "tells how much space to leave below a line,\nand "); - inswt($t, "if a text line wraps, \"spacing2\" tells how much "); - inswt($t, "space to leave\nbetween the display lines that "); - inswt($t, "make up the text line.\n"); - inswt($t, "These indented paragraphs illustrate how spacing ", 'spacing'); - inswt($t, "can be used. Each paragraph is actually a ", 'spacing'); - inswt($t, "single line in the text widget, which is ", 'spacing'); - inswt($t, "word-wrapped by the widget.\n", 'spacing'); - inswt($t, "Spacing1 is set to 10 points for this text, ", 'spacing'); - inswt($t, "which results in relatively large gaps between ", 'spacing'); - inswt($t, "the paragraphs. Spacing2 is set to 2 points, ", 'spacing'); - inswt($t, "which results in just a bit of extra space ", 'spacing'); - inswt($t, "within a pararaph. Spacing3 isn't used ", 'spacing'); - inswt($t, "in this example.\n", 'spacing'); - inswt($t, "To see where the space is, select ranges of ", 'spacing'); - inswt($t, "text within these paragraphs. The selection ", 'spacing'); - inswt($t, "highlight will cover the extra space.", 'spacing'); + $t->insert('insert', "\n\n10. Spacing.", 'big'); + $t->insert('insert', " You can control the spacing of lines with three "); + $t->insert('insert', "separate parameters. \"Spacing1\" tells how much "); + $t->insert('insert', "extra space to leave\nabove a line, \"spacing3\" "); + $t->insert('insert', "tells how much space to leave below a line,\nand "); + $t->insert('insert', "if a text line wraps, \"spacing2\" tells how much "); + $t->insert('insert', "space to leave\nbetween the display lines that "); + $t->insert('insert', "make up the text line.\n"); + $t->insert('insert', "These indented paragraphs illustrate how spacing ", 'spacing'); + $t->insert('insert', "can be used. Each paragraph is actually a ", 'spacing'); + $t->insert('insert', "single line in the text widget, which is ", 'spacing'); + $t->insert('insert', "word-wrapped by the widget.\n", 'spacing'); + $t->insert('insert', "Spacing1 is set to 10 points for this text, ", 'spacing'); + $t->insert('insert', "which results in relatively large gaps between ", 'spacing'); + $t->insert('insert', "the paragraphs. Spacing2 is set to 2 points, ", 'spacing'); + $t->insert('insert', "which results in just a bit of extra space ", 'spacing'); + $t->insert('insert', "within a pararaph. Spacing3 isn't used ", 'spacing'); + $t->insert('insert', "in this example.\n", 'spacing'); + $t->insert('insert', "To see where the space is, select ranges of ", 'spacing'); + $t->insert('insert', "text within these paragraphs. The selection ", 'spacing'); + $t->insert('insert', "highlight will cover the extra space.", 'spacing'); $t->mark(qw/set insert 0.0/); Index: demos/widget --- Tk800.022/demos/widget Fri Mar 31 13:55:09 2000 +++ Tk800.023/demos/widget Sat Dec 30 16:12:37 2000 @@ -6,7 +6,7 @@ use lib Tk->findINC('demos/widget_lib'); use Tk::widgets qw/Dialog ErrorDialog ROText/; use WidgetDemo; -use subs qw/inswt invoke lsearch see_code see_vars show_stat view_widget_code/; +use subs qw/invoke lsearch see_code see_vars show_stat view_widget_code/; use vars qw/$MW $FONT $WIDTRIB/; use vars qw/$CODE $CODE_RERUN $CODE_TEXT $VARS $VIEW $VIEW_TEXT/; use vars qw/$BRAKES $LIGHTS $OIL $SOBER $TRANS $WIPERS/; @@ -19,7 +19,7 @@ { package WidgetWrap; - @WidgetWrap::ISA = qw(Tk::MainWindow); + @WidgetWrap::ISA = qw/Tk::MainWindow/; # This magic conspires with widget's AUTOLOAD subroutine to make user # contributed demonstrations that don't use WidgetDemo embed properly. @@ -74,6 +74,8 @@ -font => $FONT, -setgrid => 1, )->grid(qw/-sticky nsew/); +$MW->gridRowconfigure( 0, -weight => 1); # allow expansion in both ... +$MW->gridColumnconfigure(0, -weight => 1); # ... X and Y dimensions my $STATUS_VAR; my $status = $MW->Label(-textvariable => \$STATUS_VAR, qw/-anchor w/); @@ -242,7 +244,7 @@ -default_button => 'OK', -buttons => ['OK'], -text => " widget\n\nPerl Version $]" . - "\nTk Version $Tk::VERSION\n\n 2000/03/18", + "\nTk Version $Tk::VERSION\n\n 2000/07/07", ); $help->cget(-menu)->entryconfigure('About', -command => [$DIALOG_ABOUT => 'Show'], @@ -277,31 +279,6 @@ } # end AUTOLOAD -sub inswt { - - # insert_with_tags - # - # The procedure below inserts text into a given text widget and applies - # one or more tags to that text. The arguments are: - # - # w Window in which to insert - # text Text to insert (it's inserted at the "insert" mark) - # args One or more tags to apply to text. If this is empty then all - # tags are removed from the text. - - my($w, $text, @args) = @_; - - my $start = $w->index('insert'); - $w->insert('insert', $text); - foreach my $tag ($w->tagNames($start)) { - $w->tagRemove($tag, $start, 'insert'); - } - foreach my $i (@args) { - $w->tagAdd($i, $start, 'insert'); - } - -} # end inswt - sub invoke { # This procedure is called when the user clicks on a demo description. @@ -517,6 +494,9 @@ # Demo some "dash patch" changes. # Stephen.O.Lidie@Lehigh.EDU, 2000/01/11, Lehigh University. # Update menubar to Tk 8, fix color palette Menubutton demo. + # Stephen.O.Lidie@Lehigh.EDU, 2000/07/06, Lehigh University. + # Remove inswt() from widget and styles.pl to show the proper Perl/Tk + # idiom for inserting Text tags. Various and sundry cleanups. =head1 AUTHOR Index: grepc --- Tk800.022/grepc Mon Mar 13 14:24:03 2000 +++ Tk800.023/grepc Sat Dec 30 12:16:02 2000 @@ -10,7 +10,7 @@ getopts("mlce:",\%opt); my $expr = (defined $opt{'e'}) ? $opt{'e'} : shift; -print "Matching '$expr'\n"; +warn "Matching '$expr'\n"; my $count = 0; Index: grepperl --- Tk800.022/grepperl Thu Dec 30 14:52:10 1999 +++ Tk800.023/grepperl Thu Mar 29 09:42:59 2001 @@ -1,4 +1,4 @@ -#!/usr/local/bin/perl +#!/tools/local/perl -w use Getopt::Std; @@ -36,7 +36,7 @@ $count++; unless ($opt{'c'}) { - print "$File::Find::dir/$file:$.: $_" + print "$File::Find::dir/$file:$.: $_" } } } @@ -48,9 +48,9 @@ return 1; } $count++; - unless ($opt{'c'}) + unless ($opt{'c'} || $opt{'l'}) { - print "$File::Find::dir/$file:$.: $_" + print "$File::Find::dir/$file:$.: $_" } } return 0; @@ -65,7 +65,11 @@ local $file = ($_); local ($_); local $count = 0; - open($file,"<$file") || die "Cannot open $file:$!"; + unless (open($file,"<$file")) + { + warn "Cannot open $file:$!"; + return; + } while (<$file>) { last if &match; @@ -73,7 +77,7 @@ close($file); if ($opt{'c'} && $count) { - print "$File::Find::dir/$file: $count\n" + print "$File::Find::dir/$file: $count\n" } } elsif (-d $_) Index: grept --- Tk800.022/grept Tue Jul 27 19:20:24 1999 +++ Tk800.023/grept Sat Jan 13 17:57:07 2001 @@ -1,18 +1,24 @@ -#!/usr/local/bin/nperl +#!/tools/local/perl -w +use strict; use File::Find; use Getopt::Std; my %opt; -getopts("mlc",\%opt); +getopts("milce:",\%opt); -$expr = shift; +my $count; +use vars qw($file); + +my $expr = (defined $opt{'e'}) ? $opt{'e'} : shift; +warn "Matching '$expr'\n"; + +my $re = ($opt{'i'}) ? qr/$expr/i : qr/$expr/; -print "Matching '$expr'\n"; sub match { - if (/$expr/o) + if ($_ =~ $re) { if ($opt{'l'}) { @@ -22,7 +28,7 @@ $count++; unless ($opt{'c'}) { - print "$File::Find::name:$.: $_" + print "$File::Find::name:$.: $_" } } return 0; @@ -35,6 +41,7 @@ { local $file = ($_); local ($_); + no strict 'refs'; open($file,"<$file") || die "Cannot open $file:$!"; while (<$file>) { @@ -43,7 +50,7 @@ close($file); if ($opt{'c'} && $count) { - print "$File::Find::name: $count\n" + print "$File::Find::name: $count\n" } } elsif (-d $_) Index: lib/Tie/Watch.pm --- /dev/null Sat Dec 30 02:58:04 2000 +++ Tk800.023/lib/Tie/Watch.pm Sat Dec 30 16:12:37 2000 @@ -0,0 +1,546 @@ +package Tie::Watch; + +use vars qw($VERSION); +$VERSION = '3.002'; # $Id: //depot/Tk8/lib/Tie/Watch.pm#2 $ + +=head1 NAME + + Tie::Watch - place watchpoints on Perl variables. + +=head1 SYNOPSIS + + use Tie::Watch; + + $watch = Tie::Watch->new( + -variable => \$frog, + -debug => 1, + -shadow => 0, + -fetch => [\&fetch, 'arg1', 'arg2', ..., 'argn'], + -store => \&store, + -destroy => sub {print "Final value=$frog.\n"}, + } + %vinfo = $watch->Info; + $args = $watch->Args(-fetch); + $val = $watch->Fetch; + print "val=", $watch->Say($val), ".\n"; + $watch->Store('Hello'); + $watch->Unwatch; + +=head1 DESCRIPTION + +This class module binds one or more subroutines of your devising to a +Perl variable. All variables can have B, B and +B callbacks. Additionally, arrays can define B, B, +B, B, B, B, B, B and +B callbacks, and hashes can define B, B, B, +B and B callbacks. If these term are unfamiliar to you, +I I suggest you read L. + +With Tie::Watch you can: + + . alter a variable's value + . prevent a variable's value from being changed + . invoke a Perl/Tk callback when a variable changes + . trace references to a variable + +Callback format is patterned after the Perl/Tk scheme: supply either a +code reference, or, supply an array reference and pass the callback +code reference in the first element of the array, followed by callback +arguments. (See examples in the Synopsis, above.) + +Tie::Watch provides default callbacks for any that you fail to +specify. Other than negatively impacting performance, they perform +the standard action that you'd expect, so the variable behaves +"normally". Once you override a default callback, perhaps to insert +debug code like print statements, your callback normally finishes by +calling the underlying (overridden) method. But you don't have to! + +To map a tied method name to a default callback name simply lowercase +the tied method name and uppercase its first character. So FETCH +becomes Fetch, NEXTKEY becomes Nextkey, etcetera. + +Here are two callbacks for a scalar. The B (read) callback does +nothing other than illustrate the fact that it returns the value to +assign the variable. The B (write) callback uppercases the +variable and returns it. In all cases the callback I return the +correct read or write value - typically, it does this by invoking the +underlying method. + + my $fetch_scalar = sub { + my($self) = @_; + $self->Fetch; + }; + + my $store_scalar = sub { + my($self, $new_val) = @_; + $self->Store(uc $new_val); + }; + +Here are B and B callbacks for either an array or hash. +They do essentially the same thing as the scalar callbacks, but +provide a little more information. + + my $fetch = sub { + my($self, $key) = @_; + my $val = $self->Fetch($key); + print "In fetch callback, key=$key, val=", $self->Say($val); + my $args = $self->Args(-fetch); + print ", args=('", join("', '", @$args), "')" if $args; + print ".\n"; + $val; + }; + + my $store = sub { + my($self, $key, $new_val) = @_; + my $val = $self->Fetch($key); + $new_val = uc $new_val; + $self->Store($key, $new_val); + print "In store callback, key=$key, val=", $self->Say($val), + ", new_val=", $self->Say($new_val); + my $args = $self->Args(-store); + print ", args=('", join("', '", @$args), "')" if $args; + print ".\n"; + $new_val; + }; + +In all cases, the first parameter is a reference to the Watch object, +used to invoke the following class methods. + +=head1 METHODS + +=over 4 + +=item $watch = Tie::Watch->new(-options => values); + +The watchpoint constructor method that accepts option/value pairs to +create and configure the Watch object. The only required option is +B<-variable>. + +B<-variable> is a I to a scalar, array or hash variable. + +B<-debug> (default 0) is 1 to activate debug print statements internal +to Tie::Watch. + +B<-shadow> (default 1) is 0 to disable array and hash shadowing. To +prevent infinite recursion Tie::Watch maintains parallel variables for +arrays and hashes. When the watchpoint is created the parallel shadow +variable is initialized with the watched variable's contents, and when +the watchpoint is deleted the shadow variable is copied to the original +variable. Thus, changes made during the watch process are not lost. +Shadowing is on my default. If you disable shadowing any changes made +to an array or hash are lost when the watchpoint is deleted. + +Specify any of the following relevant callback parameters, in the +format described above: B<-fetch>, B<-store>, B<-destroy>. +Additionally for arrays: B<-clear>, B<-extend>, B<-fetchsize>, +B<-pop>, B<-push>, B<-shift>, B<-splice>, B<-storesize> and +B<-unshift>. Additionally for hashes: B<-clear>, B<-delete>, +B<-exists>, B<-firstkey> and B<-nextkey>. + +=item $args = $watch->Args(-fetch); + +Returns a reference to a list of arguments for the specified callback, +or undefined if none. + +=item $watch->Fetch(); $watch->Fetch($key); + +Returns a variable's current value. $key is required for an array or +hash. + +=item %vinfo = $watch->Info(); + +Returns a hash detailing the internals of the Watch object, with these +keys: + + %vinfo = { + -variable => SCALAR(0x200737f8) + -debug => '0' + -shadow => '1' + -value => 'HELLO SCALAR' + -destroy => ARRAY(0x200f86cc) + -fetch => ARRAY(0x200f8558) + -store => ARRAY(0x200f85a0) + -legible => above data formatted as a list of string, for printing + } + +For array and hash Watch objects, the B<-value> key is replaced with a +B<-ptr> key which is a reference to the parallel array or hash. +Additionally, for an array or hash, there are key/value pairs for +all the variable specific callbacks. + +=item $watch->Say($val); + +Used mainly for debugging, it returns $val in quotes if required, or +the string "undefined" for undefined values. + +=item $watch->Store($new_val); $watch->Store($key, $new_val); + +Store a variable's new value. $key is required for an array or hash. + +=item $watch->Unwatch(); + +Stop watching the variable. + +=back + +=head1 EFFICIENCY CONSIDERATIONS + +If you can live using the class methods provided, please do so. You +can meddle with the object hash directly and improved watch +performance, at the risk of your code breaking in the future. + +=head1 AUTHOR + +Stephen.O.Lidie@Lehigh.EDU + +=head1 HISTORY + + lusol@Lehigh.EDU, LUCC, 96/05/30 + . Original version 0.92 release, based on the Trace module from Hans Mulder, + and ideas from Tim Bunce. + + lusol@Lehigh.EDU, LUCC, 96/12/25 + . Version 0.96, release two inner references detected by Perl 5.004. + + lusol@Lehigh.EDU, LUCC, 97/01/11 + . Version 0.97, fix Makefile.PL and MANIFEST (thanks Andreas Koenig). + Make sure test.pl doesn't fail if Tk isn't installed. + + Stephen.O.Lidie@Lehigh.EDU, Lehigh University Computing Center, 97/10/03 + . Version 0.98, implement -shadow option for arrays and hashes. + + Stephen.O.Lidie@Lehigh.EDU, Lehigh University Computing Center, 98/02/11 + . Version 0.99, finally, with Perl 5.004_57, we can completely watch arrays. + With tied array support this module is essentially complete, so its been + optimized for speed at the expense of clarity - sorry about that. The + Delete() method has been renamed Unwatch() because it conflicts with the + builtin delete(). + + Stephen.O.Lidie@Lehigh.EDU, Lehigh University Computing Center, 99/04/04 + . Version 1.0, for Perl 5.005_03, update Makefile.PL for ActiveState, and + add two examples (one for Perl/Tk). + +=head1 COPYRIGHT + +Copyright (C) 1996 - 1999 Stephen O. Lidie. All rights reserved. + +This program is free software; you can redistribute it and/or modify it under +the same terms as Perl itself. + +=cut + +use 5.004_57; +use Carp; +use strict; +use subs qw/normalize_callbacks/; +use vars qw/@array_callbacks @hash_callbacks @scalar_callbacks/; + +@array_callbacks = qw/-clear -destroy -extend -fetch -fetchsize -pop -push + -shift -splice -store -storesize -unshift/; +@hash_callbacks = qw/-clear -delete -destroy -exists -fetch -firstkey + -nextkey -store/; +@scalar_callbacks = qw/-destroy -fetch -store/; + +sub new { + + # Watch constructor. The *real* constructor is Tie::Watch->base_watch(), + # invoked by methods in other Watch packages, depending upon the variable's + # type. Here we supply defaulted parameter values and then verify them, + # normalize all callbacks and bind the variable to the appropriate package. + + my($class, %args) = @_; + my $version = $Tie::Watch::VERSION; + my (%arg_defaults) = (-debug => 0, -shadow => 1); + my $variable = $args{-variable}; + croak "Tie::Watch::new(): -variable is required." if not defined $variable; + + my($type, $watch_obj) = (ref $variable, undef); + if ($type =~ /SCALAR/) { + @arg_defaults{@scalar_callbacks} = ( + [\&Tie::Watch::Scalar::Destroy], [\&Tie::Watch::Scalar::Fetch], + [\&Tie::Watch::Scalar::Store]); + } elsif ($type =~ /ARRAY/) { + @arg_defaults{@array_callbacks} = ( + [\&Tie::Watch::Array::Clear], [\&Tie::Watch::Array::Destroy], + [\&Tie::Watch::Array::Extend], [\&Tie::Watch::Array::Fetch], + [\&Tie::Watch::Array::Fetchsize], [\&Tie::Watch::Array::Pop], + [\&Tie::Watch::Array::Push], [\&Tie::Watch::Array::Shift], + [\&Tie::Watch::Array::Splice], [\&Tie::Watch::Array::Store], + [\&Tie::Watch::Array::Storesize], [\&Tie::Watch::Array::Unshift]); + } elsif ($type =~ /HASH/) { + @arg_defaults{@hash_callbacks} = ( + [\&Tie::Watch::Hash::Clear], [\&Tie::Watch::Hash::Delete], + [\&Tie::Watch::Hash::Destroy], [\&Tie::Watch::Hash::Exists], + [\&Tie::Watch::Hash::Fetch], [\&Tie::Watch::Hash::Firstkey], + [\&Tie::Watch::Hash::Nextkey], [\&Tie::Watch::Hash::Store]); + } else { + croak "Tie::Watch::new() - not a variable reference."; + } + my(@margs, %ahsh, $args, @args); + @margs = grep ! defined $args{$_}, keys %arg_defaults; + %ahsh = %args; # argument hash + @ahsh{@margs} = @arg_defaults{@margs}; # fill in missing values + normalize_callbacks \%ahsh; + + if ($type =~ /SCALAR/) { + $watch_obj = tie $$variable, 'Tie::Watch::Scalar', %ahsh; + } elsif ($type =~ /ARRAY/) { + $watch_obj = tie @$variable, 'Tie::Watch::Array', %ahsh; + } elsif ($type =~ /HASH/) { + $watch_obj = tie %$variable, 'Tie::Watch::Hash', %ahsh; + } + $watch_obj; + +} # end new, Watch constructor + +sub Args { + + # Return a reference to a list of callback arguments, or undef if none. + # + # $_[0] = self + # $_[1] = callback type + + defined $_[0]->{$_[1]}->[1] ? [@{$_[0]->{$_[1]}}[1 .. $#{$_[0]->{$_[1]}}]] + : undef; + +} # end Args + +sub Info { + + # Info() method subclassed by other Watch modules. + # + # $_[0] = self + # @_[1 .. $#_] = optional callback types + + my(%vinfo, @results); + my(@info) = (qw/-variable -debug -shadow/); + push @info, @_[1 .. $#_] if scalar @_ >= 2; + foreach my $type (@info) { + push @results, sprintf('%-10s: ', substr $type, 1) . + $_[0]->Say($_[0]->{$type}); + $vinfo{$type} = $_[0]->{$type}; + } + $vinfo{-legible} = [@results]; + %vinfo; + +} # end Info + +sub Say { + + # For debugging, mainly. + # + # $_[0] = self + # $_[1] = value + + defined $_[1] ? (ref($_[1]) ne '' ? $_[1] : "'$_[1]'") : "undefined"; + +} # end Say + +sub Unwatch { + + # Stop watching a variable by releasing the last reference and untieing it. + # Update the original variable with its shadow, if appropriate. + # + # $_[0] = self + + my $variable = $_[0]->{-variable}; + my $type = ref $variable; + my $copy = $_[0]->{-ptr} if $type !~ /SCALAR/; + my $shadow = $_[0]->{-shadow}; + undef $_[0]; + if ($type =~ /SCALAR/) { + untie $$variable; + } elsif ($type =~ /ARRAY/) { + untie @$variable; + @$variable = @$copy if $shadow; + } elsif ($type =~ /HASH/) { + untie %$variable; + %$variable = %$copy if $shadow; + } else { + croak "Tie::Watch::Delete() - not a variable reference."; + } + +} # end Unwatch + +# Watch private methods. + +sub base_watch { + + # Watch base class constructor invoked by other Watch modules. + + my($class, %args) = @_; + my $watch_obj = {%args}; + $watch_obj; + +} # end base_watch + +sub callback { + + # Execute a Watch callback, either the default or user specified. + # Note that the arguments are those supplied by the tied method, + # not those (if any) specified by the user when the watch object + # was instantiated. This is for performance reasons, and why the + # Args() method exists. + # + # $_[0] = self + # $_[1] = callback type + # $_[2] through $#_ = tied arguments + + &{$_[0]->{$_[1]}->[0]} ($_[0], @_[2 .. $#_]); + +} # end callback + +sub normalize_callbacks { + + # Ensure all callbacks are normalized in [\&code, @args] format. + + my($args_ref) = @_; + my($cb, $ref); + foreach my $arg (keys %$args_ref) { + next if $arg =~ /variable|debug|shadow/; + $cb = $args_ref->{$arg}; + $ref = ref $cb; + if ($ref =~ /CODE/) { + $args_ref->{$arg} = [$cb]; + } elsif ($ref !~ /ARRAY/) { + croak "Tie::Watch: malformed callback $arg=$cb."; + } + } + +} # end normalize_callbacks + +############################################################################### + +package Tie::Watch::Scalar; + +use Carp; +@Tie::Watch::Scalar::ISA = qw/Tie::Watch/; + +sub TIESCALAR { + + my($class, %args) = @_; + my $variable = $args{-variable}; + my $watch_obj = Tie::Watch->base_watch(%args); + $watch_obj->{-value} = $$variable; + print "WatchScalar new: $variable created, \@_=", join(',', @_), "!\n" + if $watch_obj->{-debug}; + bless $watch_obj, $class; + +} # end TIESCALAR + +sub Info {$_[0]->SUPER::Info('-value', @Tie::Watch::scalar_callbacks)} + +# Default scalar callbacks. + +sub Destroy {undef %{$_[0]}} +sub Fetch {$_[0]->{-value}} +sub Store {$_[0]->{-value} = $_[1]} + +# Scalar access methods. + +sub DESTROY {$_[0]->callback(-destroy)} +sub FETCH {$_[0]->callback(-fetch)} +sub STORE {$_[0]->callback(-store, $_[1])} + +############################################################################### + +package Tie::Watch::Array; + +use Carp; +@Tie::Watch::Array::ISA = qw/Tie::Watch/; + +sub TIEARRAY { + + my($class, %args) = @_; + my($variable, $shadow) = @args{-variable, -shadow}; + my @copy = @$variable if $shadow; # make a private copy of user's array + $args{-ptr} = $shadow ? \@copy : []; + my $watch_obj = Tie::Watch->base_watch(%args); + print "WatchArray new: $variable created, \@_=", join(',', @_), "!\n" + if $watch_obj->{-debug}; + bless $watch_obj, $class; + +} # end TIEARRAY + +sub Info {$_[0]->SUPER::Info('-ptr', @Tie::Watch::array_callbacks)} + +# Default array callbacks. + +sub Clear {$_[0]->{-ptr} = ()} +sub Destroy {undef %{$_[0]}} +sub Extend {} +sub Fetch {$_[0]->{-ptr}->[$_[1]]} +sub Fetchsize {scalar @{$_[0]->{-ptr}}} +sub Pop {pop @{$_[0]->{-ptr}}} +sub Push {push @{$_[0]->{-ptr}}, @_[1 .. $#_]} +sub Shift {shift @{$_[0]->{-ptr}}} +sub Splice { + my $n = scalar @_; # splice() is wierd! + return splice @{$_[0]->{-ptr}}, $_[1] if $n == 2; + return splice @{$_[0]->{-ptr}}, $_[1], $_[2] if $n == 3; + return splice @{$_[0]->{-ptr}}, $_[1], $_[2], @_[3 .. $#_] if $n >= 4; +} +sub Store {$_[0]->{-ptr}->[$_[1]] = $_[2]} +sub Storesize {$#{@{$_[0]->{-ptr}}} = $_[1] - 1} +sub Unshift {unshift @{$_[0]->{-ptr}}, @_[1 .. $#_]} + +# Array access methods. + +sub CLEAR {$_[0]->callback(-clear)} +sub DESTROY {$_[0]->callback(-destroy)} +sub EXTEND {$_[0]->callback(-extend, $_[1])} +sub FETCH {$_[0]->callback(-fetch, $_[1])} +sub FETCHSIZE {$_[0]->callback(-fetchsize)} +sub POP {$_[0]->callback('-pop')} +sub PUSH {$_[0]->callback('-push', @_[1 .. $#_])} +sub SHIFT {$_[0]->callback('-shift')} +sub SPLICE {$_[0]->callback('-splice', @_[1 .. $#_])} +sub STORE {$_[0]->callback(-store, $_[1], $_[2])} +sub STORESIZE {$_[0]->callback(-storesize, $_[1])} +sub UNSHIFT {$_[0]->callback('-unshift', @_[1 .. $#_])} + +############################################################################### + +package Tie::Watch::Hash; + +use Carp; +@Tie::Watch::Hash::ISA = qw/Tie::Watch/; + +sub TIEHASH { + + my($class, %args) = @_; + my($variable, $shadow) = @args{-variable, -shadow}; + my %copy = %$variable if $shadow; # make a private copy of user's hash + $args{-ptr} = $shadow ? \%copy : {}; + my $watch_obj = Tie::Watch->base_watch(%args); + print "WatchHash new: $variable created, \@_=", join(',', @_), "!\n" + if $watch_obj->{-debug}; + bless $watch_obj, $class; + +} # end TIEHASH + +sub Info {$_[0]->SUPER::Info('-ptr', @Tie::Watch::hash_callbacks)} + +# Default hash callbacks. + +sub Clear {$_[0]->{-ptr} = ()} +sub Delete {delete $_[0]->{-ptr}->{$_[1]}} +sub Destroy {undef %{$_[0]}} +sub Exists {exists $_[0]->{-ptr}->{$_[1]}} +sub Fetch {$_[0]->{-ptr}->{$_[1]}} +sub Firstkey {my $c = keys %{$_[0]->{-ptr}}; each %{$_[0]->{-ptr}}} +sub Nextkey {each %{$_[0]->{-ptr}}} +sub Store {$_[0]->{-ptr}->{$_[1]} = $_[2]} + +# Hash access methods. + +sub CLEAR {$_[0]->callback(-clear)} +sub DELETE {$_[0]->callback('-delete', $_[1])} +sub DESTROY {$_[0]->callback(-destroy)} +sub EXISTS {$_[0]->callback('-exists', $_[1])} +sub FETCH {$_[0]->callback(-fetch, $_[1])} +sub FIRSTKEY {$_[0]->callback(-firstkey)} +sub NEXTKEY {$_[0]->callback(-nextkey)} +sub STORE {$_[0]->callback(-store, $_[1], $_[2])} + +1; Index: objGlue.c --- Tk800.022/objGlue.c Fri Apr 21 09:36:23 2000 +++ Tk800.023/objGlue.c Sat Dec 30 16:12:37 2000 @@ -456,7 +456,9 @@ } else { - sv_setsv(sv,MakeReference((SV *) av)); + SV *ref = MakeReference((SV *) av); + sv_setsv(sv,ref); + SvREFCNT_dec(ref); } return (AV *) SvRV(sv); } @@ -468,6 +470,8 @@ Tcl_Obj *objPtr) { AV *av = ForceList(interp,listPtr); + if (!objPtr) + objPtr = &PL_sv_undef; if (av) { av_push(av, objPtr); Index: pTk/Lang.h --- Tk800.022/pTk/Lang.h Fri Apr 21 09:13:10 2000 +++ Tk800.023/pTk/Lang.h Sat Dec 30 16:12:37 2000 @@ -43,6 +43,11 @@ # define strcasecmp stricmp #endif +#ifdef __CYGWIN__ +#include +#define MASK_SIZE howmany(FD_SETSIZE, NFDBITS) +#endif + /* * When version numbers change here, must also go into the following files * and update the version numbers: @@ -346,7 +351,7 @@ typedef void (Tcl_CloseProc) _ANSI_ARGS_((ClientData data)); typedef void (Tcl_CmdDeleteProc) _ANSI_ARGS_((ClientData clientData)); typedef int (Tcl_CmdProc) _ANSI_ARGS_((ClientData clientData, - Tcl_Interp *interp, int argc, Arg *argv)); + Tcl_Interp *interp, int argc, Tcl_Obj **argv)); typedef void (Tcl_CmdTraceProc) _ANSI_ARGS_((ClientData clientData, Tcl_Interp *interp, int level, char *command, Tcl_CmdProc *proc, ClientData cmdClientData, int argc, char *argv[])); @@ -952,7 +957,7 @@ * are also used in Tcl_GetStdChannel. */ -#define TCL_STDIN (1<<1) +#define TCL_STDIN (1<<1) #define TCL_STDOUT (1<<2) #define TCL_STDERR (1<<3) #define TCL_ENFORCE_MODE (1<<4) @@ -1089,7 +1094,7 @@ EXTERN int Tcl_Close _ANSI_ARGS_((Tcl_Interp *interp, Tcl_Channel chan)); EXTERN int Tcl_CommandComplete _ANSI_ARGS_((char *cmd)); -EXTERN Arg Tcl_Concat _ANSI_ARGS_((int argc, Arg *argv)); +EXTERN Tcl_Obj *Tcl_Concat _ANSI_ARGS_((int argc, Tcl_Obj **argv)); EXTERN Tcl_Obj * Tcl_ConcatObj _ANSI_ARGS_((int objc, Tcl_Obj *CONST objv[])); EXTERN int Tcl_ConvertCountedElement _ANSI_ARGS_((char *src, @@ -1263,7 +1268,7 @@ EXTERN ClientData Tcl_GetAssocData _ANSI_ARGS_((Tcl_Interp *interp, char *name, Tcl_InterpDeleteProc **procPtr)); EXTERN int Tcl_GetBoolean _ANSI_ARGS_((Tcl_Interp *interp, - Arg string, int *boolPtr)); + Tcl_Obj *string, int *boolPtr)); EXTERN int Tcl_GetBooleanFromObj _ANSI_ARGS_(( Tcl_Interp *interp, Tcl_Obj *objPtr, int *boolPtr)); @@ -1287,7 +1292,7 @@ Tcl_Command command)); EXTERN char * Tcl_GetCwd _ANSI_ARGS_((char *buf, int len)); EXTERN int Tcl_GetDouble _ANSI_ARGS_((Tcl_Interp *interp, - Arg string, double *doublePtr)); + Tcl_Obj *string, double *doublePtr)); EXTERN int Tcl_GetDoubleFromObj _ANSI_ARGS_(( Tcl_Interp *interp, Tcl_Obj *objPtr, double *doublePtr)); @@ -1298,7 +1303,7 @@ Tcl_Obj *objPtr, char **tablePtr, char *msg, int flags, int *indexPtr)); EXTERN int Tcl_GetInt _ANSI_ARGS_((Tcl_Interp *interp, - Arg string, int *intPtr)); + Tcl_Obj *string, int *intPtr)); EXTERN int Tcl_GetInterpPath _ANSI_ARGS_((Tcl_Interp *askInterp, Tcl_Interp *slaveInterp)); EXTERN int Tcl_GetIntFromObj _ANSI_ARGS_((Tcl_Interp *interp, @@ -1309,7 +1314,7 @@ EXTERN Tcl_Obj * Tcl_GetObjResult _ANSI_ARGS_((Tcl_Interp *interp)); EXTERN Tcl_ObjType * Tcl_GetObjType _ANSI_ARGS_((char *typeName)); EXTERN int Tcl_GetOpenFile _ANSI_ARGS_((Tcl_Interp *interp, - Arg string, int write, int checkUsage, + Tcl_Obj *string, int write, int checkUsage, ClientData *filePtr)); EXTERN Tcl_Command Tcl_GetOriginalCommand _ANSI_ARGS_(( Tcl_Command command)); @@ -1325,9 +1330,9 @@ EXTERN char * Tcl_GetStringFromObj _ANSI_ARGS_((Tcl_Obj *objPtr, int *lengthPtr)); EXTERN char * Tcl_GetStringResult _ANSI_ARGS_((Tcl_Interp *interp)); -EXTERN Arg Tcl_GetVar _ANSI_ARGS_((Tcl_Interp *interp, +EXTERN Tcl_Obj *Tcl_GetVar _ANSI_ARGS_((Tcl_Interp *interp, Var varName, int flags)); -EXTERN Arg Tcl_GetVar2 _ANSI_ARGS_((Tcl_Interp *interp, +EXTERN Tcl_Obj *Tcl_GetVar2 _ANSI_ARGS_((Tcl_Interp *interp, Var part1, char *part2, int flags)); EXTERN int Tcl_GlobalEval _ANSI_ARGS_((Tcl_Interp *interp, char *command)); @@ -1374,7 +1379,7 @@ EXTERN int Tcl_MakeSafe _ANSI_ARGS_((Tcl_Interp *interp)); EXTERN Tcl_Channel Tcl_MakeTcpClientChannel _ANSI_ARGS_(( ClientData tcpSocket)); -EXTERN Arg Tcl_Merge _ANSI_ARGS_((int argc, Arg *argv)); +EXTERN Tcl_Obj *Tcl_Merge _ANSI_ARGS_((int argc, Tcl_Obj **argv)); EXTERN Tcl_HashEntry * Tcl_NextHashEntry _ANSI_ARGS_(( Tcl_HashSearch *searchPtr)); EXTERN void Tcl_NotifyChannel _ANSI_ARGS_((Tcl_Channel channel, @@ -1487,7 +1492,7 @@ EXTERN char * Tcl_SetVar _ANSI_ARGS_((Tcl_Interp *interp, Var varName, char *newValue, int flags)); EXTERN char * Tcl_SetVarArg _ANSI_ARGS_((Tcl_Interp *interp, - Var varName, Arg newValue, int flags)); + Var varName, Tcl_Obj *newValue, int flags)); EXTERN char * Tcl_SetVar2 _ANSI_ARGS_((Tcl_Interp *interp, Var part1, char *part2, char *newValue, int flags)); @@ -1551,7 +1556,7 @@ int options)); EXTERN int Tcl_Write _ANSI_ARGS_((Tcl_Channel chan, char *s, int slen)); -EXTERN void Tcl_AppendArg _ANSI_ARGS_((Tcl_Interp *interp, Arg)); +EXTERN void Tcl_AppendArg _ANSI_ARGS_((Tcl_Interp *interp, Tcl_Obj *)); EXTERN void Tcl_IntResults _ANSI_ARGS_((Tcl_Interp *interp,int,int,...)); EXTERN void Tcl_DoubleResults _ANSI_ARGS_((Tcl_Interp *interp,int,int,...)); @@ -1564,23 +1569,27 @@ #define Tcl_GlobalEval(interp,cmd) LangEval(interp,cmd,1) -EXTERN char * LangMergeString _ANSI_ARGS_((int argc, Arg *args)); +EXTERN char * LangMergeString _ANSI_ARGS_((int argc, Tcl_Obj **args)); EXTERN int LangEval _ANSI_ARGS_((Tcl_Interp *interp, char *cmd, int global)); -EXTERN char *LangString _ANSI_ARGS_((Arg)); -EXTERN void LangSetString _ANSI_ARGS_((Arg *,char *)); -EXTERN void LangSetDefault _ANSI_ARGS_((Arg *,char *)); -EXTERN void LangSetInt _ANSI_ARGS_((Arg *,int)); -EXTERN void LangSetDouble _ANSI_ARGS_((Arg *,double)); -EXTERN void LangSetArg _ANSI_ARGS_((Arg *,Arg)); -EXTERN void LangSetVar _ANSI_ARGS_((Arg *,Var)); +EXTERN char *LangString _ANSI_ARGS_((Tcl_Obj *)); +EXTERN void LangSetString _ANSI_ARGS_((Tcl_Obj **,char *)); +EXTERN void LangSetDefault _ANSI_ARGS_((Tcl_Obj **,char *)); +EXTERN void LangSetInt _ANSI_ARGS_((Tcl_Obj **,int)); +EXTERN void LangSetDouble _ANSI_ARGS_((Tcl_Obj **,double)); +EXTERN void LangSetObj _ANSI_ARGS_((Tcl_Obj **,Tcl_Obj *)); +EXTERN void LangOldSetArg _ANSI_ARGS_((Tcl_Obj **,Tcl_Obj *,char *,int)); +#define LangSetArg(ap,a) LangOldSetArg(ap,a,__FILE__,__LINE__) +EXTERN void LangSetVar _ANSI_ARGS_((Tcl_Obj **,Var)); -EXTERN int LangCmpArg _ANSI_ARGS_((Arg,Arg)); +EXTERN int LangCmpArg _ANSI_ARGS_((Tcl_Obj *,Tcl_Obj *)); EXTERN int LangCmpOpt _ANSI_ARGS_((char *opt,char *arg,size_t length)); +EXTERN void Lang_OldArgResult _ANSI_ARGS_ ((Tcl_Interp *,Tcl_Obj *,char *,int)); +EXTERN Tcl_Obj *LangObjArg _ANSI_ARGS_ ((Tcl_Obj *,char *,int)); #define LangStringArg(s) Tcl_NewStringObj(s,-1) -#define Tcl_ArgResult(interp,obj) Tcl_SetObjResult(interp,obj) +#define Tcl_ArgResult(interp,obj) Lang_OldArgResult(interp,obj,__FILE__,__LINE__) /* FIXME: Tk will set freeProc as for Tcl e.g. NULL for statics & UIDs @@ -1592,8 +1601,8 @@ LangSetString() deliberately malloc() a copy of the string so we don't need the freeProc */ -EXTERN void LangFreeArg _ANSI_ARGS_((Arg,Tcl_FreeProc *freeProc)); -EXTERN Arg LangCopyArg _ANSI_ARGS_((Arg)); +EXTERN void LangFreeArg _ANSI_ARGS_((Tcl_Obj *,Tcl_FreeProc *freeProc)); +EXTERN Tcl_Obj *LangCopyArg _ANSI_ARGS_((Tcl_Obj *)); EXTERN void LangRestoreResult _ANSI_ARGS_((Tcl_Interp **,LangResultSave *)); EXTERN LangResultSave *LangSaveResult _ANSI_ARGS_((Tcl_Interp **)); @@ -1604,13 +1613,13 @@ #define panic Tcl_Panic -EXTERN int LangNull _ANSI_ARGS_((Arg)); +EXTERN int LangNull _ANSI_ARGS_((Tcl_Obj *)); /* Used to default Menu variable to the label TCL just strdup's the string so it can be ckfree'ed */ -EXTERN int LangStringMatch _ANSI_ARGS_((char *string, Arg match)); +EXTERN int LangStringMatch _ANSI_ARGS_((char *string, Tcl_Obj *match)); EXTERN void LangExit _ANSI_ARGS_((int)); @@ -1632,10 +1641,10 @@ EXTERN char *Lang_GetErrorCode _ANSI_ARGS_((Tcl_Interp *interp)); EXTERN char *Lang_GetErrorInfo _ANSI_ARGS_((Tcl_Interp *interp)); -EXTERN int LangSaveVar _ANSI_ARGS_((Tcl_Interp *,Arg,Var *,int type)); +EXTERN int LangSaveVar _ANSI_ARGS_((Tcl_Interp *,Tcl_Obj *,Var *,int type)); EXTERN void LangFreeVar _ANSI_ARGS_((Var)); -EXTERN Arg Tcl_ResultArg _ANSI_ARGS_((Tcl_Interp *interp)); -EXTERN Arg LangScalarResult _ANSI_ARGS_((Tcl_Interp *interp)); +EXTERN Tcl_Obj *Tcl_ResultArg _ANSI_ARGS_((Tcl_Interp *interp)); +EXTERN Tcl_Obj *LangScalarResult _ANSI_ARGS_((Tcl_Interp *interp)); EXTERN void Tcl_WrongNumArgs _ANSI_ARGS_((Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[], char *message)); @@ -1658,14 +1667,14 @@ Tcl_CmdDeleteProc *deleteProc)); EXTERN int Lang_CallWithArgs _ANSI_ARGS_ ((Tcl_Interp *interp, - char *sub, int argc, Arg *argv)); + char *sub, int argc, Tcl_Obj **argv)); #ifndef LangCallback typedef struct LangCallback *LangCallback; #endif EXTERN int LangDoCallback _ANSI_ARGS_((Tcl_Interp *,LangCallback *,int result,int argc,...)); -EXTERN int LangMethodCall _ANSI_ARGS_((Tcl_Interp *,Arg,char *,int result,int argc,...)); +EXTERN int LangMethodCall _ANSI_ARGS_((Tcl_Interp *,Tcl_Obj *,char *,int result,int argc,...)); EXTERN char *LangLibraryDir _ANSI_ARGS_((void)); EXTERN void Lang_SetBinaryResult _ANSI_ARGS_((Tcl_Interp *interp, Index: pTk/Lang.m --- Tk800.022/pTk/Lang.m Fri Apr 21 09:18:24 2000 +++ Tk800.023/pTk/Lang.m Sat Dec 30 16:12:37 2000 @@ -59,6 +59,14 @@ # define LangNull (*LangVptr->V_LangNull) #endif +#ifndef LangObjArg +# define LangObjArg (*LangVptr->V_LangObjArg) +#endif + +#ifndef LangOldSetArg +# define LangOldSetArg (*LangVptr->V_LangOldSetArg) +#endif + #ifndef LangRestoreResult # define LangRestoreResult (*LangVptr->V_LangRestoreResult) #endif @@ -75,10 +83,6 @@ # define LangScalarResult (*LangVptr->V_LangScalarResult) #endif -#ifndef LangSetArg -# define LangSetArg (*LangVptr->V_LangSetArg) -#endif - #ifndef LangSetDefault # define LangSetDefault (*LangVptr->V_LangSetDefault) #endif @@ -91,6 +95,10 @@ # define LangSetInt (*LangVptr->V_LangSetInt) #endif +#ifndef LangSetObj +# define LangSetObj (*LangVptr->V_LangSetObj) +#endif + #ifndef LangSetString # define LangSetString (*LangVptr->V_LangSetString) #endif @@ -137,6 +145,10 @@ #ifndef Lang_GetStrInt # define Lang_GetStrInt (*LangVptr->V_Lang_GetStrInt) +#endif + +#ifndef Lang_OldArgResult +# define Lang_OldArgResult (*LangVptr->V_Lang_OldArgResult) #endif #ifndef Lang_RegExpCompile Index: pTk/Lang.t --- Tk800.022/pTk/Lang.t Fri Apr 21 09:18:23 2000 +++ Tk800.023/pTk/Lang.t Sat Dec 30 16:12:37 2000 @@ -5,7 +5,7 @@ #endif #ifndef LangCmpArg -VFUNC(int,LangCmpArg,V_LangCmpArg,_ANSI_ARGS_((Arg,Arg))) +VFUNC(int,LangCmpArg,V_LangCmpArg,_ANSI_ARGS_((Tcl_Obj *,Tcl_Obj *))) #endif #ifndef LangCmpOpt @@ -13,7 +13,7 @@ #endif #ifndef LangCopyArg -VFUNC(Arg,LangCopyArg,V_LangCopyArg,_ANSI_ARGS_((Arg))) +VFUNC(Tcl_Obj *,LangCopyArg,V_LangCopyArg,_ANSI_ARGS_((Tcl_Obj *))) #endif #ifndef LangDoCallback @@ -33,7 +33,7 @@ #endif #ifndef LangFreeArg -VFUNC(void,LangFreeArg,V_LangFreeArg,_ANSI_ARGS_((Arg,Tcl_FreeProc *freeProc))) +VFUNC(void,LangFreeArg,V_LangFreeArg,_ANSI_ARGS_((Tcl_Obj *,Tcl_FreeProc *freeProc))) #endif #ifndef LangFreeVar @@ -45,15 +45,23 @@ #endif #ifndef LangMergeString -VFUNC(char *,LangMergeString,V_LangMergeString,_ANSI_ARGS_((int argc, Arg *args))) +VFUNC(char *,LangMergeString,V_LangMergeString,_ANSI_ARGS_((int argc, Tcl_Obj **args))) #endif #ifndef LangMethodCall -VFUNC(int,LangMethodCall,V_LangMethodCall,_ANSI_ARGS_((Tcl_Interp *,Arg,char *,int result,int argc,...))) +VFUNC(int,LangMethodCall,V_LangMethodCall,_ANSI_ARGS_((Tcl_Interp *,Tcl_Obj *,char *,int result,int argc,...))) #endif #ifndef LangNull -VFUNC(int,LangNull,V_LangNull,_ANSI_ARGS_((Arg))) +VFUNC(int,LangNull,V_LangNull,_ANSI_ARGS_((Tcl_Obj *))) +#endif + +#ifndef LangObjArg +VFUNC(Tcl_Obj *,LangObjArg,V_LangObjArg,_ANSI_ARGS_((Tcl_Obj *,char *,int))) +#endif + +#ifndef LangOldSetArg +VFUNC(void,LangOldSetArg,V_LangOldSetArg,_ANSI_ARGS_((Tcl_Obj **,Tcl_Obj *,char *,int))) #endif #ifndef LangRestoreResult @@ -65,43 +73,43 @@ #endif #ifndef LangSaveVar -VFUNC(int,LangSaveVar,V_LangSaveVar,_ANSI_ARGS_((Tcl_Interp *,Arg,Var *,int type))) +VFUNC(int,LangSaveVar,V_LangSaveVar,_ANSI_ARGS_((Tcl_Interp *,Tcl_Obj *,Var *,int type))) #endif #ifndef LangScalarResult -VFUNC(Arg,LangScalarResult,V_LangScalarResult,_ANSI_ARGS_((Tcl_Interp *interp))) -#endif - -#ifndef LangSetArg -VFUNC(void,LangSetArg,V_LangSetArg,_ANSI_ARGS_((Arg *,Arg))) +VFUNC(Tcl_Obj *,LangScalarResult,V_LangScalarResult,_ANSI_ARGS_((Tcl_Interp *interp))) #endif #ifndef LangSetDefault -VFUNC(void,LangSetDefault,V_LangSetDefault,_ANSI_ARGS_((Arg *,char *))) +VFUNC(void,LangSetDefault,V_LangSetDefault,_ANSI_ARGS_((Tcl_Obj **,char *))) #endif #ifndef LangSetDouble -VFUNC(void,LangSetDouble,V_LangSetDouble,_ANSI_ARGS_((Arg *,double))) +VFUNC(void,LangSetDouble,V_LangSetDouble,_ANSI_ARGS_((Tcl_Obj **,double))) #endif #ifndef LangSetInt -VFUNC(void,LangSetInt,V_LangSetInt,_ANSI_ARGS_((Arg *,int))) +VFUNC(void,LangSetInt,V_LangSetInt,_ANSI_ARGS_((Tcl_Obj **,int))) +#endif + +#ifndef LangSetObj +VFUNC(void,LangSetObj,V_LangSetObj,_ANSI_ARGS_((Tcl_Obj **,Tcl_Obj *))) #endif #ifndef LangSetString -VFUNC(void,LangSetString,V_LangSetString,_ANSI_ARGS_((Arg *,char *))) +VFUNC(void,LangSetString,V_LangSetString,_ANSI_ARGS_((Tcl_Obj **,char *))) #endif #ifndef LangSetVar -VFUNC(void,LangSetVar,V_LangSetVar,_ANSI_ARGS_((Arg *,Var))) +VFUNC(void,LangSetVar,V_LangSetVar,_ANSI_ARGS_((Tcl_Obj **,Var))) #endif #ifndef LangString -VFUNC(char *,LangString,V_LangString,_ANSI_ARGS_((Arg))) +VFUNC(char *,LangString,V_LangString,_ANSI_ARGS_((Tcl_Obj *))) #endif #ifndef LangStringMatch -VFUNC(int,LangStringMatch,V_LangStringMatch,_ANSI_ARGS_((char *string, Arg match))) +VFUNC(int,LangStringMatch,V_LangStringMatch,_ANSI_ARGS_((char *string, Tcl_Obj *match))) #endif #ifndef Lang_BuildInImages @@ -110,7 +118,7 @@ #ifndef Lang_CallWithArgs VFUNC(int,Lang_CallWithArgs,V_Lang_CallWithArgs,_ANSI_ARGS_((Tcl_Interp *interp, - char *sub, int argc, Arg *argv))) + char *sub, int argc, Tcl_Obj **argv))) #endif #ifndef Lang_CreateObject @@ -141,6 +149,10 @@ char *string, int *intPtr))) #endif +#ifndef Lang_OldArgResult +VFUNC(void,Lang_OldArgResult,V_Lang_OldArgResult,_ANSI_ARGS_((Tcl_Interp *,Tcl_Obj *,char *,int))) +#endif + #ifndef Lang_RegExpCompile VFUNC(Tcl_RegExp,Lang_RegExpCompile,V_Lang_RegExpCompile,_ANSI_ARGS_((Tcl_Interp *interp, char *string, int fold))) @@ -170,7 +182,7 @@ #endif #ifndef Tcl_AppendArg -VFUNC(void,Tcl_AppendArg,V_Tcl_AppendArg,_ANSI_ARGS_((Tcl_Interp *interp, Arg))) +VFUNC(void,Tcl_AppendArg,V_Tcl_AppendArg,_ANSI_ARGS_((Tcl_Interp *interp, Tcl_Obj *))) #endif #ifndef Tcl_AppendElement @@ -202,7 +214,7 @@ #endif #ifndef Tcl_Concat -VFUNC(Arg,Tcl_Concat,V_Tcl_Concat,_ANSI_ARGS_((int argc, Arg *argv))) +VFUNC(Tcl_Obj *,Tcl_Concat,V_Tcl_Concat,_ANSI_ARGS_((int argc, Tcl_Obj **argv))) #endif #ifndef Tcl_CreateCommand @@ -327,7 +339,7 @@ #ifndef Tcl_GetBoolean VFUNC(int,Tcl_GetBoolean,V_Tcl_GetBoolean,_ANSI_ARGS_((Tcl_Interp *interp, - Arg string, int *boolPtr))) + Tcl_Obj *string, int *boolPtr))) #endif #ifndef Tcl_GetBooleanFromObj @@ -343,7 +355,7 @@ #ifndef Tcl_GetDouble VFUNC(int,Tcl_GetDouble,V_Tcl_GetDouble,_ANSI_ARGS_((Tcl_Interp *interp, - Arg string, double *doublePtr))) + Tcl_Obj *string, double *doublePtr))) #endif #ifndef Tcl_GetDoubleFromObj @@ -360,7 +372,7 @@ #ifndef Tcl_GetInt VFUNC(int,Tcl_GetInt,V_Tcl_GetInt,_ANSI_ARGS_((Tcl_Interp *interp, - Arg string, int *intPtr))) + Tcl_Obj *string, int *intPtr))) #endif #ifndef Tcl_GetIntFromObj @@ -379,7 +391,7 @@ #ifndef Tcl_GetOpenFile VFUNC(int,Tcl_GetOpenFile,V_Tcl_GetOpenFile,_ANSI_ARGS_((Tcl_Interp *interp, - Arg string, int write, int checkUsage, + Tcl_Obj *string, int write, int checkUsage, ClientData *filePtr))) #endif @@ -393,12 +405,12 @@ #endif #ifndef Tcl_GetVar -VFUNC(Arg,Tcl_GetVar,V_Tcl_GetVar,_ANSI_ARGS_((Tcl_Interp *interp, +VFUNC(Tcl_Obj *,Tcl_GetVar,V_Tcl_GetVar,_ANSI_ARGS_((Tcl_Interp *interp, Var varName, int flags))) #endif #ifndef Tcl_GetVar2 -VFUNC(Arg,Tcl_GetVar2,V_Tcl_GetVar2,_ANSI_ARGS_((Tcl_Interp *interp, +VFUNC(Tcl_Obj *,Tcl_GetVar2,V_Tcl_GetVar2,_ANSI_ARGS_((Tcl_Interp *interp, Var part1, char *part2, int flags))) #endif @@ -531,7 +543,7 @@ #endif #ifndef Tcl_ResultArg -VFUNC(Arg,Tcl_ResultArg,V_Tcl_ResultArg,_ANSI_ARGS_((Tcl_Interp *interp))) +VFUNC(Tcl_Obj *,Tcl_ResultArg,V_Tcl_ResultArg,_ANSI_ARGS_((Tcl_Interp *interp))) #endif #ifndef Tcl_Seek @@ -604,7 +616,7 @@ #ifndef Tcl_SetVarArg VFUNC(char *,Tcl_SetVarArg,V_Tcl_SetVarArg,_ANSI_ARGS_((Tcl_Interp *interp, - Var varName, Arg newValue, int flags))) + Var varName, Tcl_Obj *newValue, int flags))) #endif #ifndef Tcl_SprintfResult Index: pTk/LangIO.h --- Tk800.022/pTk/LangIO.h Tue Jul 27 22:07:29 1999 +++ Tk800.023/pTk/LangIO.h Wed Mar 28 20:32:40 2001 @@ -1,47 +1,48 @@ #ifdef NEED_REAL_STDIO #include #else -#if !defined(__H_STDIO__) && \ +#if !defined(_STDIO_INCLUDED) && \ + !defined(_stdio_h) && \ !defined(__STDIO_H__) && \ - !defined(__h_stdio__) && \ - !defined(__stdio_h__) && \ - !defined(_H_STDIO_) && \ - !defined(_stdio_h_) && \ !defined(_h_stdio_) && \ - !defined(__STDIO_H) && \ + !defined(_included_stdio) && \ + !defined(_H_STDIO_) && \ + !defined(_STDIO_H) && \ + !defined(_INCLUDED_STDIO) && \ !defined(_STDIO_H_) && \ + !defined(__STDIO_H) && \ + !defined(__STDIO_LOADED) && \ !defined(_H_STDIO) && \ - !defined(_INCLUDED_STDIO) && \ + !defined(_INC_STDIO) && \ + !defined(__h_stdio__) && \ + !defined(STDIO_H) && \ + !defined(_stdio_h_) && \ + !defined(__stdio_h__) && \ !defined(_stdio_included) && \ - !defined(_stdio_h) && \ - !defined(_included_stdio) && \ !defined(_h_stdio) && \ - !defined(__STDIO_LOADED) && \ - !defined(_STDIO_INCLUDED) && \ - !defined(_STDIO_H) && \ - !defined(STDIO_H) && \ - !defined(_INC_STDIO) && \ + !defined(__H_STDIO__) && \ !defined(FILE) -#define __H_STDIO__ +#define _STDIO_INCLUDED +#define _stdio_h #define __STDIO_H__ -#define __h_stdio__ -#define __stdio_h__ -#define _H_STDIO_ -#define _stdio_h_ #define _h_stdio_ -#define __STDIO_H +#define _included_stdio +#define _H_STDIO_ +#define _STDIO_H +#define _INCLUDED_STDIO #define _STDIO_H_ +#define __STDIO_H +#define __STDIO_LOADED #define _H_STDIO -#define _INCLUDED_STDIO +#define _INC_STDIO +#define __h_stdio__ +#define STDIO_H +#define _stdio_h_ +#define __stdio_h__ #define _stdio_included -#define _stdio_h -#define _included_stdio #define _h_stdio -#define __STDIO_LOADED -#define _STDIO_INCLUDED -#define _STDIO_H -#define STDIO_H -#define _INC_STDIO +#define __H_STDIO__ +#define _FILEDEFED #undef FILE struct _FILE; #define FILE struct _FILE Index: pTk/LangIO.h.PL --- Tk800.022/pTk/LangIO.h.PL Tue Jul 27 19:20:25 1999 +++ Tk800.023/pTk/LangIO.h.PL Sun Feb 4 19:16:51 2001 @@ -41,7 +41,7 @@ foreach $dir (@cinc) { my $inc = "$dir/stdio.h"; - if (open(INC,"<$inc")) + if (open(INC,"<$inc")) { my $gard; while () @@ -53,7 +53,7 @@ } } while () - { + { if (/^#define\s+$gard/o) { warn "stdio.h garded with $gard\n"; @@ -71,7 +71,7 @@ { warn "Cannot find #include gard in $inc\n"; } - last; + last; } else { @@ -101,6 +101,7 @@ print H "#define $_\n"; } print H <<'END'; +#define _FILEDEFED #undef FILE struct _FILE; #define FILE struct _FILE Index: pTk/Makefile.PL --- Tk800.022/pTk/Makefile.PL Tue Jul 27 19:20:25 1999 +++ Tk800.023/pTk/Makefile.PL Sat Dec 30 16:12:37 2000 @@ -45,6 +45,10 @@ { @list = qw(win xlib additions generic tixWin tixGeneric tclWin tclGeneric); } + elsif ($win_arch eq 'MSWin32' and $^O eq 'cygwin') + { + @list = qw(win xlib additions generic tixWin tixGeneric tclUnix tclGeneric); + } elsif ($win_arch eq 'open32') { @list = qw(open32 open32/h win xlib additions generic tixWin tixGeneric tclUnix tclGeneric ); @@ -145,7 +149,8 @@ $self->{PM}->{$name} = $self->catfile($dir,$name); } - if ($Tk::MMutil::IsWin32 or $win_arch eq 'open32' or $win_arch eq 'pm') + if ($Tk::MMutil::IsWin32 or $win_arch eq 'open32' or $win_arch eq 'pm' or + ($win_arch eq 'MSWin32' and $^O eq 'cygwin')) {my $ddir = $self->catdir('$(INST_ARCHLIBDIR)','X11'); my $sdir = $self->catdir('mTk','xlib','X11'); push(@{$self->{'dir_targets'}},$ddir); @@ -228,7 +233,7 @@ $dep .= "config :: " . join(" \\\n\t",map($self->catfile($_,".exists"),@{$self->{'dir_targets'}})) . "\n\t".$self->{NOECHO}."\$(NOOP)\n"; -if ($Tk::MMutil::IsWin32) +if ($Tk::MMutil::IsWin32 or ($win_arch eq 'MSWin32' and $^O eq 'cygwin')) { my $cc = $Config{'cc'}; my $file = 'tk.res'; Index: pTk/Tcl-pTk --- Tk800.022/pTk/Tcl-pTk Sun Dec 12 13:58:36 1999 +++ Tk800.023/pTk/Tcl-pTk Sat Dec 30 16:12:37 2000 @@ -49,7 +49,7 @@ sub result {my ($interp,$value,$tail) = @_; my $line = &getline; - my $kind = "TCL_STATIC"; + my $kind = "TCL_STATIC"; if (defined $line) { if ($line =~ /^\s*$interp\s*->\s*freeProc\s*=\s*(.*)\s*;\s*$/) @@ -119,7 +119,7 @@ if (/Tcl_(Create|Delete)Command[^;{]*$/) { &complete; - redo PROCESS; + redo PROCESS; } s/Tcl_CreateCommand\s*\(\s*((\w+->)*interp)\s*,\s*Tk_PathName\s*\(([^\)]+)\)/Lang_CreateWidget($1,$3/; s/Tcl_DeleteCommand\s*\(\s*((\w+->)*(\w+\.)?interp)\s*,\s*Tcl_GetCommandName\s*\([^,]+,\s*([^\)]+->(\w+\.style|image)Cmd)\)/Lang_DeleteObject($1,$4/; @@ -131,40 +131,33 @@ if (/\bargv\w*\s*\[([^[]*)\]\s*=[^=][^;{]*$/) { &complete; - redo PROCESS; + redo PROCESS; } if (/\bchar\b.*\bargv\w*\b/) { # convert char *argv[] to char **argv s/char\s*\*\s*\bargv\s*\[\s*\]/char **argv/; - # convert char **argv to Arg *args - s/char\s*\*\*\s*\bargv\b/Arg *args/; - # convert char *argv[n] to Arg *args = LangAllocVec(n) - s/char\s*\*\s*\bargv\s*\[\s*([^[]+)\]/Arg *args = LangAllocVec($1)/; + # convert char **argv to Tcl_Obj **objv + s/char\s*\*\*\s*\bargv\b/Tcl_Obj **objv/; + # convert char *argv[n] to Tcl_Obj **objv = LangAllocVec(n) + s/char\s*\*\s*\bargv\s*\[\s*([^[]+)\]/Tcl_Obj **objv = LangAllocVec($1)/; } else { s/([^*])\*(argv\w*(\[[^[]*\])?)/${1}${2}[0]/g; } - s/\bargv\s*\[([^[]*)\]\s*=([^=].*);\s*$/LangSetString(args+$1,$2);\n/; - s/\bargv\s*\[([^[]*)\]\+\+/args[$1] = LangStringArg(LangString(args[$1])+1)/; - s/\bargv\s*\[([^[]*)\]\+([0-9])/LangStringArg(LangString(args[$1])+$2)/; -# unless (/\b(str\w+|Tk[A-Za-z0-9_]+)\s*\(/) -# { -# # skip things that look like parm list -# s/([(,])\s*argv(\w*|\[[^[]*\])\s*([,)])/$1args$2$3/; -# } + s/\bargv\s*\[([^[]*)\]\s*=([^=].*);\s*$/LangSetString(objv+$1,$2);\n/; + s/\bargv\s*\[([^[]*)\]\+\+/objv[$1] = LangStringArg(LangString(objv[$1])+1)/; + s/\bargv\s*\[([^[]*)\]\+([0-9])/LangStringArg(LangString(objv[$1])+$2)/; if (/Tcl_Get(Boolean|Int|Double)/ || /Tk_Get(Cursor)/) { - s/\bargv(\w*)\b/args$1/g; + s/\bargv(\w*)\b/objv$1/g; } - s/\bargv\s*(\[[^[]*\])/LangString(args$1)/g; -# s/((\w+->)+)\bargv(\w+)\b/LangString(${1}args$3)/g; -# s/\bargv(\w+)\b/LangString(args$1)/g; + s/\bargv\s*(\[[^[]*\])/LangString(objv$1)/g; if (/\bargv\b/) { warn "Leak: $_" if ($verbose && !/\bargv\s*\)/); - s/\bargv\b/args/; + s/\bargv\b/objv/; } } if (/->\s*result\b/) @@ -179,7 +172,7 @@ if (/\binterp->result\s*=[^;]*$/) { &complete; - redo PROCESS; + redo PROCESS; } s/\b((\w+\s*->\s*)*interp)->result\s*=([^;]*);/&result($1,$3,";")/e; s/\b((\w+\s*->\s*)*interp)->result\s*=(.*);\s*$/&result($1,$3,";\n")/e; @@ -191,11 +184,11 @@ if (/Tcl_SetResult\s*\([^;{]*$/) { &complete; - redo PROCESS; - } + redo PROCESS; + } s/Tcl_SetResult\s*\(\s*((\w+->)*interp),\s*"(\d+)",\s*TCL_STATIC\s*\)/Tcl_SetObjResult($1, Tcl_NewIntObj($3))/; - s/Tcl_SetResult\s*\(\s*((\w+->)*interp),\s*Tk_PathName\(([^)]+)\),\s*TCL_STATIC\s*\)/Tcl_ArgResult($1,LangWidgetArg($1,$3))/; - s/Tcl_SetResult\s*\(\s*((\w+->)*interp),\s*((\w+->)*\w+)->pathName\s*,\s*TCL_STATIC\s*\)/Tcl_ArgResult($1,LangWidgetArg($1,(Tk_Window)($3)))/; + s/Tcl_SetResult\s*\(\s*((\w+->)*interp),\s*Tk_PathName\(([^)]+)\),\s*TCL_STATIC\s*\)/Tcl_SetObjResult($1,LangWidgetObj($1,$3))/; + s/Tcl_SetResult\s*\(\s*((\w+->)*interp),\s*((\w+->)*\w+)->pathName\s*,\s*TCL_STATIC\s*\)/Tcl_SetObjResult($1,LangWidgetObj($1,(Tk_Window)($3)))/; die $_ if /(Tk_PathName|->pathName)/; } # 1 2 3 4 5 6 @@ -207,12 +200,13 @@ print $copyright; undef $copyright; } - + + s/[^\S\n]+$//; print; if (0 && /^((\s\*)\s*)Copyright/) { - $copyright = "$2\n$1Modifications Copyright (c) 1994-1998 Nick Ing-Simmons\n"; + $copyright = "$2\n$1Modifications Copyright (c) 1994-2000 Nick Ing-Simmons\n"; } } Index: pTk/Xlib.h --- Tk800.022/pTk/Xlib.h Sat Nov 20 14:52:01 1999 +++ Tk800.023/pTk/Xlib.h Wed Apr 4 20:14:15 2001 @@ -11,7 +11,7 @@ extern Atom XInternAtom _ANSI_ARGS_((Display *, const char *, int)); extern Colormap XCreateColormap _ANSI_ARGS_((Display *, Window, Visual *, int)); extern Cursor XCreatePixmapCursor _ANSI_ARGS_((Display *, Pixmap, Pixmap, XColor *, XColor *, unsigned int, unsigned int)); -extern Cursor XCreateGlyphCursor _ANSI_ARGS_((Display *, Font, Font, unsigned int, unsigned int, XColor *, XColor *)); +extern Cursor XCreateGlyphCursor _ANSI_ARGS_((Display *, Font, Font, unsigned int, unsigned int, XColor const *, XColor const *)); extern Font XLoadFont _ANSI_ARGS_((Display *, const char *)); extern GC XCreateGC _ANSI_ARGS_((Display *, Drawable, long unsigned int, XGCValues *)); extern GContext XGContextFromGC _ANSI_ARGS_((GC)); @@ -141,6 +141,7 @@ extern char **XListFonts _ANSI_ARGS_(( Display*, const char *, int, int *)); extern int XFreeFontNames _ANSI_ARGS_((char **)); extern Window XGetSelectionOwner _ANSI_ARGS_((Display *, Atom)); +extern int XRectInRegion _ANSI_ARGS_(( Region,int,int,unsigned,unsigned)); #endif /* _XLIB_H_ */ extern int _XInitImageFuncPtrs _ANSI_ARGS_((XImage *image)); #endif /* _XLIB */ Index: pTk/Xlib.m --- Tk800.022/pTk/Xlib.m Sat Nov 20 21:10:06 1999 +++ Tk800.023/pTk/Xlib.m Wed Apr 4 20:14:18 2001 @@ -443,6 +443,10 @@ #endif #endif /* !DO_X_EXCLUDE */ +#ifndef XRectInRegion +# define XRectInRegion (*XlibVptr->V_XRectInRegion) +#endif + #ifndef XRefreshKeyboardMapping # define XRefreshKeyboardMapping (*XlibVptr->V_XRefreshKeyboardMapping) #endif Index: pTk/Xlib.t --- Tk800.022/pTk/Xlib.t Sat Nov 20 21:10:03 1999 +++ Tk800.023/pTk/Xlib.t Wed Apr 4 20:14:18 2001 @@ -93,7 +93,7 @@ #endif #ifndef XCreateGlyphCursor -VFUNC(Cursor,XCreateGlyphCursor,V_XCreateGlyphCursor,_ANSI_ARGS_((Display *, Font, Font, unsigned int, unsigned int, XColor *, XColor *))) +VFUNC(Cursor,XCreateGlyphCursor,V_XCreateGlyphCursor,_ANSI_ARGS_((Display *, Font, Font, unsigned int, unsigned int, XColor const *, XColor const *))) #endif #ifndef XCreateImage @@ -439,6 +439,10 @@ VFUNC(int,XReadBitmapFile,V_XReadBitmapFile,_ANSI_ARGS_((Display *, Drawable, const char *, unsigned int *, unsigned int *, Pixmap *, int *, int *))) #endif #endif /* !DO_X_EXCLUDE */ + +#ifndef XRectInRegion +VFUNC(int,XRectInRegion,V_XRectInRegion,_ANSI_ARGS_(( Region,int,int,unsigned,unsigned))) +#endif #ifndef XRefreshKeyboardMapping VFUNC(int,XRefreshKeyboardMapping,V_XRefreshKeyboardMapping,_ANSI_ARGS_((XMappingEvent *))) Index: pTk/deArg --- /dev/null Sat Dec 30 02:58:04 2000 +++ Tk800.023/pTk/deArg Tue May 15 15:53:37 2001 @@ -0,0 +1,9 @@ +#!/tools/local/perl -w +use strict; +$^I = '.bak'; +while (<>) + { + s/\bArg\b[^\S\n]*/Tcl_Obj */g; + s/[^\S\n]+$//; + print; + } Index: pTk/imgInt.m --- Tk800.022/pTk/imgInt.m Sat Apr 1 16:36:02 2000 +++ Tk800.023/pTk/imgInt.m Sat Dec 30 16:12:37 2000 @@ -50,10 +50,6 @@ # define ImgReadInit (*ImgintVptr->V_ImgReadInit) #endif -#ifndef ImgSeek -# define ImgSeek (*ImgintVptr->V_ImgSeek) -#endif - #ifndef ImgWrite # define ImgWrite (*ImgintVptr->V_ImgWrite) #endif Index: pTk/imgInt.t --- Tk800.022/pTk/imgInt.t Sat Apr 1 16:36:02 2000 +++ Tk800.023/pTk/imgInt.t Sat Dec 30 16:12:37 2000 @@ -25,7 +25,7 @@ #ifndef ImgListObjGetElements VFUNC(int,ImgListObjGetElements,V_ImgListObjGetElements,_ANSI_ARGS_((Tcl_Interp *interp, - Tcl_Obj *objPtr, int *argc, Tcl_Obj ***args))) + Tcl_Obj *objPtr, int *argc, Tcl_Obj ***objv))) #endif #ifndef ImgObjInit @@ -52,10 +52,6 @@ #ifndef ImgReadInit VFUNC(int,ImgReadInit,V_ImgReadInit,_ANSI_ARGS_((Tcl_Obj *data, int c, MFile *handle))) -#endif - -#ifndef ImgSeek -VFUNC(int,ImgSeek,V_ImgSeek,_ANSI_ARGS_((MFile *handle, int off, int whence))) #endif #ifndef ImgWrite Index: pTk/mTk/additions/img.h --- Tk800.022/pTk/mTk/additions/img.h Sat Apr 1 16:04:29 2000 +++ Tk800.023/pTk/mTk/additions/img.h Sat Dec 30 16:12:37 2000 @@ -12,7 +12,7 @@ #define IMG_RELEASE_SERIAL 2 #define IMG_VERSION "1.2" -#define IMG_PATCH_LEVEL "1.2.3" +#define IMG_PATCH_LEVEL "1.2.4" #ifndef RESOURCE_INCLUDED Index: pTk/mTk/additions/imgBMP.c --- Tk800.022/pTk/mTk/additions/imgBMP.c Sat Apr 1 16:42:41 2000 +++ Tk800.023/pTk/mTk/additions/imgBMP.c Sat Dec 30 16:12:37 2000 @@ -226,7 +226,7 @@ CommonMatchBMP(handle, &fileWidth, &fileHeight, &colorMap, &numBits, &numCols, &comp); - /*printf("reading %d-bit BMP %dx%d\n", numBits, width, height);*/ + /* printf("reading %d-bit BMP %dx%d\n", numBits, width, height); */ if (comp != 0) { Tcl_AppendResult(interp, "Compressed BMP files not (yet) supported", (char *) NULL); @@ -405,7 +405,6 @@ unsigned char *imagePtr, *pixelPtr; unsigned char buf[4]; int colors[256]; - int testnum = 10; greenOffset = blockPtr->offset[1] - blockPtr->offset[0]; blueOffset = blockPtr->offset[2] - blockPtr->offset[0]; @@ -429,8 +428,12 @@ else pixel = (pixelPtr[0]<<16) | (pixelPtr[greenOffset]<<8) | pixelPtr[blueOffset]; for (i = 0; i < ncolors && pixel != colors[i]; i++); - if ((i == ncolors) && (ncolors < 256)) - colors[ncolors++] = pixel; + if (i == ncolors) { + if (ncolors < 256) { + colors[ncolors] = pixel; + } + ncolors++; + } pixelPtr += blockPtr->pixelSize; } } @@ -472,17 +475,6 @@ imagePtr = blockPtr->pixelPtr + blockPtr->offset[0] + blockPtr->height * blockPtr->pitch; - greenOffset = blockPtr->offset[1] - blockPtr->offset[0]; - blueOffset = blockPtr->offset[2] - blockPtr->offset[0]; - alphaOffset = blockPtr->offset[0]; - if (alphaOffset < blockPtr->offset[2]) { - alphaOffset = blockPtr->offset[2]; - } - if (++alphaOffset < blockPtr->pixelSize) { - alphaOffset -= blockPtr->offset[0]; - } else { - alphaOffset = 0; - } for (y = 0; y < blockPtr->height; y++) { pixelPtr = imagePtr -= blockPtr->pitch; for (x=0; xwidth; x++) { @@ -502,9 +494,6 @@ buf[2] = pixelPtr[0]; } ImgWrite(handle, (char *) buf, nbytes); - if (testnum >0) { - testnum--; - } pixelPtr += blockPtr->pixelSize; } if (bperline) { Index: pTk/mTk/additions/imgGIF.c --- Tk800.022/pTk/mTk/additions/imgGIF.c Sat Apr 1 16:43:48 2000 +++ Tk800.023/pTk/mTk/additions/imgGIF.c Sat Dec 30 16:12:37 2000 @@ -1,24 +1,23 @@ /* * imgGIF.c -- * - * A photo image file handler for GIF files. Reads 87a and 89a GIF files. - * At present THERE ARE WRITE functions for 87a and 89a GIF. - * - * GIF images may be read using the -data option of the photo image by - * representing the data as BASE64 encoded ascii (SAU 6/96) - * - * Derived from the giftoppm code found in the pbmplus package - * and tkImgFmtPPM.c in the tk4.0b2 distribution by - - * - * Reed Wade (wade@cs.utk.edu), University of Tennessee - * - * Copyright (c) 1995-1996 Sun Microsystems, Inc. + * A photo image file handler for GIF files. Reads 87a and 89a GIF + * files. At present, there only is a file write function. GIF images may be + * read using the -data option of the photo image. The data may be + * given as a binary string in a Tcl_Obj or by representing + * the data as BASE64 encoded ascii. Derived from the giftoppm code + * found in the pbmplus package and tkImgFmtPPM.c in the tk4.0b2 + * distribution. + * + * Copyright (c) Reed Wade (wade@cs.utk.edu), University of Tennessee + * Copyright (c) 1995-1997 Sun Microsystems, Inc. + * Copyright (c) 1997 Australian National University * * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * This file also contains code from the giftoppm and the ppmtogif programs, - * which are copyrighted as follows: + * This file also contains code from the giftoppm program, which is + * copyrighted as follows: * * +-------------------------------------------------------------------+ * | Copyright 1990, David Koblas. | @@ -30,34 +29,9 @@ * | provided "as is" without express or implied warranty. | * +-------------------------------------------------------------------+ * - * It also contains parts of the the LUG package developed by Raul Rivero. - * - * The GIF write function uses the Xiaolin Wu quantize function: - * - * +-------------------------------------------------------------------+ - * | C Implementation of Wu's Color Quantizer (v. 2) | - * | (see Graphics Gems vol. II, pp. 126-133) | - * | | - * | Author: Xiaolin Wu | - * | Dept. of Computer Science | - * | Univ. of Western Ontario | - * | London, Ontario N6A 5B7 | - * | wu@csd.uwo.ca | - * | | - * | Algorithm: Greedy orthogonal bipartition of RGB space for | - * | variance minimization aided by inclusion-exclusion | - * | tricks. For speed no nearest neighbor search is done. | - * | Slightly better performance can be expected by more | - * | sophisticated but more expensive versions. | - * | | - * | The author thanks Tom Lane at Tom_Lane@G.GP.CS.CMU.EDU for much | - * | of additional documentation and a cure to a previous bug. | - * | | - * | Free to distribute, comments and suggestions are appreciated. | - * +-------------------------------------------------------------------+ - * - * SCCS: @(#) imgGIF.c 1.13 97/01/21 19:54:13 + * RCS: @(#) $Id: tkImgGIF.c,v 1.14 2000/03/30 19:44:41 ericm Exp $ */ + #include "tk.h" #include "tkVMacro.h" #include "imgInt.h" @@ -65,6 +39,22 @@ #include /* + * Non-ASCII encoding support: + * Most data in a GIF image is binary and is treated as such. However, + * a few key bits are stashed in ASCII. If we try to compare those pieces + * to the char they represent, it will fail on any non-ASCII (eg, EBCDIC) + * system. To accomodate these systems, we test against the numeric value + * of the ASCII characters instead of the characters themselves. This is + * encoding independant. + */ + +# define GIF87a "\x47\x49\x46\x38\x37\x61" /* ASCII GIF87a */ +# define GIF89a "\x47\x49\x46\x38\x39\x61" /* ASCII GIF89a */ +# define GIF_TERMINATOR 0x3b /* ASCII ; */ +# define GIF_EXTENSION 0x21 /* ASCII ! */ +# define GIF_START 0x2c /* ASCII , */ + +/* * The format record for the GIF file format: */ @@ -126,8 +116,6 @@ int flag)); static int GetDataBlock _ANSI_ARGS_((MFile *handle, unsigned char *buf)); -static int LWZReadByte _ANSI_ARGS_((MFile *handle, int flag, - int input_code_size)); static int ReadColorMap _ANSI_ARGS_((MFile *handle, int number, unsigned char buffer[MAXCOLORMAPSIZE][4])); static int ReadGIFHeader _ANSI_ARGS_((MFile *handle, @@ -188,7 +176,7 @@ * * Results: * A standard TCL completion code. If TCL_ERROR is returned - * then an error message is left in interp->result. + * then an error message is left in the interp's result. * * Side effects: * The access position in channel chan is changed, and new data is @@ -233,7 +221,7 @@ * * Results: * A standard TCL completion code. If TCL_ERROR is returned - * then an error message is left in interp->result. + * then an error message is left in the interp's result. * * Side effects: * The access position in file f is changed, and new data is @@ -270,6 +258,7 @@ Tcl_Obj **objv = NULL; myblock bl; unsigned char buf[100]; + unsigned char *trashBuffer = NULL; int bitPixel; unsigned int colorResolution; unsigned int background; @@ -329,7 +318,8 @@ if ((srcY + height) > fileHeight) { height = fileHeight - srcY; } - if ((width <= 0) || (height <= 0)) { + if ((width <= 0) || (height <= 0) + || (srcX >= fileWidth) || (srcY >= fileHeight)) { return TCL_OK; } @@ -352,7 +342,7 @@ break; } - if (buf[0] == ';') { + if (buf[0] == GIF_TERMINATOR) { /* * GIF terminator. */ @@ -362,7 +352,7 @@ goto error; } - if (buf[0] == '!') { + if (buf[0] == GIF_EXTENSION) { /* * This is a GIF extension. */ @@ -381,7 +371,7 @@ continue; } - if (buf[0] != ',') { + if (buf[0] != GIF_START) { /* * Not a valid start character; ignore it. */ @@ -401,41 +391,54 @@ bitPixel = 2<<(buf[8]&0x07); if (index--) { - int x,y; - unsigned char c; /* this is not the image we want to read: skip it. */ - if (BitSet(buf[8], LOCALCOLORMAP)) { - if (!ReadColorMap(handle, bitPixel, 0)) { + if (!ReadColorMap(handle, bitPixel, colorMap)) { Tcl_AppendResult(interp, "error reading color map", (char *) NULL); goto error; } } - /* read data */ - if (!ReadOK(handle,&c,1)) { - goto error; + /* If we've not yet allocated a trash buffer, do so now */ + if (trashBuffer == NULL) { + nBytes = fileWidth * fileHeight * 3; + trashBuffer = + (unsigned char *) ckalloc((unsigned int) nBytes); } - LWZReadByte(handle, 1, c); - - for (y=0; yresult. + * then an error message is left in the interp's result. * * Side effects: * new data is added to the image given by imageHandle. This @@ -604,8 +607,8 @@ unsigned char buf[7]; if ((ImgRead(handle, buf, 6) != 6) - || ((strncmp("GIF87a", (char *) buf, 6) != 0) - && (strncmp("GIF89a", (char *) buf, 6) != 0))) { + || ((strncmp(GIF87a, (char *) buf, 6) != 0) + && (strncmp(GIF89a, (char *) buf, 6) != 0))) { return 0; } @@ -627,357 +630,407 @@ static int ReadColorMap(handle, number, buffer) - MFile *handle; - int number; - unsigned char buffer[MAXCOLORMAPSIZE][4]; -{ - int i; - unsigned char rgb[3]; - - for (i = 0; i < number; ++i) { - if (! ReadOK(handle, rgb, sizeof(rgb))) - return 0; - if (buffer) { + MFile *handle; + int number; + unsigned char buffer[MAXCOLORMAPSIZE][4]; +{ + int i; + unsigned char rgb[3]; + + for (i = 0; i < number; ++i) { + if (! ReadOK(handle, rgb, sizeof(rgb))) { + return 0; + } + + if (buffer) { buffer[i][CM_RED] = rgb[0] ; buffer[i][CM_GREEN] = rgb[1] ; buffer[i][CM_BLUE] = rgb[2] ; buffer[i][CM_ALPHA] = 255 ; + } } - } - return 1; + return 1; } static int DoExtension(handle, label, transparent) - MFile *handle; - int label; - int *transparent; -{ - static unsigned char buf[256]; - int count = 0; - - switch (label) { - case 0x01: /* Plain Text Extension */ - break; - - case 0xff: /* Application Extension */ - break; - - case 0xfe: /* Comment Extension */ - do { - count = GetDataBlock(handle, (unsigned char*) buf); - } while (count > 0); - return count; - - case 0xf9: /* Graphic Control Extension */ - count = GetDataBlock(handle, (unsigned char*) buf); - if (count < 0) { - return 1; - } - if ((buf[0] & 0x1) != 0) { - *transparent = buf[3]; - } - - do { - count = GetDataBlock(handle, (unsigned char*) buf); - } while (count > 0); - return count; - } + MFile *handle; + int label; + int *transparent; +{ + static unsigned char buf[256]; + int count; - do { + switch (label) { + case 0x01: /* Plain Text Extension */ + break; + + case 0xff: /* Application Extension */ + break; + + case 0xfe: /* Comment Extension */ + do { + count = GetDataBlock(handle, (unsigned char*) buf); + } while (count > 0); + return count; + + case 0xf9: /* Graphic Control Extension */ count = GetDataBlock(handle, (unsigned char*) buf); - } while (count > 0); - return count; + if (count < 0) { + return 1; + } + if ((buf[0] & 0x1) != 0) { + *transparent = buf[3]; + } + + do { + count = GetDataBlock(handle, (unsigned char*) buf); + } while (count > 0); + return count; + } + + do { + count = GetDataBlock(handle, (unsigned char*) buf); + } while (count > 0); + return count; } static int ZeroDataBlock = 0; static int GetDataBlock(handle, buf) - MFile *handle; - unsigned char *buf; + MFile *handle; + unsigned char *buf; { - unsigned char count; + unsigned char count; - if (! ReadOK(handle,&count,1)) { - return -1; - } + if (! ReadOK(handle,&count,1)) { + return -1; + } - ZeroDataBlock = count == 0; + ZeroDataBlock = count == 0; - if ((count != 0) && (! ReadOK(handle, buf, count))) { - return -1; - } + if ((count != 0) && (! ReadOK(handle, buf, count))) { + return -1; + } - return count; + return count; } + +/* + *---------------------------------------------------------------------- + * + * ReadImage -- + * + * Process a GIF image from a given source, with a given height, + * width, transparency, etc. + * + * This code is based on the code found in the ImageMagick GIF decoder, + * which is (c) 2000 ImageMagick Studio. + * + * Some thoughts on our implementation: + * It sure would be nice if ReadImage didn't take 11 parameters! I think + * that if we were smarter, we could avoid doing that. + * + * Possible further optimizations: we could pull the GetCode function + * directly into ReadImage, which would improve our speed. + * + * Results: + * Processes a GIF image and loads the pixel data into a memory array. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + static int ReadImage(interp, imagePtr, handle, len, rows, cmap, width, height, srcX, srcY, interlace, transparent) -Tcl_Interp *interp; -char *imagePtr; -MFile *handle; -int len, rows; -unsigned char cmap[MAXCOLORMAPSIZE][4]; -int width, height; -int srcX, srcY; -int interlace; -int transparent; -{ - unsigned char c; - int v; - int xpos = 0, ypos = 0, pass = 0; - char *pixelPtr; - - - /* - * Initialize the Compression routines - */ - if (! ReadOK(handle,&c,1)) { - Tcl_AppendResult(interp, "error reading GIF image: ", - Tcl_PosixError(interp), (char *) NULL); - return TCL_ERROR; - } + Tcl_Interp *interp; + char *imagePtr; + MFile *handle; + int len, rows; + unsigned char cmap[MAXCOLORMAPSIZE][4]; + int width, height; + int srcX, srcY; + int interlace; + int transparent; +{ + unsigned char initialCodeSize; + int v; + int xpos = 0, ypos = 0, pass = 0, i; + register char *pixelPtr; + CONST static int interlaceStep[] = { 8, 8, 4, 2 }; + CONST static int interlaceStart[] = { 0, 4, 2, 1 }; + unsigned short prefix[(1 << MAX_LWZ_BITS)]; + unsigned char append[(1 << MAX_LWZ_BITS)]; + unsigned char stack[(1 << MAX_LWZ_BITS)*2]; + register unsigned char *top; + int codeSize, clearCode, inCode, endCode, oldCode, maxCode, + code, firstCode; - if (LWZReadByte(handle, 1, c) < 0) { - Tcl_AppendResult(interp, "format error in GIF image", (char*) NULL); - return TCL_ERROR; - } + /* + * Initialize the decoder + */ + if (! ReadOK(handle,&initialCodeSize,1)) { + Tcl_AppendResult(interp, "error reading GIF image: ", + Tcl_PosixError(interp), (char *) NULL); + return TCL_ERROR; + } + if (transparent!=-1) { + cmap[transparent][CM_RED] = 0; + cmap[transparent][CM_GREEN] = 0; + cmap[transparent][CM_BLUE] = 0; + cmap[transparent][CM_ALPHA] = 0; + } - if (transparent!=-1) { - cmap[transparent][CM_RED] = 0; - cmap[transparent][CM_GREEN] = 0; - cmap[transparent][CM_BLUE] = 0; - cmap[transparent][CM_ALPHA] = 0; - } - - pixelPtr = imagePtr; - while ((v = LWZReadByte(handle,0,c)) >= 0 ) { - - if ((xpos>=srcX) && (xpos=srcY) && (ypos=0) { - *pixelPtr++ = cmap[v][CM_ALPHA]; - } + pixelPtr = imagePtr; + + /* Initialize the decoder */ + /* Set values for "special" numbers: + * clear code reset the decoder + * end code stop decoding + * code size size of the next code to retrieve + * max code next available table position + */ + clearCode = 1 << (int) initialCodeSize; + endCode = clearCode + 1; + codeSize = (int) initialCodeSize + 1; + maxCode = clearCode + 2; + oldCode = -1; + firstCode = -1; + + memset((void *)prefix, 0, (1 << MAX_LWZ_BITS) * sizeof(short)); + memset((void *)append, 0, (1 << MAX_LWZ_BITS) * sizeof(char)); + for (i = 0; i < clearCode; i++) { + append[i] = i; + } + top = stack; + + GetCode(handle, 0, 1); + + /* Read until we finish the image */ + for (i = 0, ypos = 0; i < rows; i++) { + for (xpos = 0; xpos < len; ) { + + if (top == stack) { + /* Bummer -- our stack is empty. Now we have to work! */ + code = GetCode(handle, codeSize, 0); + if (code < 0) { + return TCL_OK; } - ++xpos; - if (xpos == width) { - xpos = 0; - if (interlace) { - switch (pass) { - case 0: - case 1: - ypos += 8; break; - case 2: - ypos += 4; break; - case 3: - ypos += 2; break; - } - - while (ypos >= height) { - ++pass; - switch (pass) { - case 1: - ypos = 4; break; - case 2: - ypos = 2; break; - case 3: - ypos = 1; break; - default: - return TCL_OK; - } - } - } else { - ++ypos; - } - pixelPtr = imagePtr + (ypos-srcY) * len * ((transparent>=0)?4:3); + + if (code > maxCode || code == endCode) { + /* + * If we're doing things right, we should never + * receive a code that is greater than our current + * maximum code. If we do, bail, because our decoder + * does not yet have that code set up. + * + * If the code is the magic endCode value, quit. + */ + return TCL_OK; } - if (ypos >= height) - break; - } - return TCL_OK; -} -static int -LWZReadByte(handle, flag, input_code_size) -MFile *handle; -int flag; -int input_code_size; -{ - static int fresh = 0; - int code, incode; - static int code_size, set_code_size; - static int max_code, max_code_size; - static int firstcode, oldcode; - static int clear_code, end_code; - static int table[2][(1<< MAX_LWZ_BITS)]; - static int stack[(1<<(MAX_LWZ_BITS))*2], *sp; - register int i; - - - if (flag) { - - set_code_size = input_code_size; - code_size = set_code_size+1; - clear_code = 1 << set_code_size ; - end_code = clear_code + 1; - max_code_size = 2*clear_code; - max_code = clear_code+2; - - GetCode(handle, 0, 1); - - fresh = 1; - - for (i = 0; i < clear_code; ++i) { - table[0][i] = 0; - table[1][i] = i; + if (code == clearCode) { + /* Reset the decoder */ + codeSize = initialCodeSize + 1; + maxCode = clearCode + 2; + oldCode = -1; + continue; } - for (; i < (1< stack) - return *--sp; - - while ((code = GetCode(handle, code_size, 0)) >= 0) { - if (code == clear_code) { - for (i = 0; i < clear_code; ++i) { - table[0][i] = 0; - table[1][i] = i; - } - - for (; i < (1< 0) - ; - - if (count != 0) - return -2; - } - - incode = code; + if (code == maxCode) { + /* + * maxCode is always one bigger than our highest assigned + * code. If the code we see is equal to maxCode, then + * we are about to add a new string to the table. ??? + */ + *top++ = firstCode; + code = oldCode; + } - if (code >= max_code) { - *sp++ = firstcode; - code = oldcode; - } + while (code > clearCode) { + /* + * Populate the stack by tracing the string in the + * string table from its tail to its head + */ + *top++ = append[code]; + code = prefix[code]; + } + firstCode = append[code]; - while (code >= clear_code) { - *sp++ = table[1][code]; - if (code == table[0][code]) { - return -2; + /* + * If there's no more room in our string table, quit. + * Otherwise, add a new string to the table + */ + if (maxCode >= (1 << MAX_LWZ_BITS)) { + return TCL_OK; + } - /* - * Used to be this instead, Steve Ball suggested - * the change to just return. + /* Push the head of the string onto the stack */ + *top++ = firstCode; - printf("circular table entry BIG ERROR\n"); - */ + /* Add a new string to the string table */ + prefix[maxCode] = oldCode; + append[maxCode] = firstCode; + maxCode++; + + /* maxCode tells us the maximum code value we can accept. + * If we see that we need more bits to represent it than + * we are requesting from the unpacker, we need to increase + * the number we ask for. + */ + if ((maxCode >= (1 << codeSize)) + && (maxCode < (1<= 0) { + *pixelPtr++ = cmap[v][CM_ALPHA]; + } + xpos++; - table[0][code] = oldcode; - table[1][code] = firstcode; - ++max_code; - if ((max_code>=max_code_size) && (max_code_size < (1< stack) - return *--sp; + /* If interlacing, the next ypos is not just +1 */ + if (interlace) { + ypos += interlaceStep[pass]; + while (ypos >= height) { + pass++; + if (pass > 3) { + return TCL_OK; + } + ypos = interlaceStart[pass]; + } + } else { + ypos++; } - return code; + pixelPtr = imagePtr + (ypos) * len * ((transparent>=0)?4:3); + } + return TCL_OK; } +/* + *---------------------------------------------------------------------- + * + * GetCode -- + * + * Extract the next compression code from the file. In GIF's, the + * compression codes are between 3 and 12 bits long and are then + * packed into 8 bit bytes, left to right, for example: + * bbbaaaaa + * dcccccbb + * eeeedddd + * ... + * We use a byte buffer read from the file and a sliding window + * to unpack the bytes. Thanks to ImageMagick for the sliding window + * idea. + * args: handle the handle to read from + * code_size size of the code to extract + * flag boolean indicating whether the extractor + * should be reset or not + * + * Results: + * code the next compression code + * + * Side effects: + * May consume more input from chan. + * + *---------------------------------------------------------------------- + */ static int GetCode(handle, code_size, flag) -MFile *handle; -int code_size; -int flag; -{ - static unsigned char buf[280]; - static int curbit, lastbit, done, last_byte; - int i, j, ret; - unsigned char count; - - if (flag) { - curbit = 0; - lastbit = 0; - done = 0; - return 0; - } - - - if ( (curbit+code_size) >= lastbit) { - if (done) { - /* ran off the end of my bits */ - return -1; - } - buf[0] = buf[last_byte-2]; - buf[1] = buf[last_byte-1]; - - if ((count = GetDataBlock(handle, &buf[2])) == 0) - done = 1; + MFile *handle; + int code_size; + int flag; +{ + static unsigned char buf[280]; + static int bytes = 0, done; + static unsigned char *c; + + static unsigned int window; + static int bitsInWindow = 0; + int ret; + + if (flag) { + /* Initialize the decoder */ + bitsInWindow = 0; + bytes = 0; + window = 0; + done = 0; + c = NULL; + return 0; + } - last_byte = 2 + count; - curbit = (curbit - lastbit) + 16; - lastbit = (2+count)*8 ; + while (bitsInWindow < code_size) { + /* Not enough bits in our window to cover the request */ + if (done) { + return -1; + } + if (bytes == 0) { + /* Not enough bytes in our buffer to add to the window */ + bytes = GetDataBlock(handle, buf); + c = buf; + if (bytes <= 0) { + done = 1; + break; + } } - - ret = 0; - for (i = curbit, j = 0; j < code_size; ++i, ++j) - ret |= ((buf[ i / 8 ] & (1 << (i % 8))) != 0) << j; + /* Tack another byte onto the window, see if that's enough */ + window += (*c) << bitsInWindow; + c++; + bitsInWindow += 8; + bytes--; + } - curbit += code_size; + /* The next code will always be the last code_size bits of the window */ + ret = window & ((1 << code_size) - 1); - return ret; + /* Shift data in the window to put the next code at the end */ + window >>= code_size; + bitsInWindow -= code_size; + return ret; } /* @@ -1013,6 +1066,10 @@ * e-mail zz11425958@zeus.etsimo.uniovi.es * lolo@pcsig22.etsimo.uniovi.es * Date: Fri September 20 1996 + * + * Modified for transparency handling (gif89a) and miGIF compression + * by Jan Nijtmans + * *---------------------------------------------------------------------- * FileWriteGIF- * @@ -1021,7 +1078,7 @@ * * Results: * A standard TCL completion code. If TCL_ERROR is returned - * then an error message is left in interp->result. + * then an error message is left in the interp's result. * *---------------------------------------------------------------------- */ @@ -1146,7 +1203,7 @@ alphaOffset = 0; } - ImgWrite(handle, (CONST char *) (alphaOffset ? "GIF89a":"GIF87a"), 6); + ImgWrite(handle, (CONST char *) (alphaOffset ? GIF89a:GIF87a), 6); for (x=0;x=0;bno--,bit>>=1) + for (bno=nbits-1,bit=1<=0;bno--,bit>>=1) { *bp++ = (v & bit) ? '1' : '0'; if (((bno&3) == 0) && (bno != 0)) *bp++ = '.'; } @@ -1733,7 +1792,7 @@ give better compression. */ out_clear_init = (init_bits <= 3) ? 9 : (out_bump_init-1); #ifdef DEBUGGING_ENVARS - { const char *ocienv; + { CONST char *ocienv; ocienv = getenv("GIF_OUT_CLEAR_INIT"); if (ocienv) { out_clear_init = atoi(ocienv); Index: pTk/mTk/additions/imgInit.c --- Tk800.022/pTk/mTk/additions/imgInit.c Sat Apr 1 16:04:41 2000 +++ Tk800.023/pTk/mTk/additions/imgInit.c Sat Dec 30 16:12:37 2000 @@ -29,12 +29,12 @@ #ifndef USE_TCL_STUBS #undef Tcl_InitStubs -#define Tcl_InitStubs(a,b,c) Tcl_PkgRequire(a,"Tcl",TCL_VERSION,1) +#define Tcl_InitStubs(a,b,c) Tcl_PkgRequire(a,"Tcl","8.0",1) #endif #ifndef USE_TK_STUBS #undef Tk_InitStubs -#define Tk_InitStubs(a,b,c) Tcl_PkgRequire(a,"Tk",TK_VERSION,1) +#define Tk_InitStubs(a,b,c) Tcl_PkgRequire(a,"Tk","8.0",1) #endif /* @@ -86,7 +86,7 @@ * version of Tcl or Perl we are running: * * IMG_TCL Tcl - * IMG_OBJS using Tcl_Obj's in stead of char* (patch.tk8) + * IMG_OBJS using Tcl_Obj's in stead of char* (Tk 8.3 or higher) * IMG_PERL perl * * These flags will be determined at runtime (except the IMG_PERL @@ -131,11 +131,15 @@ while(*formatPtr) { Tk_CreatePhotoImageFormat(*formatPtr++); } +#ifdef __WIN32__ + CreateMutex(NULL, FALSE, "ImgDllMutex"); +#endif + #ifndef TCL_MAC Tk_CreateImageType(&imgPixmapImageType); #endif } -#ifdef ALLOW_B64 +#ifdef ALLOW_B64 /* Undocumented feature */ Tcl_CreateObjCommand(interp,"img_to_base64", tob64, (ClientData) NULL, NULL); Tcl_CreateObjCommand(interp,"img_from_base64", fromb64, (ClientData) NULL, NULL); #endif @@ -444,30 +448,6 @@ } return c & 0xff; }; -/* - *----------------------------------------------------------------------- - * - * ImgSeek -- - * - * This procedure performs seek operations on FILE*'s and Tcl_Channel's - * - * Results: - * The current file position. - * - * Side effects: - * The current file position is changed. - * - *----------------------------------------------------------------------- - */ - -int -ImgSeek(handle, off, whence) - MFile *handle; /* mmdecode "file" handle */ - int off; - int whence; -{ - return Tcl_Seek((Tcl_Channel) handle->data, off, whence); -} /* *------------------------------------------------------------------------- Index: pTk/mTk/additions/imgInt.h --- Tk800.022/pTk/mTk/additions/imgInt.h Sat Apr 1 16:35:58 2000 +++ Tk800.023/pTk/mTk/additions/imgInt.h Sat Dec 30 16:12:37 2000 @@ -53,7 +53,6 @@ EXTERN int ImgRead _ANSI_ARGS_((MFile *handle, char *dst, int count)); EXTERN int ImgPutc _ANSI_ARGS_((int c, MFile *handle)); EXTERN int ImgWrite _ANSI_ARGS_((MFile *handle, CONST char *src, int count)); -EXTERN int ImgSeek _ANSI_ARGS_((MFile *handle, int off, int whence)); EXTERN void ImgWriteInit _ANSI_ARGS_((Tcl_DString *buffer, MFile *handle)); EXTERN int ImgReadInit _ANSI_ARGS_((Tcl_Obj *data, int c, MFile *handle)); EXTERN Tcl_Channel ImgOpenFileChannel _ANSI_ARGS_((Tcl_Interp *interp, Index: pTk/mTk/additions/imgObj.c --- Tk800.022/pTk/mTk/additions/imgObj.c Sat Apr 1 16:50:25 2000 +++ Tk800.023/pTk/mTk/additions/imgObj.c Sat Dec 30 16:12:37 2000 @@ -300,6 +300,9 @@ } if (initialized & IMG_OBJS) { tmp = (Tcl_Interp *) *height; + if (tmp->result != ((Interp *) tmp)->resultSpace) { + return; + } } else { tmp = (Tcl_Interp *) NULL; } @@ -330,6 +333,9 @@ } if (initialized & IMG_OBJS) { tmp = (Tcl_Interp *) *height; + if (tmp->result != ((Interp *) tmp)->resultSpace) { + return; + } } else { tmp = (Tcl_Interp *) NULL; } Index: pTk/mTk/additions/imgPS.c --- Tk800.022/pTk/mTk/additions/imgPS.c Sat Apr 1 16:04:50 2000 +++ Tk800.023/pTk/mTk/additions/imgPS.c Sat Dec 30 16:12:37 2000 @@ -272,44 +272,29 @@ int len, i, j, fileWidth, fileHeight, maxintensity, index; char *p, type; unsigned char buffer[1025], *line = NULL, *line3 = NULL; + char zoom[64], papersize[64]; Tcl_Channel chan; Tcl_DString dstring; myblock bl; int zoomx, zoomy; - argv[0] = "gs"; - argv[1] = "-sDEVICE=ppmraw"; - argv[2] = (char *) buffer; - argv[3] = "-q"; - argv[4] = "-dNOPAUSE"; - argv[5] = "-sOutputFile=-"; - argv[6] = "-"; - index = parseFormat(format, &zoomx, &zoomy); if (index < 0) { Tcl_AppendResult(interp, "invalid format: \"", ImgGetStringFromObj(format, NULL), "\"", (char *) NULL); return TCL_ERROR; } - sprintf((char *) buffer, "-r%dx%d", zoomx, zoomy); - chan = Tcl_OpenCommandChannel(interp, 7, argv, - TCL_STDIN|TCL_STDOUT|TCL_STDERR|TCL_ENFORCE_MODE); - if (!chan) { - return TCL_ERROR; - } - if (Tcl_SetChannelOption(interp, chan, "-translation", "binary") != TCL_OK) { - return TCL_ERROR; - } - + sprintf(zoom, "-r%dx%d", zoomx, zoomy); len = ImgRead(handle, buffer, 1024); buffer[1024] = 0; p = strstr(buffer,"%%BoundingBox:"); + fileHeight = height + srcY; if (p) { /* postscript */ p += 14; srcX += (strtoul(p, &p, 0) * zoomx + 36) / 72; - strtoul(p, &p, 0); + fileHeight += (strtoul(p, &p, 0) * zoomy + 36) / 72; strtoul(p, &p, 0); srcY -= (strtoul(p, &p, 0) * zoomy + 36) / 72; } else { @@ -323,6 +308,27 @@ srcX += (0 * zoomx + 36) / 72; srcY -= (792 * zoomy + 36) /72; } + + sprintf(papersize, "-g%dx%d", srcX+width, fileHeight); + + argv[0] = "gs"; + argv[1] = "-sDEVICE=ppmraw"; + argv[2] = zoom; + argv[3] = papersize; + argv[4] = "-q"; + argv[5] = "-dNOPAUSE"; + argv[6] = "-sOutputFile=-"; + argv[7] = "-"; + + chan = Tcl_OpenCommandChannel(interp, 8, argv, + TCL_STDIN|TCL_STDOUT|TCL_STDERR|TCL_ENFORCE_MODE); + if (!chan) { + return TCL_ERROR; + } + if (Tcl_SetChannelOption(interp, chan, "-translation", "binary") != TCL_OK) { + return TCL_ERROR; + } + while (len > 0) { Tcl_Write(chan, (char *) buffer, 1024); len = ImgRead(handle, buffer, 1024); @@ -375,6 +381,7 @@ block.offset[0] = 0; block.offset[1] = 0; block.offset[2] = 0; + block.offset[3] = 0; switch(type) { case '4': i = (fileWidth+7)/8; Index: pTk/mTk/additions/imgPmap.c --- Tk800.022/pTk/mTk/additions/imgPmap.c Sat Apr 1 16:15:13 2000 +++ Tk800.023/pTk/mTk/additions/imgPmap.c Sat Dec 30 16:12:37 2000 @@ -13,7 +13,6 @@ #include #include #include -#include #include #include @@ -93,6 +92,9 @@ ImgXpmDisplay, /* displayProc */ ImgXpmFree, /* freeProc */ ImgXpmDelete, /* deleteProc */ +#ifdef TK_CONFIG_OBJS + (Tk_ImagePostscriptProc *) NULL, /* postscriptProc */ +#endif (Tk_ImageType *) NULL /* nextPtr */ }; Index: pTk/mTk/additions/imgTIFF.c --- Tk800.022/pTk/mTk/additions/imgTIFF.c Sat Apr 1 16:04:54 2000 +++ Tk800.023/pTk/mTk/additions/imgTIFF.c Sat Dec 30 16:12:37 2000 @@ -14,7 +14,6 @@ #include "imgInt.h" #include #include -#include #if defined(__STDC__) || defined(HAS_STDARG) #include #else @@ -133,15 +132,15 @@ "TIFFSetErrorHandler", "TIFFSetWarningHandler", "TIFFClientOpen", - "TIFFRegisterCODEC", + "TIFFRegisterCODEC", /* not in libtiff.def */ "TIFFError", - "TIFFPredictorInit", - "_TIFFMergeFieldInfo", - "TIFFFlushData1", - "_TIFFNoPostDecode", + "TIFFPredictorInit", /* not in libtiff.def */ + "_TIFFMergeFieldInfo", /* not in libtiff.def */ + "TIFFFlushData1", /* not in libtiff.def */ + "_TIFFNoPostDecode", /* not in libtiff.def */ "TIFFTileRowSize", "TIFFScanlineSize", - "_TIFFsetByteArray", + "_TIFFsetByteArray", /* not in libtiff.def */ "TIFFVSetField", "TIFFSwabArrayOfShort", (char *) NULL @@ -335,12 +334,12 @@ static tsize_t writeDummy _ANSI_ARGS_((thandle_t, tdata_t, tsize_t)); static tsize_t readMFile _ANSI_ARGS_((thandle_t, tdata_t, tsize_t)); -static tsize_t seekMFile _ANSI_ARGS_((thandle_t, toff_t, int)); +static toff_t seekMFile _ANSI_ARGS_((thandle_t, toff_t, int)); static toff_t sizeMFile _ANSI_ARGS_((thandle_t)); static tsize_t readString _ANSI_ARGS_((thandle_t, tdata_t, tsize_t)); static tsize_t writeString _ANSI_ARGS_((thandle_t, tdata_t, tsize_t)); -static tsize_t seekString _ANSI_ARGS_((thandle_t, toff_t, int)); +static toff_t seekString _ANSI_ARGS_((thandle_t, toff_t, int)); static toff_t sizeString _ANSI_ARGS_((thandle_t)); static char *errorMessage = NULL; @@ -473,13 +472,13 @@ return (tsize_t) ImgRead((MFile *) fd, (char *) data, (int) size) ; } -static tsize_t +static toff_t seekMFile(fd, off, whence) thandle_t fd; toff_t off; int whence; { - return (tsize_t) ImgSeek((MFile *) fd, (int) off, whence); + return Tcl_Seek((Tcl_Channel) ((MFile *) fd)->data, (int) off, whence); } static toff_t @@ -487,7 +486,8 @@ thandle_t fd; { int fsize; - return (fsize = ImgSeek((MFile *) fd, 0, SEEK_END)) < 0 ? 0 : (toff_t) fsize; + return (fsize = Tcl_Seek((Tcl_Channel) ((MFile *) fd)->data, + (int) 0, SEEK_END)) < 0 ? 0 : (toff_t) fsize; } /* @@ -537,7 +537,7 @@ return size; } -static tsize_t +static toff_t seekString(fd, off, whence) thandle_t fd; toff_t off; @@ -994,7 +994,7 @@ Tcl_DString nameBuffer; char *fullname, *mode; - if ((fullname=Tcl_TranslateFileName(interp,filename,&nameBuffer))==NULL) { + if (!(fullname=Tcl_TranslateFileName(interp, filename, &nameBuffer))) { return TCL_ERROR; } @@ -1004,10 +1004,11 @@ } if (ParseWriteFormat(interp, format, &comp, &mode) != TCL_OK) { + Tcl_DStringFree(&nameBuffer); return TCL_ERROR; } - if (!(tif = tiff.Open(fullname,mode))) { + if (!(tif = tiff.Open(fullname, mode))) { Tcl_AppendResult(interp, filename, ": ", Tcl_PosixError(interp), (char *)NULL); Tcl_DStringFree(&nameBuffer); Index: pTk/mTk/additions/imgTIFFpixar.c --- Tk800.022/pTk/mTk/additions/imgTIFFpixar.c Sat Apr 1 16:04:56 2000 +++ Tk800.023/pTk/mTk/additions/imgTIFFpixar.c Sat Dec 30 16:12:37 2000 @@ -87,7 +87,6 @@ #undef EXPORT #include "zlib.h" -#include #include #include #include "imgInt.h" @@ -1379,6 +1378,23 @@ return (1); } +static voidpf +PixarLogAlloc(opaque, items, size) + voidpf opaque; + uInt items; + uInt size; +{ + return (voidpf) ImgTIFFmalloc((tsize_t)(items * size)); +} + +static void +PixarLogFree(opaque, address) + voidpf opaque; + voidpf address; +{ + ImgTIFFfree((tdata_t) address); +} + static const TIFFFieldInfo pixarlogFieldInfo[] = { {TIFFTAG_PIXARLOGDATAFMT,0,0,TIFF_ANY, FIELD_PSEUDO,FALSE,FALSE,""}, {TIFFTAG_PIXARLOGQUALITY,0,0,TIFF_ANY, FIELD_PSEUDO,FALSE,FALSE,""} @@ -1408,6 +1424,8 @@ sp = (PixarLogState*) tif->tif_data; memset(sp, 0, sizeof (*sp)); sp->stream.data_type = Z_BINARY; + sp->stream.zalloc = PixarLogAlloc; + sp->stream.zfree = PixarLogFree; sp->user_datafmt = PIXARLOGDATAFMT_UNKNOWN; /* Index: pTk/mTk/additions/imgTIFFzip.c --- Tk800.022/pTk/mTk/additions/imgTIFFzip.c Sat Apr 1 16:04:56 2000 +++ Tk800.023/pTk/mTk/additions/imgTIFFzip.c Sat Dec 30 16:12:37 2000 @@ -50,7 +50,6 @@ #undef EXPORT #include "zlib.h" -#include #include #include "imgInt.h" @@ -421,6 +420,23 @@ }; #define N(a) (sizeof (a) / sizeof (a[0])) +static voidpf +ZipAlloc(opaque, items, size) + voidpf opaque; + uInt items; + uInt size; +{ + return (voidpf) ImgTIFFmalloc((tsize_t)(items * size)); +} + +static void +ZipFree(opaque, address) + voidpf opaque; + voidpf address; +{ + ImgTIFFfree((tdata_t) address); +} + int ImgInitTIFFzip(handle, scheme) VOID * handle; @@ -443,8 +459,8 @@ if (tif->tif_data == NULL) goto bad; sp = ZState(tif); - sp->stream.zalloc = NULL; - sp->stream.zfree = NULL; + sp->stream.zalloc = ZipAlloc; + sp->stream.zfree = ZipFree; sp->stream.opaque = NULL; sp->stream.data_type = Z_BINARY; Index: pTk/mTk/additions/imgXBM.c --- Tk800.022/pTk/mTk/additions/imgXBM.c Sat Apr 1 16:53:28 2000 +++ Tk800.023/pTk/mTk/additions/imgXBM.c Sat Dec 30 16:12:37 2000 @@ -5,7 +5,7 @@ * * Written by: * Jan Nijtmans - * CMG (Computer Management Group) Arnhem B.V. + * CMG Oost-Nederland B.V. * email: j.nijtmans@chello.nl (private) * jan.nijtmans@cmg.nl (work) * url: http://purl.oclc.org/net/nijtmans/ @@ -420,7 +420,7 @@ *dst = buf; dst++; parseInfoPtr->wordLength++; - if (parseInfoPtr->wordLength > MAX_WORD_LENGTH) { + if (num == 0 || parseInfoPtr->wordLength > MAX_WORD_LENGTH) { return TCL_ERROR; } } Index: pTk/mTk/additions/imgXPM.c --- Tk800.022/pTk/mTk/additions/imgXPM.c Sat Apr 1 16:54:37 2000 +++ Tk800.023/pTk/mTk/additions/imgXPM.c Sat Dec 30 16:12:37 2000 @@ -5,7 +5,7 @@ * * Written by: * Jan Nijtmans - * CMG (Computer Management Group) Arnhem B.V. + * CMG Oost-Nederland B.V. * email: j.nijtmans@chello.nl (private) * jan.nijtmans@cmg.nl (work) * url: http://purl.oclc.org/net/nijtmans/ @@ -412,6 +412,9 @@ Tk_PhotoGetImage(imageHandle, &block.pub); /* in case Tk_PhotoGetImage doesn't set this */ + block.pub.offset[0] = 0; + block.pub.offset[1] = 1; + block.pub.offset[2] = 2; block.pub.offset[3] = (block.pub.pixelSize > 3) ? 3 : 0; block.pub.width = width; block.pub.pitch = block.pub.pixelSize * fileWidth; Index: pTk/mTk/additions/pTk.exc --- Tk800.022/pTk/mTk/additions/pTk.exc Tue Jul 27 19:20:27 1999 +++ Tk800.023/pTk/mTk/additions/pTk.exc Sat Dec 30 16:12:37 2000 @@ -1,6 +1,6 @@ imgPmap.c -imgPmap.h -imgUnixPmap.c +imgPmap.h +imgUnixPmap.c imgWinPmap.c imgPS.c imgJPEG.c @@ -11,3 +11,4 @@ imgTIFFzip.c imgTIFFpixar.c imgPNG.c +tkAppInit.c Index: pTk/mTk/additions/port.h --- /dev/null Sat Dec 30 02:58:04 2000 +++ Tk800.023/pTk/mTk/additions/port.h Sat Dec 30 16:12:37 2000 @@ -0,0 +1,32 @@ +/* + * Warning, this file was automatically created by the TIFF configure script + * VERSION: v3.5.5 + * DATE: Sun Jul 16 20:21:17 MET DST 2000 + * TARGET: i386-unknown-linux + * CCOMPILER: /usr/bin/gcc-2.7.2.1 + */ +#ifndef _PORT_ +#define _PORT_ 1 +#ifdef __cplusplus +extern "C" { +#endif +#include +#define HOST_FILLORDER FILLORDER_LSB2MSB +#define HOST_BIGENDIAN 0 +#define HAVE_MMAP 1 +#include +#include +#include +#include +#include +typedef double dblparam_t; +#ifdef __STRICT_ANSI__ +#define INLINE __inline__ +#else +#define INLINE inline +#endif +#define GLOBALDATA(TYPE,NAME) extern TYPE NAME +#ifdef __cplusplus +} +#endif +#endif Index: pTk/mTk/additions/tkAppInit.c --- /dev/null Sat Dec 30 02:58:04 2000 +++ Tk800.023/pTk/mTk/additions/tkAppInit.c Sat Dec 30 16:12:37 2000 @@ -0,0 +1,159 @@ +/* + * tkAppInit.c -- + * + * Provides a default version of the Tcl_AppInit procedure for + * use in wish and similar Tk-based applications. + * + * Copyright (c) 1993 The Regents of the University of California. + * Copyright (c) 1994-1997 Sun Microsystems, Inc. + * + * See the file "license.terms" for information on usage and redistribution + * of this file, and for a DISCLAIMER OF ALL WARRANTIES. + * + * RCS: @(#) $Id: tkAppInit.c,v 1.5 1999/12/02 02:05:39 redman Exp $ + */ + +#undef TCL_USE_STUBS + +#include "tk.h" +#include "img.h" +#ifndef I18N_IMPROVE +#include "locale.h" +#endif /* !I18N_IMPROVE */ + +/* + * The following variable is a special hack that is needed in order for + * Sun shared libraries to be used for Tcl. + */ + +extern int matherr(); +int *tclDummyMathPtr = (int *) matherr; + +#ifdef TK_TEST +extern int Tcltest_Init _ANSI_ARGS_((Tcl_Interp *interp)); +extern int Tktest_Init _ANSI_ARGS_((Tcl_Interp *interp)); +#endif /* TK_TEST */ + +/* + *---------------------------------------------------------------------- + * + * main -- + * + * This is the main program for the application. + * + * Results: + * None: Tk_Main never returns here, so this procedure never + * returns either. + * + * Side effects: + * Whatever the application does. + * + *---------------------------------------------------------------------- + */ + +int +main(argc, argv) + int argc; /* Number of command-line arguments. */ + char **argv; /* Values of command-line arguments. */ +{ + /* + * The following #if block allows you to change the AppInit + * function by using a #define of TCL_LOCAL_APPINIT instead + * of rewriting this entire file. The #if checks for that + * #define and uses Tcl_AppInit if it doesn't exist. + */ + +#ifndef TK_LOCAL_APPINIT +#define TK_LOCAL_APPINIT Tcl_AppInit +#endif + extern int TK_LOCAL_APPINIT _ANSI_ARGS_((Tcl_Interp *interp)); + + /* + * The following #if block allows you to change how Tcl finds the startup + * script, prime the library or encoding paths, fiddle with the argv, + * etc., without needing to rewrite Tk_Main() + */ + +#ifdef TK_LOCAL_MAIN_HOOK + extern int TK_LOCAL_MAIN_HOOK _ANSI_ARGS_((int *argc, char ***argv)); + TK_LOCAL_MAIN_HOOK(&argc, &argv); +#endif + + Tk_Main(argc, argv, TK_LOCAL_APPINIT); + return 0; /* Needed only to prevent compiler warning. */ +} + +/* + *---------------------------------------------------------------------- + * + * Tcl_AppInit -- + * + * This procedure performs application-specific initialization. + * Most applications, especially those that incorporate additional + * packages, will have their own version of this procedure. + * + * Results: + * Returns a standard Tcl completion code, and leaves an error + * message in the interp's result if an error occurs. + * + * Side effects: + * Depends on the startup script. + * + *---------------------------------------------------------------------- + */ + +int +Tcl_AppInit(interp) + Tcl_Interp *interp; /* Interpreter for application. */ +{ + if (Tcl_Init(interp) == TCL_ERROR) { + return TCL_ERROR; + } + if (Tk_Init(interp) == TCL_ERROR) { + return TCL_ERROR; + } + Tcl_StaticPackage(interp, "Tk", Tk_Init, Tk_SafeInit); + if (Img_Init(interp) == TCL_ERROR) { + return TCL_ERROR; + } + Tcl_StaticPackage(interp, "Img", Img_Init, Img_SafeInit); +#ifdef TK_TEST + if (Tcltest_Init(interp) == TCL_ERROR) { + return TCL_ERROR; + } + Tcl_StaticPackage(interp, "Tcltest", Tcltest_Init, + (Tcl_PackageInitProc *) NULL); + if (Tktest_Init(interp) == TCL_ERROR) { + return TCL_ERROR; + } + Tcl_StaticPackage(interp, "Tktest", Tktest_Init, + (Tcl_PackageInitProc *) NULL); +#endif /* TK_TEST */ + + + /* + * Call the init procedures for included packages. Each call should + * look like this: + * + * if (Mod_Init(interp) == TCL_ERROR) { + * return TCL_ERROR; + * } + * + * where "Mod" is the name of the module. + */ + + /* + * Call Tcl_CreateCommand for application-specific commands, if + * they weren't already created by the init procedures called above. + */ + + /* + * Specify a user-specific startup file to invoke if the application + * is run interactively. Typically the startup file is "~/.apprc" + * where "app" is the name of the application. If this line is deleted + * then no user-specific startup file will be run under any conditions. + */ + + Tcl_SetVar(interp, "tcl_rcFileName", "~/.wishrc", TCL_GLOBAL_ONLY); + return TCL_OK; +} Index: pTk/mTk/generic/tk.h --- Tk800.022/pTk/mTk/generic/tk.h Mon Mar 13 09:51:02 2000 +++ Tk800.023/pTk/mTk/generic/tk.h Sat Dec 30 16:12:37 2000 @@ -49,8 +49,8 @@ #define TK_VERSION "8.0" #define TK_PATCH_LEVEL "8.0.5" -/* - * A special definition used to allow this header file to be included +/* + * A special definition used to allow this header file to be included * in resource files. */ @@ -355,7 +355,7 @@ /* * The following structure is used by Tk_GetFontMetrics() to return - * information about the properties of a Tk_Font. + * information about the properties of a Tk_Font. */ typedef struct Tk_FontMetrics { @@ -912,16 +912,16 @@ typedef struct Tk_CanvasTextInfo { Tk_3DBorder selBorder; /* Border and background for selected * characters. Read-only to items.*/ - int selBorderWidth; /* Width of border around selection. + int selBorderWidth; /* Width of border around selection. * Read-only to items. */ XColor *selFgColorPtr; /* Foreground color for selected text. * Read-only to items. */ Tk_Item *selItemPtr; /* Pointer to selected item. NULL means * selection isn't in this canvas. * Writable by items. */ - int selectFirst; /* Index of first selected character. + int selectFirst; /* Index of first selected character. * Writable by items. */ - int selectLast; /* Index of last selected character. + int selectLast; /* Index of last selected character. * Writable by items. */ Tk_Item *anchorItemPtr; /* Item corresponding to "selectAnchor": * not necessarily selItemPtr. Read-only @@ -1301,7 +1301,7 @@ typedef int (Tk_SelectionProc) _ANSI_ARGS_((ClientData clientData, int offset, char *buffer, int maxBytes)); typedef int (Tk_XSelectionProc) _ANSI_ARGS_((ClientData clientData, - int offset, long *buffer, int maxBytes, + int offset, long *buffer, int maxBytes, Atom type, Tk_Window tkwin)); @@ -1320,8 +1320,8 @@ *-------------------------------------------------------------- */ -EXTERN char * Tk_EventInfo _ANSI_ARGS_((int letter, Tk_Window tkwin, XEvent *eventPtr, - KeySym keySym, int *numPtr, int *isNum, int *type, +EXTERN char * Tk_EventInfo _ANSI_ARGS_((int letter, Tk_Window tkwin, XEvent *eventPtr, + KeySym keySym, int *numPtr, int *isNum, int *type, int num_size, char *numStorage)); EXTERN XColor * Tk_3DBorderColor _ANSI_ARGS_((Tk_3DBorder border)); @@ -1934,7 +1934,7 @@ ClientData clientData, Tk_Window tkwin, char *widgRec, int offset, Tcl_FreeProc **freeProcPtr)); - + EXTERN Tcl_Command Lang_CreateWidget _ANSI_ARGS_((Tcl_Interp *interp, Tk_Window, Tcl_CmdProc *proc, ClientData clientData, @@ -1953,9 +1953,13 @@ EXTERN Var LangFindVar _ANSI_ARGS_((Tcl_Interp * interp, Tk_Window, char *name)); -EXTERN Arg LangWidgetArg _ANSI_ARGS_((Tcl_Interp *interp, Tk_Window)); -EXTERN Arg LangFontArg _ANSI_ARGS_((Tcl_Interp *interp, Tk_Font font, char *name)); -EXTERN Arg LangObjectArg _ANSI_ARGS_((Tcl_Interp *interp, char *)); +EXTERN Tcl_Obj * LangWidgetObj _ANSI_ARGS_((Tcl_Interp *interp, Tk_Window)); +EXTERN Tcl_Obj * LangFontObj _ANSI_ARGS_((Tcl_Interp *interp, Tk_Font font, char *name)); +EXTERN Tcl_Obj * LangObjectObj _ANSI_ARGS_((Tcl_Interp *interp, char *)); + +#define LangWidgetArg(interp,win) LangObjArg(LangWidgetObj(interp,win),__FILE__,__LINE__) +#define LangFontArg(interp,font,name) LangObjArg(LangFontObj(interp,font,name),__FILE__,__LINE__) +#define LangObjectArg(interp,name) LangObjArg(LangObjectObj(interp,name),__FILE__,__LINE__) #ifndef NO_EXTERN Index: pTk/mTk/generic/tkBind.c --- Tk800.022/pTk/mTk/generic/tkBind.c Sat Apr 1 13:42:58 2000 +++ Tk800.023/pTk/mTk/generic/tkBind.c Sat Dec 30 16:12:37 2000 @@ -1307,7 +1307,7 @@ if (psPtr->eventProc == LangEventCallback) { /* REFCNT is not incremented so mimic what tkConfig.c does */ Arg result = NULL; - LangSetArg(&result,LangCallbackArg((LangCallback *) psPtr->clientData)); + LangSetObj(&result,LangCallbackObj((LangCallback *) psPtr->clientData)); return result; } return Tcl_NewStringObj("",0); Index: pTk/mTk/generic/tkButton.c --- Tk800.022/pTk/mTk/generic/tkButton.c Sat Apr 29 14:10:45 2000 +++ Tk800.023/pTk/mTk/generic/tkButton.c Sat Dec 30 16:12:37 2000 @@ -388,7 +388,7 @@ return TCL_ERROR; } - TkClassOption(new, classNames[type],&argc,&args); + TkClassOption(new, classNames[type],&argc,&objv); butPtr = TkpCreateButton(new); TkSetClassProcs(new, &tkpButtonProcs, (ClientData) butPtr); Index: pTk/mTk/generic/tkCanvArc.c --- Tk800.022/pTk/mTk/generic/tkCanvArc.c Sun Apr 30 20:25:11 2000 +++ Tk800.023/pTk/mTk/generic/tkCanvArc.c Sat Dec 30 16:12:37 2000 @@ -331,7 +331,7 @@ if (argc==1) { i = 1; } else { - char *arg = Tcl_GetStringFromObj(args[1], NULL); + char *arg = Tcl_GetStringFromObj(objv[1], NULL); if ((argc>1) && (arg[0] == '-') && (arg[1] >= 'a') && (arg[1] <= 'z')) { i = 1; @@ -433,7 +433,7 @@ Tcl_SetObjResult(interp, obj); } else if ((argc == 1)||(argc == 4)) { if (argc==1) { - if (Tcl_ListObjGetElements(interp, args[0], &argc, &args) != TCL_OK) { + if (Tcl_ListObjGetElements(interp, objv[0], &argc, &objv) != TCL_OK) { return TCL_ERROR; } else if (argc != 4) { sprintf(c0,"%d",argc); @@ -442,13 +442,13 @@ return TCL_ERROR; } } - if ((Tk_CanvasGetCoordFromObj(interp, canvas, args[0], + if ((Tk_CanvasGetCoordFromObj(interp, canvas, objv[0], &arcPtr->bbox[0]) != TCL_OK) - || (Tk_CanvasGetCoordFromObj(interp, canvas, args[1], + || (Tk_CanvasGetCoordFromObj(interp, canvas, objv[1], &arcPtr->bbox[1]) != TCL_OK) - || (Tk_CanvasGetCoordFromObj(interp, canvas, args[2], + || (Tk_CanvasGetCoordFromObj(interp, canvas, objv[2], &arcPtr->bbox[2]) != TCL_OK) - || (Tk_CanvasGetCoordFromObj(interp, canvas, args[3], + || (Tk_CanvasGetCoordFromObj(interp, canvas, objv[3], &arcPtr->bbox[3]) != TCL_OK)) { return TCL_ERROR; } Index: pTk/mTk/generic/tkCanvBmap.c --- Tk800.022/pTk/mTk/generic/tkCanvBmap.c Sat Dec 4 23:13:38 1999 +++ Tk800.023/pTk/mTk/generic/tkCanvBmap.c Sat Dec 30 16:12:37 2000 @@ -1,4 +1,4 @@ -/* +/* * tkCanvBmap.c -- * * This file implements bitmap items for canvas widgets. @@ -187,7 +187,7 @@ if (argc==1) { i = 1; } else { - char *arg = Tcl_GetStringFromObj(args[1], NULL); + char *arg = Tcl_GetStringFromObj(objv[1], NULL); if (((argc>1) && (arg[0] == '-') && (arg[1] >= 'a') && (arg[1] <= 'z'))) { i = 1; @@ -277,7 +277,7 @@ Tcl_SetObjResult(interp, obj); } else if (argc <3) { if (argc==1) { - if (Tcl_ListObjGetElements(interp, args[0], &argc, &argv) != TCL_OK) { + if (Tcl_ListObjGetElements(interp, objv[0], &argc, &argv) != TCL_OK) { return TCL_ERROR; } else if (argc != 2) { sprintf(x,"%d",argc); @@ -286,8 +286,8 @@ return TCL_ERROR; } } - if ((Tk_CanvasGetCoordFromObj(interp, canvas, args[0], &bmapPtr->x) != TCL_OK) - || (Tk_CanvasGetCoordFromObj(interp, canvas, args[1], &bmapPtr->y) + if ((Tk_CanvasGetCoordFromObj(interp, canvas, objv[0], &bmapPtr->x) != TCL_OK) + || (Tk_CanvasGetCoordFromObj(interp, canvas, objv[1], &bmapPtr->y) != TCL_OK)) { return TCL_ERROR; } @@ -676,7 +676,7 @@ * to line up with the bitmap's origin (in order to make * bitmaps with "-background {}" work right). */ - + XSetClipOrigin(display, bmapPtr->gc, drawableX - bmapX, drawableY - bmapY); XCopyPlane(display, bitmap, drawable, Index: pTk/mTk/generic/tkCanvImg.c --- Tk800.022/pTk/mTk/generic/tkCanvImg.c Sat Dec 4 23:13:38 1999 +++ Tk800.023/pTk/mTk/generic/tkCanvImg.c Sat Dec 30 16:12:37 2000 @@ -1,4 +1,4 @@ -/* +/* * tkCanvImg.c -- * * This file implements image items for canvas widgets. @@ -179,7 +179,7 @@ if (argc==1) { i = 1; } else { - char *arg = Tcl_GetStringFromObj(args[1], NULL); + char *arg = Tcl_GetStringFromObj(objv[1], NULL); if (((argc>1) && (arg[0] == '-') && (arg[1] >= 'a') && (arg[1] <= 'z'))) { i = 1; @@ -266,7 +266,7 @@ Tcl_SetObjResult(interp, obj); } else if (argc < 3) { if (argc==1) { - if (Tcl_ListObjGetElements(interp, args[0], &argc, &args) != TCL_OK) { + if (Tcl_ListObjGetElements(interp, objv[0], &argc, &objv) != TCL_OK) { return TCL_ERROR; } else if (argc != 2) { sprintf(x,"%d",argc); @@ -275,8 +275,8 @@ return TCL_ERROR; } } - if ((Tk_CanvasGetCoordFromObj(interp, canvas, args[0], &imgPtr->x) != TCL_OK) - || (Tk_CanvasGetCoordFromObj(interp, canvas, args[1], + if ((Tk_CanvasGetCoordFromObj(interp, canvas, objv[0], &imgPtr->x) != TCL_OK) + || (Tk_CanvasGetCoordFromObj(interp, canvas, objv[1], &imgPtr->y) != TCL_OK)) { return TCL_ERROR; } @@ -751,7 +751,7 @@ x = imgPtr->x; y = Tk_CanvasPsY(canvas, imgPtr->y); - + switch (imgPtr->anchor) { case TK_ANCHOR_NW: y -= height; break; case TK_ANCHOR_N: x -= width/2.0; y -= height; break; @@ -767,7 +767,7 @@ if (image == NULL) { return TCL_OK; } - + if (!prepass) { sprintf(buffer, "%.15g %.15g", x, y); Tcl_AppendResult(interp, buffer, " translate\n", (char *) NULL); @@ -887,7 +887,7 @@ height = imgHeight; Tk_CanvasEventuallyRedraw(imgPtr->canvas, imgPtr->header.x1, imgPtr->header.y1, imgPtr->header.x2, imgPtr->header.y2); - } + } ComputeImageBbox(imgPtr->canvas, imgPtr); Tk_CanvasEventuallyRedraw(imgPtr->canvas, imgPtr->header.x1 + x, imgPtr->header.y1 + y, (int) (imgPtr->header.x1 + x + width), Index: pTk/mTk/generic/tkCanvLine.c --- Tk800.022/pTk/mTk/generic/tkCanvLine.c Sun Apr 30 20:25:31 2000 +++ Tk800.023/pTk/mTk/generic/tkCanvLine.c Sat Dec 30 16:12:37 2000 @@ -348,7 +348,7 @@ */ for (i = 0; i < argc; i++) { - char *arg = Tcl_GetStringFromObj(args[i], NULL); + char *arg = Tcl_GetStringFromObj(objv[i], NULL); if ((arg[0] == '-') && (arg[1] >= 'a') && (arg[1] <= 'z')) { break; @@ -423,7 +423,7 @@ return TCL_OK; } if (argc == 1) { - if (Tcl_ListObjGetElements(interp, args[0], &argc, &args) != TCL_OK) { + if (Tcl_ListObjGetElements(interp, objv[0], &argc, &objv) != TCL_OK) { return TCL_ERROR; } } @@ -445,7 +445,7 @@ } coordPtr = linePtr->coordPtr; for (i = 0; i = 'a') && (arg[1] <= 'z')) { break; @@ -395,7 +395,7 @@ return TCL_OK; } if (argc == 1) { - if (Tcl_ListObjGetElements(interp, args[0], &argc, &args) != TCL_OK) { + if (Tcl_ListObjGetElements(interp, objv[0], &argc, &objv) != TCL_OK) { return TCL_ERROR; } } @@ -421,7 +421,7 @@ polyPtr->pointsAllocated = numPoints+1; } for (i = argc-1; i >= 0; i--) { - if (Tk_CanvasGetCoordFromObj(interp, canvas, args[i], + if (Tk_CanvasGetCoordFromObj(interp, canvas, objv[i], &polyPtr->coordPtr[i]) != TCL_OK) { return TCL_ERROR; } Index: pTk/mTk/generic/tkCanvPs.c --- Tk800.022/pTk/mTk/generic/tkCanvPs.c Sun Dec 12 13:58:36 1999 +++ Tk800.023/pTk/mTk/generic/tkCanvPs.c Sat Dec 30 16:12:37 2000 @@ -1,4 +1,4 @@ -/* +/* * tkCanvPs.c -- * * This module provides Postscript output support for canvases, @@ -635,8 +635,8 @@ " safe interpreter", (char *) NULL); result = TCL_ERROR; goto cleanup; - } - + } + p = Tcl_TranslateFileName(interp, psInfo.fileName, &buffer); if (p == NULL) { goto cleanup; @@ -650,7 +650,7 @@ if (psInfo.channelName != NULL) { int mode; - + /* * Check that the channel is found in this interpreter and that it * is open for writing. @@ -670,7 +670,7 @@ goto cleanup; } } - + /* *-------------------------------------------------------- * Make a pre-pass over all of the items, generating Postscript @@ -687,7 +687,7 @@ if ((itemPtr->x1 >= psInfo.x2) || (itemPtr->x2 < psInfo.x) || (itemPtr->y1 >= psInfo.y2) || (itemPtr->y2 < psInfo.y)) { continue; - } + } if (itemPtr->group != canvasPtr->activeGroup) { continue; } @@ -751,7 +751,7 @@ } Tcl_AppendResult(interp, "%%BoundingBox: ", string, "\n", (char *) NULL); - Tcl_AppendResult(interp, "%%Pages: 1\n", + Tcl_AppendResult(interp, "%%Pages: 1\n", "%%DocumentData: Clean7Bit\n", (char *) NULL); Tcl_AppendResult(interp, "%%Orientation: ", psInfo.rotate ? "Landscape\n" : "Portrait\n", (char *) NULL); @@ -817,7 +817,7 @@ Tk_PostscriptY((double) psInfo.y, (Tk_PostscriptInfo) &psInfo), psInfo.x2, Tk_PostscriptY((double) psInfo.y, (Tk_PostscriptInfo) &psInfo), - psInfo.x2, + psInfo.x2, Tk_PostscriptY((double) psInfo.y2, (Tk_PostscriptInfo) &psInfo), psInfo.x, Tk_PostscriptY((double) psInfo.y2, (Tk_PostscriptInfo) &psInfo)); @@ -1049,9 +1049,10 @@ */ Tcl_DStringInit(&ds); - + if (psInfoPtr->fontVar != NULL) { - Arg list, *args; + Tcl_Obj *list; + Tcl_Obj **objv; int argc; double size; char *name; @@ -1070,16 +1071,16 @@ if (argc != 2) { goto badMapEntry; } - if (Tcl_GetDouble(interp, args[1], &size) != TCL_OK) { + if (Tcl_GetDouble(interp, objv[1], &size) != TCL_OK) { goto badMapEntry; } Tcl_DStringAppend(&ds, argv[0], -1); points = (int) size; - + goto findfont; } - } + } points = Tk_PostscriptFontName(tkfont, &ds); @@ -1119,7 +1120,7 @@ *-------------------------------------------------------------- */ -#undef TkGetProlog +#undef TkGetProlog int Tk_PostscriptBitmap(interp, tkwin, psInfo, bitmap, startX, startY, width, height) @@ -1408,13 +1409,13 @@ * TkImageGetColor -- * * This procedure converts a pixel value to three floating - * point numbers, representing the amount of red, green, and + * point numbers, representing the amount of red, green, and * blue in that pixel on the screen. It makes use of colormap * data passed as an argument, and should work for all Visual * types. * * Results: - * Returns red, green, and blue color values in the range + * Returns red, green, and blue color values in the range * 0 to 1. There are no error returns. * * Side effects: @@ -1449,8 +1450,8 @@ * TkPostscriptImage -- * * This procedure is called to output the contents of an - * image in Postscript, using a format appropriate for the - * current color mode (i.e. one bit per pixel in monochrome, + * image in Postscript, using a format appropriate for the + * current color mode (i.e. one bit per pixel in monochrome, * one byte per pixel in gray, and three bytes per pixel in * color). * @@ -1536,9 +1537,9 @@ XQueryColors(Tk_Display(tkwin), cmap, cdata.colors, ncolors); /* - * Figure out which color level to use (possibly lower than the + * Figure out which color level to use (possibly lower than the * one specified by the user). For example, if the user specifies - * color with monochrome screen, use gray or monochrome mode instead. + * color with monochrome screen, use gray or monochrome mode instead. */ if (!cdata.color && level == 2) { @@ -1551,10 +1552,10 @@ /* * Check that at least one row of the image can be represented - * with a string less than 64 KB long (this is a limit in the + * with a string less than 64 KB long (this is a limit in the * Postscript interpreter). */ - + switch (level) { case 0: bytesPerLine = (width + 7) / 8; maxWidth = 240000; break; @@ -1630,7 +1631,7 @@ } case 1: { /* - * Generate data in gray mode--in this case, take a + * Generate data in gray mode--in this case, take a * weighted sum of the red, green, and blue values. */ for (xx = x; xx < x+width; xx ++) { Index: pTk/mTk/generic/tkCanvText.c --- Tk800.022/pTk/mTk/generic/tkCanvText.c Sun Apr 30 20:26:15 2000 +++ Tk800.023/pTk/mTk/generic/tkCanvText.c Sat Dec 30 16:12:37 2000 @@ -260,7 +260,7 @@ if (argc==1) { i = 1; } else { - char *arg = Tcl_GetStringFromObj(args[1],NULL); + char *arg = Tcl_GetStringFromObj(objv[1],NULL); if ((argc>1) && (arg[0] == '-') && (arg[1] >= 'a') && (arg[1] <= 'z')) { i = 1; @@ -368,7 +368,7 @@ Tcl_SetObjResult(interp, obj); } else if (argc < 3) { if (argc==1) { - if (Tcl_ListObjGetElements(interp, args[0], &argc, &args) != TCL_OK) { + if (Tcl_ListObjGetElements(interp, objv[0], &argc, &objv) != TCL_OK) { return TCL_ERROR; } else if (argc != 2) { sprintf(x,"%d",argc); @@ -377,8 +377,8 @@ return TCL_ERROR; } } - if ((Tk_CanvasGetCoordFromObj(interp, canvas, args[0], &textPtr->x) != TCL_OK) - || (Tk_CanvasGetCoordFromObj(interp, canvas, args[1], + if ((Tk_CanvasGetCoordFromObj(interp, canvas, objv[0], &textPtr->x) != TCL_OK) + || (Tk_CanvasGetCoordFromObj(interp, canvas, objv[1], &textPtr->y) != TCL_OK)) { return TCL_ERROR; } Index: pTk/mTk/generic/tkCanvUtil.c --- Tk800.022/pTk/mTk/generic/tkCanvUtil.c Sun Dec 12 13:58:36 1999 +++ Tk800.023/pTk/mTk/generic/tkCanvUtil.c Sat Dec 30 16:12:37 2000 @@ -1,4 +1,4 @@ -/* +/* * tkCanvUtil.c -- * * This procedure contains a collection of utility procedures @@ -675,7 +675,7 @@ register Tk_SmoothMethod **smoothPtr = (Tk_SmoothMethod **) (widgRec + offset); Tk_SmoothMethod *smooth = NULL; int b, length; - SmoothAssocData *method; + SmoothAssocData *method; char *value = LangString(ovalue); if(value == NULL || *value == 0) { @@ -773,8 +773,8 @@ * store dash information. */ { int argc, i; - Arg *largv = NULL; - Arg *args = NULL; + Tcl_Obj **largv = NULL; + Tcl_Obj **objv = NULL; char *pt; char *value = LangString(ovalue); @@ -798,7 +798,7 @@ dash->number = -i; return TCL_OK; } - if (Tcl_ListObjGetElements(interp, ovalue, &argc, &args) != TCL_OK) { + if (Tcl_ListObjGetElements(interp, ovalue, &argc, &objv) != TCL_OK) { Tcl_ResetResult(interp); badDashList: Tcl_AppendResult(interp, "bad dash list \"", value, @@ -820,7 +820,7 @@ } dash->number = argc; - largv = argv; + largv = objv; while(argc>0) { if (Tcl_GetInt(interp, *largv, &i) != TCL_OK || i < 1 || i>255) { @@ -830,9 +830,9 @@ goto syntaxError; } *pt++ = i; - argc--; largv++; + argc--; largv++; } - + return TCL_OK; } @@ -1156,7 +1156,7 @@ if (color==NULL) { return 0; } - + if ((dash->number<-1) || ((dash->number == -1) && (dash->pattern.array[1]!=','))) { char *q; int i = -dash->number; @@ -1213,7 +1213,7 @@ * * Tk_ResetOutlineGC * - * Restores the GC to the situation before + * Restores the GC to the situation before * Tk_ChangeDashGC() was called. * This function should be called just after the dashed * item is drawn, because the GC is supposed to be Index: pTk/mTk/generic/tkCanvWind.c --- Tk800.022/pTk/mTk/generic/tkCanvWind.c Sat Dec 4 23:13:38 1999 +++ Tk800.023/pTk/mTk/generic/tkCanvWind.c Sat Dec 30 16:12:37 2000 @@ -1,4 +1,4 @@ -/* +/* * tkCanvWind.c -- * * This file implements window items for canvas widgets. @@ -194,7 +194,7 @@ if (argc==1) { i = 1; } else { - char *arg = Tcl_GetStringFromObj(args[1], NULL); + char *arg = Tcl_GetStringFromObj(objv[1], NULL); if (((argc>1) && (arg[0] == '-') && (arg[1] >= 'a') && (arg[1] <= 'z'))) { i = 1; @@ -278,7 +278,7 @@ Tcl_SetObjResult(interp, obj); } else if (argc < 3) { if (argc==1) { - if (Tcl_ListObjGetElements(interp, args[0], &argc, &args) != TCL_OK) { + if (Tcl_ListObjGetElements(interp, objv[0], &argc, &objv) != TCL_OK) { return TCL_ERROR; } else if (argc != 2) { sprintf(x,"%d",argc); @@ -287,8 +287,8 @@ return TCL_ERROR; } } - if ((Tk_CanvasGetCoordFromObj(interp, canvas, args[0], &winItemPtr->x) - != TCL_OK) || (Tk_CanvasGetCoordFromObj(interp, canvas, args[1], + if ((Tk_CanvasGetCoordFromObj(interp, canvas, objv[0], &winItemPtr->x) + != TCL_OK) || (Tk_CanvasGetCoordFromObj(interp, canvas, objv[1], &winItemPtr->y) != TCL_OK)) { return TCL_ERROR; } @@ -612,7 +612,7 @@ if (((x + width) <= 0) || ((y + height) <= 0) || (x >= Tk_Width(canvasTkwin)) || (y >= Tk_Height(canvasTkwin))) { if (canvasTkwin == Tk_Parent(winItemPtr->tkwin)) { - Tk_UnmapWindow(winItemPtr->tkwin); + Tk_UnmapWindow(winItemPtr->tkwin); } else { Tk_UnmaintainGeometry(winItemPtr->tkwin, canvasTkwin); } @@ -808,7 +808,7 @@ if (prepass || winItemPtr->tkwin == NULL) { return TCL_OK; } - + width = Tk_Width(tkwin); height = Tk_Height(tkwin); @@ -819,7 +819,7 @@ x = winItemPtr->x; y = Tk_CanvasPsY(canvas, winItemPtr->y); - + switch (winItemPtr->anchor) { case TK_ANCHOR_NW: y -= height; break; case TK_ANCHOR_N: x -= width/2.0; y -= height; break; @@ -855,6 +855,7 @@ #ifdef X_GetImage Tk_ErrorHandler handle; #endif + Tcl_Obj *obj = NULL; sprintf(buffer, "\n%%%% %s item (%s, %d x %d)\n%.15g %.15g translate\n", Tk_Class(tkwin), Tk_PathName(tkwin), width, height, x, y); @@ -869,12 +870,13 @@ Tcl_DStringInit(&buffer1); Tcl_DStringInit(&buffer2); Tcl_DStringGetResult(interp, &buffer2); -#ifndef _LANG +#ifndef _LANG sprintf (buffer, "%s postscript -prolog 0\n", Tk_PathName(tkwin)); result = Tcl_Eval(interp, buffer); -#else - result = LangMethodCall(interp,LangWidgetArg(interp,tkwin),"postscript", - 1,2,"%s %d","-prolog",0); +#else + obj = LangWidgetObj(interp,tkwin); + result = LangMethodCall(interp,obj,"postscript",1,2,"%s %d","-prolog",0); + Tcl_DecrRefCount(obj); #endif /* _LANG */ Tcl_DStringGetResult(interp, &buffer1); Tcl_DStringResult(interp, &buffer2); @@ -915,7 +917,7 @@ #endif /* - * Generate an XImage from the window. We can then read pixel + * Generate an XImage from the window. We can then read pixel * values out of the XImage. */ @@ -926,7 +928,7 @@ Tk_DeleteErrorHandler(handle); #endif - if (ximage == (XImage*) NULL) { + if (ximage == (XImage*) NULL) { return TCL_OK; } Index: pTk/mTk/generic/tkCanvas.c --- Tk800.022/pTk/mTk/generic/tkCanvas.c Sat Apr 29 14:12:58 2000 +++ Tk800.023/pTk/mTk/generic/tkCanvas.c Sat Dec 30 16:12:37 2000 @@ -403,12 +403,12 @@ */ int -Tk_CanvasObjCmd(clientData, interp, argc, args) +Tk_CanvasObjCmd(clientData, interp, argc, objv) ClientData clientData; /* Main window associated with * interpreter. */ Tcl_Interp *interp; /* Current interpreter. */ int argc; /* Number of arguments. */ - Tcl_Obj *CONST args[]; /* Argument objects. */ + Tcl_Obj *CONST objv[]; /* Argument objects. */ { Tk_Window tkwin = (Tk_Window) clientData; TkCanvas *canvasPtr; @@ -424,7 +424,7 @@ } new = Tk_CreateWindowFromPath(interp, tkwin, - Tcl_GetStringFromObj(args[1], NULL), (char *) NULL); + Tcl_GetStringFromObj(objv[1], NULL), (char *) NULL); if (new == NULL) { return TCL_ERROR; } @@ -528,7 +528,7 @@ CanvasBindProc, (ClientData) canvasPtr); Tk_CreateSelHandler(canvasPtr->tkwin, XA_PRIMARY, XA_STRING, CanvasFetchSelection, (ClientData) canvasPtr, XA_STRING); - if (ConfigureCanvas(interp, canvasPtr, argc-2, (Tcl_Obj **)args+2, 0) != TCL_OK) { + if (ConfigureCanvas(interp, canvasPtr, argc-2, (Tcl_Obj **)objv+2, 0) != TCL_OK) { goto error; } @@ -820,14 +820,13 @@ goto done; } } else if (argc == 4) { - Arg command = + Tcl_Obj *command = Tk_GetBinding(interp, canvasPtr->bindingTable, object, LangString(args[3])); if (command == NULL) { result = TCL_ERROR; goto done; } - Tcl_ArgResult(interp,command); - Tcl_DecrRefCount(command); + Tcl_SetObjResult(interp,command); } else { Tk_GetAllBindings(interp, canvasPtr->bindingTable, object); } @@ -1579,9 +1578,6 @@ for (itemPtr = TagSearchFirst(searchPtr); itemPtr != NULL; itemPtr = TagSearchNext(searchPtr)) { #endif /* USE_OLD_TAG_SEARCH */ - if (itemPtr->group != canvasPtr->activeGroup) { - continue; - } EventuallyRedrawItem((Tk_Canvas) canvasPtr, itemPtr); (void) (*itemPtr->typePtr->translateProc)((Tk_Canvas) canvasPtr, itemPtr, xAmount, yAmount); @@ -2330,6 +2326,42 @@ canvasPtr->xOrigin + Tk_Width(canvasPtr->tkwin), canvasPtr->yOrigin + Tk_Height(canvasPtr->tkwin)); } +/* + * ItemHidden + * + */ + +static int +ItemHidden(canvasPtr, itemPtr, picking) + TkCanvas *canvasPtr; + Tk_Item *itemPtr; + int picking; +{ + if (itemPtr->state == TK_STATE_HIDDEN || + (picking && itemPtr->state == TK_STATE_DISABLED) || + (itemPtr->state == TK_STATE_NULL && + ( canvasPtr->canvas_state == TK_STATE_HIDDEN || + (picking && canvasPtr->canvas_state == TK_STATE_DISABLED)) )) { + return 1; + } + if (itemPtr->group != canvasPtr->activeGroup) { + if (!itemPtr->group) { + return 1; + } + if (!picking) { + return 1; + } + if (itemPtr->group->state != TK_STATE_ACTIVE) { + return 1; + } + /* We are member of an "active" group + we are hidden if group is hidden + */ + return ItemHidden(canvasPtr, itemPtr->group, picking); + } + return 0; +} + /* *-------------------------------------------------------------- @@ -2548,12 +2580,7 @@ } #endif } - if (itemPtr->state == TK_STATE_HIDDEN || - (itemPtr->state == TK_STATE_NULL && - canvasPtr->canvas_state == TK_STATE_HIDDEN)) { - continue; - } - if (itemPtr->group != canvasPtr->activeGroup) { + if (ItemHidden(canvasPtr,itemPtr, 0)) { continue; } (*itemPtr->typePtr->displayProc)((Tk_Canvas) canvasPtr, itemPtr, @@ -4256,9 +4283,7 @@ */ if (tag == NULL) { - char msg[30]; - sprintf(msg, "%d", itemPtr->id); - Tcl_AppendElement(interp, msg); + Tcl_IntResults(interp, 1, 1, itemPtr->id); return; } @@ -4324,16 +4349,16 @@ static int #ifdef USE_OLD_TAG_SEARCH -FindItems(interp, canvasPtr, argc, args, newTag, first) +FindItems(interp, canvasPtr, argc, objv, newTag, first) #else /* USE_OLD_TAG_SEARCH */ -FindItems(interp, canvasPtr, argc, args, newTag, first, searchPtrPtr) +FindItems(interp, canvasPtr, argc, objv, newTag, first, searchPtrPtr) #endif /* USE_OLD_TAG_SEARCH */ Tcl_Interp *interp; /* Interpreter for error reporting. */ TkCanvas *canvasPtr; /* Canvas whose items are to be * searched. */ int argc; /* Number of entries in argv. Must be * greater than zero. */ - Tcl_Obj **args; /* Arguments that describe what items + Tcl_Obj **objv; /* Arguments that describe what items * to search for (see user doc on * "find" and "addtag" options). */ Tcl_Obj *newTag; /* If non-NULL, gives new tag to set @@ -4368,7 +4393,7 @@ } else { uid = NULL; } - if (Tcl_GetIndexFromObj(interp, args[first], optionStrings, "search command", 0, + if (Tcl_GetIndexFromObj(interp, objv[first], optionStrings, "search command", 0, &index) != TCL_OK) { return TCL_ERROR; } @@ -4380,10 +4405,10 @@ return TCL_ERROR; } #ifdef USE_OLD_TAG_SEARCH - for (itemPtr = StartTagSearch(canvasPtr, args[first+1], &search); + for (itemPtr = StartTagSearch(canvasPtr, objv[first+1], &search); itemPtr != NULL; itemPtr = NextItem(&search)) { #else /* USE_OLD_TAG_SEARCH */ - if (TagSearchScan(canvasPtr, args[first+1], searchPtrPtr) != TCL_OK) { + if (TagSearchScan(canvasPtr, objv[first+1], searchPtrPtr) != TCL_OK) { return TCL_ERROR; } for (itemPtr = TagSearchFirst(*searchPtrPtr); @@ -4428,14 +4453,14 @@ return TCL_ERROR; } #ifdef USE_OLD_TAG_SEARCH - itemPtr = StartTagSearch(canvasPtr, args[first+1], &search); + itemPtr = StartTagSearch(canvasPtr, objv[first+1], &search); #else /* USE_OLD_TAG_SEARCH */ - if (TagSearchScan(canvasPtr, args[first+1], searchPtrPtr) != TCL_OK) { + if (TagSearchScan(canvasPtr, objv[first+1], searchPtrPtr) != TCL_OK) { return TCL_ERROR; } itemPtr = TagSearchFirst(*searchPtrPtr); #endif /* USE_OLD_TAG_SEARCH */ - if (itemPtr->prevPtr != NULL) { + if (itemPtr != NULL && itemPtr->prevPtr != NULL) { DoItem(interp, itemPtr->prevPtr, uid); } break; @@ -4450,19 +4475,19 @@ Tcl_WrongNumArgs(interp, first+1, argv, "x y ?halo? ?start?"); return TCL_ERROR; } - if ((Tk_CanvasGetCoordFromObj(interp, (Tk_Canvas) canvasPtr, args[first+1], + if ((Tk_CanvasGetCoordFromObj(interp, (Tk_Canvas) canvasPtr, objv[first+1], &coords[0]) != TCL_OK) || (Tk_CanvasGetCoordFromObj(interp, - (Tk_Canvas) canvasPtr, args[first+2], &coords[1]) != TCL_OK)) { + (Tk_Canvas) canvasPtr, objv[first+2], &coords[1]) != TCL_OK)) { return TCL_ERROR; } if (argc > first+3) { - if (Tk_CanvasGetCoordFromObj(interp, (Tk_Canvas) canvasPtr, args[first+3], + if (Tk_CanvasGetCoordFromObj(interp, (Tk_Canvas) canvasPtr, objv[first+3], &halo) != TCL_OK) { return TCL_ERROR; } if (halo < 0.0) { Tcl_AppendResult(interp, "can't have negative halo value \"", - Tcl_GetStringFromObj(args[first+3],NULL), "\"", (char *) NULL); + Tcl_GetStringFromObj(objv[first+3],NULL), "\"", (char *) NULL); return TCL_ERROR; } } else { @@ -4476,9 +4501,9 @@ startPtr = canvasPtr->firstItemPtr; if (argc == first+5) { #ifdef USE_OLD_TAG_SEARCH - itemPtr = StartTagSearch(canvasPtr, args[first+4], &search); + itemPtr = StartTagSearch(canvasPtr, objv[first+4], &search); #else /* USE_OLD_TAG_SEARCH */ - if (TagSearchScan(canvasPtr, args[first+4], searchPtrPtr) != TCL_OK) { + if (TagSearchScan(canvasPtr, objv[first+4], searchPtrPtr) != TCL_OK) { return TCL_ERROR; } itemPtr = TagSearchFirst(*searchPtrPtr); @@ -4497,9 +4522,7 @@ */ itemPtr = startPtr; - while(itemPtr && (itemPtr->state == TK_STATE_HIDDEN || - (itemPtr->group != canvasPtr->activeGroup) || - (itemPtr->state == TK_STATE_NULL && canvasPtr->canvas_state == TK_STATE_HIDDEN))) { + while (itemPtr && ItemHidden(canvasPtr, itemPtr, 1) ) { itemPtr = itemPtr->nextPtr; } if (itemPtr == NULL) { @@ -4539,12 +4562,10 @@ DoItem(interp, closestPtr, uid); return TCL_OK; } - if (itemPtr->state == TK_STATE_HIDDEN || - itemPtr->group != canvasPtr->activeGroup || - (itemPtr->state == TK_STATE_NULL && - canvasPtr->canvas_state == TK_STATE_HIDDEN)) { + if (ItemHidden(canvasPtr, itemPtr, 1)) { continue; } + if ((itemPtr->x1 >= x2) || (itemPtr->x2 <= x1) || (itemPtr->y1 >= y2) || (itemPtr->y2 <= y1)) { continue; @@ -4582,10 +4603,10 @@ return TCL_ERROR; } #ifdef USE_OLD_TAG_SEARCH - for (itemPtr = StartTagSearch(canvasPtr, args[first+1], &search); + for (itemPtr = StartTagSearch(canvasPtr, objv[first+1], &search); itemPtr != NULL; itemPtr = NextItem(&search)) { #else /* USE_OLD_TAG_SEARCH */ - if (TagSearchScan(canvasPtr, args[first+1], searchPtrPtr) != TCL_OK) { + if (TagSearchScan(canvasPtr, objv[first+1], searchPtrPtr) != TCL_OK) { return TCL_ERROR; } for (itemPtr = TagSearchFirst(*searchPtrPtr); @@ -4671,11 +4692,7 @@ y2 = (int) (rect[3]+1.0); for (itemPtr = canvasPtr->firstItemPtr; itemPtr != NULL; itemPtr = itemPtr->nextPtr) { - if (itemPtr->state == TK_STATE_HIDDEN || (itemPtr->state == TK_STATE_NULL && - canvasPtr->canvas_state == TK_STATE_HIDDEN)) { - continue; - } - if (itemPtr->group != canvasPtr->activeGroup) { + if (ItemHidden(canvasPtr, itemPtr, 1)) { continue; } if ((itemPtr->x1 >= x2) || (itemPtr->x2 <= x1) @@ -5182,10 +5199,7 @@ bestPtr = NULL; for (itemPtr = canvasPtr->firstItemPtr; itemPtr != NULL; itemPtr = itemPtr->nextPtr) { - if (itemPtr->state == TK_STATE_HIDDEN || itemPtr->state==TK_STATE_DISABLED || - itemPtr->group != canvasPtr->activeGroup || - (itemPtr->state == TK_STATE_NULL && (canvasPtr->canvas_state == TK_STATE_HIDDEN || - canvasPtr->canvas_state == TK_STATE_DISABLED))) { + if (ItemHidden(canvasPtr, itemPtr, 1)) { continue; } if ((itemPtr->x1 > x2) || (itemPtr->x2 < x1) @@ -6171,25 +6185,6 @@ Tk_PostscriptPath(interp, ((TkCanvas *) canvas)->psInfo, coordPtr, numPoints); } - -#if 0 -Tk_State -Tk_GetItemState(canvas, itemPtr) - Tk_Canvas canvas; /* Canvas containing item. */ - Tk_Item *itemPtr; /* Item to check against point. */ -{ - TkCanvas *canvasPtr = (TkCanvas *) canvas; - if (itemPtr->group != canvasPtr->activeGroup) { - return TK_STATE_HIDDEN; - } else { - Tk_State state = itemPtr->state; - if (state == TK_STATE_NULL) { - state = ((TkCanvas *)canvas)->canvas_state; - } - return state; - } -} -#endif static int CanvGroupParseProc(clientData, interp, tkwin, value, widgRec, offset) Index: pTk/mTk/generic/tkCanvas.h --- Tk800.022/pTk/mTk/generic/tkCanvas.h Sun Dec 5 17:05:17 1999 +++ Tk800.023/pTk/mTk/generic/tkCanvas.h Sat Dec 30 16:12:37 2000 @@ -235,7 +235,7 @@ Tk_TSOffset tsoffset; #ifndef USE_OLD_TAG_SEARCH TagSearchExpr *bindTagExprs; /* linked list of tag expressions used in bindings */ -#endif +#endif /* pTk additions */ Tk_Item *activeGroup; /* Which group item is active */ } TkCanvas; @@ -291,7 +291,7 @@ #define FORCE_REDRAW 8 /* - * The following definition is shared between tkCanvPs.c and tkCanvImg.c, + * The following definition is shared between tkCanvPs.c and tkCanvImg.c, * and is used in generating postscript for images and windows. */ @@ -302,17 +302,27 @@ XColor *colors; /* Pixel value -> RGB mappings */ int red_mask, green_mask, blue_mask; /* Masks and shifts for each */ int red_shift, green_shift, blue_shift; /* color band */ -} TkColormapData; +} TkColormapData; + +#define Tk_CanvasActiveGroup(canvas) ((TkCanvas *) (canvas))->activeGroup + +#define Tk_CanvasGroupHidden(canvas,itemPtr) \ + ( Tk_CanvasActiveGroup(canvas) && \ + (itemPtr)->group != Tk_CanvasActiveGroup(canvas)) || \ + ( (itemPtr)->group && \ + (itemPtr)->group != Tk_CanvasActiveGroup(canvas) && \ + (itemPtr)->group->state != TK_STATE_ACTIVE ) #define Tk_GetItemState(canvas,itemPtr) \ - ( \ - ((itemPtr)->group != ((TkCanvas *) (canvas))->activeGroup) \ +( \ + Tk_CanvasGroupHidden(canvas,itemPtr) \ ? TK_STATE_HIDDEN \ : (((itemPtr)->state == TK_STATE_NULL) \ ? ((TkCanvas *)(canvas))->canvas_state \ : (itemPtr)->state \ ) \ - ) +) + EXTERN void TkGroupRemoveItem _ANSI_ARGS_((Tk_Item *item)); Index: pTk/mTk/generic/tkCmds.c --- Tk800.022/pTk/mTk/generic/tkCmds.c Sun Dec 12 13:58:36 1999 +++ Tk800.023/pTk/mTk/generic/tkCmds.c Sat Dec 30 16:12:37 2000 @@ -1,4 +1,4 @@ -/* +/* * tkCmds.c -- * * This file contains a collection of Tk-related Tcl commands @@ -141,12 +141,12 @@ append = 1; } mask = Tk_CreateBinding(interp, winPtr->mainPtr->bindingTable, - object, argv[2], args[3], append); + object, argv[2], objv[3], append); if (mask == 0) { return TCL_ERROR; } } else if (argc == 3) { - Arg command; + Tcl_Obj *command; command = Tk_GetBinding(interp, winPtr->mainPtr->bindingTable, object, argv[2]); @@ -154,8 +154,7 @@ Tcl_ResetResult(interp); return TCL_OK; } - Tcl_ArgResult(interp,command); - Tcl_DecrRefCount(command); + Tcl_SetObjResult(interp,command); } else { Tk_GetAllBindings(interp, winPtr->mainPtr->bindingTable, object); } @@ -312,9 +311,9 @@ if (argv[2][0] == 0) { return TCL_OK; } - if (Tcl_ListObjGetElements(interp, args[2], &tagArgc, &tagArgv) != TCL_OK) { + if (Tcl_ListObjGetElements(interp, objv[2], &tagArgc, &tagArgv) != TCL_OK) { return TCL_ERROR; - } + } winPtr->numTags = tagArgc; winPtr->tagPtr = (ClientData *) ckalloc((unsigned) (tagArgc * sizeof(ClientData))); @@ -372,7 +371,7 @@ * Names starting with "." are malloced rather than Uids, so * they have to be freed. */ - + ckfree(p); } } @@ -606,7 +605,7 @@ Screen *screenPtr; int skip, width, height; double d; - + screenPtr = Tk_Screen(tkwin); skip = TkGetDisplayOf(interp, objc - 2, objv + 2, &tkwin); @@ -627,7 +626,7 @@ if (width <= 0) { width = 1; } - height = (int) (d * HeightOfScreen(screenPtr) + 0.5); + height = (int) (d * HeightOfScreen(screenPtr) + 0.5); if (height <= 0) { height = 1; } @@ -684,7 +683,7 @@ if ((c == 'v') && (strncmp(argv[1], "variable", length) == 0) && (length >= 2)) { Var variable; - if (LangSaveVar(interp,args[2],&variable,TK_CONFIG_SCALARVAR) != TCL_OK) + if (LangSaveVar(interp,objv[2],&variable,TK_CONFIG_SCALARVAR) != TCL_OK) return TCL_ERROR; if (Tcl_TraceVar(interp, variable, TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS, @@ -957,7 +956,7 @@ }; tkwin = (Tk_Window) clientData; - + if (objc < 2) { Tcl_WrongNumArgs(interp, 1, objv, "option ?arg?"); return TCL_ERROR; @@ -993,8 +992,7 @@ Tcl_ResetResult(interp); winPtr = winPtr->childList; for ( ; winPtr != NULL; winPtr = winPtr->nextPtr) { - strPtr = LangWidgetArg(interp,(Tk_Window) winPtr); - Tcl_IncrRefCount(strPtr); /* CHECK REFCNT */ + strPtr = LangWidgetObj(interp,(Tk_Window) winPtr); Tcl_ListObjAppendElement(NULL, Tcl_GetObjResult(interp), strPtr); } @@ -1057,7 +1055,7 @@ case WIN_PARENT: { Tcl_ResetResult(interp); if (winPtr->parentPtr != NULL) { - Tcl_ArgResult(interp, LangWidgetArg(interp, (Tk_Window) winPtr->parentPtr)); + Tcl_SetObjResult(interp, LangWidgetObj(interp, (Tk_Window) winPtr->parentPtr)); } break; } @@ -1170,7 +1168,7 @@ winPtr = GetToplevel(tkwin); if (winPtr != NULL) { Tcl_ResetResult(interp); - Tcl_ArgResult(interp, LangWidgetArg(interp, (Tk_Window) winPtr)); + Tcl_SetObjResult(interp, LangWidgetObj(interp, (Tk_Window) winPtr)); } break; } @@ -1253,7 +1251,7 @@ /* * Uses -displayof. */ - + case WIN_ATOM: { skip = TkGetDisplayOf(interp, objc - 2, objv + 2, &tkwin); if (skip < 0) { @@ -1273,7 +1271,7 @@ case WIN_ATOMNAME: { char *name; long id; - + skip = TkGetDisplayOf(interp, objc - 2, objv + 2, &tkwin); if (skip < 0) { return TCL_ERROR; @@ -1319,13 +1317,13 @@ tkwin = Tk_CoordsToWindow(x, y, tkwin); if (tkwin != NULL) { Tcl_ResetResult(interp); - Tcl_ArgResult(interp, LangWidgetArg(interp, tkwin)); + Tcl_SetObjResult(interp, LangWidgetObj(interp, tkwin)); } break; } case WIN_INTERPS: { int result; - + skip = TkGetDisplayOf(interp, objc - 2, objv + 2, &tkwin); if (skip < 0) { return TCL_ERROR; @@ -1372,7 +1370,7 @@ tkwin = (Tk_Window) winPtr; if (Tk_PathName(tkwin) != NULL) { Tcl_ResetResult(interp); - Tcl_ArgResult(interp, LangWidgetArg(interp,tkwin)); + Tcl_SetObjResult(interp, LangWidgetObj(interp,tkwin)); } break; } @@ -1422,7 +1420,7 @@ } case WIN_PIXELS: { int pixels; - + if (objc != 4) { Tcl_WrongNumArgs(interp, 2, objv, "window number"); return TCL_ERROR; @@ -1481,9 +1479,9 @@ } string = Tcl_GetStringFromObj(objv[2], NULL); - tkwin = Tk_NameToWindow(interp, string, tkwin); - if (tkwin == NULL) { - return TCL_ERROR; + tkwin = Tk_NameToWindow(interp, string, tkwin); + if (tkwin == NULL) { + return TCL_ERROR; } template.screen = Tk_ScreenNumber(tkwin); @@ -1561,7 +1559,7 @@ { char *string; int length; - + if (objc < 1) { return 0; } Index: pTk/mTk/generic/tkConfig.c --- Tk800.022/pTk/mTk/generic/tkConfig.c Mon Mar 13 09:51:02 2000 +++ Tk800.023/pTk/mTk/generic/tkConfig.c Sat Dec 30 16:12:37 2000 @@ -1,4 +1,4 @@ -/* +/* * tkConfig.c -- * * This file contains the Tk_ConfigureWidget procedure. @@ -43,7 +43,7 @@ char *widgRec)); static Arg FormatConfigValue _ANSI_ARGS_((Tcl_Interp *interp, Tk_Window tkwin, Tk_ConfigSpec *specPtr, - char *widgRec, + char *widgRec, Tcl_FreeProc **freeProcPtr)); /* @@ -128,7 +128,7 @@ char *arg; if (flags & TK_CONFIG_OBJS) { - arg = Tcl_GetStringFromObj(*args, NULL); + arg = Tcl_GetStringFromObj(*objv, NULL); } else { arg = *argv; } @@ -136,16 +136,16 @@ if (specPtr == NULL) { if (!(flags & TK_CONFIG_ARGV_ONLY)) { /* - * Handle generic, tkwin related create-time only options + * Handle generic, tkwin related create-time only options */ - char *string = LangString(*args); + char *string = LangString(*objv); size_t length = strlen(string); if (LangCmpOpt("-class", string, length) == 0) { - Tk_SetClass(tkwin, LangString(args[1])); + Tk_SetClass(tkwin, LangString(objv[1])); continue; } - } + } Tcl_SprintfResult(interp,"Bad option `%s'",*argv); return TCL_ERROR; } @@ -167,7 +167,7 @@ } if (DoConfig(interp, tkwin, specPtr, arg, 0, widgRec) != TCL_OK) { } #endif /* DASH PATCH */ - if (DoConfig(interp, tkwin, specPtr, args[1], widgRec) != TCL_OK) { + if (DoConfig(interp, tkwin, specPtr, objv[1], widgRec) != TCL_OK) { char msg[100]; sprintf(msg, "\n (processing \"%.40s\" option)", @@ -206,7 +206,7 @@ if (DoConfig(interp, tkwin, specPtr, value, widgRec) != TCL_OK) { char msg[200]; - + sprintf(msg, "\n (%s \"%.50s\" in widget \"%.50s\")", "database entry for", specPtr->dbName, Tk_PathName(tkwin)); @@ -227,7 +227,7 @@ sprintf(msg, "\n (%s \"%.50s\" in widget \"%.50s\")", "default value for", - (specPtr->dbName) ? specPtr->dbName : specPtr->argvName, + (specPtr->dbName) ? specPtr->dbName : specPtr->argvName, Tk_PathName(tkwin)); Tcl_AddErrorInfo(interp, msg); if (value) { @@ -339,7 +339,7 @@ argvName, "\"", (char *) NULL); return (Tk_ConfigSpec *) NULL; } - if ((specPtr->dbName == matchPtr->dbName) + if ((specPtr->dbName == matchPtr->dbName) && (specPtr->type != TK_CONFIG_SYNONYM) && ((specPtr->specFlags & needFlags) == needFlags) && !(specPtr->specFlags & hateFlags)) { @@ -408,7 +408,7 @@ return TCL_ERROR; } break; - case TK_CONFIG_OBJECT: + case TK_CONFIG_OBJECT: case TK_CONFIG_STRING: { char *old, *new; @@ -441,22 +441,22 @@ break; } case TK_CONFIG_LANGARG: { - Arg old, new; + Tcl_Obj *old, *new; if (nullValue) { new = NULL; } else { new = LangCopyArg(value); } - old = *((Arg *) ptr); + old = *((Tcl_Obj **) ptr); if (old != NULL) { LangFreeArg(old,TCL_DYNAMIC); } - *((Arg *) ptr) = new; + *((Tcl_Obj **) ptr) = new; break; } - case TK_CONFIG_SCALARVAR: - case TK_CONFIG_HASHVAR: + case TK_CONFIG_SCALARVAR: + case TK_CONFIG_HASHVAR: case TK_CONFIG_ARRAYVAR: { Var old, new; @@ -506,7 +506,7 @@ if (nullValue) { new = NULL; - } else { + } else { Arg tmp = LangCopyArg(value); new = Tk_GetFontFromObj(interp, tkwin, tmp); LangFreeArg(tmp, TCL_DYNAMIC); @@ -521,8 +521,8 @@ case TK_CONFIG_BITMAP: { Pixmap new, old; - if (nullValue || - (( specPtr->specFlags & TK_CONFIG_NULL_OK) && + if (nullValue || + (( specPtr->specFlags & TK_CONFIG_NULL_OK) && !*LangString(value))) { new = None; } else { @@ -568,8 +568,8 @@ case TK_CONFIG_ACTIVE_CURSOR: { Tk_Cursor new, old; - if (nullValue || - (( specPtr->specFlags & TK_CONFIG_NULL_OK) && + if (nullValue || + (( specPtr->specFlags & TK_CONFIG_NULL_OK) && !*LangString(value))) { new = None; } else { @@ -724,8 +724,7 @@ return TCL_ERROR; } result = FormatConfigInfo(interp, tkwin, specPtr, widgRec); - Tcl_ArgResult(interp,result); - LangFreeArg(result,TCL_DYNAMIC); + Tcl_SetObjResult(interp,result); return TCL_OK; } @@ -733,8 +732,8 @@ * Loop through all the specs, creating a big list with all * their information. */ - - result = Tcl_NewListObj(0,NULL); + + result = Tcl_NewListObj(0,NULL); for (specPtr = specs; specPtr->type != TK_CONFIG_END; specPtr++) { Arg val; @@ -750,11 +749,10 @@ continue; } val = FormatConfigInfo(interp, tkwin, specPtr, widgRec); - Tcl_ListObjAppendElement(interp,result,val); + Tcl_ListObjAppendElement(interp,result,val); } - Tcl_ArgResult(interp,result); - LangFreeArg(result,TCL_DYNAMIC); + Tcl_SetObjResult(interp,result); return TCL_OK; } @@ -797,23 +795,23 @@ args[2] = Tcl_NewStringObj(specPtr->dbClass,-1); args[3] = Tcl_NewStringObj(specPtr->defValue,-1); - args[4] = FormatConfigValue(interp, tkwin, specPtr, widgRec, + args[4] = FormatConfigValue(interp, tkwin, specPtr, widgRec, &freeProc); if (args[1] == NULL) { LangSetDefault(&args[1],""); - } - if (args[2] == NULL) { + } + if (args[2] == NULL) { LangSetDefault(&args[2],""); - } - if (args[3] == NULL) { + } + if (args[3] == NULL) { LangSetDefault(&args[3],""); - } - if (args[4] == NULL) { + } + if (args[4] == NULL) { LangSetDefault(&args[4],""); } return Tcl_NewListObj(5, args); - } + } } /* @@ -838,7 +836,7 @@ *---------------------------------------------------------------------- */ -static Arg +static Arg FormatConfigValue(interp, tkwin, specPtr, widgRec, freeProcPtr) Tcl_Interp *interp; /* Interpreter for use in real conversions. */ Tk_Window tkwin; /* Window corresponding to widget. */ @@ -873,16 +871,17 @@ LangSetString(&result,*(char **) ptr); break; case TK_CONFIG_OBJECT: - LangSetArg(&result,LangObjectArg(interp, *(char **) ptr)); + LangSetObj(&result,LangObjectObj(interp, *(char **) ptr)); break; case TK_CONFIG_CALLBACK: - LangSetArg(&result,LangCallbackArg(*(LangCallback **) ptr)); + LangSetObj(&result,LangCallbackObj(*(LangCallback **) ptr)); break; case TK_CONFIG_LANGARG: - LangSetArg(&result,*((Arg *) ptr)); + Tcl_IncrRefCount(*((Tcl_Obj **) ptr)); + LangSetObj(&result,*((Tcl_Obj **) ptr)); break; - case TK_CONFIG_SCALARVAR: - case TK_CONFIG_HASHVAR: + case TK_CONFIG_SCALARVAR: + case TK_CONFIG_HASHVAR: case TK_CONFIG_ARRAYVAR: LangSetVar(&result,*(Var *) ptr); break; @@ -903,7 +902,7 @@ case TK_CONFIG_FONT: { Tk_Font tkfont = *((Tk_Font *) ptr); if (tkfont != NULL) { - LangSetArg(&result, LangFontArg(interp, tkfont, NULL)); + LangSetObj(&result, LangFontObj(interp, tkfont, NULL)); } break; } @@ -948,10 +947,10 @@ LangSetInt(&result,*((int *) ptr)); break; case TK_CONFIG_MM: - LangSetDouble(&result, *((double *) ptr)); + LangSetDouble(&result, *((double *) ptr)); break; case TK_CONFIG_WINDOW: { - LangSetArg(&result, LangWidgetArg(interp, *((Tk_Window *) ptr))); + LangSetObj(&result, LangWidgetObj(interp, *((Tk_Window *) ptr))); break; } case TK_CONFIG_CUSTOM: @@ -959,10 +958,10 @@ specPtr->customPtr->clientData, tkwin, widgRec, specPtr->offset, freeProcPtr); break; - default: + default: LangSetString(&result,"?? unknown type ??"); } - if (!result) + if (!result) LangSetDefault(&result,""); return result; } @@ -1002,7 +1001,7 @@ { Tk_ConfigSpec *specPtr; int needFlags, hateFlags; - Arg value; + Tcl_Obj *value; Tcl_FreeProc *freeProc = NULL; needFlags = flags & ~(TK_CONFIG_USER_BIT - 1); if (Tk_Depth(tkwin) <= 1) { @@ -1017,8 +1016,7 @@ value = FormatConfigValue(interp, tkwin, specPtr, widgRec, &freeProc); - Tcl_ArgResult(interp, value); - LangFreeArg(value,freeProc); + Tcl_SetObjResult(interp, value); return TCL_OK; } @@ -1073,9 +1071,9 @@ *((Arg *) ptr) = NULL; } break; - case TK_CONFIG_SCALARVAR: - case TK_CONFIG_HASHVAR: - case TK_CONFIG_ARRAYVAR: + case TK_CONFIG_SCALARVAR: + case TK_CONFIG_HASHVAR: + case TK_CONFIG_ARRAYVAR: if (*((Var *) ptr) != NULL) { LangFreeVar(*((Var *) ptr)); *((Var *) ptr) = NULL; Index: pTk/mTk/generic/tkEntry.c --- Tk800.022/pTk/mTk/generic/tkEntry.c Sat Apr 29 14:13:17 2000 +++ Tk800.023/pTk/mTk/generic/tkEntry.c Sat Dec 30 16:12:37 2000 @@ -622,7 +622,7 @@ (char *) NULL); goto error; } - if (GetEntryIndex(interp, entryPtr, args[2], &index) != TCL_OK) { + if (GetEntryIndex(interp, entryPtr, objv[2], &index) != TCL_OK) { goto error; } if ((index == entryPtr->numChars) && (index > 0)) { @@ -662,13 +662,13 @@ (char *) NULL); goto error; } - if (GetEntryIndex(interp, entryPtr, args[2], &first) != TCL_OK) { + if (GetEntryIndex(interp, entryPtr, objv[2], &first) != TCL_OK) { goto error; } if (argc == 3) { last = first+1; } else { - if (GetEntryIndex(interp, entryPtr, args[3], &last) != TCL_OK) { + if (GetEntryIndex(interp, entryPtr, objv[3], &last) != TCL_OK) { goto error; } } @@ -690,7 +690,7 @@ (char *) NULL); goto error; } - if (GetEntryIndex(interp, entryPtr, args[2], &entryPtr->insertPos) + if (GetEntryIndex(interp, entryPtr, objv[2], &entryPtr->insertPos) != TCL_OK) { goto error; } @@ -704,7 +704,7 @@ argv[0], " index string\"", (char *) NULL); goto error; } - if (GetEntryIndex(interp, entryPtr, args[2], &index) != TCL_OK) { + if (GetEntryIndex(interp, entryPtr, objv[2], &index) != TCL_OK) { goto error; } sprintf(interp->result, "%d", index); @@ -718,7 +718,7 @@ (char *) NULL); goto error; } - if (GetEntryIndex(interp, entryPtr, args[2], &index) != TCL_OK) { + if (GetEntryIndex(interp, entryPtr, objv[2], &index) != TCL_OK) { goto error; } if (entryPtr->state == TK_STATE_NORMAL) { @@ -784,7 +784,7 @@ goto done; } if (argc >= 4) { - if (GetEntryIndex(interp, entryPtr, args[3], &index) != TCL_OK) { + if (GetEntryIndex(interp, entryPtr, objv[3], &index) != TCL_OK) { goto error; } } @@ -827,7 +827,7 @@ (char *) NULL); goto error; } - if (GetEntryIndex(interp, entryPtr, args[4], &index2) != TCL_OK) { + if (GetEntryIndex(interp, entryPtr, objv[4], &index2) != TCL_OK) { goto error; } if (index >= index2) { @@ -883,7 +883,7 @@ sprintf(interp->result, "%g %g", first, last); goto done; } else if (argc == 3) { - if (GetEntryIndex(interp, entryPtr, args[2], &index) != TCL_OK) { + if (GetEntryIndex(interp, entryPtr, objv[2], &index) != TCL_OK) { goto error; } } else { Index: pTk/mTk/generic/tkFocus.c --- Tk800.022/pTk/mTk/generic/tkFocus.c Fri Nov 19 21:24:21 1999 +++ Tk800.023/pTk/mTk/generic/tkFocus.c Sat Dec 30 16:12:37 2000 @@ -1,4 +1,4 @@ -/* +/* * tkFocus.c -- * * This file contains procedures that manage the input @@ -121,12 +121,12 @@ */ int -Tk_FocusObjCmd(clientData, interp, argc, argv) +Tk_FocusObjCmd(clientData, interp, argc, objv) ClientData clientData; /* Main window associated with * interpreter. */ Tcl_Interp *interp; /* Current interpreter. */ int argc; /* Number of arguments. */ - Tcl_Obj *CONST args[]; /* Argument objects. */ + Tcl_Obj *CONST objv[]; /* Argument objects. */ { static char *focusOptions[] = {"-displayof", "-force", "-lastfor", (char *) NULL}; @@ -155,7 +155,7 @@ */ if (argc == 2) { - windowName = Tcl_GetStringFromObj(args[1], (int *) NULL); + windowName = Tcl_GetStringFromObj(objv[1], (int *) NULL); if (windowName[0] == 0) { return TCL_OK; } @@ -171,17 +171,17 @@ } } - if (Tcl_GetIndexFromObj(interp, args[1], focusOptions, "option", 0, + if (Tcl_GetIndexFromObj(interp, objv[1], focusOptions, "option", 0, &index) != TCL_OK) { return TCL_ERROR; } if (argc != 3) { - Tcl_WrongNumArgs(interp, 2, args, "window"); + Tcl_WrongNumArgs(interp, 2, objv, "window"); return TCL_ERROR; } switch (index) { case 0: { /* -displayof */ - windowName = Tcl_GetStringFromObj(args[2], (int *) NULL); + windowName = Tcl_GetStringFromObj(objv[2], (int *) NULL); newPtr = (TkWindow *) Tk_NameToWindow(interp, windowName, tkwin); if (newPtr == NULL) { return TCL_ERROR; @@ -193,7 +193,7 @@ break; } case 1: { /* -force */ - windowName = Tcl_GetStringFromObj(args[2], (int *) NULL); + windowName = Tcl_GetStringFromObj(objv[2], (int *) NULL); if (windowName[0] == 0) { return TCL_OK; } @@ -205,7 +205,7 @@ break; } case 2: { /* -lastfor */ - windowName = Tcl_GetStringFromObj(args[2], (int *) NULL); + windowName = Tcl_GetStringFromObj(objv[2], (int *) NULL); newPtr = (TkWindow *) Tk_NameToWindow(interp, windowName, tkwin); if (newPtr == NULL) { return TCL_ERROR; @@ -263,8 +263,8 @@ * Design notes: the window manager and X server work together to * transfer the focus among top-level windows. This procedure takes * care of transferring the focus from a top-level or wrapper window - * to the actual window within that top-level that has the focus. - * We do this by synthesizing X events to move the focus around. + * to the actual window within that top-level that has the focus. + * We do this by synthesizing X events to move the focus around. * None of the FocusIn and FocusOut events generated by X are ever * used outside of this procedure; only the synthesized events get * through to the rest of the application. At one point (e.g. @@ -502,7 +502,7 @@ * command was used to redirect the focus after it arrived at * dispPtr->implicitWinPtr)!! In addition, we generate events * because the window manager won't give us a FocusOut event when - * we focus on the root. + * we focus on the root. */ if ((dispPtr->implicitWinPtr != NULL) Index: pTk/mTk/generic/tkFont.c --- Tk800.022/pTk/mTk/generic/tkFont.c Fri Nov 19 12:42:07 1999 +++ Tk800.023/pTk/mTk/generic/tkFont.c Sat Dec 30 16:12:37 2000 @@ -1,4 +1,4 @@ -/* +/* * tkFont.c -- * * This file maintains a database of fonts for the Tk toolkit. @@ -22,7 +22,7 @@ * exist in the current application. It must be stored in the * TkMainInfo for the application. */ - + typedef struct TkFontInfo { Tcl_HashTable fontCache; /* Map a string to an existing Tk_Font. * Keys are CachedFontKey structs, values are @@ -56,7 +56,7 @@ * last reference goes away. */ TkFontAttributes fa; /* Desired attributes for named font. */ } NamedFont; - + /* * The following two structures are used to keep track of string * measurement information when using the text layout facilities. @@ -161,7 +161,7 @@ {TK_FW_BOLD, "demi"}, {TK_FW_BOLD, "demibold"}, {TK_FW_NORMAL, NULL} /* Assume anything else is "normal". */ -}; +}; static TkStateMap xlfdSlantMap[] = { {TK_FS_ROMAN, "r"}, @@ -184,9 +184,9 @@ {TK_CS_SYMBOL, "sun"}, {TK_CS_OTHER, NULL} }; - + /* - * The following structure and defines specify the valid builtin options + * The following structure and defines specify the valid builtin options * when configuring a set of font attributes. */ @@ -316,7 +316,7 @@ /* *--------------------------------------------------------------------------- * - * Tk_FontObjCmd -- + * Tk_FontObjCmd -- * * This procedure is implemented to process the "font" Tcl command. * See the user documentation for details on what it does. @@ -467,7 +467,7 @@ if (TkCreateNamedFont(interp, tkwin, name, &fa) != TCL_OK) { return TCL_ERROR; } - Tcl_ArgResult(interp, LangFontArg( interp, NULL, name)); + Tcl_SetObjResult(interp, LangFontObj( interp, NULL, name)); break; } case FONT_DELETE: { @@ -521,7 +521,7 @@ char *string; Tk_Font tkfont; int length, skip; - + skip = TkGetDisplayOf(interp, objc - 3, objv + 3, &tkwin); if (skip < 0) { return TCL_ERROR; @@ -565,7 +565,7 @@ objc -= skip; objv += skip; fmPtr = GetFontMetrics(tkfont); - if (objc == 3) { + if (objc == 3) { Tcl_AppendElement(interp, "-ascent"); Tcl_IntResults(interp, 1, 1, fmPtr->ascent); Tcl_AppendElement(interp, "-descent"); @@ -599,7 +599,7 @@ NamedFont *nfPtr; Tcl_HashSearch search; Tcl_HashEntry *namedHashPtr; - + if (objc != 2) { Tcl_WrongNumArgs(interp, 1, objv, "names"); return TCL_ERROR; @@ -609,7 +609,8 @@ nfPtr = (NamedFont *) Tcl_GetHashValue(namedHashPtr); if (nfPtr->deletePending == 0) { string = Tcl_GetHashKey(&fiPtr->namedTable, namedHashPtr); - Tcl_AppendArg(interp, LangFontArg(interp, NULL, string)); + Tcl_ListObjAppendElement(interp, Tcl_GetObjResult(interp), + LangFontObj(interp, NULL, string)); } namedHashPtr = Tcl_NextHashEntry(&search); } @@ -705,7 +706,7 @@ * TkCreateNamedFont -- * * Create the specified named font with the given attributes in the - * named font table associated with the interp. + * named font table associated with the interp. * * Results: * Returns TCL_OK if the font was successfully created, or TCL_ERROR @@ -733,13 +734,13 @@ TkFontInfo *fiPtr; Tcl_HashEntry *namedHashPtr; int new; - NamedFont *nfPtr; + NamedFont *nfPtr; fiPtr = ((TkWindow *) tkwin)->mainPtr->fontInfoPtr; name = Tk_GetUid(name); namedHashPtr = Tcl_CreateHashEntry(&fiPtr->namedTable, name, &new); - + if (new == 0) { nfPtr = (NamedFont *) Tcl_GetHashValue(namedHashPtr); if (nfPtr->deletePending == 0) { @@ -772,7 +773,7 @@ /* *--------------------------------------------------------------------------- * - * Tk_GetFont -- + * Tk_GetFont -- * * Given a string description of a font, map the description to a * corresponding Tk_Font that represents the font. @@ -800,9 +801,9 @@ { Tcl_Obj *strPtr; Tk_Font tkfont; - + strPtr = Tcl_NewStringObj((char *) string, -1); - + tkfont = Tk_GetFontFromObj(interp, tkwin, strPtr); if (tkfont == NULL) { Tcl_SetResult(interp, @@ -817,7 +818,7 @@ /* *--------------------------------------------------------------------------- * - * Tk_GetFontFromObj -- + * Tk_GetFontFromObj -- * * Given a string description of a font, map the description to a * corresponding Tk_Font that represents the font. @@ -850,7 +851,7 @@ int new, descent; NamedFont *nfPtr; char *string; - + fiPtr = ((TkWindow *) tkwin)->mainPtr->fontInfoPtr; string = Tcl_GetStringFromObj(objPtr, NULL); @@ -866,7 +867,7 @@ fontPtr = (TkFont *) Tcl_GetHashValue(cacheHashPtr); if (fontPtr != NULL) { - fontPtr->refCount++; + fontPtr->refCount++; } return (Tk_Font) fontPtr; } @@ -902,7 +903,7 @@ fontPtr = TkpGetFontFromAttributes(NULL, tkwin, &fa); } - } + } Tcl_SetHashValue(cacheHashPtr, fontPtr); fontPtr->refCount = 1; @@ -928,7 +929,7 @@ * Get information used for drawing underlines in generic code on a * non-underlined font. */ - + descent = fontPtr->fm.descent; fontPtr->underlinePos = descent / 2; fontPtr->underlineHeight = fontPtr->fa.pointsize / 10; @@ -948,7 +949,7 @@ fontPtr->underlineHeight = 1; } } - + return (Tk_Font) fontPtr; } @@ -983,13 +984,13 @@ hPtr = fontPtr->cacheHashPtr; keyPtr = (CachedFontKey *) Tcl_GetHashKey(hPtr->tablePtr, hPtr); - return (char *) keyPtr->string; + return (char *) keyPtr->string; } /* *--------------------------------------------------------------------------- * - * Tk_FreeFont -- + * Tk_FreeFont -- * * Called to release a font allocated by Tk_GetFont(). * @@ -1249,7 +1250,7 @@ */ if ((slantString == NULL) && (weightString == NULL)) { - if ((strcmp(family, "Times") == 0) + if ((strcmp(family, "Times") == 0) || (strcmp(family, "NewCenturySchlbk") == 0) || (strcmp(family, "Palatino") == 0)) { Tcl_DStringAppend(dsPtr, "-Roman", -1); @@ -1312,7 +1313,7 @@ * underline. This procedure would mainly be used to quickly * underline a few characters without having to construct an * underlined font. To produce properly underlined text, the - * appropriate underlined font should be constructed and used. + * appropriate underlined font should be constructed and used. * * Results: * None. @@ -1344,7 +1345,7 @@ int startX, endX; fontPtr = (TkFont *) tkfont; - + Tk_MeasureChars(tkfont, string, firstChar, 0, 0, &startX); Tk_MeasureChars(tkfont, string, lastChar, 0, 0, &endX); @@ -1380,7 +1381,7 @@ * are stored in *widthPtr and *heightPtr. * * Side effects: - * Memory is allocated to hold the measurement information. + * Memory is allocated to hold the measurement information. * *--------------------------------------------------------------------------- */ @@ -1419,7 +1420,7 @@ lineLengths = staticLineLengths; maxLines = MAX_LINES; - + fontPtr = (TkFont *) tkfont; if ((fontPtr == NULL) || (string == NULL)) { if (widthPtr != NULL) { @@ -1460,7 +1461,7 @@ special = string; flags &= TK_IGNORE_TABS | TK_IGNORE_NEWLINES; - flags |= TK_WHOLE_WORDS | TK_AT_LEAST_ONE; + flags |= TK_WHOLE_WORDS | TK_AT_LEAST_ONE; curLine = 0; for (start = string; start < end; ) { if (start >= special) { @@ -1535,7 +1536,7 @@ /* * No more characters are going to go on this line, either because * no more characters can fit or there are no more characters left. - * Consume all extra spaces at end of line. + * Consume all extra spaces at end of line. */ while ((start < end) && isspace(UCHAR(*start))) { @@ -1565,7 +1566,7 @@ } } - wrapLine: + wrapLine: flags |= TK_AT_LEAST_ONE; /* @@ -1584,7 +1585,7 @@ if (curLine >= maxLines) { int *newLengths; - + newLengths = (int *) ckalloc(2 * maxLines * sizeof(int)); memcpy((void *) newLengths, lineLengths, maxLines * sizeof(int)); if (lineLengths != staticLineLengths) { @@ -1613,13 +1614,13 @@ chunkPtr->numDisplayChars = -1; baseline += height; } - } + } /* * Using maximum line length, shift all the chunks so that the lines are * all justified correctly. */ - + curLine = 0; chunkPtr = layoutPtr->chunks; y = chunkPtr->y; @@ -1823,7 +1824,7 @@ layoutPtr = (TextLayout *) layout; fontPtr = (TkFont *) layoutPtr->tkfont; - XFillRectangle(display, drawable, gc, x + xx, + XFillRectangle(display, drawable, gc, x + xx, y + yy + fontPtr->fm.ascent + fontPtr->underlinePos, (unsigned int) width, (unsigned int) fontPtr->underlineHeight); } @@ -1972,7 +1973,7 @@ * Tk_CharBbox -- * * Use the information in the Tk_TextLayout token to return the - * bounding box for the character specified by index. + * bounding box for the character specified by index. * * The width of the bounding box is the advance width of the * character, and does not include and left- or right-bearing. @@ -1989,7 +1990,7 @@ * * A text layout that contains no characters is considered to * contain a single zero-width placeholder character. - * + * * Results: * The return value is 0 if the index did not specify a character * in the text layout, or non-zero otherwise. In that case, @@ -2131,7 +2132,7 @@ fontPtr = (TkFont *) layoutPtr->tkfont; ascent = fontPtr->fm.ascent; descent = fontPtr->fm.descent; - + minDist = 0; chunkPtr = layoutPtr->chunks; for (i = 0; i < layoutPtr->numChunks; i++) { @@ -2222,7 +2223,7 @@ * detected, return immediately; otherwise wait until all chunks have * been processed and see if they were all inside or all outside. */ - + layoutPtr = (TextLayout *) layout; chunkPtr = layoutPtr->chunks; fontPtr = (TkFont *) layoutPtr->tkfont; @@ -2366,7 +2367,7 @@ * If there are a whole bunch of returns or tabs in a row, * then buf[] could get filled up. */ - + buf[used] = '\0'; Tcl_AppendResult(interp, buf, (char *) NULL); used = 0; @@ -2444,7 +2445,7 @@ int i, n, index; Tcl_Obj *value; char *option, *string; - + if (objc & 1) { string = Tcl_GetStringFromObj(objv[objc - 1], NULL); Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), "missing value for \"", @@ -2482,7 +2483,7 @@ faPtr->weight = n; break; - case FONT_SLANT: + case FONT_SLANT: string = Tcl_GetStringFromObj(value, NULL); n = TkFindStateNum(interp, option, slantMap, string); if (n == TK_FS_UNKNOWN) { @@ -2649,14 +2650,14 @@ Tcl_Obj **objv; TkXLFDAttributes xa; char *string; - + string = Tcl_GetStringFromObj(objPtr, NULL); if (*string == '-') { /* * This may be an XLFD or an "-option value" string. * * If the string begins with "-*" or a "-foundry-family-*" pattern, - * then consider it an XLFD. + * then consider it an XLFD. */ if (string[1] == '*') { @@ -2673,7 +2674,7 @@ return ConfigAttributesObj(interp, tkwin, objc, objv, faPtr); } - + if (*string == '*') { /* * This appears to be an XLFD. @@ -2762,7 +2763,7 @@ * Results: * Return value is TCL_ERROR if string was not a fully specified XLFD. * Otherwise, fills font attribute buffer with the values parsed - * from the XLFD and returns TCL_OK. + * from the XLFD and returns TCL_OK. * * Side effects: * None. @@ -2782,7 +2783,7 @@ int i, j; char *field[XLFD_NUMFIELDS + 2]; Tcl_DString ds; - + memset(field, '\0', sizeof(field)); str = string; @@ -2810,7 +2811,7 @@ } /* - * An XLFD of the form -adobe-times-medium-r-*-12-*-* is pretty common, + * An XLFD of the form -adobe-times-medium-r-*-12-*-* is pretty common, * but it is (strictly) malformed, because the first * is eliding both * the Setwidth and the Addstyle fields. If the Addstyle field is a * number, then assume the above incorrect form was used and shift all @@ -2901,7 +2902,7 @@ * * [ N1 N2 N3 N4 ] * - * where N1 is the pixel size, and where N2, N3, and N4 + * where N1 is the pixel size, and where N2, N3, and N4 * are some additional numbers that I don't know * the purpose of, so I ignore them. */ @@ -3005,7 +3006,7 @@ LayoutChunk *chunkPtr; int maxChunks; size_t s; - + layoutPtr = *layoutPtrPtr; maxChunks = *maxPtr; if (layoutPtr->numChunks == maxChunks) { Index: pTk/mTk/generic/tkFrame.c --- Tk800.022/pTk/mTk/generic/tkFrame.c Sat Apr 29 14:14:36 2000 +++ Tk800.023/pTk/mTk/generic/tkFrame.c Sat Dec 30 16:12:37 2000 @@ -327,10 +327,10 @@ screenName = argv[i+1]; } else if ((c == 'u') && toplevel && (strncmp(arg, "-use", strlen(arg)) == 0)) { - useOption = args[i+1]; + useOption = objv[i+1]; } else if ((c == 'v') && (strncmp(arg, "-visual", strlen(arg)) == 0)) { - visualName = args[i+1]; + visualName = objv[i+1]; } } Index: pTk/mTk/generic/tkGrid.c --- Tk800.022/pTk/mTk/generic/tkGrid.c Sat Mar 25 11:06:06 2000 +++ Tk800.023/pTk/mTk/generic/tkGrid.c Sat Dec 30 16:12:37 2000 @@ -477,7 +477,8 @@ } Tcl_AppendElement(interp, "-in"); - Tcl_AppendArg(interp, LangWidgetArg(interp, slavePtr->masterPtr->tkwin)); + Tcl_ListObjAppendElement(interp,Tcl_GetObjResult(interp), + LangWidgetObj(interp, slavePtr->masterPtr->tkwin)); Tcl_AppendElement(interp, "-column"); Tcl_IntResults(interp, 1, 1, slavePtr->column); Tcl_AppendElement(interp, "-row"); @@ -685,7 +686,8 @@ slavePtr->row+slavePtr->numRows-1 < row)) { continue; } - Tcl_AppendArg(interp, LangWidgetArg(interp, slavePtr->tkwin)); + Tcl_ListObjAppendElement(interp, Tcl_GetObjResult(interp), + LangWidgetObj(interp, slavePtr->tkwin)); } /* @@ -726,7 +728,7 @@ return TCL_ERROR; } - if (Tcl_ListObjGetElements(interp, args[3], &argcPtr, &argsPtr) != TCL_OK) { + if (Tcl_ListObjGetElements(interp, objv[3], &argcPtr, &argsPtr) != TCL_OK) { return TCL_ERROR; } Index: pTk/mTk/generic/tkImage.c --- Tk800.022/pTk/mTk/generic/tkImage.c Sat Mar 11 17:17:05 2000 +++ Tk800.023/pTk/mTk/generic/tkImage.c Sat Dec 30 16:12:37 2000 @@ -327,7 +327,7 @@ masterPtr->height); } } - Tcl_ArgResult(interp, LangObjectArg( interp, Tcl_GetHashKey(&winPtr->mainPtr->imageTable, hPtr))); + Tcl_SetObjResult(interp, LangObjectObj( interp, Tcl_GetHashKey(&winPtr->mainPtr->imageTable, hPtr))); } else if ((c == 'd') && (strncmp(strv[1], "delete", length) == 0)) { for (i = 2; i < argc; i++) { hPtr = Tcl_FindHashEntry(&winPtr->mainPtr->imageTable, strv[i]); @@ -361,7 +361,8 @@ } for (hPtr = Tcl_FirstHashEntry(&winPtr->mainPtr->imageTable, &search); hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) { - Tcl_AppendArg(interp, LangObjectArg(interp,Tcl_GetHashKey(&winPtr->mainPtr->imageTable, hPtr))); + Tcl_ListObjAppendElement(interp, Tcl_GetObjResult(interp), + LangObjectObj(interp,Tcl_GetHashKey(&winPtr->mainPtr->imageTable, hPtr))); } } else if ((c == 't') && (strcmp(strv[1], "type") == 0)) { if (argc != 3) { Index: pTk/mTk/generic/tkListbox.c --- Tk800.022/pTk/mTk/generic/tkListbox.c Sat Nov 20 19:33:34 1999 +++ Tk800.023/pTk/mTk/generic/tkListbox.c Sat Dec 30 16:12:37 2000 @@ -1,4 +1,4 @@ -/* +/* * tkListbox.c -- * * This module implements listbox widgets for the Tk @@ -516,7 +516,7 @@ goto error; } ListboxRedrawRange(listPtr, listPtr->active, listPtr->active); - if (GetListboxIndex(interp, listPtr, args[2], 0, &index) != TCL_OK) { + if (GetListboxIndex(interp, listPtr, objv[2], 0, &index) != TCL_OK) { goto error; } if (index >= listPtr->numElements) { @@ -536,7 +536,7 @@ argv[0], " bbox index\"", (char *) NULL); goto error; } - if (GetListboxIndex(interp, listPtr, args[2], 0, &index) != TCL_OK) { + if (GetListboxIndex(interp, listPtr, objv[2], 0, &index) != TCL_OK) { goto error; } if ((index >= listPtr->numElements) || (index < 0)) { @@ -611,14 +611,14 @@ (char *) NULL); goto error; } - if (GetListboxIndex(interp, listPtr, args[2], 0, &first) != TCL_OK) { + if (GetListboxIndex(interp, listPtr, objv[2], 0, &first) != TCL_OK) { goto error; } if (first < listPtr->numElements) { if (argc == 3) { last = first; } else { - if (GetListboxIndex(interp, listPtr, args[3], 0, + if (GetListboxIndex(interp, listPtr, objv[3], 0, &last) != TCL_OK) { goto error; } @@ -637,10 +637,10 @@ argv[0], " get first ?last?\"", (char *) NULL); goto error; } - if (GetListboxIndex(interp, listPtr, args[2], 0, &first) != TCL_OK) { + if (GetListboxIndex(interp, listPtr, objv[2], 0, &first) != TCL_OK) { goto error; } - if ((argc == 4) && (GetListboxIndex(interp, listPtr, args[3], + if ((argc == 4) && (GetListboxIndex(interp, listPtr, objv[3], 0, &last) != TCL_OK)) { goto error; } @@ -676,7 +676,7 @@ (char *) NULL); goto error; } - if (GetListboxIndex(interp, listPtr, args[2], 1, &index) + if (GetListboxIndex(interp, listPtr, objv[2], 1, &index) != TCL_OK) { goto error; } @@ -691,7 +691,7 @@ (char *) NULL); goto error; } - if (GetListboxIndex(interp, listPtr, args[2], 1, &index) + if (GetListboxIndex(interp, listPtr, objv[2], 1, &index) != TCL_OK) { goto error; } @@ -748,7 +748,7 @@ (char *) NULL); goto error; } - if (GetListboxIndex(interp, listPtr, args[2], 0, &index) != TCL_OK) { + if (GetListboxIndex(interp, listPtr, objv[2], 0, &index) != TCL_OK) { goto error; } if (index >= listPtr->numElements) { @@ -785,11 +785,11 @@ (char *) NULL); goto error; } - if (GetListboxIndex(interp, listPtr, args[3], 0, &first) != TCL_OK) { + if (GetListboxIndex(interp, listPtr, objv[3], 0, &first) != TCL_OK) { goto error; } if (argc == 5) { - if (GetListboxIndex(interp, listPtr, args[4], 0, &last) != TCL_OK) { + if (GetListboxIndex(interp, listPtr, objv[4], 0, &last) != TCL_OK) { goto error; } } else { @@ -815,7 +815,7 @@ } else if ((c == 'i') && (strncmp(argv[2], "includes", length) == 0)) { int i; Element *elPtr; - + if (argc != 4) { Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], " selection includes index\"", (char *) NULL); @@ -916,7 +916,7 @@ } sprintf(interp->result, "%g %g", fraction, fraction2); } else if (argc == 3) { - if (GetListboxIndex(interp, listPtr, args[2], 0, &index) + if (GetListboxIndex(interp, listPtr, objv[2], 0, &index) != TCL_OK) { goto error; } @@ -1119,7 +1119,7 @@ * *--------------------------------------------------------------------------- */ - + static void ListboxWorldChanged(instanceData) ClientData instanceData; /* Information about widget. */ @@ -1290,7 +1290,7 @@ continue; } x = listPtr->inset; - y = ((i - listPtr->topIndex) * listPtr->lineHeight) + y = ((i - listPtr->topIndex) * listPtr->lineHeight) + listPtr->inset; gc = listPtr->textGC; if (elPtr->selected) { Index: pTk/mTk/generic/tkMenu.c --- Tk800.022/pTk/mTk/generic/tkMenu.c Sat Apr 29 14:15:51 2000 +++ Tk800.023/pTk/mTk/generic/tkMenu.c Sat Dec 30 16:12:37 2000 @@ -513,12 +513,13 @@ && ((cascadeListPtr->menuPtr->masterMenuPtr == cascadeListPtr->menuPtr)))) { newArgv[0] = Tcl_NewStringObj("-menu",-1); - newArgv[1] = LangWidgetArg(interp,menuPtr->tkwin); + newArgv[1] = LangWidgetObj(interp,menuPtr->tkwin); ConfigureMenuEntry(cascadeListPtr, 2, newArgv, TK_CONFIG_ARGV_ONLY); Tcl_DecrRefCount(newArgv[0]); + Tcl_DecrRefCount(newArgv[1]); } else { - newMenuName = LangWidgetArg(menuPtr->interp, cascadeListPtr->menuPtr->tkwin); + newMenuName = LangWidgetObj(menuPtr->interp, cascadeListPtr->menuPtr->tkwin); CloneMenu(menuPtr, &newMenuName, "normal"); /* @@ -547,6 +548,7 @@ TkMenuTopLevelList *topLevelListPtr = menuRefPtr->topLevelListPtr; TkMenuTopLevelList *nextPtr; Tk_Window listtkwin; + Tcl_Obj *menuObj; while (topLevelListPtr != NULL) { /* @@ -557,9 +559,9 @@ nextPtr = topLevelListPtr->nextPtr; listtkwin = topLevelListPtr->tkwin; - TkSetWindowMenuBar(menuPtr->interp, listtkwin, - LangWidgetArg(menuPtr->interp,menuPtr->tkwin), - LangWidgetArg(menuPtr->interp,menuPtr->tkwin)); + menuObj = LangWidgetObj(menuPtr->interp,menuPtr->tkwin); + TkSetWindowMenuBar(menuPtr->interp, listtkwin, menuObj, menuObj); + Tcl_DecrRefCount(menuObj); topLevelListPtr = nextPtr; } } @@ -623,7 +625,7 @@ argv[0], " activate index\"", (char *) NULL); goto error; } - if (TkGetMenuIndex(interp, menuPtr, args[2], 0, &index) != TCL_OK) { + if (TkGetMenuIndex(interp, menuPtr, objv[2], 0, &index) != TCL_OK) { goto error; } if (menuPtr->active == index) { @@ -665,10 +667,10 @@ (char *) NULL); goto error; } - result = CloneMenu(menuPtr, &args[2], (argc == 3) ? NULL : argv[3]); + Tcl_IncrRefCount(objv[2]); + result = CloneMenu(menuPtr, &objv[2], (argc == 3) ? NULL : argv[3]); if (result == TCL_OK) { - Tcl_ArgResult(interp, args[2]); - LangFreeArg(args[2], TCL_DYNAMIC); + Tcl_SetObjResult(interp, objv[2]); } } else if ((c == 'c') && (strncmp(argv[1], "configure", length) == 0) && (length >= 2)) { @@ -690,13 +692,13 @@ argv[0], " delete first ?last?\"", (char *) NULL); goto error; } - if (TkGetMenuIndex(interp, menuPtr, args[2], 0, &first) != TCL_OK) { + if (TkGetMenuIndex(interp, menuPtr, objv[2], 0, &first) != TCL_OK) { goto error; } if (argc == 3) { last = first; } else { - if (TkGetMenuIndex(interp, menuPtr, args[3], 0, &last) != TCL_OK) { + if (TkGetMenuIndex(interp, menuPtr, objv[3], 0, &last) != TCL_OK) { goto error; } } @@ -723,7 +725,7 @@ (char *) NULL); goto error; } - if (TkGetMenuIndex(interp, menuPtr, args[2], 0, &index) != TCL_OK) { + if (TkGetMenuIndex(interp, menuPtr, objv[2], 0, &index) != TCL_OK) { goto error; } if (index < 0) { @@ -745,7 +747,7 @@ (char *) NULL); goto error; } - if (TkGetMenuIndex(interp, menuPtr, args[2], 0, &index) != TCL_OK) { + if (TkGetMenuIndex(interp, menuPtr, objv[2], 0, &index) != TCL_OK) { goto error; } if (index < 0) { @@ -776,7 +778,7 @@ argv[0], " index string\"", (char *) NULL); goto error; } - if (TkGetMenuIndex(interp, menuPtr, args[2], 0, &index) != TCL_OK) { + if (TkGetMenuIndex(interp, menuPtr, objv[2], 0, &index) != TCL_OK) { goto error; } if (index < 0) { @@ -791,7 +793,7 @@ argv[0], " insert index type ?options?\"", (char *) NULL); goto error; } - if (MenuAddOrInsert(interp, menuPtr, args[2], + if (MenuAddOrInsert(interp, menuPtr, objv[2], argc-3, argv+3) != TCL_OK) { goto error; } @@ -804,7 +806,7 @@ argv[0], " invoke index\"", (char *) NULL); goto error; } - if (TkGetMenuIndex(interp, menuPtr, args[2], 0, &index) != TCL_OK) { + if (TkGetMenuIndex(interp, menuPtr, objv[2], 0, &index) != TCL_OK) { goto error; } if (index < 0) { @@ -845,7 +847,7 @@ argv[0], " postcascade index\"", (char *) NULL); goto error; } - if (TkGetMenuIndex(interp, menuPtr, args[2], 0, &index) != TCL_OK) { + if (TkGetMenuIndex(interp, menuPtr, objv[2], 0, &index) != TCL_OK) { goto error; } if ((index < 0) || (menuPtr->entries[index]->type != CASCADE_ENTRY)) { @@ -860,7 +862,7 @@ argv[0], " type index\"", (char *) NULL); goto error; } - if (TkGetMenuIndex(interp, menuPtr, args[2], 0, &index) != TCL_OK) { + if (TkGetMenuIndex(interp, menuPtr, objv[2], 0, &index) != TCL_OK) { goto error; } if (index < 0) { @@ -901,7 +903,7 @@ argv[0], " yposition index\"", (char *) NULL); goto error; } - result = MenuDoYPosition(interp, menuPtr, args[2]); + result = MenuDoYPosition(interp, menuPtr, objv[2]); } else { Tcl_AppendResult(interp, "bad option \"", argv[1], "\": must be activate, add, cget, clone, configure, delete, ", @@ -947,6 +949,7 @@ { int result = TCL_OK; TkMenuEntry *mePtr; + Tcl_Obj *obj = NULL; if (index < 0) { goto done; @@ -957,8 +960,9 @@ } Tcl_Preserve((ClientData) mePtr); if (mePtr->type == TEAROFF_ENTRY) { - result = LangMethodCall(interp, LangWidgetArg(interp,menuPtr->tkwin), - "tearOffMenu", 0, 0); + obj = LangWidgetObj(interp,menuPtr->tkwin); + result = LangMethodCall(interp, obj, "tearOffMenu", 0, 0); + Tcl_DecrRefCount(obj); } else if (mePtr->type == CHECK_BUTTON_ENTRY) { if (mePtr->entryFlags & ENTRY_SELECTED) { if (Tcl_SetVarArg(interp, mePtr->variable, mePtr->offValue, @@ -1773,7 +1777,7 @@ Arg newArgV[2]; Arg newCloneName; - newCloneName = LangWidgetArg(menuPtr->interp, menuListPtr->tkwin); + newCloneName = LangWidgetObj(menuPtr->interp, menuListPtr->tkwin); CloneMenu(cascadeMenuRefPtr->menuPtr, &newCloneName, "normal"); @@ -2146,7 +2150,7 @@ Arg newArgv[2]; TkMenuReferences *menuRefPtr; - newCascadeName = LangWidgetArg(menuListPtr->interp, menuListPtr->tkwin); + newCascadeName = LangWidgetObj(menuListPtr->interp, menuListPtr->tkwin); CloneMenu(cascadeMenuPtr, &newCascadeName, "normal"); menuRefPtr = TkFindMenuReferences(menuListPtr->interp, @@ -2388,8 +2392,8 @@ Tcl_ListObjAppendElement(menuPtr->interp, commandObjPtr, Tcl_NewStringObj("MenuDup", -1)); Tcl_ListObjAppendElement(menuPtr->interp, commandObjPtr, - LangCopyArg(LangWidgetArg(menuPtr->interp, menuPtr->tkwin))); - Tcl_ListObjAppendElement(menuPtr->interp, commandObjPtr, LangCopyArg(*widget)); + LangWidgetObj(menuPtr->interp, menuPtr->tkwin)); + Tcl_ListObjAppendElement(menuPtr->interp, commandObjPtr, *widget); Tcl_ListObjAppendElement(menuPtr->interp, commandObjPtr, Tcl_NewStringObj(newMenuTypeString, -1)); Tcl_Preserve((ClientData) menuPtr); @@ -2485,6 +2489,7 @@ oldCascadePtr = cascadeRefPtr->menuPtr; newCascadeName = newMenuName; + Tcl_IncrRefCount(newCascadeName); CloneMenu(oldCascadePtr, &newCascadeName, NULL); newArgv[0] = Tcl_NewStringObj("-menu",-1); @@ -2843,7 +2848,7 @@ * Clone the menu and all of the cascades underneath it. */ - cloneMenuName = LangWidgetArg(interp, tkwin); + cloneMenuName = LangWidgetObj(interp, tkwin); CloneMenu(menuPtr, &cloneMenuName, "menubar"); cloneMenuRefPtr = TkFindMenuReferences(interp, LangString(cloneMenuName)); if ((cloneMenuRefPtr != NULL) Index: pTk/mTk/generic/tkPack.c --- Tk800.022/pTk/mTk/generic/tkPack.c Sun Dec 12 13:58:37 1999 +++ Tk800.023/pTk/mTk/generic/tkPack.c Sat Dec 30 16:12:37 2000 @@ -1,4 +1,4 @@ -/* +/* * tkPack.c -- * * This file contains code to implement the "packer" @@ -301,7 +301,8 @@ return TCL_ERROR; } Tcl_AppendElement(interp, "-in"); - Tcl_AppendArg(interp, LangWidgetArg(interp,slavePtr->masterPtr->tkwin)); + Tcl_ListObjAppendElement(interp,Tcl_GetObjResult(interp), + LangWidgetObj(interp,slavePtr->masterPtr->tkwin)); Tcl_AppendElement(interp, "-anchor"); Tcl_AppendElement(interp, Tk_NameOfAnchor(slavePtr->anchor)); Tcl_AppendElement(interp, "-expand"); @@ -391,7 +392,8 @@ masterPtr = GetPacker(master); for (slavePtr = masterPtr->slavePtr; slavePtr != NULL; slavePtr = slavePtr->nextPtr) { - Tcl_AppendArg(interp, LangWidgetArg(interp,slavePtr->tkwin)); + Tcl_ListObjAppendElement(interp,Tcl_GetObjResult(interp), + LangWidgetObj(interp,slavePtr->tkwin)); } } else if ((c == 'u') && (strncmp(argv[1], "unpack", length) == 0)) { Tk_Window tkwin2; @@ -553,7 +555,7 @@ /* * Abort any nested call to ArrangePacking for this window, since * we'll do everything necessary here, and set up so this call - * can be aborted if necessary. + * can be aborted if necessary. */ if (masterPtr->abortPtr != NULL) { @@ -1083,7 +1085,7 @@ * Process options for this window. */ - if (Tcl_ListObjGetElements(interp, args[1], &optionCount, &options) != TCL_OK) { + if (Tcl_ListObjGetElements(interp, objv[1], &optionCount, &options) != TCL_OK) { return TCL_ERROR; } packPtr->side = TOP; @@ -1480,7 +1482,7 @@ } for (i = numWindows; i < argc; i+=2) { - string = argv[i]; + string = argv[i]; if ((i+2) > argc) { Tcl_AppendResult(interp, "extra option \"", string, "\" (option with no value?)", (char *) NULL); @@ -1651,13 +1653,13 @@ masterPtr = slavePtr->masterPtr; goto scheduleLayout; } - + /* * If none of the "-in", "-before", or "-after" options has * been specified, arrange for the slave to go at the end of * the order for its parent. */ - + if (!positionGiven) { masterPtr = GetPacker(Tk_Parent(slave)); prevPtr = masterPtr->slavePtr; @@ -1673,7 +1675,7 @@ * an ancestor of the master, and that the master and slave * aren't the same. */ - + parent = Tk_Parent(slave); for (ancestor = masterPtr->tkwin; ; ancestor = Tk_Parent(ancestor)) { if (ancestor == parent) { Index: pTk/mTk/generic/tkPlace.c --- Tk800.022/pTk/mTk/generic/tkPlace.c Mon Nov 15 14:59:27 1999 +++ Tk800.023/pTk/mTk/generic/tkPlace.c Sat Dec 30 16:12:37 2000 @@ -1,4 +1,4 @@ -/* +/* * tkPlace.c -- * * This file contains code to implement a simple geometry manager @@ -303,7 +303,8 @@ if ((slavePtr->masterPtr != NULL) && (slavePtr->masterPtr->tkwin != Tk_Parent(slavePtr->tkwin))) { Tcl_AppendElement(interp, "-in"); - Tcl_AppendArg(interp, LangWidgetArg(interp,slavePtr->masterPtr->tkwin)); + Tcl_ListObjAppendElement(interp, Tcl_GetObjResult(interp), + LangWidgetObj(interp,slavePtr->masterPtr->tkwin)); } } else if ((c == 's') && (strncmp(argv[1], "slaves", length) == 0)) { if (argc != 3) { @@ -317,7 +318,8 @@ masterPtr = (Master *) Tcl_GetHashValue(hPtr); for (slavePtr = masterPtr->slavePtr; slavePtr != NULL; slavePtr = slavePtr->nextPtr) { - Tcl_AppendArg(interp, LangWidgetArg(interp,slavePtr->tkwin)); + Tcl_ListObjAppendElement(interp, Tcl_GetObjResult(interp), + LangWidgetObj(interp,slavePtr->tkwin)); } } } else { @@ -778,7 +780,7 @@ height += slavePtr->height; } if (slavePtr->flags & CHILD_REL_HEIGHT) { - /* + /* * See note above for rounding errors in width computation. */ Index: pTk/mTk/generic/tkPort.h --- Tk800.022/pTk/mTk/generic/tkPort.h Tue Jul 27 19:20:32 1999 +++ Tk800.023/pTk/mTk/generic/tkPort.h Sat Dec 30 16:12:37 2000 @@ -29,6 +29,9 @@ # ifndef strcasecmp # define strcasecmp(a,b) stricmp(a,b) # endif +# ifdef __CYGWIN__ +# undef strcasecmp +# endif #else # if defined(MAC_TCL) # include "tkMacPort.h" Index: pTk/mTk/generic/tkRectOval.c --- Tk800.022/pTk/mTk/generic/tkRectOval.c Sun Apr 30 20:27:16 2000 +++ Tk800.023/pTk/mTk/generic/tkRectOval.c Sat Dec 30 16:12:37 2000 @@ -291,7 +291,7 @@ if (argc==1) { i = 1; } else { - char *arg = Tcl_GetStringFromObj(args[1], NULL); + char *arg = Tcl_GetStringFromObj(objv[1], NULL); if ((argc>1) && (arg[0] == '-') && (arg[1] >= 'a') && (arg[1] <= 'z')) { i = 1; @@ -364,21 +364,21 @@ */ static int -RectOvalCoords(interp, canvas, itemPtr, argc, argv) +RectOvalCoords(interp, canvas, itemPtr, argc, objv) Tcl_Interp *interp; /* Used for error reporting. */ Tk_Canvas canvas; /* Canvas containing item. */ Tk_Item *itemPtr; /* Item whose coordinates are to be * read or modified. */ int argc; /* Number of coordinates supplied in * args. */ - Arg *args; /* Array of coordinates: x1, y1, + Arg *objv; /* Array of coordinates: x1, y1, * x2, y2, ... */ { RectOvalItem *rectOvalPtr = (RectOvalItem *) itemPtr; char c0[TCL_DOUBLE_SPACE]; if (argc == 0) { - Tcl_Obj *obj = Tcl_NewObj(); + Tcl_Obj *obj = Tcl_NewListObj(0,NULL); Tcl_Obj *subobj = Tcl_NewDoubleObj(rectOvalPtr->bbox[0]); Tcl_ListObjAppendElement(interp, obj, subobj); subobj = Tcl_NewDoubleObj(rectOvalPtr->bbox[1]); @@ -390,7 +390,7 @@ Tcl_SetObjResult(interp, obj); } else if ((argc == 1)||(argc == 4)) { if (argc==1) { - if (Tcl_ListObjGetElements(interp, args[0], &argc, &args) != TCL_OK) { + if (Tcl_ListObjGetElements(interp, objv[0], &argc, &objv) != TCL_OK) { return TCL_ERROR; } else if (argc != 4) { sprintf(c0,"%d",argc); @@ -399,13 +399,13 @@ return TCL_ERROR; } } - if ((Tk_CanvasGetCoordFromObj(interp, canvas, args[0], + if ((Tk_CanvasGetCoordFromObj(interp, canvas, objv[0], &rectOvalPtr->bbox[0]) != TCL_OK) - || (Tk_CanvasGetCoordFromObj(interp, canvas, args[1], + || (Tk_CanvasGetCoordFromObj(interp, canvas, objv[1], &rectOvalPtr->bbox[1]) != TCL_OK) - || (Tk_CanvasGetCoordFromObj(interp, canvas, args[2], + || (Tk_CanvasGetCoordFromObj(interp, canvas, objv[2], &rectOvalPtr->bbox[2]) != TCL_OK) - || (Tk_CanvasGetCoordFromObj(interp, canvas, args[3], + || (Tk_CanvasGetCoordFromObj(interp, canvas, objv[3], &rectOvalPtr->bbox[3]) != TCL_OK)) { return TCL_ERROR; } Index: pTk/mTk/generic/tkSelect.c --- Tk800.022/pTk/mTk/generic/tkSelect.c Sat Mar 18 14:12:43 2000 +++ Tk800.023/pTk/mTk/generic/tkSelect.c Sat Dec 30 16:12:37 2000 @@ -852,7 +852,7 @@ TkWindow *winPtr = (TkWindow *) tkwin; tkwin = Tk_IdToWindow(Tk_Display(tkwin), win); if (tkwin != NULL && tkwin != winPtr->dispPtr->clipWindow) { - Tcl_ArgResult(interp,LangWidgetArg(interp,tkwin)); + Tcl_SetObjResult(interp,LangWidgetObj(interp,tkwin)); } else { Tcl_IntResults(interp, 1, 0, win); } @@ -1061,7 +1061,7 @@ if ((infoPtr != NULL) && (infoPtr->owner != winPtr->dispPtr->clipWindow)) { - Tcl_ArgResult(interp,LangWidgetArg(interp,infoPtr->owner)); + Tcl_SetObjResult(interp,LangWidgetObj(interp,infoPtr->owner)); } return TCL_OK; } Index: pTk/mTk/generic/tkText.c --- Tk800.022/pTk/mTk/generic/tkText.c Sat Apr 29 14:13:51 2000 +++ Tk800.023/pTk/mTk/generic/tkText.c Sat Dec 30 16:12:37 2000 @@ -324,7 +324,7 @@ TkText *textPtr, int what, TkTextLine *linePtr, int start, int end, int lineno, LangCallback *command)); static int DumpSegment _ANSI_ARGS_((Tcl_Interp *interp, char *key, - char *value, Arg arg, LangCallback *command, int lineno, int offset, + char *value, Tcl_Obj *arg, LangCallback *command, int lineno, int offset, int what)); static void TileChangedProc _ANSI_ARGS_((ClientData clientData, Tk_Tile tile, Tk_Item *itemPtr)); @@ -758,7 +758,7 @@ } ckfree((char *) oldTagArrayPtr); } - if (Tcl_ListObjGetElements(interp, args[j+1], &numTags, &tagNames) + if (Tcl_ListObjGetElements(interp, objv[j+1], &numTags, &tagNames) != TCL_OK) { result = TCL_ERROR; goto done; @@ -1788,7 +1788,7 @@ return TCL_ERROR; } i++; - varName = args[i]; + varName = objv[i]; } else if ((c == 'e') && (strncmp(argv[i], "-exact", length) == 0)) { exact = 1; } else if ((c == 'e') && (strncmp(argv[i], "-elide", length) == 0)) { @@ -2277,7 +2277,7 @@ Tcl_AppendResult(interp, "Usage: ", argv[0], " dump ?-all -image -text -mark -tag -window? ?-command script? index ?index2?", NULL); return TCL_ERROR; } - command = LangMakeCallback(args[arg]); + command = LangMakeCallback(objv[arg]); } else { Tcl_AppendResult(interp, "Usage: ", argv[0], " dump ?-all -image -text -mark -tag -window? ?-command script? index ?index2?", NULL); return TCL_ERROR; @@ -2417,8 +2417,10 @@ DumpSegment(interp, "image", eiPtr->name, NULL, command, lineno, offset, what); } else { - DumpSegment(interp, "image", NULL, LangObjectArg( interp, eiPtr->name), + Tcl_Obj *obj = LangObjectObj( interp, eiPtr->name); + DumpSegment(interp, "image", NULL, obj, command, lineno, offset, what); + Tcl_DecrRefCount(obj); } } else if ((what & TK_DUMP_WIN) && (segPtr->typePtr->name[0] == 'w')) { @@ -2427,8 +2429,10 @@ DumpSegment(interp, "window", NULL, NULL, command, lineno, offset, what); } else { - DumpSegment(interp, "window", NULL, LangWidgetArg(interp, ewPtr->tkwin), + Tcl_Obj *obj = LangWidgetObj(interp, ewPtr->tkwin); + DumpSegment(interp, "window", NULL, obj, command, lineno, offset, what); + Tcl_DecrRefCount(obj); } } } @@ -2462,7 +2466,8 @@ if (command == (LangCallback *) NULL) { Tcl_AppendElement(interp, key); if (arg || !value) { - Tcl_AppendArg(interp, arg); + Tcl_IncrRefCount(arg); + Tcl_ListObjAppendElement(interp, Tcl_GetObjResult(interp), arg); } else { Tcl_AppendElement(interp, value); } Index: pTk/mTk/generic/tkTextDisp.c --- Tk800.022/pTk/mTk/generic/tkTextDisp.c Sat Nov 20 10:24:57 1999 +++ Tk800.023/pTk/mTk/generic/tkTextDisp.c Sat Dec 30 16:12:37 2000 @@ -1,4 +1,4 @@ -/* +/* * tkTextDisp.c -- * * This module provides facilities to display text widgets. It is @@ -1089,7 +1089,7 @@ (*breakChunkPtr->undisplayProc)(textPtr, breakChunkPtr); segPtr = TkTextIndexToSeg(&breakIndex, &offset); (*segPtr->typePtr->layoutProc)(textPtr, &breakIndex, - segPtr, offset, maxX, breakCharOffset, 0, + segPtr, offset, maxX, breakCharOffset, 0, wrapMode, breakChunkPtr); } lastChunkPtr = breakChunkPtr; @@ -1475,7 +1475,7 @@ panic("Added too many new lines in UpdateDisplayInfo"); } dlPtr->y = y; - y += dlPtr->height; + y += dlPtr->height; } } @@ -1852,7 +1852,7 @@ * assignment was replaced with 0 on 6/18/97. This has the effect * of highlighting the empty space to the left of a line whenever * the leftmost character of the line is highlighted. This way, - * multi-line highlights always line up along their left edges. + * multi-line highlights always line up along their left edges. * However, this may look funny in the case where a single word is * highlighted. To undo the change, replace "leftX = 0" with "leftX * = chunkPtr->x" and "rightX2 = 0" with "rightX2 = nextPtr2->x" @@ -2363,7 +2363,7 @@ textPtr->borderWidth, textPtr->relief); if (textPtr->highlightWidth != 0) { GC gc; - + if (textPtr->flags & GOT_FOCUS) { gc = Tk_GCForColor(textPtr->highlightColorPtr, Tk_WindowId(textPtr->tkwin)); @@ -2503,7 +2503,7 @@ * important to clear REDRAW_PENDING here, just in case the * scroll procedure does something that requires redisplay. */ - + if (textPtr->flags & UPDATE_SCROLLBARS) { textPtr->flags &= ~UPDATE_SCROLLBARS; if (textPtr->yScrollCmd != NULL) { @@ -2815,7 +2815,7 @@ TkBTreeNumLines(textPtr->tree), 0, &endOfText); } - /* + /* * Initialize a search through all transitions on the tag, starting * with the first transition where the tag's current state is different * from what it will eventually be. @@ -3173,7 +3173,7 @@ * on a display line. The display line is found by measuring * up "distance" pixels above the pixel just below an imaginary * display line that contains srcPtr. If the display line - * that covers this coordinate actually extends above the + * that covers this coordinate actually extends above the * coordinate, then return the index of the next lower line * instead (i.e. the returned index will be completely visible * at or below the given y-coordinate). @@ -3532,14 +3532,14 @@ * Discard the display lines, then either return or prepare * for the next display line to lay out. */ - + FreeDLines(textPtr, lowestPtr, (DLine *) NULL, 0); if (offset >= 0) { goto scheduleUpdate; } charsToCount = INT_MAX; } - + /* * Ran off the beginning of the text. Return the first character * in the text. @@ -3610,7 +3610,7 @@ double fraction; TkTextIndex index, new; TkTextLine *lastLinePtr; - DLine *dlPtr; + DLine *dlPtr; if (dInfoPtr->flags & DINFO_OUT_OF_DATE) { UpdateDisplayInfo(textPtr); @@ -3639,19 +3639,19 @@ } } } - if ((argc == 3) || pickPlace) { + if ((argc == 3) || pickPlace) { /* FIXME: Disable integer form altogether ??? */ - if (!strchr(LangString(args[2+pickPlace]),'.') && + if (!strchr(LangString(objv[2+pickPlace]),'.') && Tcl_GetInt(interp, argv[2+pickPlace], &lineNum) == TCL_OK) { TkTextMakeIndex(textPtr->tree, lineNum, 0, &index); TkTextSetYView(textPtr, &index, 0); return TCL_OK; } - + /* * The argument must be a regular text index. */ - + Tcl_ResetResult(interp); if (TkTextGetIndex(interp, textPtr, argv[2+pickPlace], &index) != TCL_OK) { @@ -4364,7 +4364,7 @@ int baseline; /* Location of line's baseline, in * pixels measured down from y. */ int *xPtr, *yPtr; /* Gets filled in with coords of - * character's upper-left pixel. + * character's upper-left pixel. * X-coord is in same coordinate * system as chunkPtr->x. */ int *widthPtr; /* Gets filled in with width of @@ -4630,7 +4630,7 @@ } if (sValuePtr->overstrike) { Tk_FontMetrics fm; - + Tk_GetFontMetrics(sValuePtr->tkfont, &fm); Tk_UnderlineChars(display, dst, stylePtr->fgGC, sValuePtr->tkfont, ciPtr->chars + offsetChars, offsetX, @@ -4736,7 +4736,7 @@ int baseline; /* Location of line's baseline, in * pixels measured down from y. */ int *xPtr, *yPtr; /* Gets filled in with coords of - * character's upper-left pixel. + * character's upper-left pixel. * X-coord is in same coordinate * system as chunkPtr->x. */ int *widthPtr; /* Gets filled in with width of @@ -4768,7 +4768,7 @@ *widthPtr = maxX - *xPtr; } else { - MeasureChars(chunkPtr->stylePtr->sValuePtr->tkfont, + MeasureChars(chunkPtr->stylePtr->sValuePtr->tkfont, ciPtr->chars + index, 1, *xPtr, 1000000, 0, widthPtr); if (*widthPtr > maxX) { *widthPtr = maxX - *xPtr; @@ -4932,7 +4932,7 @@ /* * There wasn't a decimal point. Right justify the text. */ - + width = 0; for (chunkPtr2 = chunkPtr->nextPtr; chunkPtr2 != NULL; chunkPtr2 = chunkPtr2->nextPtr) { @@ -5144,7 +5144,7 @@ * non-zero if text has been scrolled. */ { int tabWidth, rem; - + tabWidth = Tk_TextWidth(tkfont, "0", 1) * 8; if (tabWidth == 0) { tabWidth = 1; @@ -5174,7 +5174,7 @@ * * If a newline is encountered in the string, the line will be * broken at that point, unless the TK_NEWSLINES_NOT_SPECIAL flag - * is specified. + * is specified. * * Results: * The return value is the number of characters from source Index: pTk/mTk/generic/tkTextTag.c --- Tk800.022/pTk/mTk/generic/tkTextTag.c Sat Nov 20 19:29:12 1999 +++ Tk800.023/pTk/mTk/generic/tkTextTag.c Sat Dec 30 16:12:37 2000 @@ -1,4 +1,4 @@ -/* +/* * tkTextTag.c -- * * This module implements the "tag" subcommand of the widget command @@ -183,7 +183,7 @@ index2 = index1; TkTextIndexForwChars(&index2, 1, &index2); } - + if (tagPtr->affectsDisplay) { TkTextRedrawTag(textPtr, &index1, &index2, tagPtr, !addTag); } else { @@ -191,17 +191,17 @@ * Still need to trigger enter/leave events on tags that * have changed. */ - + TkTextEventuallyRepick(textPtr); } TkBTreeTag(&index1, &index2, tagPtr, addTag); - + /* * If the tag is "sel" then grab the selection if we're supposed * to export it and don't already have it. Also, invalidate * partially-completed selection retrievals. */ - + if (tagPtr == textPtr->selTagPtr) { if (addTag && textPtr->exportSelection && !(textPtr->flags & GOT_SELECTION)) { @@ -243,7 +243,7 @@ append = 1; } mask = Tk_CreateBinding(interp, textPtr->bindingTable, - (ClientData) tagPtr, argv[4], args[5], append); + (ClientData) tagPtr, argv[4], objv[5], append); if (mask == 0) { return TCL_ERROR; } @@ -261,15 +261,14 @@ return TCL_ERROR; } } else if (argc == 5) { - Arg command; - + Tcl_Obj *command; + command = Tk_GetBinding(interp, textPtr->bindingTable, (ClientData) tagPtr, argv[4]); if (command == NULL) { return TCL_ERROR; } - Tcl_ArgResult(interp,command); - Tcl_DecrRefCount(command); + Tcl_SetObjResult(interp,command); } else { Tk_GetAllBindings(interp, textPtr->bindingTable, (ClientData) tagPtr); @@ -612,7 +611,7 @@ * skip to the end of this tagged range. */ - for (segPtr = index1.linePtr->segPtr, offset = index1.charIndex; + for (segPtr = index1.linePtr->segPtr, offset = index1.charIndex; offset >= 0; offset -= segPtr->size, segPtr = segPtr->nextPtr) { if ((offset == 0) && (segPtr->typePtr == &tkTextToggleOnType) Index: pTk/mTk/tclGeneric/tclEvent.c --- Tk800.022/pTk/mTk/tclGeneric/tclEvent.c Mon Nov 15 14:59:27 1999 +++ Tk800.023/pTk/mTk/tclGeneric/tclEvent.c Sat Dec 30 16:12:37 2000 @@ -1,9 +1,9 @@ -/* +/* * tclEvent.c -- * * This file implements some general event related interfaces including * background errors, exit handlers, and the "vwait" and "update" - * command procedures. + * command procedures. * * Copyright (c) 1990-1994 The Regents of the University of California. * Copyright (c) 1994-1997 Sun Microsystems, Inc. @@ -220,7 +220,7 @@ Tcl_Channel errChannel; Tcl_Preserve((ClientData) assocPtr); - + while (assocPtr->firstBgPtr != NULL) { interp = assocPtr->firstBgPtr->interp; if (interp == NULL) { @@ -287,13 +287,13 @@ ckfree(argv[1]); goto doneWithInterp; - } + } /* * We have to get the error output channel at the latest possible * time, because the eval (above) might have changed the channel. */ - + errChannel = Tcl_GetStdChannel(TCL_STDERR); if (errChannel != (Tcl_Channel) NULL) { if (strcmp(interp->result, @@ -344,7 +344,7 @@ ckfree((char *) assocPtr->firstBgPtr); assocPtr->firstBgPtr = errPtr; } - + if (interp != NULL) { Tcl_Release((ClientData) interp); } @@ -413,7 +413,7 @@ * application exits. * *---------------------------------------------------------------------- - */ + */ void @@ -526,7 +526,7 @@ Tcl_Finalize() { ExitHandler *exitPtr; - + /* * Invoke exit handler first. */ @@ -549,7 +549,7 @@ * after the exit handlers, because there are order dependencies. */ -#if 0 +#if 0 TclFinalizeCompExecEnv(); TclFinalizeEnvironment(); TclpFinalize(); @@ -617,7 +617,7 @@ argv[0], " name\"", (char *) NULL); return TCL_ERROR; } - if (LangSaveVar(interp, args[1], &variable, TK_CONFIG_SCALARVAR) != TCL_OK) + if (LangSaveVar(interp, objv[1], &variable, TK_CONFIG_SCALARVAR) != TCL_OK) return TCL_ERROR; if (Tcl_TraceVar(interp, variable, TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS, @@ -716,6 +716,6 @@ Tcl_ResetResult(interp); return TCL_OK; -} +} #endif /* TCL_EVENT_IMPLEMENT */ Index: pTk/mTk/tclGeneric/tclTimer.c --- Tk800.022/pTk/mTk/tclGeneric/tclTimer.c Mon Nov 15 14:59:28 1999 +++ Tk800.023/pTk/mTk/tclGeneric/tclTimer.c Sat Dec 30 16:12:37 2000 @@ -1,4 +1,4 @@ -/* +/* * tclTimer.c -- * * This file provides timer event management facilities for Tcl, @@ -205,7 +205,7 @@ * exactly once. * *-------------------------------------------------------------- - */ + */ Tcl_TimerToken @@ -235,7 +235,7 @@ timerHandlerPtr->time.usec -= 1000000; timerHandlerPtr->time.sec += 1; } - + /* * Fill in other fields for the event. */ @@ -502,7 +502,7 @@ if (timerHandlerPtr == NULL) { break; } - + if ((timerHandlerPtr->time.sec > time.sec) || ((timerHandlerPtr->time.sec == time.sec) && (timerHandlerPtr->time.usec > time.usec))) { @@ -694,7 +694,7 @@ Tcl_SetMaxBlockTime(&blockTime); } return 1; -} +} #else @@ -747,7 +747,7 @@ static char *subCmds[] = { "cancel", "idle", "info", (char *) NULL}; - + if (objc < 2) { Tcl_WrongNumArgs(interp, 1, objv, "option ?arg arg ...?"); return TCL_ERROR; @@ -779,7 +779,7 @@ /* * First lets see if the command was passed a number as the first argument. */ - + arg = Tcl_GetStringFromObj(objv[1], &length); if (isdigit(UCHAR(arg[0]))) { if (Tcl_GetIntFromObj(interp, objv[1], &ms) != TCL_OK) { @@ -834,7 +834,7 @@ return TCL_ERROR; } if (objc == 3) { - objPtr = objv[2]; + objPtr = objv[2]; Tcl_IncrRefCount(objPtr); } else { objPtr = Tcl_ConcatObj(objc-2, objv+2);; @@ -846,7 +846,7 @@ } } if (afterPtr == NULL) { - arg = Tcl_GetStringFromObj( objPtr, &length ); + arg = Tcl_GetStringFromObj( objPtr, &length ); afterPtr = GetAfterEvent(assocPtr, arg); } if (objPtr != NULL) { @@ -887,7 +887,7 @@ case 2: /* info */ if (objc == 2) { char buffer[30]; - + for (afterPtr = assocPtr->firstAfterPtr; afterPtr != NULL; afterPtr = afterPtr->nextPtr) { if (assocPtr->interp == interp) { @@ -908,7 +908,8 @@ "\" doesn't exist", (char *) NULL); return TCL_ERROR; } - Tcl_AppendArg(interp, LangCallbackArg(afterPtr->command)); + Tcl_ListObjAppendElement(interp, Tcl_GetObjResult(interp), + LangCallbackObj(afterPtr->command)); Tcl_AppendElement(interp, (afterPtr->token == NULL) ? "idle" : "timer"); break; @@ -1021,7 +1022,7 @@ Tcl_BackgroundError(interp); } Tcl_Release((ClientData) interp); - + /* * Free the memory for the callback. */ @@ -1109,5 +1110,5 @@ } ckfree((char *) assocPtr); } - + #endif Index: pTk/mTk/tixGeneric/tix.h --- Tk800.022/pTk/mTk/tixGeneric/tix.h Mon Aug 9 21:25:58 1999 +++ Tk800.023/pTk/mTk/tixGeneric/tix.h Sat Dec 30 16:12:37 2000 @@ -91,7 +91,7 @@ # define TkPutImage(a, b, c, d, e, f, g, h, i, j, k, l) \ XPutImage(c, d, e, f, g, h, i, j, k, l) -# define TkStringToKeysym XStringToKeysym +# define TkStringToKeysym XStringToKeysym #endif /* TK_4_1_OR_LATER */ @@ -274,7 +274,7 @@ Tix_ListInfo * infoPtr, Tix_LinkList * lPtr, char * itemPtr, Tix_ListIterator * liPtr)); -EXTERN void Tix_LinkListIteratorInit _ANSI_ARGS_(( Tix_ListIterator * liPtr)); +EXTERN void Tix_LinkListIteratorInit _ANSI_ARGS_(( Tix_ListIterator * liPtr)); #define Tix_LinkListDone(liPtr) ((liPtr)->curr == NULL) @@ -340,7 +340,7 @@ * C functions exported by Tix */ -EXTERN int Tix_ArgcError _ANSI_ARGS_((Tcl_Interp *interp, +EXTERN int Tix_ArgcError _ANSI_ARGS_((Tcl_Interp *interp, int argc, char ** argv, int prefixCount, char *message)); EXTERN void Tix_CreateCommands _ANSI_ARGS_(( @@ -386,7 +386,7 @@ char *tclName, char *initFile, char *defDir, char * appName)); EXTERN void Tix_OpenStdin _ANSI_ARGS_((Tcl_Interp *interp)); -EXTERN void Tix_SetArgv _ANSI_ARGS_((Tcl_Interp *interp, +EXTERN void Tix_SetArgv _ANSI_ARGS_((Tcl_Interp *interp, int argc, char **argv)); EXTERN void Tix_SetRcFileName _ANSI_ARGS_(( Tcl_Interp * interp, char * rcFileName)); @@ -394,7 +394,7 @@ char *objPtr,int *lengthPtr)); /* - * Entry points for Tk_CONFIG_CUSTOM stubs to call + * Entry points for Tk_CONFIG_CUSTOM stubs to call */ EXTERN int TixDItemParseProc _ANSI_ARGS_((ClientData clientData, @@ -466,7 +466,8 @@ * Compatibility section *---------------------------------------------------------------------- */ -#define strdup tixStrDup +#undef strdup +#define strdup DoNotUse_strdup EXTERN char * tixStrDup _ANSI_ARGS_((CONST char * s)); #ifdef _WINDOWS Index: pTk/mTk/tixGeneric/tixDItem.c --- Tk800.022/pTk/mTk/tixGeneric/tixDItem.c Mon Nov 15 14:59:29 1999 +++ Tk800.023/pTk/mTk/tixGeneric/tixDItem.c Sat Dec 30 16:12:37 2000 @@ -30,8 +30,8 @@ #define DItemParseProc TixDItemParseProc #define DItemPrintProc TixDItemPrintProc #else -#define FORWARD static -#define LINKAGE static +#define FORWARD static +#define LINKAGE static #endif FORWARD int DItemParseProc _ANSI_ARGS_((ClientData clientData, @@ -221,7 +221,7 @@ argListPtr->numLists = numLists; for (i=0; iargvName, len) == 0) { - arg[i].args[arg[i].argc++] = args[n ]; - arg[i].args[arg[i].argc++] = args[n+1]; + arg[i].objv[arg[i].argc++] = objv[n ]; + arg[i].objv[arg[i].argc++] = objv[n+1]; found = 1; break; } @@ -500,7 +500,7 @@ * inside the widget record. *---------------------------------------------------------------------- */ -LINKAGE int +LINKAGE int DItemParseProc(clientData, interp, tkwin, value, widRec,offset) ClientData clientData; Tcl_Interp *interp; @@ -525,7 +525,7 @@ return TCL_OK; } -LINKAGE Arg +LINKAGE Arg DItemPrintProc(clientData, tkwin, widRec,offset, freeProcPtr) ClientData clientData; Tk_Window tkwin; Index: pTk/mTk/tixGeneric/tixDiStyle.c --- Tk800.022/pTk/mTk/tixGeneric/tixDiStyle.c Fri Mar 31 13:04:30 2000 +++ Tk800.023/pTk/mTk/tixGeneric/tixDiStyle.c Sat Dec 30 16:12:37 2000 @@ -269,7 +269,7 @@ RefWindowStructureProc, (ClientData)stylePtr); Tcl_ResetResult(interp); - Tcl_ArgResult(interp, LangObjectArg( interp, styleName)); + Tcl_SetObjResult(interp, LangObjectObj( interp, styleName)); return TCL_OK; } @@ -976,7 +976,7 @@ Tix_DItemStyle *stylePtr = *((Tix_DItemStyle**)(widRec+offset)); Arg result = NULL; if (stylePtr != NULL && !(stylePtr->base.flags & TIX_STYLE_DEFAULT)) { - LangSetArg(&result,LangObjectArg(stylePtr->base.interp, + LangSetObj(&result,LangObjectObj(stylePtr->base.interp, stylePtr->base.name)); } return result; Index: pTk/mTk/tixGeneric/tixFormMisc.c --- Tk800.022/pTk/mTk/tixGeneric/tixFormMisc.c Sun Dec 12 13:58:37 1999 +++ Tk800.023/pTk/mTk/tixGeneric/tixFormMisc.c Sat Dec 30 16:12:37 2000 @@ -95,7 +95,7 @@ /* Otherwise, give full info */ for (i=0; i<2; i++) { - for (j=0; j<2; j++) { + for (j=0; j<2; j++) { /* The information about attachment */ Tcl_AppendElement(interp,sideNames[i][j]); AttachInfo(interp, clientPtr, i, j); @@ -103,7 +103,7 @@ /* The information about padding */ Tcl_AppendElement(interp, padNames[i][j]); sprintf(buff, "%d", clientPtr->pad[i][j]); - Tcl_IntResults(interp, 1, 1, clientPtr->pad[i][j]); + Tcl_IntResults(interp, 1, 1, clientPtr->pad[i][j]); } } return TCL_OK; @@ -155,7 +155,7 @@ Tcl_Interp* interp; int axis, which; Arg avalue; -{ +{ char *value = LangString(avalue); Tk_Window tkwin; FormInfo * attWidget; @@ -163,7 +163,7 @@ int offset; int grid; int argc; - char ** argv; + char ** argv; int delta = 0; if (Tcl_ListObjGetElements(interp, avalue, &argc, &argv) != TCL_OK) { @@ -173,7 +173,7 @@ switch (argv[0][0]) { case '#': /* Attached to grid */ case '%': /* Attached to percent (aka grid) */ - {Tcl_Obj *temp = Tcl_NewStringObj(LangString(args[0])+1,-1); + {Tcl_Obj *temp = Tcl_NewStringObj(LangString(objv[0])+1,-1); if (Tcl_GetIntFromObj(interp,temp,&grid) != TCL_OK) { Tcl_DecrRefCount(temp); goto error; @@ -186,12 +186,12 @@ case '&': /* Attached to parallel widget */ if (argc < 2) - goto malformed; - tkwin = Tk_NameToWindow(interp, LangString(args[++delta]), topLevel); + goto malformed; + tkwin = Tk_NameToWindow(interp, LangString(objv[++delta]), topLevel); if (tkwin != NULL) { if (Tk_IsTopLevel(tkwin)) { - Tcl_AppendResult(interp, "can't attach to \"", LangString(args[1]), + Tcl_AppendResult(interp, "can't attach to \"", LangString(objv[1]), "\": it's a top-level window", (char *) NULL); goto error; } @@ -206,7 +206,7 @@ break; case '.': /* Attach to opposite widget */ - tkwin = Tk_NameToWindow(interp, LangString(args[0]), topLevel); + tkwin = Tk_NameToWindow(interp, LangString(objv[0]), topLevel); if (tkwin != NULL) { if (Tk_IsTopLevel(tkwin)) { @@ -390,49 +390,49 @@ return TCL_ERROR; } else if (strcmp(argv[flag], "-l") == 0) { if (ConfigureAttachment(clientPtr, topLevel, interp, - 0, 0, args[value]) == TCL_ERROR) { + 0, 0, objv[value]) == TCL_ERROR) { return TCL_ERROR; } } else if (strcmp(argv[flag], "-left") == 0) { if (ConfigureAttachment(clientPtr, topLevel, interp, - 0, 0, args[value]) == TCL_ERROR) { + 0, 0, objv[value]) == TCL_ERROR) { return TCL_ERROR; } } else if (strcmp(argv[flag], "-r") == 0) { if (ConfigureAttachment(clientPtr, topLevel, interp, - 0, 1, args[value]) == TCL_ERROR) { + 0, 1, objv[value]) == TCL_ERROR) { return TCL_ERROR; } } else if (strcmp(argv[flag], "-right") == 0) { if (ConfigureAttachment(clientPtr, topLevel, interp, - 0, 1, args[value]) == TCL_ERROR) { + 0, 1, objv[value]) == TCL_ERROR) { return TCL_ERROR; } } else if (strcmp(argv[flag], "-top") == 0) { if (ConfigureAttachment(clientPtr, topLevel, interp, - 1, 0, args[value]) == TCL_ERROR) { + 1, 0, objv[value]) == TCL_ERROR) { return TCL_ERROR; } } else if (strcmp(argv[flag], "-t") == 0) { if (ConfigureAttachment(clientPtr, topLevel, interp, - 1, 0, args[value]) == TCL_ERROR) { + 1, 0, objv[value]) == TCL_ERROR) { return TCL_ERROR; } } else if (strcmp(argv[flag], "-bottom") == 0) { if (ConfigureAttachment(clientPtr, topLevel, interp, - 1, 1, args[value]) == TCL_ERROR) { + 1, 1, objv[value]) == TCL_ERROR) { return TCL_ERROR; } } else if (strcmp(argv[flag], "-b") == 0) { if (ConfigureAttachment(clientPtr, topLevel, interp, - 1, 1, args[value]) == TCL_ERROR) { + 1, 1, objv[value]) == TCL_ERROR) { return TCL_ERROR; } @@ -508,42 +508,42 @@ } } else if (strcmp(argv[flag], "-leftspring") == 0) { if (ConfigureSpring(clientPtr, topLevel, interp, - 0, 0, args[value]) == TCL_ERROR) { + 0, 0, objv[value]) == TCL_ERROR) { return TCL_ERROR; } } else if (strcmp(argv[flag], "-ls") == 0) { if (ConfigureSpring(clientPtr, topLevel, interp, - 0, 0, args[value]) == TCL_ERROR) { + 0, 0, objv[value]) == TCL_ERROR) { return TCL_ERROR; } } else if (strcmp(argv[flag], "-rightspring") == 0) { if (ConfigureSpring(clientPtr, topLevel, interp, - 0, 1, args[value]) == TCL_ERROR) { + 0, 1, objv[value]) == TCL_ERROR) { return TCL_ERROR; } } else if (strcmp(argv[flag], "-rs") == 0) { if (ConfigureSpring(clientPtr, topLevel, interp, - 0, 1, args[value]) == TCL_ERROR) { + 0, 1, objv[value]) == TCL_ERROR) { return TCL_ERROR; } } else if (strcmp(argv[flag], "-topspring") == 0) { if (ConfigureSpring(clientPtr, topLevel, interp, - 1, 0, args[value]) == TCL_ERROR) { + 1, 0, objv[value]) == TCL_ERROR) { return TCL_ERROR; } } else if (strcmp(argv[flag], "-ts") == 0) { if (ConfigureSpring(clientPtr, topLevel, interp, - 1, 0, args[value]) == TCL_ERROR) { + 1, 0, objv[value]) == TCL_ERROR) { return TCL_ERROR; } } else if (strcmp(argv[flag], "-bottomspring") == 0) { if (ConfigureSpring(clientPtr, topLevel, interp, - 1, 1, args[value]) == TCL_ERROR) { + 1, 1, objv[value]) == TCL_ERROR) { return TCL_ERROR; } } else if (strcmp(argv[flag], "-bs") == 0) { if (ConfigureSpring(clientPtr, topLevel, interp, - 1, 1, args[value]) == TCL_ERROR) { + 1, 1, objv[value]) == TCL_ERROR) { return TCL_ERROR; } } else if (strcmp(argv[flag], "-fill") == 0) { Index: pTk/mTk/tixGeneric/tixGrSort.c --- Tk800.022/pTk/mTk/tixGeneric/tixGrSort.c Mon Nov 15 14:59:29 1999 +++ Tk800.023/pTk/mTk/tixGeneric/tixGrSort.c Sat Dec 30 16:12:37 2000 @@ -1,4 +1,4 @@ -/* +/* * tixGrSel.c -- * * This module handles the sorting of the Grid widget. @@ -23,7 +23,7 @@ * "lsort" needs internal mutual exclusion. */ -static Tcl_Interp *sortInterp = NULL; /* Interpreter for "lsort" command. +static Tcl_Interp *sortInterp = NULL; /* Interpreter for "lsort" command. * NULL means no lsort is active. */ static enum {ASCII, INTEGER, REAL, COMMAND} sortMode; /* Mode for sorting:compare as strings, @@ -184,20 +184,20 @@ /* get the start and end index */ if (axis == 0) { - if (TixGridDataGetIndex(interp, wPtr, args[1], NULL, &start, NULL) + if (TixGridDataGetIndex(interp, wPtr, objv[1], NULL, &start, NULL) !=TCL_OK) { return TCL_ERROR; } - if (TixGridDataGetIndex(interp, wPtr, args[2], NULL, &end, NULL) + if (TixGridDataGetIndex(interp, wPtr, objv[2], NULL, &end, NULL) !=TCL_OK) { return TCL_ERROR; } } else { - if (TixGridDataGetIndex(interp, wPtr, NULL, args[1], NULL, &start) + if (TixGridDataGetIndex(interp, wPtr, NULL, objv[1], NULL, &start) !=TCL_OK) { return TCL_ERROR; } - if (TixGridDataGetIndex(interp, wPtr, NULL, args[2], NULL, &end) + if (TixGridDataGetIndex(interp, wPtr, NULL, objv[2], NULL, &end) !=TCL_OK) { return TCL_ERROR; } @@ -265,14 +265,14 @@ else if (strncmp(argv[i], "-key", len) == 0) { if (axis == 0) { /* sort columns: the key is a column index (1) */ - if (TixGridDataGetIndex(interp, wPtr, NULL, args[i+1], NULL, + if (TixGridDataGetIndex(interp, wPtr, NULL, objv[i+1], NULL, &sortKeyIndex) !=TCL_OK) { sortCode = TCL_ERROR; goto done; } } else { /* sort rows: the key is a row index (0)*/ - if (TixGridDataGetIndex(interp, wPtr, args[i+1], NULL, + if (TixGridDataGetIndex(interp, wPtr, objv[i+1], NULL, &sortKeyIndex, NULL) !=TCL_OK) { sortCode = TCL_ERROR; goto done; @@ -281,7 +281,7 @@ } else if (strncmp(argv[i], "-command", len) == 0) { sortMode = COMMAND; - command = LangMakeCallback(args[i+1]); + command = LangMakeCallback(objv[i+1]); } else { Tcl_AppendResult(interp, "wrong option \"", argv[i], @@ -423,7 +423,7 @@ order = -1; } } else { -#ifdef _LANG +#ifdef _LANG /* FIXME */ Tcl_Panic("Need Callback Handling Added"); return 0; Index: pTk/mTk/tixGeneric/tixGrid.c --- Tk800.022/pTk/mTk/tixGeneric/tixGrid.c Mon Nov 15 14:59:29 1999 +++ Tk800.023/pTk/mTk/tixGeneric/tixGrid.c Sat Dec 30 16:12:37 2000 @@ -1,4 +1,4 @@ -/* +/* * tixGrid.c -- * * This module implements "tixGrid" widgets. @@ -145,7 +145,7 @@ {TK_CONFIG_UID, "-state", (char*)NULL, (char*)NULL, DEF_GRID_STATE, Tk_Offset(WidgetRecord, state), 0}, - + {TK_CONFIG_STRING, "-takefocus", "takeFocus", "TakeFocus", DEF_GRID_TAKE_FOCUS, Tk_Offset(WidgetRecord, takeFocus), TK_CONFIG_NULL_OK}, @@ -711,7 +711,7 @@ case DestroyNotify: if (wPtr->dispData.tkwin != NULL) { wPtr->dispData.tkwin = NULL; - Tcl_DeleteCommand(wPtr->dispData.interp, + Tcl_DeleteCommand(wPtr->dispData.interp, Tcl_GetCommandName(wPtr->dispData.interp, wPtr->widgetCmd)); } Tix_GrCancelDoWhenIdle(wPtr); @@ -890,7 +890,7 @@ winSize[0] = winW; winSize[1] = winH; - + TixGridDataGetGridSize(wPtr->dataSet, &gridSize[0], &gridSize[1]); @@ -951,7 +951,7 @@ totalSize += pad0 + pad1; } - /* + /* *we may need some left over spaces after the last element. */ totalSize += (-winSize[i]); @@ -1104,7 +1104,7 @@ if (!wPtr->idleEvent) { /* sanity check */ return; } - wPtr->idleEvent = 0; + wPtr->idleEvent = 0; if (wPtr->toResize) { wPtr->toResize = 0; @@ -1223,7 +1223,7 @@ Tk_Draw3DRectangle(tkwin, Tk_WindowId(tkwin), wPtr->border, wPtr->highlightWidth, wPtr->highlightWidth, - Tk_Width(tkwin) - 2*wPtr->highlightWidth, + Tk_Width(tkwin) - 2*wPtr->highlightWidth, Tk_Height(tkwin) - 2*wPtr->highlightWidth, wPtr->borderWidth, wPtr->relief); @@ -1231,7 +1231,7 @@ if (wPtr->hasFocus) { highlightGC = wPtr->highlightGC; } else { - highlightGC = Tk_3DBorderGC(tkwin, wPtr->border, + highlightGC = Tk_3DBorderGC(tkwin, wPtr->border, TK_3D_FLAT_GC); } @@ -1370,10 +1370,10 @@ wPtr->mainRB->elms[i][j].borderW[0][0], y+riPtr->origin[1]+ wPtr->mainRB->elms[i][j].borderW[1][0], - wPtr->mainRB->dispSize[0][i].total - + wPtr->mainRB->dispSize[0][i].total - wPtr->mainRB->elms[i][j].borderW[0][0] - wPtr->mainRB->elms[i][j].borderW[0][1], - wPtr->mainRB->dispSize[1][j].total - + wPtr->mainRB->dispSize[1][j].total - wPtr->mainRB->elms[i][j].borderW[1][0] - wPtr->mainRB->elms[i][j].borderW[1][1], 0, TK_RELIEF_FLAT); @@ -1384,7 +1384,7 @@ if (chPtr != NULL) { if (Tix_DItemType(chPtr->iPtr) == TIX_DITEM_WINDOW) { Tix_DItemDisplay(Tk_WindowId(wPtr->dispData.tkwin), None, - chPtr->iPtr, x1, y1, + chPtr->iPtr, x1, y1, wPtr->mainRB->dispSize[0][i].size, wPtr->mainRB->dispSize[1][j].size, TIX_DITEM_NORMAL_FG); @@ -1408,7 +1408,7 @@ nextCol: x+= wPtr->mainRB->dispSize[0][i].total; } - + for (i=0; imainRB->size[0]; i++) { for (j=0; jmainRB->size[1]; j++) { chPtr = wPtr->mainRB->elms[i][j].chPtr; @@ -1661,7 +1661,7 @@ else if (in[1] < wPtr->hdrSize[1] && bd[0] >= 0) { inX = 1; } - + if (bd[0] < 0) { bd[0] = 0; } @@ -1670,15 +1670,15 @@ } Tcl_ResetResult(interp); - if (inX && inY) { + if (inX && inY) { Tcl_AppendElement(interp,"xy"); - Tcl_IntResults(interp,2,1, bd[0], bd[1]); + Tcl_IntResults(interp,2,1, bd[0], bd[1]); } else if (inX) { Tcl_AppendElement(interp,"x"); - Tcl_IntResults(interp,2,1, bd[0], bd[1]); + Tcl_IntResults(interp,2,1, bd[0], bd[1]); } else if (inY) { Tcl_AppendElement(interp,"y"); - Tcl_IntResults(interp,2,1, bd[0], bd[1]); + Tcl_IntResults(interp,2,1, bd[0], bd[1]); } else { buf[0] = '\0'; } @@ -1689,7 +1689,7 @@ } /*---------------------------------------------------------------------- - * "set" sub command -- + * "set" sub command -- * * Sets the item at the position on the grid. This either creates * a new element or modifies the existing element. (if you don't want @@ -1715,7 +1715,7 @@ * (0) We need to find out where you want to set *------------------------------------------------------------ */ - if (TixGridDataGetIndex(interp, wPtr, args[0], args[1], &x, &y)!=TCL_OK) { + if (TixGridDataGetIndex(interp, wPtr, objv[0], objv[1], &x, &y)!=TCL_OK) { return TCL_ERROR; } @@ -1796,7 +1796,7 @@ TixGrEntry * chPtr; int x, y; - if (TixGridDataGetIndex(interp, wPtr, args[0], args[1], &x, &y) + if (TixGridDataGetIndex(interp, wPtr, objv[0], objv[1], &x, &y) !=TCL_OK) { return TCL_ERROR; } @@ -1883,12 +1883,14 @@ ClientData clientData; Tcl_Interp *interp; /* Current interpreter. */ int argc; /* Number of arguments. */ - Arg *args; /* Argument strings. */ + Tcl_Obj **objv; /* Argument strings. */ { WidgetPtr wPtr = (WidgetPtr) clientData; int x, y; char buff[20]; - int len, code; + int len; + int code = TCL_OK; + Tcl_Obj *obj = NULL; len = strlen(argv[0]); @@ -1897,24 +1899,28 @@ Tcl_AppendResult(interp, "wrong # of arguments, must be: ", argv[-2], " edit set x y", NULL); } - if (TixGridDataGetIndex(interp, wPtr, args[1], args[2], &x, &y) + if (TixGridDataGetIndex(interp, wPtr, objv[1], objv[2], &x, &y) !=TCL_OK) { return TCL_ERROR; } - return LangMethodCall(interp,LangWidgetArg(interp,wPtr->dispData.tkwin), - "EditCell",0, 2," %d %d",x, y); + obj = LangWidgetObj(interp,wPtr->dispData.tkwin); + code = LangMethodCall(interp,obj, "EditCell",0, 2," %d %d",x, y); } else if (strncmp(argv[0], "apply", len) == 0) { if (argc != 1) { Tcl_AppendResult(interp, "wrong # of arguments, must be: ", argv[-2], " edit apply", NULL); } - return LangMethodCall(interp,LangWidgetArg(interp,wPtr->dispData.tkwin), - "EditApply",0, 0); + obj = LangWidgetObj(interp,wPtr->dispData.tkwin); + code = LangMethodCall(interp,obj, "EditApply",0, 0); } else { Tcl_AppendResult(interp, "unknown option \"", argv[0], "\", must be apply or set", NULL); return TCL_ERROR; } + if (obj) { + Tcl_DecrRefCount(obj); + } + return code; } /*---------------------------------------------------------------------- @@ -1932,7 +1938,7 @@ int x, y; TixGrEntry * chPtr; - if (TixGridDataGetIndex(interp, wPtr, args[0], args[1], &x, &y)!=TCL_OK) { + if (TixGridDataGetIndex(interp, wPtr, objv[0], objv[1], &x, &y)!=TCL_OK) { return TCL_ERROR; } @@ -1962,7 +1968,7 @@ int x, y; TixGrEntry * chPtr; - if (TixGridDataGetIndex(interp, wPtr, args[0], args[1], &x, &y)!=TCL_OK) { + if (TixGridDataGetIndex(interp, wPtr, objv[0], objv[1], &x, &y)!=TCL_OK) { return TCL_ERROR; } @@ -2043,10 +2049,10 @@ int x, y; char buff[100]; - if (TixGridDataGetIndex(interp, wPtr, args[0], args[1], &x, &y)!=TCL_OK) { + if (TixGridDataGetIndex(interp, wPtr, objv[0], objv[1], &x, &y)!=TCL_OK) { return TCL_ERROR; } - Tcl_IntResults(interp,2,0, x, y); + Tcl_IntResults(interp,2,0, x, y); return TCL_OK; } @@ -2069,7 +2075,7 @@ if (argc != 3) { return Tix_ArgcError(interp, argc+2, argv-2, 3, "x y"); } - if (TixGridDataGetIndex(interp, wPtr, args[1], args[2], &x, &y) + if (TixGridDataGetIndex(interp, wPtr, objv[1], objv[2], &x, &y) !=TCL_OK) { return TCL_ERROR; } @@ -2080,7 +2086,7 @@ if (argc != 3) { return Tix_ArgcError(interp, argc+2, argv-2, 3, "x y"); } - if (TixGridDataGetIndex(interp, wPtr, args[1], args[2], &x, &y) + if (TixGridDataGetIndex(interp, wPtr, objv[1], objv[2], &x, &y) !=TCL_OK) { return TCL_ERROR; } @@ -2092,7 +2098,7 @@ return TCL_OK; } else { - Tcl_AppendResult(interp, "unknown option \"", argv[0], + Tcl_AppendResult(interp, "unknown option \"", argv[0], "\": must be bbox or exists", NULL); return TCL_ERROR; @@ -2223,7 +2229,7 @@ if (argc == 3) { int x, y; - if (TixGridDataGetIndex(interp, wPtr, args[1], args[2], + if (TixGridDataGetIndex(interp, wPtr, objv[1], objv[2], &x, &y)!=TCL_OK) { return TCL_ERROR; } @@ -2335,7 +2341,7 @@ { int k, i = axis; int winSize, sz, start, num; - int pad0, pad1; + int pad0, pad1; Tix_GridScrollInfo * siPtr = &wPtr->scrollInfo[axis]; int gridSize[2]; @@ -2498,7 +2504,7 @@ } #if 0 - printf("Configing Scrollbars: (%d %f %d) (%d %f %d)\n", + printf("Configing Scrollbars: (%d %f %d) (%d %f %d)\n", wPtr->scrollInfo[0].max, wPtr->scrollInfo[0].window, wPtr->scrollInfo[0].offset, @@ -2569,9 +2575,9 @@ wPtr->renderInfo->fmt.whichArea = which; code = LangDoCallback(wPtr->dispData.interp, wPtr->formatCmd, 0, 5, "%s %d %d %d %d", areaNames[which], - wPtr->renderInfo->fmt.x1, - wPtr->renderInfo->fmt.y1, - wPtr->renderInfo->fmt.x2, + wPtr->renderInfo->fmt.x1, + wPtr->renderInfo->fmt.y1, + wPtr->renderInfo->fmt.x2, wPtr->renderInfo->fmt.y2); if (code != TCL_OK) { @@ -2639,14 +2645,14 @@ if (wPtr->hdrSize[0] > 0 && mainSize[1] > 0) { wPtr->renderInfo->fmt.x1 = 0; wPtr->renderInfo->fmt.x2 = visibleHdr[0] - 1; - wPtr->renderInfo->fmt.y1 = + wPtr->renderInfo->fmt.y1 = wPtr->scrollInfo[1].offset + wPtr->hdrSize[1]; wPtr->renderInfo->fmt.y2 = wPtr->renderInfo->fmt.y1 + mainSize[1] - 1; Tix_GrCallFormatCmd(wPtr, TIX_Y_MARGIN); } - + /* the stationary part of the margin */ if (visibleHdr[0] > 0 && visibleHdr[1] > 0) { @@ -2654,7 +2660,7 @@ wPtr->renderInfo->fmt.x2 = visibleHdr[0] - 1; wPtr->renderInfo->fmt.y1 = 0; wPtr->renderInfo->fmt.y2 = visibleHdr[1] - 1; - + Tix_GrCallFormatCmd(wPtr, TIX_S_MARGIN); } @@ -2665,11 +2671,11 @@ wPtr->scrollInfo[0].offset + wPtr->hdrSize[0]; wPtr->renderInfo->fmt.x2 = wPtr->renderInfo->fmt.x1 + mainSize[0] - 1; - wPtr->renderInfo->fmt.y1 = + wPtr->renderInfo->fmt.y1 = wPtr->scrollInfo[1].offset + wPtr->hdrSize[1]; wPtr->renderInfo->fmt.y2 = wPtr->renderInfo->fmt.y1 + mainSize[1] - 1; - + Tix_GrCallFormatCmd(wPtr, TIX_MAIN); } } @@ -2738,7 +2744,7 @@ wPtr->mainRB->elms[x][y].selected = 1; break; case TIX_GR_TOGGLE: - wPtr->mainRB->elms[x][y].selected = + wPtr->mainRB->elms[x][y].selected = !wPtr->mainRB->elms[x][y].selected; break; @@ -2785,7 +2791,7 @@ } else { visibleHdr[1] = wPtr->hdrSize[1]; } - + /* Compute selection on the stationary part of the margin */ if (visibleHdr[0] > 0 && visibleHdr[1] > 0) { @@ -2795,8 +2801,8 @@ rect[1][1] = visibleHdr[1] - 1; offs[0] = 0; offs[1] = 0; - - Tix_GrComputeSubSelection(wPtr, rect, offs); + + Tix_GrComputeSubSelection(wPtr, rect, offs); } /* Compute selection on the horizontal margin @@ -2808,7 +2814,7 @@ rect[1][1] = visibleHdr[1] - 1; offs[0] = wPtr->scrollInfo[0].offset;; offs[1] = 0; - + Tix_GrComputeSubSelection(wPtr, rect, offs); } @@ -2821,7 +2827,7 @@ rect[1][1] = rect[1][0] + mainSize[1] - 1; offs[0] = 0; offs[1] = wPtr->scrollInfo[1].offset;; - + Tix_GrComputeSubSelection(wPtr, rect, offs); } @@ -2834,7 +2840,7 @@ rect[1][1] = rect[1][0] + mainSize[1] - 1; offs[0] = wPtr->scrollInfo[0].offset;; offs[1] = wPtr->scrollInfo[1].offset;; - + Tix_GrComputeSubSelection(wPtr, rect, offs); } } @@ -2854,7 +2860,7 @@ double usuable; usuable = 1.0 - siPtr->window; - + if (siPtr->max > 0) { first = usuable * (double)(siPtr->offset) / (double)(siPtr->max); last = first + siPtr->window; @@ -3013,7 +3019,7 @@ int winSize[2]; int exactSize[2]; /* BOOL: are all the visible coloums and rows * displayed in whole */ - int pad0, pad1; + int pad0, pad1; offset[0] = wPtr->scrollInfo[0].offset + wPtr->hdrSize[0]; offset[1] = wPtr->scrollInfo[1].offset + wPtr->hdrSize[1]; @@ -3089,7 +3095,7 @@ index = k + offset[i] - wPtr->hdrSize[i]; } - rbPtr->dispSize[i][k].size = TixGridDataGetRowColSize(wPtr, + rbPtr->dispSize[i][k].size = TixGridDataGetRowColSize(wPtr, wPtr->dataSet, i, index, &wPtr->defSize[i], &pad0, &pad1); rbPtr->dispSize[i][k].preBorder = pad0; rbPtr->dispSize[i][k].postBorder = pad1; @@ -3137,7 +3143,7 @@ for (k=0; k<2; k++) { for (i=0; isize[k]; i++) { - rbPtr->dispSize[k][i].total = + rbPtr->dispSize[k][i].total = rbPtr->dispSize[k][i].preBorder + rbPtr->dispSize[k][i].size + rbPtr->dispSize[k][i].postBorder; @@ -3230,12 +3236,12 @@ if (strncmp(argv[0], "row", len) == 0) { *which = 1; - if (TixGridDataGetIndex(interp, wPtr, NULL, args[1], &dummy, from) + if (TixGridDataGetIndex(interp, wPtr, NULL, objv[1], &dummy, from) !=TCL_OK) { return TCL_ERROR; } if (argc == 3) { - if (TixGridDataGetIndex(interp, wPtr, NULL, args[2], &dummy, to) + if (TixGridDataGetIndex(interp, wPtr, NULL, objv[2], &dummy, to) !=TCL_OK) { return TCL_ERROR; } @@ -3244,13 +3250,13 @@ } } else if (strncmp(argv[0], "column", len) == 0) { *which = 0; - if (TixGridDataGetIndex(interp, wPtr, args[1], NULL, from, &dummy) + if (TixGridDataGetIndex(interp, wPtr, objv[1], NULL, from, &dummy) !=TCL_OK) { return TCL_ERROR; } if (argc == 3) { - if (TixGridDataGetIndex(interp, wPtr, args[2], NULL, to, &dummy) + if (TixGridDataGetIndex(interp, wPtr, objv[2], NULL, to, &dummy) !=TCL_OK) { return TCL_ERROR; } Index: pTk/mTk/tixGeneric/tixHLHdr.c --- Tk800.022/pTk/mTk/tixGeneric/tixHLHdr.c Mon Nov 15 14:59:29 1999 +++ Tk800.023/pTk/mTk/tixGeneric/tixHLHdr.c Sat Dec 30 16:12:37 2000 @@ -81,7 +81,7 @@ 0, 0, (char *)hPtr, 0) != TCL_OK) { /* some unrecoverable errors */ return NULL; - } + } Tk_SetBackgroundFromBorder(wPtr->headerWin, hPtr->background); return hPtr; @@ -210,7 +210,7 @@ if (wPtr->needToRaise) { /* the needToRaise flag is set every time a new window item is * created inside the header of the HList. - * + * * We need to make sure that the windows items in the list * body are clipped by the header subwindow. However, the window * items inside the header should be over the header subwindow. @@ -260,7 +260,7 @@ wPtr->headerHeight - 2*hPtr->borderWidth, TIX_DITEM_NORMAL_FG); - if (wPtr->needToRaise && + if (wPtr->needToRaise && Tix_DItemType(hPtr->iPtr) == TIX_DITEM_WINDOW) { TixWindowItem * wiPtr; @@ -320,7 +320,7 @@ wPtr->headerDirty = 0; } - + /*---------------------------------------------------------------------- * "header" sub command *---------------------------------------------------------------------- @@ -368,7 +368,7 @@ WidgetPtr wPtr = (WidgetPtr) clientData; HListHeader * hPtr; - if ((hPtr=Tix_HLGetHeader(interp, wPtr, args[0], 1)) == NULL) { + if ((hPtr=Tix_HLGetHeader(interp, wPtr, objv[0], 1)) == NULL) { return TCL_ERROR; } @@ -390,7 +390,7 @@ WidgetPtr wPtr = (WidgetPtr) clientData; HListHeader * hPtr; - if ((hPtr=Tix_HLGetHeader(interp, wPtr, args[0], 1)) == NULL) { + if ((hPtr=Tix_HLGetHeader(interp, wPtr, objv[0], 1)) == NULL) { return TCL_ERROR; } @@ -436,7 +436,7 @@ Tix_DItem * iPtr; char * ditemType = NULL; - if ((hPtr=Tix_HLGetHeader(interp, wPtr, args[0], 0)) == NULL) { + if ((hPtr=Tix_HLGetHeader(interp, wPtr, objv[0], 0)) == NULL) { return TCL_ERROR; } @@ -502,7 +502,7 @@ WidgetPtr wPtr = (WidgetPtr) clientData; HListHeader * hPtr; - if ((hPtr=Tix_HLGetHeader(interp, wPtr, args[0], 1)) == NULL) { + if ((hPtr=Tix_HLGetHeader(interp, wPtr, objv[0], 1)) == NULL) { return TCL_ERROR; } @@ -533,7 +533,7 @@ WidgetPtr wPtr = (WidgetPtr) clientData; HListHeader * hPtr; - if ((hPtr=Tix_HLGetHeader(interp, wPtr, args[0], 0)) == NULL) { + if ((hPtr=Tix_HLGetHeader(interp, wPtr, objv[0], 0)) == NULL) { return TCL_ERROR; } @@ -560,17 +560,17 @@ WidgetPtr wPtr = (WidgetPtr) clientData; HListHeader * hPtr; - if ((hPtr=Tix_HLGetHeader(interp, wPtr, args[0], 1)) == NULL) { + if ((hPtr=Tix_HLGetHeader(interp, wPtr, objv[0], 1)) == NULL) { return TCL_ERROR; } if (hPtr->iPtr == NULL) { Tcl_AppendResult(interp, "entry \"", argv[0], - "\" does not have a header", (char*)NULL); + "\" does not have a header", (char*)NULL); return TCL_ERROR; } - Tcl_IntResults(interp,2, 0, - Tix_DItemWidth(hPtr->iPtr), - Tix_DItemHeight(hPtr->iPtr)); + Tcl_IntResults(interp,2, 0, + Tix_DItemWidth(hPtr->iPtr), + Tix_DItemHeight(hPtr->iPtr)); return TCL_OK; } Index: pTk/mTk/tixGeneric/tixHList.c --- Tk800.022/pTk/mTk/tixGeneric/tixHList.c Sat Mar 4 15:04:07 2000 +++ Tk800.023/pTk/mTk/tixGeneric/tixHList.c Sat Dec 30 16:12:37 2000 @@ -1,4 +1,4 @@ -/* +/* * tixHList.c -- * * This module implements "HList" widgets. @@ -57,7 +57,7 @@ {TK_CONFIG_CALLBACK, "-dragcmd", "dragCmd", "DragCmd", DEF_HLIST_DRAG_COMMAND, Tk_Offset(WidgetRecord, dragCmd), TK_CONFIG_NULL_OK}, - + {TK_CONFIG_BOOLEAN, "-drawbranch", "drawBranch", "DrawBranch", DEF_HLIST_DRAW_BRANCH, Tk_Offset(WidgetRecord, drawBranch), 0}, @@ -165,7 +165,7 @@ {TK_CONFIG_CALLBACK, "-sizecmd", "sizeCmd", "SizeCmd", DEF_HLIST_SIZE_COMMAND, Tk_Offset(WidgetRecord, sizeCmd), TK_CONFIG_NULL_OK}, - + {TK_CONFIG_STRING, "-takefocus", "takeFocus", "TakeFocus", DEF_HLIST_TAKE_FOCUS, Tk_Offset(WidgetRecord, takeFocus), TK_CONFIG_NULL_OK}, @@ -221,7 +221,7 @@ /* Extra procedures for this widget */ static HListElement * AllocElement _ANSI_ARGS_((WidgetPtr wPtr, - HListElement * parent, char * pathName, + HListElement * parent, char * pathName, char * name, char * ditemType)); static void AppendList _ANSI_ARGS_((WidgetPtr wPtr, HListElement *parent, HListElement *chPtr, int at, @@ -238,7 +238,7 @@ static void ComputeOneElementGeometry _ANSI_ARGS_((WidgetPtr wPtr, HListElement *chPtr, int indent)); static int ConfigElement _ANSI_ARGS_((WidgetPtr wPtr, - HListElement *chPtr, int argc, char ** argv, + HListElement *chPtr, int argc, char ** argv, int flags, int forced)); static int CurSelection _ANSI_ARGS_((Tcl_Interp * interp, WidgetPtr wPtr, HListElement * chPtr)); @@ -251,7 +251,7 @@ static void DrawElements _ANSI_ARGS_((WidgetPtr wPtr, Pixmap pixmap, GC gc, HListElement * chPtr, int x, int y, int xOffset)); -static void DrawOneElement _ANSI_ARGS_((WidgetPtr wPtr, +static void DrawOneElement _ANSI_ARGS_((WidgetPtr wPtr, Pixmap pixmap, GC gc, HListElement * chPtr, int x, int y, int xOffset)); static HListElement * FindElementAtPosition _ANSI_ARGS_((WidgetPtr wPtr, @@ -580,7 +580,7 @@ } /*---------------------------------------------------------------------- - * "add" sub command -- + * "add" sub command -- * * Add a new item into the list *---------------------------------------------------------------------- @@ -840,7 +840,7 @@ wrong_arg: - Tcl_AppendResult(interp, + Tcl_AppendResult(interp, "wrong # of arguments, should be pathName delete ", argv[0], " entryPath", NULL); return TCL_ERROR; @@ -871,7 +871,7 @@ return TCL_ERROR; } if (chPtr->col[0].iPtr == NULL) { - Tcl_AppendResult(interp, "Item \"", argv[0], + Tcl_AppendResult(interp, "Item \"", argv[0], "\" does not exist", (char*)NULL); return TCL_ERROR; } @@ -1028,7 +1028,7 @@ WidgetPtr wPtr = (WidgetPtr) clientData; HListElement * chPtr; size_t len = strlen(argv[0]); - + if (strncmp(argv[0], "anchor", len)==0) { if (wPtr->anchor) { Tcl_AppendResult(interp, wPtr->anchor->pathName, NULL); @@ -1073,8 +1073,8 @@ if ((chPtr = Tix_HLFindElement(interp, wPtr, argv[1])) == NULL) { return TCL_ERROR; } - - Tcl_AppendArg(interp, chPtr->data); + Tcl_IncrRefCount(chPtr->data); + Tcl_ListObjAppendElement(interp, Tcl_GetObjResult(interp), chPtr->data); return TCL_OK; } else if (strncmp(argv[0], "dragsite", len)==0) { @@ -1135,7 +1135,7 @@ if (nextPtr) { Tcl_AppendResult(interp, nextPtr->pathName, NULL); - } + } return TCL_OK; } @@ -1162,7 +1162,7 @@ prevPtr = FindPrevEntry(wPtr, chPtr); if (prevPtr) { Tcl_AppendResult(interp, prevPtr->pathName, NULL); - } + } return TCL_OK; } @@ -1170,7 +1170,7 @@ return CurSelection(interp, wPtr, wPtr->root); } else { - Tcl_AppendResult(interp, "unknown option \"", argv[0], + Tcl_AppendResult(interp, "unknown option \"", argv[0], "\": must be anchor, bbox, children, data, dragsite, dropsite, ", "exists, hidden, item, next, parent, prev or selection", NULL); @@ -1407,7 +1407,7 @@ if (wPtr->root->dirty || wPtr->allDirty) { /* - * We must update the geometry NOW otherwise we will wrong geometry + * We must update the geometry NOW otherwise we will wrong geometry * info */ Tix_HLCancelResizeWhenIdle(wPtr); @@ -1456,7 +1456,7 @@ y2 = pad+wYSize -1; } - if (y2 >= y1) { + if (y2 >= y1) { #ifdef _LANG Tcl_Obj *result = Tcl_NewListObj(0,NULL); Tcl_ListObjAppendElement(interp, result, Tcl_NewIntObj(x1)); @@ -1495,7 +1495,7 @@ cXSize = chPtr->col[0].width; } cYSize = chPtr->height; - wXSize = Tk_Width(wPtr->dispData.tkwin) - + wXSize = Tk_Width(wPtr->dispData.tkwin) - (2*wPtr->borderWidth + 2*wPtr->highlightWidth); wYSize = Tk_Height(wPtr->dispData.tkwin) - (2*wPtr->borderWidth + 2*wPtr->highlightWidth); @@ -1536,7 +1536,7 @@ } else if (y+cYSize > wPtr->topPixel+wYSize){ top = y+cYSize - wYSize ; - } + } if (top < 0) { top = 0; } @@ -1655,7 +1655,7 @@ } } else { - Tcl_AppendResult(interp, "unknown option \"", argv[0], + Tcl_AppendResult(interp, "unknown option \"", argv[0], "\": must be anchor, clear, get, includes or set", NULL); code = TCL_ERROR; } @@ -2030,7 +2030,7 @@ if (wPtr->dispData.tkwin != NULL) { wPtr->dispData.tkwin = NULL; wPtr->dispData.sizeChangedProc = NULL; - Tcl_DeleteCommand(wPtr->dispData.interp, + Tcl_DeleteCommand(wPtr->dispData.interp, Tcl_GetCommandName(wPtr->dispData.interp, wPtr->widgetCmd)); } Tix_HLCancelResizeWhenIdle(wPtr); @@ -2244,7 +2244,7 @@ int width = 0; if (wPtr->dispData.tkwin == NULL) { - panic("No tkwin"); + panic("No tkwin"); return; } @@ -2330,9 +2330,9 @@ void Tix_HLResizeWhenIdle(wPtr) WidgetPtr wPtr; -{ +{ if (wPtr->dispData.tkwin == NULL) { - panic("No tkwin"); + panic("No tkwin"); return; } @@ -2386,7 +2386,7 @@ WidgetPtr wPtr; { if (wPtr->dispData.tkwin == NULL) { - panic("No tkwin"); + panic("No tkwin"); return; } @@ -2404,7 +2404,7 @@ static void CancelRedrawWhenIdle(wPtr) WidgetPtr wPtr; -{ +{ if (wPtr->redrawing) { wPtr->redrawing = 0; @@ -2729,7 +2729,7 @@ char ** argv; char * pathName; /* Default pathname, if -pathname is not * specified in the options */ - char * defParentName; /* Default parent name (will NULL if pathName + char * defParentName; /* Default parent name (will NULL if pathName * is not NULL */ int * newArgc; { @@ -2789,7 +2789,7 @@ continue; } else if (strncmp(argv[i], "-at", len) == 0) { - if (Tcl_GetInt(interp, args[i+1], &at) != TCL_OK) { + if (Tcl_GetInt(interp, objv[i+1], &at) != TCL_OK) { chPtr = NULL; goto done; } @@ -2799,8 +2799,8 @@ copy: if (n!=i) { - args[n] = args[i]; - args[n+1] = args[i+1]; + objv[n] = objv[i]; + objv[n+1] = objv[i+1]; } n+=2; } @@ -2889,7 +2889,7 @@ if ((pathName[0] == sep) && (pathName[1] == '\0')) { /* * The separator by itself is also a toplevel entry - */ + */ parentName = 0; } else { parentName[0] = sep; @@ -2981,7 +2981,7 @@ int forced; /* We need a "forced" configure to ensure that * the DItem is initialized properly */ { - int sizeChanged; + int sizeChanged; if (wPtr->dispData.tkwin == NULL) panic("No tkwin"); @@ -3099,7 +3099,7 @@ /* FIXME: If we fall out of for loop chPtr is NULL, so we * cannot do chPtr->childHead as while loop implies * this is a quick-fix. - */ + */ return NULL; } } @@ -3147,7 +3147,7 @@ * * SelectionModifyRange -- * - * Select or de-select all the elements between from and to + * Select or de-select all the elements between from and to * (inclusive), according to the "select" argument. * * select == 1 : select @@ -3384,7 +3384,7 @@ ComputeElementGeometry(wPtr, ptr, indent); } - /* Propagate the child's size to the parent + /* Propagate the child's size to the parent * */ for (i=0; inumColumns; i++) { @@ -3401,7 +3401,7 @@ * * ComputeOneElementGeometry -- * - * Compute the geometry of the element itself, not including + * Compute the geometry of the element itself, not including * its children, according to its current display type. * * Results: @@ -3484,7 +3484,7 @@ branchX = iPtr->imagetext.bitmapW / 2; branchY = iPtr->imagetext.bitmapH; if (Tix_DItemHeight(iPtr) >iPtr->imagetext.bitmapH) { - branchY += (Tix_DItemHeight(iPtr) - + branchY += (Tix_DItemHeight(iPtr) - iPtr->imagetext.bitmapH) /2; } } @@ -3586,7 +3586,7 @@ if (wPtr->elmToSee != NULL) { HListElement *chPtr; - + if ((chPtr = Tix_HLFindElement(interp, wPtr, wPtr->elmToSee)) == NULL) { Tcl_ResetResult(interp); @@ -3605,7 +3605,7 @@ * Calculate the drawing parameters */ if (wPtr->wideSelect) { - wPtr->selectWidth = Tk_Width(wPtr->dispData.tkwin) - + wPtr->selectWidth = Tk_Width(wPtr->dispData.tkwin) - (2*wPtr->borderWidth + 2*wPtr->highlightWidth); if (wPtr->selectWidth < wPtr->totalSize[0]) { wPtr->selectWidth = wPtr->totalSize[0]; @@ -3642,7 +3642,7 @@ /* Draw the border */ Tk_Draw3DRectangle(wPtr->dispData.tkwin, buffer, wPtr->border, wPtr->highlightWidth, wPtr->highlightWidth, - Tk_Width(tkwin) - 2*wPtr->highlightWidth, + Tk_Width(tkwin) - 2*wPtr->highlightWidth, Tk_Height(tkwin) - 2*wPtr->highlightWidth, wPtr->borderWidth, wPtr->relief); } @@ -3703,7 +3703,7 @@ 0, 0, hdrW, hdrH, xOffset); if (buffer != Tk_WindowId(wPtr->headerWin)) { - XCopyArea(wPtr->dispData.display, buffer, + XCopyArea(wPtr->dispData.display, buffer, Tk_WindowId(wPtr->headerWin), wPtr->normalGC, 0, 0, hdrW, hdrH, 0, 0); @@ -3779,8 +3779,8 @@ oldY = childY; /* saved for 2nd iteration */ - /* find the last non-hidden element, - * to determine when to draw the vertical line + /* find the last non-hidden element, + * to determine when to draw the vertical line */ lastVisible = NULL; for (ptr = chPtr->childTail; ptr!=NULL; ptr=ptr->prev) { @@ -4215,7 +4215,7 @@ else { chPtr->next->prev = chPtr->prev; } - + FreeElement(wPtr, chPtr); } @@ -4255,7 +4255,7 @@ CheckScrollBar(wPtr, TIX_X); CheckScrollBar(wPtr, TIX_Y); - + if (wPtr->xScrollCmd) { total = wPtr->totalSize[0]; window = Tk_Width(wPtr->dispData.tkwin) @@ -4626,7 +4626,7 @@ if (changed) { RedrawWhenIdle(wPtr); } - } + } } Index: pTk/mTk/tixGeneric/tixInt.h --- Tk800.022/pTk/mTk/tixGeneric/tixInt.h Sat Jan 15 16:08:23 2000 +++ Tk800.023/pTk/mTk/tixGeneric/tixInt.h Sat Dec 30 16:12:37 2000 @@ -249,16 +249,16 @@ Tix_DItemInfo * diTypePtr; \ Tk_Anchor anchor; /* Anchor information */ \ char * name; /* Name of this style */ \ - int pad[2] /* paddings */ + int pad[2] /* paddings */ #if 0 Tix_Relief relief /* %bordercolor not used */ - int borderWidth; - XColor * borderColor; /* color of the border when it is displayed - * in "flat border" mode - */ + int borderWidth; + XColor * borderColor; /* color of the border when it is displayed + * in "flat border" mode + */ GC borderGC #endif @@ -332,7 +332,7 @@ Tk_Justify justify; /* Justification to use for multi-line text. */ TixFont font; int gap; /* Gap between text and image */ - Tk_Anchor textanchor; /* Text anchor information */ + Tk_Anchor textanchor; /* Text anchor information */ }; /*---------------------------------------------------------------------- @@ -445,7 +445,7 @@ /*---------------------------------------------------------------------- * Tix_ArgumentList -- - * + * * This data structure is used to split command arguments for * the display item types *---------------------------------------------------------------------- @@ -453,7 +453,7 @@ #define FIXED_SIZE 4 typedef struct { int argc; - Arg *args; + Tcl_Obj **objv; } Tix_Argument; typedef struct { @@ -464,7 +464,7 @@ /*---------------------------------------------------------------------- * Tix_ScrollInfo -- - * + * * This data structure encapsulates all the necessary operations * for scrolling widgets *---------------------------------------------------------------------- @@ -476,10 +476,10 @@ typedef struct Tix_ScrollInfo { int type; /* TIX_SCROLL_INT or TIX_SCROLL_DOUBLE */ LangCallback *command; - /* place holder for actual space - double must be mentioned + /* place holder for actual space - double must be mentioned to force alignment for too-clever-by-half compilers */ - union { + union { int iscroll[4]; double dscroll[4]; } info; @@ -673,7 +673,7 @@ EXTERN char * Tix_FindMethod _ANSI_ARGS_((Tcl_Interp *interp, char *context, char *method)); EXTERN char * Tix_FindPublicMethod _ANSI_ARGS_(( - Tcl_Interp *interp, TixClassRecord * cPtr, + Tcl_Interp *interp, TixClassRecord * cPtr, char * method)); EXTERN int Tix_GetChars _ANSI_ARGS_((Tcl_Interp *interp, char *string, double *doublePtr)); @@ -737,7 +737,7 @@ EXTERN void TixDItemStyleChanged _ANSI_ARGS_(( Tix_DItemInfo * diTypePtr, Tix_DItemStyle * stylePtr)); -EXTERN void TixDItemStyleFree _ANSI_ARGS_((Tix_DItem *iPtr, +EXTERN void TixDItemStyleFree _ANSI_ARGS_((Tix_DItem *iPtr, Tix_DItemStyle * stylePtr)); EXTERN void TixDItemGetAnchor _ANSI_ARGS_((Tk_Anchor anchor, int x, int y, int cav_w, int cav_h, @@ -788,7 +788,7 @@ typedef struct _TixpSubRegion TixpSubRegion; -/* +/* * Functions that should be used by Tix only. Functions prefixed by "Tix" * are generic functions that has one implementation for all platforms. * Functions prefixed with "Tixp" requires one implementation on each @@ -838,8 +838,8 @@ TixpSubRegion * subRegPtr, int x, int y, int width, int height)); -/* These functions are also, and originaly declared in tixPort.h but - * that would mean even more Vtables +/* These functions are also, and originaly declared in tixPort.h but + * that would mean even more Vtables */ EXTERN void TixComputeTextGeometry _ANSI_ARGS_(( Index: pTk/mTk/tixGeneric/tixTList.c --- Tk800.022/pTk/mTk/tixGeneric/tixTList.c Fri Apr 21 10:01:36 2000 +++ Tk800.023/pTk/mTk/tixGeneric/tixTList.c Sat Dec 30 16:12:37 2000 @@ -1145,7 +1145,7 @@ */ /* (1.1) Find out where */ - if (Tix_TranslateIndex(wPtr, interp, args[0], &at, 1) != TCL_OK) { + if (Tix_TranslateIndex(wPtr, interp, objv[0], &at, 1) != TCL_OK) { code = TCL_ERROR; goto done; } @@ -1264,7 +1264,7 @@ int index; char buff[100]; - if (Tix_TranslateIndex(wPtr, interp, args[0], &index, 0) != TCL_OK) { + if (Tix_TranslateIndex(wPtr, interp, objv[0], &index, 0) != TCL_OK) { return TCL_ERROR; } @@ -1408,7 +1408,7 @@ Tix_ArgcError(interp, argc+3, argv-3, 3, "index"); } - if (Tix_TranslateIndex(wPtr, interp, args[0], &index, 0) != TCL_OK) { + if (Tix_TranslateIndex(wPtr, interp, objv[0], &index, 0) != TCL_OK) { return TCL_ERROR; } @@ -1822,11 +1822,11 @@ ListEntry * toPtr; int from, to, tmp; - if (Tix_TranslateIndex(wPtr, interp, args[0], &from, 0) != TCL_OK) { + if (Tix_TranslateIndex(wPtr, interp, objv[0], &from, 0) != TCL_OK) { return TCL_ERROR; } if (argc == 2) { - if (Tix_TranslateIndex(wPtr, interp, args[1], &to, 0) != TCL_OK) { + if (Tix_TranslateIndex(wPtr, interp, objv[1], &to, 0) != TCL_OK) { return TCL_ERROR; } } else { Index: pTk/mTk/unix/tkUnixCursor.c --- Tk800.022/pTk/mTk/unix/tkUnixCursor.c Sat Mar 25 13:20:58 2000 +++ Tk800.023/pTk/mTk/unix/tkUnixCursor.c Sat Dec 30 16:12:37 2000 @@ -154,18 +154,18 @@ TkUnixCursor *cursorPtr = NULL; Cursor cursor = None; int argc; - Arg *args = NULL; + Tcl_Obj **objv = NULL; Pixmap source = None; Pixmap mask = None; Display *display = Tk_Display(tkwin); - if (Tcl_ListObjGetElements(interp, arg, &argc, &args) != TCL_OK) { + if (Tcl_ListObjGetElements(interp, arg, &argc, &objv) != TCL_OK) { return NULL; } if (argc == 0) { goto badString; } - if (LangString(args[0])[0] != '@') { + if (LangString(objv[0])[0] != '@') { XColor fg, bg; unsigned int maskIndex; register struct CursorName *namePtr; @@ -186,8 +186,8 @@ if (namePtr->name == NULL) { goto badString; } - if ((namePtr->name[0] == LangString(args[0])[0]) - && (strcmp(namePtr->name, LangString(args[0])) == 0)) { + if ((namePtr->name[0] == LangString(objv[0])[0]) + && (strcmp(namePtr->name, LangString(objv[0])) == 0)) { break; } } Index: pTk/mTk/unix/tkUnixWm.c --- Tk800.022/pTk/mTk/unix/tkUnixWm.c Sun Dec 12 13:58:37 1999 +++ Tk800.023/pTk/mTk/unix/tkUnixWm.c Sat Dec 30 16:12:37 2000 @@ -1,4 +1,4 @@ -/* +/* * tkUnixWm.c -- * * This module takes care of the interactions between a Tk-based @@ -40,7 +40,7 @@ static void ProtocolFree _ANSI_ARGS_((char *clientData)); -static void +static void ProtocolFree(clientData) char *clientData; {ProtocolHandler *p = (ProtocolHandler *) clientData; @@ -80,7 +80,7 @@ * destroyed. */ Tk_Window icon; /* Window to use as icon for this window, * or NULL. */ - Tk_Image iconImage; /* Image used to generate Icon - or NULL */ + Tk_Image iconImage; /* Image used to generate Icon - or NULL */ Tk_Window iconFor; /* Window for which this window is icon, or * NULL if this isn't an icon for anyone. */ int withdrawn; /* Non-zero means window has been withdrawn. */ @@ -330,6 +330,7 @@ typedef struct WaitRestrictInfo { Display *display; /* Window belongs to this display. */ Window window; /* We're waiting for events on this window. */ + Window parent; /* or this one - if reparented */ int type; /* We only care about this type of event. */ XEvent *eventPtr; /* Where to store the event when it's found. */ int foundEvent; /* Non-zero means that an event of the @@ -365,7 +366,7 @@ static void WaitForConfigureNotify _ANSI_ARGS_((TkWindow *winPtr, unsigned long serial)); static int WaitForEvent _ANSI_ARGS_((Display *display, - Window window, int type, XEvent *eventPtr)); + Window window, int type, XEvent *eventPtr, Window parent)); static void WaitForMapNotify _ANSI_ARGS_((TkWindow *winPtr, int mapped)); @@ -525,19 +526,19 @@ XSetWMName(winPtr->display, wmPtr->wrapperPtr->window, &textProp); XFree((char *) textProp.value); } - + TkWmSetClass(winPtr); if (wmPtr->iconName != NULL) { XSetIconName(winPtr->display, wmPtr->wrapperPtr->window, wmPtr->iconName); } - + if (wmPtr->master != None) { XSetTransientForHint(winPtr->display, wmPtr->wrapperPtr->window, wmPtr->master); } - + wmPtr->flags |= WM_UPDATE_SIZE_HINTS; UpdateHints(winPtr); UpdateWmProtocols(wmPtr); @@ -620,7 +621,7 @@ * mapped when in fact it is mapped. I suspect that this has something * to do with the window manager filtering Map events (and possily not * filtering Unmap events?). - */ + */ XUnmapWindow(winPtr->display, winPtr->wmInfoPtr->wrapperPtr->window); WaitForMapNotify(winPtr, 0); } @@ -692,7 +693,7 @@ if (wmPtr->iconName != NULL) { ckfree(wmPtr->iconName); } - if (wmPtr->hints.flags & IconPixmapHint) { + if (wmPtr->hints.flags & IconPixmapHint) { if (wmPtr->iconImage) { Tk_FreePixmap(winPtr->display, wmPtr->hints.icon_pixmap); Tk_FreeImage(wmPtr->iconImage); @@ -754,7 +755,7 @@ } ckfree((char *) wmPtr); winPtr->wmInfoPtr = NULL; -} +} /* @@ -802,7 +803,7 @@ * * TopLevelLostSlaveProc -- * - * This procedure is invoked when a toplevel window becomes + * This procedure is invoked when a toplevel window becomes * managed by another geometry manager. * * Results: @@ -814,12 +815,12 @@ *---------------------------------------------------------------------- */ -static +static void TopLevelLostSlaveProc(clientData, tkwin) ClientData clientData; Tk_Window tkwin; -{ +{ /* Don't do anything yet */ } @@ -838,7 +839,7 @@ * See the user documentation. * *---------------------------------------------------------------------- - */ + */ /* ARGSUSED */ int Tk_WmCmd(clientData, interp, argc, argv) @@ -853,7 +854,7 @@ register WmInfo *wmPtr; int c; size_t length; - int i; + int i; if (argc < 3) { Tcl_AppendResult(interp, "wrong # args: should be \"", @@ -874,8 +875,8 @@ argv[0], " tracing ?boolean?\"", (char *) NULL); return TCL_ERROR; } - if (argc == 3) { - Tcl_IntResults(interp,1,0, wmTracing); + if (argc == 3) { + Tcl_IntResults(interp,1,0, wmTracing); return TCL_OK; } return Tcl_GetBoolean(interp, argv[3], &wmTracing); @@ -914,12 +915,12 @@ wmPtr = winPtr->wmInfoPtr; wmPtr->hints.initial_state = WithdrawnState; wmPtr->withdrawn = 1; - + /* Size was set - force a call to Geometry Manager */ winPtr->reqWidth++; winPtr->reqHeight++; Tk_GeometryRequest((Tk_Window)winPtr, winPtr->reqWidth-1, winPtr->reqHeight-1); - + return TCL_OK; } else if (!(winPtr->flags & TK_TOP_LEVEL)) { @@ -982,8 +983,8 @@ wmPtr->hints.initial_state = WithdrawnState; wmPtr->withdrawn = 1; if (wmPtr->flags & WM_NEVER_MAPPED) { - /* Now handle all idletasks so that the initial - * idle map is certain to have happened + /* Now handle all idletasks so that the initial + * idle map is certain to have happened */ while (Tcl_DoOneEvent(TCL_IDLE_EVENTS)) { /* Empty loop body */ @@ -993,7 +994,7 @@ winPtr->screenNum) != 0) { WaitForMapNotify(winPtr, 0); } - } + } /* Dis-associate from wm - do this later ?*/ TkWmDeadWindow(winPtr); @@ -1013,7 +1014,7 @@ int i, done1 = 0, done2 = 0, count = 0; /* wmDontReparent is set to 2 if it is determined that - * the window manager does not do a reparent after + * the window manager does not do a reparent after * "wm capture" does the reparent. If that's the case, we don't * need to perform the hack */ @@ -1023,7 +1024,7 @@ * * To change a widget from a toplevel window to a non-toplevel * window, we reparent it (from the root window) to its - * real (TK) parent. However, after we do that, some window + * real (TK) parent. However, after we do that, some window * managers (mwm in particular), will reparent the widget, again, * to its decoration frames. In that case, we need to perform the * reparenting again. @@ -1044,7 +1045,7 @@ do { if (WaitForEvent(winPtr->display, winPtr->window, - StructureNotifyMask, &event) != TCL_OK) { + StructureNotifyMask, &event, None) != TCL_OK) { goto done; } Tk_HandleEvent(&event); @@ -1169,7 +1170,7 @@ } return TCL_OK; } - if (Tcl_ListObjGetElements(interp, args[3], &windowArgc, &windowArgs) + if (Tcl_ListObjGetElements(interp, objv[3], &windowArgc, &windowArgs) != TCL_OK) { return TCL_ERROR; } @@ -1216,11 +1217,12 @@ } if (argc == 3) { if (wmPtr->cmdArg != NULL) { - Tcl_ArgResult(interp,wmPtr->cmdArg); + Tcl_IncrRefCount(wmPtr->cmdArg); + Tcl_SetObjResult(interp,wmPtr->cmdArg); } return TCL_OK; } - if (LangNull(args[3])) { + if (LangNull(objv[3])) { if (wmPtr->cmdArgv != NULL) { TkWmFreeCmd(wmPtr); if (!(wmPtr->flags & WM_NEVER_MAPPED)) { @@ -1230,7 +1232,7 @@ } return TCL_OK; } - if (Tcl_ListObjGetElements(interp, args[3], &cmdArgc, &cmdArgs) != TCL_OK) { + if (Tcl_ListObjGetElements(interp, objv[3], &cmdArgc, &cmdArgs) != TCL_OK) { return TCL_ERROR; } if (wmPtr->cmdArgv != NULL) { @@ -1238,7 +1240,7 @@ } wmPtr->cmdArgv = (char **) ckalloc(cmdArgc*sizeof(char *)); wmPtr->cmdArgc = cmdArgc; - wmPtr->cmdArg = LangCopyArg(args[3]); + wmPtr->cmdArg = LangCopyArg(objv[3]); for (i=0; i < cmdArgc; i++) { wmPtr->cmdArgv[i] = LangString(cmdArgs[i]); @@ -1519,7 +1521,7 @@ wmPtr->hints.flags &= ~IconPixmapHint; wmPtr->iconImage = Tk_GetImage(interp, tkwin, argv[3], ImageChangedProc, (ClientData) winPtr); - if (wmPtr->iconImage != NULL) { + if (wmPtr->iconImage != NULL) { int width = 0; int height = 0; Tk_SizeOfImage(wmPtr->iconImage, &width, &height); @@ -1723,15 +1725,15 @@ if (wmPtr2->wrapperPtr == NULL) { CreateWrapper(wmPtr2); - } + } - /* Now disable btoon events on the wrapper as well ! */ + /* Now disable btoon events on the wrapper as well ! */ if (wmPtr2->wrapperPtr != NULL) { Tk_Attributes((Tk_Window) wmPtr2->wrapperPtr)->event_mask &= ~(ButtonPressMask | ButtonReleaseMask | ButtonMotionMask); Tk_ChangeWindowAttributes( - (Tk_Window) wmPtr2->wrapperPtr, + (Tk_Window) wmPtr2->wrapperPtr, CWEventMask, Tk_Attributes((Tk_Window) wmPtr2->wrapperPtr)); } @@ -1851,7 +1853,7 @@ &atts); if (winPtr->wmInfoPtr->wrapperPtr != NULL) { Tk_ChangeWindowAttributes( - (Tk_Window) winPtr->wmInfoPtr->wrapperPtr, + (Tk_Window) winPtr->wmInfoPtr->wrapperPtr, CWSaveUnder, &atts); } } else if ((c == 'p') && (strncmp(argv[1], "positionfrom", length) == 0) @@ -1920,7 +1922,7 @@ for (protPtr = wmPtr->protPtr; protPtr != NULL; protPtr = protPtr->nextPtr) { if (protPtr->protocol == protocol) { - Tcl_ArgResult(interp,LangCallbackArg(protPtr->command)); + Tcl_SetObjResult(interp,LangCallbackObj(protPtr->command)); return TCL_OK; } } @@ -1952,7 +1954,7 @@ protPtr->nextPtr = wmPtr->protPtr; wmPtr->protPtr = protPtr; protPtr->interp = interp; - protPtr->command = LangMakeCallback(args[4]); + protPtr->command = LangMakeCallback(objv[4]); } if (!(wmPtr->flags & WM_NEVER_MAPPED)) { UpdateWmProtocols(wmPtr); @@ -2147,7 +2149,7 @@ } WaitForMapNotify(winPtr, 0); } else if ((c == 'w') && (strncmp(argv[1], "wrapper", length) == 0) - && (length >= 2)) { + && (length >= 2)) { if (wmPtr->wrapperPtr == NULL) { CreateWrapper(wmPtr); } @@ -2257,7 +2259,7 @@ wmPtr->height = -1; } - /* + /* * Set the new gridding information, and start the process of passing * all of this information to the window manager. */ @@ -2367,7 +2369,7 @@ TkWindow *wrapperPtr = wmPtr->wrapperPtr; TkWindow *winPtr = wmPtr->winPtr; - /* + /* * Update size information from the event. There are a couple of * tricky points here: * @@ -2792,7 +2794,7 @@ * Tk_DestroyWindow will try to destroy the window, but of course * it's already gone. */ - + handler = Tk_CreateErrorHandler(wmPtr->winPtr->display, -1, -1, -1, (Tk_ErrorProc *) NULL, (ClientData) NULL); Tk_DestroyWindow((Tk_Window) wmPtr->winPtr); @@ -2831,7 +2833,7 @@ mapEvent = *eventPtr; mapEvent.xexpose.window = wmPtr->winPtr->window; Tk_HandleEvent(&mapEvent); - } + } return; doMapEvent: @@ -3272,6 +3274,7 @@ XEvent event; int diff, code; int gotConfig = 0; + Window window = (wmPtr->reparent != None) ? wmPtr->reparent : wmPtr->wrapperPtr->window; /* * One more tricky detail about this procedure. In some cases the @@ -3281,10 +3284,32 @@ * then give up. */ + /* + * Note too that if window manager has reparented the window it may achieve + * the result by configuring the parent so we need to watch the parent too. + */ + + if (window != wmPtr->wrapperPtr->window) { + Tk_ErrorHandler handler; + /* + * We're going to have to wait for events on a window that + * Tk doesn't own, so we have to tell X specially that we + * want to get events on that window. To make matters worse, + * it's possible that the window doesn't exist anymore (e.g. + * the toplevel could have been withdrawn) so ignore events + * occurring during the request. + */ + + handler = Tk_CreateErrorHandler(winPtr->display, -1, -1, -1, + (Tk_ErrorProc *) NULL, (ClientData) NULL); + XSelectInput(winPtr->display, window, StructureNotifyMask); + Tk_DeleteErrorHandler(handler); + } + while (!gotConfig) { wmPtr->flags |= WM_SYNC_PENDING; code = WaitForEvent(winPtr->display, wmPtr->wrapperPtr->window, - ConfigureNotify, &event); + ConfigureNotify, &event, window); wmPtr->flags &= ~WM_SYNC_PENDING; if (code != TCL_OK) { if (wmTracing) { @@ -3303,6 +3328,20 @@ printf("WaitForConfigureNotify finished with %s, serial %ld\n", winPtr->pathName, serial); } + + if (window != wmPtr->wrapperPtr->window) { + Tk_ErrorHandler handler; + /* + * Ignore errors that occur when we are de-selecting events on + * window, since it's possible that the window doesn't exist + * anymore (see comment above previous call to XSelectInput). + */ + + handler = Tk_CreateErrorHandler(winPtr->display, -1, -1, -1, + (Tk_ErrorProc *) NULL, (ClientData) NULL); + XSelectInput(winPtr->display, window, (long) 0); + Tk_DeleteErrorHandler(handler); + } } /* @@ -3330,11 +3369,12 @@ */ static int -WaitForEvent(display, window, type, eventPtr) +WaitForEvent(display, window, type, eventPtr, parent) Display *display; /* Display event is coming from. */ Window window; /* Window for which event is desired. */ int type; /* Type of event that is wanted. */ XEvent *eventPtr; /* Place to store event. */ + Window parent; /* Parent window may get event instead */ { WaitRestrictInfo info; Tk_RestrictProc *oldRestrictProc; @@ -3352,6 +3392,7 @@ info.type = type; info.eventPtr = eventPtr; info.foundEvent = 0; + info.parent = parent; oldRestrictProc = Tk_RestrictEvents(WaitRestrictProc, (ClientData) &info, &oldRestrictData); @@ -3405,7 +3446,7 @@ if (eventPtr->type == SelectionNotify) { return TK_PROCESS_EVENT; } - if ((eventPtr->xany.window != infoPtr->window) + if ((eventPtr->xany.window != infoPtr->window && eventPtr->xany.window != infoPtr->parent) || (eventPtr->xany.display != infoPtr->display)) { return TK_DEFER_EVENT; } @@ -3468,7 +3509,7 @@ } wmPtr->flags |= WM_SYNC_PENDING; code = WaitForEvent(winPtr->display, wmPtr->wrapperPtr->window, - mapped ? MapNotify : UnmapNotify, &event); + mapped ? MapNotify : UnmapNotify, &event, None); wmPtr->flags &= ~WM_SYNC_PENDING; if (code != TCL_OK) { /* @@ -3725,7 +3766,7 @@ if (root == None) { root = RootWindowOfScreen(Tk_Screen((Tk_Window)winPtr)); } - XTranslateCoordinates(winPtr->display, winPtr->window, + XTranslateCoordinates(winPtr->display, winPtr->window, root, 0, 0, &rootX, &rootY, &dummyChild); x += rootX; y += rootY; @@ -4408,7 +4449,7 @@ * to handle all of this stuff, so be careful to use it instead * of XConfigureWindow. */ - + #if 0 if (!(mask & CWSibling)) { window = winPtr->window; @@ -4416,57 +4457,15 @@ #endif serial = NextRequest(winPtr->display); - if (window != wrapperPtr->window) { - /* - * We're going to have to wait for events on a window that - * Tk doesn't own, so we have to tell X specially that we - * want to get events on that window. To make matters worse, - * it's possible that the window doesn't exist anymore (e.g. - * the toplevel could have been withdrawn) so ignore events - * occurring during the request. - */ - - handler = Tk_CreateErrorHandler(winPtr->display, -1, -1, -1, - (Tk_ErrorProc *) NULL, (ClientData) NULL); - XSelectInput(winPtr->display, window, StructureNotifyMask); - Tk_DeleteErrorHandler(handler); - } XReconfigureWMWindow(winPtr->display, wrapperPtr->window, Tk_ScreenNumber((Tk_Window) winPtr), mask, &changes); /* * Wait for the reconfiguration to complete. If we don't wait, then * the window may not restack for a while and the application might - * observe it before it has restacked. Waiting for the reconfiguration - * is tricky if winPtr has been reparented, since the window getting - * the event isn't one that Tk owns. + * observe it before it has restacked. */ - - if (window == wrapperPtr->window) { - WaitForConfigureNotify(winPtr, serial); - } else { - while (1) { - if (WaitForEvent(winPtr->display, window, ConfigureNotify, - &event) != TCL_OK) { - break; - } - diff = event.xconfigure.serial - serial; - if (diff >= 0) { - break; - } - } - - /* - * Ignore errors that occur when we are de-selecting events on - * window, since it's possible that the window doesn't exist - * anymore (see comment above previous call to XSelectInput). - */ - - handler = Tk_CreateErrorHandler(winPtr->display, -1, -1, -1, - (Tk_ErrorProc *) NULL, (ClientData) NULL); - XSelectInput(winPtr->display, window, (long) 0); - Tk_DeleteErrorHandler(handler); - } + WaitForConfigureNotify(winPtr, serial); } /* @@ -5169,7 +5168,7 @@ return wmPtr->wrapperPtr; } - + /* Support Procedures for release and capture */ /* *---------------------------------------------------------------------- @@ -5240,7 +5239,7 @@ * Tk_DestroyWindow will try to destroy the window, but of course * it's already gone. */ - + handler = Tk_CreateErrorHandler(winPtr->display, -1, -1, -1, (Tk_ErrorProc *) NULL, (ClientData) NULL); Tk_DestroyWindow((Tk_Window) winPtr); @@ -5291,9 +5290,9 @@ register TkWindow *winPtr = (TkWindow *) clientData; WmInfo *wmPtr = winPtr->wmInfoPtr; Pixmap old = wmPtr->hints.icon_pixmap; - Pixmap pixmap = Tk_GetPixmap(winPtr->display, + Pixmap pixmap = Tk_GetPixmap(winPtr->display, RootWindowOfScreen(Tk_Screen((Tk_Window)winPtr)), - imageWidth, imageHeight, + imageWidth, imageHeight, DefaultDepthOfScreen(Tk_Screen((Tk_Window)winPtr))); if (pixmap != None) { Tk_RedrawImage(wmPtr->iconImage, 0, 0, imageWidth, imageHeight, pixmap, 0, 0); Index: pTk/mTk/win/tkWinDialog.c --- Tk800.022/pTk/mTk/win/tkWinDialog.c Mon Nov 15 14:59:31 1999 +++ Tk800.023/pTk/mTk/win/tkWinDialog.c Sat Dec 30 16:12:37 2000 @@ -76,14 +76,14 @@ static int TkGetFileName _ANSI_ARGS_((ClientData clientData, - Tcl_Interp *interp, int argc, Arg *args, + Tcl_Interp *interp, int argc, Tcl_Obj **objv, int isOpen)); static UINT CALLBACK ColorDlgHookProc _ANSI_ARGS_((HWND hDlg, UINT uMsg, WPARAM wParam, LPARAM lParam)); static int MakeFilter _ANSI_ARGS_((Tcl_Interp *interp, OPENFILENAME *ofnPtr, Arg string)); static int ParseFileDlgArgs _ANSI_ARGS_((Tcl_Interp * interp, - OPENFILENAME *ofnPtr, int argc, Arg *args, + OPENFILENAME *ofnPtr, int argc, Tcl_Obj **objv, int isOpen)); static int ProcessCDError _ANSI_ARGS_((Tcl_Interp * interp, DWORD dwErrorCode, HWND hWnd)); @@ -387,13 +387,13 @@ */ int -Tk_GetOpenFileCmd(clientData, interp, argc, argv) +Tk_GetOpenFileCmd(clientData, interp, argc, objv) ClientData clientData; /* Main window associated with interpreter. */ Tcl_Interp *interp; /* Current interpreter. */ int argc; /* Number of arguments. */ - Arg *args; /* Argument strings. */ + Tcl_Obj **objv; /* Argument strings. */ { - return TkGetFileName(clientData, interp, argc, args, OPEN_FILE); + return TkGetFileName(clientData, interp, argc, objv, OPEN_FILE); } /* @@ -418,9 +418,9 @@ ClientData clientData; /* Main window associated with interpreter. */ Tcl_Interp *interp; /* Current interpreter. */ int argc; /* Number of arguments. */ - Arg *args; /* Argument strings. */ + Tcl_Obj **objv; /* Argument strings. */ { - return TkGetFileName(clientData, interp, argc, args, SAVE_FILE); + return TkGetFileName(clientData, interp, argc, objv, SAVE_FILE); } /* @@ -440,11 +440,11 @@ */ static int -TkGetFileName(clientData, interp, argc, args, isOpen) +TkGetFileName(clientData, interp, argc, objv, isOpen) ClientData clientData; /* Main window associated with interpreter. */ Tcl_Interp *interp; /* Current interpreter. */ int argc; /* Number of arguments. */ - Arg *args; /* Argument strings. */ + Tcl_Obj **objv; /* Argument strings. */ int isOpen; /* true if we should call GetOpenFileName(), * false if we should call GetSaveFileName() */ { @@ -458,7 +458,7 @@ /* * 1. Parse the arguments. */ - if (ParseFileDlgArgs(interp, ofnPtr, argc, args, isOpen) != TCL_OK) { + if (ParseFileDlgArgs(interp, ofnPtr, argc, objv, isOpen) != TCL_OK) { return TCL_ERROR; } custData = (OpenFileData*) ofnPtr->lCustData; @@ -542,7 +542,7 @@ Tcl_Interp * interp; /* Current interpreter. */ OPENFILENAME *ofnPtr; /* Info about the file dialog */ int argc; /* Number of arguments. */ - Arg *args; /* Argument strings. */ + Tcl_Obj **objv; /* Argument strings. */ int isOpen; /* true if we should call GetOpenFileName(), * false if we should call GetSaveFileName() */ { @@ -611,7 +611,7 @@ else if (strncmp(argv[i], "-filetypes", len)==0) { if (v==argc) {goto arg_missing;} - if (MakeFilter(interp, ofnPtr, args[v]) != TCL_OK) { + if (MakeFilter(interp, ofnPtr,objv[v]) != TCL_OK) { return TCL_ERROR; } doneFilter = 1; Index: pTk/mTk/win/tkWinWm.c --- Tk800.022/pTk/mTk/win/tkWinWm.c Mon Mar 27 15:07:36 2000 +++ Tk800.023/pTk/mTk/win/tkWinWm.c Sat Dec 30 16:12:37 2000 @@ -1303,7 +1303,7 @@ } return TCL_OK; } - if (Tcl_ListObjGetElements(interp, args[3], &windowArgc, &windowArgv) + if (Tcl_ListObjGetElements(interp, objv[3], &windowArgc, &windowArgv) != TCL_OK) { return TCL_ERROR; } @@ -1361,7 +1361,8 @@ } if (argc == 3) { if (wmPtr->cmdArgv != NULL) { - Tcl_ArgResult(interp, wmPtr->cmdArgv); + Tcl_IncrRefCount(wmPtr->cmdArgv); + Tcl_SetObjResult(interp, wmPtr->cmdArgv); } return TCL_OK; } @@ -1376,13 +1377,13 @@ } return TCL_OK; } - if (Tcl_ListObjGetElements(interp, args[3], &cmdArgc, &cmdArgv) != TCL_OK) { + if (Tcl_ListObjGetElements(interp, objv[3], &cmdArgc, &cmdArgv) != TCL_OK) { return TCL_ERROR; } if (wmPtr->cmdArgv != NULL) { Tcl_DecrRefCount(wmPtr->cmdArgv); } - wmPtr->cmdArgv = args[3]; + wmPtr->cmdArgv = objv[3]; Tcl_IncrRefCount(wmPtr->cmdArgv); if (!(wmPtr->flags & WM_NEVER_MAPPED)) { char **cmdArgs = (char **) ckalloc((cmdArgc+1)*sizeof(char *)); @@ -2024,7 +2025,7 @@ for (protPtr = wmPtr->protPtr; protPtr != NULL; protPtr = protPtr->nextPtr) { if (protPtr->protocol == protocol) { - Tcl_ArgResult(interp,LangCallbackArg(protPtr->command)); + Tcl_SetObjResult(interp,LangCallbackObj(protPtr->command)); return TCL_OK; } } @@ -2056,7 +2057,7 @@ protPtr->nextPtr = wmPtr->protPtr; wmPtr->protPtr = protPtr; protPtr->interp = interp; - protPtr->command = LangMakeCallback(args[4]); + protPtr->command = LangMakeCallback(objv[4]); } } else if ((c == 'r') && (strncmp(argv[1], "resizable", length) == 0)) { int width, height; @@ -2177,7 +2178,7 @@ } if (argc == 3) { if (wmPtr->masterPtr != NULL) { - Tcl_ArgResult(interp, LangWidgetArg(interp, (Tk_Window)(wmPtr->masterPtr))); + Tcl_SetObjResult(interp, LangWidgetObj(interp, (Tk_Window)(wmPtr->masterPtr))); } return TCL_OK; } Index: pTk/mTk/win/tkWinX.c --- Tk800.022/pTk/mTk/win/tkWinX.c Mon Mar 27 15:07:36 2000 +++ Tk800.023/pTk/mTk/win/tkWinX.c Sat Dec 30 16:12:37 2000 @@ -20,11 +20,9 @@ * The zmouse.h file includes the definition for WM_MOUSEWHEEL. */ -#ifndef __GNUC__ // not in Minw32 yet #ifndef __BORLANDC__ #include #endif -#endif #ifndef WM_MOUSEWHEEL #define WM_MOUSEWHEEL (WM_MOUSELAST+1) // message that will be supported // by the OS @@ -53,6 +51,10 @@ * Forward declarations of procedures used in this file. */ +#ifdef __CYGWIN__ +static void DisplayFileProc _ANSI_ARGS_((ClientData clientData, + int flags)); +#endif static void GenerateXEvent _ANSI_ARGS_((HWND hwnd, UINT message, WPARAM wParam, LPARAM lParam)); static unsigned int GetState _ANSI_ARGS_((UINT message, WPARAM wParam, @@ -384,6 +386,12 @@ AllocNone); winDisplay = (TkDisplay *) ckalloc(sizeof(TkDisplay)); winDisplay->display = display; +#ifdef __CYGWIN__ + if((ConnectionNumber(display) = open("/dev/windows", O_RDONLY)) < 0) + return NULL; + Tcl_CreateFileHandler(ConnectionNumber(display), TCL_READABLE, + DisplayFileProc, (ClientData) winDisplay); +#endif return winDisplay; } @@ -447,10 +455,64 @@ } ckfree((char *) display->screens); } +#ifdef __CYGWIN__ + if (dispPtr->display != 0) { + Tcl_DeleteFileHandler(ConnectionNumber(dispPtr->display)); + close(ConnectionNumber(dispPtr->display)); + } +#endif ckfree((char *) display); ckfree((char *) dispPtr); } +#ifdef __CYGWIN__ +/* + *---------------------------------------------------------------------- + * + * DisplayFileProc -- + * + * This procedure implements the file handler for the /dev/windows + * connection. + * + * Results: + * None. + * + * Side effects: + * Process Win32 message queue. Compare to tclWin/tclWinNotify.c + * Tcl_WaitForEvent() event loop. + * + *---------------------------------------------------------------------- + */ + +static void +DisplayFileProc(clientData, flags) + ClientData clientData; /* The display pointer. */ + int flags; /* Should be TCL_READABLE. */ +{ + TkDisplay *dispPtr = (TkDisplay *) clientData; + Display *display = dispPtr->display; + MSG msg; + int n; + + /* NOTE: read returns the result of GetMessage */ + /* *not* the number of bytes read */ + n = read(ConnectionNumber(display), &msg, sizeof(MSG)); + if(n == 0) { + /* + * The application is exiting, so repost the quit message + * and start unwinding. + */ + + PostQuitMessage(msg.wParam); + return; + } + if(n > 0) { + TranslateMessage(&msg); + DispatchMessage(&msg); + } +} +#endif + /* *---------------------------------------------------------------------- * @@ -1132,9 +1194,5 @@ unsigned long TkpGetMS() { -#ifdef __GNUC__ - return GetTickCount(); -#else return GetCurrentTime(); -#endif } Index: pTk/port.h --- /dev/null Sat Dec 30 02:58:04 2000 +++ Tk800.023/pTk/port.h Sat Dec 30 16:12:37 2000 @@ -0,0 +1,32 @@ +/* + * Warning, this file was automatically created by the TIFF configure script + * VERSION: v3.5.5 + * DATE: Sun Jul 16 20:21:17 MET DST 2000 + * TARGET: i386-unknown-linux + * CCOMPILER: /usr/bin/gcc-2.7.2.1 + */ +#ifndef _PORT_ +#define _PORT_ 1 +#ifdef __cplusplus +extern "C" { +#endif +#include +#define HOST_FILLORDER FILLORDER_LSB2MSB +#define HOST_BIGENDIAN 0 +#define HAVE_MMAP 1 +#include +#include +#include +#include +#include +typedef double dblparam_t; +#ifdef __STRICT_ANSI__ +#define INLINE __inline__ +#else +#define INLINE inline +#endif +#define GLOBALDATA(TYPE,NAME) extern TYPE NAME +#ifdef __cplusplus +} +#endif +#endif Index: pTk/ptkCanvGroup.c --- Tk800.022/pTk/ptkCanvGroup.c Fri Mar 24 16:41:09 2000 +++ Tk800.023/pTk/ptkCanvGroup.c Sat Dec 30 16:12:37 2000 @@ -1,4 +1,4 @@ -/* +/* * ptkCanvGroup.c -- * * This file implements grid items for canvas @@ -35,7 +35,7 @@ /* * Information used for parsing configuration specs: - */ + */ static int MembersParseProc _ANSI_ARGS_((ClientData clientData, Tcl_Interp *interp, Tk_Window tkwin, @@ -47,7 +47,7 @@ static Tk_CustomOption stateOption = { Tk_StateParseProc, - Tk_StatePrintProc, (ClientData) 2 + Tk_StatePrintProc, (ClientData) 3 }; static Tk_CustomOption tagsOption = { Tk_CanvasTagsParseProc, @@ -108,7 +108,7 @@ Tk_Item *itemPtr, double deltaX, double deltaY)); static int GroupIndex _ANSI_ARGS_((Tcl_Interp *interp, Tk_Canvas canvas, Tk_Item *itemPtr, Tcl_Obj *indexString, - int *indexPtr)); + int *indexPtr)); static int GroupInsert _ANSI_ARGS_((Tk_Canvas canvas, Tk_Item *itemPtr, int beforeThis, Tcl_Obj *string)); static void GroupInsertProc _ANSI_ARGS_((Tk_Canvas canvas, @@ -137,7 +137,7 @@ ScaleGroup, /* scaleProc */ TranslateGroup, /* translateProc */ GroupIndex, /* indexProc */ - (Tk_ItemCursorProc *) NULL, /* icursorProc */ /* Abuse to set active? */ + (Tk_ItemCursorProc *) NULL, /* icursorProc */ /* Abuse to set active? */ (Tk_ItemSelectionProc *) NULL, /* selectionProc */ GroupInsertProc, /* insertProc */ GroupDChars, /* dTextProc */ @@ -203,7 +203,7 @@ { GroupItem *groupPtr = (GroupItem *) itemPtr; int i; - + if (argc==1) { i = 1; } else { @@ -353,7 +353,7 @@ GroupItem *groupPtr = (GroupItem *) itemPtr; Tk_Item *saveGroup = canvasPtr->activeGroup; Tk_State state = Tk_GetItemState(canvas, itemPtr); - int i; + int i; Tk_Window tkwin = Tk_CanvasTkwin(canvas); if (Tk_ConfigureWidget(interp, tkwin, configSpecs, argc, args, @@ -401,24 +401,24 @@ GroupItem *groupPtr = (GroupItem *) itemPtr; Tk_Item *saveGroup = canvasPtr->activeGroup; Tk_State state = Tk_GetItemState(canvas, itemPtr); - int i; + int i; canvasPtr->activeGroup = itemPtr; for (i=groupPtr->numMembers-1; i >= 0; i--) { Tk_Item *subitemPtr = groupPtr->members[i]; - TkGroupRemoveItem(subitemPtr); + TkGroupRemoveItem(subitemPtr); #ifdef DELETE_GROUP_DELETES_MEMBERS - if (subitemPtr != NULL) { + if (subitemPtr != NULL) { (*subitemPtr->typePtr->deleteProc)(canvas, subitemPtr, display); } #endif } canvasPtr->activeGroup = saveGroup; if (groupPtr->members) { - ckfree((char *) groupPtr->members); + ckfree((char *) groupPtr->members); } -} +} void @@ -432,13 +432,13 @@ if (groupPtr->members[i] == itemPtr) { int j; for (j=i+1; j < groupPtr->numMembers; j++) { - groupPtr->members[j-1] = groupPtr->members[j]; + groupPtr->members[j-1] = groupPtr->members[j]; } itemPtr->redraw_flags |= FORCE_REDRAW; groupPtr->numMembers--; itemPtr->group = NULL; return; - } + } } } itemPtr->group = NULL; @@ -476,12 +476,12 @@ Tk_Item *saveGroup = canvasPtr->activeGroup; Tk_State state = Tk_GetItemState(canvas, &groupPtr->header); int seen = 0; - int i; + int i; canvasPtr->activeGroup = &groupPtr->header; for (i=0; i < groupPtr->numMembers; i++) { Tk_Item *subitemPtr = groupPtr->members[i]; - if (subitemPtr != NULL) { + if (subitemPtr != NULL) { if (Tk_GetItemState(canvas, subitemPtr) == TK_STATE_HIDDEN) { continue; } @@ -493,21 +493,21 @@ groupPtr->header.x2 = subitemPtr->x2; groupPtr->header.y2 = subitemPtr->y2; } else { - if (subitemPtr->x1 < groupPtr->header.x1) { + if (subitemPtr->x1 < groupPtr->header.x1) { groupPtr->header.x1 = subitemPtr->x1; } - if (subitemPtr->y1 < groupPtr->header.y1) { + if (subitemPtr->y1 < groupPtr->header.y1) { groupPtr->header.y1 = subitemPtr->y1; } - if (subitemPtr->x2 > groupPtr->header.x2) { + if (subitemPtr->x2 > groupPtr->header.x2) { groupPtr->header.x2 = subitemPtr->x2; } - if (subitemPtr->y2 > groupPtr->header.y2) { + if (subitemPtr->y2 > groupPtr->header.y2) { groupPtr->header.y2 = subitemPtr->y2; } } } - } + } canvasPtr->activeGroup = saveGroup; /* If all items were hidden then have a "null" bbox */ @@ -552,20 +552,20 @@ GroupItem *groupPtr = (GroupItem *) itemPtr; Tk_Item *saveGroup = canvasPtr->activeGroup; Tk_State state = Tk_GetItemState(canvas, itemPtr); - int i; + int i; if (state == TK_STATE_HIDDEN) { return; } canvasPtr->activeGroup = itemPtr; for (i=0; i < groupPtr->numMembers; i++) { Tk_Item *subitemPtr = groupPtr->members[i]; - if (subitemPtr != NULL) { + if (subitemPtr != NULL) { if (Tk_GetItemState(canvas, subitemPtr) == TK_STATE_HIDDEN) { continue; } - if (drawable != None || + if (drawable != None || (subitemPtr->typePtr->flags & TK_ITEM_ALWAYS_REDRAW)) { - (*subitemPtr->typePtr->displayProc)(canvas, subitemPtr, display, + (*subitemPtr->typePtr->displayProc)(canvas, subitemPtr, display, drawable, x, y, width, height); } } @@ -585,7 +585,7 @@ * The return value is 0 if the point whose x and y coordinates * are coordPtr[0] and coordPtr[1] is inside the group. If the * point isn't inside the rectangle then the return value is the - * distance from the point to the group. + * distance from the point to the group. * * Side effects: * None. @@ -604,7 +604,7 @@ GroupItem *groupPtr = (GroupItem *) itemPtr; Tk_Item *saveGroup = canvasPtr->activeGroup; Tk_State state = Tk_GetItemState(canvas, itemPtr); - int i; + int i; double best = 1.0e36; @@ -612,10 +612,15 @@ return best; } + /* If the group is active it is invisible to picking */ + if (state == TK_STATE_ACTIVE) { + return best; + } + canvasPtr->activeGroup = itemPtr; for (i=0; i < groupPtr->numMembers; i++) { Tk_Item *subitemPtr = groupPtr->members[i]; - if (subitemPtr != NULL) { + if (subitemPtr != NULL) { double try = (*subitemPtr->typePtr->pointProc)(canvas, subitemPtr, pointPtr); if (try < best) { best = try; @@ -663,19 +668,24 @@ GroupItem *groupPtr = (GroupItem *) itemPtr; Tk_Item *saveGroup = canvasPtr->activeGroup; Tk_State state = Tk_GetItemState(canvas, itemPtr); - int i; + int i; #define ALL_OUTSIDE 1 #define ALL_INSIDE 2 - int seen = ALL_INSIDE|ALL_OUTSIDE; + int seen = ALL_INSIDE|ALL_OUTSIDE; if (state == TK_STATE_HIDDEN) { return -1; } + /* If the group is active it is invisible to picking */ + if (state == TK_STATE_ACTIVE) { + return -1; + } + canvasPtr->activeGroup = itemPtr; for (i=0; i < groupPtr->numMembers; i++) { Tk_Item *subitemPtr = groupPtr->members[i]; - if (subitemPtr != NULL) { + if (subitemPtr != NULL) { int inner = (*subitemPtr->typePtr->areaProc)(canvas, subitemPtr, areaPtr); if (inner < 0) /* outside */ seen &= ~ALL_INSIDE; /* clear the inside option */ @@ -690,12 +700,12 @@ canvasPtr->activeGroup = saveGroup; switch (seen) { - case 0 : + case 0 : return 0; - case ALL_INSIDE : + case ALL_INSIDE : return 1; default: - case ALL_OUTSIDE : + case ALL_OUTSIDE : return -1; } } @@ -734,7 +744,7 @@ GroupItem *groupPtr = (GroupItem *) itemPtr; Tk_Item *saveGroup = canvasPtr->activeGroup; Tk_State state = Tk_GetItemState(canvas, itemPtr); - int i; + int i; groupPtr->posn[0] = originX + scaleX*(groupPtr->posn[0] - originX); groupPtr->posn[1] = originY + scaleY*(groupPtr->posn[1] - originY); @@ -742,7 +752,7 @@ canvasPtr->activeGroup = itemPtr; for (i=0; i < groupPtr->numMembers; i++) { Tk_Item *subitemPtr = groupPtr->members[i]; - if (subitemPtr != NULL) { + if (subitemPtr != NULL) { (*subitemPtr->typePtr->scaleProc)(canvas, subitemPtr, originX, originY, scaleX, scaleY); } } @@ -780,13 +790,13 @@ TkCanvas *canvasPtr = (TkCanvas *) canvas; GroupItem *groupPtr = (GroupItem *) itemPtr; Tk_Item *saveGroup = canvasPtr->activeGroup; - int i; + int i; groupPtr->posn[0] += deltaX; groupPtr->posn[1] += deltaY; canvasPtr->activeGroup = itemPtr; for (i=0; i < groupPtr->numMembers; i++) { Tk_Item *subitemPtr = groupPtr->members[i]; - if (subitemPtr != NULL) { + if (subitemPtr != NULL) { (*subitemPtr->typePtr->translateProc)(canvas, subitemPtr, deltaX, deltaY); } } @@ -830,12 +840,12 @@ Tk_Item *saveGroup = canvasPtr->activeGroup; Tk_State state = Tk_GetItemState(canvas, itemPtr); int code = TCL_OK; - int i; + int i; canvasPtr->activeGroup = itemPtr; for (i=0; i < groupPtr->numMembers; i++) { Tk_Item *subitemPtr = groupPtr->members[i]; - if (subitemPtr != NULL) { - code = (*subitemPtr->typePtr->postscriptProc)(interp, canvas, + if (subitemPtr != NULL) { + code = (*subitemPtr->typePtr->postscriptProc)(interp, canvas, subitemPtr, prepass); if (code != TCL_OK) { break; @@ -858,7 +868,7 @@ GroupItem *groupPtr = (GroupItem *) itemPtr; Tk_Item *saveGroup = canvasPtr->activeGroup; Tk_State state = Tk_GetItemState(canvas, itemPtr); - int i; + int i; int length; int id; char *string; @@ -873,7 +883,7 @@ && Tk_CanvasGetCoordFromObj(interp, canvas, objv[0], &point[0]) == TCL_OK && Tk_CanvasGetCoordFromObj(interp, canvas, objv[1], &point[1]) == TCL_OK) { goto doxy; - } + } string = Tcl_GetStringFromObj(obj, &length); if (string[0] == 'e') { @@ -902,7 +912,7 @@ point[1] = strtod(p, &end); if ((end == p) || (*end != 0)) { goto badIndex; - } + } doxy: bestDist = 1.0e36; *indexPtr = 0; @@ -931,7 +941,7 @@ } } return TCL_OK; -} +} static int GroupInsert(canvas, itemPtr, beforeThis, string) @@ -939,7 +949,7 @@ Tk_Item *itemPtr; int beforeThis; Tcl_Obj *string; -{ +{ TkCanvas *canvasPtr = (TkCanvas *) canvas; GroupItem *groupPtr = (GroupItem *) itemPtr; Tk_Item *saveGroup = canvasPtr->activeGroup; @@ -947,7 +957,7 @@ Tcl_Obj **objv; int argc; int i; - int id; + int id; if (Tcl_ListObjGetElements(groupPtr->interp,string,&argc,&objv) == TCL_OK) { int count = 0; for (i=0; i < argc; i++) { @@ -955,15 +965,15 @@ Tcl_HashEntry *entryPtr = Tcl_FindHashEntry(&canvasPtr->idTable, (char *) id); if (entryPtr != NULL) { Tk_Item *subitemPtr = (Tk_Item *) Tcl_GetHashValue(entryPtr); - if (subitemPtr == NULL + if (subitemPtr == NULL || subitemPtr == itemPtr || subitemPtr->group == itemPtr) { continue; } if (subitemPtr->group != NULL) { TkGroupRemoveItem(subitemPtr); - } - count++; + } + count++; } } else { return TCL_ERROR; @@ -974,7 +984,7 @@ if (groupPtr->members == NULL) { groupPtr->members = (Tk_Item **)ckalloc(i*sizeof(Tk_Item *)); } else { - groupPtr->members = (Tk_Item **)ckrealloc((char *)groupPtr->members, + groupPtr->members = (Tk_Item **)ckrealloc((char *)groupPtr->members, i*sizeof(Tk_Item *)); } if (groupPtr->members != NULL) { @@ -984,12 +994,12 @@ groupPtr->numSlots = 0; Tcl_SetResult(groupPtr->interp,"Out of memory",TCL_STATIC); return TCL_ERROR; - } + } } /* Move tail up */ for (i=groupPtr->numMembers-1; i >= beforeThis; i--) { groupPtr->members[i+count] = groupPtr->members[i]; - } + } /* Fill in slots */ groupPtr->numMembers += count; for (i=0; i < argc; i++) { @@ -998,7 +1008,7 @@ Tcl_HashEntry *entryPtr = Tcl_FindHashEntry(&canvasPtr->idTable, (char *) id); if (entryPtr != NULL) { Tk_Item *subitemPtr = (Tk_Item *) Tcl_GetHashValue(entryPtr); - if (subitemPtr == NULL + if (subitemPtr == NULL || subitemPtr == itemPtr || subitemPtr->group == itemPtr) { continue; @@ -1008,9 +1018,9 @@ groupPtr->members[beforeThis] = subitemPtr; beforeThis++; count--; - } - } - } + } + } + } if (count != 0) { abort(); } @@ -1044,17 +1054,17 @@ GroupItem *groupPtr = (GroupItem *) itemPtr; Tk_Item *saveGroup = canvasPtr->activeGroup; Tk_State state = Tk_GetItemState(canvas, itemPtr); - int i; + int i; if (first < 0) { first = 0; - } + } if (last >= groupPtr->numMembers) { last = groupPtr->numMembers-1; } if (first > last) { return; - } + } for (i=last; i >= first; i--) { TkGroupRemoveItem(groupPtr->members[i]); } @@ -1064,31 +1074,31 @@ static int MembersParseProc(clientData,interp,tkwin,value,recordPtr,offset) ClientData clientData; -Tcl_Interp *interp; +Tcl_Interp *interp; Tk_Window tkwin; -Arg value; -char *recordPtr; +Arg value; +char *recordPtr; int offset; -{ - Tk_Item *itemPtr = (Tk_Item *) recordPtr; - GroupItem *groupPtr = (GroupItem *) itemPtr; +{ + Tk_Item *itemPtr = (Tk_Item *) recordPtr; + GroupItem *groupPtr = (GroupItem *) itemPtr; int code = TCL_OK; Tk_CanvasEventuallyRedraw(groupPtr->canvas, itemPtr->x1, itemPtr->y1, itemPtr->x2, itemPtr->y2); - GroupDChars(groupPtr->canvas, itemPtr, 0, groupPtr->numMembers-1); + GroupDChars(groupPtr->canvas, itemPtr, 0, groupPtr->numMembers-1); code = GroupInsert(groupPtr->canvas, itemPtr, 0, value); Tk_CanvasEventuallyRedraw(groupPtr->canvas, itemPtr->x1, itemPtr->y1, itemPtr->x2, itemPtr->y2); return code; } static Arg -MembersPrintProc(clientData,tkwin,recordPtr,offset,freeProcPtr) +MembersPrintProc(clientData,tkwin,recordPtr,offset,freeProcPtr) ClientData clientData; Tk_Window tkwin; char *recordPtr; int offset; Tcl_FreeProc **freeProcPtr; { - GroupItem *groupPtr = (GroupItem *) recordPtr; + GroupItem *groupPtr = (GroupItem *) recordPtr; Tcl_Obj *result = Tcl_NewListObj(0,NULL); int i; for (i=0; i < groupPtr->numMembers; i++) { Index: pTk/tix.t --- Tk800.022/pTk/tix.t Mon Mar 13 16:01:16 2000 +++ Tk800.023/pTk/tix.t Sat Dec 30 16:12:37 2000 @@ -29,8 +29,8 @@ #endif #ifndef Tix_ArgcError -VFUNC(int,Tix_ArgcError,V_Tix_ArgcError,_ANSI_ARGS_((Tcl_Interp *interp, - int argc, Arg *args, int prefixCount, +VFUNC(int,Tix_ArgcError,V_Tix_ArgcError,_ANSI_ARGS_((Tcl_Interp *interp, + int argc, Tcl_Obj **objv, int prefixCount, char *message))) #endif @@ -56,7 +56,7 @@ Tix_CmdInfo * cmdInfo, Tix_SubCmdInfo * subCmdInfo, ClientData clientData, Tcl_Interp *interp, - int argc, Arg *args))) + int argc, Tcl_Obj **objv))) #endif #ifndef Tix_LinkListAppend Index: pTk/tixInt.t --- Tk800.022/pTk/tixInt.t Mon Mar 13 16:01:17 2000 +++ Tk800.023/pTk/tixInt.t Sat Dec 30 16:12:37 2000 @@ -24,7 +24,7 @@ #endif #ifndef TixDItemStyleFree -VFUNC(void,TixDItemStyleFree,V_TixDItemStyleFree,_ANSI_ARGS_((Tix_DItem *iPtr, +VFUNC(void,TixDItemStyleFree,V_TixDItemStyleFree,_ANSI_ARGS_((Tix_DItem *iPtr, Tix_DItemStyle * stylePtr))) #endif @@ -85,7 +85,7 @@ #ifndef Tix_DItemConfigure VFUNC(int,Tix_DItemConfigure,V_Tix_DItemConfigure,_ANSI_ARGS_(( Tix_DItem * diPtr, int argc, - Arg *args, int flags))) + Tcl_Obj **objv, int flags))) #endif #ifndef Tix_DItemCreate @@ -147,7 +147,7 @@ #ifndef Tix_SetScrollBarView VFUNC(int,Tix_SetScrollBarView,V_Tix_SetScrollBarView,_ANSI_ARGS_(( Tcl_Interp *interp, Tix_ScrollInfo * siPtr, - int argc, Arg *args, int compat))) + int argc, Tcl_Obj **objv, int compat))) #endif #ifndef Tix_SetWindowItemSerial @@ -159,7 +159,7 @@ #ifndef Tix_SplitConfig VFUNC(int,Tix_SplitConfig,V_Tix_SplitConfig,_ANSI_ARGS_((Tcl_Interp * interp, Tk_Window tkwin, Tk_ConfigSpec ** specsList, - int numLists, int argc, Arg *args, + int numLists, int argc, Tcl_Obj **objv, Tix_ArgumentList * argListPtr))) #endif @@ -177,7 +177,7 @@ VFUNC(int,Tix_WidgetConfigure2,V_Tix_WidgetConfigure2,_ANSI_ARGS_(( Tcl_Interp *interp, Tk_Window tkwin, char * entRec, Tk_ConfigSpec *entConfigSpecs, - Tix_DItem * iPtr, int argc, Arg *args, + Tix_DItem * iPtr, int argc, Tcl_Obj **objv, int flags, int forced, int * sizeChanged_ret))) #endif Index: pTk/tk.m --- Tk800.022/pTk/tk.m Mon Mar 13 16:01:17 2000 +++ Tk800.023/pTk/tk.m Sat Dec 30 16:12:37 2000 @@ -10,16 +10,16 @@ # define LangFindVar (*TkVptr->V_LangFindVar) #endif -#ifndef LangFontArg -# define LangFontArg (*TkVptr->V_LangFontArg) +#ifndef LangFontObj +# define LangFontObj (*TkVptr->V_LangFontObj) #endif -#ifndef LangObjectArg -# define LangObjectArg (*TkVptr->V_LangObjectArg) +#ifndef LangObjectObj +# define LangObjectObj (*TkVptr->V_LangObjectObj) #endif -#ifndef LangWidgetArg -# define LangWidgetArg (*TkVptr->V_LangWidgetArg) +#ifndef LangWidgetObj +# define LangWidgetObj (*TkVptr->V_LangWidgetObj) #endif #ifndef Lang_CreateImage Index: pTk/tk.t --- Tk800.022/pTk/tk.t Mon Mar 13 16:01:17 2000 +++ Tk800.023/pTk/tk.t Sat Dec 30 16:12:37 2000 @@ -7,16 +7,16 @@ VFUNC(Var,LangFindVar,V_LangFindVar,_ANSI_ARGS_((Tcl_Interp * interp, Tk_Window, char *name))) #endif -#ifndef LangFontArg -VFUNC(Arg,LangFontArg,V_LangFontArg,_ANSI_ARGS_((Tcl_Interp *interp, Tk_Font font, char *name))) +#ifndef LangFontObj +VFUNC(Tcl_Obj *,LangFontObj,V_LangFontObj,_ANSI_ARGS_((Tcl_Interp *interp, Tk_Font font, char *name))) #endif -#ifndef LangObjectArg -VFUNC(Arg,LangObjectArg,V_LangObjectArg,_ANSI_ARGS_((Tcl_Interp *interp, char *))) +#ifndef LangObjectObj +VFUNC(Tcl_Obj *,LangObjectObj,V_LangObjectObj,_ANSI_ARGS_((Tcl_Interp *interp, char *))) #endif -#ifndef LangWidgetArg -VFUNC(Arg,LangWidgetArg,V_LangWidgetArg,_ANSI_ARGS_((Tcl_Interp *interp, Tk_Window))) +#ifndef LangWidgetObj +VFUNC(Tcl_Obj *,LangWidgetObj,V_LangWidgetObj,_ANSI_ARGS_((Tcl_Interp *interp, Tk_Window))) #endif #ifndef Lang_CreateImage @@ -192,7 +192,7 @@ #ifndef Tk_ConfigureWidget VFUNC(int,Tk_ConfigureWidget,V_Tk_ConfigureWidget,_ANSI_ARGS_((Tcl_Interp *interp, Tk_Window tkwin, Tk_ConfigSpec *specs, - int argc, Arg *args, char *widgRec, + int argc, Tcl_Obj **objv, char *widgRec, int flags))) #endif @@ -362,8 +362,8 @@ #endif #ifndef Tk_EventInfo -VFUNC(char *,Tk_EventInfo,V_Tk_EventInfo,_ANSI_ARGS_((int letter, Tk_Window tkwin, XEvent *eventPtr, - KeySym keySym, int *numPtr, int *isNum, int *type, +VFUNC(char *,Tk_EventInfo,V_Tk_EventInfo,_ANSI_ARGS_((int letter, Tk_Window tkwin, XEvent *eventPtr, + KeySym keySym, int *numPtr, int *isNum, int *type, int num_size, char *numStorage))) #endif @@ -605,7 +605,7 @@ #ifndef Tk_GetScrollInfo VFUNC(int,Tk_GetScrollInfo,V_Tk_GetScrollInfo,_ANSI_ARGS_((Tcl_Interp *interp, - int argc, Arg *args, double *dblPtr, + int argc, Tcl_Obj **objv, double *dblPtr, int *intPtr))) #endif Index: pTk/tkEvent.h --- Tk800.022/pTk/tkEvent.h Fri Apr 21 09:13:10 2000 +++ Tk800.023/pTk/tkEvent.h Sat Dec 30 16:12:37 2000 @@ -2,7 +2,11 @@ #define _TKEVENT EXTERN LangCallback * LangMakeCallback _ANSI_ARGS_((Arg)); -EXTERN Arg LangCallbackArg _ANSI_ARGS_((LangCallback *)); +EXTERN Tcl_Obj * LangCallbackObj _ANSI_ARGS_((LangCallback *)); +EXTERN Arg LangOldCallbackArg _ANSI_ARGS_((LangCallback *,char *,int)); + +#define LangCallbackArg(x) LangOldCallbackArg(x,__FILE__,__LINE__) + EXTERN void LangFreeCallback _ANSI_ARGS_((LangCallback *)); EXTERN LangCallback * LangCopyCallback _ANSI_ARGS_((LangCallback *)); EXTERN int LangCmpCallback _ANSI_ARGS_((LangCallback *a,Arg b)); Index: pTk/tkEvent.m --- Tk800.022/pTk/tkEvent.m Fri Apr 21 09:18:24 2000 +++ Tk800.023/pTk/tkEvent.m Sat Dec 30 16:12:37 2000 @@ -6,8 +6,8 @@ # define LangCallCallback (*TkeventVptr->V_LangCallCallback) #endif -#ifndef LangCallbackArg -# define LangCallbackArg (*TkeventVptr->V_LangCallbackArg) +#ifndef LangCallbackObj +# define LangCallbackObj (*TkeventVptr->V_LangCallbackObj) #endif #ifndef LangCmpCallback @@ -28,6 +28,10 @@ #ifndef LangMakeCallback # define LangMakeCallback (*TkeventVptr->V_LangMakeCallback) +#endif + +#ifndef LangOldCallbackArg +# define LangOldCallbackArg (*TkeventVptr->V_LangOldCallbackArg) #endif #ifndef LangPushCallbackArgs Index: pTk/tkEvent.t --- Tk800.022/pTk/tkEvent.t Fri Apr 21 09:18:24 2000 +++ Tk800.023/pTk/tkEvent.t Sat Dec 30 16:12:37 2000 @@ -3,8 +3,8 @@ VFUNC(int,LangCallCallback,V_LangCallCallback,_ANSI_ARGS_((LangCallback *cb, int flags))) #endif -#ifndef LangCallbackArg -VFUNC(Arg,LangCallbackArg,V_LangCallbackArg,_ANSI_ARGS_((LangCallback *))) +#ifndef LangCallbackObj +VFUNC(Tcl_Obj *,LangCallbackObj,V_LangCallbackObj,_ANSI_ARGS_((LangCallback *))) #endif #ifndef LangCmpCallback @@ -25,6 +25,10 @@ #ifndef LangMakeCallback VFUNC(LangCallback *,LangMakeCallback,V_LangMakeCallback,_ANSI_ARGS_((Arg))) +#endif + +#ifndef LangOldCallbackArg +VFUNC(Arg,LangOldCallbackArg,V_LangOldCallbackArg,_ANSI_ARGS_((LangCallback *,char *,int))) #endif #ifndef LangPushCallbackArgs Index: pTk/tkInt.t --- Tk800.022/pTk/tkInt.t Sat Mar 25 13:23:22 2000 +++ Tk800.023/pTk/tkInt.t Sat Dec 30 16:12:37 2000 @@ -30,7 +30,7 @@ #ifndef TkCanvPostscriptCmd VFUNC(int,TkCanvPostscriptCmd,V_TkCanvPostscriptCmd,_ANSI_ARGS_((struct TkCanvas *canvasPtr, - Tcl_Interp *interp, int argc, Arg *args))) + Tcl_Interp *interp, int argc, Tcl_Obj **objv))) #endif #ifndef TkChangeEventWindow @@ -81,7 +81,7 @@ #ifndef TkCreateFrame VFUNC(int,TkCreateFrame,V_TkCreateFrame,_ANSI_ARGS_((ClientData clientData, - Tcl_Interp *interp, int argc, Arg *args, + Tcl_Interp *interp, int argc, Tcl_Obj **objv, int toplevel, char *appName))) #endif @@ -100,7 +100,7 @@ #ifndef TkDeadAppCmd VFUNC(int,TkDeadAppCmd,V_TkDeadAppCmd,_ANSI_ARGS_((ClientData clientData, - Tcl_Interp *interp, int argc, Arg *args))) + Tcl_Interp *interp, int argc, Tcl_Obj **objv))) #endif #ifndef TkDeleteAllImages Index: t/create.t --- Tk800.022/t/create.t Sun Mar 26 13:25:56 2000 +++ Tk800.023/t/create.t Sat Dec 30 16:12:37 2000 @@ -61,7 +61,10 @@ ) ); - @class = grep(!/InputO/,@class) if ($^O eq 'MSWin32'); + require Tk if ($^O eq 'cygwin'); + @class = grep(!/InputO/,@class) if ($^O eq 'MSWin32' or + ($^O eq 'cygwin' and defined($Tk::platform) + and $Tk::platform eq 'MSWin32')); plan test => (13*@class+3); Index: t/mwm.t --- Tk800.022/t/mwm.t Tue Jul 27 19:21:22 1999 +++ Tk800.023/t/mwm.t Sat Dec 30 16:12:37 2000 @@ -1,7 +1,8 @@ BEGIN { $^W = 1; $| = 1; - if ($^O eq 'MSWin32') + require Tk if ($^O eq 'cygwin'); + if ($^O eq 'MSWin32' or ($^O eq 'cygwin' and $Tk::platform eq 'MSWin32')) { print "1..0\n"; exit; Index: t/optmenu.t --- Tk800.022/t/optmenu.t Sat Oct 2 17:25:30 1999 +++ Tk800.023/t/optmenu.t Sat Dec 30 16:12:37 2000 @@ -3,9 +3,9 @@ use strict; use Test; -BEGIN +BEGIN { - plan test => 10; + plan test => 24; }; eval { require Tk }; @@ -22,17 +22,53 @@ my $foo = 12; my @opt = (0..20); +# Granfather documented use of just -variable my $opt = $mw->Optionmenu(-variable => \$foo, -options => \@opt)->pack; ok($@, "", "can't create Optionmenu"); ok(Tk::Exists($opt), 1, "Optionmenu creation failed"); -ok($ {$opt->cget(-textvariable)}, $foo, "setting of -variable failed"); +ok($ {$opt->cget(-variable)}, $foo, "setting of -variable failed"); +ok($opt->cget(-variable),\$foo, "Wrong variable"); my $optmenu = $opt->cget(-menu); ok($optmenu ne "", 1, "can't get menu from Optionmenu"); ok(ref $optmenu, 'Tk::Menu', "reference returned is not a Tk::Menu"); ok($optmenu->index("last"), 20, "wrong number of elements in menu"); +ok($optmenu->entrycget("last", -label), "20", "wrong label"); + +# Test use of both variables on the list of lists case +my $foo3 = 5; +my $bar3 = ""; +my $opt3 = $mw->Optionmenu(-variable => \$foo3, + -textvariable => \$bar3, + -options => [map { [ "Label $_" => $_ ] } @opt], + )->pack; +ok($@, "", "can't create Optionmenu"); +ok(Tk::Exists($opt3), 1, "Optionmenu creation failed"); + +ok($ {$opt3->cget(-variable)}, $foo3, "setting of -variable failed"); +ok($bar3, "Label $foo3", "textvariable set to wrong value"); +my $opt3menu = $opt3->cget(-menu); +ok($opt3menu ne "", 1, "can't get menu from Optionmenu"); +ok($opt3menu->entrycget("last", -label), "Label 20", "wrong label"); + +# See if we have fixed use of just -variable in the list of lists case +my $foo2 = 5; +my $opt2 = $mw->Optionmenu(-variable => \$foo2, + -options => [map { [ "Label $_" => $_ ] } @opt], + )->pack; +ok($@, "", "can't create Optionmenu"); +ok(Tk::Exists($opt2), 1, "Optionmenu creation failed"); + +ok($ {$opt2->cget(-variable)}, $foo2, "setting of -variable failed"); +my $opt2menu = $opt2->cget(-menu); +ok($opt2menu ne "", 1, "can't get menu from Optionmenu"); +ok($opt2menu->entrycget("last", -label), "Label 20", "wrong label"); + +ok($ {$opt2->cget(-textvariable)}, "Label $foo2", "wrong label"); + +#Tk::MainLoop(); 1; __END__ Index: tkGlue.c --- Tk800.022/tkGlue.c Fri Apr 21 09:13:10 2000 +++ Tk800.023/tkGlue.c Wed Apr 4 21:37:27 2001 @@ -8,6 +8,10 @@ #include #include #include +#ifdef __CYGWIN__ +# undef XS +# define XS(name) void name(pTHXo_ CV* cv) +#endif #define Tkgv_fullname(x,y,z) gv_fullname3(x,y,z) @@ -26,7 +30,7 @@ #include "pTk/Xlib_f.h" #include "pTk/tkEvent.h" #include "pTk/tkEvent.m" -#ifdef WIN32 +#if defined(WIN32) || (defined(__WIN32__) && defined(__CYGWIN__)) #include "pTk/tkWin.h" #include "pTk/tkWinInt.h" #include "pTk/tkWin_f.h" @@ -102,6 +106,11 @@ extern XSdec(XS_Tk_DoWhenIdle); extern XSdec(XS_Tk_CreateGenericHandler); +#ifdef PERL_MG_UFUNC +#define DECL_MG_UFUNC(name,a,b) PERL_MG_UFUNC(name,a,b) +#else +#define DECL_MG_UFUNC(name,a,b) I32 name(IV a, SV *b) +#endif extern void LangPrint _((SV *sv)); @@ -115,12 +124,6 @@ static SV *Blessed _((char *package, SV * sv)); static int PushObjCallbackArgs _((Tcl_Interp *interp, SV **svp,EventAndKeySym *obj)); static int Check_Eval _((Tcl_Interp *interp)); -static I32 Perl_Trace _((IV ix, SV * sv)); -static I32 LinkIntSet _((IV ix, SV * sv)); -static I32 LinkIntVal _((IV ix, SV * sv)); -static I32 LinkDoubleSet _((IV ix, SV * sv)); -static I32 LinkDoubleVal _((IV ix, SV * sv)); -static I32 LinkCannotSet _((IV ix, SV * sv)); static int handle_generic _((ClientData clientData, XEvent * eventPtr)); static void HandleBgErrors _((ClientData clientData)); static void SetTclResult _((Tcl_Interp *interp,int count)); @@ -790,7 +793,7 @@ } void -LangSetArg(sp, arg) +LangSetObj(sp, arg) SV **sp; SV *arg; { @@ -799,20 +802,38 @@ if (!arg) arg = &PL_sv_undef; if (SvTYPE(arg) == SVt_PVAV) - arg = newRV(arg); + arg = newRV_noinc(arg); if (sv && SvMAGICAL(sv)) { sv_setsv(sv, arg); SvSETMAGIC(sv); + SvREFCNT_dec(arg); } else { - *sp = SvREFCNT_inc(arg); + *sp = arg; if (sv) SvREFCNT_dec(sv); } } +static void +Deprecated(char *what, char *file, int line) +{ + LangDebug("%s:%d: %s is deprecated\n",file,line,what); +} + +void +LangOldSetArg(sp, arg, file, line) +SV **sp; +SV *arg; +char *file; +int line; +{ + Deprecated("LangSetArg",file,line); + LangSetObj(sp,(arg) ? SvREFCNT_inc(arg) : arg); +} + /* This replaces LangSetArg(sp,LangVarArg(var)) which leaked RVs */ void LangSetVar(sp,sv) @@ -822,11 +843,10 @@ if (sv) { SV *rv = newRV(sv); - LangSetArg(sp,rv); - SvREFCNT_dec(rv); + LangSetObj(sp,rv); } else - LangSetArg(sp,NULL); + LangSetObj(sp,NULL); } void @@ -1102,7 +1122,6 @@ #endif sv_vsetpvfn(sv, fmt, strlen(fmt), &ap, Null(SV**), 0, Null(bool*)); Tcl_SetObjResult(interp, sv); - SvREFCNT_dec(sv); va_end(ap); } @@ -1262,14 +1281,36 @@ SV *result; Tcl_ResetResult(interp); result = Tcl_GetObjResult(interp); + Tcl_ListObjAppendElement(interp, result, sv); +} + +void +Lang_OldArgResult(interp,sv,file,line) +Tcl_Interp *interp; +SV *sv; +char *file; +int line; +{ /* * It is caller's responsibility to free the incoming sv if it * is a temporary, we increment refcount here as common case is * LangWidgetArg() which just returns a raw un-incremented value * from the hash. */ + Deprecated("Tcl_ArgResult",file,line); Increment(sv, "Tcl_ArgResult"); - Tcl_ListObjAppendElement(interp, result, sv); + Tcl_SetObjResult(interp,sv); +} + +SV * +LangObjArg(sv,file,line) +SV *sv; +char *file; +int line; +{ + Deprecated("LangXxxxArg",file,line); + SvREFCNT_dec(sv); + return sv; } static SV * @@ -1350,19 +1391,19 @@ } Arg -LangWidgetArg(interp, tkwin) +LangWidgetObj(interp, tkwin) Tcl_Interp *interp; Tk_Window tkwin; { - return TkToWidget(tkwin,NULL); + return SvREFCNT_inc(TkToWidget(tkwin,NULL)); } Arg -LangObjectArg(interp, name) +LangObjectObj(interp, name) Tcl_Interp *interp; char *name; { - return ObjectRef(interp, name); + return SvREFCNT_inc(ObjectRef(interp, name)); } Tk_Font @@ -1395,7 +1436,7 @@ } Arg -LangFontArg(interp, tkfont, name) +LangFontObj(interp, tkfont, name) Tcl_Interp *interp; Tk_Font tkfont; char *name; @@ -1424,7 +1465,7 @@ sv = Blessed("Tk::Font", MakeReference(sv)); hv_store(fonts, name, strlen(name), sv, 0); } - return sv; /* Not SvREFCNT_inc(sv) for symetry with Widget */; + return SvREFCNT_inc(sv); } void @@ -1454,8 +1495,7 @@ if (string) { SV *sv = newSVpv(string, len); - Tcl_ArgResult(interp, sv); - SvREFCNT_dec(sv); + Tcl_SetObjResult(interp, sv); if (freeProc != TCL_STATIC && freeProc != TCL_VOLATILE) (*freeProc) (string); } @@ -1940,6 +1980,7 @@ FREETMPS; LEAVE; Tcl_ResetResult(interp); + DecInterp(interp,"HandleBgErrors"); } void @@ -1971,6 +2012,7 @@ if (av_len(pend) <= 0) { /* 1st one - setup callback */ + IncInterp(interp,"Tk_BackgroundError"); Tcl_DoWhenIdle(HandleBgErrors, (ClientData) interp); } Tcl_ResetResult(interp); @@ -3378,8 +3420,8 @@ return SvPV(sv, na); } -static I32 -Perl_Value(IV ix, SV *sv) +static +DECL_MG_UFUNC(Perl_Value, ix, sv) { Tk_TraceInfo *p = (Tk_TraceInfo *) ix; char *result; @@ -3410,10 +3452,7 @@ return 0; } -static I32 -Perl_Trace(ix, sv) -IV ix; -SV *sv; +static DECL_MG_UFUNC(Perl_Trace, ix, sv) { Tk_TraceInfo *p = (Tk_TraceInfo *) ix; char *result; @@ -3556,49 +3595,39 @@ return NULL; } -static I32 -LinkIntSet(ix, sv) -IV ix; -SV *sv; +static +DECL_MG_UFUNC(LinkIntSet,ix,sv) { int *p = (int *) ix; (*p) = SvIV(sv); return 0; } -static I32 -LinkDoubleSet(ix, sv) -IV ix; -SV *sv; +static +DECL_MG_UFUNC(LinkDoubleSet,ix,sv) { double *p = (double *) ix; (*p) = SvNV(sv); return 0; } -static I32 -LinkCannotSet(ix, sv) -IV ix; -SV *sv; +static +DECL_MG_UFUNC(LinkCannotSet,ix,sv) { croak("Attempt to set readonly linked variable"); return 0; } -static I32 -LinkIntVal(ix, sv) -IV ix; -SV *sv; +static +DECL_MG_UFUNC(LinkIntVal,ix,sv) { int *p = (int *) ix; sv_setiv(sv,*p); return 0; } -static I32 -LinkDoubleVal(ix, sv) -IV ix; -SV *sv; +static +DECL_MG_UFUNC(LinkDoubleVal,ix,sv) { double *p = (double *) ix; sv_setnv(sv,*p); @@ -5123,7 +5152,7 @@ Lang_OSHandle(fd) int fd; { -#ifdef WIN32 +#if defined(WIN32) && !defined(__CYGWIN__) return win32_get_osfhandle(fd); #else return fd; Index: tkWin32Dll.c --- Tk800.022/tkWin32Dll.c Tue Jul 27 19:21:23 1999 +++ Tk800.023/tkWin32Dll.c Sat Dec 30 16:12:37 2000 @@ -13,7 +13,7 @@ #include "pTk/tkPort.h" -#ifdef WIN32 +#if defined(WIN32) || (defined(__WIN32__) && defined(__CYGWIN__)) #include "pTk/tkWinInt.h" __END_OF_PATCH__