home *** CD-ROM | disk | FTP | other *** search
/ Amiga ISO Collection / AmigaUtilCD2.iso / Programming / COMAL3-1.DMS / in.adf / CITDemos / BreakTask < prev    next >
Encoding:
Text File  |  1993-05-04  |  3.7 KB  |  157 lines
  1. // This program is used to break a running program
  2. //
  3. // Any program that is acting on the break signals
  4. // CTRL-C (bit 12), CTRL-D (bit 13), CTRL-E (bit 14)
  5. // or CTRL-F (bit 15) can be breaked.
  6. //
  7. // A running Comal program acts on CTRL-C.
  8.  
  9. USE System
  10. USE ExecLists
  11. USE ExecLibrary
  12. USE CITScreen
  13. USE CITWindow
  14. USE CITGadgets
  15.  
  16. DIM TaskList OF List
  17. DIM Task OF ULONG
  18. DIM TaskName$ OF 40
  19. DIM BreakSigMask OF ULONG
  20. DIM Error OF SHORT
  21. DIM Stop OF SHORT
  22.  
  23. ReadTasks(TaskList)
  24.  
  25. DIM BreakWindow OF CITWindow
  26. BreakWindow.Position(20,20)
  27. BreakWindow.Size(600,170)
  28. BreakWindow.Activate
  29. ComalScreen.InsObject(BreakWindow,Error)
  30. IF Error THEN
  31.   STOP "Could'nt open the window"
  32. ENDIF
  33.  
  34. // Make a string input gadget for our ListView gadget below
  35. // NOTE: do not create explicitely. ListView will do it for you
  36. DIM StringGad OF StringGadget
  37. StringGad.Size(300,14)
  38.  
  39. // Now, make the ListView
  40. DIM ListView OF ListViewGadget
  41. ListView.Position(10,15)
  42. ListView.Size(300,100)
  43. ListView.Label("Select task to break",ABOVE+HIGHLIGHT)
  44. ListView.ChoiceList(TaskList)
  45. ListView.ShowSelected(StringGad)
  46. ListView.Selected(0)
  47. BreakWindow.InsObject(ListView,Error)
  48.  
  49. DIM Text OF TextGadget
  50. Text.Position(400,2)
  51. Text.Label("Break Signals",INSIDE+HIGHLIGHT)
  52. BreakWindow.InsObject(Text,Error)
  53.  
  54. DIM CtrlC_Gad OF CheckboxGadget
  55. CtrlC_Gad.Label("Control-C",LEFT)
  56. CtrlC_Gad.Size(30,14)
  57. CtrlC_Gad.Position(470,20)
  58. CtrlC_Gad.On
  59. BreakWindow.InsObject(CtrlC_Gad,Error)
  60.  
  61. DIM CtrlD_Gad OF CheckboxGadget
  62. CtrlD_Gad.Label("Control-D",LEFT)
  63. CtrlD_Gad.Size(30,14)
  64. CtrlD_Gad.Position(470,40)
  65. BreakWindow.InsObject(CtrlD_Gad,Error)
  66.  
  67. DIM CtrlE_Gad OF CheckboxGadget
  68. CtrlE_Gad.Label("Control-E",LEFT)
  69. CtrlE_Gad.Size(30,14)
  70. CtrlE_Gad.Position(470,60)
  71. BreakWindow.InsObject(CtrlE_Gad,Error)
  72.  
  73. DIM CtrlF_Gad OF CheckboxGadget
  74. CtrlF_Gad.Label("Control-F",LEFT)
  75. CtrlF_Gad.Size(30,14)
  76. CtrlF_Gad.Position(470,80)
  77. BreakWindow.InsObject(CtrlF_Gad,Error)
  78.  
  79. DIM BreakPrgGad OF ButtonGadget
  80. BreakPrgGad.Size(120,16)
  81. BreakPrgGad.Position(10,-(16+5))
  82. BreakPrgGad.Label("Break Program",INSIDE)
  83. BreakWindow.InsObject(BreakPrgGad,Error)
  84.  
  85. DIM CancelGad OF ButtonGadget
  86. CancelGad.Size(120,16)
  87. CancelGad.Position(-(120+10),-(16+5))
  88. CancelGad.Label("Cancel",INSIDE)
  89. BreakWindow.InsObject(CancelGad,Error)
  90.  
  91. IF Error THEN
  92.   PRINT "Could'nt create one or more of the gadgets"
  93. ELSE
  94.   REPEAT
  95.     IF BreakPrgGad.Pressed THEN
  96.       IF CtrlC_Gad.Value THEN BreakSigMask:=BreakSigMask BITOR %0001000000000000
  97.       IF CtrlD_Gad.Value THEN BreakSigMask:=BreakSigMask BITOR %0010000000000000
  98.       IF CtrlE_Gad.Value THEN BreakSigMask:=BreakSigMask BITOR %0100000000000000
  99.       IF CtrlF_Gad.Value THEN BreakSigMask:=BreakSigMask BITOR %1000000000000000
  100.       Forbid
  101.       TaskName$:=StringGad.Value$
  102.       Task:=FindTask(ADR(TaskName$))
  103.       IF Task THEN
  104.         Signal(Task,BreakSigMask)
  105.       ENDIF
  106.       Permit
  107.       Stop:=TRUE
  108.     ELIF CancelGad.Pressed THEN
  109.       Stop:=TRUE
  110.     ENDIF
  111.   UNTIL Stop
  112. ENDIF
  113.  
  114. ComalScreen.RemObject(BreakWindow)
  115.  
  116. // Make an Exec list with all task names (except this task)
  117. PROC ReadTasks(REF List OF List)
  118.   LOCAL ExecBase OF POINTER TO ULONG
  119.   LOCAL TaskReady OF POINTER TO List
  120.   LOCAL TaskWait OF POINTER TO List
  121.   LOCAL tn OF POINTER TO Node
  122.   LOCAL n OF POINTER TO TaskNode
  123.  
  124.   ExecBase:=$0004
  125.   TaskReady:=ExecBase@+406
  126.   TaskWait:=ExecBase@+420
  127.  
  128.   Forbid
  129.   tn:=TaskReady@.lh_Head
  130.   WHILE tn@.ln_Succ DO
  131.     ALLOCATE(n)
  132.     n@.Name$:=CharArrayToString$(tn@.ln_Name)
  133.     AddTail(ADR(List),n)
  134.     tn:=tn@.ln_Succ
  135.   ENDWHILE
  136.   tn:=TaskWait@.lh_Head
  137.   WHILE tn@.ln_Succ DO
  138.     ALLOCATE(n)
  139.     n@.Name$:=CharArrayToString$(tn@.ln_Name)
  140.     AddTail(ADR(List),n)
  141.     tn:=tn@.ln_Succ
  142.   ENDWHILE
  143.   Permit
  144. ENDPROC ReadTasks
  145.  
  146. STRUC TaskNode
  147.   INHERIT Node
  148.  
  149.   DIM Name$ OF 40
  150.  
  151.   FUNC Init CONSTRUCTOR
  152.     ln_Name:=ADR(Name$)
  153.     RETURN TRUE
  154.   ENDFUNC Init
  155.  
  156. ENDSTRUC TaskNode
  157.