Posted to tcl by aspect at Tue Sep 15 04:41:22 GMT 2015view pretty

package require critcl

critcl::ccode {
    #define PATHOBJ(pathPtr) ((FsPath *) (pathPtr)->internalRep.twoPtrValue.ptr1)
    typedef struct FsPath {
        Tcl_Obj *translatedPathPtr; /* Name without any ~user sequences. If this
                    * is NULL, then this is a pure normalized,
                    * absolute path object, in which the parent
                    * Tcl_Obj's string rep is already both
                    * translated and normalized. */
        Tcl_Obj *normPathPtr;	/* Normalized absolute path, without ., .. or
                    * ~user sequences. If the Tcl_Obj containing
                    * this FsPath is already normalized, this may
                    * be a circular reference back to the
                    * container. If that is NOT the case, we have
                    * a refCount on the object. */
        Tcl_Obj *cwdPtr;		/* If null, path is absolute, else this points
                    * to the cwd object used for this path. We
                    * have a refCount on the object. */
        int flags;			/* Flags to describe interpretation - see
                    * below. */
        ClientData nativePathPtr;	/* Native representation of this path, which
                    * is filesystem dependent. */
        int filesystemEpoch;	/* Used to ensure the path representation was
                    * generated during the correct filesystem
                    * epoch. The epoch changes when
                    * filesystem-mounts are changed. */
        const Tcl_Filesystem *fsPtr;/* The Tcl_Filesystem that claims this path */
    } FsPath;

    /*
    * Flag values for FsPath->flags.
    */

    #define TCLPATH_APPENDED 1
    #define TCLPATH_NEEDNORM 4
}

critcl::cproc pathbits {Tcl_Interp* interp Tcl_Obj* pathPtr} ok {
    if (pathPtr->typePtr == NULL || strcmp(pathPtr->typePtr->name, "path")) {
        return TCL_ERROR;
    }
    FsPath *path = PATHOBJ(pathPtr);

    int type = Tcl_FSGetPathType(pathPtr);
    int flags = path->flags;

    Tcl_Obj *result = Tcl_ObjPrintf("type %d flags %d", type, flags);

    Tcl_ListObjAppendElement(NULL, result, Tcl_ObjPrintf("translatedPathPtr"));
    if (path->translatedPathPtr != NULL) {
        Tcl_ListObjAppendElement(NULL, result, path->translatedPathPtr);
    } else {
        Tcl_ListObjAppendElement(NULL, result, Tcl_ObjPrintf("NULL"));
    }

    Tcl_ListObjAppendElement(NULL, result, Tcl_ObjPrintf("normPathPtr"));
    if (path->normPathPtr != NULL) {
        Tcl_ListObjAppendElement(NULL, result, path->normPathPtr);
    } else {
        Tcl_ListObjAppendElement(NULL, result, Tcl_ObjPrintf("NULL"));
    }

    Tcl_ListObjAppendElement(NULL, result, Tcl_ObjPrintf("cwdPtr"));
    if (path->cwdPtr != NULL) {
        Tcl_ListObjAppendElement(NULL, result, path->cwdPtr);
    } else {
        Tcl_ListObjAppendElement(NULL, result, Tcl_ObjPrintf("NULL"));
    }

    Tcl_SetObjResult(interp, result);

    return TCL_OK;
}


# % pathbits [file normalize {}]
# type 1 flags 0 translatedPathPtr {} normPathPtr {} cwdPtr /home/aspect/tcl
# % pathbits [file normalize foo]
# type 0 flags 1 translatedPathPtr NULL normPathPtr foo cwdPtr /home/aspect/tcl