home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 18 REXX / 18-REXX.zip / rexxtk12.zip / demo / spectcl / makerexxtk.rexx < prev    next >
OS/2 REXX Batch file  |  2000-04-23  |  6KB  |  202 lines
  1. #!/home/ocon/bin/rexx
  2. /*
  3.  * makerexxtk.rexx - generate Rexx/Tk template program from specTcl ui files.
  4. */
  5. Trace o
  6. Parse Arg args
  7. fn = Word(args,1)
  8. If fn = '' Then Call Usage
  9. uis = Subword(args,2)
  10. Call BuildHeader fn, uis
  11. Call BuildCallbacks fn, uis
  12. Return
  13.  
  14. BuildHeader: Procedure
  15. Parse Arg fn, uis
  16. Call Stream fn, 'C', 'OPEN WRITE REPLACE'
  17. Call Lineout fn, "/*"
  18. Call Lineout fn, " *" fn "generated by makerexxtk.rexx on" Date() "at" Time()
  19. Call Lineout fn, " */"
  20. Call Lineout fn, "Trace o"
  21. Call Lineout fn, ""
  22. Call Lineout fn, "Call RxFuncAdd 'TkLoadFuncs', 'rexxtk', 'TkLoadFuncs'"
  23. Call Lineout fn, "Call TkLoadFuncs"
  24. Call Lineout fn, ""
  25. Call Lineout fn, "Call SetupMainWindow"
  26. Call Lineout fn, ""
  27. Call Lineout fn, "/*"
  28. Call Lineout fn, " * Our 'normal' Rexx/Tk loop"
  29. Call Lineout fn, " */"
  30. Call Lineout fn, "Do Forever"
  31. Call Lineout fn, "   Interpret 'Call' TkWait()"
  32. Call Lineout fn, "End"
  33. Call Lineout fn, ""
  34. Call Lineout fn, "Return"
  35. Call Lineout fn, ""
  36. Call Lineout fn, "SetupMainWindow:"
  37. Call Lineout fn, "/*"
  38. Call Lineout fn, " * Load the UI Tcl code, but don't execute it"
  39. Call Lineout fn, " */"
  40. Do i = 1 To Words(uis)
  41. Call Lineout fn, "Call TkTcl 'source', '" || Word(uis,i) || ".ui.tcl'"
  42. End
  43. Call Lineout fn, "/*"
  44. Call Lineout fn, " * Add any other setup code here"
  45. Call Lineout fn, " */"
  46. Call Lineout fn, ""
  47. Call Lineout fn, "/*"
  48. Call Lineout fn, " * The first ui file will be executed"
  49. Call Lineout fn, " */"
  50. Call Lineout fn, "Call TkTcl '" || Word(uis,1) || "_ui', '.'"
  51. Call Lineout fn, ""
  52. Call Lineout fn, "Return"
  53. Return
  54.  
  55. BuildCallbacks: Procedure
  56. Parse Arg fn, uis
  57. tclvars = ''
  58. rexxtk_commands = ''
  59. idx = 0
  60. Call Lineout fn, ""
  61. Call Lineout fn, "/*"
  62. widget_tag. = ''
  63. widget_name. = ''
  64. widget_type. = ''
  65. widget_parent. = ''
  66. widget_command. = ''
  67. widget_variable. = ''
  68. widget_ui. = ''
  69. Do i = 1 To Words(uis)
  70.    ui = Word(uis,i) || ".ui"
  71.    Do While(Lines(ui) > 0)
  72.       line = Linein(ui)
  73.       Parse Var line word1 word2 word3
  74.       Select
  75.          When word1 = 'configure' & word2 = 'variable' Then
  76.             Do
  77.                If Wordpos( word3, tclvars ) = 0 Then tclvars = tclvars word3
  78.                widget_variable.idx = word3
  79.             End
  80.          When word1 = 'configure' & word2 = 'textvariable' Then
  81.             Do
  82.                If Wordpos( word3, tclvars ) = 0 Then tclvars = tclvars word3
  83.                widget_variable.idx = word3
  84.             End
  85.          When word1 = 'configure' & word2 = 'command' Then
  86.             Do
  87.                Parse Var word3 . '{' cmd '}' .
  88.                If Translate(Word(cmd,1)) = 'SETREXXTK' Then
  89.                   Do
  90.                      widget_command.idx = Subword(cmd,2)
  91.                      If Wordpos( Subword(cmd,2), rexxtk_commands ) = 0 Then rexxtk_commands = rexxtk_commands Subword(cmd,2)
  92.                      Else Say 'Warning: Duplicate function:' Subword(cmd,2) 'defined'
  93.                   End
  94.             End
  95.          When word1 = 'other' & word2 = 'item_name' Then
  96.             Do
  97.                widget_name.idx = word3
  98.             End
  99.          When word1 = 'other' & word2 = 'type' Then
  100.             Do
  101.                widget_type.idx = word3
  102.             End
  103.          When word1 = 'other' & word2 = 'master' Then
  104.             Do
  105.                If word3 \= '{}' Then widget_master.idx = Substr(word3,2)
  106.             End
  107.          When Substr(line, 1, 6) = 'Widget' Then
  108.             Do
  109.                idx = idx + 1
  110.                widget_tag.idx = Word(line,2)
  111.                widget_ui.idx = ui
  112.             End
  113.          Otherwise
  114.             Nop
  115.       End
  116.    End
  117. End
  118. widget_name.0 = idx
  119. /*
  120.  * Resolve the "real" name of the widget
  121.  */
  122. Do i = 1 To widget_name.0
  123.    Do j = 1 To widget_name.0
  124.       If widget_master.i = widget_tag.j Then
  125.          Do
  126.             widget_name.i = widget_name.j || '.' || widget_name.i
  127.             Leave
  128.          End
  129.    End
  130. End
  131. ui_name = ''
  132. Do i = 1 To widget_name.0
  133.    If widget_name.i \= 'f' Then
  134.       Do
  135.          If ui_name \= widget_ui.i Then
  136.             Do
  137.               Call Lineout fn, " * Widgets defined in UI:" widget_ui.i
  138.               ui_name = widget_ui.i
  139.             End
  140.          Call Charout fn, "   ." || widget_name.i "(type:" widget_type.i || ')'
  141.          If widget_command.i \= '' Then Call Charout fn, " (function:" widget_command.i || ')'
  142.          If widget_variable.i \= '' Then Call Charout fn, " (variable:" widget_variable.i || ')'
  143.          Call Lineout fn, ""
  144.       End
  145. End
  146. Call Lineout fn, " */"
  147. Do i = 1 To widget_name.0
  148.    If widget_command.i \= '' Then
  149.       Call WriteCmdFunction fn, widget_name.i, widget_command.i, widget_ui.i
  150. End
  151. /*
  152.  * Don't write out Tcl varaible functions
  153. Do i = 1 To Words(tclvars)
  154.    Call WriteVarFunction fn, Word( tclvars, i )
  155. End
  156. */
  157. Return
  158.  
  159. WriteCmdFunction: Procedure
  160. Parse Arg fn, widget, cmd, ui
  161. Call Lineout fn, ""
  162. Call Lineout fn, "/*"
  163. Call Lineout fn, " * This function is called from the ." || widget "widget in UI:" ui
  164. Call Lineout fn, " */"
  165. Call Lineout fn, cmd || ":"
  166. Call Lineout fn, "/*"
  167. Call Lineout fn, " * Put your code here"
  168. Call Lineout fn, " */"
  169. Call Lineout fn, "Say '" || cmd "called'"
  170. Call Lineout fn, "Return"
  171. Return
  172.  
  173. WriteVarFunction: Procedure
  174. Parse Arg fn, tclvar
  175. Call Lineout fn, ""
  176. Call Lineout fn, "/*"
  177. Call Lineout fn, " * This function returns the value of the Tcl variable:" tclvar
  178. Call Lineout fn, " */"
  179. Call Lineout fn, "GetValueOf" || tclvar || ":"
  180. Call Lineout fn, ""
  181. Call Lineout fn, "Return TkVar( '" || tclvar || "' )"
  182. Return
  183.  
  184. Usage: Procedure
  185. Say 'This program generates a template Rexx/Tk program based on the output'
  186. Say 'from specTcl.'
  187. Say
  188. Say 'The first argument is the name of the Rexx/Tk program to build'
  189. Say 'Any subsequent arguments specify the base specTcl user interface'
  190. Say 'files that the Rexx/Tk program will use. eg if you have built two'
  191. Say 'user interface files from specTcl, called mdlog and dlog2, then you'
  192. Say 'will have the files:'
  193. Say '  mdlog.ui, mdlog.ui.tcl and'
  194. Say '  dlog2.ui, dlog2.ui.tcl'
  195. Say 
  196. Say 'To generate mytk.rexx using the above two user interface files:'
  197. Say '  rexx makerexxtk.rexx mytk.rexx mdlog dlog2'
  198. Say
  199. Say 'The order of the user interface files is important, as the first'
  200. Say 'one will be executed by default.'
  201. Exit
  202.