Posted to tcl by lm at Wed Oct 31 23:07:20 GMT 2007view raw

  1. TclFopenObjCmd(
  2. ClientData dummy, /* Not used. */
  3. Tcl_Interp *interp, /* Current interpreter. */
  4. int objc, /* Number of arguments. */
  5. Tcl_Obj *const objv[]) /* Argument objects. */
  6. {
  7. char *mode = "r";
  8. char *fileName;
  9. char buf[100];
  10. FILE *f;
  11.  
  12. if ((objc < 2) || (objc > 3)) {
  13. Tcl_WrongNumArgs(interp, 1, objv, "fileName ?mode?");
  14. return TCL_ERROR;
  15. }
  16. fileName = Tcl_GetString(objv[1]);
  17. if (objc == 3) mode = Tcl_GetString(objv[2]);
  18. if ((f = fopen(fileName, mode)) == NULL) {
  19. Tcl_AppendResult(interp,
  20. "could not open file \"", fileName, "\"", NULL);
  21. return TCL_ERROR;
  22. }
  23. sprintf(buf, "%p", f);
  24. Tcl_SetStringObj(Tcl_GetObjResult(interp), buf, -1);
  25. return TCL_OK;
  26. }
  27. ^L
  28. int
  29. chomp(char *s)
  30. {
  31. int any = 0;
  32. char *p;
  33.  
  34. p = s + strlen(s);
  35. while ((p > s) && ((p[-1] == '\n') || (p[-1] == '\r'))) --p, any = 1;
  36. *p = 0;
  37. return (any);
  38. }
  39. int
  40. TclFgetlineObjCmd(
  41. ClientData dummy, /* Not used. */
  42. Tcl_Interp *interp, /* Current interpreter. */
  43. int objc, /* Number of arguments. */
  44. Tcl_Obj *const objv[]) /* Argument objects. */
  45. {
  46. FILE *f;
  47. char buf[2048];
  48.  
  49. if (objc != 3) {
  50. Tcl_WrongNumArgs(interp, 1, objv, "fileHandle varName");
  51. return TCL_ERROR;
  52. }
  53. sscanf(Tcl_GetString(objv[1]), "%p", &f);
  54. buf[0] = 0;
  55. if (fgets(buf, sizeof(buf), f)) {
  56. chomp(buf);
  57. Tcl_ObjSetVar2(interp, objv[2], NULL, Tcl_NewStringObj(buf, -1), 0);
  58. Tcl_SetObjResult(interp, Tcl_NewIntObj(strlen(buf)));
  59. } else {
  60. Tcl_SetObjResult(interp, Tcl_NewIntObj(-1));
  61. }
  62. return TCL_OK;
  63. }
  64.  
  65.