tclwinfcmd.c

linux系统下的音频通信

 *
 * Side effects:
 *      Depending on the value of type, src may be copied to dst.
 *      
 *----------------------------------------------------------------------
 */

static int 
TraversalCopy(
    char *src,			/* Source pathname to copy. */
    char *dst,			/* Destination pathname of copy. */
    DWORD srcAttr,		/* File attributes for src. */
    int type,			/* Reason for call - see TraverseWinTree() */
    Tcl_DString *errorPtr)	/* If non-NULL, initialized DString for
				 * error return. */
{
    switch (type) {
	case DOTREE_F:
	    if (TclpCopyFile(src, dst) == TCL_OK) {
		return TCL_OK;
	    }
	    break;

	case DOTREE_PRED:
	    if (TclpCreateDirectory(dst) == TCL_OK) {
		if (SetFileAttributes(dst, srcAttr) != FALSE) {
		    return TCL_OK;
		}
		TclWinConvertError(GetLastError());
	    }
	    break;

        case DOTREE_POSTD:
	    return TCL_OK;

    }

    /*
     * There shouldn't be a problem with src, because we already
     * checked it to get here.
     */

    if (errorPtr != NULL) {
	Tcl_DStringAppend(errorPtr, dst, -1);
    }
    return TCL_ERROR;
}

/*
 *----------------------------------------------------------------------
 *
 * TraversalDelete --
 *
 *      Called by procedure TraverseWinTree for every file and
 *      directory that it encounters in a directory hierarchy. This
 *      procedure unlinks files, and removes directories after all the
 *      containing files have been processed.
 *
 * Results:
 *      Standard Tcl result.
 *
 * Side effects:
 *      Files or directory specified by src will be deleted. If an
 *      error occurs, the windows error is converted to a Posix error
 *      and errno is set accordingly.
 *
 *----------------------------------------------------------------------
 */

static int
TraversalDelete( 
    char *src,			/* Source pathname. */
    char *ignore,		/* Destination pathname (not used). */
    DWORD srcAttr,		/* File attributes for src (not used). */
    int type,			/* Reason for call - see TraverseWinTree(). */
    Tcl_DString *errorPtr)	/* If non-NULL, initialized DString for
				 * error return. */
{
    switch (type) {
	case DOTREE_F:
	    if (TclpDeleteFile(src) == TCL_OK) {
		return TCL_OK;
	    }
	    break;

	case DOTREE_PRED:
	    return TCL_OK;

	case DOTREE_POSTD:
	    if (TclpRemoveDirectory(src, 0, NULL) == TCL_OK) {
		return TCL_OK;
	    }
	    break;

    }

    if (errorPtr != NULL) {
	Tcl_DStringAppend(errorPtr, src, -1);
    }
    return TCL_ERROR;
}

/*
 *----------------------------------------------------------------------
 *
 * AttributesPosixError --
 *
 *	Sets the object result with the appropriate error.
 *
 * Results:
 *      None.
 *
 * Side effects:
 *      The interp's object result is set with an error message
 *	based on the objIndex, fileName and errno.
 *
 *----------------------------------------------------------------------
 */

static void
AttributesPosixError(
    Tcl_Interp *interp,		/* The interp that has the error */
    int objIndex,		/* The attribute which caused the problem. */
    char *fileName,		/* The name of the file which caused the 
				 * error. */
    int getOrSet)		/* 0 for get; 1 for set */
{
    TclWinConvertError(GetLastError());
    Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), 
	    "cannot ", getOrSet ? "set" : "get", " attribute \"", 
	    tclpFileAttrStrings[objIndex], "\" for file \"", fileName, 
	    "\": ", Tcl_PosixError(interp), (char *) NULL);
}

/*
 *----------------------------------------------------------------------
 *
 * GetWinFileAttributes --
 *
 *      Returns a Tcl_Obj containing the value of a file attribute.
 *	This routine gets the -hidden, -readonly or -system attribute.
 *
 * Results:
 *      Standard Tcl result and a Tcl_Obj in attributePtrPtr. The object
 *	will have ref count 0. If the return value is not TCL_OK,
 *	attributePtrPtr is not touched.
 *
 * Side effects:
 *      A new object is allocated if the file is valid.
 *
 *----------------------------------------------------------------------
 */

static int
GetWinFileAttributes(
    Tcl_Interp *interp,		    /* The interp we are using for errors. */
    int objIndex,		    /* The index of the attribute. */
    char *fileName,		    /* The name of the file. */
    Tcl_Obj **attributePtrPtr)	    /* A pointer to return the object with. */
{
    DWORD result = GetFileAttributes(fileName);

    if (result == 0xFFFFFFFF) {
	AttributesPosixError(interp, objIndex, fileName, 0);
	return TCL_ERROR;
    }

    *attributePtrPtr = Tcl_NewBooleanObj(result & attributeArray[objIndex]);
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * ConvertFileNameFormat --
 *
 *      Returns a Tcl_Obj containing either the long or short version of the 
 *	file name.
 *
 * Results:
 *      Standard Tcl result and a Tcl_Obj in attributePtrPtr. The object
 *	will have ref count 0. If the return value is not TCL_OK,
 *	attributePtrPtr is not touched.
 *
 * Side effects:
 *      A new object is allocated if the file is valid.
 *
 *----------------------------------------------------------------------
 */

static int
ConvertFileNameFormat(
    Tcl_Interp *interp,		    /* The interp we are using for errors. */
    int objIndex,		    /* The index of the attribute. */
    char *fileName,		    /* The name of the file. */
    int longShort,		    /* 0 to short name, 1 to long name. */
    Tcl_Obj **attributePtrPtr)	    /* A pointer to return the object with. */
{
    HANDLE findHandle;
    WIN32_FIND_DATA findData;
    int pathArgc, i;
    char **pathArgv, **newPathArgv;
    char *currentElement, *resultStr;
    Tcl_DString resultDString;
    int result = TCL_OK;

    Tcl_SplitPath(fileName, &pathArgc, &pathArgv);
    newPathArgv = (char **) ckalloc(pathArgc * sizeof(char *));

    i = 0;
    if ((pathArgv[0][0] == '/') 
	    || ((strlen(pathArgv[0]) == 3) && (pathArgv[0][1] == ':'))) {
	newPathArgv[0] = (char *) ckalloc(strlen(pathArgv[0]) + 1);
	strcpy(newPathArgv[0], pathArgv[0]);
	i = 1;
    } 
    for ( ; i < pathArgc; i++) {
	if (strcmp(pathArgv[i], ".") == 0) {
	    currentElement = ckalloc(2);
	    strcpy(currentElement, ".");
	} else if (strcmp(pathArgv[i], "..") == 0) {
	    currentElement = ckalloc(3);
	    strcpy(currentElement, "..");
	} else {
	    int useLong;

	    Tcl_DStringInit(&resultDString);
	    resultStr = Tcl_JoinPath(i + 1, pathArgv, &resultDString);
	    findHandle = FindFirstFile(resultStr, &findData);
	    if (findHandle == INVALID_HANDLE_VALUE) {
		pathArgc = i - 1;
		AttributesPosixError(interp, objIndex, fileName, 0);
		result = TCL_ERROR;
		Tcl_DStringFree(&resultDString);
		goto cleanup;
	    }
	    if (longShort) {
		if (findData.cFileName[0] != '\0') {
		    useLong = 1;
		} else {
		    useLong = 0;
		}
	    } else {
		if (findData.cAlternateFileName[0] == '\0') {
		    useLong = 1;
		} else {
		    useLong = 0;
		}
	    }
	    if (useLong) {
		currentElement = ckalloc(strlen(findData.cFileName) + 1);
		strcpy(currentElement, findData.cFileName);
	    } else {
		currentElement = ckalloc(strlen(findData.cAlternateFileName) 
			+ 1);
		strcpy(currentElement, findData.cAlternateFileName);
	    }
	    Tcl_DStringFree(&resultDString);
	    FindClose(findHandle);
	}
	newPathArgv[i] = currentElement;
    }

    Tcl_DStringInit(&resultDString);
    resultStr = Tcl_JoinPath(pathArgc, newPathArgv, &resultDString);
    *attributePtrPtr = Tcl_NewStringObj(resultStr, Tcl_DStringLength(&resultDString));
    Tcl_DStringFree(&resultDString);

cleanup:
    for (i = 0; i < pathArgc; i++) {
	ckfree(newPathArgv[i]);
    }
    ckfree((char *) newPathArgv);
    return result;
}

/*
 *----------------------------------------------------------------------
 *
 * GetWinFileLongName --
 *
 *      Returns a Tcl_Obj containing the short version of the file
 *	name.
 *
 * Results:
 *      Standard Tcl result and a Tcl_Obj in attributePtrPtr. The object
 *	will have ref count 0. If the return value is not TCL_OK,
 *	attributePtrPtr is not touched.
 *
 * Side effects:
 *      A new object is allocated if the file is valid.
 *
 *----------------------------------------------------------------------
 */

static int
GetWinFileLongName(
    Tcl_Interp *interp,		    /* The interp we are using for errors. */
    int objIndex,		    /* The index of the attribute. */
    char *fileName,		    /* The name of the file. */
    Tcl_Obj **attributePtrPtr)	    /* A pointer to return the object with. */
{
    return ConvertFileNameFormat(interp, objIndex, fileName, 1, attributePtrPtr);
}

/*
 *----------------------------------------------------------------------
 *
 * GetWinFileShortName --
 *
 *      Returns a Tcl_Obj containing the short version of the file
 *	name.
 *
 * Results:
 *      Standard Tcl result and a Tcl_Obj in attributePtrPtr. The object
 *	will have ref count 0. If the return value is not TCL_OK,
 *	attributePtrPtr is not touched.
 *
 * Side effects:
 *      A new object is allocated if the file is valid.
 *
 *----------------------------------------------------------------------
 */

static int
GetWinFileShortName(
    Tcl_Interp *interp,		    /* The interp we are using for errors. */
    int objIndex,		    /* The index of the attribute. */
    char *fileName,		    /* The name of the file. */
    Tcl_Obj **attributePtrPtr)	    /* A pointer to return the object with. */
{
    return ConvertFileNameFormat(interp, objIndex, fileName, 0, attributePtrPtr);
}

/*
 *----------------------------------------------------------------------
 *
 * SetWinFileAttributes --
 *
 *	Set the file attributes to the value given by attributePtr.
 *	This routine sets the -hidden, -readonly, or -system attributes.
 *
 * Results:
 *      Standard TCL error.
 *
 * Side effects:
 *      The file's attribute is set.
 *
 *----------------------------------------------------------------------
 */

static int
SetWinFileAttributes(
    Tcl_Interp *interp,		    /* The interp we are using for errors. */
    int objIndex,		    /* The index of the attribute. */
    char *fileName,		    /* The name of the file. */
    Tcl_Obj *attributePtr)	    /* The new value of the attribute. */
{
    DWORD fileAttributes = GetFileAttributes(fileName);
    int yesNo;
    int result;

    if (fileAttributes == 0xFFFFFFFF) {
	AttributesPosixError(interp, objIndex, fileName, 1);
	return TCL_ERROR;
    }

    result = Tcl_GetBooleanFromObj(interp, attributePtr, &yesNo);
    if (result != TCL_OK) {
	return result;
    }

    if (yesNo) {
	fileAttributes |= (attributeArray[objIndex]);
    } else {
	fileAttributes &= ~(attributeArray[objIndex]);
    }

    if (!SetFileAttributes(fileName, fileAttributes)) {
	AttributesPosixError(interp, objIndex, fileName, 1);
	return TCL_ERROR;
    }
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * SetWinFileLongName --
 *
 *	The attribute in question is a readonly attribute and cannot
 *	be set.
 *
 * Results:
 *      TCL_ERROR
 *
 * Side effects:
 *      The object result is set to a pertinant error message.
 *
 *----------------------------------------------------------------------
 */

static int
CannotSetAttribute(
    Tcl_Interp *interp,		    /* The interp we are using for errors. */
    int objIndex,		    /* The index of the attribute. */
    char *fileName,		    /* The name of the file. */
    Tcl_Obj *attributePtr)	    /* The new value of the attribute. */
{
    Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), 
	    "cannot set attribute \"", tclpFileAttrStrings[objIndex],
	    "\" for file \"", fileName, "\" : attribute is readonly", 
	    (char *) NULL);
    return TCL_ERROR;
}


/*
 *---------------------------------------------------------------------------
 *
 * TclpListVolumes --
 *
 *	Lists the currently mounted volumes
 *
 * Results:
 *	A standard Tcl result.  Will always be TCL_OK, since there is no way
 *	that this command can fail.  Also, the interpreter's result is set to 
 *	the list of volumes.
 *
 * Side effects:
 *	None
 *
 *---------------------------------------------------------------------------
 */

int
TclpListVolumes( 
    Tcl_Interp *interp)    /* Interpreter to which to pass the volume list */
{
    Tcl_Obj *resultPtr, *elemPtr;
    char buf[4];
    int i;

    resultPtr = Tcl_GetObjResult(interp);

    buf[1] = ':';
    buf[2] = '/';
    buf[3] = '\0';

    /*
     * On Win32s: 
     * GetLogicalDriveStrings() isn't implemented.
     * GetLogicalDrives() returns incorrect information.
     */

    for (i = 0; i < 26; i++) {
        buf[0] = (char) ('a' + i);
	if (GetVolumeInformation(buf, NULL, 0, NULL, NULL, NULL, NULL, 0)  
		|| (GetLastError() == ERROR_NOT_READY)) {
	    elemPtr = Tcl_NewStringObj(buf, -1);
	    Tcl_ListObjAppendElement(NULL, resultPtr, elemPtr);
	}
    }
    return TCL_OK;	
}