home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 18 REXX / 18-REXX.zip / vxcliser.zip / VXREXX.2 / VREDISPG.VRM < prev    next >
Text File  |  1994-12-23  |  13KB  |  429 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":" ErrorText(rc), "Error!"
  9.     call VRFini
  10.     exit 32000
  11.  
  12. _VREMain:
  13. /*:VRX         Main
  14. */
  15. Main:
  16. /*  Uncomment to debug
  17.     call VRRedirectSTDIO "on"
  18.     trace ?r
  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.  
  79. /*:VRX         CN_Operations_DoubleClick
  80. */
  81. CN_Operations_DoubleClick:
  82.     call Process
  83. return
  84.  
  85. /*:VRX         CN_Operations_ExpandTree
  86. */
  87. CN_Operations_ExpandTree:
  88.     record = VRInfo( "record" )
  89.     child = VRMethod( "CN_Operations", "GetRecordAttr", record, "FirstChild" )
  90.     if child \= "" & VRMethod( "CN_Operations", "GetRecordAttr", child, "Caption" ) = " " then do
  91.         call VRSet "CN_Operations", "Painting", 0
  92.         window = VRWindow()
  93.         call VRSet window, "Pointer", "Wait"
  94.         /* Expand!  First get rid of the temporary child */
  95.         call VRMethod "CN_Operations", "RemoveRecord", child
  96.         /* Now add all the children of the record */
  97.         type = VRMethod( "CN_Operations", "GetFieldData", record, CNField.3 )
  98.         if type = "HEADING" then do
  99.             parent = VRMethod( "CN_Operations", "GetRecordAttr", record, "Parent" )
  100.             if parent = "" then do
  101.                 parenttype = ""
  102.             end
  103.             else do
  104.                 parenttype = VRMethod( "CN_Operations", "GetFieldData", parent, CNField.3 )
  105.             end
  106.             if parenttype = "OBJECT" then do
  107.                 rectype = "OBJECTMACRO"
  108.             end
  109.             else do
  110.                 rectype = "MACRO"
  111.             end
  112.             caption = VRMethod( "CN_Operations", "GetRecordAttr", record, "Caption" )
  113.             if caption \= "Objects" then do
  114.                 /* Get the children from the Macro stem */
  115.                 stub = VRMethod( "CN_Operations", "GetFieldData", record, CNField.1 )
  116.                 call VRMethod "CN_Operations", "AddRecordList", record, "First", "Macro." || stub || "."
  117.             end
  118.         end
  119.         else if type = "OBJECT" then do          
  120.             objHnd = VRMethod( "CN_Operations", "GetFieldData", record, CNField.1 )
  121.             if( objHnd = "" ) then
  122.                 objClass = VRMethod( "CN_Operations", "GetRecordAttr", record, "Caption" )
  123.             else
  124.                 objClass = VRGet( objHnd, "ClassName" )
  125.             fname = GetFileName( objClass )
  126.             if( fname = "" ) then do
  127.                 call VRMessage window, "No MTO file defined for" objClass "objects.", "Error"
  128.                 return
  129.             end
  130.             call ListMacros fname, record
  131.             call stream fname, "c", "Close"
  132.             if (translate(objClass) = "EDITWINDOW") then do
  133.                 call VRMethod objHnd, "ListChildren", "objects."
  134.                 newrec.0 = 0
  135.                 do i = 1 to objects.0
  136.                     newrec.0 = newrec.0 + 1
  137.                     newrec.i = ";" || VRGet(objects.i, "Name") || ";;;;" ||,
  138.                        CNField.1 || ";" || objects.i || ";" ||,
  139.                        CNField.2 || ";'';" ||,
  140.                        CNField.3 || ";" || "OBJECT"
  141.                 end
  142.                 if (newrec.0 > 0) then do
  143.                     call VRSortStem "newrec."
  144.                     call VRMethod "CN_Operations", "AddRecordList", record, , "newrec.", "reclist."
  145.  
  146.                     do i = 1 to reclist.0
  147.                         temp = VRMethod( "CN_Operations", "AddRecord", reclist.i, , " " )
  148.                     end
  149.                 end
  150.             end
  151.         end
  152.         call VRSet window, "Pointer", "<Default>"
  153.         call VRSet "CN_Operations", "Painting", 1
  154.     end
  155. return
  156.  
  157. /* Get the name of the file listing all the object specific macros
  158. */
  159. GetFileName: procedure expose VRXPath
  160.     parse arg objClass
  161.  
  162.     fullname = ""
  163.     if translate(objClass) = "EDITWINDOW" then do
  164.         objClass = "Window"
  165.     end
  166.     if length( objClass ) > 8 then do
  167.         objClass = left( objClass, 8 )
  168.     end
  169.     fname = VRDir( VRXPath || "SYSTEM\" || objClass || "*.MTO", "N" )
  170.     if fname \= "" then do
  171.         fullname = VRXPath || "SYSTEM\" || fname
  172.     end
  173. return fullname
  174.  
  175. /*:VRX         Fini
  176. */
  177. Fini:
  178.     call VRSet VRWindow(), "Visible", 0
  179. return RetStr
  180.  
  181. /*:VRX         Halt
  182. */
  183. Halt:
  184.     signal _VREHalt
  185. return
  186.  
  187.  
  188. /*:VRX         Init
  189. */
  190. /*
  191.     ret = VREDispG( parent, edit, path )
  192.  
  193.     Display a list of objects and general code areas
  194.     for which code can be generated.
  195.     
  196.     Args:
  197.         parent              Window parent or ""
  198.         edit                1 if in VRXEDIT
  199.         path                VX-REXX home dir.
  200.     
  201.     Returns:
  202.         Cancel              ""
  203.         Object              "OBJECT";<handle>
  204.         Macro               "MACRO";<macroname>;<parms>
  205. */
  206. Init: procedure expose InitArgs. RetStr VRXEdit VRXPath CNField. Macro.
  207.  
  208.     if( RXFuncQuery( 'VRELoadMTCNInfo' ) ) then
  209.         call RXFuncAdd 'VRELoadMTCNInfo', 'MT', 'VRELoadMTInfo'
  210.  
  211.     Macro.0 = 0
  212.  
  213.     RetStr = ""
  214.  
  215.     VRXEdit = InitArgs.1    
  216.     VRXPath = InitArgs.2
  217.  
  218.     window = VRWindow()
  219.     call VRMethod window, "CenterWindow"
  220.     parent = VRGet( window, "Parent" )
  221.     call VRSet window, "Pointer", "Wait"
  222.     call VRSet window, "Visible", 1
  223.  
  224.     call VRSet "CN_Operations", "Painting", 0
  225.     call CreateFields
  226.     call ListObjects
  227.     call ListOperations
  228.     call VRMethod "CN_Operations", "SortRecords"
  229.     call VRSet "CN_Operations", "Painting", 1
  230.  
  231.     call VRSet "PB_Okay", "Enabled", 1
  232.     call VRSet "PB_Cancel", "Enabled", 1
  233.  
  234.     call VRSet window, "Pointer", "<default>"
  235.     call VRMethod window, "Activate"
  236.  
  237. return
  238.  
  239.  
  240. /*  CreateFields
  241.     Create the fields for the container
  242. */
  243. CreateFields: procedure expose CNField.
  244.     do i = 1 to 3
  245.         CNField.i = VRMethod( "CN_Operations", "AddField", "String" )
  246.         parse var CNField.i "?FH" stuff
  247.         numzeros = 8 - length( stuff )
  248.         CNField.i = "?FH" || copies( "0", numzeros ) || stuff
  249.     end
  250. return
  251.  
  252. /*  AddRec
  253.     Add a record to the container
  254.     val.1 = null, self, or macroname, depending on type of record (val.3)
  255.     val.2 = parms
  256.     val.3 = type of record
  257. */
  258. AddRec: procedure expose CNField.
  259.     parse arg parent, caption, val.1, val.2, val.3
  260.  
  261.     newrec = VRMethod( "CN_Operations", "AddRecord", parent, , caption )
  262.     call VRMethod "CN_Operations", "SetFieldData", newrec, CNField.1, val.1, CNField.2, val.2, CNField.3, val.3
  263.     if val.3 = "OBJECT" | val.3 = "HEADING" then do
  264.         /* create a dummy child for the heading, so that
  265.          *    the expander box will appear
  266.          */
  267.         temp = VRMethod( "CN_Operations", "AddRecord", newrec, , " " )
  268.     end
  269. return newrec
  270.  
  271. /*  ListClasses
  272.     List all the non-virtual classes currently loaded.
  273. */
  274. ListClasses: procedure expose classes.
  275.     call VRMethod "Application", "ListClasses", "list."
  276.     j = 0
  277.     do i = 1 to list.0
  278.         parse var list.i "classname='" class "'" . "virtual=" virtual .
  279.         if virtual = 0 then do
  280.             j = j + 1
  281.             classes.j = class          
  282.         end
  283.     end     
  284.     classes.0 = j
  285. return    
  286.  
  287. /*  ListObjects
  288.     Fill the container with the objects in the user window.
  289.     If we are not in the VRXEdit environment just list the  
  290.     available classes.
  291. */
  292. ListObjects: procedure expose VRXEdit CNField. classes.
  293.     parent = AddRec( "", "Objects", "", "HEADING" )
  294.     newrec.0 = 0
  295.     if VRXEdit = 1 then do
  296.         newrec.1 = ";Application;;;;" || CNField.1 || ";" ||,
  297.                    VRGet( "Application", "Self" ) || ";" ||,
  298.                    CNField.2 || ";'';" ||,
  299.                    CNField.3 || ";" || "OBJECT"
  300.         newrec.2 = ";Screen;;;;" || CNField.1 || ";" ||,
  301.                    VRGet( "Screen", "Self" ) || ";" ||,
  302.                    CNField.2 || ";'';" ||,
  303.                    CNField.3 || ";" || "OBJECT"
  304.         newrec.0 = 2
  305.         call VRMethod "CN_Operations", "AddRecordList", parent, , "newrec.", "reclist."
  306.  
  307.         do i = 1 to reclist.0
  308.             temp = VRMethod( "CN_Operations", "AddRecord", reclist.i, , " " )
  309.         end
  310.  
  311.         windownum = 1
  312.         newrec.0 = 0
  313.         uwindow = VREMMWHandle( windownum )
  314.         do while (uwindow \= "")
  315.             newrec.windownum = ";" || VRGet(uwindow, "Name") || ";;;;" ||,
  316.                    CNField.1 || ";" || uwindow || ";" ||,
  317.                    CNField.2 || ";'';" ||,
  318.                    CNField.3 || ";" || "OBJECT"
  319.             newrec.0 = windownum
  320.             windownum = windownum + 1
  321.             uwindow = VREMMWHandle( windownum )
  322.         end
  323.     end
  324.     else do
  325.         call ListClasses
  326.         pos = newrec.0
  327.         do i = 1 to classes.0
  328.             pos = pos + 1
  329.             newrec.pos = ";" || classes.i || ";;;;" ||,
  330.                    CNField.1 || ";;" ||,
  331.                    CNField.2 || ";'';" ||,
  332.                    CNField.3 || ";" || "OBJECT"
  333.         end
  334.         newrec.0 = pos
  335.     end
  336.     call VRMethod "CN_Operations", "AddRecordList", parent, , "newrec.", "reclist."
  337.  
  338.     do i = 1 to reclist.0
  339.         temp = VRMethod( "CN_Operations", "AddRecord", reclist.i, , " " )
  340.     end
  341. return
  342.  
  343.  
  344. /*  Fill the container with functions not associated with any object.
  345. */
  346. ListOperations: procedure expose VRXPath CNField. Macro.
  347.  
  348.     call ListMacros VRXPath, ""
  349.  
  350. return
  351.  
  352.  
  353. /* List all the macros from a file in the container.
  354.  * NB Somewhat different from VREDispO equivalent.
  355.  */
  356. ListMacros: procedure expose CNField. Macro. Headers.
  357.     parse arg fname, grandparent
  358.     if grandparent \= "" then do
  359.         gptype = VRMethod( "CN_Operations", "GetFieldData", grandparent, CNField.3 )
  360.     end
  361.     else do
  362.         gptype = ""
  363.     end
  364.     if gptype = "OBJECT" then rectype = "OBJECTMACRO"
  365.     else rectype = "MACRO"
  366.  
  367.     call VRELoadMTCNInfo fname, "Headers.", "Macro.", ,
  368.          CNField.1, CNField.2, CNField.3, rectype, Macro.0
  369.  
  370.     call VRMethod "CN_Operations", "AddRecordList", grandparent, , "Headers.", "reclist."
  371.  
  372.     do i = 1 to reclist.0
  373.         temp = VRMethod( "CN_Operations", "AddRecord", reclist.i, , " " )
  374.     end
  375. return
  376.  
  377.  
  378. /*:VRX         PB_Cancel_Click
  379. */
  380. PB_Cancel_Click:
  381.     call Quit
  382. return
  383.  
  384.  
  385. /*:VRX         PB_Okay_Click
  386. */
  387. PB_Okay_Click:
  388.     call Process
  389. return
  390.  
  391. Process:
  392.     /* Set record.0 to 0 to prevent raising a 
  393.      * novalue exception
  394.      */
  395.     record.0 = 0
  396.     call VRMethod "CN_Operations", "GetRecordList", "Selected", "record."
  397.     if record.0 \= 1 then return
  398.     rec = record.1
  399.     do i = 1 to 3
  400.         field.i = VRMethod( "CN_Operations", "GetFieldData", record.1, CNField.i )
  401.     end
  402.  
  403.     if field.3 = "OBJECTMACRO" then do
  404.         parent = VRMethod( "CN_Operations", "GetRecordAttr", record.1, "Parent" )
  405.         grandp = VRMethod( "CN_Operations", "GetRecordAttr", parent, "Parent" )
  406.         objName = VRMethod( "CN_Operations", "GetRecordAttr", grandp, "Caption" )
  407.         RetStr = "OBJECTMACRO" || ";" || objName || ";" || field.1 || ";" || field.2
  408.         call Quit
  409.     end
  410.     else if field.3 = "MACRO" then do
  411.         RetStr = "MACRO" || ";" || field.1 || ";" || field.2
  412.         call Quit
  413.     end
  414.  
  415. return
  416.  
  417. /*:VRX         Quit
  418. */
  419. Quit:
  420.     call VRSet VRWindow(), "Shutdown", 1
  421. return
  422.  
  423.  
  424. /*:VRX         Window1_Close
  425. */
  426. Window1_Close:
  427.     call Quit
  428. return
  429.