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

  1. package require critcl
  2.  
  3. critcl::ccode {
  4. #define PATHOBJ(pathPtr) ((FsPath *) (pathPtr)->internalRep.twoPtrValue.ptr1)
  5. typedef struct FsPath {
  6. Tcl_Obj *translatedPathPtr; /* Name without any ~user sequences. If this
  7. * is NULL, then this is a pure normalized,
  8. * absolute path object, in which the parent
  9. * Tcl_Obj's string rep is already both
  10. * translated and normalized. */
  11. Tcl_Obj *normPathPtr; /* Normalized absolute path, without ., .. or
  12. * ~user sequences. If the Tcl_Obj containing
  13. * this FsPath is already normalized, this may
  14. * be a circular reference back to the
  15. * container. If that is NOT the case, we have
  16. * a refCount on the object. */
  17. Tcl_Obj *cwdPtr; /* If null, path is absolute, else this points
  18. * to the cwd object used for this path. We
  19. * have a refCount on the object. */
  20. int flags; /* Flags to describe interpretation - see
  21. * below. */
  22. ClientData nativePathPtr; /* Native representation of this path, which
  23. * is filesystem dependent. */
  24. int filesystemEpoch; /* Used to ensure the path representation was
  25. * generated during the correct filesystem
  26. * epoch. The epoch changes when
  27. * filesystem-mounts are changed. */
  28. const Tcl_Filesystem *fsPtr;/* The Tcl_Filesystem that claims this path */
  29. } FsPath;
  30.  
  31. /*
  32. * Flag values for FsPath->flags.
  33. */
  34.  
  35. #define TCLPATH_APPENDED 1
  36. #define TCLPATH_NEEDNORM 4
  37. }
  38.  
  39. critcl::cproc pathbits {Tcl_Interp* interp Tcl_Obj* pathPtr} ok {
  40. if (pathPtr->typePtr == NULL || strcmp(pathPtr->typePtr->name, "path")) {
  41. return TCL_ERROR;
  42. }
  43. FsPath *path = PATHOBJ(pathPtr);
  44.  
  45. int type = Tcl_FSGetPathType(pathPtr);
  46. int flags = path->flags;
  47.  
  48. Tcl_Obj *result = Tcl_ObjPrintf("type %d flags %d", type, flags);
  49.  
  50. Tcl_ListObjAppendElement(NULL, result, Tcl_ObjPrintf("translatedPathPtr"));
  51. if (path->translatedPathPtr != NULL) {
  52. Tcl_ListObjAppendElement(NULL, result, path->translatedPathPtr);
  53. } else {
  54. Tcl_ListObjAppendElement(NULL, result, Tcl_ObjPrintf("NULL"));
  55. }
  56.  
  57. Tcl_ListObjAppendElement(NULL, result, Tcl_ObjPrintf("normPathPtr"));
  58. if (path->normPathPtr != NULL) {
  59. Tcl_ListObjAppendElement(NULL, result, path->normPathPtr);
  60. } else {
  61. Tcl_ListObjAppendElement(NULL, result, Tcl_ObjPrintf("NULL"));
  62. }
  63.  
  64. Tcl_ListObjAppendElement(NULL, result, Tcl_ObjPrintf("cwdPtr"));
  65. if (path->cwdPtr != NULL) {
  66. Tcl_ListObjAppendElement(NULL, result, path->cwdPtr);
  67. } else {
  68. Tcl_ListObjAppendElement(NULL, result, Tcl_ObjPrintf("NULL"));
  69. }
  70.  
  71. Tcl_SetObjResult(interp, result);
  72.  
  73. return TCL_OK;
  74. }
  75.  
  76.  
  77. # % pathbits [file normalize {}]
  78. # type 1 flags 0 translatedPathPtr {} normPathPtr {} cwdPtr /home/aspect/tcl
  79. # % pathbits [file normalize foo]
  80. # type 0 flags 1 translatedPathPtr NULL normPathPtr foo cwdPtr /home/aspect/tcl
  81.