home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
OS/2 Shareware BBS: 18 REXX
/
18-REXX.zip
/
vxdemo.zip
/
DISPATCH.$$$
/
VREDISPO.VRM
< prev
next >
Wrap
Text File
|
1993-09-15
|
6KB
|
265 lines
/* Custom mainline for macro */
call RXFuncAdd "VRLoadFuncs", "VROBJ", "VRLoadFuncs"
call VRLoadFuncs
_VREVersion = SubWord( VRVersion( "VRObj" ), 1, 1 )
if( _VREVersion < 1.01 )then do
call VRMessage "", "This program requires VX-REXX version 1.01 to run", "Error!"
_VREReturnValue = 32000
signal _VRELeaveMain
end
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
*/
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 = VREDispO( parent, edit, path, object )
Display the list of properties and method for
an object for which code can be generated.
Arguments:
parent Window parent or ""
edit 1 if in VRXEdit
path VX-REXX home dir
object ID (in VRXEdit) or Class of object
Returns:
Cancel ""
Macro "MACRO";<macroname>;<parms>
*/
Init: procedure expose InitArgs. RetStr VRXEdit VRXPath
RetStr = ""
VRXEdit = InitArgs.1
VRXPath = InitArgs.2
if VRXEdit = 1 then do
objClass = VRGet( InitArgs.3, "ClassName" )
objTitle = VRGet( InitArgs.3, "Name" )
end
else do
objClass = InitArgs.3
objTitle = objClass
end
window = VRWindow()
call VRMethod window, "CenterWindow"
call VRSet window, "Caption", objTitle || ": Select an action"
call VRSet window, "Visible", 1
call VRMethod window, "Activate"
call VRSet window, "Pointer", "Wait"
fname = GetFileName( objClass )
if( fname = "" ) then do
call VRMessage window, "No MTO file defined for" objClass "objects.", "Error"
call Quit
signal InitQuit
end
call VRSet "LB_Operations", "Painting", 0
call ListMacros fname
call stream fname, "c", "Close"
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>"
InitQuit:
return
/* Get the name of the file listing all the object specific macros
*/
GetFileName: procedure expose InitArgs. VRXPath
parse arg objClass
fullname = ""
fname = VRDir( VRXPath || "SYSTEM\" || left( objClass, 6 ) || "*.MTO", "N" )
do while( fname \= "" )
fullname = VRXPath || "SYSTEM\" || fname
line = linein( fullname )
if( line = objclass ) then
signal gfn_done
call stream fullname, "c", "Close"
fname = VRDir( , "N" )
end
gfn_done:
return fullname
/* Format a line for display in the list box.
*/
LineFormat: procedure
parse arg field1, field2, field3, field4, indent
spaces = ""
if indent = 1 then do
spaces = " "
end
line = spaces || left( field1, 80 ) || ";" || field2 || ";" || field3 || ";" || field4
return line
/* 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 = "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