/****************************** Module Header *******************************
*
* Module Name: newsamewindow.erx
*
* Syntax: rx newsamewindow <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 -> Open in same window.
*
* When activated, the EPM parameter /r is added to the program objects. Then
* newly opened files were added to the topmost EPM window. Otherwise, each
* file is opened is a new window.
*
* Special object = EPM program object that gets the converse setting applied.
*
*    When other program objects were set to open newly added files in the
*    same window, then the special object was set to open newly added files
*    in a new window.
*
*    Additionally, its object title is changed to inform about the current
*    behavior. It's toggled between "EPM same window" and "EPM new window".
*
* Copyright (c) Netlabs EPM Distribution Project 2002
*
* $Id$
*
* ===========================================================================
*
* 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.
*
****************************************************************************/

/* ----------------- 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'
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   = ''

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

/* ------------- Configuration ---------------- */
UserDir           = VALUE( 'NEPMD_USERDIR',, env)
Ini._Filename     = UserDir'\bin\nepmd.ini'
Ini._RegKeys      = 'RegKeys'
Ini._RegDefaults  = 'RegDefaults'
Ini._RegContainer = 'RegContainer'
Key._MainPath     = '\NEPMD\User\ProgramObjects\OpenSameWindow'
Key._Special      = 'Special'

/* TODO: NLS */
Title._EPM_NEW_WINDOW  = 'EPM new window'
Title._EPM_SAME_WINDOW = 'EPM same window'
/* -------------------------------------------- */

GlobalVars = GlobalVars 'Ini. Key. Title.'

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

DO 1

   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 NEWSAMEWINDOW.ERX is missing.'
      LEAVE
   END

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

   /* 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
   DO FOREVER
      PARSE VAR rest SubKey'00'x''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'\'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

   IF Obj.0 = 0 THEN
   DO
      /* Get all default keys */
      DefaultKey.  = ''
      DefaultKey.0 = ''
      next = SysIni( Ini._Filename, Ini._RegDefaults, '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'\'.

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

            /* Query key */
            next = SysIni( Ini._Filename, Ini._RegDefaults, DefaultKey.k)
            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
      END
   END

   /* Get special object */
   next = SysIni( Ini._Filename, Ini._RegKeys, Key._MainPath'\'Key._Special)
   next = STRIP( next, 'T', '00'x)
   IF (next = '' | next = 'ERROR:') THEN
   DO
      /* No user key exists in RegKeys, query RegDefaults */
      next = SysIni( Ini._Filename, Ini._RegDefaults, Key._MainPath'\'Key._Special)
      next = STRIP( next, 'T', '00'x)
      IF (next = '' | next = 'ERROR:') THEN
      DO
         ErrorMessage = 'Error: No special object defined in "'Key._MainPath'".'
         rc = ERROR.INVALID_DATA
         LEAVE
      END
   END
   Obj._Special = next

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

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

   OldState = WORD( 'OFF ON', fOldR + 1)

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

   /* Toggle presence of /r */
   fNewR = \fOldR
   i = 0
   DO n = 1 TO Obj.0
      IF Obj.n = '' THEN
         ITERATE
      rcx = ToggleR( Obj.n, fNewR)
      IF (rcx = 1) THEN
         i = i + 1
   END

   /* For special object, toggle presence of /r (inverted) and change title */
   rcx = ToggleR( Obj._Special, \fNewR)
   IF (rcx = 1) THEN
      i = i + 1
   rcx = ToggleTitle( Obj._Special, fNewR)

   CALL SayText 'Changed 'i' object(s).'

END

CALL SayErrorMessage
EXIT( rc)

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

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

   RETURN( wp > 0)

/* ----------------------------------------------------------------------- */
ToggleR: PROCEDURE EXPOSE (GlobalVars)
   PARSE arg Obj, fAddR

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

      wp = WORDPOS( '/R', TRANSLATE( Params))
      SELECT
         WHEN (fAddR & wp = 0) THEN
            Params = '/r 'Params
         WHEN (\fAddR & 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 filanames with spaces */
      IF Params = '' THEN
         Params = '"%*"'

      Setup = First'PARAMETERS='Params';'Rest

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

/* ----------------------------------------------------------------------- */
ToggleTitle: PROCEDURE EXPOSE (GlobalVars)
   PARSE ARG Obj, fNewWindow

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

      wp = WORDPOS( 'NEW', TRANSLATE( Title))
      IF (fNewWindow) THEN
         Title = Title._EPM_NEW_WINDOW
      ELSE
         Title = Title._EPM_SAME_WINDOW

      Setup = First'TITLE='Title';'Rest

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

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

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

   SELECT
      WHEN ADDRESS() = 'EPM' THEN
         'sayerror' 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*/
         ThisFileName = SUBSTR( ThisFile, LASTPOS( '\', ThisFile) + 1)
         rcx = RxMessageBox( ErrorMessage, TRANSLATE( ThisFileName),,
            '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)