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