Posted to tcl by apw at Mon Aug 20 12:19:35 GMT 2007view raw

  1. /*
  2. * itclNeededFromTclOO.c --
  3. *
  4. * This file contains code to create and manage methods.
  5. *
  6. * Copyright (c) 2007 by Arnulf P. Wiedemann
  7. *
  8. * See the file "license.terms" for information on usage and redistribution of
  9. * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  10. *
  11. * RCS: @(#) $Id: itclNeededFromTclOO.c 1.0 2007/07/30 14:20:21 apw Exp $
  12. */
  13.  
  14. #include "../oo/generic/tclOOInt.h"
  15.  
  16.  
  17. /*
  18. * ----------------------------------------------------------------------
  19. *
  20. * _Tcl_NewProcMethod --
  21. *
  22. * Create a new procedure-like method for an object for Itcl.
  23. *
  24. * ----------------------------------------------------------------------
  25. */
  26.  
  27. Tcl_Method
  28. _Tcl_NewProcMethod(
  29. Tcl_Interp *interp, /* The interpreter containing the object. */
  30. Tcl_Object oPtr, /* The object to modify. */
  31. Tcl_Obj *nameObj, /* The name of the method, which must not be
  32. * NULL. */
  33. Tcl_Obj *argsObj, /* The formal argument list for the method,
  34. * which must not be NULL. */
  35. Tcl_Obj *bodyObj, /* The body of the method, which must not be
  36. * NULL. */
  37. int flags, /* Whether this is a public method. */
  38. ClientData *clientData)
  39. {
  40. ProcedureMethod *pmPtr;
  41. Tcl_Method method;
  42.  
  43. method = (Tcl_Method)TclOONewProcMethod(interp, (Object *)oPtr, flags,
  44. nameObj, argsObj, bodyObj, &pmPtr);
  45. pmPtr->flags = flags & USE_DECLARER_NS;
  46. pmPtr->clientData = clientData;
  47. if (clientData != NULL) {
  48. *clientData = pmPtr;
  49. }
  50. return method;
  51. }
  52.  
  53. /*
  54. * ----------------------------------------------------------------------
  55. *
  56. * _Tcl_NewProcClassMethod --
  57. *
  58. * Create a new procedure-like method for a class for Itcl.
  59. *
  60. * ----------------------------------------------------------------------
  61. */
  62.  
  63. Tcl_Method
  64. _Tcl_NewProcClassMethod(
  65. Tcl_Interp *interp, /* The interpreter containing the class. */
  66. Tcl_Class clsPtr, /* The class to modify. */
  67. TclOO_PreCallProc preCallPtr,
  68. TclOO_PostCallProc postCallPtr,
  69. ClientData clientData,
  70. Tcl_Obj *nameObj, /* The name of the method, which may be NULL;
  71. * if so, up to caller to manage storage
  72. * (e.g., because it is a constructor or
  73. * destructor). */
  74. Tcl_Obj *argsObj, /* The formal argument list for the method,
  75. * which may be NULL; if so, it is equivalent
  76. * to an empty list. */
  77. Tcl_Obj *bodyObj, /* The body of the method, which must not be
  78. * NULL. */
  79. int flags, /* Whether this is a public method. */
  80. ClientData *clientData2)
  81. {
  82. ProcedureMethod *pmPtr;
  83. Method *method;
  84.  
  85. method = TclOONewProcClassMethod(interp, (Class *)clsPtr, flags,
  86. nameObj, argsObj, bodyObj, &pmPtr);
  87. pmPtr->flags = flags & USE_DECLARER_NS;
  88. pmPtr->preCallProc = preCallPtr;
  89. pmPtr->postCallProc = postCallPtr;
  90. pmPtr->clientData = clientData;
  91. if (clientData2 != NULL) {
  92. *clientData2 = pmPtr;
  93. }
  94. return (Tcl_Method)method;
  95. }
  96.  
  97. /*
  98. * ----------------------------------------------------------------------
  99. *
  100. * _Tcl_ProcPtrFromPM --
  101. *
  102. * Get The ProcPtr from a struct ProcedureMethod
  103. *
  104. * ----------------------------------------------------------------------
  105. */
  106.  
  107. ClientData
  108. _Tcl_ProcPtrFromPM(
  109. ClientData *clientData)
  110. {
  111. return ((ProcedureMethod *)clientData)->procPtr;
  112. }
  113.