From: nijtmans@NICI.KUN.NL
Date: Wed, 06 Mar 1996 17:01:44 +0100
Subject: Re: gdtcl with Tcl7.5
To: spencer@umich.edu
Cc: nijtmans@ergolab4
Message-id: <9603061601.AA14760@ergolab4.cogw>
Content-transfer-encoding: 7BIT


Oops, small bug. Clearing interp-result didn't return a
handle any more. Just ignore the previous patch: here is the
correct one.

	Jan Nijtmans
	NICI (Nijmegen Insitute of Cognition and Information)
	email: nijtmans@nici.kun.nl
	url:   http://www.nici.kun.nl/~nijtmans/

*** gdCmd.c.orig	Wed Mar  6 14:16:06 1996
--- gdCmd.c	Wed Mar  6 14:54:07 1996
***************
*** 24,35 ****
  			  int entrySize, int initEntries);
  void_pt Tcl_HandleAlloc(void_pt headerPtr, char *handlePtr);
  void_pt Tcl_HandleXlate(Tcl_Interp *interp, void_pt headerPtr,
! 			const char *handle);
  void Tcl_HandleFree(void_pt headerPtr, void_pt entryPtr);
  #endif
  #include "gd.h"
  #include "gdfonts.h"
  #include "gdfontl.h"
  
  /* Fonts table. */
  static struct {
--- 24,38 ----
  			  int entrySize, int initEntries);
  void_pt Tcl_HandleAlloc(void_pt headerPtr, char *handlePtr);
  void_pt Tcl_HandleXlate(Tcl_Interp *interp, void_pt headerPtr,
! 			char *handle);
  void Tcl_HandleFree(void_pt headerPtr, void_pt entryPtr);
  #endif
  #include "gd.h"
+ #include "gdfontt.h"
  #include "gdfonts.h"
+ #include "gdfontmb.h"
  #include "gdfontl.h"
+ #include "gdfontg.h"
  
  /* Fonts table. */
  static struct {
***************
*** 36,43 ****
      char *fontname;
      gdFontPtr *fontp;
  } fontTbl[] = {
      "small",	&gdFontSmall,
!     "large",	&gdFontLarge
  };
  
  static void_pt GDHandleTable = 0;
--- 39,49 ----
      char *fontname;
      gdFontPtr *fontp;
  } fontTbl[] = {
+     "tiny",	&gdFontTiny,
      "small",	&gdFontSmall,
!     "middle",	&gdFontMediumBold,
!     "large",	&gdFontLarge,
!     "giant",	&gdFontGiant
  };
  
  static void_pt GDHandleTable = 0;
***************
*** 137,142 ****
--- 143,177 ----
      	"gdhandle ?color?"}
  };
  
+ #if (TCL_MAJOR_VERSION > 7) || (TCL_MINOR_VERSION > 4)
+ static int Tcl_GetOpenFile( Tcl_Interp *interp, char *arg, int dir, int dummy, FILE **f )
+ {   Tcl_Channel channel;
+     Tcl_File file;
+     int fd;
+ 
+     channel = Tcl_GetChannel(interp, arg, NULL);
+     if (channel == (Tcl_Channel) NULL) return TCL_ERROR;
+     if (dir==TCL_WRITABLE) Tcl_Flush(channel);
+     file = Tcl_GetChannelFile(channel,dir?TCL_WRITABLE:TCL_READABLE);
+     if (file==(Tcl_File) NULL) return TCL_ERROR;
+     fd = (int) Tcl_GetFileInfo(file,NULL);
+     *f = fdopen(fd,dir?"wb":"rb");
+     return TCL_OK;
+ }
+ static void CloseFile(Tcl_Interp *interp, char *arg, FILE *f) {
+     Tcl_Channel channel;
+ 
+     fclose(f);
+     channel = Tcl_GetChannel(interp, arg, NULL);
+     if (channel != (Tcl_Channel) NULL) {
+ 	Tcl_UnregisterChannel(interp, channel);
+     }
+     Tcl_ResetResult(interp);
+ }
+ #else
+ #define CloseFile(interp,arg,f) fclose(f)
+ #endif
+ 
  /*
   * Helper function to interpret color index values.
   */
***************
*** 391,396 ****
--- 426,432 ----
  	    im = gdImageCreateFromGd( f );
  	}
  	if ( im == NULL ) {
+ 	    CloseFile(interp,argv[2],f);
  	    interp->result = "GD unable to read image file";
  	    return TCL_ERROR;
  	}
***************
*** 402,412 ****
--- 438,451 ----
  	GDHandleTable = Tcl_HandleTblInit( "gd", sizeof(gdImagePtr), 1 );
  	if ( GDHandleTable == 0 )
  	{
+ 	    CloseFile(interp,argv[2],f);
  	    interp->result = "unable to create table for GD handles.";
  	    return TCL_ERROR;
  	}
      }
  	
+     CloseFile(interp,argv[2],f);
+ 
      *(gdImagePtr *)(Tcl_HandleAlloc( GDHandleTable, interp->result)) = im;
      return TCL_OK;
  }
***************
*** 446,451 ****
--- 485,491 ----
      } else {
  	gdImageGd( im, f );
      }
+     CloseFile(interp,argv[3],f);
      return TCL_OK;
  }
  
***************
*** 1048,1058 ****
  /* 
   * Initialize the package.
   */
! void
  Gdtcl_Init( Tcl_Interp *interp ) 
  {
      Tcl_CreateCommand( interp, "gd", gdCmd,
                         (ClientData)NULL, (Tcl_CmdDeleteProc *)NULL );
  }
  
  #ifndef TCLX_SUPPORT
--- 1088,1109 ----
  /* 
   * Initialize the package.
   */
! int
  Gdtcl_Init( Tcl_Interp *interp ) 
  {
+ #if (TCL_MAJOR_VERSION > 7) || (TCL_MINOR_VERSION > 4)
+     if (Tcl_PkgRequire(interp, "Tcl", TCL_VERSION, 1) == NULL) {
+ 	return TCL_ERROR;
+     }
+     if (Tcl_PkgProvide(interp, "Gd", "1.2") != TCL_OK) {
+ 	return TCL_ERROR;
+     }
+ #endif
      Tcl_CreateCommand( interp, "gd", gdCmd,
                         (ClientData)NULL, (Tcl_CmdDeleteProc *)NULL );
+     
+     Tcl_SetVar(interp, "gd_version", "1.2", TCL_GLOBAL_ONLY);
+     return TCL_OK;
  }
  
  #ifndef TCLX_SUPPORT
***************
*** 1108,1114 ****
  }
  
  void_pt Tcl_HandleXlate(Tcl_Interp *interp, void_pt headerPtr,
! 			const char *handle)
  {
      Tcl_HashEntry *ep;
      HandleTable *hp = (HandleTable *)headerPtr;
--- 1159,1165 ----
  }
  
  void_pt Tcl_HandleXlate(Tcl_Interp *interp, void_pt headerPtr,
! 			char *handle)
  {
      Tcl_HashEntry *ep;
      HandleTable *hp = (HandleTable *)headerPtr;