/****************************** Module Header *******************************
*
* Module Name: assocs.erx
*
* Syntax: assocs <action> <list_item>
*
* with
*    <action>    = query | prepend | append | remove
*                  (query returns list items found in the ini file,
*                  separated by '|' and also with a leading '|'.)
*    <list_item> = the name or the number of an association list item, not
*                  required for the query action.
*
* Syntax for Assocs keys values:
*
*    = OBJECT, Type:TYPE [,POS]
*       or
*    = OBJECT, Filter:FILTER [,POS]
*
* with
*    OBJECT  an <object_id>
*    TYPE    a WPS association type
*    FILTER  a WPS association filter
*    POS     optional position number (default = 1) or L (means: last),
*            used for the prepend action only
*
* This EPM REXX file is used for the setting
* Programm objects -> Set association...
*
* This EPM-REXX file may also be executed from non-EPM environments. It is
* callable from other REXX commands.
*
* Copyright (c) Netlabs EPM Distribution Project 2008
*
* $Id: assocs.erx 3856 2020-02-12 21:26:41Z aschn $
*
* ===========================================================================
*
* This file is part of the Netlabs EPM Distribution package and is free
* software.  You can redistribute it and/or modify it under the terms of the
* GNU General Public License as published by the Free Software
* Foundation, in version 2 as it comes in the "COPYING" file of the
* Netlabs EPM Distribution.  This library is distributed in the hope that it
* will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty
* of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
* General Public License for more details.
*
****************************************************************************/

IF ADDRESS() <> 'EPM' THEN
   '@ECHO OFF'

/* ----------------- Standard ERX initialization follows ----------------- */
SIGNAL ON HALT NAME Halt
SIGNAL ON ERROR NAME Error
SIGNAL ON SYNTAX NAME Error
SIGNAL ON NOVALUE NAME Error
SIGNAL ON FAILURE NAME Error
SIGNAL ON NOTREADY NAME Error

env   = 'OS2ENVIRONMENT'
TRUE  = (1 = 1)
FALSE = (0 = 1)
CrLf  = '0d0a'x
Redirection = '>NUL 2>&1'
PARSE SOURCE . . ThisFile
GlobalVars = 'env TRUE FALSE Redirection ERROR. ThisFile ThisName'
GlobalVars = GlobalVars 'ErrorQueueName ErrorMessage'

/* Some OS/2 error codes */
ERROR.NO_ERROR           =   0
ERROR.INVALID_FUNCTION   =   1
ERROR.FILE_NOT_FOUND     =   2
ERROR.PATH_NOT_FOUND     =   3
ERROR.ACCESS_DENIED      =   5
ERROR.NOT_ENOUGH_MEMORY  =   8
ERROR.INVALID_FORMAT     =  11
ERROR.INVALID_DATA       =  13
ERROR.NO_MORE_FILES      =  18
ERROR.WRITE_FAULT        =  29
ERROR.READ_FAULT         =  30
ERROR.SHARING_VIOLATION  =  32
ERROR.GEN_FAILURE        =  31
ERROR.INVALID_PARAMETER  =  87
ERROR.ENVVAR_NOT_FOUND   = 204

rc = ERROR.NO_ERROR
ErrorQueueName = VALUE( 'NEPMD_RXQUEUE',, env)
ErrorMessage   = ''

PARSE SOURCE . . ThisFile
lp = LASTPOS( '\', ThisFile)
ThisDir = LEFT( ThisFile, lp - 1)
ThisName = SUBSTR( ThisFile, lp + 1)

CALL RxFuncAdd 'SysLoadFuncs', 'RexxUtil', 'SysLoadFuncs'
CALL SysLoadFuncs
/* ----------------- Standard ERX initialization ends -------------------- */

/* Extend the environment, if not already */
next = VALUE( 'NEPMD_NAME',, env)
IF next = '' THEN
   'CALL' ThisDir'\..\..\netlabs\bin\EPMENV'

/* ------------- Configuration ---------------- */
RootDir           = VALUE( 'NEPMD_ROOTDIR',, env)
UserDir           = VALUE( 'NEPMD_USERDIR',, env)
NetlabsBinDir     = RootDir'\netlabs\bin'
UserBinDir        = UserDir'\bin'
Ini._Filename     = UserDir'\bin\nepmd.ini'
Ini._RegKeys      = 'RegKeys'
Ini._RegContainer = 'RegContainer'
Ini._RegDefaults  = 'RegDefaults'
Key._MainPath     = '\NEPMD\User\ProgramObjects\Assocs'
Key._Name         = 'Name'
DO 1
   DefaultsCfg = UserBinDir'\defaults.cfg'
   IF FileExist( DefaultsCfg) THEN
   DO
      File._DefaultsCfg = DefaultsCfg
      LEAVE
   END
   DefaultsCfg = NetlabsBinDir'\defaults.cfg'
   IF FileExist( DefaultsCfg) THEN
   DO
      File._DefaultsCfg = DefaultsCfg
      LEAVE
   END
END

NameNotSpecified  = '<Name not specified>'
/* -------------------------------------------- */

/* Added File. */
GlobalVars = GlobalVars 'Ini. Key. Cfg. File. DefaultKey. Processed. Assoc. fInit'
GlobalVars = GlobalVars 'FoundGroup Action ListItem NameNotSpecified'

Processed._Objects = ''
Processed._Types   = ''
Processed._Filters = ''

DO 1
   fInit = 0

   PARSE ARG Action ListItem
   Action = TRANSLATE( STRIP( Action))
   ListItem = STRIP( ListItem)

   IF (Action = '') THEN
   DO
      rc = ERROR.INVALID_PARAMETER
      ErrorMessage = 'Error: No action specified. First parameter' ||,
         ' for 'TRANSLATE( ThisName)' is missing.'
      LEAVE
   END
   IF ((ListItem = '') & (Action <> 'QUERY')) THEN
   DO
      rc = ERROR.INVALID_PARAMETER
      ErrorMessage = 'Error: No list item specified. Second parameter' ||,
         ' for 'TRANSLATE( ThisName)' is missing.'
      LEAVE
   END

   /* Init stem vars */
   /* n = 1 to Cfg._Name.0 = counter    */
   /* Name = Cfg._Name.n   = group name */
   /* g = Cfg._Group.n     = group id   */
   Cfg._Name. = ''
   Cfg._Name.0 = 0
   Cfg._Group. = ''

   /* Get all user keys */
   CALL GetUserGroups

   /* Get all default keys */
   /* This fills also the DefaultKey. array */
   CALL GetDefaultGroups

   /* Get names for all available groups */
   CALL GetGroupNames

   IF (Action = 'QUERY') THEN
   DO
      /* Return ListBoxData string */
      ListBoxData = ''
      DO n = 1 TO Cfg._Name.0
         ListBoxData = ListBoxData'|'Cfg._Name.n
      END
      EXIT( ListBoxData)
   END

   FoundGroup = ''
   /* ListItem can be specified as number or as name */
   /* Check if valid number specified as ListItem */
   DO 1
      IF VERIFY( ListItem, '0123456789') <> 0 THEN
         LEAVE
      IF ListItem = 0 THEN
         LEAVE
      IF ListItem > Cfg._Name.0 THEN
         LEAVE
      FoundGroup = ListItem
   END
   /* Find ListItem in group names */
   IF FoundGroup = '' THEN
   DO n = 1 TO Cfg._Name.0
      g = Cfg._Group.n
      IF TRANSLATE( Cfg._Name.n) = TRANSLATE( ListItem) THEN
      DO
         FoundGroup = g
         LEAVE
      END
   END
   IF FoundGroup = '' THEN
   DO
      ErrorMessage = 'Error: "'ListItem'" not found in 'Key._MainPath'\*\'Key._Name' keys.'
      rc = ERROR.INVALID_DATA
      LEAVE
   END

   /* Build Assoc. array */
   CALL BuildAssocArray

   /* Process Assoc. array */
   CALL ProcessAssocArray
END

/* ErrorMessage */
DO 1
   IF ErrorMessage = '' THEN
      LEAVE
   /* Prepend 'Error 'rc ... if ErrorMessage doesn't contain the word 'Error' */
   IF POS( 'ERROR', TRANSLATE( ErrorMessage)) = 0 THEN
      ErrorMessage = 'Error 'rc' running 'ThisFile': 'ErrorMessage
   CALL SayErrorMessage
END
EXIT( rc)

/* ----------------------------------------------------------------------- */
GetUserGroups: PROCEDURE EXPOSE (GlobalVars)

   rc = ERROR.NO_ERROR

   /* Get user sub keys from RegContainer */
   UserSubKeys = ''
   next = SysIni( Ini._Filename, Ini._RegContainer, Key._MainPath)
   next = STRIP( next, 'T', '00'x)
   IF next <> '' & next <> 'ERROR:' THEN
      UserSubKeys = next

   /* Add user groups to Cfg._Group. */
   rest = UserSubKeys
   Sep = '00'x
   DO FOREVER
      PARSE VAR rest SubKey(Sep)rest
      IF SubKey = '' THEN
         LEAVE

      /* Check item for integer > 0 as group id */
      IF VERIFY( SubKey, '0123456789') <> 0 THEN
         ITERATE
      IF SubKey = 0 THEN
         ITERATE

      /* Check if SubKey is present in Cfg._Group. */
      fFound = 0
      DO n = 1 TO Cfg._Name.0
         IF SubKey = Cfg._Group.n THEN
         DO
            fFound = 1
            LEAVE
         END
      END
      IF fFound = 0 THEN
      DO
         /* Add SubKey to Cfg._Group. */
         n = Cfg._Name.0 + 1
         Cfg._Group.n = SubKey
         Cfg._Name.0 = n
      END
   END

   RETURN( rc)

/* ----------------------------------------------------------------------- */
GetDefaultGroups: PROCEDURE EXPOSE (GlobalVars)

   rc = ERROR.NO_ERROR

   /* Get all default keys */
   DefaultKey.  = ''
   DefaultKey.0 = 0

   next = SysIni( Ini._Filename, Ini._RegDefaults, 'ALL:', 'DefaultKey.')
   IF next = 'ERROR:' THEN
       fInit = 1

   IF fInit THEN
      next = TextIniToStem( File._DefaultsCfg, 'ALL:', 'ALL:', 'DefaultKey.')

   SearchKey = Key._MainPath'\'
   SearchLen = LENGTH( SearchKey)
   DO k = 1 TO DefaultKey.0
      /* Find keys that start with SearchKey */
      IF LEFT( DefaultKey.k, SearchLen) = SearchKey THEN
      DO
         /* Get reamaining key string */
         SubKey = SUBSTR( DefaultKey.k, SearchLen + 1)
         /* Get first path segment */
         PARSE VAR SubKey SubKey'\'.
         PARSE VAR SubKey SubKey '=' .

         /* Check item for integer > 0 as group id */
         IF VERIFY( SubKey, '0123456789') <> 0 THEN
            ITERATE
         IF SubKey = 0 THEN
            ITERATE

         /* Check if SubKey is present in Cfg._Group. */
         fFound = 0
         DO n = 1 TO Cfg._Name.0
            IF SubKey = Cfg._Group.n THEN
            DO
               fFound = 1
               LEAVE
            END
         END
         IF fFound = 0 THEN
         DO
            /* Add SubKey to Cfg._Group. */
            n = Cfg._Name.0 + 1
            Cfg._Group.n = SubKey
            Cfg._Name.0 = n
         END
      END
   END

   RETURN( rc)

/* ----------------------------------------------------------------------- */
GetGroupNames: PROCEDURE EXPOSE (GlobalVars)

   rc = ERROR.NO_ERROR

   /* Get names for all available groups */
   DO n = 1 TO Cfg._Name.0
      /* Use saved group id to query names */
      g = Cfg._Group.n

      /* Query user key */
      next = SysIni( Ini._Filename, Ini._RegKeys, Key._MainPath'\'g'\'Key._Name)
      next = STRIP( next, 'T', '00'x)
      IF next <> '' & next <> 'ERROR:' THEN
      DO
         Cfg._Name.n = next
         ITERATE
      END

      /* Query default key */
      IF fInit THEN
      DO
         next = FindTextIniVal( 'DefaultKey.', Key._MainPath'\'g'\'Key._Name)
         IF \(next = '') THEN
         DO
            Cfg._Name.n = next
            ITERATE
         END
      END
      ELSE
      DO
         next = SysIni( Ini._Filename, Ini._RegDefaults, Key._MainPath'\'g'\'Key._Name)
         next = STRIP( next, 'T', '00'x)
         IF next <> '' & next <> 'ERROR:' THEN
         DO
            Cfg._Name.n = next
            ITERATE
         END
      END

      Cfg._Name.n = NameNotSpecified
   END

   RETURN( rc)

/* ----------------------------------------------------------------------- */
BuildAssocArray: PROCEDURE EXPOSE (GlobalVars)

   rc = ERROR.NO_ERROR

   /* Init stem var */
   Assoc.  = ''
   Assoc.0 = 0

   /* Get user sub keys from RegContainer */
   UserSubKeys = ''
   next = SysIni( Ini._Filename, Ini._RegContainer, Key._MainPath'\'FoundGroup)
   next = STRIP( next, 'T', '00'x)
   IF next <> '' & next <> 'ERROR:' THEN
      UserSubKeys = next

   /* Add user objects to Assoc. */
   rest = UserSubKeys
   Sep = '00'x
   DO FOREVER
      PARSE VAR rest SubKey(Sep)rest
      IF SubKey = '' THEN
         LEAVE

      /* Check items for integer > 0 */
      IF VERIFY( SubKey, '0123456789') <> 0 THEN
         ITERATE
      IF SubKey = 0 THEN
         ITERATE

      /* Query key */
      next = SysIni( Ini._Filename, Ini._RegKeys, Key._MainPath'\'FoundGroup'\'SubKey)
      next = STRIP( next, 'T', '00'x)
      IF next <> '' & next <> 'ERROR:' THEN
      DO
         /* Add next to Assoc. */
         n = Assoc.0 + 1
         Assoc.n = next
         Assoc.0 = n
      END
   END

   IF Assoc.0 = 0 THEN
   DO
      /* Default keys were already queried */
      SearchKey = Key._MainPath'\'FoundGroup'\'
      SearchLen = LENGTH( SearchKey)
      DO k = 1 TO DefaultKey.0
         /* Find keys that start with SearchKey */
         IF LEFT( DefaultKey.k, SearchLen) = SearchKey THEN
         DO
            /* Get reamaining key string */
            SubKey = SUBSTR( DefaultKey.k, SearchLen + 1)
            /* Get first path segment, either separated by '\' or '=' */
            PARSE VAR SubKey SubKey'\'.
            PARSE VAR SubKey SubKey '=' .
            SubKey = strip( SubKey)

            /* Check items for integer > 0 */
            IF VERIFY( SubKey, '0123456789') <> 0 THEN
               ITERATE
            IF SubKey = 0 THEN
               ITERATE

            /* Query key */
            IF fInit THEN
            DO
               parse value DefaultKey.k with ThisKey '=' ThisVal
               ThisKey = STRIP( ThisKey)
               ThisVal = STRIP( ThisVal)
               next = ThisVal
            END
            ELSE
            DO
               next = SysIni( Ini._Filename, Ini._RegDefaults, DefaultKey.k)
               next = STRIP( next, 'T', '00'x)
            END

            IF next <> '' & next <> 'ERROR:' THEN
            DO
               /* Add next to Assoc. */
               n = Assoc.0 + 1
               Assoc.n = next
               Assoc.0 = n
            END
         END
      END
   END

   RETURN( rc)

/* ----------------------------------------------------------------------- */
ProcessAssocArray: PROCEDURE EXPOSE (GlobalVars)

   rc = ERROR.NO_ERROR

   DO a = 1 TO Assoc.0
      PARSE VAR Assoc.a Object','Setup','Position
      Object   = STRIP( Object)
      Setup    = STRIP( Setup)
      Position = STRIP( Position)
      IF Object = '' THEN
         ITERATE

      /* First, save object settings for maybe just created objects. */
      /* Otherwise the following configuration may fail (because the */
      /* previous object call was not wriiten to the inis).          */
      fAsync = 0
      rcx = SysSaveObject( Object, fAsync)

      IF Action = 'REMOVE' THEN
      DO
         IF POS( ','Object',', ','Processed._Objects) <> 0 THEN
            ITERATE
         rc = RemoveAssocs( Object)
         IF rc <> ERROR.NO_ERROR THEN
            LEAVE
         ITERATE
      END

      IF Setup = '' THEN
         ITERATE
      IF Position = '' THEN
         Position = 1
      IF Action = 'APPEND' THEN
         Position = 'L'
      ThisType   = ''
      ThisFilter = ''
      SELECT
         WHEN POS( 'TYPE:', TRANSLATE( Setup)) = 1 THEN
         DO
            PARSE VAR SETUP .':'ThisType
            ThisType = STRIP( ThisType)
            rc = ChangeAssocPos( 'TYPE', ThisType, Object, Position)
            IF rc <> ERROR.NO_ERROR THEN
               LEAVE
         END
         WHEN POS( 'FILTER:', TRANSLATE( Setup)) = 1 THEN
         DO
            PARSE VAR SETUP .':'ThisFilter
            ThisFilter = TRANSLATE( STRIP( ThisFilter))
            rc = ChangeAssocPos( 'FILTER', ThisFilter, Object, Position)
            IF rc <> ERROR.NO_ERROR THEN
               LEAVE
         END
         OTHERWISE
            NOP
      END
   END

   if rc = ERROR.NO_ERROR THEN
   DO
      MsgArgs = ListItem'|'Action'|'Processed._Objects'|' ||,
                Processed._Types'|'Processed._Filters
      IF ADDRESS() = 'EPM' THEN
         'AssocsMsgBox' MsgArgs
      ELSE
         rcx = AssocsMsg( MsgArgs)
   END

   RETURN( rc)

/* ----------------------------------------------------------------------- */
AssocsMsg: PROCEDURE EXPOSE (GlobalVars)

   PARSE ARG ListItem'|'Action'|'Objects'|'Types'|'Filters
   rc = ERROR.NO_ERROR

   verb = '<unknown action>'
   SELECT
      WHEN Action = 'PREPEND' THEN
         verb = 'prepending associations'
      WHEN Action = 'APPEND' THEN
         verb = 'appending associations'
      WHEN Action = 'REMOVE' THEN
         verb = 'removing associations'
   OTHERWISE
   END
   SAY 'Result of 'verb' for 'ListItem':'
   SAY
   SAY 'Changed objects:'
   rest = Objects
   DO WHILE rest <> ''
      PARSE VALUE rest WITH next','rest
      IF next = '' THEN
         ITERATE
      SAY '   o  'next
   END
   SAY
   SAY 'Changed types:'
   rest = Types
   DO WHILE rest <> ''
      PARSE VALUE rest WITH next','rest
      IF next = '' THEN
         ITERATE
      SAY '   o  'next
   END
   SAY
   SAY 'Changed filters:'
   rest = Filters
   DO WHILE rest <> ''
      PARSE VALUE rest WITH next','rest
      IF next = '' THEN
         ITERATE
      SAY '   o  'next
   END
   RETURN( rc)

/* ----------------------------------------------------------------------- */
RemoveAssocs: PROCEDURE EXPOSE (GlobalVars)
   PARSE ARG Object

   rc = ERROR.NO_ERROR

   CALL RxFuncAdd 'WPToolsLoadFuncs', 'WPTOOLS', 'WPToolsLoadFuncs'
   CALL WPToolsLoadFuncs

   /* Get all assocs for this object */
   rcx = WPToolsQueryObject( Object, 'Class', 'Title', 'Setup', 'Location')

   /* Remove all types */
   PARSE VAR Setup .'ASSOCTYPE='Types';'
   DO WHILE Types <> ''
      PARSE VAR Types ThisType','Types
      IF ThisType = '' THEN ITERATE
      rc = ChangeAssocPos( 'TYPE', ThisType, Object, 'REMOVE')
   END

   /* Remove all filters */
   PARSE VAR Setup .'ASSOCFILTER='Filters';'
   DO WHILE Filters <> ''
      PARSE VAR Filters ThisFilter','Filters
      IF ThisFilter = '' THEN ITERATE
      rc = ChangeAssocPos( 'FILTER', ThisFilter, Object, 'REMOVE')
   END

   RETURN( rc)

/* ----------------------------------------------------------------------- */
ChangeAssocPos: PROCEDURE EXPOSE (GlobalVars)
   PARSE ARG Category, Assoc, ObjectId, Position

   rc = ERROR.NO_ERROR
   DO 1

      /* Check values */
      fPassed = 0
      DO 1
         IF (Assoc = '') THEN
            LEAVE
         IF (ObjectId = '') THEN
            LEAVE
         IF (LEFT( ObjectId, 1) <> '<') THEN
            LEAVE
         IF (RIGHT( ObjectId, 1) <> '>') THEN
            LEAVE
         IF ((VERIFY( Position, '123456789L') <> 0) & (Position <> 'REMOVE')) THEN
            LEAVE
         fPassed = 1
      END
      IF \(fPassed) THEN
      DO
         ErrorMessage = 'Error: Invalid args "'Category', 'Assoc', 'ObjectId ||,
            ', 'Position'" for ChangeAssocPos.'
         rc = ERROR.INVALID_DATA
         LEAVE
      END

      /* Get decimal object handle from object id */
      Handle = GetObjHandle( ObjectId)
      IF (Handle = '') THEN
      DO
         ErrorMessage = 'Error: ObjectId 'ObjectId' not defined in user ini.'
         rc = ERROR.FILE_NOT_FOUND
         LEAVE
      END

      /* Get user ini assoc val for Category key */
      SELECT
         WHEN (Category = 'TYPE') THEN
            IniApplication = 'PMWP_ASSOC_TYPE'
         WHEN (Category = 'FILTER') THEN
            IniApplication = 'PMWP_ASSOC_FILTER'
      OTHERWISE
         ErrorMessage =  'Error: Undefined category "'Category'" specified.'
         rc = ERROR.INVALID_DATA
         LEAVE
      END

      IniKey = Assoc
      next = SysIni( 'USER', IniApplication, IniKey)
      IF next = 'ERROR:' THEN
         HandleList = ''
      ELSE
         /* Convert zeros to spaces to use the WORD functions */
         HandleList = STRIP( TRANSLATE( next, ' ', '00'x))

      NewHandleList = HandleList
      /* Find Handle in list of handles and maybe remove it */
      wp = WORDPOS( Handle, HandleList)
      IF (wp > 0) THEN
         NewHandleList = SPACE( DELWORD( HandleList, wp, 1))

      /* Add Handle according to Position */
      SELECT
         WHEN (Position = 'REMOVE') THEN
            nop
         WHEN (Position = 1) THEN
            NewHandleList = SPACE( Handle NewHandleList)
         WHEN ((Position = 'L') | (Position > WORDS( NewHandleList))) THEN
            NewHandleList = SPACE( NewHandleList Handle)
      OTHERWISE
         windex = WORDINDEX( NewHandleList, Position)
         NewHandleList = SPACE( INSERT( Handle' ', NewHandleList, windex - 1))
      END

      /* Write ini key */
      IF (NewHandleList <> HandleList) THEN
      DO
         val = TRANSLATE( SPACE( NewHandleList)' ', '00'x, ' ')
         IF val = '00'x THEN
            val = 'DELETE:'

         /*'dprintf next = SysIni( USER, 'IniApplication', 'IniKey', 'TRANSLATE( val, '.', '00'x)')'; next = ''*/
         next = SysIni( 'USER', IniApplication, IniKey, val)
         IF next = 'ERROR:' THEN
         DO
            ErrorMessage = 'Error: List of changed handles could not be' ||,
               ' written for 'IniApplication'->'IniKey ||,
               ', value = "'TRANSLATE( val, '.', '00'x)'"')
            rc = ERROR.INVALID_DATA
            LEAVE
         END

         /* Changed, so alter global lists */
         IF POS( ','ObjectId',', ','Processed._Objects) = 0 THEN
            Processed._Objects = Processed._Objects''ObjectId','
         IF (Category = 'TYPE') THEN
         DO
            IF POS( ','Assoc',', ','Processed._Types) = 0 THEN
               Processed._Types = Processed._Types''Assoc','
         END
         ELSE
         DO
            IF POS( ','Assoc',', ','Processed._Filters) = 0 THEN
               Processed._Filters = Processed._Filters''Assoc','
         END
      END

   END

   RETURN( rc)

/* ----------------------------------------------------------------------- */
/* Returns the decimal object handle for an object id.                     */
GetObjHandle: PROCEDURE
   PARSE ARG ObjectId

   next = SysIni( 'USER', 'PM_Workplace:Location', ObjectId)
   IF next = 'ERROR:' THEN
      RETURN( '')

   HexObjHandle = REVERSE( next)
   DecObjHandle = C2D( HexObjHandle)

   RETURN( DecObjHandle)

/* ----------------------------------------------------------------------- */
/* Syntax:                                                                 */
/*    rc = TextIniToStem( File, ApplicationList, Key, Stem)                */
/* Adds key = value lines of a text ini file to a specified stem var. The  */
/* search can be reduced to a list of ini applications or to a key. If no  */
/* Application list is specified, 'ALL:' applications are listed. If no    */
/* key is specified, 'ALL:' keys are listed. The number of items is        */
/* written to Stem''0.                                                     */
/* Different from SysIni for OS/2 ini files, TextIniToStem always lists    */
/* entire lines. Theerefore, in most cases, that list has to be parsed     */
/* to key and value pairs.                                                 */
/* Example:                                                                */
/*    rcx = TextIniToStem( 'defaults.cfg', 'ALL:', 'ALL:', 'DefaultKey.')  */
/*    DO n = 1 TO DefaultKey.0                                             */
/*       SAY DefaultKey.n                                                  */
/*    END                                                                  */
/* This is used here for DEFAULTS.CFG parsing */
TextIniToStem:
/*
Adding the value of StemVar to the expose list is not possible. Therefore
this function must be global.
*/
   rc = ERROR.NO_ERROR
   PARSE ARG File, ApplicationList, Key, StemVar

   Entry = ''
   IF ApplicationList  = '' THEN
      ApplicationList  = 'ALL:'
   Application = ''
   IF Key = '' THEN
      Key = 'ALL:'

   IF RIGHT( StemVar, 1) <> '.' THEN
      StemVar = StemVar'.'
   CALL VALUE StemVar, ''
   CALL VALUE StemVar''0, 0

   next = STREAM( File, 'C', 'OPEN READ')
   DO WHILE CHARS( File) > 0
      line = LINEIN( File)
      SELECT
         WHEN LEFT( line, 1) = ';' THEN
            NOP
         WHEN STRIP( line) = '' THEN
            NOP
         WHEN LEFT( line, 1) = '[' THEN
         DO
            p2 = POS( ']', line)
            IF p2 > 0 THEN
            DO
               nextApplication = SUBSTR( line, 2, p2 - 2)
               IF WORDPOS( nextApplication, ApplicationList) > 0 | ApplicationList = 'ALL:' THEN
                  Application = nextApplication
               ELSE
                  Application = ''  /* nextApplication is other, reset Application */
            END
         END
      OTHERWISE
         PARSE VALUE line WITH nextKey '=' nextEntry
         /* it must be a 'Key = Entry' line */
         nextKey   = STRIP( nextKey)
         nextEntry = STRIP( nextEntry)
         IF ApplicationList <> 'ALL:' & Application = '' THEN
            ITERATE
         IF nextKey = '' THEN
            ITERATE
         IF Key = 'ALL:' | nextKey = Key THEN
         DO
            s = VALUE( StemVar''0) + 1
            CALL VALUE StemVar''0, s
            CALL VALUE StemVar''s, nextKey'='nextEntry
         END
      END
   END
   rc = STREAM( File, 'C', 'CLOSE')

   RETURN( rc)

/* ----------------------------------------------------------------------- */
/* Requires a previous call to TextIniToStem. Returns Val for a specified  */
/* Key.                                                                    */
FindTextIniVal: PROCEDURE EXPOSE (GlobalVars)
   Val = ''
   PARSE ARG StemVar, Key
   IF RIGHT( StemVar, 1) <> '.' THEN
      StemVar = StemVar'.'

   DO s = 1 TO VALUE( StemVar''0)
      ThisLine = VALUE( StemVar''s)
      PARSE VALUE ThisLine WITH ThisKey '=' ThisVal
      ThisKey = STRIP( ThisKey)
      ThisVal = STRIP( ThisVal)
      IF ThisKey = Key THEN
      DO
         Val = ThisVal
         LEAVE
      END
   END
   RETURN( Val)

/* ----------------------------------------------------------------------- */
FileExist: PROCEDURE EXPOSE (GlobalVars)
   PARSE ARG Filename
   IF FileName = '' THEN
      RETURN( 0)
   ELSE
      RETURN( STREAM( Filename, 'C', 'QUERY EXISTS') <> '')

/* --------------------- Standard ERX macros follow ---------------------- */

/* ----------------------------------------------------------------------- */
SayText: PROCEDURE EXPOSE (GlobalVars)
   PARSE ARG Message

   SELECT
      WHEN ADDRESS() = 'EPM' THEN
         'sayerror' Message
   OTHERWISE
      SAY Message
   END

   RETURN( '')

/* ----------------------------------------------------------------------- */
/* For PmPrintf output, use CALL SayDegug '...' When being called from an  */
/* environment outside of EPM, the message text is processed by a SAY      */
/* statement instead. */
SayDebug: PROCEDURE EXPOSE (GlobalVars)
   PARSE ARG Message

   SELECT
      WHEN ADDRESS() = 'EPM' THEN
         'dprintf' Message
   OTHERWISE
      SAY Message
   END

   RETURN( '')

/* ----------------------------------------------------------------------- */
SayErrorMessage: PROCEDURE EXPOSE (GlobalVars)

   SELECT
      WHEN (ErrorMessage = '') THEN NOP

      /* Called by frame program: insert error */
      /* message into private queue            */
      WHEN (ErrorQueueName <> '') THEN
      DO
         rcx = RXQUEUE( 'SET', ErrorQueueName)
         PUSH ErrorMessage
      END

      /* Called directly */
      WHEN ADDRESS() = 'EPM' THEN
      DO
         'sayerror' ErrorMessage
         rcx = RxMessageBox( ErrorMessage, TRANSLATE( ThisName),,
            'OK', 'ERROR')
      END

      /* Called directly */
      OTHERWISE
      DO
         SAY ErrorMessage
         'PAUSE'
      END
   END

   RETURN( '')

/* ----------------------------------------------------------------------- */
Halt:
   ErrorMessage = 'Interrupted by user.'
   CALL SayErrorMessage
   EXIT( ERROR.GEN_FAILURE)

/* ----------------------------------------------------------------------- */
/* Give a standard REXX error message and jump to the error line           */
Error:
   /* sigl must be saved to not get overwritten by SayErrorMessage call */
   ErrorLine = sigl

   /* As an extension to the standard REXX error messages,    */
   /* the error condition will be appended to the error text. */
   ConditionText = 'Condition: 'CONDITION( 'C')
   ConditionDescription = CONDITION( 'D')
   IF ConditionDescription <> '' THEN
      ConditionText = ConditionText', Reason: 'ConditionDescription
   ErrText = ERRORTEXT( rc)
   IF ErrText = '' THEN
      ErrText = ConditionText
   ELSE
      ErrText = ErrText', 'ConditionText

   ErrorMessage = 'REX'RIGHT( rc, 4, 0)': Error 'rc' running 'ThisFile',' ||,
      ' line 'sigl': 'ErrText
   CALL SayErrorMessage

   IF ADDRESS() = 'EPM' THEN
      "e "ThisFile" 'postme "ErrorLine"'"

   /* Ensure that rc <> 0 is returned */
   IF rc = 0 THEN
      rc = ERROR.GEN_FAILURE
   EXIT( rc)