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