home *** CD-ROM | disk | FTP | other *** search
/ PC World 2000 December / PCWorld_2000-12_cd.bin / Komunikace / Comanche / comanche.exe / lib / iwidgets3.0.0 / scripts / scopedobject.tcl < prev    next >
Text File  |  1999-02-24  |  5KB  |  182 lines
  1. #
  2. # Scopedobject
  3. # -----------------------------------------------------------------------------
  4. # Implements a base class for defining Itcl classes which posses
  5. # scoped behavior like Tcl variables.  The objects are only accessible
  6. # within the procedure in which they are instantiated and are deleted
  7. # when the procedure returns.
  8. #
  9. # Option(s):
  10. #
  11. #   -enterscopecommand: Tcl command to invoke when a object enters scope
  12. #                       (i.e. when it is created ...).
  13. #
  14. #   -exitscopecommand: Tcl command to invoke when a object exits scope
  15. #                       (i.e. when it is deleted ...).
  16. #
  17. # Note(s):
  18. #
  19. # Although a Scopedobject instance will automatically destroy itself
  20. # when it goes out of scope, one may explicity delete an instance
  21. # before it destroys itself.
  22. #
  23. # Example(s):
  24. #
  25. #  Creating an instance at local scope in a procedure provides
  26. #  an opportunity for tracing the entry and exiting of that
  27. #  procedure.  Users can register their proc/method tracing handlers
  28. #  with the Scopedobject class via either of the following two ways:
  29. #
  30. #  1.) configure the "-exitscopecommand" on a Scopedobject instance;
  31. #      e.g.
  32. #      #!/usr/local/bin/wish
  33. #
  34. #      proc tracedProc {} {
  35. #        scopedobject #auto \
  36. #            -exitscopecommand {puts "enter tracedProc"} \
  37. #            -exitscopecommand {puts "exit tracedProc"}
  38. #      }
  39. #
  40. #  2.) deriving from the Scopedobject and implementing the exit handling
  41. #      in their derived classes destructor.
  42. #      e.g.
  43. #
  44. #      #!/usr/local/bin/wish
  45. #
  46. #      class Proctrace {
  47. #        inherit Scopedobject
  48. #
  49. #        proc procname {} {
  50. #          return [info level -1]
  51. #        }
  52. #
  53. #        constructor {args} {
  54. #          puts "enter [procname]"
  55. #          eval configure $args
  56. #        }
  57. #
  58. #        destructor {
  59. #          puts "exit [procname]"
  60. #        }
  61. #      }
  62. #
  63. #      proc tracedProc {} {
  64. #        Proctrace #auto
  65. #      }
  66. #
  67. # -----------------------------------------------------------------------------
  68. #   AUTHOR:  John Tucker
  69. #            DSC Communications Corp  
  70. # -----------------------------------------------------------------------------
  71.  
  72. class iwidgets::Scopedobject {
  73.  
  74.   #
  75.   # OPTIONS:
  76.   #
  77.   public {
  78.     variable enterscopecommand {}
  79.     variable exitscopecommand {}
  80.   }
  81.  
  82.   #
  83.   # PUBLIC:
  84.   #
  85.   constructor {args} {}
  86.   destructor {}
  87.  
  88.   #
  89.   # PRIVATE:
  90.   #
  91.   private {
  92.  
  93.     # Implements the Tcl trace command callback which is responsible
  94.     # for destroying a Scopedobject instance when its corresponding
  95.     # Tcl variable goes out of scope.
  96.     #
  97.     method _traceCommand {varName varValue op}
  98.  
  99.     # Stores the stack level of the invoking procedure in which
  100.     # a Scopedobject instance in created.
  101.     #
  102.     variable _level 0
  103.   }
  104. }
  105.  
  106. #
  107. # Provide a lowercased access method for the Scopedobject class.
  108. # 
  109. proc ::iwidgets::scopedobject {pathName args} {
  110.     uplevel ::iwidgets::Scopedobject $pathName $args
  111. }
  112.  
  113. #--------------------------------------------------------------------------------
  114. # CONSTRUCTOR
  115. #--------------------------------------------------------------------------------
  116. body iwidgets::Scopedobject::constructor {args} {
  117.  
  118.   # Create a local variable in the procedure which this instance was created,
  119.   # and then register out instance deletion command (i.e. _traceCommand)
  120.   # to be called whenever the local variable is unset.
  121.   #
  122.   # If this is a derived class, then we will need to perform the variable creation
  123.   # and tracing N levels up the stack frame, where:
  124.   #   N = depth of inheritance hierarchy.
  125.   #
  126.   set depth [llength [$this info heritage]]
  127.   set _level "#[uplevel $depth info level]"
  128.   uplevel $_level set _localVar($this) $this
  129.   uplevel $_level trace variable _localVar($this) u \"[code $this _traceCommand]\"
  130.  
  131.   eval configure $args
  132.  
  133.   if {$enterscopecommand != {}} {
  134.     eval $enterscopecommand
  135.   }
  136. }
  137.  
  138. #--------------------------------------------------------------------------------
  139. # DESTRUCTOR
  140. #--------------------------------------------------------------------------------
  141. body iwidgets::Scopedobject::destructor {} {
  142.  
  143.   uplevel $_level trace vdelete _localVar($this) u \"[code $this _traceCommand]\"
  144.  
  145.   if {$exitscopecommand != {}} {
  146.     eval $exitscopecommand
  147.   }
  148. }
  149.  
  150. #--------------------------------------------------------------------------------#
  151. #
  152. # METHOD: _traceCommand
  153. #
  154. # PURPOSE: 
  155. # Callback used to destroy instances when their locally created variable
  156. # goes out of scope.
  157. #
  158. body iwidgets::Scopedobject::_traceCommand {varName varValue op} {
  159.   delete object $this
  160. }
  161.  
  162. #------------------------------------------------------------------------------
  163. #
  164. # OPTION: -enterscopecommand
  165. #
  166. # PURPOSE:
  167. # Specifies a Tcl command to invoke when a object enters scope.
  168. #
  169. configbody iwidgets::Scopedobject::enterscopecommand {
  170. }
  171.  
  172. #------------------------------------------------------------------------------
  173. #
  174. # OPTION: -exitscopecommand
  175. #
  176. # PURPOSE:
  177. # Specifies a Tcl command to invoke when an object exits scope.
  178. #
  179. configbody iwidgets::Scopedobject::exitscopecommand {
  180. }
  181.  
  182.