/*
 * dviCFTcl.c --
 *
 *      This file implements a Tcl interface to the routines in dviCode.c
 *      and dviFile.c.
 *
 * Copyright © 1999 Anselm Lingnau <lingnau@tm.informatik.uni-frankfurt.de>
 * See file COPYING for conditions on use and distribution.
 */

#include <string.h>
#include "dviInt.h"

#ifndef lint
static char rcsid[] VAR_UNUSED = "$Id: dviCFTcl.c,v 1.4 2000/06/29 10:56:25 lingnau Exp $";
#endif /* lint */

typedef struct DviCFCookie {
    Tcl_Interp *interp;
    Tcl_Command cmdCookie;
    Dvi_File *dviFilePtr;
    Tcl_Obj *reloadCmd;
    Tcl_HashTable anchorTable;
} DviCFCookie;

static int DviFileTclError _ANSI_ARGS_((ClientData clientData,
					const char *errMsg));

static Tcl_Obj * FormatPageNumbers _ANSI_ARGS_((Dvi_Code *, unsigned int));
static int GetPageNumbers _ANSI_ARGS_((Tcl_Interp *, Dvi_Code *, Tcl_Obj *));

static int DviCodeObjCmd _ANSI_ARGS_((ClientData clientData,
				      Tcl_Interp *interp,
				      int objc, Tcl_Obj * CONST objv[]));
static int RegisterAnchor _ANSI_ARGS_((ClientData clientData, char *anchor,
				       unsigned int pageNum));
static int DviCodeCreateCmd _ANSI_ARGS_((ClientData clientData,
					 Tcl_Interp *interp,
					 int objc, Tcl_Obj * CONST objv[]));

static void CookieSetReloadCmd _ANSI_ARGS_((Tcl_Interp *,
					    Tcl_Obj *cookie, Tcl_Obj *cmd));
static Tcl_Obj *CookieGetReloadCmd _ANSI_ARGS_((Tcl_Interp *,
						Tcl_Obj *cookie));
static void InvokeReloadCmds _ANSI_ARGS_((ClientData clientData,
					  Dvi_File *dviFile));

/*
 * ------------------------------------------------------------------------
 *
 * DviFileTclError --
 *
 *      Callback function for error messages.
 *
 * ------------------------------------------------------------------------
 */

static int
DviFileTclError (clientData, errMsg)
    ClientData clientData;
    const char *errMsg;
{
    Tcl_Interp *interp = (Tcl_Interp *)clientData;

    Tcl_SetResult(interp, (char *)errMsg, TCL_VOLATILE);
    return TCL_ERROR;
}

/*
 * ------------------------------------------------------------------------
 *
 * FormatPageNumbers --
 *
 *      Construct a Tcl object containing the formatted page numbers of a
 *      single page in the DVI code.
 *
 * Results:
 *      A Tcl object containing the logical page number for a physical
 *      page in the DVI code. The logical page number is constructed from the
 *      arguments to the BOP op-code, which in turn derive from the
 *      values of the TeX counters \count0 ... \count9 at the moment the
 *      page was shipped out. The individual counter values are separated
 *      by dots. Trailing zeroes are suppressed if at least one counter
 *      is non-zero; if all counters are zero a `0' is output.
 *
 * ------------------------------------------------------------------------
 */

static Tcl_Obj *
FormatPageNumbers (codePtr, absPageNumber)
    Dvi_Code *codePtr;
    unsigned int absPageNumber;
{
    Tcl_Obj *pageObj = Tcl_NewObj();
    int countNumber;	/* general variable for indexing counters */
    int lastUsed;	/* index of last non-zero counter, 0..9 */
    long count[10];	/* buffer for the counter values */
    char buf[20];	/* buffer for formatting a single counter */

    Dvi_CodeGetPageNumbers(codePtr, absPageNumber, count);
    
    /*
     * Locate the last non-zero counter and put its index
     * into `lastUsed'.
     */
    
    lastUsed = 0;
    for (countNumber = 0; countNumber < 10; countNumber++) {
	if (count[countNumber] != 0) {
	    lastUsed = countNumber;
	}
    }

    /*
     * Output the first counter followed by all counters up
     * to the last non-zero counter.
     */
    
    sprintf(buf, "%ld", count[0]);
    Tcl_AppendToObj(pageObj, buf, -1);
    for (countNumber = 1; countNumber <= lastUsed; countNumber++) {
	sprintf(buf, "." S32FMT, count[countNumber]);
	Tcl_AppendToObj(pageObj, buf, -1);
    }

    return pageObj;
}

static int
GetPageNumbers (interp, codePtr, pageNumberObj)
    Tcl_Interp *interp;
    Dvi_Code *codePtr;
    Tcl_Obj *pageNumberObj;
{
    Tcl_Obj *resultPtr = Tcl_GetObjResult(interp);
    int pageNumber;

    if (pageNumberObj == (Tcl_Obj *)0) {
	for (pageNumber = 0; pageNumber < codePtr->pageCount; pageNumber++) {
	    Tcl_Obj *pageObj = FormatPageNumbers(codePtr, pageNumber);
	    Tcl_ListObjAppendElement(interp, resultPtr, pageObj);
	}
    } else {
	if (Tcl_GetIntFromObj(interp, pageNumberObj, &pageNumber) != TCL_OK) {
	    return TCL_ERROR;
	}
	if (pageNumber < 0 || pageNumber >= codePtr->pageCount) {
	    Tcl_SetResult(interp, "absolute page number out of bounds",
			  TCL_STATIC);
	    return TCL_ERROR;
	}
	Tcl_SetObjResult(interp, FormatPageNumbers(codePtr, pageNumber));
    }
    return TCL_OK;
}

static int
DviCodeObjCmd (clientData, interp, objc, objv)
    ClientData clientData;
    Tcl_Interp *interp;
    int objc;
    Tcl_Obj * CONST objv[];
{
    DviCFCookie *dviCookiePtr = (DviCFCookie *)clientData; 
    Tcl_Obj *resultPtr = Tcl_GetObjResult(interp);

    static enum {
	DVICF_CHANGED, DVICF_CLOSE, DVICF_CONFIGURE,
	DVICF_FINDANCHOR, DVICF_FINDCODE, DVICF_FINDPAGE, DVICF_INFO,
	DVICF_RELOAD, DVICF_SPECIALS,
#if DVI_DEBUG
	DVICF_PURGE,
#endif /* DVI_DEBUG */
    } idx;
    static char *subCmds[] = {
	"changed", "close", "configure",
	"findanchor", "findcode", "findpage", "info",
	"reload", "specials",
#if DVI_DEBUG
	"_purge",
#endif /* DVI_DEBUG */
	(char *)0
    };

    static enum {
	DVICFC_RELOADCMD,
    } confIdx;
    static char *confOpts[] = {
	"-reloadcommand",
	(char *)0
    };

    static enum {
	DVICFI_ANCHORS, DVICFI_COMMENT, DVICFI_FILENAME, DVICFI_FONTS,
	DVICFI_PAGES, DVICFI_PAGENUMBERS, DVICFI_PARAMETERS,
    } infoIdx;
    static char *infoSubCmds[] = {
	"anchors", "comment", "filename", "fonts",
	"pages", "pagenumbers", "parameters",
	(char *)0
    };

    if (objc == 1) {
	Tcl_WrongNumArgs(interp, 1, objv, "subcommand ?parameters?");
	return TCL_ERROR;
    }

    if (Tcl_GetIndexFromObj(interp, objv[1], subCmds, "subcommand",
			    TCL_EXACT, (int *)&idx) != TCL_OK) {
	return TCL_ERROR;
    }

    switch (idx) {

    case DVICF_CONFIGURE:
	if (objc == 2) {
	    Tcl_SetResult(interp, "not implemented yet", TCL_STATIC);
	    return TCL_ERROR;
	} else if (objc > 3 && (objc % 2) == 0) {
	    int i;
	    for (i = 2; i < objc; i += 2) {
		if (Tcl_GetIndexFromObj(interp, objv[i], confOpts, "option",
					TCL_EXACT,
					(int *)&confIdx) != TCL_OK) {
		    return TCL_ERROR;
		}
		switch (confIdx) {
		case DVICFC_RELOADCMD:
		    if (dviCookiePtr->reloadCmd != 0) {
			Tcl_DecrRefCount(dviCookiePtr->reloadCmd);
		    }
		    dviCookiePtr->reloadCmd = objv[i+1];
		    Tcl_IncrRefCount(dviCookiePtr->reloadCmd);
		    break;
		}
	    }
	}
	break;

    case DVICF_INFO:
	if (objc < 3) {
	    Tcl_WrongNumArgs(interp, 2, objv, "topic");
	    return TCL_ERROR;
	}

	if (Tcl_GetIndexFromObj(interp, objv[2], infoSubCmds, "topic",
				TCL_EXACT, (int *)&infoIdx) != TCL_OK) {
	    return TCL_ERROR;
	}

	switch (infoIdx) {
	    unsigned char *postamble;
	    long num, den, mag;
	    unsigned int stackSize, pageCount;
	    Tcl_HashSearch search;
	    Tcl_HashEntry *entryPtr;
	    char *pattern;
	    char *commentPtr;
	    unsigned int length;

	case DVICFI_FILENAME:
	    if (objc != 3) {
		Tcl_WrongNumArgs(interp, 3, objv, "");
		return TCL_ERROR;
	    }

	    Tcl_SetStringObj(resultPtr,
			     dviCookiePtr->dviFilePtr->infoPtr->name, -1);
	    break;

	case DVICFI_COMMENT:
	    if (objc != 3) {
		Tcl_WrongNumArgs(interp, 3, objv, "");
		return TCL_ERROR;
	    }

	    Dvi_FileComment(dviCookiePtr->dviFilePtr, &commentPtr, &length);
	    Tcl_SetStringObj(resultPtr, commentPtr, length);
	    break;

	case DVICFI_PARAMETERS:
	    if (objc != 3) {
		Tcl_WrongNumArgs(interp, 3, objv, "");
		return TCL_ERROR;
	    }

	    if (Dvi_FileParameters(dviCookiePtr->dviFilePtr->infoPtr,
				   &postamble, &num, &den, &mag,
				   &stackSize, &pageCount) < 0) {
		Tcl_SetResult(interp, "couldn't determine code parameters",
			      TCL_STATIC);
		return TCL_ERROR;
	    } else {
		char buf[20];
		Dvi_FileInfo *dviInfoPtr = dviCookiePtr->dviFilePtr->infoPtr;

		sprintf(buf, "%ld",
			postamble ? (postamble - dviInfoPtr->contents) : 0);
		Tcl_ListObjAppendElement(interp, resultPtr,
					 Tcl_NewStringObj(buf, -1));
		sprintf(buf, "%ld", num);
		Tcl_ListObjAppendElement(interp, resultPtr,
					 Tcl_NewStringObj(buf, -1));
		sprintf(buf, "%ld", den);
		Tcl_ListObjAppendElement(interp, resultPtr,
					 Tcl_NewStringObj(buf, -1));
		sprintf(buf, "%ld", mag);
		Tcl_ListObjAppendElement(interp, resultPtr,
					 Tcl_NewStringObj(buf, -1));
		sprintf(buf, "%u", stackSize);
		Tcl_ListObjAppendElement(interp, resultPtr,
					 Tcl_NewStringObj(buf, -1));
		sprintf(buf, "%u", pageCount);
		Tcl_ListObjAppendElement(interp, resultPtr,
					 Tcl_NewStringObj(buf, -1));
		sprintf(buf, "%u", dviInfoPtr->refCount);
		Tcl_ListObjAppendElement(interp, resultPtr,
					 Tcl_NewStringObj(buf, -1));
		sprintf(buf, "%lu", dviInfoPtr->fileSize);
		Tcl_ListObjAppendElement(interp, resultPtr,
					 Tcl_NewStringObj(buf, -1));
		sprintf(buf, "%lu", (unsigned long)dviInfoPtr->lastModTime);
		Tcl_ListObjAppendElement(interp, resultPtr,
					 Tcl_NewStringObj(buf, -1));
		sprintf(buf, "%lu", dviInfoPtr->generation);
		Tcl_ListObjAppendElement(interp, resultPtr,
					 Tcl_NewStringObj(buf, -1));
		sprintf(buf, "%d", dviInfoPtr->fileDesc);
		Tcl_ListObjAppendElement(interp, resultPtr,
					 Tcl_NewStringObj(buf, -1));
	    }
	    break;

	case DVICFI_PAGES:
	    if (objc != 3) {
		Tcl_WrongNumArgs(interp, 3, objv, "");
		return TCL_ERROR;
	    }

	    Tcl_SetIntObj(resultPtr,
			  dviCookiePtr->dviFilePtr->infoPtr->codePtr->pageCount);
	    break;

	case DVICFI_PAGENUMBERS:
	    if (objc != 3 && objc != 4) {
		Tcl_WrongNumArgs(interp, 3, objv, "?pageNumber?");
		return TCL_ERROR;
	    }

	    GetPageNumbers(interp, dviCookiePtr->dviFilePtr->infoPtr->codePtr,
			   (objc == 3) ? (Tcl_Obj *)0 : objv[3]);
	    break;

	case DVICFI_ANCHORS:
	    if (objc != 3 && objc != 4) {
		Tcl_WrongNumArgs(interp, 3, objv, "?pattern?");
		return TCL_ERROR;
	    }

	    pattern = objc == 4 ? Tcl_GetStringFromObj(objv[3], (int *)0) : 0;
	    entryPtr = Tcl_FirstHashEntry(&dviCookiePtr->anchorTable, &search);
	    while (entryPtr != (Tcl_HashEntry *)0) {
		char *key = Tcl_GetHashKey(&dviCookiePtr->anchorTable,
					   entryPtr);
		if (pattern == 0 || Tcl_StringMatch(key, pattern) == 1) {
		    Tcl_Obj *anchorObj = Tcl_NewStringObj(key, -1);
		    Tcl_ListObjAppendElement(interp, resultPtr, anchorObj);
		}
		entryPtr = Tcl_NextHashEntry(&search);
	    }
	    break;

	case DVICFI_FONTS:
	    if (objc != 3) {
		Tcl_WrongNumArgs(interp, 3, objv, "");
		return TCL_ERROR;
	    }

	    Tcl_SetStringObj(resultPtr, "font list", -1);
	}
	break;

    case DVICF_FINDANCHOR:
	if (objc != 3) {
	    Tcl_WrongNumArgs(interp, 2, objv, "anchor");
	    return TCL_ERROR;
	} else {
	    char *anchor;
	    Tcl_HashEntry *entryPtr;

	    anchor = Tcl_GetStringFromObj(objv[2], (int *)0);
	    entryPtr = Tcl_FindHashEntry(&dviCookiePtr->anchorTable, anchor);
	    if (entryPtr == (Tcl_HashEntry *)0) {
		Tcl_SetIntObj(resultPtr, -1);
	    } else {
		Tcl_SetIntObj(resultPtr, (int)Tcl_GetHashValue(entryPtr));
	    }
	}
	break;

    case DVICF_FINDCODE:
	if (objc != 3) {
	    Tcl_WrongNumArgs(interp, 2, objv, "pageNumber");
	    return TCL_ERROR;
	} else {
	    int pageNumber;
	    if (Tcl_GetIntFromObj(interp, objv[2], &pageNumber) != TCL_OK) {
		return TCL_ERROR;
	    } else {
		Dvi_Code *codePtr = dviCookiePtr->dviFilePtr->infoPtr->codePtr;
		U8 *codeBytesPtr;
		char buf[12];

		if (pageNumber < 0 || pageNumber >= codePtr->pageCount) {
		    Tcl_SetResult(interp, "absolute page number out of bounds",
				  TCL_STATIC);
		    return TCL_ERROR;
		}
		
		codeBytesPtr = Dvi_CodeFindCodeForPage(codePtr, pageNumber);
		if (codeBytesPtr == (U8 *)0) {
		    Tcl_SetResult(interp,
				  "code for page not found (can't happen)",
				  TCL_STATIC);
		    return TCL_ERROR;
		}

		Tcl_SetIntObj(resultPtr,
			      codeBytesPtr
			      - dviCookiePtr->dviFilePtr->infoPtr->contents);
	    }
	}
	break;

    case DVICF_FINDPAGE:
	if (objc != 3) {
	    Tcl_WrongNumArgs(interp, 2, objv, "pageSpec");
	    return TCL_ERROR;
	} else {
	    char *page = Tcl_GetStringFromObj(objv[2], (int *)0);
	    Dvi_PageSpec pageSpec;
	    
	    if (Dvi_CodeGetPageSpec(page, &pageSpec) == 0) {
		Tcl_AppendStringsToObj(resultPtr, "page specification \"",
				       page, "\" is invalid", (char *)0);
		return TCL_ERROR;
	    } else {
		int pageNumber = Dvi_CodeFindTeXPage(dviCookiePtr->
						     dviFilePtr->infoPtr->
						     codePtr, &pageSpec);
		if (pageNumber < 0) {
		    Tcl_AppendStringsToObj(resultPtr, "no page \"", page,
					   "\" found", (char *)0);
		    return TCL_ERROR;
		}
		Tcl_SetObjResult(interp, Tcl_NewIntObj((int)pageNumber));
	    }
	}
	break;

    case DVICF_CHANGED:
	if (objc != 2) {
	    Tcl_WrongNumArgs(interp, 2, objv, "");
	    return TCL_ERROR;
	} else {
	    int changed;

	    if ((changed = Dvi_FileChanged(dviCookiePtr->dviFilePtr)) < 0) {
		Tcl_SetResult(interp, Tcl_PosixError(interp), TCL_VOLATILE);
		return TCL_ERROR;
	    }
	    Tcl_SetObjResult(interp, Tcl_NewBooleanObj(changed));
	}
	break;

    case DVICF_RELOAD:
	if (objc != 2) {
	    Tcl_WrongNumArgs(interp, 2, objv, "");
	    return TCL_ERROR;
	}

	Dvi_FileReload(dviCookiePtr->dviFilePtr, DviFileTclError,
		       (ClientData)interp);
	break;

    case DVICF_CLOSE:
	if (objc != 2) {
	    Tcl_WrongNumArgs(interp, 2, objv, "");
	    return TCL_ERROR;
	}

	Dvi_FileClose(dviCookiePtr->dviFilePtr);
	Tcl_DecrRefCount(dviCookiePtr->reloadCmd);
	Tcl_DeleteCommandFromToken(dviCookiePtr->interp,
				   dviCookiePtr->cmdCookie);
	Tcl_DeleteHashTable(&dviCookiePtr->anchorTable);
	ckfree((char *)dviCookiePtr);
	break;

    }
    return TCL_OK;
}

static int
RegisterAnchor (clientData, anchor, pageNum)
    ClientData clientData;
    char *anchor;
    unsigned int pageNum;
{
    /* fprintf(stderr, "RegisterAnchor: clientData %p anchor %s pageNum %u\n",
       clientData, anchor, pageNum); */
    
    Tcl_HashTable *anchorTable = (Tcl_HashTable *)clientData;
    Tcl_HashEntry *entryPtr;
    int new;

    entryPtr = Tcl_CreateHashEntry(anchorTable, anchor, &new);
    Tcl_SetHashValue(entryPtr, (ClientData)pageNum);

    return TCL_OK;
}

static int
DviCodeCreateCmd (clientData, interp, objc, objv)
    ClientData clientData;
    Tcl_Interp *interp;
    int objc;
    Tcl_Obj * CONST objv[];
{
    Tcl_Obj *resultPtr = Tcl_GetObjResult(interp);
    int objIdx;
    static int cookieCount = 0;
    char *cookieName;
    char cookieNameBuf[32];
    char *optionPtr;
    DviCFCookie *cookiePtr;
    Tcl_HashTable *cfTablePtr;
    Tcl_HashEntry *hPtr;
    int new;
    
    if (objc < 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "?cookie? -file filename");
	return TCL_ERROR;
    }

    cookieName = Tcl_GetStringFromObj(objv[2], (int *)0);
    if (cookieName[0] == '-') {	/* no cookie specified */
	int new = 0;
	Tcl_CmdInfo junk;
	do {
	    sprintf(cookieNameBuf, "dvi%d", cookieCount++);
	} while (Tcl_GetCommandInfo(interp, cookieNameBuf, &junk) == 1);
	cookieName = cookieNameBuf;
	objIdx = 2;
    } else {
	Tcl_CmdInfo junk;
	if (Tcl_GetCommandInfo(interp, cookieName, &junk) == 1) {
	    Tcl_AppendStringsToObj(resultPtr, "command \"", cookieName,
				   "\" already defined", (char *)0);
	    return TCL_ERROR;
	}
	objIdx = 3;
    }

    /*
     * At this point `cookie' points to a suitable command name for
     * the new procedure.
     */

    optionPtr = Tcl_GetStringFromObj(objv[objIdx], (int *)0);
    if (strcmp(optionPtr, "-file") != 0) {
	Tcl_AppendStringsToObj(resultPtr, "invalid option \"", optionPtr,
			       "\"", (char *)0);
	return TCL_ERROR;
    }
    if (objIdx + 1 >= objc) {
	Tcl_WrongNumArgs(interp, objIdx, objv, "filename");
	return TCL_ERROR;
    }

    cookiePtr = (DviCFCookie *)ckalloc(sizeof(DviCFCookie));
    cookiePtr->interp = interp;
    cookiePtr->reloadCmd = (Tcl_Obj *)0;

    cookiePtr->dviFilePtr = Dvi_FileOpen(Tcl_GetStringFromObj(objv[objIdx+1],
							      (int *)0),
					 InvokeReloadCmds,
					 (ClientData)cookiePtr,
					 DviFileTclError, (ClientData)interp);
    if (cookiePtr->dviFilePtr == (Dvi_File *)0) {
	return TCL_ERROR;
    }

    Tcl_InitHashTable(&cookiePtr->anchorTable, TCL_STRING_KEYS);

    cookiePtr->dviFilePtr->infoPtr->codePtr
	= Dvi_CodeCreateFromFileInfo(cookiePtr->dviFilePtr->infoPtr,
				     RegisterAnchor, &cookiePtr->anchorTable);

    Tcl_SetStringObj(resultPtr, cookieName, -1);
    Tcl_CreateObjCommand(interp, cookieName, DviCodeObjCmd,
			 (ClientData)cookiePtr, (Tcl_CmdDeleteProc *)0);

    cfTablePtr = (Tcl_HashTable *)Tcl_GetAssocData(interp, DVI_NAME,
						   (Tcl_InterpDeleteProc **)0);
    hPtr = Tcl_CreateHashEntry(cfTablePtr, cookieName, &new);
    if (new) {
	Tcl_SetHashValue(hPtr, cookiePtr);
    } else {
	Tcl_SetResult(interp,
		      "cookie name already in hash table (shouldn't happen)",
		      TCL_STATIC);
	return TCL_ERROR;
    }
    return TCL_OK;
}

/*
 * ------------------------------------------------------------------------
 *
 * InvokeReloadCmds --
 *
 *      This procedure invokes the registered command when the file
 *      pointed to by dviFile is being reloaded.
 *
 * Side effects:
 *      Whatever the cookiePtr->reloadCmd does.
 *
 * ------------------------------------------------------------------------
 */

static void
InvokeReloadCmds (clientData, dviFile)
    ClientData clientData;
    Dvi_File *dviFile;
{
    DviCFCookie *cookiePtr = (DviCFCookie *)clientData;

    cookiePtr->dviFilePtr->infoPtr->codePtr
	= Dvi_CodeCreateFromFileInfo(cookiePtr->dviFilePtr->infoPtr,
				     RegisterAnchor, &cookiePtr->anchorTable);
    if (cookiePtr->reloadCmd) {
	Tcl_GlobalEvalObj(cookiePtr->interp, cookiePtr->reloadCmd);
    }
}

/*
 * ------------------------------------------------------------------------
 *
 * Dvi_GetFileByCookie --
 *
 *      Returns a pointer to a Dvi_File given a DVI cookie.
 *
 * Results:
 *      A pointer to the Dvi_File structure of the file identified by
 *      `cookie' or a null pointer if the cookie doesn't currently
 *      exist. In the latter case, if `flags' is TCL_LEAVE_ERR_MSG,
 *      then an * error message appears as the Tcl result.
 *
 * Side Effects:
 *      None.
 *
 * ------------------------------------------------------------------------
 */

Dvi_File *
Dvi_GetFileByCookie (interp, cookie, flags)
    Tcl_Interp *interp;		/* Current Tcl interpreter */
    const char *cookie;		/* DVI file cookie in question */
    const int flags;		/* 0, or TCL_LEAVE_ERR_MSG */
{
    Tcl_HashTable *cfTablePtr;
    Tcl_HashEntry *cookieEntry;

    cfTablePtr = (Tcl_HashTable *)Tcl_GetAssocData(interp, DVI_NAME,
					  (Tcl_InterpDeleteProc **)0);
    cookieEntry = Tcl_FindHashEntry(cfTablePtr, cookie);
    if (cookieEntry == (Tcl_HashEntry *)0) {
	if (flags & TCL_LEAVE_ERR_MSG) {
	    Tcl_Obj *resultPtr = Tcl_GetObjResult(interp);
	    Tcl_AppendStringsToObj(resultPtr, "DVI cookie \"", cookie,
				   "\" does not exist", (char *)0);
	}
	return (Dvi_File *)0;
    }
    return ((DviCFCookie *)Tcl_GetHashValue(cookieEntry))->dviFilePtr;
}

/*
 * ------------------------------------------------------------------------
 *
 * DeleteCFTable --
 *
 *      Removes the cookie-to-Dvi-info translation table.
 *
 * This procedure is called when the Tcl interpreter is deleted. It
 * removes the hash table used to map cookie names to DviCookie structures.
 *
 * ------------------------------------------------------------------------
 */

static void
DeleteCFTable (clientData, interp)
    ClientData clientData __attribute__((unused));
    Tcl_Interp *interp;
{
    Tcl_HashTable *cfTablePtr;

    cfTablePtr = (Tcl_HashTable *)Tcl_GetAssocData(interp, DVI_NAME,
					  (Tcl_InterpDeleteProc **)0);
    if (cfTablePtr != 0) {
	Tcl_DeleteHashTable(cfTablePtr);
    }
    Tcl_DeleteAssocData(interp, DVI_NAME);
}

int
Dvicf_Init (interp)
    Tcl_Interp *interp;
{
    Tcl_Obj *resultPtr;
    Tcl_HashTable *cfTablePtr;

#ifdef USE_TCL_STUBS
    if (Tcl_InitStubs(interp, "8.0", 0) == 0) {
	return TCL_ERROR;
    }
#endif /* USE_TCL_STUBS */

    if (Tcl_PkgProvide(interp, "Dvicf", VERSION) != TCL_OK) {
	return TCL_ERROR;
    }

    cfTablePtr = (Tcl_HashTable *)ckalloc(sizeof(Tcl_HashTable));
    if (cfTablePtr == (Tcl_HashTable *)0) {
	Tcl_SetResult(interp, "not enough memory for cfTable", TCL_STATIC);
	return TCL_ERROR;
    }
    Tcl_InitHashTable(cfTablePtr, TCL_STRING_KEYS);
    Tcl_SetAssocData(interp, DVI_NAME, DeleteCFTable,
		     (ClientData)cfTablePtr);

    Tcl_CreateObjCommand(interp, "::dvi::code", DviCodeCreateCmd,
			 (ClientData)cfTablePtr, (Tcl_CmdDeleteProc *)0);
    return TCL_OK;
}
