/* Custom mainline for macro */

    call RXFuncAdd "VRLoadFuncs", "VROBJ", "VRLoadFuncs"
    call VRLoadFuncs

    _VREVersion = SubWord( VRVersion( "VRObj" ), 1, 1 )
    if( _VREVersion < 2.10 )then do
        call VRMessage "", "This program requires VX-REXX version 2.1 to run.", "Error!"
        return 32000
    end

    signal on SYNTAX name _VRESyntax
    signal _VREMain

_VRESyntax:
    parse source . . _VRESourceSpec
    call VRMessage "", "Syntax error in" _VRESourceSpec "line" SIGL":" ErrorText(rc), "Error!"
    call VRFini
    exit 32000

_VREMain:
/*:VRX         Main
*/
/*  Main
*/
Main:
/*  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         CNField_DoubleClick
*/
CNField_DoubleClick:
recHandle = VRInfo( 'Record' )
if recHandle = '' then
    return
caption = VRMethod( 'CNField', 'GetRecordAttr', recHandle, 'Caption' )
if caption = 'Cancel' then do
    call VRMessage 'Screen', 'The Cleared field cannot be hidden.  ', 'Information'
    drop caption recHandle
    return
end
stat = VRMethod( 'CNField', 'GetFieldData', recHandle, field.!Stat )
if stat = 'Visible' then
    call VRMethod 'CNField', 'SetFieldData', recHandle, field.!Stat, 'Hidden'
else
    call VRMethod 'CNField', 'SetFieldData', recHandle, field.!Stat, 'Visible'
call VRMethod 'CNField', 'SetFieldData', recHandle, field.!Chge, 1
return

/*:VRX         Fini
*/
Fini:
    window = VRWindow()
    call VRSet window, "Visible", 0
    drop window
return 0

/*:VRX         Halt
*/
Halt:
    signal _VREHalt
return

/*:VRX         Init
*/
Init:
    fields.0 = 0
    call VRMethod 'Application', 'GetVar', 'args.'
    call VRMethod 'Application', 'GetVar', 'fields.'
    filename = args.1
    tID = args.2
    window = VRWindow()
    call VRMethod window, "CenterWindow"
    call VRSet window, "Visible", 1
    call VRMethod window, "Activate"
    drop window
return

/*:VRX         MenuDef_Click
*/
MenuDef_Click:
call VRMethod 'CNField', 'RemoveRecord', 'All'
fields.0 = 0
signal Window1_Create
return

/*:VRX         MenuExit_Click
*/
MenuExit_Click:
call Quit
return

/*:VRX         MenuSave_Click
*/
MenuSave_Click:
call MenuSet_Click
ClrFile = VRParseFilePath( filename, 'DPN' )||'.clr'
TmpFile = VRParseFilePath( filename, 'DPN' )||'.cmp'
rc = stream( ClrFile, 'c', 'open' )
if rc <> 'READY:' then do
    call VRMessage '', 'Error opening 'ClrFile'.  Field order will not be saved.  ', 'Error'
    signal Quit
end
call VRLoadSecondary 'SWMsg'
call stream ClrFile, 'c', 'seek =1'
do forever
    if( lines( ClrFile ) = 0 )then
        leave
    line = linein( ClrFile )
    if line = '[Cleared]' then  do
        call WriteFieldOrder
        call lineout TmpFile, '[Cleared]'
        leave
    end
    if line = '[FieldOrder]' then do
        call WriteFieldOrder
        do forever
            if( lines( ClrFile ) = 0 )then
                leave
            line = linein( ClrFile )
            if line = '[Cleared]' then do
                call lineout TmpFile, line
                leave
            end
        end
        leave
    end
    call lineout TmpFile, line
end
if( lines( ClrFile ) <> 0 )then do
    do forever
        if( lines( ClrFile ) = 0 )then
            leave
        line = linein( ClrFile )
        if line <> '' then
            call lineout TmpFile, line
    end
end
call stream ClrFile, 'c', 'close'
call stream TmpFile, 'c', 'close'
call VRDestroy 'SWMsg'
ok = VRDeleteFile( ClrFile )
if ok = 0 then do
    call VRMessage '', VRError(), 'Error'
    return
end
if( \VRRenameFile( TmpFile, ClrFile ) )then do
    call VRMessage '', VRError(), 'Error'
    return
end
call VRMessage '', 'New field order has been saved.  The changes will be reflected the next time you open this ledger.  ', 'Information'
drop ClrFile TmpFile field line id ok newfields.
signal Quit
return

WriteFieldOrder:
call lineout TmpFile, '[FieldOrder]'
do i = 1 to newfields.0
    name = VRMethod( 'CNField', 'GetFieldData', newfields.i, field.!Name )
    stat = VRMethod( 'CNField', 'GetFieldData', newfields.i, field.!Stat )
    if stat = 'Hidden' then
        stat = '<hidden>'
    else
        stat = ''
    call lineout TmpFile, name||' '||stat
    fields.i = name||' '||stat
end
call lineout TmpFile, ''
return

/*:VRX         MenuSet_Click
*/
MenuSet_Click:
ok = VRMethod( "CNField", "GetRecordList", "All", "newfields." )
call VRMethod 'Application', 'PostQueue', tID, 1, "call VRSet 'CNRegister', 'Painting', 0"
do i = 1 to newfields.0
    name = VRMethod( 'CNField', 'GetFieldData', newfields.i, field.!Name )
    stat = VRMethod( 'CNField', 'GetFieldData', newfields.i, field.!Stat )
    chge = VRMethod( 'CNField', 'GetFieldData', newfields.i, field.!Chge )
    if chge = 1 then do
        if name = 'Date' then do
            if stat = 'Visible' then
                call VRMethod 'Application', 'PostQueue', tID, 1, "call VRMethod 'CNRegister', 'SetFieldAttr', field.!Date, 'Visible', 1"
            else
                call VRMethod 'Application', 'PostQueue', tID, 1, "call VRMethod 'CNRegister', 'SetFieldAttr', field.!Date, 'Visible', 0"
        end
        if name = 'Number' then do
            if stat = 'Visible' then
                call VRMethod 'Application', 'PostQueue', tID, 1, "call VRMethod 'CNRegister', 'SetFieldAttr', field.!Number, 'Visible', 1"
            else
                call VRMethod 'Application', 'PostQueue', tID, 1, "call VRMethod 'CNRegister', 'SetFieldAttr', field.!Number, 'Visible', 0"
        end
        if name = 'Particulars' then do
            if stat = 'Visible' then
                call VRMethod 'Application', 'PostQueue', tID, 1, "call VRMethod 'CNRegister', 'SetFieldAttr', field.!Info, 'Visible', 1"
            else
                call VRMethod 'Application', 'PostQueue', tID, 1, "call VRMethod 'CNRegister', 'SetFieldAttr', field.!Info, 'Visible', 0"
        end
        if name = 'Credit' then do
            if stat = 'Visible' then
                call VRMethod 'Application', 'PostQueue', tID, 1, "call VRMethod 'CNRegister', 'SetFieldAttr', field.!Credit, 'Visible', 1"
            else
                call VRMethod 'Application', 'PostQueue', tID, 1, "call VRMethod 'CNRegister', 'SetFieldAttr', field.!Credit, 'Visible', 0"
        end
        if name = 'Debit' then do
            if stat = 'Visible' then
                call VRMethod 'Application', 'PostQueue', tID, 1, "call VRMethod 'CNRegister', 'SetFieldAttr', field.!Debit, 'Visible', 1"
            else
                call VRMethod 'Application', 'PostQueue', tID, 1, "call VRMethod 'CNRegister', 'SetFieldAttr', field.!Debit, 'Visible', 0"
        end
        if name = 'Balance' then do
            if stat = 'Visible' then
                call VRMethod 'Application', 'PostQueue', tID, 1, "call VRMethod 'CNRegister', 'SetFieldAttr', field.!Balance, 'Visible', 1"
            else
                call VRMethod 'Application', 'PostQueue', tID, 1, "call VRMethod 'CNRegister', 'SetFieldAttr', field.!Balance, 'Visible', 0"
        end
        if name = 'Memo' then do
            if stat = 'Visible' then do
                call VRMethod 'Application', 'PostQueue', tID, 1, "call VRMethod 'CNRegister', 'SetFieldAttr', field.!Memo, 'Visible', 1"
                call VRMethod 'Application', 'PostQueue', tID, 1, "call VRSet 'PictMemo', 'PicturePath', '#1010:et_dll'"
                call VRMethod 'Application', 'PostQueue', tID, 1, "call VRSet 'MenuDisplayMemo', 'Checked', 1"
            end; else do
                call VRMethod 'Application', 'PostQueue', tID, 1, "call VRMethod 'CNRegister', 'SetFieldAttr', field.!Memo, 'Visible', 0"
                call VRMethod 'Application', 'PostQueue', tID, 1, "call VRSet 'PictMemo', 'PicturePath', '#1009:et_dll'"
                call VRMethod 'Application', 'PostQueue', tID, 1, "call VRSet 'MenuDisplayMemo', 'Checked', 0"
            end
        end
        if name = 'Category' then do
            if stat = 'Visible' then do
                call VRMethod 'Application', 'PostQueue', tID, 1, "call VRMethod 'CNRegister', 'SetFieldAttr', field.!Cat, 'Visible', 1"
                call VRMethod 'Application', 'PostQueue', tID, 1, "call VRSet 'PictCat', 'PicturePath', '#1003:et_dll'"
                call VRMethod 'Application', 'PostQueue', tID, 1, "call VRSet 'MenuDisplayCat', 'Checked', 1"
            end; else do
                call VRMethod 'Application', 'PostQueue', tID, 1, "call VRMethod 'CNRegister', 'SetFieldAttr', field.!Cat, 'Visible', 0"
                call VRMethod 'Application', 'PostQueue', tID, 1, "call VRSet 'PictCat', 'PicturePath', '#1002:et_dll'"
                call VRMethod 'Application', 'PostQueue', tID, 1, "call VRSet 'MenuDisplayCat', 'Checked', 0"
            end
        end
        if name = 'MultiCategory' then do
            if stat = 'Visible' then do
                call VRMethod 'Application', 'PostQueue', tID, 1, "call VRMethod 'CNRegister', 'SetFieldAttr', field.!Multi, 'Visible', 1"
                call VRMethod 'Application', 'PostQueue', tID, 1, "call VRSet 'PictMulti', 'PicturePath', '#1012:et_dll'"
                call VRMethod 'Application', 'PostQueue', tID, 1, "call VRSet 'MenuDisplayMulti', 'Checked', 1"
            end; else do
                call VRMethod 'Application', 'PostQueue', tID, 1, "call VRMethod 'CNRegister', 'SetFieldAttr', field.!Multi, 'Visible', 0"
                call VRMethod 'Application', 'PostQueue', tID, 1, "call VRSet 'PictMulti', 'PicturePath', '#1011:et_dll'"
                call VRMethod 'Application', 'PostQueue', tID, 1, "call VRSet 'MenuDisplayMulti', 'Checked', 0"
            end
        end
        if name = 'Cleared' then do
            if stat = 'Visible' then
                call VRMethod 'Application', 'PostQueue', tID, 1, "call VRMethod 'CNRegister', 'SetFieldAttr', field.!Cancel, 'Visible', 1"
            else
                call VRMethod 'Application', 'PostQueue', tID, 1, "call VRMethod 'CNRegister', 'SetFieldAttr', field.!Cancel, 'Visible', 0"
        end
    end /* if chge = 1 */
end /* i = 1 to newfields.0 */
call VRMethod 'Application', 'PostQueue', tID, 1, "call VRSet 'CNRegister', 'Painting', 1"
return

/*:VRX         Quit
*/
Quit:
    call VRMethod 'Application', 'PutVar', 'fields.'
    call VRMethod 'Application', 'PostQueue', tID, 1, 'call end_MenuLedgerFieldOrder_Click'
    window = VRWindow()
    call VRSet window, "Shutdown", 1
    drop window fields. filename tID name stat chge newfields. recHandle field.!Chge field.!Stat field.!Name
return

/*:VRX         SWMsg_Close
*/
SWMsg_Close:
    window = VRInfo( "Object" )
    call VRDestroy window
    drop window
return
/*:VRX         Window1_Close
*/
Window1_Close:
    call Quit
return

/*:VRX         Window1_Create
*/
Window1_Create:
if fields.0 = 0 then do
    fields.0 = 10
    fields.1 = 'Date'
    fields.2 = 'Number'
    fields.3 = 'Particulars'
    fields.4 = 'Credit'
    fields.5 = 'Debit'
    fields.6 = 'Balance'
    fields.7 = 'Memo'
    fields.8 = 'Category'
    fields.9 = 'MultiCategory'
    fields.10 = 'Cleared'
end
call VRSet 'CNField', 'Painting', 0
field.!Name = VRMethod( 'CNField', 'AddField', 'String', 'Title' )
field.!Stat = VRMethod( 'CNField', 'AddField', 'String', 'Status' )
field.!Chge = VRMethod( 'CNField', 'AddField', 'ULong', 'Changed' )
call VRMethod 'CNField', 'SetFieldAttr', field.!Chge, 'Visible', 0
do i = 1 to fields.0
    recHandle = VRMethod( "CNField", "AddRecord", , "", fields.i, "File", ,  )
    if recHandle <> '' then do
        parse var fields.i name stat
        call VRMethod 'CNField', 'SetFieldData', recHandle, field.!Name, name
        if stat = '' then
            call VRMethod 'CNField', 'SetFieldData', recHandle, field.!Stat, 'Visible'
        else
            call VRMethod 'CNField', 'SetFieldData', recHandle, field.!Stat, 'Hidden'
        call VRMethod 'CNField', 'SetFieldData', recHandle, field.!Chge, 0
    end
end
call VRSet 'CNField', 'Painting', 1
call VRMethod 'Application', 'PutVar', 'fields.'
return

/*:VRX         Window1_Help
*/
Window1_Help: 
address cmd 'view e-teller Fields...'
return

