home *** CD-ROM | disk | FTP | other *** search
/ Skunkware 5 / Skunkware 5.iso / src / X11 / tclMotif-1.4 / tests / callbacks.test < prev    next >
Encoding:
Text File  |  1995-06-29  |  2.5 KB  |  103 lines
  1.  
  2. if {[string compare test [info procs test]] == 1} then \
  3.   {source defs}
  4.  
  5. # set VERBOSE 1
  6.  
  7. # the list of all callback info contains the
  8. # event field, which contains a runtime value 
  9. # of the event number. This is meaningless for
  10. # tests, so lose it (arg 2)
  11. proc lose_event l {
  12.     return [lreplace $l 1 1] 
  13. } 
  14.  
  15. xtAppInitialize -class Arrow
  16. . setValues -allowShellResize true
  17.  
  18. xmRowColumn .row managed
  19.  
  20. xmArrowButton .row.arrow managed \
  21.     -width 10 -height 10
  22.  
  23. xmCommand .row.command managed
  24.  
  25. . realizeWidget
  26.  
  27.  
  28. #############################
  29. # setup for arrow callbacks #
  30. #############################
  31.  
  32. proc arrowCB {call} {
  33.     return "[lose_event $call]"
  34. }
  35.  
  36. .row.arrow armCallback {arrowCB {%call_data}}
  37. .row.arrow activateCallback {arrowCB [list %call_data]}
  38. .row.arrow disarmCallback {arrowCB [list %call_data]}
  39.  
  40. #################
  41. # Arrow callbacks
  42. #################
  43.  
  44. test callbacks-1.1 {arrow arm} {
  45.     .row.arrow callActionProc Arm() \
  46.         -type ButtonPress \
  47.         -x 5 -y 5
  48. } {{reason arm}}
  49.  
  50. # activate assumes it comes from a ButtonPress.
  51. # coords within its boundaries mean ButtonRelease
  52. # occurs within the widget, so activate callback occurs.
  53. # outside this, no callback is invoked
  54.  
  55. # this one is inside boundary
  56. test callbacks-1.2 {arrow activate } {
  57.     .row.arrow callActionProc Activate() \
  58.         -type ButtonPress \
  59.         -x 5 -y 5
  60. } {{reason activate} {click_count 1}}
  61.  
  62. test callbacks-1.3 {arrow disarm} {
  63.     .row.arrow callActionProc Disarm()
  64. } {{reason disarm}}
  65.  
  66. test callbacks-1.4 {arrow armAndActivate} {
  67.     .row.arrow callActionProc ArmAndActivate()
  68. } {{reason arm}{reason activate} {click_count 1}{reason disarm}}
  69.  
  70. test callbacks-1.5 {arrow removeCallback disarmCallback} {
  71.     .row.arrow removeCallback disarmCallback {arrowCB [list %call_data]}
  72.     .row.arrow callActionProc Disarm()
  73. } {}
  74.  
  75. .row.arrow destroyWidget
  76.  
  77.  
  78. #############################
  79. # setup for command callbacks #
  80. #############################
  81.  
  82. proc commandCB {call} {
  83.     return "[lose_event $call]"
  84. }
  85.  
  86. .row.command commandChangedCallback {commandCB {%call_data}}
  87. .row.command commandEnteredCallback {commandCB [list %call_data]}
  88. .row.command applyCallback {commandCB [list %call_data]}
  89. .row.command cancelCallback {commandCB [list %call_data]}
  90. .row.command noMatchCallback {commandCB [list %call_data]}
  91.  
  92. #################
  93. # Command callbacks
  94. #################
  95.  
  96. # test callbacks-2.1 {command arm} {
  97. #    .row.command callActionProc Arm()
  98. # } {{reason arm}}
  99.  
  100.  
  101. # we don't want to go into interactivity:
  102. # . mainLoop
  103.