/****************************** Module Header *******************************
*
* Module Name: omitopenbox.erx
*
* Syntax: rx omitopenbox <action>
*
* with
*    <action> = query | toggle | 1 | 0 | on | off | yes | no
*               (query retrieves the object settings for object \1.)
*
* This EPM REXX file is used for the setting
* Programm objects -> File open selection: Omit open box.
*
* When activated, the EPM parameter /o is added to the program objects. Then
* the opening of the additional EPM open box is bypassed and the file dialog
* is opened directly.
*
* The open box has the advantage that it provides a history list with
* previously selected files.
*
* Copyright (c) Netlabs EPM Distribution Project 2002
*
* $Id: omitopenbox.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 ---------------- */
UserDir           = VALUE( 'NEPMD_USERDIR',, env)
Ini._Filename     = UserDir'\bin\nepmd.ini'
Ini._RegKeys      = 'RegKeys'
Ini._RegContainer = 'RegContainer'
Ini._RegDefaults  = 'RegDefaults'
Key._MainPath     = '\NEPMD\User\ProgramObjects\OmitOpenBox'
/* -------------------------------------------- */

GlobalVars = GlobalVars 'Ini. Key. Obj. fInit'

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

DO 1
   fInit = 0

   PARSE ARG Args
   Args = TRANSLATE( STRIP( Args))
   SELECT
      WHEN (POS( Args, 'ON') = 1 | POS( Args, 'YES') = 1 | Args = 1) THEN
         Action = 'ON'
      WHEN (POS( Args, 'OFF') = 1 | POS( Args, 'NO') = 1 | Args = 0) THEN
         Action = 'OFF'
      WHEN (POS( Args, 'TOGGLE') = 1) THEN
         Action = 'TOGGLE'
      WHEN (POS( Args, 'QUERY') = 1) THEN
         Action = 'QUERY'
   OTHERWISE
      rc = ERROR.INVALID_PARAMETER
      ErrorMessage = 'Error: No action specified. Parameter' ||,
         ' for 'TRANSLATE( ThisName)' is missing.'
      LEAVE
   END

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

   /* Get all user keys */
   CALL GetUserObjects

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

   /* Query current setting from first object */
   Object = Obj.1
   rcx = WPToolsQueryObject( Object, 'Class', 'Title', 'Setup', 'Location')
   IF (rcx = 1) THEN
      fOldO = CheckO( Setup)
   ELSE
   DO
      ErrorMessage = 'Error: Setup string couldn''t be queried from 'Object'.'
      rc = ERROR.FILE_NOT_FOUND
      LEAVE
   END

   IF (Action = 'QUERY') THEN
      EXIT( fOldO)

   OldState = WORD( 'OFF ON', fOldO + 1)
   /* 'DPrintf Current state of parameter "/o" is: 'OldState */

   IF Action = OldState THEN
   DO
      CALL SayText 'No changes.'
      LEAVE
   END

   /* Toggle presence of /o */
   fNewO = \fOldO

   i = 0
   DO n = 1 to Obj.0
      IF Obj.n = '' THEN
         ITERATE
      rcx = ToggleO( Obj.n, fNewO)
      IF (rcx = 1) THEN
         i = i + 1
   END

   CALL SayText 'Changed 'i' object(s). Restart all EPM windows to make' ||,
      ' the changes take effect.'
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)

/* ----------------------------------------------------------------------- */
GetUserObjects: 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 objects to Obj. */
   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

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

   RETURN( rc)

/* ----------------------------------------------------------------------- */
GetDefaultObjects: 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

         /* Query key */
         IF fInit THEN
         DO
            PARSE VAR DefaultKey.k . '=' next
            next = STRIP( next)
         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 Obj. */
            n = Obj.0 + 1
            Obj.n = next
            Obj.0 = n
         END
      END
   END

   RETURN( rc)

/* ----------------------------------------------------------------------- */
CheckO: PROCEDURE
   PARSE ARG Setup

   PARSE VAR Setup First'PARAMETERS='Params';'Rest
   wp = WORDPOS( '/O', TRANSLATE( Params))

   RETURN( wp > 0)

/* ----------------------------------------------------------------------- */
ToggleO: PROCEDURE EXPOSE (GlobalVars)
   PARSE ARG Obj, fAddO

   rcx = WPToolsQueryObject( Obj, 'Class', 'Title', 'Setup', 'Location')
   IF (rcx = 1) THEN
   DO
      PARSE VAR Setup First'PARAMETERS='Params';'Rest

      wp = WORDPOS( '/O', TRANSLATE( Params))
      SELECT
         WHEN (fAddO & wp = 0) THEN
            Params = '/o 'Params
         WHEN (\fAddO & wp > 0) THEN
            Params = DELWORD( Params, wp, 1)
      OTHERWISE
         NOP
      END

      /* Remove trailing "%*" */
      IF (WORD( Params, WORDS( Params)) = '"%*"') THEN
         Params = STRIP( DELWORD( Params, WORDS( Params)), 'T')

      /* Setting an empty parameter doesn't work */
      /* The doublequotes are required for filenames with spaces */
      IF Params = '' THEN
         Params = '"%*"'

      Setup = First'PARAMETERS='Params';'Rest
      /* 'DPrintf' Obj 'PARAMETERS='Params';' */

      rcx = SysSetObjectData( Obj, Setup)
      rc2 = SysSaveObject( Obj, 0)
   END
   RETURN( rcx)

/* ----------------------------------------------------------------------- */
/* 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)

/* --------------------- 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)