home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
OS/2 Shareware BBS: 18 REXX
/
18-REXX.zip
/
vxdemo.zip
/
DISPATCH.$$$
/
VREDISPG.VRM
< prev
next >
Wrap
Text File
|
1993-09-15
|
7KB
|
278 lines
/* Custom mainline for macro */
signal on SYNTAX name _VRESyntax
signal _VREMain
_VRESyntax:
parse source . . _VRESourceSpec
call VRMessage "", "Syntax error in" _VRESourceSpec "line" SIGL, "Error!"
_VREReturnValue = 32000
signal _VRELeaveMain
_VREMain:
/*:VRX Main
*/
Main:
/* Uncomment to debug
call VRRedirectSTDIO "on"
trace ?r
*/
signal on novalue
/* Process the arguments.
Get the parent window.
*/
parse source . calledAs .
parent = ""
argCount = arg()
argOff = 0
if( calledAs \= "COMMAND" ) then do
if argCount >= 1 then do
parent = arg( 1 )
argCount = argCount - 1
argOff = 1
end
end
InitArgs.0 = argCount
if( argCount > 0 ) then
do i = 1 to argCount
InitArgs.i = arg( i + argOff )
end
drop calledAs argCount argOff
/* Load the windows
*/
call VRInit
parse source . . spec
_VREPrimaryWindowPath = VRParseFileName( spec, "dpn" ) || ".VRW"
_VREPrimaryWindow = VRLoad( parent, _VREPrimaryWindowPath )
drop parent spec
if( _VREPrimaryWindow == "" ) then do
call VRMessage "", "Cannot load window:" VRError(), , "Error!"
_VREReturnValue = 32000
signal _VRELeaveMain
end
/* Process events
*/
call Init
signal on halt
do while( \VRGet( _VREPrimaryWindow, "Shutdown" ) )
_VREEvent = VREvent()
interpret _VREEvent
end
_VREHalt:
_VREReturnValue = Fini()
call VRDestroy _VREPrimaryWindow
_VRELeaveMain:
call VRFini
exit _VREReturnValue
VRLoadSecondary: procedure
name = arg( 1 )
window = VRLoad( VRWindow(), VRWindowPath(), name )
call VRMethod window, "CenterWindow"
call VRSet window, "Visible", 1
call VRMethod window, "Activate"
return window
/*:VRX Fini
*/
Fini:
call VRSet VRWindow(), "Visible", 0
return RetStr
/*:VRX Halt
*/
Halt:
signal _VREHalt
return
/*:VRX Init
*/
/*
ret = VREDispG( parent, edit, path )
Display a list of objects and general code areas
for which code can be generated.
Args:
parent Window parent or ""
edit 1 if in VRXEDIT
path VX-REXX home dir.
Returns:
Cancel ""
Object "OBJECT";<handle>
Macro "MACRO";<macroname>;<parms>
*/
Init: procedure expose InitArgs. RetStr VRXEdit VRXPath
RetStr = ""
VRXEdit = InitArgs.1
VRXPath = InitArgs.2
window = VRWindow()
call VRMethod window, "CenterWindow"
call VRSet window, "Visible", 1
call VRMethod window, "Activate"
call VRSet window, "Pointer", "Wait"
call VRSet "LB_Operations", "Painting", 0
call ListObjects
call ListOperations
call VRSet "LB_Operations", "Selected", 1
call VRSet "LB_Operations", "Painting", 1
call VRSet "PB_Okay", "Enabled", 1
call VRSet "PB_Cancel", "Enabled", 1
call VRSet window, "Pointer", "<default>"
return
/* LineFormat
Format a line for display in the list box.
*/
LineFormat: procedure
parse arg field1, field2, field3, field4, indent
space = ""
if indent = 1 then do
space = " "
end
line = space || left( field1, 80 ) || ";" || field2 || ";" || field3 || ";" || field4
return line
/* ListClasses
List all the non-virtual classes currently loaded.
*/
ListClasses: procedure expose classes.
call VRMethod "Application", "ListClasses", "list."
j = 0
do i = 1 to list.0
parse var list.i "classname='" class "'" . "virtual=" virtual .
if virtual = 0 then do
j = j + 1
classes.j = class
end
end
classes.0 = j
return
/* ListObjects
Fill the list box with the objects in the user window.
If we are not in the VRXEdit environment just list the
available classes.
*/
ListObjects: procedure expose VRXEdit
if VRXEdit = 1 then do
uwindow = VREGetUserWindow()
if uwindow \= "" then do
call VRMethod "LB_Operations", "AddString", LineFormat( "Objects", "", "", "HEADING", 0 )
call VRMethod "LB_Operations", "AddString", LineFormat( "Application", VRGet( "Application", "Self" ), "", "OBJECT", 1 )
call VRMethod "LB_Operations", "AddString", LineFormat( VRGet(uwindow, "Name"), uwindow, "", "OBJECT", 1 )
call VRMethod uwindow, "ListChildren", "objects."
do i = 1 to objects.0
objects.i = LineFormat( VRGet( objects.i, "Name" ), objects.i, "", "OBJECT", 1 )
end
end
end
else do
call VRMethod "LB_Operations", "AddString", LineFormat( "Objects", "", "", "HEADING", 0 )
call ListClasses
do i = 1 to classes.0
objects.i = LineFormat( classes.i, classes.i, "", "OBJECT", 1 )
end
objects.0 = classes.0
end
call VRMethod "LB_Operations", "AddStringList", "objects."
return
/* Fill the list box with functions not associated with any object.
*/
ListOperations: procedure expose VRXPath
fname = VRDir( VRXPath || "SYSTEM\*.MTC", "N" )
do while( fname \= "" )
fullname = VRXPath || "SYSTEM\" || fname
/* Skip the title on the first line */
line = linein( fullname )
call ListMacros fullname
call stream fullname, "c", "Close"
fname = VRDir( , "N" )
end
return
/* List all the macros from a file in the list box.
*/
ListMacros: procedure
parse arg fname
currHeading = ""
line = linein( fname )
do while( ( line \= ":" ) & ( line \= "" ) )
parse VAR line heading ";" descrip ";" parms ";" macroname
if( heading \= currHeading ) then do
if heading \= "_" then do
call VRMethod "LB_Operations", "AddString", LineFormat( heading, "", "", "HEADING", 0 )
end
currHeading = heading
end
indent = 1
if( heading = "_" ) then do
indent = 0
end
call VRMethod "LB_Operations", "AddString", LineFormat( descrip, macroname, parms, "MACRO", indent )
line = linein( fname )
end
return
/*:VRX LB_Operations_DoubleClick
*/
LB_Operations_DoubleClick:
call PB_Okay_Click
return
/*:VRX PB_Cancel_Click
*/
PB_Cancel_Click:
call Quit
return
/*:VRX PB_Okay_Click
*/
PB_Okay_Click: procedure expose RetStr VRXEdit VRXPath
selected = VRGet( "LB_Operations", "SelectedString" )
parse VAR selected . ";" field2 ";" field3 ";" field4
if field4 = "OBJECT" then do
RetStr = "OBJECT" || ";" || field2
call Quit
end
else if field4 = "MACRO" then do
RetStr = "MACRO" || ";" || field2 || ";" || field3
call Quit
end
return
/*:VRX Quit
*/
Quit:
call VRSet VRWindow(), "Shutdown", 1
return
/*:VRX Window1_Close
*/
Window1_Close:
call Quit
return