Posted to tcl by apw at Sun Sep 09 19:11:04 GMT 2007view raw

  1. Tcl_Method
  2. Tcl_NewProcMethod(
  3. Tcl_Interp *interp, /* The interpreter containing the object. */
  4. Tcl_Object oPtr, /* The object to modify. */
  5. TclOO_PreCallProc preCallPtr,
  6. TclOO_PostCallProc postCallPtr,
  7. Tcl_ProcErrorProc errProc,
  8. ClientData clientData,
  9. Tcl_Obj *nameObj, /* The name of the method, which must not be
  10. * NULL. */
  11. Tcl_Obj *argsObj, /* The formal argument list for the method,
  12. * which must not be NULL. */
  13. Tcl_Obj *bodyObj, /* The body of the method, which must not be
  14. * NULL. */
  15. int flags, /* Whether this is a public method. */
  16. ClientData *clientData2)
  17. {
  18. ProcedureMethod *pmPtr;
  19. Tcl_Method method;
  20.  
  21. method = (Tcl_Method)TclOONewProcMethod(interp, (Object *)oPtr, flags,
  22. nameObj, argsObj, bodyObj, &pmPtr);
  23. pmPtr->flags = flags & USE_DECLARER_NS;
  24. pmPtr->preCallProc = preCallPtr;
  25. pmPtr->postCallProc = postCallPtr;
  26. pmPtr->errProc = errProc;
  27. pmPtr->clientData = clientData;
  28. if (clientData2 != NULL) {
  29. *clientData2 = pmPtr;
  30. }
  31. return method;
  32. }
  33. Tcl_Method
  34. Tcl_NewProcClassMethod(
  35. Tcl_Interp *interp, /* The interpreter containing the class. */
  36. Tcl_Class clsPtr, /* The class to modify. */
  37. TclOO_PreCallProc preCallPtr,
  38. TclOO_PostCallProc postCallPtr,
  39. Tcl_ProcErrorProc errProc,
  40. ClientData clientData,
  41. Tcl_Obj *nameObj, /* The name of the method, which may be NULL;
  42. * if so, up to caller to manage storage
  43. * (e.g., because it is a constructor or
  44. * destructor). */
  45. Tcl_Obj *argsObj, /* The formal argument list for the method,
  46. * which may be NULL; if so, it is equivalent
  47. * to an empty list. */
  48. Tcl_Obj *bodyObj, /* The body of the method, which must not be
  49. * NULL. */
  50. int flags, /* Whether this is a public method. */
  51. ClientData *clientData2)
  52. {
  53. ProcedureMethod *pmPtr;
  54. Method *method;
  55.  
  56. method = TclOONewProcClassMethod(interp, (Class *)clsPtr, flags,
  57. nameObj, argsObj, bodyObj, &pmPtr);
  58. pmPtr->flags = flags & USE_DECLARER_NS;
  59. pmPtr->preCallProc = preCallPtr;
  60. pmPtr->postCallProc = postCallPtr;
  61. pmPtr->errProc = errProc;
  62. pmPtr->clientData = clientData;
  63. if (clientData2 != NULL) {
  64. *clientData2 = pmPtr;
  65. }
  66. return (Tcl_Method)method;
  67. }
  68. #define PUBLIC_METHOD 0x01 /* This is a public (exported) method. */
  69. #define PRIVATE_METHOD 0x02 /* This is a private (class's direct instances
  70. * only) method. */
  71. #define USE_DECLARER_NS 0x80
  72. /*
  73. * ----------------------------------------------------------------------
  74. *
  75. * Tcl_PublicObjectCmd, Tcl_PrivateObjectCmd --
  76. *
  77. * ----------------------------------------------------------------------
  78. */
  79. int
  80. Tcl_PublicObjectCmd(
  81. ClientData clientData,
  82. Tcl_Interp *interp,
  83. Tcl_Class clsPtr,
  84. int objc,
  85. Tcl_Obj *const *objv)
  86. {
  87. Object *oPtr = (Object *)clientData;
  88. int result;
  89.  
  90. result = TclOOObjectCmdCore(oPtr, interp, objc, objv, PUBLIC_METHOD,
  91. &oPtr->publicContextCache, (Class *)clsPtr);
  92. return result;
  93. }
  94.  
  95. int
  96. Tcl_PrivateObjectCmd(
  97. ClientData clientData,
  98. Tcl_Interp *interp,
  99. Tcl_Class clsPtr,
  100. int objc,
  101. Tcl_Obj *const *objv)
  102. {
  103. Object *oPtr = (Object *)clientData;
  104. int result;
  105.  
  106. result = TclOOObjectCmdCore(oPtr, interp, objc, objv, PRIVATE_METHOD,
  107. &oPtr->publicContextCache, (Class *)clsPtr);
  108. return result;
  109. }
  110.