Posted to tcl by lmcvoy at Mon Nov 05 22:13:55 GMT 2007view raw

  1. ===== generic/tclBasic.c 1.204 vs edited =====
  2. --- 1.204/generic/tclBasic.c 2007-10-17 11:24:46 -07:00
  3. +++ edited/generic/tclBasic.c 2007-11-02 08:07:04 -07:00
  4. @@ -193,6 +193,10 @@ static const CmdInfo builtInCmds[] = {
  5.  
  6. {"L", Tcl_LObjCmd, TclCompileLCmd, 1},
  7. {"pointer", Tcl_PointerObjCmd, TclCompilePointerCmd, 1},
  8. + {"fopen", TclFopenObjCmd, NULL, 1},
  9. + {"fread", TclFreadObjCmd, NULL, 1},
  10. + {"fgetline", TclFgetlineObjCmd, NULL, 1},
  11. + {"fputs", TclFputsObjCmd, NULL, 1},
  12. /*
  13. * Commands in the UNIX core:
  14. */
  15. ===== generic/tclCmdIL.c 1.98 vs edited =====
  16. --- 1.98/generic/tclCmdIL.c 2007-10-17 12:19:58 -07:00
  17. +++ edited/generic/tclCmdIL.c 2007-11-02 08:07:04 -07:00
  18. @@ -1,3 +1,4 @@
  19. +#define INFO_BODY_ENABLED
  20. /*
  21. * tclCmdIL.c --
  22. *
  23. ===== generic/tclIOCmd.c 1.44 vs edited =====
  24. --- 1.44/generic/tclIOCmd.c 2007-10-15 14:27:48 -07:00
  25. +++ edited/generic/tclIOCmd.c 2007-11-02 08:07:04 -07:00
  26. @@ -1778,11 +1778,130 @@ TclChanTruncateObjCmd(
  27. return TCL_OK;
  28. }
  29.  
  30.  
  31. -/*
  32. - * Local Variables:
  33. - * mode: c
  34. - * c-basic-offset: 4
  35. - * fill-column: 78
  36. - * End:
  37. - */
  38. +int
  39. +TclFopenObjCmd(
  40. + ClientData dummy, /* Not used. */
  41. + Tcl_Interp *interp, /* Current interpreter. */
  42. + int objc, /* Number of arguments. */
  43. + Tcl_Obj *const objv[]) /* Argument objects. */
  44. +{
  45. + char *mode = "r";
  46. + char *fileName;
  47. + char buf[100];
  48. + FILE *f;
  49.  
  50. + if ((objc < 2) || (objc > 3)) {
  51. + Tcl_WrongNumArgs(interp, 1, objv, "fileName ?mode?");
  52. + return TCL_ERROR;
  53. + }
  54. + fileName = Tcl_GetString(objv[1]);
  55. + if (objc == 3) mode = Tcl_GetString(objv[2]);
  56. + if ((f = fopen(fileName, mode)) == NULL) {
  57. + Tcl_AppendResult(interp,
  58. + "could not open file \"", fileName, "\"", NULL);
  59. + return TCL_ERROR;
  60. + }
  61. + sprintf(buf, "%p", f);
  62. + Tcl_SetStringObj(Tcl_GetObjResult(interp), buf, -1);
  63. + return TCL_OK;
  64. +}
  65. +
  66.  
  67. +int
  68. +chomp(char *s)
  69. +{
  70. + int any = 0;
  71. + char *p;
  72. +
  73. + p = s + strlen(s);
  74. + while ((p > s) && ((p[-1] == '\n') || (p[-1] == '\r'))) --p, any = 1;
  75. + *p = 0;
  76. + return (any);
  77. +}
  78. +
  79. +int
  80. +TclFgetlineObjCmd(
  81. + ClientData dummy, /* Not used. */
  82. + Tcl_Interp *interp, /* Current interpreter. */
  83. + int objc, /* Number of arguments. */
  84. + Tcl_Obj *const objv[]) /* Argument objects. */
  85. +{
  86. + FILE *f;
  87. + char buf[2048];
  88. +
  89. + if (objc != 3) {
  90. + Tcl_WrongNumArgs(interp, 1, objv, "fileHandle varName");
  91. + return TCL_ERROR;
  92. + }
  93. + sscanf(Tcl_GetString(objv[1]), "%p", &f);
  94. + buf[0] = 0;
  95. + if (fgets(buf, sizeof(buf), f)) {
  96. + int len = (int) strlen(buf);
  97. + Tcl_Obj *objPtr = Tcl_NewObj();
  98. + /* chomp with known length */
  99. + while (len && ((buf[len-1] == '\n') || (buf[len-1] == '\r'))) len--;
  100. + Tcl_SetStringObj(objPtr, buf, len);
  101. + Tcl_ObjSetVar2(interp, objv[2], NULL, objPtr, 0);
  102. + Tcl_SetObjResult(interp, Tcl_NewIntObj(len));
  103. + } else {
  104. + Tcl_SetObjResult(interp, Tcl_NewIntObj(-1));
  105. + }
  106. + return TCL_OK;
  107. +}
  108. +
  109. +
  110. +int
  111. +TclFputsObjCmd(
  112. + ClientData dummy, /* Not used. */
  113. + Tcl_Interp *interp, /* Current interpreter. */
  114. + int objc, /* Number of arguments. */
  115. + Tcl_Obj *const objv[]) /* Argument objects. */
  116. +{
  117. + FILE *f;
  118. +
  119. + if (objc != 3) {
  120. + Tcl_WrongNumArgs(interp, 1, objv, "fileHandle varName");
  121. + return TCL_ERROR;
  122. + }
  123. + sscanf(Tcl_GetString(objv[1]), "%p", &f);
  124. + if (fputs(Tcl_GetString(objv[2]), f) == EOF) {
  125. + Tcl_SetObjResult(interp, Tcl_NewIntObj(-1));
  126. + } else {
  127. + Tcl_SetObjResult(interp, Tcl_NewIntObj(1));
  128. + }
  129. + return TCL_OK;
  130. +}
  131. +
  132. +int
  133. +TclFreadObjCmd(
  134. + ClientData dummy, /* Not used. */
  135. + Tcl_Interp *interp, /* Current interpreter. */
  136. + int objc, /* Number of arguments. */
  137. + Tcl_Obj *const objv[]) /* Argument objects. */
  138. +{
  139. + int nBytes = 1024;
  140. + FILE *f;
  141. + char buf[1024];
  142. + Tcl_Obj *resultObj = Tcl_GetObjResult(interp);
  143. +
  144. + if ((objc < 2) || (objc > 3)) {
  145. + Tcl_WrongNumArgs(interp, 1, objv, "fileHandle ?bytesToRead?");
  146. + return TCL_ERROR;
  147. + }
  148. +
  149. + sscanf(Tcl_GetString(objv[1]), "%p", &f);
  150. +
  151. + if (objc == 3) {
  152. + if (Tcl_GetIntFromObj(interp, objv[2], &nBytes) == TCL_ERROR) {
  153. + return TCL_ERROR;
  154. + }
  155. + }
  156. +
  157. + if (nBytes == -1) {
  158. +
  159. + } else {
  160. + fread( &buf, 1, 1024, f);
  161. + Tcl_SetByteArrayObj(resultObj, buf, nBytes);
  162. + }
  163. +
  164. + return TCL_OK;
  165. +}
  166. ===== generic/tclInt.h 1.282 vs edited =====
  167. --- 1.282/generic/tclInt.h 2007-10-17 11:24:47 -07:00
  168. +++ edited/generic/tclInt.h 2007-11-02 08:07:04 -07:00
  169. @@ -2845,6 +2845,18 @@ MODULE_SCOPE int Tcl_LObjCmd(ClientData
  170. MODULE_SCOPE int Tcl_PointerObjCmd(ClientData clientData,
  171. Tcl_Interp *interp, int objc,
  172. Tcl_Obj *CONST objv[]);
  173. +MODULE_SCOPE int TclFopenObjCmd(ClientData clientData,
  174. + Tcl_Interp *interp, int objc,
  175. + Tcl_Obj *CONST objv[]);
  176. +MODULE_SCOPE int TclFreadObjCmd(ClientData clientData,
  177. + Tcl_Interp *interp, int objc,
  178. + Tcl_Obj *CONST objv[]);
  179. +MODULE_SCOPE int TclFgetlineObjCmd(ClientData clientData,
  180. + Tcl_Interp *interp, int objc,
  181. + Tcl_Obj *CONST objv[]);
  182. +MODULE_SCOPE int TclFputsObjCmd(ClientData clientData,
  183. + Tcl_Interp *interp, int objc,
  184. + Tcl_Obj *CONST objv[]);
  185.  
  186.