home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 18 REXX / 18-REXX.zip / vxdemo.zip / DISPATCH.$$$ / VREDISPG.VRM < prev    next >
Text File  |  1993-09-15  |  7KB  |  278 lines
  1. /* Custom mainline for macro */
  2.  
  3.     signal on SYNTAX name _VRESyntax
  4.     signal _VREMain
  5.  
  6. _VRESyntax:
  7.     parse source . . _VRESourceSpec
  8.     call VRMessage "", "Syntax error in" _VRESourceSpec "line" SIGL, "Error!"
  9.     _VREReturnValue = 32000
  10.     signal _VRELeaveMain
  11.  
  12. _VREMain:
  13. /*:VRX         Main
  14. */
  15. Main:
  16. /*  Uncomment to debug
  17.     call VRRedirectSTDIO "on"
  18.     trace ?r
  19. */
  20.     signal on novalue
  21.  
  22. /*  Process the arguments.
  23.     Get the parent window.
  24. */
  25.     parse source . calledAs .
  26.     parent = ""
  27.     argCount = arg()
  28.     argOff = 0
  29.     if( calledAs \= "COMMAND" ) then do
  30.         if argCount >= 1 then do
  31.             parent = arg( 1 )
  32.             argCount = argCount - 1
  33.             argOff = 1
  34.         end
  35.     end
  36.     InitArgs.0 = argCount
  37.     if( argCount > 0 ) then
  38.     do i = 1 to argCount
  39.         InitArgs.i = arg( i + argOff )
  40.     end
  41.     drop calledAs argCount argOff
  42.  
  43. /*  Load the windows
  44. */
  45.     call VRInit
  46.     parse source . . spec
  47.     _VREPrimaryWindowPath = VRParseFileName( spec, "dpn" ) || ".VRW"
  48.     _VREPrimaryWindow = VRLoad( parent, _VREPrimaryWindowPath )
  49.     drop parent spec
  50.     if( _VREPrimaryWindow == "" ) then do
  51.         call VRMessage "", "Cannot load window:" VRError(), , "Error!"
  52.         _VREReturnValue = 32000
  53.         signal _VRELeaveMain
  54.     end
  55.  
  56. /*  Process events
  57. */
  58.     call Init
  59.     signal on halt
  60.     do while( \VRGet( _VREPrimaryWindow, "Shutdown" ) )
  61.         _VREEvent = VREvent()
  62.         interpret _VREEvent
  63.     end
  64. _VREHalt:
  65.     _VREReturnValue = Fini()
  66.     call VRDestroy _VREPrimaryWindow
  67. _VRELeaveMain:
  68.     call VRFini
  69. exit _VREReturnValue
  70.  
  71. VRLoadSecondary: procedure
  72.     name = arg( 1 )
  73.     window = VRLoad( VRWindow(), VRWindowPath(), name )
  74.     call VRMethod window, "CenterWindow"
  75.     call VRSet window, "Visible", 1
  76.     call VRMethod window, "Activate"
  77. return window
  78.  
  79.  
  80. /*:VRX         Fini
  81. */
  82. Fini:
  83.     call VRSet VRWindow(), "Visible", 0
  84. return RetStr
  85.  
  86. /*:VRX         Halt
  87. */
  88. Halt:
  89.     signal _VREHalt
  90. return
  91.  
  92.  
  93. /*:VRX         Init
  94. */
  95. /*
  96.     ret = VREDispG( parent, edit, path )
  97.  
  98.     Display a list of objects and general code areas
  99.     for which code can be generated.
  100.     
  101.     Args:
  102.         parent              Window parent or ""
  103.         edit                1 if in VRXEDIT
  104.         path                VX-REXX home dir.
  105.     
  106.     Returns:
  107.         Cancel              ""
  108.         Object              "OBJECT";<handle>
  109.         Macro               "MACRO";<macroname>;<parms>
  110. */
  111. Init: procedure expose InitArgs. RetStr VRXEdit VRXPath
  112.  
  113.     RetStr = ""
  114.  
  115.     VRXEdit = InitArgs.1    
  116.     VRXPath = InitArgs.2
  117.  
  118.     window = VRWindow()
  119.     call VRMethod window, "CenterWindow"
  120.     call VRSet window, "Visible", 1
  121.     call VRMethod window, "Activate"
  122.     call VRSet window, "Pointer", "Wait"
  123.     
  124.     call VRSet "LB_Operations", "Painting", 0
  125.     call ListObjects
  126.     call ListOperations
  127.     call VRSet "LB_Operations", "Selected", 1
  128.     call VRSet "LB_Operations", "Painting", 1
  129.  
  130.     call VRSet "PB_Okay", "Enabled", 1
  131.     call VRSet "PB_Cancel", "Enabled", 1
  132.  
  133.     call VRSet window, "Pointer", "<default>"
  134. return
  135.  
  136.  
  137. /*  LineFormat
  138.     Format a line for display in the list box.
  139. */
  140. LineFormat: procedure 
  141.     parse arg field1, field2, field3, field4, indent
  142.     space = ""
  143.     if indent = 1 then do
  144.         space = "    "
  145.     end
  146.     line = space || left( field1, 80 ) || ";" || field2 || ";" || field3 || ";" || field4
  147. return line
  148.  
  149. /*  ListClasses
  150.     List all the non-virtual classes currently loaded.
  151. */
  152. ListClasses: procedure expose classes.
  153.     call VRMethod "Application", "ListClasses", "list."
  154.     j = 0
  155.     do i = 1 to list.0
  156.         parse var list.i "classname='" class "'" . "virtual=" virtual .
  157.         if virtual = 0 then do
  158.             j = j + 1
  159.             classes.j = class          
  160.         end
  161.     end     
  162.     classes.0 = j
  163. return    
  164.  
  165. /*  ListObjects
  166.     Fill the list box with the objects in the user window.
  167.     If we are not in the VRXEdit environment just list the  
  168.     available classes.
  169. */
  170. ListObjects: procedure expose VRXEdit
  171.     if VRXEdit = 1 then do
  172.         uwindow = VREGetUserWindow()
  173.         if uwindow \= "" then do
  174.             call VRMethod "LB_Operations", "AddString", LineFormat( "Objects", "", "", "HEADING", 0 )
  175.             call VRMethod "LB_Operations", "AddString", LineFormat( "Application", VRGet( "Application", "Self" ), "", "OBJECT", 1 )
  176.             call VRMethod "LB_Operations", "AddString", LineFormat( VRGet(uwindow, "Name"), uwindow, "", "OBJECT", 1 )
  177.             call VRMethod uwindow, "ListChildren", "objects."
  178.             do i = 1 to objects.0
  179.                 objects.i = LineFormat( VRGet( objects.i, "Name" ), objects.i, "", "OBJECT", 1 )
  180.             end
  181.         end
  182.     end
  183.     else do
  184.         call VRMethod "LB_Operations", "AddString", LineFormat( "Objects", "", "", "HEADING", 0 )
  185.         call ListClasses
  186.         do i = 1 to classes.0
  187.             objects.i = LineFormat( classes.i, classes.i, "", "OBJECT", 1 )
  188.         end
  189.         objects.0 = classes.0
  190.     end
  191.     call VRMethod "LB_Operations", "AddStringList", "objects."
  192. return
  193.  
  194.  
  195. /*  Fill the list box with functions not associated with any object.
  196. */
  197. ListOperations: procedure expose VRXPath
  198.     fname = VRDir( VRXPath || "SYSTEM\*.MTC", "N" )
  199.     do while( fname \= "" )
  200.         fullname = VRXPath || "SYSTEM\" || fname
  201.         /* Skip the title on the first line */
  202.         line = linein( fullname )    
  203.         call ListMacros fullname
  204.         call stream fullname, "c", "Close"
  205.         fname = VRDir( , "N" )
  206.     end
  207. return
  208.  
  209.  
  210. /* List all the macros from a file in the list box.
  211. */
  212. ListMacros: procedure
  213.     parse arg fname
  214.     currHeading = ""
  215.     line = linein( fname )
  216.     do while( ( line \= ":" ) & ( line \= "" ) )
  217.         parse VAR line heading ";" descrip ";" parms ";" macroname
  218.         if( heading \= currHeading ) then do
  219.             if heading \= "_" then do
  220.                 call VRMethod "LB_Operations", "AddString", LineFormat( heading, "", "", "HEADING", 0 )
  221.             end
  222.             currHeading = heading
  223.         end
  224.         indent = 1
  225.         if( heading = "_" ) then do
  226.             indent = 0
  227.         end
  228.         call VRMethod "LB_Operations", "AddString", LineFormat( descrip, macroname, parms, "MACRO", indent )
  229.         line = linein( fname )
  230.     end
  231. return
  232.  
  233.  
  234. /*:VRX         LB_Operations_DoubleClick
  235. */
  236. LB_Operations_DoubleClick:
  237.     call PB_Okay_Click
  238. return
  239.  
  240.  
  241. /*:VRX         PB_Cancel_Click
  242. */
  243. PB_Cancel_Click:
  244.     call Quit
  245. return
  246.  
  247.  
  248. /*:VRX         PB_Okay_Click
  249. */
  250. PB_Okay_Click: procedure expose RetStr VRXEdit VRXPath
  251.  
  252.     selected = VRGet( "LB_Operations", "SelectedString" )
  253.     parse VAR selected . ";" field2 ";" field3 ";" field4
  254.  
  255.     if field4 = "OBJECT" then do
  256.         RetStr = "OBJECT" || ";" || field2
  257.         call Quit
  258.     end
  259.     else if field4 = "MACRO" then do
  260.         RetStr = "MACRO" || ";" || field2 || ";" || field3
  261.         call Quit
  262.     end
  263.  
  264. return
  265.  
  266. /*:VRX         Quit
  267. */
  268. Quit:
  269.     call VRSet VRWindow(), "Shutdown", 1
  270. return
  271.  
  272.  
  273. /*:VRX         Window1_Close
  274. */
  275. Window1_Close:
  276.     call Quit
  277. return
  278.