×undefined‰''8ò/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/
/*----------------------------------------------------------------------------

File: lstdn1.i

Description:
    Shift an item "down" one in a select list.

Arguments:
   &pick_list_w - The list.
   &frame       - The frame of the pick list
   
Author: David Lee

Date Created: 03/04/93
----------------------------------------------------------------------------*/

{adecomm/lst1def.i}

IF {&pick_list_w}:VALUE IN FRAME {&frame} <> ? THEN
  DO:

  /*
   * Find the entry in the list
   */
  ASSIGN
    lst_choice    = {&pick_list_w}:VALUE IN FRAME {&frame}
    lst_pick_list = {&pick_list_w}:LIST-ITEMS IN FRAME {&frame}
    lst_index     = LOOKUP(ENTRY(1, lst_choice), lst_pick_list).
  /*
   * Pull out the selected string from its current slot
   */ 
 
 DO lst_i = 1 TO NUM-ENTRIES(lst_choice):

    ASSIGN
    ENTRY(LOOKUP(ENTRY(lst_i, lst_choice), lst_pick_list), lst_pick_list) = "":u
      lst_pick_list = REPLACE(lst_pick_list,",,":u,",":u).

  END.

  /*
   * And now add the chosen item back into the list
   */
  ASSIGN
    lst_pick_list = TRIM(lst_pick_list,",":u)
    lst_index = MINIMUM(lst_index ,NUM-ENTRIES(lst_pick_list)).
    
    IF lst_index = 0 THEN
      lst_pick_list = lst_choice.
    ELSE
      ENTRY(lst_value_index, lst_pick_list) =
              ENTRY(lst_index, lst_pick_list) + ",":u + lst_choice.
    
    ASSIGN         
      {&pick_list_w}:LIST-ITEMS IN FRAME {&frame} = lst_pick_list     
      {&pick_list_w}:VALUE      IN FRAME {&frame} = lst_choice.
           
END.
/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/
/*----------------------------------------------------------------------------

File: 1lstup.i

Description:
    Shift an item "up" one in a soingle select list.

Arguments:
   &pick_list_w - The list.
   &frame     - The frame of the pick list
   

Author: David Lee

Date Created: 03/04/93
----------------------------------------------------------------------------*/

{adecomm/lstdef1.i}

IF {&pick_list_w}:VALUE IN FRAME {&frame} <> ? THEN
  DO:

  /*
   * Find the entry in the list
   */
  
  ASSIGN
    lst_choice    = {&pick_list_w}:VALUE IN FRAME {&frame}
    lst_pick_list = {&pick_list_w}:LIST-ITEMS IN FRAME {&frame}
    lst_index     = LOOKUP(ENTRY(1, lst_choice), lst_pick_list).

  /*
   * Update the data structure
   */
   
   {adecomm/lstup.i &choice       = lst_choice
                    &pick_list    = lst_pick_list
                    &choice_index = lst_index}

  /*
   * And now add the chosen item back into the list
   */
  ASSIGN       
    {&pick_list_w}:LIST-ITEMS IN FRAME {&frame} = lst_pick_list
      
    {&pick_list_w}:VALUE      IN FRAME {&frame} = lst_choice.
           
END.
/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/
/*----------------------------------------------------------------------------

File: 2lstdef.i

Description:
    Includes all the definitions needed to make a shadow pick list work

Arguments
   
Author: David Lee

Date Created: 03/04/93
----------------------------------------------------------------------------*/


&IF (DEFINED(include2lstup) = 0)
&THEN

  {adecomm/lstdef1.i}

  DEFINE VARIABLE lst2_index      AS INTEGER NO-UNDO.
  DEFINE VARIABLE lst2_shadow     AS CHARACTER NO-UNDO.
  DEFINE VARIABLE lst2_pick_list  AS CHARACTER NO-UNDO.
  DEFINE VARIABLE lst2_orig_index AS INTEGER NO-UNDO.

&SCOPED-DEFINE include2lstup 1
&ENDIF
/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/
/*----------------------------------------------------------------------------

File: 2lstdn.i

Description:
    Shift an item "down" one in a "shadow" select list situation. This
    code assumes that both lists have the same number of entries and
    are already in proper order.
    
    The function including this file must also include 2lstdef.i

Arguments:
   &pick_list_w   - The list.
   &shadow_list_w - The shadow of the list.
   &frame         - The frame of the pick list

Author: David Lee

Date Created: 03/04/93
----------------------------------------------------------------------------*/

IF {&pick_list_w}:SCREEN-VALUE IN FRAME {&frame} <> ? THEN DO:
  /* Find the entry in the list */
  ASSIGN
    lst_choice      = {&pick_list_w}:SCREEN-VALUE IN FRAME {&frame}
    lst_pick_list   = {&pick_list_w}:LIST-ITEMS IN FRAME {&frame}
    lst_index       = LOOKUP(ENTRY(1,lst_choice,CHR(3)),lst_pick_list,CHR(3))
    lst2_orig_index = lst_index
    lst2_pick_list  = {&shadow_list_w}:LIST-ITEMS IN FRAME {&frame}.

  /*
   * Update the shadow list. First build a second choice list
   * based on the first choice list. First get the name of the
   * choice, then gets its location in its data structure, then
   * get the corresponding element from the shadow's datastructure
   */
  
  DO lst2_index = 1 TO NUM-ENTRIES(lst_choice,CHR(3)):
    lst2_shadow = lst2_shadow +
      ENTRY(LOOKUP(ENTRY(lst2_index,lst_choice,CHR(3)),lst_pick_list,CHR(3)),
            lst2_pick_list,CHR(3)).

    IF lst2_index <> NUM-ENTRIES(lst_choice,CHR(3)) THEN
      lst2_shadow = lst2_shadow + CHR(3).
  END.

  /* Update the data structure for the list that has the selection */
  {adecomm/lstdn.i &choice       = lst_choice
                   &pick_list    = lst_pick_list
                   &choice_index = lst_index}

  /* And now add the chosen item back into the list */
  ASSIGN       
    {&pick_list_w}:LIST-ITEMS IN FRAME {&frame}   = lst_pick_list      
    {&pick_list_w}:SCREEN-VALUE IN FRAME {&frame} = lst_choice.
  
  /* Go change the data structure */
  {adecomm/lstdn.i &choice       = lst2_shadow
                   &pick_list    = lst2_pick_list
                   &choice_index = lst2_orig_index}

  /* And now update the shadow.  */
  ASSIGN       
    {&shadow_list_w}:LIST-ITEMS IN FRAME {&frame}   = lst2_pick_list      
    {&shadow_list_w}:SCREEN-VALUE IN FRAME {&frame} = lst2_shadow.
       
END.

/* 2lstdn.i - end of file */

/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/
/*----------------------------------------------------------------------------

File: 2lstup.i

Description:
    Shift an item "up" one in a "shadow" select list situation. This
    code assumes that both lists have the same number of entries and
    are already in proper order.
    
    The function including this file must also include 2lstdef.i

Arguments:
   &pick_list_w   - The list.
   &shadow_list_w - The shadow of the list.
   &frame         - The frame of the pick list

Author: David Lee

Date Created: 03/04/93
----------------------------------------------------------------------------*/

IF {&pick_list_w}:SCREEN-VALUE IN FRAME {&frame} <> ? THEN DO:
  /* Find the entry in the list */
  ASSIGN
    lst_choice     =  {&pick_list_w}:SCREEN-VALUE IN FRAME {&frame}
    lst_pick_list  =  {&pick_list_w}:LIST-ITEMS IN FRAME {&frame}
    lst_index      =  LOOKUP(ENTRY(1,lst_choice,CHR(3)),lst_pick_list,CHR(3))
    lst2_orig_index = lst_index
    lst2_pick_list =  {&shadow_list_w}:LIST-ITEMS IN FRAME {&frame}.

  /*
   * Update the shadow list. First build a second choice list
   * based on the first choice list. First get the name of the
   * choice, then gets its location in its data structure, then
   * get the corresponding element from the shadow's datastructure
   */
   
  DO lst2_index = 1 TO NUM-ENTRIES(lst_choice,CHR(3)):
    lst2_shadow = lst2_shadow +
      ENTRY(LOOKUP(ENTRY(lst2_index,lst_choice,CHR(3)),lst_pick_list,CHR(3)), 
            lst2_pick_list,CHR(3)).

    IF lst2_index <> NUM-ENTRIES(lst_choice,CHR(3)) THEN
      lst2_shadow = lst2_shadow + CHR(3).
  END.

  /* Update the data structure for the list that has the selection */
  {adecomm/lstup.i &choice       = lst_choice
                   &pick_list    = lst_pick_list
                   &choice_index = lst_index}

  /* And now add the chosen item back into the list */
  ASSIGN       
    {&pick_list_w}:LIST-ITEMS IN FRAME {&frame} = lst_pick_list      
    {&pick_list_w}:SCREEN-VALUE      IN FRAME {&frame} = lst_choice.
  
  /* Go change the data structure */
  {adecomm/lstup.i &choice       = lst2_shadow
                   &pick_list    = lst2_pick_list
                   &choice_index = lst2_orig_index}

  /* And now update the shadow.  */
  ASSIGN       
    {&shadow_list_w}:LIST-ITEMS IN FRAME {&frame} = lst2_pick_list      
    {&shadow_list_w}:SCREEN-VALUE      IN FRAME {&frame} = lst2_shadow.
    
END.

/* 2lstup.i - end of file */

/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/
/* a-schema.p - all fields of _dtype = int(pi_dtype) into comma-sep-list.
   _dtype = 0 or * = wildcards (i.e. all types)

DICTDB must be pointing to SDBNAME(pi_dbname).

Note that this returns _Label, not _Col-label, as the first choice.
_y-schem.p returns _Col-label.

History: 07/10/98 D. McMann Changed Find to FOR EACH to be able to verify
                            _owner with DBVERSION.
*/

DEFINE INPUT  PARAMETER pi_dbname AS CHARACTER NO-UNDO. /* ldbname */
DEFINE INPUT  PARAMETER pi_table  AS CHARACTER NO-UNDO. /* tablename */
DEFINE INPUT  PARAMETER pi_dtype  AS CHARACTER NO-UNDO. /* dtype listing */
DEFINE OUTPUT PARAMETER po_labels AS CHARACTER INITIAL "" NO-UNDO.
DEFINE OUTPUT PARAMETER po_fields AS CHARACTER INITIAL "" NO-UNDO.

DEFINE VARIABLE ix  AS INTEGER   NO-UNDO.
DEFINE VARIABLE lbl AS CHARACTER NO-UNDO.

FIND DICTDB._Db
  WHERE DICTDB._Db._Db-name =
    (IF DBTYPE(pi_dbname) = "PROGRESS":u THEN ? ELSE pi_dbname)
  NO-LOCK NO-ERROR.
IF NOT AVAILABLE DICTDB._Db THEN RETURN.

FOR EACH DICTDB._File OF DICTDB._Db WHERE DICTDB._File._File-name = pi_table 
            AND CAN-DO(DICTDB._File._Can-Read,USERID(pi_dbname)) NO-LOCK:
  IF INTEGER(DBVERSION("DICTDB")) > 8 AND 
     (DICTDB._File._Owner <> "PUB" AND DICTDB._File._Owner <> "_FOREIGN") THEN 
    RELEASE DICTDB._File. 
  ELSE LEAVE.  
END.
IF NOT AVAILABLE DICTDB._File THEN RETURN.

/*--------------------------------------------------------------------------*/

ASSIGN
  pi_dtype = (IF pi_dtype = "0":u OR pi_dtype = "*":u THEN
                "1,2,3,4,5":u
              ELSE
                pi_dtype
              )
  po_fields = ""
  po_labels = "".

FOR EACH DICTDB._Field OF DICTDB._File
  WHERE CAN-DO(pi_dtype,STRING(DICTDB._Field._dtype)) 
   AND CAN-DO(DICTDB._Field._Can-Read,USERID(pi_dbname)) NO-LOCK
  BY DICTDB._Field._Field-name:

  lbl = (IF DICTDB._Field._Label = ? OR DICTDB._Field._Label = ""
         THEN DICTDB._Field._Field-name ELSE DICTDB._Field._Label).

  IF DICTDB._Field._Extent = 0 THEN
    ASSIGN
      po_fields = po_fields + (IF po_fields = "" THEN "" ELSE ",":u)
		+ DICTDB._Field._Field-name
      po_labels = po_labels + (IF po_labels = "" THEN "" ELSE ",":u)
		+ lbl.
  ELSE
    DO ix = 1 TO DICTDB._Field._Extent:
      ASSIGN
	po_fields = po_fields + (IF po_fields = "" THEN "" ELSE ",":u)
		  + DICTDB._Field._Field-name + "[" + STRING(ix) + "]"
	po_labels = po_labels + (IF po_labels = "" THEN "" ELSE ",":u)
		  + lbl.
    END.
END.

RETURN.

/* a-schema.p - end of file */


/**************************************************************************
*Copyright (C) 2005,2010-2013 by Progress Software Corporation. *
*All rights reserved.  Prior versions of this work may contain portions   *
*contributed by participants of Possenet.                                 *
**************************************************************************/
/*
Procedure:    adecomm/_about.p
Author:       R. Ryan
Created:      1/95
Purpose:      re-written by Bob Ryan 1/95 to look better under 3-D
              and provide some Windows environment info
*/

&SCOPED-DEFINE FRAME-NAME  Dialog-1

&IF "{&WINDOW-SYSTEM}" = "TTY" &THEN
  &SCOPED-DEFINE StartRow 6
  &SCOPED-DEFINE StartCol 4
  &SCOPED-DEFINE OKBtnRow 8.5
&ELSE
  &SCOPED-DEFINE StartRow 5
  &SCOPED-DEFINE StartCol 11.57
  &SCOPED-DEFINE OKBtnRow 7.5
&ENDIF

{adecomm/adestds.i}

DEFINE INPUT PARAMETER pTitle AS CHARACTER NO-UNDO.
DEFINE INPUT PARAMETER pIcon  AS CHARACTER NO-UNDO.

DEFINE VARIABLE result       AS LOGICAL   NO-UNDO.
DEFINE VARIABLE AboutText1   AS CHARACTER NO-UNDO.
DEFINE VARIABLE AboutText2   AS CHARACTER NO-UNDO.
DEFINE VARIABLE Label1       AS CHARACTER FORMAT "x(50)" VIEW-AS TEXT.
DEFINE VARIABLE Label2       AS CHARACTER FORMAT "x(50)" VIEW-AS TEXT.
DEFINE VARIABLE DBEtestvalue AS CHARACTER NO-UNDO.
DEFINE VARIABLE ProName      AS CHARACTER NO-UNDO.
DEFINE VARIABLE ABLic        AS INTEGER   NO-UNDO.
DEFINE VARIABLE ABTools      AS CHARACTER NO-UNDO.
DEFINE VARIABLE Workshop-only AS LOGICAL  NO-UNDO.

DEFINE VARIABLE majorversion  AS INTEGER   NO-UNDO.
DEFINE VARIABLE minorversion  AS CHARACTER NO-UNDO.
DEFINE VARIABLE dot           AS INTEGER   NO-UNDO.
 
DEFINE VARIABLE lICF          AS LOGICAL    NO-UNDO.


DEFINE IMAGE AboutImage &IF "{&WINDOW-SYSTEM}" BEGINS "MS-WIN" &THEN
                           SIZE-PIXELS 32 BY 32.
                         &ELSE
                           SIZE-PIXELS 42 BY 42.
                         &ENDIF

DEFINE RECTANGLE TopLine    
  EDGE-PIXELS 2 GRAPHIC-EDGE NO-FILL SIZE 55 BY .08.
DEFINE RECTANGLE BottomLine LIKE TopLine.
DEFINE RECTANGLE ContainerRectangle
  EDGE-PIXELS 2 SIZE-PIXELS 40 BY 40 BGCOLOR 8.

DEFINE BUTTON BtnOK AUTO-END-KEY
  LABEL "OK":l SIZE 10 BY 1.

DEFINE FRAME Dialog-1
&IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN
  ContainerRectangle AT ROW 1.5 COLUMNS 3
  AboutImage AT ROW 1.67 COLUMNS 3.57
  AboutText1 NO-LABELS AT ROW 1.75 COLUMNS {&StartCol}
             VIEW-AS EDITOR SIZE 55 BY 6 NO-BOX
  SKIP
  AboutText2 NO-LABELS AT {&StartCol}
             VIEW-AS EDITOR SIZE 55 BY 5 SCROLLBAR-VERTICAL
  SKIP(1)
  TopLine AT 11 SKIP(0.5)
  Label1 AT {&StartCol} NO-LABELS SKIP(.15)
  Label2 AT {&StartCol} NO-LABELS SKIP(0.5)
  BottomLine AT 11 SKIP(1)
  BtnOK AT 27 SKIP(1)
  WITH VIEW-AS DIALOG-BOX KEEP-TAB-ORDER
  SIDE-LABELS NO-UNDERLINE SCROLLABLE DEFAULT-BUTTON BtnOK.
&ELSE
  ContainerRectangle AT ROW 1.5 COLUMNS 3
  AboutText1 NO-LABELS AT ROW 1.75 COLUMNS {&StartCol}
             VIEW-AS EDITOR SIZE 50 BY 10
  SKIP
  /* currently empty 
  AboutText2 NO-LABELS AT {&StartCol}
             VIEW-AS EDITOR SIZE 50 BY 5 SCROLLBAR-VERTICAL
  SKIP
  */
  TopLine AT 11     SKIP
  BottomLine AT 11  SKIP(1)
  BtnOK AT 27       SKIP
  WITH VIEW-AS DIALOG-BOX SIDE-LABELS DEFAULT-BUTTON BtnOK.
&ENDIF

/*----------- function prototy-types ---------------------*/
function getVersion returns char (pcText as character) forward.
 
IF VALID-HANDLE(ACTIVE-WINDOW) AND FRAME {&FRAME-NAME}:PARENT EQ ? THEN
  FRAME {&FRAME-NAME}:PARENT = ACTIVE-WINDOW.

ON WINDOW-CLOSE OF FRAME {&FRAME-NAME} 
  APPLY "END-ERROR":u TO SELF.

/*---------------------------------------------------------------------------*/
main-block:
DO ON ERROR   UNDO main-block, LEAVE main-block
   ON END-KEY UNDO main-block, LEAVE main-block:

  /* general assignments... */
  ASSIGN
    FRAME {&FRAME-NAME}:THREE-D = SESSION:THREE-D
    FRAME {&FRAME-NAME}:TITLE   = "About " + pTitle
    BtnOK:WIDTH                 = IF SESSION:WINDOW-SYSTEM = "TTY":u THEN 
                                    4 ELSE 14
    BtnOK:HEIGHT                = IF SESSION:WINDOW-SYSTEM = "TTY":u THEN 
                                    1 ELSE 1.14
    BtnOK:X                     = (FRAME {&FRAME-NAME}:WIDTH-PIXELS / 2) 
                                - (BtnOK:WIDTH-PIXELS / 2).

  &IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN
    ASSIGN
      AboutImage:AUTO-RESIZE = TRUE
      result                 = AboutImage:LOAD-IMAGE(pIcon).

    /* Check for WebSpeed Workshop */
    RUN adeshar/_ablic.p (INPUT NO /* ShowMsgs */ , OUTPUT ABLic, OUTPUT ABTools).
    IF ABLic = 2 THEN Workshop-Only = TRUE.
    ELSE Workshop-Only = FALSE.
  &ENDIF 
  
 

 IF Workshop-Only THEN
 DO:
   ASSIGN dot          = INDEX(PROVERSION,".":U)
          majorversion = INT(SUBSTRING(PROVERSION,1,(dot - 1)))
          minorversion = SUBSTRING(PROVERSION,(dot + 1))
          ProName      = "WebSpeed Workshop ":U + 
            STRING(majorversion - 6) + ".":U + minorversion.
 END.
 ELSE
 DO:
 /* Are we running with DBE PROGRESS or not? Test the LENGTH of a value 
   * that is double byte in all 4 languages.  If the RAW LENGTH equals the 
   * character LENGTH, then either the core is not DBE, or the character 
   * set is not one of the 4...
   */
  ASSIGN
    DBEtestvalue = CHR(224) + CHR(164)

    ProName      = IF ( OPSYS <> "WIN32" OR SESSION:DISPLAY-TYPE <> "TTY" OR SESSION:BATCH)
                      AND LENGTH(DBEtestvalue,"CHARACTER":u) <>
                          LENGTH(DBEtestvalue,"RAW":u) THEN
                     "DBE OpenEdge ":u + pTitle
                   ELSE
                     "OpenEdge ":u + pTitle.
  END.
  
  /* If this is MS-WINDOWS, go out and make some WIN API calls */
  IF SESSION:WINDOW-SYSTEM BEGINS "MS-WIN":u THEN
    RUN adecomm/_winsys.p (OUTPUT Label1, OUTPUT Label2).
  ELSE
    ASSIGN
      Label1 = "Use the ""showcfg"" utility at the operating " +
               "system prompt for licensing information.".
  
  RUN Realize.
  WAIT-FOR GO OF FRAME {&FRAME-NAME}.
END.

HIDE FRAME Dialog-1.

RETURN.

/*------------- functions ------------------------------------------------------------*/
/* get the version from the string read from the version file - or return proversion */ 
function getVersion returns char (pcText as character):
     define variable cWord as character no-undo.  
     define variable i as integer no-undo.  
     do i = 1 to num-entries(pcText," "):
         cWord = entry(i,pcText," ").
         if cWord begins entry(1,PROVERSION,".") then 
             return cWord.
     end.  
     return proversion.  
end.    

/*--------------- procedures ------------------------------------------------------------*/
PROCEDURE Realize:
    
DO WITH FRAME {&FRAME-NAME}:
  DEFINE VARIABLE cCopyRight AS CHAR NO-UNDO.
  DEFINE VARIABLE cVersion   AS CHAR NO-UNDO.
  DEFINE VARIABLE cCommercialVer  AS CHAR NO-UNDO.                        
  
  &IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN
     cCopyRight = "Copyright ©".
  &ELSE
     cCopyRight = "Copyright". /* According to Legal 10/14/2009 */
  &ENDIF
  
  /* Read the commercial version from the "version" text file */
  RUN GetVersionText(OUTPUT cCommercialVer).  
  /* get the actual version from the text */
  cVersion = getVersion(cCommercialVer).
   
  AboutText1 =
    ProName + CHR(10) +

    (IF Workshop-Only
     THEN pTitle + " (Build: ":U + cVersion + ")":U 
     ELSE "Release ":U + cVersion 
    ) + CHR(10) + CHR(10) +
    (IF cCommercialVer <> "" AND cCommercialVer <> ?
     THEN cCommercialVer + CHR(10) 
     ELSE ""
    ) +
    cCopyright + " 1984-2013 Progress Software Corporation and/or its subsidiaries or affiliates. "
    + "All rights reserved.".

 IF NOT SESSION:WINDOW-SYSTEM BEGINS "TTY":u THEN
  AboutText2 = AboutText2 +
        "OpenEdge includes Infragistics NetAdvantage for .NET v2013 Vol 1. " +  
        cCopyright + " 2001-2012 Infragistics, Inc. " +  
        "All rights reserved." +
        CHR(10) + CHR(10).

  /* The Snowbound library is only used in 32-bit GUI products. */
  IF NOT SESSION:WINDOW-SYSTEM BEGINS "TTY":u AND PROCESS-ARCHITECTURE = 32 THEN
        AboutText2 = AboutText2 +
         "OpenEdge includes Imaging Technology copyrighted by Snowbound Software Corporation 1993 - 2011." + CHR(10) +
         "www.snowbound.com" +
         CHR(10) + CHR(10).

  ASSIGN AboutText1:READ-ONLY = TRUE
         AboutText1:TAB-STOP  = NO   
         AboutText1:SENSITIVE = SESSION:WINDOW-SYSTEM <> "TTY":U.
  
  &IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN
      ASSIGN
          AboutText2:READ-ONLY = TRUE
          AboutText2:TAB-STOP  = NO   
          AboutText2:SENSITIVE = SESSION:WINDOW-SYSTEM <> "TTY":U
          NO-ERROR.
  &ENDIF
  
  &IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN
  DISPLAY
    AboutText1
    AboutText2
    Label1 
    Label2 
    WITH FRAME {&FRAME-NAME}.
  &ELSE
  DISPLAY
    AboutText1
  /*  AboutText2  currently empty */
    WITH FRAME {&FRAME-NAME}.
  &ENDIF

  /* Enable everything so we can test some enabled properties */
  ENABLE btnOK WITH FRAME {&FRAME-NAME}.

  IF FRAME {&FRAME-NAME}:THREE-D THEN
    ASSIGN
      ContainerRectangle:HIDDEN = FALSE
      result                    = ContainerRectangle:MOVE-TO-BOTTOM()
      TopLine:EDGE-PIXELS       = 2
      BottomLine:EDGE-PIXELS    = TopLine:EDGE-PIXELS.
  ELSE
    ASSIGN
      ContainerRectangle:HIDDEN = TRUE
      TopLine:EDGE-PIXELS       = 1
      BottomLine:EDGE-PIXELS    = TopLine:EDGE-PIXELS.
END. /* DO WITH FRAME */

END PROCEDURE.
  
PROCEDURE GetVersionText:
  /*   Read the commercial version from the "version" text file */  
  DEFINE OUTPUT PARAMETER cText AS CHARACTER NO-UNDO.

  DEFINE VARIABLE i        AS INTEGER             NO-UNDO.
  DEFINE VARIABLE dlcValue AS CHARACTER           NO-UNDO. /* DLC */
  DEFINE VARIABLE inp      AS CHARACTER           NO-UNDO. /* hold 1st line of version file */
    
  IF OPSYS = "Win32":U THEN /* Get DLC from Registry */
    GET-KEY-VALUE SECTION "Startup":U KEY "DLC":U VALUE dlcValue.

  IF (dlcValue = "" OR dlcValue = ?) THEN DO:
    ASSIGN dlcValue = OS-GETENV("DLC":U). /* Get DLC from environment */
      IF (dlcValue = "" OR dlcValue = ?) THEN DO: /* Still nothing? */
         RETURN. 
      END.
  END.
  FILE-INFO:FILE-NAME = dlcValue + "/version":U.
  IF FILE-INFO:FULL-PATHNAME NE ? THEN DO: /* Read the version file */
    INPUT FROM VALUE(FILE-INFO:FULL-PATHNAME).
    REPEAT:
        IMPORT UNFORMATTED inp.
        ASSIGN cText = cText + inp + CHR(10).
    END.
 
    INPUT CLOSE. 
  END.         
END PROCEDURE.

&UNDEFINE FRAME-NAME

/* _about.p - end of file */
/*********************************************************************
* Copyright (C) 2000,2009 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/
/*----------------------------------------------------------------------------

File: _adeevnt.p

Description:
    This is the special file that provided hooks into the ADE.
    
    By modifying _adeevnt.p, you can intercept or filter various events
    that occur in an Application Development Environment session.  The 
    ADE tools call this routine when certain processing occurs.  Generally
    these events are file oriented (eg. OPEN, SAVE, CLOSE), but they can
    be more general (eg. UIB STARTUP or UIB SHUTDOWN).

    
Input Parameters:
    p_product : The ADE product code. (eg. "UIB" , "Editor")  
    p_event   : The name of the event (eg. "Close", "Open", "Before-Save")
    p_context : A unique context string that can be used to compare the
                object, or context, of an event. (eg. This might be a
                RECID or HANDLE of the object being closed or opened).
                NOTE: this context string will be unique for a given
                class of events in a given product, but not necessarily
                across products or events.  That is, a "UIB/Save" event  
                for a given window will always have the same context id,
                even if the name of the window changes.
   p_other    : Additional information passed about an event. (eg. a
                save event normally passes the File Name for the save).
                
Output Parameters:
    p_ok      : On a case by case basis, this procedure allows you to
                cancel various ADE events.  For example, you can return
                a FALSE here from a "UIB/Before-Save" event if you want
                to cancel the save.
   
Details on Specific Events:
   
   p_product = "UIB"
   =================
     The following events are all related to file operations. 
     p_event  
     -------  
     New            Called after a new window/dialog-box is created
                    or after a new code-block is creating in the section
                    editor.  If p_other is "_PROCEDURE", "_FUNCTION"
                    or "_CONTROL" then this call is a new code-block.
     Before-Open    Called before a file is opened
                    Returning p_ok = FALSE can cancel the open.
     Open           Called after a window has been opened
     Before-Close   Called before a window is to be closed - Returning
                    p_ok = FALSE can cancel the close.
     Close          Called after a window has been closed
     Before-Save    Called immediately before a window has been saved 
                    (but after the name for the save has been decided on).
                    Returning p_ok = FALSE can cancel the save.
     Save           Called after a window has been saved
     Before-Compile Called before a file has been compiled by the UIB.  If
                    a UIB file is "Compile on Save", this event is called
                    after the SAVE has occured. 
                    Returning p_ok = FALSE can cancel the compile.
     Compile        Called after COMPILE of file has ended.
     Before-Run     Called before a file has been written to disk for a
                    run. [p_ok = FALSE can cancel the run]
     Run            Called after RUN of file has ended.
     Before-Debug   Same as Before-Run (except Debug has been chosen).
     Debug          Same as Run (except Debug has been chosen)
                    [p_ok = FALSE can cancel the operation]
     Before-Check-Syntax  
                    Called before a Check Syntax 
                    [p_ok = FALSE can cancel the check]
     Check-Syntax   Called after a Check Syntax
     Before-Check-Syntax-Partial  
                    Called before a Check Syntax is done on 
                    part of a file from the UIB.  For example, in the Section
                    Editor, or in the Query Builder, the user can ask to have
                    only a portion of a file checked. 
                    [p_ok = FALSE can cancel the check]
     Check-Syntax-Partial   
                    Called after a partial file Check Syntax
     
     In all these cases:
       p_context - a string associated with the window/dialog-box being
                   editted in the UIB. A specific file will have the 
                   same Context number for all its NEW, OPEN, SAVE, RUN, 
                   CLOSE, etc. operations.  However, if you close a file
                   and then open it again, the context number will change.
                   (FYI - this will be based on an internal RECID).
                   If the call is for a NEW section code block, then this
                   is the RECID of the record containing the code block.
       p_other -   the current filename associated with the window.  The
                   name will be unknown (?) if it has not been set
                   (e.g. after a File/New...).  If the call to _adeevnt.p
                   if for a new section code block, then p_other is either
                   "_PROCEDURE" (for a new internal procedure), "_FUNCTION"
                   (for a new user defined function) or "_CONTROL" (for a 
                   new trigger code block.)

     The following events are related to the UIB startup and shutdown:
       p_event = "Startup"
       ===================
         Called when the UIB has been loaded and initialized.  This call
         occurs immediately before user input is allowed.  In this case:
            p_context = STRING(procedure handle of the UIB main routine)
            p_other   = STRING(widget handle of the UIB main window)
       
       p_event = "Shutdown"
       ====================
          Called when a user requests that the UIB shutdown. (But before
          and settings have been saved or items destroyed).
            p_context = STRING(procedure handle of the UIB main routine)
            p_other   = STRING(widget handle of the UIB main window)
           
      The following additional comments apply to the UIB's usage:
         1. BEFORE-CLOSE and CLOSE:  technically, p_other should be ?
            after a file has been closed.  However, it still shows the
            last available file name for the .w file.  Unknown (?) is 
            only shown if there is no file name.
         2. BEFORE-RUN, RUN, BEFORE-DEBUG, DEBUG,  BEFORE-CHECK-SYNTAX,
            CHECK-SYNTAX all use the last specified file name as p_other.
            (Technically the actual file being run or checked is a temporary 
            file with a name like p01928384.uib. This name is NOT used).
         3. If the user tries to close a window, then the UIB first asks 
            the user if a save is desired.  The entire save operation events
            fire prior to the call to BEFORE-CLOSE. 
         4. NEW is called after the window is created.  You will see the 
            window before the NEW event is called.  (Note: this is not
            unusual.  All events are called after the event has finished.  
            However, some users feel this is unusual.).
            
 The Section Editor (in the UIB)
         The UIB's Section Editor issues a Startup event the first time
         it is called and also issues a Shutdown event when it deletes
         itself during UIB exit. In both cases, here are its SCM values:

            p_product = "Section Editor"
            p_event   = "Startup" or "Shutdown"
            p_context = STRING(procedure handle of the Section Editor)
            p_other   = STRING(widget handle of the Section Editor window)

 The Procedure Window and Procedure Editor
     p_product = "Procedure Window", p_product = "Editor"
     ====================================================
     p_event
     -------
      Same as for UIB file operations:
         New 
         Before-Open 
         Open
         Close & Before-Close
         Save &  Before-Save
         Run &   Before-Run
         Debug & Before-Debug
         Check-Syntax & Before-Check-Syntax 

     In all these cases: 
     
       p_context - a string associated with the file being editted.
                   A specific file will have the same Context number for 
                   all its file operations.  However, if you close a file
                   and then open it again, the context number will change
                   for the Procedure Editor product only. The context
                   number for a Procedure Window remains the same for all
                   operations on that Procedure Window.
                   (NOTE - p_context is based on the widget handle of the
                   editor widget of the buffer).
       p_other -   the current filename associated with the window.  The
                   name will be unknown (?) if it has not been set (e.g. 
                   after a File/New...).
      
     The Procedure Editor handles p_event = "Startup" and p_event = 
     "Shutdown" and assigns p_context and p_other the same way the UIB
     does.
     
     A Procedure Window handles the "Startup" and "Shutdown" events the
     same as the UIB and Procedure Editor, but assigns p_context and
     p_other (for both events) as follows:
            p_context = STRING(Procedure Window window handle)
            p_other   = STRING(Procedure Window Parent ID)
     
     The comments related to UIB usage of _adeevnt.p also apply to the 
     Procedure Editor.

     The following additional comments apply to Procedure Window's usage:
         1. For file operations, p_context does not change for a Procedure
            Window. It is not sufficient to track whether this number has 
            changed to determine Open or Close status of a file in a 
            Procedure Window.
         2. BEFORE-RUN, RUN, BEFORE-DEBUG, DEBUG, BEFORE-CHECK-SYNTAX, 
            CHECK-SYNTAX all use the last specified file name as p_other. 
            (Technically the actual being run or checked is a temporary file 
            with a name like p123456r.ped. This name is NOT used).
         3. If the user tries to close a file, then the Procedure Window 
            first asks the user if a save is desired.  The entire save 
            operation events fire prior to the call to BEFORE-CLOSE. 
         4. NEW is called after the window is created.  You will see the
            window before the NEW event is called.

Author: D. Ross Hunter,  John Palazzo,  Wm.T.Wood

Date Created: December, 1994

Modified:
 08/10/95 gfs Added BEFORE-OPEN
 07/21/01 bsg Added changes for ICF
 09/01/01 bsg Updated ICF changes to cater for new session management.
 09/15/01 ads Updated ICF changes to cater Roundtable and correct databases.
 10/02/01 jep IZ 1981 ICF Changes - don't do a repository save for UIB, it
              does this itself now. Added repository save and save-as for
              Editor and Procedure Editor.
 11/18/01 jep IZ 2513 ICF : Remove repository save and save-as check for
              Procedure Editor and Procedure Windows.
----------------------------------------------------------------------------*/

DEFINE INPUT  PARAMETER p_product  AS CHAR    NO-UNDO.
DEFINE INPUT  PARAMETER p_event    AS CHAR    NO-UNDO.
DEFINE INPUT  PARAMETER p_context  AS CHAR    NO-UNDO.
DEFINE INPUT  PARAMETER p_other    AS CHAR    NO-UNDO.
DEFINE OUTPUT PARAMETER p_ok       AS LOGICAL NO-UNDO INITIAL TRUE.

DEFINE VARIABLE Mwindow-handle AS HANDLE NO-UNDO.
DEFINE VARIABLE lICFIsRunning AS LOGICAL NO-UNDO.

/* By default, we always return after doing nothing */

/* The following debugging code can be uncommented... */
/*
MESSAGE
  "Product:"    p_product SKIP
  "Event:"      p_event   SKIP
  "Context:"    p_context SKIP
  "Other Data:" p_other
  VIEW-AS ALERT-BOX QUESTION 
  BUTTONS OK-CANCEL
  TITLE "adecomm/_adeevnt.p"
  UPDATE p_ok.
*/

/* --- Start Roundtable section ---
 * We pass our parameters through to the Roundtable session, if
 * it exists.  Note that it IS possible for Roundtable to send
 * back NO for our p_ok.
 * -------------------------------- */
DEFINE NEW GLOBAL SHARED VARIABLE Grtb-proc-handle AS HANDLE NO-UNDO.

IF VALID-HANDLE( Grtb-proc-handle ) 
THEN RUN ade_event IN Grtb-proc-handle
     ( INPUT p_product, INPUT p_event, INPUT p_context, INPUT p_other,
       OUTPUT p_ok ).
/* --- End Roundtable section --- */

/* ICF compile hook to copy code to Appserver */
IF p_event = "compile":U
THEN DO:

  IF CONNECTED("RTB":U)
  THEN DO:
    DEFINE VARIABLE cErrorMessage AS CHARACTER NO-UNDO.
    IF SEARCH("rtb/prc/afrtbappsp.p":U) <> ?
    OR SEARCH("rtb/prc/afrtbappsp.r":U) <> ?
    THEN
      RUN rtb/prc/afrtbappsp.p (INPUT 0,                  /* RECID of rtb_object */
                                INPUT p_other,            /* object name */
                                OUTPUT cErrorMessage).
  END.

END.

IF p_event = "Startup"
AND p_product = "UIB":U
THEN DO:

  /* Check if ICF is running. */
  lICFIsRunning = DYNAMIC-FUNCTION("isICFRunning":U IN THIS-PROCEDURE) NO-ERROR.
  IF lICFIsRunning = ? THEN
    lICFIsRunning = NO.
  ERROR-STATUS:ERROR = NO.

  /* Run protools pallette */
  RUN protools/_protool.p PERSISTENT.

END.  /* If connected */

IF p_event = "Shutdown"
AND (p_product = "Desktop":U
 OR  p_product = "UIB":U
     )
THEN DO:

  /* Check if ICF is running. */
  lICFIsRunning = DYNAMIC-FUNCTION("isICFRunning":U IN THIS-PROCEDURE) NO-ERROR.
  IF   lICFIsRunning = ?
  THEN lICFIsRunning = NO.
  ERROR-STATUS:ERROR = NO.

  IF lICFIsRunning
  AND ( SEARCH("af/sup2/afshutdwnp.p") <> ?
     OR SEARCH("af/sup2/afshutdwnp.r") <> ?)
  THEN
    RUN af/sup2/afshutdwnp.p NO-ERROR.

END.

/* --- bring active window to the top --- */
IF VALID-HANDLE(ACTIVE-WINDOW) THEN 
  CURRENT-WINDOW = ACTIVE-WINDOW.

/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/
/*----------------------------------------------------------------------------

PROCEDURE:
    _adehelp.p

PURPOSE:
    Procedure to access the PROGRESS Online Help System. ADE tools run this
    this procedure to provide users with online help.

SYNTAX
    RUN adecomm/_adehelp.p
        (INPUT  p_HelpID,
         INPUT  p_HelpCommand,
         INPUT  p_ContextNumber,
         INPUT  p_SearchString).

DESCRIPTION:
    
    1. Help File ID's and ADE Tool Names
  
        For the purpose of accessing help, PROGRESS uses unique help id
        strings to identify help files. The PROGRESS ADE tool help files
        are identified this way - where the help id string is a tool name.
        For example, some tool names from the PROGRESS ADE toolset are:

            AppBuilder              :   ab
            Procedure Editor        :   edit
            Data Dictionary         :   dict
            
        In addition to the ADE tools, PROGRESS can identify other types of
        help files using a unique help id string. Some PROGRESS examples:
        
            ADM Reference Help      :   adm
            Language Reference Help :   lgrf
            Common Directory Help   :   comm
            OpenEdge Master Help    :   mast
            
        The help id string is used as part of the help file name,
        which is described in "Naming of PROGRESS Help Files" below.
        
    2. Location of PROGRESS Help Files
    
        PROGRESS help files are located in the DLC/prohelp directory.
        Dynamics help files are located in the Dynamics/prohelp directory.
        
        All help files in DLC must also exist in Dynamics, with the exception of 
        the files for which Dynamics has custom information, such as 
        icfabeng.hlp. This is necessary because the help files contain different 
        help topics (using Help .cnt Content files) and only know about the help 
        files in their own directory. If Dynamics did not have duplicate help 
        files, ADE Help would find the DLC/prohelp files, and these do not 
        contain Dynamics help topics.
        
    3. Naming of PROGRESS Help Files
        
        To support help files for different tools and multiple languages,
        PROGRESS help file names are composed of the help id (p_HelpID)
        and the first three letters of a language. _adehelp.p determines
        the language name using the 4GL CURRENT-LANGUAGE function.
        
        For example, the PROGRESS UIB English help file is uibeng.hlp and
        is located in the DLC/prohelp directory.
        
        For portability across operating system, help file names are
        lowercase.
        
        Dynamics help files have the prefix 'ic' before the help id.
        Example: icabeng.hlp.

    4. Notes for Dynamics
   
       ADE Help takes into account that Dynamics help files have the prefix 'ic' 
       before the help id. ADE Help calls from Dynamics can have just the help 
       id (like 'ab') or can have the Dynamics prefix 'ic' (like 'icab'). This 
       is because existing ADE help calls use only the help id while Dynamics 
       specific help calls may use the 'ic' prefix in front of the help id.

       Given this, if the Dynamics framework (ICF) is running, ADE help        
       examines the help id. If the prefix is not 'ic', then ADE help adds the 
       prefix and searches for a Dynamics help file. Otherwise, the help id is 
       used as is to search for the help file. For example, a newer Dynamics 
       call could have 'icab' as the help id. ADE help does not alter that 
       request, since its appropriate for Dynamics. When no 'ic' prefix is 
       passed, ADE help wants to force a search for a Dynamics help (if the 
       framework is running) and adds the prefix to search for a Dynamics 
       specific help file. If one is not found, then a search is performed for a 
       standard named help file.

       Dynamics Help files are located in Dynamics/prohelp. Dynamics help files        
       that are replacements for DLC/prohelp files begin with the prefix 'ic'. 
       For example, Dynamics/prohelp/icabeng.hlp is a replacement help file for 
       DLC/prohelp/abeng.hlp. When Dynamics is running, it's directory is 
       earlier in the Propath than the installed DLC directory. This ensures the 
       SEARCH always finds Dynamics help files before the DLC help files, 
       whether or not they are Dynamics specific or standard ADE help files.
       
       The context ids for pre-Dynamics help topics are the same in both DLC and
       Dynamics help files. The Dynamics help files introduce new help topics
       not found in the DLC help files.

INPUT PARAMETERS:
    
    p_HelpID
        A character string identifying the PROGRESS ADE tool whose help
        file you want to access.
        
    p_HelpCommand
        A character string identifying the SYSTEM-HELP command you want
        to execute.
        
        This procedure processes the following help commands:
        
            HELP    Displays the contents of the system How to Use Help
                    file.
            
            CONTEXT Displays the help topic that the context number parameter
                    p_ContextNumber identifies.
                    
            CONTENTS
                    Displays the help contents help screen for the specified
                    ADE tool.

            TOPICS  Displays the Help Topics dialog box for the specified
                    ADE tool.

            KEY     Displays the help topic matching the p_SearchString
                    string found in the help file's keyword list. If there
                    is more than one match, it displays the first topic
                    containing the keyword. If there is no match or the
                    string is omitted, a message is displayed indicating
                    that the keyword is invalid.

            PARTIAL-KEY
                    Displays the help topic matching the p_SearchString
                    string found in the help file's keyword list. If there
                    is more than one match, no match, or if the string is
                    omitted, it displays the Search dialog box.

            QUIT    Informs the help application that help is no longer
                    required.
                    
            GET-HELPFILE
                    Instructs procedure to determine the full pathname to the
                    help file based on the help id. Value is returned using
                    the RETURN statement.
        

    p_ContextNumber
        An integer identifying the SYSTEM-HELP context number. It identifies
        a unique help topic within a help file.

        If called with a p_ContextNumber = ? using p_HelpCommand = CONTEXT,
        an alert-box message is displayed indicating an invalid value.

    p_SearchString
        A character string identifying a keyword or partial keyword in a
        desired help file.
        
        If called with p_SearchString = ? using p_HelpCommand = KEY or
        PARTIAL-KEY, an alert-box message is displayed indicating an
        invalid value.

    
OUTPUT PARAMETERS:
    None
   
SEE ALSO
    See the PROGRESS SYSTEM-HELP Statement in the Language Reference
    manual or online help for more information.
    
    The _kwhelp.p procedure invokes PROGRESS Online Language Reference Help
    to search for keyword help on code selected in an editor widget. You
    can view this file in DLC/src/adecomm.

   
AUTHORS     : Ravi Ramalingam
DATE CREATED: April, 1993
LAST UPDATED: September, 1999 - J. Palazzo
                Added command support for GET-HELPFILE.              
              June 12, 2003 - D. McMann
                Added support for V10 to find chm files(html) instead of hlp files
                (Winhelp)
              Jan, 2012 - Rajinder Kamboj 
              Added support to run help with integrated app builder for PDS.
----------------------------------------------------------------------------*/

DEFINE INPUT PARAMETER p_HelpID        AS CHARACTER NO-UNDO.
DEFINE INPUT PARAMETER p_HelpCommand   AS CHARACTER NO-UNDO.
DEFINE INPUT PARAMETER p_ContextNumber AS INTEGER   NO-UNDO.
DEFINE INPUT PARAMETER p_SearchString  AS CHARACTER NO-UNDO.

DEFINE VARIABLE HelpFileDir           AS CHARACTER INITIAL "prohelp/":u NO-UNDO.
DEFINE VARIABLE HelpFileName          AS CHARACTER NO-UNDO.
DEFINE VARIABLE HelpFileFullName      AS CHARACTER NO-UNDO.
DEFINE VARIABLE LanguageExtension     AS CHARACTER INITIAL "eng":u NO-UNDO.
DEFINE VARIABLE lIsICFRunning         AS LOGICAL   NO-UNDO.
DEFINE VARIABLE ICFPrefix             AS CHARACTER INITIAL "ic":u NO-UNDO.
DEFINE VARIABLE iVersion              AS INTEGER   NO-UNDO.

/* UIB Shared Variables and Common Definitions */
{adecomm/oeideservice.i}

/*{adeuib/sharvars.i}                  */
/*{adeuib/uniwidg.i}                   */

DO ON STOP UNDO, LEAVE ON ERROR UNDO, LEAVE ON ENDKEY UNDO, LEAVE:
  IF OEIDEIsRunning THEN
  DO:
      
      DEFINE VARIABLE cResult      AS CHARACTER   NO-UNDO.
      DEFINE VARIABLE newContextNumber AS CHARACTER NO-UNDO.

      /* Use lower case for consistent casing */
      ASSIGN newContextNumber = lc(p_HelpID) + string(p_ContextNumber).

      IF newContextNumber <> ? then
      do:
          /** return if help was found in Eclipse other wise continue and use help here */
          if checkHelp(newContextNumber) then
          do:
              showHelp(newContextNumber).
              return. 
          end.
      end.
  END.
  
  IF SESSION:DISPLAY-TYPE = "TTY":U THEN
  DO ON STOP UNDO, RETURN ON ERROR UNDO, RETURN ON ENDKEY UNDO, RETURN:
    IF p_HelpCommand <> "QUIT":u THEN BELL.

    RETURN.
  END.

  /* Help on Help is a special case. */
  IF p_HelpCommand = "HELP":u THEN
  DO:
    SYSTEM-HELP "" HELP.
    RETURN.
  END.
  
  /* Determine Language Extension */
  IF CURRENT-LANGUAGE <> "?" THEN
      ASSIGN LanguageExtension = 
             LC(SUBSTRING(CURRENT-LANGUAGE,1,3,"CHARACTER":u)).
  
  /* Be sure case of help id is lower. Its used as part of OS file name. */
  ASSIGN p_HelpID = LC( p_HelpID )
         iVersion = INTEGER(ENTRY(1,PROVERSION,".":U)) 
         NO-ERROR.
         
  IF iVersion > 9 THEN
    ASSIGN HelpFileName     = HelpFileDir +  
                              p_HelpID + LanguageExtension + ".chm":u
           HelpFileFullName = SEARCH(HelpFileName).
  ELSE
    ASSIGN HelpFileName     = HelpFileDir +  
                              p_HelpID + LanguageExtension + ".hlp":u
           HelpFileFullName = SEARCH(HelpFileName).
       
          
  /* IZ 3056 If ICF is running and the help id doesn't begin with 'ic', force
     a search for an 'ic' help file of the same name. This enables
     existing tool calls that don't pass the 'ic' string to still
     find icf help files if they exist for that tool. Otherwise,
     the help id is taken as is and the search continues unchanged. */
  ASSIGN lIsICFRunning = DYNAMIC-FUNCTION("IsICFRunning":U) NO-ERROR.
  ASSIGN lIsICFRunning = (lIsICFRunning = YES) NO-ERROR.
  IF lIsICFRunning AND NOT p_helpID BEGINS ICFPrefix THEN
  DO:
    /* Add the ICF prefix to determine the name. */
    IF iVersion > 9 THEN
      ASSIGN HelpFileName     = HelpFileDir + ICFPrefix + p_HelpID + LanguageExtension + ".chm":u
             HelpFileFullName = SEARCH(HelpFileName).
    ELSE
      ASSIGN HelpFileName     = HelpFileDir + ICFPrefix + p_HelpID + LanguageExtension + ".hlp":u
             HelpFileFullName = SEARCH(HelpFileName).
    /* If an icf help file is found, change the ID to add the 'ic' prefix. */
    IF (HelpFileFullName <> ?) THEN
      ASSIGN p_HelpID = ICFPrefix + p_HelpID.
    /* If the help file full name is unknown, the prefix is not added and
       ADE Help searches using the passed help id in the ASSIGN below. */
  END.
 
  /* Determine the help file name and full path. */
  IF iVersion  > 9 THEN
     ASSIGN HelpFileName     = HelpFileDir +  
                               p_HelpID + LanguageExtension + ".chm":u
            HelpFileFullName = SEARCH(HelpFileName).
  ELSE
     ASSIGN HelpFileName     = HelpFileDir +  
                               p_HelpID + LanguageExtension + ".hlp":u
            HelpFileFullName = SEARCH(HelpFileName).
 

  IF HelpFileFullName = ? THEN
  DO: /* Assign default help file name. */
    IF iVersion > 9 THEN
      ASSIGN HelpFileName     = HelpFileDir + p_HelpID + "eng":u + ".chm":u
             HelpFileFullName = SEARCH(HelpFileName).
    ELSE
      ASSIGN HelpFileName     = HelpFileDir + p_HelpID + "eng":u + ".hlp":u
             HelpFileFullName = SEARCH(HelpFileName).
  END.

  /* If just requesting the help file name, return now. */
  IF p_HelpCommand = "GET-HELPFILE":u THEN
  DO:
    RETURN HelpFileFullName.
  END.
    
  /* Still unable to locate the help file, inform the user. */
  IF HelpFileFullName = ? THEN
  DO ON STOP UNDO, RETURN:
    /* If QUIT/Closing Help Window, no need to inform user. Its annoying. */
    IF p_HelpCommand <> "QUIT":u THEN
        MESSAGE "Unable to locate help file """ + HelpFileName + """."
                VIEW-AS ALERT-BOX INFORMATION BUTTONS OK.
    RETURN.
  END.
 
  CASE p_HelpCommand:
    WHEN "CONTENTS":u THEN
    DO:
      SYSTEM-HELP HelpFileFullName CONTENTS.
    END.
  
    WHEN "TOPICS":u THEN
    DO:
      IF iVersion > 9 THEN
        SYSTEM-HELP HelpFileFullName CONTENTS.
      ELSE
        SYSTEM-HELP HelpFileFullName FINDER.
    END.

    WHEN "CONTEXT":u THEN
    DO ON STOP UNDO, LEAVE:
      IF p_ContextNumber = ? THEN
        MESSAGE "Unknown context number ""?""."
           VIEW-AS ALERT-BOX INFORMATION BUTTONS OK.
      ELSE
        SYSTEM-HELP HelpFileFullName CONTEXT p_ContextNumber.
    END.
  
    WHEN "KEY":u THEN
    DO ON STOP UNDO, LEAVE:
      IF p_SearchString = ? THEN
        MESSAGE "Unknown key ""?""."
           VIEW-AS ALERT-BOX INFORMATION BUTTONS OK.
      ELSE
        SYSTEM-HELP HelpFileFullName KEY p_SearchString.
    END.
  
    WHEN "PARTIAL-KEY":u THEN
    DO ON STOP UNDO, LEAVE:
      IF p_SearchString = ? THEN
        MESSAGE "Unknown partial key ""?""."
           VIEW-AS ALERT-BOX INFORMATION BUTTONS OK.
      ELSE DO:
       IF iVersion > 9 THEN
          SYSTEM-HELP HelpFileFullName ALTERNATE-KEY p_SearchString.
       ELSE
        SYSTEM-HELP HelpFileFullName PARTIAL-KEY p_SearchString.
      END.
    END.
  
    WHEN "QUIT":u THEN
    DO:
      SYSTEM-HELP HelpFileFullName QUIT.
    END.
  
    OTHERWISE
      MESSAGE "Unsupported help command """ + CAPS(p_HelpCommand) + """."
        VIEW-AS ALERT-BOX INFORMATION BUTTONS OK.
  END CASE.
  
END. /* DO */
/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/
/*----------------------------------------------------------------------------

File: _adeload.p

Description:
         Reads the default values for the standard colors and fonts to be used by all
         ADE applications.  Those colors are found in adestds.i.
         Also sets the Windows ALT-TAB icon. (jep - 10/29/98)
         
Author: Wm.T.Wood + Ravi-Chandar Ramalingam

Date Created: January 14, 1993
Modified    : 10/29/98 jep - Added SESSION:LOAD-ICON code for ALT-TAB icon.
----------------------------------------------------------------------------*/


{ adecomm/adestds.i }
&IF DEFINED(ADEICONDIR) = 0 &THEN
 {adecomm/icondir.i}
&ENDIF

  DEFINE VAR color-count   AS INTEGER        NO-UNDO.
  DEFINE VAR v       AS CHAR           NO-UNDO.
  
  /* MESSAGE "Defining Fonts and Colors!"
        VIEW-AS ALERT-BOX INFORMATION BUTTONS OK. */

 initialized_adestds = yes.

 /* Set the ALT-TAB icon for the session. */
 SESSION:LOAD-ICON({&ADEICON-DIR} + "progress.ico":U) NO-ERROR.

 /* Set the ADE default fonts - we are using 3 fonts (FONT 0 to 2) for sure. */
 /* We also recommend that the first 8 fonts exist (see PROGRESS.INI file    */
 /* for further documentation.                                               */

 /* Set up the fonts for the ADE environment                 */
 IF FONT-TABLE:NUM-ENTRIES < 8 THEN FONT-TABLE:NUM-ENTRIES = 8.

 /* Get each ADE font from the INI file and make sure it is valid. */
 GET-KEY-VALUE SECTION "ProADE" KEY "FixedFont" VALUE v.
 CASE v:
        WHEN "DEFAULT" THEN  fixed_font = ?.
        WHEN ?         THEN fixed_font = 0.
        OTHERWISE DO:
          ASSIGN fixed_font = INTEGER(v) NO-ERROR.
          IF ERROR-STATUS:ERROR THEN fixed_font = 0.
        END.
  END CASE.  

 GET-KEY-VALUE SECTION "ProADE" KEY "StandardFont" VALUE v.
 CASE v:
        WHEN "DEFAULT" THEN std_font = ?.
        WHEN ?          THEN std_font = 1.
        OTHERWISE DO:
          ASSIGN std_font = INTEGER(v) NO-ERROR.
          IF ERROR-STATUS:ERROR THEN std_font = 1.
        END.
  END CASE.  

    GET-KEY-VALUE SECTION "ProADE" KEY "Editor4GLFont" VALUE v.
    CASE v:
        WHEN "DEFAULT" THEN editor_font = ?.
        WHEN ?         THEN editor_font = 2.
        OTHERWISE DO:
            ASSIGN editor_font = INTEGER(v) NO-ERROR.
            IF ERROR-STATUS:ERROR THEN editor_font = 2.
        END.
     END CASE.  

    GET-KEY-VALUE SECTION "ProADE" KEY "EditorTabStop" VALUE v.
    CASE v:
        WHEN ?         THEN editor_tab = 4.
        OTHERWISE DO:
            ASSIGN editor_tab = INTEGER(v) NO-ERROR.
            IF ERROR-STATUS:ERROR THEN editor_tab = 4.
        END.
     END CASE.  

    /* Set up the colors for the ADE environment                 */
    IF COLOR-TABLE:NUM-ENTRIES < 16 THEN COLOR-TABLE:NUM-ENTRIES = 16.

    /* Get each ADE color from the INI file and make sure it is valid. */

    GET-KEY-VALUE SECTION "ProADE" KEY "DividerFgColor" VALUE v.
    CASE v:
        WHEN "DEFAULT" THEN std_div_fgcolor = ?.
        WHEN ?         THEN std_div_fgcolor = 15.
        OTHERWISE DO:
            ASSIGN std_div_fgcolor = INTEGER(v) NO-ERROR.
            IF ERROR-STATUS:ERROR THEN std_div_fgcolor = 15.
        END.
    END CASE.
    GET-KEY-VALUE SECTION "ProADE" KEY "DividerBgColor" VALUE v.
    CASE v:
        WHEN "DEFAULT" THEN std_div_bgcolor = ?.
        WHEN ?         THEN std_div_bgcolor = 1.
        OTHERWISE DO:
            ASSIGN std_div_bgcolor = INTEGER(v) NO-ERROR.
            IF ERROR-STATUS:ERROR THEN std_div_bgcolor = 1.
        END.
    END CASE.  

    GET-KEY-VALUE SECTION "ProADE" KEY "OKBoxFgColor" VALUE v.
    CASE v:
        WHEN "DEFAULT" THEN std_okbox_fgcolor = ?.
        WHEN ?         THEN std_okbox_fgcolor = 1.
        OTHERWISE DO:
            ASSIGN std_okbox_fgcolor = INTEGER(v) NO-ERROR.
            IF ERROR-STATUS:ERROR THEN std_okbox_fgcolor = 1.
        END.
    END CASE.
    GET-KEY-VALUE SECTION "ProADE" KEY "OKBoxBgColor" VALUE v.
    CASE v:
        WHEN "DEFAULT" THEN std_okbox_bgcolor = ?.
        WHEN ?         THEN std_okbox_bgcolor = 8.
        OTHERWISE DO:
            ASSIGN std_okbox_bgcolor = INTEGER(v) NO-ERROR.
            IF ERROR-STATUS:ERROR THEN std_okbox_bgcolor = 8.
        END.
    END CASE.  

    GET-KEY-VALUE SECTION "ProADE" KEY "FillinFgColor" VALUE v.
    CASE v:
        WHEN "DEFAULT" THEN std_fillin_fgcolor = ?.
        WHEN ?         THEN std_fillin_fgcolor = 0.
        OTHERWISE DO:
            ASSIGN std_fillin_fgcolor = INTEGER(v) NO-ERROR.
            IF ERROR-STATUS:ERROR THEN std_fillin_fgcolor = 0.
        END.
    END CASE.
    GET-KEY-VALUE SECTION "ProADE" KEY "FillinBgColor" VALUE v.
    CASE v:
        WHEN "DEFAULT" THEN std_fillin_bgcolor = ?.
        WHEN ?         THEN std_fillin_bgcolor = 8.
        OTHERWISE DO:
            ASSIGN std_fillin_bgcolor = INTEGER(v) NO-ERROR.
            IF ERROR-STATUS:ERROR THEN std_fillin_bgcolor = 8.
        END.
    END CASE.

    GET-KEY-VALUE SECTION "ProADE" KEY "Editor4GLFgColor" VALUE v.
    CASE v:
        WHEN "DEFAULT" THEN std_ed4gl_fgcolor = ?.
        WHEN ?         THEN std_ed4gl_fgcolor = ?.
        OTHERWISE DO:
            ASSIGN std_ed4gl_fgcolor = INTEGER(v) NO-ERROR.
            IF ERROR-STATUS:ERROR THEN std_ed4gl_fgcolor = ?.
        END.
    END CASE.
    GET-KEY-VALUE SECTION "ProADE" KEY "Editor4GLBgColor" VALUE v.
    CASE v:
        WHEN "DEFAULT" THEN std_ed4gl_bgcolor = ?.
        WHEN ?         THEN std_ed4gl_bgcolor = ?.
        OTHERWISE DO:
            ASSIGN std_ed4gl_bgcolor = INTEGER(v) NO-ERROR.
            IF ERROR-STATUS:ERROR THEN std_ed4gl_bgcolor = ?.
        END.
    END CASE.

    GET-KEY-VALUE SECTION "ProADE" KEY "Editor4GLSmallFgColor" VALUE v.
    CASE v:
        WHEN "DEFAULT" THEN std_ed4gl_small_fgcolor = ?.
        WHEN ?         THEN std_ed4gl_small_fgcolor = 0.
        OTHERWISE DO:
            ASSIGN std_ed4gl_small_fgcolor = INTEGER(v) NO-ERROR.
            IF ERROR-STATUS:ERROR THEN std_ed4gl_small_fgcolor = 0.
        END.
    END CASE.
    GET-KEY-VALUE SECTION "ProADE" KEY "Editor4GLSmallBgColor" VALUE v.
    CASE v:
        WHEN "DEFAULT" THEN std_ed4gl_small_bgcolor = ?.
        WHEN ?         THEN std_ed4gl_small_bgcolor = 8.
        OTHERWISE DO:
            ASSIGN std_ed4gl_small_bgcolor = INTEGER(v) NO-ERROR.
            IF ERROR-STATUS:ERROR THEN std_ed4gl_small_bgcolor = 8.
        END.
    END CASE.



/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/**************************************************************************
    Procedure:  _adeobj.p
    
    Purpose:    Run a Persistent PROGRESS ADE Object.

    Syntax :    
                RUN adecomm/_adeobj.p ( INPUT        p_Object_Name ,
                                        INPUT-OUTPUT p_hObject ) .

    Parameters:
        INPUT
            p_Object_Name - String Identifying the ADE Object to run.
        INPUT-OUTPUT    
            p_hObject - Persistent Procedure Handle of the requested object.
                            
    Description:
        1. Given an ADE Object Name p_Object_Name, identify the procedure
           run reference for that object.
        2. If caller passes the correct handle for the object, treat
           that as a query and return right away.  We just assume the
           caller was not aware they had the right handle.
        3. Trace the Persistent Procedure chain starting with SESSION:
           FIRST-PROCEDURE looking for a Persistent procedure with the
           identified file name.
        4. If match is found, returns that procedures handle via p_hObject.
        5. If no match, runs the specified file name.
        
    Notes  :
    Authors: John Palazzo
    Date   : February, 1995
    Updated: April, 1995   jep - made p_hObject INPUT-OUTPUT
**************************************************************************/

DEFINE INPUT        PARAMETER p_Object_Name   AS CHARACTER    NO-UNDO.
DEFINE INPUT-OUTPUT PARAMETER p_hObject       AS HANDLE       NO-UNDO.

DEFINE VARIABLE Object_List AS CHARACTER    NO-UNDO .
DEFINE VARIABLE Run_List    AS CHARACTER    NO-UNDO .
DEFINE VARIABLE Obj_Run     AS CHARACTER    NO-UNDO .

/* MAIN */
DO:
    ASSIGN Object_List  = 
               "CONTAINER-API,LIB-MGR,WINMENU-MGR"
           Run_List     = 
               "adeshar/_cntrapi.p,adeshar/_mlmgr.p,adecomm/_winmenu.w"
           . /* END ASSIGN */
           
    ASSIGN Obj_Run = ENTRY( LOOKUP( p_Object_Name , Object_List ) , Run_List )
                     NO-ERROR.
    
    /* If the caller already has the correct handle to the object it
       wants, then return now.
    */
    IF VALID-HANDLE(p_hObject) AND (p_hObject:FILE-NAME = Obj_Run) THEN RETURN. 

    /* Otherwise, find the handle or dispatch the object. */
    RUN Dispatch_Object ( INPUT Obj_Run , OUTPUT p_hObject ).
    
    RETURN.
END.
/* MAIN */


PROCEDURE Dispatch_Object .

  DEFINE INPUT  PARAMETER p_File_Name       AS CHARACTER    NO-UNDO.
  DEFINE OUTPUT PARAMETER p_hObject         AS HANDLE       NO-UNDO.
  
  ASSIGN p_hObject = SESSION:FIRST-PROCEDURE.

  DO WHILE VALID-HANDLE( p_hObject ) AND
           ( p_hObject:FILE-NAME <> p_File_Name ):
    ASSIGN p_hObject = p_hObject:NEXT-SIBLING.
  END.
  
  IF NOT VALID-HANDLE( p_hObject ) THEN
    RUN VALUE( p_File_Name ) PERSISTENT SET p_hObject .
    
  RETURN.
  
END PROCEDURE.
/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/**************************************************************************
    Procedure:  _adetool.i
                                       
    Purpose:    Defines an internal procedure called 'ADEPersistent'. This
                should be included in any Persistent procedure which you do
                not want to be automatically deleted by any ADE tools (e.g.
                Editor, UIB). The program _runtool.p will check for the
                existence of ADEPersistent in a procedure and will delete
                it only if it doesn't exist.

    Syntax :    {adecomm/_adetool.i}

    Parameters: None
        
    Description:
    Notes  :
    Authors: Gerry Seidl
    Date   : 1/18/95
**************************************************************************/
PROCEDURE ADEPersistent:
    RETURN "OK".
END.
&ANALYZE-SUSPEND _VERSION-NUMBER UIB_v9r12
/* Procedure Description
"This procedure is the companion program to the ASInfo PRO*Tool. It runs on the AppServer and reads session information to return back to the caller."
*/
&ANALYZE-RESUME
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _DEFINITIONS Procedure 
/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/
/*------------------------------------------------------------------------
    File        : adecomm/_asread.p
    Purpose     : AppServer session information reader for the
                  ASInfo PRO*Tool

    Syntax      : 

    Description : This procedure must be located where the AppServer
                  can run it.

    Author(s)   : Gerry Seidl
    Created     : 11/19/98
    Notes       : This procedure is run from the ASInfo PRO*Tool
  ----------------------------------------------------------------------*/
/*          This .W file was created with the Progress AppBuilder.      */
/*----------------------------------------------------------------------*/

/* ***************************  Definitions  ************************** */

/* Define parameters */
DEFINE OUTPUT PARAMETER connid   AS CHARACTER NO-UNDO. /* SESSION:SERVER-CONNECTION-ID */
DEFINE OUTPUT PARAMETER opmode   AS CHARACTER NO-UNDO. /* SESSION:SERVER-OPERATING-MODE */
DEFINE OUTPUT PARAMETER connreq  AS LOGICAL   NO-UNDO. /* SESSION:SERVER-CONNECTION-BOUND-REQUEST */
DEFINE OUTPUT PARAMETER connbnd  AS LOGICAL   NO-UNDO. /* SESSION:SERVER-CONNECTION-BOUND */
DEFINE OUTPUT PARAMETER connctxt AS CHARACTER NO-UNDO. /* SESSION:SERVER-CONNECTION-CONTEXT */
DEFINE OUTPUT PARAMETER ASppath  AS CHARACTER NO-UNDO. /* PROPATH */
DEFINE OUTPUT PARAMETER conndbs  AS CHARACTER NO-UNDO. /* List of Databases */
DEFINE OUTPUT PARAMETER connpps  AS CHARACTER NO-UNDO. /* List of Running Persistent Procedures */

/* Define local variables */
DEFINE VARIABLE i   AS INTEGER NO-UNDO. /* Generic counter */
DEFINE VARIABLE hAS AS HANDLE  NO-UNDO. /* AppServer connection handle */

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME


&ANALYZE-SUSPEND _UIB-PREPROCESSOR-BLOCK 

/* ********************  Preprocessor Definitions  ******************** */

&Scoped-define PROCEDURE-TYPE Procedure
&Scoped-define DB-AWARE no



/* _UIB-PREPROCESSOR-BLOCK-END */
&ANALYZE-RESUME



/* *********************** Procedure Settings ************************ */

&ANALYZE-SUSPEND _PROCEDURE-SETTINGS
/* Settings for THIS-PROCEDURE
   Type: Procedure
   Allow: 
   Frames: 0
   Add Fields to: Neither
   Other Settings: CODE-ONLY COMPILE
 */
&ANALYZE-RESUME _END-PROCEDURE-SETTINGS

/* *************************  Create Window  ************************** */

&ANALYZE-SUSPEND _CREATE-WINDOW
/* DESIGN Window definition (used by the UIB) 
  CREATE WINDOW Procedure ASSIGN
         HEIGHT             = 15
         WIDTH              = 60.
/* END WINDOW DEFINITION */
                                                                        */
&ANALYZE-RESUME

 


&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _MAIN-BLOCK Procedure 


/* ***************************  Main Block  *************************** */

/* Read SESSION data */
ASSIGN 
  connid   = SESSION:SERVER-CONNECTION-ID
  opmode   = SESSION:SERVER-OPERATING-MODE
  connreq  = SESSION:SERVER-CONNECTION-BOUND-REQUEST
  connbnd  = SESSION:SERVER-CONNECTION-BOUND
  connctxt = SESSION:SERVER-CONNECTION-CONTEXT
  ASppath  = PROPATH
  .
  
/* Generate list of connected databases */
IF NUM-DBS > 0 THEN 
DO i = 1 TO NUM-DBS:
  ASSIGN conndbs = conndbs + (IF conndbs NE "" THEN ",":U ELSE "") + LDBNAME(i) + " (":U + PDBNAME(i) + ")":U.
END.

/* Generate a list of running persistent procedures */
hAS = SESSION:FIRST-PROCEDURE.
DO WHILE hAS <> ?:
  IF hAS:PERSISTENT THEN
    ASSIGN connpps = connpps + (IF connpps NE "" THEN ",":U ELSE "") + hAS:FILE-NAME.
  hAS = hAS:NEXT-SIBLING.
END.

/*MESSAGE
 *   connid skip opmode skip connreq skip connbnd skip connctxt skip asppath skip
 *   conndbs skip connpps 
 *   VIEW-AS ALERT-BOX.*/
  
RETURN.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME


&ANALYZE-SUSPEND _VERSION-NUMBER UIB_v8r11
&ANALYZE-RESUME
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _DEFINITIONS Procedure 
/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/
/*--------------------------------------------------------------------------
    File        : _bldfld.w
    Purpose     : This procedure builds a set of _tt-fld temp-table records
                  with the names of the fields that can be selected for a given
                  temp-table. The name of the actual (the real db table) is in
                  p_table and the _tt-tbl record that is the parent of the
                  _tt-fld records created in this procedure has a RECID of
                  p_tt-rec.

    Syntax      : RUN adecomm/_bldfld.w (INPUT p_tt-rec, INPUT p_table).

    Description :

    Author(s)   : D. Ross Hunter
    Created     : 11/05/96
    Notes       :
  ------------------------------------------------------------------------*/
/*          This .W file was created with the Progress UIB.             */
/*----------------------------------------------------------------------*/

/* ***************************  Definitions  ************************** */
DEFINE INPUT PARAMETER p_tt-rec AS RECID                            NO-UNDO.
DEFINE INPUT PARAMETER p_table  AS CHARACTER                        NO-UNDO.

{adecomm/tt-brws.i}

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME


&ANALYZE-SUSPEND _UIB-PREPROCESSOR-BLOCK 

/* ********************  Preprocessor Definitions  ******************** */

&Scoped-define PROCEDURE-TYPE Procedure
&Scoped-define DB-AWARE no



/* _UIB-PREPROCESSOR-BLOCK-END */
&ANALYZE-RESUME



/* *********************** Procedure Settings ************************ */

&ANALYZE-SUSPEND _PROCEDURE-SETTINGS
/* Settings for THIS-PROCEDURE
   Type: Procedure
   Allow: 
   Frames: 0
   Add Fields to: Neither
   Other Settings: CODE-ONLY COMPILE
 */
&ANALYZE-RESUME _END-PROCEDURE-SETTINGS

/* *************************  Create Window  ************************** */

&ANALYZE-SUSPEND _CREATE-WINDOW
/* DESIGN Window definition (used by the UIB) 
  CREATE WINDOW Procedure ASSIGN
         HEIGHT             = 2
         WIDTH              = 40.
/* END WINDOW DEFINITION */
                                                                        */
&ANALYZE-RESUME

 


&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _MAIN-BLOCK Procedure 


/* ***************************  Main Block  *************************** */
IF INTEGER(DBVERSION("DICTDB":U)) > 8 THEN
  FIND DICTDB._File WHERE DICTDB._FILE._FILE-NAME = "_Field":U AND
                    LOOKUP(DICTDB._FILE._OWNER,"PUB,_FOREIGN":U) > 0 NO-LOCK.
ELSE
  FIND DICTDB._File WHERE DICTDB._FILE._FILE-NAME = "_Field":U NO-LOCK.

IF NOT CAN-DO(DICTDB._File._Can-Read, USERID("DICTDB":U)) THEN DO:
  MESSAGE "You do not have permission to see any field information.":t
    VIEW-AS ALERT-BOX ERROR BUTTONS OK.
  RETURN.
END.

IF INTEGER(DBVERSION("DICTDB":U)) > 8 THEN
  FIND DICTDB._File WHERE DICTDB._FILE._FILE-NAME = p_table AND
                         LOOKUP(DICTDB._FILE._OWNER,"PUB,_FOREIGN":U) > 0 NO-LOCK.
ELSE
  FIND DICTDB._File WHERE DICTDB._FILE._FILE-NAME = p_table NO-LOCK.

FOR EACH _FIELD OF DICTDB._FILE NO-LOCK:
  DO TRANSACTION:
    CREATE _tt-fld.
    ASSIGN _tt-fld.tt-fld   = _FIELD._FIELD-NAME
           _tt-fld.tt-recid = p_tt-rec.
    IF _FIELD._EXTENT > 0 THEN
      _tt-fld.tt-fld = _tt-fld.tt-fld + "[1-" + STRING(_FIELD._EXTENT) + "]".
  END.
END.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME


&ANALYZE-SUSPEND _VERSION-NUMBER WDT_v2r12 Procedure
&ANALYZE-RESUME
&ANALYZE-SUSPEND _CODE-BLOCK _CUSTOM "Main Code Block" 
/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/
/*----------------------------------------------------------------------------
File: _bstfnam.p

Description:
    Generate the "best" filename for a wizard file.

    See if the suggested file exists.  If not, keep adding 1, 2, 3, etc
    until a unique name is NOT found on disk.

Input Parameter:
   p_suggestion - base name with &1 used where the number will go.

Output Parameter:
   p_name       - The final name.

Author: Wm.T.Wood

Date Created: May 1997
----------------------------------------------------------------------------*/
/*            This file was created with WebSpeed Workshop.                 */
/*--------------------------------------------------------------------------*/
DEFINE INPUT  PARAMETER p_suggestion AS CHAR NO-UNDO.
DEFINE OUTPUT PARAMETER p_name       AS CHAR NO-UNDO.

/* Local Definitions --                                                */
DEF VAR i AS INTEGER NO-UNDO.

/* ************************ Main Code Block ************************** */

/* Initialize the name to the suggestion. */
p_name = SUBSTITUTE(p_suggestion, "":U).

/* ERROR CHECK: If p_suggestion did not contain &1, make sure it does.
   Otherwise we will look forever. */
IF p_name eq p_suggestion THEN p_suggestion = p_suggestion + "~&1":U.

/* Find a sample file name that does not exist. */
DO WHILE SEARCH(p_name) ne ?:
  ASSIGN i = i + 1
         p_name = SUBSTITUTE(p_suggestion, i).
END.
&ANALYZE-RESUME
/* *********************** Procedure Settings ************************ */

&ANALYZE-SUSPEND _PROCEDURE-SETTINGS
/* Settings for THIS-PROCEDURE
   Other Settings: COMPILE
 */
&ANALYZE-RESUME _END-PROCEDURE-SETTINGS
/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/
/*----------------------------------------------------------------------------

File: _chkfmt.i

Description:
This function validates the format of a given field.

Input Parameters:
	fd-tp  - The type of the field 
                  1 - char
		  2 - date
		  3 - logical
		  4 - other (integer or decimal)
                 34 - datetime
                 40 - datetime-tz
	fd-nm  - The field Name
	lbl    - The field label
   	fmt    - The field format to check

Output Parameters:
	fld-wdth - The width of the field
	lError   - TRUE if there is an error.

Author:   R. Hunter, G. O'Connor

Date Created: June 24, 1993

----------------------------------------------------------------------------*/
DEFINE INPUT  PARAMETER fd-tp     AS INTEGER   NO-UNDO.
DEFINE INPUT  PARAMETER fd-nm     AS CHARACTER NO-UNDO.
DEFINE INPUT  PARAMETER lbl       AS CHARACTER NO-UNDO.
DEFINE INPUT  PARAMETER fmt       AS CHARACTER NO-UNDO.
DEFINE OUTPUT PARAMETER fld-wdth  AS INTEGER   NO-UNDO.
DEFINE OUTPUT PARAMETER lError    AS LOGICAL   NO-UNDO.

DEFINE VARIABLE sError AS CHARACTER NO-UNDO.

/* The field width is the maximum of label-width and format width */
/* ksu 02/24/94 LENGTH use raw mode */
ASSIGN 
  fld-wdth = MAXIMUM(LENGTH(lbl, "RAW":U), 
               IF      fd-tp = 1 THEN LENGTH(STRING("A",fmt), "RAW":U)
               ELSE IF fd-tp = 2 THEN LENGTH(STRING(TODAY,fmt), "RAW":U)
               ELSE IF fd-tp = 34 THEN LENGTH(STRING(NOW,fmt), "RAW":U)
               ELSE IF fd-tp = 40 THEN LENGTH(STRING(NOW,fmt), "RAW":U)
               ELSE IF fd-tp = 3 THEN MAXIMUM(LENGTH(STRING(YES,fmt), "RAW":U),
                                              LENGTH(STRING(NO,fmt), "RAW":U))
               ELSE LENGTH(STRING(0,fmt), "RAW":U))
  lError   = FALSE
  NO-ERROR.

IF (ERROR-STATUS:ERROR) THEN DO:
  ASSIGN
    sError = REPLACE(ERROR-STATUS:GET-MESSAGE(1),"** ":u,"")
    sError = SUBSTRING(sError,1,INDEX(sError,".":u),"CHARACTER":u)
    lError = TRUE
    .

  IF (fd-nm > "") THEN
    MESSAGE sError SKIP
       """" + fmt + """ is not a valid format for" fd-nm + "." SKIP
       IF fd-tp = 1 THEN "The format of a character field should use X, N, A, !, " +
                        "or 9 and be followed of (n) to indicate n more of a prevous " +
                        "format character."
       ELSE IF fd-tp = 2 THEN "The format of a date field should use 9's to " +
                              "represent the month, day, and year separated by " +
                              "a /, -, or . "
       ELSE IF fd-tp = 34 THEN "The format of a datetime field should use 9's to " +
                              "represent the month, day, and year separated by " +
                              "a /, -, or . and it should use 9's to represent " +
                              "the hours, minutes, and seconds separated by :  "
       ELSE IF fd-tp = 40 THEN "The format of a datetime-tz field should use 9's to " +
                              "represent the month, day, and year separated by " +
                              "a /, -, or . and it should use 9's to represent " +
                              "the hours, minutes, seconds and timezone separated by :  "
       ELSE IF fd-tp = 3 THEN "The format for a Logical field should be two string to " +
                              "represent true and false separated by a /."
       ELSE "The format for an Integer or Decimal field should use 9, Z, z, ., ,, <, >, (, " +
            "), *, +, -, cr, dr, or db"
       SKIP " " SKIP
       IF fd-tp = 1 THEN "For example xxxxx or x(5). See help for more details."
       ELSE IF fd-tp = 2 THEN "For example 99/99/99, 99/99/9999, or 99-99-99. See help for more details."
       ELSE IF fd-tp = 34 THEN "For example 99/99/99 HH:MM, 99/99/9999, or 99-99-99 HH:MM:SS. See help for more details."
       ELSE IF fd-tp = 40 THEN "For example 99/99/99 HH:MM:SS+HH:MM, 99/99/9999, or 99-99-99 HH:MM:SS+HH:MM. See help for more details."
       ELSE IF fd-tp = 3 THEN "For example true/false, yes/no, or shipped/waiting. See help fpr more details."
       ELSE "For eample ->,>>>,>>9 or >,>>>,>>9cr. See help for more details."
       VIEW-AS ALERT-BOX ERROR BUTTON OK.
  ELSE
    MESSAGE sError SKIP
      """" + fmt + """ is not a valid format." SKIP
      IF fd-tp = 1 THEN "The format of a character field should use X, N, A, !, " +
                        "or 9 and be followed of (n) to indicate n more of a prevous " +
                        "format character."
      ELSE IF fd-tp = 2 THEN "The format of a date field should use 9's to " +
                             "represent the month, day, and year separated by " +
                             "a /, -, or . "
      ELSE IF fd-tp = 3 THEN "The format for a Logical field should be two string to " +
                             "represent true and false separated by a /."
      ELSE IF fd-tp = 34 THEN "The format of a datetime field should use 9's to " +
                             "represent the month, day, and year separated by " +
                             "a /, -, or . and it should use 9's to represent " +
                             "the hours, minutes, and seconds separated by :  "
      ELSE IF fd-tp = 40 THEN "The format of a datetime-tz field should use 9's to " +
                             "represent the month, day, and year separated by " +
                             "a /, -, or . and it should use 9's to represent " +
                             "the hours, minutes, seconds and timezone separated by :  "
      ELSE "The format for an Integer or Decimal field should use 9, Z, z, ., ,, <, >, (, " +
           "), *, +, -, cr, dr, or db"
      SKIP " " SKIP
      IF fd-tp = 1 THEN "For example xxxxx or x(5). See help for more details."
      ELSE IF fd-tp = 2 THEN "For example 99/99/99 or 99/99/9999. See help for more details."
      ELSE IF fd-tp = 34 THEN "For example 99/99/99 HH:MM, 99/99/9999, or 99-99-99 HH:MM:SS. See help for more details."
      ELSE IF fd-tp = 40 THEN "For example 99/99/99 HH:MM:SS+HH:MM, 99/99/9999, or 99-99-99 HH:MM:SS+HH:MM. See help for more details."
      ELSE IF fd-tp = 3 THEN "For example true/false, yes/no, or shipped/waiting. See help fpr more details."
      ELSE "For eample ->,>>>,>>9 or >,>>>,>>9cr. See help for more details."
      VIEW-AS ALERT-BOX ERROR BUTTON OK.
  ASSIGN
    fld-wdth = LENGTH(lbl,"RAW":U).
END.

RETURN.

/* _chkfmt.p - end of file */
/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/
/*----------------------------------------------------------------------------

File: _chkpp.i

Description:
   Contains the Chk_PP procedure that determines whether any databases
   are in use when either the admin tool or the dictionary tool are used.

Author: Bruce Gruenbaum

Date Created: 05/17/2000

----------------------------------------------------------------------------*/

PROCEDURE Chk_PPs:
  /* Finds all persistent procedures and generates a list of databases which they
   * use. The user gets a warning message stating that if they modify the schema
   * of any of these database, PROGRESS will restart and all unsaved work will
   * be lost.
   */
  DEFINE VARIABLE h          AS HANDLE    NO-UNDO. /* procedure handle */
  DEFINE VARIABLE dbentry    AS CHARACTER NO-UNDO.
  DEFINE VARIABLE run_dblist AS CHARACTER NO-UNDO. /* list of databases */
  DEFINE VARIABLE i          AS INTEGER   NO-UNDO.
  
  ASSIGN h  = SESSION:FIRST-PROCEDURE.
  DO WHILE VALID-HANDLE(h):
    IF NOT (h:FILE-NAME BEGINS "adetran") THEN 
    DO i = 1 TO NUM-ENTRIES(h:DB-REFERENCES):
      ASSIGN dbentry = ENTRY(i,h:DB-REFERENCES).
      IF dbentry NE "PROGRESST":U AND
         LOOKUP(dbentry, run_dblist) = 0 THEN
        ASSIGN run_dblist = run_dblist + (IF run_dblist NE "" THEN "," + dbentry ELSE dbentry).
    END.
    h = h:NEXT-SIBLING.
  END.
  IF run_dblist NE "" THEN
    MESSAGE "The following database" + (IF NUM-ENTRIES(run_dblist) > 1 THEN "s are" ELSE " is") + 
            " currently in use by running procedures:" skip(1)
            run_dblist skip(1)
            "Making schema changes to" + 
            (IF NUM-ENTRIES(run_dblist) > 1 THEN " any of these databases" ELSE " this database") +
            " at this time will" {&SKP}
            "cause PROGRESS to initiate a session restart causing all" {&SKP}
            "unsaved work to be lost."
            VIEW-AS ALERT-BOX WARNING BUTTONS OK.
END PROCEDURE.
&Scoped-define WINDOW-NAME CURRENT-WINDOW
&Scoped-define FRAME-NAME d_openso
/************************************************************************
* Copyright (C) 2005-2013 by Progress Software Corporation. All rights  *
* reserved.  Prior versions of this work may contain portions           *
* contributed by participants of Possenet.                              *
*                                                                       *
*************************************************************************/
/*------------------------------------------------------------------------

  File: _chosobj.w

  Description: Choose dialog for custom objects 

  Input Parameters:
     p_mode (char) - defines mode for dialog: {&WT-CONTROL} OR ""
                     (i.e. OCX or non-OCX (SmartObjects)
     p_cst-attr (char) - chr(10) delimited list of options from .cst file:
                   DIRECTORY-LIST dir1,dir2,...       /* list of dirs to search */
                   FILTERS        filter1,filter2,... /* file filters to use */
                   TITLE          <string>            /* title for this dialog */
     p_newTemplate (char) - template designated for a new object of this type
                            (e.g. from .cst file: NEW-TEMPLATE <templ-name>)
     p_showOptions (char) - buttons to enable in the dialog-box in a CDL:
                            BROWSE, NEW, PREVIEW
     
  Output Parameters:
     p_fileChosen (char) - filename of object to draw in a window or dialog
     p_otherThing (char) - OCX chosen to draw (unused for SmartObjects)
     p_cancelled  (log)  - True if the user cancelled out of the dialog

  Author: Gerry Seidl 

  Created: 02/12/95 - 10:11 pm

  Modified on 7/31/95 - Moved to adecomm
  Modified on 5/3/98 HD - Added remote file management  
     
  Note:    Remote file management has some differences in behaviour.
           Because asynchron OCX events is used some variables and settings 
           must be treated differently. 
           Error handling is very different, because we cannot check for 
           valid files and directories in the procedures that changes 
           paths and filters.     
           
           WAIT-FOR U1 to be able to hide frame while waiting for 
           response from server.
           --
      11.3 removed appbuilder analyze  blocks
           The file can no longer (from 11.2) be opened in AppBuilder due 
           to frame conditional compile needed to host this in ide dialogs 
           used by AppBuilder integration in PDS.
                           
------------------------------------------------------------------------*/
/*          This .W file was created with the Progress UIB.             */
/*----------------------------------------------------------------------*/
&GLOBAL-DEFINE WIN95-BTN YES
{adecomm/commeng.i}   /* Help String Definitions                 */

/* ***************************  Definitions  ************************** */
&GLOBAL-DEFINE WT-CONTROL               OCX
&GLOBAL-DEFINE WL-CONTROL               OCX-Controls

  
  DEFINE STREAM inStream.   
 
 /** 
 The temptable is used to store the file type for remotefiles because
 the selection list also shows directories */
     
  DEFINE TEMP-TABLE tRmtFile 
    FIELD Num      AS INTEGER 
    FIELD Name     AS CHARACTER
    FIELD FileType AS CHARACTER
    INDEX Num  Num 
    INDEX Name Name.
  
/* Parameters Definitions ---   */
  DEFINE INPUT  PARAMETER p_mode        AS CHARACTER NO-UNDO.
  DEFINE INPUT  PARAMETER p_cst-attr    AS CHARACTER NO-UNDO.
  DEFINE INPUT  PARAMETER p_newTemplate AS CHARACTER NO-UNDO.
  DEFINE INPUT  PARAMETER p_showOptions AS CHARACTER NO-UNDO.
  DEFINE OUTPUT PARAMETER p_fileChosen  AS CHARACTER NO-UNDO.
  DEFINE OUTPUT PARAMETER p_otherThing  AS CHARACTER NO-UNDO.
  DEFINE OUTPUT PARAMETER p_cancelled   AS LOGICAL   NO-UNDO INITIAL FALSE. 

  
/* Local global variables */  
  DEFINE VARIABLE gBrokerURL   AS CHARACTER  NO-UNDO.
  DEFINE VARIABLE gRemotefile  AS LOGICAL    NO-UNDO.
  DEFINE VARIABLE gRmtFullPath AS CHARACTER  NO-UNDO.
  DEFINE VARIABLE gFileSearch  AS LOGICAL    NO-UNDO.
  DEFINE VARIABLE gFilter      AS CHAR       NO-UNDO.
  DEFINE VARIABLE gError       AS LOGICAL    NO-UNDO.
   
  DEFINE VARIABLE gFilters     AS CHARACTER NO-UNDO.
  DEFINE VARIABLE gPathAdded   AS LOG       NO-UNDO.
  DEFINE VARIABLE gOldPath     AS CHARACTER NO-UNDO.
  DEFINE VARIABLE gDirs        AS CHARACTER NO-UNDO.
  DEFINE VARIABLE gTdirs       AS CHARACTER NO-UNDO.
  DEFINE VARIABLE gTitle       AS CHARACTER NO-UNDO init "Open SmartObject".
  
  DEFINE VARIABLE gBrowseone   AS LOGICAL   NO-UNDO INITIAL no.
  DEFINE VARIABLE gNewone      AS LOGICAL   NO-UNDO INITIAL no.

    
  DEFINE VARIABLE gHelpFile   AS INTEGER   NO-UNDO.

  DEFINE VARIABLE rc          AS LOGICAL   NO-UNDO.
  /* Used in error message set from p_mode*/
  DEFINE VARIABLE gObjectType AS CHAR      NO-UNDO.
  
  DEFINE VARIABLE DOS-SLASH   AS CHARACTER NO-UNDO INITIAL "~\":U.
  DEFINE VARIABLE UNIX-SLASH  AS CHARACTER NO-UNDO INITIAL "/":U.
  DEFINE VARIABLE OS-SLASH    AS CHARACTER NO-UNDO INITIAL "/":U.
  
  DEFINE VARIABLE xMatchClient AS CHAR      NO-UNDO INITIAL "*_cl~~.w".
           
   /* Initialized in main block. */

/*
** Patrick Tullmann's Dir DLL
*/
{adecomm/dirsrch.i}
  DEFINE VARIABLE list-mem    AS MEMPTR            NO-UNDO.
  DEFINE VARIABLE list-char   AS CHARACTER         NO-UNDO.
  DEFINE VARIABLE list-size   AS INTEGER INIT 8000 NO-UNDO. 
  DEFINE VARIABLE missed-file AS INTEGER           NO-UNDO.
  DEFINE VARIABLE DirError    AS INTEGER           NO-UNDO.



/* ********************  Preprocessor Definitions  ******************** */

&Scoped-define PROCEDURE-TYPE DIALOG-BOX
&Scoped-define DB-AWARE no

/* Name of designated FRAME-NAME and/or first browse and/or first query */
&Scoped-define FRAME-NAME d_openso

/* Standard List Definitions                                            */
&Scoped-Define ENABLED-OBJECTS filename s_files cb_filters cb_dirs listlbl 
&Scoped-Define DISPLAYED-OBJECTS filename cb_filters cb_dirs listlbl 

/* Custom List Definitions                                              */
/* List-1,List-2,List-3,List-4,List-5,List-6                            */



/* ************************  Function Prototypes ********************** */

FUNCTION getCurrentPMDir RETURNS CHARACTER
  (   )  FORWARD.


FUNCTION getDesignManager RETURNS HANDLE
  (  )  FORWARD.



/* ***********************  Control Definitions  ********************** */

/* Define a dialog box                                                  */

/* Definitions of the field level widgets                               */
DEFINE BUTTON b_Browse 
     LABEL "&Browse..." 
     SIZE 15 BY 1.14.

DEFINE BUTTON b_New 
     LABEL "&New..." 
     SIZE 15 BY 1.14.

DEFINE BUTTON b_Preview 
     LABEL "&Preview..." 
     SIZE 15 BY 1.14.

DEFINE VARIABLE cb_dirs AS CHARACTER FORMAT "X(256)":U 
     VIEW-AS COMBO-BOX INNER-LINES 5
     DROP-DOWN-LIST
     SIZE 35 BY 1 NO-UNDO.

DEFINE VARIABLE cb_filters AS CHARACTER FORMAT "X(256)":U 
     VIEW-AS COMBO-BOX INNER-LINES 5
     DROP-DOWN-LIST
     SIZE 35 BY 1 NO-UNDO.

DEFINE VARIABLE fiCurDir AS CHARACTER FORMAT "X(256)":U 
      VIEW-AS TEXT 
     SIZE 50.4 BY .62 NO-UNDO.

DEFINE VARIABLE filename AS CHARACTER FORMAT "X(256)":U 
     VIEW-AS FILL-IN 
     SIZE 35 BY 1 NO-UNDO.

DEFINE VARIABLE listlbl AS CHARACTER FORMAT "X(256)":U INITIAL "Master File:" 
      VIEW-AS TEXT 
     SIZE 16 BY .62 NO-UNDO.

DEFINE VARIABLE s_files AS CHARACTER 
     VIEW-AS SELECTION-LIST SINGLE NO-DRAG SORT SCROLLBAR-VERTICAL 
     SIZE 33 BY 5 NO-UNDO.


/* ************************  Frame Definitions  *********************** */

DEFINE FRAME d_openso
     filename AT ROW 2.76 COL 3 NO-LABEL
     s_files AT ROW 3.76 COL 5 NO-LABEL
     cb_filters AT ROW 9.91 COL 3 NO-LABEL
     cb_dirs AT ROW 11.76 COL 3 NO-LABEL
     b_Preview AT ROW 2.76 COL 39
     b_Browse AT ROW 4.14 COL 39
     b_New AT ROW 7.67 COL 39
     fiCurDir AT ROW 1.24 COL 3 NO-LABEL
     listlbl AT ROW 2.1 COL 1 COLON-ALIGNED NO-LABEL
     "File Filter:" VIEW-AS TEXT
          SIZE 14 BY .62 AT ROW 9.19 COL 3
     "Directory:" VIEW-AS TEXT
          SIZE 12 BY .62 AT ROW 11.05 COL 3
     SPACE(39.56) SKIP(1.55)
    WITH 
    &if defined(IDE-IS-RUNNING) = 0 &then
    VIEW-AS DIALOG-BOX 
    TITLE gTitle
    &else
    no-box
    &endif
    KEEP-TAB-ORDER 
    SIDE-LABELS 
    NO-UNDERLINE THREE-D  
    SCROLLABLE. 
    

/* *********************** Procedure Settings ************************ */





/* ***********  Runtime Attributes and AppBuilder Settings  *********** */

/* SETTINGS FOR DIALOG-BOX d_openso
   NOT-VISIBLE FRAME-NAME L-To-R,COLUMNS                                */
ASSIGN 
       FRAME d_openso:SCROLLABLE       = FALSE
       FRAME d_openso:HIDDEN           = TRUE.

/* SETTINGS FOR BUTTON b_Browse IN FRAME d_openso
   NO-ENABLE                                                            */
ASSIGN 
       b_Browse:HIDDEN IN FRAME d_openso           = TRUE.

/* SETTINGS FOR BUTTON b_New IN FRAME d_openso
   NO-ENABLE                                                            */
ASSIGN 
       b_New:HIDDEN IN FRAME d_openso           = TRUE.

/* SETTINGS FOR BUTTON b_Preview IN FRAME d_openso
   NO-ENABLE                                                            */
ASSIGN 
       b_Preview:HIDDEN IN FRAME d_openso           = TRUE.

/* SETTINGS FOR COMBO-BOX cb_dirs IN FRAME d_openso
   ALIGN-L                                                              */
/* SETTINGS FOR COMBO-BOX cb_filters IN FRAME d_openso
   ALIGN-L                                                              */
/* SETTINGS FOR FILL-IN fiCurDir IN FRAME d_openso
   NO-DISPLAY NO-ENABLE ALIGN-L                                         */
/* SETTINGS FOR FILL-IN filename IN FRAME d_openso
   ALIGN-L                                                              */
/* SETTINGS FOR SELECTION-LIST s_files IN FRAME d_openso
   NO-DISPLAY                                                           */
/* _RUN-TIME-ATTRIBUTES-END */

 



/* ************************  Control Triggers  ************************ */

&Scoped-define SELF-NAME d_openso
ON ENDKEY OF FRAME d_openso /* Open SmartObject */
OR END-ERROR OF FRAME d_openso
DO:
  ASSIGN
    p_fileChosen = "":U
    p_otherThing = "":U
    p_cancelled = TRUE
  .
END.



&Scoped-define SELF-NAME b_Browse
ON CHOOSE OF b_Browse IN FRAME d_openso /* Browse... */
DO:
  RUN adecomm/_opnfile.w
      ("Open an object":U ,
       "AppBuilder files (*.w),R-code files (*.r),All Files (*.*)":U,  
       INPUT-OUTPUT p_fileChosen).
       
  /* Did we cancel at this point? */
  IF p_fileChosen = "":U THEN RETURN NO-APPLY.
  ELSE DO:
    /* Set the flag that indicates we just browsed a file (so that
       the "GO" action won't look at the file name in the selection list) */
    gBrowseone = YES.
    APPLY "U1" TO THIS-PROCEDURE.
  END.
END.



&Scoped-define SELF-NAME b_New
ON CHOOSE OF b_New IN FRAME d_openso /* New... */
DO:
  IF p_newTemplate <> "" OR p_newTemplate = ? THEN DO:
    FILE-INFO:FILE-NAME = p_newTemplate.
    IF FILE-INFO:FULL-PATHNAME NE ? THEN DO:
      ASSIGN FRAME {&FRAME-NAME}:HIDDEN = YES.
      RUN adeuib/_open-w.p (FILE-INFO:FULL-PATHNAME, "", "UNTITLED"). /* open from template in UIB */
      ASSIGN gNewone  = YES.
      APPLY "U1" TO THIS-PROCEDURE. /* direct path out */
    END.
  END.   
END.



&Scoped-define SELF-NAME b_Preview
ON CHOOSE OF b_Preview IN FRAME d_openso /* Preview... */
DO:
  DEFINE VARIABLE ok_choice AS LOGICAL NO-UNDO.
  
  Run adecomm/_setcurs.p("WAIT":u).
  /* See if there is a valid choice? */
  RUN Check_Filechosen (OUTPUT ok_choice).
 
  /* If so, preview the current object in a dialog-box */
  IF ok_choice THEN 
    If p_mode = "{&WT-CONTROL}":U then 
      run adeuib/_prvcont.w(p_fileChosen, p_otherThing).
    Else 
      run adeuib/_so-prvw.w(p_fileChosen).
      
  Run adecomm/_setcurs.p("":U).
END.



&Scoped-define SELF-NAME cb_dirs
ON VALUE-CHANGED OF cb_dirs IN FRAME d_openso
DO:
  If cb_dirs = cb_dirs:SCREEN-VALUE then 
    RETURN.    
  RUN BuildFileList. 
  ASSIGN cb_dirs.
  
END.



&Scoped-define SELF-NAME cb_filters
ON VALUE-CHANGED OF cb_filters IN FRAME d_openso
DO:
  If cb_filters = cb_filters:SCREEN-VALUE then 
    RETURN. 
  RUN BuildFileList.  
  ASSIGN cb_filters.
END.



&Scoped-define SELF-NAME s_files
ON DEFAULT-ACTION OF s_files IN FRAME d_openso
DO:
  APPLY "U1" TO THIS-PROCEDURE.
END.



ON ENTRY OF s_files IN FRAME d_openso
DO:
  
  IF SELF:SCREEN-VALUE <> "":U AND
     SELF:SCREEN-VALUE <> ?  AND
     SELF:SCREEN-VALUE <> "?" AND
     SELF:SCREEN-VALUE <> "<None>" THEN
       ASSIGN filename:SCREEN-VALUE = SELF:SCREEN-VALUE.
     ELSE filename:SCREEN-VALUE = "".
     
  Filename = filename:SCREEN-VALUE.
END.



ON VALUE-CHANGED OF s_files IN FRAME d_openso
DO:
  IF SELF:SCREEN-VALUE <> "":U AND
     SELF:SCREEN-VALUE <> ?  AND
     SELF:SCREEN-VALUE <> "?" AND
     SELF:SCREEN-VALUE <> "<None>" THEN
       ASSIGN filename:SCREEN-VALUE = SELF:SCREEN-VALUE.
     ELSE filename:SCREEN-VALUE = "":U.
  
  /*
   * Reset the user's choices
   */
  
  assign   
      filename = filename:SCREEN-VALUE
      p_fileChosen = "":U
      p_otherThing = "":U
  .
     
  RUN Set_Sensitivity.
END.



&UNDEFINE SELF-NAME



/* ***************************  Main Block  *************************** */

IF p_mode = "{&WT-CONTROL}":U THEN gHelpFile = {&Choose_VBX_Controls_Dlg_Box}.
                              ELSE gHelpFile = {&Choose_SmartObject_Dlg_Box}.

IF LOOKUP(OPSYS, "MSDOS,WIN32":u) > 0 THEN
  ASSIGN OS-SLASH = "~\":u.
ELSE
  ASSIGN OS-SLASH = "/":u.

{ adecomm/okbar.i &TOOL    = "COMM"
                  &CONTEXT = gHelpFile
                 }

&if defined(IDE-IS-RUNNING) = 0 &then           
/* Parent the dialog-box to the ACTIVE-WINDOW, if there is no parent.   */
IF VALID-HANDLE(ACTIVE-WINDOW) AND FRAME {&FRAME-NAME}:PARENT eq ?
THEN FRAME {&FRAME-NAME}:PARENT = ACTIVE-WINDOW.
&else
{adeuib/ide/dialoginit.i "FRAME {&FRAME-NAME}:HANDLE"}
&endif

/* Add Trigger to equate WINDOW-CLOSE to END-ERROR                      */
ON WINDOW-CLOSE OF FRAME {&FRAME-NAME} APPLY "END-ERROR":U TO SELF.

ON GO OF FRAME {&FRAME-NAME}  
   APPLY "U1":U TO THIS-PROCEDURE.

ON U1 OF THIS-PROCEDURE DO: 
  IF NOT gNewOne THEN
  DO:
    RUN ApplyGo NO-ERROR.
    IF ERROR-STATUS:ERROR THEN RETURN NO-APPLY.
  END.
END.    

ON RETURN OF FRAME {&FRAME-NAME} ANYWHERE 
  APPLY "U1":U TO THIS-PROCEDURE.
     
&SCOPED-DEFINE CANCEL-EVENT U1
{adeuib/ide/dialogstart.i btn_ok btn_cancel gTitle }

/* Now enable the interface and wait for the exit condition.            */
/* (NOTE: handle ERROR and END-KEY so cleanup code will always fire.    */
MAIN-BLOCK:
DO ON ERROR   UNDO MAIN-BLOCK, LEAVE MAIN-BLOCK
   ON END-KEY UNDO MAIN-BLOCK, LEAVE MAIN-BLOCK:

  RUN initGUI.
  
  RUN Setup(OUTPUT rc).
  IF NOT rc THEN DO:
     &if defined(IDE-IS-RUNNING) <> 0 &then  
         if OEIDE_CanShowMessage() then 
              ShowMessageInIDE("Invalid parameters defined for " + gObjectType + ".","Error":U,?,"ok":U,true).
         else    
     &endif  
         MESSAGE "Invalid parameters defined for " gObjectType + "."
              VIEW-AS ALERT-BOX ERROR BUTTONS OK.
    RETURN.
  END.
  
  RUN BuildFileList.
 
  IF NOT gError THEN 
  DO:  
    RUN enable_UI.
    IF NOT gRemoteFile THEN VIEW FRAME {&FRAME-NAME}. 
    WAIT-FOR U1 OF THIS-PROCEDURE.
  END.  
END.


RUN destroyObject.



/* **********************  Internal Procedures  *********************** */

PROCEDURE ApplyGo :
DEFINE VARIABLE ok_choice AS LOGICAL NO-UNDO.
     
  /*
   * Make sure that the contents of the fill-in
   * are legal. This traps the problem if the
   * user types a bad filter and goes to OK
   * without hitting CR
   */
  
  IF gERROR AND GRemoteFile THEN 
  DO:
    Message 
      DYNAMIC-FUNCTION("getWSAERROrText")
      VIEW-AS ALERT-BOX.
    RETURN.
  END.
    
  IF NOT GBrowseOne THEN DO:
    RUN ChangeFilter(OUTPUT Ok_Choice).
    IF NOT ok_choice THEN RETURN ERROR.   
  END.
  
  /* See if there is a valid choice? */
   
  RUN Check_Filechosen (OUTPUT ok_choice). 
  
  IF NOT ok_choice THEN RETURN ERROR.
  
  IF NOT gRemoteFile THEN
  DO: 
    /* Make sure slashes are correct for the platform */
    IF LOOKUP(OPSYS , "MSDOS,WIN32":U) > 0 THEN
      p_fileChosen = REPLACE(p_fileChosen, UNIX-SLASH, DOS-SLASH).
    ELSE IF OPSYS = "UNIX":U THEN            
      p_fileChosen = REPLACE(p_fileChosen, DOS-SLASH, UNIX-SLASH).
  
  END.
   
  /* Lowercase the filename to make it easier to port code to Unix */
  p_fileChosen = LC(p_fileChosen).
  
  /* If a new SmartObject Master was created, then return the edvidence */
  IF gNewone THEN 
    ASSIGN p_fileChosen = "":U
           p_otherThing = "New Master":U.
  
END PROCEDURE.


PROCEDURE BuildFileList :
/* -----------------------------------------------------------
  Purpose:     Build the file listing in the selection list
  Parameters:  <none>
  Notes:       
-------------------------------------------------------------*/
  DEFINE VARIABLE file_list AS CHARACTER NO-UNDO INITIAL "".
  DEFINE VARIABLE file_base AS CHARACTER NO-UNDO FORMAT "X(64)".
  DEFINE VARIABLE file_abs  AS CHARACTER NO-UNDO FORMAT "X(64)".
  DEFINE VARIABLE fileattr AS CHARACTER NO-UNDO FORMAT "X(10)".
  DEFINE VARIABLE pos       AS INTEGER   NO-UNDO.
  DEFINE VARIABLE CurDir    AS CHARACTER NO-UNDO.
  DEFINE VARIABLE CurFilter AS CHARACTER NO-UNDO.
  DEFINE VARIABLE t         AS CHARACTER NO-UNDO INITIAL "":U.
  DEFINE VARIABLE i         AS INTEGER   NO-UNDO.
  DEFINE VARIABLE numFiles  AS INTEGER   NO-UNDO.
  DEFINE VARIABLE Use_DLL   AS LOGICAL   NO-UNDO.
  DEFINE VARIABLE DirPrefix AS CHARACTER NO-UNDO.
  DEFINE VARIABLE DirBase   AS CHARACTER NO-UNDO.
  
  Run adecomm/_setcurs.p("WAIT":U).
  
  DO WITH FRAME {&FRAME-NAME}:
    ASSIGN 
      cb_dirs
      cb_filters.
         
    IF gRemoteFile THEN 
    DO:
      /* ConnectServer is in the cihttp SUPER proc */ 
      RUN ConnectServer NO-ERROR.
      
      IF ERROR-STATUS:ERROR THEN ASSIGN gError = TRUE.
         
      /* This will trig an asynchron OCX event from the server  
         that will call the following procedure 
      -> OCX.HTTPServerConnection 
             calls GetData in SUPER which will trig another OCX event
             that will call the followin procedure 
      -> OCX.FileClosed */          
    
    END.
     
    ELSE 
    DO:  
      ASSIGN
        filename:SCREEN-VALUE  = "":U
        filename               = "":U
        s_files:LIST-ITEMS     = "":U
        pos = cb_dirs:LOOKUP(cb_dirs:SCREEN-VALUE)
        FILE-INFO:FILENAME     = ENTRY(pos,gTdirs)
        CurDir                 = LC(file-info:full-pathname).
        FiCurDir:SCREEN-VALUE  = file-info:full-pathname. 
 
     /* The DLL does not return any files if the directory passed is
      * the Root directory (e.g. "C:\"), so in that case, we'll use
      * the "slow" way.
      */  
      IF LOOKUP(OPSYS, "MSDOS,WIN32":u) > 0 THEN
      DO:
        RUN adecomm/_osprefx.p
            (INPUT CurDir, OUTPUT DirPrefix, OUTPUT DirBase).
        /* If the directory path is not the same as the directory prefix,
           then we do not have a root drive, so use the DLL. */
        ASSIGN Use_DLL = (CurDir <> DirPrefix).
      END.
    
      IF Use_DLL THEN 
      DO: /* use Windows .DLL instead of OS-DIR */
        RUN adecomm/_setcurs.p ("WAIT":U).
        ASSIGN
          SET-SIZE(list-mem)         = list-size
          CurFilter                  = "":U
          CurFilter                  = cb_filters:SCREEN-VALUE.

        RUN file_search (CurDir,CurFilter,INPUT-OUTPUT list-mem,list-size,
          OUTPUT missed-file, OUTPUT DirError).
      
        /* Error checking */
        IF DirError <> 0 THEN DO:
          RUN adecomm/_setcurs.p ("":U).
          SET-SIZE(list-mem) = 0.
          &if defined(IDE-IS-RUNNING) <> 0 &then  
              if OEIDE_CanShowMessage() then 
                 ShowMessageInIDE("Error in directory search.","Error":U,?,"ok":U,true).
               else    
          &endif  
             MESSAGE "Error in directory search." VIEW-AS ALERT-BOX ERROR.

          RETURN.
        END.
        IF missed-file > 0 THEN 
        do:
          &if defined(IDE-IS-RUNNING) <> 0 &then  
              if OEIDE_CanShowMessage() then 
                 ShowMessageInIDE("Too many files in your directory. The file list may not be inclusive.","Information":U,?,"ok":U,true).
               else    
          &endif  
          MESSAGE "Too many files in your directory." skip
                  "The file list may not be inclusive."
           VIEW-AS ALERT-BOX INFORMATION. 
      
        end.
        ASSIGN 
          file_list          = LC(GET-STRING(list-mem,1))
          SET-SIZE(list-mem) = 0.
      END. /* WINDOWS .DLL version */
      ELSE DO: /* other O/S's use the slow 4GL method */  
        RUN adecomm/_setcurs.p ("WAIT":U).
        INPUT FROM OS-DIR (ENTRY(pos,gTdirs)) NO-ECHO.
        LOAD-File-List:
        REPEAT:
          IMPORT file_base file_abs fileattr.
          IF NUM-ENTRIES(file_base,"_":U) > 1 THEN DO:
            IF ENTRY(2, file_base, "_":U) = "cl.w":U THEN NEXT LOAD-File-List.
          END.
          IF file_base MATCHES REPLACE(cb_filters:SCREEN-VALUE,".","~~.") AND INDEX(fileattr,"D") = 0 THEN
             file_list = file_list + (IF file_list NE "" THEN "," ELSE "") + file_base.
        END.
        INPUT CLOSE.
        IF LOOKUP(OPSYS , "MSDOS,WIN32":u) > 0 THEN file_list = LC(file_list).
      END.    
      IF file_list NE "" THEN DO: 
        s_files:LIST-ITEMS   = file_list.
        IF gTitle MATCHES "*SmartDataObject*" OR 
           gTitle MATCHES "*SmartBusinessObject*" THEN 
        DO:
          numFiles = NUM-ENTRIES(file_list).
          /* Strip out the _cl.w files */
          DO i = numFiles TO 1 BY -1:
            IF S_files:ENTRY(i) MATCHES xMatchClient THEN
              S_files:DELETE(i).
          END.
        END.
        IF gTitle MATCHES "*SmartPanel*" THEN DO:
          numFiles = NUM-ENTRIES(file_list).
          /* Strip out panel.r and panel.w files */
          DO i = numFiles TO 1 BY -1:
            IF S_files:ENTRY(i) MATCHES "panel~.." THEN
              S_files:DELETE(i).
          END.
        END.
        s_files:SCREEN-VALUE = s_files:ENTRY(1).
      END.
      ELSE s_files:ADD-FIRST("<none>").
    END. /* else: NOT remote */
  END. /* do with frame */
  IF NOT gRemoteFile THEN
  DO:
     RUN Set_first.     
     RUN adecomm/_setcurs.p ("":U).
  END.
  
END PROCEDURE.


PROCEDURE ChangeFilter :
/*------------------------------------------------------------------------------
  Purpose: Called on GO of the frame to see if we
           can get path or filename from filename field.     
  Parameters:  OUTPUT p_ok
  Notes:  P_ok returns FALSE to RETURN No-Apply from the GO.      
------------------------------------------------------------------------------*/
  DEFINE OUTPUT PARAMETER p_OK AS LOGICAL NO-UNDO INITIAL yes.
  
  DEFINE VARIABLE pos       AS INTEGER   NO-UNDO.
  DEFINE VARIABLE newpath   AS CHARACTER NO-UNDO.
  DEFINE VARIABLE newfilter AS CHARACTER NO-UNDO.
  DEFINE VARIABLE l         AS LOGICAL   NO-UNDO.
  DEFINE VARIABLE chdir     AS LOGICAL   NO-UNDO INITIAL NO.
  DEFINE VARIABLE chfilter  AS LOGICAL   NO-UNDO INITIAL NO.
  DEFINE VARIABLE chfile    AS LOGICAL   NO-UNDO INITIAL NO.
  DEFINE VARIABLE tfname    AS CHARACTER NO-UNDO.
     
  IF gRemoteFile THEN
  DO WITH FRAME {&FRAME-NAME}:
  
    ASSIGN 
      gFileSearch = FALSE
      tfName      = REPLACE(filename:SCREEN-VALUE, DOS-SLASH, UNIX-SLASH). 
   
    /* Find path if slash  */    
    IF INDEX(tfName, UNIX-SLASH) > 0 THEN 
       newpath = SUBSTR(tFname,1,R-INDEX(tfName, UNIX-SLASH) - 1).  
      
     /* Find the filter if there is a slash or not */   
    IF INDEX(tfName, "*":U) > 0 THEN
    DO:     
      newfilter = ENTRY(NUM-ENTRIES(tFname,UNIX-SLASH),tFname,UNIX-SLASH).           
      IF cb_filters:LOOKUP(newfilter) = 0 THEN 
          cb_filters:ADD-FIRST(newfilter).    
      ASSIGN 
        cb_filters:SCREEN-VALUE = newfilter
        chfilter                = TRUE
        cb_filters.           
    END.
    ELSE IF newpath <> "":U THEN gFileSearch = TRUE.
    
    /* If no wildcard and slash, check if entered name is a directory 
      (ALL directories have been read in even if they are not in the list */
    ELSE IF newpath = "":U THEN 
    DO:      
      FIND tRmtFile WHERE tRmtFile.Name     = tfName 
                    AND   tRmtFile.FileType = "D":U NO-ERROR.
                   
      IF AVAIL tRmtFile THEN 
        ASSIGN newpath = tfName.  
    END.
    IF newpath <> "" THEN
    DO:   
      IF cb_dirs:LOOKUP(newpath) = 0 THEN 
      DO:
         /* Variables used to reset combo if wrong path added. */ 
        ASSIGN 
          gPathAdded = TRUE
          gOldPath   = cb_dirs:SCREEN-VALUE.      
        cb_dirs:ADD-FIRST(newpath).
        
      END.
      ASSIGN 
        cb_dirs:SCREEN-VALUE = newpath
        chdir                = TRUE
        cb_dirs.              
    END.
    
    IF NOT (chdir OR chfilter) THEN
      gFileSearch = s_files:LOOKUP(filename:SCREEN-VALUE) = 0.
      
    ASSIGN p_ok = NOT (chdir OR chfilter OR gFileSearch). 
        
  END. /* If gremotefile */
  ELSE  
  DO WITH FRAME {&FRAME-NAME}:
    ASSIGN tfname = (IF LOOKUP(OPSYS , "MSDOS,WIN32":U) > 0
                     THEN REPLACE(filename:SCREEN-VALUE, UNIX-SLASH, DOS-SLASH) 
                     ELSE REPLACE(filename:SCREEN-VALUE, DOS-SLASH, UNIX-SLASH)).
    
    IF INDEX(tfname, OS-SLASH) = 0 THEN /* add path from filter */
        FILE-INFO:FILE-NAME = cb_dirs:SCREEN-VALUE + OS-SLASH + tfname.
    ELSE
        FILE-INFO:FILE-NAME = tfname. /* assume that user is specifying dir and filename */
    
    IF FILE-INFO:FULL-PATHNAME <> ? THEN DO:
    
        IF INDEX(FILE-INFO:FILE-TYPE,"D") > 0 THEN DO: /* directory */
            ASSIGN p_OK = NO.
            IF LOOKUP(FILE-INFO:FULL-PATHNAME, gTdirs) > 0 THEN
              ASSIGN cb_dirs:SCREEN-VALUE = cb_dirs:ENTRY(LOOKUP(FILE-INFO:FULL-PATHNAME, gTdirs)). /* existing dir */
            ELSE DO: /* New dir */
              IF cb_dirs:LOOKUP(FILE-INFO:PATHNAME) = 0 THEN l = cb_dirs:ADD-FIRST(FILE-INFO:PATHNAME).
              ASSIGN cb_dirs:SCREEN-VALUE = FILE-INFO:PATHNAME
                     gDirs = cb_dirs:LIST-ITEMS
                     gTdirs = "".
              RUN Check_Dirs.  
            END.
            ASSIGN chdir = YES.
        END.        
        ELSE do: /* not a directory */
          ASSIGN
            p_fileChosen = FILE-INFO:PATHNAME
            chfile       = YES
           .     
        end.         
    END.
    ELSE DO:
       
      /* Bad filename, but might be a new filter and/or dir */
      IF INDEX(tfname, OS-SLASH) > 0 OR INDEX(tfname, "*") > 0 THEN DO:  /* change dir and/or filter */
      
        ASSIGN p_OK = NO.
        IF INDEX(tfname, OS-SLASH) > 0 THEN DO:
          
          /* If there is no wildcard here, it's really a bad filename */
          IF INDEX(tfname, "*") = 0 THEN DO:
            &if defined(IDE-IS-RUNNING) <> 0 &then  
                if OEIDE_CanShowMessage() then 
                    ShowMessageInIDE("Invalid directory path or filename.","Error":U,?,"ok":U,true).
                else    
            &endif    
                MESSAGE "Invalid directory path or filename." VIEW-AS ALERT-BOX ERROR.
            RETURN.
          END.
         
          /* It's got a slash, extract new search dir */
          ASSIGN newpath = SUBSTRING(tfname, 1, R-INDEX(tfname,OS-SLASH) - 1, "CHARACTER":U).
                    
          FILE-INFO:FILE-NAME = newpath.
          
          IF FILE-INFO:FULL-PATHNAME = ? THEN DO:
            MESSAGE "Invalid pathname: " newpath VIEW-AS ALERT-BOX ERROR.
            RETURN.
          END. 
          ELSE DO:
            IF LOOKUP(FILE-INFO:FULL-PATHNAME, gTdirs) > 0 THEN
              ASSIGN cb_dirs:SCREEN-VALUE = cb_dirs:ENTRY(LOOKUP(FILE-INFO:FULL-PATHNAME, gTdirs)). /* existing dir */
            ELSE DO:
              IF cb_dirs:LOOKUP(newpath) = 0 THEN l = cb_dirs:ADD-FIRST(newpath).
              ASSIGN cb_dirs:SCREEN-VALUE = newpath
                     gDirs = cb_dirs:LIST-ITEMS
                     gTdirs = "".
              RUN Check_Dirs.
            END.
            ASSIGN chdir = YES.
          END.          
        END.
        
        IF INDEX(tfname, "*") > 0 THEN DO: /* wildcard */
          
          IF INDEX(tfname,OS-SLASH) > 0 THEN /* contains a slash? */
            IF R-INDEX(tfname,OS-SLASH) < R-INDEX(tfname, "*") THEN DO:
              /* The slash comes before the wildcard - good */
              ASSIGN newfilter = SUBSTRING(tfname, R-INDEX(tfname,OS-SLASH) + 1,-1,"CHARACTER":U).
              IF cb_filters:LOOKUP(newfilter) = 0 THEN l = cb_filters:ADD-FIRST(newfilter).
              ASSIGN cb_filters:SCREEN-VALUE = newfilter.
            END.
            ELSE DO: /* The '*' should not come before the last slash! */
                &if defined(IDE-IS-RUNNING) <> 0 &then  
                if OEIDE_CanShowMessage() then 
                    ShowMessageInIDE("Invalid wildcard entry.","Error":U,?,"ok":U,true).
                else    
                &endif
                MESSAGE "Invalid wildcard entry." VIEW-AS ALERT-BOX ERROR.
                chfilter = NO.
                p_OK = NO.
            END.
          ELSE DO: /* No slash */
            ASSIGN newfilter = filename:SCREEN-VALUE.
            IF cb_filters:LOOKUP(newfilter) = 0 THEN l = cb_filters:ADD-FIRST(newfilter).
            ASSIGN cb_filters:SCREEN-VALUE = newfilter
                   chfilter = YES.         
          END.
        END. 
      
      END. /* slash or '*' */
      ELSE DO: /* really a bad filename! */
        &if defined(IDE-IS-RUNNING) <> 0 &then  
            if OEIDE_CanShowMessage() then 
                ShowMessageInIDE("File: " + filename:SCREEN-VALUE + " was not found.","Error":U,?,"ok":U,true).
            else    
        &endif
            MESSAGE "File: " + filename:SCREEN-VALUE + " was not found." 
            VIEW-AS ALERT-BOX ERROR BUTTONS OK.
        p_OK = NO.
      END.         
    END.    
  END. /* else : not gRemoteFile */ 
                           
  /* 
  If filter is changed 
  OR directory is changed 
  OR remote and filesearch (meaning there is no slash or wildcard in the filename
                            and that the filename is not in the list) 
  We must run BuildFilelist   
  */
                               
  IF chfilter OR chdir OR (gRemoteFile AND gFileSearch) THEN 
    RUN BuildFileList.  
  
  IF chfile  
  AND s_files:LOOKUP(filename:SCREEN-VALUE) > 0 THEN 
      s_files:SCREEN-VALUE = filename:SCREEN-VALUE.
   
END PROCEDURE.


PROCEDURE Check_Dirs :
/* -----------------------------------------------------------
  Purpose:     Check to see if we can locate the dirs in the list
  Parameters:  <none>
  Notes:       
-------------------------------------------------------------*/
  DEFINE VARIABLE i     AS INTEGER   NO-UNDO.
  DEFINE VARIABLE dirs2 AS CHARACTER NO-UNDO.
  define variable cMsg  as character no-undo.
  DO i = 1 TO NUM-ENTRIES(gDirs):
      ASSIGN FILE-INFO:FILE-NAME = ENTRY(i,gDirs).
      IF INDEX(FILE-INFO:FILE-TYPE,"D") > 0 THEN /* must be a directory */
          ASSIGN gTdirs  = gTdirs  + "," + FILE-INFO:FULL-PATHNAME
                 dirs2  = dirs2  + "," + ENTRY(i,gDirs).
         
      /* Skip .pl's and null entries */           
      ELSE IF ENTRY(i,gDirs) NE "" AND 
              SUBSTRING(ENTRY(i,gDirs),LENGTH(ENTRY(i,gDirs)) - 1,2,"CHARACTER":U) 
              NE "PL" AND p_mode NE "{&WT-CONTROL}":U THEN
      do:
          cMsg =  "Directory: " + ENTRY(i,gDirs) + " is defined for this object" 
               +  " but does not currently exist on this system." + "~n~n" 
               +   "This directory name will be ignored.".
         
          &if defined(IDE-IS-RUNNING) <> 0 &then  
        
          if OEIDE_CanShowMessage() then 
              ShowMessageInIDE(cMsg,"Warning":U,?,"ok":U,true).
          else    
          &endif 
           
          MESSAGE  cmsg
                  VIEW-AS ALERT-BOX WARNING BUTTONS OK.
  
      end.          
  END.
  ASSIGN gDirs  = SUBSTRING(dirs2,2,-1,"CHARACTER")
         gTdirs = SUBSTRING(gTdirs,2,-1,"CHARACTER").
END PROCEDURE.


PROCEDURE Check_FileChosen :
/*------------------------------------------------------------------------------
  Purpose: Check the value of the variable fileChosen and make sure it is valid.
           Reset filechose based on the value in the filling.    
  Parameters:  p_OK - FALSE if the file is not good
  Notes:       
------------------------------------------------------------------------------ */  
  DEFINE OUTPUT PARAMETER p_OK AS LOGICAL NO-UNDO INITIAL yes.
  DEFINE VARIABLE ocxStatus    AS INTEGER NO-UNDO.
  DEFINE VARIABLE dispMessage  AS LOGICAL NO-UNDO INITIAL no.
  
  DO WITH FRAME {&FRAME-NAME}: 
    
    IF NOT gNewone AND NOT gBrowseone THEN 
    DO:
      If p_mode = "{&WT-CONTROL}" then 
      do:
        Run processOCX(output ocxStatus).
        IF ocxStatus = 0 then
        do:
          Assign
            p_OK = no
            p_otherThing = ""
            .
          &if defined(IDE-IS-RUNNING) <> 0 &then  
          if OEIDE_CanShowMessage() then 
              ShowMessageInIDE("Please select a file.","Warning":U,?,"ok":U,true).
          else    
          &endif  
          MESSAGE "Please select a file." VIEW-AS ALERT-BOX WARNING. 
        end.    
        Else if ocxStatus = -1 then
          Assign
            p_OK = no
            p_otherThing = ""
            . 
      end.
      else do: 
        Run processObj(output p_OK).
      end.
    END.    
  END.
END PROCEDURE.


PROCEDURE destroyObject :
/*------------------------------------------------------------------------------
  Purpose:    Kill _cihttp and this-procedure
  Parameters:  
  Notes:       
------------------------------------------------------------------------------*/
  RUN SUPER NO-ERROR.
  RUN disable_UI.
END PROCEDURE.


PROCEDURE disable_UI :
/*------------------------------------------------------------------------------
  Purpose:     DISABLE the User Interface
  Parameters:  <none>
  Notes:       Here we clean-up the user-interface by deleting
               dynamic widgets we have created and/or hide 
               frames.  This procedure is usually called when
               we are ready to "clean-up" after running.
------------------------------------------------------------------------------*/
  /* Hide all frames. */
  HIDE FRAME d_openso.
END PROCEDURE.


PROCEDURE enable_UI :
/*------------------------------------------------------------------------------
  Purpose:     ENABLE the User Interface
  Parameters:  <none>
  Notes:       Here we display/view/enable the widgets in the
               user-interface.  In addition, OPEN all queries
               associated with each FRAME and BROWSE.
               These statements here are based on the "Other 
               Settings" section of the widget Property Sheets.
------------------------------------------------------------------------------*/
  DISPLAY filename cb_filters cb_dirs listlbl 
      WITH FRAME d_openso.
  ENABLE filename s_files cb_filters cb_dirs listlbl 
      WITH FRAME d_openso.
  {&OPEN-BROWSERS-IN-QUERY-d_openso}
END PROCEDURE.


PROCEDURE initAdmGUI :
/*------------------------------------------------------------------------------
  Purpose:     
  Parameters:  <none>
  Notes:       
----------------------------------------------------------------------------*/
 DEF VAR RemoteStr AS CHAR NO-UNDO.
 
 DO WITH FRAME {&FRAME-NAME}:
  IF p_newTemplate = "" OR p_newTemplate = ? THEN
      b_New:HIDDEN = TRUE. /* turn it off */
 END.
 
 If p_mode = "WEB":U THEN
 DO: 
   RUN adeuib/_uibinfo.p (?,"SESSION":U,"remote", OUTPUT RemoteStr).
   ASSIGN gRemotefile = RemoteStr = "TRUE":U.
 
   IF gRemotefile THEN 
     RUN initHTTP. 
 END.  
END PROCEDURE.


PROCEDURE initGUI :
/*------------------------------------------------------------------------------
  Purpose:     
  Parameters:  <none>
  Notes:       
------------------------------------------------------------------------------*/
/*
 * Do the common things first ...
 */
 
 DO WITH FRAME {&FRAME-NAME}:
   ASSIGN 
     b_browse:hidden     = NOT CAN-DO(p_showoptions,"BROWSE":U)
   
     b_browse:sensitive  = NOT b_browse:hidden
     
     /* not supported in PDS 
        need handler that starts wizard.  */
     &if defined(IDE-IS-RUNNING) = 0 &then
         b_new:hidden        = NOT CAN-DO(p_showoptions,"NEW":U)
     &else
         b_new:hidden  = true 
     &endif
     b_new:sensitive     = NOT b_new:hidden
     b_preview:hidden    = NOT CAN-DO(p_showoptions,"PREVIEW":U)
     b_preview:sensitive = NOT b_preview:hidden
     .
   
   
   ASSIGN 
     gObjectType = IF p_mode = "WEB":U THEN "object" else p_mode.
            
   If p_mode = "{&WT-CONTROL}" then 
     RUN initOCXGUI.
   Else 
     RUN initAdmGUI.

 END.                          
END PROCEDURE.


PROCEDURE initHTTP :
/*------------------------------------------------------------------------------
  Purpose:    Start the HTTP super procedure 
              set attributes and subscribe to events 
  Parameters: 
  Notes:       
------------------------------------------------------------------------------*/
  DEF VAR Hdl       AS HANDLE NO-UNDO.

  RUN adeuib/_uibinfo.p (?,"SESSION":U,"BrokerURL", OUTPUT gBrokerURL).
  
  RUN adeweb/_cihttp.p PERSISTENT SET Hdl.
  THIS-PROCEDURE:ADD-SUPER-PROCEDURE(Hdl).
  
  DYNAMIC-FUNCTION("setBROKERURL":U, gBrokerURL).      
  DYNAMIC-FUNCTION("setParseIncomingdata":U, true).
  
  RETURN.
  
END PROCEDURE.


PROCEDURE initOCXGUI :
/*------------------------------------------------------------------------------
  Purpose:     
  Parameters:  <none>
  Notes:       
------------------------------------------------------------------------------*/

END PROCEDURE.


PROCEDURE OCX.FileClosed :
/*------------------------------------------------------------------------------
  Purpose:     
  Parameters:  
  Notes:       
------------------------------------------------------------------------------*/
  DEF VAR ReadCnt  AS INTEGER    NO-UNDO.  
  DEF VAR FileCnt  AS INTEGER    NO-UNDO.    
  DEF VAR RmtFile  AS CHARACTER  NO-UNDO.  
  DEF VAR FileType AS CHARACTER  NO-UNDO.  
  DEF VAR lScrap   AS LOGICAL    NO-UNDO.  
  
  DEF VAR lError   AS LOGICAL NO-UNDO.  

  INPUT STREAM instream FROM VALUE(DYNAMIC-FUNCTION("getlocalfilename")) NO-ECHO.
  
  REPEAT WITH FRAME {&FRAME-NAME}:
    ASSIGN 
      Rmtfile  = ""
      FileType = "".
    IMPORT STREAM instream RmtFile FileType.
    ReadCnt  = ReadCnt + 1.
  
    CASE ReadCnt:
      /* Check for line that begins <HTML> indicating an error reported by the
         web server. View the error in a web browser. */
      WHEN 1 THEN 
      DO:
        IF RmtFile BEGINS "<HTML>":U THEN DO:
          INPUT STREAM instream CLOSE.
          RUN adecomm/_s-alert.p (INPUT-OUTPUT lScrap, "error":U, "ok":U,
            "An error occured while reading the WebSpeed directory and will be displayed in your Web browser.").
          
          RUN adeweb/_abrunwb.p ("webutil/_weblist.w").
          ASSIGN lError = TRUE.
          LEAVE.
        END.
        ELSE NEXT.
      END.
      
      WHEN 2 THEN NEXT.

      /* Check for non-blank line indicating an error. */
      WHEN 3 THEN 
      DO:
        IF RmtFile <> "" THEN DO:
          MESSAGE "An error occured while reading the WebSpeed directory."
            VIEW-AS ALERT-BOX ERROR.
          ASSIGN lError = TRUE. 
          LEAVE.
        END.
        NEXT.
      END.
  
      /* Get current directory full path from 4th data line. */
      WHEN 4 THEN 
      DO: 
        IF RmtFile = ? THEN 
        DO:
          MESSAGE            
            gRmtFullPath + 
            OS-SLASH +
            /* If path was added show path and file as entered in filename */
            IF gPathAdded 
            THEN filename:SCREEN-VALUE 
            ELSE (cb_dirs:SCREEN-VALUE +
                  OS-SLASH 
                  +
                  gFilter) 
            "This path or file does not exist." SKIP
            "Make sure that the correct path is given."             
           VIEW-AS ALERT-BOX WARNING 
           TITLE FRAME {&FRAME-NAME}:TITLE.
          
          IF gPathAdded THEN 
          DO:           
            /* Remove the directory that was added when starting the filesearch */  
            cb_dirs:DELETE(cb_dirs:SCREEN-VALUE).
            ASSIGN
              cb_dirs:SCREEN-VALUE = gOldPath
              cb_dirs. 
          END.

          /*
          This is the case were the invalid directory already 
          was in the box.
          Because the path remains visible in the combo-box 
          we clear data belonging to previous path.*/ 
          ELSE
          DO:
            s_files:LIST-ITEMS = "":U.
            IF NOT gFileSearch THEN
              filename:SCREEN-VALUE = "":U.                   
          END.     
          ASSIGN lError = TRUE.
          LEAVE.          
        END.
       
        ASSIGN 
          OS-SLASH     = IF INDEX(RmtFile,DOS-SLASH) > 0 
                         THEN DOS-SLASH
                         ELSE UNIX-SLASH 
          gRmtFullPath = DYNAMIC-FUNCTION("GetHostName") 
                         + ":":U 
                         + RmtFile
        
          fiCurDir:SCREEN-VALUE IN FRAME {&FRAME-NAME} = 
               DYNAMIC-FUNCTION("getHostName") + ":":U + RmtFile.
        
        NEXT. 
      END.
      WHEN 5 THEN
      DO:
       
        /***
        Keep data in case of error 
        Don't blank current data until we are certain that the 
        first 4 lines are ok  */
        
        FOR EACH tRmtFile:
          DELETE tRmtFile. 
        END.  
        
        /* 
        We can empty the list at this stage because we know that 
        something will be displayed.
        But if gFilesearch we don't know if we found the file until 
        all files are read (Because all directories are returned)            
        */ 
        
        IF NOT gFileSearch THEN
          ASSIGN 
            s_files:LIST-ITEMS = "".
          
      END.         
    END CASE.
    
    IF ReadCnt < 5 OR RmtFile = "" THEN NEXT.
         
    CREATE tRmtFile.
    ASSIGN 
      tRmtFile.Name     = RmtFile
      tRmtFile.FileType = FileType.
     
    /*** 
    ALL directories are returned from server, 
    but should only be added to the selection list if they  
    match filter criteria and gFilesearch is false */ 
  
    IF fileType eq "F":U 
    OR (NOT gFileSearch AND RmtFile MATCHES cb_Filters:SCREEN-VALUE) THEN
    DO:
      /* only ONE if gfilesearch */
      IF gFileSearch THEN 
        s_files:LIST-ITEMS = RmtFile.
      ELSE
      IF NOT (gTitle MATCHES "*SmartDataObject*" 
              AND RmtFile MATCHES xMatchClient) THEN
        s_files:ADD-LAST(RmtFile).
      
      tRmtFile.Num   = s_files:LOOKUP(RmtFile).                  
    END.
  END.
  
  IF NOT lERROR THEN
  DO WITH FRAME {&FRAME-NAME}:    
   
    IF gFileSearch THEN
    DO: 
      IF s_files:LIST-ITEMS = gFilter THEN
      DO:
        ASSIGN filename:SCREEN-VALUE = gFilter.  
        APPLY "U1" TO THIS-PROCEDURE.
      END.
      ELSE do:
          &if defined(IDE-IS-RUNNING) <> 0 &then  
          if OEIDE_CanShowMessage() then 
              ShowMessageInIDE("File: " + filename:SCREEN-VALUE + " was not found.","Error":U,?,"ok":U,true).
          else    
          &endif    
          
          MESSAGE "File: " + filename:SCREEN-VALUE + " was not found." 
             VIEW-AS ALERT-BOX ERROR BUTTONS OK.    
      end.     
    END. 
    ELSE IF s_files:NUM-ITEMS = 0 THEN 
       s_files:LIST-ITEMS = "<none>". 
    ELSE 
      RUN Set_First.          
     
  END.

  /* Blank data set in changefilter for filesearch */
  ASSIGN
    gFileSearch = FALSE
    gFilter     = "":U
    gPathAdded  = FALSE
    gOldPath    = "":U.
    
  INPUT STREAM instream CLOSE.
  
  VIEW FRAME {&FRAME-NAME}.
    
  OS-DELETE VALUE(DYNAMIC-FUNCTION("getlocalfilename")).

  RUN adecomm/_setcurs.p ("":U).

END PROCEDURE.


PROCEDURE OCX.HTTPServerConnection :
/*------------------------------------------------------------------------------
  Purpose:     
  Parameters:  <none>
  Notes:       
------------------------------------------------------------------------------*/ 
  Run adecomm/_setcurs.p("WAIT":U).
  
  DO WITH FRAME {&FRAME-NAME}:
    /* 
    If both path and filename is entered as a filesearch, 
    we must use only the filename as filter */
     
    IF gFileSearch THEN 
      ASSIGN 
        gFilter = REPLACE(filename:SCREEN-VALUE,DOS-SLASH,UNIX-SLASH)
        gFilter = IF NUM-ENTRIES(gFilter,UNIX-SLASH) > 1 
                  THEN ENTRY(NUM-ENTRIES(gFilter,UNIX-SLASH),gFilter,UNIX-SLASH)
                  ELSe gFilter.    
    ELSE 
      ASSIGN
        gFilter =  cb_filters:SCREEN-VALUE.      
    
    RUN GetData
          ("webutil/_weblist.w":U,
           "directory=":U 
            + cb_dirs:SCREEN-VALUE
            + "&filter=":U 
            + gFilter).
             
  END.
END PROCEDURE.


PROCEDURE OCX.WSAError :
/*------------------------------------------------------------------------------
  Purpose:     
  Parameters:  <none>
  Notes:       
------------------------------------------------------------------------------*/
  DEFINE INPUT PARAMETER pError AS INTEGER.
  
  ASSIGN gError = TRUE.
 
  APPLY "U1" TO THIS-PROCEDURE.  
 
END PROCEDURE.


PROCEDURE processObj :
/*------------------------------------------------------------------------------
  Purpose: 
    Notes: Called from check_filechosen.      
------------------------------------------------------------------------------*/
  DEFINE OUTPUT PARAMETER p_OK AS LOGICAL NO-UNDO INITIAL yes.
  
  define variable cResolvePath as character no-undo.
  define variable iDir         as integer no-undo.
  define variable cDir         as character no-undo.
  define variable lFullDir     as logical no-undo.
  DO WITH FRAME {&FRAME-NAME}:
    /* 
    Don't use ./ on web because the value is displayed in fill-ins
    We should always use UNIX-SLASH to get portable code */                              

    IF p_mode = "WEB":U THEN  
           ASSIGN p_fileChosen =
                (IF cb_dirs:SCREEN-VALUE = ".":U THEN "":U
                 ELSE cb_dirs:SCREEN-VALUE 
                      + UNIX-SLASH )
                      
                 + filename:SCREEN-VALUE. 
   ELSE do:
      
      assign 
          cDir         = cb_dirs:SCREEN-VALUE             
          lFullDir     = (cDir begins "/" or cDir begins "~\" or index(cDir,":") <> 0)
          iDir         = lookup(cDir,gDirs)
          p_fileChosen = cb_dirs:SCREEN-VALUE + OS-SLASH + filename:SCREEN-VALUE.
      
      if idir > 0 then 
      do:    
          cResolvePath = entry(iDir,gTDirs) + OS-SLASH + filename:SCREEN-VALUE. 
          /* resolve relative path from full path file 
             prompts if relative name shadowed by other file in propath */
          run adecomm/_resolvepath.p (input-output cResolvePath).
          if cResolvePath = "" then 
             p_Ok = false.
          
          /* the if test is likely not required, but to be 100% sure that 
             old behavior is kept intact with relative directories 
             (ie ./<file> when pciking files from current )  */   
          if lFullDir then   
              p_fileChosen = cResolvePath.   
      end.
       
   end.
  END.
END PROCEDURE.


PROCEDURE processOCX :
/*------------------------------------------------------------------------------
  Purpose:     
  Parameters:  <none>
  Notes:       
------------------------------------------------------------------------------*/
DEFINE OUTPUT PARAMETER OCXStatus AS INTEGER NO-UNDO INITIAL 1.

DEFINE VARIABLE pos      AS INTEGER   NO-UNDO.
define variable s        as integer   no-undo.
define variable cList    as character no-undo.
define variable fullName as character no-undo.
define variable ldummy   as logical   no-undo.


do with frame {&FRAME-NAME}:

    /*
     * If there is already a p_fileChosen and p_otherThing that
     * means that the user has come through here before (probably
     * did a ppreview). Return with the same values. This is
     * needed if there is a OCX dll with multiple OCXs. If
     * we go through the code again the user will be forced to
     * pick the dialog box again.
     */

    if p_fileChosen <> "" and p_otherThing <> "" then return.
    
    assign
        fullName = cb_dirs:SCREEN-VALUE + OS-SLASH + s_files:SCREEN-VALUE
        p_fileChosen = s_files:SCREEN-VALUE 
      .
    /*
     * The user supplied a OCX DLL. Go get the control..
     */
    
    /* Call to GetControlsOfLib moved to _getctrl.p */    
    RUN adeuib/_getctrl.p (INPUT fullName, OUTPUT cList, OUTPUT s).
    
    if s <> 0 then do:
       assign
           p_fileChosen = ""
           OCXStatus = -1
       .

        return.
    end.
    /*
     * IF there are more than 1 control in the OCX then present the
     * user with a choice.
     */
   
    if num-entries(cList, chr(10)) = 0 then do:
    
       /*
        * There is a problem. 
        */
       &if defined(IDE-IS-RUNNING) <> 0 &then  
          if OEIDE_CanShowMessage() then 
              ShowMessageInIDE("A problem was detected trying to access the " + fullname + " control.","Error":U,?,"ok":U,true).
          else    
       &endif  
         message "A problem was detected trying to access the" skip
                  fullname " control." skip

               view-as alert-box.
       assign
           p_fileChosen = ""
           OCXStatus = -1
       .
       return.
    end.

    if num-entries(cList, chr(10)) > 1 then do:

        Run adecomm/_setcurs.p("WAIT").
        Run adeuib/_mulcont.w("Choose control from " + p_fileChosen,
                                          replace(cList,chr(10), ","),
                              entry(1, cList, chr(10)),
                              output p_otherThing,
                              output lDummy).
                              
        if lDummy = true then do:
           assign
               p_fileChosen = ""
               OCXStatus = -1.
           .
           return.
        end.
    end.
    else do:

        p_otherThing = entry(1, cList, CHR(10)).
    end.        
end.
END PROCEDURE.


PROCEDURE Setup :
/* -----------------------------------------------------------
  Purpose:     Setup dialog
  Parameters:  <none>
  Notes:       
-------------------------------------------------------------*/
DEFINE OUTPUT PARAMETER rc AS LOGICAL INITIAL yes.
DEFINE VARIABLE         i  AS INTEGER NO-UNDO.
DEFINE VARIABLE cPMDir     AS CHARACTER  NO-UNDO.
DEFINE VARIABLE cStart     AS CHARACTER  NO-UNDO.

DO WITH FRAME {&FRAME-NAME}:
  IF p_cst-attr <> "" THEN DO:
    DO i = 1 TO NUM-ENTRIES(p_cst-attr,CHR(10)):
        IF ENTRY(i,p_cst-attr,CHR(10)) BEGINS "DIRECTORY-LIST" THEN
            gDirs = TRIM(SUBSTRING(TRIM(ENTRY(i,p_cst-attr,CHR(10))),15,-1,"CHARACTER")).
        ELSE IF ENTRY(i,p_cst-attr,CHR(10)) BEGINS "FILTER" THEN
            gFilters = TRIM(SUBSTRING(TRIM(ENTRY(i,p_cst-attr,CHR(10))),7,-1,"CHARACTER")).
        ELSE IF ENTRY(i,p_cst-attr,CHR(10)) BEGINS "TITLE" THEN
            gTitle = TRIM(SUBSTRING(TRIM(ENTRY(i,p_cst-attr,CHR(10))),6,-1,"CHARACTER")).
    END.
    IF gDirs = "" OR gFilters = "" THEN DO:
        rc = no.
        RETURN.
    END.
    IF gTitle = "" THEN DO:
      IF p_mode = "{&WT-CONTROL}" THEN gTitle = "Choose {&WL-CONTROL}".
                                ELSE gTitle = "Choose Object".
    END.
                
    /* add current product module to list if dynamics is running */
    cPMDir = getCurrentPmDir().
    IF cPmDir > '' AND LOOKUP(cPmDir,gDirs) = 0 THEN
    DO:
       file-info:file-name = cPmDir.
       if index(file-info:file-type,"D") > 0 then 
       do: 
        
          /* since this in theory is user defined data ensure that the first 
             specified directory still is the first (as for now also for current) */ 
          cStart = ENTRY(1,gDirs).
          gDirs = cPmDir + ',' + gDirs.
       end.
    END.

    /* 
    Don't do this for remote. We could perhaps check directories 
    after running BuildFielList, but it would cost too much if multi leveldirectories
    are used, so we leave the error messages until someone tries to use them. 
    That's also more in line with good UI standards */
    
    IF NOT gRemoteFile THEN  
      RUN Check_Dirs.
    ASSIGN cb_filters:LIST-ITEMS     = gFilters
           cb_dirs:LIST-ITEMS        = gDirs
           cb_filters:SCREEN-VALUE   = cb_filters:ENTRY(1)
           cb_dirs:SCREEN-VALUE      = cb_dirs:ENTRY(1)
           cb_dirs                   = cb_dirs:SCREEN-VALUE
           cb_filters                = cb_filters:SCREEN-VALUE
           filename                  = ""
           p_otherThing              = ""
          &if defined(IDE-IS-RUNNING) = 0 &then
           FRAME {&FRAME-NAME}:TITLE = gTitle
          &endif
        .
     IF cStart > '' THEN
       cb_dirs:SCREEN-VALUE = cStart.   
    IF p_mode = "{&WT-CONTROL}" THEN listlbl = "{&WL-CONTROL}" + ":".
  END.
  ELSE rc = no.
END.         
END PROCEDURE.


PROCEDURE Set_First :
/* -----------------------------------------------------------
  Purpose:     Selects the first file in the list.
  Parameters:  <none>
  Notes:       
-------------------------------------------------------------*/
DO WITH FRAME {&FRAME-NAME}:
  IF s_files:NUM-ITEMS > 0 AND s_files:ENTRY(1) NE "<None>" THEN
      ASSIGN s_files:SCREEN-VALUE = s_files:ENTRY(1).
  APPLY "VALUE-CHANGED" TO s_files IN FRAME {&FRAME-NAME}.
  APPLY "ENTRY" TO s_files IN FRAME {&FRAME-NAME}.

END.  
END PROCEDURE.


PROCEDURE Set_Sensitivity :
/*------------------------------------------------------------------------------
  Purpose:     Sets the Sensitivity of various items in the dialog-box based
               on the current situation. 
  Parameters:  <none>
  Notes:       
------------------------------------------------------------------------------*/
  DO WITH FRAME {&FRAME-NAME}:
    /* We cannot preview if there are no files selected. */
    b_Preview:SENSITIVE = (filename:SCREEN-VALUE ne "").
  END.
END PROCEDURE.


/* ************************  Function Implementations ***************** */

FUNCTION getCurrentPMDir RETURNS CHARACTER
  (   ) :
/*------------------------------------------------------------------------------
  Purpose:  
    Notes:  
------------------------------------------------------------------------------*/
  DEFINE VARIABLE hManager    AS HANDLE     NO-UNDO.
  DEFINE VARIABLE cModule     AS CHARACTER  NO-UNDO.
  DEFINE VARIABLE cModulelist AS CHARACTER  NO-UNDO.
  DEFINE VARIABLE iModule     AS INTEGER    NO-UNDO.
  hManager = getDesignManager().
 
  IF VALID-HANDLE(hManager) THEN
  DO:
    cModuleList = DYNAMIC-FUNCTION("getproductModuleList":U IN hManager,
                  "product_module_Code":U,
                  "relative_path":U,
                  /* './' to avoid lookup of path below if module has same name */
                  "./&1":U, 
                  CHR(1)).
    cModule = DYNAMIC-FUNC("getCurrentProductModule":U IN hManager).
    cModule = IF INDEX(cModule,"//":U) > 0 
              THEN RIGHT-TRIM(SUBSTRING(cModule,1,INDEX(cModule,"//":U) - 1))
              ELSE cModule.

    iModule = LOOKUP(cModule,cModuleList,CHR(1)).
    IF iModule > 0 THEN
      RETURN SUBSTR(ENTRY(iModule - 1,cModuleList,CHR(1)),3).
  END.
  RETURN "".   

END FUNCTION.


FUNCTION getDesignManager RETURNS HANDLE
  (  ) :
/*------------------------------------------------------------------------------
  Purpose:  
    Notes:  
------------------------------------------------------------------------------*/
  DEFINE VARIABLE hManager AS HANDLE     NO-UNDO.
  DEFINE VARIABLE cNum AS CHARACTER  NO-UNDO.
  DEFINE VARIABLE cLicense AS CHARACTER  NO-UNDO.
  RUN adeshar/_ablic.p (INPUT NO, OUTPUT cNum, OUTPUT cLicense).
  
  IF LOOKUP('enable-icf':U,cLicense) > 0 THEN
    ASSIGN hManager = DYNAMIC-FUNCTION("getManagerHandle":U, INPUT "RepositoryDesignManager":U).

  RETURN hManager.

END FUNCTION.


&ANALYZE-SUSPEND _VERSION-NUMBER UIB_v9r12
&ANALYZE-RESUME
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _DEFINITIONS Procedure 
/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/
/*------------------------------------------------------------------------
    File        : adecomm/_chossdo.p
    Purpose     : Start the Choose SO dialog-box to choose a SmartDataObject.  
  
  Input Parameters:
     pcShowOptions (char) - Buttons to enable in the Choose SO dialog-box.
                            
                            BROWSE, NEW, PREVIEW 
                            
                            Avoid the use of NEW if this is called from a 
                            WIZARD, because NEW will try to call another wizard.
                            This does not work. 
                            
     plWeb         (log)  - Yes for WEB. 
                            The dialog will check the development mode and 
                            search remotely or locally accordingly.     
                          - No - always search locally
  Input-Output Parameters:
     piocDataObject(char) - Filename of selected SmartDataObject.
                            There's no real use of the input value 
                            except that it is returned unchanged if the dialog
                            is cancelled.    
  
  Description   : Reads info to use as input to the dialog from  .cst definitions.  
                   
  Author: Håvard Danielsen 

  Created: 06/22/99
  
  Note:    The object type "SmartDataObject" is a constant.
           The reason is that it isn't a parameter is that the SDO is the
           only SO that needs to be read outside of the AppBuilder
           and also the only one that need to be read from a remote file system.                 
  ----------------------------------------------------------------------*/
/*          This .W file was created with the Progress AppBuilder.      */
/*----------------------------------------------------------------------*/

/* ***************************  Definitions  ************************** */
  DEFINE INPUT        PARAMETER pcShowOptions  AS CHARACTER NO-UNDO.
  DEFINE INPUT        PARAMETER plWeb          AS LOGICAL   NO-UNDO.
  DEFINE INPUT-OUTPUT PARAMETER piocDataObject AS CHARACTER NO-UNDO.
  
  
  DEFINE VARIABLE lCancelled  AS LOGICAL              NO-UNDO.
  DEFINE VARIABLE cOtherthing AS CHARACTER            NO-UNDO.
  DEFINE VARIABLE cAttributes AS CHARACTER            NO-UNDO.  
  DEFINE VARIABLE cTemplate   AS CHARACTER            NO-UNDO.  
  DEFINE VARIABLE cObjLabel   AS CHARACTER            NO-UNDO.  
  DEFINE VARIABLE cDataObject AS CHARACTER            NO-UNDO.  
  define variable cProjects as character no-undo.
  define variable cDirs as character no-undo.
  define variable iPos as integer no-undo.
  DEFINE VARIABLE xcSmartDataObject AS CHAR NO-UNDO INIT "SmartDataObject":U.

{adecomm/oeideservice.i}
function getRequestContext returns char () in hOEIDEService.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME


&ANALYZE-SUSPEND _UIB-PREPROCESSOR-BLOCK 

/* ********************  Preprocessor Definitions  ******************** */

&Scoped-define PROCEDURE-TYPE Procedure
&Scoped-define DB-AWARE no



/* _UIB-PREPROCESSOR-BLOCK-END */
&ANALYZE-RESUME



/* *********************** Procedure Settings ************************ */

&ANALYZE-SUSPEND _PROCEDURE-SETTINGS
/* Settings for THIS-PROCEDURE
   Type: Procedure
   Allow: 
   Frames: 0
   Add Fields to: Neither
   Other Settings: CODE-ONLY COMPILE
 */
&ANALYZE-RESUME _END-PROCEDURE-SETTINGS

/* *************************  Create Window  ************************** */

&ANALYZE-SUSPEND _CREATE-WINDOW
/* DESIGN Window definition (used by the UIB) 
  CREATE WINDOW Procedure ASSIGN
         HEIGHT             = 15
         WIDTH              = 60.
/* END WINDOW DEFINITION */
                                                                        */
&ANALYZE-RESUME

 


&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _MAIN-BLOCK Procedure 


/* ***************************  Main Block  *************************** */

  RUN adeuib/_uibinfo.p (
      INPUT ?,
      INPUT "PALETTE-ITEM ":U + xcSmartDataObject,
      INPUT "ATTRIBUTES":U,
      OUTPUT cAttributes).
  
  /* Get template if the NEW button is shown */
    
  IF CAN-DO(pcShowOptions,"NEW":U) THEN
    RUN adeuib/_uibinfo.p (
       INPUT ?,
       INPUT "PALETTE-ITEM ":U + xcSmartDataObject,
       INPUT "TEMPLATE":U,
       OUTPUT cTemplate).
  
  
  
  cDataObject = piocDataObject.
  IF cAttributes <> "":U THEN
  DO:
    if OEIDE_CanLaunchDialog() then
    do:    
        IF ENTRY(1,cAttributes,CHR(10)) BEGINS "DIRECTORY-LIST" THEN 
        DO:
            cProjects = getRequestContext().          
            /** if shared projects add them to directory list (replace  current if applicable)  */
            if cProjects > "" then 
            do:
                cDirs = TRIM(SUBSTRING(TRIM(ENTRY(1,cAttributes,CHR(10))),15,-1,"CHARACTER")).
                iPos = lookup(".",cDirs).
                if(iPos > 0) then
                do:
                    entry(iPos,cDirs) = cProjects. 
                end.    
                else do:
                    cDirs = cProjects + "," + cDirs.
                end.
                ENTRY(1,cAttributes,CHR(10)) = "DIRECTORY-LIST" + " " + cDirs.
            end.    
        END. 
        
        RUN adeuib/ide/_dialog_chosobj.p(
            INPUT (IF plweb THEN "WEB":U  
                   ELSE "SmartObject":U),           
            INPUT cAttributes,
            INPUT cTemplate,
            INPUT  pcShowOptions,
            OUTPUT piocDataObject,
            OUTPUT cOtherThing,
            OUTPUT lCancelled).
    end.
    else do:
         RUN adecomm/_chosobj.w (
            INPUT (IF plweb THEN "WEB":U  
                   ELSE "SmartObject":U),           
            INPUT cAttributes,
            INPUT cTemplate,
            INPUT  pcShowOptions,
            OUTPUT piocDataObject,
            OUTPUT cOtherThing,
            OUTPUT lCancelled).  
    end.
         
    /* Reset if cancelled */
    IF lCancelled THEN 
      piocDataObject = cDataObject.
    
    /* Remove 'current directory' period and replace backslashes with slash */  
    ELSE DO:
      piocDataObject = REPLACE(piocDataObject,"~\":U,"/":U).
      IF piocDataObject BEGINS "./":U THEN        
        piocDataObject = SUBSTR(piocDataObject,3).
    END.
  END. /* IF cAttributes <> "" */

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME


/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/
/*----------------------------------------------------------------------------

File: _chscolor.p

Description: This dialog serves as a common color chooser.  The tricky point
             to represent is the DEFAULT color.  A button should show the
             default color of its frame for the default, while a frame or
             window should show the System Default.

Input Parameters: ipTitle        - Title for the dialog
                  cipMessage     - Message to write at bottom of screen
                                   (e.g."Button color has no effect on Windows")
                  lipSeparator   - Indicates if separator colors need to display for browse widgets
		    iipDfltBgColor - color number to use as default background
		    iipDfltFgColor - color number to use as default foreground
		    iipDfltSpColor - color number to use as default separator color
Input-Output Parameters:
                  iiopBgColor - background color number
		    iiopFgColor - foreground color number
		    iiopSpColor - separator color number
Output Parameters:  pressed_OK  - FALSE if cancelled dialog box.

Author: Ravi-Chandar Ramalingam

Date Created: 31 March 1993

Modifications:
  9/15/93 wood  Added explicit default colors (iipDfltBgColor etc). 
  7/18/05 wood  Allow editting of color < 16 (bug # 95-06-30-052)
  6/14/99 tsm   Added separator fgcolor for browse widgets
---------------------------------------------------------------------------- 
Test code:
def var iBgC AS INTEGER NO-UNDO.
def var iFgC AS INTEGER NO-UNDO.
def var pressed_OK  AS LOGICAL.
RUN adecomm/_chscolr.p ("Title", "message", FALSE, ?, ?, ?,
  INPUT-OUTPUT ibgc,
  INPUT-OUTPUT ifgc,
  INPUT-OUTPUT isc
  OUTPUT pressed_OK).
MESSAGE ibgc ifgc pressed_OK.
---------------------------------------------------------------------------- */

&GLOBAL-DEFINE WIN95-BTN YES

{adecomm/commeng.i}   /* Help pre-processor directives                       */
{adecomm/adestds.i}

/******************************* Definitions *********************************/
DEFINE INPUT        PARAMETER ipTitle AS CHARACTER NO-UNDO. 
DEFINE INPUT        PARAMETER cipMessage AS CHARACTER NO-UNDO.
DEFINE INPUT        PARAMETER lipSeparator AS LOGICAL NO-UNDO.
DEFINE INPUT        PARAMETER iipDfltBgColor AS INTEGER NO-UNDO.
DEFINE INPUT        PARAMETER iipDfltFgColor AS INTEGER NO-UNDO.
DEFINE INPUT        PARAMETER iipDfltSpColor AS INTEGER NO-UNDO.
DEFINE INPUT-OUTPUT PARAMETER iiopBgColor AS INTEGER NO-UNDO.
DEFINE INPUT-OUTPUT PARAMETER iiopFgColor AS INTEGER NO-UNDO.
DEFINE INPUT-OUTPUT PARAMETER iiopSpColor AS INTEGER NO-UNDO.
DEFINE       OUTPUT PARAMETER pressed_OK  AS LOGICAL.

&Global-define SKP ""

DEFINE BUTTON bOk LABEL "OK" {&STDPH_OKBTN} AUTO-GO.
DEFINE BUTTON bCancel LABEL "Cancel" {&STDPH_OKBTN} AUTO-END-KEY.
DEFINE BUTTON bHelp LABEL "&Help" {&STDPH_OKBTN}.

DEFINE BUTTON bfcEdit LABEL "Edit..." SIZE 9 BY 1.
DEFINE BUTTON bbcEdit LIKE bfcEdit.
DEFINE BUTTON bscEdit LIKE bfcEdit.

DEFINE BUTTON bSave LABEL "&Save Color Settings":C20 SIZE 22 BY {&H_OKBTN} MARGIN-EXTRA DEFAULT.

DEFINE BUTTON ifcLeftArrow IMAGE-UP FILE "btn-left-arrow".
DEFINE BUTTON ifcRightArrow IMAGE-UP FILE "btn-right-arrow".

DEFINE BUTTON ibcLeftArrow LIKE ifcLeftArrow.
DEFINE BUTTON ibcRightArrow LIKE ifcRightArrow.

DEFINE BUTTON iscLeftArrow LIKE ifcLeftArrow.
DEFINE BUTTON iscRightArrow LIKE ifcRightArrow.

DEFINE VARIABLE lChanged AS LOGICAL NO-UNDO.
DEFINE VARIABLE lSaved AS LOGICAL NO-UNDO.
DEFINE VARIABLE highest-color AS INTEGER NO-UNDO.

DEFINE VARIABLE tFgTitle AS CHARACTER
	INITIAL "Foreground Colors: " FORMAT "x(22)".
DEFINE VARIABLE tBgTitle AS CHARACTER
	INITIAL "Background Colors: " FORMAT "x(22)".
DEFINE VARIABLE tScTitle AS CHARACTER
	INITIAL "Separator Foreground Colors: " FORMAT "x(30)".

DEFINE RECTANGLE rFgHilite SIZE-PIXELS 1 BY 1 
                           FGCOLOR ? BGCOLOR ? EDGE-PIXELS 3 NO-FILL.
DEFINE RECTANGLE rBgHilite LIKE rFgHilite.  
DEFINE RECTANGLE rScHilite LIKE rFgHilite.     

DEFINE VARIABLE iBgColor AS INTEGER NO-UNDO.
DEFINE VARIABLE iFgColor AS INTEGER NO-UNDO.
DEFINE VARIABLE iSpColor AS INTEGER NO-UNDO.

DEFINE VARIABLE tSample AS CHARACTER FORMAT "X(7)" NO-UNDO.
DEFINE RECTANGLE rSample SIZE-CHAR 20 BY 1 EDGE-PIXELS 2 BGCOLOR 0.
DEFINE VARIABLE tMessage AS CHARACTER FORMAT "X(65)" VIEW-AS TEXT.
&if DEFINED(IDE-IS-RUNNING) <> 0 &then
define variable CallResult as logical no-undo.
 &endif     
/* standard button rectangle */
&IF {&OKBOX} &THEN
DEFINE RECTANGLE rHeavyRule {&STDPH_OKBOX}.
&ENDIF

DEFINE VARIABLE tfc1 AS CHARACTER FORMAT "X(3)" 
       VIEW-AS TEXT SIZE 3 BY 1.
DEFINE VARIABLE tfc2 LIKE tfc1.
DEFINE VARIABLE tfc3 LIKE tfc1.
DEFINE VARIABLE tfc4 LIKE tfc1.
DEFINE VARIABLE tfc5 LIKE tfc1.
DEFINE VARIABLE tfc6 LIKE tfc1.
DEFINE VARIABLE tfc7 LIKE tfc1.
DEFINE VARIABLE tfc8 LIKE tfc1.
DEFINE VARIABLE tfc9 LIKE tfc1.
DEFINE VARIABLE tfc10 LIKE tfc1.
DEFINE VARIABLE tfc11 LIKE tfc1.
DEFINE VARIABLE tfc12 LIKE tfc1.
DEFINE VARIABLE tfc13 LIKE tfc1.
DEFINE VARIABLE tfc14 LIKE tfc1.
DEFINE VARIABLE tfc15 LIKE tfc1.
DEFINE VARIABLE tfc16 LIKE tfc1.

DEFINE VARIABLE tbc1 LIKE tfc1.
DEFINE VARIABLE tbc2 LIKE tfc1.
DEFINE VARIABLE tbc3 LIKE tfc1.
DEFINE VARIABLE tbc4 LIKE tfc1.
DEFINE VARIABLE tbc5 LIKE tfc1.
DEFINE VARIABLE tbc6 LIKE tfc1.
DEFINE VARIABLE tbc7 LIKE tfc1.
DEFINE VARIABLE tbc8 LIKE tfc1.
DEFINE VARIABLE tbc9 LIKE tfc1.
DEFINE VARIABLE tbc10 LIKE tfc1.
DEFINE VARIABLE tbc11 LIKE tfc1.
DEFINE VARIABLE tbc12 LIKE tfc1.
DEFINE VARIABLE tbc13 LIKE tfc1.
DEFINE VARIABLE tbc14 LIKE tfc1.
DEFINE VARIABLE tbc15 LIKE tfc1.
DEFINE VARIABLE tbc16 LIKE tfc1.

DEFINE VARIABLE tsc1 LIKE tfc1.
DEFINE VARIABLE tsc2 LIKE tfc1.
DEFINE VARIABLE tsc3 LIKE tfc1.
DEFINE VARIABLE tsc4 LIKE tfc1.
DEFINE VARIABLE tsc5 LIKE tfc1.
DEFINE VARIABLE tsc6 LIKE tfc1.
DEFINE VARIABLE tsc7 LIKE tfc1.
DEFINE VARIABLE tsc8 LIKE tfc1.
DEFINE VARIABLE tsc9 LIKE tfc1.
DEFINE VARIABLE tsc10 LIKE tfc1.
DEFINE VARIABLE tsc11 LIKE tfc1.
DEFINE VARIABLE tsc12 LIKE tfc1.
DEFINE VARIABLE tsc13 LIKE tfc1.
DEFINE VARIABLE tsc14 LIKE tfc1.
DEFINE VARIABLE tsc15 LIKE tfc1.
DEFINE VARIABLE tsc16 LIKE tfc1.

DEFINE VARIABLE tFgDefault LIKE tfc1.
DEFINE VARIABLE tBgDefault LIKE tfc1.
DEFINE VARIABLE tScDefault LIKE tfc1.

DEFINE RECTANGLE rfc0 SIZE-CHAR 3.2 BY 1 EDGE-PIXELS 1.
DEFINE RECTANGLE rfc1 LIKE rfc0.
DEFINE RECTANGLE rfc2 LIKE rfc0.
DEFINE RECTANGLE rfc3 LIKE rfc0.
DEFINE RECTANGLE rfc4 LIKE rfc0.
DEFINE RECTANGLE rfc5 LIKE rfc0.
DEFINE RECTANGLE rfc6 LIKE rfc0.
DEFINE RECTANGLE rfc7 LIKE rfc0.
DEFINE RECTANGLE rfc8 LIKE rfc0.
DEFINE RECTANGLE rfc9 LIKE rfc0.
DEFINE RECTANGLE rfc10 LIKE rfc0.
DEFINE RECTANGLE rfc11 LIKE rfc0.
DEFINE RECTANGLE rfc12 LIKE rfc0.
DEFINE RECTANGLE rfc13 LIKE rfc0.
DEFINE RECTANGLE rfc14 LIKE rfc0.
DEFINE RECTANGLE rfc15 LIKE rfc0.

DEFINE RECTANGLE rbc0 LIKE rfc0.
DEFINE RECTANGLE rbc1 LIKE rfc0.
DEFINE RECTANGLE rbc2 LIKE rfc0.
DEFINE RECTANGLE rbc3 LIKE rfc0.
DEFINE RECTANGLE rbc4 LIKE rfc0.
DEFINE RECTANGLE rbc5 LIKE rfc0.
DEFINE RECTANGLE rbc6 LIKE rfc0.
DEFINE RECTANGLE rbc7 LIKE rfc0.
DEFINE RECTANGLE rbc8 LIKE rfc0.
DEFINE RECTANGLE rbc9 LIKE rfc0.
DEFINE RECTANGLE rbc10 LIKE rfc0.
DEFINE RECTANGLE rbc11 LIKE rfc0.
DEFINE RECTANGLE rbc12 LIKE rfc0.
DEFINE RECTANGLE rbc13 LIKE rfc0.
DEFINE RECTANGLE rbc14 LIKE rfc0.
DEFINE RECTANGLE rbc15 LIKE rfc0.

DEFINE RECTANGLE rsc0 LIKE rfc0.
DEFINE RECTANGLE rsc1 LIKE rfc0.
DEFINE RECTANGLE rsc2 LIKE rfc0.
DEFINE RECTANGLE rsc3 LIKE rfc0.
DEFINE RECTANGLE rsc4 LIKE rfc0.
DEFINE RECTANGLE rsc5 LIKE rfc0.
DEFINE RECTANGLE rsc6 LIKE rfc0.
DEFINE RECTANGLE rsc7 LIKE rfc0.
DEFINE RECTANGLE rsc8 LIKE rfc0.
DEFINE RECTANGLE rsc9 LIKE rfc0.
DEFINE RECTANGLE rsc10 LIKE rfc0.
DEFINE RECTANGLE rsc11 LIKE rfc0.
DEFINE RECTANGLE rsc12 LIKE rfc0.
DEFINE RECTANGLE rsc13 LIKE rfc0.
DEFINE RECTANGLE rsc14 LIKE rfc0.
DEFINE RECTANGLE rsc15 LIKE rfc0.

DEFINE RECTANGLE rfcDefault LIKE rfc0 EDGE-CHAR 1.6.
DEFINE RECTANGLE rbcDefault LIKE rfc0.
DEFINE RECTANGLE rscDefault LIKE rfc0.

DEFINE FRAME frColorEdit
  SKIP({&TFM_WID})
  rSample AT 30
  tSample AT ROW-OF rSample COL-OF rSample + 7 VIEW-AS TEXT NO-LABEL SKIP(1)

  tFgTitle VIEW-AS TEXT NO-LABEL AT 2 SKIP(0.4)
  ifcLeftArrow AT 2 SPACE ifcRightArrow SPACE(3)
  rfcDefault SPACE(0.5)
  rfc0 SPACE(0.5) rfc1 SPACE(0.5)
  rfc2 SPACE(0.5) rfc3 SPACE(0.5) rfc4 SPACE(0.5)
  rfc5 SPACE(0.5) rfc6 SPACE(0.5) rfc7 SPACE(0.5)
  rfc8 SPACE(0.5) rfc9 SPACE(0.5) rfc10 SPACE(0.5)
  rfc11 SPACE(0.5) rfc12 SPACE(0.5) rfc13 SPACE(0.5)
  rfc14 SPACE(0.5) rfc15 SPACE(0.5) bfcEdit SKIP(0.2)
  rFgHilite tfgDefault AT ROW-OF rFgHilite COL-OF rfcDefault + 1
  tfc1 AT ROW-OF rFgHilite COL-OF rfc0 + .5
  tfc2 AT ROW-OF rFgHilite COL-OF rfc1 + .5
  tfc3 AT ROW-OF rFgHilite COL-OF rfc2 + .5
  tfc4 AT ROW-OF rFgHilite COL-OF rfc3 + .5
  tfc5 AT ROW-OF rFgHilite COL-OF rfc4 + .5
  tfc6 AT ROW-OF rFgHilite COL-OF rfc5 + .5
  tfc7 AT ROW-OF rFgHilite COL-OF rfc6 + .5
  tfc8 AT ROW-OF rFgHilite COL-OF rfc7 + .5
  tfc9 AT ROW-OF rFgHilite COL-OF rfc8 + .5
  tfc10 AT ROW-OF rFgHilite COL-OF rfc9 + .5
  tfc11 AT ROW-OF rFgHilite COL-OF rfc10 + .3
  tfc12 AT ROW-OF rFgHilite COL-OF rfc11 + .3
  tfc13 AT ROW-OF rFgHilite COL-OF rfc12 + .3
  tfc14 AT ROW-OF rFgHilite COL-OF rfc13 + .3 
  tfc15 AT ROW-OF rFgHilite COL-OF rfc14 + .3
  tfc16 AT ROW-OF rFgHilite COL-OF rfc15 + .3 SKIP({&VM_WIDG})

  tBgTitle VIEW-AS TEXT NO-LABEL AT 2 SKIP(0.4)
  ibcLeftArrow AT 2 SPACE ibcRightArrow SPACE(3)
  rbcDefault SPACE(0.5)
  rbc0 SPACE(0.5) rbc1 SPACE(0.5)
  rbc2 SPACE(0.5) rbc3 SPACE(0.5) rbc4 SPACE(0.5)
  rbc5 SPACE(0.5) rbc6 SPACE(0.5) rbc7 SPACE(0.5)
  rbc8 SPACE(0.5) rbc9 SPACE(0.5) rbc10 SPACE(0.5)
  rbc11 SPACE(0.5) rbc12 SPACE(0.5) rbc13 SPACE(0.5)
  rbc14 SPACE(0.5) rbc15 SPACE(0.5) bbcEdit SKIP(0.2)
  rBgHilite tBgDefault AT ROW-OF rBgHilite COL-OF rbcDefault + 1
  tbc1 AT ROW-OF rBgHilite COL-OF rbc0 + .5
  tbc2 AT ROW-OF rBgHilite COL-OF rbc1 + .5 
  tbc3 AT ROW-OF rBgHilite COL-OF rbc2 + .5
  tbc4 AT ROW-OF rBgHilite COL-OF rbc3 + .5
  tbc5 AT ROW-OF rBgHilite COL-OF rbc4 + .5
  tbc6 AT ROW-OF rBgHilite COL-OF rbc5 + .5
  tbc7 AT ROW-OF rBgHilite COL-OF rbc6 + .5
  tbc8 AT ROW-OF rBgHilite COL-OF rbc7 + .5
  tbc9 AT ROW-OF rBgHilite COL-OF rbc8 + .5
  tbc10 AT ROW-OF rBgHilite COL-OF rbc9 + .5
  tbc11 AT ROW-OF rBgHilite COL-OF rbc10 + .3
  tbc12 AT ROW-OF rBgHilite COL-OF rbc11 + .3
  tbc13 AT ROW-OF rBgHilite COL-OF rbc12 + .3
  tbc14 AT ROW-OF rBgHilite COL-OF rbc13 + .3
  tbc15 AT ROW-OF rBgHilite COL-OF rbc14 + .3
  tbc16 AT ROW-OF rBgHilite COL-OF rbc15 + .3
  tMessage AT 2
  {adecomm/okform.i
      &BOX    = "rHeavyRule"
      &STATUS = "no"
      &OK     = "bOK"
      &CANCEL = "bCancel"
      &OTHER  = "space({&HM_DBTNG}) bSave"
      &HELP   = "bHelp"}
WITH NO-LABELS 
&if DEFINED(IDE-IS-RUNNING) = 0 &then
  TITLE ipTitle 
  VIEW-AS DIALOG-BOX  
&else
  no-box
&endif
DEFAULT-BUTTON bOK WIDTH 90.


DEFINE FRAME frSepColorEdit
  tScTitle VIEW-AS TEXT NO-LABEL AT 2 SKIP(0.4)
  iscLeftArrow AT 2 SPACE iscRightArrow SPACE(3)
  rscDefault SPACE(0.5)
  rsc0 SPACE(0.5) rsc1 SPACE(0.5)
  rsc2 SPACE(0.5) rsc3 SPACE(0.5) rsc4 SPACE(0.5)
  rsc5 SPACE(0.5) rsc6 SPACE(0.5) rsc7 SPACE(0.5)
  rsc8 SPACE(0.5) rsc9 SPACE(0.5) rsc10 SPACE(0.5)
  rsc11 SPACE(0.5) rsc12 SPACE(0.5) rsc13 SPACE(0.5)
  rsc14 SPACE(0.5) rsc15 SPACE(0.5) bscEdit SKIP(0.2)
  rScHilite tscDefault AT ROW-OF rScHilite COL-OF rscDefault + 1
  tsc1 AT ROW-OF rScHilite COL-OF rsc0 + .5
  tsc2 AT ROW-OF rScHilite COL-OF rsc1 + .5
  tsc3 AT ROW-OF rScHilite COL-OF rsc2 + .5
  tsc4 AT ROW-OF rScHilite COL-OF rsc3 + .5
  tsc5 AT ROW-OF rScHilite COL-OF rsc4 + .5
  tsc6 AT ROW-OF rScHilite COL-OF rsc5 + .5
  tsc7 AT ROW-OF rScHilite COL-OF rsc6 + .5
  tsc8 AT ROW-OF rScHilite COL-OF rsc7 + .5
  tsc9 AT ROW-OF rScHilite COL-OF rsc8 + .5
  tsc10 AT ROW-OF rScHilite COL-OF rsc9 + .5
  tsc11 AT ROW-OF rScHilite COL-OF rsc10 + .3
  tsc12 AT ROW-OF rScHilite COL-OF rsc11 + .3
  tsc13 AT ROW-OF rScHilite COL-OF rsc12 + .3
  tsc14 AT ROW-OF rScHilite COL-OF rsc13 + .3 
  tsc15 AT ROW-OF rScHilite COL-OF rsc14 + .3
  tsc16 AT ROW-OF rScHilite COL-OF rsc15 + .3 SKIP(1)
WITH NO-LABELS NO-BOX AT COL 1 ROW 10.5 BGCOLOR 8 WIDTH 87.
  
IF lipSeparator THEN
  ASSIGN FRAME frSepColorEdit:FRAME  = FRAME frColorEdit:HANDLE
         FRAME frSepColorEdit:HIDDEN = TRUE.

/* **************************** THREE-D Support *************************** */       
/* In 3D, we want to change some of the characteristics of the widgets
   to show better in this environment. Changes include:
      - Fill Default FGCOLOR with black
      - Fill Default BGCOLOR with grey (?)
      - Make Hilight box solid black
 */
IF SESSION:THREE-D THEN ASSIGN 
  rfcDefault:EDGE-PIXELS = 1
  rfcDefault:BGCOLOR     = 0
  rfcDefault:FILLED      = YES
  
  rbcDefault:EDGE-PIXELS = 2
  rbcDefault:FILLED      = YES

  rscDefault:EDGE-PIXELS = 1
  rscDefault:BGCOLOR     = 0
  rscDefault:FILLED      = YES
  
  rFgHilite:EDGE-PIXELS  = 1  
  rFgHilite:BGCOLOR      = 15
  rFgHilite:FILLED       = YES
  
  rBgHilite:EDGE-PIXELS  = 1
  rBgHilite:BGCOLOR      = 15
  rBgHilite:FILLED       = YES
  
  rScHilite:EDGE-PIXELS  = 1
  rScHilite:BGCOLOR      = 15
  rScHilite:FILLED       = YES
  .
/**************************** Internal Procedures ***************************/

PROCEDURE EditColor.
  DEFINE INPUT PARAMETER iipColorNumber AS INTEGER NO-UNDO.  
  
  DEF VAR lvAccepted AS LOGICAL NO-UNDO.
  DEF VAR old-red AS INTEGER NO-UNDO. 
  DEF VAR old-green AS INTEGER NO-UNDO. 
  DEF VAR old-blue AS INTEGER NO-UNDO. 
  
  IF iipColorNumber > -1 AND iipColorNumber < 256 THEN DO:
    ASSIGN lvAccepted = COLOR-TABLE:SET-DYNAMIC(iipColorNumber, TRUE)
           old-red    = COLOR-TABLE:GET-RED-VALUE(iipColorNumber)
           old-green  = COLOR-TABLE:GET-GREEN-VALUE(iipColorNumber)
           old-blue   = COLOR-TABLE:GET-BLUE-VALUE(iipColorNumber)
           . 
    SYSTEM-DIALOG COLOR iipColorNumber UPDATE lvAccepted. 
    /* If anything changed, then note the fact. */
    IF lvAccepted AND
       ((old-red   ne COLOR-TABLE:GET-RED-VALUE(iipColorNumber)) OR
        (old-green ne COLOR-TABLE:GET-GREEN-VALUE(iipColorNumber)) OR
        (old-blue  ne COLOR-TABLE:GET-BLUE-VALUE(iipColorNumber)) 
       )
    THEN ASSIGN lchanged      = YES
                highest-color = MAX(highest-color, iipColorNumber).
  END.
  ELSE
  do:
    &if DEFINED(IDE-IS-RUNNING) <> 0 &then
      define variable colnum as character no-undo.
      colnum = if iipColorNumber = ? then "?" else string(iipColorNumber).
      ShowMessageInIDE("Color number" + colnum + "is not valid. ~n
                        Valid color numbers are from 0 - 255.",
                        "Information","?","OK",yes).
      
    &else   
    MESSAGE "Color number" iipColorNumber "is not valid." SKIP
	    "Valid color numbers are from 0 - 255."
	VIEW-AS ALERT-BOX INFORMATION BUTTONS OK.
	&endif
  end.	
END PROCEDURE.

PROCEDURE GetStartingColorNumber.
  DEFINE INPUT PARAMETER iipColorNumber AS INTEGER.
  DEFINE OUTPUT PARAMETER iopColorStart AS INTEGER.

  ASSIGN iopColorStart = TRUNCATE(iipColorNumber / 16, 0) * 16.
END PROCEDURE.

PROCEDURE BoxRectangle.
  DEFINE INPUT PARAMETER whipRectangleHandle AS WIDGET-HANDLE.
  DEFINE INPUT PARAMETER whipBoxHandle AS WIDGET-HANDLE.
  DEFINE INPUT PARAMETER iipColorNumber AS INTEGER.

  ASSIGN whipBoxHandle:HIDDEN = TRUE
	 whipBoxHandle:X = whipRectangleHandle:X - 3
	 whipBoxHandle:Y = whipRectangleHandle:Y - 4
	 whipBoxHandle:WIDTH-PIXELS = whipRectangleHandle:WIDTH-PIXELS + 6
	 whipBoxHandle:HEIGHT-PIXELS = whipRectangleHandle:HEIGHT-PIXELS + 8
         whipBoxHandle:HIDDEN = FALSE.
END PROCEDURE.

PROCEDURE SetSampleForeground.
  DEFINE INPUT PARAMETER iipFgColor AS INTEGER.

  DO WITH FRAME frColorEdit: 
    /* Use the default color if the value is UNKNOWN. */    
    IF iipFgColor = ? THEN iipFgColor = iipDfltFgColor.
    ASSIGN bfcEdit:SENSITIVE = yes
           rSample:FGCOLOR = iipFgColor
	   tSample:FGCOLOR = iipFgColor.
  END.
END PROCEDURE.

PROCEDURE SetSampleBackground.
  DEFINE INPUT PARAMETER iipBgColor AS INTEGER.

  DO WITH FRAME frColorEdit:
    /* Use the default color if the value is UNKNOWN. */    
    IF iipBgColor = ? THEN iipBgColor = iipDfltBgColor. 
    IF iipBgColor eq ?
    THEN rSample:FILLED  = NOT (FRAME frColorEdit:THREE-D).
    ELSE rSample:FILLED  = YES.
    ASSIGN rSample:BGCOLOR = iipBgColor
	   tSample:BGCOLOR = iipBgColor.  
  END.
END PROCEDURE.

PROCEDURE InitializeColors.
  DEFINE VARIABLE ivfgColStart AS INTEGER INITIAL 0.
  DEFINE VARIABLE ivbgColStart AS INTEGER INITIAL 0.
  DEFINE VARIABLE ivspColStart AS INTEGER INITIAL 0.
  DEFINE VARIABLE dummy AS LOGICAL.

  DO WITH FRAME frColorEdit:
    IF COLOR-TABLE:NUM-ENTRIES < 16 THEN /* verify 16 color entries */
      ASSIGN COLOR-TABLE:NUM-ENTRIES = 16.

    ASSIGN FRAME frColorEdit:HIDDEN = TRUE
           highest-color = COLOR-TABLE:NUM-ENTRIES.
    RUN SetSampleForeground( iFgColor ).
    IF iFgColor = ? 
    THEN RUN SelectForegroundRectangle( ? ).
    ELSE DO:
      RUN GetStartingColorNumber( iFgColor, OUTPUT ivfgColStart ).
      RUN SelectForegroundRectangle(iFgColor - ivfgColStart).
    END.
    RUN SetForegroundRectangleColors( ivfgColStart ).
    dummy = rFgHilite:MOVE-TO-BOTTOM().
    IF iBgColor = ? 
    THEN RUN SelectBackgroundRectangle( ? ).
    ELSE DO:
      RUN GetStartingColorNumber( iBgColor, OUTPUT ivbgColStart ).
      RUN SelectBackgroundRectangle(iBgColor - ivbgColStart).
    END.
    RUN SetBackgroundRectangleColors( ivbgColStart ).
    dummy = rBgHilite:MOVE-TO-BOTTOM().
    /* Hide the frame and set the colors of the "default" boxes.  The
       default boxes might be a different color than ? (eg. if we
       are choosing the color of a fill-in, the defaults will be the
       frame defaults.  So fill in the Foreground rectangle with the
       FGCOLOR - this will only matter if it is not ?.  If it is ?
       then we can only see the default FGCOLOR on its edge */
    ASSIGN rbcDefault:BGCOLOR = IF (FRAME frColorEdit:THREE-D AND 
                                    iipDfltBgColor eq ?)
                                THEN 8
                                ELSE iipDfltBgColor
           rfcDefault:FGCOLOR = iipDfltFgColor  
           FRAME frColorEdit:HIDDEN = FALSE.    

    /* Fill the Default FGCOLOR rectangle with its appropriate value.
       This needs to be done after the frame has been unhidden. */
   RUN SetSampleBackground( iBgColor ). 
   IF NOT (FRAME frColorEdit:THREE-D AND iipDfltFgColor eq ?)
   THEN rfcDefault:BGCOLOR = iipDfltFgColor.   
  END.
  
  IF lipSeparator THEN DO WITH FRAME frSepColorEdit:
    ASSIGN FRAME frSepColorEdit:HIDDEN = TRUE.
    IF iSpColor = ? 
    THEN RUN SelectSeparatorRectangle( ? ).
    ELSE DO:
      RUN GetStartingColorNumber( iSpColor, OUTPUT ivspColStart ).
      RUN SelectSeparatorRectangle(iSpColor - ivspColStart).
    END.
    RUN SetSeparatorRectangleColors( ivspColStart ).
    dummy = rScHilite:MOVE-TO-BOTTOM().
    FRAME frSepColorEdit:HIDDEN = FALSE.
  END.  /* do with frame frsepcoloredit */
  
END PROCEDURE.

PROCEDURE SelectForegroundRectangle.
  DEFINE INPUT PARAMETER iipColorNumber AS INTEGER.
  DEFINE VARIABLE whRectangle AS WIDGET-HANDLE NO-UNDO.

  DO WITH FRAME frColorEdit:
    CASE iipColorNumber:
      WHEN ? THEN
        ASSIGN whRectangle = rfcDefault:HANDLE.
      WHEN  0 THEN
        ASSIGN whRectangle = rfc0:HANDLE.
      WHEN  1 THEN
        ASSIGN whRectangle = rfc1:HANDLE.
      WHEN  2 THEN
        ASSIGN whRectangle = rfc2:HANDLE.
      WHEN  3 THEN
        ASSIGN whRectangle = rfc3:HANDLE.
      WHEN  4 THEN
        ASSIGN whRectangle = rfc4:HANDLE.
      WHEN  5 THEN
        ASSIGN whRectangle = rfc5:HANDLE.
      WHEN  6 THEN
        ASSIGN whRectangle = rfc6:HANDLE.
      WHEN  7 THEN
        ASSIGN whRectangle = rfc7:HANDLE.
      WHEN  8 THEN
        ASSIGN whRectangle = rfc8:HANDLE.
      WHEN  9 THEN
        ASSIGN whRectangle = rfc9:HANDLE.
      WHEN 10 THEN
        ASSIGN whRectangle = rfc10:HANDLE.
      WHEN 11 THEN
        ASSIGN whRectangle = rfc11:HANDLE.
      WHEN 12 THEN
        ASSIGN whRectangle = rfc12:HANDLE.
      WHEN 13 THEN
        ASSIGN whRectangle = rfc13:HANDLE.
      WHEN 14 THEN
        ASSIGN whRectangle = rfc14:HANDLE.
      WHEN 15 THEN
        ASSIGN whRectangle = rfc15:HANDLE.
      OTHERWISE
      do:
        &if DEFINED(IDE-IS-RUNNING) <> 0 &then
      
        ShowMessageInIDE("Unknown color number.",
                         "Error","?","OK",yes).
      
        &else  
        MESSAGE "Unknown color number." VIEW-AS ALERT-BOX ERROR BUTTONS OK.
        &endif
      end.  
    END CASE.
    IF whRectangle <> ? AND rFgHilite:HANDLE <> ? THEN DO:
      RUN BoxRectangle( whRectangle, rFgHilite:HANDLE, iipColorNumber ).
    END.
  END.
END PROCEDURE.

PROCEDURE SelectBackgroundRectangle.
  DEFINE INPUT PARAMETER iipColorNumber AS INTEGER.
  DEFINE VARIABLE whRectangle AS WIDGET-HANDLE NO-UNDO.

  DO WITH FRAME frColorEdit:
    CASE iipColorNumber:
      WHEN ? THEN
        ASSIGN whRectangle = rbcDefault:HANDLE.
      WHEN  0 THEN
        ASSIGN whRectangle = rbc0:HANDLE.
      WHEN  1 THEN
        ASSIGN whRectangle = rbc1:HANDLE.
      WHEN  2 THEN
        ASSIGN whRectangle = rbc2:HANDLE.
      WHEN  3 THEN
        ASSIGN whRectangle = rbc3:HANDLE.
      WHEN  4 THEN
        ASSIGN whRectangle = rbc4:HANDLE.
      WHEN  5 THEN
        ASSIGN whRectangle = rbc5:HANDLE.
      WHEN  6 THEN
        ASSIGN whRectangle = rbc6:HANDLE.
      WHEN  7 THEN
        ASSIGN whRectangle = rbc7:HANDLE.
      WHEN  8 THEN
        ASSIGN whRectangle = rbc8:HANDLE.
      WHEN  9 THEN
        ASSIGN whRectangle = rbc9:HANDLE.
      WHEN 10 THEN
        ASSIGN whRectangle = rbc10:HANDLE.
      WHEN 11 THEN
        ASSIGN whRectangle = rbc11:HANDLE.
      WHEN 12 THEN
        ASSIGN whRectangle = rbc12:HANDLE.
      WHEN 13 THEN
        ASSIGN whRectangle = rbc13:HANDLE.
      WHEN 14 THEN
        ASSIGN whRectangle = rbc14:HANDLE.
      WHEN 15 THEN
        ASSIGN whRectangle = rbc15:HANDLE.
      OTHERWISE
        do:
        &if DEFINED(IDE-IS-RUNNING) <> 0 &then
      
        ShowMessageInIDE("Unknown color number.",
                         "Error","?","OK",yes).
      
        &else  
        MESSAGE "Unknown color number." VIEW-AS ALERT-BOX ERROR BUTTONS OK.
        &endif
      end.
    END CASE.
    IF whRectangle <> ? AND rBgHilite:HANDLE <> ? 
    THEN RUN BoxRectangle( whRectangle, rBgHilite:HANDLE, iipColorNumber ).
  END.
END PROCEDURE.

PROCEDURE SelectSeparatorRectangle.
  DEFINE INPUT PARAMETER iipColorNumber AS INTEGER.
  DEFINE VARIABLE whRectangle AS WIDGET-HANDLE NO-UNDO.

  DO WITH FRAME frSepColorEdit:
    CASE iipColorNumber:
      WHEN ? THEN
        ASSIGN whRectangle = rscDefault:HANDLE.
      WHEN  0 THEN
        ASSIGN whRectangle = rsc0:HANDLE.
      WHEN  1 THEN
        ASSIGN whRectangle = rsc1:HANDLE.
      WHEN  2 THEN
        ASSIGN whRectangle = rsc2:HANDLE.
      WHEN  3 THEN
        ASSIGN whRectangle = rsc3:HANDLE.
      WHEN  4 THEN
        ASSIGN whRectangle = rsc4:HANDLE.
      WHEN  5 THEN
        ASSIGN whRectangle = rsc5:HANDLE.
      WHEN  6 THEN
        ASSIGN whRectangle = rsc6:HANDLE.
      WHEN  7 THEN
        ASSIGN whRectangle = rsc7:HANDLE.
      WHEN  8 THEN
        ASSIGN whRectangle = rsc8:HANDLE.
      WHEN  9 THEN
        ASSIGN whRectangle = rsc9:HANDLE.
      WHEN 10 THEN
        ASSIGN whRectangle = rsc10:HANDLE.
      WHEN 11 THEN
        ASSIGN whRectangle = rsc11:HANDLE.
      WHEN 12 THEN
        ASSIGN whRectangle = rsc12:HANDLE.
      WHEN 13 THEN
        ASSIGN whRectangle = rsc13:HANDLE.
      WHEN 14 THEN
        ASSIGN whRectangle = rsc14:HANDLE.
      WHEN 15 THEN
        ASSIGN whRectangle = rsc15:HANDLE.
      OTHERWISE
        do:
        &if DEFINED(IDE-IS-RUNNING) <> 0 &then
      
         ShowMessageInIDE("Unknown color number.",
                          "Error","?","OK",yes).
      
        &else  
        MESSAGE "Unknown color number." VIEW-AS ALERT-BOX ERROR BUTTONS OK.
        &endif
        end.
    END CASE.
    IF whRectangle <> ? AND rScHilite:HANDLE <> ? THEN DO:
      RUN BoxRectangle( whRectangle, rScHilite:HANDLE, iipColorNumber ).
    END.
  END.
END PROCEDURE.

PROCEDURE SetForegroundRectangleColors.
  DEFINE INPUT PARAMETER iipColorStart AS INTEGER.

  IF COLOR-TABLE:NUM-ENTRIES < (iipColorStart + 16) OR
     highest-color <= (iipColorStart + 16)
  THEN COLOR-TABLE:NUM-ENTRIES = iipColorStart + 16.

  DO WITH FRAME frColorEdit:
    ASSIGN rfc0:BGCOLOR = iipColorStart
	   tfc1:SCREEN-VALUE = STRING(rfc0:BGCOLOR)
	   rfc1:BGCOLOR = rfc0:BGCOLOR + 1
	   tfc2:SCREEN-VALUE = STRING(rfc1:BGCOLOR)
	   rfc2:BGCOLOR = rfc1:BGCOLOR + 1
	   tfc3:SCREEN-VALUE = STRING(rfc2:BGCOLOR)
	   rfc3:BGCOLOR = rfc2:BGCOLOR + 1
	   tfc4:SCREEN-VALUE = STRING(rfc3:BGCOLOR)
	   rfc4:BGCOLOR = rfc3:BGCOLOR + 1
	   tfc5:SCREEN-VALUE = STRING(rfc4:BGCOLOR)
	   rfc5:BGCOLOR = rfc4:BGCOLOR + 1
	   tfc6:SCREEN-VALUE = STRING(rfc5:BGCOLOR)
	   rfc6:BGCOLOR = rfc5:BGCOLOR + 1
	   tfc7:SCREEN-VALUE = STRING(rfc6:BGCOLOR)
	   rfc7:BGCOLOR = rfc6:BGCOLOR + 1
	   tfc8:SCREEN-VALUE = STRING(rfc7:BGCOLOR)
	   rfc8:BGCOLOR = rfc7:BGCOLOR + 1
	   tfc9:SCREEN-VALUE = STRING(rfc8:BGCOLOR)
	   rfc9:BGCOLOR = rfc8:BGCOLOR + 1
	   tfc10:SCREEN-VALUE = STRING(rfc9:BGCOLOR)
	   rfc10:BGCOLOR = rfc9:BGCOLOR + 1
	   tfc11:SCREEN-VALUE = STRING(rfc10:BGCOLOR)
	   rfc11:BGCOLOR = rfc10:BGCOLOR + 1
	   tfc12:SCREEN-VALUE = STRING(rfc11:BGCOLOR)
	   rfc12:BGCOLOR = rfc11:BGCOLOR + 1
	   tfc13:SCREEN-VALUE = STRING(rfc12:BGCOLOR)
	   rfc13:BGCOLOR = rfc12:BGCOLOR + 1
	   tfc14:SCREEN-VALUE = STRING(rfc13:BGCOLOR)
	   rfc14:BGCOLOR = rfc13:BGCOLOR + 1
	   tfc15:SCREEN-VALUE = STRING(rfc14:BGCOLOR)
	   rfc15:BGCOLOR = rfc14:BGCOLOR + 1
	   tfc16:SCREEN-VALUE = STRING(rfc15:BGCOLOR).

      IF rfc0:BGCOLOR = 0 THEN
        ASSIGN ifcLeftArrow:SENSITIVE = FALSE.
      ELSE IF NOT ifcLeftArrow:SENSITIVE THEN
	ASSIGN ifcLeftArrow:SENSITIVE = TRUE.

      IF rfc15:BGCOLOR = 255 THEN
        ASSIGN ifcRightArrow:SENSITIVE = FALSE.
      ELSE IF NOT ifcRightArrow:SENSITIVE THEN
	ASSIGN ifcRightArrow:SENSITIVE = TRUE.

      IF iFgColor = ? THEN
        ASSIGN bfcEdit:SENSITIVE = FALSE.
      ELSE IF NOT bfcEdit:SENSITIVE THEN
        ASSIGN bfcEdit:SENSITIVE = TRUE.

      IF iFgColor = ? OR ( iFgColor >= rfc0:BGCOLOR AND
				iFgColor <= rfc15:BGCOLOR) THEN
        ASSIGN rFgHilite:HIDDEN = FALSE.
      ELSE
        ASSIGN rFgHilite:HIDDEN = TRUE.
  END.
END PROCEDURE.

PROCEDURE SetBackgroundRectangleColors.
  DEFINE INPUT PARAMETER iipColorStart AS INTEGER.

  IF COLOR-TABLE:NUM-ENTRIES < (iipColorStart + 16)  OR
     highest-color <= (iipColorStart + 16) 
  THEN COLOR-TABLE:NUM-ENTRIES = iipColorStart + 16.

  DO WITH FRAME frColorEdit:
    ASSIGN rbc0:BGCOLOR = iipColorStart
	   tbc1:SCREEN-VALUE = STRING(rbc0:BGCOLOR)
	   rbc1:BGCOLOR = rbc0:BGCOLOR + 1
	   tbc2:SCREEN-VALUE = STRING(rbc1:BGCOLOR)
	   rbc2:BGCOLOR = rbc1:BGCOLOR + 1
	   tbc3:SCREEN-VALUE = STRING(rbc2:BGCOLOR)
	   rbc3:BGCOLOR = rbc2:BGCOLOR + 1
	   tbc4:SCREEN-VALUE = STRING(rbc3:BGCOLOR)
	   rbc4:BGCOLOR = rbc3:BGCOLOR + 1
	   tbc5:SCREEN-VALUE = STRING(rbc4:BGCOLOR)
	   rbc5:BGCOLOR = rbc4:BGCOLOR + 1
	   tbc6:SCREEN-VALUE = STRING(rbc5:BGCOLOR)
	   rbc6:BGCOLOR = rbc5:BGCOLOR + 1
	   tbc7:SCREEN-VALUE = STRING(rbc6:BGCOLOR)
	   rbc7:BGCOLOR = rbc6:BGCOLOR + 1
	   tbc8:SCREEN-VALUE = STRING(rbc7:BGCOLOR)
	   rbc8:BGCOLOR = rbc7:BGCOLOR + 1
	   tbc9:SCREEN-VALUE = STRING(rbc8:BGCOLOR)
	   rbc9:BGCOLOR = rbc8:BGCOLOR + 1
	   tbc10:SCREEN-VALUE = STRING(rbc9:BGCOLOR)
	   rbc10:BGCOLOR = rbc9:BGCOLOR + 1
	   tbc11:SCREEN-VALUE = STRING(rbc10:BGCOLOR)
	   rbc11:BGCOLOR = rbc10:BGCOLOR + 1
	   tbc12:SCREEN-VALUE = STRING(rbc11:BGCOLOR)
	   rbc12:BGCOLOR = rbc11:BGCOLOR + 1
	   tbc13:SCREEN-VALUE = STRING(rbc12:BGCOLOR)
	   rbc13:BGCOLOR = rbc12:BGCOLOR + 1
	   tbc14:SCREEN-VALUE = STRING(rbc13:BGCOLOR)
	   rbc14:BGCOLOR = rbc13:BGCOLOR + 1
	   tbc15:SCREEN-VALUE = STRING(rbc14:BGCOLOR)
	   rbc15:BGCOLOR = rbc14:BGCOLOR + 1
	   tbc16:SCREEN-VALUE = STRING(rbc15:BGCOLOR).

      IF rbc0:BGCOLOR = 0 THEN
        ASSIGN ibcLeftArrow:SENSITIVE = FALSE.
      ELSE IF NOT ibcLeftArrow:SENSITIVE THEN
	ASSIGN ibcLeftArrow:SENSITIVE = TRUE.

      IF rbc15:BGCOLOR + 1 >= 256 THEN
        ASSIGN ibcRightArrow:SENSITIVE = FALSE.
      ELSE IF NOT ibcRightArrow:SENSITIVE THEN
	ASSIGN ibcRightArrow:SENSITIVE = TRUE.

      IF iBgColor = ? THEN
        ASSIGN bbcEdit:SENSITIVE = FALSE.
      ELSE IF NOT bbcEdit:SENSITIVE THEN
        ASSIGN bbcEdit:SENSITIVE = TRUE.

      IF iBgColor = ? OR ( iBgColor >= rbc0:BGCOLOR AND
				iBgColor <= rbc15:BGCOLOR) THEN
        ASSIGN rBgHilite:HIDDEN = FALSE.
      ELSE
        ASSIGN rBgHilite:HIDDEN = TRUE.
  END.
END PROCEDURE.
  
PROCEDURE SetSeparatorRectangleColors.
  DEFINE INPUT PARAMETER iipColorStart AS INTEGER.

  IF COLOR-TABLE:NUM-ENTRIES < (iipColorStart + 16)  OR
     highest-color <= (iipColorStart + 16) 
  THEN COLOR-TABLE:NUM-ENTRIES = iipColorStart + 16.

  DO WITH FRAME frSepColorEdit:
    ASSIGN rsc0:BGCOLOR = iipColorStart
	   tsc1:SCREEN-VALUE = STRING(rsc0:BGCOLOR)
	   rsc1:BGCOLOR = rsc0:BGCOLOR + 1
	   tsc2:SCREEN-VALUE = STRING(rsc1:BGCOLOR)
	   rsc2:BGCOLOR = rsc1:BGCOLOR + 1
	   tsc3:SCREEN-VALUE = STRING(rsc2:BGCOLOR)
	   rsc3:BGCOLOR = rsc2:BGCOLOR + 1
	   tsc4:SCREEN-VALUE = STRING(rsc3:BGCOLOR)
	   rsc4:BGCOLOR = rsc3:BGCOLOR + 1
	   tsc5:SCREEN-VALUE = STRING(rsc4:BGCOLOR)
	   rsc5:BGCOLOR = rsc4:BGCOLOR + 1
	   tsc6:SCREEN-VALUE = STRING(rsc5:BGCOLOR)
	   rsc6:BGCOLOR = rsc5:BGCOLOR + 1
	   tsc7:SCREEN-VALUE = STRING(rsc6:BGCOLOR)
	   rsc7:BGCOLOR = rsc6:BGCOLOR + 1
	   tsc8:SCREEN-VALUE = STRING(rsc7:BGCOLOR)
	   rsc8:BGCOLOR = rsc7:BGCOLOR + 1
	   tsc9:SCREEN-VALUE = STRING(rsc8:BGCOLOR)
	   rsc9:BGCOLOR = rsc8:BGCOLOR + 1
	   tsc10:SCREEN-VALUE = STRING(rsc9:BGCOLOR)
	   rsc10:BGCOLOR = rsc9:BGCOLOR + 1
	   tsc11:SCREEN-VALUE = STRING(rsc10:BGCOLOR)
	   rsc11:BGCOLOR = rsc10:BGCOLOR + 1
	   tsc12:SCREEN-VALUE = STRING(rsc11:BGCOLOR)
	   rsc12:BGCOLOR = rsc11:BGCOLOR + 1
	   tsc13:SCREEN-VALUE = STRING(rsc12:BGCOLOR)
	   rsc13:BGCOLOR = rsc12:BGCOLOR + 1
	   tsc14:SCREEN-VALUE = STRING(rsc13:BGCOLOR)
	   rsc14:BGCOLOR = rsc13:BGCOLOR + 1
	   tsc15:SCREEN-VALUE = STRING(rsc14:BGCOLOR)
	   rsc15:BGCOLOR = rsc14:BGCOLOR + 1
	   tsc16:SCREEN-VALUE = STRING(rsc15:BGCOLOR).

      IF rsc0:BGCOLOR = 0 THEN
        ASSIGN iscLeftArrow:SENSITIVE = FALSE.
      ELSE IF NOT iscLeftArrow:SENSITIVE THEN
	ASSIGN iscLeftArrow:SENSITIVE = TRUE.

      IF rsc15:BGCOLOR + 1 >= 256 THEN
        ASSIGN iscRightArrow:SENSITIVE = FALSE.
      ELSE IF NOT iscRightArrow:SENSITIVE THEN
	ASSIGN iscRightArrow:SENSITIVE = TRUE.

      IF iSpColor = ? THEN
        ASSIGN bscEdit:SENSITIVE = FALSE.
      ELSE IF NOT bscEdit:SENSITIVE THEN
        ASSIGN bscEdit:SENSITIVE = TRUE.

      IF iSpColor = ? OR ( iSpColor >= rsc0:BGCOLOR AND
				iSpColor <= rsc15:BGCOLOR) THEN
        ASSIGN rScHilite:HIDDEN = FALSE.
      ELSE
        ASSIGN rScHilite:HIDDEN = TRUE.
  END.
END PROCEDURE.
  
PROCEDURE SaveSettings:       
  DEFINE VAR ok_save AS LOGICAL NO-UNDO.
  /* Check the ability to save settings */
  RUN adeshar/_chksave.p (INPUT "uib", OUTPUT ok_save).
  IF ok_save THEN DO:
    PUT-KEY-VALUE COLOR ALL. 
    lSaved = YES.
  END.
END PROCEDURE.

/*************************** UserInterface Triggers **************************/
ON WINDOW-CLOSE OF FRAME frColorEdit APPLY "END-ERROR":U TO SELF.

ON CHOOSE OF bHelp IN FRAME frColorEdit OR HELP OF FRAME frColorEdit
  RUN adecomm/_adehelp.p ( "comm", "CONTEXT", {&Color_Dlg_Box}, ? ).

ON CHOOSE OF bfcEdit
  RUN EditColor( rSample:FGCOLOR ).

ON CHOOSE OF bbcEdit
  RUN EditColor( rSample:BGCOLOR ).

ON CHOOSE OF bSave 
  RUN SaveSettings.

ON GO OF FRAME frColorEdit DO:
  DEF VAR lOK AS LOGICAL NO-UNDO.
  /* Tell the user if they changed any colors, but did not save. */
  IF lChanged AND NOT lSaved THEN DO:
    &if DEFINED(IDE-IS-RUNNING) <> 0 &then
      
      lOK = ShowMessageInIDE("Color settings were edited, but they have ~n
                             not been saved.  These changes will be lost when ~n
                             you leave the PROGRESS session. ~n
                             Would you like to save settings?",
                            "Warning","?","YES-NO-CANCEL",yes).
      &else  
    MESSAGE "Color settings were edited, but they have" {&SKP}
            "not been saved.  These changes will be lost when" {&SKP}
            "you leave the PROGRESS session." SKIP(1)
            "Would you like to save settings?"
            VIEW-AS ALERT-BOX WARNING BUTTONS YES-NO-CANCEL UPDATE lOK.
    &endif        
    IF lOK eq ? THEN RETURN NO-APPLY.
    ELSE IF lOK THEN RUN SaveSettings.
  END.
END.

ON ENDKEY OF FRAME frColorEdit DO:
  /* Tell the user that changes make to the SYSTEM-DIALOG will not
     be undone. */
  IF lChanged OR lSaved THEN DO:
      &if DEFINED(IDE-IS-RUNNING) <> 0 &then
      
      CallResult = ShowMessageInIDE("Changes make editing colors or saving ~n color settings cannot be undone. ~n
                            Cancelling this dialog will not undo those changes.",
                            "Warning","?","OK",yes).
      if not CallResult then return.                 
      &else 
      MESSAGE "Changes make editing colors or saving" {&SKP}
            "color settings cannot be undone." SKIP(1)
            "Cancelling this dialog will not undo those changes."
            VIEW-AS ALERT-BOX WARNING BUTTONS OK.
      &endif      
  END.
END.

ON CHOOSE OF ifcLeftArrow DO:
  DEFINE VARIABLE ivColorStart as INTEGER.

  DO WITH FRAME frColorEdit:
    ASSIGN ivColorStart = rfc0:BGCOLOR - 16.
    IF ivColorStart >= 0 THEN
      RUN SetForegroundRectangleColors( ivColorStart ).
  END.
END.

ON CHOOSE OF ifcRightArrow DO:
  DEFINE VARIABLE ivColorStart as INTEGER.

  DO WITH FRAME frColorEdit:
    ASSIGN ivColorStart = rfc15:BGCOLOR + 1.
    IF ivColorStart < 256 THEN DO:
      IF COLOR-TABLE:NUM-ENTRIES < (ivColorStart + 16) THEN
        ASSIGN COLOR-TABLE:NUM-ENTRIES = ivColorStart + 16.
      RUN SetForegroundRectangleColors( ivColorStart ).
    END.
  END.
END.

ON CHOOSE OF ibcLeftArrow DO:
  DEFINE VARIABLE ivColorStart as INTEGER.

  DO WITH FRAME frColorEdit:
    ASSIGN ivColorStart = rbc0:BGCOLOR - 16.
    IF ivColorStart >= 0 THEN
      RUN SetBackgroundRectangleColors( ivColorStart ).
  END.
END.

ON CHOOSE OF ibcRightArrow DO:
  DEFINE VARIABLE ivColorStart as INTEGER.

  DO WITH FRAME frColorEdit:
    ASSIGN ivColorStart = rbc15:BGCOLOR + 1.
    IF ivColorStart < 256 THEN DO:
      IF COLOR-TABLE:NUM-ENTRIES < (ivColorStart + 16) THEN
        ASSIGN COLOR-TABLE:NUM-ENTRIES = ivColorStart + 16.
      RUN SetBackgroundRectangleColors( ivColorStart ).
    END.
  END.
END.

ON CHOOSE OF iscLeftArrow DO:
  DEFINE VARIABLE ivColorStart AS INTEGER.
  
  DO WITH FRAME frSepColorEdit:
    ASSIGN ivColorStart = rsc0:BGCOLOR - 16.
    IF ivColorStart >= 0 THEN
      RUN SetSeparatorRectangleColors( ivColorStart ).
  END.
END.

ON CHOOSE OF iscRightArrow DO:
  DEFINE VARIABLE ivColorStart AS INTEGER.
  
  DO WITH FRAME frSepColorEdit:
    ASSIGN ivColorStart = rsc15:BGCOLOR + 1.
    IF ivColorStart < 256 THEN DO:
      IF COLOR-TABLE:NUM-ENTRIES < (ivColorStart + 16) THEN
        ASSIGN COLOR-TABLE:NUM-ENTRIES = ivColorStart + 16.
      RUN SetSeparatorRectangleColors ( ivColorStart ).
    END.
  END.
END.

ON MOUSE-SELECT-CLICK OF rbc0, rbc1, rbc2, rbc3, rbc4, rbc5, rbc6, rbc7, rbc8, 
	rbc9, rbc10, rbc11, rbc12, rbc13, rbc14, rbc15
DO:
  DO WITH FRAME frColorEdit:
    ASSIGN iBgColor = SELF:BGCOLOR.
    RUN BoxRectangle( SELF:HANDLE, rBgHilite:HANDLE, iBgColor ).
    RUN SetSampleBackground( iBgColor ).
  END.
END.

ON MOUSE-SELECT-CLICK OF rbcDefault
DO:
  DO WITH FRAME frColorEdit:
    ASSIGN iBgColor = ?.
    RUN BoxRectangle( SELF:HANDLE, rBgHilite:HANDLE, iipDfltBgColor ).
    RUN SetSampleBackground( iBgColor ).
  END.
END.

ON MOUSE-SELECT-CLICK OF rfc0, rfc1, rfc2, rfc3, rfc4, rfc5, rfc6, rfc7, rfc8, 
	rfc9, rfc10, rfc11, rfc12, rfc13, rfc14, rfc15
DO:
  DO WITH FRAME frColorEdit:
    ASSIGN iFgColor = SELF:BGCOLOR.
    RUN BoxRectangle( SELF:HANDLE, rFgHilite:HANDLE, iFgColor ).
    RUN SetSampleForeground( iFgColor ).
  END.
END.

ON MOUSE-SELECT-CLICK OF rfcDefault
DO:
  DO WITH FRAME frColorEdit:
    ASSIGN iFgColor = ?.
    RUN BoxRectangle( SELF:HANDLE, rFgHilite:HANDLE, iipDfltFgColor ).
    RUN SetSampleForeground( iFgColor ).
  END.
END.

ON MOUSE-SELECT-CLICK OF rsc0, rsc1, rsc2, rsc3, rsc4, rsc5, rsc6, rsc7, rsc8,
       rsc9, rsc10, rsc11, rsc12, rsc13, rsc14, rsc15
DO:
  DO WITH FRAME frSepColorEdit:
    ASSIGN iSpColor = SELF:BGCOLOR.
    RUN BoxRectangle( SELF:HANDLE, rScHilite:HANDLE, iSpColor ).
  END.
END.

ON MOUSE-SELECT-CLICK OF rscDefault
DO:
  DO WITH FRAME frSepColorEdit:
    ASSIGN iSpColor = ?.
    RUN BoxRectangle( SELF:HANDLE, rScHilite:HANDLE, iipDfltSpColor ).
  END.
END.

ON MOUSE-SELECT-DBLCLICK OF rfc0, rfc1, rfc2, rfc3, rfc4, rfc5, rfc6, rfc7,
  rfc8, rfc9, rfc10, rfc11, rfc12, rfc13, rfc14, rfc15, rbc0, rbc1, rbc2,
  rbc3, rbc4, rbc5, rbc6, rbc7, rbc8, rbc9, rbc10, rbc11, rbc12, rbc13,
  rbc14, rbc15, rsc0, rsc1, rsc2, rsc3, rsc4, rsc5, rsc6, rsc7, rsc8, rsc9,
  rsc10, rsc11, rsc12, rsc13, rsc14, rsc15, rfcDefault, rbcDefault, rscDefault
DO:
  IF SELF:BGCOLOR = ? THEN
  do:
    &if DEFINED(IDE-IS-RUNNING) <> 0 &then
      
      ShowMessageInIDE("The default color is not customizable.",
                       "Information","?","OK",yes).
    &else                                  
    MESSAGE "The default color is not customizable."
	VIEW-AS ALERT-BOX INFORMATION BUTTONS Ok.
	&endif
  end.	
  ELSE DO:
    RUN EditColor( SELF:BGCOLOR ).
  END.
END.

/****************************** Main Loop ******************************/
 
DO WITH FRAME frColorEdit:
  /* if IDE then */
  {adeuib/ide/dialoginit.i "FRAME frColorEdit:handle"}
/*                                                                       */
/*  &if DEFINED(IDE-IS-RUNNING) <> 0 &then                               */
/*      define variable dialogService as adeuib.idialogservice no-undo.  */
/*      Run CreateDialogService in hOEIDEService (,output dialogService).*/
/*  &endif                                                               */
/*                                                                       */
  IF lipSeparator THEN DO:
    ASSIGN FRAME frColorEdit:HEIGHT = 17
           bOK:ROW     IN FRAME frColorEdit = 15
           bCancel:ROW IN FRAME frColorEdit = 15
           bHelp:ROW   IN FRAME frColorEdit = 15
           bSave:ROW   IN FRAME frColorEdit = 15.
  END.  /* if lipSeparator */
 
  /* Run time layout for button area. */
  {adecomm/okrun.i  
     &FRAME = "FRAME frColorEdit" 
     &BOX   = "rHeavyRule"
     &OK    = "bOK" 
     &HELP  = "bHelp"}

  IF SESSION:PIXELS-PER-ROW = 21 THEN 
    ASSIGN ifcLeftArrow:HEIGHT-PIXELS = 24
           ifcLeftArrow:WIDTH-PIXELS  = 21
           ifcRightArrow:HEIGHT-PIXELS = ifcLeftArrow:HEIGHT-PIXELS
           ifcRightArrow:WIDTH-PIXELS  = ifcLeftArrow:WIDTH-PIXELS
           ibcLeftArrow:HEIGHT-PIXELS  = ifcLeftArrow:HEIGHT-PIXELS
           ibcLeftArrow:WIDTH-PIXELS   = ifcLeftArrow:WIDTH-PIXELS
           ibcRightArrow:HEIGHT-PIXELS = ifcLeftArrow:HEIGHT-PIXELS
           ibcRightArrow:WIDTH-PIXELS  = ifcLeftArrow:WIDTH-PIXELS
           iscLeftArrow:HEIGHT-PIXELS  = ifcLeftArrow:HEIGHT-PIXELS
           iscLeftArrow:WIDTH-PIXELS   = ifcLeftArrow:WIDTH-PIXELS
           iscRightArrow:HEIGHT-PIXELS = ifcLeftArrow:HEIGHT-PIXELS
           iscRightArrow:WIDTH-PIXELS  = ifcLeftArrow:WIDTH-PIXELS
           ifcRightArrow:X = ifcLeftArrow:X + ifcLeftArrow:WIDTH-PIXELS
           ibcRightArrow:X = ifcRightArrow:X
           iscRightArrow:X = ifcRightArrow:X.

  ASSIGN iFgColor = iiopFgColor  /* Make local copy of input-output parameters */
         iBgColor = iiopBgColor  /* ...in case user cancels changes            */
         iSpColor = iiopSpColor
         tMessage:SCREEN-VALUE = cipMessage
	  tBgTitle:SCREEN-VALUE = "Background Colors: "
	  tFgTitle:SCREEN-VALUE = "Foreground Colors: "
	  tScTitle:SCREEN-VALUE = "Separator Foreground Colors: "
	  tSample:SCREEN-VALUE = "Sample"
         tSample:Y = rSample:Y + 5
	  tFgDefault:SCREEN-VALUE = "?"
	  tBgDefault:SCREEN-VALUE = "?"
	  tScDefault:SCREEN-VALUE = "?"
	  
	 ifcLeftArrow:Y = (rfcDefault:Y + (rfcDefault:HEIGHT-PIXELS / 2))
				- (ifcLeftArrow:HEIGHT-PIXELS / 2)
	 ibcLeftArrow:Y = (rbcDefault:Y + (rbcDefault:HEIGHT-PIXELS / 2))
				- (ibcLeftArrow:HEIGHT-PIXELS / 2)
	 ifcRightArrow:Y = (rfc15:Y + (rfc15:HEIGHT-PIXELS / 2))
				- (ifcRightArrow:HEIGHT-PIXELS / 2)
	 ibcRightArrow:Y = (rbc15:Y + (rbc15:HEIGHT-PIXELS / 2))
				- (ibcRightArrow:HEIGHT-PIXELS / 2)
	 iscLeftArrow:Y = (rscDefault:Y + (rscDefault:HEIGHT-PIXELS / 2))
	                     - (iscLeftArrow:HEIGHT-PIXELS / 2)
	 iscRightArrow:Y = (rsc15:Y + (rsc15:HEIGHT-PIXELS / 2))
	                     - (iscRightArrow:HEIGHT-PIXELS / 2).
/*  &if DEFINED(IDE-IS-RUNNING) <> 0  &then                   */
/*     define variable lCancel as logical no-undo.            */
/*     dialogService:View().                                  */
/*     dialogService:SetOkButton(bOk:handle).                 */
/*     dialogService:SetCancelButton(bCancel:handle).         */
/*     dialogService:Title = iptitle.                         */
/*                                                            */
/*     /* endkey does not work it seems when we are a child of*/
/*        another dialog running from ide,*/                  */
/*     ON CHOOSE OF bCancel DO:                               */
/*         lCancel = true.                                    */
/*         apply "u2" to this-procedure.                      */
/*     END.                                                   */
/*  &endif                                                    */
  &scoped-define CANCEL-EVENT U2
  {adeuib/ide/dialogstart.i bOk bCancel iptitle}  
  RUN InitializeColors.

  DO TRANSACTION ON ENDKEY UNDO, LEAVE:
    ENABLE ALL EXCEPT bfcEdit bbcEdit ifcRightArrow ifcLeftArrow
      ibcRightArrow ibcLeftArrow WITH FRAME frColorEdit .
    IF lipSeparator THEN 
        ENABLE ALL EXCEPT bScEdit iscRightArrow iscLeftArrow
        WITH FRAME frSepColorEdit.
    ASSIGN pressed_OK = no. 
   
    ENABLE bOk bCancel bHelp WITH FRAME frColorEdit.
    IF NOT RETRY then
    &if DEFINED(IDE-IS-RUNNING) = 0  &then
        WAIT-FOR "choose" of bok in frame frColorEdit. 
    &ELSE
        WAIT-FOR "choose" of bok in frame frColorEdit or "u2" of this-procedure.       
        if cancelDialog THEN UNDO, LEAVE.  
    &endif
    /* Return Changes made by user */
    ASSIGN iiopFgColor = iFgColor
           iiopBgColor = iBgColor
           iiopSpColor = iSpColor
           pressed_OK  = yes.
           
  END.
 
  HIDE FRAME frColorEdit.
  
END.

/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/
/*****************************************************************************

Procedure: adecomm/_chsfont.p

Syntax:
    RUN adecomm/_chsfont.p( INPUT cipTitle, INPUT-OUTPUT iiopFontNumber,
                           OUTPUT pressed_OK)

Description:
    This is the font selector which lets the user change the current font.
    The trick is to represent is the DEFAULT font  A button should show the
    default font of its frame for the default, while a frame or window 
    should show the System Default.

Parameters:
  INPUT         cipTitle: Title for the Font Dialog.
  INPUT         iipDfltFontNumber: Font to show when user chooses DEFAULT.
  INPUT-OUTPUT  iiopFontNumber: The initial font, also reset to output values.
	OUTPUT  pressed_OK: FALSE if cancelled dialog box.

Author: Ravi-Chandar Ramalingam

---------------------------------------------------------------------------- 
Test code:
def var ifont AS INTEGER NO-UNDO.
def var pressed_OK  AS LOGICAL.
RUN adecomm/_chsfont.p ("Title", ?,
  INPUT-OUTPUT ifont,
  OUTPUT pressed_OK).
MESSAGE ifont pressed_OK.
******************************************************************************/

&GLOBAL-DEFINE WIN95-BTN
&Global-define SKP ""
{adecomm/commeng.i}   /* Help pre-processor directives                       */
{adecomm/adestds.i}
/******************************* Definitions *********************************/
DEFINE INPUT        PARAMETER cipTitle          AS CHARACTER NO-UNDO.
DEFINE INPUT        PARAMETER iipDfltFontNumber AS INTEGER NO-UNDO.
DEFINE INPUT-OUTPUT PARAMETER iiopFontNumber    AS INTEGER NO-UNDO.
DEFINE       OUTPUT PARAMETER pressed_OK        AS LOGICAL NO-UNDO.

DEFINE BUTTON bOk LABEL "OK" {&STDPH_OKBTN} AUTO-GO.
DEFINE BUTTON bCancel LABEL "Cancel" {&STDPH_OKBTN} AUTO-END-KEY.
DEFINE BUTTON bEdit LABEL "Edit...":C10 SIZE 10 BY {&H_OKBTN} MARGIN-EXTRA DEFAULT.
DEFINE BUTTON bSave LABEL "&Save Font Settings":C19 SIZE 22 BY {&H_OKBTN} MARGIN-EXTRA DEFAULT.
DEFINE BUTTON bHelp LABEL "&Help" {&STDPH_OKBTN}.

DEFINE VARIABLE ldummy AS LOGICAL NO-UNDO.
DEFINE BUTTON iRightArrow IMAGE-UP FILE "btn-right-arrow":U.
DEFINE BUTTON iLeftArrow  IMAGE-UP FILE "btn-left-arrow":U.

DEFINE VARIABLE iFontNumber AS INTEGER NO-UNDO.

DEFINE VARIABLE lChanged AS LOGICAL NO-UNDO.
DEFINE VARIABLE lSaved AS LOGICAL NO-UNDO.
DEFINE VARIABLE highest-font AS INTEGER NO-UNDO.

DEFINE VARIABLE tFontDefault AS CHARACTER INITIAL "AaBbYyZz" FORMAT "X(10)"
	VIEW-AS TEXT SIZE 10 BY 3.
DEFINE VARIABLE tFont0 LIKE tFontDefault.
DEFINE VARIABLE tFont1 LIKE tFontDefault.
DEFINE VARIABLE tFont2 LIKE tFontDefault.
DEFINE VARIABLE tFont3 LIKE tFontDefault.

DEFINE VARIABLE tDefault AS CHARACTER INITIAL "Default"
	FONT 4 FORMAT "X(7)" VIEW-AS TEXT.
DEFINE VARIABLE tZero AS CHARACTER INITIAL "0"
	FONT 4 FORMAT "X(3)" VIEW-AS TEXT.
DEFINE VARIABLE tOne LIKE tZero INITIAL "1".
DEFINE VARIABLE tTwo LIKE tZero INITIAL "2".
DEFINE VARIABLE tThree LIKE tZero INITIAL "3".

DEFINE VARIABLE ivFrameWidth AS INTEGER.

DEFINE RECTANGLE rFontDefault
	SIZE 11 BY 3.25 FGCOLOR ? EDGE-PIXELS 1.
DEFINE RECTANGLE rFont0 LIKE rFontDefault.
DEFINE RECTANGLE rFont1 LIKE rFontDefault.
DEFINE RECTANGLE rFont2 LIKE rFontDefault.
DEFINE RECTANGLE rFont3 LIKE rFontDefault.

DEFINE VARIABLE tSample AS CHARACTER INITIAL "Sample"
	FORMAT "X(9)" LABEL "Sample" VIEW-AS TEXT.

DEFINE RECTANGLE rSelected SIZE-PIXELS 1 BY 1 FGCOLOR ? BGCOLOR 0 EDGE-PIXELS 3 NO-FILL.

&IF {&OKBOX} &THEN
DEFINE RECTANGLE rHeavyRule {&STDPH_OKBOX}.
&ENDIF

    
DEFINE FRAME frFontEdit
  SKIP({&TFM_WID})
  tSample NO-LABEL AT 25 SKIP(3)
  iLeftArrow AT 4 SPACE iRightArrow SPACE(2)
  tFontDefault NO-LABEL SPACE(2)
  tFont0 NO-LABEL SPACE(2)
  tFont1 NO-LABEL SPACE(2)
  tFont2 NO-LABEL SPACE(2)
  tFont3 NO-LABEL 

  rFontDefault AT ROW-OF tFontDefault - 0.1 COL-OF tFontDefault - 0.4
  rFont0 AT ROW-OF tFont0 - 0.1 COL-OF tFont0 - 0.4
  rFont1 AT ROW-OF tFont1 - 0.1 COL-OF tFont1 - 0.4
  rFont2 AT ROW-OF tFont2 - 0.1 COL-OF tFont2 - 0.4
  rFont3 AT ROW-OF tFont3 - 0.1 COL-OF tFont3 - 0.4 SKIP(0.25)

  rSelected tDefault AT ROW-OF rSelected COL-OF tFontDefault + 2 NO-LABEL
  tZero AT ROW-OF rSelected COL-OF tFont0 + 4 NO-LABEL
  tOne AT ROW-OF rSelected COL-OF tFont1 + 4 NO-LABEL
  tTwo AT ROW-OF rSelected COL-OF tFont2 + 4 NO-LABEL
  tThree AT ROW-OF rSelected COL-OF tFont3 + 4 NO-LABEL

  {adecomm/okform.i
      &BOX    = "rHeavyRule"
      &STATUS = "no"
      &OK     = "bOK"
      &CANCEL = "bCancel"
      &OTHER  = "space({&HM_DBTNG}) bEdit space({&HM_DBTNG}) bSave"
      &HELP   = "bHelp"}
WITH SIDE-LABELS 
  &if DEFINED(IDE-IS-RUNNING) = 0  &then
     TITLE cipTitle 
     VIEW-AS DIALOG-BOX
  &else
      NO-BOX THREE-D  
  &endif      
     WIDTH 90
     DEFAULT-BUTTON bOK.


{adeuib/ide/dialoginit.i "FRAME frFontEdit:handle"}
&if DEFINED(IDE-IS-RUNNING) <> 0  &then
   dialogService:View(). 
&endif

/* **************************** THREE-D Support *************************** */       
/* In 3D, we want to change some of the characteristics of the widgets
   to show better in this environment. Changes include:
      - Make Hilight box solid black
 */
IF SESSION:THREE-D THEN ASSIGN 
  rSelected:EDGE-PIXELS = 1  
  rSelected:FILLED      = YES
  .

/**************************** Internal Procedures ***************************/
PROCEDURE EditFont.
  DEFINE INPUT PARAMETER iipFontNumber AS INTEGER NO-UNDO.
  DEFINE VARIABLE lvAccepted AS LOGICAL NO-UNDO.

  IF iipFontNumber > -1 AND iipFontNumber < 256 THEN DO:
    /* Change cursor to wait.  The dialog will set the pointer back */
    ldummy = FRAME frFontEdit:LOAD-MOUSE-POINTER ("WAIT":U).
    SYSTEM-DIALOG FONT iipFontNumber UPDATE lvAccepted.
    ldummy = FRAME frFontEdit:LOAD-MOUSE-POINTER ("":U).
    /* If anything changed, then note the fact. */
    IF lvAccepted   
    THEN ASSIGN lChanged      = YES
                highest-font = MAX(highest-font, iipFontNumber).
  END.
  ELSE
  do:
    &if DEFINED(IDE-IS-RUNNING) <> 0 &then
    ShowMessageInIDE("Font number" + string(iipFontNumber)+ " is not valid. ~n Valid font numbers are from 0 - 255. ",
                     "Information","?","OK",yes).
          
    &else  
    MESSAGE "Font number" iipFontNumber "is not valid." SKIP
	    "Valid font numbers are from 0 - 255."
	VIEW-AS ALERT-BOX INFORMATION BUTTONS OK.
	&endif
  end.	   
END PROCEDURE.

PROCEDURE GetStartingFontNumber.
  DEFINE INPUT PARAMETER ipFontNumber AS INTEGER.
  DEFINE OUTPUT PARAMETER opFontStart AS INTEGER.

  opFontStart = TRUNCATE(ipFontNumber / 4, 0) * 4.
END PROCEDURE.

PROCEDURE SetSampleFont:
  DEF INPUT PARAMETER iipFont AS INTEGER NO-UNDO.
       
  DEFINE VAR new-Width-P AS INTEGER NO-UNDO.
  DEFINE VAR new-X       AS INTEGER NO-UNDO.
       
  DO WITH FRAME frFontEdit:
    ASSIGN tSample:FONT = iipFont
           new-width-p  = MIN(ivFrameWidth - 2,
                          FONT-TABLE:GET-TEXT-WIDTH-PIXELS
                                       (tSample:SCREEN-VALUE,iipFont))
  	   new-x        = (ivFrameWidth - new-width-p) / 2
                                       .
    /* Set X and WIDTH-P in the order that won't cause any "Widget in Frame"
       errors. */                                  
    IF new-width-p < tSample:WIDTH-P                                    
    THEN ASSIGN tSample:WIDTH-P = new-width-p
  	      tSample:X         = new-x.  
    ELSE ASSIGN tSample:X       = new-x
                tSample:WIDTH-P = new-width-p.
  END.
END PROCEDURE.

PROCEDURE SetTextFonts.
  DEFINE INPUT PARAMETER ivFontStart AS INTEGER.

  DO WITH FRAME frFontEdit:
    IF FONT-TABLE:NUM-ENTRIES < (ivFontStart + 4) OR
       highest-font <= (ivFontStart + 4) 
    THEN FONT-TABLE:NUM-ENTRIES = ivFontStart + 4.
    
    ASSIGN tFont0:FONT = ivFontStart
	   tZero:SCREEN-VALUE = STRING(ivFontStart)
	   tFont1:FONT = tFont0:FONT + 1
	   tOne:SCREEN-VALUE = STRING(tFont0:FONT + 1)
	   tFont2:FONT = tFont1:FONT + 1
	   tTwo:SCREEN-VALUE = STRING(tFont1:FONT + 1)
	   tFont3:FONT = tFont2:FONT + 1
	   tThree:SCREEN-VALUE = STRING(tFont2:FONT + 1).

    IF iFontNumber <> ? AND (iFontNumber < tFont0:FONT OR
        iFontNumber > tFont3:FONT) THEN
      rSelected:HIDDEN = TRUE.
    ELSE IF rSelected:HIDDEN THEN
      rSelected:HIDDEN = FALSE.

    IF iFontNumber = ? OR iFontNumber < 8 OR 
        iFontNumber < tFont0:FONT OR iFontNumber > tFont3:FONT THEN
      bEdit:SENSITIVE = FALSE.
    ELSE IF NOT bEdit:SENSITIVE THEN
      bEdit:SENSITIVE = TRUE.

    IF tFont0:FONT = 0 THEN
      iLeftArrow:SENSITIVE = FALSE.
    ELSE IF NOT iLeftArrow:SENSITIVE THEN
      iLeftArrow:SENSITIVE = TRUE.
      
    IF tFont3:FONT = 255 THEN
      iRightArrow:SENSITIVE = FALSE.
    ELSE IF NOT iRightArrow:SENSITIVE THEN
      iRightArrow:SENSITIVE = TRUE.   
  END.
END PROCEDURE.


PROCEDURE HighlightSelectedFont.
  DEFINE INPUT PARAMETER whipBox AS WIDGET-HANDLE.

  DO WITH FRAME frFontEdit:
    ASSIGN rSelected:X             = whipBox:X - 4
	   rSelected:Y             = whipBox:Y - 4
	   rSelected:WIDTH-PIXELS  = whipBox:WIDTH-PIXELS + 8
	   rSelected:HEIGHT-PIXELS = whipBox:HEIGHT-PIXELS + 8.
  END.
END PROCEDURE.
  
PROCEDURE SaveSettings:       
  DEFINE VAR ok_save AS LOGICAL NO-UNDO.
  /* Check the ability to save settings */
  RUN adeshar/_chksave.p (INPUT "uib", OUTPUT ok_save).
  IF ok_save THEN DO:
    PUT-KEY-VALUE FONT ALL. 
    lSaved = YES.
  END.
END PROCEDURE.

/*************************** UserInterface Triggers **************************/
ON WINDOW-CLOSE OF FRAME frFontEdit APPLY "END-ERROR":U TO SELF.

ON CHOOSE OF bHelp IN FRAME frFontEdit OR HELP OF FRAME frFontEdit
  RUN adecomm/_adehelp.p ( "comm", "CONTEXT", {&Font_Dlg_Box}, ? ).

ON CHOOSE OF bEdit IN FRAME frFontEdit 
  RUN EditFont(iFontNumber).

ON MOUSE-SELECT-CLICK OF tFont0, tFont1, tFont2, tFont3
	IN FRAME frFontEdit DO:
  ASSIGN iFontNumber = SELF:FONT
         rSelected:HIDDEN = TRUE.
  RUN HighlightSelectedFont(SELF).
  ASSIGN rSelected:HIDDEN = FALSE.
  RUN SetSampleFont (iFontNumber).
  IF iFontNumber = ? OR iFontNumber < 8 THEN
    bEdit:SENSITIVE = FALSE.
  ELSE IF NOT bEdit:SENSITIVE THEN
    bEdit:SENSITIVE = TRUE.
END.

ON MOUSE-SELECT-CLICK OF tFontDefault IN FRAME frFontEdit DO:
  ASSIGN iFontNumber = ?
         rSelected:HIDDEN = TRUE.
  RUN HighlightSelectedFont(SELF). 
  ASSIGN rSelected:HIDDEN = FALSE
         bEdit:SENSITIVE  = FALSE.
  RUN SetSampleFont (SELF:FONT).
END.


ON MOUSE-SELECT-DBLCLICK OF tFont0, tFont1, tFont2, tFont3 IN FRAME frFontEdit
DO:
  DEFINE VARIABLE lvAcceptChange AS LOGICAL INITIAL FALSE.

  IF SELF:FONT > 7 THEN RUN EditFont (SELF:FONT).
  ELSE DO:
    &if DEFINED(IDE-IS-RUNNING) <> 0 &then
    
     ShowMessageInIDE("Only font numbers 8-255 are customizable.",
                      "Information","?","OK",yes).
                     
    &else   
    MESSAGE "Only font numbers 8-255 are customizable."
	VIEW-AS ALERT-BOX INFORMATION BUTTONS Ok.
	&endif
  END.
END.


ON MOUSE-SELECT-DBLCLICK OF tFontDefault
DO:
  &if DEFINED(IDE-IS-RUNNING) <> 0 &then
    
     ShowMessageInIDE("Only font numbers 8-255 are customizable.",
                      "Information","?","OK",yes).
                     
  &else  
  MESSAGE "Only font numbers 8-255 are customizable."
	VIEW-AS ALERT-BOX INFORMATION BUTTONS Ok.
  &endif
END.

ON CHOOSE OF iLeftArrow DO:
  DEFINE VARIABLE ivFontStart AS INTEGER.

  ASSIGN ivFontStart = tFont0:FONT IN FRAME frFontEdit.
  IF ivFontStart <> 0 THEN DO:
    IF iFontNumber <> ? THEN  /* if default font is not selected */
      ASSIGN rSelected:HIDDEN = TRUE.
    ivFontStart = ivFontStart - 4.
    RUN SetTextFonts(ivFontStart).
  END.
END.


ON CHOOSE OF iRightArrow DO:
  DEFINE VARIABLE ivFontStart as integer.

  ASSIGN ivFontStart = tFont3:FONT IN FRAME frFontEdit + 1.
  IF ivFontStart > 255 THEN
  do:
  &if DEFINED(IDE-IS-RUNNING) <> 0 &then
    
     ShowMessageInIDE("Valid Font numbers are from 0 to 255.",
                       "Information","?","OK",yes).
                     
    &else
    MESSAGE "Valid Font numbers are from 0 to 255."
	VIEW-AS ALERT-BOX INFORMATION BUTTONS OK.
	&endif
  end.	
  ELSE
    DO:
      IF FONT-TABLE:NUM-ENTRIES < (ivFontStart + 4) THEN
        FONT-TABLE:NUM-ENTRIES = ivFontStart + 4.
      IF iFontNumber <> ? THEN /* if default font is not selected */
        rSelected:HIDDEN = TRUE.
      RUN SetTextFonts(ivFontStart).
    END.
END.

ON CHOOSE OF bSave 
  RUN SaveSettings.

ON GO OF FRAME frFontEdit DO:
  DEF VAR lOK AS LOGICAL NO-UNDO.
  /* Tell the user if they changed any colors, but did not save. */
  IF lChanged AND NOT lSaved THEN DO:
    &if DEFINED(IDE-IS-RUNNING) <> 0 &then
    
    lok     = ShowMessageInIDE("Font settings were edited, but they have ~n 
                                   not been saved.  These changes will be lost when ~n
                                   you leave the PROGRESS session. ~n
                                   Would you like to save settings?",
                                   "Warning","?","YES-NO-CANCEL",yes).
                                   
                      
    &else
    MESSAGE "Font settings were edited, but they have" {&SKP}
            "not been saved.  These changes will be lost when" {&SKP}
            "you leave the PROGRESS session." SKIP(1)
            "Would you like to save settings?"
            VIEW-AS ALERT-BOX WARNING BUTTONS YES-NO-CANCEL UPDATE lOK.
    &endif        
    IF lOK eq ? THEN RETURN NO-APPLY.
    ELSE IF lOK THEN RUN SaveSettings.
  END.
END.

ON ENDKEY OF FRAME frFontEdit DO:
  /* Tell the user that changes make to the SYSTEM-DIALOG will not
     be undone. */
  IF lChanged OR lSaved THEN DO:
    &if DEFINED(IDE-IS-RUNNING) <> 0 &then
    
     ShowMessageInIDE("Changes make editing fonts or saving ~n font settings cannot be undone. ~n
                      Cancelling this dialog will not undo those changes.",
                      "Warning","?","OK",yes).
                                   
     
    &else  
    MESSAGE "Changes make editing fonts or saving" {&SKP}
            "font settings cannot be undone." SKIP(1)
            "Cancelling this dialog will not undo those changes."
            VIEW-AS ALERT-BOX WARNING BUTTONS OK.
   &endif         
  END.
END.

/****************************** Main Loop ******************************/
DO WITH FRAME frFontEdit:
  DEFINE VARIABLE ivFontStart AS INTEGER.

  /* Always make sure that we have the minimal font entries. */
  IF FONT-TABLE:NUM-ENTRIES < 8 THEN
    FONT-TABLE:NUM-ENTRIES = 8.

  /* Note the highest font so far. */
  highest-font = FONT-TABLE:NUM-ENTRIES.
  
  /* Run time layout for button area. */
  {adecomm/okrun.i  
     &FRAME = "FRAME frFontEdit" 
     &BOX   = "rHeavyRule"
     &OK    = "bOK" 
     &HELP  = "bHelp"
  }

  ASSIGN FRAME frFontEdit:HIDDEN = TRUE.
  
  ASSIGN iFontNumber = iiopFontNumber /* Copy output parameter to local var */
  
         tSample:HEIGHT-PIXELS = tSample:HEIGHT-PIXELS + 50
	 tSample:WIDTH-PIXELS = tSample:WIDTH-PIXELS + 80
	 tSample:SCREEN-VALUE = "Sample"
	 
	 tDefault:SCREEN-VALUE = "Default"
	 tZero:SCREEN-VALUE = "0"
	 tOne:SCREEN-VALUE = "1"
	 tTwo:SCREEN-VALUE = "2"
	 tThree:SCREEN-VALUE = "3"

	 tFont0:FONT = 0
	 tFont1:FONT = 1
	 tFont2:FONT = 2
	 tFont3:FONT = 3
	 tFontDefault:FONT = iipDfltFontNumber
	 
	 tFont0:SCREEN-VALUE = "AaBbYyZz"
	 tFont1:SCREEN-VALUE = "AaBbYyZz"
	 tFont2:SCREEN-VALUE = "AaBbYyZz"
	 tFont3:SCREEN-VALUE = "AaBbYyZz"
	 tFontDefault:SCREEN-VALUE = "AaBbYyZz"
         
         rFontDefault:X = tFontDefault:X - 1
         rFontDefault:Y = tFontDefault:Y - 1
         rFontDefault:WIDTH-P  = tFontDefault:WIDTH-P + 2
         rFontDefault:HEIGHT-P = tFontDefault:HEIGHT-P + 2
         
         rFont0:X = tFont0:X - 1
         rFont0:Y = tFont0:Y - 1
         rFont0:WIDTH-P  = tFont0:WIDTH-P + 2
         rFont0:HEIGHT-P = tFont0:HEIGHT-P + 2
         
         rFont1:X = tFont1:X - 1
         rFont1:Y = tFont1:Y - 1
         rFont1:WIDTH-P  = tFont1:WIDTH-P + 2
         rFont1:HEIGHT-P = tFont1:HEIGHT-P + 2
         
         rFont2:X = tFont2:X - 1
         rFont2:Y = tFont2:Y - 1
         rFont2:WIDTH-P  = tFont2:WIDTH-P + 2
         rFont2:HEIGHT-P = tFont2:HEIGHT-P + 2
         
         rFont3:X = tFont3:X - 1
         rFont3:Y = tFont3:Y - 1
         rFont3:WIDTH-P  = tFont3:WIDTH-P + 2
         rFont3:HEIGHT-P = tFont3:HEIGHT-P + 2
         
        ldummy = rSelected:MOVE-TO-BOTTOM()
        iLeftArrow:HEIGHT-PIXELS = iLeftArrow:HEIGHT-PIXELS *
                   (IF SESSION:PIXELS-PER-ROW = 21 THEN 1.4 ELSE 1)
        iLeftArrow:WIDTH-PIXELS = iLeftARROW:WIDTH-PIXELS *
                   (IF SESSION:PIXELS-PER-COLUMN = 6 THEN 1.2 ELSE 1) 
        iLeftArrow:Y = (rFontDefault:Y + (rFontDefault:HEIGHT-PIXELS / 2))
				- (iLeftArrow:HEIGHT-PIXELS / 2)
        iRightArrow:HEIGHT-PIXELS = iLeftArrow:HEIGHT-PIXELS
        iRightArrow:WIDTH-PIXELS  = iLeftArrow:WIDTH-PIXELS
 	iRightArrow:Y = (rFont3:Y + (rFont3:HEIGHT-PIXELS / 2))
				- (iRightArrow:HEIGHT-PIXELS / 2).

  /*
    Display the correct initial font based on the font that was passed in
    and highlight the passed font.
  */

  IF iFontNumber = ? THEN DO:
    RUN SetTextFonts(0).
    RUN HighlightSelectedFont(tFontDefault:HANDLE).
  END.
  ELSE DO:
    RUN GetStartingFontNumber(iFontNumber, OUTPUT ivFontStart).
    RUN SetTextFonts(ivFontStart). 
    IF iFontNumber = ivFontStart THEN
      RUN HighlightSelectedFont(tFont0:HANDLE).
    ELSE IF iFontNumber = ivFontStart + 1 THEN
      RUN HighlightSelectedFont(tFont1:HANDLE).
    ELSE IF iFontNumber = ivFontStart + 2 THEN
      RUN HighlightSelectedFont(tFont2:HANDLE).
    ELSE IF iFontNumber = ivFontStart + 3 THEN
      RUN HighlightSelectedFont(tFont3:HANDLE).
  END.
  
  ASSIGN ivFrameWidth = FRAME frFontEdit:WIDTH-PIXELS -
                        FRAME frFontEdit:BORDER-LEFT-P -
                        FRAME frFontEdit:BORDER-RIGHT-P.
  ASSIGN FRAME frFontEdit:HIDDEN = FALSE.
  
&scoped-define CANCEL-EVENT U2
{adeuib/ide/dialogstart.i bok bcancel cipTitle}
  DO TRANSACTION ON ENDKEY UNDO, LEAVE:
    ASSIGN pressed_OK = no.
    RUN setSampleFont (IF iFontNumber eq ? 
                       THEN iipDfltFontNumber
                       ELSE iFontNumber).

    ENABLE ALL EXCEPT bEdit iLeftArrow iRightArrow WITH FRAME frFontEdit.
    
    ENABLE bOk bCancel bHelp WITH FRAME frFontEdit.
    IF NOT RETRY THEN
      &if DEFINED(IDE-IS-RUNNING) = 0  &then
        UPDATE bOk bCancel bHelp WITH FRAME frFontEdit. 
    &ELSE
        WAIT-FOR "choose" of bok in frame frFontEdit or "u2" of this-procedure.       
        if cancelDialog THEN UNDO, LEAVE.  
    &endif
      
    ASSIGN iiopFontNumber = iFontNumber  /* Send back changes */
           pressed_OK     = yes.
  END.
  HIDE FRAME frFontEdit.
END.
/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/
/*----------------------------------------------------------------------------

  File: _collaps.p

  Description: 

  Input Parameters:
      <none>

  Output Parameters:
      <none>

  Author: Greg O'Connor

  Created: 05/12/93 - 12:17 pm


-----------------------------------------------------------------------------*/
DEFINE INPUT         PARAMETER whList       AS widget-handle NO-UNDO.
DEFINE INPUT         PARAMETER cTemp        AS CHARACTER NO-UNDO.

  DEFINE VARIABLE cArrayList   AS CHARACTER NO-UNDO.
  DEFINE VARIABLE cArrayEntry  AS CHARACTER NO-UNDO.
  DEFINE VARIABLE lArray       AS LOGICAL   NO-UNDO INIT FALSE.
  DEFINE VARIABLE lMatch       AS LOGICAL   NO-UNDO INIT FALSE.
  DEFINE VARIABLE lOk          AS LOGICAL   NO-UNDO INIT FALSE.
  DEFINE VARIABLE cMatch       AS CHARACTER NO-UNDO INIT FALSE.
  DEFINE VARIABLE cMatchNext   AS CHARACTER NO-UNDO INIT FALSE.
  DEFINE VARIABLE cName        AS CHARACTER NO-UNDO.
  Define VARIABLE cTempOrg     AS CHARACTER NO-UNDO.
  Define VARIABLE j            AS INTEGER   NO-UNDO.  /* loop index */
  Define VARIABLE i            AS INTEGER   NO-UNDO.  /* loop index */
  Define VARIABLE iPos         AS INTEGER   NO-UNDO.  /* loop index */
  Define VARIABLE k            AS INTEGER   NO-UNDO.  /* loop index */
  Define VARIABLE icurrent     AS INTEGER   NO-UNDO.  /* loop index */
  Define VARIABLE iHigh        AS INTEGER   NO-UNDO.  
  Define VARIABLE iLow         AS INTEGER   NO-UNDO.  
  Define VARIABLE iHighNext    AS INTEGER   NO-UNDO.  
  Define VARIABLE iLowNext     AS INTEGER   NO-UNDO.  
  Define VARIABLE iListLen     AS INTEGER   NO-UNDO.

  ASSIGN cTempOrg = cTemp.

  IF cTemp MATCHES ("*[*]*") THEN 
    ASSIGN cArrayEntry = ENTRY(2,cTemp,'[':u)
           cArrayEntry = RIGHT-TRIM(cArrayEntry,"]":u)
           cTemp       = ENTRY(1,cTemp,'[':u)
           lArray      = TRUE.
  /*  
  ** This code assumes that the list on the Left side is in
  ** aplhabetical order and will insert or add accordingly
  */
  DO j = 1 TO NUM-ENTRIES(whList:LIST-ITEMS,whList:DELIMITER):
    cName = ENTRY(j,whList:LIST-ITEMS,whList:DELIMITER).

    IF (lArray = TRUE) AND cName MATCHES ("*[*]*":u) THEN
      ASSIGN cArrayList = ENTRY(2,cName,'[':u)
             cArrayList = RIGHT-TRIM(cArrayList,"]":u)
             cName      = ENTRY(1,cName,'[':u)
             iListLen   = NUM-ENTRIES(cArrayList).	
    /*
    ** If it is an array and the names match the add the index in to
    ** the existing list.
    */
    IF (lArray = TRUE) AND (cTemp = cName) THEN DO:

      ASSIGN lMatch   = FALSE
             cMatch   = ENTRY (1, cArrayList, ' ':u)
             iListLen = NUM-ENTRIES (cArrayList, ' ':u).

      DO k = 1 to iListLen:
        ASSIGN cMatch = ENTRY (k, cArrayList, ' ')
               iHigh  = INTEGER (ENTRY (NUM-ENTRIES (cMatch, '-'), cMatch, '-'))
               iLow   = INTEGER (ENTRY (1, cMatch, '-')).
        /*
        ** Check here for adding a number that will extend a sequence.
		** [1-4] andding 5 => [1-5] or
		** [2-4] andding 1 => [1-5] or
		** [2-4] andding 6 => [2-4,6] 
        */ 
        IF iHigh > INTEGER (cArrayEntry) THEN DO:
          IF NUM-ENTRIES (cMatch, '-') = 2 AND
             iHigh + 1 = INTEGER (cArrayEntry) THEN 
            ENTRY (k, cArrayList, ' ') = STRING (iLow) + '-' + cArrayEntry.
          ELSE IF NUM-ENTRIES (cMatch, '-') = 2 AND
             iLow - 1 = INTEGER (cArrayEntry) THEN 
            ENTRY (k, cArrayList, ' ') = cArrayEntry + '-' + STRING (iHigh).
		  ELSE
            ENTRY (k, cArrayList, ' ') = cArrayEntry + " " + ENTRY (k, cArrayList, ' ').
          LEAVE.
        END.  /* If iHigh > INTEGER */
      END.  /* do k = 1 to iListLen */
  
/*      message  'first' ihigh cArrayList  view-as alert-box error buttons Ok. */

      /* NOT ADDED ABOVE SO...
      ** Check here for adding a number that will extend a sequence.
	  ** [1-4] andding 5 => [1-5] or
	  ** [2-4] andding 1 => [1-5] or
	  ** [2-4] andding 6 => [2-4,6]    */ 
      IF k > iListLen THEN 
        IF NUM-ENTRIES (cMatch, '-') = 2 AND
           iHigh + 1 = INTEGER (cArrayEntry) THEN 
            ENTRY (iListLen, cArrayList, ' ') = STRING (iLow) + '-' + cArrayEntry.
        ELSE IF NUM-ENTRIES (cMatch, '-') = 2 AND
           iLow - 1 = INTEGER (cArrayEntry) THEN 
            ENTRY (iListLen, cArrayList, ' ') = cArrayEntry + '-' + STRING (iHigh).
 		ELSE
          cArrayList = cArrayList + " " + cArrayEntry.

      /* Remove and extra , if we collapsed some where  */
      cArrayList =  TRIM (REPLACE (cArrayList, '  ', ' '), ' ').
      DO WHILE INDEX(cArrayList, '  ') > 0:
        cArrayList = REPLACE (cArrayList, '  ', ' ').
      END.

/*      message  'first' cArrayList  view-as alert-box error buttons Ok. */

      ASSIGN cMatch   = ENTRY (1, cArrayList, ' ')
             iCurrent = INTEGER (ENTRY (NUM-ENTRIES (cMatch, '-'), cMatch, '-'))
             iListLen = NUM-ENTRIES (cArrayList, ' ') - 1.

      DO k = 1 TO iListLen:
        cMatch = ENTRY (k + 1, cArrayList, ' ').
/*      message  'colapse2 ' iCurrent INTEGER (ENTRY (1, cMatch, '-')) lMatch skip cArrayList
                  view-as alert-box error buttons Ok.	   */

        /* Check for consecutive entries to collapse.
           ** [1,2,3] => [1-3]                    */      
        IF ((iCurrent + 1) = INTEGER (ENTRY (1, cMatch, '-'))) THEN DO:
          IF lMatch THEN
            ASSIGN ENTRY (iPos, cArrayList, ' ')  =  ENTRY (iPos, cArrayList, ' ') + '-' +
                                                         ENTRY (k + 1,  cArrayList, ' ') 
                   ENTRY (k,  cArrayList, ' ')     = ''
                   ENTRY (k + 1,  cArrayList, ' ') = ''.

          /* If not a match the set for next time around and save position.  */
          IF NOT lMatch THEN
            ASSIGN lMatch = TRUE
                   iPos   = k.

          iCurrent = iCurrent + 1.
        END. /* consecutive entries */
        ELSE /* Reset match */
          ASSIGN iCurrent = INTEGER (ENTRY (NUM-ENTRIES (cMatch, '-'), cMatch, '-')) 
                 lMatch   = FALSE.
      END.  /* k = 1 TO iListLen */

      /* Remove and extra , if we collapsed some where  */
      cArrayList =  TRIM (REPLACE (cArrayList, '  ', ' ')).
      DO WHILE INDEX(cArrayList, '  ') > 0:
        cArrayList = REPLACE (cArrayList, '  ', ' ').
      END.

      ASSIGN iListLen   = NUM-ENTRIES (cArrayList, ' ').

/*      message  'middle' cArrayList iListLen view-as alert-box error buttons Ok.  */

      DO k = 1 to iListLen:
        ASSIGN cMatch = ENTRY (k, cArrayList, ' ')
               iHigh  = INTEGER (ENTRY (NUM-ENTRIES (cMatch, '-'), cMatch, '-'))
               iLow   = INTEGER (ENTRY (1, cMatch, '-')).

/*      message iListLen cMatch k skip cArrayList iHigh  INTEGER (cArrayEntry)    view-as alert-box error buttons Ok. */
        /* Check here for adding a number that will extend a sequence.
		** [1-4-9] => [1-9]     */ 
        IF NUM-ENTRIES (cMatch, '-') > 2 THEN DO:
          ENTRY (k, cArrayList, ' ') = STRING (iLow) + '-' + STRING (iHigh).
          LEAVE.
        END.  /* If more than 2 entries */
      END.  /* Do k = 1 TO iListLen */
  
      /* Remove and extra - if we collapsed some where  */
      DO WHILE INDEX(cArrayList,"--":U) > 0:
        cArrayList = REPLACE (cArrayList, '--', '-').
      END.

      /* Remove and extra , if we collapsed some where	  */
      cArrayList =  TRIM (REPLACE (cArrayList, '  ', ' ')).
      DO WHILE INDEX(cArrayList,'  ') > 0:
        cArrayList = REPLACE (cArrayList, '  ', ' ').
      END.

      ASSIGN iListLen   = NUM-ENTRIES (cArrayList, ' ') - 1.

/*    message  'last' cArrayList  view-as alert-box error buttons Ok.  */

      DO k = 1 to iListLen:
        ASSIGN cMatchNext = ENTRY (k + 1, cArrayList, ' ')
               iHighNext  = INTEGER (ENTRY (NUM-ENTRIES (cMatchNext, '-'), cMatchNext, '-'))
               iLowNext   = INTEGER (ENTRY (1, cMatchNext, '-'))
               cMatch     = ENTRY (k, cArrayList, ' ')
               iHigh      = INTEGER (ENTRY (NUM-ENTRIES (cMatch, '-'), cMatch, '-'))
               iLow       = INTEGER (ENTRY (1, cMatch, '-')).

/*        message  iHigh   '=' ilowNext skip   iHighNext  ilow skip    
        view-as alert-box error buttons Ok. */

        IF ((iHigh + 1) = iLowNext) THEN DO:
        /*   ** Check here for adding a number that will extend a sequence.
             ** [1-4,5-7]  => [1-7]        */ 
          IF NUM-ENTRIES (cMatch, '-') = 2 THEN 
            ASSIGN ENTRY (k, cArrayList, ' ') =  STRING (iLow) + '-' + STRING (iHighNext)
                   /*REPLACE (cMatch, STRING (iHigh), STRING(iHighNext))*/
                   ENTRY (k + 1, cArrayList, ' ') = "" .
          /*  ** Check here for adding a number that will extend a sequence.
		** [1,4,5-7]  => [1,4-7]        */ 
          ELSE IF NUM-ENTRIES (cMatchNext, '-') = 2 THEN 
            ASSIGN ENTRY (k + 1, cArrayList, ' ') = STRING (iLow) + '-' + STRING (iHighNext)
                   ENTRY (k    , cArrayList, ' ') = "" .
          LEAVE.
        END.  /* If iHigh + 1 = iLowNext */
      END. /* Do k = 1 TO iListLen */

/*        message  'replace' j ilistlen cArrayList       view-as alert-box error buttons Ok. */

      /* Remove and extra - if we collapsed some where */
      DO WHILE INDEX(cArrayList,"--") > 0:
        cArrayList = REPLACE (cArrayList, '--', '-').
      END.

      /* Remove and extra , if we collapsed some where	  */
      cArrayList =  TRIM (REPLACE (cArrayList, '  ', ' ')).
      DO WHILE INDEX(cArrayList, '  ':U) > 0:
        cArrayList = REPLACE (cArrayList, '  ', ' ').
      END.

      /* Need to check if this is the last item to be added and the collapse
  	  to 1-N notation where N is the number of extents...  	  */
      ASSIGN cName = cName + '[' + cArrayList + ']'
             lOk = whList:REPLACE (cName, ENTRY (j, whList:LIST-ITEMS, whList:DELIMITER))
             cTempOrg = cName.
      LEAVE.
    END.  /* IF (lArray = TRUE) AND (cTemp = cName) */
    ELSE IF (ENTRY(1,ENTRY(j,whList:LIST-ITEMS,whList:DELIMITER),"[":U) > cTemp) THEN DO:
      ASSIGN lOk = whList:INSERT(cTempOrg, 
                   ENTRY (j, whList:LIST-ITEMS, whList:DELIMITER)).
      RUN adecomm/_scroll.p (whList:HANDLE, INPUT cTempOrg). 
      LEAVE.
    END. /* Else if entry j is after cTemp */
  END. /*   DO j = 1 TO num-entries of whList */

  IF (j > NUM-ENTRIES (whList:LIST-ITEMS, whList:DELIMITER) OR whList:LIST-ITEMS = ?) THEN DO:
    lOK = whList:ADD-LAST(cTempOrg). 
    RUN adecomm/_scroll.p (whList:HANDLE, INPUT cTempOrg). 
  END.

RETURN.

/* _collaps.p - end of file */


/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/
/*

  File: _fconvert.p

  Description: 
     Converts an American numeric format to non-American and vice-versa.
   
  Input Parameters:
      pType          A-TO-N  American to Non-American
                     N-TO-A  Non-American to American
      pInFormat      The input format to convert
      pNumSeparator  The numeric separator to use
      pNumDecimal    The numeric decimal point to use
      
  Output Parameters:   
       pOutFormat The resulting output format
       
  Note: In this function, CHR(6) is used as a temporary replacement 
         character because it is assume that the value should not be found
         in the format string.

  Author: Bob Ryan
  Created: 6/6/94
 
  Modified: 
    04/09/99  -  Added support for various Intl Numeric Formats (in 
                 addition to American and European).  
*/

define input parameter  pType         as char no-undo.
define input parameter  pInFormat     as char no-undo.
define input parameter  pNumSeparator as char no-undo.
define input parameter  pNumDecimal   as char no-undo.
define output parameter pOutFormat    as char no-undo.

define var FirstPass  as char no-undo.
define var SecondPass as char no-undo.

if pInFormat = "" or pType = "" then do:
  pOutFormat = pInFormat.
  return.
end.

if caps(pType) =  "A-TO-N" then
  assign
    FirstPass  = replace(pInFormat, ".", chr(6)) 
    SecondPass = replace(FirstPass, ",", pNumSeparator) 
    pOutFormat = replace(SecondPass, chr(6), pNumDecimal) .
else
  assign    
    FirstPass  = replace(pInFormat, pNumDecimal, chr(6)) 
    SecondPass = replace(FirstPass, pNumSeparator, ",") 
    pOutFormat = replace(SecondPass, chr(6), ".") .
    
    

/************************************************************************
* Copyright (C) 2000,2005 by Progress Software Corporation.  All rights *
* reserved.  Prior versions of this work may contain portions           *
* contributed by participants of Possenet.                              *
************************************************************************/
/*----------------------------------------------------------------------------

File: _datatyp.p

Description:
    Return a progress datatype given an integer value
    Integer value is assumed to be the same code used in the _dtype field
    in the schema.

    Returns blank if integer is not a known integer value

Parameter:
   INPUT 	dType	        INTEGER
   OUTPUT 	dataType	CHARACTER
   
Author: SLK
Date Created: 08/11/98
Copied integer values from getDataSignature in adm2/browser.p

----------------------------------------------------------------------------*/

DEFINE INPUT PARAMETER  pi_dType          AS INTEGER NO-UNDO.
DEFINE OUTPUT PARAMETER pc_dataType       AS CHARACTER NO-UNDO.

CASE pi_dType:
   WHEN  1 THEN pc_dataType = 'CHARACTER':U .
   WHEN  2 THEN pc_dataType = 'DATE':U .
   WHEN  3 THEN pc_dataType = 'LOGICAL':U .
   WHEN  4 THEN pc_dataType = 'INTEGER':U .
   WHEN  5 THEN pc_dataType = 'DECIMAL':U .
      /* Note: Float/Double reserved for possible future use. */
   WHEN  6 THEN pc_dataType = 'DOUBLE':U. /* FLOAT */
   WHEN  7 THEN pc_dataType = 'RECID':U .
   WHEN  8 THEN pc_dataType = 'RAW':U .
   WHEN  9 THEN pc_dataType = 'ROWID':U .
   WHEN 18 THEN pc_dataType = 'BLOB':U .
   WHEN 19 THEN pc_dataType = 'CLOB':U .
   WHEN 34 THEN pc_dataType = 'DATETIME':U .
   WHEN 40 THEN pc_dataType = 'DATETIME-TZ':U .
   WHEN 41 THEN pc_dataType = 'INT64':U .
   WHEN  0 THEN pc_dataType = '':U .
   OTHERWISE    pc_dataType = '':U.
END CASE.
/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/*----------------------------------------------------------------------------

File: dbcnnct.p

Description:
   Calls _dbconnx.p to display and handle the connect dialog box, doing the
   connection if the user presses OK.  This call takes only three parameters.

Input Parameters:
   pi_msg    - A message to display in an ALERT-BOX which asks the user
               if they wish to connect.  If this is ? then we always
               try to connect.  If an alert-box is requested, the message
               is pi_msg {&SKP} "Do you want to connect to a database?"
Input Parameters:
   po_OK     - TRUE if the user asked to connect and if a connection
               was made.

Author: William T. Wood

Date Created: 06/3/93

----------------------------------------------------------------------------*/

Define INPUT  parameter pi_msg as char    NO-UNDO.
Define OUTPUT parameter po_OK  as logical NO-UNDO.
/* Database Parameters */
Define var PName         as char    NO-UNDO. /* Physical DB Name */
Define var LName         as char    NO-UNDO. /* Logical DB Name  */
Define var DB_Type       as char    NO-UNDO. /* DB Name Type - eg. "PROGRESS" */
Define var Db_Multi_User as logical NO-UNDO.

/* Dummy Parameters */
Define var dummy_1       as char    NO-UNDO.
Define var dummy_2       as char    NO-UNDO.
Define var dummy_3       as char    NO-UNDO.
Define var dummy_4       as char    NO-UNDO.
Define var dummy_5       as char    NO-UNDO.
Define var dummy_6       as char    NO-UNDO.
Define var dummy_7       as char    NO-UNDO.
Define var dummy_8       as char    NO-UNDO.
Define var dummy_9       as char    NO-UNDO.
define variable luseide as logical no-undo.
{adecomm/oeideservice.i}

/* Define a SKIP for alert-boxes that only exists under Motif */
&Global-define SKP ""
/*----------------------------Mainline code----------------------------------*/
/* Should we ask if user wants to connect ? */
IF pi_msg eq ? THEN po_OK = YES.
ELSE
do: 
    if OEIDEIsRunning then
    do:         
       if OEIDE_CanShowMessage() then
       do: 
           po_OK =  OpenDBConnectionDialog(pi_msg). 
           if po_ok = ? then 
              po_ok = no.
           luseide = true.
       end.
       else do:
           pi_msg = pi_msg + "~n" 
                   +  "The current ABL Dialog is not managed by the current workbench."
                   +  " You can connect to a database from here, but the connection will not be defined in the current project."
                   + "~n~n". 
       end.
    end.
    if not luseide then                     
        MESSAGE pi_msg {&SKP} "Do you want to connect to a database?"
             VIEW-AS ALERT-BOX QUESTION BUTTONS OK-CANCEL UPDATE po_OK.

end.

IF po_OK and not luseide THEN 
DO:
     if pi_msg eq ? and OEIDE_CanShowMessage() then
     do: 
           po_OK =  OpenDBConnectionDialog(?). 
           if po_ok = ? then 
              po_ok = no.
     end. 
     else do:
      /* Set defaults for the db connect dialog. */
        ASSIGN DB_Multi_User = no
               DB_Type       = "PROGRESS":U.
    
        RUN adecomm/_dbconnx.p ( YES,   /* whether to connect the database spec'd */
                            INPUT-OUTPUT PName,
                            INPUT-OUTPUT LName,
                            INPUT-OUTPUT DB_Type,
                            INPUT-OUTPUT Db_Multi_User,
                            INPUT-OUTPUT dummy_1,
                            INPUT-OUTPUT dummy_2,
                            INPUT-OUTPUT dummy_3,
                            INPUT-OUTPUT dummy_4,
                            INPUT-OUTPUT dummy_5,
                            INPUT-OUTPUT dummy_6,
                            INPUT-OUTPUT dummy_7,
                            INPUT-OUTPUT dummy_8,
                            OUTPUT       dummy_9  ).
       
            /* Was a database connected */
        IF PName eq ? THEN po_OK = no.
    end.
END.
/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/*----------------------------------------------------------------------------

File: _dbconn.p

Description:
   Calls dbconnx.p to display and handle the connect dialog box, doing the 
   connection if the user presses OK.  This call takes only three parameters.

Input/Output Parameters:
   
   | On input:  a value is supplied if known, otherwise, the value is ?
   | On output: if connect succeeded, all values are set.  If connect failed
      	        or if the user cancelled, Pname and LName are set to ?.

   p_PName  - the physical name of the database
   p_LName  - the logical name of the database
   p_Type   - The database type (e.g., PROGRESS, ORACLE)
   
 
Author: Laura Stern

Date Created: 03/24/92

----------------------------------------------------------------------------*/
{adecomm/oeideservice.i}

Define INPUT-OUTPUT parameter p_PName  as char NO-UNDO.
Define INPUT-OUTPUT parameter p_LName  as char NO-UNDO.
Define INPUT-OUTPUT parameter p_Type   as char NO-UNDO.

Define var dummy_1   	 as char    NO-UNDO.
Define var dummy_2   	 as char    NO-UNDO.
Define var dummy_3   	 as char    NO-UNDO.
Define var dummy_4   	 as char    NO-UNDO.
Define var dummy_5   	 as char    NO-UNDO.
Define var dummy_6   	 as char    NO-UNDO.
Define var dummy_7       as char    NO-UNDO.
Define var dummy_8       as char    NO-UNDO.
Define var dummy_9       as char    NO-UNDO.
Define var Db_Multi_User as logical NO-UNDO.
define var lok           as logical no-undo.
define variable inum as integer no-undo.
/*----------------------------Mainline code----------------------------------*/

DB_Multi_User = no.

if OEIDE_CanShowMessage() and num-dbs = 0 then
do: 
    RUN adecomm/_dbconnide.p ( 
                        INPUT-OUTPUT p_PName,
                        INPUT-OUTPUT p_LName,
                        INPUT-OUTPUT p_Type).        
end. 
else 
    RUN adecomm/_dbconnx.p ( YES,   /* whether to connect the database spec'd */
                        INPUT-OUTPUT p_PName,
                        INPUT-OUTPUT p_LName,
                        INPUT-OUTPUT p_Type,
                        INPUT-OUTPUT Db_Multi_User,
                        INPUT-OUTPUT dummy_1,
                        INPUT-OUTPUT dummy_2,
                        INPUT-OUTPUT dummy_3,
                        INPUT-OUTPUT dummy_4,
                        INPUT-OUTPUT dummy_5,
                        INPUT-OUTPUT dummy_6,
                        INPUT-OUTPUT dummy_7,
                        INPUT-OUTPUT dummy_8,
                        OUTPUT       dummy_9  ).

RETURN.



/*********************************************************************
* Copyright (C) 2000,2009 by Progress Software Corporation. All rights *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/*----------------------------------------------------------------------------

File: _dbconnc.p

Description:
   Display and handle the connect dialog box, doing the connection
   if the user presses OK. Used in Character Mode only, but does
   run in GUI. The ADE GUI version is now in adecomm/_dbconng.w.

Input Parameters:
   p_Connect - whether the CONNECT should be executed
   
Input/Output Parameters:

   On input:  A value is supplied if known, otherwise, the value is ?
   On output: If connect succeeded, all values are set.  If more than one
                    database is connected (via -db parms), the information is
                    set for the first one that was connected successfully.
                    If connect failed or if the user cancelled, PName and LName 
                    are set to ?.
   
   p_PName               - the physical name of the database
   p_LName               - the logical name of the database
   p_Type                - the database type (e.g., PROGRESS, ORACLE) (internal name)
   p_Multi_User          - connect in single user (no) or multi-user (yes) mode
   p_UserId              - user id
   p_Password            - password
   p_Unix_Parms          - any other parms 

Output Parameters:
   p_args   - this is the argument string built for the connect
 
Author: Laura Stern

Date Created: 03/24/92
Modified:
  05/06/09 fernando   support for manual start encryption
  06/12/00 D. McMann - Fixed frame definition to fix better
  05/18/00 D. McMann - removed comments on password 20000512011
  04/12/00 D. McMann - Added support for long database names.
  07/16/98 Mario B. - Added -N -H -S parameters.  Bug# 98-04-19-027.
  05/04/98 mcmann   - Added check of name for logical name
                      98-04-02-053
  02/11/98 mcmann   - Added logical name check for spaces.
  03/05/97 hutegger - put on stop phrase around connect
  08/01/95 hutegger - add -ld, -H, -S, -dt params only if logical
                      and/or physical dbname available
                      (sometimes people just enter pf-file. In this
                      case we need to ignore the other parameters)
  11/10/94 gfs - .pl must exist off Files...
  08/22/94 gfs - remove comments on ASSIGN of Password.
  06/22/94 gfs - ensure editor widget for other params is blank.
  05/25/94 hutegger - disabled db-type
  02/22/94 wood - Display all CONNECT error messages in a single ALERT-BOX.
  07/30/92 by Elliot Chikofsky
  08/08/11 rkamboj -     fixed issue of login when special chracter in password 
                        at the time of db connect. Applied set-db-client method.

----------------------------------------------------------------------------*/
{adecomm/cbvar.i}
{adecomm/commeng.i}  /* Help contexts */
{adecomm/adestds.i}
Define INPUT        parameter p_Connect      as logical  NO-UNDO.
Define INPUT-OUTPUT parameter p_PName        as char     NO-UNDO.
Define INPUT-OUTPUT parameter p_LName        as char     NO-UNDO.
Define INPUT-OUTPUT parameter p_Type         as char     NO-UNDO.
Define INPUT-OUTPUT parameter p_Multi_User   as logical  NO-UNDO.
Define INPUT-OUTPUT parameter p_Network      as char     NO-UNDO.
Define INPUT-OUTPUT parameter p_Host_Name    as char     NO-UNDO.
Define INPUT-OUTPUT parameter p_Service_Name as char     NO-UNDO.
Define INPUT-OUTPUT parameter p_UserId       as char     NO-UNDO.
Define INPUT-OUTPUT parameter p_Password     as char     NO-UNDO.
Define INPUT-OUTPUT parameter p_Trig_Loc     as char     NO-UNDO.
Define INPUT-OUTPUT parameter p_Parm_File    as char     NO-UNDO.
Define INPUT-OUTPUT parameter p_Unix_Parms   as char     NO-UNDO.
Define OUTPUT       parameter p_args         as char     NO-UNDO.

DEFINE              VARIABLE  Pass_Phrase    AS LOGICAL  NO-UNDO.
Define              variable  capab          as char     NO-UNDO. /* DataServ Cabap's */
Define              variable  ext_Type       as char     NO-UNDO.
DEFINE              VARIABLE hCP             AS HANDLE  NO-UNDO.
DEFINE              VARIABLE setdbclnt       AS LOGICAL NO-UNDO.
DEFINE              VARIABLE currentdb       AS CHAR VIEW-AS TEXT FORMAT "x(32)" NO-UNDO.
/*Define              variable  qbf_l_name    as logical NO-UNDO. / * l-name NOT needed */
Define              variable  qbf_p_name     as logical  NO-UNDO. /* p-name NOT needed */

&IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN
   /* "Blue bar" optional text */
   define var txt_optional as char initial " Optional" {&STDPH_SDIV}
                                             format "x(12)" view-as text.

&ENDIF

/* Buttons */
Define button btn_Filen  label "&Files..." SIZE 12 by 1.
Define button btn_Filet  label "Files..."  SIZE 12 by 1.
Define button btn_Filep  label "Files..."  SIZE 12 by 1.
Define button btn_Fileb  label "Files..."  SIZE 12 by 1.
Define button btn_Filea  label "Files..."  SIZE 12 by 1.
Define button btn_Ok          label "OK"        {&STDPH_OKBTN}.
Define button btn_Cancel label "Cancel"    {&STDPH_OKBTN} AUTO-ENDKEY.
Define button btn_Help   label "&Help"           {&STDPH_OKBTN}.

&IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN
   /* standard button rectangle */
   Define rectangle rect_Btns {&STDPH_OKBOX}.
&ENDIF

/* Miscellaneous */
Define var stat   as logical NO-UNDO.
Define var ix     as integer NO-UNDO.
Define var Other  as char    NO-UNDO.

&IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN
   &global-define FBTN_SPACE  .3
&ELSE
   &global-define FBTN_SPACE  1
&ENDIF

form
  /* SKIP({&TFM_WID})*/
   p_PName             label "Physical &Name"             colon  18
                   format "x({&PATH_WIDG})" {&STDPH_FILL}
                                view-as FILL-IN SIZE 39 by 1                  SPACE({&FBTN_SPACE})
   btn_Filen                                                                  

   &IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN
      SKIP({&VM_WIDG})
      txt_optional no-label                     at 2 
      SKIP({&VM_WIDG})
   &ELSE
      SKIP({&VM_WID})
   &ENDIF

   p_LName               label "&Logical Name"        colon  18
                                format "x(50)" {&STDPH_FILL}             SKIP({&VM_WID})

   ext_Type              label "&Database Type"             colon  18
                                format "x(11)" {&STDPH_FILL}     

   p_Multi_User    label "&Multiple Users"      at     35
                                view-as TOGGLE-BOX
   Pass_Phrase     label "Passphrase"      at     57
                                view-as TOGGLE-BOX                             SKIP({&VM_WID})

   p_UserId              label "&User ID"                         colon  18 
                                format "x(50)" {&STDPH_FILL}             SKIP({&VM_WID})
   p_Password            label "Pass&word"                        colon  18
                                format "x(50)" {&STDPH_FILL} PASSWORD-FIELD SKIP({&VM_WID})
   p_Trig_Loc      label "&Trigger Location"    colon  18
                         format "x({&PATH_WIDG})" {&STDPH_FILL}
                                view-as FILL-IN SIZE 39 by 1             SPACE({&FBTN_SPACE})
   btn_Filet                                                SKIP({&VM_WID})
   p_Parm_File           label "&Parameter File"            colon  18
                                format "x({&PATH_WIDG})" {&STDPH_FILL}
                                view-as FILL-IN SIZE 39 by 1             SPACE({&FBTN_SPACE})
   btn_Filep                                                SKIP({&VM_WID}) 

   &IF "{&WINDOW-SYSTEM}" = "TTY" &THEN
      SKIP(1)
   &ENDIF
                                             
   "Other CONNECT Statement Parameters:"              at      4   SKIP({&VM_WID})
   Other    NO-LABEL  {&STDPH_EDITOR}    at      4
                                view-as EDITOR SCROLLBAR-VERTICAL
                                &IF "{&WINDOW-SYSTEM}" = "TTY" &THEN
                                  SIZE 67 BY 4
                                &ELSE
                                  SIZE 67 BY 2.5
                                &ENDIF

   {adecomm/okform.i
      &BOX    = rect_btns
      &STATUS = no
      &OK     = btn_OK
      &CANCEL = btn_Cancel 
      &HELP   = btn_Help}

   with frame CONNECT ROW 1
        SIDE-LABELS 
              DEFAULT-BUTTON btn_Ok CANCEL-BUTTON btn_Cancel
        view-as DIALOG-BOX TITLE "Connect Database".


/*====================== Internal Procedures and Functions ===================*/

Procedure Get_File_Name:
   Define INPUT PARAMETER h_name  as widget-handle NO-UNDO.
   Define INPUT PARAMETER p_ext   as char          NO-UNDO. /* contains "." */
   Define INPUT PARAMETER p_title as char          NO-UNDO.
   Define INPUT PARAMETER p_exist as logical       NO-UNDO.

   Define var name       as char    NO-UNDO.
   Define var picked_one as logical NO-UNDO.
   Define var filter     as char    NO-UNDO.
   Define var must_exist as char    NO-UNDO.

   filter = "*" + p_ext.
   name = TRIM(h_name:screen-value).

   &IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN
      if p_exist then
         system-dialog GET-FILE 
            name 
            filters            filter filter
            default-extension  p_ext
            title                p_title 
            must-exist
            update             picked_one.
      else
         system-dialog GET-FILE 
            name 
            filters            filter filter
            default-extension  p_ext
            title                p_title 
            update             picked_one.
   &ELSE
      ASSIGN must_exist = IF p_exist THEN "MUST-EXIST"
                                     ELSE "".
      RUN adecomm/_filecom.p
          ( INPUT filter /* p_Filter */, 
            INPUT ""          /* p_Dir */ , 
            INPUT ""          /* p_Drive */ ,
            INPUT NO ,          /* p_Save_As */
            INPUT p_Title ,
            INPUT must_exist ,
            INPUT-OUTPUT name,
            OUTPUT picked_one). 
   &ENDIF

   if picked_one then
      h_name:screen-value = name.
end.

FUNCTION StartupParameter RETURNS CHARACTER
         (INPUT        TargetParameter AS CHARACTER,
          INPUT-OUTPUT ParameterLine   AS CHARACTER,
	  INPUT        HasArgument     AS LOGICAL).

/* Returns argument for TargetParameter or parameter if not HasArgument  *
 * If no target found, returns ""                                        */
   
   DEF VAR Extract   AS CHAR.
   DEF VAR Remainder AS CHAR.
   DEF VAR i         AS INT.
   
   DO i = 1 TO NUM-ENTRIES(ParameterLine," "):
      CASE ENTRY(i,ParameterLine," "):
         WHEN TargetParameter THEN
	 DO:
            IF HasArgument THEN
	    DO:
	       i = i + 1.
               Extract = ENTRY(i,ParameterLine," ").
            END.	       
         END.
         OTHERWISE
            Remainder = Remainder + ENTRY(i,ParameterLine," ") + " ".
      END CASE.
   END.

   ParameterLine = Remainder.
   RETURN Extract.
   
END FUNCTION.

 
/*===============================Triggers====================================*/

/*----- HIT of OK BUTTON -----*/
on choose of btn_Ok in frame connect OR GO of frame connect
do:
   Define var args         as char    NO-UNDO.
   Define var num          as integer NO-UNDO.
   Define var ix           as integer NO-UNDO.
   
   Define var cMsgs        as char   NO-UNDO.

   assign 
      p_PName     = input frame connect p_PName
      p_Parm_File = input frame connect p_Parm_File.

   /* Check for required input. */
   IF (p_PName     = ""   OR p_PName     = ?) AND
      (p_Parm_File = ""   OR p_Parm_File = ?) AND
      qbf_p_name   = TRUE                     then
   do:
      message "You must supply a physical name or a parameter file."
                     view-as ALERT-BOX ERROR buttons OK.
      return NO-APPLY.
   end.

   assign 
      input frame connect p_LName
/*    input frame connect p_Type    */
      input frame connect p_Multi_User
      input frame connect Pass_Phrase
      input frame connect p_UserId
      input frame connect p_Password
      input frame connect p_Trig_Loc
      input frame connect Other
      p_Network      = StartupParameter("-N",Other,TRUE)
      p_Host_Name    = StartupParameter("-H",Other,TRUE)
      p_Service_Name = StartupParameter("-S",Other,TRUE)
      p_Unix_Parms   = Other.
      
   /* Set up parameters for CONNECT */
   /* WIN95-LFN : WIN95 Long Filename support requires physical and logical
      dbnames be quoted. - jep 12/14/95 */
   assign args = "'" + ( if qbf_p_name then p_Pname else p_LName ) + "'".
   if args = "''" or args = ? then args = "".
   
   if args <> "" then
   do:
     assign args = args + " -dt "   + p_Type.
     if p_LName        <> "" then assign args = args + " -ld " +
                                                "'" + p_LName + "'".
     if p_Network   <> "" THEN assign args = args + " -N " + p_Network.
     if p_Host_Name <> "" THEN assign args = args + " -H " + p_Host_Name.
     if p_Service_Name <> "" THEN assign args = args + " -S " + p_Service_Name.
     if p_Type <> "PROGRESS" then
     do:
        if p_UserId    <> "" then assign args = args + " -U "  + p_UserId.
        if p_Password  <> "" then assign args = args + " -P "  + p_Password. 
     end.  
     if p_Multi_User = no then assign args = args + ' -1 '.
   end.
   
   if p_Trig_Loc  <> "" then assign args = args + " -trig " + p_Trig_Loc.
   if p_Parm_File <> "" then assign args = args + " -pf "   + p_Parm_File.

   assign p_args = args.
 
   /* If the caller did not want the database connected now, we're done */
   if not p_Connect then return.

   /* We need do ON ERROR because otherwise, if any connect fails, Progress
      will kick us out of the trigger.  Note that Progress will raise
      error on the first connect that fails and won't keep going to try
      to connect other ones.
   */
   assign num = NUM-DBS.
   /* num-dbs sometimes returns 1 instead of 0. If ldbname and pdbname 
    * are ? we reassign num to be 0 (hutegger 95/01)
    */
   if num        = 1 and
      ldbname(1) = ? and
      pdbname(1) = ? then assign num = 0.
   
   do on stop undo, retry:
     if retry
      then do:
       run adecomm/_setcurs.p ("").
       return no-apply.
       end.
      else do:
       IF NOT Pass_Phrase THEN DO:
           run adecomm/_setcurs.p ("WAIT").
           connect VALUE(args) VALUE(p_Unix_Parms) NO-ERROR.
           run adecomm/_setcurs.p ("").
       END.

       IF Pass_Phrase OR 
          (ERROR-STATUS:ERROR AND ERROR-STATUS:GET-NUMBER(1) = 15271) THEN DO:
          /* if missing or incorrect passphrase for a database
             with encryption enabled and manual start, prompt
             for the passphrase now.
          */
          DEFINE VARIABLE cpassPhrase AS CHAR NO-UNDO.

          RUN _passphrase.p (OUTPUT cpassPhrase).

          /* if they don't specify a passphrase when asked to, we will
             just display the errors we got above.
          */
          IF cpassPhrase <> ? AND length(cpassPhrase) > 0 THEN DO:
              /* this will let them try once. If it fails, then they will
                 need to try to connect again.
              */
              connect VALUE(args) VALUE("-KeyStorePassPhrase " + QUOTER(cpassPhrase)) VALUE(p_Unix_Parms) NO-ERROR.
          END.
       END.
       if  NUM-DBS > num then ASSIGN currentdb = LDBNAME(num + 1).
       if p_UserId <> "" and connected(currentdb) and p_Type = "PROGRESS" then
       do:
           create client-principal hCP. /* create a CLIENT-PRINCIPAL only once during login*/
           /* Use SET-DB-CLIENT instead of SETUSERID */ 
           hCP:initialize(p_UserId,?,?,p_Password) no-error.
           setdbclnt = set-db-client(hCP,currentdb) no-error.
             
           if NOT setdbclnt THEN 
           DO:
                MESSAGE "Userid/Password is incorrect."
                    VIEW-AS ALERT-BOX ERROR BUTTONS OK. 
                disconnect value(currentdb).
               
           end.
           delete object hCP.
           hcp = ?.
       end.
      end.
     end.

   /* This will be set from any errors or warnings. Merge all the warnings
      together and display them in one shot.  */
   IF error-status:NUM-MESSAGES > 0 THEN DO:
     if lookup(string(error-status:GET-NUMBER(1)),'15944,13691,12710',',') = 0 then  
     cMsgs = error-status:get-message(1).
     do ix = 2 to error-status:num-messages:
       if lookup(string(error-status:GET-NUMBER(ix)),'15944,13691,12710',',') = 0 then  
       cMsgs = cMsgs + CHR(10) + error-status:get-message(ix).
     end.
     if trim(cMsgs) <> "" then
     MESSAGE cMsgs VIEW-AS ALERT-BOX ERROR BUTTONS OK. 
   END.

   /* If the user has tried to connect to more than one database 
      (via -db parms) one may succeed while another failed.  The only way 
      we can tell what's really happened is to check NUM-DBS again.
   */
   if  NUM-DBS > num then
   do:
      /* The database whose name was entered in the name fill-in, may in
            fact not be one of the ones that connected successfully.
            To be sure we get this right, get the info from Progress for
            the num+1 connected database - it should be the first of the ones
            that were just connected.
      */
      assign
            p_LName = LDBNAME(num + 1)
            p_PName = PDBNAME(num + 1)
            p_Type = DBTYPE(num + 1).
      return.
   end.
   else do:
      /* The connect failed on all counts  - we want to leave the box up, 
               so abort the OK button. */
      if qbf_p_name
       then apply "entry" to p_Pname in frame connect.
       else apply "entry" to p_Lname in frame connect.
      return NO-APPLY.
   end.
end.

/*----- WINDOW-CLOSE-----*/
on WINDOW-CLOSE of frame connect do:
   assign
     p_PName = ?
     p_LName = ?.
   apply "END-ERROR" to frame connect.
   end.

/*----- HIT of FILE BUTTONS -----*/
on choose of btn_Filen in frame connect
   run Get_File_Name (INPUT p_PName:HANDLE in frame connect,
                                   INPUT ".db",
                                   INPUT "Find Database File",
                                   INPUT TRUE).

on choose of btn_Filet in frame connect
   run Get_File_Name (INPUT p_Trig_Loc:HANDLE in frame connect,
                                   INPUT ".pl",
                                   INPUT "Find Procedure Library File",
                                   INPUT TRUE).

on choose of btn_Filep in frame connect
   run Get_File_Name (INPUT p_Parm_File:HANDLE in frame connect,
                                   INPUT ".pf",
                                   INPUT "Find Parameter File",
                                   INPUT TRUE).



/*----- ON LEAVE of LOGICAL NAME ----- */
on leave of p_LName in frame connect
do:
   Define var name as char NO-UNDO.

   name = input frame connect p_LName.
   if LOOKUP(name, "DICTDB,DICTDB2,DICTDBG,AS4DICT") <> 0 then
   do:         
      message "You cannot connect to a database" SKIP
                    "with a logical name of " name "."
                     view-as ALERT-BOX ERROR buttons OK.

      return NO-APPLY.  /* prevent user from leaving the field. */
   end.
   IF NUM-ENTRIES(name, " ") <> 1 AND LENGTH(name) > 1 THEN DO:
     message "You cannot have spaces in the logical name"
        VIEW-AS ALERT-BOX ERROR BUTTONS OK.
     RETURN NO-APPLY.
   END.     

end.


/*----- ON LEAVE of TRIGGER LOCATION ----- */
on leave of p_Trig_loc in frame connect
do:
   Define var name as char NO-UNDO.

   name = input frame connect p_Trig_loc.
   if    length(name,"character") > 2
     and substring(name,length(name,"character") - 2,-1,"character") = ".pl"
     and SEARCH(name)    = ? 
     then do:         
     message "This library-file does not exist"
             view-as ALERT-BOX ERROR buttons OK.

     return NO-APPLY.  /* prevent user from leaving the field. */
     end.
end.


/*-----HIT of Cancel BUTTON or ENDKEY, END-ERROR -----*/
on choose of btn_Cancel in frame connect 
  OR ENDKEY             of frame connect
  OR END-ERROR          of frame connect
  assign
    p_PName = ?
    p_LName = ?.


/*----- HELP -----*/
on HELP of frame connect OR
   choose of btn_Help in frame connect
   RUN "adecomm/_adehelp.p" (INPUT "comm", INPUT "CONTEXT", 
                                               INPUT {&Connect_Database},
                                               INPUT ?).


/*============================Mainline code==================================*/

/* Unfortunately, even if pname or lname are given, we can't figure out
   the type since the thing isn't connected!  So always default to
   PROGRESS.
*/

if p_Type = ? then
   p_Type = "PROGRESS".

if p_type <> "PROGRESS"
 then do: /* some DataServers do not need a physical db-name */
  { prodict/dictgate.i
      &action = "query"
      &output = "capab"
      &dbrec  = "?"
      &dbtype = "p_type"
      }
  ASSIGN
    qbf_p_name = INDEX(ENTRY(5,capab),"p") > 0  /* p-name needed */.
  end.
 else assign
  qbf_p_name = TRUE.
  
/* Multi_User defaults no if not decided */
if p_Multi_User = ? 
   then p_Multi_User = no.

/* Run time layout for button area.  This defines eff_frame_width */
{adecomm/okrun.i  
   &FRAME  = "frame connect" 
   &BOX    = "rect_Btns"
   &OK     = "btn_OK"
   &CANCEL = "btn_Cancel"
   &HELP   = "btn_Help"
}

/* So Return doesn't hit default button in editor widget */
Other:return-inserted = yes.

&IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN
   /* runtime adjustment of "Optional" title band to the width of the frame */
   txt_optional:width-chars = eff_frame_width - ({&HFM_WID} * 2).
&ENDIF

assign ext_Type = {adecomm/ds_type.i
                    &direction = "itoe"
                    &from-type = "p_Type"
                    }
       Other = (IF p_Unix_Parms <> "" AND p_Unix_Parms <> ? THEN
                   p_Unix_Parms + " " ELSE "") + 
               (IF p_Network <> "" AND p_Network <> ? THEN
	           " -N " + p_Network ELSE "") +
               (IF p_Host_Name <> "" AND p_Host_Name <> ? THEN
	           " -H " + p_Host_Name ELSE "") +
	       (IF p_Service_Name <> "" AND p_Service_Name <> ? THEN
	           " -S " + p_Service_Name ELSE "").
display 
   &IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN
      txt_optional
   &ENDIF
   p_PName  when p_PName <> ?
   p_LName  when p_LName <> ?
   ext_Type             
   p_Multi_User
   Pass_Phrase
   p_UserId
   p_Password    
   p_Trig_Loc
   p_Parm_File
   Other
   with frame connect.              

do ON ERROR UNDO,LEAVE  ON ENDKEY UNDO,LEAVE:
   enable p_PName   when qbf_p_name
          btn_Filen when qbf_p_name
          p_LName   /* when qbf_l_name */
          p_Multi_User
          Pass_Phrase
          p_UserId
          p_Password
          p_Trig_Loc
          btn_Filet
          p_Parm_File
          btn_Filep
          Other
          btn_OK
          btn_Cancel
          btn_Help {&WHEN_HELP}
      with frame connect.
   wait-for choose of btn_OK in frame connect OR
                                   GO of frame connect
                                   focus p_PName.
end.

hide frame connect.
return.





&ANALYZE-SUSPEND _VERSION-NUMBER UIB_v8r12 GUI
/* Procedure Description
"Basic Dialog-Box Template

Use this template to create a new dialog-box. Alter this default template or create new ones to accomodate your needs for different default sizes and/or attributes."
*/
&ANALYZE-RESUME
&Scoped-define WINDOW-NAME CURRENT-WINDOW
&Scoped-define FRAME-NAME Connect
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _DEFINITIONS Connect 
/*********************************************************************
* Copyright (C) 2000,2009 by Progress Software Corporation. All rights*
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/
/*----------------------------------------------------------------------------

File: _dbconng.w  

Description:
   Display and handle the connect dialog box, doing the connection
   if the user presses OK. GUI only. adecomm/_dbconnc.p is called for
   character mode.
 
Input Parameters:
   p_Connect - whether the CONNECT should be executed
   
Input/Output Parameters:

   On input:  A value is supplied if known, otherwise, the value is ?
   On output: If connect succeeded, all values are set.  If more than one
              database is connected (via -db parms), the information is
              set for the first one that was connected successfully.
              If connect failed or if the user cancelled, PName and LName 
              are set to ?.
   
   p_PName        - the physical name of the database
   p_LName        - the logical name of the database
   p_Type         - the database type (e.g., PROGRESS, ORACLE) (internal name)
   p_Multi_User   - connect in single user (no) or multi-user (yes) mode
   p_Network      - network type - initial selection only.
   p_Host_Name    - host name
   p_Service_Name - service name
   p_UserId       - user id
   p_Password     - password
   p_Unix_Parms   - any other parms 

Output Parameters:
   p_args   - this is the argument string built for the connect
 
Author:  John Palazzo
Created: 04/14/95
         From older GUI and the current character version _dbconnx.p
         by Laura Stern.

Modified:
    fernando  05/06/09  support for manual start encryption
    mcmann    02/19/03  Removed AS400SNA
    jep       02/05/02  Issue 3656 : Not enough space for frames in XP
    mcmann    12/17/98  Removed other obsolete networks protocols
    mcmann    07/16/98  Removed AS400LFP from supported networks
    mcmann    05/04/98  Added check for length and spaces to logical name
                        98-04-02-053
    hutegger    97/03   put on stop phrase around connect
    jep         95/08   Enabled Host Name and Service Name fields even when
                        Network field is "(None)".
    hutegger    95/08   add -ld, -H, -S, -dt params only if logical
                        and/or physical dbname available
                        (sometimes people just enter pf-file. In this
                        case we need to ignore the other parameters)
    rkamboj   08/08/11  fixed issue of login when special chracter in password 
                        at the time of db connect. Applied set-db-client method.

----------------------------------------------------------------------------*/
/*          This .W file was created with the Progress UIB.             */
/*----------------------------------------------------------------------*/

/* ***************************  Definitions  ************************** */
{adecomm/commeng.i}  /* Help contexts */
{adecomm/adestds.i}
IF NOT initialized_adestds THEN
    RUN adecomm/_adeload.p.

/* Parameters Definitions ---                                           */

&IF DEFINED(UIB_is_Running) = 0 &THEN
Define INPUT        parameter p_Connect      as logical   NO-UNDO.
Define INPUT-OUTPUT parameter p_PName        as char      NO-UNDO.
Define INPUT-OUTPUT parameter p_LName        as char      NO-UNDO.
Define INPUT-OUTPUT parameter p_Type         as char      NO-UNDO.
Define INPUT-OUTPUT parameter p_Multi_User   as logical   NO-UNDO.
Define INPUT-OUTPUT parameter p_Network      as char      NO-UNDO.
Define INPUT-OUTPUT parameter p_Host_Name    as char      NO-UNDO.
Define INPUT-OUTPUT parameter p_Service_Name as char      NO-UNDO.
Define INPUT-OUTPUT parameter p_UserId       as char      NO-UNDO.
Define INPUT-OUTPUT parameter p_Password     as char      NO-UNDO.
Define INPUT-OUTPUT parameter p_Trig_Loc     as char      NO-UNDO.
Define INPUT-OUTPUT parameter p_Parm_File    as char      NO-UNDO.
Define INPUT-OUTPUT parameter p_Unix_Parms   as char      NO-UNDO.
Define OUTPUT       parameter p_args         as char      NO-UNDO.
&ELSE
Define var p_Connect      as logical   NO-UNDO INITIAL YES.
Define var p_PName        as char      NO-UNDO.
Define var p_LName        as char      NO-UNDO.
Define var p_Type         as char      NO-UNDO INITIAL ?.
Define var p_Multi_User   as logical   NO-UNDO.
Define var p_Network      as char      NO-UNDO /*INIT "FAKE-NET"*/.
Define var p_Host_Name    as char      NO-UNDO.
Define var p_Service_Name as char      NO-UNDO.
Define var p_UserId       as char      NO-UNDO.
Define var p_Password     as char      NO-UNDO.
Define var p_Trig_Loc     as char      NO-UNDO.
Define var p_Parm_File    as char      NO-UNDO.
Define var p_Unix_Parms   as char      NO-UNDO.
Define var p_args         as char      NO-UNDO.
&ENDIF

/* Local Variable Definitions ---                                       */

Define variable  capab          as char      NO-UNDO. /* DataServ Cabap's */
Define variable  ext_Type       as char      NO-UNDO.
/*
Define variable  qbf_l_name     as logical   NO-UNDO. /* l-name NOT needed */
*/
Define variable  qbf_p_name     as logical   NO-UNDO. /* p-name NOT needed */
Define variable  enable_host    as logical   NO-UNDO.
Define variable  enable_service as logical   NO-UNDO.
Define variable  None           as char    initial "(None)":U NO-UNDO.
Define variable  Opts_Displayed as logical   NO-UNDO.
Define variable  Dlg_FullH      as integer   NO-UNDO. /* Full Height of Dialog */
Define variable  Dlg_ShortH     as integer   NO-UNDO. /* Short Height of Dialog */
Define variable  Full_First_Time as logical  NO-UNDO initial TRUE.
Define variable  h_parent_win   as handle    NO-UNDO.
DEFINE VARIABLE hCP             AS HANDLE  NO-UNDO.
DEFINE VARIABLE setdbclnt       AS LOGICAL NO-UNDO.
DEFINE VARIABLE currentdb       AS CHAR VIEW-AS TEXT FORMAT "x(32)" NO-UNDO.
/* Miscellaneous */
Define variable  stat           as logical NO-UNDO.
Define variable  ix             as integer NO-UNDO.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME


&ANALYZE-SUSPEND _UIB-PREPROCESSOR-BLOCK 

/* ********************  Preprocessor Definitions  ******************** */

&Scoped-define PROCEDURE-TYPE DIALOG-BOX
&Scoped-define DB-AWARE no

/* Name of designated FRAME-NAME and/or first browse and/or first query */
&Scoped-define FRAME-NAME Connect

/* Standard List Definitions                                            */
&Scoped-Define ENABLED-OBJECTS PName btn_filen btn_OK Btn_Cancel LName ~
btn_Options Btn_Help 
&Scoped-Define DISPLAYED-OBJECTS PName LName DB_Type 

/* Custom List Definitions                                              */
/* OPTIONAL-FIELDS,ENABLE-OPTIONAL,List-3,List-4,List-5,List-6          */
&Scoped-define OPTIONAL-FIELDS Network Multi_User Pass_Phrase Host_Name ~
Service_Name User_Id Pass_word Trig_Loc btn_filep Parm_File btn_filet ~
Unix_Parms Unix_Label 
&Scoped-define ENABLE-OPTIONAL Network Multi_User Pass_Phrase Host_Name ~
Service_Name User_Id Pass_word Trig_Loc btn_filep Parm_File btn_filet ~
Unix_Parms Unix_Label 

/* _UIB-PREPROCESSOR-BLOCK-END */
&ANALYZE-RESUME



/* ***********************  Control Definitions  ********************** */

/* Define a dialog box                                                  */

/* Definitions of the field level widgets                               */
DEFINE BUTTON Btn_Cancel AUTO-END-KEY 
     LABEL "Cancel" 
     SIZE 15 BY 1.14
     BGCOLOR 8 .

DEFINE BUTTON btn_filen 
     LABEL "&Browse..." 
     SIZE 15 BY 1.14.

DEFINE BUTTON btn_filep 
     LABEL "Browse..." 
     SIZE 15 BY 1.14.

DEFINE BUTTON btn_filet 
     LABEL "Browse..." 
     SIZE 15 BY 1.14.

DEFINE BUTTON Btn_Help 
     LABEL "&Help" 
     SIZE 15 BY 1.14
     BGCOLOR 8 .

DEFINE BUTTON btn_OK AUTO-GO 
     LABEL "OK" 
     SIZE 15 BY 1.14
     BGCOLOR 8 .

DEFINE BUTTON btn_Options 
     LABEL "&Options >>" 
     SIZE 15 BY 1.14.

DEFINE VARIABLE Network AS CHARACTER FORMAT "X(256)":U 
     LABEL "Net&work" 
     VIEW-AS COMBO-BOX SORT 
     LIST-ITEMS "(None)","TCP" 
     DROP-DOWN-LIST
     SIZE 22 BY 1 NO-UNDO.

DEFINE VARIABLE Unix_Parms AS CHARACTER 
     VIEW-AS EDITOR SCROLLBAR-VERTICAL
     SIZE 82 BY 3 NO-UNDO.

DEFINE VARIABLE DB_Type AS CHARACTER FORMAT "X(256)":U 
     LABEL "Database Type" 
     VIEW-AS FILL-IN 
     SIZE 22 BY 1 NO-UNDO.

DEFINE VARIABLE Host_Name AS CHARACTER FORMAT "X(256)":U 
     LABEL "Hos&t Name" 
     VIEW-AS FILL-IN 
     SIZE 22 BY 1 NO-UNDO.

DEFINE VARIABLE LName AS CHARACTER FORMAT "X(256)":U 
     LABEL "&Logical Name" 
     VIEW-AS FILL-IN 
     SIZE 50 BY 1 NO-UNDO.

DEFINE VARIABLE Parm_File AS CHARACTER FORMAT "X(256)":U 
     LABEL "P&arameter File" 
     VIEW-AS FILL-IN 
     SIZE 50 BY 1 NO-UNDO.

DEFINE VARIABLE Pass_word AS CHARACTER FORMAT "X(256)":U 
     LABEL "&Password" 
     VIEW-AS FILL-IN 
     SIZE 66 BY 1 NO-UNDO.

DEFINE VARIABLE PName AS CHARACTER FORMAT "X(256)":U 
     LABEL "Physical &Name" 
     VIEW-AS FILL-IN 
     SIZE 34 BY 1 NO-UNDO.

DEFINE VARIABLE Service_Name AS CHARACTER FORMAT "X(256)":U 
     LABEL "&Service Name" 
     VIEW-AS FILL-IN 
     SIZE 22 BY 1 NO-UNDO.

DEFINE VARIABLE Trig_Loc AS CHARACTER FORMAT "X(256)":U 
     LABEL "T&rigger Location" 
     VIEW-AS FILL-IN 
     SIZE 50 BY 1 NO-UNDO.

DEFINE VARIABLE Unix_Label AS CHARACTER FORMAT "X(256)":U 
     LABEL "Oth&er CONNECT Statement Parameters" 
      VIEW-AS TEXT 
     SIZE 9.8 BY .62 NO-UNDO.

DEFINE VARIABLE User_Id AS CHARACTER FORMAT "X(256)":U 
     LABEL "&User ID" 
     VIEW-AS FILL-IN 
     SIZE 66 BY 1 NO-UNDO.

DEFINE VARIABLE Multi_User AS LOGICAL INITIAL no 
     LABEL "&Multiple Users" 
     VIEW-AS TOGGLE-BOX
     SIZE 22 BY .76 NO-UNDO.

DEFINE VARIABLE Pass_Phrase AS LOGICAL INITIAL no 
     LABEL "Passphrase" 
     VIEW-AS TOGGLE-BOX
     SIZE 17 BY .76 NO-UNDO.


/* ************************  Frame Definitions  *********************** */

DEFINE FRAME Connect
     PName AT ROW 1.29 COL 18 COLON-ALIGNED
     btn_filen AT ROW 1.29 COL 55
     btn_OK AT ROW 1.29 COL 71
     Btn_Cancel AT ROW 2.57 COL 71
     LName AT ROW 2.62 COL 18 COLON-ALIGNED
     btn_Options AT ROW 4.29 COL 55
     Btn_Help AT ROW 4.29 COL 71
     DB_Type AT ROW 4.33 COL 18 COLON-ALIGNED
     Network AT ROW 5.86 COL 18.2 COLON-ALIGNED
     Multi_User AT ROW 5.86 COL 44
     Pass_Phrase AT ROW 5.86 COL 64
     Host_Name AT ROW 7.19 COL 18 COLON-ALIGNED
     Service_Name AT ROW 7.19 COL 62 COLON-ALIGNED
     User_Id AT ROW 8.52 COL 18 COLON-ALIGNED
     Pass_word AT ROW 9.86 COL 18 COLON-ALIGNED PASSWORD-FIELD 
     Trig_Loc AT ROW 11.24 COL 18 COLON-ALIGNED
     btn_filep AT ROW 11.24 COL 71
     Parm_File AT ROW 12.67 COL 18 COLON-ALIGNED
     btn_filet AT ROW 12.67 COL 71
     Unix_Parms AT ROW 14.81 COL 4 NO-LABEL
     Unix_Label AT ROW 14 COL 1
     SPACE(35.99) SKIP(3.23)
    WITH VIEW-AS DIALOG-BOX KEEP-TAB-ORDER 
         SIDE-LABELS NO-UNDERLINE THREE-D  SCROLLABLE 
         TITLE "Connect Database"
         DEFAULT-BUTTON btn_OK CANCEL-BUTTON Btn_Cancel.


/* *********************** Procedure Settings ************************ */

&ANALYZE-SUSPEND _PROCEDURE-SETTINGS
/* Settings for THIS-PROCEDURE
   Type: DIALOG-BOX
   Other Settings: COMPILE
 */
&ANALYZE-RESUME _END-PROCEDURE-SETTINGS



/* ***********  Runtime Attributes and AppBuilder Settings  *********** */

&ANALYZE-SUSPEND _RUN-TIME-ATTRIBUTES
/* SETTINGS FOR DIALOG-BOX Connect
   FRAME-NAME L-To-R                                                    */
ASSIGN 
       FRAME Connect:SCROLLABLE       = FALSE.

/* SETTINGS FOR BUTTON btn_filep IN FRAME Connect
   NO-DISPLAY NO-ENABLE 1 2                                             */
ASSIGN 
       btn_filep:HIDDEN IN FRAME Connect           = TRUE.

/* SETTINGS FOR BUTTON btn_filet IN FRAME Connect
   NO-DISPLAY NO-ENABLE 1 2                                             */
ASSIGN 
       btn_filet:HIDDEN IN FRAME Connect           = TRUE.

/* SETTINGS FOR FILL-IN DB_Type IN FRAME Connect
   NO-ENABLE                                                            */
/* SETTINGS FOR FILL-IN Host_Name IN FRAME Connect
   NO-DISPLAY NO-ENABLE 1 2                                             */
ASSIGN 
       Host_Name:HIDDEN IN FRAME Connect           = TRUE.

/* SETTINGS FOR TOGGLE-BOX Multi_User IN FRAME Connect
   NO-DISPLAY NO-ENABLE 1 2                                             */
ASSIGN 
       Multi_User:HIDDEN IN FRAME Connect           = TRUE.

/* SETTINGS FOR COMBO-BOX Network IN FRAME Connect
   NO-DISPLAY NO-ENABLE 1 2                                             */
ASSIGN 
       Network:HIDDEN IN FRAME Connect           = TRUE.

/* SETTINGS FOR FILL-IN Parm_File IN FRAME Connect
   NO-DISPLAY NO-ENABLE 1 2                                             */
ASSIGN 
       Parm_File:HIDDEN IN FRAME Connect           = TRUE.

/* SETTINGS FOR TOGGLE-BOX Pass_Phrase IN FRAME Connect
   NO-DISPLAY NO-ENABLE 1 2                                             */
ASSIGN 
       Pass_Phrase:HIDDEN IN FRAME Connect           = TRUE.

/* SETTINGS FOR FILL-IN Pass_word IN FRAME Connect
   NO-DISPLAY NO-ENABLE 1 2                                             */
ASSIGN 
       Pass_word:HIDDEN IN FRAME Connect           = TRUE.

/* SETTINGS FOR FILL-IN Service_Name IN FRAME Connect
   NO-DISPLAY NO-ENABLE 1 2                                             */
ASSIGN 
       Service_Name:HIDDEN IN FRAME Connect           = TRUE.

/* SETTINGS FOR FILL-IN Trig_Loc IN FRAME Connect
   NO-DISPLAY NO-ENABLE 1 2                                             */
ASSIGN 
       Trig_Loc:HIDDEN IN FRAME Connect           = TRUE.

/* SETTINGS FOR FILL-IN Unix_Label IN FRAME Connect
   NO-DISPLAY NO-ENABLE ALIGN-L 1 2                                     */
ASSIGN 
       Unix_Label:HIDDEN IN FRAME Connect           = TRUE.

/* SETTINGS FOR EDITOR Unix_Parms IN FRAME Connect
   NO-DISPLAY NO-ENABLE 1 2                                             */
ASSIGN 
       Unix_Parms:HIDDEN IN FRAME Connect           = TRUE
       Unix_Parms:RETURN-INSERTED IN FRAME Connect  = TRUE.

/* SETTINGS FOR FILL-IN User_Id IN FRAME Connect
   NO-DISPLAY NO-ENABLE 1 2                                             */
ASSIGN 
       User_Id:HIDDEN IN FRAME Connect           = TRUE.

/* _RUN-TIME-ATTRIBUTES-END */
&ANALYZE-RESUME


/* Setting information for Queries and Browse Widgets fields            */

&ANALYZE-SUSPEND _QUERY-BLOCK DIALOG-BOX Connect
/* Query rebuild information for DIALOG-BOX Connect
     _Options          = "SHARE-LOCK"
     _Query            is NOT OPENED
*/  /* DIALOG-BOX Connect */
&ANALYZE-RESUME

 



/* ************************  Control Triggers  ************************ */

&Scoped-define SELF-NAME Connect
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL Connect Connect
ON ALT-E OF FRAME Connect /* Connect Database */
ANYWHERE
DO:
  APPLY "ENTRY" TO Unix_Parms IN FRAME {&FRAME-NAME}.
  RETURN NO-APPLY.
END.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME


&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL Connect Connect
ON GO OF FRAME Connect /* Connect Database */
DO:
  DO ON ERROR UNDO, RETRY :
    IF RETRY THEN
        RETURN NO-APPLY.
    ELSE
        RUN Pressed_OK.
  END.  
END.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME


&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL Connect Connect
ON WINDOW-CLOSE OF FRAME Connect /* Connect Database */
DO:
 APPLY "END-ERROR":U TO SELF.
END.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME


&Scoped-define SELF-NAME btn_filen
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL btn_filen Connect
ON CHOOSE OF btn_filen IN FRAME Connect /* Browse... */
DO:
   RUN Get_File_Name (INPUT PName:HANDLE in frame connect,
                      INPUT ".db",
                      INPUT "Find Database File",
                      INPUT TRUE).
END.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME


&Scoped-define SELF-NAME btn_filep
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL btn_filep Connect
ON CHOOSE OF btn_filep IN FRAME Connect /* Browse... */
DO:
   RUN Get_File_Name (INPUT Trig_Loc:HANDLE in frame connect,
                      INPUT ".pl",
                      INPUT "Find Procedure Library File",
                      INPUT TRUE).
END.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME


&Scoped-define SELF-NAME btn_filet
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL btn_filet Connect
ON CHOOSE OF btn_filet IN FRAME Connect /* Browse... */
DO:
   RUN Get_File_Name (INPUT Parm_File:HANDLE in frame connect,
                      INPUT ".pf",
                      INPUT "Find Parameter File",
                      INPUT TRUE).
END.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME


&Scoped-define SELF-NAME Btn_Help
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL Btn_Help Connect
ON CHOOSE OF Btn_Help IN FRAME Connect /* Help */
OR HELP OF FRAME {&FRAME-NAME}
DO:
   RUN adecomm/_adehelp.p (INPUT "comm", INPUT "CONTEXT", 
                           INPUT {&Connect_Database},
                           INPUT ?).
END.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME


&Scoped-define SELF-NAME btn_Options
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL btn_Options Connect
ON CHOOSE OF btn_Options IN FRAME Connect /* Options >> */
DO:
  DO WITH FRAME {&FRAME-NAME} :
  
    IF (FRAME {&FRAME-NAME}:HEIGHT-PIXELS <> Dlg_FullH) THEN
    DO:
      /* Display the full dialog. */
      ASSIGN btn_Options:LABEL = REPLACE(btn_Options:LABEL , ">>":U , "<<":U ).
      ASSIGN FRAME {&FRAME-NAME}:HEIGHT-PIXELS = Dlg_FullH NO-ERROR.
      
      IF Full_First_Time THEN
      DO:
        /* Only display optional fields the first time. This preserves the
           users typed values in subsequent full dialog displays.
        */
        DISPLAY {&OPTIONAL-FIELDS}.
        ASSIGN Full_First_Time = FALSE.
      END.
      ELSE
        VIEW {&OPTIONAL-FIELDS}.
        
      ENABLE {&ENABLE-OPTIONAL}.
      RUN enable_custom.
    END.
    ELSE
    DO:
      /* Display the shortened dialog. */
      ASSIGN btn_Options:LABEL = REPLACE(btn_Options:LABEL , "<<":U , ">>":U )
             . /* END ASSIGN */
      HIDE {&OPTIONAL-FIELDS}.
      DISABLE {&OPTIONAL-FIELDS}.
      ASSIGN FRAME {&FRAME-NAME}:HEIGHT-PIXELS = Dlg_ShortH NO-ERROR
             . /* END ASSIGN */
    END.
    
  END.
END.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME


&Scoped-define SELF-NAME LName
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL LName Connect
ON LEAVE OF LName IN FRAME Connect /* Logical Name */
DO:
   Define var name as char NO-UNDO.

   ASSIGN name = input frame connect LName.
   if LOOKUP(name, "DICTDB,DICTDB2,DICTDBG") <> 0 then
   do:   
      message "You cannot connect to a database" SKIP
              "with a logical name of " name "."
               view-as ALERT-BOX INFORMATION IN WINDOW ACTIVE-WINDOW.
      apply "ENTRY" to LName IN FRAME {&FRAME-NAME}.
      return NO-APPLY.  /* prevent user from leaving the field. */
   end.
   IF NUM-ENTRIES(name, " ") <> 1 AND LENGTH(name) > 1 THEN DO:
     message "You cannot have spaces in the logical name"
        VIEW-AS ALERT-BOX INFORMATION IN WINDOW ACTIVE-WINDOW.
     APPLY "ENTRY" TO LName IN FRAME {&FRAME-NAME}.
     RETURN NO-APPLY.
   END.     
END.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME


&Scoped-define SELF-NAME Trig_Loc
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL Trig_Loc Connect
ON LEAVE OF Trig_Loc IN FRAME Connect /* Trigger Location */
DO:
   Define var name as char NO-UNDO.

   assign name = input frame connect Trig_loc.
   if    length(name,"character") > 2
     and substring(name,length(name,"character") - 2,-1,"character") = ".pl"
     and SEARCH(name)    = ? 
   then
   do:   
     message "Cannot find Procedure Library file."
             view-as ALERT-BOX INFORMATION IN WINDOW ACTIVE-WINDOW.
     apply "ENTRY" to Trig_Loc IN FRAME {&FRAME-NAME}.
     return NO-APPLY.  /* prevent user from leaving the field. */
   end.
   
END.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME


&UNDEFINE SELF-NAME

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _MAIN-BLOCK Connect 


/* ***************************  Main Block  *************************** */

/* Parent the dialog-box to the ACTIVE-WINDOW, if there is no parent.   */
IF VALID-HANDLE(ACTIVE-WINDOW) AND FRAME {&FRAME-NAME}:PARENT eq ?
THEN FRAME {&FRAME-NAME}:PARENT = ACTIVE-WINDOW.

/* If the parent window is delayed-minimized, the db connect dialog won't 
   display in a manner the user can see it. This can occur with the ADE
   Desktop window for example. By assigning the parent's window-state to
   its own current state, we can clear that situation, because window-state
   will not be minimized yet. -jep */
ASSIGN h_parent_win = FRAME {&FRAME-NAME}:PARENT.
h_parent_win:WINDOW-STATE = h_parent_win:WINDOW-STATE NO-ERROR.

/* Now enable the interface and wait for the exit condition.            */
/* (NOTE: handle ERROR and END-KEY so cleanup code will always fire.    */
MAIN-BLOCK:
DO ON ERROR   UNDO MAIN-BLOCK, RETRY MAIN-BLOCK
   ON END-KEY UNDO MAIN-BLOCK, RETRY MAIN-BLOCK
   ON STOP    UNDO MAIN-BLOCK, RETRY MAIN-BLOCK:
  
  IF RETRY THEN
  DO:
    ASSIGN p_PName = ?
           p_LName = ?
           . /* END ASSIGN */
    LEAVE MAIN-BLOCK.
  END.
  
  RUN Set_Init_Values.
  RUN enable_UI.
  RUN enable_custom.
  WAIT-FOR GO OF FRAME {&FRAME-NAME}.
END.
RUN disable_UI.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME


/* **********************  Internal Procedures  *********************** */

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE disable_UI Connect  _DEFAULT-DISABLE
PROCEDURE disable_UI :
/*------------------------------------------------------------------------------
  Purpose:     DISABLE the User Interface
  Parameters:  <none>
  Notes:       Here we clean-up the user-interface by deleting
               dynamic widgets we have created and/or hide 
               frames.  This procedure is usually called when
               we are ready to "clean-up" after running.
------------------------------------------------------------------------------*/
  /* Hide all frames. */
  HIDE FRAME Connect.
END PROCEDURE.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE enable_custom Connect 
PROCEDURE enable_custom :
/*------------------------------------------------------------------------------
  Purpose:     
  Parameters:  <none>
  Notes:       
------------------------------------------------------------------------------*/
  DO WITH FRAME {&FRAME-NAME} :
    
    ASSIGN PName:SENSITIVE        = qbf_p_name
           btn_Filen:SENSITIVE    = qbf_p_name
           . /* END ASSIGN */ 

  END.

END PROCEDURE.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE enable_UI Connect  _DEFAULT-ENABLE
PROCEDURE enable_UI :
/*------------------------------------------------------------------------------
  Purpose:     ENABLE the User Interface
  Parameters:  <none>
  Notes:       Here we display/view/enable the widgets in the
               user-interface.  In addition, OPEN all queries
               associated with each FRAME and BROWSE.
               These statements here are based on the "Other 
               Settings" section of the widget Property Sheets.
------------------------------------------------------------------------------*/
  DISPLAY PName LName DB_Type 
      WITH FRAME Connect.
  ENABLE PName btn_filen btn_OK Btn_Cancel LName btn_Options Btn_Help 
      WITH FRAME Connect.
  {&OPEN-BROWSERS-IN-QUERY-Connect}
END PROCEDURE.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE Get_File_Name Connect 
PROCEDURE Get_File_Name :
/*------------------------------------------------------------------------------
  Purpose:     
  Parameters:  <none>
  Notes:       
------------------------------------------------------------------------------*/

   Define INPUT PARAMETER h_name  as widget-handle NO-UNDO.
   Define INPUT PARAMETER p_ext   as char          NO-UNDO. /* contains "." */
   Define INPUT PARAMETER p_title as char          NO-UNDO.
   Define INPUT PARAMETER p_exist as logical       NO-UNDO.

   Define var name       as char    NO-UNDO.
   Define var picked_one as logical NO-UNDO.
   Define var filter     as char    NO-UNDO.
   Define var must_exist as char    NO-UNDO.

   filter = "*" + p_ext.
   name = TRIM(h_name:screen-value).

   &IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN
      if p_exist then
         system-dialog GET-FILE 
            name 
            filters            filter filter
            default-extension  p_ext
            title              p_title 
            must-exist
            update             picked_one.
      else
         system-dialog GET-FILE 
            name 
            filters            filter filter
            default-extension  p_ext
            title              p_title 
            update             picked_one.
   &ELSE
      ASSIGN must_exist = IF p_exist THEN "MUST-EXIST"
                                     ELSE "".
      RUN adecomm/_filecom.p
          ( INPUT filter /* p_Filter */, 
            INPUT ""     /* p_Dir */ , 
            INPUT ""     /* p_Drive */ ,
            INPUT NO ,   /* p_Save_As */
            INPUT p_Title ,
            INPUT must_exist ,
            INPUT-OUTPUT name,
            OUTPUT picked_one). 
   &ENDIF

   if picked_one then
      h_name:screen-value = name.

END PROCEDURE.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE Pressed_OK Connect 
PROCEDURE Pressed_OK :
/*------------------------------------------------------------------------------
  Purpose:     
  Parameters:  <none>
  Notes:       
------------------------------------------------------------------------------*/

   Define var args as char    NO-UNDO.
   Define var num  as integer NO-UNDO.
   Define var ix   as integer NO-UNDO.
   
   Define var cMsgs as char   NO-UNDO.

   assign 
      p_PName     = input frame connect PName
      p_Parm_File = input frame connect Parm_File.

   /* Check for required input. */
   IF (p_PName     = ""   OR p_PName     = ?) AND
      (p_Parm_File = ""   OR p_Parm_File = ?) AND
      qbf_p_name   = TRUE then
   do:
      message "You must supply a physical name or a parameter file."
               view-as ALERT-BOX INFORMATION IN WINDOW ACTIVE-WINDOW.
      return error.
   end.

   assign 
      input frame connect LName
      input frame connect DB_Type
      input frame connect Multi_User
      input frame connect Pass_Phrase
      input frame connect Network
      input frame connect Host_Name
      input frame connect Service_Name
      input frame connect User_Id
      input frame connect Pass_word
      input frame connect Trig_Loc
      input frame connect Unix_Parms.
      . /* end assign */

   if Unix_Parms = ? then assign Unix_Parms = "".
      
   assign
      p_LName       = LName
      p_Multi_User  = Multi_User
      p_Type        = DB_Type
      p_Network     = Network
      p_Host_Name   = Host_Name
      p_Service_Name = Service_Name
      p_Userid      = User_Id
      p_Password    = Pass_word
      p_Trig_Loc    = Trig_Loc
      p_Unix_Parms  = Unix_Parms
      . /* end assign */

   /* Set up parameters for CONNECT */
   /* WIN95-LFN : WIN95 Long Filename support requires physical and logical
      dbnames be quoted. - jep 12/14/95 */
   assign args = "'" + ( if qbf_p_name then p_Pname else p_LName ) + "'".
   if args = "''" or args = ? then args = "".
   
   if args <> "" then
   do:
     assign args = args + " -dt "   + p_Type.
     if p_LName        <> "" then assign args = args + " -ld " +
                                                "'" + p_LName + "'".
     if p_Network    <> None then assign args = args + " -N "  + p_Network.
     if p_Host_Name    <> "" then assign args = args + " -H "  + p_Host_Name.
     if p_Service_Name <> "" then assign args = args + " -S "  + p_Service_Name.
     if p_UserId       <> "" then assign args = args + " -U "  + p_UserId.
     IF p_Password <> "" then 
     DO:
         ASSIGN args = args + " -P ".
         IF INDEX(p_Password,'~"') > 0 THEN
              ASSIGN args = args + QUOTER(trim(p_Password),"'").
         ELSE 
            ASSIGN args = args + QUOTER(trim(p_Password)).
         
     END.

     if p_Multi_User    = no then assign args = args + ' -1 '.
   end.
   
   if p_Trig_Loc     <> "" then assign args = args + " -trig " + p_Trig_Loc.
   if p_Parm_File    <> "" then assign args = args + " -pf "   + p_Parm_File.
   
   assign p_args = args.
 
 
   /* If the caller did not want the database connected now, we're done */
   if (p_Connect = NO) then return.

   /* We need do ON ERROR because otherwise, if any connect fails, Progress
      will kick us out of the trigger.  Note that Progress will raise
      error on the first connect that fails and won't keep going to try
      to connect other ones.
   */
   assign num = NUM-DBS.
   /* num-dbs sometimes returns 1 instead of 0. If ldbname and pdbname 
    * are ? we reassign num to be 0 (hutegger 95/01)
    */
   if num        = 1 and
      ldbname(1) = ? and
      pdbname(1) = ? then assign num = 0.
   
   do on stop undo, retry:
     if retry
      then do:
       run adecomm/_setcurs.p ("").
       return error.
       end.
      else do:
       IF NOT Pass_Phrase THEN DO:
          run adecomm/_setcurs.p ("WAIT").
          connect VALUE(args) VALUE(p_Unix_Parms) NO-ERROR.
          run adecomm/_setcurs.p ("").
       END.

       IF Pass_Phrase OR 
          (ERROR-STATUS:ERROR AND ERROR-STATUS:GET-NUMBER(1) = 15271) THEN DO:
          /* if missing or incorrect passphrase for a database
             with encryption enabled and manual start, prompt
             for the passphrase now.
          */
          DEFINE VARIABLE cpassPhrase AS CHAR NO-UNDO.

          RUN _passphrase.p (OUTPUT cpassPhrase).

          /* if they don't specify a passphrase when asked to, we will
             just display the errors we got above.
          */
          IF cpassPhrase <> ? AND length(cpassPhrase) > 0 THEN DO:
              /* this will let them try once. If it fails, then they will
                 need to try to connect again.
              */
              connect VALUE(args) VALUE("-KeyStorePassPhrase " + QUOTER(cpassPhrase)) VALUE(p_Unix_Parms) NO-ERROR.
          END.
       END.
       if  NUM-DBS > num then ASSIGN currentdb = LDBNAME(num + 1).
       if p_UserId <> "" and connected(currentdb) and DB_Type = "PROGRESS"then
       do:
           create client-principal hCP. /* create a CLIENT-PRINCIPAL only once during login*/
           /* Use SET-DB-CLIENT instead of SETUSERID */ 
           hCP:initialize(p_UserId,?,?,p_Password) no-error.
           setdbclnt = set-db-client(hCP,currentdb) no-error.
             
           if NOT setdbclnt THEN 
           DO:
                MESSAGE "Userid/Password is incorrect."
                    VIEW-AS ALERT-BOX ERROR BUTTONS OK. 
                disconnect value(currentdb).
               
           end.
           delete object hCP.
           hcp = ?.
       end.
      end.
     end.
   
   /* This will be set from any errors or warnings. Merge all the warnings
      together and display them in one shot.  */
   IF error-status:NUM-MESSAGES > 0 THEN DO:
     if lookup(string(error-status:GET-NUMBER(1)),'15944,13691,12710',',') = 0 then  
     cMsgs = error-status:get-message(1).
     do ix = 2 to error-status:num-messages:
        if lookup(string(error-status:GET-NUMBER(ix)),'15944,13691,12710',',') = 0 then
        cMsgs = cMsgs + CHR(10) + error-status:get-message(ix).
     end.
     if trim(cMsgs) <> "" then
     MESSAGE cMsgs VIEW-AS ALERT-BOX ERROR IN WINDOW ACTIVE-WINDOW.
   END.

   /* If the user has tried to connect to more than one database 
      (via -db parms) one may succeed while another failed.  The only way 
      we can tell what's really happened is to check NUM-DBS again.
   */
   if  NUM-DBS > num then
   do:
      /* The database whose name was entered in the name fill-in, may in
         fact not be one of the ones that connected successfully.
         To be sure we get this right, get the info from Progress for
         the num+1 connected database - it should be the first of the ones
         that were just connected.
      */
      assign
         p_LName = LDBNAME(num + 1)
         p_PName = PDBNAME(num + 1)
         p_Type = DBTYPE(num + 1).
      return.
   end.
   else do:
      /* The connect failed on all counts  - we want to leave the box up, 
         so abort the OK button. */
      if qbf_p_name
       then apply "entry" to Pname in frame connect.
       else apply "entry" to Lname in frame connect.
      return error.
   end.


END PROCEDURE.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE Set_Init_Values Connect 
PROCEDURE Set_Init_Values :
/*------------------------------------------------------------------------------
  Purpose:     
  Parameters:  <none>
  Notes:       
------------------------------------------------------------------------------*/
   
  DO WITH FRAME {&FRAME-NAME}:
                        
    /* Set the dialog size values and shorten the dialog height. */
    /* IZ 3656 : Add a small margin {&VM_OKBOX} in pixels to short and full height to
       ensure dialog is large enough for the widgets, particularly on Windows XP. */
    assign Dlg_ShortH = FRAME {&FRAME-NAME}:HEIGHT-PIXELS -
                        (FRAME {&FRAME-NAME}:HEIGHT-PIXELS
                         - Host_Name:Y IN FRAME {&FRAME-NAME})
           Dlg_ShortH = Dlg_ShortH + {&VM_OKBOX}
           Dlg_FullH  = FRAME {&FRAME-NAME}:HEIGHT-PIXELS + {&VM_OKBOX}
           . /* END ASSIGN */
    assign FRAME {&FRAME-NAME}:HEIGHT-PIXELS = Dlg_ShortH NO-ERROR.
    
    /* Change Unknown to Null if PName and LName are passed in that way. */
    assign  p_PName = (IF p_PName = ? THEN "" ELSE p_PName)
            p_LName = (IF p_LName = ? THEN "" ELSE p_LName)
            . /* END ASSIGN */
            
    /* Unfortunately, even if pname or lname are given, we can't figure out
       the type since the thing isn't connected!  So always default to
       PROGRESS.
    */
    if p_Type = ? then p_Type = "PROGRESS".

    if p_type <> "PROGRESS"
    then do: /* some DataServers do not need a physical db-name */
        { prodict/dictgate.i
            &action = "query"
            &output = "capab"
            &dbrec  = "?"
            &dbtype = "p_type"
        }
        assign
            /*  qbf_l_name = INDEX(ENTRY(5,capab),"l") > 0 /* l-name needed */ */
            qbf_p_name = INDEX(ENTRY(5,capab),"p") > 0  /* p-name needed */.
    end.
    else
        assign qbf_p_name = TRUE.
  
    /* Multi_User defaults no if not decided */
    if p_Multi_User = ? then p_Multi_User = no.

    /* If Network type is not passed, initialize to (None). If it is passed,
       add it to the Network Type list if its not already there. */
    if (p_Network = "" or p_Network = ?) then
        assign p_Network = None.
    else if Network:LOOKUP(p_Network) IN FRAME {&FRAME-NAME} = 0 then
        assign stat = Network:ADD-FIRST(p_Network) IN FRAME {&FRAME-NAME}.
    assign Network:SCREEN-VALUE IN FRAME {&FRAME-NAME} = p_Network.
        
    assign ext_Type = {adecomm/ds_type.i
                        &direction = "itoe"
                        &from-type = "p_Type"
                      } .
                      
    if p_Unix_Parms = ? then assign p_Unix_Parms = "".

   /* Now initialize the screen objects program variables. */
   assign
      PName        = p_PName
      LName        = p_LName
      DB_Type      = p_Type
      Multi_User   = p_Multi_User
      Network      = p_Network  
      Host_Name    = p_Host_Name
      Service_Name = p_Service_Name
      User_Id      = p_UserId
      Pass_word    = p_Password
      Trig_Loc     = p_Trig_Loc
      Unix_Parms   = p_Unix_Parms
      . /* end assign */

  END.
END PROCEDURE.

PROCEDURE seruser:
    
END PROCEDURE.
/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME

/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/*----------------------------------------------------------------------------

File: _dbconnx.p

Description:
   Dispatch call for tty and gui version of Connect Database dialog box.
   See adecomm/_dbconnc.p and adecomm/_dbconng.w for details.
   
Input Parameters:
   p_Connect - whether the CONNECT should be executed
   
Input/Output Parameters:

   On input:  A value is supplied if known, otherwise, the value is ?
   On output: If connect succeeded, all values are set.  If more than one
              database is connected (via -db parms), the information is
              set for the first one that was connected successfully.
              If connect failed or if the user cancelled, PName and LName 
              are set to ?.
   
   p_PName        - the physical name of the database
   p_LName        - the logical name of the database
   p_Type         - the database type (e.g., PROGRESS, ORACLE) (internal name)
   p_Multi_User   - connect in single user (no) or multi-user (yes) mode
   p_Network      - network type - initial selection only.
   p_Host_Name    - host name
   p_Service_Name - service name
   p_UserId       - user id
   p_Password     - password
   p_Unix_Parms   - any other parms 

Output Parameters:
   p_args   - this is the argument string built for the connect
   
 
Author: Laura Stern and John Palazzo

Date Created: 03/24/92
Modified:
  98/07/16 Mario B. - Added -N -H -S parameters.  Bug# 98-04-19-027.
  
----------------------------------------------------------------------------*/


Define INPUT        parameter p_Connect      as logical   NO-UNDO.
Define INPUT-OUTPUT parameter p_PName        as char      NO-UNDO.
Define INPUT-OUTPUT parameter p_LName        as char      NO-UNDO.
Define INPUT-OUTPUT parameter p_Type         as char      NO-UNDO.
Define INPUT-OUTPUT parameter p_Multi_User   as logical   NO-UNDO.
Define INPUT-OUTPUT parameter p_Network      as char      NO-UNDO.
Define INPUT-OUTPUT parameter p_Host_Name    as char      NO-UNDO.
Define INPUT-OUTPUT parameter p_Service_Name as char      NO-UNDO.
Define INPUT-OUTPUT parameter p_UserId       as char      NO-UNDO.
Define INPUT-OUTPUT parameter p_Password     as char      NO-UNDO.
Define INPUT-OUTPUT parameter p_Trig_Loc     as char      NO-UNDO.
Define INPUT-OUTPUT parameter p_Parm_File    as char      NO-UNDO.
Define INPUT-OUTPUT parameter p_Unix_Parms   as char      NO-UNDO.
Define OUTPUT       parameter p_args         as char      NO-UNDO.


/*----------------------------Mainline code----------------------------------*/

&IF "{&WINDOW-SYSTEM}" = "TTY" &THEN
RUN adecomm/_dbconnc.p (INPUT p_Connect,   /* whether to connect the database spec'd */
                        INPUT-OUTPUT p_PName,
                        INPUT-OUTPUT p_LName,
                        INPUT-OUTPUT p_Type,
                        INPUT-OUTPUT p_Multi_User,
                        INPUT-OUTPUT p_Network,
                        INPUT-OUTPUT p_Host_Name,
                        INPUT-OUTPUT p_Service_Name,
                        INPUT-OUTPUT p_UserId,
                        INPUT-OUTPUT p_Password,
                        INPUT-OUTPUT p_Trig_Loc,
                        INPUT-OUTPUT p_Parm_File,
                        INPUT-OUTPUT p_Unix_Parms,
                        OUTPUT        p_args  ).
&ELSE
IF SESSION:V6DISPLAY THEN
  RUN adecomm/_dbconnc.p (INPUT p_Connect,   /* whether to connect the database spec'd */
                          INPUT-OUTPUT p_PName,
                          INPUT-OUTPUT p_LName,
                          INPUT-OUTPUT p_Type,
                          INPUT-OUTPUT p_Multi_User,
                          INPUT-OUTPUT p_Network,
                          INPUT-OUTPUT p_Host_Name,
                          INPUT-OUTPUT p_Service_Name,
                          INPUT-OUTPUT p_UserId,
                          INPUT-OUTPUT p_Password,
                          INPUT-OUTPUT p_Trig_Loc,
                          INPUT-OUTPUT p_Parm_File,
                          INPUT-OUTPUT p_Unix_Parms,
                          OUTPUT        p_args  ).
ELSE
  RUN adecomm/_dbconng.w (INPUT p_Connect,   /* whether to connect the database spec'd */
                          INPUT-OUTPUT p_PName,
                          INPUT-OUTPUT p_LName,
                          INPUT-OUTPUT p_Type,
                          INPUT-OUTPUT p_Multi_User,
                          INPUT-OUTPUT p_Network,
                          INPUT-OUTPUT p_Host_Name,
                          INPUT-OUTPUT p_Service_Name,
                          INPUT-OUTPUT p_UserId,
                          INPUT-OUTPUT p_Password,
                          INPUT-OUTPUT p_Trig_Loc,
                          INPUT-OUTPUT p_Parm_File,
                          INPUT-OUTPUT p_Unix_Parms,
                          OUTPUT        p_args  ).

&ENDIF

RETURN.



/*********************************************************************
* Copyright (C) 2005 by Progress Software Corporation. All rights    *
* reserved.  Prior versions of this work may contain portions        *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/*----------------------------------------------------------------------------

File: _dbcreat.p

Description:   
   Put up a dialog box to get parameters for creating a new database.
   Then create the database by calling prodb.  This routine will display
   any necessary error messages to the user.

Input Parameter:
   p_olddb   - Suggested name of database to copy from.  The user can 
               change this.  This should be either "Sports", "empty", or
               some other physical db name.  Or it can be the null string.
  
Input-Output Parameter:
   p_newdb   - On input, this can be the suggested name of the new database or
               it can be the null string.  On output, if a new database was
               created successfully, this is set to the name of the new 
               database.

               It is set to ? if an error occurred or if the user pressed
               Cancel.

Author: Laura Stern

Date Created: 01/27/92

Modified on 10/6/95 by gfs - Added initial value to radio-set.
            04/12/00 DLM   - Added longer db name support
            05/26/05 KSM   - Added support for NEW-INSTANCE option of the 
                             CREATE DATABASE statement
            10/18/05 KSM   - Fixed setting of lNewInstance 20050621-024
            10/21/05 KSM   - Removed usage of SEARCH function to check 
                             DLC NE ?.  Search only works for propath
                             20050621-023.
            10/27/05 KSM   - Added Sports2000 to list of databases to create
----------------------------------------------------------------------------*/
&GLOBAL-DEFINE WIN95-BTN YES
{adecomm/commeng.i}  /* Help contexts */
{adecomm/adestds.i}  /* standard form layout, color and font defines */

DEFINE STREAM dbStream.

Define INPUT               PARAMETER p_olddb as char.
Define INPUT-OUTPUT PARAMETER p_newdb as char NO-UNDO.

Define var sysdb as char NO-UNDO INITIAL "Empty"
   view-as radio-set
   radio-buttons "An &EMPTY Database",                 "Empty",
                 "A Copy of the &SPORTS Database",     "Sports",
                 "A Copy of the S&ports2000 Database", "sports2000",
                 "A Copy of Some &Other Database",     "Other".

Define var otherdb as char    NO-UNDO.
Define var lReplace as logical NO-UNDO INIT NO view-as TOGGLE-BOX.

DEFINE VARIABLE lNewInstance AS LOGICAL     NO-UNDO
                            INITIAL TRUE VIEW-AS TOGGLE-BOX.
DEFINE VARIABLE lChanging    AS LOGICAL     NO-UNDO.

DEFINE VARIABLE lDbInDlc     AS LOGICAL     NO-UNDO.

DEFINE VARIABLE cDlc         AS CHARACTER   NO-UNDO INITIAL ?.
DEFINE VARIABLE cDlcDbs      AS CHARACTER   NO-UNDO.
DEFINE VARIABLE cDb          AS CHARACTER   NO-UNDO.
DEFINE VARIABLE cSlash       AS CHARACTER   NO-UNDO.

/* Buttons */
Define button btn_Filen  label "&Files..." 
   &IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN SIZE 15 by 1.125 &ENDIF .
Define button btn_Fileo  label "Files..." 
   &IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN SIZE 15 by 1.125 &ENDIF .
Define button btn_Ok          label "OK"       {&STDPH_OKBTN}.
Define button btn_Cancel label "Cancel"   {&STDPH_OKBTN} AUTO-ENDKEY.

&IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN
   Define button    btn_Help  label "&Help" {&STDPH_OKBTN}.
   Define rectangle rect_Btns {&STDPH_OKBOX}. /* standard button rectangle */
   &global-define   HLP_BTN  &HELP = "btn_Help"
&ELSE
   &global-define   HLP_BTN  
&ENDIF

Define var stat        as logical NO-UNDO. 
Define var p_newdb_lbl as char format "x(35)" no-undo
  init "&New Physical Database Name:".

FORM 
   SKIP({&TFM_WID})  
   p_newdb_lbl  NO-LABEL VIEW-AS TEXT            AT 2  SKIP({&VM_WID})
   p_newdb      NO-LABEL                                at 4   
                      format "x({&PATH_WIDG})" {&STDPH_FILL}
                      view-as fill-in size 37 by 1            SPACE(.3)
   btn_Filen                                                                     SKIP({&VM_WID})
   "(.db extension can be omitted)":t34 
                      view-as TEXT                    at 4   SKIP({&VM_WIDG}) 

   "Start with:":t17 view-as TEXT                         at 2   SKIP({&VM_WID})
   sysdb               NO-LABEL                                  at 2   SKIP({&VM_WID})

   otherdb      NO-LABEL                                 at 4   
                      format "x({&PATH_WIDG})" {&STDPH_FILL}
                      view-as fill-in native size 37 by 1     SPACE(.3)
   btn_Fileo                                                                      SKIP({&VM_WIDG})  

   lReplace     LABEL "&Replace If Exists"       at 2
   lNewInstance LABEL "New &Instance"
   {adecomm/okform.i
      &BOX    = rect_btns
      {&HLP_BTN}
      &STATUS = no
      &OK     = btn_OK
      &CANCEL = btn_Cancel
   }

   with frame dbcreate 
   SIDE-LABELS CENTERED 
   DEFAULT-BUTTON btn_OK CANCEL-BUTTON btn_Cancel
   TITLE "Create Database" view-as DIALOG-BOX.

IF SESSION:DISPLAY-TYPE = "GUI" THEN DO:
  cSlash = "~\".
  GET-KEY-VALUE SECTION "Startup" KEY "DLC" VALUE cDlc.
  cDlc = RIGHT-TRIM(cDlc,cSlash).
END.
ELSE cSlash = "/".

IF cDlc EQ ? THEN
  ASSIGN cDlc = OS-GETENV("DLC")
         cDlc = RIGHT-TRIM(cDlc,cSlash).

IF cDlc NE ? THEN DO:
  INPUT STREAM dbStream FROM OS-DIR(cDlc) NO-ATTR-LIST.
  db-blk:
  REPEAT ON ERROR UNDO db-blk, LEAVE db-blk:
    IMPORT STREAM dbStream cDb.
    IF NUM-ENTRIES(cDb,".") > 1 AND
       ENTRY(NUM-ENTRIES(cDb,"."),cDb,".") = "db" THEN
      cDlcDbs = cDlcDbs + (IF cDlcDbs NE "" THEN "," ELSE "") +
                SUBSTRING(cDb,1,R-INDEX(cDb,".") - 1).
  END.
  INPUT STREAM dbStream CLOSE.
END. /* DLC Not ? */

/* Associate text widget with fill-in label to enable mnemonic (Nordhougen 07/26/95) */
ASSIGN
  p_newdb:SIDE-LABEL-HANDLE IN FRAME dbcreate = p_newdb_lbl:HANDLE
  p_newdb:LABEL IN FRAME dbcreate = p_newdb_lbl.

/*============================ Internal Procedures =================================*/

Procedure Get_Db_Name:
   Define INPUT PARAMETER h_name  as widget-handle NO-UNDO.
   Define INPUT PARAMETER p_exist as logical       NO-UNDO. /* must exist */

   Define var name       as char    NO-UNDO.
   Define var picked_one as logical NO-UNDO.
   Define var d_title    as char    NO-UNDO init "Find Database File".

   name = TRIM(h_name:screen-value).
   &IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN
      if p_exist then
               system-dialog GET-FILE 
            name 
            filters            "*.db" "*.db"
            default-extension  ".db"
            title                d_title 
            must-exist
            update             picked_one.
      else
               system-dialog GET-FILE 
            name 
            filters            "*.db" "*.db"
            default-extension  ".db"
            title                d_title 
            update             picked_one.
   &ELSE
      run adecomm/_filecom.p
          ( INPUT "*.db",  /* p_Filter */
            INPUT "",            /* p_Dir */
            INPUT "",            /* p_Drive */
            INPUT no,           /* File Open */
            INPUT d_title,
            INPUT (if p_exist then "MUST-EXIST" else ""), /* Dialog Options */
            INPUT-OUTPUT name,
               OUTPUT picked_one). 
   &ENDIF

   if picked_one then
      h_name:screen-value = name.
end.

FUNCTION dlcDb RETURNS LOGICAL
        ( INPUT pcDbName AS CHARACTER ):

  DEFINE VARIABLE cDb AS CHARACTER NO-UNDO.

  DEBUGGER:SET-BREAK().
  cDb = pcDbName.
  IF NUM-ENTRIES(cDb,".") > 1 THEN
    cDb = SUBSTRING(cDb,1,R-INDEX(cDb,".") - 1).

  RETURN (cDb BEGINS cDlc OR
          CAN-DO(cDlcDbs,cDb)).

END FUNCTION.

/*============================== Triggers ====================================*/

/*-----------HIT of OK BUTTON---------*/
on choose of btn_OK in frame dbcreate OR GO of frame dbcreate
do:
   Define var err as integer NO-UNDO.

   assign
     input frame dbcreate p_newdb
     input frame dbcreate sysdb
     input frame dbcreate lReplace.
   
   p_newdb = TRIM(p_newdb).
   p_newdb:screen-value in frame dbcreate = p_newdb.

   if sysdb = "Other" then
      assign p_olddb = TRIM(input frame dbcreate otherdb).
   else
      assign p_olddb = sysdb.

   if p_olddb = "" or p_newdb = "" then 
   do:
      message "You must specify a database name for both" SKIP
                     "the source and the destination databases."
               view-as ALERT-BOX ERROR buttons OK.
      apply "entry" to p_newdb in frame dbcreate.
      return NO-APPLY.
   end.

   run adecomm/_setcurs.p ("WAIT").
   IF lReplace THEN DO:
     IF lNewInstance THEN
       CREATE DATABASE p_newdb FROM p_olddb NEW-INSTANCE REPLACE NO-ERROR.
     ELSE CREATE DATABASE p_newdb FROM p_olddb REPLACE NO-ERROR.
   END.
   ELSE DO:
     IF lNewInstance THEN
       CREATE DATABASE p_newdb FROM p_olddb NEW-INSTANCE NO-ERROR.
     ELSE CREATE DATABASE p_newdb FROM p_olddb NO-ERROR.
   END.

   run adecomm/_setcurs.p ("").

   if error-status:get-message(1) = "" then
      return.

   message error-status:get-message(1) view-as alert-box error buttons ok.
   p_newdb = ?.  /* flag that error occured. */
   return NO-APPLY.  /* let user cancel out after seeing error */
end.


/*-----HIT of CANCEL, ENDKEY-----*/
on ENDKEY,END-ERROR of frame dbcreate  /* or cancel which is auto-endkey */
   p_newdb = ?.

/*----- WINDOW-CLOSE-----*/
on WINDOW-CLOSE of frame dbcreate
do:
   p_newdb = ?.
   apply "END-ERROR" to frame dbcreate.
end.

/*-----SELECTION of a sysdb RADIO-ITEM-----*/
on value-changed of sysdb in frame dbcreate
do:
/*    DEBUGGER:INITIATE().  */
/*    DEBUGGER:SET-BREAK(). */
   lDbInDlc = dlcDb(otherdb:SCREEN-VALUE IN FRAME dbcreate).

   /* Either hide or enable the "other" fill-in field based on the
      radio button selection. */
   if sysdb:screen-value in frame dbcreate = "Other" then
   do:
     ASSIGN &IF "{&WINDOW-SYSTEM}" = "TTY" &THEN 
              otherdb:VISIBLE IN FRAME dbcreate        = TRUE
              btn_Fileo:VISIBLE IN FRAME dbcreate      = TRUE
            &ELSE
              otherdb:SENSITIVE IN FRAME dbcreate      = TRUE
              btn_Fileo:SENSITIVE IN FRAME dbcreate    = TRUE
            &ENDIF
            lNewInstance:SENSITIVE IN FRAME dbcreate = (NOT lDbInDlc = TRUE)
            lNewInstance:CHECKED IN FRAME dbcreate   = (lDbInDlc = TRUE)
            lNewInstance                             = (lDbInDlc = TRUE).
      IF NOT (lChanging = TRUE) THEN 
       apply "entry" to otherdb in frame dbcreate. 
     lChanging = FALSE.
   end.
   else
     ASSIGN otherdb:screen-value in frame dbcreate = ""
            &IF "{&WINDOW-SYSTEM}" = "TTY" &THEN 
              otherdb:VISIBLE IN FRAME dbcreate        = FALSE
              btn_Fileo:VISIBLE IN FRAME dbcreate      = FALSE
            &ELSE
              otherdb:SENSITIVE IN FRAME dbcreate      = FALSE
              btn_Fileo:SENSITIVE IN FRAME dbcreate    = FALSE
            &ENDIF
            lNewInstance:SENSITIVE IN FRAME dbcreate = FALSE
            lNewInstance:CHECKED IN FRAME dbcreate   = TRUE
            lNewInstance                             = TRUE.
end.


/*----- HIT of New FILE BUTTON -----*/
on choose of btn_Filen in frame dbcreate
   run Get_Db_Name (INPUT p_newdb:HANDLE in frame dbcreate, INPUT no).
   

/*----- HIT of Other FILE BUTTON -----*/
ON CHOOSE OF btn_Fileo IN FRAME dbcreate DO:
  RUN Get_Db_Name 
        ( INPUT otherdb:HANDLE IN FRAME dbcreate, 
          INPUT TRUE ).
  APPLY "VALUE-CHANGED" TO sysdb IN FRAME dbcreate.
END.

ON LEAVE OF otherdb IN FRAME dbcreate DO:
  APPLY "VALUE-CHANGED" TO sysdb IN FRAME dbcreate.
  APPLY "ENTRY" TO Btn_Fileo IN FRAME dbcreate.
END.

ON VALUE-CHANGED OF otherdb IN FRAME dbcreate DO:
  lChanging = TRUE.

  APPLY "VALUE-CHANGED" TO sysdb IN FRAME dbcreate.
END.

/*----- HELP -----*/
on HELP of frame dbcreate
   &IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN
      OR choose of btn_Help in frame dbcreate
   &ENDIF
   RUN "adecomm/_adehelp.p" (INPUT "comm", INPUT "CONTEXT", 
                                               INPUT {&Create_Database},
                                               INPUT ?).


/*============================= Mainline code ==============================*/

/* "Other" database name fill-in starts insensitive by default */
assign
   &IF "{&WINDOW-SYSTEM}" = "TTY" &THEN
      otherdb:hidden in frame dbcreate = yes
      btn_Fileo:hidden in frame dbcreate = yes
      otherdb:sensitive in frame dbcreate = yes
      btn_Fileo:sensitive in frame dbcreate = yes.
   &ELSE
      otherdb:sensitive in frame dbcreate = no
      btn_Fileo:sensitive in frame dbcreate = no.
   &ENDIF

/* Set defaults based on input parms */
if p_olddb = "empty" or p_olddb = "" or p_olddb = ? then
   sysdb:screen-value in frame dbcreate = "empty".
else if p_olddb = "sports" then
   sysdb:screen-value in frame dbcreate = "sports".
else
do:
   assign
      otherdb:screen-value in frame dbcreate = p_olddb
      sysdb:screen-value in frame dbcreate = "other"
      &IF "{&WINDOW-SYSTEM}" = "TTY" &THEN 
               otherdb:hidden in frame dbcreate = no
               btn_Fileo:hidden in frame dbcreate = no.
      &ELSE
               otherdb:sensitive in frame dbcreate = yes
               btn_Fileo:sensitive in frame dbcreate = yes.
      &ENDIF
end.

assign
   p_newdb:screen-value in frame dbcreate = p_newdb
   lReplace:screen-value in frame dbcreate = "no".

/* Run time layout for button area. */
{adecomm/okrun.i  
   &FRAME  = "frame dbcreate" 
   &BOX    = "rect_Btns"
   &OK     = "btn_OK" 
   &CANCEL = "btn_Cancel"
   {&HLP_BTN}
}

/* Since the "otherdb" field isn't enabled to start, in order to get
   the tab order right, we can't use update.  Instead enable and reset
   tab position for "otherdb" and btn_Fileo.  Other widgets will be pushed
   down in the tab chain.
*/  

enable p_newdb 
       btn_Filen
       sysdb 
       lReplace
       lNewInstance
       btn_Ok
       btn_Cancel
       &IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN
                btn_Help
       &ENDIF
       with frame dbcreate.

APPLY "VALUE-CHANGED" TO sysdb IN FRAME dbcreate.
assign
   stat = otherdb:move-after-tab-item(sysdb:HANDLE) in frame dbcreate
   stat = btn_Fileo:move-after-tab-item(otherdb:HANDLE) in frame dbcreate.

do ON ERROR UNDO,LEAVE  ON ENDKEY UNDO,LEAVE:
   Wait-for choose of btn_OK in frame dbcreate OR
                  GO of frame dbcreate
                  FOCUS p_newdb.
end.

hide frame dbcreate.
return.

/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/*----------------------------------------------------------------------------

File: _dblist.p

Description:
   Fill a selection list with all the databases in a given Progress database.
   Yes, this will usually only put one database in the list -- the actual
   Progress database -- but it will handle the case where the progress database
   is a schema holder and will add all the gateway dbs as well.

   IMPORTANT:  If all you are interested in schema, which is the usual
   case for this type of tool, you should only call this for PROGRESS
   databases.  You will then see all of the Progress schemas as well as 
   any gateway schema, but you will not see an additional entry
   when the gateway database is connected.  The call syntax should look
   something like this:

     /* Fill up the database selection list */
     do t_int = 1 to num-dbs:
       IF DBTYPE(t_int) = "PROGRESS" THEN
       DO:
         create alias dictdb for database VALUE(ldbname(t_int)).
         RUN adecomm/_dblist.p 
           (INPUT HANDLE(v_PickDb in frame schemapk),
           OUTPUT v_access).
       END.
     end.

Input Parameters:
  p_List    - Handle of the selection list to fill up.

Output Parameters:
   p_Stat   - Set to true if list is retrieved.

Author: Warren Bare

Date Created: 08/03/92
    Modified: 07/10/98 D. McMann Added DBVERSION and _Owner check.

----------------------------------------------------------------------------*/


DEFINE INPUT  PARAMETER p_List   AS WIDGET   NO-UNDO.
DEFINE OUTPUT PARAMETER p_Stat 	 AS LOGICAL  NO-UNDO.

DEFINE VARIABLE show_it AS LOGICAL   NO-UNDO.
DEFINE VARIABLE err     AS LOGICAL   NO-UNDO.
DEFINE VARIABLE t_char  AS CHARACTER NO-UNDO.

/*****************  Inline code **************************/
IF INTEGER(DBVERSION("DICTDB")) > 8 THEN 
  FIND DICTDB._File WHERE DICTDB._File._File-name = "_DB"
                      AND (DICTDB._File._Owner = "PUB" OR DICTDB._File._Owner = "_FOREIGN")
                      NO-LOCK.
ELSE FIND DICTDB._File "_DB" NO-LOCK.

IF NOT CAN-DO(DICTDB._File._Can-read, USERID("DICTDB")) THEN DO:
  RUN adecomm/_s-alert.p (INPUT-OUTPUT err, "i", "ok",
    "You do not have permission to see any database information.").
  p_Stat = FALSE.
  RETURN.
END.

/* Add the actual progress database */
err = p_List:add-last(LDBNAME("DICTDB")).

/* Find each gateway schema in this database. */
FOR EACH DICTDB._DB WHERE _db-type NE "PROGRESS" NO-LOCK:
  err = p_List:ADD-LAST(DICTDB._DB._db-name).
END.

p_Stat = TRUE.
RETURN.

/* _dblist.p - end of file */

/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/*----------------------------------------------------------------------------

File: delitem.p

Description:
   Delete an item from a selection list and reset selection to the spot
   this item inhabited (or if it was at the bottom to the line above that).

Input Parameters:
   p_List - Widget handle of selection list to delete from.
   p_Val  - The value of the item to delete.

Output Parameters:
   p_Cnt  - The number of items left in the list after deletion. 

Author: Laura Stern

Date Created: 02/24/92 

----------------------------------------------------------------------------*/

Define INPUT  PARAMETER p_List as widget-handle NO-UNDO.
Define INPUT  PARAMETER p_Val  as char 	     	NO-UNDO.
Define OUTPUT PARAMETER p_Cnt  as integer    	NO-UNDO.

Define var err as logical NO-UNDO.
Define var num as integer NO-UNDO.
Define var val as char    NO-UNDO.


num = p_List:Lookup(p_Val).	 /* Get position of p_Val in the list */
err = p_List:Delete(p_Val).	 /* Delete the value */
p_Cnt = p_List:Num-Items.	 /* The total # of values after delete */

if p_Cnt > 0 then
do:
   /* adjust num if the deleted item was at the end of the list */
   if num > p_Cnt then	
      num = num - 1.
   val = p_List:Entry(num).   	 /* Get the value at deleted position */
   p_List:screen-value = val.	 /* Reset selection to the same position */
end.
/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/*-----------------------------------------------------------------------

File: adecomm/_dictdb.p

Description:   
   This procedure checks the setting of DICTDB. In case it's ? or pointing
   to a non-progress db it resets it to the first PROGRESS-db it finds

Shared Output:
   DICTDB       pointing at valid db

History:
    95/08     hutegger    creation
    09/16/02  D. McMann  Added check for DBVERSION of DICTDB 20020916-024

-----------------------------------------------------------------------*/

define variable l_dbnr          as integer.

/*-----------------------------  TRIGGERS  ----------------------------*/

/*--------------------------  INT.-PROCEDURES  ------------------------*/

/*--------------------------  INITIALIZATIONS  ------------------------*/

/*-----------------------------  MAIN-CODE  ---------------------------*/

if NUM-DBS > 0 AND LDBNAME("DICTDB") = ?
 OR  DBTYPE("DICTDB") <> "PROGRESS" then do:  /* change/set DICTDB alias */
  repeat while l_dbnr < NUM-DBS and DBTYPE(l_dbnr) <> "PROGRESS":
    assign l_dbnr = l_dbnr + 1.
  end.
  
  if l_dbnr <= NUM-DBS
   then create alias DICTDB for database value(LDBNAME(l_dbnr)).
   
end.     /* change/set DICTDB alias */
ELSE IF INTEGER(DBVERSION("DICTDB")) < 9 THEN DO:
  DO l_dbnr = 1 TO NUM-DBS:
    IF DBTYPE(l_dbnr) <> "PROGRESS" THEN NEXT.
    IF INTEGER(DBVERSION(l_dbnr)) < 9 THEN NEXT.
    ELSE LEAVE.
  END.
 
  IF l_dbnr <= NUM-DBS THEN
    CREATE ALIAS DICTDB FOR DATABASE VALUE(LDBNAME(l_dbnr)).
END.
/*---------------------------------------------------------------------*/
/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/
&GLOBAL-DEFINE WIN95-BTN YES
{adecomm/adestds.i}
{adecomm/commeng.i}  /* Help contexts */

DEFINE BUTTON bOK LABEL "OK" {&STDPH_OKBTN} AUTO-GO.
DEFINE BUTTON bCancel LABEL "Cancel" {&STDPH_OKBTN} AUTO-ENDKEY.
DEFINE BUTTON bHelp LABEL "Help" {&STDPH_OKBTN}.

/* standard button rectangle */
&IF {&OKBOX} &THEN
DEFINE RECTANGLE rHeavyRule {&STDPH_OKBOX}.
&ENDIF

DEFINE VARIABLE db-list AS CHARACTER INITIAL ""
     VIEW-AS SELECTION-LIST SINGLE SORT 
     SCROLLBAR-HORIZONTAL SCROLLBAR-VERTICAL 
     SIZE 70 BY 9 NO-UNDO.

DEFINE VARIABLE db_lname AS CHARACTER FORMAT "X(80)":U
     LABEL "Logical Name" 
     VIEW-AS FILL-IN 
     SIZE 50 BY 1 NO-UNDO.

DEFINE VARIABLE db_pname AS CHARACTER FORMAT "X(80)":U
     LABEL "Physical Name" 
     VIEW-AS FILL-IN 
     SIZE 50 BY 1 NO-UNDO.

DEFINE VARIABLE db_type AS CHARACTER FORMAT "X(80)":U
     LABEL "Database Type" 
     VIEW-AS FILL-IN 
     SIZE 50 BY 1 NO-UNDO.

/* ************************  Frame Definitions  *********************** */
DEFINE FRAME frDisconnect
   SKIP({&TFM_WID})
   db_lname AT 2 SKIP
   db_pname AT 2 SKIP
   db_type AT 2 SKIP
   db-list AT 2 NO-LABEL
   {adecomm/okform.i
      &BOX    = "rHeavyRule"
      &STATUS = "no"
      &OK     = "bOK"
      &CANCEL = "bCancel"
      &HELP   = "bHelp"}

    WITH VIEW-AS DIALOG-BOX SIDE-LABELS 
         TITLE "Disconnect..." DEFAULT-BUTTON bOK CANCEL-BUTTON bCancel.

/* Use ade standards dialog includes -- this also makes WINDOW-CLOSE act
   like END-ERROR. */
   
/* Define a SKIP for alert-boxes that only exists under Motif */
&Global-define SKP ""

PAUSE 0 BEFORE-HIDE.

/* WINDOW-CLOSE event will issue END-ERROR to the frame */
ON WINDOW-CLOSE OF FRAME frDisconnect APPLY "END-ERROR":U TO SELF.


 
/* ************************  Control Triggers  ************************ */
ON HELP OF FRAME frDisconnect OR CHOOSE OF bHelp IN FRAME frDisconnect
  RUN adecomm/_adehelp.p (INPUT "comm", INPUT "CONTEXT", 
                          INPUT ?, INPUT ?).

ON GO of frame frDisconnect
DO:
  ASSIGN db-list.
  IF db-list <> "" AND db-list <> ? THEN
    DISCONNECT VALUE(db-list) NO-ERROR.
END.

ON VALUE-CHANGED OF db-list IN FRAME frDisconnect RUN show-dbinfo.

/* **********************  Internal Procedures  *********************** */
PROCEDURE initialize-dblist.
  def var i as integer.
  DO WITH FRAME frDisconnect:
    ASSIGN db-list:SCREEN-VALUE = ""
           db-list:LIST-ITEMS   = "".
    DO i = 1 to NUM-DBS:
      IF db-list:ADD-LAST(LDBNAME(i)) THEN.
    END.
    IF NUM-DBS > 0 THEN db-list:SCREEN-VALUE = LDBNAME(1).
  END.
  RUN show-dbinfo.
END PROCEDURE.

PROCEDURE show-dbinfo.
  db_lname = db-list:SCREEN-VALUE IN FRAME frDisconnect.
  IF db_lname eq "" OR db_lname eq ? THEN DO:
    ASSIGN db_lname = "n/a"
           db_pname = "n/a"
           db_type  = "n/a".
&IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN
    bOK:SENSITIVE = FALSE.
&ENDIF
  END.
  ELSE DO:
    ASSIGN db_pname = PDBNAME(db_lname)
           db_type  = DBTYPE (db_lname).
&IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN
    bOK:SENSITIVE = TRUE.
&ENDIF
  END.
  DISPLAY db_lname db_pname db_type WITH FRAME frDisconnect.
END PROCEDURE.

/*********************************** Main ************************************/
/* Run time layout for button area. */
{adecomm/okrun.i  
    &FRAME = "FRAME frDisconnect" 
    &BOX   = "rHeavyRule"
    &OK    = "bOK" 
    &CANCEL= "bCancel"
    &HELP  = "bHelp"
}

RUN initialize-dblist.

/* Restore the current-window if it is an icon.                         */
/* Otherwise the dialog box will be hidden                              */
IF CURRENT-WINDOW:WINDOW-STATE = WINDOW-MINIMIZED 
THEN CURRENT-WINDOW:WINDOW-STATE = WINDOW-NORMAL.

DO ON ERROR UNDO,LEAVE  ON ENDKEY UNDO,LEAVE:
ENABLE db-list &if "{&WINDOW-SYSTEM}" = "TTY" &then bOK &endif bCancel
	bHelp {&WHEN_HELP} WITH FRAME frDisconnect.
VIEW FRAME frDisconnect.
WAIT-FOR CHOOSE of bOK in FRAME frDisconnect OR
	GO of frame frDisconnect OR WINDOW-CLOSE OF FRAME frDisconnect
	FOCUS bOK.
END.
HIDE FRAME frDisconnect.
/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/*******************************************************************************
    Procedure : _dlgmnua.p

    Syntax    : RUN adecomm/_dlgmnua.p ( INPUT p_MenuBar , INPUT p_Exclude ) .

    Purpose   : Dialog box to allow user to query and assign menu accelerator
		keys.

    Parameters: INPUT
        INPUT     p_MenuBar : Handle to menu/menubar to query/assign.
                
        INPUT     p_Exclude : Comma-delimited list of Menu Labels (of a 
                              menubar) to exclude from the Menu lists.  
                              Pass Null ("") or Unknown (?) to not exclude
                              any menus.  If the & is passed for each menu
                              name, this routine strips the &'s out for you.
                            
                              Example: "Tools,Options,Help"

        RETURN-VALUE        : "OK" when user presses OK. Not set otherwise.
        
    Date      : 12/92

    Author    : John Palazzo
*******************************************************************************/

DEFINE INPUT PARAMETER p_MenuBar AS WIDGET-HANDLE NO-UNDO .
DEFINE INPUT PARAMETER p_Exclude AS CHAR          NO-UNDO .

/* ADE Standards Include */
&GLOBAL-DEFINE WIN95-BTN YES
{ adecomm/adestds.i }
IF NOT initialized_adestds
THEN RUN adecomm/_adeload.p.

/* Help Context */
{ adecomm/commeng.i }

DEFINE WORK-TABLE w_MenuObject NO-UNDO
	FIELD hMenu AS WIDGET-HANDLE
	FIELD Menu_Label AS CHAR
	FIELD Menu_Item_Label AS CHAR
	FIELD Menu_Item_Key  AS CHAR 
	FIELD Menu_Accelerator AS CHAR
	.

DEFINE VARIABLE First_Menu_Label AS CHARACTER NO-UNDO.
DEFINE VARIABLE Temp_Logical     AS LOGICAL   NO-UNDO.
DEFINE VARIABLE OK_Pressed       AS LOGICAL   NO-UNDO.

/* Definitions of the field level widgets                               */
DEFINE VARIABLE Menus_List AS CHAR LABEL ""
    VIEW-AS COMBO-BOX INNER-LINES 7 SIZE 25 BY 1
            FONT ? NO-UNDO.

DEFINE VARIABLE MenuItems_List AS CHAR LABEL ""
    VIEW-AS SELECTION-LIST SINGLE SIZE 25 BY 6
            /* INNER-CHARS 15 INNER-LINES 9 */ 
            SCROLLBAR-V FONT ? NO-UNDO.

DEFINE VARIABLE Accelerators_List LIKE MenuItems_List LABEL "".

DEFINE BUTTON btn_OK LABEL "OK"
    {&STDPH_OKBTN} AUTO-GO.

DEFINE BUTTON btn_Cancel LABEL "Cancel"
    {&STDPH_OKBTN} AUTO-ENDKEY.

DEFINE BUTTON btn_Help LABEL "&Help"
    {&STDPH_OKBTN}.

DEFINE BUTTON btn_Record LABEL "&Record..."
    SIZE 15.00 BY {&H_OKBTN}.

DEFINE BUTTON btn_Clear LABEL "&Clear"
    SIZE 15.00 BY {&H_OKBTN}.

/* Dialog Button Box */
&IF {&OKBOX} &THEN
DEFINE RECTANGLE MA_Btn_Box    {&STDPH_OKBOX}.
&ENDIF
/* Dialog Box */    
FORM
    SKIP( {&TFM_WID} )
    " "   {&AT_OKBOX} VIEW-AS TEXT
    SKIP( {&VM_WID}  )
    Menus_List {&AT_OKBOX} 
    SKIP ( {&TFM_WID} )  
    " " {&AT_OKBOX} VIEW-AS TEXT 
    " " AT 28 VIEW-AS TEXT
    MenuItems_List {&AT_OKBOX} 
    Accelerators_List
    { adecomm/okform.i
        &BOX    ="MA_Btn_Box"
        &OK     ="btn_OK"
        &CANCEL ="btn_Cancel"
        &OTHER  =" "
        &HELP   ="btn_Help" 
    }
    btn_Record AT ROW-OF Accelerators_List COLUMN 58
    SKIP( {&VM_WID} )
    btn_Clear  AT 58
    WITH FRAME dlg_Menus TITLE  "Menu Accelerators"  SIDE-LABEL
         VIEW-AS DIALOG-BOX
         DEFAULT-BUTTON btn_OK 
         CANCEL-BUTTON btn_Cancel.

/* Explicitly position and display labels. */
RUN PutLabel ( INPUT Menus_list:HANDLE IN FRAME dlg_Menus ,
               INPUT "x" ). /* kludge: need to put out first time because of core change */               
RUN PutLabel ( INPUT Menus_list:HANDLE IN FRAME dlg_Menus ,
               INPUT "&Menu" ). 
RUN PutLabel ( INPUT MenuItems_list:HANDLE IN FRAME dlg_Menus ,
               INPUT "x" ). /* kludge: need to put out first time because of core change */               
RUN PutLabel ( INPUT MenuItems_list:HANDLE IN FRAME dlg_Menus ,
               INPUT "Menu &Items" ).
RUN PutLabel ( INPUT Accelerators_List:HANDLE IN FRAME dlg_Menus ,
               INPUT "&Accelerator Keys" ).  

{ adecomm/okrun.i
    &FRAME  = "FRAME dlg_Menus"
    &BOX    = "MA_Btn_Box"
    &OK     = "btn_OK"
    &HELP   = "btn_Help"
}

/*------------------- UI Triggers -------------------*/
ON HELP OF FRAME DLG_Menus ANYWHERE
  RUN adecomm/_adehelp.p
      ( INPUT "comm" , INPUT "CONTEXT" , INPUT {&Menu_Accelerators} , INPUT ? ).

ON CHOOSE OF btn_Help IN FRAME DLG_Menus
  RUN adecomm/_adehelp.p
      ( INPUT "comm" , INPUT "CONTEXT" , INPUT {&Menu_Accelerators} , INPUT ? ).

ON VALUE-CHANGED OF Menus_List IN FRAME DLG_Menus
DO:

  DEFINE VARIABLE vMenu_Label        AS CHAR NO-UNDO .  
  DEFINE VARIABLE vMenuItems_List    AS CHAR NO-UNDO.
  DEFINE VARIABLE vAccelerators_List AS CHAR NO-UNDO.
  
  vMenu_Label = Menus_List:SCREEN-VALUE IN FRAME DLG_Menus.

  /* Re-Build the Menu Item list for the new item. Build list first and then
     replace the entire LIST-ITEMS intead of using ADD-LAST.
  */
  FOR EACH w_MenuObject WHERE w_MenuObject.Menu_Label = vMenu_Label:
    /* Exclude Most Recently Used file list menu items - MRU file menu items
       begins with a number 1-9 followed by the file name */
    IF ( LOOKUP ( SUBSTRING(w_MenuObject.Menu_Item_Label, 1, 1), "1,2,3,4,5,6,7,8,9") > 0 )
      THEN NEXT.

    ASSIGN vMenuItems_List    = vMenuItems_List + "," +
                                w_MenuObject.Menu_Item_Label
           vAccelerators_List = vAccelerators_List + "," +
                                w_MenuObject.Menu_Accelerator
           .
  END.
  
  /* Display new lists.  SUBSTRING is used to remove leading comma added from
     the above FOR EACH.
  */
  ASSIGN
    vMenuItems_List    = SUBSTRING(vMenuItems_List,2,-1,"CHARACTER":u)
    vAccelerators_List = SUBSTRING(vAccelerators_List,2,-1,"CHARACTER":u)
    MenuItems_List:LIST-ITEMS IN FRAME DLG_Menus = ( vMenuItems_List )
    Accelerators_List:LIST-ITEMS IN FRAME DLG_Menus = ( vAccelerators_List )
  
    MenuItems_List:SCREEN-VALUE IN FRAME DLG_Menus = 
		   ENTRY( 1 , MenuItems_List:LIST-ITEMS IN FRAME DLG_Menus )
    Accelerators_List:SCREEN-VALUE IN FRAME DLG_Menus = 
		   ENTRY( 1 , Accelerators_List:LIST-ITEMS IN FRAME DLG_Menus )
    . /* END ASSIGN */

  RUN ClearButtonSetState .  /* Toggles Enable State as needed. */
END.

ON VALUE-CHANGED OF MenuItems_List IN FRAME DLG_Menus
DO:
  DEFINE VARIABLE vMenu_Label AS CHAR NO-UNDO .
  DEFINE VARIABLE vMenu_Item_Label AS CHAR NO-UNDO .

  vMenu_Label = Menus_List:SCREEN-VALUE IN FRAME DLG_Menus.
  vMenu_Item_Label = MenuItems_List:SCREEN-VALUE IN FRAME DLG_Menus.

  FIND FIRST w_MenuObject WHERE w_MenuObject.Menu_Label = vMenu_Label AND
  			w_MenuObject.Menu_Item_Label = vMenu_Item_Label.
  Accelerators_List:SCREEN-VALUE IN FRAME DLG_Menus = 
  				( IF ( w_MenuObject.Menu_Accelerator = ? )
  				  THEN ""
    				  ELSE w_MenuObject.Menu_Accelerator ) .
  RUN ClearButtonSetState .  /* Toggles Enable State as needed. */
END.

ON VALUE-CHANGED OF Accelerators_List IN FRAME DLG_Menus
DO:

  DEFINE VARIABLE vMenu_Label AS CHAR NO-UNDO .
  DEFINE VARIABLE vMenu_Accelerator AS CHAR NO-UNDO .

  IF (Accelerators_List:SCREEN-VALUE IN FRAME DLG_Menus <> ? AND
      Accelerators_List:SCREEN-VALUE IN FRAME DLG_Menus <> "") THEN
  DO: 
    ASSIGN vMenu_Label       = Menus_List:SCREEN-VALUE IN FRAME DLG_Menus
           vMenu_Accelerator = Accelerators_List:SCREEN-VALUE IN FRAME DLG_Menus.
  
    FIND FIRST w_MenuObject WHERE ( w_MenuObject.Menu_Label = vMenu_Label ) AND
  				  ( w_MenuObject.Menu_Accelerator = 
                                    vMenu_Accelerator )
  			    NO-ERROR.
    ASSIGN MenuItems_List:SCREEN-VALUE IN FRAME DLG_Menus = 
                          w_MenuObject.Menu_Item_Label.
    RUN ClearButtonSetState .  /* Toggles Enable State as needed. */
  END.
  ELSE
  DO:
    /* We can't tell which menu item to select based on the Accelerator
       Key. So reset selected item in Accelerator selection list to
       correspond to what's currently selected in Menu Item list.
    */
    APPLY "VALUE-CHANGED" TO MenuItems_List.
  END.
END.


ON CHOOSE OF btn_Clear IN FRAME DLG_Menus
DO:
  DEFINE VARIABLE vMenu_Label AS CHAR NO-UNDO .
  DEFINE VARIABLE vMenu_Item_Label AS CHAR NO-UNDO .
  DEFINE VARIABLE vMenu_Accelerator AS CHAR NO-UNDO .

  /* Do I need to test for this?  ClearButtonSetState disables btn_Clear. */
  IF Accelerators_List:SCREEN-VALUE IN FRAME DLG_Menus = ? THEN RETURN.
  
  vMenu_Label = Menus_List:SCREEN-VALUE IN FRAME DLG_Menus.
  vMenu_Item_Label = MenuItems_List:SCREEN-VALUE IN FRAME DLG_Menus.
  vMenu_Accelerator = Accelerators_List:SCREEN-VALUE IN FRAME DLG_Menus.
  /*------------------------------------------------------------------------- 
     Clear the Accelerator Key by replacing its value with Null (""). 
     Cannot use UNKNOWN(?) - not a value assignable to SELECTION-LIST:VALUE
     or :LIST-ITEM.
  -------------------------------------------------------------------------*/
  Temp_Logical = Accelerators_List:REPLACE( "" , Accelerators_List:SCREEN-VALUE 
  				IN FRAME DLG_Menus ) IN FRAME DLG_Menus .

  FIND FIRST w_MenuObject WHERE w_MenuObject.Menu_Label = vMenu_Label AND
  			w_MenuObject.Menu_Item_Label = vMenu_Item_Label AND
  			w_MenuObject.Menu_Accelerator = vMenu_Accelerator.
  w_MenuObject.Menu_Accelerator = "".
  RUN ClearButtonSetState .  /* Toggles Enable State as needed. */
END.

ON DEFAULT-ACTION OF Menus_List           IN FRAME DLG_Menus
   OR DEFAULT-ACTION OF MenuItems_List    IN FRAME DLG_Menus
   OR DEFAULT-ACTION OF Accelerators_List IN FRAME DLG_Menus
APPLY "CHOOSE" TO btn_Record IN FRAME DLG_Menus .

ON CHOOSE OF btn_Record IN FRAME DLG_Menus
DO:
  DEFINE VARIABLE vMenu_Label        AS CHAR NO-UNDO .
  DEFINE VARIABLE vMenu_Item_Label   AS CHAR NO-UNDO.
  DEFINE VARIABLE vMenu_Accelerator  AS CHAR NO-UNDO.
  DEFINE VARIABLE vAccelerators_List AS CHAR NO-UNDO.

  vMenu_Label      = Menus_List:SCREEN-VALUE     IN FRAME DLG_Menus.
  vMenu_Item_Label = MenuItems_List:SCREEN-VALUE IN FRAME dlg_Menus.
  FIND FIRST w_MenuObject WHERE ( w_MenuObject.Menu_Label      = vMenu_Label )
  			  AND	( w_MenuObject.Menu_Item_Label = 
                                                            vMenu_Item_Label )
  			  . 
  vMenu_Accelerator = w_MenuObject.Menu_Accelerator .

  RUN adecomm/_dlgrecm.p (INPUT vMenu_Item_Label , INPUT-OUTPUT vMenu_Accelerator ) .
  IF vMenu_Accelerator = w_MenuObject.Menu_Accelerator THEN RETURN.

  FIND FIRST w_MenuObject WHERE ( w_MenuObject.Menu_Accelerator =
                                  vMenu_Accelerator )
  			AND	( ( w_MenuObject.Menu_Label <> vMenu_Label  ) OR
				( w_MenuObject.Menu_Item_Label <>
                                  vMenu_Item_Label ) )
  			NO-ERROR.
  IF AVAILABLE ( w_MenuObject )
  THEN DO:
    MESSAGE vMenu_Accelerator
      SKIP(1.0)
      "Cannot assign accelerator key."
      SKIP(1.0)
      "This key sequence is already assigned to"
       w_MenuObject.Menu_Item_Label "on the" w_MenuObject.Menu_Label "menu."
      SKIP
      "Try a different key sequence or clear the existing one and record again."
      VIEW-AS ALERT-BOX ERROR BUTTONS OK.
    RETURN.
  END.

  /*------------------------------------------------------------------------- 
     Only pressing OK saves the new accelerators to the menu items.
     Until then, it is stored in the worktable field.
  -------------------------------------------------------------------------*/
  FIND FIRST w_MenuObject WHERE (w_MenuObject.Menu_Label      = vMenu_Label )
                          AND  (w_MenuObject.Menu_Item_Label = vMenu_Item_Label)
  			  .
  ASSIGN w_MenuObject.Menu_Accelerator = vMenu_Accelerator.

  /* Re-Build the Accelerator list. */
  FOR EACH w_MenuObject WHERE ( w_MenuObject.Menu_Label = vMenu_Label ) :
    ASSIGN vAccelerators_List = vAccelerators_List + "," + 
                                w_MenuObject.Menu_Accelerator
           .
  END.
  ASSIGN vAccelerators_List = SUBSTRING(vAccelerators_List,2,-1,"CHARACTER":u)
         Accelerators_List:LIST-ITEMS IN FRAME DLG_Menus = vAccelerators_List
         . /* END ASSIGN */
         
  APPLY "VALUE-CHANGED" TO MenuItems_List IN FRAME DLG_Menus.
  APPLY "ENTRY" TO MenuItems_List IN FRAME Dlg_Menus. 
  
END.

ON GO OF FRAME DLG_Menus
DO:
    DO ON STOP UNDO, RETRY ON ERROR UNDO, RETRY:
      IF NOT RETRY
      THEN DO:
        RUN adecomm/_setcurs.p ( INPUT "WAIT" ) NO-ERROR.
        /* <> "" Skips Top-level Menubar items & Items which are sub-menu items. */
        FOR EACH w_MenuObject WHERE w_MenuObject.Menu_Label <> "" :
    	   /* Cannot assign (?) to :ACCELERATOR, so re-assign as NULL(""). */
    	   w_MenuObject.Menu_Accelerator = ( IF (w_MenuObject.Menu_Accelerator = ?)
    					       THEN ""
    					       ELSE w_MenuObject.Menu_Accelerator ).
            w_MenuObject.hMenu:ACCELERATOR = w_MenuObject.Menu_Accelerator.
        END. 
      END.
      RUN adecomm/_setcurs.p ( INPUT "" ) NO-ERROR.
      ASSIGN OK_Pressed = YES.
    END. /* ON STOP */
END.
        
PROCEDURE PutLabel.
    DEFINE INPUT PARAMETER p_Widget AS WIDGET     NO-UNDO.
    DEFINE INPUT PARAMETER p_Label  AS CHARACTER  NO-UNDO.
    DEFINE VARIABLE hLabel AS WIDGET NO-UNDO.
   
ASSIGN hLabel       = p_Widget:SIDE-LABEL-HANDLE.
ASSIGN hLabel:WIDTH = FONT-TABLE:GET-TEXT-WIDTH-CHARS ( p_Label , hLabel:FONT ) NO-ERROR.
ASSIGN hLabel:SCREEN-VALUE = p_Label NO-ERROR.
ASSIGN hLabel:ROW   = p_Widget:ROW - 1  /* ( 1 - {&VM_WID} ) Ryan 9/94 */ NO-ERROR.
ASSIGN hLabel:COL   = p_Widget:COL NO-ERROR.

END PROCEDURE.


PROCEDURE ClearButtonSetState .

  btn_Clear:SENSITIVE IN FRAME DLG_Menus = 
  		( Accelerators_List:SCREEN-VALUE IN FRAME DLG_Menus <> ? )
  	   AND	( Accelerators_List:SCREEN-VALUE IN FRAME DLG_Menus <> "" ).
  
END PROCEDURE.


PROCEDURE MenuTree.

  DEFINE INPUT PARAMETER p_Menu AS WIDGET-HANDLE.
  DEFINE INPUT PARAMETER p_Parent AS CHAR.

  DEFINE VAR hMenu_Item AS WIDGET-HANDLE.
  DEFINE VAR Item_Label AS CHAR.

  IF CAN-QUERY( p_Menu , "LABEL" ) 
  THEN DO:
       Item_Label = p_Menu:LABEL .
       Item_Label = REPLACE( Item_Label , "&" , "" ). /* Take out if you want & */
  END.
  IF ( Item_Label <> ? ) AND ( Item_Label <> "" )
  THEN DO:
       CREATE w_MenuObject.
       ASSIGN w_MenuObject.hMenu = p_Menu
              w_MenuObject.Menu_Label = IF CAN-QUERY( p_Menu , "FIRST-CHILD" )
              				THEN "" ELSE p_Parent
              w_MenuObject.Menu_Item_Label = Item_Label /* ie, p_Menu:LABEL */
              .
       IF CAN-QUERY( p_Menu , "ACCELERATOR" )
       THEN w_MenuObject.Menu_Accelerator = 
       				( IF ( p_Menu:ACCELERATOR <> ? )
            			  THEN p_Menu:ACCELERATOR
            			  ELSE "" ) .
       ELSE p_Parent = Item_Label . /* ie, p_Menu:LABEL */
  END.
    
  IF CAN-QUERY ( p_Menu , "FIRST-CHILD" ) 
  THEN DO:
       hMenu_Item = p_Menu:FIRST-CHILD.
       IF ( hMenu_Item <> ? )
       THEN RUN MenuTree( hMenu_Item , p_Parent ).
  END.
  IF ( CAN-QUERY( p_Menu , "NEXT-SIBLING" ) = FALSE )
      THEN RETURN.
  ASSIGN hMenu_Item = p_Menu:NEXT-SIBLING.
  IF ( hMenu_Item <> ? )
  THEN RUN MenuTree( hMenu_Item , p_Parent ).
  
END PROCEDURE.


MAIN:
DO ON STOP   UNDO, RETRY
   ON ERROR  UNDO, RETRY
   ON ENDKEY UNDO, RETRY:

  IF NOT RETRY
  THEN DO:

    IF ( p_MenuBar = ? ) THEN RETURN.

    RUN adecomm/_setcurs.p ( INPUT "WAIT" ) NO-ERROR.


    /* Build the Work-Table which contains the Menu Tree information */
    RUN MenuTree ( p_MenuBar  , "" ).

    /* Remove unwanted menus and menu items. */
    IF ( p_Exclude <> "" ) AND ( p_Exclude <> ? )
    THEN DO:
        /* Be sure there are no &'s imbedded in the Menus to exclude list. */
        ASSIGN p_Exclude = REPLACE( p_Exclude , "&" , "" ).
        FOR EACH w_MenuObject:
            /* Remove unwanted menus. */
            IF ( w_MenuObject.Menu_Label = "" ) AND
                ( LOOKUP( w_MenuObject.Menu_Item_Label , p_Exclude ) > 0 )
                THEN DELETE w_MenuObject.
            /* Remove unwanted menu items. */
            ELSE IF ( LOOKUP( w_MenuObject.Menu_Label , p_Exclude ) > 0 )
                THEN DELETE w_MenuObject.
        END.
    END.

    /* Build the Menus List. */
    FOR EACH w_MenuObject WHERE w_MenuObject.Menu_Label = "":
        Temp_Logical = Menus_List:ADD-LAST( w_MenuObject.Menu_Item_Label )
    					       IN FRAME DLG_Menus  .
    END.

    /* Build the Menu Item list for the first item. */
    FIND FIRST w_MenuObject WHERE w_MenuObject.Menu_Label = "" .
    First_Menu_Label = w_MenuObject.Menu_Item_Label.
    FOR EACH w_MenuObject WHERE w_MenuObject.Menu_Label = First_Menu_Label:

        /* Exclude Most Recently Used file list menu items - MRU file menu items
           begins with a number 1-9 followed by the file name */
        IF ( LOOKUP ( SUBSTRING(w_MenuObject.Menu_Item_Label, 1, 1), "1,2,3,4,5,6,7,8,9") > 0 )
          THEN NEXT.

        Temp_Logical = MenuItems_List:ADD-LAST(  w_MenuObject.Menu_Item_Label )
                                                    IN FRAME DLG_Menus .
        Temp_Logical = Accelerators_List:ADD-LAST( w_MenuObject.Menu_Accelerator )
                                                    IN FRAME DLG_Menus.
    END.

    ASSIGN Menus_List:SCREEN-VALUE IN FRAME dlg_Menus = 
                ENTRY( 1 , Menus_List:LIST-ITEMS IN FRAME dlg_Menus )
                                             
           MenuItems_List:SCREEN-VALUE IN FRAME dlg_Menus = 
                ENTRY( 1 , MenuItems_List:LIST-ITEMS IN FRAME Dlg_Menus )

           Accelerators_List:SCREEN-VALUE IN FRAME dlg_Menus =
                ENTRY( 1 , Accelerators_List:LIST-ITEMS IN FRAME DLG_Menus )
    . /* END ASSIGN */

    ENABLE Menus_List MenuItems_List Accelerators_list
            btn_Record btn_Clear btn_OK btn_Cancel btn_Help
            WITH FRAME dlg_Menus.

    RUN ClearButtonSetState.
    
    RUN adecomm/_setcurs.p ( INPUT "" ) NO-ERROR.
 
    SET Menus_List GO-ON( GO,WINDOW-CLOSE )
        WITH FRAME DLG_Menus.
  END.  /* IF NOT RETRY */

  RUN adecomm/_setcurs.p ( INPUT "" ) NO-ERROR.
  IF OK_Pressed THEN RETURN "OK":U.
  
END. /* MAIN */
/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/*******************************************************************************
    Procedure : _dlgrecm.p

    Purpose   : Dialog box to record user keystrokes for menu accelerator keys.

    Syntax    : RUN adecomm/_dlgrecm.p ( INPUT p_Menu_Item , 
					 INPUT-OUTPUT p_Accelerator) .

    Date      : 12.02.92

    Author    : John Palazzo
*******************************************************************************/

DEFINE INPUT PARAMETER p_Menu_Item AS CHAR FORMAT "x(30)" 
					LABEL "Menu Item".
DEFINE INPUT-OUTPUT PARAMETER p_Accelerator AS CHAR FORMAT "x(30)"
					LABEL "Accelerator Key".
/* ADE Stanards Include */
&GLOBAL-DEFINE WIN95-BTN YES
{ adecomm/adestds.i }
IF NOT initialized_adestds
THEN RUN adecomm/_adeload.p.

/* Help Context */
{ adecomm/commeng.i }

DEFINE VAR Menu_Item AS CHAR.
DEFINE VAR Accelerator AS CHAR.
DEFINE VAR ok_pressed as logical.
DEFINE VAR i as integer.
DEFINE VAR Recording AS LOGICAL INIT TRUE.

DEFINE BUTTON btn_OK LABEL "OK"
    {&STDPH_OKBTN} AUTO-GO.
    
DEFINE BUTTON btn_Cancel LABEL "Cancel"
    {&STDPH_OKBTN} AUTO-ENDKEY.

DEFINE BUTTON btn_Record  LABEL "&Record"
    SIZE 14 BY {&H_OKBTN} MARGIN-EXTRA DEFAULT.
    
DEFINE BUTTON btn_Retry  LABEL "Re&try"
    {&STDPH_OKBTN}.

DEFINE BUTTON btn_Help  LABEL "&Help"
    {&STDPH_OKBTN}.
DEFINE VARIABLE wintitle as char no-undo init "Record Menu Accelerator".
/* Dialog Button Box */
&IF {&OKBOX} &THEN
DEFINE RECTANGLE RA_Btn_Box    {&STDPH_OKBOX}.
&ENDIF

/* Dialog Box */    

FORM
  SKIP( {&TFM_WID} )
  "Press the keys you want to assign as the Accelerator Key." 
    {&AT_OKBOX} VIEW-AS TEXT
  SKIP( {&VM_WIDG} )
  p_Menu_Item    COLON 18 VIEW-AS TEXT 
  SKIP( {&VM_WIDG} )
  p_Accelerator  COLON 18 {&STDPH_FILL}
    { adecomm/okform.i
        &BOX    ="RA_Btn_Box"
        &OK     ="btn_OK"
        &CANCEL ="btn_Cancel"
        &OTHER  ="SPACE( {&HM_BTNG} ) btn_Record"
        &HELP   ="btn_Help" 
    }
  WITH FRAME Record_Accels SIDE-LABELS 
       &if DEFINED(IDE-IS-RUNNING) = 0  &then
       VIEW-AS DIALOG-BOX TITLE  wintitle
       &else
       no-box
       &endif
               DEFAULT-BUTTON btn_OK 
               CANCEL-BUTTON btn_Cancel.
    { adecomm/okrun.i
        &FRAME  = "FRAME Record_Accels"
        &BOX    = "RA_Btn_Box"
        &OK     = "btn_OK"
        &HELP   = "btn_Help"
    }
{adeuib/ide/dialoginit.i "FRAME Record_Accels:handle"}
/*------------------- UI Triggers -------------------*/
ON HELP OF FRAME Record_Accels ANYWHERE
  RUN adecomm/_adehelp.p
      ( INPUT "comm" , 
        INPUT "CONTEXT" , INPUT {&Record_Menu_Accelerators} , INPUT ? ).

ON CHOOSE OF btn_Help IN FRAME Record_Accels
DO:
    IF ( Recording = TRUE )
    THEN DO:
        RUN StopRecording.
        APPLY "ENTRY" TO btn_Help.
    END.

    RUN adecomm/_adehelp.p
      ( INPUT "comm" , 
        INPUT "CONTEXT" , INPUT {&Record_Menu_Accelerators} , INPUT ? ).
END.

ON GO OF FRAME Record_Accels
DO:
    ASSIGN ok_pressed    = true
           p_Accelerator = p_Accelerator:SCREEN-VALUE
    . /* END ASSIGN */
END.

ON WINDOW-CLOSE OF FRAME Record_Accels 
   OR CHOOSE OF btn_Cancel IN FRAME Record_Accels
DO:
  ASSIGN ok_pressed    = ?
         p_Menu_Item   = Menu_Item
         p_Accelerator = Accelerator
  . /* END ASSIGN */
END.

ON "CHOOSE" OF btn_Record IN FRAME Record_Accels
DO:
    IF ( Recording = FALSE )
        THEN RUN StartRecording.
        ELSE DO:
            RUN StopRecording.
            APPLY "ENTRY" TO btn_Cancel.
        END.
END.

/*
ON LEAVE OF p_Accelerator IN FRAME Record_Accels
DO:
    RUN StopRecording.
END.
*/
  
ON ANY-KEY OF p_Accelerator IN FRAME Record_Accels
DO:
  DO ON STOP UNDO, LEAVE:
      IF CAN-DO("ENTER,RETURN,TAB" , LAST-EVENT:FUNCTION )
         OR CAN-DO("ENTER,RETURN,CTRL-TAB,TAB,SHIFT-TAB" , LAST-EVENT:LABEL)
      THEN DO:
          MESSAGE LAST-EVENT:LABEL SKIP
                  "Invalid Accelerator Key." SKIP(1)
                  VIEW-AS ALERT-BOX ERROR BUTTONS OK.
          APPLY "ENTRY" TO SELF.
          RETURN NO-APPLY.
      END.
      
      ASSIGN p_Accelerator:SCREEN-VALUE = LAST-EVENT:LABEL .
      RUN StopRecording.
 
      APPLY "ENTRY" TO btn_OK.
      RETURN NO-APPLY.
  END.
  
END.

PROCEDURE StartRecording.
    ASSIGN Recording = TRUE
           btn_Record:LABEL IN FRAME Record_Accels = "Stop Record"
           p_Accelerator:SENSITIVE IN FRAME Record_Accels = TRUE
    . /* END ASSIGN */
    APPLY "ENTRY" TO p_Accelerator IN FRAME Record_Accels.
END PROCEDURE.


PROCEDURE StopRecording.
    ASSIGN Recording = FALSE
           btn_Record:LABEL IN FRAME Record_Accels = "&Record"
           p_Accelerator:SENSITIVE IN FRAME Record_Accels = FALSE
    . /* END ASSIGN */
END PROCEDURE.
&scoped-define CANCEL-EVENT U2
{adeuib/ide/dialogstart.i btn_OK btn_cancel wintitle } 
/*------------------- MAIN -------------------*/
DO ON STOP UNDO, LEAVE :
    
    IF RETRY
    THEN DO:
        p_Accelerator = Accelerator.
        LEAVE.
    END.
    
    /* Run-Time Frame Layout */
    ASSIGN btn_Help:COLUMN IN FRAME Record_Accels = ( FRAME Record_Accels:WIDTH - btn_Help:WIDTH IN FRAME Record_Accels ) - 2.

    ASSIGN Menu_Item   = p_Menu_Item
           Accelerator = p_Accelerator.

    DISPLAY p_Menu_Item p_Accelerator WITH FRAME Record_Accels.
    ENABLE ALL WITH FRAME Record_Accels.
    RUN StartRecording.
    
    UPDATE p_Accelerator
           GO-ON ( GO,WINDOW-CLOSE )
           WITH FRAME Record_Accels .
  
  /*   
    WAIT-FOR GO,WINDOW-CLOSE OF FRAME Record_Accels 
             FOCUS p_Accelerator.
  */
    
END. /* Main */
/**********************************************************************
* Copyright (C) 2000,2006 by Progress Software Corporation. All rights*
* reserved.  Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                            *
*                                                                     *
**********************************************************************/
/*----------------------------------------------------------------------------

File: _dtbldat.p

Description:
   Display detailed table,  field and index information to
   the currently set output device (e.g., a file, the printer).
 
Input Parameters:
   p_DbId  - Id of the _Db record for this database.
   p_Tbl   - The name of the table to report on - or ALL for all tables.
   p_Order - Order for field display, "a"- alphabetical or "o" - by order#.

Author: Laura Stern

Date Created: 10/09/92

Modified on 5/31/95 by GFS Allow display of hidden tables (not meta-schema).
            6/07/94 by GFS - 94-05-09-001 - Added NO-LOCKs
            01/07/98 DLM  Added display or current storage area
            04/17/98 DLM  Added check for _field-recid > 0 for default index.
            04/20/98 DLM  change display of area number to area name.
            07/10/98 DLM  Added _owner and DBVERSION syntax for V9 databases
            01/18/00 DLM  Added NO-LOCK where missed.
                          Added display of File Valexp and Valmsg.
            01/31/03 DLM  Added support for Blobs              
            06/15/06 fernando   Adding support for long dump names
----------------------------------------------------------------------------*/
{ prodict/fhidden.i }

DEFINE INPUT PARAMETER p_DbId  AS RECID NO-UNDO.
DEFINE INPUT PARAMETER p_Tbl   AS CHAR  NO-UNDO.
DEFINE INPUT PARAMETER p_Order AS CHAR  NO-UNDO.

DEFINE BUFFER   bField FOR DICTDB._Field.
DEFINE BUFFER   bFile  FOR DICTDB._File.

DEFINE SHARED STREAM rpt.

DEFINE VARIABLE line        AS CHAR                NO-UNDO.
DEFINE VARIABLE name        AS CHAR                NO-UNDO.
DEFINE VARIABLE descrip     AS CHAR    INITIAL ""  NO-UNDO.
DEFINE VARIABLE flags       AS CHAR                   NO-UNDO.
DEFINE VARIABLE fldcnt      AS INTEGER INITIAL -1  NO-UNDO.
DEFINE VARIABLE idx_primary AS LOGICAL                   NO-UNDO.
DEFINE VARIABLE check_crc   AS LOGICAL                   NO-UNDO.
DEFINE VARIABLE word_idx    AS LOGICAL                   NO-UNDO.
DEFINE VARIABLE temp        AS CHAR                NO-UNDO.
DEFINE VARIABLE odbtyp      AS CHARACTER  NO-UNDO. /* list of ODBC-types */
define variable mAreaLabel  as character no-undo.

DEFINE VAR lbls AS CHAR EXTENT 19 NO-UNDO INITIAL
   [ /* 1 */ "        Owner: ",
     /* 2 */ "  Record Size: ",
     /* 3 */ "        Label: ",
     /* 4 */ "    Col-Label: ",
     /* 5 */ "  Description: ",
     /* 6 */ "         Help: ",
     /* 7 */ "      Val-Msg: ",
     /* 8 */ "      Val-Exp: ", 
     /* 9 */ "** Field Name: ",
     /*10 */ "** Index Name: ",
     /*11 */ "               ",
     /*12 */ ""               ,
     /*13 */ "      DB-Link: ",
     /*14 */ " Storage Area: ",
     /*15 */ " Default Area: ",
     /*16 */ "     Lob Size: ",
     /*17 */ "    Code Page: ",
     /*18 */ "    Collation: ",
     /*19*/  "    Dump Name: "
   ].

&GLOBAL-DEFINE LBL_OWNER       1
&GLOBAL-DEFINE LBL_RECSIZE     2
&GLOBAL-DEFINE LBL_LABEL       3
&GLOBAL-DEFINE LBL_COLLABEL    4
&GLOBAL-DEFINE LBL_DESC        5
&GLOBAL-DEFINE LBL_HELP        6
&GLOBAL-DEFINE LBL_VALMSG      7
&GLOBAL-DEFINE LBL_VALEXP      8
&GLOBAL-DEFINE LBL_FLDNAME     9
&GLOBAL-DEFINE LBL_IDXNAME     10
&GLOBAL-DEFINE LBL_EMPTY       11
&GLOBAL-DEFINE LBL_NONE        12
&GLOBAL-DEFINE LBL_DBLINK      13
&GLOBAL-DEFINE LBL_AREA        14
&GLOBAL-DEFINE LBL_DEFAULTAREA 15
&GLOBAL-DEFINE LBL_LSIZE       16
&GLOBAL-DEFINE LBL_CODEPG      17
&GLOBAL-DEFINE LBL_COLL        18
&GLOBAL-DEFINE LBL_DUMPNAME    19

DEFINE VAR separators AS CHAR EXTENT 6 NO-UNDO INITIAL 
[
  "=========================================================================",
  "============================= FIELD SUMMARY =============================", 
  "============================= INDEX SUMMARY =============================",
  "============================= FIELD DETAILS =============================",
  "============================= Table: ",
  "============================= SEQUENCES ================================="
].

&GLOBAL-DEFINE SEP_NEXTTBL    1
&GLOBAL-DEFINE SEP_SUMFIELD   2
&GLOBAL-DEFINE SEP_SUMINDEX   3
&GLOBAL-DEFINE SEP_DETFIELD   4
&GLOBAL-DEFINE SEP_TBLNAME    5
&GLOBAL-DEFINE SEP_SEQUENCE   6

&GLOBAL-DEFINE SEP_TBLEND " " + STRING(separators[{&SEP_NEXTTBL}],   SUBSTITUTE("x(&1)", 35 - LENGTH(bFile._File-name,"RAW":u)))

/*=================================Forms===================================*/

/* For general long text strings.  line is formatted as appropriate. */
FORM
   line FORMAT "x(77)" NO-LABEL
   WITH FRAME rptline NO-ATTR-SPACE DOWN NO-BOX USE-TEXT STREAM-IO.

FORM
   bFile._File-name  FORMAT "x(32)"  COLUMN-LABEL "Table!Name"
   flags             FORMAT "x(5)"   COLUMN-LABEL "Table!Flags" 
   fldcnt            FORMAT ">>>>9"  COLUMN-LABEL "Field!Count"
   bFile._numkey     FORMAT ">>>>9"  COLUMN-LABEL "Index!Count"
   bFile._File-label FORMAT "x(24)"  COLUMN-LABEL "Table!Label"
   WITH FRAME sumtable NO-ATTR-SPACE USE-TEXT STREAM-IO DOWN.

FORM
   dictdb._File-trig._Event         AT 8  FORMAT "x(13)"  COLUMN-LABEL "Trigger Event"
   dictdb._File-trig._Proc-name       FORMAT "x(20)"  COLUMN-LABEL "Trigger Procedure"
   dictdb._File-trig._Override        FORMAT "yes/no" COLUMN-LABEL "Overridable?"
   check_crc                        FORMAT "yes/no" COLUMN-LABEL "Check CRC?"
   WITH FRAME tbltrigs NO-ATTR-SPACE DOWN NO-BOX USE-TEXT STREAM-IO.

FORM
   bField._Order      FORMAT ">>>>9" COLUMN-LABEL "Order"
   bField._Field-name FORMAT "x(32)" COLUMN-LABEL "Field Name"
   bField._Data-type  FORMAT "x(11)" COLUMN-LABEL "Data Type"
   flags              FORMAT "x(4)"  COLUMN-LABEL "Flags"   
   WITH FRAME sumfield NO-ATTR-SPACE DOWN NO-BOX USE-TEXT STREAM-IO.

FORM
  bField._Field-name FORMAT "x(32)" COLUMN-LABEL "Field Name"
  bField._Format     FORMAT "x(29)" COLUMN-LABEL "Format"
  WITH FRAME nsumfield NO-ATTR-SPACE DOWN NO-BOX USE-TEXT STREAM-IO.

FORM
  bField._Field-name FORMAT "x(32)" COLUMN-LABEL "Field Name"
  bField._Initial    FORMAT "x(29)" COLUMN-LABEL "Initial"
  WITH FRAME isumfield NO-ATTR-SPACE DOWN NO-BOX USE-TEXT STREAM-IO.

FORM
  bField._Field-name FORMAT "x(30)"  COLUMN-LABEL "Field Name"
  bField._Label      FORMAT "x(22)"  COLUMN-LABEL "Label"
  bField._Col-label  FORMAT "x(22)"  COLUMN-LABEL "Column Label"
  WITH FRAME fieldlbls NO-ATTR-SPACE DOWN NO-BOX USE-TEXT STREAM-IO.

FORM
   dictdb._Field-trig._Event         AT 8  FORMAT "x(13)"  COLUMN-LABEL "Trigger Event"
   dictdb._Field-trig._Proc-name      FORMAT "x(20)"  COLUMN-LABEL "Trigger Procedure"
   dictdb._Field-trig._Override       FORMAT "yes/no" COLUMN-LABEL "Overridable?"
   check_crc                        FORMAT "yes/no" COLUMN-LABEL "Check CRC?"
   WITH FRAME fldtrigs NO-ATTR-SPACE DOWN NO-BOX USE-TEXT STREAM-IO.

FORM
  flags                   FORMAT "x(5)"  COLUMN-LABEL "Flags"
  dictdb._Index._Index-name      FORMAT "x(32)" COLUMN-LABEL "Index Name"
  dictdb._Index._Num-comp        FORMAT ">>9"   COLUMN-LABEL "Cnt"
  dictdb._Index-field._Ascending FORMAT "+ /- " COLUMN-LABEL "Fi" SPACE(0)
  dictdb._Field._Field-name      FORMAT "x(31)" COLUMN-LABEL "eld Name"
  WITH FRAME sumindex NO-ATTR-SPACE DOWN NO-BOX USE-TEXT STREAM-IO.

FORM
  SKIP(1) 
  SPACE(3) bFile._File-name LABEL "Working on" FORMAT "x(32)" SPACE
  SKIP(1)
  WITH FRAME working_on SIDE-LABELS VIEW-AS DIALOG-BOX 
  TITLE "Generating Report".


/*==========================Internal Procedures==============================*/

/*--------------------------------------------------------------
   Display a line of the report, splitting it apart if it is 
   longer than will fit and making sure to split on a delimiter
   (blank) boundary.  Don't display it if it's blank.

   Input Parameter:
      p_Str   - The string to display
      p_Label - Label to display on the first line
      p_null  - display even if p_Str is null else do nothing.
----------------------------------------------------------------*/
PROCEDURE Display_Value:

&GLOBAL-DEFINE TEXTLEN        60  /* 77 - Max length of label */

   DEFINE INPUT PARAMETER p_Str   AS CHAR    NO-UNDO.
   DEFINE INPUT PARAMETER p_Label AS CHAR    NO-UNDO.
   DEFINE INPUT PARAMETER p_null  AS LOGICAL NO-UNDO.
   
   DEFINE VARIABLE val  AS CHAR    NO-UNDO.
   DEFINE VARIABLE ix   AS INTEGER NO-UNDO.
   DEFINE VARIABLE frst AS LOGICAL NO-UNDO INIT yes.

   IF NOT p_null AND p_Str = "" THEN RETURN.

   DO WHILE LENGTH(p_Str,"RAW":u) > {&TEXTLEN}:
      /* Find the last delimiter within the length of text that will fit. */
      ASSIGN
               ix    = R-INDEX(SUBSTRING(p_Str,1,{&TEXTLEN},"FIXED":u), " ")
               ix    = (IF ix = 0 THEN {&TEXTLEN} ELSE ix)
               val   = SUBSTRING(p_Str,1,ix - 1,"CHARACTER":u)   
               p_Str = TRIM(SUBSTRING(p_Str,ix + 1,-1,"CHARACTER":u)).

      DISPLAY STREAM rpt 
               (IF frst THEN p_Label ELSE lbls[{&LBL_EMPTY}]) + val @ line
               WITH FRAME rptline.
      DOWN STREAM rpt WITH FRAME rptline.
      frst = no.
   END.
   DISPLAY STREAM rpt 
      (IF frst THEN p_Label ELSE lbls[{&LBL_EMPTY}]) + p_Str @ line
      WITH FRAME rptline.
   DOWN STREAM rpt WITH FRAME rptline.
END.

/*--------------------------------------------------------------------
   Display the data for one record of the field summary report which
   is in table format.
--------------------------------------------------------------------*/
PROCEDURE Display_Fld_Summary_Rec:
   DEFINE VARIABLE dspdt   AS CHARACTER NO-UNDO.

   IF bField._Data-type = "DATETIME" THEN
     ASSIGN dspdt = "datetm".
   ELSE IF bField._Data-type = "DATETIME-TZ" THEN
     ASSIGN dspdt = "datetm-tz".
   ELSE 
     ASSIGN dspdt = SUBSTRING(bField._Data-type,1,4,"CHARACTER":u).

   IF bField._Data-type <> "Decimal" OR bField._Decimals = ? THEN.
   ELSE 
     ASSIGN dspdt = dspdt + "-" + STRING(bField._Decimals).

   IF bField._Extent > 0 THEN
     ASSIGN dspdt = dspdt + "[" + STRING(bField._Extent) + "]".

   DISPLAY STREAM rpt
      bField._Order
      bField._Field-name
      dspdt @ bField._Data-type
  
      /* flags */
      (   (IF bField._Fld-case THEN "c" ELSE "")
        + (IF CAN-FIND(FIRST dictdb._Index-field OF bField)
           THEN "i" ELSE "")
        + (IF bField._Mandatory THEN "m" ELSE "")
        + (IF CAN-FIND(FIRST dictdb._View-ref
          WHERE dictdb._View-ref._Ref-Table = bFile._File-name
          AND dictdb._View-ref._Base-col = bField._Field-name)
          THEN "v" ELSE "")
      ) @ flags

      WITH FRAME sumfield.
   DOWN STREAM rpt WITH FRAME sumfield.
END.
/*--------------------------------------------------------------------
   Display the data for one record of the field format report which
   is in table format.
--------------------------------------------------------------------*/
PROCEDURE Display_Fld_Format:

   DISPLAY STREAM rpt
      bField._Field-name
      bField._Format
      WITH FRAME nsumfield.           
   DOWN STREAM rpt WITH FRAME nsumfield.
END.

/*--------------------------------------------------------------------
   Display the data for one record of the field inital value report which
   is in table format.
--------------------------------------------------------------------*/
PROCEDURE Display_Fld_Initial:

   DISPLAY STREAM rpt
      bField._Field-name
      bField._Initial
      WITH FRAME isumfield.           
   DOWN STREAM rpt WITH FRAME isumfield.
END.

/*--------------------------------------------------------------------
   Display the data for one record of the field label report which
   is in table format.
--------------------------------------------------------------------*/
PROCEDURE Display_Fld_Labels:

   DISPLAY STREAM rpt
      bField._Field-name
      bField._Label
      bField._Col-label
      WITH FRAME fieldlbls.           
   DOWN STREAM rpt WITH FRAME fieldlbls.
END.


/*--------------------------------------------------------------------
   Display the data for field in the detail report.  This includes
   stuff that didn't fit in the summary tables.
--------------------------------------------------------------------*/
PROCEDURE Display_Fld_Detail_Rec:
   DEFINE VAR any_vals        AS LOGICAL NO-UNDO.
   DEFINE VAR any_trig        AS LOGICAL NO-UNDO.
   define variable cAreaLabel as character no-undo.
   define buffer bFile for dictdb._file. 
   
   any_vals = (IF (bField._Desc = ?   OR bField._Desc = "")   AND
                               (bField._Help = ?   OR bField._Help = "")   AND
                               (bField._Valmsg = ? OR bField._Valmsg = "") AND
                               (bField._Valexp = ? OR bField._Valexp = "")
                     THEN no else yes).
   any_trig = (IF CAN-FIND(FIRST dictdb._Field-trig OF bField) THEN yes else no).

   IF any_vals OR any_trig THEN
      RUN Display_Value (bField._Field-name, lbls[{&LBL_FLDNAME}], no).

   IF any_vals THEN DO:
      if bField._Desc <> ? THEN DO:
         temp = REPLACE(bField._Desc, CHR(10), " "). /* remove carriage rtrns */
         RUN Display_Value (temp, lbls[{&LBL_DESC}], no).
      END.
      if bField._Help <> ? THEN
         RUN Display_Value (bField._Help, lbls[{&LBL_HELP}], no).
      if bField._Valmsg <> ? THEN
         RUN Display_Value (bField._Valmsg, lbls[{&LBL_VALMSG}], no).
      if bField._Valexp <> ? THEN
         RUN Display_Value (bField._Valexp, lbls[{&LBL_VALEXP}], no).
   
      DOWN STREAM rpt 1 WITH FRAME rptline.
   END.
   
   IF bField._Data-type = "BLOB" OR bField._Data-type = "CLOB"  
   AND dictdb._Db._Db-type = "PROGRESS" THEN DO:
     find bFile of bField no-lock.
     
     if INTEGER(DBVERSION("DICTDB")) > 10 then
     do:
        FIND dictdb._StorageObject WHERE dictdb._StorageObject._Db-recid = bFile._db-Recid
                                     and dictdb._StorageObject._Object-Number = bField._Fld-stlen 
                                     and dictdb._StorageObject._Object-type = 3 
                                     and dictdb._StorageObject._Partitionid = 0
                                     NO-LOCK NO-ERROR.
         /* show label as default area if multi-tenant */
         cAreaLabel = if bFile._File-Attributes[1] 
                      then lbls[{&LBL_DEFAULTAREA}]
                      else lbls[{&LBL_AREA}]. 
     end.
     else do:
         FIND dictdb._StorageObject WHERE dictdb._StorageObject._Db-recid = bFile._db-Recid
                                      and dictdb._StorageObject._Object-Number = bField._Fld-stlen 
                                      and dictdb._StorageObject._Object-type = 3 
                                      NO-LOCK NO-ERROR.
         cAreaLabel = lbls[{&LBL_AREA}].
     end.
       
     IF AVAILABLE _StorageObject THEN 
     do:
         FIND dictdb._Area where dictdb._Area._Area-number = dictdb._StorageObject._Area-number NO-LOCK NO-ERROR.
         RUN Display_Value (bField._Field-name, lbls[{&LBL_FLDNAME}], no).
         RUN Display_Value (if avail dictdb._Area then dictdb._Area._Area-name else "", cAreaLabel, YES). 
         RUN Display_Value (IF bField._Fld-Misc2[1] <> ? THEN bField._Fld-Misc2[1] ELSE "?", lbls[{&LBL_LSIZE}], no).
         IF bField._Data-type = "CLOB" then
         DO: 
           RUN Display_Value (bField._Charset, lbls[{&LBL_CODEPG}], no).
           RUN Display_Value (bField._Collation, lbls[{&LBL_COLL}], no).
         END.
         DOWN STREAM rpt 1 WITH FRAME rptline.   
     end. 
   END.
   /*----- Field triggers -----*/
   FOR EACH dictdb._Field-trig OF bField NO-LOCK:
      DISPLAY STREAM rpt 
               dictdb._Field-trig._Event
               dictdb._Field-trig._Proc-name
               dictdb._Field-trig._Override
               (IF dictdb._Field-trig._Trig-Crc <> 0 AND dictdb._Field-trig._Trig-Crc <> ?
                  THEN yes ELSE no) @ check_crc
               WITH FRAME fldtrigs.
      DOWN STREAM rpt WITH FRAME fldtrigs.
   END.

   IF any_trig THEN
      DOWN STREAM rpt 1 WITH FRAME rptline.
END.


/*===========================Mainline code=================================*/

ASSIGN
  odbtyp = {adecomm/ds_type.i &direction = "ODBC" &from-type = "flags"}.
                  
IF p_Tbl = "ALL" THEN
   SESSION:IMMEDIATE-DISPLAY = yes.
   
FIND dictdb._Db NO-LOCK WHERE RECID(_Db) = p_DbId.

/* Summary table data */
IF p_Tbl = "ALL" THEN DO:
   line = STRING("Table Name","x(15)") + "Description".
   DISPLAY STREAM rpt line WITH FRAME rptline.
   DOWN STREAM rpt WITH FRAME rptline.
   line = FILL ("-", 76).
   DISPLAY STREAM rpt line WITH FRAME rptline.
   DOWN STREAM rpt WITH FRAME rptline.

   FOR EACH bFile NO-LOCK 
     WHERE bFile._Db-recid = p_DbId AND (IF NOT fHidden THEN NOT bFile._Hidden ELSE bFile._File-Number > 0)
     BY bFile._File-name:
     
     IF INTEGER(DBVERSION("DICTDB")) > 8 AND (bFile._Owner <> "PUB" AND bFile._Owner <> "_FOREIGN")
       THEN NEXT.

     temp = REPLACE(bFile._Desc, CHR(10), " "). /* remove carriage rtrns */
     RUN Display_Value (temp,
       STRING(SUBSTRING(bFile._File-name,1,14,"FIXED":u),"x(15)"),yes).
   END.
END.

FOR EACH bFile NO-LOCK 
  WHERE bFile._Db-recid = p_DbId 
    AND (IF p_Tbl = "ALL" THEN (IF NOT fHidden THEN NOT bFile._Hidden ELSE bFile._File-Number > 0)
         ELSE bFile._File-name = p_Tbl)
    BY bFile._File-name:

   IF INTEGER(DBVERSION("DICTDB")) > 8 AND (bFile._Owner <> "PUB" AND bFile._Owner <> "_FOREIGN")
       THEN NEXT.

   PAGE STREAM rpt.
   IF p_Tbl = "ALL" THEN
      DISPLAY bFile._File-name WITH FRAME working_on.

   /*----- Table information -----*/

   /* Table separator and flags */
   DOWN STREAM rpt 2 WITH FRAME rptline.
   DISPLAY STREAM rpt separators[{&SEP_NEXTTBL}] @ line WITH FRAME rptline.
   DOWN STREAM rpt WITH FRAME rptline.
   DISPLAY STREAM rpt separators[{&SEP_TBLNAME}] + bFile._File-name + 
      {&SEP_TBLEND} @ line WITH FRAME rptline.
   DOWN STREAM rpt 2 WITH FRAME rptline.

   flags = STRING("", "x(4)") + 
                 "Table Flags: ""m"" = multi-tenant, ""f"" = frozen, ""s"" = a SQL table".
   DISPLAY STREAM rpt flags @ line WITH FRAME rptline.
   DOWN STREAM rpt 2 WITH FRAME rptline.

   /* Table info */      
   ASSIGN
      flags = (if bFile._File-Attributes[1] then "m" else "")
      flags = (flags + IF bFile._Db-lang > 0 THEN "s" ELSE "")
      flags = (flags + IF bFile._Frozen THEN "f" ELSE "").

   DISPLAY STREAM rpt
      bFile._File-name
      flags
      bFile._numkey
      /* Progress Db's have an extra hidden field that holds the table # 
               which gateway Db's don't have.
      */
      (IF dictdb._Db._Db-type = "PROGRESS"
       OR dictdb._Db._Db-type = "AS400" 
       OR CAN-DO(odbtyp,dictdb._Db._Db-type)
       THEN bFile._numfld - 1 
       ELSE bFile._numfld) @ fldcnt
      bFile._File-label
      WITH FRAME sumtable.

  /* IF (bFile._Desc <> ? AND bFile._Desc <> "" AND p_Tbl <> "ALL") OR
      (bFile._For-Owner <> ? AND bFile._For-Owner <> "") OR
      (bFile._For-Size <> ?) THEN */
      DOWN STREAM rpt 1 WITH FRAME rptline.

   RUN Display_Value (bFile._Dump-name, lbls[{&LBL_DUMPNAME}], no).
   IF bFile._Desc <> ? /* AND p_Tbl <> "ALL"*/ THEN DO:
      temp = REPLACE(bFile._Desc, CHR(10), " "). /* remove carriage rtrns */
      RUN Display_Value (temp, lbls[{&LBL_DESC}], no).
   END.   
   if bFile._Valexp <> ? THEN
         RUN Display_Value (bFile._Valexp, lbls[{&LBL_VALEXP}], no).  
   if bFile._Valmsg <> ? THEN
         RUN Display_Value (bFile._Valmsg, lbls[{&LBL_VALMSG}], no).
   IF dictdb._Db._Db-type = "PROGRESS" AND INTEGER(DBVERSION("DICTDB")) > 8 THEN 
   DO:
   
     IF INTEGER(DBVERSION("DICTDB")) > 10 THEN
     DO:
        FIND  dictdb._StorageObject WHERE dictdb._StorageObject._Db-recid = bFile._db-recid
                                     and dictdb._StorageObject._Object-Number = bFile._File-Number 
                                     and dictdb._StorageObject._Object-type = 1 
                                     and dictdb._StorageObject._Partitionid = 0 NO-LOCK NO-ERROR.
        /* show label as default area if multi-tenant */
        mAreaLabel = if bFile._File-Attributes[1] 
                     then lbls[{&LBL_DEFAULTAREA}]
                     else lbls[{&LBL_AREA}]. 
     END.                
     ELSE DO:
        FIND  dictdb._StorageObject WHERE dictdb._StorageObject._Db-recid = bFile._db-recid
                                     and  dictdb._StorageObject._Object-Number = bFile._File-Number 
                                     and  dictdb._StorageObject._Object-type = 1 NO-LOCK NO-ERROR. 
         mAreaLabel = lbls[{&LBL_AREA}].
     
     END.                        
     IF AVAILABLE _StorageObject THEN DO:
       
       FIND dictdb._Area where dictdb._Area._Area-number = dictdb._StorageObject._Area-number NO-LOCK NO-ERROR.                              
       
       RUN Display_Value (if avail dictdb._area then dictdb._Area._Area-name else "",mAreaLabel, YES). 
     END.
     ELSE DO:
       RUN Display_Value (bFile._ianum, lbls[{&LBL_AREA}], no).
     END.    
   END.
   ELSE
       RUN Display_Value ("N/A", lbls[{&LBL_AREA}], no).
   
   if bFile._For-Owner <> ? THEN
      RUN Display_Value (bFile._For-Owner, lbls[{&LBL_OWNER}], no).
   if bFile._For-Size <> ? THEN
      RUN Display_Value (STRING(bFile._For-Size), lbls[{&LBL_RECSIZE}], no).
   if bFile._Fil-misc2[8] <> ? THEN
      RUN Display_Value (bFile._Fil-misc2[8], lbls[{&LBL_DBLINK}], no).

   IF CAN-FIND(FIRST dictdb._File-trig OF bFile) THEN
      DOWN STREAM rpt 1 WITH FRAME rptline.

   /*----- Table triggers -----*/
   FOR EACH dictdb._File-trig OF bFile NO-LOCK:
      DISPLAY STREAM rpt 
               dictdb._File-trig._Event
               dictdb._File-trig._Proc-name
               dictdb._File-trig._Override
               (IF dictdb._File-trig._Trig-Crc <> 0 AND dictdb._File-trig._Trig-Crc <> ?
                  THEN yes ELSE no) @ check_crc
               WITH FRAME tbltrigs.
      DOWN STREAM rpt WITH FRAME tbltrigs.
   END.

   /*----- Field summary -----*/

   /* Field separator and flags */
   DOWN STREAM rpt 2 WITH FRAME rptline.
   DISPLAY STREAM rpt separators[{&SEP_SUMFIELD}] @ line WITH FRAME rptline.
   DOWN STREAM rpt WITH FRAME rptline.
   DISPLAY STREAM rpt separators[{&SEP_TBLNAME}] + bFile._File-name + 
      {&SEP_TBLEND} @ line WITH FRAME rptline.
   DOWN STREAM rpt 2 WITH FRAME rptline.

   flags = "Flags: <c>ase sensitive, <i>ndex component, <m>andatory, " +
           "<v>iew component".
   DISPLAY STREAM rpt flags @ line WITH FRAME rptline.
   DOWN STREAM rpt 2 WITH FRAME rptline.

   /* Field info */
   IF p_Order = "a" THEN
      FOR EACH bField OF bFile NO-LOCK USE-INDEX _Field-Name:
         RUN Display_Fld_Summary_Rec. 
      END.
   ELSE
      FOR EACH bField OF bFile NO-LOCK USE-INDEX _Field-Position:
         RUN Display_Fld_Summary_Rec.
      END.

   DOWN STREAM rpt 1 WITH FRAME rptline.
   
   /* Display format and initial values. */
   IF p_order = "a" THEN
     FOR EACH bField OF bFile NO-LOCK USE-INDEX _File/Field:
        RUN Display_Fld_Format.
     END.
   ELSE
     FOR EACH bField OF bFile NO-LOCK USE-INDEX _Field-Position:
        RUN Display_Fld_Format.
     END.

      DOWN STREAM rpt 1 WITH FRAME rptline.

   IF p_order = "a" THEN
     FOR EACH bField OF bFile NO-LOCK USE-INDEX _File/Field:
        RUN Display_Fld_Initial.
     END.
   ELSE
     FOR EACH bField OF bFile NO-LOCK USE-INDEX _Field-Position:
        RUN Display_Fld_Initial.
     END.

      DOWN STREAM rpt 1 WITH FRAME rptline.

   /* Labels and Col labels */
   IF p_Order = "a" THEN
      FOR EACH bField OF bFile NO-LOCK USE-INDEX _File/Field:
               RUN Display_Fld_Labels.
      END.
   ELSE
      FOR EACH bField OF bFile NO-LOCK USE-INDEX _Field-Position:
               RUN Display_Fld_Labels.
      END.

   /*----- Index Summary -----*/

   /* Index separator and flags */
   DOWN STREAM rpt 2 WITH FRAME rptline.
   DISPLAY STREAM rpt separators[{&SEP_SUMINDEX}] @ line WITH FRAME rptline.
   DOWN STREAM rpt WITH FRAME rptline.
   DISPLAY STREAM rpt separators[{&SEP_TBLNAME}] + bFile._File-name + 
      {&SEP_TBLEND} @ line WITH FRAME rptline.
   DOWN STREAM rpt 2 WITH FRAME rptline.

   flags = "Flags: <p>rimary, <u>nique, <w>ord, <a>bbreviated, <i>nactive, " +
                 "+ asc, - desc".
   DISPLAY STREAM rpt flags @ line WITH FRAME rptline.
   DOWN STREAM rpt 2 WITH FRAME rptline.

   /* Index info */
   FOR EACH dictdb._Index OF bFile NO-LOCK BREAK BY dictdb._Index._Index-name:
      FIND LAST dictdb._Index-field OF dictdb._Index NO-LOCK NO-ERROR.
      flags = 
           ( (IF bFile._Prime-index = RECID(dictdb._Index) 
              THEN "p" ELSE "")
           + (IF dictdb._Index._Unique   
               THEN "u" ELSE "")
           + (IF NOT dictdb._Index._Active
               THEN "i" ELSE "") 
           + (IF dictdb._Index._Wordidx = 1
               THEN "w" ELSE "") 
                 + (IF AVAILABLE dictdb._Index-field AND dictdb._Index-field._Abbreviate
                     THEN "a" ELSE "") ).

      DISPLAY STREAM rpt
                flags
                dictdb._Index._Index-name
                dictdb._Index._Num-comp
                WITH FRAME sumindex.

      /* The default index has no fields! so this loop must be separate
               from the FOR EACH _Index loop or we'll get no output.
      */
      FOR EACH dictdb._Index-field OF dictdb._Index NO-LOCK:
        IF dictdb._Index-field._Field-recid > 0 THEN DO:
          FIND dictdb._Field WHERE RECID(dictdb._Field) = dictdb._Index-field._Field-recid NO-LOCK.
               
          DISPLAY STREAM rpt
              dictdb._Field._Field-name
              dictdb._Index-field._Ascending
              WITH FRAME sumindex.
         END.
         ELSE
           DISPLAY STREAM rpt
             "" @ dictdb._Field._Field-name
             dictdb._Index-field._Ascending
             WITH FRAME sumindex.

         DOWN STREAM rpt WITH FRAME sumindex.    
      END.
      
     /* Put an extra line in between each index. */
     IF LAST-OF(dictdb._Index._Index-name) THEN 
        DOWN STREAM rpt 1 WITH FRAME sumindex.
   END.

   /*----- Index descriptions -----*/
   FOR EACH dictdb._Index OF bFile NO-LOCK:
      IF dictdb._Index._Desc <> ? THEN DO:
         RUN Display_Value (dictdb._Index._Index-Name, lbls[{&LBL_IDXNAME}], no).
         temp = REPLACE(dictdb._Index._Desc, CHR(10), " ").
         RUN Display_Value (temp, lbls[{&LBL_DESC}], no).
      END.
      ELSE 
         RUN Display_Value (dictdb._Index._Index-Name, lbls[{&LBL_IDXNAME}], no).
         
      IF dictdb._Db._Db-type = "PROGRESS"  AND INTEGER(DBVERSION("DICTDB")) > 8 THEN 
      DO:   
         
         IF INTEGER(DBVERSION("DICTDB")) > 10 THEN
         DO:
            /* first in case of multiple collations */ 
            FIND first dictdb._StorageObject WHERE dictdb._StorageObject._Db-recid = bFile._db-recid
                                             and   dictdb._StorageObject._Object-Number = dictdb._Index._Idx-num 
                                             and   dictdb._StorageObject._Object-type = 2 
                                             and   dictdb._StorageObject._Partitionid = 0 
                                      NO-LOCK NO-ERROR.
            /* show label as default area if multi-tenant */
            mAreaLabel = if bFile._File-Attributes[1] 
                         then lbls[{&LBL_DEFAULTAREA}]
                         else lbls[{&LBL_AREA}]. 
        END.                
        ELSE DO:
            FIND  dictdb._StorageObject WHERE dictdb._StorageObject._Db-recid = bFile._db-recid
                                        and   dictdb._StorageObject._Object-Number = dictdb._Index._Idx-num 
                                        and   dictdb._StorageObject._Object-type = 2 
                                         NO-LOCK NO-ERROR. 
             mAreaLabel = lbls[{&LBL_AREA}].
         END.
        
         IF AVAILABLE dictdb._StorageObject THEN DO:
            FIND dictdb._Area where dictdb._Area._Area-number = dictdb._StorageObject._Area-number NO-lock no-error.
            RUN Display_Value (if avail dictdb._Area then dictdb._Area._Area-name else "", mAreaLabel, YES). 
         END.
         ELSE  
            RUN Display_Value (dictdb._Index._ianum, lbls[{&LBL_AREA}], no).
          
      END.
      ELSE
        RUN Display_Value ("N/A", lbls[{&LBL_AREA}], no).
           
   END.
   
   /*----- Field details -----*/
   
   /* Detail separator */
   DOWN STREAM rpt 2 WITH FRAME rptline.
   DISPLAY STREAM rpt separators[{&SEP_DETFIELD}] @ line WITH FRAME rptline.
   DOWN STREAM rpt WITH FRAME rptline.
   DISPLAY STREAM rpt separators[{&SEP_TBLNAME}] + bFile._File-name + 
      {&SEP_TBLEND} @ line WITH FRAME rptline.
   DOWN STREAM rpt 2 WITH FRAME rptline.

   /* More field info */
   IF p_Order = "a" THEN
      FOR EACH bField OF bFile NO-LOCK USE-INDEX _Field-Name:
         RUN Display_Fld_Detail_Rec. 
      END.
   ELSE
      FOR EACH bField OF bFile NO-LOCK USE-INDEX _Field-Position:
         RUN Display_Fld_Detail_Rec.
      END.
END.

IF p_Tbl = "ALL" THEN
DO:
   DISPLAY "Sequences" @ bFile._File-name WITH FRAME working_on.
   DOWN STREAM rpt 2 WITH FRAME rptline.
   DISPLAY STREAM rpt separators[{&SEP_SEQUENCE}] @ line WITH FRAME rptline.
   DOWN STREAM rpt WITH FRAME rptline.
   RUN adecomm/_qseqdat.p (INPUT p_DbId).

   HIDE FRAME working_on NO-PAUSE.
   SESSION:IMMEDIATE-DISPLAY = no.
END.

RETURN "".





/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/*----------------------------------------------------------------------------

File: dtblrpt.p

Description:
   Detailed table report for both the GUI and character dictionary.
 
Input Parameters:
   p_DbId   - Id of the _Db record corresponding to the current database
   p_PName  - Physical name of the database
   p_DbType - Database type (e.g., PROGRESS)
   p_Order  - "a" - alpha field order
      	      "o" - order# field order
      	      ""  - Ask the user
   p_Tbl    - The table name or "ALL".  
   p_TblAsk - If yes, ask the user if he wants the table name specified or ALL.

NOTE: You can only ask one of the options questions - either ask for field 
      order or ask for table (selected/all)

Author: Tony Lavinio, Laura Stern

Date Created: 10/12/92

94/07/22    gfs         removed MUST-EXIST option from Files dialog
94/01/19    hutegger    report of hidden file printable, even when there are
                        no non-hidden files in the db
98/07/10   D. McMann    Added check for DBVERSION and _Owner.      
03/29/99   Mario B      BUG# 99-03-26-19 Changed DBNAME to 
                       "DICTDB" in _Owner check.
04/13/00   D. McMann   Added support for long path names

----------------------------------------------------------------------------*/
&GLOBAL-DEFINE WIN95-BTN YES
{adecomm/commeng.i}  /* Help contexts */
{adecomm/adestds.i}  /* Standard layout defines, colors etc. */
{adecomm/adeintl.i}  /* International support */

DEFINE INPUT PARAMETER p_DbId 	 AS RECID    NO-UNDO.
DEFINE INPUT PARAMETER p_PName 	 AS CHAR     NO-UNDO.
DEFINE INPUT PARAMETER p_DbType  AS CHAR     NO-UNDO.
DEFINE INPUT PARAMETER p_Order   AS CHAR     NO-UNDO.
DEFINE INPUT PARAMETER p_Tbl 	 AS CHAR     NO-UNDO.
DEFINE INPUT PARAMETER p_TblAsk  AS LOGICAL  NO-UNDO.

DEFINE NEW SHARED STREAM rpt.  /* used by prtrpt.i */

DEFINE VAR ans         AS LOGICAL      	     	       NO-UNDO.
DEFINE VAR header_str  AS CHAR 	       	     	       NO-UNDO.
DEFINE VAR app         AS LOGICAL   INITIAL FALSE      NO-UNDO.
DEFINE VAR dev         AS CHAR 	       	     	       NO-UNDO
   VIEW-AS RADIO-SET
   RADIO-BUTTONS "Terminal","TERMINAL","Printer","PRINTER","File","F"
   INITIAL "TERMINAL".
DEFINE VAR fil         AS CHAR                         NO-UNDO.
DEFINE VAR siz         AS INTEGER   INITIAL 0          NO-UNDO.

DEFINE VAR order_alpha AS CHARACTER INITIAL "o"	       NO-UNDO
      LABEL "&Order Fields"
      VIEW-AS RADIO-SET  
      RADIO-BUTTONS "By Order #",     "o",
      	       	    "Alphabetically", "a".

DEFINE VAR which_tbl   AS CHARACTER  INITIAL "t"       NO-UNDO
      LABEL "&Report on"
      VIEW-AS RADIO-SET  
      RADIO-BUTTONS "Selected Table", "t",
      	       	    "ALL Tables",     "a".

DEFINE BUTTON btn_Ok 	 LABEL "OK"       {&STDPH_OKBTN} AUTO-GO.
DEFINE BUTTON btn_Cancel LABEL "Cancel"   {&STDPH_OKBTN} AUTO-ENDKEY.
DEFINE BUTTON btn_Files  LABEL "&Files..." 
   &IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN SIZE 15 by 1.125 &ENDIF .
   
&IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN
   Define button    btn_Help  label "&Help" {&STDPH_OKBTN}.
   Define rectangle rect_Btns {&STDPH_OKBOX}. /* standard button rectangle */
   &global-define   HLP_BTN  &HELP = "btn_Help"
&ELSE
   &global-define   HLP_BTN  
&ENDIF

DEFINE VAR stat AS LOGICAL NO-UNDO.


/*-------------------------------Forms------------------------------------*/
FORM
   SKIP({&TFM_WID})
   
   dev LABEL "&Send Output to"           COLON 17  
   SKIP ({&VM_WID})

   fil NO-LABEL FORMAT "x({&PATH_WIDG})"           AT    19
       VIEW-AS FILL-IN NATIVE SIZE 30 BY 1   	   {&STDPH_FILL} SPACE(.3)
   btn_Files
   SKIP({&VM_WID})

   app LABEL "&Append to Existing File?" AT    19
       VIEW-AS TOGGLE-BOX 
   SKIP({&VM_WIDG})
   
   siz LABEL "&Page Length" FORMAT ">>9" COLON 17   {&STDPH_FILL}
   "(# Lines, 0 for Continuous)":t35                   	  
   SKIP({&VM_WIDG})

   order_alpha 	     	      	       	 COLON 17
   which_tbl   AT ROW-OF order_alpha COL 17 COLON-ALIGNED 

   {adecomm/okform.i
      &BOX    = rect_btns
      &STATUS = no
      &OK     = btn_OK
      &CANCEL = btn_Cancel
      {&HLP_BTN}
   }

   WITH FRAME options 
      SIDE-LABELS 
      DEFAULT-BUTTON btn_Ok CANCEL-BUTTON btn_Cancel
      VIEW-AS DIALOG-BOX TITLE "Report Options".


/*-----------------------------Triggers------------------------------------*/

/*----- OK or GO -----*/
ON GO OF FRAME OPTIONS  
DO:

   DEFINE VARIABLE flags AS CHARACTER.
  
   IF p_Order = "" THEN
      order_alpha = order_alpha:SCREEN-VALUE.
   IF p_TblAsk THEN
      which_tbl = which_tbl:SCREEN-VALUE.

   ASSIGN 
      dev
      fil
      app
      siz.

   fil = TRIM(fil).
   IF p_Order = "" THEN p_Order = order_alpha.
   IF p_TblAsk AND which_tbl = "a" THEN
      p_Tbl = "ALL".
   
   /* Do it.  If user displays to terminal he will have the option to print
      later.  If going to printer - that's all folks.
   */   
   header_str = "Database: " + p_PName + " (" + p_DbType + ")".
   IF dev = "TERMINAL" THEN
   DO:
      header_str = "Database: " + p_PName + " (" + p_DbType + ")".
      RUN adecomm/_report.p 
	 (INPUT p_DbId, 
	  INPUT header_str,
      	  INPUT "Detailed Table Report",
	  INPUT "",
	  INPUT p_Order,
	  INPUT "adecomm/_dtbldat.p",
	  INPUT p_Tbl,
      	  INPUT {&Detailed_Table_Report}).
   END.
   ELSE DO:

      IF dev = "F" then DO:
        ASSIGN dev = fil.  
        IF NOT app THEN DO:
          FILE-INFO:FILE-NAME = fil.
          IF FILE-INFO:FULL-PATHNAME NE ? THEN DO:
            DEF VAR choice AS LOGICAL INITIAL NO.
            MESSAGE fil "already exists. Overwrite?" VIEW-AS ALERT-BOX QUESTION 
              BUTTONS YES-NO UPDATE choice.
            IF NOT choice THEN DO:
              APPLY "ENTRY" TO fil.
              RETURN NO-APPLY.
            END.
          END.
        END.
      END.
      {adecomm/prtrpt.i
	    &Header = header_str
      	    &Flags  = flags
	    &dev    = dev
	    &app    = app
	    &siz    = siz
	    &Func   = "adecomm/_dtbldat.p 
      	       	      (INPUT p_DbId, INPUT p_Tbl, INPUT p_Order)"}
   END.
END.

/*----- VALUE-CHANGED of DEVICE RADIO SET -----*/
ON VALUE-CHANGED OF dev IN FRAME options
DO:
   /* Default to continuous output for terminal, 60 for printer */
   dev = SELF:SCREEN-VALUE.
   IF dev = "F" /* file */ THEN DO:
      ASSIGN
	 siz:SCREEN-VALUE IN FRAME options = "0"
	 &IF "{&WINDOW-SYSTEM}" = "TTY" &THEN 
	    fil:VISIBLE IN FRAME options = yes
	    btn_Files:VISIBLE IN FRAME options = yes
	    app:VISIBLE IN FRAME options = yes
	 &ELSE
	    fil:SENSITIVE IN FRAME options = yes
	    btn_Files:SENSITIVE IN FRAME options = yes
	    app:SENSITIVE IN FRAME options = yes
	 &ENDIF
      	 .
      APPLY "ENTRY" TO fil IN FRAME options.
   END.
   ELSE DO:
      &IF "{&WINDOW-SYSTEM}" = "TTY" &THEN 
	 ASSIGN
	    fil:VISIBLE IN FRAME options = no
	    btn_Files:VISIBLE IN FRAME options = no
	    app:VISIBLE IN FRAME options = no.
      &ELSE
	 ASSIGN
	    fil:SENSITIVE IN FRAME options = no
	    fil:SCREEN-VALUE IN FRAME options = ""
	    btn_Files:SENSITIVE IN FRAME options = no
	    app:SENSITIVE IN FRAME options = no.
      &ENDIF
      IF dev = "TERMINAL" THEN
	 siz:SCREEN-VALUE IN FRAME options = "0".
      ELSE IF dev = "PRINTER" THEN  
	 siz:SCREEN-VALUE IN FRAME options = "60".
   END.
END.

/*----- HIT of FILE BUTTON -----*/
on choose of btn_Files in frame options
do:
   Define var name       as char    NO-UNDO.
   Define var picked_one as logical NO-UNDO.
   Define var d_title    as char    NO-UNDO init "Report File".

   name = TRIM(fil:screen-value in frame options).
   &IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN
      system-dialog GET-FILE 
		    name 
		    filters            "*" "*"
		    default-extension  ""
		    title 	       d_title 
		    /*must-exist*/
		    update             picked_one.
   &ELSE
      run adecomm/_filecom.p
	  ( INPUT "" /* p_Filter */, 
	    INPUT "" /* p_Dir */ , 
	    INPUT "" /* p_Drive */ ,
	    INPUT no /* File Open */ ,
	    INPUT d_title ,
            INPUT "" /* Dialog Options */ ,
	    INPUT-OUTPUT name,
   	    OUTPUT picked_one ). 
   &ENDIF

   if picked_one then
      fil:screen-value in frame options = name.
end.

ON HELP OF FRAME options
  &IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN
    OR CHOOSE OF btn_Help IN FRAME options
  &ENDIF
  RUN "adecomm/_adehelp.p" ("comm", "CONTEXT", {&Report_Options}, ?).

/*-------------------------------Mainline code-----------------------------*/
/* Check for privileges */

IF INTEGER(DBVERSION("DICTDB")) > 8 THEN DO:
  FIND _File WHERE  _File._File-name = "_File" 
               AND _File._Owner = "PUB" NO-LOCK.
  ans = CAN-DO(_Can-read,USERID("DICTDB")).
  FIND _File WHERE _File._File-name = "_Field" 
               AND _File._Owner = "PUB" NO-LOCK.
  ans = ans AND CAN-DO(_Can-read,USERID("DICTDB")).
  FIND _File WHERE  _File._File-name = "_Index" 
               AND _File._Owner = "PUB" NO-LOCK.
  ans = ans AND CAN-DO(_Can-read,USERID("DICTDB")).
  FIND _File WHERE  _File._File-name = "_Index-field" 
               AND _File._Owner = "PUB" NO-LOCK.
  ans = ans AND CAN-DO(_Can-read,USERID("DICTDB")).
END.  
ELSE DO:
  FIND _File "_File" NO-LOCK.
  ans = CAN-DO(_Can-read,USERID("DICTDB")).
  FIND _File "_Field" NO-LOCK.
  ans = ans AND CAN-DO(_Can-read,USERID("DICTDB")).
  FIND _File "_Index" NO-LOCK.
  ans = ans AND CAN-DO(_Can-read,USERID("DICTDB")).
  FIND _File "_Index-field" NO-LOCK.
  ans = ans AND CAN-DO(_Can-read,USERID("DICTDB")).
END.  
IF NOT ans THEN DO:
  MESSAGE "You do not have permission to use this option."
    VIEW-AS ALERT-BOX ERROR BUTTONS OK.
  RETURN.
END.

/* "ALL" selected -> print all non-hidden files, if there are non -> error */
IF  p_Tbl = "ALL" THEN DO:
  FIND LAST _File NO-LOCK WHERE _File._Db-recid = p_DbId AND 
    NOT _File._Hidden NO-ERROR.
  IF NOT AVAILABLE _File THEN DO:
    MESSAGE "There are no tables in this database to look at."
      VIEW-AS ALERT-BOX ERROR BUTTONS OK.
    RETURN.
  END.
END.

/* Only one of the optional questions will be visible */
ASSIGN
  order_alpha:HIDDEN IN FRAME options = (IF p_Order = "" THEN no else yes)
  which_tbl:HIDDEN IN FRAME options = (IF p_TblAsk THEN no else yes).

/* "File" related fields start insensitive or hidden by default */
ASSIGN
  &IF "{&WINDOW-SYSTEM}" = "TTY" &THEN 
    fil:hidden IN FRAME options = yes
    btn_Files:hidden IN FRAME options = yes
    app:hidden IN FRAME options = yes
    fil:sensitive IN FRAME options = yes
    btn_Files:sensitive IN FRAME options = yes
    app:sensitive IN FRAME options = yes
  &ELSE
    fil:sensitive IN FRAME options = no
    btn_Files:sensitive IN FRAME options = no
    app:sensitive IN FRAME options = no
  &ENDIF
  .

/* Run time layout for button area. */
{adecomm/okrun.i  
  &FRAME  = "frame options" 
  &BOX    = "rect_Btns"
  &OK     = "btn_OK" 
  &Cancel = "btn_Cancel"
  {&HLP_BTN} }

DISPLAY
  dev
  siz
  order_alpha WHEN p_Order = ""
  which_tbl   WHEN p_TblAsk
  WITH FRAME options.

ENABLE
  dev siz order_alpha WHEN p_Order = "" which_tbl WHEN p_TblAsk
  btn_Ok btn_Cancel
  &IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN
    btn_Help
  &ENDIF
  WITH FRAME options.

/* Reset tab-order for things that will be enabled later. */
ASSIGN
  stat = fil:MOVE-AFTER-TAB-ITEM(dev:HANDLE IN FRAME options)
  stat = btn_Files:MOVE-AFTER-TAB-ITEM(fil:HANDLE IN FRAME options)
  stat = app:MOVE-AFTER-TAB-ITEM(btn_Files:HANDLE IN FRAME options).

/* If user choose print and there's a problem with the printer, 
   Progress may generate a STOP condition - so trap that so
   we don't get kicked out of the whole application.  */
DO ON ERROR UNDO, LEAVE ON ENDKEY UNDO, LEAVE ON STOP UNDO, LEAVE:
  WAIT-FOR CHOOSE of btn_OK in FRAME options OR GO of FRAME options FOCUS dev.
END.

HIDE FRAME options.
RETURN RETURN-VALUE.

/* _dtblrpt.p -  end of file */





&ANALYZE-SUSPEND _VERSION-NUMBER UIB_v9r12
&ANALYZE-RESUME
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _DEFINITIONS Procedure 
/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/
/*------------------------------------------------------------------------
    File        : adecomm/_dynbuf.p
    Purpose     : Run persistent for programs that need to access query data  

    Syntax      : RUN adecomm/_dynbuf.p persistetn set <handle>
                  setBuffers('<bufferlist>') in <handle>

    Description : A dynamic query is used to store the buffer handles. 
                  the get* functions retrieves the data through the dynamic query  
                                                        
    Author(s)   : H Danielsen 
    Created     : April 1999 
    Notes       : The program is used to make ForeignFields (adecomm/_mfldmap) 
                  available for queries.  
                  The current use could probably have been achieved by just
                  having a getTables function that returned a character string,
                  But by using a dynamic query we ensure that the buffers 
                  always are valid.      
  ----------------------------------------------------------------------*/
/*          This .W file was created with the Progress AppBuilder.      */
/*----------------------------------------------------------------------*/

/* ***************************  Definitions  ************************** */

DEFINE VARIABLE ghQuery AS HANDLE.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME


&ANALYZE-SUSPEND _UIB-PREPROCESSOR-BLOCK 

/* ********************  Preprocessor Definitions  ******************** */

&Scoped-define PROCEDURE-TYPE Procedure
&Scoped-define DB-AWARE no



/* _UIB-PREPROCESSOR-BLOCK-END */
&ANALYZE-RESUME


/* ************************  Function Prototypes ********************** */

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION-FORWARD getDataColumns Procedure 
FUNCTION getDataColumns RETURNS CHARACTER
  ( /* parameter-definitions */ )  FORWARD.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION-FORWARD getTables Procedure 
FUNCTION getTables RETURNS CHARACTER
  ( )  FORWARD.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION-FORWARD setBuffers Procedure  _DB-REQUIRED
FUNCTION setBuffers RETURNS LOGICAL
  (pcBuffers AS CHAR)  FORWARD.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME


/* *********************** Procedure Settings ************************ */

&ANALYZE-SUSPEND _PROCEDURE-SETTINGS
/* Settings for THIS-PROCEDURE
   Type: Procedure
   Allow: 
   Frames: 0
   Add Fields to: Neither
   Other Settings: CODE-ONLY COMPILE
 */
&ANALYZE-RESUME _END-PROCEDURE-SETTINGS

/* *************************  Create Window  ************************** */

&ANALYZE-SUSPEND _CREATE-WINDOW
/* DESIGN Window definition (used by the UIB) 
  CREATE WINDOW Procedure ASSIGN
         HEIGHT             = 15
         WIDTH              = 60.
/* END WINDOW DEFINITION */
                                                                        */
&ANALYZE-RESUME

 


&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _MAIN-BLOCK Procedure 


/* ***************************  Main Block  *************************** */

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME


/* **********************  Internal Procedures  *********************** */

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE destroyObject Procedure 
PROCEDURE destroyObject :
/*------------------------------------------------------------------------------
  Purpose:     
  Parameters:  <none>
  Notes:       
------------------------------------------------------------------------------*/
   DELETE PROCEDURE THIS-PROCEDURE.
END PROCEDURE.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME

/* ************************  Function Implementations ***************** */

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION getDataColumns Procedure 
FUNCTION getDataColumns RETURNS CHARACTER
  ( /* parameter-definitions */ ) :
/*------------------------------------------------------------------------------
  Purpose: Return the unqualified names of all Columns of the buffers  
    Notes: This is equivalent to what is returned by a SmartDataObject  
------------------------------------------------------------------------------*/
  DEF VAR iBuf    AS INT     NO-UNDO. 
  DEF VAR iFld    AS INT     NO-UNDO. 
  DEF VAR hFld    AS HANDLE  NO-UNDO. 
  DEF VAR hBuffer AS HANDLE  NO-UNDO. 
  DEF VAR cCols   AS CHAR    NO-UNDO. 
  
  IF NOT VALID-HANDLE(ghQuery) THEN
    RETURN ?. 

  DO iBuf = 1 TO ghQuery:NUM-BUFFERS:
     hBuffer = ghQuery:GET-BUFFER-HANDLE(iBuf).
     DO iFld = 1 TO hBuffer:NUM-FIELDS:
       ASSIGN
         hFld  = hBuffer:BUFFER-FIELD(iFld)
         cCols = cCols + (IF cCols = "":U THEN "":U ELSE ",":U)
                 + hFld:NAME.
     END.  
  END.
  
  RETURN cCols. 
  

END FUNCTION.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION getTables Procedure 
FUNCTION getTables RETURNS CHARACTER
  ( ) :
/*------------------------------------------------------------------------------
  Purpose: Return the TABLE names of this object.  
    Notes: Note that the <buffer>:TABLE always returns the dictionary name
           also if the setBuffers used buffer names.   
------------------------------------------------------------------------------*/
  DEF VAR i       AS INT     NO-UNDO. 
  DEF VAR hBuffer AS HANDLE  NO-UNDO. 
  DEF VAR cTables AS CHAR    NO-UNDO. 
  
  IF NOT VALID-HANDLE(ghQuery) THEN 
    RETURN ?.
  
  ELSE 
  DO i = 1 TO ghQuery:NUM-BUFFERS:
    ASSIGN
      hBuffer  = ghQuery:GET-BUFFER-HANDLE(i)
      cTables = cTables 
                 + (IF cTables = "":U THEN "":U ELSE ",":U) 
                 + hBuffer:TABLE.
  END.
  RETURN cTables.
  
END FUNCTION.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION setBuffers Procedure 
FUNCTION setBuffers RETURNS LOGICAL
  (pcBuffers AS CHAR) :
/*------------------------------------------------------------------------------
  Purpose: Create dynamic buffers and add them to the dynamic query.   
    Notes:  
------------------------------------------------------------------------------*/
  DEF VAR i       AS INT     NO-UNDO. 
  DEF VAR hBuffer AS HANDLE  NO-UNDO. 
 
  IF NOT VALID-HANDLE(ghQuery) THEN 
    CREATE query ghQuery.
  
  ELSE 
  DO i = 1 TO ghQuery:NUM-BUFFERS:
     hBuffer = ghQuery:GET-BUFFER-HANDLE(i).
     DELETE WIDGET hBuffer.
  END.
  
  DO i = 1 TO NUM-ENTRIES(pcBuffers):
    CREATE BUFFER hBuffer FOR TABLE ENTRY(i,pcBuffers). 
    IF i = 1 THEN 
      ghQuery:SET-BUFFERS(hBuffer).
    ELSE
      ghQuery:ADD-BUFFER(hBuffer).
      
  END.
   
  RETURN TRUE.  

END FUNCTION.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME

/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/**************************************************************************
    Procedure:  _errmsgs.p
    
    Purpose:    Display PROGRESS Compiler error messages.

    Syntax :    RUN adecomm/_errmsgs.p (INPUT p_Window ,
                                        INPUT p_Error_File ,
                                        INPUT p_Comp_File).

    Parameters:
        INPUT   p_Window        Handle of window to display alert-box in.
        INPUT   p_Error_File    Name of COMPILER:FILE-NAME (file with error).
        INPUT   p_Comp_File     Name of temporary compile file.
        
    Description:
        Currently, this routine displays the COMPILER error
        messages generated by a NO-ERROR statement (typically a
        COMPILE...NO-ERROR statement) in an Error Alert-Box.

        You must be careful here, if you have a COMPILE..NO-ERROR you
        want to check but your code uses a NO-ERROR statement between
        the COMPILE and the call to this routine, you'll get
        "erroneous" error messages displayed, if any at all.

    Authors: John Palazzo
    Create : June, 1994

    Updated: Sept, 1996 - John Palazzo
             Display all message including line number errors. However,
             when Section Editor is the caller, remove the line number
             from the message.
    Updated: May, 1995 - John Palazzo
             Display all messages except line number error messages.
**************************************************************************/

&SCOPED-DEFINE PP-4345      4345    
  /* PROGRESS Preprocessor system message number. When we find this number,
     we do not remove the file name from the message. This allows the use
     of &MESSAGE {&FILE-NAME} to work. */

&SCOPED-DEFINE MAX-DISPLAY  512
  /* Maximum characters to display in message box. Windows 3.1 maximum
     is used. */

&SCOPED-DEFINE EOL          CHR(10)
  /* End of Line character. Progress ensures this for all opsys. */

DEFINE INPUT PARAMETER p_Window     AS WIDGET-HANDLE NO-UNDO.
DEFINE INPUT PARAMETER p_Error_File AS CHARACTER     NO-UNDO.
DEFINE INPUT PARAMETER p_Comp_File  AS CHARACTER     NO-UNDO.

DEFINE VARIABLE Error_Msg    AS CHARACTER     NO-UNDO.
DEFINE VARIABLE Error_Num    AS INTEGER       NO-UNDO.
DEFINE VARIABLE Error_File   AS CHARACTER     NO-UNDO.
DEFINE VARIABLE Num_Messages AS CHARACTER     NO-UNDO.
DEFINE VARIABLE Cur_Msg      AS CHARACTER     NO-UNDO.
DEFINE VARIABLE Line_Errors  AS CHARACTER     NO-UNDO.

DO ON STOP UNDO, LEAVE:
    IF NOT VALID-HANDLE( p_Window ) THEN
        ASSIGN p_Window = IF VALID-HANDLE(ACTIVE-WINDOW)
                          THEN ACTIVE-WINDOW
                          ELSE CURRENT-WINDOW.
    
    /* Display compiler messages. */
    DO Error_Num = 1 TO ERROR-STATUS:NUM-MESSAGES:

      ASSIGN Error_Msg = Error_Msg + {&EOL}.
      
      /* If the current message is not a PROGRESS Preprocessor message,
         remove the tempfile name. Otherwise, leave it, because the user
         may be trying to display the file name during preprocessing
         using {&FILE-NAME}.
      */
      ASSIGN Cur_Msg = ERROR-STATUS:GET-MESSAGE( Error_Num ).
      IF ERROR-STATUS:GET-NUMBER( Error_Num ) <> {&PP-4345} THEN
        ASSIGN Cur_Msg = REPLACE( Cur_Msg , p_Comp_File , "" ) .

      /* If Section Editor, remove line number from message if its not the
         same as the error number. We don't want to lose the error number. 
         Check on error-row is when the error is only a preprcessor message,
         in which case error-row is unknown (?) and we don't want to do
         the replace (message would be replaced with unknown). */
      IF (p_Window:NAME = "Section Editor") THEN
      DO:
         IF (COMPILER:ERROR-ROW <> ?) AND
         (COMPILER:ERROR-ROW <> ERROR-STATUS:GET-NUMBER(Error_Num)) THEN
         ASSIGN Cur_Msg = REPLACE(Cur_Msg, STRING(COMPILER:ERROR-ROW), "").
      END.
      
      ASSIGN Error_Msg = Error_Msg + Cur_Msg.
        
      IF LENGTH(Error_msg) > {&MAX-DISPLAY} THEN LEAVE.
    END.
        
    /* Get rid of the leading EOL. */
    ASSIGN Error_Msg   = TRIM( Error_Msg , CHR(10) ).
    IF Error_Msg <> "" THEN
    DO:
        RUN adecomm/_setcurs.p (INPUT "":U ).
        MESSAGE Error_Msg
            VIEW-AS ALERT-BOX ERROR IN WINDOW p_Window.
    END.
        
END. /* DO ON STOP */

/***********************************************************************
* Copyright (C) 2005-2006 by Progress Software Corporation. All rights *
* reserved.  Prior versions of this work may contain portions          *
* contributed by participants of Possenet.                             *
*                                                                    *
***********************************************************************/
/*----------------------------------------------------------------------------

File: adecomm/_filecom.p

Description:
   This is the file common dialog.  It will provide a common user
   interface for file open, and file save as.

Input/Output Parameters:
   
Author: Warren Bare

Date Created: 03/24/92 
     History:  D. McMann 04/12/00 Added long pathname support

----------------------------------------------------------------------------*/
/*---------------------------------------------------------------------------
Modifications:
  01.25.93  John Palazzo
            Made entire dialog more like MS-Windows Common Get File.
----------------------------------------------------------------------------*/

define input parameter p_Filter as char no-undo.
define input parameter p_Dir as char  no-undo.
define input parameter p_Drive as char no-undo.
define input parameter p_Save_As as log init true no-undo. /* YES = save */
define input parameter p_Title as char no-undo. 
define input parameter p_Options as char no-undo.
define input-output parameter p_File as char.
define output parameter p_Return_Status as logical init no no-undo.

/* ADE Stanards Include */
{ adecomm/adestds.i }
IF NOT initialized_adestds
THEN RUN adecomm/_adeload.p.

/* Help Context */
{ adecomm/commeng.i }


&IF "{&WINDOW-SYSTEM}" = "TTY" &THEN
&GLOBAL List_Phrase    single sort size 30 by 8 scrollbar-v
&ELSE
&GLOBAL List_Phrase    single sort size 30 by 6 scrollbar-v
&ENDIF

define var v_PickDir  as char 
    view-as selection-list {&List_Phrase} .
define var v_PickFile as char 
    view-as selection-list {&List_Phrase} .

define var v_Type     as char no-undo.
define var v_InFile   as char no-undo.
define var v_InAttr   as char no-undo.
define var v_TmpDir   as char no-undo.
define var v_TmpFilt  as char no-undo.

define var Help_Context as integer no-undo.
define var File_Name  as char no-undo.
define var t_log      as log  no-undo.
define var Status_Line as char format "x(60)" no-undo.

define button b_ok     label "OK"
    {&STDPH_OKBTN} AUTO-GO.
define button b_cancel label "Cancel"
    {&STDPH_OKBTN} AUTO-ENDKEY.
define button b_help label "&Help"
    {&STDPH_OKBTN}.


/* Dialog Button Box */
&IF {&OKBOX} &THEN
DEFINE RECTANGLE FC_Btn_Box    {&STDPH_OKBOX}.
&ENDIF

/* Dialog Box */    
FORM
    SKIP( {&TFM_WID}  )
  "File Name:" {&AT_OKBOX} VIEW-AS TEXT
    SKIP( {&VM_WID} )
  p_File {&AT_OKBOX}  FORMAT "x({&PATH_WIDG})"
    VIEW-AS FILL-IN SIZE 60 BY 1
    SKIP( {&VM_WIDG} )
  p_Dir {&AT_OKBOX} FORMAT "x({&PATH_WIDG})" NO-LABEL VIEW-AS FILL-IN SIZE 60 BY 1 
    SKIP( {&VM_WIDG} )
  "Files:" {&AT_OKBOX} VIEW-AS TEXT 
  "Directories:" at 33 VIEW-AS TEXT
    SKIP( {&VM_WID} )
  v_PickFile {&AT_OKBOX} v_PickDir
    { adecomm/okform.i
        &BOX    ="FC_Btn_Box"
        &OK     ="b_OK"
        &CANCEL ="b_Cancel"
        &HELP   ="b_Help"
    }
  Status_Line
  with frame filecomm no-label TITLE p_Title overlay
       view-as dialog-box
               DEFAULT-BUTTON b_OK
               CANCEL-BUTTON  b_Cancel.
    { adecomm/okrun.i
        &FRAME  = "FRAME filecomm"
        &BOX    = "FC_Btn_Box"
        &OK     = "b_OK"
        &CANCEL = "b_Cancel"
        &HELP   = "b_Help"
    }



/******************* Trigger Section *******************/
on help of frame filecomm anywhere
  RUN adecomm/_adehelp.p
      ( INPUT "comm" ,
        INPUT "CONTEXT" , INPUT Help_Context , INPUT ? ).

on choose of b_help in frame filecomm
  RUN adecomm/_adehelp.p
      ( INPUT "comm" ,
        INPUT "CONTEXT" , INPUT Help_Context , INPUT ? ).

on window-close of frame filecomm
   OR choose of b_cancel in frame filecomm
do:
  p_File = ?.
  p_Return_Status = NO.
end.

on return,enter of p_File in frame filecomm
do:
  apply "go" to frame filecomm.
  return no-apply.
end.

on go of frame filecomm 
do:
  def var Fullpath as char.
  def var ok_overwrite as logical.
  def var v_dirname as char.
  def var v_basename as char.
  def var cSubDir as char no-undo.
  def var cFile as char no-undo.
  def var cTmp as char no-undo.

  assign v_TmpDir  = p_Dir:SCREEN-VALUE in frame filecomm 
         v_TmpFilt = TRIM( p_File:SCREEN-VALUE in frame filecomm )
         File_Name = TRIM( p_File:SCREEN-VALUE in frame filecomm )
         .

  /* If we drop all the way through, then return status = true and we're out. */

  /* First, check if user entered a file spec to update lists. */
  if ( INDEX( v_TmpFilt , "*" ) > 0 )
  then do:
    /* Check for entry of the form dir/filter. Split out dirname from
       filter and process. */                                   
    run adecomm/_osprefx.p ( input v_TmpFilt , output v_dirname ,
                              output v_basename ).
    if not ( v_TmpFilt begins "*" )
    then do:
      assign file-info:file-name =  v_dirname.

      if ( file-info:full-pathname = ? ) or
         ( index( file-info:file-type , "D" ) = 0 ) or
         ( index(file-info:file-type , "R") = 0 )
      then do:
          message File_Name skip
                  "Path does not exist or cannot be read." SKIP(1)
                  "Please verify that the correct path is given."
                  view-as alert-box warning buttons ok.
          apply "entry" to p_File in frame filecomm.
          return no-apply.
      end.
    end.

    assign
      p_Dir    = if v_TmpFilt begins "*"
                 then v_TmpDir
                 else v_dirname
      v_TmpFilt = SUBSTRING(v_TmpFilt,INDEX(v_TmpFilt,"*":u),-1,"CHARACTER":u)
      p_Filter  = v_TmpFilt
      p_File:SCREEN-VALUE in frame filecomm = p_Filter
    . /* end assign */
    run FillLists.ip.
    apply "entry" to p_File in frame filecomm.
    return no-apply.
  end.

  /* If user entered a dir name, go read it. */
  assign file-info:file-name = File_Name.
  if ( index( file-info:file-type , "D" ) > 0 )
  then do:
    if ( index(file-info:file-type , "R") = 0 )
    then do:
        message File_Name skip
                "Cannot read this directory."
                view-as alert-box warning buttons ok.
        return no-apply.
    end.
    assign p_Dir = file-info:full-pathname 
           p_File:SCREEN-VALUE in frame filecomm = p_Filter
    .
    run FillLists.ip.
    apply "entry" to p_File in frame filecomm.
    return no-apply.
  end.

  /* Otherwise...*/
  /* User entered file name, so try and complete open or save as. */
  do:
      case p_Save_As :
        when NO     /* FILE OPEN */
        then do:

           assign file-info:filename = File_Name.

           /* If these are equal, then user entered a full pathname.
              Else, user entered relative pathname, which we concatenate
              with the current directory in the dialog.
           */
           if ( file-info:filename = file-info:full-pathname )
           then assign Fullpath = file-info:full-pathname.
           else
           do:
             run adecomm/_osfmush.p ( INPUT v_TmpDir  ,
                                      INPUT File_Name ,
                                      OUTPUT Fullpath ).
             assign file-info:file-name = FullPath.
             if file-info:file-name <> ? then
               assign File_Name = FullPath.
           end.
           
           /* Open, but can we find it? */
           if can-do( p_Options , "MUST-EXIST" ) and
              ( file-info:full-pathname = ? ) then
           do:
              message v_TmpFilt SKIP
                "Cannot find this file." SKIP(1)
                "Please verify that the correct path and filename are given."
                view-as alert-box warning buttons ok.
              apply "entry" to p_File in frame filecomm.
              return no-apply.
           end.
           assign p_File:SCREEN-VALUE in frame filecomm = File_Name.
        end.

        when YES    /* FILE SAVE-AS */
        then do: 
          /* Save as, so check if file already exists and warn user. */
          assign file-info:filename = File_Name.
          /* file already exists */
          if ( file-info:full-pathname <> ? )
          then do:

          /* If these are equal, then user entered a full pathname.
             Else, user entered relative pathname, which we concatenate
             with the current directory in the dialog.
          */
          if ( file-info:filename = file-info:full-pathname )
          then assign Fullpath = file-info:full-pathname.
          else
               run adecomm/_osfmush.p
                   ( INPUT v_TmpDir  , 
                     INPUT v_TmpFilt ,
                     OUTPUT Fullpath ).

          assign File_Name = FullPath
                 File-Info:file-name = File_Name.

          if can-do( p_Options , "ASK-OVERWRITE" ) and
              ( file-info:full-pathname <> ? )
           then do:
              assign ok_overwrite = no.
              message File_Name SKIP
                      "This file already exists." SKIP(1)
                      "Replace existing file?"
                       view-as alert-box warning buttons yes-no 
                               update ok_overwrite.
              if ok_overwrite <> true
              then do:
                  apply "entry" to p_File in frame filecomm.
                  return no-apply.
              end.
            end.
          end. /* <> ? */
          else
          /* file doesn't exist on disk yet */
          do:
              /* separate the path from the actual file name */
              run adecomm/_osprefx.p (File_Name, output cSubDir, output cFile).
              
              /* If no path typed in, add selected path and file to create filename */
              if cSubDir eq '':u then
                  run adecomm/_osfmush.p ( v_TmpDir, File_Name, OUTPUT File_Name ).
              else
              /* some path info typed in */
              do: 
                  /* The path from _osprefx has a trailing directory separator.
                     file-info:full-pathname doesn't, so our comparison won't work
                     unless its removed.
                     Also make everything forward slash for ease of comparison. */                 
                  cSubDir = replace(cSubDir, '~\', '/').
                  cSubDir = right-trim(cSubDir, '/').
                  
                  file-information:file-name = cSubDir.
                  cTmp = replace(file-information:full-pathname, '~\', '/').
                  
                  /* If a full path typed in, use that, in the form of File_Name.
                     If not, add relative path to selected path. */
                  if cTmp ne cSubDir then
                      run adecomm/_osfmush.p ( v_TmpDir, File_Name, OUTPUT File_Name ).
              end.    /* some pathing */
          end.    /* file doesn't exist */
           
           assign p_File:SCREEN-VALUE in frame filecomm = File_Name.
        end. /* when YES */

      end case.

  end.

  p_Return_Status = YES.
end.

on value-changed of v_PickFile in frame filecomm
do:
    IF ( v_PickFile:SCREEN-VALUE  = "" ) OR ( v_PickFile:SCREEN-VALUE = ? )
    THEN RETURN NO-APPLY.
    ASSIGN p_File:SCREEN-VALUE = v_PickFile:SCREEN-VALUE.
end.

on default-action of v_PickFile in frame filecomm
do:
  define var Fullpath as char no-undo.

  if v_PickFile:SCREEN-VALUE in frame filecomm = ""
    OR v_PickFile:SCREEN-VALUE in frame filecomm = ? 
    THEN RETURN NO-APPLY.

  assign v_TmpDir  = p_Dir:SCREEN-VALUE in frame filecomm
         File_Name = TRIM( v_PickFile:SCREEN-VALUE in frame filecomm )
         .
  run adecomm/_osfmush.p
      (  v_TmpDir  ,
         File_Name ,
         OUTPUT Fullpath ).
  p_File:SCREEN-VALUE in frame filecomm = Fullpath.
  IF SESSION:WINDOW-SYSTEM = "TTY"
    THEN apply "GO" to frame filecomm.
end.
  
on default-action of v_PickDir in frame filecomm
do:
  if can-do(OS-DRIVES , v_PickDir:SCREEN-VALUE in frame filecomm )
  then do:
    p_Dir = v_PickDir:SCREEN-VALUE .
  end.
  else do: 
    run adecomm/_osfmush.p
         (p_Dir, v_PickDir:SCREEN-VALUE in frame filecomm , 
          OUTPUT p_Dir).
  end.

  ASSIGN FILE-INFO:FILENAME = p_Dir NO-ERROR.
  ASSIGN p_Dir = FILE-INFO:FULL-PATHNAME.

  if p_Dir = ? or p_Dir = "" then return.

  run FillLists.ip.
  if v_PickDir:SENSITIVE in frame filecomm
  then apply "entry" to v_PickDir in frame filecomm.
  
end.

/******************* Internal Procedures ***************/

procedure FillLists.ip:
  /* use a temporary filter with . escaped */
  define var v_TmpFilter as char.
  
  do with frame filecomm:

  v_TmpFilter = TRIM( p_File:SCREEN-VALUE ).
  /* First, check if user entered a file spec to update lists. */
  if ( INDEX( v_TmpFilter , "*" ) > 0 )
  then do:
    assign p_Filter       = v_TmpFilter
           v_TmpFilter    = REPLACE( p_Filter    , "." , "~~." )
    . /* end assign */
  end.
  else assign v_TmpFilter = REPLACE( p_Filter    , "." , "~~." ).
  
  Status_Line:SCREEN-VALUE = "Reading directory...".

  ASSIGN
     v_PickFile:VISIBLE = no
     v_PickDir:VISIBLE = no
     t_log = v_PickDir:DELETE(v_PickDir:LIST-ITEMS )
     t_log = v_PickFile:DELETE(v_PickFile:LIST-ITEMS )
     . /* end assign */

  /* Set dialog current working dir to root (drive:\.) if at drive level. */
  if CAN-DO(OPSYS,"MSDOS,WIN32") and can-do(OS-DRIVES , p_Dir ) then
  do:
    assign p_Dir = p_Dir + "~\".
  end.

  if ( OPSYS = "VMS" ) then
    assign t_log = v_PickDir:ADD-LAST("[.-]").

  input from os-dir(p_Dir).
  repeat:
    import v_InFile ^ v_InAttr.
    
/*    IF v_InFile = "." THEN NEXT. */
    IF INDEX(v_InAttr,"D") > 0 THEN
    DO:
        IF OPSYS = "VMS" THEN
          ASSIGN v_InFile = SUBSTRING(v_InFile,1,INDEX(v_InFile,".":u) - 1, 
                                      "CHARACTER":u)
                 v_InFile = "[." + v_InFile + "]"
          . /* END ASSIGN */
        t_log = v_PickDir:ADD-LAST(v_InFile).
    END.
    ELSE
    IF ( INDEX(v_InAttr , "F") > 0 and  /* Be sure its a file and not X. */
          v_Infile Matches v_TmpFilter ) THEN
    DO:
        ASSIGN t_log = v_PickFile:ADD-LAST(v_InFile).
    END.
  END.

  IF OS-DRIVES <> "" THEN
    ASSIGN t_log = v_PickDir:ADD-LAST( REPLACE(OS-DRIVES, "," , CHR(10)) ).

  /* Assign using no-error in case LIST-ITEMS is ? (empty). Avoids
     Progress list error about invalid arguments in ENTRY.
  */
  t_log = v_PickFile:SCROLL-TO-ITEM( v_PickFile:ENTRY(1) ) no-error.

  t_log = v_PickDir:SCROLL-TO-ITEM( v_PickDir:ENTRY(1) ) no-error.

  ASSIGN v_PickFile:VISIBLE = yes.
  ASSIGN v_PickDir:VISIBLE  = yes.

  display p_Dir.
  assign Status_Line:SCREEN-VALUE = "".
  
  end. /* do with frame filecomm */
END.
/******************* Main Line Code ********************/


if ( p_Title = "" )
then do:
  v_Type  = IF p_Save_As THEN "Save As" ELSE "Open".
  p_Title = v_Type.
end.

if ( p_Filter = "" )
then do:
  p_Filter = if can-do(opsys, "MSDOS,WIN32":u)
             then "*.*"
             else "*".
end.
if ( p_Save_As = NO ) AND ( p_File = "" )
then p_File = p_Filter.

/* If passed an initial-dir, check 1) If its a dir, and 2) can-find. */
if ( p_Dir <> "" )
then do:
  assign file-info:filename = p_Dir
         p_Dir              = file-info:full-pathname.
  if ( index( file-info:file-type , "D" ) = 0 ) /* not a directory */
     or
     ( p_Dir = ? )                              /* not found */
  then p_Dir = "".
end.

if ( p_Dir = "" )
then do:
  /* Initialize dir to root for the current drive. If no drive specified,
     initialize dir to current working dir (.) . */
  p_Dir = IF ( p_Drive <> "" )
          THEN ( p_Drive + "~\" + "." )
          ELSE IF ( OPSYS = "VMS" ) THEN "[]" ELSE "." .
  FILE-INFO:FILENAME = p_Dir.
  p_Dir              = FILE-INFO:FULL-PATHNAME.
end.

/* Assign appropriate Help Context number for Save or Open. */
if p_Save_As
   then assign Help_Context = {&Chr_Save_As_Dlg_Box} .
   else assign Help_Context = {&Chr_Get_File_Dlg_Box} .

/* Change delimiter to non-printable so lists handle commas. */
assign v_PickDir:DELIMITER IN FRAME filecomm = CHR(10)
       v_PickFile:DELIMITER IN FRAME filecomm = CHR(10).

/* Fill the two lists */
run FillLists.ip.

display
  p_File
  with frame filecomm.

do on stop undo, retry on endkey undo, leave:

  if not retry 
  then do:
    set
      p_File
      v_PickFile v_PickDir
      b_ok b_Cancel b_Help {&WHEN_HELP}
      with frame filecomm.
    p_File = TRIM( p_File ).
  end.
  else do:
    p_File = ?.
    p_Return_Status = NO.
  end.
  
end.
/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/*----------------------------------------------------------------------------

File: _filter6.p

Description:
   This procedure is used against Progress V6 DICTDB (or earlier).
   The input is a RECID of a _FILE record and a filter string.  The
   output is YES or NO depending on whether the _FILE._FLD-MISC2[8]
   fields is in the filter string or not.
   (Note: _filter7.p is for DB's 7 or greater.)

Input Parameters:
   p_recid  - Recid of _FILE record
   p_filter - Comma delimited list of types to be filtered
             
Output Parameters:
   p_in     - Set to true if _FILE._FIL-MISC2[8] is in p_filter string.

Author: Ross Hunter

Date Created: 06/15/92 

----------------------------------------------------------------------------*/

DEFINE INPUT  PARAMETER p_recid   AS RECID           NO-UNDO.
DEFINE INPUT  PARAMETER p_filter  AS CHARACTER       NO-UNDO.
DEFINE OUTPUT PARAMETER p_in      AS LOGICAL         NO-UNDO.

FIND DICTDB._FILE WHERE RECID(DICTDB._FILE) = p_recid NO-LOCK.
p_in = CAN-DO(p_filter,DICTDB._FILE._FIL-MISC2[8]).
/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/*----------------------------------------------------------------------------

File: _filter7.p

Description:
   This procedure is used against Progress V7 DICTDB (or later).
   The input is a RECID of a _FILE record and a filter string.  The
   output is YES or NO depending on whether the _FILE._FOR-TYPE
   field is in the filter string or not.
   (Note: _filter6.p is for DB's 6 or earlier.)

Input Parameters:
   p_recid  - Recid of _FILE record
   p_filter - Comma delimited list of types to be filtered
             
Output Parameters:
   p_in     - Set to true if _FILE._FLD-MISC2[8] is in p_filter string.

Author: Ross Hunter

Date Created: 06/15/92 

----------------------------------------------------------------------------*/

DEFINE INPUT  PARAMETER p_recid   AS RECID           NO-UNDO.
DEFINE INPUT  PARAMETER p_filter  AS CHARACTER       NO-UNDO.
DEFINE OUTPUT PARAMETER p_in      AS LOGICAL         NO-UNDO.

FIND DICTDB._FILE WHERE RECID(DICTDB._FILE) = p_recid NO-LOCK.
p_in = CAN-DO(p_filter,DICTDB._FILE._FOR-TYPE).
/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/
/*----------------------------------------------------------------------------

File: _finddb.p

Description:
  Returns id of _db record if it exists in current database.

Input Parameters:
   p_DBName - Name of the _db record we are looking for.

Output Parameters:
   p_DBID   - Set to recid of _dbrecord

Author: Warren Bare

Date Created: 09/03/92

----------------------------------------------------------------------------*/


Define INPUT  PARAMETER p_DBName as character NO-UNDO.
Define OUTPUT PARAMETER p_DBID 	 as recid     NO-UNDO INIT ?.

FIND DICTDB._DB WHERE DICTDB._DB._DB-Name = p_DBName NO-LOCK NO-ERROR.

IF AVAILABLE DICTDB._DB THEN
  p_DBID = RECID(DICTDB._DB).

RETURN.
/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/
/*----------------------------------------------------------------------------

File: _findtbl.p

Description:
  Returns id of _File record if it exists in current database, and the
  id of the _db record that the _file record belongs to.

Input Parameters:
   p_TblName - Name of the _File record we are looking for.

Output Parameters:
   p_DBID   - Set to recid of _db record
   p_TblID  - Set to recid of _File record

Author: Warren Bare

Date Created: 09/03/92

----------------------------------------------------------------------------*/


Define INPUT  PARAMETER p_TblName as character NO-UNDO.
Define OUTPUT PARAMETER p_DBName  as char      NO-UNDO.
Define OUTPUT PARAMETER p_DBID    as recid     NO-UNDO INIT ?.
Define OUTPUT PARAMETER p_TblID   as recid     NO-UNDO INIT ?.

FOR EACH DICTDB._DB NO-LOCK,
    EACH DICTDB._File of DICTDB._DB 
         WHERE DICTDB._File._File-Name = p_TblName NO-LOCK:
  IF INTEGER(DBVERSION("DICTDB":U)) > 8 THEN DO:
    IF LOOKUP(DICTDB._FILE._OWNER,"PUB,_FOREIGN":U) = 0 THEN NEXT.
  END.

  ASSIGN
    p_DBName = (IF DICTDB._DB._db-name = ? THEN
    LDBNAME("DICTDB") ELSE DICTDB._DB._DB-name)
    p_DBID = RECID(DICTDB._DB)
    p_TblID = RECID(DICTDB._File).
  RETURN.
END.
/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/*----------------------------------------------------------------------------

File: fldlist.p

Description:
   Fill a selection list with fields.  The fields will be ordered either
   either alphabetically or by order #.
   The database that these fields are stored in must be aliased to
   to DICTDB before this routine is called.

Input Parameters:
   p_List   - Handle of the selection list widget to add to.
	      p_List:private-data is a comma seperated list of items
	      NOT to be added. OR no items if the entire table-list is
	      to be added.

   p_Recid  - The recid of the table to which these fields belong.
   p_Alpha  - true if order should be alphabetical, false if we want to
      	      order by the _Order value of the field.
   p_Items  - List of fields to included in list.  If this parameter is
              blank, then just the field name is put in the list.  Currently
              the parameter can have the following values in any order:
              1 - just the field name - then is the default
              2 - tablename.fldname
              3 - dbname.tablename.fldname
              T - Name of table containing the field
              F - Format
   p_DType  - The data type to screen for.  If this is ?, then don't screen.
      	      Otherwise this must be either
      	       	  "character"
      	       	  "date"
      	       	  "decimal"
      	       	  "integer"
      	       	  "logical"
      	       	  "recid"
   p_ExpandExtent  - true if the array extents are to be expanded [1-N].


  p_CallBack  - The name of the program to run for security of a "" to blow
              this callback off.


Output Parameters:
   p_Stat   - Set to true if list is retrieved (even if there were no fields
      	      this is successful).  Set to false, if user doesn't have access
      	      to fields.

Author: Laura Stern, Warren Bare

Date Created: 06/02/92 

----------------------------------------------------------------------------*/


Define INPUT  PARAMETER p_List         as widget-handle NO-UNDO.
Define INPUT  PARAMETER p_Recid        as recid     	 NO-UNDO.
Define INPUT  PARAMETER p_Alpha        as logical   	 NO-UNDO.
Define INPUT  PARAMETER p_Items        as character 	 NO-UNDO.
Define INPUT  PARAMETER p_DType        as character      NO-UNDO.
Define INPUT  PARAMETER p_ExpandExtent as logical   	 NO-UNDO.
Define INPUT  PARAMETER p_CallBack     as character   	 NO-UNDO.
Define OUTPUT PARAMETER p_Stat         as logical    	 NO-UNDO.

define variable expandOption as integer no-undo.

if p_ExpandExtent = true then expandOption = 1.
                         else expandOption = 0.

run adecomm/_getflst.p(p_list, p_Recid, ?,
                               p_Alpha,
                               p_Items,
                               p_Dtype,
                               expandOption,
                               p_Callback,
                               output p_Stat).

RETURN.


/*********************************************************************
* Copyright (C) 2000,2007 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/*----------------------------------------------------------------------------

File: fldsas.p  (field string attributes dialog box)
      	        *** Used for both GUI and Character Dictionaries ***

Description:   
   Display and handle the dialog box for specifying string attributes
   this field.

Input Parameter:
   p_ReadOnly  - True if box should be non-modifiable.
   p_Buf       - The database field buffer we're working on

Output Parameter:
   p_Modified  - Set to yes if a modification was made, no otherwise.

Author: Laura Stern

Date Created: 04/02/93 

History:    fernando   11/13/2007 Leave untouched fields alone - OE00150364

----------------------------------------------------------------------------*/
&GLOBAL-DEFINE WIN95-BTN YES
{adecomm/commeng.i}
{adecomm/adestds.i}

Define button btn_Ok     label "OK"     {&STDPH_OKBTN} AUTO-GO.
Define button btn_Cancel label "Cancel" {&STDPH_OKBTN} AUTO-ENDKEY.

&IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN 
   Define rectangle rect_Btns {&STDPH_OKBOX}.
   Define button    btn_Help label "&Help" {&STDPH_OKBTN}.

   &GLOBAL-DEFINE   HLP_BTN  &HELP = "btn_Help"
   &GLOBAL-DEFINE   CAN_BTN  /* we have one but it's not passed to okrun.i */
   &GLOBAL-DEFINE   RECT     &BOX = "rect_btns"
&ELSE
   &GLOBAL-DEFINE   HLP_BTN  /* no help for tty */
   &GLOBAL-DEFINE   CAN_BTN  &CANCEL = "btn_Cancel" /* so btn can be centered */
   &GLOBAL-DEFINE   RECT   
&ENDIF

Define INPUT  PARAMETER p_ReadOnly     as logical NO-UNDO.
Define 	      PARAMETER BUFFER  p_Buf  for _Field.
Define OUTPUT PARAMETER p_Modified     as logical NO-UNDO init no.

FORM
   SKIP({&TFM_WID})
   "String attribute options are:"      at 2 view-as TEXT SKIP
   "T, R, L, C, U and # of characters." at 2 view-as TEXT 
   SKIP({&VM_WIDG})

   p_Buf._Label-SA 	colon 21 label "&Label"      	 {&STDPH_FILL}
   SKIP({&VM_WID})

   p_Buf._Col-label-SA  colon 21 label "&Column Label" 	 {&STDPH_FILL}
   SKIP({&VM_WID})

   p_Buf._Format-SA	colon 21 label "&Format"     	 {&STDPH_FILL}
   SKIP({&VM_WID})

   p_Buf._Initial-SA	colon 21 label "&Initial Value"  {&STDPH_FILL}
   SKIP({&VM_WID})

   p_Buf._Help-SA	colon 21 label "Hel&p"     	 {&STDPH_FILL}
   SKIP({&VM_WID})

   p_Buf._Valmsg-SA	colon 21 label "&Validation Message" {&STDPH_FILL}

   {adecomm/okform.i
      {&RECT}
      &STATUS = no
      &OK     = btn_OK
      &CANCEL = btn_Cancel
      {&HLP_BTN}
   }

   with frame fld_string_attrs
   SIDE-LABELS 
   DEFAULT-BUTTON btn_OK CANCEL-BUTTON btn_Cancel
   view-as DIALOG-BOX TITLE "Field String Attributes".


/*--------------------------------Triggers-----------------------------------*/

&IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN 
/*----- HELP -----*/
on HELP of frame fld_string_attrs OR 
   choose of btn_Help in frame fld_string_attrs
   RUN "adecomm/_adehelp.p" (INPUT "comm", INPUT "CONTEXT", 
      	       	     	     INPUT {&Field_String_Attributes_Dlg_Box},
      	       	     	     INPUT ?).
&ENDIF


/*-----WINDOW-CLOSE-----*/
on window-close of frame fld_string_attrs
   apply "END-ERROR" to frame fld_string_attrs.


/*---- GO or OK -----*/
on GO of frame fld_string_attrs
do:
   DO ON ERROR UNDO, LEAVE:
      assign 
	 p_Buf._Label-SA
	 p_Buf._Valmsg-SA
      	 p_Buf._Col-label-SA
      	 p_Buf._Format-SA
      	 p_Buf._Initial-SA
      	 p_Buf._Help-SA.
      return.
   END.

   /* error occurred */
   apply "entry" to p_Buf._Label-SA in frame fld_string_attrs.
   return no-apply.  
end.


/*------------------------------Mainline Code--------------------------------*/

/* Run time layout for button area. */
{adecomm/okrun.i  
   &FRAME = "frame fld_string_attrs" 
   &BOX   = "rect_Btns"
   &OK    = "btn_OK" 
   {&CAN_BTN}
   {&HLP_BTN}
}

display (if p_Buf._Label-SA = ? then "" else p_Buf._Label-SA)
      	    @ p_Buf._Label-SA
      	(if p_Buf._Col-label-SA = ? then "" else p_Buf._Col-label-SA)
      	    @ p_Buf._Col-label-SA
      	(if p_Buf._Format-SA = ? then "" else p_Buf._Format-SA)
      	    @ p_Buf._Format-SA
      	(if p_Buf._Initial-SA = ? then "" else p_Buf._Initial-SA)
      	    @ p_Buf._Initial-SA
      	(if p_Buf._Help-SA = ? then "" else p_Buf._Help-SA)
      	    @ p_Buf._Help-SA
      	(if p_Buf._Valmsg-SA = ? then "" else p_Buf._Valmsg-SA)
      	    @ p_Buf._Valmsg-SA
      	with frame fld_string_attrs.

do ON ERROR UNDO,LEAVE  ON ENDKEY UNDO,LEAVE:
   /* Do the actual field assignment in GO trigger instead of using 
      update so that if an error occurs, the dialog won't flash.
   */
   enable p_Buf._Label-SA   	 when NOT p_ReadOnly
	  p_Buf._Col-label-SA  	 when NOT p_ReadOnly
	  p_Buf._Format-SA	 when NOT p_ReadOnly
	  p_Buf._Initial-SA	 when NOT p_ReadOnly
	  p_Buf._Help-SA	 when NOT p_ReadOnly
	  p_Buf._Valmsg-SA	 when NOT p_ReadOnly
      	  btn_OK  	      	 when NOT p_ReadOnly
      	  btn_Cancel
      	  &IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN 
      	  btn_Help
      	  &ENDIF
      	  with frame fld_string_attrs.

   wait-for choose of btn_OK in frame fld_string_attrs OR 
      	    GO of frame fld_string_attrs
      	    focus p_Buf._Label-SA.

   /* leave any untouched field alone */
   IF NOT p_ReadOnly THEN DO:
        IF p_Buf._Label-SA = "" THEN
           p_Buf._Label-SA = ?.
        IF p_Buf._Col-label-SA  = "" THEN
           p_Buf._Col-label-SA  = ?.
        IF p_Buf._Format-SA = "" THEN
           p_Buf._Format-SA = ?.
        IF p_Buf._Initial-SA = "" THEN
           p_Buf._Initial-SA = ?.
   END.
   p_Modified = yes.
end.

hide frame fld_string_attrs.
hide message no-pause.
/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/
/*----------------------------------------------------------------------------

File: _fldsel.p

Description:
  Allows a user to select a database, a table, then a list of fields in that
  table.  The database is defaulted to whatever dictdb is pointing to at the
  time.

INPUT Parameters
p_Multi    - Should they be allowed to select multiple items.
p_DType    - The data type to screen for.  If this is ?, then don't screen.
                    Otherwise this must be either
                     "character"
                     "date"
                     "decimal"
                     "integer"
                     "logical"
                     "recid"
p_TT       - ? if temp-tables need to be included
             Otherwise a comma delitted list where each entry has the form:
             _like-db._like-table|_name
             The _like-db and _like-table are real database.table combinations
             and _name is either the name of the temp-table that is like
             _like-table or ? if it is the same.

INPUT-OUTPUT Parameters
p_Prefix   - Determines prefix options on output strings
                     ? - Don't show option
                     0 - none
                     1 - table
                     2 - database[.table]
p_DBName   - The name of the database the schema was picked from.  May 
             optionally be passed in to default the database.
p_TblName  - The name of the table selection.  Optional to pass in default.
p_FldNames - A comma list of selected fields.  Optional to pass in default.

OUTPUT Parameters
p_OK       - Did they press OK to get out?

Author:   Ross Hunter
Created:  08/10/95 
Modified: 09/22/99 adams    Refound s_ttb_db after opening query.

----------------------------------------------------------------------------*/

/* ADE Standards Include */
&GLOBAL-DEFINE WIN95-BTN YES
{adecomm/adestds.i}
{adecomm/getdbs.i &NEW="NEW"}
{adecomm/tt-brws.i "NEW"}

&global-define TCOL  20
&global-define FCOL  40
&global-define BCOL  61

IF NOT initialized_adestds
   THEN RUN adecomm/_adeload.p.

{adecomm/commeng.i}  /* Help contexts */

DEFINE INPUT        PARAMETER p_Multi    AS LOGICAL   NO-UNDO.
DEFINE INPUT        PARAMETER p_DType    AS CHARACTER NO-UNDO.
DEFINE INPUT        PARAMETER p_TT       AS CHARACTER NO-UNDO.
DEFINE INPUT-OUTPUT PARAMETER p_Prefix   AS INTEGER   NO-UNDO.
DEFINE INPUT-OUTPUT PARAMETER p_DBName   AS CHARACTER NO-UNDO.
DEFINE INPUT-OUTPUT PARAMETER p_TblName  AS CHARACTER NO-UNDO.
DEFINE INPUT-OUTPUT PARAMETER p_FldName  AS CHARACTER NO-UNDO.
DEFINE OUTPUT       PARAMETER p_OK       AS LOGICAL   NO-UNDO INITIAL FALSE.

DEFINE VARIABLE h_fld_brws  AS HANDLE    NO-UNDO.
DEFINE VARIABLE h_tbl_brws  AS HANDLE    NO-UNDO.
DEFINE VARIABLE ix          AS INTEGER   NO-UNDO.
DEFINE VARIABLE new-proc    AS HANDLE    NO-UNDO.
DEFINE VARIABLE old-proc    AS HANDLE    NO-UNDO.
DEFINE VARIABLE repos       AS RECID     NO-UNDO INITIAL ?.
DEFINE VARIABLE t_char      AS CHARACTER NO-UNDO.
DEFINE VARIABLE t_int       AS INTEGER   NO-UNDO.
DEFINE VARIABLE t_log       AS LOGICAL   NO-UNDO.
DEFINE VARIABLE tbl-col     AS DECIMAL   NO-UNDO INITIAL {&TCOL}.
DEFINE VARIABLE v_access    AS LOGICAL   NO-UNDO.
DEFINE VARIABLE v_OldDictDb AS CHARACTER NO-UNDO INITIAL ?.  /* saved name of dictdb */
DEFINE VARIABLE v_PfixLbl   AS CHARACTER NO-UNDO INITIAL "Prefix:". 
DEFINE VARIABLE v_TblID     AS RECID     NO-UNDO.
DEFINE VARIABLE v_Type      AS CHARACTER NO-UNDO.

DEFINE BUTTON b_all_flds label "&Select All"    SIZE 15.00 BY 1.125.
DEFINE BUTTON b_cancel   label "Cancel"   {&STDPH_OKBTN} AUTO-ENDKEY.
DEFINE BUTTON b_Help     label "&Help"    {&STDPH_OKBTN}.
DEFINE BUTTON b_ok       label "OK"       {&STDPH_OKBTN} AUTO-GO.
DEFINE BUTTON b_no_flds  label "&Deselect All"  SIZE 15.00 BY 1.125.
define variable xTitle   as character no-undo init "Field Selector" .
DEFINE QUERY  db-browse FOR s_ttb_db.
DEFINE BROWSE db-browse QUERY db-browse NO-LOCK
       DISPLAY s_ttb_db.ldbnm FORMAT "X(40)"
    WITH NO-ROW-MARKERS NO-COLUMN-SCROLLING SIZE 16.5 BY 6.9 NO-LABELS.

/* Dialog Button Box */
&IF {&OKBOX} &THEN
DEFINE RECTANGLE FS_Btn_Box    {&STDPH_OKBOX}.
&ENDIF

/* Dialog Box */    
FORM 
  SKIP( {&TFM_WID} )
  "Databases:"  AT 2        VIEW-AS TEXT
  "Tables:"     AT {&TCOL}  VIEW-AS TEXT
  "Fields:"     AT {&FCOL}  VIEW-AS TEXT 
  v_Type FORMAT "x(12)"     VIEW-AS TEXT NO-LABEL
  SKIP( {&VM_WID} )

  db-browse     AT 2
  SKIP( {&VM_WIDG} )

  p_Prefix      AT 2
                LABEL "&Prefix"
                             view-as radio-set horizontal SIZE 42 BY 1.1
                             radio-buttons "None",0,"Table",1,"Database.Table",2
  { adecomm/okform.i
        &BOX    ="FS_Btn_Box"
        &OK     ="b_OK"
        &CANCEL ="b_Cancel"
        &HELP   ="b_Help" 
  }

  b_all_flds    AT ROW-OF db-browse COL {&BCOL}
  SKIP( {&VM_WID} )

  b_no_flds     AT {&BCOL}

  with frame schemapk 
       side-labels 
       &IF "{&WINDOW-SYSTEM}" = "OSF/Motif":u &THEN WIDTH 81 &ENDIF
       &if DEFINED(IDE-IS-RUNNING) = 0 &THEN
       view-as dialog-box 
       title xTitle
       &else
       no-box three-d  
       &endif
       DEFAULT-BUTTON b_OK
       CANCEL-BUTTON  b_Cancel.


ASSIGN
   FRAME schemapk:HIDDEN = TRUE
&if DEFINED(IDE-IS-RUNNING) = 0 &THEN  
   FRAME schemapk:PARENT = active-window
&endif
   NO-ERROR.

/*-------------------------------Triggers------------------------------------*/

/*----- HELP -----*/
ON HELP OF FRAME schemapk OR CHOOSE of b_Help IN FRAME schemapk
   RUN "adecomm/_adehelp.p" (INPUT "comm", INPUT "CONTEXT", 
                                               INPUT {&Field_Selection},
                                               INPUT ?).

/*-----WINDOW-CLOSE-----*/
ON WINDOW-CLOSE OF FRAME schemapk DO:
  APPLY "END-ERROR":U TO SELF.
END.

/*----- SELECTION of OK BUTTON or GO -----*/
ON GO OF FRAME schemapk DO:
  RUN load-private-data IN old-proc.

  DEFINE VARIABLE db   AS CHARACTER NO-UNDO.
  DEFINE VARIABLE tbl  AS CHARACTER NO-UNDO.
  DEFINE VARIABLE flds AS CHARACTER NO-UNDO.
  DEFINE VARIABLE fld  AS CHARACTER NO-UNDO.
  DEFINE VARIABLE cIdx  AS CHARACTER NO-UNDO.
  DEFINE VARIABLE iIdx  as integer no-undo.
  DEFINE VARIABLE prfx AS CHARACTER NO-UNDO.

  IF p_Prefix <> ? THEN p_Prefix = INPUT FRAME schemapk p_Prefix.

  ASSIGN db        = s_ttb_db.ldbnm
         tbl       = h_tbl_brws:PRIVATE-DATA
         flds      = h_fld_brws:PRIVATE-DATA
         p_ok      = TRUE
         p_DBName  = db
         p_TblName = IF p_Prefix = 2 THEN db + "." + tbl
                                     ELSE tbl
         p_FldName = ""
         prfx      = (IF p_Prefix = 0 THEN ""              ELSE
                      IF p_Prefix = 1 THEN tbl + "."       ELSE
                      IF p_Prefix = 2 THEN p_TblName + "." ELSE
                        /* NEVER HAPPENS */  "").

  DO t_int = 1 TO NUM-ENTRIES(flds):
    ASSIGN fld = prfx + ENTRY(t_int,flds)
           p_FldName = IF t_int = 1 THEN fld
                       ELSE (p_FldName + ",":U + fld).

    IF fld MATCHES ("*[*]*":u) THEN DO:
      ASSIGN
         fld  = TRIM(Fld)
         cIdx = SUBSTRING(Fld,INDEX(Fld,'[':u)   + 1,-1,"CHARACTER":u)
         cIdx = SUBSTRING(cIdx,INDEX(cIdx,'-':u) + 1,-1,"CHARACTER":u)
         cIdx = REPLACE(cIdx,"]":u,"")
         Fld  = SUBSTRING(Fld,1,INDEX(Fld,'[':u) - 1,"CHARACTER":u).

      IF (NOT p_Multi) THEN DO:
        RUN adecomm/_selindx.p (CAPS(fld), INTEGER (cIdx), OUTPUT iIdx).
        IF iIdx = 0 THEN RETURN NO-APPLY.
        ASSIGN ENTRY (t_int, p_FldName) = Fld + '[' + STRING (iIdx) + ']'.
      END.  /* Only one element */
      ELSE
      DO iIdx = 1 TO INTEGER (cIdx):
        IF iIdx = 1 THEN
            ASSIGN ENTRY (NUM-ENTRIES(p_FldName) , p_FldName) =
                        Fld + '[' + STRING (iIdx) + ']'.
        ELSE
            ASSIGN p_FldName =
                        p_FldName + ',' + Fld + '[' + STRING (iIdx) + ']'.
      END.  /* Expand the entire array */
    END.  /* If an array */
  END.  /* DO t_int 1 to NUM-ENTRIES */
END.  /* ON GO OF FRAME schemapk */


/*----- DEFAULT-ACTION of fld_browse -------*/
PROCEDURE field-browse-def-act.
  APPLY "GO" TO FRAME schemapk.
END.

/*----- SELECT ALL FIELDS BUTTON -----*/
ON CHOOSE OF b_all_flds IN FRAME schemapk RUN select-all IN old-proc.


/*----- DE-SELECT ALL FIELDS BUTTON -----*/
ON CHOOSE OF b_no_flds IN FRAME schemapk DO:
  t_log = h_fld_brws:DESELECT-ROWS().
END.


/*----- VALUE-CHANGED of DB LIST -----*/
ON VALUE-CHANGED OF db-browse IN FRAME schemapk DO:
  RUN load_tables (INPUT "":U).
END.

/*----- VALUE-CHANGED of TBL LIST ----- */    /*
ON VALUE-CHANGED OF v_PickTbl IN FRAME schemapk DO:
  IF /* v_PickDB:screen-value in frame schemapk = ? OR DRH */
     v_PickTbl:screen-value in frame schemapk = ? THEN DO:
    IF VALID-HANDLE(old-proc) THEN DELETE PROCEDURE old-proc.
    RETURN.
  END.
  
  /* get the id of the table they picked */
  v_TblID = ?.
  run adecomm/_gttblid.p (s_ttb_db.dbrcd,v_PickTbl:screen-value,OUTPUT v_TblID).

  /* if we could not find the id, we got a problem */
  if v_TblID = ? then do:
    RUN adecomm/_s-alert.p (input-output t_log,"information":u,"ok":u,
      SUBSTITUTE("Table &1 was not found.", INPUT v_PickTbl:screen-value)).
    RETURN NO-APPLY.  /* no read permission on fields */
  END.
   
  v_PickFld:list-items in frame schemapk = "".  /* clear the list first */
  RUN adecomm/_fldlist.p (v_PickFld:HANDLE in frame schemapk, v_TblID,
      Yes, "", p_DType, Yes, "", OUTPUT  v_access).
  IF NOT v_access then return NO-APPLY.  /* no read permission on fields */

  /*
  ** Try to set the default fields in this table.  t_char is the list
  ** of default items that appear in the list.
  */
  t_char = "".
  do t_int = 1 to num-entries(p_FldName):
    IF CAN-DO(v_PickFld:LIST-ITEMS,ENTRY(t_int,p_FldName)) THEN DO:
      t_char = t_char + ENTRY(t_int,p_FldName) + ",":u.
      if not p_Multi THEN leave. /* only add one if it is not a multi select */
    END.
  end.
  IF LENGTH(t_char,"CHARACTER":u) > 1 THEN
    ASSIGN
      SUBSTRING(t_char,LENGTH(t_char,"CHARACTER":u),1,"CHARACTER":u) = ""
      v_PickFld:SCREEN-VALUE = t_char.
  else
    /* just set selection to first field if there is one and if the user
       is NOT in multiselect mode (otherwise they will have to deselect
       that one). */
    if (v_PickFld:NUM-ITEMS > 0 AND v_PickFld:MULTIPLE eq no )
    then v_PickFld:screen-value = v_PickFld:ENTRY(1).
    else v_PickFld:screen-value = ?.
end.  */

/*----- DEFAULT-ACTION of FIELD LIST -----*/     /*
ON DEFAULT-ACTION OF v_PickFld DO:
   APPLY "GO" TO FRAME schemapk.
END.                                               */


/*----------------------------Mainline code----------------------------------*/

/* save the pointer to the current dictdb */
IF CONNECTED("dictdb":U) THEN
  v_olddictdb = LDBNAME("dictdb":U).

/* Make sure there is at least one database connected. */
IF NUM-DBS = 0 THEN DO:
  ASSIGN t_log = NO.
  RUN adecomm/_dbcnnct.p (
      INPUT "You must have at least one connected database to select fields.",
      OUTPUT t_log).
  IF t_log <> TRUE THEN RETURN.
END.

ASSIGN b_all_flds:hidden in frame schemapk = NOT p_Multi
       b_no_flds:hidden in frame schemapk  = NOT p_Multi.

IF NOT p_Multi THEN DO:
  IF p_DType = ? THEN
    ASSIGN v_type:WIDTH = 1
           FRAME schemapk:WIDTH = FRAME schemapk:WIDTH - b_all_flds:WIDTH - 2.
  ELSE FRAME schemapk:WIDTH = v_type:COLUMN + v_type:WIDTH + 1.
END.

&if defined(IDE-IS-RUNNING) &then
{adeuib/ide/dialoginit.i "frame schemapk:handle"} 
dialogService:View().
&endif

{ adecomm/okrun.i
    &FRAME  = "FRAME schemapk"
    &BOX    = "FS_Btn_Box"
    &OK     = "b_OK"
    &CANCEL = "b_Cancel"
    &HELP   = "b_Help"
}

/* Don't show prefix choice if ? */
IF p_Prefix = ? THEN p_Prefix:HIDDEN IN FRAME schemapk = TRUE.
                ELSE DISPLAY p_Prefix WITH FRAME schemapk.

/* Fill up the database selection list */
RUN adecomm/_getdbs.p.

/* Remove the TEMP-DB entry because it is only for creating temp-table
   Definitions */
FIND s_ttb_db WHERE s_ttb_db.ldbnm = "TEMP-DB":U NO-ERROR.
IF AVAILABLE s_ttb_db THEN DELETE s_ttb_db.

IF p_TT NE ? THEN DO:  /* Create psuedo db for temp-table definitions */
  CREATE s_ttb_db.
  ASSIGN s_ttb_db.ldbnm = "Temp-Tables":U
         s_ttb_db.sdbnm = s_ttb_db.ldbnm
         s_ttb_db.dbnr  = 99999
         s_ttb_db.empty = FALSE.
END.

/* Find correct s_ttb_db record. */
RUN findDb.
IF ERROR-STATUS:ERROR THEN RETURN.

OPEN QUERY db-browse FOR EACH s_ttb_db WHERE NOT s_ttb_db.empty.
t_log = db-browse:SET-REPOSITIONED-ROW(1,"CONDITIONAL":U).

/* Refind correct s_ttb_db record, since opening the query will reposition
   the s_ttb_db record cursor. */
RUN findDb.
IF ERROR-STATUS:ERROR THEN RETURN.

/* Open table browse */
RUN load_tables (INPUT p_TblName).

/* show data type over field list if we're screening by data type */
v_Type = (if p_DType = ? then "" else "(" + p_DType + ")").
DISPLAY v_Type WITH FRAME schemapk.
FRAME schemapk:HIDDEN = FALSE.

ENABLE
  db-browse
  b_all_flds   when p_Multi
  b_no_flds    when p_Multi
  p_Prefix     when p_Prefix <> ?
  b_ok
  b_cancel 
  b_Help       {&WEN_HELP}
  WITH FRAME schemapk.

/* See if we can select the default database */
IF repos NE ? THEN REPOSITION db-browse TO RECID repos.
ELSE t_log = db-browse:SELECT-ROW(1).

&SCOPED-DEFINE CANCEL-EVENT U2
{adeuib/ide/dialogstart.i b_ok b_cancel xtitle}
DO ON ERROR UNDO, LEAVE  ON ENDKEY UNDO, LEAVE:
   &if DEFINED(IDE-IS-RUNNING) = 0 &THEN    
   WAIT-FOR CHOOSE OF b_ok IN FRAME schemapk 
         OR GO OF FRAME schemapk.
   &ELSE
   WAIT-FOR CHOOSE OF b_ok IN FRAME schemapk 
         OR GO OF FRAME schemapk
         OR "{&CANCEL-EVENT}":U of this-procedure.
   if cancelDialog then undo, leave.
   &ENDIF
   
END.

HIDE FRAME schemapk.
IF VALID-HANDLE(old-proc) THEN DELETE PROCEDURE old-proc.
RETURN.

/**********************************************************************/
/*                      Internal Procedures                           */
/**********************************************************************/

PROCEDURE findDb:
/*------------------------------------------------------------------------------
  Purpose:    Assigns the current form buffer values in the enabled fields/
              objects to the SmartDataObject, the database, and/or to local 
              object variables.
  Parameters: <none>
  Notes:      Commonly used in a HTML Mapping object's process-web-request 
              procedure.
------------------------------------------------------------------------------*/
  FIND s_ttb_db WHERE s_ttb_db.ldbnm = p_DBName NO-ERROR.
  IF NOT AVAILABLE s_ttb_db OR s_ttb_db.empty THEN
    FIND FIRST s_ttb_db WHERE NOT s_ttb_db.empty NO-ERROR.
  IF AVAILABLE s_ttb_db THEN repos = RECID(s_ttb_db).     
  ELSE DO:
    /* It appears that no database has any tables.  This could be because
       the wrong database is currently dictdb.  Let make one attempt to fix
       this before giving up.                                              */
    db-search:
    REPEAT ix = 1 TO NUM-DBS:
      IF LDBNAME("DICTDB":U) = LDBNAME(ix) THEN LEAVE db-search.
      ELSE IF DBTYPE(ix) <> "PROGRESS" THEN NEXT db-search.
      ELSE DO:  /* This is a possibility - make it DICTDB and redo _getdbs */
         FOR EACH s_ttb_db WHERE s_ttb_db.ldbnm NE "Temp-Tables":U:
           DELETE s_ttb_db.
         END.  /* Delete loop */
         CREATE ALIAS DICTDB FOR DATABASE VALUE(LDBNAME(ix)).
         RUN adecomm/_getdbs.p.
         LEAVE db-search.
      END.  /* Else a possibility */
    END.  /* db-search: Repeat loop */
    FIND FIRST s_ttb_db WHERE NOT s_ttb_db.empty NO-ERROR.
    IF AVAILABLE s_ttb_db THEN repos = RECID(s_ttb_db).
    ELSE DO:  /* Give up */
      MESSAGE "No connected database has any tables." VIEW-AS ALERT-BOX ERROR.
      RETURN ERROR.
    END.  /* Else give up */
  END.  /* Else try again */
  
END PROCEDURE.

PROCEDURE load_tables:
/*------------------------------------------------------------------------------
  Purpose:    Populate shared browse tbl-browse based on fields from the db 
              pointed to by repos.  Initially select the tables based on the 
              value of ivalue, or if ivalue is "" then pick the first table in 
              tbl-browse for single select lists and no table for multiselect 
              lists.
  Parameters: ivalue
  Notes:      syntax: RUN load_tables.
------------------------------------------------------------------------------*/
  DEFINE INPUT PARAMETER ivalue  AS CHARACTER                    NO-UNDO.
  
  DEFINE VARIABLE cur-ent AS CHARACTER                           NO-UNDO.
  DEFINE VARIABLE r-table AS CHARACTER                           NO-UNDO.

  IF s_ttb_db.sdbnm NE "Temp-Tables":U THEN DO:
    IF LDBNAME("DICTDB":U) NE s_ttb_db.sdbnm THEN
      CREATE ALIAS DICTDB FOR DATABASE VALUE(s_ttb_db.sdbnm).
    
    /* if we could not find the id, we got a problem */
    IF s_ttb_db.dbrcd = ? THEN DO:
      t_log = FALSE.
      run adecomm/_s-alert.p
        (input-output t_log, "i", "ok",
        SUBSTITUTE("Database &1 was not found.", s_ttb_db.ldbnm)).
      IF VALID-HANDLE(old-proc) THEN DELETE PROCEDURE old-proc.
      RETURN.  /* no read permission on fields */
    END.

    /* Everything is in order, open the shared query for tbl-browse */
    RUN adecomm/_tfbrws.p PERSISTENT SET new-proc
           (INPUT FRAME schemapk:HANDLE,
            INPUT THIS-PROCEDURE,
            INPUT p_multi,
            INPUT db-browse:ROW,
            INPUT tbl-col,
            INPUT s_ttb_db.dbrcd,
            INPUT "BUFFER,FUNCTION,PACKAGE,PROCEDURE,SEQUENCE":U,
            INPUT ivalue,
            INPUT  p_DType,
            OUTPUT h_tbl_brws,
            OUTPUT h_fld_brws,
            OUTPUT v_access).
  END.  /* IF NOT TEMP-TABLES */
  ELSE DO:  /* Attempting to select from the temptables */
    /* User wants to select from defined temp tables.  Build temp table
       definitions needed to simulate tables and fields.               */
     
    /* First see if we have already built the temp-table info          */
    IF NOT CAN-FIND(FIRST _tt-tbl) THEN DO:
      DO ix = 1 TO NUM-ENTRIES(p_TT):
        CREATE _tt-tbl.
        ASSIGN cur-ent         = ENTRY(ix, p_TT)
               _tt-tbl.tt-name = ENTRY(2, cur-ent, "|":U)
               r-table         = ENTRY(2, ENTRY(1, cur-ent, "|":U), ".":U).
        IF _tt-tbl.tt-name = "?":U THEN _tt-tbl.tt-name = r-table.
        CREATE ALIAS "DICTDB":U FOR
               DATABASE VALUE(SDBNAME(ENTRY(1, cur-ent, ".":U))).
        /* Build the field records for this table */       
        RUN adecomm/_bldfld.w (INPUT RECID(_tt-tbl), INPUT r-table).
      END. /* Do ix = 1 to num-entries(p_TT) */
    END.  /* If we haven't already built these records */

    /* The table and field tt records are made, browse them */ 
    RUN adecomm/_ttfbrws.p PERSISTENT SET new-proc
           (INPUT FRAME schemapk:HANDLE,
            INPUT THIS-PROCEDURE,
            INPUT p_multi,
            INPUT db-browse:ROW,
            INPUT tbl-col,
            INPUT s_ttb_db.dbrcd,
            INPUT ivalue,
            INPUT  p_DType,
            OUTPUT h_tbl_brws,
            OUTPUT h_fld_brws,
            OUTPUT v_access).
  END.  /* If selecting from temptables */
          
  IF NOT v_access THEN DO:
    IF VALID-HANDLE(old-proc) THEN DELETE PROCEDURE old-proc.
    IF VALID-HANDLE(new-proc) THEN DELETE PROCEDURE new-proc.
    RETURN.  /* No read permission on fields */
  END.
  IF VALID-HANDLE(old-proc) THEN DELETE PROCEDURE old-proc.
  old-proc = new-proc.
  
END PROCEDURE.

/* _fldsel.p - end of file */
/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/
/*
 * _fldseld.p - Single Field Selector for Data-Fields. From _mfldsel.p.
 */

/*
p_TblList     -> list of dbname.tables that should be viewed in list 1 (the left
                 side)
                 Note: Leave blank ("") if selecting from a DataObject.
p_hDataObject -> handle to DataObject that should be viewed in list 1
p_TT          -> ? if no temp-tables need to be included
                 Otherwise a comma delitted list where each entry has the form:
                 _like-db._like-table|_name
                 The _like-db and _like-table are real database.table combinations
                 and _name is either the name of the temp-table that is like
                 _like-table or ? if it is the same.

p_Items       -> Either "1", "2", or "3".  This indicates the number of
      	          components that will be used in the select lists and in 
                 the output.  i.e., 1: field, 2: table.field, 3: db.table.field
p_Dlmtr       -> The delimiter of the p_Result List
p_DType    - The data type to screen for.  If this is ?, then don't screen.
                    Otherwise this must be either
                     "character"
                     "date"
                     "decimal"
                     "integer"
                     "logical"
                     "recid"
p_Result      -> input-output list of selected fields
*/

&GLOBAL-DEFINE WIN95-BTN YES
{adecomm/commeng.i}  /* Help contexts */
{adecomm/adestds.i}  /* Standard layout stuff, colors etc. */
{adecomm/tt-brws.i "NEW"}

DEFINE INPUT        PARAMETER p_TblLst AS CHARACTER NO-UNDO.
DEFINE INPUT        PARAMETER p_hDataObject AS WIDGET-HANDLE NO-UNDO.
DEFINE INPUT        PARAMETER p_TT     AS CHARACTER NO-UNDO.
DEFINE INPUT        PARAMETER p_Items  AS CHARACTER NO-UNDO.
DEFINE INPUT        PARAMETER p_Dlmtr  AS CHARACTER NO-UNDO.
DEFINE INPUT        PARAMETER p_DType  AS CHARACTER NO-UNDO.
DEFINE INPUT-OUTPUT PARAMETER p_Result AS CHARACTER NO-UNDO.

DEFINE VARIABLE stat          AS LOGICAL NO-UNDO. /* For status of widget methods */
DEFINE VARIABLE useDataObject AS LOGICAL NO-UNDO.
define variable xWinTitle as character no-undo init "Field Selector":t32. 
/*--------------------------------------------------------------------------*/

DEFINE VARIABLE v_SrcLst AS CHARACTER  NO-UNDO
  VIEW-AS SELECTION-LIST SINGLE SIZE 50 by 10 SCROLLBAR-V SCROLLBAR-H.

DEFINE VARIABLE cArrayEntry AS CHARACTER NO-UNDO.
DEFINE VARIABLE cArrayList  AS CHARACTER NO-UNDO.
DEFINE VARIABLE cTemp       AS CHARACTER NO-UNDO.
DEFINE VARIABLE first-time  AS LOGICAL   NO-UNDO.
DEFINE VARIABLE iArrayHigh  AS INTEGER   NO-UNDO.
DEFINE VARIABLE iArrayLow   AS INTEGER   NO-UNDO. 
DEFINE VARIABLE i           AS INTEGER   NO-UNDO.
DEFINE VARIABLE j           AS INTEGER   NO-UNDO.
DEFINE VARIABLE l_Cancel    AS LOGICAL   NO-UNDO.

DEFINE BUTTON qbf-ok   label "OK"      {&STDPH_OKBTN} AUTO-GO.
DEFINE BUTTON qbf-cn   label "Cancel"  {&STDPH_OKBTN} AUTO-ENDKEY.
DEFINE BUTTON qbf-hlp  label "&Help"   {&STDPH_OKBTN}.

/* Dialog Button Box */
&IF {&OKBOX} &THEN
   DEFINE RECTANGLE rect_Btn_Box {&STDPH_OKBOX}.
&ENDIF

DEFINE VARIABLE t_int AS INTEGER   NO-UNDO. /* scrap/loop */
DEFINE VARIABLE t_log AS LOGICAL   NO-UNDO. /* scrap/loop */

FORM 
  SKIP ({&TFM_WID})
  "Available Fields:":L31 AT 2 VIEW-AS TEXT
  SKIP({&VM_WID})

  v_SrcLst     	     	  AT 2 

  { adecomm/okform.i
      &BOX    ="rect_Btn_Box"
      &OK     ="qbf-ok"
      &CANCEL ="qbf-cn"
      &HELP   ="qbf-hlp" 
  }
  SKIP ({&VM_WID})
  WITH FRAME FldPicker NO-LABELS
  &if DEFINED(IDE-IS-RUNNING) = 0 &THEN
   TITLE xWinTitle
   VIEW-AS DIALOG-BOX
  &else
       no-box three-d  
  &endif  
   DEFAULT-BUTTON qbf-ok 
   CANCEL-BUTTON qbf-cn.
   
ASSIGN v_SrcLst:DELIMITER  = p_Dlmtr.


/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */

ON "GO" OF FRAME FldPicker
  OR DEFAULT-ACTION OF v_SrcLst  IN FRAME FldPicker
DO:
  DEFINE VARIABLE tmp-entry AS CHARACTER                             NO-UNDO.
  DEFINE VARIABLE i         AS INTEGER                               NO-UNDO.

  p_Result = (IF v_SrcLst:SCREEN-VALUE IN FRAME FldPicker = ?
              THEN ""
              ELSE v_SrcLst:SCREEN-VALUE IN FRAME FldPicker
              ).

  IF INDEX(p_TblLst,"Temp-Tables":U) > 0 THEN DO:
    DO i = 1 TO NUM-ENTRIES(p_Result, p_Dlmtr):
      tmp-entry = ENTRY(i, p_Result, p_Dlmtr).
      IF NUM-ENTRIES(tmp-entry,".":U) = 2 AND
         LOOKUP("Temp-Tables.":U + ENTRY(1, tmp-entry, ".":U), p_TblLst) > 0
      THEN ENTRY(i, p_Result, p_Dlmtr) = "Temp-Tables.":U + tmp-entry.
      ELSE IF NUM-ENTRIES(tmp-entry,".":U) = 1 /* Assume DataObject RowObject table. jep-code */
      THEN ENTRY(i, p_Result, p_Dlmtr) = "Temp-Tables.RowObject.":U + tmp-entry.
    END.  /* Do i = 1 to Num-Entries */
  END.  /* If  there are temp-tables in the initial table list */

END.  /* On GO of Frame FldPicker */

/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */

ON WINDOW-CLOSE OF FRAME FldPicker
   APPLY "END-ERROR" TO FRAME FldPicker.

/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
/* jep-unfinished - must change to Data_Field_Selection for help. */
ON HELP of FRAME FldPicker OR CHOOSE OF qbf-hlp IN FRAME FldPicker
   RUN "adecomm/_adehelp.p" (INPUT "comm", INPUT "CONTEXT", 
      	       	     	     INPUT {&Multi_Field_Selection},
      	       	     	     INPUT ?).


/*--------------------------------------------------------------------------*/
&if defined(IDE-IS-RUNNING) &then
{adeuib/ide/dialoginit.i "frame FldPicker:handle"} 
dialogService:View().
&endif

{ adecomm/okrun.i
    &FRAME  = "FRAME FldPicker"
    &BOX    = "rect_Btn_Box"
    &OK     = "qbf-ok"
    &HELP   = "qbf-hlp"
}

useDataObject = IF VALID-HANDLE(p_hDataObject) THEN TRUE ELSE FALSE.

/* JEP-UNFINISHED - _getdlst.p: should this support temp-tables? */
IF useDataObject THEN
    RUN adecomm/_getdlst.p
        (INPUT v_SrcLst:HANDLE,
         INPUT p_hDataObject,
         INPUT no,
         INPUT p_Items,
         INPUT p_DType,
         OUTPUT t_log).
/* Add temp-tables fields to the available list.
  This used to be an ELSE. I changed it to the IF check instead.
  jep-code */
IF (useDataObject <> TRUE) OR (p_TT <> ?) THEN
    RUN adecomm/_mfldlst.p
        (INPUT v_SrcLst:HANDLE,
         INPUT p_TblLst,
         INPUT p_TT,
         INPUT yes,
         INPUT p_Items,
         INPUT 1,
         INPUT "",
         OUTPUT t_log).
  
/* Remove array elements from v_SrcLst that might already be there */ 
IF p_Result NE "" THEN DO:  /* If first time, no need to check for elements */
  DO t_int = 1 TO v_SrcLst:NUM-ITEMS:
    /* Check if an array */
    cTemp = v_SrcLst:ENTRY(t_int).
    IF INDEX(cTemp,"[":U) > 0 THEN DO:  /* This is an array */
      ASSIGN cTemp      = TRIM (cTemp)
             cArrayList = SUBSTRING(cTemp,INDEX(cTemp,'[':u) + 1,-1,
                                    "CHARACTER":u)
             cArrayList = REPLACE(cArrayList,"]":u,"")
             cTemp      = ENTRY(1,cTemp,"[":U)
             first-time = TRUE.

      /* Loop through the list base on " " */
      DO i = 1 TO NUM-ENTRIES (cArrayList, ' '):
        ASSIGN cArrayEntry = ENTRY (i, cArrayList, ' ')
               iArrayLow   = INTEGER (ENTRY (1, cArrayEntry, '-'))
               iArrayHigh  = INTEGER (ENTRY (NUM-ENTRIES (cArrayEntry, '-'),
                                                          cArrayEntry, '-')).

        IF first-time THEN /* Clear existing brackets */
          ASSIGN  t_log = v_SrcLst:REPLACE(cTemp + "[]":U, t_int)
                  first-time = FALSE.
                       
        /* Loop through the list base on X-Y. X is the low number.
                                              Y is the high number.           */
        DO j = iArrayLow TO iArrayHigh:
          ASSIGN cArrayEntry = cTemp + '[' + STRING (j) + ']'.
          /* Add and "Collapse" cArrayEntry out if it is NOT
             in the results list                              */
          IF LOOKUP(cArrayEntry, p_Result, p_Dlmtr) = 0 THEN DO:
            RUN adecomm/_collaps.p (v_SrcLst:HANDLE, cArrayEntry).
          END.
        END. /* DO J */
      END. /* DO I */
      IF v_SrcLst:ENTRY(t_int) MATCHES "*[]" THEN
         t_log = v_SrcLst:DELETE(t_int).
    END.  /* This is an array */  
  END. /* DO t_int 1 to num-items */
END.  /* If possibility of array elements */
   
/*
** Remove p_Result items from source list. They are not meant to be
** part of selection.
*/
DO t_int = 1 TO NUM-ENTRIES(p_Result, p_Dlmtr):
  ASSIGN t_log = v_SrcLst:DELETE(ENTRY(t_int,p_Result, p_Dlmtr)) IN FRAME FldPicker.
END.

ENABLE v_SrcLst qbf-ok qbf-cn qbf-hlp
       WITH FRAME FldPicker.

/* Select the first item in the source list */
IF v_SrcLst:NUM-ITEMS > 0 THEN v_SrcLst:SCREEN-VALUE = v_SrcLst:ENTRY(1).

&SCOPED-DEFINE CANCEL-EVENT U2
{adeuib/ide/dialogstart.i qbf-ok qbf-cn xWinTitle}

/* Assume a cancel until the user hits OK. */
l_Cancel = yes.
DO ON ERROR UNDO,RETRY ON ENDKEY UNDO,LEAVE:
  APPLY "ENTRY"  TO v_SrcLst IN FRAME FldPicker.
  &if DEFINED(IDE-IS-RUNNING) = 0 &THEN    
  WAIT-FOR GO OF FRAME FldPicker
           OR DEFAULT-ACTION OF v_SrcLst  IN FRAME FldPicker.
  /* No Cancel. */
  &ELSE 
  WAIT-FOR GO OF FRAME FldPicker
           OR DEFAULT-ACTION OF v_SrcLst  IN FRAME FldPicker
           OR "{&CANCEL-EVENT}":U of this-procedure.
  if cancelDialog then undo, leave.        
  &ENDIF
  l_cancel = NO.
END.

HIDE FRAME FldPicker NO-PAUSE.

IF l_Cancel 
THEN RETURN "Cancel":U.
ELSE RETURN.

/* two.p - end of file */

/* This is a kludge for MS-WINDOWS  - see bug # 94-09-16-030.   */
/* When the user dblclicks on a table in the adecomm/_tblsel.p procedure this dialog
   (_mfldsel.p) is brought into context on the MOUSE-SELECT-DOWN of the 2nd click.
   However, the MOUSE-SELECT-UP of the second click "bleeds" through to the underlying
   frame of the UIB design window and attempts to fire the frame-select-up persistent
   trigger.  This fails with an error message that it can't find frame-select-up.  By
   putting this procedure in this file it will find it and supress the error message. */
PROCEDURE frame-select-up.
  RETURN.
END.
&ANALYZE-SUSPEND _VERSION-NUMBER UIB_v8r12 GUI
&ANALYZE-RESUME
&Scoped-define WINDOW-NAME CURRENT-WINDOW
&Scoped-define FRAME-NAME f_findfile
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _DEFINITIONS f_findfile 
/***********************************************************************
* Copyright (C) 2000,2007 by Progress Software Corporation. All rights *
* reserved. Prior versions of this work may contain portions           *
* contributed by participants of Possenet.                             *
*                                                                      *
***********************************************************************/
/*
** Program:        _fndfile.p
** Author:         Robert Ryan
**                 (Wm.T.Wood - converted this to UIB compatible file)
**
** Date:           3/10/94
** Purpose:        Supercedes SYSTEM-FILE common dialog file opens in the UIB;
**                 displays files/images simultaneously like MS Word's Find File
**
** Inputs:         pTitle
**                   Title of the dialog box. "Choose " is prepended automatically,
**                   so only pass type of file to choose. Eg, pTitle = "Image File".
**                   If pTitle already begins with "Choose ", pTitle is not changed.
**
**                 pMode
**                   TEMPLATE    Preview file as an image, then text, then
**                               full qualified image file name
**                   TEXT        Preview file as text only
**                   IMAGE       Preview file as fully-qualified image only
**
**                 pFilter
**                    Filetypes that the user can select.  The list is in 
**                    list-items-pairs format to display in the combo-box.
**                    The 1st file type is user as the initial filter.  
**                    Pipe character "|" is used as a delimeter character 
**                    (and not commas).  Commas are used to separate filetypes 
**                    as in:
**
**                        Bitmaps (*.ico, *.dib)|*.ico,*.dib|
**
** Input/Ouptut:   pFileName
**                    If available at input, that file's filetype/directory are
**                    used as the initial filter and the file is subsequently
**                    previewed.  If blank, the first pFilter is used.
**                    As an output parm, the relative path/file is provided.
**                    Backslashes are changed to forward slashes for
**                    UNIX compatibility.
**
**                 pDirList
**                    At input, the initial list of directories to search.
**                    If the user added/subtracted directories, then, at output,
**                    this list will reflects those modfications.  The list
**                    is of the form:
**                        c:\second,c:\first,src\template,.,c:\second
**                    The first item in the list will be the intial selection.
**                    It can appear in the list twice.  If so, the list will be
**                    entries 2 to n.  Therefore:
**                      "a,b,c,d"   -- List is "a,b,c,d". Initial value is "a".
**                      "c,a,b,c,d" -- list is "a,b,c,d". Initial value is "c".
**
** Output:         pAbsoluteFileName
**                    The absolute, or fully qualified path/file name.
**                    Backslashes are changed to forward slashes for
**                    UNIX compatibility.
**
**                 pOk
**                    True if Ok was pressed, False if Cancel was pressed
**
** Modified: 05/27/99  TSM  Change FileType combo to use list-item-pairs 
**                          rather than list items to support new image formats
**           06/24/99  TSM  Removed code that was stripping off ext of images to
**                          support new image formats
*/

/*
** Parameter Definitions
*/
&GLOBAL-DEFINE WIN95-BTN YES
&IF DEFINED(UIB_is_running) = 0 AND DEFINED(INCLUDED) = 0 &THEN
DEFINE INPUT        PARAMETER pTitle            AS CHARACTER NO-UNDO.
DEFINE INPUT        PARAMETER pMode             AS CHARACTER NO-UNDO.
DEFINE INPUT        PARAMETER pFilter           AS CHARACTER NO-UNDO.
DEFINE INPUT-OUTPUT PARAMETER pDirList          AS CHARACTER NO-UNDO.
DEFINE INPUT-OUTPUT PARAMETER pFileName         AS CHARACTER NO-UNDO.
DEFINE OUTPUT       PARAMETER pAbsoluteFileName AS CHARACTER NO-UNDO.
DEFINE OUTPUT       PARAMETER pOk               AS LOGICAL   NO-UNDO.
&ELSE
DEFINE VARIABLE pTitle            AS CHARACTER NO-UNDO INITIAL "Open File".
DEFINE VARIABLE pMode             AS CHARACTER NO-UNDO INITIAL "TEMPLATE".
DEFINE VARIABLE pFilter           AS CHARACTER NO-UNDO INITIAL "*.w".
DEFINE VARIABLE pDirList          AS CHARACTER NO-UNDO INITIAL "src/template,.".
DEFINE VARIABLE pFileName         AS CHARACTER NO-UNDO.
DEFINE VARIABLE pAbsoluteFileName AS CHARACTER NO-UNDO.
DEFINE VARIABLE pOk               AS LOGICAL   NO-UNDO.

/* Other UIB setup */
SESSION:THREE-D = yes.
&ENDIF

/*
** Local Variable Definitions
*/
DEFINE VARIABLE i                 AS INTEGER   NO-UNDO.
DEFINE VARIABLE ItemCnt           AS INTEGER   NO-UNDO.
DEFINE VARIABLE Result            AS LOGICAL   NO-UNDO.
DEFINE VARIABLE FileStatus        AS LOGICAL   NO-UNDO.
DEFINE VARIABLE Matched           AS LOGICAL   NO-UNDO.
DEFINE VARIABLE TempDir           AS CHARACTER NO-UNDO.
DEFINE VARIABLE DirName           AS CHARACTER NO-UNDO.
DEFINE VARIABLE FileName          AS CHARACTER NO-UNDO.
DEFINE VARIABLE FullFileName      AS CHARACTER NO-UNDO.
DEFINE VARIABLE CurFilter         AS CHARACTER NO-UNDO.
DEFINE VARIABLE NewFilter         AS CHARACTER NO-UNDO.
DEFINE VARIABLE FileStream        AS CHARACTER NO-UNDO.
DEFINE VARIABLE ListOfFiles       AS CHARACTER NO-UNDO.
DEFINE VARIABLE pCurrentPath      AS CHARACTER NO-UNDO.
DEFINE VARIABLE PrefPreviewType   AS LOGICAL   NO-UNDO.
DEFINE VARIABLE TestValue         AS CHARACTER NO-UNDO.
DEFINE VARIABLE ExtensionFlag     AS LOGICAL   NO-UNDO.
DEFINE VARIABLE ByteSize          AS DECIMAL   NO-UNDO.
DEFINE VARIABLE FileContents      AS CHARACTER NO-UNDO.
DEFINE VARIABLE LeaveFlag         AS LOGICAL   NO-UNDO.
define var wintitle as char no-undo.
 
/*
** Patrick Tullmann's Dir DLL
*/
{adecomm/dirsrch.i}
DEFINE VARIABLE list-mem    AS MEMPTR.
DEFINE VARIABLE list-char   AS CHARACTER.
DEFINE VARIABLE list-size   AS INTEGER INITIAL 8000.
DEFINE VARIABLE missed-file AS INTEGER.
DEFINE VARIABLE DirError    AS INTEGER.

/*
** Pre-processor DefinitionsFRAME {&FRAME-NAME}:title
*/
&SCOPED-DEFINE WINDOW-NAME {&FRAME-NAME}
&SCOPED-DEFINE FRAME-NAME  {&FRAME-NAME}

&IF LOOKUP(OPSYS, "MSDOS,WIN32":u) = 0 &THEN
&SCOPED-DEFINE DIR-SLASH   /
&ELSE
&SCOPED-DEFINE DIR-SLASH   ~~~\
&SCOPED-DEFINE OS-HT       1.0
&SCOPED-DEFINE SEL-HT      6.15
&ENDIF

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME


&ANALYZE-SUSPEND _UIB-PREPROCESSOR-BLOCK 

/* ********************  Preprocessor Definitions  ******************** */

&Scoped-define PROCEDURE-TYPE DIALOG-BOX
&Scoped-define DB-AWARE no

/* Name of first Frame and/or Browse and/or first Query                 */
&Scoped-define FRAME-NAME f_findfile

/* Standard List Definitions                                            */
&Scoped-Define ENABLED-OBJECTS TextDisplay FileNameField FileList FileType ~
PreviewType PreviewFile DirList EditPathButton BrowseButton ~
FullFileNameField FileNameLabel Container ImageDisplay 
&Scoped-Define DISPLAYED-OBJECTS TextDisplay FileNameField FileList ~
FileType PreviewType PreviewFile DirList FullFileNameField FileNameLabel 

/* Custom List Definitions                                              */
/* List-1,List-2,List-3,List-4,List-5,List-6                            */

/* _UIB-PREPROCESSOR-BLOCK-END */
&ANALYZE-RESUME



/* ***********************  Control Definitions  ********************** */

/* Define a dialog box                                                  */

/* Definitions of the field level widgets                               */
DEFINE BUTTON BrowseButton 
     LABEL "&Browse...":C13 
     SIZE 15 BY 1.14.

DEFINE BUTTON EditPathButton 
     LABEL "&Edit Path...":C13 
     SIZE 15 BY 1.14.

DEFINE VARIABLE DirList AS CHARACTER FORMAT "x(80)":U 
     VIEW-AS COMBO-BOX INNER-LINES 5
     DROP-DOWN-LIST
     SIZE 35 BY 1.

DEFINE VARIABLE FileType AS CHARACTER FORMAT "x(80)":U 
     VIEW-AS COMBO-BOX INNER-LINES 5
     DROP-DOWN-LIST
     SIZE 35 BY 1.

DEFINE VARIABLE TextDisplay AS CHARACTER 
     VIEW-AS EDITOR NO-WORD-WRAP SCROLLBAR-HORIZONTAL SCROLLBAR-VERTICAL
     SIZE 47.8 BY 9.86
     FONT 2 NO-UNDO.

DEFINE VARIABLE FileNameField AS CHARACTER FORMAT "x(80)":U 
     VIEW-AS FILL-IN 
     SIZE 35 BY 1 NO-UNDO.

DEFINE VARIABLE FileNameLabel AS CHARACTER FORMAT "x(8)":U 
      VIEW-AS TEXT 
     SIZE 11 BY .67 NO-UNDO.

DEFINE VARIABLE FullFileNameField AS CHARACTER FORMAT "x(80)":U 
      VIEW-AS TEXT 
     SIZE 46.6 BY 1 NO-UNDO.

DEFINE IMAGE ImageDisplay
     SIZE 47 BY 9.67.

DEFINE VARIABLE PreviewType AS LOGICAL 
     VIEW-AS RADIO-SET HORIZONTAL
     RADIO-BUTTONS 
          "&Code", no,
"&Image", yes
     SIZE 19.6 BY 1 NO-UNDO.

DEFINE RECTANGLE Container
     EDGE-PIXELS 2 GRAPHIC-EDGE  
     SIZE 47.8 BY 9.86.

DEFINE VARIABLE FileList AS CHARACTER 
     VIEW-AS SELECTION-LIST SINGLE SORT SCROLLBAR-VERTICAL 
     SIZE 35 BY 6.86.

DEFINE VARIABLE PreviewFile AS LOGICAL INITIAL no 
     LABEL "&Preview" 
     VIEW-AS TOGGLE-BOX
     SIZE 12 BY 1 NO-UNDO.


/* ************************  Frame Definitions  *********************** */

DEFINE FRAME f_findfile
     TextDisplay AT ROW 2.19 COL 39 NO-LABEL
     FileNameField AT ROW 2.24 COL 2 NO-LABEL
     FileList AT ROW 3.52 COL 2 NO-LABEL
     FileType AT ROW 11.33 COL 2 NO-LABEL
     PreviewType AT ROW 12.29 COL 52.6 NO-LABEL
     PreviewFile AT ROW 12.33 COL 39
     DirList AT ROW 13.38 COL 2 NO-LABEL
     EditPathButton AT ROW 13.38 COL 38.2
     BrowseButton AT ROW 13.38 COL 55.2
     FullFileNameField AT ROW 1 COL 37.8 COLON-ALIGNED NO-LABEL
     FileNameLabel AT ROW 1.33 COL 2 NO-LABEL
     Container AT ROW 2.14 COL 39
     ImageDisplay AT ROW 2.33 COL 39.6
     "File &Type:" VIEW-AS TEXT
          SIZE 9.2 BY .67 AT ROW 10.52 COL 2.4
     "&Directory:" VIEW-AS TEXT
          SIZE 9 BY .67 AT ROW 12.62 COL 2.4
     SPACE(75.59) SKIP(1.23)
    WITH
    &if DEFINED(IDE-IS-RUNNING) = 0  &then 
    VIEW-AS DIALOG-BOX TITLE "":C  
    &else
    NO-BOX
    &endif
    SIDE-LABELS  NO-UNDERLINE THREE-D SCROLLABLE .
{adeuib/ide/dialoginit.i "FRAME f_findfile:handle"}

&IF DEFINED(IDE-IS-RUNNING) <> 0 &THEN
dialogService:View().  
&ENDIF 

/* *********************** Procedure Settings ************************ */

&ANALYZE-SUSPEND _PROCEDURE-SETTINGS
/* Settings for THIS-PROCEDURE
   Type: DIALOG-BOX
   Other Settings: COMPILE
 */
&ANALYZE-RESUME _END-PROCEDURE-SETTINGS



/* ***********  Runtime Attributes and AppBuilder Settings  *********** */

&ANALYZE-SUSPEND _RUN-TIME-ATTRIBUTES
/* SETTINGS FOR DIALOG-BOX f_findfile
                                                                        */
ASSIGN 
       FRAME f_findfile:SCROLLABLE       = FALSE
       FRAME f_findfile:HIDDEN           = TRUE.

/* SETTINGS FOR COMBO-BOX DirList IN FRAME f_findfile
   ALIGN-L                                                              */
/* SETTINGS FOR FILL-IN FileNameField IN FRAME f_findfile
   ALIGN-L                                                              */
/* SETTINGS FOR FILL-IN FileNameLabel IN FRAME f_findfile
   ALIGN-L                                                              */
/* SETTINGS FOR COMBO-BOX FileType IN FRAME f_findfile
   ALIGN-L                                                              */
/* _RUN-TIME-ATTRIBUTES-END */
&ANALYZE-RESUME




/* ************************  Control Triggers  ************************ */

&Scoped-define SELF-NAME f_findfile
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL f_findfile f_findfile
ON GO OF FRAME f_findfile
DO:
  DEFINE VARIABLE fext AS CHARACTER NO-UNDO.
  DEFINE VARIABLE xDirName AS CHARACTER NO-UNDO.
  /*
  ** LeaveFlag is set when a user has a wildcard in the FileNameField. This
  ** allows the <CR> to be trapped and to not act as the default OK button.
  */
  IF LeaveFlag THEN RETURN NO-APPLY.

  /*
  ** Upon exit, make these assigns to pass to the calling procedure.
  */
  ASSIGN xDirName = RIGHT-TRIM(DirList:SCREEN-VALUE, "~\").
  
  /* WIN95-UNC - Windows 95 UNC Pathnames support. - jep 12/18/95 */
  /* Get the filename and add in the directory. */
  ASSIGN pFileName = IF FileNameField:SCREEN-VALUE = "(None)" OR
                        FileNameField:SCREEN-VALUE = ?
                     THEN "" ELSE FileNameField:SCREEN-VALUE.
  IF (pFileName <> "") THEN
    RUN adecomm/_osfmush.p
      (INPUT xDirName, INPUT pFileName, OUTPUT pFileName).
  ASSIGN
    pDirList              = DirList:LIST-ITEMS
    pOK                   = TRUE
    FILE-INFO:FILENAME    = pFileName
    pAbsoluteFileName     = FILE-INFO:FULL-PATHNAME.

  /* If the current directory is not the first item, then add it onto the
     front. */
  ASSIGN DirList.
  IF LOOKUP(DirList, pDirList) > 1 THEN
    ASSIGN pDirList = DirList + ",":U + pDirList.

  RUN Make_Rel (INPUT-OUTPUT pFileName). /* make filename relative to PROPATH */

  /* Make sure the file name is valid. */
  IF SEARCH(pAbsoluteFileName) EQ ? AND pfilename NE "" THEN DO:
    &if DEFINED(IDE-IS-RUNNING) <> 0 &then
          ShowMessageInIDE("The file does not exist or cannot be located.",
                           "Warning",?,"OK",yes).
      
    &else  
    MESSAGE pFileName SKIP
      "The file does not exist or cannot be located." VIEW-AS ALERT-BOX WARNING.
    &endif  
    RETURN NO-APPLY.
  END.
  
  /* Change backslash to forward slash for UNIX compatibility. */
  ASSIGN pFileName          = REPLACE(pFileName, "~\":U, "/":U)
         pAbsoluteFileName  = REPLACE(pAbsoluteFileName, "~\":U, "/":U).

END.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME


&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL f_findfile f_findfile
ON WINDOW-CLOSE OF FRAME f_findfile
DO:
  APPLY "END-ERROR":U TO SELF.
END.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME


&Scoped-define SELF-NAME BrowseButton
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL BrowseButton f_findfile
ON CHOOSE OF BrowseButton IN FRAME f_findfile /* Browse... */
DO:
  DEFINE VARIABLE ProcName               AS CHARACTER NO-UNDO.
  DEFINE VARIABLE OKpressed              AS LOGICAL   NO-UNDO.
  DEFINE VARIABLE InitFilter             AS INTEGER   NO-UNDO.
  DEFINE VARIABLE FilterNameString       AS CHARACTER NO-UNDO EXTENT 11.
  DEFINE VARIABLE StartingDir            AS CHARACTER NO-UNDO.
  DEFINE VARIABLE WildCardFlag           AS LOGICAL   NO-UNDO.

  ASSIGN
    FILE-INFO:FILENAME = DirList:SCREEN-VALUE
    StartingDir        = FILE-INFO:FULL-PATHNAME
    ItemCnt            = FileType:NUM-ITEMS.

  /* Copy the file filters in the FileType combo-box to an array.
     Also record the initial file-filter. */
  InitFilter = 1.
  DO i = 1 TO ItemCnt:
    IF i > 10 THEN DO:
       &if DEFINED(IDE-IS-RUNNING) <> 0 &then
          ShowMessageInIDE("Only first ten file types will be used as filters.",
                           "Information",?,"OK",yes).
      
      &else   
      MESSAGE "Only first ten file types will be used as filters." 
        VIEW-AS ALERT-BOX INFORMATION.
      &endif  
      LEAVE.
    END.

    FilterNameString[i] = FileType:ENTRY(i).
    IF FilterNameString[i] eq Filetype:SCREEN-VALUE THEN InitFilter = i.
    IF FilterNameString[i] eq "*.*":U               THEN WildCardFlag = TRUE.
  END.

  /*
  ** Add the wildcard filter ("*.*") to the list, if it is not there.
  */
  IF NOT WildCardFlag THEN DO:
    FilterNameString[10] = "*.*".
    IF FilterNameString[10] eq Filetype:SCREEN-VALUE THEN InitFilter = 10.
  END.
  
  REPEAT:
    SYSTEM-DIALOG GET-FILE ProcName
      TITLE           "Browse Files"
      FILTERS         FilterNameString[1] FilterNameString[1],
      FilterNameString[2] FilterNameString[2],
      FilterNameString[3] FilterNameString[3],
      FilterNameString[4] FilterNameString[4],
      FilterNameString[5] FilterNameString[5],
      FilterNameString[6] FilterNameString[6],
      FilterNameString[7] FilterNameString[7],
      FilterNameString[8] FilterNameString[8],
      FilterNameString[9] FilterNameString[9],
      FilterNameString[10] FilterNameString[10],
      FilterNameString[11] FilterNameString[11]
      INITIAL-FILTER  InitFilter
      INITIAL-DIR     StartingDir
      RETURN-TO-START-DIR
      MUST-EXIST
      USE-FILENAME
      UPDATE OkPressed.

    IF OkPressed THEN DO:
      ASSIGN 
        FullFileName = ProcName
        pFileName    = ProcName.
      RUN AddFileFilter.
      RUN InitpFileName (TRUE).
      IF RETURN-VALUE EQ "False" THEN
        APPLY "VALUE-CHANGED" TO DirList IN FRAME {&FRAME-NAME}.
    END. /* end OkPressed */
    LEAVE.
  END.
END.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME


&Scoped-define SELF-NAME DirList
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL DirList f_findfile
ON VALUE-CHANGED OF DirList IN FRAME f_findfile
DO:
  RUN PopulateFileList.
  IF RETURN-VALUE = "True" THEN
    APPLY "VALUE-CHANGED" TO FileList IN FRAME {&FRAME-NAME}.
  ELSE
    RUN adecomm/_setcurs.p ("":U).
END.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME


&Scoped-define SELF-NAME EditPathButton
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL EditPathButton f_findfile
ON CHOOSE OF EditPathButton IN FRAME f_findfile /* Edit Path... */
DO:
  DO WITH FRAME {&FRAME-NAME}:
     run choose_modpath(DirList:SCREEN-VALUE) .
  END.
END.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME


&Scoped-define SELF-NAME FileList
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL FileList f_findfile
ON DEFAULT-ACTION OF FileList IN FRAME f_findfile
DO:
  /* Accept the current value. */
  APPLY "go":U TO FRAME {&FRAME-NAME}.
END.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME


&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL FileList f_findfile
ON VALUE-CHANGED OF FileList IN FRAME f_findfile
DO:
  ASSIGN
    FileNameField:SCREEN-VALUE     = self:SCREEN-VALUE
    FileNameField                  = FileNameField:SCREEN-VALUE.

  RUN FullFileName.
  FullFileNameField:SCREEN-VALUE = FullFileName.
  RUN FileLoad.
END.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME


&Scoped-define SELF-NAME FileNameField
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL FileNameField f_findfile
ON LEAVE OF FileNameField IN FRAME f_findfile
DO:
  DEF VAR fname AS CHARACTER NO-UNDO.   
  DEF VAR h AS HANDLE.

  /* hdl to widget we are entering, if any */
  ASSIGN h = LAST-EVENT:WIDGET-ENTER. 
  /* If we are entering the FileList, set this fill-in to
   * to newly selected name
   */
  IF VALID-HANDLE(h) AND h:NAME = "FileList" AND
  FileList:SCREEN-VALUE NE ? THEN
    FileNameField:SCREEN-VALUE = FileList:SCREEN-VALUE.
  
  ASSIGN
    ExtensionFlag = TRUE
    FileNameField = IF FileNameField:SCREEN-VALUE = "" THEN "(None)" ELSE
                      LEFT-TRIM(FileNameField:SCREEN-VALUE)
    TestValue     = FileNameField 
    LeaveFlag     = INDEX(FileNameField,"*":U) > 0.

  /*
  ** Step 1: See if this file matches something in the file list.  If it does,
  **         you're all set and you can get out of here.
  */
  RUN MatchFileName (ExtensionFlag).

  /*
  ** Step 2: add a file type if needed
  */
  IF Matched THEN APPLY "VALUE-CHANGED" TO FileList.
  ELSE DO:
    /* 
    ** Is this a valid file at all.
    */
    IF NOT LeaveFlag AND TestValue ne "" THEN DO:
      IF SEARCH(DirList:SCREEN-VALUE + "{&DIR-SLASH}" + TestValue) eq ?
      THEN DO:
        /* It's not in the list, but maybe it's a fully qualified name */
        FILE-INFO:FILE-NAME = TestValue.
        IF FILE-INFO:FULL-PATHNAME EQ ? THEN DO:
            IF VALID-HANDLE(h) AND (h:NAME NE "btn_OK" OR h:NAME NE "btn_Help") THEN LEAVE.
             &if DEFINED(IDE-IS-RUNNING) <> 0 &then
                ShowMessageInIDE(TestValue + "~n Cannot find this file.~n
                                 Please verify that the correct path and filename are given.",
                                 "Error",?,"OK",yes).
      
           &else 
            MESSAGE TestValue SKIP 
                "Cannot find this file." SKIP(1)
                "Please verify that the correct path and filename are given."
                VIEW-AS ALERT-BOX ERROR.
           &endif     
          RETURN NO-APPLY.
        END.
        /* If it's a directory, add a filter */
        IF INDEX(FILE-INFO:FILE-TYPE,"D") > 0 THEN DO:
          ASSIGN FileNameField = FileNameField + "{&DIR-SLASH}" + ENTRY(1,FileType:SCREEN-VALUE)
                 LeaveFlag = yes.
        END.
        ELSE LeaveFlag = no.
      END.    
    END.
    /*
    ** This is a new file spec
    */
    FullFileName = FileNameField.
    RUN AddFileFilter.

    IF DirName = "" THEN
      DirName = DirList:SCREEN-VALUE.

    RUN AddDirName.
    /* If the user entered a good filename, then use it and leave
     * the dialog
     */
    IF R-INDEX(FileNameField,"{&DIR-SLASH}") > 0                                   AND
       LENGTH(FileNameField,"CHARACTER":U) > R-INDEX(FileNameField,"{&DIR-SLASH}") AND
       INDEX(FILE-INFO:FILE-TYPE,"D") = 0                                          THEN 
    DO:
      ASSIGN fname = SUBSTRING(FileNameField,R-INDEX(FileNameField,"{&DIR-SLASH}") + 1, -1, "CHARACTER":U).
      ASSIGN leaveflag = no
             FileNameField:SCREEN-VALUE = fname
             FileNameField = fname.
      APPLY "GO" TO FRAME f_findfile.
    END.
    ELSE APPLY "VALUE-CHANGED" TO FileType.
  END.
END.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME


&Scoped-define SELF-NAME FileType
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL FileType f_findfile
ON VALUE-CHANGED OF FileType IN FRAME f_findfile
DO:
  RUN PopulateFileList.
  IF RETURN-VALUE = "True" THEN
    APPLY "VALUE-CHANGED" TO FileList IN FRAME {&FRAME-NAME}.
  ELSE
    RUN adecomm/_setcurs.p ("":U).
END.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME


&Scoped-define SELF-NAME PreviewFile
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL PreviewFile f_findfile
ON VALUE-CHANGED OF PreviewFile IN FRAME f_findfile /* Preview */
DO:
  ASSIGN
    PreviewFile              = SELF:CHECKED
    PreviewType              = PrefPreviewType
    PreviewType:SCREEN-VALUE = STRING(PreviewType)
    PreviewType:SENSITIVE    = (PreviewFile AND pMode = "TEMPLATE")
    TextDisplay:SCREEN-VALUE = IF SELF:CHECKED THEN TextDisplay:SCREEN-VALUE
                               ELSE "".

  /* Preview the current file, if appropriate. */
  IF PreviewFile THEN
    RUN FileLoad.
  ELSE
    RUN ClearContents.
END.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME


&Scoped-define SELF-NAME PreviewType
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL PreviewType f_findfile
ON VALUE-CHANGED OF PreviewType IN FRAME f_findfile
DO:
  ASSIGN PreviewType.
  /* The user explicitly changed the preview type. Save this preference.
  (Note that the radio-set can change implicitly if, for example, an image
  file does not exist.  We don't want to save the implicit changes.) */
  PrefPreviewType = PreviewType.

  RUN FileLoad.
END.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME


&UNDEFINE SELF-NAME

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _MAIN-BLOCK f_findfile 


/* ******************* Sullivan Standards & Run-time Setup ******************** */

/* Parent the dialog-box to the ACTIVE-WINDOW, if there is no parent.   */
IF VALID-HANDLE(ACTIVE-WINDOW) AND FRAME {&FRAME-NAME}:PARENT eq ?
THEN FRAME {&FRAME-NAME}:PARENT = ACTIVE-WINDOW.

/* Help File */
{ adecomm/commeng.i }

/* Sullivan bar standards */
DEF VAR hlp_context AS INTEGER NO-UNDO.
hlp_context = IF pMode eq "TEMPLATE" THEN {&Find_Template_Dlg_Box}
              ELSE IF pMode eq "IMAGE" THEN {&Find_Image_Dlg_Box}
              ELSE {&Find_File_Dlg_Box}
              . 
{ adecomm/okbar.i 
   &TOOL    = "COMM"
   &CONTEXT = hlp_context }


/* Fix up the screen to handle diffenences in resolution (on GUI platforms)
   1) Round off the selection-list to an integer number of lines. 
   2) Make sure image/rectangle is wide enough to hold 320 pixels
   3) Make sure the Text and Image displays just fit inside the Container 
      rectangle. */
&if DEFINED(IDE-IS-RUNNING) = 0  &then
DO WITH FRAME {&FRAME-NAME}:
  ASSIGN FileList:INNER-LINES  = INTEGER(FileList:INNER-LINES).
  /* Check that the rectangle can hold a 320 pixel image. */
  i = 320 + (2 * Container:EDGE-PIXELS) - Container:WIDTH-P.
  IF i > 0 THEN DO:
    /* Widen the Frame and container rectangle by the value of i.
       Also widen and reposition items in the "sullivan" bar. */
    ASSIGN 
      FRAME {&FRAME-NAME}:WIDTH-P = FRAME {&FRAME-NAME}:WIDTH-P + i
      &IF {&OKBOX} &THEN
      rect_btn_bar:WIDTH-P        = rect_btn_bar:WIDTH-P + i /* Def'd in okbar.i */
      &ENDIF
      Btn_help:X                  = btn_help:X + i           /* Def'd in okbar.i */
      Container:WIDTH-P           = Container:WIDTH-P + i
      .
  END.
  ASSIGN i                     = Container:EDGE-PIXELS
         TextDisplay:WIDTH-P   = Container:WIDTH-P - (2 * i)
         TextDisplay:HEIGHT-P  = Container:HEIGHT-P - (2 * i)  
         TextDisplay:X         = Container:X + i
         TextDisplay:Y         = Container:Y + i
         ImageDisplay:WIDTH-P  = TextDisplay:WIDTH-P 
         ImageDisplay:HEIGHT-P = TextDisplay:HEIGHT-P
         ImageDisplay:X        = TextDisplay:X 
         ImageDisplay:Y        = TextDisplay:Y       
         .

END. /* DO WITH FRAME... */
 &endif
/* ***************************** Main Code Block ****************************** */

/* These trigger on the ALT keys serve to make the accelerators work as expected.
   They do not because the labels are not really attached to the fields they label */
ON ALT-F OF FRAME {&FRAME-NAME}
  APPLY "ENTRY" TO FileNameField.
  
ON ALT-T OF FRAME {&FRAME-NAME}
  APPLY "ENTRY" TO FileType.
  
ON ALT-D OF FRAME {&FRAME-NAME}
  APPLY "ENTRY" TO DirList.
  
DO ON ERROR UNDO, LEAVE ON ENDKEY UNDO, LEAVE:
  /*
  ** Running InitFindFile does the main block assigns and loads the contents
  ** of the file type, directory list, and file selection/combo lists. This
  ** procedure also handles the enabling.
  */
  RUN InitFindFile.
 wintitle = (IF NOT pTitle BEGINS "Choose" THEN "Choose ":U ELSE "") + pTitle.   
  &scoped-define CANCEL-EVENT U2
{adeuib/ide/dialogstart.i btn_ok btn_cancel wintitle}
&if DEFINED(IDE-IS-RUNNING) = 0  &then
  WAIT-FOR GO OF FRAME {&FRAME-NAME} FOCUS FileList. 
&ELSE
  WAIT-FOR GO OF FRAME {&FRAME-NAME} or "{&CANCEL-EVENT}" of this-procedure.       
  
  if cancelDialog THEN UNDO, LEAVE.  
&endif
   
END.

/*
** All done, so get out and clean-up
*/
HIDE FRAME {&FRAME-NAME}.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME

/* **********************  Internal Procedures  *********************** */
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE choose_modpath f_findfile

PROCEDURE choose_modpath:
     define input  parameter pCurrentPath as character no-undo.
     &if DEFINED(IDE-IS-RUNNING) <> 0  &then
      dialogService:SetCurrentEvent(this-procedure,"do_choose_modpath",pCurrentPath).
      run runChildDialog in hOEIDEService (dialogService) .
     &else 
      run do_choose_modpath(pCurrentPath).
     &endif
end procedure.

 /* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME
 
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE do_choose_modpath f_findfile
PROCEDURE do_choose_modpath:
     define input  parameter pCurrentPath as character no-undo.
     define variable cNewList as character no-undo.
     define variable OrigPath as character no-undo.
     DO WITH FRAME {&FRAME-NAME}:
         OrigPath     = pCurrentPath.
    
    &if DEFINED(IDE-IS-RUNNING) <> 0  &then
         RUN adeuib/ide/_dialog_modpath.p (DirList:LIST-ITEMS, SESSION:THREE-D, 
                            INPUT-OUTPUT pCurrentPath, OUTPUT cNewList).
    &else 
         RUN adecomm/_modpath.w (DirList:LIST-ITEMS, SESSION:THREE-D, 
                            INPUT-OUTPUT pCurrentPath, OUTPUT cNewList).
    &endif                        
      
      /* NewList will be blank if the user cancelled. */
         IF cNewList ne "" THEN DO:
             ASSIGN
                DirList:LIST-ITEMS   = ""
                DirList:LIST-ITEMS   = cNewList
                DirList:SCREEN-VALUE = TRIM(pCurrentPath).
            
             /* Was the current item changed? */
             IF pCurrentPath ne OrigPath THEN 
                APPLY "VALUE-CHANGED" TO DirList IN FRAME {&FRAME-NAME}.
         END.
     END.
                       
END PROCEDURE.   

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME
 
 
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE AddDirName f_findfile 
PROCEDURE AddDirName :
DO WITH FRAME {&FRAME-NAME}:
    DEFINE VARIABLE AlreadyExists AS LOGICAL NO-UNDO INITIAL FALSE.
    /*
    ** If the directory is new, add it to the directory list
    */
    IF NOT DirList:SCREEN-VALUE = DirName THEN i = 0.

    DO i = 1 TO DirList:num-items:
      IF DirList:ENTRY(i) = DirName THEN AlreadyExists = TRUE.
    END.
    IF NOT AlreadyExists THEN Result = DirList:ADD-LAST(DirName).
  
    ASSIGN
      DirList:SCREEN-VALUE       = DirName.
  END.
END PROCEDURE.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE AddFileFilter f_findfile 
PROCEDURE AddFileFilter :
DO WITH FRAME {&FRAME-NAME}:
    /*
    ** Parse the path name and strip last directory separator
    */
    RUN adecomm/_osprefx.p (FullFileName, OUTPUT DirName, OUTPUT FileName).
    ASSIGN
      DirName = RIGHT-TRIM(DirName,"~\/")
      DirName = IF (LENGTH(DirName,"CHARACTER":u) = 2
                  AND SUBSTRING(DirName,2,1,"CHARACTER":u) = ":":u) THEN
                  DirName + "~\":u ELSE DirName.
  
    /*
    ** De-construct the file type
    */
    /* Make sure there's something to de-construct */
    IF NUM-ENTRIES (FileName,".") < 2 THEN RETURN.
  
    /* WIN95-LFN - Windows 95 Long Filename support. Code below applies
       .3 extension limit. Only do this for DOS/WIN3.1. - jep 12/12/95 */
    IF OPSYS = "MSDOS":u THEN
    DO:
      IF LENGTH(ENTRY(2,FileName,".":U),"raw") > 3 THEN DO:
         &if DEFINED(IDE-IS-RUNNING) <> 0 &then
                ShowMessageInIDE(ENTRY(2,FileName,".":U) + " file filter is too long for DOS.",
                                 "Error",?,"OK",yes).
      
        &else   
        MESSAGE ENTRY(2,FileName,".":U) "file filter is too long for DOS."
          VIEW-AS ALERT-BOX.
        &endif  
        RETURN.
      END.
    END.
  
    /* WIN95-LFN - Windows 95 Long Filename support - jep 12/12/95 */
    /* Determine file type using the extension. */
    RUN adecomm/_osfext.p
        (INPUT  FileName  /* OS File Name.   */ ,
         OUTPUT FileType  /* File Extension. */ ).
    ASSIGN FileType = "*.":u + TRIM(FileType, ".").
    /*ASSIGN FileType = "*." + ENTRY(2,FileName,".":U).*/
    
    DO i = 1 TO ItemCnt:
      CurFilter = FileType:ENTRY(i).
      IF LOOKUP(FileType,CurFilter) > 0 THEN LEAVE.
    END.
  
    /*
    ** See if the current file type is in the list of file types.
    ** if not, add it
    */
    IF curFilter NE "*.*" THEN DO:
        IF LOOKUP(FileType,CurFilter) = 0 THEN
          ASSIGN
            Result                = FileType:ADD-LAST(FileType) IN FRAME {&FRAME-NAME}
            FileType:SCREEN-VALUE = FileType.
        ELSE
          FileType:SCREEN-VALUE = FileType:ENTRY(i).
    END.
  END.
END PROCEDURE.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE ClearContents f_findfile 
PROCEDURE ClearContents :
/*------------------------------------------------------------------------------
  Purpose:     
  Parameters:  <none>
  Notes:       
------------------------------------------------------------------------------*/
  DO WITH FRAME {&FRAME-NAME}:
    IF TextDisplay:SCREEN-VALUE <> "" THEN
      TextDisplay:SCREEN-VALUE = "".
    Result = ImageDisplay:LOAD-IMAGE("adeicon/blank",0,0,1,1) NO-ERROR.
  END.
END PROCEDURE.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE EvaluateByteSize f_findfile 
PROCEDURE EvaluateByteSize :
/*
  ** Procedure to evaluate whether the small editor widget can read files
  ** that are too large
  */
  DEFINE VARIABLE LineContents AS CHARACTER NO-UNDO.
  DEFINE VARIABLE TestFileName AS CHARACTER NO-UNDO.
  DEFINE VARIABLE CR           AS CHARACTER NO-UNDO.
  
  ASSIGN
    CR                 = CHR(10)
    FILE-INFO:FILENAME = FullFileName
    TestFileName       = FILE-INFO:FULL-PATHNAME.
  
  INPUT FROM VALUE(TestFileName).
  
  SEEK INPUT TO END.
  ByteSize = SEEK(INPUT).
  INPUT CLOSE.
  
  IF ByteSize > 20000 THEN DO:
    ASSIGN
      i            = 0
      FileContents = "".
  
    INPUT FROM VALUE(TestFileName) NO-ECHO.
    DO i = 1 TO 100.
      IMPORT UNFORMATTED LineContents.
      FileContents = FileContents + CR + LineContents.
    END.
  
    FileContents = FileContents + CR + CR +
                   "...and more..." + CR + CR +
                   "[NOTE: " + TestFileName + " was too" + CR +
                   " large to preview in its entirety." + CR +
                   " Only the first 100 lines are shown here.]"
                   .
    INPUT CLOSE.
  END.
END PROCEDURE.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE FileLoad f_findfile 
PROCEDURE FileLoad :
/*------------------------------------------------------------------------------
  Purpose:     
  Parameters:  <none>
  Notes:       
------------------------------------------------------------------------------*/

  /* Clear old image first */
  RUN ClearContents.

  DO WITH FRAME {&FRAME-NAME}:
    /*
    ** First, check to see if we should do anything. If not, get out
    */
    IF NOT PreviewFile:CHECKED THEN RETURN.
    IF FileNameField:SCREEN-VALUE = "(None)" OR
       FileNameField:SCREEN-VALUE = ""       OR
       FileNameField:SCREEN-VALUE = "?"      THEN 
      RETURN.

    /* 
    **  Do nothing if directory. get out
    */
    FILE-INFO:FILE-NAME = FullFileName.
    IF INDEX(FILE-INFO:FILE-TYPE,"D":U) <> 0 THEN 
        RETURN.
  
    /* Make sure we are trying to display the "Correct" preview mode. */
    IF PreviewType NE PrefPreviewType
      THEN ASSIGN PreviewType = PrefPreviewType
      PreviewType:SCREEN-VALUE = STRING(PreviewType).
  
    IF PreviewType THEN DO:
      /*
      ** load as an image: PreviewType = True 
      */
      ASSIGN Result = ImageDisplay:LOAD-IMAGE
        (FullFileName,0,0,ImageDisplay:WIDTH-P,ImageDisplay:HEIGHT-P) NO-ERROR.
      IF Result THEN ASSIGN Container:VISIBLE        = TRUE
                            ImageDisplay:VISIBLE     = TRUE
                            TextDisplay:VISIBLE      = FALSE
                            .
      ELSE DO:
        /* Report that the image could not be loaded (unless the option of showing
           text is available, in which case we will try that). */ 
        IF NOT PreviewType:SENSITIVE THEN RUN LoadImageError.
      END.
    END.
    /* Load the file contents itself if PreviewType is not Image (or if the image
       failed to load. */
    IF NOT PreviewType OR Result eq NO THEN DO:     
      /* The "small" windows editor cannot load large files. */
      IF SESSION:WINDOW-SYSTEM BEGINS "MS-WIN" THEN DO:
        RUN EvaluateByteSize.
        IF ByteSize > 20000 THEN DO:
          TextDisplay:SCREEN-VALUE = FileContents.
          Result = yes.
        END.
        ELSE Result = TextDisplay:READ-FILE(FullFileName) NO-ERROR.
      END.
      ELSE Result = TextDisplay:READ-FILE(FullFileName) NO-ERROR.
      IF Result 
      THEN ASSIGN Container:VISIBLE        = FALSE
                  ImageDisplay:VISIBLE     = FALSE
                  TextDisplay:VISIBLE      = TRUE
                  PreviewType              = FALSE
                  PreviewType:SCREEN-VALUE = STRING(PreviewType).
      ELSE RUN LoadTextError.
    END.
  END.
END PROCEDURE.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE FullFileName f_findfile 
PROCEDURE FullFileName :
DO WITH FRAME {&FRAME-NAME}:
    /* Show nothing if no file is selected. */
    IF FileNameField = "(None)":U THEN FullFileName = "":U.
    ELSE DO:
      TempDir = IF DirList:SCREEN-VALUE = "" THEN "." ELSE DirList:SCREEN-VALUE.
  
      /* If TempDir ends with a ":" then do nothing. Otherwise, add a proper
      directory slash. */
      IF TempDir NE "" AND
        SUBSTRING(TempDir,LENGTH(TempDir,"CHARACTER"),1,"CHARACTER") NE ":" THEN
          TempDir = RIGHT-TRIM (TempDir,"~\/") + "{&DIR-SLASH}":U.
      FullFileName = TempDir + FileNameField.
    END.
  END.
END PROCEDURE.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE InitDirList f_findfile 
PROCEDURE InitDirList :
DEFINE VAR tempList AS CHAR NO-UNDO.
  
  ASSIGN pDirList = REPLACE(pDirList,"/","{&DIR-SLASH}")
         tempList = pDirList
         .
  DO WITH FRAME {&FRAME-NAME}:
    IF tempList = "" THEN DO:
      ASSIGN
        DirList             = "."
        FILE-INFO:FILE-NAME = DirList
        tempList            = FILE-INFO:FULL-PATHNAME
        .
    END.
    ELSE IF NUM-ENTRIES (tempList ) eq 1 THEN DO:
      DirList = tempList.
    END.      
    ELSE DO:
      /* The first item in the list is the initial directory.  If that item
         appears twice, then remove the first item.  For example:
           "a,b,c"   --> List is "a,b,c"; initial is "a"
           "b,a,b,c" --> List is "a,b,c"; initial is "b" */
      ASSIGN DirList  = ENTRY (1, tempList)
             tempList = SUBSTRING (tempList, LENGTH(DirList,"CHARACTER":U) + 2,
                                   -1, "CHARACTER":U).
      /* Does the first item appear again in the list? If not, keep DirList
         in the List. */
      IF LOOKUP (DirList, tempList) eq 0
      THEN tempList = DirList + ",":U + tempList.
    END.
    ASSIGN
      DirList:LIST-ITEMS   = tempList 
      DirList:SCREEN-VALUE = DirList.
  END.
END PROCEDURE.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE InitFindFile f_findfile 
PROCEDURE InitFindFile :
/*------------------------------------------------------------------------------
  Purpose:     
  Parameters:  <none>
  Notes:       
------------------------------------------------------------------------------*/
  DO WITH FRAME {&FRAME-NAME}:
    /*
    ** Initial screen assignments
    */
    ASSIGN
      pFileName                       = REPLACE(pFileName,"/","{&DIR-SLASH}")
      &if DEFINED(IDE-IS-RUNNING) = 0  &then 
      FRAME {&FRAME-NAME}:title       = (IF NOT pTitle BEGINS "Choose" THEN
                                          "Choose ":U ELSE "") + pTitle
      &endif                                          
      ImageDisplay:auto-resize        = FALSE
      TextDisplay:read-only           = TRUE
      pOK                             = FALSE
      FileType:delimiter              = "|"
      FileType:LIST-ITEM-PAIRS        = TRIM(pFilter)
      FileType:SCREEN-VALUE           = FileType:ENTRY(1)
      PreviewFile                     = TRUE
      PreviewFile:SCREEN-VALUE        = STRING(PreviewFile)
      PrefPreviewType                 = CAN-DO( "TEMPLATE,IMAGE", pMode)
      PreviewType                     = PrefPreviewType
      PreviewType:SCREEN-VALUE        = STRING(PreviewType)
      FileNameLabel:SCREEN-VALUE      = "&File:"
      FileNameLabel:side-label-handle = FileNameLabel:handle.

    ENABLE
        FileNameLabel
        FullFileNameField
        FileNameField
        FileList
        FileType
        DirList
        PreviewFile
        PreviewType
        EditPathButton
        BrowseButton
        Container
        ImageDisplay
        TextDisplay
      WITH FRAME {&FRAME-NAME}.
      
    RUN InitDirList.
    ASSIGN
      /* Don't show the radio-set unless we support two modes of Preview. */
      PreviewType:HIDDEN    = pMode ne "TEMPLATE"
      PreviewType:SENSITIVE = NOT PreviewType:HIDDEN
      FRAME {&FRAME-NAME}:hidden   = FALSE.

    /*
    ** Now initialize how FindFile will come up
    */
    IF pFileName <> "" AND pMode = "IMAGE" THEN DO:
      ASSIGN FileName = pFileName
             FullFileName = pFileName.         
      RUN InitpFileName (FALSE).
      IF RETURN-VALUE = "False" THEN
        APPLY "VALUE-CHANGED" TO DirList IN FRAME {&FRAME-NAME}.
    END.
    ELSE DO:
      APPLY "VALUE-CHANGED" TO DirList IN FRAME {&FRAME-NAME}.
    END.
    /*
    ** Now apply focus to the filelist
    */
    APPLY "ENTRY" TO FileList.
  
  END.

  /*
  Useful debug message ...
  message "pfilename" pfilename skip
  "pDirList" pdirlist skip
  "pFilter" pFilter skip
  "pMode" pMode
  view-as alert-box.
  */
END PROCEDURE.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE InitpFileName f_findfile 
PROCEDURE InitpFileName :
DEFINE INPUT PARAMETER pExtensionFlag AS LOGICAL NO-UNDO.
  
  DEFINE VARIABLE NewFileName   AS CHARACTER NO-UNDO.
  
  DO WITH FRAME {&FRAME-NAME}:
    RUN adecomm/_osprefx.p (pFileName, OUTPUT DirName, OUTPUT NewFileName).
    ASSIGN DirName = RIGHT-TRIM(DirName,"~\/":U) 
           FileNameField = NewFileName.
    RUN AddDirName.
    /* Note the new directory.  This will also set the File Name. */
    ExtensionFlag = pExtensionFlag.
    APPLY "VALUE-CHANGED" TO DirList.
  END.
END PROCEDURE.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE LoadImageError f_findfile 
PROCEDURE LoadImageError :
DO WITH FRAME {&FRAME-NAME}:
    RUN ClearContents.
    ASSIGN 
       TextDisplay:SCREEN-VALUE = TRIM(FullFileName)  + " could not be" + CHR(10) 
                                                      + "loaded successfully as an image." 
       TextDisplay:HIDDEN       = FALSE.
       
END.
END PROCEDURE.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE LoadTextError f_findfile 
PROCEDURE LoadTextError :
DO WITH FRAME {&FRAME-NAME}:
    RUN ClearContents.
    BELL.
    &if DEFINED(IDE-IS-RUNNING) <> 0 &then
        ShowMessageInIDE(TRIM(FullFileName) + " could not be loaded successfully.",
                         "Error",?,"OK",yes).
      
    &else
    MESSAGE TRIM(FullFileName) "could not be loaded successfully."
      VIEW-AS ALERT-BOX ERROR.
    &endif  
  END.
END PROCEDURE.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE Make_Rel f_findfile 
PROCEDURE Make_Rel :
/*------------------------------------------------------------------------------
  Purpose:     If file can be found in the PROPATH, return relative filename
  Parameters:  pFileName (char)
  Notes:       
------------------------------------------------------------------------------*/
DEFINE INPUT-OUTPUT PARAMETER pFileName AS CHARACTER NO-UNDO.

DEFINE VARIABLE i AS INTEGER NO-UNDO.

DO i = 1 to NUM-ENTRIES(PROPATH):
  IF pFileName BEGINS TRIM(ENTRY(i,PROPATH))        AND
                      TRIM(ENTRY(i,PROPATH)) NE ""  AND
                      TRIM(ENTRY(i,PROPATH)) NE "." THEN 
  DO:
    /* If it's there, chop off the leading part */
    ASSIGN pFileName = SUBSTRING(pFileName, LENGTH(ENTRY(i,PROPATH)) + 2, -1, "CHARACTER":U).
    LEAVE.
  END.
END.
END PROCEDURE.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE MatchFileName f_findfile 
PROCEDURE MatchFileName :
DEFINE INPUT PARAMETER ExtensionFlag AS LOGICAL.

  DO WITH FRAME {&FRAME-NAME}:
    Matched = FALSE.

    FirstComparison:
    DO i = 1 TO FileList:num-items:
      /*
      ** this loop is necessary to compensate for a bug in Progress
      */
      IF ExtensionFlag THEN DO:
        IF FileList:ENTRY(i) = FileNameField THEN DO:
          FileList:SCREEN-VALUE = FileNameField.
          Matched = TRUE.
          LEAVE FirstComparison.
        END.
      END.
      ELSE DO:
        IF ENTRY(1,FileList:ENTRY(i),".") = FileNameField THEN DO:
          FileList:SCREEN-VALUE = Filelist:ENTRY(i).
          Matched = TRUE.
          LEAVE FirstComparison.
        END.
      END.
    END.
  END.
END PROCEDURE.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE PopulateFileList f_findfile 
PROCEDURE PopulateFileList :
/******************************************************************************
 Procedure: PopulateFileList
 Description: Fills the file list with the contents of the current selected
              directory & filter.  NOTE that MS-WINDOWS uses a custom DLL
              to do this.  Otherwise we use the PROGRESS OS-DIR stream.
 ******************************************************************************/
  DEFINE VARIABLE CurDir    AS CHARACTER NO-UNDO.
  DEFINE VARIABLE Use_DLL   AS LOGICAL   NO-UNDO.
  DEFINE VARIABLE DirPrefix AS CHARACTER NO-UNDO.
  DEFINE VARIABLE DirBase   AS CHARACTER NO-UNDO.
  
  DO WITH FRAME {&FRAME-NAME} ON ERROR UNDO, RETURN "False":
    RUN adecomm/_setcurs.p ("WAIT":U).
    /* Standard initializations. */
    ASSIGN
      CurFilter           = ""
      FILE-INFO:FILE-NAME = IF DirList:SCREEN-VALUE = "" 
                              OR DirList:SCREEN-VALUE = "?" THEN "."
                            ELSE DirList:SCREEN-VALUE.
      CurDir               = FILE-INFO:FULL-PATHNAME 
      .
    
    /* The DLL currently has a bug which prevents it from reading
     * correctly from a root directory. In that case, the "unix"
     * style will be used below .
     */
    IF LOOKUP(OPSYS, "MSDOS,WIN32":u) > 0 THEN
    DO:
        RUN adecomm/_osprefx.p
            (INPUT CurDir, OUTPUT DirPrefix, OUTPUT DirBase).
        /* If the directory path is not the same as the directory prefix,
           then we do not have a root drive, so use the DLL. */
        ASSIGN Use_DLL = (CurDir <> DirPrefix).
    END.
    
    IF Use_DLL THEN
    DO:
      /*
      ** MS/DOS File processing ...
      */
      ASSIGN
        SET-SIZE(list-mem)  = list-size
        list-char           = "" /* init to blank */
        CurDir              = LC(CurDir)
        CurFilter           = IF FileType:SCREEN-VALUE = "" THEN "*.*" ELSE
                              FileType:SCREEN-VALUE
        .

      RUN file_search (CurDir,CurFilter,INPUT-OUTPUT list-mem,list-size,
                       OUTPUT missed-file, OUTPUT DirError).

      IF DirError <> 0 THEN DO:
        RUN adecomm/_setcurs.p ("":U).
        SET-SIZE(list-mem) = 0.
        &if DEFINED(IDE-IS-RUNNING) <> 0 &then
        ShowMessageInIDE("Error in directory search.",
                         "Error",?,"OK",yes).
      
        &else
        MESSAGE "Error in directory search." 
          VIEW-AS ALERT-BOX ERROR.
        &endif  
        RETURN "False".
      END.
      
      IF missed-file > 0 THEN DO:
        &if DEFINED(IDE-IS-RUNNING) <> 0 &then
        ShowMessageInIDE("Too many files in your directory.~n
                          The file list may not be inclusive.",
                         "Information",?,"OK",yes).
      
        &else  
        MESSAGE "Too many files in your directory." SKIP
          "The file list may not be inclusive."
          VIEW-AS ALERT-BOX INFORMATION.
        &endif  
      END.
      
      ASSIGN
        list-char                  = GET-STRING(list-mem,1)
        SET-SIZE(list-mem)         = 0
        FileList                   = IF list-char <> "" THEN 
                                       "(None),":U + LC(list-char)
                                     ELSE "(None)":U
        .
    END.
    ELSE DO:
      /*
      ** UNIX file processing
      */
      RUN adecomm/_setcurs.p ("WAIT":U).
    
      DEFINE VARIABLE TempType AS CHARACTER NO-UNDO.
      ASSIGN
        i                          = 0
        FileList:LIST-ITEMS        = ""
        FileList:SCREEN-VALUE      = ""
        FileNameField:SCREEN-VALUE = ""
        NewFilter                  = ""
        FileStream                 = ""
        ListOfFiles                = "".
      /*
      ** First, parse the Filetype combo for multiple file types and construct 
      ** a new filter that will be used by the lookup function to compare values
      */
      DO i = 1 TO NUM-ENTRIES(FileType:SCREEN-VALUE,",":U):
        CurFilter = ENTRY(i,FileType:SCREEN-VALUE,",":U).
        IF NUM-ENTRIES(CurFilter,".") > 1 
        THEN CurFilter = ENTRY(2,CurFilter,".":U). 
        IF i = 1
        THEN NewFilter = CurFilter.
        ELSE NewFilter = NewFilter + "," + CurFilter .
      END.
    
      /*
      ** Fill up an input stream of files
      */
    
      INPUT FROM OS-DIR(CurDir) ECHO.
      REPEAT:
        IMPORT FileStream.
        FileStream = FileStream.
    
        IF NewFilter = "*.*" OR NewFilter = "*" THEN DO:
          /*
          ** For filter of "*.*" process everything except hidden files and 
          ** directories. Note: the FILE-INFO function doesn't work right and 
          ** still returns many directories
          */
          FILE-INFO:FILENAME = FileStream.
          Result = IF FILE-INFO:FILE-TYPE BEGINS "D" 
                     OR FileStream BEGINS "." THEN FALSE ELSE TRUE.
          IF Result THEN
            ListOfFiles = IF ListOfFiles = "" THEN FileStream
                          ELSE ListOfFiles + "," + FileStream.
        END.
        ELSE DO:
          /*
          ** For specific filetypes, this code screens files from the stream
          */
          /* WIN95-LFN - Windows 95 Long Filename support - jep 12/12/95 */
          RUN adecomm/_osfext.p
              (INPUT  FileStream  /* OS File Name.   */ ,
               OUTPUT TempType    /* File Extension. */ ).
          ASSIGN TempType = TRIM(TempType , ".").
    
          IF LOOKUP(TempType, NewFilter) > 0 THEN
            ListOfFiles = IF ListOfFiles = "" THEN FileStream
                          ELSE ListOfFiles + "," + FileStream.
        END.
      END.
      INPUT CLOSE.
      /*
      ** If this is Motif, the stream needs to be sorted
      */
      RUN adecomm/_sortstr.p (INPUT-OUTPUT ListOfFiles, INPUT ",").
      IF LOOKUP(OPSYS , "MSDOS,WIN32":u) > 0 THEN ListOfFiles = LC(ListOfFiles).
      FileList = IF TRIM(ListOfFiles) = "" THEN "(None)"
                 ELSE "(None)," + ListOfFiles.
      
    END.
    /*
    ** Now do some final assigns.  See if the current FileNameField matches.
    */
    Filelist:LIST-ITEMS = FileList.
    RUN MatchFileName (ExtensionFlag).
    IF NOT Matched
    THEN ASSIGN
            FileList:SCREEN-VALUE      = IF FileList:NUM-ITEMS eq 1 
                                         THEN FileList:ENTRY(1)
                                         ELSE FileList:ENTRY(2)
            FileNameField:SCREEN-VALUE = FileList:SCREEN-VALUE
            FileNameField              = FileNameField:SCREEN-VALUE.
      
    RUN adecomm/_setcurs.p ("":U).
    RETURN "True".

  END. /* DO WITH FRAME... */
END PROCEDURE.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME

/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/*--------------------------------------------------------------------

IMPORTANT: THIS PROGRAM CANNOT BE RAN WITH NO _DB-RECORD IN THE SYSTEM!!

File: adecomm/_getconp.p

Description:
  parses the connection-parameters of the databases (according to
  p_user_dbname) and returns them within the corresponding parameters

Input-Parameters:
  p_user_dbname logical name of the DB to be connected

Output-Parameters:
  p_db          physical db-name
  p_ld          logical db-name
  p_dt          db-type
  p_tl          trigger-file-name
  p_pf          parameter-file
  p_1           multi-user ?
  p_network     network type (-N)
  p_host        host name (-H)
  p_service     service name (-S)
  p_u           user-id
  p_p           password
  p_r1          rest of parameters 1. line
  p_r2          rest of parameters 2. line
  p_r3          rest of parameters 3. line

Used/Modified Shared Objects:
  none

Author: Tom Hutegger

History:
  hutegger    94/03/31    creation
  hutegger    94/05/02    removed .ai and .bi-handling
  j.palazzo   95/04/17    Added p_network, p_host, p_service.
  D.Adams     95/05/12    Moved from prodict/misc to adecomm
  D.McMann    01/16/98    Changed so -S would not fine -Sn instead
                          97-10-27-022

NOTE: I use this file only from within
        prodict/user/_usrscon.p
        adedict/DB/_connect.p.

      There the physical db-name and the db-type are already known, so I 
      don't care about that around here.

--------------------------------------------------------------------*/

/*----------------------------  DEFINES  ---------------------------*/

DEFINE INPUT        PARAMETER p_user_dbname AS CHARACTER.
DEFINE INPUT-OUTPUT PARAMETER p_db          AS CHARACTER.
DEFINE INPUT-OUTPUT PARAMETER p_ld          AS CHARACTER.
DEFINE INPUT-OUTPUT PARAMETER p_dt          AS CHARACTER.
DEFINE OUTPUT       PARAMETER p_tl          AS CHARACTER.
DEFINE OUTPUT       PARAMETER p_pf          AS CHARACTER.
DEFINE OUTPUT       PARAMETER p_1           AS LOGICAL.
DEFINE OUTPUT       PARAMETER p_network     AS CHARACTER.
DEFINE OUTPUT       PARAMETER p_host        AS CHARACTER.
DEFINE OUTPUT       PARAMETER p_service     AS CHARACTER.
DEFINE OUTPUT       PARAMETER p_u           AS CHARACTER.
DEFINE OUTPUT       PARAMETER p_p           AS CHARACTER.
DEFINE OUTPUT       PARAMETER p_r1          AS CHARACTER.
DEFINE OUTPUT       PARAMETER p_r2          AS CHARACTER.
DEFINE OUTPUT       PARAMETER p_r3          AS CHARACTER.

DEFINE VARIABLE ix         AS INTEGER   NO-UNDO.
DEFINE VARIABLE l_stri     AS CHARACTER NO-UNDO.

/*---------------------------  TRIGGERS  ---------------------------*/

/*------------------------  INT.-PROCEDURES  -----------------------*/

/*---------------------------  MAIN-CODE  --------------------------*/

FIND FIRST _db WHERE _db._db-name = p_user_dbname NO-LOCK NO-ERROR.
IF AVAILABLE _db THEN DO:   /* try to scan for specific parameters */
  ASSIGN
    l_stri = " ":u + _db._db-comm
    p_db   = ( IF _Db._Db-addr <> "" THEN _Db._Db-addr ELSE "").

  /* replace CarriageReturns by Blanks to make text scanable */
  REPEAT WHILE INDEX(l_stri,CHR(10)) <> 0:
    ASSIGN SUBSTRING(l_stri,INDEX(l_stri,CHR(10)),-1,"CHARACTER":u) = " ":u.
  END.

  IF INDEX(l_stri," -db":u) <> 0 THEN
    ASSIGN
      p_db   = SUBSTRING(l_stri,INDEX(l_stri," -db":u) + 5,-1,"CHARACTER":u)
      p_db   = SUBSTRING(p_db,1,INDEX(p_db + " ":u," ":u),"CHARACTER":u)
      l_stri = SUBSTRING(l_stri,1,INDEX(l_stri," -db":u),"CHARACTER":u) 
             + SUBSTRING(l_stri,INDEX(l_stri," -db":u) + 5 
               + LENGTH(p_db,"CHARACTER":u),-1,"CHARACTER":u).

  IF INDEX(l_stri," -ld":u) <> 0 THEN
    ASSIGN
      p_ld   = SUBSTRING(l_stri,INDEX(l_stri," -ld":u) + 5,-1,"CHARACTER":u)
      p_ld   = SUBSTRING(p_ld,1,INDEX(p_ld + " ":u," ":u) - 1,"CHARACTER":u)
      l_stri = SUBSTRING(l_stri,1,INDEX(l_stri," -ld":u),"CHARACTER":u)
             + SUBSTRING(l_stri,INDEX(l_stri," -ld":u) + 5 
               + LENGTH(p_ld,"CHARACTER":u),-1,"CHARACTER":u).

  IF INDEX(l_stri," -dt":u) <> 0 THEN
    ASSIGN
      p_dt   = SUBSTRING(l_stri,INDEX(l_stri," -dt":u) + 5,-1,"CHARACTER":u)
      p_dt   = SUBSTRING(p_dt,1,INDEX(p_dt + " ":u," ":u) - 1,"CHARACTER":u)
      l_stri = SUBSTRING(l_stri,1,INDEX(l_stri," -dt":u),"CHARACTER":u)
             + SUBSTRING(l_stri,INDEX(l_stri," -dt":u) + 5 
               + LENGTH(p_dt,"CHARACTER":u),-1,"CHARACTER":u).

  IF INDEX(l_stri," -trig":u) <> 0 THEN
    ASSIGN
      p_tl   = SUBSTRING(l_stri,INDEX(l_stri," -trig":u) + 7,-1,"CHARACTER":u)
      p_tl   = SUBSTRING(p_tl,1,INDEX(p_tl + " ":u," ":u),"CHARACTER":u)
      l_stri = SUBSTRING(l_stri,1,INDEX(l_stri," -trig":u),"CHARACTER":u) 
             + SUBSTRING(l_stri,INDEX(l_stri," -trig":u) 
             + 7 + LENGTH(p_tl,"CHARACTER":u),-1,"CHARACTER":u).

  IF INDEX(l_stri," -pf":u) <> 0 THEN
    ASSIGN
      p_pf   = SUBSTRING(l_stri,INDEX(l_stri," -pf":u) + 5,-1,"CHARACTER":u)
      p_pf   = SUBSTRING(p_pf,1,INDEX(p_pf + " ":u," ":u),"CHARACTER":u)
      l_stri = SUBSTRING(l_stri,1,INDEX(l_stri," -pf":u),"CHARACTER":u) 
             + SUBSTRING(l_stri,INDEX(l_stri," -pf":u) 
             + 5 + LENGTH(p_pf,"CHARACTER":u),-1,"CHARACTER":u).

  IF INDEX(l_stri," -1":u) <> 0 THEN
    ASSIGN
      p_1    = FALSE
      l_stri = SUBSTRING(l_stri,1,INDEX(l_stri," -1":u),"CHARACTER":u) 
             + SUBSTRING(l_stri,INDEX(l_stri," -1":u) + 4,-1,"CHARACTER":u).
  ELSE
    ASSIGN
      p_1    = TRUE.

  IF INDEX(l_stri," -N":u) <> 0 THEN
    ASSIGN
      p_network = SUBSTRING(l_stri,INDEX(l_stri," -N":u) + 4,-1,"CHARACTER":u)
      p_network = SUBSTRING(p_network,1,INDEX(p_network + " ":u," ":u),
                            "CHARACTER":u)
      l_stri    = SUBSTRING(l_stri,1,INDEX(l_stri," -N":u),"CHARACTER":u) 
                + SUBSTRING(l_stri,INDEX(l_stri," -N":u) + 4
                  + LENGTH(p_network,"CHARACTER":u),-1,"CHARACTER":u).

  IF INDEX(l_stri," -H":u) <> 0 THEN
    ASSIGN
      p_host    = SUBSTRING(l_stri,INDEX(l_stri," -H":u) + 4,-1,"CHARACTER":u)
      p_host    = SUBSTRING(p_host,1,INDEX(p_host + " ":u," ":u),"CHARACTER":u)
      l_stri    = SUBSTRING(l_stri,1,INDEX(l_stri," -H":u),"CHARACTER":u) 
                + SUBSTRING(l_stri,INDEX(l_stri," -H":u) + 4 
                  + LENGTH(p_host,"CHARACTER":u),-1,"CHARACTER":u).

  IF INDEX(l_stri," -S ":u) <> 0 THEN
    ASSIGN
      p_service = SUBSTRING(l_stri,INDEX(l_stri," -S":u) + 4,-1,"CHARACTER":u)
      p_service = SUBSTRING(p_service,1,INDEX(p_service + " ":u," ":u),
                            "CHARACTER":u)
      l_stri    = SUBSTRING(l_stri,1,INDEX(l_stri," -S":u),"CHARACTER":u) 
                + SUBSTRING(l_stri,INDEX(l_stri," -S":u) + 4
                  + LENGTH(p_service,"CHARACTER":u),-1,"CHARACTER":u).

  IF INDEX(l_stri," -U":u) <> 0 THEN
    ASSIGN
      p_u    = SUBSTRING(l_stri,INDEX(l_stri," -U":u) + 4,-1,"CHARACTER":u)
      p_u    = SUBSTRING(p_u,1,INDEX(p_u + " ":u," ":u),"CHARACTER":u)
      l_stri = SUBSTRING(l_stri,1,INDEX(l_stri," -U":u),"CHARACTER":u) 
             + SUBSTRING(l_stri,INDEX(l_stri," -U":u) + 4
               + LENGTH(p_u,"CHARACTER":u),-1,"CHARACTER":u).

  IF INDEX(l_stri," -P":u) <> 0 THEN
    ASSIGN
      p_p    = SUBSTRING(l_stri,INDEX(l_stri," -P":u) + 4,-1,"CHARACTER":u)
      p_p    = SUBSTRING(p_p,1,INDEX(p_p + " ":u," ":u),"CHARACTER":u)
      l_stri = SUBSTRING(l_stri,1,INDEX(l_stri," -P":u),"CHARACTER":u) 
             + SUBSTRING(l_stri,INDEX(l_stri," -P":u) + 4 
               + LENGTH(p_p,"CHARACTER":u),-1,"CHARACTER":u).

  ASSIGN l_stri = TRIM(l_stri).

  IF LENGTH(l_stri,"CHARACTER":u) > 64 THEN
    ASSIGN
      p_r1   = SUBSTRING(l_stri,1,64,"CHARACTER":u)
      l_stri = SUBSTRING(l_stri,65,-1,"CHARACTER":u).
  ELSE
    ASSIGN 
      p_r1   = l_stri
      l_stri = "".

  IF LENGTH(l_stri,"CHARACTER":u) > 64 THEN
    ASSIGN 
      p_r2   = SUBSTRING(l_stri,1,64,"CHARACTER":u)
      l_stri = SUBSTRING(l_stri,65,-1,"CHARACTER":u).
  ELSE
    ASSIGN
      p_r2   = l_stri
      l_stri = "".

  IF LENGTH(l_stri,"CHARACTER":u) > 64 THEN
    ASSIGN 
      p_r3   = SUBSTRING(l_stri,1,64,"CHARACTER":u)
      l_stri = SUBSTRING(l_stri,65,-1,"CHARACTER":u).
  ELSE
    ASSIGN 
      p_r3   = l_stri
      l_stri = "".
END. 

/* _getconp.p - end of file */

/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/
/*----------------------------------------------------------------------------

File: _getdbid.p

Description:
   This will make sure your selected database is connected, then
   find the recid of an _db record.  If you pass the name of a 
   gateway database, it puts DICTDB on the schema holder database.

Input Parameters:
   p_DBName  - This is the name of the database you want to find.

Output Parameters:
   p_DBID   - The recid of the _DB record.  ? if the db was not found.

Author: Warren Bare

Date Created: 06/30/92 

----------------------------------------------------------------------------*/

Define INPUT  PARAMETER p_DBName    as char     NO-UNDO.
Define OUTPUT PARAMETER p_DBID      as recid    NO-UNDO.

Define Var v_DBCount as int no-undo. /* loop through connected dbs */

/* if this is a schema holder, then find it in the right progress db */
IF NOT CONNECTED(p_DBName) OR DBTYPE(p_DBName) NE "Progress" THEN
do:
  FindDB:
  do v_DBCount = 1 to num-dbs:
    IF DBTYPE(v_DBCount) = "PROGRESS" THEN
    DO:
      create alias dictdb for database VALUE(ldbname(v_DBCount)).
      RUN adecomm/_finddb.p (INPUT p_DBName, OUTPUT p_DBID).
      IF p_DBID NE ? THEN leave FindDB.
    END.
  end.
end.
else /* just put the alias on this db */
DO:
  IF LDBNAME("DICTDB") <> p_DBName THEN
    create alias DICTDB for database VALUE(p_DBName).
  RUN adecomm/_finddb.p (INPUT ?, OUTPUT p_DBID).
END.

RETURN.
/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/*--------------------------------------------------------------------

File: adecomm/_getdbs.p

Description:
    
    creates s_ttb_db-records for all connected physical PROGRESS-Dbs
    and all auto-connect records.
            
Input-Parameters:
    none

Output-Parameters:
    none
    
Used/Modified Shared Objects:
    s_ttb_db    Temp-Table containing a record for EACH AND EVERY
                available DB


Author: Tom Hutegger

History:
    hutegger    95/06   creation
    hutegger    95/08   added dbrcd, empty and dspnm fields

                            
--------------------------------------------------------------------*/
/*h-*/

/*----------------------------  DEFINES  ---------------------------*/

{ prodict/dictvar.i NEW }

define         variable     l_curr-db as integer init 1.
define         variable     l_dbnr    as integer.

{ adecomm/getdbs.i }

/*------------------------  INT.-PROCEDURES  -----------------------*/

/*---------------------------  MAIN-CODE  --------------------------*/


/* determine current DICTDB */

repeat l_dbnr = 1 to NUM-DBS:
  if LDBNAME("DICTDB") = LDBNAME(l_dbnr)
   then assign l_curr-db = l_dbnr.
  end.


/* generate temp-table records for all available dbs */

repeat l_dbnr = 1 to NUM-DBS:

if DBTYPE(l_dbnr) <> "PROGRESS" then next.  /* SchemaHolders later */

  run adecomm/_setalia.p
    ( INPUT l_dbnr
    ).

  run adecomm/_getpdbs.p
    ( INPUT l_dbnr
    ).

  end.


/* reset DICTDB to the db it pointed when we came in, or delete it */

if LDBNAME(l_curr-db) = ?
 then delete alias DICTDB.
 else run adecomm/_setalia.p
        ( INPUT l_curr-db
        ).

/*------------------------------------------------------------------*/
/*********************************************************************
* Copyright (C) 2005 by Progress Software Corporation. All rights    *
* reserved.  Prior versions of this work may contain portions        *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/*----------------------------------------------------------------------------

File: _getdlst.p

Description:
   Fill a selection list with SmartData fields.  The fields will be ordered either
   alphabetically or by order #.  
Input Parameters:
   p_List   - Handle of the selection list widget to add to.
              p_List:private-data is a comma seperated list of items
              NOT to be added. OR no items if the entire table-list is
              to be added.
   p_hSmartData  - Handle of the SmartData to which these fields belong.
   p_Alpha  - TRUE if order should be alphabetical, FALSE if we want to
              order by the field order in the temp table. Should default to 
              order for the temp table fields... specially for a browse
              querying the SmartObject
   p_Items  - List of fields to included in list.  If this parameter is
              blank, then just the field name is put in the list.  Currently
              the parameter can have the following values in any order:
              1 - just the field name - this is the default
              2 - tablename.fldname
              3 - dbname.tablename.fldname
              T - Name of table containing the field
              F - Format
   p_DType  - The data type to screen for.  If this is ?, then don't screen.
              Otherwise this must be either
                      "character"
                      "date"
                      "decimal"
                      "integer"
                      "logical"
                      "recid"
Output Parameters:
  p_Stat   - Set to TRUE if list is retrieved (even if there were no fields
      	      this is successful).  Set to FALSE, if user doesn't have access
      	      to fields.
Author: SLK
Date Created: 02/98
Copied from _getflst.p
Modified:   mm/dd/yyyy  SLK use of dynamic-function instead of get.
            3/16/1998   JEP Assign correct value to fDataType when
                            creating sdoData records.
            01/12/2000  Tomn  Allow for the p_Items value to be a "|" delimited
                              list: The first element being the same as the 
                              original value (fields to include) and the second
                              being an optional table name to use instead of
                              the hard-coded "RowObject" name.
            05/18/2000  BSG  Allow columnDataType to request a qualified field
                             for support of SBOs 
----------------------------------------------------------------------------*/

DEFINE INPUT  PARAMETER p_List         AS WIDGET-HANDLE NO-UNDO.
DEFINE INPUT  PARAMETER p_hSmartData        AS WIDGET-HANDLE NO-UNDO.
DEFINE INPUT  PARAMETER p_Alpha        AS LOGICAL       NO-UNDO.
DEFINE INPUT  PARAMETER p_Items        AS CHARACTER     NO-UNDO.
DEFINE INPUT  PARAMETER p_DType        AS CHARACTER     NO-UNDO.
DEFINE OUTPUT PARAMETER p_Stat         AS LOGICAL   	NO-UNDO.
/* DEFINE VARIABLE err       AS LOGICAL        NO-UNDO. */
DEFINE VARIABLE widg        AS widget-handle  NO-UNDO.
DEFINE VARIABLE seq         AS INTEGER        NO-UNDO.
DEFINE VARIABLE v_ItemCnt   AS INTEGER        NO-UNDO.
DEFINE VARIABLE i           AS INTEGER        NO-UNDO.
DEFINE VARIABLE cItems      AS CHARACTER      NO-UNDO.
DEFINE VARIABLE cTable      AS CHARACTER      NO-UNDO.

DEFINE VARIABLE cCurrField  AS CHARACTER      NO-UNDO.
DEFINE VARIABLE cCurrTable  AS CHARACTER      NO-UNDO.

DEFINE VARIABLE FldList AS CHARACTER NO-UNDO.
define variable hColumn         as handle                no-undo.
define variable lDbAware        as logical               no-undo.


DEFINE TEMP-TABLE sdoData NO-UNDO
       FIELD seq       AS INTEGER
       FIELD ftable    AS CHARACTER
       FIELD fname     AS CHARACTER
       FIELD fformat   AS CHARACTER
       FIELD fdatatype AS CHARACTER
     INDEX seq IS PRIMARY seq
     INDEX table-name ftable fname.

/************************* Function Prototypes ***************************/

FUNCTION fieldDataType
  RETURNS CHARACTER
  (INPUT icObject AS CHARACTER,
   INPUT icField AS CHARACTER) FORWARD.


/************************* Inline code section ***************************/

/* If the SmartData object handle is invalid, tell user and return. jep-code */
IF NOT VALID-HANDLE(p_hSmartData) THEN DO:
  MESSAGE "Could not access data field information.":t SKIP(1)
          "The data object is not active."
    VIEW-AS ALERT-BOX ERROR BUTTONS OK.
  p_Stat = FALSE.
  RETURN.
END.

FldList = dynamic-function("getDataColumns" IN p_hSmartData).
IF FldList = "" OR FldList = ? THEN DO:
  MESSAGE "The data object has no field information.":t
    VIEW-AS ALERT-BOX ERROR BUTTONS OK.
  p_Stat = FALSE.
  RETURN.
END.

/* Split out the (possible) multiple elements in p_Items and put them in
 * separate variables.
 */
ASSIGN
   cItems = ENTRY(1, p_Items, "|":U)
   cTable = IF NUM-ENTRIES(p_Items, "|":U) > 1 THEN ENTRY(2, p_Items, "|":U) ELSE ?.
/* default to field name. 3 = database.table.field which is not relevant 
 * to a smartData. 2=table.field which is still relevant to a SmartData
 * but the temp table name is hardcoded to rowObject 
 */

IF cItems = "" OR cItems = "3" THEN cItems = "1":U.

/* Give me the parent of the selection list */
ASSIGN widg = p_List:parent       /* gives me the group */
       widg = widg:parent.        /* gives me the frame */

RUN adecomm/_setcurs.p ("WAIT":u).

/* Determine whether this data obejct is a Dataview or SDO */
{get DbAware lDbAware p_hSmartData}.

DO i = 1 to NUM-ENTRIES(FldList):
   cCurrField = ENTRY(i,FldList).
   /* Use qualifer if the field list is qualified (SBOs and DataViews) */
   IF i = 1 THEN 
     cItems = STRING(NUM-ENTRIES(cCurrField,".":U)).

   cCurrTable = IF NUM-ENTRIES(cCurrField,".":U) >= 2 THEN 
                ENTRY(NUM-ENTRIES(cCurrField,".":U) - 1,cCurrField,".":U) 
                ELSE "RowObject":U.
   
   cCurrField = ENTRY(NUM-ENTRIES(cCurrField,".":U),cCurrField,".":U).
       
   IF cTable <> ? THEN 
   do:
       /* If this is a DataView, and a table has been passed to the API
	      via p_Items, then only show the fields that belong to that table.
	    */
       if not lDbAware and cTable ne cCurrTable then
           next.
       else
           cCurrTable = cTable.
   end.    /* table specified */
   
   /* Array fields are not supported for DataViews. We may at some point
      expand the use of the p_Dtype parameter to be able to generically 
      exclude (rather than include) fields on data type, and may add support
      for arrays there.
    */
   if not lDbAware then
   do:
       hColumn = {fnarg ColumnHandle "cCurrTable + '.':u + cCurrField" p_hSmartData}.
       if valid-handle(hColumn) and hColumn:Extent gt 0 then
           next.
   end.    /* db aware */
   
   CREATE sdoData.
   ASSIGN seq               = seq + 1
          sdoData.seq       = seq
          sdoData.fTable    = cCurrTable
          sdoData.fName     = cCurrField.

   /* Get the column data type from the object. If the table is RowObject,
      we're dealing with an SDO and the code doesn't need to qualify the
      field name. Otherwise we need to qualify the field name with the 
      table name (ObjectName in the SBO) so the SBO can go and figure
      out what the data type of the field is. */
   sdoData.fDataType = dynamic-function("columnDataType" IN p_hSmartData, 
                                        INPUT (IF sdoData.fTable = "RowObject":U THEN "":U ELSE sdoData.fTable + ".":U) 
                                              + sdoData.fName).
END.

IF p_Alpha THEN DO:
  IF p_DType = ? THEN
    FOR EACH sdoData BY sdoData.fName:
      p_List:ADD-LAST(IF cItems eq "1" THEN sdoData.fName
                 ELSE IF cItems eq "2" THEN sdoData.fTable + "." + sdoData.fName
                 ELSE sdoData.fName).
    END.
  ELSE
    FOR EACH sdoData WHERE sdoData.fDataType = p_DType BY sdoData.fName:
      p_List:ADD-LAST(IF cItems eq "1" THEN sdoData.fName
                 ELSE IF cItems eq "2" THEN sdoData.fTable + "." + sdoData.fName
                 ELSE sdoData.fName).
    END.
END.
ELSE DO:
  IF p_DType = ? THEN
    FOR EACH sdoData:
      p_List:ADD-LAST(IF cItems eq "1" THEN sdoData.fName
                 ELSE IF cItems eq "2" THEN sdoData.fTable + "." + sdoData.fName
                 ELSE sdoData.fName).
    END.
  ELSE
    FOR EACH sdoData WHERE sdoData.fdataType = p_DType:
       p_List:ADD-LAST(IF cItems eq "1" THEN sdoData.fName
                 ELSE IF cItems eq "2" THEN sdoData.fTable + "." + sdoData.fName
                 ELSE sdoData.fName).
    END.
END.

RUN adecomm/_setcurs.p ("").
p_Stat = TRUE.

RETURN.

/* _getdlst.p - end of file */
/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/
/*--------------------------------------------------------------------

File: adecomm/_getfdbs.p

Description:
    
    creates s_ttb_db-records for all foreign schemas in this physical
    PROGRESS-Db
            
Input-Parameters:
    p_sdbnm     Name of SchemaHolder
    p_sdbnm     Name of SchemaHolder
    p_vrsn      Version of SchemaHolder

Output-Parameters:
    none
    
Used/Modified Shared Objects:
    none
    
Author: Tom Hutegger

History:
    hutegger    94/06   creation
    hutegger    95/08   added dbrcd, empty and dspnm fields
    mcmann      00/07   Added check for _db-type = PROGRESS so duplicate
                        s_ttb_db records won't be created when auto connect
                        records are present.

                            
--------------------------------------------------------------------*/
/*h-*/

/*----------------------------  DEFINES  ---------------------------*/

define input parameter p_dbnr       as integer.
define input parameter p_sdbnm      as character.
define input parameter p_vrsn       as character.

{ adecomm/getdbs.i }

/*------------------------  INT.-PROCEDURES  -----------------------*/

/*---------------------------  MAIN-CODE  --------------------------*/

/*------------------------------------------------------------------*/

for each DICTDB._Db NO-LOCK:

  if  DICTDB._Db._Db-local = TRUE          /* not a foreign schema  */
   or DICTDB._Db._Db-name  = "z_ora_links" /* for internal use only */
   OR DICTDB._Db._Db-type = "PROGRESS"    /* Only foreign wanted */
   then next.

  IF INTEGER(DBVERSION("DICTDB":U)) > 8 THEN
    find first DICTDB._File of DICTDB._Db WHERE
      LOOKUP(DICTDB._FILE._OWNER,"_FOREIGN":U) > 0      
      no-lock no-error.                     
  ELSE
    find first DICTDB._File of DICTDB._Db
         where DICTDB._File._File-num > 0   /* foregin schemas don't  */
      no-lock no-error.                     /* have negativ file-num  */
   

    create s_ttb_db.
    assign
      s_ttb_db.cnnctd = CONNECTED(DICTDB._Db._Db-name)
      s_ttb_db.dbnr   = p_dbnr
      s_ttb_db.dbrcd  = RECID(DICTDB._Db)
      s_ttb_db.dbtyp  = { adecomm/ds_type.i
                        &direction = "itoe"
                        &from-type = "DICTDB._Db._Db-type"
                      }
      s_ttb_db.dspnm  = DICTDB._Db._Db-name + "(" + p_sdbnm + ")"
      s_ttb_db.empty  = NOT available DICTDB._File
      s_ttb_db.ldbnm  = DICTDB._Db._Db-name
      s_ttb_db.local  = FALSE
      s_ttb_db.pdbnm  = ( if CONNECTED(DICTDB._Db._Db-name)
                          then PDBNAME(DICTDB._Db._Db-name)
                          else DICTDB._Db._Db-addr
                      )
      s_ttb_db.sdbnm  = p_sdbnm
      s_ttb_db.vrsn   = p_vrsn.
  
  end.

/*------------------------------------------------------------------*/
/*********************************************************************
* Copyright (C) 2005 by Progress Software Corporation. All rights    *
* reserved.  Prior versions of this work may contain portions        *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/
/*----------------------------------------------------------------------------

File: _getfile.p

Description:
    This is the ADE version of the SYSTEM-DIALOG GET-FILE call.
    
    It provides one level of indirection to the SYSTEM-DIALOG in case a 
    ADE user/developer wants to intercept OPEN/SAVEs from ADE applications
    where the source code is not provided.
    
    Not all ADE tools use _getfile.p (because their source code is provided
    and a developer can add custom hooks).  
    
    By modifying _getfile.p, you can intercept or filter all file/open
    or file/save as... actions.  By looking at the combination of input
    parameters p_product and p_action, you can find out the condition that
    this file is requested for: eg.
        p_product = "uib"  p_action = "Save As"
        
    In certain cases this procedure changes the file-filters used by the 
    SYSTEM-DIALOG.  The special cases are for 
       p_product = "uib" and 
                   p_action          Look For
                   ---------         --------
                   "Open"               *.w;*.p;*.i
                   "Insert from File"   *.wx
                   "Copy to File"       *.wx
    
Input Parameters:
    p_Window  : Window in which to display the dialog box.
    p_product : The ADE product code.  eg. "uib" for the UIB, or "Procedure"
                for the Procedure Window.
    p_action  : A string indicating what the intent of this call is.
                eg.  "Open", "Save As", "Export As"
                [This is often identical to the p_title for the dialog].
    p_title   : The title to use for the system-dialog.
    p_mode    : "OPEN" or "SAVE".  This determines which version of
                SYSTEM-DIALOG to use:
                    p_mode  Options
                    ------  -------
                    OPEN -> MUST-EXIT
                    SAVE -> SAVE-AS USE-FILENAME ASK-OVERWRITE CREATE-TEST-FILE

Input-Output Parameters:
    p_filename: The filename to use as the default, and to return.

Output Parameters:
    p_ok      : TRUE if user successfully choose a file name (the result of the
                SYSTEM-DIALOG GET-FILE...UPDATE p_ok.
   
Side Effects:
    <none>
    
Author: D. Ross Hunter,  Wm.T.Wood

Date Created: 1992

----------------------------------------------------------------------------*/

DEFINE INPUT        PARAMETER p_Window   AS WIDGET-HANDLE NO-UNDO.
DEFINE INPUT        PARAMETER p_product  AS CHAR    NO-UNDO.
DEFINE INPUT        PARAMETER p_action   AS CHAR    NO-UNDO.
DEFINE INPUT        PARAMETER p_title    AS CHAR    NO-UNDO.
DEFINE INPUT        PARAMETER p_mode     AS CHAR    NO-UNDO.
DEFINE INPUT-OUTPUT PARAMETER p_filename AS CHAR    NO-UNDO.
DEFINE       OUTPUT PARAMETER p_ok       AS LOGICAL NO-UNDO.

DEFINE VAR    cScrap            AS CHAR  INITIAL ?       NO-UNDO.
DEFINE VAR    Filter_NameString AS CHAR  EXTENT 7        NO-UNDO.
DEFINE VAR    Filter_FileSpec   LIKE Filter_NameString   NO-UNDO.
DEFINE VAR    File_Ext          AS CHAR                  NO-UNDO.
DEFINE VAR    lWebLicense       AS LOGICAL               NO-UNDO.

IF SEARCH("adeuib/_uibinfo.r":U) <> ? THEN
    RUN adeuib/_uibinfo.p (?, "SESSION":U, "ABLicense":U, OUTPUT cScrap) NO-ERROR.
IF cScrap ne ? AND cScrap ne "" THEN 
  lWebLicense = cScrap gt "1":U.

/* Initialize the file filters, for special cases. */
IF p_product = "UIB" THEN
DO:
  CASE p_action:
    WHEN "Open":U OR WHEN "Save":U OR WHEN "Save As":U THEN DO:
      ASSIGN
         Filter_NameString[ 2 ] = "Windows(*.w)"
         Filter_FileSpec[ 2 ]   = "*.w"
         Filter_NameString[ 3 ] = "Procedures(*.p)"
         Filter_FileSpec[ 3 ]   = "*.p"
         Filter_NameString[ 4 ] = "Includes(*.i)"
         Filter_FileSpec[ 4 ]   = "*.i"
         Filter_NameString[ 5 ] = "XML Schema(*.xmc~;*.xmp~;*.xsd)"
         Filter_FileSpec[ 5 ]   = "*.xmc~;*.xmp~;*.xsd".
         
      IF lWebLicense THEN
        ASSIGN
           Filter_NameString[ 1]  = "All Source(*.w~;*.p~;*.i;*.htm*;*.x*)"
           Filter_FileSpec[ 1 ]   = "*.w~;*.p~;*.i;*.htm*;*.x*"
           Filter_NameString[ 6 ] = "HTML(*.htm*)"
           Filter_FileSpec[ 6 ]   = "*.htm*"
           Filter_NameString[ 7 ] = "All Files(*.*)"
           Filter_FileSpec[ 7 ]   = "*.*".
      ELSE
        ASSIGN
           Filter_NameString[ 1]  = "All Source(*.w~;*.p~;*.i)"
           Filter_FileSpec[ 1 ]   = "*.w~;*.p~;*.i"
           Filter_NameString[ 6 ] = "All Files(*.*)"
           Filter_FileSpec[ 6 ]   = "*.*".
    END.
         
    WHEN "Insert from File" OR WHEN "Copy to File" THEN
      ASSIGN
        Filter_NameString[ 1 ] = "Export(*.wx)"
        Filter_FileSpec[ 1 ]   = "*.wx"
        Filter_NameString[ 2 ] = "Windows(*.w)"
        Filter_FileSpec[ 2 ]   = "*.w" 
        Filter_NameString[ 3 ] = "Procedures(*.p)"
        Filter_FileSpec[ 3 ]   = "*.p"
        Filter_NameString[ 4 ] = "All Source(*.w~;*.p~;*.i)"
        Filter_FileSpec[ 4 ]   = "*.w~;*.p~;*.i"
        Filter_NameString[ 5 ] = "All Files(*.*)"
        Filter_FileSpec[ 5 ]   = "*.*".
         
    OTHERWISE p_product = ?. 
  END CASE.
END.
ELSE IF p_product = "TTYRESULTS" THEN
  ASSIGN
         Filter_NameString[ 1 ] = "Configuration Files(*.qc)"
         Filter_FileSpec[ 1 ]   = "*.qc".
ELSE IF p_product = "TTYRESULTSQD" THEN
  ASSIGN
         Filter_NameString[ 1 ] = "Query Directory Files(*.qd)"
         Filter_FileSpec[ 1 ]   = "*.qd".
ELSE IF p_product = "PROSPY" THEN
  ASSIGN
         Filter_NameString[ 1 ] = "Log Files(*.log)"
         Filter_FileSpec[ 1 ]   = "*.log".
ELSE IF p_product = "XMLMAPPING" THEN
  ASSIGN
         Filter_NameString[ 1 ] = "XML Schema(*.xmc~;*.xmp~;*.xsd)"
         Filter_FileSpec[ 1 ]   = "*.xmc~;*.xmp~;*.xsd"
         Filter_NameString[ 2 ] = "All Files(*.*)"
         Filter_FileSpec[ 2 ]   = "*.*".
ELSE p_product = ?. 

/* If p_product is UNKNOWN, then use the default case */
IF p_product eq ? THEN DO:
  ASSIGN
         Filter_NameString[ 2 ] = "Procedures(*.p)"
         Filter_FileSpec[ 2 ]   = "*.p"
         Filter_NameString[ 3 ] = "Windows(*.w)"
         Filter_FileSpec[ 3 ]   = "*.w"
         Filter_NameString[ 4 ] = "Includes(*.i)"
         Filter_FileSpec[ 4 ]   = "*.i".
         
  IF lWebLicense AND p_Window:PRIVATE-DATA = "_ab.p":U THEN
    ASSIGN
           Filter_NameString[ 1]  = "All Source(*.p~;*.w~;*.i;*.htm*;*.x*~;*.cls)"
           Filter_FileSpec[ 1 ]   = "*.p~;*.w~;*.i~;*.htm*~;*.x*~;*.cls"
           Filter_NameString[ 5 ] = "HTML(*.htm*)"
           Filter_FileSpec[ 5 ]   = "*.htm*"
           Filter_NameString[ 6 ] = "Classes(*.cls)"
           Filter_FileSpec[ 6 ]   = "*.cls"
           Filter_NameString[ 7 ] = "All Files(*.*)"
           Filter_FileSpec[ 7 ]   = "*.*".
  ELSE
    ASSIGN
           Filter_NameString[ 1]  = "All Source(*.p~;*.w~;*.i~;*.cls)"
           Filter_FileSpec[ 1 ]   = "*.p~;*.w~;*.i~;*.cls"
           Filter_NameString[ 5 ] = "Classes(*.cls)"
           Filter_FileSpec[ 5 ]   = "*.cls"
           Filter_NameString[ 6 ] = "All Files(*.*)"
           Filter_FileSpec[ 6 ]   = "*.*".
END.
         
/* If not specified, display dialog in active-window. */
IF NOT VALID-HANDLE( p_Window ) THEN ASSIGN p_Window = ACTIVE-WINDOW.

REPEAT ON STOP UNDO, LEAVE:

/* File-names to open must exist */                          
IF p_mode EQ "OPEN" THEN
DO:
     SYSTEM-DIALOG GET-FILE p_filename
      TITLE    p_title 
      FILTERS  Filter_NameString[ 1 ]   Filter_FileSpec[ 1 ],
               Filter_NameString[ 2 ]   Filter_FileSpec[ 2 ],
               Filter_NameString[ 3 ]   Filter_FileSpec[ 3 ],
               Filter_NameString[ 4 ]   Filter_FileSpec[ 4 ],
               Filter_NameString[ 5 ]   Filter_FileSpec[ 5 ],
               Filter_NameString[ 6 ]   Filter_FileSpec[ 6 ],
               Filter_NameString[ 7 ]   Filter_FileSpec[ 7 ]
      MUST-EXIST
      UPDATE   p_ok IN WINDOW p_Window.
     IF p_ok <> TRUE THEN LEAVE.
     RUN adecomm/_valpnam.p
        (INPUT  p_filename, INPUT YES /* Show Msg */, INPUT "_EXTERNAL":U,
         OUTPUT p_ok).
     IF p_ok = TRUE THEN LEAVE.
END.
/* File-names to save must be writeable */
ELSE
DO:
    /* Set DEFAULT-EXTENSION and the Filters appropriately. */
    RUN SetDefaultExt.
    
    SYSTEM-DIALOG GET-FILE p_filename
     TITLE   p_title
     FILTERS Filter_NameString[ 1 ]  Filter_FileSpec[ 1 ],
             Filter_NameString[ 2 ]  Filter_FileSpec[ 2 ],
             Filter_NameString[ 3 ]  Filter_FileSpec[ 3 ],
             Filter_NameString[ 4 ]  Filter_FileSpec[ 4 ],
             Filter_NameString[ 5 ]  Filter_FileSpec[ 5 ],
             Filter_NameString[ 6 ]  Filter_FileSpec[ 6 ]
     SAVE-AS USE-FILENAME ASK-OVERWRITE CREATE-TEST-FILE
             DEFAULT-EXTENSION File_Ext
     UPDATE  p_ok IN WINDOW p_Window.

    IF p_ok <> TRUE THEN LEAVE.
    RUN adecomm/_valpnam.p
       (INPUT  p_filename, INPUT YES /* Show Msg */, INPUT "_EXTERNAL":U,
        OUTPUT p_ok).
    IF p_ok = TRUE THEN LEAVE.
END.
END. /* DO ON STOP */

PROCEDURE SetDefaultExt.

    /* Use the filename's extension as the default extension. */
    RUN adecomm/_osfext.p
        (INPUT  p_filename , OUTPUT File_Ext ).

    /* Now change the filters as needed to place the file's extension first
       if the All Source filter is present. This makes the GET-FILE call
       work with DEFAULT-EXTENSION. */
    IF Filter_NameString[ 1 ] BEGINS "All Source"
       AND NOT Filter_FileSpec[ 1 ] BEGINS "*" + File_Ext THEN
    DO:
        /* What we're doing here is moving the File_Ext to the beginning of the
           All Source list for the NameString and the FileSpec. */
        ASSIGN 
            Filter_NameString[ 1 ] =
                REPLACE(Filter_NameString[ 1 ], Filter_FileSpec[ 1 ], "_REMOVE":U)
            Filter_FileSpec[ 1 ] =
                ("*" + File_Ext + ";") +
                 REPLACE(Filter_FileSpec[ 1 ] , "*" + File_Ext, "")
            Filter_FileSpec[ 1 ] = TRIM(REPLACE(Filter_FileSpec[ 1 ], "~;~;", "~;"), "~;").

        ASSIGN 
            Filter_NameString[ 1 ] =
                REPLACE(Filter_NameString[ 1 ] , "_REMOVE":U, Filter_FileSpec[ 1 ]).
    END.
END PROCEDURE.
/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/**************************************************************************
    Procedure:  _getflen.p
    
    Purpose:    Returns the length in bytes of an editor widget or disk
                file.
                
    Syntax :
    
        RUN adecomm/_getflen.p
                (INPUT  p_Editor     /* Editor handle.   */ ,
                 INPUT  p_File_Name  /* OS file.         */ ,
                 OUTPUT p_Length     /* Length in bytes  */ ).

    Parameters:
    
    p_Editor
        Handle of Editor widget whose length you want to query.

    p_File_Name 
        Name of OS file whose length you want to query. Pass Null ("") and
        this procedure will query the length of the passed Editor widget
        instead.
        
    
    p_Length
        Length of the editor widget or file in bytes.

    Description:
        Return the length of an OS file or PROGRESS Editor widget.
        
        Reasons for using this routine:
          - Simple, fast, portable method to get the length of an OS file.
          - Bypass the slow LENGHT attribute of the MS-Windows LARGE Editor.
          - Bypass the DOS Character Editor widget's LENGTH attribute which
            returns an internal buffer size that does not include <CR> in the
            EOL sequence, thereby returning a length smaller than what DOS
            reports.
            
        Here's the length algorithm:
        
        1. Copy the contents of the edit buffer to a temp buffer.
        2. Get a temp file name and save to that file.
        3. Open OUTPUT APPEND to position SEEK pointer at end of file and
           assign that as the length.
        4. Close the output and delete the temporary file, if one was
           used.
    
    Notes  :
    Authors: John Palazzo
    Date   : January, 1994
    Updated: January, 1995
**************************************************************************/

DEFINE INPUT  PARAMETER p_Editor    AS WIDGET    NO-UNDO.
DEFINE INPUT  PARAMETER p_File_Name AS CHARACTER NO-UNDO.
DEFINE OUTPUT PARAMETER p_Length    AS INTEGER   NO-UNDO.

DEFINE VAR l_ok       AS LOGICAL   NO-UNDO.
DEFINE VAR l_Modified AS LOGICAL   NO-UNDO.
DEFINE VAR temp_file  AS CHARACTER NO-UNDO.

DO ON STOP UNDO, RETRY:

  IF NOT RETRY THEN DO:
    CASE p_File_Name:   /* No OS File, so query the editor widget. */
      WHEN "" THEN DO:
        IF p_Editor:EMPTY THEN RETURN.
        ASSIGN l_Modified = p_Editor:MODIFIED.
        RUN adecomm/_tmpfile.p ("",".ade":u,OUTPUT temp_file).

        /* Need the repeat here to trap error and be sure the editor
           widget's MODIFIED state is returned to what it was.
         */
        REPEAT ON STOP UNDO, LEAVE:
          ASSIGN l_ok = p_Editor:SAVE-FILE( temp_file ).
          /* Position the seek pointer at the end of the file. */
          OUTPUT TO VALUE(temp_file) APPEND NO-ECHO.
          ASSIGN p_Length = SEEK(OUTPUT).
          LEAVE.
        END.
        ASSIGN p_Editor:MODIFIED = l_Modified.
      END.
            
      OTHERWISE DO:   /* Query length of OS file. */
        /* Position the seek pointer at the end of the file. */
        OUTPUT TO VALUE(p_File_Name) APPEND NO-ECHO.
        ASSIGN p_Length = SEEK(OUTPUT).
      END.
    END CASE.
  END.
  OUTPUT CLOSE.
  OS-DELETE VALUE( temp_file ).
END. /* DO */

/* _getflen.p - end of file */

/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/*----------------------------------------------------------------------------

File: _getflst.p

Description:
   Fill a selection list with fields.  The fields will be ordered either
   alphabetically or by order #.  The database that these fields are stored 
   in must be aliased to DICTDB before this routine is called.

Input Parameters:
   p_List   - Handle of the selection list widget to add to.
         p_List:private-data is a comma seperated list of items
         NOT to be added. OR no items if the entire table-list is
         to be added.

   p_Recid  - The recid of the table to which these fields belong.
   p_usetbl = If not ? THEN use this table name instead of the actual.
   p_Alpha  - TRUE if order should be alphabetical, FALSE if we want to
               order by the _Order value of the field.
   p_Items  - List of fields to included in list.  If this parameter is
              blank, then just the field name is put in the list.  Currently
              the parameter can have the following values in any order:
              1 - just the field name - then is the default
              2 - tablename.fldname
              3 - dbname.tablename.fldname
              T - Name of table containing the field
              F - Format
   p_DType  - The data type to screen for.  If this is ?, then don't screen.
               Otherwise this must be either
                    "character"
                    "date"
                    "decimal"
                    "integer"
                    "logical"
                    "recid"
   p_ExpandExtent  - 0  field name only for extent field
                     1  extented field name changed to fieldName[1-N].
                     2  extented field names are expanded

  p_CallBack  - The name of the program to run for security of a "" to blow
              this callback off.


Output Parameters:
   p_Stat   - Set to TRUE if list is retrieved (even if there were no fields
               this is successful).  Set to FALSE, if user doesn't have access
               to fields.

Author: Laura Stern, Warren Bare

Date Created: 06/02/92 

----------------------------------------------------------------------------*/

DEFINE INPUT  PARAMETER p_List         AS WIDGET-HANDLE NO-UNDO.
DEFINE INPUT  PARAMETER p_Recid        AS RECID         NO-UNDO.
DEFINE INPUT  PARAMETER p_usetbl       AS CHARACTER     NO-UNDO.
DEFINE INPUT  PARAMETER p_Alpha        AS LOGICAL       NO-UNDO.
DEFINE INPUT  PARAMETER p_Items        AS CHARACTER     NO-UNDO.
DEFINE INPUT  PARAMETER p_DType        AS CHARACTER     NO-UNDO.
DEFINE INPUT  PARAMETER p_ExpandExtent AS INTEGER       NO-UNDO.
DEFINE INPUT  PARAMETER p_CallBack     AS CHARACTER     NO-UNDO.
DEFINE OUTPUT PARAMETER p_Stat         AS LOGICAL       NO-UNDO.

DEFINE BUFFER bField FOR DICTDB._Field.

DEFINE VARIABLE v_dbname  AS CHARACTER      NO-UNDO.
DEFINE VARIABLE err       AS LOGICAL        NO-UNDO.
DEFINE VARIABLE widg      AS widget-handle  NO-UNDO.
DEFINE VARIABLE v_ItemCnt AS INTEGER          NO-UNDO.
DEFINE VARIABLE v_BldLine AS CHARACTER      NO-UNDO.
DEFINE VARIABLE lInclude  AS LOGICAL        NO-UNDO.
DEFINE VARIABLE i         AS INTEGER        NO-UNDO.
DEFINE VARIABLE fName     AS CHARACTER      NO-UNDO.
DEFINE VARIABLE sep       AS CHARACTER      NO-UNDO.

/************************* Inline code section ***************************/

IF INTEGER(DBVERSION("DICTDB":U)) > 8 THEN
  FIND DICTDB._File WHERE DICTDB._File._FILE-NAME = "_Field":u
                      AND LOOKUP(DICTDB._FILE._OWNER,"PUB,_FOREIGN":U) > 0
                     NO-LOCK.

ELSE
  FIND DICTDB._File "_Field":u NO-LOCK.

IF NOT CAN-DO(DICTDB._File._Can-Read,USERID("DICTDB":u)) THEN DO:
  MESSAGE "You do not have permission to see any field information.":t
    VIEW-AS ALERT-BOX ERROR BUTTONS OK.
  p_Stat = FALSE.
  RETURN.
END.

/* This is where we find other buffer information that may be needed */
FIND DICTDB._File WHERE RECID(DICTDB._FILE) = p_Recid.
FIND DICTDB._DB WHERE RECID(DICTDB._DB) = _File._DB-recid NO-LOCK.

IF p_Items = "" THEN p_Items = "1":u.

v_dbname = IF _db._db-name NE ? THEN _db._db-name ELSE ldbname("DICTDB":u).

ASSIGN
  widg = p_List:parent  /* gives me the group */
  widg = widg:parent.   /* gives me the frame */

RUN adecomm/_setcurs.p ("WAIT":u).

IF p_Alpha THEN DO:
  IF p_DType = ? THEN
    FOR EACH DICTDB.bField 
      WHERE DICTDB.bField._File-Recid = p_Recid 
       AND CAN-DO(DICTDB.bField._Can-Read,USERID("DICTDB":u)) NO-LOCK
      BY DICTDB.bField._Field-Name:
      {adecomm/fldlist.i}
    END.
  ELSE
    FOR EACH DICTDB.bField 
      WHERE DICTDB.bField._File-Recid = p_Recid 
         AND bField._Data-Type = p_DType 
        AND CAN-DO(DICTDB.bField._Can-Read,USERID("DICTDB":u)) NO-LOCK
      BY DICTDB.bField._Field-Name:
      {adecomm/fldlist.i}
    END.
END.
ELSE DO:
  IF p_DType = ? THEN
    FOR EACH DICTDB.bField 
      WHERE DICTDB.bField._File-Recid = p_Recid  
        AND CAN-DO(DICTDB.bField._Can-Read,USERID("DICTDB":u)) NO-LOCK
      BY DICTDB.bField._Order:
      {adecomm/fldlist.i}
    END.
  ELSE
    FOR EACH DICTDB.bField 
      WHERE DICTDB.bField._File-Recid = p_Recid 
        AND bField._Data-Type = p_DType 
        AND CAN-DO(DICTDB.bField._Can-Read,USERID("DICTDB":u)) NO-LOCK
      BY DICTDB.bField._Order:
      {adecomm/fldlist.i}
    END.
END.

RUN adecomm/_setcurs.p ("").
p_Stat = TRUE.

RETURN.

/* _getflst.p - end of file */

/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/
/*----------------------------------------------------------------------------

File: _getimag.p

Description:
  Allows a user to select an image file as a standard dialog box.

INPUT Parameters
  p_filter   - special cases.  The only non-blank case will be
                  ICON which is used to show only the .ico files under Windows.
                  
INPUT-OUTPUT Parameters
  p_imagefile   - The name of the image file. Default file extensions for
  		  progess bitmaps (eg. ".xbm" on Motif and ".bmp" or ".ico"
  		  on Windows are not returned.
  icon_dir      - THe directory the look for the icons. Can be unknown.
                  the directory will not be changed if the user
                  cancels out of the dialog box.
OUTPUT Parameters
  pressed_ok    - TRUE if user pressed OK, FALSE if user cancelled.

Author: Wm.T.Wood

Date Created: 09/02/92
----------------------------------------------------------------------------*/

DEFINE INPUT        parameter p_filter    AS CHAR	   NO-UNDO.
DEFINE INPUT-OUTPUT parameter p_imagefile AS CHAR	   NO-UNDO.
DEFINE INPUT-OUTPUT parameter icon_dir    AS CHAR          NO-UNDO.
DEFINE       OUTPUT parameter pressed_ok  AS LOGICAL	   NO-UNDO.

DEFINE VAR filename AS CHAR                                NO-UNDO.

DEFINE VAR delim    AS CHAR				   NO-UNDO.

IF OPSYS  = "UNIX"
THEN
	delim = "/".
ELSE
        delim = "~\~\".

/* Make sure the filename is valid (by using the search command) */
filename = SEARCH (p_imagefile).

IF OPSYS = "UNIX"
THEN SYSTEM-DIALOG GET-FILE    filename
       TITLE                   "Image File"
       FILTERS                 "Motif Bitmaps" "*.x[bp]m"
       DEFAULT-EXTENSION       ".xbm"
       INITIAL-DIR             icon_dir
       MUST-EXIST
       USE-FILENAME
       RETURN-TO-START-DIR
       UPDATE pressed_ok.
ELSE IF p_filter eq "ICON" 
THEN SYSTEM-DIALOG GET-FILE    filename
       TITLE                   "Image File"
       FILTERS                 "Icons (*.ico)"	        "*.ico",
                               "All Files (*.*)" 	"*.*"
       INITIAL-FILTER          0
       DEFAULT-EXTENSION       ".bmp"
       INITIAL-DIR             icon_dir
       MUST-EXIST
       USE-FILENAME
       RETURN-TO-START-DIR
       UPDATE pressed_ok.
ELSE SYSTEM-DIALOG GET-FILE    filename
       TITLE                   "Image File"
       FILTERS                 "Images (*.bmp~;*.ico)"	"*.bmp~;*.ico",
                               "Bitmaps Only (*.bmp)"  	"*.bmp",
                               "Icons Only (*.ico)"    	"*.ico",
                               "All Files (*.*)" 	"*.*"
       INITIAL-FILTER          0
       DEFAULT-EXTENSION       ".bmp"
       INITIAL-DIR             icon_dir
       MUST-EXIST
       USE-FILENAME
       RETURN-TO-START-DIR
       UPDATE pressed_ok.
    

/* Change the icondir, if the user did not abort */
IF pressed_ok THEN DO:
  /* Return the guts of the chosen value */
  p_imagefile = TRIM(filename).
        
  /* Base the icon dir off the name. Strip off the name
   * and return the directory.
   */
  icon_dir = SUBSTRING(p_imagefile,1,R-INDEX(p_imagefile,delim),"CHARACTER":u).
END.

RETURN.

/* _getimag.p - end of file */

/***********************************************************************
* Copyright (C) 2000,2012 by Progress Software Corporation. All rights *
* reserved. Prior versions of this work may contain portions           *
* contributed by participants of Possenet.                             *
*                                                                      *
************************************************************************/
/*----------------------------------------------------------------------------

File                  : _getobject.p

Description           : This is the ADE API to do the call to open a Dynamic Object.

Input Parameters:
  phWindow            : Window in which to display the dialog box.
  gcProductModule     : Initial Product Module Code.
  glOpenInAppBuilder  : Open in Appbuilder
  pcTitle             : Title for Dialog Window to be launched

Output Parameters:
  gcFileName          : The filename selected.
  pressedOK           : TRUE if user successfully choose an object file name.

Author: Pieter J. Meyer

Date Created: September 2002

----------------------------------------------------------------------------*/
{adecomm/oeideservice.i}
DEFINE INPUT  PARAMETER phWindow           AS HANDLE      NO-UNDO.
DEFINE INPUT  PARAMETER gcProductModule    AS CHARACTER   NO-UNDO.
DEFINE INPUT  PARAMETER glOpenInAppBuilder AS LOGICAL     NO-UNDO.
DEFINE INPUT  PARAMETER pcTitle            AS CHARACTER   NO-UNDO.
DEFINE OUTPUT PARAMETER gcFileName         AS CHARACTER   NO-UNDO.
DEFINE OUTPUT PARAMETER pressedOK          AS LOGICAL     NO-UNDO.
 
IF SEARCH("adeuib/_opendialog.w":U) <> ?
OR SEARCH("adeuib/_opendialog.r":U) <> ?
THEN
DO:  
    if OEIDEIsRunning then 
        run adeuib/ide/_dialog_opendialog.p 
                               (phWindow,
                                gcProductModule,
                                glOpenInAppBuilder,
                                pcTitle,
                                OUTPUT gcFileName,
                                OUTPUT pressedOK).
    else
       run adeuib/_opendialog.w(phWindow,
                                gcProductModule,
                                glOpenInAppBuilder,
                                pcTitle,
                                OUTPUT gcFileName,
                                OUTPUT pressedOK).

END.                           
ELSE DO:
  ASSIGN
    pressedOK = NO.
  MESSAGE "No open object dialog is available."
    VIEW-AS ALERT-BOX BUTTONS OK.
  RETURN.

END.

RETURN.
/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/*--------------------------------------------------------------------

File: adecomm/_getpdbs.p

Description:

    creates s_ttb_db-records for all connected physical PROGRESS-Dbs
    and all auto-connect records.

Input-Parameters:
    none

Output-Parameters:
    none

Used/Modified Shared Objects:
    s_ttb_db    Temp-Table containing a record for EACH AND EVERY
                available DB


Author: Laurie Furgal

History:
    laurief    97/04   creation

--------------------------------------------------------------------*/
/*h-*/

/*----------------------------  DEFINES  ---------------------------*/

{ adecomm/getdbs.i }

define INPUT PARAMETER        t_db-num    as integer.

/*------------------------  INT.-PROCEDURES  -----------------------*/

/*---------------------------  MAIN-CODE  --------------------------*/


  find first DICTDB._Db NO-LOCK
   where DICTDB._Db._Db-name = ?.
  find first DICTDB._File of DICTDB._Db
    where DICTDB._File._File-num > 0
    no-lock no-error.

  create s_ttb_db.
  assign
    s_ttb_db.cnnctd = TRUE
    s_ttb_db.dbnr   = t_db-num * 2
    s_ttb_db.dbrcd  = RECID(DICTDB._Db)
    s_ttb_db.dbtyp  = "PROGRESS"
    s_ttb_db.dspnm  = LDBNAME(t_db-num)
    s_ttb_db.empty  = NOT available DICTDB._File
    s_ttb_db.ldbnm  = LDBNAME(t_db-num)
    s_ttb_db.local  = yes
    s_ttb_db.pdbnm  = PDBNAME(t_db-num)
    s_ttb_db.sdbnm  = LDBNAME(t_db-num)
    s_ttb_db.vrsn   = DBVERSION(t_db-num).

  run adecomm/_getfdbs.p
    ( INPUT t_db-num * 2 + 1,
      INPUT s_ttb_db.ldbnm,
      INPUT s_ttb_db.vrsn
    ).
/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/
/*----------------------------------------------------------------------------

File: _getprof.p

Description:
  Allows a user to select a standard progress file using the standard
  system-dialog box.

INPUT  Parameters
  p_title   - The title for the dialog box. [if ? then "Open".]
INPUT-OUTPUT Parameters
  p_imagefile   - The name of the image file. Default file extensions for
  		  progess are supported [.[piw] or .xbm for images.
OUTPUT Parameters
  pressed_ok    - TRUE if user pressed OK, FALSE if user cancelled.

Author: Wm.T.Wood

Date Created: 09/02/92
----------------------------------------------------------------------------*/

DEFINE INPUT        parameter p_title     AS CHAR	   NO-UNDO.
DEFINE INPUT-OUTPUT parameter p_imagefile AS CHAR	   NO-UNDO.
DEFINE       OUTPUT parameter pressed_ok  AS LOGICAL	   NO-UNDO.

&SCOPED-DEFINE Max_Filters 7

DEFINE VAR Filter_NameString AS CHAR EXTENT {&Max_Filters} NO-UNDO.
DEFINE VAR Filter_FileSpec   AS CHAR EXTENT {&Max_Filters} NO-UNDO.

ASSIGN     Filter_NameString[ 1 ] = IF OPSYS = "UNIX":U 
                                      THEN "All Source(*.[piw])"
                                      ELSE "All Source(*.p~;*.i~;*.w)"
           Filter_FileSpec[ 1 ]   = IF OPSYS = "UNIX":U
                                      THEN "*.[piw]"
                                      ELSE "*.p~;*.i~;*.w"        
          
           Filter_NameString[ 2 ] = "Procedures(*.p)"
           Filter_FileSpec[ 2 ]   = "*.p"           
          
           Filter_NameString[ 3 ] = "Includes(*.i)"
           Filter_FileSpec[ 3 ]   = "*.i"           
          
           Filter_NameString[ 4 ] = "Windows(*.w)"
           Filter_FileSpec[ 4 ]   = "*.w"           

           Filter_NameString[ 5 ] = IF OPSYS = "UNIX":U 
                                      THEN "Bitmaps/Pixmaps"
                                      ELSE "Images (*.bmp~;*.ico)"
           Filter_FileSpec[ 5 ]   = IF OPSYS = "UNIX":U
                                      THEN "*.x[bp]m"
                                      ELSE "*.bmp~;*.ico"          
          
           Filter_NameString[ 6 ] = IF OPSYS = "UNIX":U 
                                      THEN "All Files(*)"
                                      ELSE "All Files(*.*)"
           Filter_FileSpec[ 6 ]   = IF OPSYS = "UNIX":U
                                      THEN "*"
                                      ELSE "*.*"
    . /* END-ASSIGN */          
 
/* Get a good title */
IF p_title = ? THEN p_title = "Open".
 
SYSTEM-DIALOG GET-FILE          p_imagefile
       TITLE                    p_title
       FILTERS                  Filter_NameString[ 1 ]   Filter_FileSpec[ 1 ],
                                Filter_NameString[ 2 ]   Filter_FileSpec[ 2 ],
                                Filter_NameString[ 3 ]   Filter_FileSpec[ 3 ],
                                Filter_NameString[ 4 ]   Filter_FileSpec[ 4 ],
                                Filter_NameString[ 5 ]   Filter_FileSpec[ 5 ],
                                Filter_NameString[ 6 ]   Filter_FileSpec[ 6 ]
       USE-FILENAME
       UPDATE pressed_ok.
return.
/*********************************************************************
* Copyright (C) 2005,2012 by Progress Software Corporation. All rights *
* reserved.  Prior versions of this work may contain portions        *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/**************************************************************************
    Procedure:  _getwver.p

    Purpose:    Calls the Windows API to get the version of MS-Windows.

    Syntax :    RUN adecomm/_getwver.p (OUTPUT WinVer ).

    Parameters:
        Winver   : returns the Windows version

    Notes  :
    Author : Gerry Seidl
    Date   : 11/22/95

    Modified on 01/15/96 by gfs - ported to WIN32.
    
**************************************************************************/
DEFINE OUTPUT PARAMETER WinVer   AS DECIMAL NO-UNDO INIT 0.
DEFINE VARIABLE         RawVer   AS INTEGER NO-UNDO.

IF LOOKUP(SESSION:WINDOW-SYSTEM,"MS-WINDOWS,MS-WIN95,MS-WINXP") = 0 THEN RETURN.

IF OPSYS EQ "WIN32" THEN DO: /* 32bit version */
  DEFINE VARIABLE lpVersionInfo AS MEMPTR.
  DEFINE VARIABLE dwMajorVersion AS INTEGER.
  DEFINE VARIABLE dwMinorVersion AS INTEGER.

  SET-SIZE(lpVersionInfo)   = 148. /* sizeof(OSVERSIONINFO) */
  PUT-LONG(lpVersionInfo,1) = 148. /* dwOSVersionInfoSize */

  RUN GetVersionExA (INPUT-OUTPUT lpVersionInfo).
  dwMajorVersion = GET-LONG(lpVersionInfo, 5).  /* dwMajorVersion */
  dwMinorVersion = GET-LONG(lpVersionInfo, 9).  /* dwMinorVersion */

  ASSIGN WinVer = dwMajorVersion +
                  IF dwMinorVersion < 10 THEN dwMinorVersion / 10
				                         ELSE dwMinorVersion / 100.

  SET-SIZE(lpVersionInfo) = 0.

END.

/* Call to Windows API */
PROCEDURE GetVersionExA EXTERNAL "kernel32.dll":
  DEFINE INPUT-OUTPUT PARAMETER lpVersionInfo AS MEMPTR.
END.
/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/
/*----------------------------------------------------------------------------

File: _gttbldb.p

Description:
   This will look in all the databases to find the specified table, then
   leave with the specified alias on that database.

Input Parameters:
   p_TblName - This is the name of the table you want to get an id for.
   p_Alias   - The name of the alias to put on the target db. -- optional.

Output Parameters:
   p_DBID   - The recid of the _Db record for this _file.
   p_TblID  - The recid of the _File record.

Author: Warren Bare

Date Created: 06/30/92 

----------------------------------------------------------------------------*/


Define INPUT  PARAMETER p_TblName   as char     NO-UNDO.
Define OUTPUT PARAMETER p_DBName    as char     NO-UNDO.
Define OUTPUT PARAMETER p_DBID      as recid    NO-UNDO init ?.
Define OUTPUT PARAMETER p_TblID     as recid    NO-UNDO init ?.

Define var v_DbCnt     as int  no-undo.

do v_DbCnt = 1 to NUM-DBS:
  IF DBTYPE(v_DBCnt) NE "Progress" THEN NEXT.
  CREATE Alias DICTDB for database VALUE(LDBNAME(v_DbCnt)).
  run adecomm/_findtbl.p (p_TblName,
    OUTPUT p_DBName,
    OUTPUT p_DBID,
    OUTPUT p_TblID).

  IF p_TblID NE ? THEN
    RETURN.
END.
/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/
/*----------------------------------------------------------------------------

File: _gttblid.p

Description:
   This will return the id of a table.  DICTDB must be pointing to the
   correct database.

Input Parameters:
   p_DBID    - recid of the database this table is in. -- REQUIRED
   p_TblName - This is the name of the table you want to get an id for.

Output Parameters:
   p_TblID  - The recid of the _File record.

Author: Warren Bare

Date Created: 06/30/92 
    Modified: 07/10/98 D. McMann Added DBVERSION check and _owner to find
                                 statement for V9.

----------------------------------------------------------------------------*/


Define INPUT  PARAMETER p_DBID      as recid    NO-UNDO.
Define INPUT  PARAMETER p_TblName   as char     NO-UNDO.
Define OUTPUT PARAMETER p_TblID     as recid    NO-UNDO init ?.

IF INTEGER(DBVERSION("DICTDB")) > 8 THEN DO:
  Find dictdb._file WHERE _file._DB-recid = p_DBID 
                      AND _file-name = p_TblName 
                      AND (_Owner = "PUB" OR _Owner = "_FOREIGN")
                      NO-LOCK NO-ERROR.
  if not available _file THEN DO:
    IF NOT CAN-FIND(_db WHERE RECID(_db) = p_dbid) THEN
    MESSAGE SUBSTITUTE("_db record &1 does not exist in Database &2."
       ,p_dbid,ldbname("DICTDB"))
       view-as alert-box error buttons ok.

    MESSAGE SUBSTITUTE("Table &1 is no longer available.",p_TblName)
      view-as alert-box error buttons ok.
    RETURN.
  END.
  else
    p_TblID = RECID(_file).
END.
ELSE DO:
  Find dictdb._file WHERE _file._DB-recid = p_DBID AND
    _file-name = p_TblName NO-LOCK NO-ERROR.
  if not available _file THEN DO:
    /* This should not happen if you pass in a good p_dbid */
    IF NOT CAN-FIND(_db WHERE RECID(_db) = p_dbid) THEN
      MESSAGE SUBSTITUTE("_db record &1 does not exist in Database &2."
          ,p_dbid,ldbname("DICTDB"))
       view-as alert-box error buttons ok.

    MESSAGE SUBSTITUTE("Table &1 is no longer available.",p_TblName)
      view-as alert-box error buttons ok.
    RETURN.
  END.
  else
    p_TblID = RECID(_file).
END.
RETURN.

/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/
/*----------------------------------------------------------------------------

File: _holddb.p

Description:
   This will return a parameter to the caller telling whether the database
   with the dictdb alias is a schemaholder db.  This needs to be a subprogram
   because the caller just changed the alias on the db.

Input/Output Parameters:
   
Author: Warren Bare

Date Created: 10/19/92

----------------------------------------------------------------------------*/

define output parameter p_holder as log.

p_holder = CAN-FIND(FIRST DICTDB._DB WHERE DICTDB._DB._DB-Type NE "Progress").
/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/*----------------------------------------------------------------------------

File: _isfld.i

Description: 
   Check to see if a field and the table it belongs to are committed
   to the database and therefore in the schema cache by trying to compile 
   this .i which references the table and the field.
 
Argument:
   &1  - Name of the current database.
   &2  - The table that the field is in.
   &3  - The field we're checking for.

Author: Laura Stern

Date Created: 12/04/92 

----------------------------------------------------------------------------*/


/* We don't want any find trigger firing while we're doing this. */
disable triggers for dump of {1}.{2}.
find FIRST {1}.{2} NO-ERROR.

if AVAILABLE {1}.{2} then
   if {1}.{2}.{3} = ? then .


/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/*----------------------------------------------------------------------------

File: _istbl.i

Description: 
   Check to see if a table is committed to the database and therefore
   in the schema cache by trying to compile this .i which references
   the table.
 
Argument:
   &1  - Name of current database
   &2  - The table to check.

Author: Laura Stern

Date Created: 12/04/92 

----------------------------------------------------------------------------*/

/* We don't want any find trigger firing while we're doing this. */
disable triggers for dump of {1}.{2}.
find FIRST {1}.{2} NO-ERROR. 

/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/
/* j-test.p - check to see if table1 & table2 are OF join-able */

/*
-------------------------- READ THIS!!! --------------------------

Note that code was stolen wholesale from j-find1.p and j-find2.p.
Look there and j-find.i for explanations of the algorithms used.

This code must be called TWICE - once with table1 first and table2,
then again (if the first pass fails) with table2 first and table1.

-------------------------- READ THIS!!! --------------------------
*/

/* pi_table1 and pi_table2 must be in the form dbname.tablename.  */
DEFINE INPUT  PARAMETER pi_table1 AS CHARACTER NO-UNDO.
DEFINE INPUT  PARAMETER pi_table2 AS CHARACTER NO-UNDO.
DEFINE OUTPUT PARAMETER po_ofok   AS LOGICAL   NO-UNDO.

DEFINE VARIABLE v_joins AS INTEGER   NO-UNDO. /* count of join paths found */
DEFINE VARIABLE v_loop  AS INTEGER   NO-UNDO. /* loop */
DEFINE VARIABLE v_parts AS CHARACTER NO-UNDO. /* index components */

IF   LDBNAME("QBF$1":u) <> SDBNAME(ENTRY(1,pi_table1,".":u)) 
  OR LDBNAME("QBF$2":u) <> SDBNAME(ENTRY(1,pi_table2,".":u)) THEN DO:
  CREATE ALIAS "QBF$1" FOR DATABASE VALUE(SDBNAME(ENTRY(1,pi_table1,".":u))).
  CREATE ALIAS "QBF$2" FOR DATABASE VALUE(SDBNAME(ENTRY(1,pi_table2,".":u))).
  RUN adecomm/_j-test.p (pi_table1,pi_table2,OUTPUT po_ofok).
  RETURN.
END.

FIND FIRST QBF$1._Db
  WHERE QBF$1._Db._Db-name =
    (IF DBTYPE(ENTRY(1,pi_table1,".":u)) = "PROGRESS":u 
      THEN ? ELSE ENTRY(1,pi_table1,".":u))
  NO-LOCK.
FIND QBF$1._File
  OF QBF$1._Db
  WHERE QBF$1._File._File-name = ENTRY(2,pi_table1,".":u)
  NO-LOCK NO-ERROR.
IF NOT AVAILABLE(QBF$1._File) THEN
DO:
  po_ofok = FALSE.
  RETURN.
END.

FIND FIRST QBF$2._Db
  WHERE QBF$2._Db._Db-name =
    (IF DBTYPE(ENTRY(1,pi_table2,".":u)) = "PROGRESS":u 
      THEN ? ELSE ENTRY(1,pi_table2,".":u))
  NO-LOCK.
FIND QBF$2._File
  OF QBF$2._Db
  WHERE QBF$2._File._File-name = ENTRY(2,pi_table2,".":u)
  NO-LOCK NO-ERROR.
IF NOT AVAILABLE(QBF$2._File) THEN
DO:
  po_ofok = FALSE.
  RETURN.
END.

/* For each unique non-word index of the table...
   Added NOT CAN-FIND for non-V7 database cases, i.e. V6 -dma */ 
FOR EACH QBF$1._Index OF QBF$1._File NO-LOCK
  WHERE QBF$1._Index._Unique AND
    ((CAN-FIND (QBF$1._Field WHERE QBF$1._Field._Field-name = "_Wordidx":u) AND
     (QBF$1._Index._Wordidx = ? OR QBF$1._Index._Wordidx = 0)) OR
    NOT CAN-FIND (QBF$1._Field WHERE QBF$1._Field._Field-name = "_Wordidx":u)):

  /* grab the names and types of all the index components... */
  v_parts = "".
  FOR EACH QBF$1._Index-field OF QBF$1._Index NO-LOCK
    BY QBF$1._Index-field._Index-seq:
    FIND QBF$1._Field OF QBF$1._Index-field NO-LOCK.
    v_parts = v_parts
            + (IF QBF$1._Index-field._Index-seq = 1 THEN "" ELSE ",":u)
            + QBF$1._Field._Field-name + ",":u
            + STRING(QBF$1._Field._dtype).
  END.

  /* oops! no index components - must be default index */
  IF v_parts = "" THEN NEXT.

  FIND FIRST QBF$2._Field
    OF QBF$2._File
    WHERE QBF$2._Field._Field-name = ENTRY(1,v_parts)
      AND QBF$2._Field._dtype      = INTEGER(ENTRY(2,v_parts))
    NO-LOCK NO-ERROR.
  IF NOT AVAILABLE QBF$2._Field THEN NEXT.

  /* match up rest of components */
  DO v_loop = 2 TO NUM-ENTRIES(v_parts) / 2:
    FIND QBF$2._Field
      OF QBF$2._File
      WHERE QBF$2._Field._Field-name = ENTRY(v_loop * 2 - 1,v_parts)
        AND QBF$2._Field._dtype = INTEGER(ENTRY(v_loop * 2,v_parts))
      NO-LOCK NO-ERROR.
    IF NOT AVAILABLE QBF$2._Field THEN LEAVE.
  END.

  /* succeeded; can match with at least one OF */
  IF v_loop > NUM-ENTRIES(v_parts) / 2 THEN v_joins = v_joins + 1.
END.

/* only correct if exactly one way to perform OF */
po_ofok = (v_joins = 1).

RETURN.

/* j-test.p - end of file */

/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/*****************************************************************************

  PROCEDURE: _kvlist.p
  
  Purpose:  Reads/saves Key Values to and from Progress Environment File
            for an enumerated list of items in the Environment File 
            as follows:
            
                Item01=Value
                Item02=Value
                Item##=Value.
                  
  Syntax:
	    RUN adecomm/_kvlist.p ( INPUT p_Mode ,
                                    INPUT p_Section ,
                                    INPUT p_Key ,
                                    INPUT-OUTPUT p_List ) .
                                   
  Parameters:
  
            INPUT   p_Mode  - "GET" - routine reads using GET-KEY-VALUE.
                              "PUT" - routine saves using PUT-KEY-VALUE.
                              
            INPUT   p_Section - Section name in .INI or resource name in
                                .Xdefaults.
                                
            INPUT   p_Key   - Key name being saved. Example: Pass, "BufList",
                              and values are saved as "BufList01=Value,
                              "BufList02=Value", etc..
                              
            INPUT-OUTPUT p_List - Comma-delimited list of values.
            
  Notes:    1. If the PUT or GET fails, this routine returns ERROR.
            2. Current max limit on values to read/save is 99.
            3. In executing a GET, the routine reads sequentially until
               the next item number in sequence is not found.
            4. In executing a PUT, the routine saves up to the number
               of items in the list, and then deletes any items sequentially
               higher.  
               
               For example, if 2 items are being saved, and the
               environment file had three previously stored, then the
               routine would save the two in the list and removed Item03
               from the environment file.          

  Author: John Palazzo

  Date Created: 06/93
*****************************************************************************/

DEFINE INPUT        PARAMETER p_Mode    AS CHAR FORMAT "x(15)" NO-UNDO .
DEFINE INPUT        PARAMETER p_Section AS CHAR FORMAT "x(15)" NO-UNDO .
DEFINE INPUT        PARAMETER p_Key	AS CHAR FORMAT "x(15)" NO-UNDO .
DEFINE INPUT-OUTPUT PARAMETER p_List    AS CHAR FORMAT "x(15)" NO-UNDO .

DEFINE VARIABLE Max_Get_Limit AS INTEGER INIT 99 NO-UNDO.
       /* Max enumerated items to GET/PUT. */
    
DEFINE VARIABLE Key_Value   AS CHARACTER NO-UNDO.
DEFINE VARIABLE Entry_Num   AS INTEGER   NO-UNDO.
DEFINE VARIABLE Entry_Value AS CHARACTER NO-UNDO.
DEFINE VARIABLE Entry_Key   AS CHARACTER NO-UNDO.
DEFINE VARIABLE List_Items  AS INTEGER   NO-UNDO.
DEFINE VARIABLE New_List    AS CHARACTER NO-UNDO.

    
/* proc-main */
DO ON STOP  UNDO, RETURN ERROR      /* Note 1. */
   ON ERROR UNDO, RETURN ERROR :
       

    ASSIGN List_Items = IF ( p_Mode = "GET" )
                            THEN Max_Get_Limit
                            ELSE NUM-ENTRIES( p_List ).
    
    REPEAT:
        ASSIGN Entry_Num = Entry_Num + 1.
        IF ( Entry_Num > Max_Get_Limit ) THEN LEAVE. /* Note 2. */
        
        /*-----------------------------------------------------------------
            Get the key value. Do this regadless of PUT or GET mode.
            Then, if PUT mode and the key's value is different than
            what's currently in environment file, go ahead and save
            the new value.
        -----------------------------------------------------------------*/
        
        ASSIGN Entry_Key   = p_Key + STRING( Entry_Num , "99" )
               Key_Value   = ENTRY( Entry_Num , p_List )
               Entry_Value = Key_Value
               NO-ERROR.

        GET-KEY-VALUE SECTION p_Section KEY Entry_Key VALUE Entry_Value.

        /* Look no further if we can't find the next item. Note 3. */
        IF ( p_Mode = "GET" ) AND ( Entry_Value = ? ) THEN LEAVE.

        /* If we're finished saving the list, are there others in the
           env. file which need to be deleted? Note 4. */        
        IF ( p_Mode = "PUT" ) AND ( Entry_Num > List_Items )
        THEN DO:
            IF ( Entry_Value = ? ) THEN LEAVE.
            /* Left over item still in env. file, so delete it. */
            PUT-KEY-VALUE SECTION p_Section KEY Entry_Key VALUE ? NO-ERROR.
            IF ERROR-STATUS:ERROR THEN STOP. /* ON STOP RETURN ERROR. */
            NEXT.
        END.

        /* Check if we should save a changed value. */        
        IF ( p_Mode = "PUT" ) AND ( Entry_Value <> Key_Value )
        THEN DO:
            ASSIGN Entry_Value = Key_Value.
            PUT-KEY-VALUE SECTION p_Section 
                          KEY Entry_Key VALUE Entry_Value NO-ERROR.
            IF ERROR-STATUS:ERROR THEN STOP. /* ON STOP RETURN ERROR. */
        END.
        
        ASSIGN New_List = IF ( New_List <> "" )
                             THEN ( New_List + "," + Entry_Value )
                             ELSE Entry_Value.
   
    END. /* DO Entry_Num */
    ASSIGN p_List = New_List.
    
END. /* DO ON STOP */
/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/**************************************************************************
    Procedure:  _kwhelp.p
    
    Purpose:    Invokes PROGRESS On-Line Language Reference Help to
                search for keyword help on code selected in an editor
                widget.
                
    Syntax:     RUN adecomm/_kwhelp.p ( INPUT p_Editor    ,
                                        INPUT p_Tool_Name ,
                                        INPUT p_Context ) .

    Parameters:
    
    Description:
                If p_Editor has text selected, partial help is invoked to
                search for the selected text in the Progress On-line Language 
                Reference.  Otherwise, help is invoked for the specified
                ADE Tool (p_Tool_Name) and context (p_Context). If
                p_Context is Unknown (?), a PARTIAL-KEY help is invoked
                for the Language Reference help.
    Notes  :
                The p_Editor widget is presumed to be of :TYPE = "EDITOR".
                
                Here is a sample call.  Proeditor is a widget handle and
                the third parameter is shown as a Preprocessor value.
                
                ON HELP OF ProEditor
                RUN adecomm/_kwhelp.p ( INPUT ProEditor , 
                                        INPUT "edit"    , 
                                        INPUT {&Procedure_Editor_Window} ).
    Authors: John Palazzo
    Date   : January, 1994
**************************************************************************/

DEFINE INPUT PARAMETER p_Editor    AS WIDGET-HANDLE NO-UNDO.
DEFINE INPUT PARAMETER p_Tool_Name AS CHARACTER     NO-UNDO.
DEFINE INPUT PARAMETER p_Context   AS INTEGER       NO-UNDO.

/*----------------------------------------------------------------------
   For Keyword/Syntax Help, trim off leading/trailing periods, colons, 
   quotes, and parenthesis. This converts strings like "ENTERED(" to 
   "ENTERED" and "END." to "END".  Improves searching.
----------------------------------------------------------------------*/
&SCOPED-DEFINE Trim_Chars    ". : ( ) ' """
    
DEFINE VARIABLE Code_String AS CHARACTER NO-UNDO.
    
/* proc-main */
DO ON STOP UNDO, LEAVE :

    IF ( SESSION:WINDOW-SYSTEM = "TTY" )
    THEN DO:
        RUN adecomm/_adehelp.p
            ( INPUT p_Tool_Name , INPUT "CONTEXT" , INPUT p_Context ,
              INPUT ? ).
        RETURN.
    END.

    /* If text selected, get Language Keyword Syntax Help. Else, get
       application help. */
    IF ( p_Editor:TEXT-SELECTED )
    THEN DO:
        ASSIGN Code_String = TRIM( TRIM( p_Editor:SELECTION-TEXT ) , 
                                        {&Trim_Chars} ) NO-ERROR.
        IF ( ERROR-STATUS:NUM-MESSAGES > 0 )
        THEN DO:
            MESSAGE "Selected text is too large to process." SKIP(1)
                    ERROR-STATUS:GET-MESSAGE(1)
                    VIEW-AS ALERT-BOX ERROR BUTTONS OK.
            RETURN.
        END.
        
        RUN adecomm/_adehelp.p
            ( INPUT "lgrf" , INPUT "PARTIAL-KEY" , INPUT ? ,
              INPUT Code_String ).
    END.
    ELSE DO:
        CASE p_Context:
          WHEN 0 THEN
            RUN adecomm/_adehelp.p
                ( INPUT p_Tool_Name , INPUT "TOPICS" , INPUT ? , INPUT ? ).
          WHEN ? THEN
            RUN adecomm/_adehelp.p
                ( INPUT "lgrf" , INPUT "PARTIAL-KEY" , INPUT ? , INPUT Code_String ).
          OTHERWISE
            RUN adecomm/_adehelp.p
               ( INPUT p_Tool_Name , INPUT "CONTEXT" , INPUT p_Context , INPUT ? ).
        END CASE.
    END.

END.
/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/
/*-----------------------------------------------------------------------------

  File: _locard.p

  Description: Locates Actuate Report Designer on a system.

  Input Parameters:
      <none>

  Output Parameters:
      locard (char) - locates ARD and returns its full pathname. If it is
                      not installed, locdwb = ?

  Author: Gerry Seidl

  Modified on 
     10/15/99 by gfs - Changed name to "Actuate e.Report Designer"
     05/07/99 by gfs - Created

 *---------------------------------------------------------------------------*/
DEFINE OUTPUT PARAMETER locard AS CHARACTER INITIAL ? NO-UNDO.

/* If it's installed, it's location is in the Registry */
LOAD "Software\Actuate\Actuate e.Report Designer":U BASE-KEY "HKEY_LOCAL_MACHINE":U NO-ERROR.
IF NOT ERROR-STATUS:ERROR THEN DO:
  USE "Software\Actuate\Actuate e.Report Designer":U.
  GET-KEY-VALUE SECTION "File Path":U KEY DEFAULT VALUE locard.
  USE "".
  /* If there is something in the registry, make sure it's really there */
  IF locard <> ? THEN DO:
    ASSIGN FILE-INFO:FILE-NAME = locard.
    IF FILE-INFO:FULL-PATHNAME <> ? THEN 
      ASSIGN locard = FILE-INFO:FULL-PATHNAME. /* It's installed */
    ELSE 
      ASSIGN locard = ?. /* Not found */
  END.
END.
RETURN. 
/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/
/*-----------------------------------------------------------------------------

  File: _locdwb.p

  Description: Locates Actuate Developer Workbench on a system.

  Input Parameters:
      <none>

  Output Parameters:
      locdwb (char) - locates DWB and returns its full pathname. If it is
                      not installed, locdwb = ?

  Author: Gerry Seidl

  Modified on 
     05/04/99 by gfs - Created
 *---------------------------------------------------------------------------*/
DEFINE OUTPUT PARAMETER locdwb AS CHARACTER INITIAL ? NO-UNDO.

/* If it's installed, it's location is in the Registry */
LOAD "Software\Actuate\Actuate Developer Workbench":U BASE-KEY "HKEY_LOCAL_MACHINE":U NO-ERROR.
IF NOT ERROR-STATUS:ERROR THEN DO:
  USE "Software\Actuate\Actuate Developer Workbench":U.
  GET-KEY-VALUE SECTION "File Path":U KEY DEFAULT VALUE locdwb.
  USE "".
  /* If there is something in the registry, make sure it's really there */
  IF locdwb <> ? THEN DO:
    ASSIGN FILE-INFO:FILE-NAME = locdwb.
    IF FILE-INFO:FULL-PATHNAME <> ? THEN 
      ASSIGN locdwb = FILE-INFO:FULL-PATHNAME. /* It's installed */
    ELSE 
      ASSIGN locdwb = ?. /* Not found */
  END.
END.
RETURN. 
/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/*----------------------------------------------------------------------------

File: _lstnav.p (List 1st letter Navigation)

Description:
   This file should be called for each selection list that should
   support first letter navigation.  It should be called from an
   ANY-PRINTABLE trigger, like:

      on ANY-PRINTABLE of lst in frame x
      	 run adecomm/_lstnav.p (INPUT lst:HANDLE in frame foo, 
      	       	     	       OUTPUT found_val).

Input Parameters:
   p_List   - Widget handle of the select list.

Output Parameters:
   p_val    - Set to ? if no match was found.  Otherwise, it is set
      	      to the list value which matched the first letter search.

Author: Laura Stern

Date Created: 04/13/93 

----------------------------------------------------------------------------*/

define input  parameter p_List as widget-handle NO-UNDO.
define output parameter p_val as char  	        NO-UNDO init ?.

define var key       as char	 NO-UNDO. /* Key value just typed */
define var curr_val  as char     NO-UNDO. /* Current value of select-list */
define var lst_val   as char	 NO-UNDO. /* Value of a select list item */
define var ix        as integer  NO-UNDO. /* Loop index */
define var start     as integer  NO-UNDO. /* Index into select list */
define var found     as logical  NO-UNDO. /* Did we find a prefix match? */

/* Set curr_val to the current selection or the 1st item */
curr_val = p_List:screen-value.
if curr_val = ? then curr_val = p_List:entry(1).

/* return if list is empty */
if curr_val = ? then return. 

/* See if we can find a prefix match between the one character the user
   just typed and a select list item.  If there is no match then the
   selection is left as is.
*/
assign
   key = CHR(LASTKEY)
   found = false
   /* Start searching from the item after the currently selected item */
   start = p_List:lookup(curr_val) + 1.  

do ix = start to p_List:num-items while NOT found:
   lst_val = p_List:ENTRY(ix).
   if lst_val BEGINS key then
      found = true.
end.

/* If we haven't found a match yet, wrap around to the top of the
   list and continue searching.  Don't bother ever checking against
   the item we're already on, hence the "- 2". */
do ix = 1 to start - 2 while NOT found:
   lst_val = p_List:ENTRY(ix).
   if lst_val BEGINS key then
      found = true.
end.

if found then
do:
   /* set selection and make sure this item will be in view */
   p_List:screen-value = lst_val.
   run adecomm/_scroll.p (INPUT p_List, INPUT lst_val).
   p_val = lst_val.
end.







/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/*----------------------------------------------------------------------------

File: _mfldlst.p

Description:
   Fill a selection list with fields from MULTIPLE tables.  The fields
   will be ordered either either alphabetically or by order #.

Input Parameters:
   p_List   - Handle of the selection list widget to add to.
   p_TblList- A comma list of database.table names.
   p_TT     - ? if no temp-tables need to be included.
              Otherwise a comma delimitted list where each entry has the form:
              _like-db._like-table|_name
              The _like-db and _like-table are real database.table combinations
              and _name is either the name of the temp-table that is like
              _like-table or ? if it is the same.
   p_Alpha  - true if order should be alphabetical, false if we want to
      	      order by the _Order value of the field.
   p_Items  - String of items to place in the selection list.  If this
              is blank _mfldlst.p will select an appropriate default.
              IF one table being selected THEN
                just field name
              ELSE IF all tables in one database THEN
                tablename.fieldname
              ELSE
                dbname.tablename.fieldname

  p_ExpandExtent - true if the array extents are to be expanded

  p_Callback - Pass on to _mfldlist as the name of the program to run 
              for security puposes or pass "" to blow this off.

Output Parameters:
   p_Stat   - Set to true if list is retrieved (even if there were no fields
      	      this is successful).  Set to false, if user doesn't have access
      	      to fields.

Author: Warren Bare

Date Created: 08/03/92

----------------------------------------------------------------------------*/

DEFINE INPUT  PARAMETER p_List      AS WIDGET-HANDLE NO-UNDO.
DEFINE INPUT  PARAMETER p_TblList   AS CHARACTER     NO-UNDO.
DEFINE INPUT  PARAMETER p_TT        AS CHARACTER     NO-UNDO.
DEFINE INPUT  PARAMETER p_Alpha     AS LOGICAL       NO-UNDO.
DEFINE INPUT  PARAMETER p_Items     AS CHARACTER     NO-UNDO.
DEFINE INPUT  PARAMETER p_expandExt AS INTEGER       NO-UNDO.
DEFINE INPUT  PARAMETER p_CallBack  AS CHARACTER     NO-UNDO.
DEFINE OUTPUT PARAMETER p_Stat      AS LOGICAL       NO-UNDO.

DEFINE VARIABLE cTTName      AS CHARACTER            NO-UNDO.
DEFINE VARIABLE cType        AS CHARACTER            NO-UNDO.
DEFINE VARIABLE i            AS INTEGER              NO-UNDO.
DEFINE VARIABLE iNumItems    AS INTEGER              NO-UNDO.
DEFINE VARIABLE iNumTT       AS INTEGER              NO-UNDO.
DEFINE VARIABLE use-table    AS CHARACTER            NO-UNDO.
DEFINE VARIABLE v_Tblname    AS CHARACTER            NO-UNDO.
DEFINE VARIABLE v_TmpName    AS CHARACTER            NO-UNDO.
DEFINE VARIABLE v_ListCnt    AS INTEGER              NO-UNDO.
DEFINE VARIABLE v_LDBNames   AS CHARACTER EXTENT 50  NO-UNDO.
DEFINE VARIABLE v_TblIDs     AS RECID     EXTENT 50  NO-UNDO.
DEFINE VARIABLE v_ThisDBID   AS RECID                NO-UNDO.
DEFINE VARIABLE v_ThisDBName AS CHARACTER            NO-UNDO.
DEFINE VARIABLE v_LastDBName AS CHARACTER            NO-UNDO.
DEFINE VARIABLE v_MultiDB    AS LOGICAL              NO-UNDO.
DEFINE VARIABLE v_OldDictdb  AS CHARACTER            NO-UNDO.

v_olddictdb = ldbname("DICTDB":u).

/*
** First we loop through the databases.  We need to see if they are all in
** the same db.  If they are, then by default, we will not show the dbname
** in the selection list we build.
*/

DO v_ListCnt = 1 TO MINIMUM(50,NUM-ENTRIES(p_TblList)):
  v_TmpName = ENTRY(v_ListCnt,p_TblList).

  /* If they did not pass a dbname, find the db this tbl is in */
  IF NUM-ENTRIES(v_TmpName,".":u) = 1 THEN DO:
    v_TblName  = v_TmpName.
    /* Perhaps a buffer name */
    BUFFER-SEARCH-BLOCK:
    REPEAT i = 1 TO NUM-ENTRIES(p_TT):
      IF v_TblName = ENTRY(2, ENTRY(i,p_TT), "|":U) THEN DO:
        ASSIGN v_ThisDBName = ENTRY(1, ENTRY(i ,p_TT), ".":U)
               v_TblName    = ENTRY(2, ENTRY(1, ENTRY(i, p_TT), "|":U),
                                             ".":U).
        LEAVE BUFFER-SEARCH-BLOCK.
      END.  /* Found the buffer */
    END.  /* REPEAT */
    RUN adecomm/_gttbldb.p (v_TblName, OUTPUT v_ThisDBName,
                            OUTPUT v_ThisDBID, OUTPUT v_TblIDs[v_ListCnt]).
  END.
  ELSE DO:
    IF v_TmpName BEGINS "Temp-Tables.":U THEN DO:
      /* This entry of p_TblList is a temp-table.  Replace it with the 
         "real" db info for these id info lookups                       */
      SEARCH-BLOCK:
      REPEAT i = 1 TO NUM-ENTRIES(p_TT):
        IF ENTRY(2, v_TmpName, ".":U) = ENTRY(2, ENTRY(i,p_TT), "|":U) OR
          (ENTRY(2, v_TmpName, ".":U) = ENTRY(2, ENTRY(1, ENTRY(i,p_TT), "|":U),
                                                 ".":U) AND
                 ENTRY(2, ENTRY(i,p_TT), "|":U) = "?") THEN DO:
          ASSIGN v_ThisDBName = ENTRY(1, ENTRY(i ,p_TT), ".":U)
                 v_TblName    = ENTRY(2, ENTRY(1, ENTRY(i, p_TT), "|":U),
                                          ".":U).
          LEAVE SEARCH-BLOCK.
        END. /* IF found it */
      END. /* SEARCH-BLOCK REPEAT i = 1 TO NUM-ENTRIES */
    END. /* IF a temp-table */
    
    ELSE DO: /* Normal situation */
      ASSIGN v_ThisDBName = ENTRY(1,ENTRY(v_ListCnt,p_TblList),".":u)
             v_TblName    = ENTRY(2,ENTRY(v_ListCnt,p_TblList),".":u).
    END.  /* Normal situation */
    
    RUN adecomm/_getdbid.p (v_ThisDBName, OUTPUT v_ThisDBID).
    IF v_ThisDBID = ? THEN NEXT.
    RUN adecomm/_gttblid.p (v_ThisDBID, v_TblName, OUTPUT v_TblIDs[v_ListCnt]).
  END.

  IF v_TblIDs[v_ListCnt] = ? THEN NEXT.
  IF v_ListCnt > 1 AND v_LastDBName NE v_ThisDBName THEN
    v_MultiDB = yes.

  ASSIGN v_LDBNames[v_ListCnt] = LDBNAME("DICTDB":u)
         v_LastDBName = v_ThisDBName.
END.  /* End loop through p_TblList */

/* If they want default items, what should they be? */
IF p_Items = ""  THEN DO:
  IF NUM-ENTRIES(p_TblList) = 1 THEN
    p_Items = "1":u.
  ELSE
  IF NOT v_MultiDB THEN
    p_Items = "2":u.
  ELSE
    p_Items = "3":u.
END.

/* If they want default items, what should they be? */
ELSE IF p_Items = "4":u  THEN DO:
  IF num-dbs = 1 AND NUM-ENTRIES(p_TblList) = 1 THEN
    p_Items = "1":u.
  ELSE
  IF num-dbs = 1 THEN
    p_Items = "2":u.
  ELSE
    p_Items = "3":u.
END.

DO v_ListCnt = 1 to MINIMUM(50,NUM-ENTRIES(p_TblList)):
  IF v_TblIDs[v_ListCnt] = ? THEN NEXT.

  CREATE ALIAS DICTDB FOR DATABASE VALUE(v_LDBNames[v_ListCnt]).
  IF ENTRY(v_ListCnt,p_TblList) BEGINS "Temp-Tables":U THEN
    use-table = ENTRY(2, ENTRY(1, ENTRY(v_ListCnt, p_TblList), "|":U),
                         ".":U).
  ELSE use-table = ?.

  /* We need to store the number of items before adding additional fields
     to the list in order to change the DB Name to Temp-Table (if necessary)
     below for this table only */
  iNumItems = p_List:NUM-ITEMS.

  /* now add the fields for this table to the list */
  RUN adecomm/_getflst.p(p_List,
                         v_TblIDs[v_ListCnt],
                         use-table,
                         p_Alpha,
                         p_Items,
                         ?,
                         p_ExpandExt,
                         p_CallBack,
                         OUTPUT p_Stat).
  
  IF use-table NE ? AND p_items = "3" THEN DO:
    DO i = iNumItems + 1 TO p_List:NUM-ITEMS:
      REPEAT iNumTT = 1 TO NUM-ENTRIES(p_TT):
        /* p_TT is in the format of dbname.tablename|temp-tablename|type
           where type is "T" for temp-table or "B" for buffer */        
        ASSIGN cTTName = ENTRY(2, ENTRY(iNumTT, p_TT), "|":U)
               cType   = ENTRY(3, ENTRY(iNumTT, p_TT), "|":U).
        /* If this is a buffer then we don't want to replace the db table name with "Temp-Tables",
           we want to replace it with nothing so that only the buffer name and field name
           display on the Available Fields list */
        IF ENTRY(2, p_List:ENTRY(i), ".":U) = cTTName THEN DO:
          /* prepend dbname with blank for replace to avoid replacing table and fields */  
          IF cType = "B":U THEN
            p_List:REPLACE(REPLACE(" " + p_List:ENTRY(i), " " + v_LDBNames[v_ListCnt] + ".":U, ""), i).
          ELSE 
            p_List:REPLACE(REPLACE(" " + p_List:ENTRY(i)," " + v_LDBNames[v_ListCnt], "Temp-Tables":U), i).
        END.  /* if list item = temp-table name */                                                                                       
      END.  /* REPEAT - for each temp-table defined */
    END. /* For each item */
  END.  /* If working with a temp-table and fully qualified */
END.

IF v_Olddictdb NE ? THEN
  CREATE ALIAS DICTDB FOR DATABASE VALUE(v_OldDictDb).

/* _mfldlst.p - end of file */

/*********************************************************************
* Copyright (C) 2005 by Progress Software Corporation. All rights    *
* reserved.  Prior versions of this work may contain portions        *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/*
 * _mfldmap.p - side-by-side field picker
 */

/*
p_nSource -> name of the SmartObject that should be viewed in list 1
p_nDest   -> name of the SmartObject that should be viewed in list 2
p_hSource -> handle to SmartObject that should be viewed in list 1
p_hDest   -> handle to SmartObject that should be viewed in list 2
p_TT      -> ? if no temp-tables need to be included
             Otherwise a comma delitted list where each entry has the form:
             _like-db._like-table|_name
             The _like-db and _like-table are real database.table combinations
             and _name is either the name of the temp-table that is like
             _like-table or ? if it is the same.

p_Items   -> Either "1", "2", or "3".  This indicates the number of
                    components that will be used in the select list 1 and in 
                    the output.  i.e., 1: field, 2: table.field, 3: db.table.field
p_Dlmtr   -> The delimiter of the p_Result List
p_Result  -> input-output list of selected mapped fields
                comes in in the form "customer.cust-num,CustNum"


RUN _mfldmap.p (INPUT source-handle,
                INPUT dest-handle,
                INPUT ?,
                INPUT "2",
                INPUT ",",
                INPUT-OUTPUT p_Result)
        
Create: 03/08 SLK
Modified: 03/98 SLK Allow 1 to 1 only
          03/19/98 SLK Changed parameter to 2 handles vs tableList and handle
          08/18/98 SLK Moved display so that Destination is always on the right
          08/17/99 hd Show EACH array. 
                       Pass 2 to mfldLst and don't run adecomm/_collaps. 
                       Skip all logic to update list of extents 
*/
/*
   IT DOESN'T LOOK LIKE THIS ANYMORE, BUT THIS GIVES YOU THE IDEA! 
  Source Fields                             Target Fields
+------------------------------+ +-----+ +------------------------------+  
| Cust-num                   | | | Map | | customer.Cust-Num          | |  
| Nombre                     | | +-----+ | customer.Addr              | |  
|                            | |         | customer.Address2          | |
|                            | |         | customer.St                | |
|                            | |         | customer.Zip               | |
|                            | |         | customer.Phone             | |
|                            | |         | customer.Contact           | |
|                            | |         | customer.Sales-Rep         | |
|                            | |         |                            | | 
|                            | |         |                            | | 
|                            | |         |                            | | 
+------------------------------+         +------------------------------+ 
Mapped Fields:
+--------------------------------------------------+ +-------+
| City,customer.City                             | | | UnMap |
|                                                | | +-------+
|                                                | |
|                                                | |
|                                                | |
+-------------------------------------------------+
*/     
&GLOBAL-DEFINE WIN95-BTN YES
{adeuib/uibhlp.i}    /* Help contexts */
{adecomm/adestds.i}  /* Standard layout stuff, colors etc. */
{adeuib/sharvars.i}
{adecomm/tt-brws.i "NEW"}
  &IF DEFINED(UIB_is_running) = 0 &THEN
DEFINE INPUT        PARAMETER p_nDest   AS CHARACTER NO-UNDO.
DEFINE INPUT        PARAMETER p_nSource AS CHARACTER NO-UNDO.
DEFINE INPUT        PARAMETER p_hDest   AS HANDLE NO-UNDO.
DEFINE INPUT        PARAMETER p_hSource AS HANDLE NO-UNDO.
DEFINE INPUT        PARAMETER p_TT      AS CHARACTER NO-UNDO.
DEFINE INPUT        PARAMETER p_Items   AS CHARACTER NO-UNDO.
DEFINE INPUT        PARAMETER p_Dlmtr   AS CHARACTER NO-UNDO.
DEFINE INPUT-OUTPUT PARAMETER p_Result  AS CHARACTER NO-UNDO.
  &ELSE
DEFINE VAR  p_nDest   AS CHARACTER NO-UNDO.
DEFINE VAR  p_nSource AS CHARACTER NO-UNDO.
DEFINE VAR  p_hDest   AS HANDLE NO-UNDO.

DEFINE VAR  p_hSource AS HANDLE NO-UNDO.
DEFINE VAR  p_TT      AS CHARACTER NO-UNDO.
DEFINE VAR  p_Items   AS CHARACTER NO-UNDO.
DEFINE VAR  p_Dlmtr   AS CHARACTER NO-UNDO INIT ",".
DEFINE VAR  p_Result  AS CHARACTER NO-UNDO.

RUN dcust.w PERSISTENT SET p_hSource.
RUN dsls.w PERSISTENT SET  p_hDest.
  
  &ENDIF
  
DEFINE VAR stat AS LOGICAL NO-UNDO. /* For status of widget methods */
 
/*--------------------------------------------------------------------------*/

DEFINE VARIABLE v_TargetLst AS CHARACTER  NO-UNDO
  VIEW-AS SELECTION-LIST SIZE 31 BY 10 SCROLLBAR-V SCROLLBAR-H SORT.
DEFINE VARIABLE v_SourceLst AS CHARACTER NO-UNDO
  VIEW-AS SELECTION-LIST SIZE 31 BY 10 SCROLLBAR-V SCROLLBAR-H SORT.
DEFINE VARIABLE v_MapLst AS CHARACTER NO-UNDO
  VIEW-AS SELECTION-LIST MULTIPLE SIZE 62 BY 3 SCROLLBAR-V SCROLLBAR-H.

DEFINE VARIABLE cArrayEntry AS CHARACTER NO-UNDO.
DEFINE VARIABLE cArrayList  AS CHARACTER NO-UNDO.
DEFINE VARIABLE cTemp       AS CHARACTER NO-UNDO.
DEFINE VARIABLE cTemp2      AS CHARACTER NO-UNDO.
DEFINE VARIABLE first-time  AS LOGICAL   NO-UNDO.
DEFINE VARIABLE iArrayHigh  AS INTEGER   NO-UNDO.
DEFINE VARIABLE iArrayLow   AS INTEGER   NO-UNDO. 
DEFINE VARIABLE i           AS INTEGER   NO-UNDO.
DEFINE VARIABLE j           AS INTEGER   NO-UNDO.
DEFINE VARIABLE l_Cancel    AS LOGICAL   NO-UNDO.

DEFINE BUTTON   qbf-map            LABEL "&Map"   SIZE 13 BY 1.125.
DEFINE BUTTON   qbf-unmap          LABEL "&Unmap" SIZE 13 BY 1.125.
DEFINE VARIABLE dest_unique-list   AS CHARACTER           NO-UNDO.
DEFINE VARIABLE dest_accept-list   AS CHARACTER           NO-UNDO.
DEFINE VARIABLE dest_supply-list   AS CHARACTER           NO-UNDO.
DEFINE VARIABLE source_unique-list AS CHARACTER           NO-UNDO.
DEFINE VARIABLE source_accept-list AS CHARACTER           NO-UNDO.
DEFINE VARIABLE source_supply-list AS CHARACTER           NO-UNDO.
DEFINE VARIABLE element            AS CHARACTER           NO-UNDO.


DEFINE VARIABLE cnt                AS INTEGER             NO-UNDO.
DEFINE VARIABLE fieldName          AS CHARACTER           NO-UNDO.
DEFINE VARIABLE cTargetLbl         AS CHARACTER           NO-UNDO.
DEFINE VARIABLE cSourceLbl         AS CHARACTER           NO-UNDO.
DEFINE VARIABLE lTargetQueryObj    AS LOGICAL             NO-UNDO.
DEFINE VARIABLE lSourceQueryObj    AS LOGICAL             NO-UNDO.
DEFINE VARIABLE cTargetObjType     AS CHARACTER           NO-UNDO.
DEFINE VARIABLE cSourceObjType     AS CHARACTER           NO-UNDO.
DEFINE VARIABLE dest_TblLst        AS CHARACTER           NO-UNDO.
DEFINE VARIABLE source_TblLst      AS CHARACTER           NO-UNDO.
DEFINE VARIABLE lDbAware           AS LOGICAL             NO-UNDO.

DEFINE BUTTON qbf-ok   LABEL "OK"      {&STDPH_OKBTN} AUTO-GO.
DEFINE BUTTON qbf-cn   LABEL "Cancel"  {&STDPH_OKBTN} AUTO-ENDKEY.
DEFINE BUTTON qbf-hlp  LABEL "&Help"   {&STDPH_OKBTN}.

/* Dialog Button Box */
&IF {&OKBOX} &THEN
   DEFINE RECTANGLE rect_Btn_Box {&STDPH_OKBOX}.
&ENDIF

DEFINE VARIABLE t_int AS INTEGER   NO-UNDO. /* scrap/loop */
DEFINE VARIABLE t_log AS LOGICAL   NO-UNDO. /* scrap/loop */

FORM 
  SKIP ({&TFM_WID})
  cSourceLbl   FORMAT "x(50)"         AT 2 VIEW-AS TEXT SIZE 31 BY .7
  cTargetLbl FORMAT "x(50)"           AT 48 VIEW-AS TEXT SIZE 31 BY .7
  SKIP({&VM_WID})
  v_SourceLst                         AT 2              
  v_TargetLst                         AT 48 
  SKIP({&VM_WID})
  "Mapped Fields:"                    AT 2 VIEW-AS TEXT
  v_MapLst                            AT 2
  { adecomm/okform.i
      &BOX    ="rect_Btn_Box"
      &OK     ="qbf-ok"
      &CANCEL ="qbf-cn"
      &HELP   ="qbf-hlp" 
  }
  qbf-map AT ROW-OF v_TargetLst COL 34 SKIP ({&VM_WID})
  qbf-unmap AT ROW 13 COL 66 SKIP ({&VM_WID})
  SKIP ({&VM_WID})
  WITH FRAME FldPicker NO-LABELS
   DEFAULT-BUTTON qbf-ok CANCEL-BUTTON qbf-cn
   TITLE "Multi-Field Mapping":t32 VIEW-AS DIALOG-BOX.
   
ASSIGN v_TargetLst:DELIMITER = p_Dlmtr
       v_SourceLst:DELIMITER = p_Dlmtr
       v_MapLst:DELIMITER = CHR(10).

IF NOT(VALID-HANDLE(p_hDest) AND VALID-HANDLE(p_hSource)) THEN RETURN.

ASSIGN
   cTargetLbl      = p_nDest
   cSourceLbl      = p_nSource.

ASSIGN
   lTargetQueryObj = DYNAMIC-FUNCTION("getQueryObject":U IN p_hDest) 
   cTargetObjType  = DYNAMIC-FUNCTION("getObjectType":U  IN p_hDest) 
   lSourceQueryObj = DYNAMIC-FUNCTION("getQueryObject":U IN p_hSource) 
   cSourceObjType  = DYNAMIC-FUNCTION("getObjectType":U  IN p_hSource) 
NO-ERROR.
IF ERROR-STATUS:ERROR OR (NOT lTargetQueryObj) OR (NOT lSourceQueryObj) THEN RETURN.

/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */

ON "VALUE-CHANGED" OF v_TargetLst IN FRAME FldPicker 
   OR "VALUE-CHANGED" OF v_SourceLst IN FRAME FldPicker DO:
  DEFINE VAR some_thing AS LOGICAL.

  /* If anything highlighted */
  IF (v_TargetLst:SCREEN-VALUE NE ? OR
     v_SourceLst:SCREEN-VALUE NE ? ) AND
     qbf-unmap:SENSITIVE THEN 
  ASSIGN
     v_MapLst:SCREEN-VALUE = ""
     qbf-unmap:SENSITIVE       = NO.
/* IF pair chosen */
  IF v_TargetLst:SCREEN-VALUE NE ? AND
     v_SourceLst:SCREEN-VALUE NE ? AND
     qbf-map:SENSITIVE = FALSE THEN
  ASSIGN   qbf-map:SENSITIVE = TRUE.
END.

ON "VALUE-CHANGED" OF v_MapLst IN FRAME FldPicker DO:
  DEFINE VAR some_thing AS LOGICAL.
  some_thing = SELF:SCREEN-VALUE NE ?. 
  
  /* Sensitize UnMap button only if something is selected */
  IF some_thing NE qbf-unmap:SENSITIVE THEN
    ASSIGN qbf-unmap:SENSITIVE = some_thing.
  
  /* Turn off the Source List and Actions */
  IF qbf-unmap:SENSITIVE
  THEN ASSIGN
    v_TargetLst:SCREEN-VALUE  = ""
    v_SourceLst:SCREEN-VALUE  = ""
    qbf-map:SENSITIVE       = NO.
END.

/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */

ON "GO" OF FRAME FldPicker DO:
     IF v_MapLst:LIST-ITEMS IN FRAME FldPicker = ? THEN
        ASSIGN p_Result = "":U.
     ELSE
     DO:
        ASSIGN p_Result = v_MapLst:LIST-ITEMS IN FRAME FldPicker.
/* *** Don't need to do this; Foreign Fields are displayed in the correct order...
        RUN FlipList(INPUT CHR(10), INPUT-OUTPUT p_Result).
 *** */
        ASSIGN p_Result = REPLACE(p_Result,CHR(10),p_Dlmtr).
     END.
END.  /* On GO of Frame FldPicker */

/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */

ON WINDOW-CLOSE OF FRAME FldPicker
   APPLY "END-ERROR" TO FRAME FldPicker.

/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */

/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ON   CHOOSE                OF qbf-map    IN FRAME FldPicker
  OR MOUSE-SELECT-DBLCLICK OF v_TargetLst  IN FRAME FldPicker
  OR MOUSE-SELECT-DBLCLICK OF v_SourceLst  IN FRAME FldPicker DO:
  /* Why MOUSE-SELECT-DBLCLICK and not DEFAULT-ACTION?  Because this is in
     a dialog box and the RETURN key will fire the GO for the frame.  I don't
     want it to also fire the MAP trigger. [Arguably, this is a bug with the
     Progress DEFAULT-BUTTON logic.  RETURN should do one or the other, not
     both DEFAULT-ACTION for selection-lists and DEFAULT-BUTTON for the frame */
          
  DEFINE VARIABLE cnt         AS INTEGER   NO-UNDO.
  DEFINE VARIABLE qbf_a       AS LOGICAL   NO-UNDO.
  DEFINE VARIABLE qbf_i       AS INTEGER   NO-UNDO.
  DEFINE VARIABLE qbf_v       AS CHARACTER NO-UNDO.
  DEFINE VARIABLE qbf_vsdo    AS CHARACTER NO-UNDO.
  DEFINE VAR empty_target     AS LOGICAL   NO-UNDO.

  IF v_TargetLst:SCREEN-VALUE IN FRAME FldPicker <> ? 
     AND v_SourceLst:SCREEN-VALUE IN FRAME FldPicker <> ? THEN DO:
    /* add to end of mapped list - remove from the dbLst */
    qbf_v = v_TargetLst:SCREEN-VALUE IN FRAME FldPicker.
    qbf_vsdo = v_SourceLst:SCREEN-VALUE IN FRAME FldPicker.

      cTemp = qbf_v.
      
      /*** The arrays are shown individually in the list  
      
      /* If it matches the it is an array thing. */
      IF cTemp MATCHES ("*[*]*") THEN DO:
        ASSIGN cTemp      = TRIM (cTemp)
               cArrayList = SUBSTRING(cTemp,INDEX(cTemp,'[':u) + 1,-1,
                                      "CHARACTER":u)
               cArrayList = REPLACE(cArrayList,"]":u,"")
               cTemp      = SUBSTRING(cTemp,1,INDEX(cTemp,'[':u) - 1,
                                      "CHARACTER":u).

        /* Loop through the list base on " " */
        DO i = 1 TO NUM-ENTRIES (cArrayList, ' '):
          ASSIGN cArrayEntry = ENTRY (i, cArrayList, ' ')
                 iArrayLow   = INTEGER (ENTRY (1, cArrayEntry, '-'))
                 iArrayHigh  = INTEGER (ENTRY (NUM-ENTRIES (cArrayEntry, '-'),
                                                            cArrayEntry, '-')).

          /* Loop through the list base on X-Y. X is the low number.
                                                Y is the high number.           */
          DO j = iArrayLow TO iArrayHigh:
            ASSIGN cArrayEntry = cTemp + '[' + STRING (j) + ']'.
            /* Add element if it is not already there */
            ASSIGN element = qbf_vsdo + ",":U + cArrayEntry.
            IF v_MapLst:LOOKUP(element) = 0 THEN
                   qbf_a = v_MapLst:ADD-LAST (element) IN FRAME FldPicker.
          END. /* DO J */
        END. /* DO I */
      END. /* IF MATCHES */
      
      ELSE 
      ***/
      
      DO:
        /* Make sure displayed order matches the internal storage order
           so people don't get confused when defining the ForeignFields
           property themselves */
        ASSIGN element = qbf_v + ",":U + qbf_vsdo.
        qbf_a = v_MapLst:ADD-LAST(element) IN FRAME FldPicker.
      END.

      /* Keep the position in the db list highlighted if there was only one. */
      RUN adecomm/_delitem.p (v_TargetLst:HANDLE, 
                              qbf_v,
                              OUTPUT cnt).  
      /* Keep the position in the sdo list highlighted if there was only one. */
      RUN adecomm/_delitem.p (v_SourceLst:HANDLE, 
                              qbf_vsdo,
                              OUTPUT cnt).  
      
      ASSIGN stat = v_SourceLst:DELETE (qbf_vsdo)
             stat = v_TargetLst:DELETE (qbf_v). 
    /* If the dbLst has no selection then disable all the buttons */
    qbf-map:SENSITIVE IN FRAME FldPicker = ( v_TargetLst:SCREEN-VALUE NE ? ).
  END.
END /*TRIGGER*/ .

/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 
*/
ON   CHOOSE                OF qbf-unmap     IN FRAME FldPicker
  OR MOUSE-SELECT-DBLCLICK OF v_MapLst  IN FRAME FldPicker DO:
  /* Why MOUSE-SELECT-DBLCLICK and not DEFAULT-ACTION?  Because this is in
     a dialog box and the RETURN key will fire the GO for the frame.  I don't
     want it to also fire the REMOVE trigger. [Arguably, this is a bug with the
     Progress DEFAULT-BUTTON logic.  RETURN should do one or the other, not
     both DEFAULT-ACTION for selection-lists and DEFAULT-BUTTON for the frame */
  DEFINE VARIABLE qbf_a    AS LOGICAL   NO-UNDO.
  DEFINE VARIABLE qbf_i    AS INTEGER   NO-UNDO.
  DEFINE VARIABLE qbf_j    AS INTEGER   NO-UNDO.
  DEFINE VARIABLE cnt      AS INTEGER   NO-UNDO.
  DEFINE VARIABLE target_list  AS CHARACTER NO-UNDO.
  DEFINE VARIABLE dest_item  AS CHARACTER NO-UNDO.
  DEFINE VARIABLE source_list AS CHARACTER NO-UNDO.
  DEFINE VARIABLE source_item AS CHARACTER NO-UNDO.
  DEFINE VARIABLE map_item AS CHARACTER NO-UNDO.
  DEFINE VAR empty_target  AS LOGICAL                        NO-UNDO.
  DEFINE VAR element       AS CHARACTER                        NO-UNDO.
  
  IF v_MapLst:SCREEN-VALUE IN FRAME FldPicker <> ? THEN DO:
    /* WORK put back in original position in dbLst */
    ASSIGN
      target_list = v_TargetLst:LIST-ITEMS IN FRAME FldPicker
      source_list = v_SourceLst:LIST-ITEMS IN FRAME FldPicker
      map_item = v_MapLst:SCREEN-VALUE IN FRAME FldPicker.

    /* Fix dblist  and smartdatalist */
    DO qbf_i = 1 TO NUM-ENTRIES(map_item, CHR(10)):
      /* Keep the position in the list highlighted if there was only one. */
      IF NUM-ENTRIES(map_item,CHR(10)) EQ 1 THEN 
          RUN adecomm/_delitem.p (v_MapLst:HANDLE, 
                                   ENTRY (qbf_i, map_item, CHR(10)), 
                                   OUTPUT cnt).
      ELSE 
          stat = v_MapLst:DELETE (ENTRY(qbf_i, map_item, CHR(10))).

      ASSIGN element = ENTRY(1,ENTRY (qbf_i, map_item, CHR(10)),p_Dlmtr).
      
      /* We don't want arrays to appear as ONE element      
      RUN adecomm/_collaps.p (v_TargetLst:HANDLE, element).
      */
      
      RUN addEntry(v_TargetLst:HANDLE, element). 

      ASSIGN element = ENTRY(2,ENTRY (qbf_i, map_item, CHR(10)),p_Dlmtr).
      
      /* No need for this  
      RUN adecomm/_collaps.p (v_SourceLst:HANDLE, element).
      */
      RUN addEntry(v_SourceLst:HANDLE, element). 
    END.

    /* If the target is empty then disable all the buttons. */
    empty_target = ( v_MapLst:SCREEN-VALUE EQ ? ).
    ASSIGN
         qbf-unmap:SENSITIVE IN FRAME FldPicker = NOT empty_target
         .
    /* Empty the screen-value if the list is empty. There seems to be
       a bug here that the SCREEN-VALUE becomes UNKNOWN and stops the
       next VALUE-CHANGED from firing. */
    IF empty_target THEN v_MapLst:SCREEN-VALUE = "".
  END.
END /*TRIGGER*/ .

/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */

/*----- HELP -----*/
ON HELP OF FRAME FldPicker OR CHOOSE OF qbf-hlp IN FRAME FldPicker
   RUN "adecomm/_adehelp.p" 
     (INPUT "AB", INPUT "CONTEXT", INPUT {&Foreign_Fields}, INPUT ?).


/*--------------------------------------------------------------------------*/

{ adecomm/okrun.i
    &FRAME  = "FRAME FldPicker"
    &BOX    = "rect_Btn_Box"
    &OK     = "qbf-ok"
    &HELP   = "qbf-hlp"
}

/* The current posibilities are:
 *    SmartData -> SmartData
 *    DBBrowser -> SmartData
 *    DBBrowser -> DBBrowser
 *    SmartData -> DBBrowser
 * Target is ALWAYS in the format DB selection list
 */
/* Populates the Target selection list 
 * Target will most likely be a SmartDataObject
 */
IF cTargetObjType = "SmartBusinessObject":U THEN
DO:
  /* RUN createObjects IN p_hDest NO-ERROR. */
  RUN adecomm/_getdlst.p
      (INPUT v_TargetLst:HANDLE,
       INPUT p_hDest,
       INPUT NO,
       INPUT "2",
       INPUT ?,
       OUTPUT t_log).
END.
ELSE
DO:
  /* This section retrieves database fields, so just skip for non-dbaware */  
  IF cTargetObjType = "SmartDataObject":U THEN 
    lDbAware = {fn getDbAware p_hDest}.
  ELSE 
    lDbAware = TRUE.

  IF lDbAware THEN
  DO:
    ASSIGN
       dest_TblLst = DYNAMIC-FUNCTION("getTables":U IN p_hDest) NO-ERROR.
    
    RUN adecomm/_mfldlst.p (
       INPUT v_TargetLst:HANDLE,
       INPUT dest_TblLst,
       INPUT p_TT,
       INPUT YES,
       INPUT p_Items,
       INPUT 2, /* expand EACH array element */
       INPUT "",
       OUTPUT t_log).
  END.
  ELSE  /* not really needed jsut to make it clearer */
    t_log = FALSE. 
END.

IF NOT t_log AND cTargetObjType = "SmartDataObject":U THEN
DO:
   /* We have a DataView  */
   /* OR   */ 
   /* We have an SDO but we did not succeed in building a field list.
    * Assume that this is an SDO built against a temp-table.
    * (NOTE: Although the above procedure should be able to handle 
    *  this case, there currently does not appear to be a way to get
    *  the information needed for the p_TT parameter here.  Note also that
    *  the above function always tries to get the field information 
    *  from a database table, which should not be necessary for an SDO
    *  that queries a temp-table). [1/12/2000 tomn]
    */

    /* dbaware is set for SDO above. dest_TBlList is set for dbaware above. 
       If not dbaware ensure that only DataTable columns can be picked.  */
    IF NOT lDbAware THEN
      dest_TblLst = {fn getDataTable p_hDest}.

    RUN adecomm/_getdlst.p (
       INPUT v_TargetLst:HANDLE,
       INPUT p_hDest,
       INPUT NO,
       INPUT "2|" + dest_TblLst,
       INPUT ?,
       OUTPUT t_log).
END.

/* Populates the Source selection list 
 * Source can be in the format DB selection list or tt selection list
 */

IF cSourceObjType = "SmartDataObject":U THEN 
DO:
  lDbAware = {fn getDbAware p_hSource}.
  IF NOT lDbAware THEN
    source_TblLst = {fn getDataTable p_hSource}.

  RUN adecomm/_getdlst.p (
     INPUT v_SourceLst:HANDLE,
     INPUT p_hSource,
     INPUT NO,
     INPUT IF lDbAware THEN "1"  /* no qualifier for source */
           ELSE "2|" + source_TblLst,
     INPUT ?,
     OUTPUT t_log).

END. /* If SmartData */
ELSE IF cSourceObjType = "SmartBusinessObject":U THEN 
DO:
  RUN adecomm/_getdlst.p (
     INPUT v_SourceLst:HANDLE,
     INPUT p_hSource,
     INPUT NO,
     INPUT "2",
     INPUT ?,
     OUTPUT t_log).
END. /* If SmartData */
ELSE
DO:
   ASSIGN
      source_TblLst = DYNAMIC-FUNCTION("getTables":U IN p_hSource)
   NO-ERROR.
   RUN adecomm/_mfldlst.p (
     INPUT v_SourceLst:HANDLE,
     INPUT source_TblLst,
     INPUT p_TT,
     INPUT YES,
     INPUT "1",
     INPUT 2, /* expand arrays */
     INPUT "",
     OUTPUT t_log).
END. /* If other = SmartDataBrowser referencing a Database */

/* WORK 
   Determines the DB best guess
   FROM keyedit.p. p_hDest must be in the format sports.customer,sports.salesrep 
IF SEARCH("adeuib/_uibinfo.r":U) <> ? THEN
RUN adeuib/_keygues.p (
  INPUT p_hDest,
  OUTPUT dest_unique-list,
  OUTPUT dest_accept-list,
  OUTPUT dest_supply-list).
REMOVE */
  
IF dest_unique-list NE "" THEN DO:
  /* For BROWSE and QUERY objects, the unique-list should probably NOT
   * be in the acceptable keys because they imply a unique entry. */
  cnt = NUM-ENTRIES(dest_accept-list).
  DO i = 1 TO cnt:
     fieldName = ENTRY(i, dest_accept-list).
     IF NOT CAN-DO(dest_unique-list, fieldName) 
     THEN cTemp = (IF cTemp EQ "" THEN "" ELSE cTemp + ",":U) + fieldName.
  END.
  dest_accept-list = cTemp.   
END.

/***** No array elements ()
/* Remove array elements from v_TargetLst that might already be there */ 
IF p_Result NE "" THEN DO:  /* If first time, no need to check for elements */
  DO t_int = 1 TO v_TargetLst:NUM-ITEMS:
    /* Check if an array */
    cTemp = v_TargetLst:ENTRY(t_int).
    
    IF INDEX(cTemp,"[":U) > 0 THEN DO:  /* This is an array */
      ASSIGN cTemp      = TRIM (cTemp)
             cArrayList = SUBSTRING(cTemp,INDEX(cTemp,'[':u) + 1,-1,
                                    "CHARACTER":u)
             cArrayList = REPLACE(cArrayList,"]":u,"")
             cTemp      = ENTRY(1,cTemp,"[":U)
             first-time = TRUE.

      /* Loop through the list base on " " */
      DO i = 1 TO NUM-ENTRIES (cArrayList, ' '):
        ASSIGN cArrayEntry = ENTRY (i, cArrayList, ' ')
               iArrayLow   = INTEGER (ENTRY (1, cArrayEntry, '-'))
               iArrayHigh  = INTEGER (ENTRY (NUM-ENTRIES (cArrayEntry, '-'),
                                                          cArrayEntry, '-')).

        IF first-time THEN /* Clear existing brackets */
          ASSIGN  t_log = v_TargetLst:REPLACE(cTemp + "[]":U, t_int)
                  first-time = FALSE.
                       
        /* Loop through the list base on X-Y. X is the low number.
                                              Y is the high number.           */
        DO j = iArrayLow TO iArrayHigh:
          ASSIGN cArrayEntry = cTemp + '[' + STRING (j) + ']'.
          /* Add and "Collapse" cArrayEntry out if it is NOT
             in the results list                              */
          IF LOOKUP(cArrayEntry, p_Result, p_Dlmtr) = 0 THEN DO:
            RUN adecomm/_collaps.p (v_TargetLst:HANDLE, cArrayEntry).
          END.
        END. /* DO J */
      END. /* DO I */
      IF v_TargetLst:ENTRY(t_int) MATCHES "*[]" THEN
         t_log = v_TargetLst:DELETE(t_int).
    END.  /* This is an array */  
  END. /* DO t_int 1 to num-items */
END.  /* If possibility of array elements */
***/  

/*
** Make sure p_Result items are in the v_TargetLst list and v_SourceLst list.  
** If they are, then remove them and put the item in the v_MapLst selection list.
*/
DO t_int = 1 TO NUM-ENTRIES(p_Result, p_Dlmtr):
  ASSIGN cTemp = ENTRY(t_int,p_Result,p_Dlmtr)   
         t_log = v_TargetLst:DELETE(cTemp) IN FRAME FldPicker
         t_int = t_int + 1
         cTemp2 = ENTRY(t_int,p_Result,p_Dlmtr)
         t_log = v_SourceLst:DELETE(cTemp2) IN FRAME FldPicker
         t_log = v_MapLst:ADD-LAST(cTemp + p_Dlmtr + cTemp2) IN FRAME FldPicker.
END.

/* Highlight these fields */
ASSIGN v_TargetLst:SCREEN-VALUE = dest_accept-list NO-ERROR.
ASSIGN cSourceLbl = "Source: " + cSourceLbl  
       cTargetLbl = "Target: " + cTargetLbl.

RUN center-frame (FRAME FldPicker:HANDLE).

DISPLAY cTargetLbl cSourceLbl 
WITH FRAME FldPicker.
ENABLE v_TargetLst 
       qbf-map 
       v_SourceLst 
       v_MapLst 
       qbf-ok
       qbf-cn 
       qbf-hlp
       WITH FRAME FldPicker.
ASSIGN
   stat = qbf-unmap:MOVE-AFTER-TAB-ITEM(qbf-map:HANDLE IN FRAME FldPicker).

/* Select the first item in the source list */
IF v_TargetLst:NUM-ITEMS > 0 THEN v_TargetLst:SCREEN-VALUE = v_TargetLst:ENTRY(1).

/* Assume a cancel until the user hits OK. */
l_Cancel = YES.
DO ON ERROR UNDO,RETRY ON ENDKEY UNDO,LEAVE:
  APPLY "ENTRY"  TO v_TargetLst IN FRAME FldPicker.
  WAIT-FOR "CHOOSE" OF qbf-ok IN FRAME FldPicker OR
                 GO OF FRAME FldPicker.   
  /* No Cancel. */
  l_cancel = NO.
END.

HIDE FRAME FldPicker NO-PAUSE.

IF l_Cancel 
THEN RETURN "Cancel":U.
ELSE RETURN.

/* two.p - end of file */

/* This is a kludge for MS-WINDOWS  - see bug # 94-09-16-030.   */
/* When the user dblclicks on a table in the adecomm/_tblsel.p procedure this dialog
   (_mfldmap.p) is brought into context on the MOUSE-SELECT-DOWN of the 2nd click.
   However, the MOUSE-SELECT-UP of the second click "bleeds" through to the underlying
   frame of the UIB design window and attempts to fire the frame-select-up persistent
   trigger.  This fails with an error message that it can't find frame-select-up.  By
   putting this procedure in this file it will find it and supress the error message. */
PROCEDURE frame-select-up.
  RETURN.
END.

/* Internal Procedures */
PROCEDURE flipList:
   DEFINE INPUT        PARAMETER pcDelimeter    AS CHARACTER NO-UNDO.
   DEFINE INPUT-OUTPUT PARAMETER pcFlipList     AS CHARACTER NO-UNDO.

   DEFINE VARIABLE i                            AS INTEGER   NO-UNDO.
   DEFINE VARIABLE cTmpString                   AS CHARACTER NO-UNDO.
   DEFINE VARIABLE cTmpString2                  AS CHARACTER NO-UNDO.

   DO i = 1 TO NUM-ENTRIES(pcFlipList,pcDelimeter):
      ASSIGN  
         cTmpString = ENTRY(i, pcFlipList, pcDelimeter)
         cTmpString2 = cTmpString2 
                       + ENTRY(2, cTmpString, ",":U)
                       + ",":U
                       + ENTRY(1, cTmpString, ",":U)
                       + pcDelimeter.
   END. 
   ASSIGN pcFlipList = SUBSTRING(cTmpString2,1,LENGTH(cTmpString2) - LENGTH(pcDelimeter)).
END PROCEDURE. /* flipList */

/* Internal Procedures */
PROCEDURE addEntry:
   DEFINE INPUT  PARAMETER phHandle  AS HANDLE    NO-UNDO.
   DEFINE INPUT  PARAMETER pcEntry   AS CHARACTER NO-UNDO.

   DEFINE VARIABLE i                            AS INTEGER   NO-UNDO.
   DEFINE VARIABLE cName                        AS CHARACTER NO-UNDO.
   DEFINE VARIABLE cEntry                       AS CHARACTER NO-UNDO.
   DEFINE VARIABLE cListName                    AS CHARACTER NO-UNDO.
   DEFINE VARIABLE iArray                       AS INTEGER   NO-UNDO.
   DEFINE VARIABLE iListArray                   AS INTEGER   NO-UNDO.
   DEFINE VARIABLE lOk                          AS LOGICAL   NO-UNDO.

   ASSIGN 
     cName   = ENTRY(1,pcEntry,"[")
     iArray  = IF NUM-ENTRIES(pcEntry,"[") > 1 
               THEN INT(ENTRY(1,ENTRY(2,pcEntry,"["),"]"))
               ELSE 0.
   DO i = 1 TO NUM-ENTRIES(phHandle:LIST-ITEMS):
      ASSIGN
        cEntry     = phHandle:ENTRY(i)
        cListName  = ENTRY(1,cEntry,"[").    
        iListArray = IF NUM-ENTRIES(cEntry,"[") > 1 
                     THEN INT(ENTRY(1,ENTRY(2,cEntry,"["),"]"))
                     ELSE 0.

      IF (cListName > cName) 
      OR (iArray > 0 AND cName = cListName AND iListArray > iArray) THEN 
      DO:
        lOk = phHandle:INSERT(pcEntry,i).
        LEAVE.
      END.
   END.
   /* list was empty or we have a higher value than anything else */
   IF NOT lok THEN 
     phHandle:ADD-LAST(pcEntry).

END PROCEDURE. /* addEntry */

PROCEDURE center-frame:
/*------------------------------------------------------------------------------
  Purpose:  Center dialog box in the middle of the screen. The ROW and COLUMN
            attributes are relative to its parent, so adjust.
    Notes:  
------------------------------------------------------------------------------*/
  DEFINE INPUT PARAMETER phFrame AS HANDLE NO-UNDO.
  
  DEFINE VARIABLE hParent AS HANDLE NO-UNDO.

  ASSIGN
    hParent        = phFrame:PARENT
    phFrame:ROW    = MAXIMUM(1,(SESSION:HEIGHT - phFrame:HEIGHT) / 2) 
                     - hParent:ROW
    phFrame:COLUMN = MAXIMUM(1,(SESSION:WIDTH - phFrame:WIDTH) / 2)
                     - hParent:COLUMN.

END PROCEDURE. /* center-frame */


/*********************************************************************
* Copyright (C) 2005 by Progress Software Corporation. All rights    *
* reserved.  Prior versions of this work may contain portions        *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/
/*
 * _m_fldsel.p - side-by-side field picker
 */

/*
p_TblList     -> list of dbname.tables that should be viewed in list 1 (the left
                 side)
                 Note: Leave blank ("") if selecting from a DataObject.
p_hDataObject -> handle to DataObject that should be viewed in list 1
p_TT          -> ? if no temp-tables need to be included
                 Otherwise a comma delitted list where each entry has the form:
                 _like-db._like-table|_name
                 The _like-db and _like-table are real database.table combinations
                 and _name is either the name of the temp-table that is like
                 _like-table or ? if it is the same.

p_Items       -> Either "1", "2", or "3".  This indicates the number of
      	          components that will be used in the select lists and in 
                 the output.  i.e., 1: field, 2: table.field, 3: db.table.field
p_Dlmtr       -> The delimiter of the p_Result List
p_Exclude     -> Delimited list of fields to exclude from the Available Fields
                 list.
p_Result      -> input-output list of selected fields
*/

/*
   IT DOESN'T LOOK LIKE THIS ANYMORE, BUT THIS GIVES YOU THE IDEA! 

        Available Fields                  Selected Fields
+------------------------------+ +------------------------------+  
| Cust-num  (demo.customer)  | | |                            | |  
| Name      (demo.customer)  | | |                            | |  
| Address   (demo.customer)  | | |                            | | +----------+
| Address2  (demo.customer)  | | |                            | | |  Add >>  |
| City      (demo.customer)  | | |                            | | +----------+
| St        (demo.customer)  | | |                            | | +----------+
| Zip       (demo.customer)  | | |                            | | |<< Remove |
| Phone     (demo.customer)  | | |                            | | +----------+
| Contact   (demo.customer)  | | |                            | | +----------+
| Sales-rep (demo.customer)  | | |                            | | | Move Up  |
|                            | | |                            | | +----------+
|                            | | |                            | | +----------+
|                            | | |                            | | |Move Down |
+------------------------------+ +------------------------------+ +----------+
*/     
/* Modified
   wood 8-18-95 Deselect Avail Fields after ADD of multiple fields
                (Bug # 95-07-18-090).  
   wood 6-6-96  Clicking Cancel returns "Cancel". This avoids the
                problem of sending in an initial list and then
                clicking Cancel. You cannot just check p_Result because
                it won't be empty.
*/
&GLOBAL-DEFINE WIN95-BTN YES
{adecomm/commeng.i}  /* Help contexts */
{adecomm/adestds.i}  /* Standard layout stuff, colors etc. */
{adecomm/tt-brws.i "NEW"}

DEFINE INPUT        PARAMETER p_TblLst      AS CHARACTER NO-UNDO.
DEFINE INPUT        PARAMETER p_hDataObject AS WIDGET-HANDLE NO-UNDO.
DEFINE INPUT        PARAMETER p_TT          AS CHARACTER NO-UNDO.
DEFINE INPUT        PARAMETER p_Items       AS CHARACTER NO-UNDO.
DEFINE INPUT        PARAMETER p_Dlmtr       AS CHARACTER NO-UNDO.
DEFINE INPUT        PARAMETER p_Exclude     AS CHARACTER NO-UNDO.
DEFINE INPUT-OUTPUT PARAMETER p_Result      AS CHARACTER NO-UNDO.

DEFINE VARIABLE stat          AS LOGICAL NO-UNDO. /* For status of widget methods */
DEFINE VARIABLE useDataObject AS LOGICAL NO-UNDO.

/*--------------------------------------------------------------------------*/

DEFINE VARIABLE v_SrcLst AS CHARACTER  NO-UNDO
  VIEW-AS SELECTION-LIST MULTIPLE SIZE 31 by 10 SCROLLBAR-V SCROLLBAR-H.
DEFINE VARIABLE v_TargLst AS CHARACTER NO-UNDO
  VIEW-AS SELECTION-LIST MULTIPLE SIZE 31 by 10 SCROLLBAR-V SCROLLBAR-H.
/*DEFINE VARIABLE v_OrigSrc AS CHARACTER NO-UNDO. */

DEFINE VARIABLE cArrayEntry AS CHARACTER NO-UNDO.
DEFINE VARIABLE cArrayList  AS CHARACTER NO-UNDO.
DEFINE VARIABLE cTemp       AS CHARACTER NO-UNDO.
DEFINE VARIABLE first-time  AS LOGICAL   NO-UNDO.
DEFINE VARIABLE iArrayHigh  AS INTEGER   NO-UNDO.
DEFINE VARIABLE iArrayLow   AS INTEGER   NO-UNDO. 
DEFINE VARIABLE i           AS INTEGER   NO-UNDO.
DEFINE VARIABLE j           AS INTEGER   NO-UNDO.
DEFINE VARIABLE l_Cancel    AS LOGICAL   NO-UNDO.

DEFINE BUTTON qbf-up LABEL "Move &Up"   SIZE 13 BY 1.125.
DEFINE BUTTON qbf-dn LABEL "Move &Down" SIZE 13 BY 1.125.
DEFINE BUTTON qbf-ad LABEL "&Add >>"    SIZE 13 BY 1.125.
DEFINE BUTTON qbf-rm LABEL "<< &Remove" SIZE 13 BY 1.125.

Define button qbf-ok   label "OK"      {&STDPH_OKBTN} AUTO-GO.
Define button qbf-cn   label "Cancel"  {&STDPH_OKBTN} AUTO-ENDKEY.
Define button qbf-hlp  label "&Help"   {&STDPH_OKBTN}.

/* Dialog Button Box */
&IF {&OKBOX} &THEN
   DEFINE RECTANGLE rect_Btn_Box {&STDPH_OKBOX}.
&ENDIF

DEFINE VARIABLE t_int AS INTEGER   NO-UNDO. /* scrap/loop */
DEFINE VARIABLE t_log AS LOGICAL   NO-UNDO. /* scrap/loop */
define variable wintitle as character no-undo init "Multi-Field Selector":t32.
FORM 
  SKIP ({&TFM_WID})
  "Available Fields:":L31 AT 2 VIEW-AS TEXT
  "Selected Fields:" 	  AT 48 VIEW-AS TEXT
  SKIP({&VM_WID})

  v_SrcLst     	     	  AT 2 
  v_TargLst    	     	  AT 48              

  { adecomm/okform.i
      &BOX    ="rect_Btn_Box"
      &OK     ="qbf-ok"
      &CANCEL ="qbf-cn"
      &HELP   ="qbf-hlp" 
  }

  qbf-ad AT ROW 4 COL 34 SKIP ({&VM_WID})
  qbf-rm AT 34 	     	 SKIP ({&VM_WID})
  qbf-up AT 34 	     	 SKIP ({&VM_WID})
  qbf-dn AT 34 		 SKIP ({&VM_WID})
  SKIP ({&VM_WID})
  WITH FRAME FldPicker NO-LABELS
   DEFAULT-BUTTON qbf-ok CANCEL-BUTTON qbf-cn
   &if DEFINED(IDE-IS-RUNNING) = 0  &then 
   TITLE wintitle VIEW-AS DIALOG-BOX
   &else
   NO-BOX THREE-D
   &endif
   .

ASSIGN v_SrcLst:DELIMITER  = p_Dlmtr
       v_TargLst:DELIMITER = p_Dlmtr.
&if DEFINED(IDE-IS-RUNNING) <> 0  &then
 {adeuib/ide/dialoginit.i "FRAME FldPicker:handle"}
  dialogService:View(). 
&endif
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */

ON "VALUE-CHANGED" OF v_SrcLst IN FRAME FldPicker DO:
  DEFINE VAR some_thing AS LOGICAL.
  some_thing = SELF:SCREEN-VALUE NE ?.

  /* Sensitize ADD button only if something is selected */
  IF some_thing NE qbf-ad:SENSITIVE 
  THEN qbf-ad:SENSITIVE = some_thing.
  /* Turn off the Target List and Actions */
  IF qbf-rm:SENSITIVE
  THEN ASSIGN
    v_TargLst:SCREEN-VALUE = ""
    qbf-rm:SENSITIVE       = no
    qbf-up:SENSITIVE       = no
    qbf-dn:SENSITIVE       = no.
END.

ON "VALUE-CHANGED" OF v_TargLst IN FRAME FldPicker DO:
  DEFINE VAR some_thing AS LOGICAL.
  some_thing = SELF:SCREEN-VALUE NE ?. 
  
  /* Sensitize Remove/Move buttons only if something is selected */
  IF some_thing NE qbf-rm:SENSITIVE THEN
    ASSIGN qbf-rm:SENSITIVE = some_thing.
  
  ASSIGN qbf-up:SENSITIVE = ENTRY(1,v_TargLst:SCREEN-VALUE,p_Dlmtr)
                                  NE v_TargLst:ENTRY(1).
         qbf-dn:SENSITIVE = ENTRY(NUM-ENTRIES(v_TargLst:SCREEN-VALUE,p_Dlmtr),
                                              v_TargLst:SCREEN-VALUE,p_Dlmtr) NE
                                  v_Targlst:ENTRY(v_Targlst:NUM-ITEMS).
             
  /* Turn off the Source List and Actions */
  IF qbf-rm:SENSITIVE
  THEN ASSIGN
    v_SrcLst:SCREEN-VALUE  = ""
    qbf-ad:SENSITIVE       = no.
END.

/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */

ON "GO" OF FRAME FldPicker DO:
  DEFINE VARIABLE tmp-entry AS CHARACTER                             NO-UNDO.
  DEFINE VARIABLE i         AS INTEGER                               NO-UNDO.

  RUN adecomm/_setcurs.p ("WAIT":U).
  p_Result = (IF v_TargLst:LIST-ITEMS IN FRAME FldPicker = ? 
              THEN ""
              ELSE v_TargLst:LIST-ITEMS IN FRAME FldPicker
              ).
  IF INDEX(p_TblLst,"Temp-Tables":U) > 0 THEN DO:
    DO i = 1 TO NUM-ENTRIES(p_Result, p_Dlmtr):
      tmp-entry = ENTRY(i, p_Result, p_Dlmtr).
      IF NUM-ENTRIES(tmp-entry,".":U) = 2 AND
         LOOKUP("Temp-Tables.":U + ENTRY(1, tmp-entry, ".":U), p_TblLst) > 0 THEN
           ENTRY(i, p_Result, p_Dlmtr) = "Temp-Tables.":U + tmp-entry.
      ELSE IF (useDataObject OR p_TT = ?) AND
           NUM-ENTRIES(tmp-entry,".":U) = 1 THEN
        /* Assume DataObject RowObject table. jep-code */
        ENTRY(i, p_Result, p_Dlmtr) = p_TblLst + ".":U + tmp-entry.
    END.  /* Do i = 1 to Num-Entries */
  END.  /* If  there are temp-tables in the initial table list */

END.  /* On GO of Frame FldPicker */

/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */

ON WINDOW-CLOSE OF FRAME FldPicker
   apply "END-ERROR" to frame FldPicker.

/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */

ON "CHOOSE" OF qbf-up IN FRAME FldPicker DO:
  DEFINE VARIABLE qbf_i AS INTEGER   NO-UNDO.
  DEFINE VARIABLE qbf_j AS INTEGER   NO-UNDO.
  DEFINE VARIABLE qbf_l AS CHARACTER NO-UNDO.
  DEFINE VARIABLE qbf_v AS CHARACTER NO-UNDO.
  IF v_TargLst:SCREEN-VALUE IN FRAME FldPicker <> ? THEN DO:
    ASSIGN
      qbf_v = v_TargLst:SCREEN-VALUE IN FRAME FldPicker
      qbf_l = v_TargLst:LIST-ITEMS IN FRAME FldPicker
      qbf_i = LOOKUP(ENTRY(1,qbf_v,p_Dlmtr),qbf_l,p_Dlmtr).
    DO qbf_j = 1 TO NUM-ENTRIES(qbf_v,p_Dlmtr):
      ASSIGN
        ENTRY(LOOKUP(ENTRY(qbf_j,qbf_v,p_Dlmtr),qbf_l,p_Dlmtr),qbf_l,p_Dlmtr) = ""
        qbf_l = TRIM(REPLACE(qbf_l,p_Dlmtr + p_Dlmtr,p_Dlmtr),p_Dlmtr).
    END.
    ASSIGN
      qbf_i = MAXIMUM(qbf_i - 1,1)
      ENTRY(qbf_i,qbf_l,p_Dlmtr) = qbf_v +
                              (IF qbf_l = "" THEN ""
                                             ELSE p_Dlmtr + ENTRY(qbf_i,qbf_l,p_Dlmtr))
      v_TargLst:LIST-ITEMS IN FRAME FldPicker = qbf_l
      v_TargLst:SCREEN-VALUE      IN FRAME FldPicker = qbf_v
      qbf-up:SENSITIVE = ENTRY(1,v_TargLst:SCREEN-VALUE,p_Dlmtr)
                                NE v_TargLst:ENTRY(1)
      qbf-dn:SENSITIVE = ENTRY(NUM-ENTRIES(v_TargLst:SCREEN-VALUE,p_Dlmtr),
                                         v_TargLst:SCREEN-VALUE,p_Dlmtr) NE
                         v_Targlst:ENTRY(v_Targlst:NUM-ITEMS).
  END.
END /*TRIGGER*/ .

ON "CHOOSE" OF qbf-dn IN FRAME FldPicker DO:
  DEFINE VARIABLE qbf_i AS INTEGER   NO-UNDO.
  DEFINE VARIABLE qbf_j AS INTEGER   NO-UNDO.
  DEFINE VARIABLE qbf_l AS CHARACTER NO-UNDO.
  DEFINE VARIABLE qbf_v AS CHARACTER NO-UNDO.
  IF v_TargLst:SCREEN-VALUE IN FRAME FldPicker <> ? THEN DO:
    ASSIGN
      qbf_v = v_TargLst:SCREEN-VALUE IN FRAME FldPicker
      qbf_l = v_TargLst:LIST-ITEMS IN FRAME FldPicker
      qbf_i = LOOKUP(ENTRY(1,qbf_v,p_Dlmtr),qbf_l,p_Dlmtr).
    DO qbf_j = 1 TO NUM-ENTRIES(qbf_v,p_Dlmtr):
      ASSIGN
        ENTRY(LOOKUP(ENTRY(qbf_j,qbf_v,p_Dlmtr),qbf_l,p_Dlmtr),qbf_l,p_Dlmtr) = ""
        qbf_l = REPLACE(qbf_l,p_Dlmtr + p_Dlmtr,p_Dlmtr).
    END.
    ASSIGN
      qbf_l = TRIM(qbf_l,p_Dlmtr)
      qbf_i = MINIMUM(qbf_i,NUM-ENTRIES(qbf_l,p_Dlmtr)).
    IF qbf_i = 0 THEN
      qbf_l = qbf_v.
    ELSE
      ENTRY(qbf_i,qbf_l,p_Dlmtr) = ENTRY(qbf_i,qbf_l,p_Dlmtr) + p_Dlmtr + qbf_v.
    ASSIGN
      v_TargLst:LIST-ITEMS IN FRAME FldPicker   = qbf_l
      v_TargLst:SCREEN-VALUE IN FRAME FldPicker = qbf_v
      qbf-up:SENSITIVE = ENTRY(1,v_TargLst:SCREEN-VALUE,p_Dlmtr)
                                NE v_TargLst:ENTRY(1)
      qbf-dn:SENSITIVE = ENTRY(NUM-ENTRIES(v_TargLst:SCREEN-VALUE,p_Dlmtr),
                                         v_TargLst:SCREEN-VALUE,p_Dlmtr) NE
                         v_Targlst:ENTRY(v_Targlst:NUM-ITEMS).
  END.
END /*TRIGGER*/ .


/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ON   CHOOSE                OF qbf-ad    IN FRAME FldPicker
  OR MOUSE-SELECT-DBLCLICK OF v_SrcLst  IN FRAME FldPicker DO:
  /* Why MOUSE-SELECT-DBLCLICK and not DEFAULT-ACTION?  Because this is in
     a dialog box and the RETURN key will fire the GO for the frame.  I don't
     want it to also fire the ADD trigger. [Arguably, this is a bug with the
     Progress DEFAULT-BUTTON logic.  RETURN should do one or the other, not
     both DEFAULT-ACTION for selection-lists and DEFAULT-BUTTON for the frame */

  DEFINE VARIABLE cnt         AS INTEGER   NO-UNDO.
  DEFINE VARIABLE qbf_a       AS LOGICAL   NO-UNDO.
  DEFINE VARIABLE qbf_i       AS INTEGER   NO-UNDO.
  DEFINE VARIABLE qbf_v       AS CHARACTER NO-UNDO.
  DEFINE VAR empty_target     AS LOGICAL   NO-UNDO.

  IF v_SrcLst:SCREEN-VALUE IN FRAME FldPicker <> ? THEN DO:
    /* when going from left to right, always add to end of list */
    qbf_v = v_SrcLst:SCREEN-VALUE IN FRAME FldPicker.

    DO qbf_i = 1 TO NUM-ENTRIES(qbf_v,p_Dlmtr):
      cTemp = ENTRY (qbf_i, qbf_v,p_Dlmtr).
      
      /* If it matches the it is an array thing. */
      IF cTemp MATCHES ("*[*]*") THEN DO:
        ASSIGN cTemp      = TRIM (cTemp)
               cArrayList = SUBSTRING(cTemp,INDEX(cTemp,'[':u) + 1,-1,
                                      "CHARACTER":u)
               cArrayList = REPLACE(cArrayList,"]":u,"")
               cTemp      = SUBSTRING(cTemp,1,INDEX(cTemp,'[':u) - 1,
                                      "CHARACTER":u).

        /* Loop through the list base on " " */
        DO i = 1 TO NUM-ENTRIES (cArrayList, ' '):
          ASSIGN cArrayEntry = ENTRY (i, cArrayList, ' ')
                 iArrayLow   = INTEGER (ENTRY (1, cArrayEntry, '-'))
                 iArrayHigh  = INTEGER (ENTRY (NUM-ENTRIES (cArrayEntry, '-'),
                                                            cArrayEntry, '-')).

          /* Loop through the list base on X-Y. X is the low number.
                                                Y is the high number.           */
          DO j = iArrayLow TO iArrayHigh:
            ASSIGN cArrayEntry = cTemp + '[' + STRING (j) + ']'.
            /* Add element if it is not already there */
            IF v_TargLst:LOOKUP(cArrayEntry) = 0 THEN
                   qbf_a = v_TargLst:ADD-LAST (cArrayEntry) IN FRAME FldPicker.
          END. /* DO J */
        END. /* DO I */
      END. /* IF MATCHES */
      ELSE qbf_a = v_TargLst:ADD-LAST(ENTRY(qbf_i,qbf_v,p_Dlmtr)) IN FRAME FldPicker.

      /* Keep the position in the list highlighted if there was only one. */
      IF NUM-ENTRIES(qbf_v,p_Dlmtr) eq 1
      THEN RUN adecomm/_delitem.p (v_SrcLst:HANDLE, 
                                  ENTRY(qbf_i, qbf_v, p_Dlmtr),
                                  OUTPUT cnt).  
      ELSE stat = v_SrcLst:DELETE (ENTRY(qbf_i, qbf_v, p_Dlmtr)). 

    END. /* NUM-ENTRIES */
    /* If the source has no selection then disable all the buttons */
    qbf-ad:SENSITIVE IN FRAME FldPicker = ( v_SrcLst:SCREEN-VALUE NE ? ).
  END.
END /*TRIGGER*/ .

/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 
*/
ON   CHOOSE                OF qbf-rm     IN FRAME FldPicker
  OR MOUSE-SELECT-DBLCLICK OF v_TargLst  IN FRAME FldPicker DO:
  /* Why MOUSE-SELECT-DBLCLICK and not DEFAULT-ACTION?  Because this is in
     a dialog box and the RETURN key will fire the GO for the frame.  I don't
     want it to also fire the REMOVE trigger. [Arguably, this is a bug with the
     Progress DEFAULT-BUTTON logic.  RETURN should do one or the other, not
     both DEFAULT-ACTION for selection-lists and DEFAULT-BUTTON for the frame */
  DEFINE VARIABLE qbf_a AS LOGICAL   NO-UNDO.
  DEFINE VARIABLE qbf_i AS INTEGER   NO-UNDO.
  DEFINE VARIABLE qbf_j AS INTEGER   NO-UNDO.
  DEFINE VARIABLE cnt   AS INTEGER   NO-UNDO.
  DEFINE VARIABLE qbf_l AS CHARACTER NO-UNDO.
  DEFINE VARIABLE qbf_v AS CHARACTER NO-UNDO.
  DEFINE VAR empty_target	AS LOGICAL			NO-UNDO.
  
  IF v_TargLst:SCREEN-VALUE IN FRAME FldPicker <> ? THEN DO:
    /* when going from right to left, put back in original position */

    ASSIGN
      qbf_l = v_SrcLst:LIST-ITEMS IN FRAME FldPicker
      qbf_v = v_TargLst:SCREEN-VALUE IN FRAME FldPicker.

    DO qbf_i = 1 TO NUM-ENTRIES(qbf_v, p_Dlmtr):
      /* Keep the position in the list highlighted if there was only one. */
      IF NUM-ENTRIES(qbf_v,p_Dlmtr) eq 1
      THEN RUN adecomm/_delitem.p (v_TargLst:HANDLE, 
                                   ENTRY (qbf_i, qbf_v, p_Dlmtr), 
                                   OUTPUT cnt).

      ELSE stat = v_TargLst:DELETE (ENTRY(qbf_i, qbf_v, p_Dlmtr)). 

      RUN adecomm/_collaps.p (v_SrcLst:HANDLE, ENTRY (qbf_i, qbf_v, p_Dlmtr)).
    END.
    
    
    /* If the target is empty then disable all the buttons. */
    empty_target = ( v_TargLst:SCREEN-VALUE eq ? ).
    ASSIGN
         qbf-rm:SENSITIVE IN FRAME FldPicker = NOT empty_target
         qbf-up:SENSITIVE IN FRAME FldPicker = NOT empty_target
         qbf-dn:SENSITIVE IN FRAME FldPicker = NOT empty_target
         .
    /* Empty the screen-value if the list is empty. There seems to be
       a bug here that the SCREEN-VALUE becomes UNKNOWN and stops the
       next VALUE-CHANGED from firing. */
    IF empty_target THEN v_TargLst:SCREEN-VALUE = "".

  END.
END /*TRIGGER*/ .

/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */

/*----- HELP -----*/
ON HELP of FRAME FldPicker OR CHOOSE OF qbf-hlp IN FRAME FldPicker
   RUN "adecomm/_adehelp.p" (INPUT "comm", INPUT "CONTEXT", 
      	       	     	     INPUT {&Multi_Field_Selection},
      	       	     	     INPUT ?).


/*--------------------------------------------------------------------------*/

{ adecomm/okrun.i
    &FRAME  = "FRAME FldPicker"
    &BOX    = "rect_Btn_Box"
    &OK     = "qbf-ok"
    &HELP   = "qbf-hlp"
}

useDataObject = IF VALID-HANDLE(p_hDataObject) THEN TRUE ELSE FALSE.

/* JEP-UNFINISHED - _getdlst.p: should this support temp-tables? */
IF useDataObject THEN
DO:
   RUN adecomm/_getdlst.p
        (INPUT v_SrcLst:HANDLE,
         INPUT p_hDataObject,
         INPUT no,
         INPUT p_Items,
         INPUT ?,
         OUTPUT t_log).
   IF NOT t_log THEN
     RETURN.        
END.
/* Add temp-tables fields to the available list.
  This used to be an ELSE. I changed it to the IF check instead.
  jep-code */
IF (NOT useDataObject) OR (p_TT <> ?) THEN
DO:
    RUN adecomm/_mfldlst.p
        (INPUT v_SrcLst:HANDLE,
         INPUT p_TblLst,
         INPUT p_TT,
         INPUT yes,
         INPUT p_Items,
         INPUT 1,
         INPUT "",
         OUTPUT t_log).
    IF NOT useDataObject AND NOT t_log THEN
      RETURN.        
END.

/* Remove array elements from v_SrcLst that might already be there */
IF p_Result NE "" THEN DO:  /* If first time, no need to check for elements */
  DO t_int = 1 TO v_SrcLst:NUM-ITEMS:
    /* Check if an array */
    cTemp = v_SrcLst:ENTRY(t_int).
    IF INDEX(cTemp,"[":U) > 0 THEN DO:  /* This is an array */
      ASSIGN cArrayList = ENTRY(2, cTemp, '[':u)
             cArrayList = ENTRY(1,cArrayList,']':u)
             cTemp      = ENTRY(1,cTemp,'[':U)
             first-time = TRUE.

      /* Loop through the list base on " " */
      DO i = 1 TO NUM-ENTRIES (cArrayList, ' '):
        ASSIGN cArrayEntry = ENTRY (i, cArrayList, ' ')
               iArrayLow   = INTEGER (ENTRY (1, cArrayEntry, '-'))
               iArrayHigh  = INTEGER (ENTRY (NUM-ENTRIES (cArrayEntry, '-'),
                                                          cArrayEntry, '-')).

        IF first-time THEN /* Clear existing brackets */
          ASSIGN  t_log = v_SrcLst:REPLACE(cTemp + "[]":U, t_int)
                  first-time = FALSE.
                       
        /* Loop through the list base on X-Y. X is the low number.
                                              Y is the high number.           */
        DO j = iArrayLow TO iArrayHigh:
          ASSIGN cArrayEntry = cTemp + '[' + STRING (j) + ']'.
          /* Add and "Collapse" cArrayEntry out if it is NOT
             in the results list                              */
          IF LOOKUP(cArrayEntry, p_Result, p_Dlmtr) = 0 THEN DO:
            RUN adecomm/_collaps.p (v_SrcLst:HANDLE, cArrayEntry).
          END.
        END. /* DO J */
      END. /* DO I */
      IF v_SrcLst:ENTRY(t_int) MATCHES "*[]" THEN
         t_log = v_SrcLst:DELETE(t_int).
    END.  /* This is an array */  
  END. /* DO t_int 1 to num-items */
END.  /* If possibility of array elements */
/*
** Make sure p_Result items are in the source list.  If they are, then
** remove them and put the item in the v_TargLst selection list.
*/
/* v_OrigSrc = v_SrcLst:LIST-ITEMS in frame FldPicker. */
DO t_int = 1 TO NUM-ENTRIES(p_Result, p_Dlmtr):
  ASSIGN t_log = v_SrcLst:DELETE(ENTRY(t_int,p_Result, p_Dlmtr)) IN FRAME FldPicker
         t_log = v_TargLst:ADD-LAST(ENTRY(t_int,p_Result, p_Dlmtr)) IN FRAME FldPicker.
END.

/* Remove any fields the caller wants excluded from available fields. */
IF p_Exclude <> "" THEN
DO t_int = 1 TO NUM-ENTRIES(p_Exclude, p_Dlmtr):
  ASSIGN t_log = v_SrcLst:DELETE(ENTRY(t_int, p_Exclude, p_Dlmtr)) IN FRAME FldPicker NO-ERROR.
  /* Handle cases where the selector must use the RowObject table name,
     such as when an object has other temp-tables defined for it. */
  ASSIGN t_log = v_SrcLst:DELETE("RowObject." + ENTRY(t_int, p_Exclude, p_Dlmtr)) IN FRAME FldPicker NO-ERROR.
END.

ENABLE v_SrcLst 
       qbf-ad 
       v_TargLst 
       qbf-ok
       qbf-cn 
       qbf-hlp
       WITH FRAME FldPicker.
ASSIGN
   stat = qbf-rm:MOVE-AFTER-TAB-ITEM(qbf-ad:HANDLE IN FRAME FldPicker)
   stat = qbf-up:MOVE-AFTER-TAB-ITEM(qbf-rm:HANDLE IN FRAME FldPicker)
   stat = qbf-dn:MOVE-AFTER-TAB-ITEM(qbf-up:HANDLE IN FRAME FldPicker).

/* Select the first item in the source list */
IF v_SrcLst:NUM-ITEMS > 0 THEN v_SrcLst:SCREEN-VALUE = v_SrcLst:ENTRY(1).
 
/* Assume a cancel until the user hits OK. */
l_Cancel = yes.
&scoped-define CANCEL-EVENT U2
{adeuib/ide/dialogstart.i qbf-ok qbf-cn wintitle}
DO ON ERROR UNDO,RETRY ON ENDKEY UNDO,LEAVE:
  APPLY "ENTRY"  TO v_SrcLst IN FRAME FldPicker.
  &if DEFINED(IDE-IS-RUNNING) = 0  &then
        WAIT-FOR "CHOOSE" OF qbf-ok IN FRAME FldPicker OR
           GO OF FRAME FldPicker. 
    &ELSE
        WAIT-FOR "choose" of qbf-ok in frame FldPicker or "u2" of this-procedure.       
        if cancelDialog THEN UNDO, LEAVE.  
    &endif
    
  /* No Cancel. */
  l_cancel = NO.
END.

HIDE FRAME FldPicker NO-PAUSE.

IF l_Cancel 
THEN RETURN "Cancel":U.
ELSE RETURN.

/* two.p - end of file */

/* This is a kludge for MS-WINDOWS  - see bug # 94-09-16-030.   */
/* When the user dblclicks on a table in the adecomm/_tblsel.p procedure this dialog
   (_mfldsel.p) is brought into context on the MOUSE-SELECT-DOWN of the 2nd click.
   However, the MOUSE-SELECT-UP of the second click "bleeds" through to the underlying
   frame of the UIB design window and attempts to fire the frame-select-up persistent
   trigger.  This fails with an error message that it can't find frame-select-up.  By
   putting this procedure in this file it will find it and supress the error message. */
PROCEDURE frame-select-up.
  RETURN.
END./*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/*----------------------------------------------------------------------------
    Procedure	:  _mnkvals.p
    
    Syntax:     RUN adecomm/_mnkvals.p ( INPUT p_Menu , 
                                        INPUT p_Mode , 
                                        INPUT p_Section ,
                                        INPUT p_Exclude ,
                                        OUTPUT p_Menu_Accels ) .

  Description:

    On Save (PUT) Saves Menu Accelerator settings to current PROGRESS
    Environment file (e.g., PROGRESS.INI or .Xdefaults).  
   
    On Read (GET), assigns accelerators to p_Menu menu items.

  Parameters
        INPUT   p_Menu  Handle to menu whose accelerators you want to 
                        save/read.
        			        		
                p_Mode  Mode indicator for read or save.
                        "GET"  : Reads from current Env. file.
                        "PUT"  : Saves to current Env. file and does not report save errors.
                        "PUT-ERROR"  : Saves to current Env. file and reports save errors.
                  
                p_Section   Section to read or save in the Env. file.
                
                p_Exclude   Comma-delimited list of Menu Labels (of a menubar) to exclude
                            from the p_Menu_Accels list.  Must include the & if there is one.
                            Pass Null ("") to not exclude any menu.
                            
                            Example: "&Tools,&Options,&Help"
                
        OUTPUT  p_Menu_Accels   Comma-delimited list of Menu Items and their
                                accelerators in the form:
                                
                                    "MenuLabel:Accelerator,..."
                                
                                The menu labels have all &, spaces, and ellipses
                                removed. A trailing comma is left at the end of
                                the list.

  Notes
        If p_Menu is ?, exits without a message.

  Author: John Palazzo
----------------------------------------------------------------------------*/

DEFINE INPUT  PARAMETER p_Menu        AS WIDGET-HANDLE NO-UNDO .
DEFINE INPUT  PARAMETER p_Mode        AS CHAR          NO-UNDO .
DEFINE INPUT  PARAMETER p_Section     AS CHAR          NO-UNDO .
DEFINE INPUT  PARAMETER p_Exclude     AS CHAR          NO-UNDO .
DEFINE OUTPUT PARAMETER p_Menu_Accels AS CHAR          NO-UNDO .

DEFINE WORK-TABLE w_MenuObject NO-UNDO
	FIELD hMenu AS WIDGET-HANDLE
	FIELD Menu_Label AS CHAR
	FIELD Menu_Item_Label AS CHAR
	FIELD Menu_Item_Key AS CHAR
	FIELD Menu_Accelerator AS CHAR
	.

DEFINE VAR vKey         AS CHAR    NO-UNDO.
DEFINE VAR vKeyValue    AS CHAR    NO-UNDO.
DEFINE VAR Key_Value    AS CHAR    NO-UNDO.
DEFINE VAR Temp_Logical AS LOGICAL NO-UNDO.
DEFINE VAR Put_Failed   AS LOGICAL NO-UNDO INIT FALSE.

PROCEDURE MenuTree.

  DEFINE INPUT PARAMETER p_hMenu  AS WIDGET-HANDLE NO-UNDO .
  DEFINE INPUT PARAMETER p_Parent AS CHARACTER     NO-UNDO .

  DEFINE VAR hMenu_Item AS WIDGET-HANDLE.
  DEFINE VAR Item_Name  AS CHAR.
  
  IF ( p_hMenu = ? ) THEN RETURN.
  
  ELSE IF ( p_hMenu:TYPE = "MENU" )
  THEN DO:
    RUN MenuTree( p_hMenu:FIRST-CHILD , "" ).
    RETURN.
  END.
  
  ELSE IF ( p_hMenu:TYPE = "SUB-MENU" )
  THEN DO:
         CREATE w_MenuObject.
         ASSIGN w_MenuObject.hMenu      = p_hMenu
                w_MenuObject.Menu_Label = p_hMenu:LABEL
                w_MenuObject.Menu_Item_Label = p_hMenu:LABEL
         . /* END ASSIGN. */
        /*-------------------------------------------------------------------
            Special Character Handling for Menu Item Labels:
            - Strip out mnemonic character (&)
                ex. "Save &As..." -->  "Save As..."
            - Close up spaces
                ex. "Save As..."  -->  "SaveAs..."
            - Remove ellipses
                ex. "Save As..."  -->  "SaveAs"
        -------------------------------------------------------------------*/
         ASSIGN
           w_MenuObject.Menu_Item_Key = w_MenuObject.Menu_Item_Label
           w_MenuObject.Menu_Item_Key = REPLACE( w_MenuObject.Menu_Item_Key ,
         					 "&" , "" )
           w_MenuObject.Menu_Item_Key = REPLACE( w_MenuObject.Menu_Item_Key ,
         					 " " , "" )
           w_MenuObject.Menu_Item_Key = REPLACE( w_MenuObject.Menu_Item_Key ,
         					 "." , "" )
         . /* END ASSIGN */
         RUN MenuTree( p_hMenu:FIRST-CHILD , p_hMenu:LABEL ).
         RUN MenuTree( p_hMenu:NEXT-SIBLING , "" ).
         RETURN.
  END.
  
  ELSE IF ( p_hMenu:TYPE = "MENU-ITEM" ) AND 
          ( p_hMenu:SUBTYPE = "NORMAL" )
  THEN DO:
         CREATE w_MenuObject.
         ASSIGN w_MenuObject.hMenu      = p_hMenu
                w_MenuObject.Menu_Label = p_Parent
                w_MenuObject.Menu_Item_Label = p_hMenu:LABEL
         . /* END ASSIGN. */
        /*-------------------------------------------------------------------
            Special Character Handling for Menu Item Labels:
            - Strip out mnemonic character (&)
                ex. "Save &As..." -->  "Save As..."
            - Close up spaces
                ex. "Save As..."  -->  "SaveAs..."
            - Remove ellipses
                ex. "Save As..."  -->  "SaveAs"
        -------------------------------------------------------------------*/
         ASSIGN
           w_MenuObject.Menu_Item_Key = w_MenuObject.Menu_Item_Label
           w_MenuObject.Menu_Item_Key = REPLACE( w_MenuObject.Menu_Item_Key ,
         					 "&" , "" )
           w_MenuObject.Menu_Item_Key = REPLACE( w_MenuObject.Menu_Item_Key ,
         					 " " , "" )
           w_MenuObject.Menu_Item_Key = REPLACE( w_MenuObject.Menu_Item_Key ,
         					 "." , "" )
         . /* END ASSIGN */

        IF ( p_hMenu:ACCELERATOR <> ? )
        THEN ASSIGN w_MenuObject.Menu_Accelerator = p_hMenu:ACCELERATOR.
        RUN MenuTree( p_hMenu:NEXT-SIBLING , p_Parent ).
        RETURN.
  END.

  ELSE DO: /* SKIP to NEXT-SIBLING for RULES, SKIPs, etc */
    RUN MenuTree( p_hMenu:NEXT-SIBLING , p_Parent ).
    RETURN.
  END.  
  
END PROCEDURE.

PROC_MAIN:
DO ON STOP  UNDO, RETRY
   ON ERROR UNDO, RETRY:  /* proc-main */

  IF NOT RETRY
  THEN DO:
  
  IF p_Menu = ? THEN RETURN.
  RUN adecomm/_setcurs.p ( INPUT "WAIT" ).

  RUN MenuTree ( p_Menu , "" ).
  
  /* Be certain to reset to default Progress Environment File. */
  USE "" NO-ERROR.
          
  FOR EACH w_MenuObject:

    /* Process Menu-Items only, not SUB-MENUS. */
    IF ( w_MenuObject.hMenu:TYPE <> "MENU-ITEM" ) THEN NEXT.
    /* Exclude unwanted menus/menu-items. */
    IF ( LOOKUP( w_MenuObject.Menu_Label , p_Exclude ) > 0 ) THEN NEXT.
    /* Exclude Most Recently Used file list menu items - MRU file menu items
       begin with a number 1-9 followed by the file name */
    IF ( LOOKUP (SUBSTRING(w_MenuObject.Menu_Item_Key, 1, 1), "1,2,3,4,5,6,7,8,9") > 0 ) 
      THEN NEXT.

    ASSIGN  vKey        = w_MenuObject.Menu_Item_Key
            vKeyValue   = w_MenuObject.Menu_Accelerator
            Key_Value   = vKeyValue
    . /* END ASSIGN */
        
    /*-----------------------------------------------------------------
        Get the key value. Do this regadless of PUT or GET mode.
        Then, if PUT mode and the key's value is different than
        what's currently in environment file, go ahead and save
        the new value.
    -----------------------------------------------------------------*/
    GET-KEY-VALUE SECTION p_Section KEY vKey VALUE vKeyValue .
    IF ( p_Mode BEGINS "PUT" )
    THEN DO:
        IF ( Key_Value <> vKeyValue )
        THEN DO:
            ASSIGN vKeyValue = Key_Value .
            PUT-KEY-VALUE SECTION p_Section KEY vKey VALUE vKeyValue NO-ERROR.
            IF ERROR-STATUS:ERROR AND Put_Failed = FALSE
            THEN DO:
                ASSIGN Put_Failed = TRUE.
                IF p_Mode = "PUT-ERROR" THEN
                  RUN adeshar/_puterr.p ( INPUT "menu" , INPUT p_Menu:WINDOW ).
            END.
        END.
    END.
    ELSE IF ( vKeyValue <> ? ) /* ( p_Mode = "GET" ) is implicit. */
    THEN DO:
        ASSIGN w_MenuObject.hMenu:ACCELERATOR = vKeyValue
               w_MenuObject.Menu_Accelerator  = vKeyValue
        . /* END ASSIGN. */
    END.
    
    /* Leave trailing comma - it doesn't cause any harm. */
    ASSIGN
        p_Menu_Accels = p_Menu_Accels + w_MenuObject.Menu_Item_Key
                                      + ":" 
                                      + w_MenuObject.Menu_Accelerator
                                      + ",".
  END. /* FOR */
 
  END. /* IF NOT RETRY */
  
  RUN adecomm/_setcurs.p ( INPUT "" ).

END. /* proc-main */
&ANALYZE-SUSPEND _VERSION-NUMBER UIB_v8r12 GUI
&ANALYZE-RESUME
&Scoped-define WINDOW-NAME CURRENT-WINDOW
&Scoped-define FRAME-NAME f
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _DEFINITIONS f 
/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/
/*------------------------------------------------------------------------

  File: _modpath.w

  Description: Let the user view and modify the PROPATH attribute.

  Input Parameters:
      <none>

  Output Parameters:
      <none>

  Author: Wm.T.Wood 

  Created: 08/03/93 - 12:59 pm
  
  Modified: 1/94 by RPR
    wood 7/5/95 - Use standard "adeshar/_dirname.p" when user adds a directory
                - change label of b_Add to "Add..."

------------------------------------------------------------------------*/
/*          This .W file was created with the Progress UIB.             */
/*----------------------------------------------------------------------*/

/* ***************************  Definitions  ************************** */
DEFINE INPUT PARAMETER        pDirList     AS CHAR NO-UNDO. 
DEFINE INPUT PARAMETER        pShow3D      AS LOGICAL NO-UNDO.
DEFINE INPUT-OUTPUT PARAMETER pCurrentPath AS CHAR NO-UNDO.
DEFINE OUTPUT PARAMETER       pNewList     AS CHAR NO-UNDO.

DEFINE VARIABLE i                AS INTEGER NO-UNDO. 
DEFINE VARIABLE DirectoryPresent AS LOGICAL NO-UNDO. 
define variable wintitle as char no-undo init "Edit Path":L.
DEFINE VAR l_ok     AS LOGICAL NO-UNDO.
DEFINE VAR new_dir  AS CHAR NO-UNDO.
DEFINE VAR test_dir AS CHAR NO-UNDO.
&GLOBAL-DEFINE WIN95-BTN YES
&IF LOOKUP(OPSYS, "MSDOS,WIN32":u) > 0 &THEN
  &Scoped-define DIR-SLASH ~~~\
&ELSE 
  &Scoped-define DIR-SLASH /
&ENDIF  

&Global-define SKP ""

/* Include Files.... */
{adecomm/commeng.i}   /* Help Context stings. */

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME


&ANALYZE-SUSPEND _UIB-PREPROCESSOR-BLOCK 

/* ********************  Preprocessor Definitions  ******************** */

&Scoped-define PROCEDURE-TYPE DIALOG-BOX

/* Name of first Frame and/or Browse and/or first Query                 */
&Scoped-define FRAME-NAME f

/* Standard List Definitions                                            */
&Scoped-Define ENABLED-OBJECTS path-list b_add b_delete RECT-6 b_move_up ~
b_move_down 

/* Custom List Definitions                                              */
/* List-1,List-2,List-3,List-4,List-5,List-6                            */

/* _UIB-PREPROCESSOR-BLOCK-END */
&ANALYZE-RESUME



/* ***********************  Control Definitions  ********************** */

/* Define a dialog box                                                  */

/* Definitions of the field level widgets                               */
DEFINE BUTTON b_add 
     LABEL "&Add...":L 
     SIZE 15 BY 1.14.

DEFINE BUTTON b_delete 
     LABEL "&Remove":L 
     SIZE 15 BY 1.14.

DEFINE BUTTON b_move_down 
     LABEL "Move &Down":L 
     SIZE 15 BY 1.14.

DEFINE BUTTON b_move_up 
     LABEL "Move &Up":L 
     SIZE 15 BY 1.14.

DEFINE RECTANGLE RECT-6
     EDGE-PIXELS 3 GRAPHIC-EDGE  NO-FILL 
     SIZE 12 BY .19.

DEFINE VARIABLE path-list AS CHARACTER 
     VIEW-AS SELECTION-LIST MULTIPLE 
     SCROLLBAR-HORIZONTAL SCROLLBAR-VERTICAL 
     SIZE 34.8 BY 6.14 NO-UNDO.


/* ************************  Frame Definitions  *********************** */

DEFINE FRAME f
     path-list AT ROW 1.52 COL 3 NO-LABEL
     b_add AT ROW 1.52 COL 38.8
     b_delete AT ROW 2.81 COL 38.8
     b_move_up AT ROW 5.05 COL 39
     b_move_down AT ROW 6.38 COL 39
     RECT-6 AT ROW 4.38 COL 39.8
     SPACE(2.99) SKIP(3.28)
    WITH
    &if DEFINED(IDE-IS-RUNNING) = 0  &then 
    VIEW-AS DIALOG-BOX TITLE wintitle 
    &else
    NO-BOX
    &endif
    SIDE-LABELS THREE-D  SCROLLABLE.

 

/* *********************** Procedure Settings ************************ */

&ANALYZE-SUSPEND _PROCEDURE-SETTINGS
/* Settings for THIS-PROCEDURE
   Type: DIALOG-BOX
   Other Settings: COMPILE
 */
&ANALYZE-RESUME _END-PROCEDURE-SETTINGS


/* ***************  Runtime Attributes and UIB Settings  ************** */

&ANALYZE-SUSPEND _RUN-TIME-ATTRIBUTES
/* SETTINGS FOR DIALOG-BOX f
   UNDERLINE Default                                                    */
ASSIGN 
       FRAME f:SCROLLABLE       = FALSE
       FRAME f:HIDDEN           = TRUE.

/* SETTINGS FOR BUTTON b_add IN FRAME f
   NO-DISPLAY                                                           */
/* SETTINGS FOR BUTTON b_delete IN FRAME f
   NO-DISPLAY                                                           */
/* SETTINGS FOR BUTTON b_move_down IN FRAME f
   NO-DISPLAY                                                           */
/* SETTINGS FOR BUTTON b_move_up IN FRAME f
   NO-DISPLAY                                                           */
/* SETTINGS FOR SELECTION-LIST path-list IN FRAME f
   NO-DISPLAY                                                           */
/* _RUN-TIME-ATTRIBUTES-END */
&ANALYZE-RESUME


/* Setting information for Queries and Browse Widgets fields            */

&ANALYZE-SUSPEND _QUERY-BLOCK DIALOG-BOX f
/* Query rebuild information for DIALOG-BOX f
     _Options          = "SHARE-LOCK"
     _Query            is NOT OPENED
*/  /* DIALOG-BOX f */
&ANALYZE-RESUME

 {adeuib/ide/dialoginit.i "FRAME f:handle"}
&IF DEFINED(IDE-IS-RUNNING) <> 0 &THEN
dialogService:View().  
&ENDIF 




/* ************************  Control Triggers  ************************ */

&Scoped-define SELF-NAME f
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL f f
ON WINDOW-CLOSE OF FRAME f /* Edit Path */
DO:
   /* Add Trigger to equate WINDOW-CLOSE to END-ERROR. */
  APPLY "END-ERROR":U TO SELF.
END.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME


&Scoped-define SELF-NAME b_add
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL b_add f
ON CHOOSE OF b_add IN FRAME f /* Add... */
DO:    
  &if DEFINED(IDE-IS-RUNNING) <> 0  &then
      dialogService:SetCurrentEvent(this-procedure,"ide_choose_dirname").
      run runChildDialog in hOEIDEService (dialogService) .
  &else
  /* Get a new directory name. */
  RUN adeshar/_dirname.p
         ( INPUT        "Add Directory to Path", /* Dialog Title Bar */
           INPUT        NO,                      /* YES is \'s converted to /'s */
           INPUT        YES,                     /* YES if directory must exist */
           INPUT        "comm",                  /* ADE Tool (used for help call) */
           INPUT        {&Add_Dir_Path_Dlg_Box}, /* Context ID for HELP call */
           INPUT-OUTPUT new_dir ,                /* File Spec entered */
           OUTPUT       l_ok                     /* YES if user hits OK */
         ) .
   &endif      
  /* Make sure the user hit "OK".  Check the new directory to make sure
     it really is new. */
  IF l_ok THEN DO:    
    ASSIGN FILE-INFO:FILE-NAME = new_dir
           DirectoryPresent    = NO
           /* Convert the \'s to /'s for the upcoming test. */
           new_dir = REPLACE (new_dir, "~\":U, "~/":U)
           .
    /* Before adding this to the list-items, cycle through the list-items
       to insure that we don't already have this directory.  */ 
    TEST-BLOCK:
    DO i = 1 TO NUM-ENTRIES(path-list:LIST-ITEMS,","):  
      ASSIGN test_dir = TRIM(ENTRY(2, ENTRY(i,path-list:LIST-ITEMS,",":u),") ":u))
             test_dir = REPLACE (test_dir, "~\":U, "~/":U)
             .
      IF test_dir = new_dir THEN DO:
        DirectoryPresent = TRUE. 
        LEAVE TEST-BLOCK.
      END.
    END.
  
    IF DirectoryPresent THEN
      MESSAGE FILE-INFO:FILENAME SKIP(1)
              "This directory is already in the list." {&SKP}
              "It will not be added again."
        VIEW-AS ALERT-BOX ERROR.
    ELSE
      l_ok = path-list:ADD-FIRST ("  0) " + FILE-INFO:FILENAME).
    
    IF l_ok THEN DO:
      RUN number_path.
      path-list:SCREEN-VALUE = path-list:ENTRY(1).
    END.
  END.
END.      

/**************************************************************************/

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME


&Scoped-define SELF-NAME b_delete
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL b_delete f
ON CHOOSE OF b_delete IN FRAME f /* Remove */
DO:
  DEFINE VAR i      AS INTEGER NO-UNDO.
  DEFINE VAR choice AS CHAR NO-UNDO.
  DEFINE VAR l_ok   AS LOGICAL NO-UNDO.
  
  choice = path-list:SCREEN-VALUE. 
  IF Path-list:NUM-ITEMS <= 1 THEN DO:
    MESSAGE "You cannot delete all directories from a path list." 
      VIEW-AS ALERT-BOX ERROR.
    RETURN.
  END.
  
  DO i = 1 TO NUM-ENTRIES(choice):
    l_ok = path-list:DELETE(ENTRY(i,choice)).
  END.
  /* Renumber the path */
  RUN number_path.
  path-list:SCREEN-VALUE = path-list:ENTRY(1).
END.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME


&Scoped-define SELF-NAME b_move_down
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL b_move_down f
ON CHOOSE OF b_move_down IN FRAME f /* Move Down */
DO:
  DEFINE VAR i           AS INTEGER NO-UNDO.
  DEFINE VAR ipos        AS INTEGER NO-UNDO.
  DEFINE VAR choice      AS CHAR NO-UNDO.
  DEFINE VAR swap-item   AS CHAR NO-UNDO.
  DEFINE VAR choice-item AS CHAR NO-UNDO.
  DEFINE VAR new-swap    AS CHAR NO-UNDO.
  DEFINE VAR new-choice  AS CHAR NO-UNDO.
  DEFINE VAR l_ok        AS LOGICAL NO-UNDO.
  
  ASSIGN choice = path-list:SCREEN-VALUE.
  DO i = NUM-ENTRIES(choice) TO 1 BY -1:
    ASSIGN choice-item = ENTRY(i,choice) 
           ipos        = INTEGER(SUBSTRING(choice-item,1,3, "CHARACTER":u)).
    IF ipos < path-list:NUM-ITEMS THEN DO:
      /* Get the item above the current choice and swap it with the current 
         choice.  Change the line numbers of the choice to the swapped line 
         number (this is the first 3 characters). */
      swap-item  = path-list:ENTRY(ipos + 1).
      IF LOOKUP(swap-item,choice) eq 0 THEN 
        ASSIGN
          new-choice      = choice-item
          new-swap        = swap-item
          SUBSTRING(new-swap,1,3, "CHARACTER":u)   = 
            SUBSTRING(choice-item,1,3, "CHARACTER":u)
          SUBSTRING(new-choice,1,3, "CHARACTER":u) = 
            SUBSTRING(swap-item,1,3, "CHARACTER":u)
          l_ok            = path-list:REPLACE(new-swap, choice-item)
          l_ok            = path-list:REPLACE(new-choice, swap-item)
          ENTRY(i,choice) = new-choice.
    END.
  END.
  /* reset the value of the choice. */
  path-list:SCREEN-VALUE = choice.
END.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME


&Scoped-define SELF-NAME b_move_up
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL b_move_up f
ON CHOOSE OF b_move_up IN FRAME f /* Move Up */
DO:
  DEFINE VAR i           AS INTEGER NO-UNDO.
  DEFINE VAR ipos        AS INTEGER NO-UNDO.
  DEFINE VAR choice      AS CHAR NO-UNDO.
  DEFINE VAR swap-item   AS CHAR NO-UNDO.
  DEFINE VAR choice-item AS CHAR NO-UNDO.
  DEFINE VAR new-swap    AS CHAR NO-UNDO.
  DEFINE VAR new-choice  AS CHAR NO-UNDO.
  DEFINE VAR l_ok        AS LOGICAL NO-UNDO.
  
  ASSIGN choice = path-list:SCREEN-VALUE.
  DO i = 1 TO NUM-ENTRIES(choice):
    ASSIGN choice-item = ENTRY(i,choice) 
           ipos        = INTEGER(SUBSTRING(choice-item,1,3, "CHARACTER":u)).
    IF ipos > 1 THEN DO:
      /* Get the item above the current choice and swap it with the current 
         choice.  Change the line numbers of the choice to the swapped line 
         number (this is the first 3 characters). */
      swap-item  = path-list:ENTRY(ipos - 1).
      IF LOOKUP(swap-item,choice) eq 0 THEN 
        ASSIGN
          new-choice      = choice-item
          new-swap        = swap-item
          SUBSTRING(new-swap,1,3, "CHARACTER":u)   = 
            SUBSTRING(choice-item,1,3, "CHARACTER":u)
          SUBSTRING(new-choice,1,3, "CHARACTER":u) = 
            SUBSTRING(swap-item,1,3, "CHARACTER":u)
          l_ok            = path-list:REPLACE( new-swap, choice-item)
          l_ok            = path-list:REPLACE( new-choice, swap-item)
          ENTRY(i,choice) = new-choice.
    END.
  END.
  /* reset the value of the choice. */
  path-list:SCREEN-VALUE = choice.
END.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME


&UNDEFINE SELF-NAME

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _MAIN-BLOCK f 


/* ********************* Sullival Bar Standards ********************** */

/* Parent the dialog-box to the ACTIVE-WINDOW, if there is no parent.   */
IF VALID-HANDLE(ACTIVE-WINDOW) AND FRAME {&FRAME-NAME}:PARENT eq ?
THEN FRAME {&FRAME-NAME}:PARENT = ACTIVE-WINDOW.

/* Make the Frame 3D. */
&if DEFINED(IDE-IS-RUNNING) = 0  &then
ASSIGN FRAME {&frame-name}:THREE-D = pShow3D.
&endif
{ adecomm/commeng.i }
{ adecomm/okbar.i &TOOL = "COMM"
                 &CONTEXT = {&Edit_Path_Dlg_Box} }

/* ***************************  Main Block  *************************** */

ASSIGN
  path-list:INNER-LINES IN FRAME {&FRAME-NAME} =
       INTEGER(path-list:INNER-LINES IN FRAME {&FRAME-NAME}).

/* Populate the selection list */
RUN get_path.

/* Now enable the interface and wait for the exit condition.            */
RUN enable_UI.

&scoped-define CANCEL-EVENT U2
{adeuib/ide/dialogstart.i btn_ok btn_cancel wintitle}

   &if DEFINED(IDE-IS-RUNNING) = 0  &then
WAIT-FOR GO OF FRAME {&FRAME-NAME}.
   &ELSE
WAIT-FOR GO OF FRAME {&FRAME-NAME} or "{&CANCEL-EVENT}" of this-procedure.       
if cancelDialog THEN UNDO, LEAVE.  
   &endif

RUN SetNewPath.
RUN disable_UI.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME


/* **********************  Internal Procedures  *********************** */

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE disable_UI f _DEFAULT-DISABLE
PROCEDURE disable_UI :
/*------------------------------------------------------------------------------
  Purpose:     DISABLE the User Interface
  Parameters:  <none>
  Notes:       Here we clean-up the user-interface by deleting
               dynamic widgets we have created and/or hide 
               frames.  This procedure is usually called when
               we are ready to "clean-up" after running.
------------------------------------------------------------------------------*/
  /* Hide all frames. */
  HIDE FRAME f.
END PROCEDURE.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME


&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE enable_UI f _DEFAULT-ENABLE
PROCEDURE enable_UI :
/*------------------------------------------------------------------------------
  Purpose:     ENABLE the User Interface
  Parameters:  <none>
  Notes:       Here we display/view/enable the widgets in the
               user-interface.  In addition, OPEN all queries
               associated with each FRAME and BROWSE.
               These statements here are based on the "Other 
               Settings" section of the widget Property Sheets.
------------------------------------------------------------------------------*/
  ENABLE path-list b_add b_delete RECT-6 b_move_up b_move_down 
      WITH FRAME f.
  VIEW FRAME f.
  {&OPEN-BROWSERS-IN-QUERY-f}
END PROCEDURE.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME


&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE get_path f 
PROCEDURE get_path :
/* -----------------------------------------------------------
  Purpose:     Fill the selection list with the contents of 
               PATH.  Note that we put line numbers on each line 
               (and we support up to 999 items in the path).
  Parameters:  <none>
 -------------------------------------------------------------*/
  DEFINE VAR plist   AS CHAR    NO-UNDO.
  DEFINE VAR i       AS INTEGER NO-UNDO.
  DEFINE VAR cnt     AS INTEGER NO-UNDO.
  DEFINE VAR pEntry  AS INTEGER NO-UNDO.  
  DEFINE VAR testval AS CHAR    NO-UNDO.

  cnt = NUM-ENTRIES(pDirList,",":u).
  IF cnt > 999 THEN DO:
    MESSAGE "Only the first 999 items in the path will be displayed."
            VIEW-AS ALERT-BOX WARNING BUTTONS OK.
    cnt = 999.
  END.
  
  /* Add a number to the front of each line for uniqueness */
  DO i = 1 TO cnt: 
    plist = (IF i eq 1 THEN "" ELSE plist + ",":u) 
          + STRING(i,">>9":u) + ") ":u + ENTRY(i, pDirList, ",":u).
  END.
 
  path-list:LIST-ITEMS IN FRAME {&FRAME-NAME} = plist.
  
  i = 0.    
  DO i = 1 TO Cnt: 
    testval = ENTRY(2,ENTRY(i,Path-List:LIST-ITEMS,",":u),")":U). 
    IF TRIM(TestVal) = pCurrentPath THEN DO:
      pEntry = i. 
      LEAVE.
    END.
  END.

  ASSIGN
    pEntry                 = IF pEntry = 0 THEN 1 ELSE pEntry       
    Path-List:SCREEN-VALUE = Path-List:ENTRY(pEntry).
 
END PROCEDURE.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME


&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE number_path f 
PROCEDURE number_path :
/* -----------------------------------------------------------
  Purpose:     Change the first 3 characters of a line in path-list
               to be the line numbe (in format ">>9").
  Parameters:  <none>
 -------------------------------------------------------------*/
  DEFINE VAR plist AS CHAR    NO-UNDO.
  DEFINE VAR i     AS INTEGER NO-UNDO.
  
  DO WITH FRAME {&FRAME-NAME}:
    /* Remove a number from each line.  */
    DO i = 1 TO path-list:NUM-ITEMS:
      plist = (IF i EQ 1 THEN "" ELSE plist + ",":u) 
            + STRING(i,">>9":u) 
            + SUBSTRING(path-list:ENTRY(i),4,-1, "CHARACTER":u).
    END.
    path-list:LIST-ITEMS = plist.
  END.
END PROCEDURE.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME


&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE SetNewPath f 
PROCEDURE SetNewPath :
/* -----------------------------------------------------------
  Purpose:     
  Parameters:  <none>
  Notes:       
-------------------------------------------------------------*/
  DEFINE VAR path  AS CHAR    CASE-SENSITIVE NO-UNDO.
  DEFINE VAR i     AS INTEGER                NO-UNDO.
  
  DO WITH FRAME {&FRAME-NAME}:
    /* Remove a number from each line.  */
    DO i = 1 TO path-list:NUM-ITEMS: 
      path = (IF i = 1 THEN "" ELSE path + ",":u) 
           + SUBSTRING(path-list:ENTRY(i),6,-1, "CHARACTER":u).
     END.
  END.    
   
  ASSIGN
    pNewList     = path
    pCurrentPath = IF path-list:SCREEN-VALUE <> "" 
                   THEN ENTRY(2,path-list:SCREEN-VALUE,")":U)
                   ELSE "".  
            
END PROCEDURE.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME

PROCEDURE ide_choose_dirname:
    RUN adeuib/ide/_dialog_dirname.p
         ( INPUT        "Add Directory to Path", /* Dialog Title Bar */
           INPUT        NO,                      /* YES is \'s converted to /'s */
           INPUT        YES,                     /* YES if directory must exist */
           INPUT        "comm",                  /* ADE Tool (used for help call) */
           INPUT        {&Add_Dir_Path_Dlg_Box}, /* Context ID for HELP call */
           INPUT-OUTPUT new_dir ,                /* File Spec entered */
           OUTPUT       l_ok                     /* YES if user hits OK */
         ) .
END PROCEDURE.    
/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/
&GLOBAL-DEFINE mdir adeshar

&ANALYZE-SUSPEND _VERSION-NUMBER AB_v10r12
&ANALYZE-RESUME
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _DEFINITIONS Procedure 
/*********************************************************************
* Copyright (C) 2005 by Progress Software Corporation. All rights    *
* reserved.  Prior versions of this work may contain portions        *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/*--------------------------------------------------------------------------
    File        : _opnfile.w
    Purpose     : Run system-dialog or remote file open depending on AB 
                  preferences.
    Syntax      :
    Description : The number of filters are dynamic !  
    Parameters  : 
     INPUT        ptitle  - Title of dialog 
     INPUT        pfilter - COMMA separated string with filters.
                            MUST have the real filter in parenthesis.                                                            
                            USE Semicolon to separate filters ! 
                            Example "ALl Source(*.p;*.i;*.w),R-code files (*.r)". 
     INPUT-OUTPUT pfile   - filename, set to "" if nothing is found.
       
    Author(s)   : Haavard Danielsen
    Created     : Feb 1998
    Notes       : Currently maximum 6 filters.
                  Could easily be extended.                   
  ------------------------------------------------------------------------*/
/*          This .W file was created with the Progress UIB.             */
/*----------------------------------------------------------------------*/

/* ***************************  Definitions  ************************** */

DEFINE INPUT        PARAMETER pTitle  AS CHARACTER NO-UNDO.
DEFINE INPUT        PARAMETER pFilter AS CHARACTER NO-UNDO.
DEFINE INPUT-OUTPUT PARAMETER pFile   AS CHARACTER NO-UNDO.
  
DEFINE VAR PickedOne  AS LOGICAL   NO-UNDO.
DEFINE VAR Path       AS CHARACTER NO-UNDO.
DEFINE VAR TempFile   AS CHARACTER NO-UNDO.
DEFINE VAR I          AS INTEGER   NO-UNDO.
DEFINE VAR gDelimiter AS CHARACTER INIT ",":U NO-UNDO.
DEFINE VAR gRemoteStr AS CHARAcTER NO-UNDO.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME


&ANALYZE-SUSPEND _UIB-PREPROCESSOR-BLOCK 

/* ********************  Preprocessor Definitions  ******************** */

&Scoped-define PROCEDURE-TYPE Procedure
&Scoped-define DB-AWARE no



/* _UIB-PREPROCESSOR-BLOCK-END */
&ANALYZE-RESUME



/* *********************** Procedure Settings ************************ */

&ANALYZE-SUSPEND _PROCEDURE-SETTINGS
/* Settings for THIS-PROCEDURE
   Type: Procedure
   Allow: 
   Frames: 0
   Add Fields to: Neither
   Other Settings: CODE-ONLY COMPILE
 */
&ANALYZE-RESUME _END-PROCEDURE-SETTINGS

/* *************************  Create Window  ************************** */

&ANALYZE-SUSPEND _CREATE-WINDOW
/* DESIGN Window definition (used by the UIB) 
  CREATE WINDOW Procedure ASSIGN
         HEIGHT             = 15
         WIDTH              = 60.
/* END WINDOW DEFINITION */
                                                                        */
&ANALYZE-RESUME

 


&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _MAIN-BLOCK Procedure 


/* ***************************  Main Block  *************************** */

IF SEARCH("adeuib/_uibinfo.r":U) <> ? THEN
  RUN adeuib/_uibinfo.p
      (?, "SESSION":U, "REMOTE":U, OUTPUT gRemoteStr).
        
IF gRemoteStr <> "TRUE":U THEN 
  RUN adecomm/_getfiledialog.w (ptitle,pFilter,INPUT-OUTPUT pFile). 
  
ELSE DO:     
  RUN adeweb/_webfile.w
         ("UIB":U,
          "SEARCH":U,
          pTitle,
          pFilter,
          INPUT-OUTPUT pFile,
          OUTPUT TempFile,
          OUTPUT pickedOne). 
  IF NOT PickedOne THEN ASSIGN pFile = "":U.

END.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME


/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/**************************************************************************
    Procedure:  _oscpath.p
    
    Purpose:   Creates a path (i.e. it's careful to create all the dir 
	down a path) THIS IS ONLY FOR MS WINDOWS!!!!
                
    Syntax :
        RUN adecomm/_oscpath.p
                (INPUT  p_path  /* OS Path File Name.   */ ,
                 OUTPUT p_errcode   /* Success */ ).

    Parameters:
    
    p_path 
        Name of OS file whose full path you want to create 
    p_errcode 

    Description:
    
    Notes  :
    Authors: 
    Date   : 
    Updated: 
**************************************************************************/

DEFINE INPUT  PARAMETER p_path AS CHARACTER NO-UNDO.
DEFINE OUTPUT PARAMETER p_errcode  AS INTEGER INITIAL 0 NO-UNDO.

DEFINE VARIABLE i AS INTEGER                        NO-UNDO.
DEFINE VARIABLE pos AS INTEGER                        NO-UNDO.
DEFINE VARIABLE tmp AS CHARACTER                      NO-UNDO.

ASSIGN p_path = REPLACE(p_path,"/","~\").
IF SUBSTRING(p_path,LENGTH(p_path),1,"CHARACTER":U) NE "~\":U THEN
    ASSIGN p_path = p_path + "~\":U.
    
/* WIN95-UNC - Check for UNC \\SERVER\SHARE and treat it like a 
   drive specification. In which case, there is no basename and the prefix
   is the UNC and drive spec. -*/
IF CAN-DO("OS2,WIN32,MSDOS,UNIX":U,OPSYS) THEN DO:
      IF p_path BEGINS "~\~\" 
	AND NUM-ENTRIES(p_path,"~\") > 4 THEN
	/* start creating the dir at the 5 slashes down */
      DO: 
	ASSIGN pos = index(p_path,"~\":U).
	DO i = 1 to 3:
	   ASSIGN pos = index(p_path,"~\":U,pos + 1).
        END.
      END.
      ELSE
	ASSIGN pos = index(p_path,"~\":U).
END.

DO WHILE pos <> 0:  
    ASSIGN tmp = SUBSTRING(p_path,1,pos).
    OS-CREATE-DIR VALUE(tmp).
    IF OS-ERROR <> 0 THEN DO:
      ASSIGN p_errcode = OS-ERROR.
      RETURN.
    END.
    ASSIGN pos = index(p_path,"~\":U,pos + 1).
END.
/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/
/*
 * _oserr.p
 * 
 *  Provides an error message for OS-ERROR.
 */

define output parameter errText as character no-undo.

case OS-ERROR:

    when   0 then errText = "".
    when   1 then errText = "Not Owner".
    when   2 then errText = "No such file or directory".
    when   3 then errText = "Interrupted system call".
    when   4 then errText = "I/O error".
    when   5 then errText = "Bad file number".
    when   6 then errText = "No more processes".
    when   7 then errText = "Not enough core memory".
    when   8 then errText = "Permission denied".
    when   9 then errText = "Bad address".
    when  10 then errText = "File exists".
    when  11 then errText = "No such device".
    when  12 then errText = "Not a directory".
    when  13 then errText = "Is a directory".
    when  14 then errText = "File table overflow".
    when  15 then errText = "Too many open files".
    when  16 then errText = "File too large".
    when  17 then errText = "No space left on device".
    when  18 then errText = "Directory not empty".
    otherwise     errText = "Unmapped error (PROGRESS default)".
end.
/*********************************************************************
* Copyright (C) 2000,2013 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/**************************************************************************
    Procedure:  _osfext.p
    
    Purpose:    Returns the file name extension of an operating system
                file including the dot (.). If the file does not have
                an extension, returns Null ("").
                
    Syntax :
    
        RUN adecomm/_osfext.p
                (INPUT  p_File_Name  /* OS File Name.   */ ,
                 OUTPUT p_File_Ext   /* File Extension. */ ).

    Parameters:
    
    p_File_Name 
        Name of OS file whose extension you want.
    
    p_File_Ext 
        File name extension including the dot (.). Null is returned
        if the file has no extension.

    Description:
    
    Notes  :
    Authors: John Palazzo
    Date   : April, 1995
    Updated: 
**************************************************************************/

DEFINE INPUT  PARAMETER p_File_Name AS CHARACTER NO-UNDO.
DEFINE OUTPUT PARAMETER p_File_Ext  AS CHARACTER NO-UNDO.

/*
DEFINE VARIABLE p_File_Name AS CHARACTER NO-UNDO.
DEFINE VARIABLE p_File_Ext  AS CHARACTER NO-UNDO.

ASSIGN p_File_Name = "../dir.win/file.w":U.
*/

IF INDEX(p_File_Name,".") EQ 0 THEN RETURN. /* no extension */

ASSIGN p_File_Ext =
       IF ( LENGTH( p_File_Name , "CHARACTER" ) > 1 )
       THEN "." + ENTRY( NUM-ENTRIES( p_File_Name , "." ) ,
                         p_File_Name , "." )
       ELSE "" .

/* The code above does the wrong thing if the file name is like
** c:\11.3\myfile. It sets the extension to ".3\myfile". Check
** for this situation and blank out the extension.
*/
IF INDEX(p_File_Ext, "/") NE 0 OR
   INDEX(p_File_Ext, "~\") NE 0 THEN
   ASSIGN p_File_Ext = "".

/*
MESSAGE "File     : " p_File_Name SKIP
        "Extension: " p_File_Ext
        VIEW-AS ALERT-BOX IN WINDOW ACTIVE-WINDOW.
*/





/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/
/*
**  Program: adecomm/_osfmush.p
**       By: wlb
** Descript: mush to parts of a file spec together
** Last change: jep 12/14/95 - WIN95-LFN
**              Added WIN32 to OPSYS test as part of temporary support.
*/

DEFINE INPUT  PARAMETER p_spec1   AS CHARACTER NO-UNDO.
DEFINE INPUT  PARAMETER p_spec2   AS CHARACTER NO-UNDO.
DEFINE OUTPUT PARAMETER p_outspec AS CHARACTER NO-UNDO.

/* if both parms are NOT set then just put results in outspec */
IF p_spec1 = "" OR p_spec2 = "" THEN
p_outspec = p_spec1 + p_spec2.

ELSE  /* add a backslash between files for DOS */
IF CAN-DO("WIN32,MSDOS", OPSYS) AND NOT
  (p_spec1 MATCHES "*:" OR
  p_spec1 MATCHES "*~~~\" OR p_spec2 matches "~~~\*" OR
  p_spec1 MATCHES "*/" OR p_spec2 matches "/*") THEN
p_outspec = p_spec1 + "~\" + p_spec2.

ELSE  /* add a slash between files for DOS */
IF OPSYS = "UNIX" AND NOT(p_spec1 MATCHES "*/" OR p_spec2 matches "/*") THEN
p_outspec = p_spec1 + "/" + p_spec2.

/*
**  All of the above IFs checked for special cases where we could NOT
**  just concatinate the parms together.  Once we get to here, we know
**  that we CAN just concatinate them together.
*/
ELSE
p_outspec = p_spec1 + p_spec2.

/* Trim off a trailing \ or / as long as it does not follow a drive indicator */
IF NOT CAN-DO("WIN32,MSDOS":u, OPSYS) OR
  (NOT p_outspec MATCHES "*:/":u AND NOT p_outspec MATCHES "*:~~~\":u) THEN
  p_outspec = RIGHT-TRIM(p_outspec,"/~\":u).
/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/**************************************************************************
Procedure:  _osfrw.p
    
Purpose:    Determines if a specified file can be read from and written to.

Syntax :
    RUN adecomm/_osfrw.p
       (INPUT p_file , INPUT p_flags , OUTPUT p_access).

Parameters:
    p_file  The file you want to read from and/or write to.
        
    p_flags Comma-delimited list of flags to provide fine control over
            this routine.
            
            _READ-TEST    When present, p_file is tested for read access.
                              
            _WRITE-TEST   When present, p_file is tested for write access.
                              
            _DELETE-FILE  When present, p_file is deleted after testing
                          it for read/write access.
                              
            _SAVE-FILE    When present, p_file is first read and then
                          re-written onto itself. This preserves the file's
                          contents while still checking the write permissions.
                              
    p_access String that will contain "R" if the file was read successfully
             and "W" if the file was written successfully. This is just like
             the FILE-INFO:FILE-TYPE behavior.
                 
Description:

Notes  : 1. For _WRITE-TEST, if p_file does not exist, its created.
            If it does exist, its contents are emptied unless you 
            specifiy the _SAVE-FILE flag.
                
         2. To remove a write test file, specify _DELETE-FILE flag.

         3. This routine can be useful to replace FILE-INFO because
            FILE-INFO does not return RW access based on network
            privileges for MS platforms.
                
Authors: John Palazzo
Date   : September, 1995
**************************************************************************/

DEFINE INPUT  PARAMETER p_file     AS CHARACTER NO-UNDO.
DEFINE INPUT  PARAMETER p_flags    AS CHARACTER NO-UNDO.
DEFINE OUTPUT PARAMETER p_access   AS CHARACTER NO-UNDO.

DEFINE VARIABLE read-ok  AS LOGICAL FORMAT "R/":U NO-UNDO.
DEFINE VARIABLE write-ok AS LOGICAL FORMAT "W/":U NO-UNDO.

FORM p_file VIEW-AS EDITOR SIZE 60 BY 10 LARGE NO-WORD-WRAP
    WITH FRAME f_write.

DO ON STOP UNDO, RETRY:
  IF NOT RETRY THEN
  DO:
    IF CAN-DO(p_flags, "_READ-TEST":U) OR
       CAN-DO(p_flags, "_SAVE-FILE":U) THEN
    DO:
      ASSIGN read-ok = p_file:READ-FILE(p_file) IN FRAME f_write NO-ERROR.
      IF CAN-DO(p_flags, "_READ-TEST":U) THEN
        ASSIGN p_access = STRING(read-ok, "R/":U).
    END.
    
    IF CAN-DO(p_flags, "_WRITE-TEST":U) THEN
    DO:
      ASSIGN write-ok = p_file:SAVE-FILE(p_file) IN FRAME f_write NO-ERROR.
      ASSIGN p_access = p_access + STRING(write-ok, "W/":U).
    END.

  END.
  IF CAN-DO(p_flags , "_DELETE-FILE":U) THEN
    OS-DELETE VALUE(p_file) NO-ERROR.
END.

RETURN.
/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/
/**************************************************************************
    Procedure:  _osprefx.p
    
    Purpose:    Returns a file spec's path prefix and basename.

    Syntax :
    Parameters:
    Description:
    
    Notes  :
    Authors: Warren Bare
    Date   : 
    Updated: 
**************************************************************************/

/* ksu 94/02/24 SUBSTRING use default mode */
DEFINE INPUT  PARAMETER filename AS CHARACTER NO-UNDO.
DEFINE OUTPUT PARAMETER fiprefix AS CHARACTER NO-UNDO.
DEFINE OUTPUT PARAMETER basename AS CHARACTER NO-UNDO.
DEFINE VARIABLE i AS INTEGER NO-UNDO.

ASSIGN basename = TRIM(filename).

IF CAN-DO("WIN32,MSDOS,UNIX":u,OPSYS) THEN DO:
  i = R-INDEX(basename,":":u).
  IF i > 0 THEN
    basename = SUBSTRING(basename,i + 1,-1,"CHARACTER":u).
END.

IF CAN-DO("WIN32,MSDOS,UNIX":u,OPSYS) THEN DO:
  i = MAXIMUM(R-INDEX(basename,"~\":u),R-INDEX(basename,"/":u)).
  IF i > 0 THEN
  DO:
    /* WIN95-UNC - Check for UNC \\SERVER\SHARE and treat it like a
       drive specification. In which case, there is no basename and
       the prefix is the UNC or drive spec.  - jep 12/14/95 */
    IF basename BEGINS "~\~\":u AND NUM-ENTRIES(basename, "~\") <= 4 THEN
      basename = "".
    ELSE
      basename = SUBSTRING(basename,i + 1,-1,"CHARACTER":u).
  END.
END.

fiprefix = SUBSTRING(filename,1,LENGTH(filename,"CHARACTER":u) 
                     - LENGTH(basename,"CHARACTER":u),"CHARACTER":u).
RETURN.
/***********************************************************************
* Copyright (C) 2000,2006 by Progress Software Corporation. All rights *
* reserved.  Prior versions of this work may contain portions          *
* contributed by participants of Possenet.                             *
*                                                                      *
***********************************************************************/

/****************************************************************************
    File       _osprint.p
    
    Syntax     
               RUN adecomm/_osprint.p ( INPUT  p_Window,
                                        INPUT  p_PrintFile,
                                        INPUT  p_FontNumber,
                                        INPUT  p_PrintFlags,
                                        INPUT  p_PageSize,
                                        INPUT  p_PageCount,
                                        OUTPUT p_Printed ).
   
    Purpose    Send a specified operating system text file to the default
               printer.

    Remarks    Output is sent to printer as PAGED output, with a default
               page size of zero. This lets the printer handle the paging.
               The page size can be specified using p_PageSize.

               Max characters per line: 255.
               
               Under MS-Windows, the MSW Print Setup dialog box
               is called via a PROGRESS DLL (PROPRINT.DLL) and the
               SESSION:PRINTER-CONTROL-HANDLE is always cleared.

    Author     J. Palazzo
    Created    Mar  1994
    Updated    Mar  1999  Removed 16-bit proprint.dll entry and call.
****************************************************************************/

DEFINE INPUT  PARAMETER p_Window      AS WIDGET    NO-UNDO.
    /* Parent window for Dialogs and Message boxes. Default
       to CURRENT-WINDOW if p_Window is not valid. */
    
DEFINE INPUT  PARAMETER p_PrintFile   AS CHAR      NO-UNDO.
    /* Text file to print. Can be specified relative to PROPATH. */
    
DEFINE INPUT  PARAMETER p_FontNumber  AS INTEGER   NO-UNDO.
    /* PROGRESS Font Number to use when printing file.  MSW Only.
       This may not match screen font exactly and the printer
       driver will make the ultimate choice, not PROGRESS. */

DEFINE INPUT  PARAMETER p_PrintFlags  AS INTEGER   NO-UNDO.
    /*  Integer expression that specifies various print options.
        The table below lists the flag values that correspond to
        each print option. If a zero (0) value is passed, option
        defaults are used.

        Print Option        Flag Value  Meaning

        useDialog               1       Display the MSW Print Setup Dialog.
                                        Default is to not display the Print
                                        dialog.
                                        
        useLandscape            2       Set print orientation to Landscape.
                                        Default orientation is set in the
                                        printer properties in the Control
                                        Panel.

        You can specify any combination of these flags. For
        example, you can pass three (1 + 2) as an input parameter to
        specify that the Print Setup Dialog be displayed and that
        the print orientation be landscape. */

DEFINE INPUT  PARAMETER p_PageSize    AS INTEGER  NO-UNDO.
    /* Page length - number of lines per page. */
    
DEFINE INPUT  PARAMETER p_PageCount   AS INTEGER  NO-UNDO.
    /* If non-zero, then enable the page range selection controls
       in the printer setup dialog. If zero, the entire text file
       is printed. */
    
DEFINE OUTPUT PARAMETER p_Printed     AS LOGICAL INIT TRUE NO-UNDO .
    /* Returns TRUE if able to complete the OUTPUT TO PRINTER. */

DEFINE STREAM In_Stream.
DEFINE STREAM Out_Stream.

DEFINE VAR Text_Line      AS CHARACTER FORMAT "x(255)" NO-UNDO .
DEFINE VAR PrintResult    AS INTEGER   INITIAL 0       NO-UNDO .


DO ON STOP  UNDO, RETRY ON ERROR UNDO, RETRY:
  IF NOT RETRY THEN
  DO:
    /* Point to a valid window handle. */
    ASSIGN p_Window = IF VALID-HANDLE( p_Window ) THEN
                        p_Window
                      ELSE IF VALID-HANDLE( CURRENT-WINDOW ) THEN
                        CURRENT-WINDOW
                      ELSE
                         DEFAULT-WINDOW.
                              
    /* Get file info on file to print. */
    ASSIGN FILE-INFO:FILE-NAME = p_PrintFile NO-ERROR .
    IF ( FILE-INFO:FULL-PATHNAME = ? ) THEN
    DO:
      MESSAGE "Unable to find file to print."
        VIEW-AS ALERT-BOX ERROR BUTTONS OK IN WINDOW p_Window.
      STOP.
    END.
    ASSIGN p_PrintFile = FILE-INFO:FULL-PATHNAME.

    /* Run Proprint DLL for Windows and 32bit Windows Char Console. */        
    IF (SESSION:WINDOW-SYSTEM BEGINS "MS-WIN") OR
       (OPSYS = "WIN32" AND SESSION:WINDOW-SYSTEM = "TTY") THEN
    DO:

      /*Starting in OE 10.1A, passing a null value to an external DLL
        raises error 12272. Therefore we set the default values for
        parameters that are passed as null*/
      IF p_PrintFlags = ? THEN ASSIGN p_PrintFlags = 0.
      IF p_FontNumber = ? THEN ASSIGN p_FontNumber = 0.
      IF p_PageCount  = ? THEN ASSIGN p_PageCount  = 0.

      /* Clear the current print handle. */
      ASSIGN SESSION:PRINTER-CONTROL-HANDLE = ?.
      RUN ProPrintFile ( INPUT  SESSION:PRINTER-CONTROL-HANDLE,
                         INPUT  p_PrintFlags ,
                         INPUT  p_Window:HWND,
                         INPUT  p_FontNumber,
                         INPUT  p_PrintFile,
                         INPUT  p_PageCount,
                         OUTPUT PrintResult ).
                           
      /* Return value from DLL of 0 indicates a successful request to
         print the file. It does NOT indicate the file has finished
         printing.
      */
      ASSIGN p_Printed = ( PrintResult = 0 ). 
    END.
    ELSE
    DO:
        /* All other operating environments/windowing systems.
           Break out into a CASE statement to customize.  */
        RUN PrintFile.
    END.
  END. /* NOT RETRY */
  ELSE 
    ASSIGN p_Printed = FALSE.
        
  INPUT  STREAM In_Stream  CLOSE.
  OUTPUT STREAM Out_Stream CLOSE.
END.

/* -----------------------------------------------------------------------*/ 
PROCEDURE ProPrintFile EXTERNAL "PROPRINT.DLL":
  /* Internal Procedure call to MS-Windows DLL to Print Setup dialog.  */
  
  DEFINE INPUT  PARAMETER hControl        AS LONG.
  DEFINE INPUT  PARAMETER fPrintFlags     AS LONG.
  DEFINE INPUT  PARAMETER hWndParent      AS LONG.
  DEFINE INPUT  PARAMETER nFontNo         AS LONG.
  DEFINE INPUT  PARAMETER lpszFile        AS CHARACTER.
  DEFINE INPUT  PARAMETER nPages          AS LONG.
  DEFINE RETURN PARAMETER Print_Result    AS LONG.
END.

/* -----------------------------------------------------------------------*/ 
PROCEDURE PrintFile: 
  /* Print an operating system file via simple OUTPUT TO PRINTER. */

  INPUT  STREAM In_Stream  FROM VALUE(p_PrintFile) NO-ECHO NO-MAP.
  OUTPUT STREAM Out_Stream TO   PRINTER PAGE-SIZE VALUE( p_PageSize ).
  
  /* Frame must be down frame, so scope to REPEAT. */
  REPEAT ON STOP UNDO, LEAVE WITH FRAME f_Print:
    IMPORT STREAM In_Stream UNFORMATTED Text_Line.
    DISPLAY STREAM Out_Stream Text_Line 
      WITH FRAME f_Print NO-LABELS STREAM-IO
      NO-BOX USE-TEXT WIDTH 255.
  END.
END PROCEDURE.

/* _osprint.p - end of file */
/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/
/*----------------------------------------------------------------------------

File: _osprodl.p

Description:
   Does an os independant call to prodel.  Functions are just like those
   used by the os executable with the addition of a error return code.
   If the error code is non zero, a problem has occured.  Errors are
   listed below.   Eventually, this code will put up alert boxes for all
   of the errors so that the caller does not have to worry about it.

Input/Output Parameters:
   
   input  p_pname:   physical database name to delete.
   output p_error:   Error return code.

Author: Warren Bare

Date Created: 03/30/92 

----------------------------------------------------------------------------*/
define input parameter p_pname as char no-undo.
define output parameter p_error as int no-undo.

IF LOOKUP(OPSYS, "UNIX,MSDOS,WIN32":u) > 0 THEN
    OS-COMMAND prodel VALUE(p_pname).
/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/**************************************************************************
    Procedure:  _ossfnam.p
    
    Purpose:    Returns the shortened version of an os filename when the
                filename does not display withing a given width for a
                specified font.

    Syntax :    RUN adeedit/_ossfnam.p
                    (INPUT  p_Name,
                     INPUT  p_Width,
                     INPUT  p_Font,
                     INPUT  p_Short_Name).

    Description:
    
    Notes  :
    
    Authors: John Palazzo
    Date   : October, 1996
    Updated: 
**************************************************************************/

&IF "{&OPSYS}" = "UNIX" &THEN
&SCOPED-DEFINE    OS-SLASH    /
&ELSE
&SCOPED-DEFINE    OS-SLASH    ~\
&ENDIF

DEFINE INPUT  PARAM p_Name       AS CHARACTER NO-UNDO.
DEFINE INPUT  PARAM p_Width      AS DECIMAL   NO-UNDO.
DEFINE INPUT  PARAM p_Font       AS INTEGER   NO-UNDO.
DEFINE OUTPUT PARAM p_Short_Name AS CHARACTER NO-UNDO.

DEFINE VAR Text-Width    AS INTEGER   NO-UNDO.
DEFINE VAR Text-Prefix   AS CHARACTER NO-UNDO.
DEFINE VAR Text-Basename AS CHARACTER NO-UNDO.
DEFINE VAR Num_Entries   AS INTEGER   NO-UNDO.

DO ON STOP   UNDO, LEAVE
   ON ERROR  UNDO, LEAVE
   ON ENDKEY UNDO, LEAVE:
   
    ASSIGN p_Short_Name = p_Name.

    /* Only do the shortname on UNIX or DOS. */
    IF LOOKUP(OPSYS, "UNIX,MSDOS,WIN32") = 0 THEN RETURN.

    ASSIGN Text-Width = FONT-TABLE:GET-TEXT-WIDTH(p_Name, p_Font).
    
    IF (Text-Width > p_Width) THEN
    DO:
        /* Clear out short name. */
        ASSIGN p_Short_Name = "".
        
        /* Keep track of the total number of path elements. */
        ASSIGN Num_Entries = NUM-ENTRIES(p_Name, "{&OS-SLASH}").

        /* Is this a UNC pathname? E.g., \\Server\SharedFolder\Folder\Subfolder\filename.p */
        IF (p_Name BEGINS "~\~\":u) THEN
        DO:
            /* Set our prefix to Server and Shared Folder entries. Note that
               Server name is entry 3 in a slash delimited list "\\Server\SharedFolder".
            */
            ASSIGN Text-Prefix = "~\~\":u + ENTRY(3 , p_Name, "~\") + "~\" +
                                 ENTRY(4, p_Name, "~\").
            /* If more than 5 path elements, then we can grab the last two elements
               Subfolder\filename.p. Otherwise, just use the filename.p.
            */
            IF (Num_Entries > 5) THEN
                ASSIGN Text-Basename = ENTRY(Num_Entries - 1, p_Name, "~\")
                                       + "~\" +  ENTRY(Num_Entries, p_Name, "~\").
            ELSE
                ASSIGN Text-Basename = ENTRY(Num_Entries, p_Name, "~\").
        END.
        /* Else, Drive path: P:\Folder\Subfolder\filename.p */
        ELSE
        DO:
            /* Set our prefix to the Drive letter (or Null for no drive and for UNIX). */
            ASSIGN Text-Prefix = ENTRY(1 , p_Name, "{&OS-SLASH}").
            /* If more than 4 path elements, then we can grab the last two elements
               Subfolder\filename.p. Otherwise, just use the filename.p.
            */
            IF (Num_Entries > 4) THEN
            DO:
                ASSIGN Text-Prefix = Text-Prefix +  "{&OS-SLASH}" + ENTRY(2 , p_Name, "{&OS-SLASH}").
                ASSIGN Text-Basename = ENTRY(Num_Entries - 1, p_Name, "{&OS-SLASH}")
                                       + "{&OS-SLASH}" + ENTRY(Num_Entries, p_Name, "{&OS-SLASH}").
            END.
            ELSE
                ASSIGN Text-Basename = ENTRY(Num_Entries, p_Name, "{&OS-SLASH}").
        END.
        ASSIGN p_Short_Name = Text-Prefix + "{&OS-SLASH}" + "..." + "{&OS-SLASH}" + Text-Basename.
        
        /* If the abbreviated file name with 4 path elements is too long, truncate the original
           path up to half of the display witdth then add "...\filename.p".
        */
        IF (FONT-TABLE:GET-TEXT-WIDTH(p_Short_Name, p_Font) > p_Width) THEN
        DO:
            RUN adecomm/_osprefx.p (INPUT p_Name, OUTPUT Text-Prefix, OUTPUT Text-Basename).
            ASSIGN p_Short_Name = SUBSTRING(p_Name, 1, INTEGER((p_Width / 2)) + 4, "CHARACTER":U)
                                  + "..." + "{&OS-SLASH}" + Text-Basename.
        END.
        /* If the short name got shortened too much, set back to original file name. */
        IF (p_Short_Name = "") OR (p_Short_Name = ?) THEN
            ASSIGN p_Short_Name = p_Name.
    END.

/*
    MESSAGE "Name       = " p_Name          SKIP
            "Short Name = " p_Short_Name    SKIP
            "p_Width    = " p_Width         SKIP
            "Text-Width = " Text-Width      SKIP
            "p_Font     = " p_Font          SKIP
            "Prefix     = " Text-Prefix     SKIP
            "Basename   = " Text-Basename
        VIEW-AS ALERT-BOX.
*/
    
END.


&ANALYZE-SUSPEND _VERSION-NUMBER UIB_v8r11 GUI
&ANALYZE-RESUME
&Scoped-define WINDOW-NAME hWin
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _DEFINITIONS hWin 
/***********************************************************************
* Copyright (C) 2005,2007 by Progress Software Corporation. All rights *
* reserved.  Prior versions of this work may contain portions          *
* contributed by participants of Possenet.                             *
*                                                                      *
***********************************************************************/
/*----------------------------------------------------------------------

  File: _palette.w

  Description: 
      Create a palette in a window.  This is a persistent file.

  Input Parameters:
    <none>

  Output Parameters:
    <none>

  Author: Wm. T. Wood

  Created: April 1994

  Modified:
      gfs          - rewrote to make it object-oriented and added many features
      ryan Fall 94 - added some additional methods for Tranman II
      gfs          - added display order to temp-table and methods
      gfs          - removed support for labels - added tooltips 
      gfs 1/22/98  - added SMALL-TITLE to palette window
      gfs 1/23/98  - use TOP-ONLY attr. 
------------------------------------------------------------------------*/
/*          This .W file was created with the Progress UIB.             */
/*----------------------------------------------------------------------*/

CREATE WIDGET-POOL.

/* ***************************  Definitions  ************************** */
{adecomm/oeideservice.i}
{ adecomm/_adetool.i }

/* Parameters Definitions ---                                           */

/* Size of each palette item */
&Scoped-define palette_size 24
&Scoped-define palette_font 4

/* Local Variable Definitions ---                                       */
DEFINE VARIABLE max-label-width-p AS INTEGER NO-UNDO.
DEFINE VARIABLE num-items         AS INTEGER NO-UNDO.
DEFINE VARIABLE toponly           AS LOGICAL NO-UNDO INITIAL no.
DEFINE VARIABLE phParent          AS HANDLE  NO-UNDO. /* hdl of parent proc */
DEFINE VARIABLE pcItems           AS CHAR    NO-UNDO. /* list items for palette */
DEFINE VARIABLE mHandle           AS WIDGET  NO-UNDO. /* handle for menu-item */
DEFINE VARIABLE m_Exit            AS WIDGET  NO-UNDO.
DEFINE VARIABLE hFrame            AS WIDGET  NO-UNDO. 
DEFINE VARIABLE items-row         AS INT     NO-UNDO.   
DEFINE VARIABLE palette-size      AS INT     NO-UNDO INITIAL 24.
DEFINE VARIABLE palette-font      AS INT     NO-UNDO INITIAL 4.
DEFINE VARIABLE help_file         AS CHAR    NO-UNDO.
DEFINE VARIABLE help_loc          AS HANDLE  NO-UNDO. /* proc hdl of help proc */

/* Temp-table */
DEFINE TEMP-TABLE tt
  FIELD h_btn   AS WIDGET-HANDLE
  FIELD h_lbl-1 AS WIDGET-HANDLE
  FIELD flabel  AS CHARACTER
  FIELD order   AS INTEGER
  .

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME


&ANALYZE-SUSPEND _UIB-PREPROCESSOR-BLOCK 

/* ********************  Preprocessor Definitions  ******************** */

&Scoped-define PROCEDURE-TYPE WINDOW
&Scoped-define DB-AWARE no


/* Custom List Definitions                                              */
/* List-1,List-2,List-3,List-4,List-5,List-6                            */

/* _UIB-PREPROCESSOR-BLOCK-END */
&ANALYZE-RESUME



/* ***********************  Control Definitions  ********************** */

/* Define the widget handle for the window                              */
DEFINE VAR hWin AS WIDGET-HANDLE NO-UNDO.

/* Menu Definitions                                                     */
DEFINE SUB-MENU m_File 
       MENU-ITEM m_No_Menu      LABEL "No Menu &Bar"  
       MENU-ITEM m_Top-Only_Window LABEL "&Top-Only Window"
              TOGGLE-BOX.

DEFINE MENU MENU-BAR-hWin MENUBAR
       SUB-MENU  m_File         LABEL "&File"         .

DEFINE MENU POPUP-MENU-hWin 
       MENU-ITEM m_Menu_Bar     LABEL "&Menu Bar"     .


/* Definitions of the field level widgets                               */

/* ************************  Frame Definitions  *********************** */


/* *********************** Procedure Settings ************************ */

&ANALYZE-SUSPEND _PROCEDURE-SETTINGS
/* Settings for THIS-PROCEDURE
   Type: WINDOW
 */
&ANALYZE-RESUME _END-PROCEDURE-SETTINGS

/* *************************  Create Window  ************************** */

&ANALYZE-SUSPEND _CREATE-WINDOW
IF SESSION:DISPLAY-TYPE = "GUI":U THEN
  CREATE WINDOW hWin ASSIGN
         HIDDEN             = YES
         TITLE              = "Palette"
         HEIGHT             = 1.57
         WIDTH              = 20.8
         MAX-HEIGHT         = 2
         MAX-WIDTH          = 40
         VIRTUAL-HEIGHT     = 2
         VIRTUAL-WIDTH      = 40
         SMALL-TITLE        = yes
         SHOW-IN-TASKBAR    = yes
         CONTROL-BOX        = yes
         RESIZE             = yes
         SCROLL-BARS        = no
         STATUS-AREA        = no
         BGCOLOR            = ?
         FGCOLOR            = ?
         POPUP-MENU         = MENU POPUP-MENU-hWin:HANDLE
         THREE-D            = yes
         MESSAGE-AREA       = no
         SENSITIVE          = yes.
ELSE {&WINDOW-NAME} = CURRENT-WINDOW.

ASSIGN {&WINDOW-NAME}:MENUBAR    = MENU MENU-BAR-hWin:HANDLE
       {&WINDOW-NAME}:POPUP-MENU = MENU POPUP-MENU-hWin:HANDLE.
/* END WINDOW DEFINITION                                                */
&ANALYZE-RESUME



/* ***********  Runtime Attributes and AppBuilder Settings  *********** */

&ANALYZE-SUSPEND _RUN-TIME-ATTRIBUTES
/* SETTINGS FOR WINDOW hWin
  NOT-VISIBLE,,RUN-PERSISTENT                                           */
IF SESSION:DISPLAY-TYPE = "GUI":U AND VALID-HANDLE(hWin)
THEN hWin:HIDDEN = yes.

/* _RUN-TIME-ATTRIBUTES-END */
&ANALYZE-RESUME

 



/* ************************  Control Triggers  ************************ */

&Scoped-define SELF-NAME hWin
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL hWin hWin
ON END-ERROR OF hWin /* Palette */
OR ENDKEY OF {&WINDOW-NAME} ANYWHERE
DO:
   APPLY "CLOSE":U TO THIS-PROCEDURE.
   RETURN NO-APPLY.
END.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME


&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL hWin hWin
ON WINDOW-CLOSE OF hWin /* Palette */
DO:
   APPLY "CLOSE":U TO THIS-PROCEDURE.
   /*RETURN NO-APPLY.*/
END.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME


&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL hWin hWin
ON WINDOW-RESIZED OF hWin /* Palette */
DO:
  RUN redraw.
END.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME


&Scoped-define SELF-NAME m_Menu_Bar
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL m_Menu_Bar hWin
ON CHOOSE OF MENU-ITEM m_Menu_Bar /* Menu Bar */
DO:
  /* Turn the menu-bar back on.  */
  {&WINDOW-NAME}:MENU-BAR                          = MENU menu-bar-hwin:HANDLE.
  /* Detach popup menu */
  {&WINDOW-NAME}:POPUP-MENU                        = ?.
END.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME


&Scoped-define SELF-NAME m_No_Menu
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL m_No_Menu hWin
ON CHOOSE OF MENU-ITEM m_No_Menu /* No Menu Bar */
DO:
  /* Hide the menu-bar */
  {&WINDOW-NAME}:MENU-BAR = ?.
  /* Reattach the popup menu */
  {&WINDOW-NAME}:POPUP-MENU = MENU POPUP-MENU-hWin:HANDLE.
END.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME


&Scoped-define SELF-NAME m_Top-Only_Window
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL m_Top-Only_Window hWin
ON VALUE-CHANGED OF MENU-ITEM m_Top-Only_Window /* Top-Only Window */
DO:
  ASSIGN hWin:TOP-ONLY = SELF:CHECKED.
END.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME


&UNDEFINE SELF-NAME

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _MAIN-BLOCK hWin 


/* ***************************  Main Block  *************************** */
/* Set current window                                           .       */
ASSIGN THIS-PROCEDURE:CURRENT-WINDOW = {&WINDOW-NAME} 
       /*CURRENT-WINDOW                = {&WINDOW-NAME}*/ .

ON CLOSE OF THIS-PROCEDURE 
   RUN destroy.

ON HELP OF hWin DO:
    IF help_file <> "" AND VALID-HANDLE(help_loc) THEN /* we have help defined */
        RUN value(help_file) IN help_loc.
    ELSE MESSAGE "No help has been defined for this palette" VIEW-AS ALERT-BOX
            INFORMATION BUTTONS OK.
END.

/* Best default for GUI applications is...                              */
PAUSE 0 BEFORE-HIDE.

/* Now enable the interface and wait for the exit condition.            */
/* (NOTE: handle ERROR and END-KEY so cleanup code will always fire.    */
MAIN-BLOCK:
DO ON ERROR   UNDO MAIN-BLOCK, LEAVE MAIN-BLOCK
   ON END-KEY UNDO MAIN-BLOCK, LEAVE MAIN-BLOCK:

/**
 * TODO EAG This code needs to be reviewed when support for embedding 4GL 
 * windows is added to core.
 */
  IF OEIDEIsRunning THEN
  DO:
    DEFINE VARIABLE iLevel          AS INTEGER NO-UNDO INITIAL 1. 
    DEFINE VARIABLE lABRunning      AS LOGICAL NO-UNDO INITIAL NO.

    /* Check if AppBuilder is running. */
    REPEAT WHILE PROGRAM-NAME(iLevel) <> ?.
      IF PROGRAM-NAME(iLevel) = "adeuib/_uibmain.p" THEN lABRunning = TRUE.
      ASSIGN iLevel = iLevel + 1.
    END.
    IF lABRunning THEN
      RUN displayWindow IN hOEIDEService ("com.openedge.pdt.oestudio.views.OEAppBuilderView", "DesignView_" + getProjectName(), hWin).
  END.   
  RUN enable_UI.
  IF NOT SESSION:WINDOW-SYSTEM BEGINS "MS-WIN" THEN 
  ASSIGN MENU-ITEM m_Top-Only_Window:SENSITIVE = no.
  IF NOT THIS-PROCEDURE:PERSISTENT THEN
    WAIT-FOR CLOSE OF THIS-PROCEDURE.
END.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME


/* **********************  Internal Procedures  *********************** */

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE Add-F1-Help hWin 
PROCEDURE Add-F1-Help :
/* -----------------------------------------------------------
  Purpose:     Allows definition of a help file to be invoked
               on the HELP key.
  Parameters:  help_file (CHAR)
  Notes:       
-------------------------------------------------------------*/
  DEFINE INPUT PARAMETER hfile AS CHARACTER NO-UNDO.
  DEFINE INPUT PARAMETER hloc  AS HANDLE    NO-UNDO.

  ASSIGN help_file = hfile
         help_loc  = hloc.
END PROCEDURE.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE Add-Function hWin 
PROCEDURE Add-Function :
/* -----------------------------------------------------------
  Purpose:     Add an item to the palette
  Parameters:  pcFile (char)    
               pcImage (char)
               pcFname (char)
               perrun (log)
  Notes:       
-------------------------------------------------------------*/
  DEFINE INPUT PARAMETER pcFile  AS CHARACTER. /* File name to run */
  DEFINE INPUT PARAMETER pcImage AS CHARACTER. /* Image name */
  DEFINE INPUT PARAMETER pcFname AS CHARACTER. /* Function name */
  DEFINE INPUT PARAMETER perrun  AS LOGICAL.   /* Run Persistent? */
  DEFINE INPUT PARAMETER order   AS INTEGER.   /* order of item */

  DEFINE VARIABLE fh AS WIDGET.
  DEFINE VARIABLE rc AS LOG.

  fh = hFrame.
  CREATE tt.
  ASSIGN tt.flabel = pcFname
         tt.order  = order.

  /* Make a button. */
  CREATE BUTTON tt.h_btn ASSIGN
      LABEL     = pcFname
      FONT      = palette-font
      WIDTH-P   = palette-size
      HEIGHT-P  = palette-size
      FRAME     = fh
      NO-FOCUS  = YES
      FLAT-BUTTON = YES
      TOOLTIP   = pcFname
      SENSITIVE = yes
      HIDDEN    = no
  .

  /* Some get the button file name for the item.. */
  rc = tt.h_btn:LOAD-IMAGE-UP (pcImage) NO-ERROR.

  /* Attach Triggers */  
  IF perrun THEN
    ON CHOOSE OF tt.h_btn PERSISTENT 
      RUN run-persistent IN THIS-PROCEDURE (INPUT pcFile, INPUT no, INPUT "").
  ELSE
    ON CHOOSE OF tt.h_btn PERSISTENT 
      RUN VALUE(pcFile).
  num-items = num-items + 1.
  RUN redraw.

END PROCEDURE.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE Add-Menu-Item hWin 
PROCEDURE Add-Menu-Item :
/* -----------------------------------------------------------
  Purpose:     Add menu-item to palette
  Parameters:  mName (char)
               accel (char)
               pName (char)
               pLoc  (char)
               pHdl  (handle)
  Notes:       
-------------------------------------------------------------*/
DEFINE INPUT PARAMETER mName AS CHAR   NO-UNDO. /* menu-item name */  
DEFINE INPUT PARAMETER accel AS CHAR   NO-UNDO. /* accelerator key sequence */
DEFINE INPUT PARAMETER pName AS CHAR   NO-UNDO. /* program to run */
DEFINE INPUT PARAMETER pLoc  AS CHAR   NO-UNDO. /* Loc to run: "EXTERNAL" or "HANDLE"*/
DEFINE INPUT PARAMETER pHdl  AS HANDLE NO-UNDO. /* Handle to run in */

    CREATE MENU-ITEM mHandle
        ASSIGN parent = MENU m_File:HANDLE
               label  = mName
               accelerator = (IF accel <> "" THEN accel ELSE ""). 
    IF pLoc = "EXTERNAL" AND pName <> "" THEN
        ON CHOOSE OF mHandle PERSISTENT RUN VALUE (pName). 
    ELSE IF pLoc = "HANDLE" AND pName <> "" THEN
        ON CHOOSE OF mHandle PERSISTENT RUN VALUE (pName) IN pHdl.             
END PROCEDURE.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE AdjustForTB hWin 
PROCEDURE AdjustForTB :
/*------------------------------------------------------------------------------
  Purpose:     Adjusts window position if the palette is behind the taskbar
  Parameters:  <none>
  Notes:       
------------------------------------------------------------------------------*/
  IF SESSION:WINDOW-SYSTEM BEGINS "MS-WIN":U THEN DO: 
    /* special adjustment for Win95 TaskBar */
    DEFINE VARIABLE TBOrientation AS CHARACTER NO-UNDO.
    DEFINE VARIABLE TBHeight      AS INTEGER   NO-UNDO.
    DEFINE VARIABLE TBWidth       AS INTEGER   NO-UNDO.
    DEFINE VARIABLE AutoHide      AS LOGICAL   NO-UNDO.

    RUN adeshar/_taskbar.p (OUTPUT TBOrientation, OUTPUT TBHeight,
                            OUTPUT TBWIdth,       OUTPUT AutoHide).
    IF NOT AutoHide THEN DO:
      IF TBOrientation = "LEFT":U AND hWin:X <= TBWidth THEN
        ASSIGN hWin:X = TBWidth.
      IF TBOrientation = "LEFT":U AND hWin:X <= TBWidth THEN
        ASSIGN hWin:X   = TBWidth.
      IF TBOrientation = "TOP":U THEN DO:
        IF hWin:Y <= TBHeight THEN hWin:Y = TBHeight.
        IF hWin:Y <= TBHeight   THEN hWin:Y   = TBHeight.
      END.
      IF TBOrientation = "BOTTOM" AND hWin:Y + hWin:HEIGHT-P > SESSION:HEIGHT-P - TBHeight THEN
        hWin:Y = hWin:Y - ((hWin:Y + hWin:HEIGHT-P) - (SESSION:HEIGHT-P - TBHeight)).
      IF TBOrientation = "RIGHT" AND hWin:X + hWin:WIDTH-P > SESSION:WIDTH-P - TBWidth THEN
        hWin:X = hWin:X - ((hWin:X + hWin:WIDTH-P) - (SESSION:WIDTH-P - TBWidth)).
    END.
  END.

END PROCEDURE.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE Build-Menubar hWin 
PROCEDURE Build-Menubar :
/* -----------------------------------------------------------
  Purpose:     Add RULE and Exit to the end of the menubar.
  Parameters:  <none>
  Notes:       This assumes that the other menu-items have 
               already been added via the Add-Menu-Item fcn.
-------------------------------------------------------------*/
  DEFINE VARIABLE RuleLine AS WIDGET.
  CREATE MENU-ITEM RuleLine
      ASSIGN SUBTYPE = "RULE":U
             PARENT  = MENU m_File:HANDLE.

  CREATE MENU-ITEM m_Exit
      ASSIGN parent = MENU m_File:HANDLE
             label  = "E&xit"
             TRIGGERS:
                 ON CHOOSE PERSISTENT RUN destroy IN THIS-PROCEDURE.  
             END.

END PROCEDURE.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE Delete-Function hWin 
PROCEDURE Delete-Function :
/* -----------------------------------------------------------
  Purpose:     Delete an item from the palette
  Parameters:  dlabel (char)
  Notes:       
-------------------------------------------------------------*/
  DEFINE INPUT PARAMETER dlabel AS CHARACTER. /* feature to delete*/
  FIND tt WHERE tt.flabel = dlabel NO-ERROR.
  IF AVAILABLE (tt) THEN DO:
      DELETE WIDGET tt.h_btn.
      DELETE tt.
  END.
  ASSIGN num-items = num-items - 1.
  RUN redraw.
END PROCEDURE.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE Destroy hWin 
PROCEDURE Destroy :
/* --------------------------------------------------------------------
  Purpose:     DISABLE the User Interface
  Parameters:  <none>
  Notes:       Here we clean-up the user-interface by deleting
               dynamic widgets we have created and/or hide 
               frames.  This procedure is usually called when
               we are ready to "clean-up" after running.
   -------------------------------------------------------------------- */
  /* Delete the WINDOW we created */
  IF SESSION:DISPLAY-TYPE = "GUI":U THEN DELETE WIDGET hWin.
  IF THIS-PROCEDURE:PERSISTENT THEN DELETE PROCEDURE THIS-PROCEDURE.
  IF VALID-HANDLE(phParent) THEN APPLY "CLOSE" TO phParent.
END PROCEDURE.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE Enable_UI hWin  _DEFAULT-ENABLE
PROCEDURE Enable_UI :
/*------------------------------------------------------------------------------
  Purpose:     ENABLE the User Interface
  Parameters:  <none>
  Notes:       Here we display/view/enable the widgets in the
               user-interface.  In addition, OPEN all queries
               associated with each FRAME and BROWSE.
               These statements here are based on the "Other 
               Settings" section of the widget Property Sheets.
------------------------------------------------------------------------------*/
END PROCEDURE.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE Get-Items-Per-Row hWin 
PROCEDURE Get-Items-Per-Row :
/* -----------------------------------------------------------
  Purpose:     To get the number of items per row in the
               palette.
  Parameters:  <none>
  Notes:       
-------------------------------------------------------------*/
  DEFINE OUTPUT PARAMETER items-per-row AS INTEGER NO-UNDO.
  DEFINE VARIABLE item-width-p          AS INTEGER NO-UNDO.

  ASSIGN item-width-p  = palette-size
         items-per-row = 
        TRUNCATE (({&WINDOW-NAME}:WIDTH-P / item-width-p) + 0.33 , 0).  
END PROCEDURE.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE Get-Location hWin 
PROCEDURE Get-Location :
/* -----------------------------------------------------------
  Purpose:     To query location of PRO*Tools palette
  Parameters:  <none>
  Notes:       
-------------------------------------------------------------*/
  DEFINE OUTPUT PARAMETER px AS INTEGER NO-UNDO.
  DEFINE OUTPUT PARAMETER py AS INTEGER NO-UNDO.

  ASSIGN px = hWin:x
         py = hWin:y.

END PROCEDURE.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE Realize hWin 
PROCEDURE Realize :
/* -----------------------------------------------------------
  Purpose:     create a visualization of a palette
  Parameters:  px (int)             x location
               py (int)             y location
               items-per-row (int)  
  Notes:       
-------------------------------------------------------------*/
  DEFINE INPUT PARAMETER px AS INTEGER            NO-UNDO.
  DEFINE INPUT PARAMETER py AS INTEGER            NO-UNDO.
  DEFINE INPUT PARAMETER items-per-row AS INTEGER NO-UNDO.

  DEF VAR ch AS CHAR         NO-UNDO.
  DEF VAR iX AS INTEGER      NO-UNDO.
  DEF VAR iY AS INTEGER      NO-UNDO.
  DEF VAR o  AS INTEGER      NO-UNDO.

  DEF VAR i  AS INTEGER      NO-UNDO.

  DEF VAR lResult AS LOGICAL NO-UNDO.

  DEF VAR cItem  AS CHAR     NO-UNDO.
  DEF VAR cFile  AS CHAR     NO-UNDO.
  DEF VAR pHdl   AS HANDLE   NO-UNDO.
  DEF VAR pName  AS LOGICAL  NO-UNDO.

  DEF VAR h      AS WIDGET   NO-UNDO.

  IF px <> ? AND py <> ? THEN 
      RUN Set-Location (INPUT px, INPUT py).

  /* Create a frame to store the graph (in the current window). */
  CREATE FRAME hFrame ASSIGN 
    BOX = NO  
    WIDTH = 1
    HEIGHT = 1 
    THREE-D = YES  
    .  

  /* Walk the members of the Palette and show them.*/     
  num-items = NUM-ENTRIES(pcItems, chr(10)).
  DO i = 1 to num-items:
    ASSIGN cItem = ENTRY(i, pcItems, chr(10))
           cFile = ENTRY(3, cItem)     /* icon file */
           ch    = ENTRY(4,cItem)      /* Label */ 
           o     = INT(ENTRY(7,cItem)) /* order */
           .
    /* Store palette items in a temp-table */
    CREATE tt.
    ASSIGN tt.flabel = ch
           tt.order  = o.

    /* Make a button. */
    CREATE BUTTON tt.h_btn ASSIGN
          LABEL       = ch
          FONT        = palette-font
          X           = iX
          Y           = iY
          WIDTH-P     =  palette-size
          HEIGHT-P    = palette-size
          AUTO-RESIZE = NO
&IF "{&OPSYS}" = "WIN32"               AND
    "{&WINDOW-SYSTEM}" BEGINS "MS-WIN" &THEN
          TOOLTIP     = ch
          NO-FOCUS    = YES
          FLAT-BUTTON = YES
&ENDIF
          .
    /* Make sure the frame will hold the buttons, and show them. */
    ASSIGN h = tt.h_btn
           hFrame:WIDTH-P  = MAX(hFrame:WIDTH-P, h:X + h:WIDTH-P)
           hFrame:HEIGHT-P = MAX(hFrame:HEIGHT-P, h:Y + h:HEIGHT-P)
           h:FRAME = hFrame   
           h:SENSITIVE = YES
           h:HIDDEN = NO
           iX = iX + h:WIDTH-P
           .
    /* Some get the button file name for the item.. */
    lResult = h:LOAD-IMAGE-UP (cFile) NO-ERROR.

    /* Attach Triggers */
    cFile = ENTRY(2, cItem).  /* File name to run */
    IF cFile ne "" THEN DO:
      ASSIGN pName = IF ENTRY(6, cItem) = "yes" then yes else no. /* pass Name of function selected? y/n */
      /* Base run on the type: RUN, FLO, PERSISTENT or HANDLE */
      CASE SUBSTRING(cItem,1,3, "CHARACTER":U):
        WHEN "FLO" THEN
          ON CHOOSE OF tt.h_btn PERSISTENT RUN run-flo IN THIS-PROCEDURE (cFile).
        WHEN "PER" THEN
          ON CHOOSE OF tt.h_btn PERSISTENT RUN run-persistent IN THIS-PROCEDURE (INPUT cFile, INPUT pName, INPUT ch) . 
        WHEN "HAN" THEN DO:  
          ASSIGN pHdl  = WIDGET-HANDLE(ENTRY(5, cItem)).  /* Handle of procedure */
          IF pName THEN       
            ON CHOOSE OF tt.h_btn PERSISTENT RUN VALUE(cfile) IN pHdl (INPUT ch).
          ELSE
            ON CHOOSE OF tt.h_btn PERSISTENT RUN VALUE(cfile) IN pHdl.
        END.
        OTHERWISE  /* Run regularly */
          IF pName THEN
            ON CHOOSE OF tt.h_btn PERSISTENT RUN VALUE (cFile) (INPUT ch).
          ELSE
            ON CHOOSE OF tt.h_btn PERSISTENT RUN VALUE (cFile).
      END CASE.
    END.

    /* Start a new row, (maybe). */
    IF iX >= items-per-row * h:WIDTH-P 
    THEN ASSIGN iX = 0 iY = h:Y + h:HEIGHT-P.

  END. /* DO WHILE valid next object */

  /* Set the window size to the frame size. */
  ASSIGN hWin:WIDTH        = hFrame:WIDTH
         hWin:HEIGHT       = hFRAME:HEIGHT 
         hFrame:PARENT     = hWin
         items-row         = 0
         .
  
  /* Adjust position of palette window if off the screen. */
  IF hWin:X + hWin:WIDTH-P > SESSION:WIDTH-P THEN 
  hWin:X = MAX(0,SESSION:WIDTH-P - hWin:WIDTH-P).
  ELSE IF hWin:X < 0 THEN hWin:X = 0.
  IF hWin:Y + hWin:HEIGHT-P > SESSION:HEIGHT-P THEN
    hWin:Y = MAX(0,SESSION:HEIGHT-P - hWin:HEIGHT-P).
  ELSE IF hWin:Y < 0 THEN hWin:Y = 0.

  /* Adjust for Windows 95 taskbar if necessary */
  RUN AdjustForTB.

  /* Make the palette window visible */
  ASSIGN hWin:HIDDEN   = no
         hFrame:HIDDEN = no. 
END PROCEDURE.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE Redraw hWin 
PROCEDURE Redraw :
/* -----------------------------------------------------------
  Purpose:     Resize the palette incrementally in terms of 
               the contained palette-items.
  Parameters:  <none>
  Notes:       
-------------------------------------------------------------*/
  DEFINE VAR border-pixels AS INTEGER NO-UNDO.
  DEFINE VAR item-width-p  AS INTEGER NO-UNDO.
  DEFINE VAR item-height-p AS INTEGER NO-UNDO.
  DEFINE VAR i             AS INTEGER NO-UNDO.
  DEFINE VAR items_per_row AS INTEGER NO-UNDO.
  DEFINE VAR iRow          AS INTEGER NO-UNDO.
  DEFINE VAR iCol          AS INTEGER NO-UNDO.
  DEFINE VAR num_rows      AS INTEGER NO-UNDO.

  ASSIGN item-width-p  = palette-size
         item-height-p = palette-size
         .

  /* Get the window size in items_per_row.  Round this to a nice number.
     NOTE: Add a little to the width in case the user is close the next integer
     number of rows.  */
  /*items_per_row = TRUNCATE (({&WINDOW-NAME}:WIDTH-P / item-width-p) + 0.33 , 0).  
   */
    if items-row > 0 then do:
        items_per_row = items-row.
        items-row = 0.
    end.
    else items_per_row = MAX(1,TRUNCATE (({&WINDOW-NAME}:WIDTH-P / item-width-p) + 0.33 , 0)).
  /* How many rows do we now need? */
  num_rows = num-items / items_per_row.
  /* Note: this division could truncate inappropriately, so add 1 if we need to */
  IF num_rows * items_per_row < num-items THEN num_rows = num_rows + 1.

  &IF "{&WINDOW-SYSTEM}" BEGINS "MS-WIN" &THEN
  /* WTW: all MS WIndows have a minimum width (because we cannot get rid of
     the icons on the title-bar). This deals with this.
     NOTE that the multiplier "9" is a guesstimate - not a known constant. 
     */
  IF item-width-p * items_per_row < ( 9 * SESSION:PIXELS-PER-COLUMN)
  THEN border-pixels = (( 9 * SESSION:PIXELS-PER-COLUMN) - 
                       (item-width-p * items_per_row)) / 2.
  &ENDIF

  /* Hide the window, "Maximize" it and the contained frame,
     then reposition the contained buttons. */
  ASSIGN 
       {&WINDOW-NAME}:HIDDEN = YES
       /*hframe = {&WINDOW-NAME}:FIRST-CHILD*/
       hframe:SCROLLABLE = YES
       hframe:VIRTUAL-WIDTH-P  = MAX (hframe:VIRTUAL-WIDTH-P, 
                                      border-pixels + (items_per_row * item-width-p))
       hframe:VIRTUAL-HEIGHT-P = MAX (hframe:VIRTUAL-HEIGHT-P, 
                                      border-pixels + (num_rows * item-height-p))
       .

/* Walk through the temp-tables of items in the palette.  */
ASSIGN i = 0.
FOR EACH tt BY order:
  ASSIGN i    = i + 1
         iRow = TRUNCATE((i - 1) / items_per_row, 0)  /* 0 based */
         iCol = i - (items_per_row * iRow) - 1        /* 0 based */
         tt.h_btn:X = border-pixels +
                      (iCol * item-width-p) +
                      (item-width-p - palette-size) / 2
         tt.h_btn:Y = border-pixels + (iRow * item-height-p)
         . 
END. 

  /* Show the window. Set the window size "correctly". */
  ASSIGN
       {&WINDOW-NAME}:MAX-HEIGHT-P = MIN(SESSION:HEIGHT-P, 
                                         num-items * item-height-p + (2 * border-pixels))
       {&WINDOW-NAME}:MAX-WIDTH-P  = MIN(SESSION:WIDTH-P, 
                                         num-items * item-width-p + (2 * border-pixels))
       {&WINDOW-NAME}:WIDTH-P  = (items_per_row * item-width-p) + (2 * border-pixels)
       {&WINDOW-NAME}:HEIGHT-P = (num_rows * item-height-p) + (2 * border-pixels)
       hframe:SCROLLABLE = NO
       hframe:WIDTH-P = {&WINDOW-NAME}:WIDTH-P
       hframe:HEIGHT-P = {&WINDOW-NAME}:HEIGHT-P
       .
       
  /* If the window is MAXIMIZED, set the maximum height of the window to the actual height.
     This avoids a bug where the window is HIDDEN and VIEWED.  Under Windows, this would
     cause the window to change sizes. */
  IF {&WINDOW-NAME}:WINDOW-STATE = WINDOW-MAXIMIZED THEN DO:
    {&WINDOW-NAME}:MAX-HEIGHT = {&WINDOW-NAME}:HEIGHT. 
  END.

  /* View the window */
  {&WINDOW-NAME}:HIDDEN = NO.
  IF {&WINDOW-NAME}:MOVE-TO-TOP() THEN.

END PROCEDURE.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE Run-Persistent hWin 
PROCEDURE Run-Persistent :
/* -----------------------------------------------------------
  Purpose:     runs a file persistently   
  Parameters:  pcFile - name of thing to run
               pName  - pass Name? y/n
               fName  - function name 
  Notes:       
-------------------------------------------------------------*/
  DEFINE INPUT PARAMETER pcFile AS CHAR NO-UNDO.
  DEFINE INPUT PARAMETER pName  AS LOG  NO-UNDO.
  DEFINE INPUT PARAMETER fName  AS CHAR NO-UNDO.
  DEFINE VARIABLE hProc         AS HANDLE     NO-UNDO.

  IF SEARCH(pcFile) eq ? AND 
    SEARCH(SUBSTRING(pcFile,1,(LENGTH(pcFile,"CHARACTER":u) - 2),
                     "CHARACTER":u) + ".r") EQ ?
  THEN MESSAGE pcFile "not found." VIEW-AS ALERT-BOX ERROR.
  ELSE
  DO ON STOP UNDO, LEAVE:
    IF pName THEN
        RUN VALUE(pcFile) PERSISTENT SET hProc (INPUT fName).
    ELSE
        RUN VALUE(pcFile) PERSISTENT SET hProc.
    RUN initializeObject IN hProc NO-ERROR.
  END.
END PROCEDURE.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE Set-Button-Size hWin 
PROCEDURE Set-Button-Size :
/* -----------------------------------------------------------
  Purpose:     Set button size
  Parameters:  bSize (int)
  Notes:       
-------------------------------------------------------------*/
  DEFINE INPUT PARAMETER bSize AS INT NO-UNDO.

  IF bSize > 0 THEN ASSIGN palette-size = bSize.

END PROCEDURE.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE Set-Hide-Palette hWin 
PROCEDURE Set-Hide-Palette :
/* -----------------------------------------------------------
  Purpose:     Hides the palette so that it doesn't have to be recreated 
               each time it is invoked.
  Parameters:  pResult
  Notes:       Created by R. Ryan 11/1/94
-------------------------------------------------------------*/
  DEFINE INPUT PARAMETER pResult AS LOGICAL NO-UNDO.
  {&window-name}:HIDDEN = pResult.
END PROCEDURE.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE Set-Items hWin 
PROCEDURE Set-Items :
/* -----------------------------------------------------------
  Purpose:     Set items on the palette
  Parameters:  item-list (char)
  Notes:       
-------------------------------------------------------------*/
  DEFINE INPUT PARAMETER item-list AS CHAR NO-UNDO.
  ASSIGN pcItems = item-list.

END PROCEDURE.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE Set-Label-Font hWin 
PROCEDURE Set-Label-Font :
/* -----------------------------------------------------------
  Purpose:     Set font of labels in the palette
  Parameters:  lFont (int)
  Notes:       
-------------------------------------------------------------*/
  DEFINE INPUT PARAMETER lFont AS INTEGER NO-UNDO.

  IF lFont >= 0 THEN ASSIGN palette-font = lFont.

END PROCEDURE.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE Set-Location hWin 
PROCEDURE Set-Location :
/* -----------------------------------------------------------
  Purpose:     To set location of PRO*Tools palette
  Parameters:  <none>
  Notes:       
-------------------------------------------------------------*/
  DEFINE INPUT PARAMETER px AS INTEGER NO-UNDO.
  DEFINE INPUT PARAMETER py AS INTEGER NO-UNDO.

  ASSIGN
      hWin:x = px
      hWin:y = py.

END PROCEDURE.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE Set-Menu hWin 
PROCEDURE Set-Menu :
/* -----------------------------------------------------------
  Purpose:     Sets menubar on or off in the palette
  Parameters:  switch (log)
  Notes:       
-------------------------------------------------------------*/
  DEFINE INPUT PARAMETER switch AS LOGICAL NO-UNDO.

  RUN Build-Menubar.
  IF switch THEN DO: /* switch menu on */
      ASSIGN {&WINDOW-NAME}:MENU-BAR   = MENU menu-bar-hwin:HANDLE
             {&WINDOW-NAME}:POPUP-MENU = ?.
  END.
  ELSE 
    ASSIGN {&WINDOW-NAME}:MENU-BAR   = ?
           {&WINDOW-NAME}:POPUP-MENU = MENU POPUP-MENU-hWin:HANDLE.
END PROCEDURE.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE Set-Parent hWin 
PROCEDURE Set-Parent :
/* -----------------------------------------------------------
  Purpose:     Sets the parent of the palette
  Parameters:  hdl (proc handle)
  Notes:       
-------------------------------------------------------------*/
  DEFINE INPUT PARAMETER hdl AS HANDLE NO-UNDO.
  ASSIGN phParent = hdl.
END PROCEDURE.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE Set-Popup hWin 
PROCEDURE Set-Popup :
/* -----------------------------------------------------------
  Purpose:     Sets/Eliminates the popup menu from the right mouse button
  Parameters:  Result (logical)
  Notes:       Created by R. Ryan 11/1/94
-------------------------------------------------------------*/
  DEFINE INPUT PARAMETER pResult AS LOGICAL NO-UNDO.
  IF pResult THEN 
    ASSIGN hWin:popup-menu = MENU POPUP-MENU-hWin:HANDLE. 
  ELSE 
    ASSIGN hWin:popup-menu = ?. 
END PROCEDURE.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE Set-Title hWin 
PROCEDURE Set-Title :
/* -----------------------------------------------------------
  Purpose:     Set TITLE of palette window
  Parameters:  pcTitle (char)
  Notes:       
-------------------------------------------------------------*/
  DEFINE INPUT PARAMETER pcTitle AS CHARACTER INITIAL ?.
  IF pcTitle NE ? THEN {&WINDOW-NAME}:TITLE = pcTitle.
END PROCEDURE.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE Set-Top-Only hWin 
PROCEDURE Set-Top-Only :
/* -----------------------------------------------------------
  Purpose:     Set top-only property
  Parameters:  Result (logical)
  Notes:       Created by R. Ryan 11/1/94
-------------------------------------------------------------*/
  DEFINE INPUT PARAMETER pResult AS LOGICAL NO-UNDO.
  DEFINE VARIABLE rc AS INTEGER NO-UNDO.
  IF pResult THEN DO:
    ASSIGN 
      MENU-ITEM m_top-only_Window:CHECKED IN MENU m_File = True
      toponly                                            = True.

    RUN adecomm/_topmost.p (INPUT hWin:hWnd, INPUT yes, OUTPUT rc).
  END.

  ELSE ASSIGN  
    MENU-ITEM m_top-only_Window:CHECKED IN MENU m_File = False
    toponly                                            = False.       
END PROCEDURE.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE Set-Window-Icon hWin 
PROCEDURE Set-Window-Icon :
/* -----------------------------------------------------------
  Purpose:     Specify icon for palette window
  Parameters:  iName (char)
  Notes:       
-------------------------------------------------------------*/
  DEFINE INPUT PARAMETER iName AS CHAR    NO-UNDO.
  DEFINE VARIABLE log          AS LOGICAL NO-UNDO.

  ASSIGN FILE-INFO:FILE-NAME = iName NO-ERROR.
  IF ( FILE-INFO:FULL-PATHNAME NE ? ) THEN DO:
    ASSIGN log = hWin:LOAD-ICON(FILE-INFO:FULL-PATHNAME).
  END.
  ELSE 
      MESSAGE "Could not load palette image." VIEW-AS 
          ALERT-BOX WARNING BUTTONS OK.
END PROCEDURE.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE Swap_Order hWin 
PROCEDURE Swap_Order :
/* -----------------------------------------------------------
  Purpose:     swaps the order of two items and redraws palette
  Parameters:  <none>
  Notes:       
-------------------------------------------------------------*/
  DEFINE INPUT PARAMETER pcFname1 AS CHARACTER NO-UNDO. /* Function name1 */
  DEFINE INPUT PARAMETER pcFname2 AS CHARACTER NO-UNDO. /* Function name2 */
  DEFINE VARIABLE torder          AS INTEGER   NO-UNDO.
  DEFINE BUFFER tt1 FOR tt.
  DEFINE BUFFER tt2 FOR tt.

  FIND tt1 WHERE tt1.flabel = pcFname1 NO-ERROR.
  IF AVAILABLE (tt1) THEN DO:
      FIND tt2 WHERE tt2.flabel = pcFname2 NO-ERROR.
      IF AVAILABLE (tt2) THEN DO:
          ASSIGN torder    = tt1.order
                 tt1.order = tt2.order
                 tt2.order = torder.  
      END.
   END.
END PROCEDURE.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE Update-Function hWin 
PROCEDURE Update-Function :
/* ---------------------------------------------------------------
  Purpose:     Updates a function currently defined in the palette
  Parameters:  pcFile (char)    
               pcImage (char)
               pcFname (char)
               perrun (log)  
               oldname (char)
  Notes:       
-------------------------------------------------------------*/
  DEFINE INPUT PARAMETER pcFile  AS CHARACTER NO-UNDO. /* File name to run */
  DEFINE INPUT PARAMETER pcImage AS CHARACTER NO-UNDO. /* Image name */
  DEFINE INPUT PARAMETER pcFname AS CHARACTER NO-UNDO. /* Function name */
  DEFINE INPUT PARAMETER perrun  AS LOGICAL   NO-UNDO. /* Run Persistent? */
  DEFINE INPUT PARAMETER oldname AS CHARACTER NO-UNDO. /* original name */

  DEFINE VARIABLE fh AS WIDGET.
  DEFINE VARIABLE rc AS LOG.

  fh = hFrame.
  FIND tt WHERE tt.flabel = oldname NO-ERROR.
  IF AVAILABLE (tt) THEN DO:

      ASSIGN tt.flabel               = pcFname  
             tt.h_btn:LABEL          = pcFname
&IF "{&OPSYS}" = "WIN32"               AND
    "{&WINDOW-SYSTEM}" BEGINS "MS-WIN" &THEN
             tt.h_btn:TOOLTIP        = pcFname
&ENDIF
      .

      /* Some get the button file name for the item.. */
      rc = tt.h_btn:LOAD-IMAGE-UP (pcImage) NO-ERROR.

      /* Attach Triggers */  
      IF perrun THEN
          ON CHOOSE OF tt.h_btn PERSISTENT 
            RUN run-persistent IN THIS-PROCEDURE (INPUT pcFile, INPUT no, INPUT "").
      ELSE
          ON CHOOSE OF tt.h_btn PERSISTENT RUN VALUE(pcFile).
      RUN redraw.
  END.
  ELSE MESSAGE "Could not update Applet: " oldname VIEW-AS ALERT-BOX ERROR BUTTONS OK.
END PROCEDURE.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME

/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/*----------------------------------------------------------------------------

File: _prfxfld.p

Syntax:
        RUN adecomm/_prfxfld.p
            ( INPUT        p_FldPrefix ,
              INPUT        p_DBName,
              INPUT        p_TblName,
              INPUT-OUTPUT p_FldName ).

Description:

  Adds either tablename. or dbname.tablename. prefix to each field in a 
  field list.

INPUT Parameters

  p_FldPrefix - Indicates what kind of prefix to add to each field name.
                The values are one of the following:
              
                Field Prefixes   Description
                FP_NOPREFIX      Do not add any prefix.  (Default)
                FP_TBL           Add "tablename." prefix to each field.
                FP_DBTBL         Add "dbname.tablename." prefix to each field.
                
                If any other value is passed, no prefix will be added.
              
                (Note: FP stands for Field Prefix.)
  p_DBName   - The name of the database.  DO NOT include the period separator.
               It is added by the routine.
             
  p_TblName  - The name of the table.  DO NOT include the period separator.
               It is added by the routine. 
             
INPUT-OUTPUT Parameters

  p_FldName  - A comma-delimited list of field names.


Author: John Palazzo

Date Created: 07.30.92 

----------------------------------------------------------------------------*/


DEFINE INPUT        parameter p_FldPrefix AS CHAR no-undo INIT "FP_NOPREFIX".
DEFINE INPUT        parameter p_DBName AS CHAR no-undo.
DEFINE INPUT        parameter p_TblName AS CHAR no-undo.
DEFINE INPUT-OUTPUT parameter p_FldName AS CHAR no-undo.

DEFINE VAR v_FldList AS CHAR no-undo.  /* Used to build field list w' prefixes. */
DEFINE VAR v_period AS CHAR init "." no-undo.
DEFINE VAR v_comma AS CHAR init "," no-undo.
DEFINE VAR v_Field AS INTEGER no-undo.  /* do loop counter. */

    
  /*-------------------- Add prefixes ? -----------------------------*/
  IF ( p_FldPrefix = "FP_TBL" OR p_FldPrefix = "FP_DBTBL" )
     AND NUM-ENTRIES( p_FldName ) > 0 
  THEN DO:
   
    DO v_Field = 1 to num-entries( p_FldName ):
      /* Be sure user passed both a dbname and table name. */
      IF p_FldPrefix = "FP_DBTBL" and p_DBName <> ? and p_TblName <> ?
      THEN v_FldList = v_FldList + p_DBName + v_period.  /* dbname. */
     
      /* Be sure user passed a table name. */
      IF p_TblName <> ?
      THEN v_FldList = v_FldList + p_TblName + v_period. /* tablename. */
      
      /* Build comma delimited Field list. */
      v_FldList = v_FldList + entry( v_Field , p_FldName ) + 
                  IF v_Field < NUM-ENTRIES( p_FldName ) 
                  THEN v_comma
                  ELSE "".  /* Omit last comma in list. */
    END.
    
    p_FldName = v_FldList.  /* Pass prefixed field list back to parameter. */
  END. /* add prefixes. */
      
/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/
/*----------------------------------------------------------------------------

File: _proserr.p

Description:
    Prints out an error message for the errors that come from OS
    functions.

Input Parameters: 
    
	n	 The number
        filename The file.
        verb     The verb to be added to the message. It should
                 be in the past tense. Ex "deleted"
        extra    Any additional text you want to display with the error.
    
Output Parameters:
   
	none

Author: D. Lee

Date Created: 1993

----------------------------------------------------------------------------*/

define input parameter error_num  as integer.
define input parameter filename   as character.
define input parameter verb       as character.
define input parameter extra_text as character.

define variable l1 as character.
define variable l2 as character.

/*
 * Build the base of the error message.
 */

l1 = filename + " cannot be " + verb + ".".

/*
 * Don't print out anything if there is no error
 */

case error_num:

	when  0 then return.
	when  1 then l2 = "You are not the owner of the file.".
        when  2 then l2 = "There is no such file or directory.".
        when  3 then l2 = "There is an interrupted system call.".
        when  4 then l2 = "There is an I/O error.".
	when  5 then l2 = "There is a bad file number.".
        when  6 then l2 = "There are no more processes.".
        when  7 then l2 = "There is not enough core memory.".
        when  8 then l2 = "Permission has been denied.".
        when  9 then l2 = "There is a bad address.".
	when 10 then l2 = "The file already exisl2.".
        when 11 then l2 = "There is no such device.".
        when 12 then l2 = "It is not a directory.".
        when 13 then l2 = "It is a directory.".
        when 14 then l2 = "There is a file table overflow.".
        when 15 then l2 = "There are too many files open.".
        when 16 then l2 = "The file is too large.".
        when 17 then l2 = "The is no space left on the device.".
        when 18 then l2 = "The directory is not empty.".
        otherwise 
		    l2 = "Unmapped error number: " + (if error_num = ? then "?" else string(error_num)). 
end case.

message l1 skip l2 skip extra_text  view-as alert-box warning buttons ok.

/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/**************************************************************************
    Procedure:  _pwaddfile.p
    
    Purpose:    Adds a file to Dynamics Repository.

    Syntax :    RUN adecomm/_pwaddfile.p (INPUT pw_Editor).

    Parameters:
    Description:

    Notes  :    Part of IZ 2513 Error when trying to save structured include
                in Dynamics framework.
      
    Authors: John Palazzo
    Date   : November, 2001
**************************************************************************/

/* Procedure Window Global Defines. */
{ adecomm/_pwglob.i }

DEFINE INPUT  PARAMETER pw_Editor   AS WIDGET-HANDLE NO-UNDO.

DEFINE VARIABLE hWindow    AS HANDLE    NO-UNDO.
DEFINE VARIABLE Add_OK     AS LOGICAL   NO-UNDO.
DEFINE VARIABLE FileExt    AS CHARACTER NO-UNDO.

DO ON STOP UNDO, LEAVE:
    /* Need Window handle of Procedure Window for this editor widget. */
    hWindow = pw_Editor:WINDOW.
           
    /* Cannot add untitled / unsaved files to repository. */
    IF pw_Editor:NAME BEGINS {&PW_Untitled} THEN
    DO:
      MESSAGE "Cannot add to repository:" pw_Editor:NAME SKIP(1)
              "The file must be saved before it can be added to a repository."
              VIEW-AS ALERT-BOX INFORMATION IN WINDOW hWindow.
      RETURN.
    END.
    
    /* IZ 2513 Cannot add include files to repository. We can only filter on .i extensions. */
    RUN adecomm/_osfext.p
        (INPUT  pw_Editor:NAME  /* OS File Name.   */ ,
         OUTPUT FileExt         /* File Extension. */ ).
    IF (FileExt = ".i":U) THEN
    DO:
      MESSAGE "Cannot add to repository:" pw_Editor:NAME SKIP(1)
              "Include file types cannot be added to a repository."
              VIEW-AS ALERT-BOX INFORMATION IN WINDOW hWindow.
      RETURN.
    END.

    /* Call to run Add to Repository dialog and add file to repository. */
    RUN adeuib/_reposaddfile.p
        (INPUT hWindow,           /* Parent Window    */
         INPUT ?,                 /* _P recid         */
         INPUT "",                /* Product Module   */
         INPUT pw_Editor:NAME,    /* File to add      */
         INPUT "",                /* File type        */
         OUTPUT Add_OK).
END.
/*********************************************************************
* Copyright (C) 2005 by Progress Software Corporation. All rights    *
* reserved.  Prior versions of this work may contain portions        *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/**************************************************************************
    Procedure:  _pwattr.i
    
    Purpose:    Preprocessor Defines and Procedures used to manage
                Procedure Window attributes which contain persistent
                Procedure Window data.

    Syntax :    { adecomm/_pwattr.i }

    Parameters:
    
    Description:
        A Procedure Window must keep certain pieces of data persistenly.
        For example, the Find dialog box uses the sames settings as the
        most recent Find each time its invoked, such as the most recently
        searched for "Find Text".
                
        These values cannot be stored in regular variables because Procedure
        Windows are not actively running Progress programs, but rather are
        mere dynamically created widgets living in "screen world."
                
        The persistent data values are stored in dynamically created FILL-IN
        widgets which are in turn contained in a dynamically created FRAME.
        This Frame is a HIDDEN frame and is parented to the Procedure Window.
                
        Procedure Window (PW) Attribute Strings are used to indentify and
        describe certain information about each FILL-IN (persistent data
        value) or PW Attribute, as they are called.
                
        When a FILL-IN is created to store a PW Attribute, we use three
        pieces of information to create it: LABEL, DATA-TYPE, and
        INITIAL-VALUE.  We then store the persistent data in the FILL-IN's
        PRIVATE-DATA attribute.
                
        Additional information is provided in the code comments.
    
    Notes  :
    Authors: John Palazzo
    Date   : January, 1994
**************************************************************************/

/* These defines specify the element within an PW Attribute String where
   each is located.
*/
&GLOBAL-DEFINE  PW_LABEL            1
&GLOBAL-DEFINE  PW_DATA-TYPE        2
&GLOBAL-DEFINE  PW_INITIAL-VALUE    3

/* Procedure Window Attributes (Persistent Data).  Used for preserving
   values of some dialog boxes after dialog box is closed.
   
       Format:  PW_Attribute        "LABEL,DATA-TYPE,INITIAL-VALUE"
   
   The values of each are located using the ENTRY function, such as
   the ENTRY( {&PW_INITIAL-VALUE} , {&PW_Find_Text} ) returns the 
   initial value of a Procedure Window's Find Text field.
   
   The LABEL value is used for programming references only and is not
   used in a displayed manner.
*/

/* These two PW Attributes are stored in dynamic fill-ins because they can hold
   multi-line text and this is difficult to manage with the ENTRY function (what
   should the delimiter be?
*/
&GLOBAL-DEFINE  PW_Find_Text          "Find_Text,CHARACTER,"
&GLOBAL-DEFINE  PW_Replace_Text       "Replace_Text,CHARACTER,"

&GLOBAL-DEFINE  PW_Find_Direction     "Find_Direction,CHARACTER,DOWN"
&GLOBAL-DEFINE  PW_Find_Case          "Find_Case,LOGICAL,NO"
&GLOBAL-DEFINE  PW_Find_Wrap          "Find_Wrap,LOGICAL,YES"
&GLOBAL-DEFINE  PW_Replace_Case       "Replace_Case,LOGICAL,NO"
&GLOBAL-DEFINE  PW_Replace_Wrap       "Replace_Wrap,LOGICAL,YES"
&GLOBAL-DEFINE  PW_Schema_Prefix      "Schema_Prefix,INTEGER,1"

/* _Pos Defines - specify the element position within :PRIVATE-DATA that each PW
   attribute is located. */
&GLOBAL-DEFINE  PW_Find_Direction_Pos   1
&GLOBAL-DEFINE  PW_Find_Case_Pos        2
&GLOBAL-DEFINE  PW_Find_Wrap_Pos        3
&GLOBAL-DEFINE  PW_Replace_Case_Pos     4
&GLOBAL-DEFINE  PW_Replace_Wrap_Pos     5
&GLOBAL-DEFINE  PW_Schema_Prefix_Pos    6
&GLOBAL-DEFINE  PW_Temp_Web_File_Pos    7 
&GLOBAL-DEFINE  PW_Broker_URL_Pos       8 
&GLOBAL-DEFINE  PW_Compile_Prompt_Pos   9 
&GLOBAL-DEFINE  PW_Compile_File_Pos     10
&GLOBAL-DEFINE  PW_Class_Type_Pos       11
&GLOBAL-DEFINE  PW_Class_TmpDir_Pos     12
&GLOBAL-DEFINE  PW_Web_File_Name_Pos    13

&GLOBAL-DEFINE  PW_NUM-ATTRS            13



PROCEDURE InitAttr.
/*-------------------------------------------------------------------------
    Purpose:    Initializes the PW Persistent Attributes initial values in
                Editor widget's PRIVATE-DATA.

    Syntax :    RUN InitAttr ( INPUT p_Editor ).

    Parameters:
    Description:
                
    Notes  :
    Authors: John Palazzo
    Date   : January, 1994
-------------------------------------------------------------------------*/

DEFINE INPUT PARAMETER p_Editor AS WIDGET-HANDLE NO-UNDO.

DEFINE VARIABLE Private_Data AS CHARACTER NO-UNDO.

DO:
    /* Initialize the list to the number of PW attributes less one by filling with
       commas - the delimeter. */
       
    ASSIGN p_Editor:PRIVATE-DATA = FILL( "," , {&PW_NUM-ATTRS} - 1)
           Private_Data = p_Editor:PRIVATE-DATA.
    
    /* Assign PW Initial Attribute values to ED:PRIVATE-DATA. */
    ASSIGN ENTRY( {&PW_Find_Direction_Pos} , Private_Data  )
                = ENTRY ({&PW_INITIAL-VALUE} , {&PW_Find_Direction})
           ENTRY( {&PW_Find_Case_Pos} , Private_Data  )
                = ENTRY ({&PW_INITIAL-VALUE} , {&PW_Find_Case})
           ENTRY( {&PW_Find_Wrap_Pos} , Private_Data  )
                = ENTRY ({&PW_INITIAL-VALUE} , {&PW_Find_Wrap})
           ENTRY( {&PW_Replace_Case_Pos} , Private_Data  )
                = ENTRY ({&PW_INITIAL-VALUE} , {&PW_Replace_Case})
           ENTRY( {&PW_Replace_Wrap_Pos} , Private_Data  )
                = ENTRY ({&PW_INITIAL-VALUE} , {&PW_Replace_Wrap})
           ENTRY( {&PW_Schema_Prefix_Pos} , Private_Data  )
                = ENTRY ({&PW_INITIAL-VALUE} , {&PW_Schema_Prefix})
           ENTRY( {&PW_Compile_Prompt_Pos} , Private_Data  ) = "YES:":U
           p_Editor:PRIVATE-DATA = Private_Data
           .
END.

END PROCEDURE.


PROCEDURE CreateFrameAttr.
/*-------------------------------------------------------------------------
    Purpose:    Creates a FILL-IN field of a specified data-type and
                attaches it to a specified Frame.

    Syntax :    RUN CreateFrameAttr ( INPUT p_Frame , INPUT p_Attr ).

    Parameters:
    Description:
                This procedure extracts the needed information from
                the PW Attribute String p_Attr to create a fill-in field
                for the specified frame.
    Notes  :
    Authors: John Palazzo
    Date   : January, 1994
-------------------------------------------------------------------------*/

DEFINE INPUT PARAMETER p_Frame AS WIDGET-HANDLE NO-UNDO.
DEFINE INPUT PARAMETER p_Attr  AS CHARACTER     NO-UNDO.

DEFINE VARIABLE pw_attr        AS WIDGET-HANDLE NO-UNDO.
DEFINE VARIABLE pw_label       AS WIDGET-HANDLE NO-UNDO.

DO:
    CREATE TEXT pw_label IN WIDGET-POOL {&PW_Pool}
      ASSIGN FORMAT       = "x(50)"
             SCREEN-VALUE = ENTRY( {&PW_LABEL} , p_Attr )
             FRAME        = p_Frame
             HIDDEN       = TRUE
             .
         
    CREATE FILL-IN pw_attr IN WIDGET-POOL {&PW_Pool}
      ASSIGN DATA-TYPE          = ENTRY( {&PW_DATA-TYPE} , p_Attr )
             PRIVATE-DATA       = ENTRY( {&PW_INITIAL-VALUE} , p_Attr )
             SIDE-LABEL-HANDLE  = pw_label
             FRAME              = p_Frame
             HIDDEN             = TRUE
             .
END.

END PROCEDURE.



PROCEDURE GetFrameAttr.
/*-------------------------------------------------------------------------
    Purpose:    Returns the handle of a FILL-IN field specified by a
                Procedure Window Attribute string.

    Syntax :    RUN GetFrameAttr ( INPUT p_Frame , INPUT p_Attr ,
                                   OUTPUT p_Attr_Handle ).

    Parameters:
    Description:
                This procedure extracts the needed information from
                the PW Attribute String p_Attr to find the matching fill-in
                field for the specified frame and returns the fill-in's
                handle.
    Notes  :
    Authors: John Palazzo
    Date   : January, 1994
-------------------------------------------------------------------------*/

DEFINE INPUT  PARAMETER p_Frame       AS WIDGET-HANDLE NO-UNDO.
DEFINE INPUT  PARAMETER p_Attr        AS CHARACTER     NO-UNDO.
DEFINE OUTPUT PARAMETER p_Attr_Handle AS WIDGET-HANDLE NO-UNDO.

DEFINE VARIABLE hWidget AS WIDGET-HANDLE NO-UNDO.

DO:
    /* p_Frame is a Frame, so get down to its first-child. */
    ASSIGN hWidget = p_Frame:FIRST-CHILD    /* Field-Group.        */ 
           hWidget = hWidget:FIRST-CHILD    /* First Field widget. */
           .
    DO WHILE VALID-HANDLE( hWidget ):
        IF hWidget:LABEL = ENTRY( {&PW_LABEL} , p_Attr )
        THEN DO:
            ASSIGN p_Attr_Handle = hWidget.
            RETURN.
        END.
        ELSE ASSIGN hWidget = hWidget:NEXT-SIBLING.
    END.
END.

END PROCEDURE.

/* _pwattr.i - end of file */
/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/
/**************************************************************************
    Procedure:  _uniqfil.p
    
    Purpose:    Generates a unique file name to be associated with a buffer.

    Parameters:
                INPUT p_File_Name
                  The filename associated with the buffer.
                INPUT p_Ext
                  The extension for the generated filename.
                OUTPUT p_Unique_FileName
                  The unique filename.

    Description: Generates a unique filename for the temporary file used
                 to compile a procedure.  The filename is of the form
                 pNNNNN_origname.ext, where the various parts are:

                 "p"      - By convention
                 NNNNN    - Five-digit number to ensure uniqueness
                 origname - the original name of the file minus the path and
                            extension
                 ext      - The requested extension (p_Ext)

    Authors: Matt Gilarde
    Date   : 01/06/2003
    Updated: 
**************************************************************************/

/* Procedure Window Global Defines. */
{ adecomm/_pwglob.i }

DEFINE INPUT PARAMETER p_File_Name AS CHAR NO-UNDO.
DEFINE INPUT PARAMETER p_Ext AS CHAR NO-UNDO.
DEFINE OUTPUT PARAMETER p_Unique_FileName AS CHAR NO-UNDO.

DEFINE VAR Dummy AS CHAR NO-UNDO.

/* If it is an untitled buffer, remove the colon from the buffer
** name so we don't form an invalid temp file name.
*/
IF SUBSTRING(p_File_Name, 1, LENGTH({&PW_Untitled})) = {&PW_Untitled} THEN
  p_File_Name = REPLACE(p_File_Name, ":", "").

/* Separate the file name into its components, throwing away the path
** component.
*/
RUN adecomm/_osprefx.p ( p_File_Name, OUTPUT Dummy, OUTPUT p_Unique_FileName ).

/* If the file has an extension, drop it. */
IF R-INDEX(p_Unique_FileName, ".") > 0 THEN
  p_Unique_FileName = SUBSTRING(p_Unique_FileName, 1, R-INDEX(p_Unique_FileName, ".") - 1).

/* Generate the unique compiler file name for this buffer. */
RUN adecomm/_tmpfile.p ( "_" + p_Unique_FileName , p_Ext, OUTPUT p_Unique_FileName ).

/* _uniqfil.p - end of file. */
/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/**************************************************************************
    Procedure:  _pwchfnt.p
    
    Purpose:    Changes the font of all Procedure Windows with a specified
                font to a new specified font.

    Syntax :    RUN adecomm/_pwchfnt.p (INPUT p_Parent_ID ,
                                        INPUT p_Window    ,
                                        INPUT p_Old_Font  ,
                                        INPUT p_New_Font  ).

    Parameters:
        p_Parent_ID
            - String value indicating Parent of PW.  This can be any SESSION
              unique string, such as "UIB" or the string of the Parent window
              handle. It must be the same Parent Id used to open the PW.
        p_Window
            - Handle to a specific Procedure Window.  If passed, only its
              font is changed.  If not passed or invalid, all PW of the
              specified parent will have their font's changed.
              
    Description:
    Notes  :
    Authors: John Palazzo
    Date   : February, 1994
**************************************************************************/

/* Procedure Window Global Defines. */
{ adecomm/_pwglob.i }
  
DEFINE INPUT PARAMETER p_Parent_ID AS CHARACTER NO-UNDO.
DEFINE INPUT PARAMETER p_Window    AS WIDGET    NO-UNDO.
DEFINE INPUT PARAMETER p_Old_Font  AS INTEGER   NO-UNDO.
DEFINE INPUT PARAMETER p_New_Font  AS INTEGER   NO-UNDO.

DEFINE VARIABLE pw_Window  AS WIDGET-HANDLE NO-UNDO.
DEFINE VARIABLE pw_Editor  AS WIDGET-HANDLE NO-UNDO.

REPEAT ON STOP UNDO, LEAVE:
    /* Start with the session's first window. */
    ASSIGN pw_Window   = SESSION:FIRST-CHILD
           p_Parent_ID = ( IF p_Parent_ID = ? THEN "?" ELSE p_Parent_ID )
           .
    DO WHILE VALID-HANDLE( pw_Window ):
        /* Is this a Procedure Window and is it a "child window" of the
           Parent window passed? If Yes, change font.
        */
        IF pw_Window:NAME = {&PW_NAME}
           AND pw_WINDOW:PRIVATE-DATA = p_Parent_ID
        THEN DO:                                                           
            /* Get widget handle of Procedure Window editor widget. */
            RUN adecomm/_pwgeteh.p ( INPUT pw_Window , OUTPUT pw_Editor ).
            
            /* Change font if same as old font or if routine called
               for a specific window - then we always change the font.
            */
            IF    pw_Editor:FONT = p_Old_Font
               OR pw_Window = p_Window
            THEN ASSIGN pw_Editor:FONT = p_New_Font.
            /* Did we change the font of a specific PW? If yes, were are 
               done.
            */
            IF pw_Window = p_Window THEN LEAVE.
        END.
        ASSIGN pw_Window = pw_Window:NEXT-SIBLING.
    END.
    LEAVE.
END.
/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/**************************************************************************
    Procedure:  _pwclose.p
    
    Purpose:    Execute Procedure Window File->Close command.

    Syntax :    RUN adecomm/_pwclose.p.

    Parameters:
    Description:
    Notes  :
    Authors: John Palazzo
    Date   : January, 1994
**************************************************************************/

/* Procedure Window Global Defines. */
{ adecomm/_pwglob.i }

DEFINE VARIABLE pw_Window AS WIDGET-HANDLE NO-UNDO.
DEFINE VARIABLE pw_Editor AS WIDGET-HANDLE NO-UNDO.

DEFINE VARIABLE OK_Close    AS LOGICAL   NO-UNDO.

/* --- Begin SCM changes --- */
DEFINE VAR scm_ok       AS LOGICAL           NO-UNDO.
DEFINE VAR scm_context  AS CHARACTER         NO-UNDO.
DEFINE VAR scm_filename AS CHARACTER         NO-UNDO.
/* --- End SCM changes ----- */

DO ON STOP UNDO, LEAVE:
    /* Get widget handles of Procedure Window and its editor widget. */
    RUN adecomm/_pwgetwh.p ( INPUT SELF , OUTPUT pw_Window ).
    RUN adecomm/_pwgeteh.p  ( INPUT pw_Window , OUTPUT pw_Editor ).
    
    /* --- Begin SCM changes --- */
    ASSIGN scm_context  = STRING( pw_Editor )
           scm_filename = pw_Editor:NAME .
    RUN adecomm/_adeevnt.p 
        (INPUT  {&PW_NAME} , INPUT "Before-Close",
         INPUT scm_context , INPUT scm_filename , 
         OUTPUT scm_ok ).
    IF scm_ok = FALSE THEN RETURN ERROR.
    /* --- End SCM changes ----- */

    RUN adecomm/_pwclosf.p ( INPUT pw_Window, INPUT pw_Editor ,
                           INPUT "Close", OUTPUT OK_Close ).

    IF OK_Close <> TRUE THEN RETURN ERROR.

    /* --- Begin SCM changes --- */
    RUN adecomm/_adeevnt.p 
        (INPUT  {&PW_NAME} , INPUT "Close",
         INPUT scm_context , INPUT scm_filename , 
         OUTPUT scm_ok ).
    /* --- End SCM changes ----- */

    /* --- Begin SCM changes --- */
    /* Do custom shutdown -- this is generally a no-op, but it can
       be used to cleanup custom modifications. */
    RUN adecomm/_adeevnt.p 
        ( INPUT {&PW_NAME} ,
          INPUT "SHUTDOWN",
          INPUT STRING(pw_Window) , STRING(pw_Window:PRIVATE-DATA) ,
          OUTPUT scm_ok ).
    /* --- End SCM changes ----- */
    
    RUN adecomm/_pwdelpw.p (INPUT pw_Window ).
     
END.
/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/**************************************************************************
    Procedure:  _pwclosf.p
    
    Purpose:    Low-level routine to Close a Procedure Window file.

    Syntax :    RUN adecomm/_pwclosf.p ( INPUT p_Window , INPUT p_Editor ,
                                       INPUT p_Action ,
                                       OUTPUT p_OK_Close ) .

    Parameters:
        See DEFINE PARAMETER in code.
        
    Description:
        1. If unsaved changes, ask user to Save Changes: Yes-No-Cancel.
        2. If Untitled, open Save As dialog box.
        3. Finally, perform actual file save.

    Notes  :
    Authors: John Palazzo
    Date   : January, 1994
**************************************************************************/

/* Procedure Window Global Defines. */
{ adecomm/_pwglob.i }

DEFINE INPUT  PARAMETER p_Window   AS WIDGET-HANDLE NO-UNDO.
DEFINE INPUT  PARAMETER p_Editor   AS WIDGET-HANDLE NO-UNDO.
DEFINE INPUT  PARAMETER p_Action   AS CHARACTER     NO-UNDO.
DEFINE OUTPUT PARAMETER p_OK_Close AS LOGICAL       NO-UNDO.
    /* p_OK_Close = TRUE means its ok to continue operation.
                  = FALSE or ? means its not.
    */

DEFINE VARIABLE File_Name   AS CHARACTER NO-UNDO.
DEFINE VARIABLE l_OK        AS LOGICAL   NO-UNDO.
DEFINE VARIABLE Save_As     AS LOGICAL   NO-UNDO.

REPEAT ON STOP UNDO, RETRY:
        IF RETRY
        THEN DO:
            ASSIGN p_OK_Close = ?.    /* Cancel */
            RETURN.
        END.
        
        /* Bring PW to top. */
        ASSIGN l_OK = p_Window:MOVE-TO-TOP().
        
        /* Ask user to Save Changes: Yes-No-Cancel. Returns NO if unsaved
           changes or if user answered NO. */
        RUN adecomm/_pwfchg.p ( INPUT p_Editor , INPUT p_Action ,
                                OUTPUT p_OK_Close ). 
        
        IF p_OK_Close = ? THEN RETURN.  /* Cancel */   
        IF p_OK_Close = NO              /* NO - Don't Save. */
        THEN DO:
            ASSIGN p_OK_Close = TRUE. /* Means ok to contine and close file. */
            RETURN.
        END.
        
        IF p_OK_Close = YES THEN 
        DO: /* Yes->Save. */
            RUN adecomm/_pwsave.p (INPUT p_Editor).
            IF RETURN-VALUE = "ERROR":U THEN
               ASSIGN p_OK_Close = ?.
        END.
        LEAVE.
END.
/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/
/********************************************************************/
/* Encrypted code which is part of this file is subject to the      */
/* Possenet End User Software License Agreement Version 1.0         */
/* (the "License"); you may not use this file except in             */
/* compliance with the License. You may obtain a copy of the        */
/* License at http://www.possenet.org/license.html                  */
/********************************************************************/

/**************************************************************************
    Procedure:  _pwcmpfl.p
    
    Purpose:    Compiles the contents of an editor widget or disk file to
                check its syntax.
                
    Syntax :
    
        RUN adecomm/_pwcmpfl.p   (INPUT  p_Editor       /* Editor handle.   */ ,
                                INPUT  p_Msgs_Output  /* Messages Dest.   */ ,
                                INPUT  p_Comp_File    /* Compile file.    */ ,
                                INPUT  p_Msgs_File    /* Messages file.   */ ,
                                OUTPUT p_Comp_Stopped /* Compile Stopped? */ ).

    Parameters:
    
    p_Editor
        Handle of Editor widget whose contents you want compiled. Pass Unknown
        (?) to bypass Editor widget and procedure will compile the contents of
        p_Comp_File.

    p_Msgs_Output
        String indicating the destination of the compiler messages.
    
            VALUE           COMPILER MESSAGES DESTINATION
            -------------   -------------------------------
            "CMP_KEEP"      File specified by p_Msgs_File.
            "CMP_NOERROR"   ERROR-STATUS handle.
            "" or anything  CURRENT-WINDOW.
                  else
    
    p_Comp_File
        Name of file to compile.  If you pass p_Editor and p_Comp_File, the
        contents of p_Editor are written to p_Comp_File and compiled. If you
        do not pass p_Editor, contents of p_Comp_File are compiled directly.
                    
        If you do not pass p_Comp_File (ie, pass Null ""), this routine
        generates a standard temp file name to use. When this routine generates
        the p_Comp_File, it also deletes it before returning. If you pass
        p_Comp_File, the file is NOT deleted. That's left as your job.
                    
    p_Msgs_File 
        If you do not pass p_Msgs_File (ie, Null ""), this routine generates
        a standard temp file name to use. When this routine generates the
        p_Msgs_File, it also deletes it before returning.  If you pass
        p_Msgs_File, the file is NOT deleted.  That's left as your job.
    
    p_Comp_Stopped
        TRUE if, for any reason, the compilation was halted. Examples: User
        pressed STOP (Ctrl-C) at any time, the file to compile could not be
        found.  FALSE if PROGRESS got through the COMPILE statement successfully.
    
    Description:
        Returns a TRUE value if the compilation was stopped (in any way) and
        returns FALSE if the compilation completed uninterupted. Calling
        routine is then responsible for examining the COMPILER handle for
        the actual results of the compilation.

    Notes  :
    
        1. If you don't pass anything for p_Editor and p_Comp_File, the
           routine will attempt to compile the self-generated temp file
           name for p_Comp_File.  Of course, this file won't exist and
           you'll get an error: Can't find "pnnnnn.cmp".
           Always pass one or the other.
           
    Authors: John Palazzo
    Date   : January, 1994
**************************************************************************/

DEFINE INPUT  PARAMETER p_Editor       AS WIDGET-HANDLE NO-UNDO.
DEFINE INPUT  PARAMETER p_Msgs_Output  AS CHARACTER     NO-UNDO.
DEFINE INPUT  PARAMETER p_Comp_File    AS CHARACTER     NO-UNDO.
DEFINE INPUT  PARAMETER p_Msgs_File    AS CHARACTER     NO-UNDO.
DEFINE OUTPUT PARAMETER p_Comp_Stopped AS LOGICAL INIT TRUE NO-UNDO.

&SCOPED-DEFINE  CMP_KEEP       "CMP_KEEP"
&SCOPED-DEFINE  CMP_NOERROR    "CMP_NOERROR"

DEFINE VARIABLE ok_save       AS LOGICAL NO-UNDO.
DEFINE VARIABLE ed_mod        AS LOGICAL NO-UNDO.
DEFINE VARIABLE error_num     AS INTEGER NO-UNDO.
DEFINE VARIABLE Del_Comp_File AS LOGICAL NO-UNDO.  
DEFINE VARIABLE Del_Msgs_File AS LOGICAL NO-UNDO.

REPEAT ON QUIT       , RETRY
       ON STOP   UNDO, RETRY
       ON ERROR  UNDO, RETRY
       ON ENDKEY UNDO, RETRY :

    IF NOT RETRY
    THEN DO:
        IF p_Comp_File = ? OR p_Comp_File = ""
        THEN DO:
            RUN adecomm/_tmpfile.p ( INPUT "" , INPUT ".cmp" ,
                                     OUTPUT p_Comp_File ).
            ASSIGN Del_Comp_File = TRUE.
        END.
        
        IF VALID-HANDLE( p_Editor ) /* AND p_Editor:TYPE = "EDITOR" */
        THEN DO:
            ASSIGN ed_mod = p_Editor:MODIFIED.
            ASSIGN ok_save = p_Editor:SAVE-FILE( p_Comp_File ) NO-ERROR.
            ASSIGN p_Editor:MODIFIED = ed_mod.
            
            IF NOT ok_save OR
               ERROR-STATUS:NUM-MESSAGES > 0
            THEN DO:
                MESSAGE p_Comp_File SKIP
                        "Unable to create compile file. Compilation cancelled."
                    VIEW-AS ALERT-BOX ERROR BUTTONS OK.
            
                /* Break out and return. */
                STOP.
            END.
            RUN SetEdBufType (INPUT p_Editor, INPUT p_Editor:NAME).   /* adecomm/peditor.i */
        END. /* IF VALID-HANDLE */
        
        /* This REPEAT needed in case the OUTPUT TO fails and raises the
           STOP condition.
        */
        REPEAT ON STOP  UNDO, RETRY
               ON ERROR UNDO, RETRY:
            IF NOT RETRY
            THEN DO:
                IF p_Msgs_Output = {&CMP_KEEP}
                THEN DO:
                    IF p_Msgs_File = ? OR p_Msgs_File = ""
                    THEN DO:
                        RUN adecomm/_tmpfile.p ( INPUT "" , INPUT ".msg" ,
                                                 OUTPUT p_Msgs_File ).
                        ASSIGN Del_Msgs_File = TRUE.
                    END.
                    OUTPUT TO VALUE( p_Msgs_File ) UNBUFFERED KEEP-MESSAGES.
                END.
                    
                IF p_Msgs_Output = {&CMP_NOERROR} THEN
                DO:
                    COMPILE VALUE( p_Comp_File ) NO-ERROR.
                    /* Populate _MSG with messages suppressed by NO-ERROR. */
                    RUN add-cmp-msgs.
                END.
                ELSE COMPILE VALUE( p_Comp_File ). /* CMP_KEEP OR CMP_DEFAULT */
                
                ASSIGN p_Comp_Stopped = COMPILER:STOPPED.
            END.
            LEAVE.
        END.
        
        /* User pressed Ctrl-C during compile, so break out and return. */
        IF COMPILER:STOPPED THEN STOP.    

    END. /* IF NOT RETRY */
    
    /* Just to be sure output is closed. */
    OUTPUT CLOSE.

    IF Del_Comp_File
        THEN OS-DELETE VALUE( p_Comp_File ).
    IF Del_Msgs_File
        THEN OS-DELETE VALUE( p_Msgs_File ).
    
    RETURN.

END. /* REPEAT RETRY */


/* Populate _MSG statment with ERROR-STATUS messages.
   If you execute COMPILE..NO-ERROR, _MSG population is suppressed.
   Call this routine if you want it populated. */
PROCEDURE add-cmp-msgs:

    DEFINE VARIABLE error_num AS INTEGER NO-UNDO.
    
    DO error_num = 1 TO ERROR-STATUS:NUM-MESSAGES:
      ASSIGN _MSG = ERROR-STATUS:GET-NUMBER( error_num ).
    END.

END PROCEDURE.

{ adecomm/peditor.i }   /* Editor procedures. */
/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/**************************************************************************
    Procedure:  _pwcomp.p
    
    Purpose:    Execute Procedure Window Compile menu commands.

    Syntax :    RUN adecomm/_pwcomp.p ( INPUT p_Action ) .

    Parameters:
    Description:
    Notes  :
    Authors: John Palazzo
    Date   : January, 1994
**************************************************************************/

/* Procedure Window Global Defines include. */
{ adecomm/_pwglob.i }

/* Procedure Window Attributes include. */
{ adecomm/_pwattr.i }

DEFINE INPUT PARAMETER p_Action AS CHARACTER NO-UNDO.

DEFINE VARIABLE pw_Window       AS WIDGET-HANDLE NO-UNDO.
DEFINE VARIABLE pw_Editor       AS WIDGET-HANDLE NO-UNDO.
DEFINE VARIABLE hAttr_Field     AS WIDGET-HANDLE NO-UNDO.
DEFINE VARIABLE l_ok            AS LOGICAL       NO-UNDO.
DEFINE VARIABLE h_cwin          AS WIDGET-HANDLE NO-UNDO.
DEFINE VARIABLE Private_Data    AS CHARACTER     NO-UNDO.

/* --- Begin SCM changes --- */
DEFINE VAR scm_ok       AS LOGICAL           NO-UNDO.
/* --- End SCM changes ----- */

DO:
  REPEAT ON STOP UNDO, RETRY:
    IF RETRY THEN LEAVE.
    /* Get widget handles of Procedure Window and its editor widget. */
    RUN adecomm/_pwgetwh.p ( INPUT SELF , OUTPUT pw_Window ).
    RUN adecomm/_pwgeteh.p  ( INPUT pw_Window , OUTPUT pw_Editor ).

    /* Save current-window handle to restore later. */
    ASSIGN h_cwin         = CURRENT-WINDOW
           CURRENT-WINDOW = pw_Window.

    /* --- Begin SCM changes --- */
    RUN adecomm/_adeevnt.p
        (INPUT  {&PW_NAME} , INPUT "Before-" + p_Action ,
         INPUT STRING( pw_Editor ), INPUT pw_Editor:NAME ,
         OUTPUT scm_ok ).
    IF scm_ok = FALSE THEN RETURN.
    /* --- End SCM changes ----- */

    RUN adecomm/_pwrun.p (INPUT p_Action).
    
    LEAVE.
  END. /* REPEAT */                                                   

  /* Repoint current-window. */
  IF VALID-HANDLE( h_cwin ) THEN ASSIGN CURRENT-WINDOW = h_cwin .
  
  /* --- Begin SCM changes --- */
  RUN adecomm/_adeevnt.p
      (INPUT  {&PW_NAME} , INPUT p_Action ,
       INPUT STRING( pw_Editor ), INPUT pw_Editor:NAME ,
       OUTPUT scm_ok ).
  /* --- End SCM changes ----- */

END. /* DO */
/*********************************************************************
* Copyright (C) 2005 by Progress Software Corporation. All rights    *
* reserved.  Prior versions of this work may contain portions        *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/
/******************************************************************************

Procedure: _pwcreat.p

Syntax   :

RUN adecomm/_pwcreat.p ( INPUT  p_Parent_ID /* Parent ID   */ ,
                         INPUT  p_Name      /* Window Name */ ,
                         INPUT  p_Title     /* Title       */ ,
                         INPUT  p_Menubar   /* Menubar     */ ,
                         OUTPUT p_Window    /* Window H    */ ).

Purpose  :          
    Create a Persistent Procedure Window with Menubar, frame, and
    editor widget, and additional Attributes used to hold persistent data.
    This also attaches default triggers for WINDOW-CLOSE, WINDOW-RESIZE,
    and HELP.  Override them if you wish in the calling procedure.

Description:

       
Parameters:

Notes :

Author: John Palazzo

Date  : February, 1994

*****************************************************************************/

DEFINE INPUT  PARAMETER p_Parent_ID AS CHARACTER NO-UNDO.
DEFINE INPUT  PARAMETER p_Name      AS CHARACTER NO-UNDO.
DEFINE INPUT  PARAMETER p_Title     AS CHARACTER NO-UNDO.
DEFINE INPUT  PARAMETER p_Menubar   AS WIDGET    NO-UNDO.
DEFINE OUTPUT PARAMETER p_Window    AS WIDGET    NO-UNDO.

DEFINE VARIABLE cProcName    AS CHARACTER NO-UNDO.
DEFINE VARIABLE cTempFile    AS CHARACTER NO-UNDO.
DEFINE VARIABLE cBrokerURL   AS CHARACTER NO-UNDO.
DEFINE VARIABLE cPrivateData AS CHARACTER NO-UNDO.
DEFINE VARIABLE cValue       AS CHARACTER NO-UNDO.
DEFINE VARIABLE lWebFile     AS LOGICAL   NO-UNDO.
DEFINE VARIABLE cFullPathWeb AS CHARACTER NO-UNDO INIT ?.

/* ADE Standards Include. */
{ adecomm/adestds.i }
IF NOT initialized_adestds THEN
  RUN adecomm/_adeload.p.

/* Procedure Window application-global contstants. */
{ adecomm/_pwglob.i }

/* Procedure Window Attribute definitions and procedures. */
{ adecomm/_pwattr.i }

/* Define various handles needed to reference the various widgets.  */
DEFINE VARIABLE h_frame   AS WIDGET NO-UNDO.  /*... Frame in the  window */
DEFINE VARIABLE h_ed      AS WIDGET NO-UNDO.  /*... the editor itself    */

IF NUM-ENTRIES(p_Title, CHR(3)) eq 4 THEN
  ASSIGN cValue     = SUBSTRING(p_Title, 
                        LENGTH({&PW_Title_Leader},"CHARACTER":U) + 1, -1,
                        "CHARACTER":U)
         lWebFile   = TRUE
         cTempFile  = ENTRY( 2, cValue,  CHR(3))
         cBrokerURL = ENTRY( 3, cValue,  CHR(3))
         cFullPathWeb = ENTRY( 4, cValue,  CHR(3))
         p_Title    = ENTRY( 1, p_Title, CHR(3)).

/** ******
 ** Step 1: Create the Window for the editor and specifiy its attributes.
 ** ******
 **/

CREATE WINDOW p_Window IN WIDGET-POOL {&PW_Pool}
ASSIGN
  PRIVATE-DATA   = IF p_Parent_ID = ? THEN "?" ELSE p_Parent_ID
  NAME           = p_Name
  TITLE          = p_Title
  MENU-BAR       = p_Menubar
  MAX-WIDTH      = ?
  MAX-HEIGHT     = ?
  MIN-WIDTH      = 1 /* Zero is not acceptable to UIM. */
  MIN-HEIGHT     = 1 /* Zero is not acceptable to UIM. */
  RESIZE         = YES
  SCROLL-BARS    = NO
  MESSAGE-AREA   = NO
  STATUS-AREA    = NO
  DROP-TARGET    = TRUE
  SENSITIVE      = YES
  VISIBLE        = YES
  TRIGGERS:
    /* Attach default triggers. */
    ON WINDOW-CLOSE   PERSISTENT RUN adecomm/_pwclose.p.
    ON WINDOW-RESIZED PERSISTENT RUN adecomm/_pwresz.p.
    ON HELP           PERSISTENT RUN adecomm/_pwhelp.p ( INPUT "KEYWORD" ).
    ON DROP-FILE-NOTIFY PERSISTENT RUN adecomm/_pwopen.p.
  END.

ASSIGN
  p_Window:WIDTH          = FONT-TABLE:GET-TEXT-WIDTH(FILL("0", 85), editor_font)
  p_Window:HEIGHT         = (SESSION:HEIGHT * 0.66)
  p_Window:VIRTUAL-WIDTH  = SESSION:WIDTH
  p_Window:VIRTUAL-HEIGHT = SESSION:HEIGHT
  NO-ERROR.

/** ******
 ** Step 2: Create an "Editor" Frame for the Procedure Window.
 ** ******
 **/
CREATE FRAME h_frame IN WIDGET-POOL {&PW_Pool}
ASSIGN
  X = 0
  Y = 0
  BOX        = NO
  SCROLLABLE = NO
  WIDTH      = p_Window:WIDTH 
  HEIGHT     = p_Window:HEIGHT 
  PARENT     = p_Window
  VISIBLE    = YES 
  SENSITIVE  = YES.
  
/** ******
 ** Step 3: Create an editor widget for the Frame of the Procedure Window.
 ** ******
 **/
CREATE EDITOR h_ed IN WIDGET-POOL {&PW_Pool}
ASSIGN
  X = 0
  Y = 0
  WIDTH       = h_frame:WIDTH -
                  ( h_Frame:BORDER-LEFT + h_Frame:BORDER-RIGHT )
  HEIGHT      = h_frame:HEIGHT -
                  ( h_Frame:BORDER-TOP  + h_Frame:BORDER-BOTTOM )
  SCROLLBAR-V = YES
  SCROLLBAR-H = YES
  FONT        = editor_font         /* From adestds.i */
  FGCOLOR     = std_ed4gl_fgcolor   /* From adestds.i */
  BGCOLOR     = std_ed4gl_bgcolor   /* From adestds.i */
  AUTO-INDENT = TRUE
  LARGE       = TRUE
  PROGRESS-SOURCE = YES  /* No-Op on GUI, but ok to have. */
  FRAME       = h_frame
  TRIGGERS:
    ON TAB,CTRL-TAB
        PERSISTENT RUN adecomm/_pwedit.p ( INPUT "TAB" ).
    ON BACK-TAB,SHIFT-TAB
        PERSISTENT RUN adecomm/_pwedit.p ( INPUT "BACK-TAB" ).
    ON END-ERROR
        PERSISTENT RUN adecomm/_pwedit.p ( INPUT "END-ERROR" ).
  END TRIGGERS.

RUN SetEditor (INPUT h_ed).   /* adecomm/peditor.i */
/* Set the advanced/color editor dialog box help file name. */
RUN SetEdHelpFile.            /* adecomm/peditor.i */

ASSIGN  h_ed:VISIBLE    = YES
        h_ed:SENSITIVE  = YES.

/* Clear Undo state. */
ASSIGN h_ed:EDIT-CAN-UNDO = FALSE.

/** ******
 ** Step 4: Create the additional PW Attributes used for persistent data.
 ** ******
 **/
/* Use the Editor Frame to hold these PW's Search Attributes.  We placed
   these in FILL-IN widgets of their own because they can be multi-line
   text strings.  Because of the EOL characters, this could be tricky to
   store properly in a delimited-list.
*/
RUN CreateFrameAttr ( INPUT h_frame , {&PW_Find_Text} ).
RUN CreateFrameAttr ( INPUT h_frame , {&PW_Replace_Text} ).

/* Additional PW Attributes are stored in comma-list in the 
   ED:PRIVATE-DATA
*/
RUN InitAttr ( INPUT h_ed ).       

/* Set WebSpeed PW Attributes in ED:PRIVATE-DATA
*/
IF lWebFile THEN
  ASSIGN cPrivateData                                    = h_ed:PRIVATE-DATA
         ENTRY( {&PW_Temp_Web_File_Pos} , cPrivateData ) = cTempFile
         ENTRY( {&PW_Broker_URL_Pos}    , cPrivateData ) = cBrokerURL
         ENTRY ( {&PW_Web_File_Name_Pos}, cPrivateData ) = cFullPathWeb
         h_ed:PRIVATE-DATA                               = cPrivateData.

{ adecomm/peditor.i }   /* Editor procedures. */

/* _pwcreat.p - end of file */
/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/**************************************************************************
    Procedure:  _pwdelpw.p
    
    Purpose:    Delete Procedure Window widget, its menubar, and all
                frames.

    Syntax :    RUN adecomm/_pwdelpw.p (INPUT p_Window ).

    Parameters:
    Description:
    Notes  :
    Authors: John Palazzo
    Date   : January, 1994
    Updated: August, 1995
             Jep - Delete editor widget's dynamically created popup menu.
**************************************************************************/

DEFINE INPUT PARAMETER p_Window AS WIDGET-HANDLE NO-UNDO.

DEFINE VARIABLE h        AS WIDGET  NO-UNDO.
DEFINE VARIABLE h_next   AS WIDGET  NO-UNDO.
DEFINE VARIABLE h_Editor AS WIDGET  NO-UNDO.
DEFINE VARIABLE l_ok     AS LOGICAL NO-UNDO.

DO:
  ASSIGN p_Window:VISIBLE = FALSE.
  
  /* Delete the editor widget's dynamic popup menu. */
  RUN adecomm/_pwgeteh.p ( INPUT p_Window , OUTPUT h_Editor ).
  ASSIGN h = h_Editor:POPUP-MENU.
  IF VALID-HANDLE( h ) THEN DELETE WIDGET h.
  
  /* Delete contained frames. */
  h_next = p_Window:FIRST-CHILD.
  DO WHILE h_next <> ?:
    ASSIGN h = h_next 
           h_next = h_next:NEXT-SIBLING.
    DELETE WIDGET h.
  END.
  
  /* Delete the window's menubar. */
  ASSIGN h = p_Window:MENUBAR.
  IF VALID-HANDLE( h ) THEN DELETE WIDGET h.
  
  /* Delete the window. */
  DELETE WIDGET p_Window.
  
END.
/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/**************************************************************************
    Procedure:  _pwedit.p
    
    Purpose:    Execute Procedure Window Edit menu commands and handle
                various other events, like TAB, BACK-TAB, and END-ERROR
                when they occur in the editor widget.

    Syntax :    RUN adecomm/_pwedit.p ( INPUT p_Action ) .

    Parameters:
    Description:
    Notes  :
    Authors: John Palazzo
    Date   : January, 1994
**************************************************************************/

/* ADE Standards Include */
{ adecomm/adestds.i }
IF NOT initialized_adestds THEN RUN adecomm/_adeload.p.

/* Procedure Window Global Defines include. */
{ adecomm/_pwglob.i }

/* Procedure Window Attributes include. */
{ adecomm/_pwattr.i }

/* Edit defines and procedures. */
{ adecomm/dedit.i }
{ adecomm/pedit.i }       

DEFINE INPUT PARAMETER p_Action AS CHARACTER NO-UNDO.

DEFINE VARIABLE pw_Window       AS WIDGET-HANDLE NO-UNDO.
DEFINE VARIABLE pw_Editor       AS WIDGET-HANDLE NO-UNDO.
DEFINE VARIABLE hAttr_Field     AS WIDGET-HANDLE NO-UNDO.
DEFINE VARIABLE l_ok            AS LOGICAL       NO-UNDO.
DEFINE VARIABLE h_cwin          AS WIDGET-HANDLE NO-UNDO.
DEFINE VARIABLE Private_Data    AS CHARACTER     NO-UNDO.


/* MAIN */
DO:
  REPEAT ON STOP UNDO, RETRY:
    IF RETRY THEN LEAVE.
    /* Get widget handles of Procedure Window and its editor widget. */
    RUN adecomm/_pwgetwh.p ( INPUT SELF , OUTPUT pw_Window ).
    RUN adecomm/_pwgeteh.p ( INPUT pw_Window , OUTPUT pw_Editor ).

    /* Save current-window handle to restore later. */
    ASSIGN h_cwin         = CURRENT-WINDOW
           CURRENT-WINDOW = pw_Window.
    
    CASE p_Action:
    
        WHEN "UNDO"   THEN RUN EditUndo  ( pw_Editor ).

        WHEN "CUT"    THEN RUN EditCut   ( pw_Editor ).
        
        WHEN "COPY"   THEN RUN EditCopy  ( pw_Editor ).
        
        WHEN "PASTE"  THEN RUN EditPaste ( pw_Editor ).
        
        WHEN "INSERT-FILE" THEN RUN InsertFile ( INPUT pw_Editor ).
        
        WHEN "INSERT-FIELDS" THEN DO:
            ASSIGN Private_Data = pw_Editor:PRIVATE-DATA.
            
            /* Get the persistent Insert Field values. */
            ASSIGN ED_Schema_Prefix =
                INTEGER( ENTRY( {&PW_Schema_Prefix_Pos} ,
                                Private_Data ) ) .
            
            RUN FieldSelector ( INPUT pw_Editor ).
            
            /* Put the persistent data back into ed:Private-Data. */
            ASSIGN ENTRY( {&PW_Schema_Prefix_Pos} , Private_Data )
                        = STRING( ED_Schema_Prefix )
                   pw_Editor:PRIVATE-DATA = Private_Data.
        END.
        
        WHEN "INDENT-SELECTION"   THEN RUN ApplyTab( pw_Editor , YES ).
        WHEN "UNINDENT-SELECTION" THEN RUN ApplyBackTab( pw_Editor , YES ).

        WHEN "COMMENT-SELECTION" THEN RUN CommentSelection (pw_Editor, YES).

        WHEN "UNCOMMENT-SELECTION" THEN RUN CommentSelection (pw_Editor, NO).

        WHEN "TAB"      THEN RUN ApplyTab( pw_Editor , YES ).
        
        WHEN "BACK-TAB" THEN RUN ApplyBackTab( pw_Editor , YES ).

        WHEN "END-ERROR" THEN RETURN ERROR.

    END CASE.
    LEAVE.
  END. /* REPEAT */                                                   

  /* Repoint current-window. */
  IF VALID-HANDLE( h_cwin ) THEN ASSIGN CURRENT-WINDOW = h_cwin .
END. /* DO */
/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/**************************************************************************
    Procedure:  _pwemdrp.p
    
    Purpose:   On the MENU-DROP event for a Procedure Window Edit menu or
               Popup Menu, set the sensitive state of the menu items.

    Syntax :    RUN adecomm/_pwemdrp.p.

    Parameters:
    Description:
    Notes  :    This procedure dynamically walks the menu. As long
                as the labels match what's defined in adecomm/_pwmbar.p,
                this routine should be order independent.
                
    Authors: John Palazzo
    Date   : July, 1995
**************************************************************************/
  
DEFINE VARIABLE Sub_Menu_Label   AS CHARACTER NO-UNDO.
DEFINE VARIABLE h_Menu_Item      AS WIDGET    NO-UNDO.
DEFINE VARIABLE pw_Window        AS WIDGET    NO-UNDO.
DEFINE VARIABLE pw_Editor        AS WIDGET    NO-UNDO.
DEFINE VARIABLE Read_Only        AS LOGICAL   NO-UNDO.
DEFINE VARIABLE Text_Is_Selected AS LOGICAL   NO-UNDO.

&IF "{&WINDOW-SYSTEM}" BEGINS "MS-WIN" &THEN  
DO ON STOP UNDO, LEAVE:
    /* Get widget handles of Procedure Window and its editor widget. */
    RUN adecomm/_pwgetwh.p ( INPUT SELF , OUTPUT pw_Window ).
    RUN adecomm/_pwgeteh.p ( INPUT pw_Window , OUTPUT pw_Editor ).
  
    IF NOT CAN-DO("SUB-MENU,MENU" , SELF:TYPE) THEN
    DO:
        MESSAGE "Menu Drop procedure" PROGRAM-NAME(1) "executed from" SKIP
                "widget of type" SELF:TYPE "- must be MENU or SUB-MENU type."
            VIEW-AS ALERT-BOX ERROR.
        RETURN.
    END.
    
    ASSIGN
        Read_Only        = pw_Editor:READ-ONLY
        Text_Is_Selected = pw_Editor:TEXT-SELECTED
        h_Menu_Item      = SELF:FIRST-CHILD
        . /* END ASSIGN. */
        
    DO WHILE VALID-HANDLE(h_Menu_Item):
      IF h_Menu_Item:LABEL <> ? THEN
      DO:
        CASE REPLACE(h_Menu_Item:LABEL, "&", ""):
        
            WHEN "Check Syntax" OR
            WHEN "Insert" OR
            WHEN "Insert File..." OR
            WHEN "Insert Fields..." THEN
                ASSIGN h_Menu_Item:SENSITIVE = /* TRUE IF...*/
                        ( NOT Read_Only ).
            
            WHEN "Format Selection" THEN
                ASSIGN h_Menu_Item:SENSITIVE = /* TRUE IF... */
                        ( Text_Is_Selected ) AND ( NOT Read_Only ).

            WHEN "Undo" THEN
                ASSIGN h_Menu_Item:SENSITIVE = /* TRUE IF... */
                        ( pw_Editor:EDIT-CAN-UNDO ) AND ( pw_Editor:MODIFIED ).

            WHEN "Cut" THEN
                ASSIGN h_Menu_Item:SENSITIVE = /* TRUE IF... */
                        ( Text_Is_Selected  ) AND ( NOT Read_Only ).

            WHEN "Copy" THEN
                ASSIGN h_Menu_Item:SENSITIVE = /* TRUE IF... */
                        ( Text_Is_Selected  ).
                            
            WHEN "Paste" THEN
                ASSIGN h_Menu_Item:SENSITIVE = /* TRUE IF... */
                        ( pw_Editor:EDIT-CAN-PASTE ) AND ( NOT Read_Only ).
        END CASE.
        
      END.
      ASSIGN h_Menu_Item = h_Menu_Item:NEXT-SIBLING.
    END. /* DO WHILE */
END. /* DO ON STOP */
&ENDIF
 
RETURN.
/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/**************************************************************************
    Procedure:  _pwexit.p
    
    Purpose:    Attempt to close all open Procedure Windows for a specified
                Parent.
    
    Syntax :    RUN adecomm/_pwexit.p ( INPUT  p_Parent_ID ,
                                        OUTPUT p_OK_Close ).

    Parameters:
        INPUT
        p_Parent_ID
            - String value indicating "Parent" of Procedure Window.
              Pass Null ("") if no parent. The p_Parent_ID parameter should be
              the name of the calling tool.  When the tool exits, it calls
              adecomm/_pwexit.p and passes p_Parent_ID again. This procedure
              uses p_Parent_ID to determine which Procedure Windows to close.

              Its best to pass the application's or tool's startup procedure
              name. This allows adecomm/_pwexit.p to determine if the caller
              is the startup routine. If it is, then all PW's are closed,
              not just those owned by the caller. This takes care of those
              PW's created by PRO*Tools.

        OUTPUT
        p_OK_Close  
            - If all PW's of the Parent are closed successfully, p_OK_Close is
              returned as TRUE. Otherwise, its returned as FALSE or Unknown.
                 
    Description:
    
          1. Search all the windows in the current session looking for
             Procedure Windows belonging to the Parent specified by
             p_Parent_Id. 
             
          2. Tell the PW to close. If all PW's of the Parent are closed
             successfully, p_OK_Close is returned as TRUE. Otherwise, its
             returned as FALSE or Unknown.
    
    Notes  :
    Authors: John Palazzo
    Date   : January, 1994
**************************************************************************/

/* Procedure Window Global Defines. */
{ adecomm/_pwglob.i }

DEFINE INPUT  PARAMETER p_Parent_ID AS CHARACTER NO-UNDO.
DEFINE OUTPUT PARAMETER p_OK_Close  AS LOGICAL   NO-UNDO INIT TRUE.

DEFINE VARIABLE pw_Window  AS WIDGET-HANDLE NO-UNDO.
DEFINE VARIABLE pw_Editor  AS WIDGET-HANDLE NO-UNDO.
DEFINE VARIABLE Del_Window AS WIDGET-HANDLE NO-UNDO.
DEFINE VARIABLE Modified   AS LOGICAL       NO-UNDO.
DEFINE VARIABLE Pro_Quit   AS LOGICAL       NO-UNDO.
DEFINE VARIABLE Start_Proc AS CHARACTER     NO-UNDO.

/* --- Begin SCM changes --- */
DEFINE VAR scm_ok       AS LOGICAL           NO-UNDO.
DEFINE VAR scm_context  AS CHARACTER         NO-UNDO.
DEFINE VAR scm_filename AS CHARACTER         NO-UNDO.
/* --- End SCM changes ----- */

/* Internal Procedure Include. */
{ adecomm/pruntool.i }

REPEAT ON STOP UNDO, RETRY:
    IF RETRY
    THEN DO:
        ASSIGN p_OK_Close = FALSE.
        RETURN ERROR.
    END.
    
    /* Start with the session's first window. */
    ASSIGN pw_Window   = SESSION:FIRST-CHILD
           p_Parent_ID = ( IF p_Parent_ID = ? THEN "?" ELSE p_Parent_ID )
           .
           
    IF p_Parent_ID <> "" AND p_Parent_ID <> ? THEN
    DO:
        /* Check if the parent is the startup procedure. If so, user
           is exiting Progress. Set Pro_Quit so all PW will be deleted.
        */
        RUN RunBy (INPUT ? , OUTPUT Start_Proc).
        ASSIGN Pro_Quit = (p_Parent_ID = Start_Proc).
    END.
    
    DO WHILE VALID-HANDLE( pw_Window ):
        /* Is this a Procedure Window and is it a "child window" of the
           Parent window passed?
        */
        IF pw_Window:NAME = {&PW_NAME}
           AND (pw_WINDOW:PRIVATE-DATA = p_Parent_ID OR Pro_Quit)
        THEN DO:                                                           
            /* Get widget handle of Procedure Window editor widget. */
            RUN adecomm/_pwgeteh.p ( INPUT pw_Window , OUTPUT pw_Editor ).
            RUN adecomm/_pwfmod.p ( INPUT pw_Editor , OUTPUT Modified ).
           
            /* --- Begin SCM changes --- */
            ASSIGN scm_context  = STRING( pw_Editor )
                   scm_filename = pw_Editor:NAME .
            RUN adecomm/_adeevnt.p
                (INPUT  {&PW_NAME} , INPUT "Before-Close",
                 INPUT scm_context , INPUT scm_filename ,
                 OUTPUT scm_ok ).
            IF scm_ok = FALSE THEN
            DO:
                ASSIGN p_OK_Close = FALSE.  /* Cancel */
                RETURN.
            END.
            /* --- End SCM changes ----- */
            
            IF ( Modified = TRUE )
            THEN DO:
            
                RUN adecomm/_pwclosf.p ( INPUT pw_Window, INPUT pw_Editor ,
                                       INPUT "Exit", OUTPUT p_OK_Close ).
                /*
                ** Next two statements by changed by R. Ryan to allow cancel
                ** to process seperately from pressing NO.
                */
                IF p_OK_Close = FALSE THEN RETURN ERROR.
                IF p_OK_Close = ? THEN LEAVE.
            END.

            /* --- Begin SCM changes --- */
            RUN adecomm/_adeevnt.p
                (INPUT  {&PW_NAME} , INPUT "Close",
                 INPUT scm_context , INPUT scm_filename ,
                 OUTPUT scm_ok ).
            /* --- End SCM changes ----- */
 
            /* --- Begin SCM changes --- */
            /* Do custom shutdown -- this is generally a no-op, but it can
               be used to cleanup custom modifications. */
            RUN adecomm/_adeevnt.p 
                ( INPUT {&PW_NAME} ,
                  INPUT "SHUTDOWN",
                  INPUT STRING(pw_Window) , STRING(pw_Window:PRIVATE-DATA) ,
                  OUTPUT scm_ok ).
            /* --- End SCM changes ----- */

            /* Now close/delete the window. */
            ASSIGN Del_Window = pw_Window
                   pw_Window  = pw_Window:NEXT-SIBLING.
            RUN adecomm/_pwdelpw.p (INPUT Del_Window ).
        END.
        ELSE ASSIGN pw_Window = pw_Window:NEXT-SIBLING.
    END.

    LEAVE.

END.
/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/**************************************************************************
    Procedure:  _pwfchg.p
    
    Purpose:    Executes File Changed Dialog, which asks user to save
		changes made to a modified file before continuing some
		operation.

    Syntax :    RUN adecomm/_pwfchg.p ( INPUT p_Editor , INPUT p_Title ,
                                      OUTPUT p_Save_Changes )

    Parameters:
	p_Save_Changes     YES - User wants changes.
	                   NO  - User does not want changes saved.
	                    ?  - User wants to Cancel the current operation.
    Description:
    Notes  :
    Authors: John Palazzo
    Date   : January, 1994
**************************************************************************/

DEFINE INPUT  PARAMETER p_Editor           AS WIDGET-HANDLE NO-UNDO.
DEFINE INPUT  PARAMETER p_Title            AS CHARACTER     NO-UNDO.
DEFINE OUTPUT PARAMETER p_Save_Changes     AS LOGICAL       NO-UNDO.

DEFINE VARIABLE pw_Window    AS WIDGET-HANDLE NO-UNDO.
DEFINE VARIABLE Buf_Modified AS LOGICAL       NO-UNDO.

DO:
  ASSIGN p_Save_Changes = ?. /* Default to Cancel. */
  RUN adecomm/_pwfmod.p ( INPUT p_Editor , OUTPUT Buf_Modified ).
  IF ( Buf_Modified = TRUE )
  THEN DO:
    /* Get widget handle of Procedure Window. */
    RUN adecomm/_pwgetwh.p ( INPUT p_Editor , OUTPUT pw_Window ).
    /* Restore window if its minimized so user can see the code. */
    ASSIGN pw_Window:WINDOW-STATE = WINDOW-NORMAL
			                  WHEN pw_Window:WINDOW-STATE = WINDOW-MINIMIZED.
    p_Save_Changes = YES.
    MESSAGE p_Editor:NAME SKIP
            "Procedure file has changes which have not been saved." SKIP(1)
 	     "Save changes before closing?"
 	    VIEW-AS ALERT-BOX WARNING BUTTONS YES-NO-CANCEL 
  	            UPDATE p_Save_Changes
  	    IN WINDOW pw_Window. 
  END.
  ELSE
    p_Save_Changes = NO.  /* No changes, so skip the save. */
    
  RETURN.
  
END.
/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/**************************************************************************
    Procedure:  _pwfile.p
    
    Purpose:    Execute Procedure Window File menu commands.

    Syntax :    RUN adecomm/_pwfile.p ( INPUT p_Action ) .

    Parameters:
    Description:
    Notes  :    Added "ADD-REPOS" feature to support IZ 2513 Error when
                trying to save structured include in Dynamics framework.

    Authors: John Palazzo
    Date   : January, 1994
**************************************************************************/

/* Procedure Window Global Defines include. */
{ adecomm/_pwglob.i }

/* Procedure Window Attributes include. */
{ adecomm/_pwattr.i }

DEFINE INPUT PARAMETER p_Action AS CHARACTER NO-UNDO.

DEFINE VARIABLE pw_Window       AS WIDGET-HANDLE NO-UNDO.
DEFINE VARIABLE pw_Editor       AS WIDGET-HANDLE NO-UNDO.
DEFINE VARIABLE h_cwin          AS WIDGET-HANDLE NO-UNDO.

/* MAIN */
DO:
  REPEAT ON STOP UNDO, RETRY:
    IF RETRY THEN LEAVE.
    /* Get widget handles of Procedure Window and its editor widget. */
    RUN adecomm/_pwgetwh.p ( INPUT SELF , OUTPUT pw_Window ).
    RUN adecomm/_pwgeteh.p ( INPUT pw_Window , OUTPUT pw_Editor ).

    /* Save current-window handle to restore later. */
    ASSIGN h_cwin         = CURRENT-WINDOW
           CURRENT-WINDOW = pw_Window.
    
    CASE p_Action:
    
        WHEN "NEW"      THEN RUN adecomm/_pwnew.p.
        
        WHEN "OPEN"     THEN RUN adecomm/_pwopen.p.

        WHEN "NEW-PWIN" THEN RUN adecomm/_pwnewpw.p ( INPUT pw_Window ).

        WHEN "ADD-REPOS" THEN RUN adecomm/_pwaddfile.p (INPUT pw_Editor).

        WHEN "SAVE"     THEN RUN adecomm/_pwsave.p (INPUT pw_Editor).
        
        WHEN "SAVE-AS"  THEN RUN adecomm/_pwsavas.p (INPUT pw_Editor).
        
        WHEN "PRINT"    THEN RUN adecomm/_pwprint.p.
        
        WHEN "CLOSE"    THEN RUN adecomm/_pwclose.p.
        
    END CASE.
    LEAVE.
  END. /* REPEAT */                                                   

  /* Repoint current-window. */
  IF VALID-HANDLE( h_cwin ) THEN ASSIGN CURRENT-WINDOW = h_cwin .
END. /* DO */
/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/**************************************************************************
    Procedure:  _pwfmod.p
    
    Purpose:    Returns TRUE if editor is a modified; FALSE if not.

    Syntax :    RUN adecomm/_pwfmod.p ( INPUT p_Editor , INPUT p_Title ,
                                      OUTPUT p_Modified ) .

    Parameters:
    Description:
    Notes  :
    Authors: John Palazzo
    Date   : January, 1994
**************************************************************************/

/* Procedure Window Global Defines. */
{ adecomm/_pwglob.i }

DEFINE INPUT  PARAMETER p_Editor   AS WIDGET-HANDLE      NO-UNDO.
DEFINE OUTPUT PARAMETER p_Modified AS LOGICAL INIT FALSE NO-UNDO.
    
DO:
    /* WebSpeed Report/Detail case where the Procedure Window is the 
       visualization of the Report/Detail Wizards output. The file has not
       been modified per se, yet it is still untitled and not empty. */
    IF ( p_Editor:MODIFIED = NO AND NOT p_Editor:EMPTY AND
         p_Editor:NAME BEGINS {&PW_Untitled})
    THEN p_Modified = TRUE.
    ELSE IF 
       ( p_Editor:MODIFIED = NO ) OR 
       ( p_Editor:NAME BEGINS {&PW_Untitled} AND
         p_Editor:EMPTY ) 
    THEN p_Modified = FALSE.
    ELSE p_Modified = TRUE.

END.
/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/**************************************************************************
    Procedure :  _pwgeteh.p
    
    Purpose   : Returns the handle for any Procedure Window editor widget.
                
    Syntax    : RUN adecomm/_pwgeteh.p ( INPUT p_Window , OUTPUT p_Editor ).
    
    Parmameters :
    Description:
    Notes     : If the widget is an invalid widget or a pseudo-widget,
                routine returns Unknown (?) for p_Editor.
                                
    Authors   : J. Palazzo
**************************************************************************/
              
DEFINE INPUT  PARAMETER p_Window AS WIDGET-HANDLE NO-UNDO.
    /* Handle of editor widget's Procedure window. */
DEFINE OUTPUT PARAMETER p_Editor AS WIDGET-HANDLE NO-UNDO.
    /* Handle of Procedure Window editor widget. */

DEFINE VARIABLE hWidget AS WIDGET-HANDLE NO-UNDO.

DO:
    ASSIGN p_Editor = ?.
    /* Find the Procedure Window frame and editor widget. */
    IF p_Window:TYPE = "WINDOW"
    THEN DO:
        ASSIGN hWidget = p_Window
               hWidget = hWidget:FIRST-CHILD.  /* Editor Frame */
        IF VALID-HANDLE( hWidget ) 
        THEN ASSIGN hWidget  = hWidget:FIRST-CHILD  /*Field group. */
                    p_Editor = hWidget:FIRST-CHILD. /* The editor. */
    END.
END.
/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/**************************************************************************
    Procedure :  _pwgetfh.p
    
    Purpose   : Returns the handle of the Procedure Window Editor Frame
                given a Procedure Window handle.                
    
    Syntax    : RUN adecomm/_pwgetfh.p ( INPUT p_Window , OUTPUT p_Frame ).

    
    Parmameters :
    Description:
    Notes     : If the widget is an invalid widget or a pseudo-widget,
                routine returns Unknown (?) for p_Editor.
                                
    Authors   : J. Palazzo
**************************************************************************/
              
DEFINE INPUT  PARAMETER p_Window       AS WIDGET-HANDLE NO-UNDO.
    /* Handle of Editor Frame's Procedure window. */
DEFINE OUTPUT PARAMETER p_Frame AS WIDGET-HANDLE NO-UNDO.
    /* Handle of Procedure Window Editor Frame widget. */

DO:
    ASSIGN p_Frame = ?.
    /* PW's first child is Editor Frame. */
    IF p_Window:TYPE = "WINDOW" THEN ASSIGN p_Frame = p_Window:FIRST-CHILD.
    
END.
/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/**************************************************************************
    Procedure:  _pwgetun.p
    
    Purpose:    Returns a Procedure Window Untitled procedure name.
    
    Syntax :    RUN adecomm/_pwgetun.p ( OUTPUT p_Untitled_Name ).

    Parameters:
    Description:
        An Untitled Procedure Window has a procedure name of the form
            "Untitled:n"
        where n is some number from 1 to 9999.
        
        The untitled name algorithm:
        
          1. Search all the windows in the current session looking for
             Untitled Procedure Windows, regardless of how a Procedure
             Window was created.
             
          2. Return the maximum Untitled procedure number plus one as
             the next Untitled procedure number.
             
             For example, if there are two open Untitled PW's, Untitled:1
             and Untitled:5, the name of the next Untitled PW will be
             Untitled:6.
    
    Notes  :
    Authors: John Palazzo
    Date   : January, 1994
**************************************************************************/

/* Procedure Window Global Defines. */
{ adecomm/_pwglob.i }

DEFINE OUTPUT PARAMETER p_Untitled_Name AS CHARACTER NO-UNDO.

DEFINE VARIABLE pw_Window AS HANDLE   NO-UNDO.
DEFINE VARIABLE pw_Editor AS HANDLE   NO-UNDO.
DEFINE VARIABLE l_count   AS INTEGER  NO-UNDO.

DO:
  /* Start with the session's first window. */
  /* ksu 94/02/24 SUBSTRING use default mode */
  ASSIGN pw_Window = SESSION:FIRST-CHILD.
  DO WHILE VALID-HANDLE( pw_Window ):
    /* Is this a Procedure Window? Check :NAME to verify that it is. */
    IF pw_Window:NAME = {&PW_NAME} THEN DO:                                     
      /* Get the PW's editor handle. */
      RUN adecomm/_pwgeteh.p (pw_Window,OUTPUT pw_Editor ).

      IF pw_Editor:NAME BEGINS {&PW_Untitled} THEN
        ASSIGN l_count = MAXIMUM(l_count,
          INTEGER(SUBSTRING(pw_Editor:NAME,
            R-INDEX(pw_Editor:NAME,":":u) + 1,-1,"CHARACTER":u))).
    END.
    ASSIGN pw_Window = pw_Window:NEXT-SIBLING.
  END.
  ASSIGN l_count = l_count + 1
         p_Untitled_Name = {&PW_Untitled} + TRIM(STRING(l_Count,">>>9":u)).
END.

/* _pwgetun.p - end of file */

/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/**************************************************************************
    Procedure :  _pwgetwh.p
    
    Purpose   : Returns the Window handle for any widget.
                
    Syntax    : RUN adecomm/_pwgetwh.p ( INPUT p_Widget , OUTPUT p_Window ).
    
    Parmameters :
    Description:
    Notes     : If the widget is an invalid widget or a pseudo-widget,
                routine returns Unknown (?) for p_Window.
                                
    Authors   : J. Palazzo
**************************************************************************/
              
DEFINE INPUT  PARAMETER p_Widget AS WIDGET-HANDLE NO-UNDO.
    /* Handle of widget whose window handle you want. */
DEFINE OUTPUT PARAMETER p_Window AS WIDGET-HANDLE NO-UNDO.
    /* Handle of widget's window. */

DO:
    ASSIGN p_Window = ? .
    
    /* Handle exceptions... */
    IF NOT VALID-HANDLE( p_Widget ) OR ( p_Widget:TYPE = "PSEUDO-WIDGET" )
    THEN RETURN.
    
    /* Take care of menus, submenus, and menu items. */
    IF CAN-QUERY( p_Widget , "WINDOW" )
    THEN DO:
        ASSIGN p_Window = p_Widget:WINDOW .
        RETURN.
    END.
    
    CASE p_Widget:TYPE :
    
        WHEN "WINDOW"
            THEN ASSIGN p_Window = p_Widget.
            
        WHEN "FRAME"
            THEN ASSIGN p_Window = p_Widget:PARENT.
            
        WHEN "FIELD-GROUP"
            THEN DO:
                ASSIGN p_Window = p_Widget:PARENT   /* Frame  */
                       p_Window = p_Window:PARENT   /* Window */
                       NO-ERROR .
            END.
            
        OTHERWISE /* Field-level */
            DO:
                ASSIGN p_Window = p_Widget:FRAME
                       p_Window = p_Window:PARENT
                       NO-ERROR .
            END.
    END CASE.
    
END. /* */

/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/**************************************************************************
    Procedure:  _pwglob.i
    
    Purpose:    Global Defines for Procedure Windows.

    Syntax :    { adecomm/_pwglob.i }

    Parameters:
    Description:
    Notes  :
    Authors: John Palazzo
    Date   : January, 1994
**************************************************************************/

/* Procedure Window constants and defaults. */
&GLOBAL-DEFINE  PW_Name         "Procedure Window"
&GLOBAL-DEFINE  PW_Pool         "_ADE_Procedure_Window":U
&GLOBAL-DEFINE  PW_Title_Leader "Procedure - "
&GLOBAL-DEFINE  PW_Untitled     "Untitled:"
/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/**************************************************************************
    Procedure:  _pwhelp.p
    
    Purpose:    Execute Procedure Window Help menu commands.

    Syntax :    RUN adecomm/_pwhelp.p ( INPUT p_Action ) .

    Parameters:
    Description:
    Notes  :
    Authors: John Palazzo
    Date   : January, 1994
**************************************************************************/

/* Procedure Window Global Defines include. */
{ adecomm/_pwglob.i }

/* Procedure Window Attributes include. */
{ adecomm/_pwattr.i }

/* Help Related Defines for Procedure Windows. */
{ adecomm/commeng.i }


DEFINE INPUT PARAMETER p_Action AS CHARACTER NO-UNDO.

DEFINE VARIABLE pw_Window       AS WIDGET-HANDLE NO-UNDO.
DEFINE VARIABLE pw_Editor       AS WIDGET-HANDLE NO-UNDO.
DEFINE VARIABLE h_cwin          AS WIDGET-HANDLE NO-UNDO.

/* MAIN */
DO:
  REPEAT ON STOP UNDO, RETRY:
    IF RETRY THEN LEAVE.
    /* Get widget handle of Procedure Window. */
    RUN adecomm/_pwgetwh.p ( INPUT SELF , OUTPUT pw_Window ).
    /* Get widget handle of Procedure Window editor widget. */
    RUN adecomm/_pwgeteh.p ( INPUT pw_Window , OUTPUT pw_Editor ).

    /* Save current-window handle to restore later. */
    ASSIGN h_cwin         = CURRENT-WINDOW
           CURRENT-WINDOW = pw_Window.
    
    CASE p_Action:

        WHEN "KEYWORD"  THEN
            RUN adecomm/_kwhelp.p ( INPUT pw_Editor , 
                                    INPUT "comm"    , 
                                    INPUT 0 /* Zero is Help Topics */  ).
        WHEN "KEYWORD-HELP"  THEN
            RUN adecomm/_kwhelp.p ( INPUT pw_Editor , 
                                    INPUT "comm"    , 
                                    INPUT ? ).
        WHEN "TOPICS" THEN
            RUN adecomm/_adehelp.p 
                ( INPUT "comm" , INPUT "TOPICS" ,
                  INPUT {&Procedure_Window_Contents} , INPUT ? ).    

        WHEN "MASTER" THEN
            RUN adecomm/_adehelp.p 
                ( INPUT "mast" , INPUT "TOPICS" ,
                  INPUT ? , INPUT ? ).    

        WHEN "CONTENTS" THEN
            RUN adecomm/_adehelp.p 
                ( INPUT "comm" , INPUT "CONTEXT" ,
                  INPUT {&Procedure_Window_Contents} , INPUT ? ).    

        WHEN "MESSAGES" THEN
            RUN prohelp/_msgs.p.

        WHEN "RECENT-MESSAGES" THEN
            RUN prohelp/_rcntmsg.p.

        OTHERWISE
            MESSAGE PROGRAM-NAME(1) "received invalid action:" p_Action "."
                VIEW-AS ALERT-BOX ERROR.

    END CASE.
    LEAVE.
  END. /* REPEAT */                                                   

  /* Repoint current-window. */
  IF VALID-HANDLE( h_cwin ) THEN ASSIGN CURRENT-WINDOW = h_cwin .
END. /* DO */
/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/*****************************************************************************

Procedure: _pwin.p

Syntax:
        RUN _pwin.p.

Purpose:          
    Start-up procedure which runs Procedure Window sub-procedure module.

Description:
    - Passes the os files to open based on SESSION:PARAMETER.
    
Parameters: NONE.

Author: John Palazzo

Date Created: January, 1994

*****************************************************************************/

DEFINE VARIABLE File_List    AS CHARACTER     NO-UNDO.
  /* Files editor should open automatically on start-up. */

/* ADE Standards Include. */
{ adecomm/adestds.i }

/* This is done only once at startup of the ade.  This code runs and
   loads up the colors and fonts.
*/
IF NOT initialized_adestds THEN
    run adecomm/_adeload.p.

/* If started from OS (i.e., this is the -p startup procedure), use the
   value of SESSION:PARAMETER as the list of files to open.
*/
IF PROGRAM-NAME(2)   =  ?  AND
   SESSION:PARAMETER <> ?  AND 
   SESSION:PARAMETER <> "" THEN
    File_List = SESSION:PARAMETER.

STOP_BLOCK:
DO ON STOP UNDO STOP_BLOCK, RETRY STOP_BLOCK 
   ON ENDKEY UNDO STOP_BLOCK, RETRY STOP_BLOCK 
   ON ERROR UNDO STOP_BLOCK, RETRY STOP_BLOCK :
     IF NOT RETRY THEN DO:
       RUN adecomm/_setcurs.p ("WAIT").
       /*---------------------------------------------------------------------
          Run Procedure window sub-procedure with list of files to open for
          editing.
       ---------------------------------------------------------------------*/
       RUN adecomm/_pwmain.p (INPUT ""        /* PW Parent ID   */ ,
                            INPUT File_List /* Files to open  */ ,
                            INPUT ""        /* PW Command     */ ).
     END.
     
     /* Restore the cursor */
     RUN adecomm/_setcurs.p ("").
     /* Give user chance to read any start-up errors. */
     IF RETRY THEN PAUSE. 
END.  /* STOP_BLOCK */
 
IF PROGRAM-NAME(2) = ? THEN 
    QUIT.
ELSE 
    RETURN.
/*********************************************************************
* Copyright (C) 2005 by Progress Software Corporation. All rights    *
* reserved.  Prior versions of this work may contain portions        *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/******************************************************************************

Procedure: _pwmain.p

Syntax   :
       RUN adecomm/_pwmain.p (INPUT p_Parent_ID    /* PW Parent ID  */ ,
                              INPUT File_List      /* Files to open */ ,
                              INPUT p_Edit_Command /* PW Command    */ ).

Purpose  :          
    Open one or more PROGRESS Procedure Windows to edit procedure or
    include files or to open an Untitled procedure in a Procedure Window.

Description:
    This PROGRESS procedure is the main program for creating Procedure Windows.
    
    You use Procedure Windows to open, view, edit, create, and save PROGRESS
    procedure (.p) and include (.i) files.  You can open as many Procedure
    Windows as you want, so you can easily edit and view any number of
    procedure (.p or .i) files and copy and paste between them.  You can edit
    only one procedure file at a time in a Procedure Window. 

    This procedure can be called as often as desired and each call will
    open a Procedure Window, or multiple Procedure Windows if a File List
    to open is passed.
    
    There is no WAIT-FOR or other blocking statement in this program.
       
Parameters:
    INPUT p_Parent_ID  (CHARACTER)
        - String value indicating "Parent" of Procedure Window.
          Pass Null ("") if no parent. The p_Parent_ID parameter should be
          the name of the calling tool.  When the tool exits, it calls
          adecomm/_pwexit.p and passes p_Parent_ID again. This procedure
          uses p_Parent_ID to determine which Procedure Windows to close.

          Its best to pass the application's or tool's startup procedure
          name. This allows adecomm/_pwexit.p to determine if the caller
          is the startup routine. If it is, then all PW's are closed,
          not just those owned by the caller. This takes care of those
          PW's created by PRO*Tools.

    INPUT p_FileList   (CHAR)
        - Comma-delimited list of OS files - each of which will be opened
          in its own Procedure Window.  Pass Null ("") to open one
          Procedure Window with an Untitled procedure.
        
        - If NULL (""), sets current buffer to (Untitled).
        
        - If a file cannot be found, a warning message is given in
          an alert box.
          
        - If the file to be opened exists on a remote WebSpeed agent, the OS
          file name will contain three CHR(3)-delimited parts; file name, 
          local temp file name, and Broker URL to use to save the file.

    INPUT p_Edit_Command
        - Either "" for no special processing or
                 "UNTITLED" to force a template file to be opened Untitled.

Notes :

Author: John Palazzo, Wm.T.Wood

Created : January, 1994
Modified: 06/09/98 adams added support for 9.0A remote file managment

*****************************************************************************/

/*-----------------------------  DEFINE VARS  -------------------------------*/
{adecomm/oeideservice.i}

/* ADE Standards Include. */
{ adecomm/adestds.i }
IF NOT initialized_adestds
THEN RUN adecomm/_adeload.p.

/* Procedure Window application-global contstants. */
{ adecomm/_pwglob.i }
{ adecomm/_adetool.i } /* Add ADEPersistent IP stub to prevent editor from being
                        * destroyed by the UIB and Procedure Editor */

/*--------------------------------------------------------------------------
                       System-Wide Defines for Editor 
--------------------------------------------------------------------------*/
DEFINE INPUT PARAMETER p_Parent_ID    AS CHARACTER NO-UNDO.
DEFINE INPUT PARAMETER p_File_List    AS CHARACTER NO-UNDO.
  /* Files editor should open automatically on start-up. */
DEFINE INPUT PARAMETER p_Edit_Command AS CHARACTER NO-UNDO.
  /* If "UNTITLED" then open untitled    */

/* Define various handles needed to reference the ...  */
DEFINE VARIABLE h_win        AS WIDGET    NO-UNDO. /*... The tinyedit window  */
DEFINE VARIABLE h_frame      AS WIDGET    NO-UNDO. /*... Frame in the  window */
DEFINE VARIABLE h_ed         AS WIDGET    NO-UNDO. /*... the editor itself    */
DEFINE VARIABLE h_menu       AS WIDGET    NO-UNDO. /*... Menu-bar             */
DEFINE VARIABLE h            AS WIDGET    NO-UNDO. /*... generic handle       */

DEFINE VARIABLE Broker_URL   AS CHARACTER NO-UNDO.
DEFINE VARIABLE Private_Data AS CHARACTER NO-UNDO. /* File name in PW.        */
DEFINE VARIABLE Proc_Name    AS CHARACTER NO-UNDO. /* File name in PW.        */
DEFINE VARIABLE PW_Opened    AS LOGICAL   NO-UNDO. /* Did at least one PW open? */
DEFINE VARIABLE Read_OK      AS LOGICAL   NO-UNDO.
DEFINE VARIABLE Temp_File    AS CHARACTER NO-UNDO.
DEFINE VARIABLE Temp_Name    AS CHARACTER NO-UNDO.
DEFINE VARIABLE List_Item    AS INTEGER   NO-UNDO.
DEFINE VARIABLE Web_File     AS LOGICAL   NO-UNDO.
DEFINE VARIABLE RelPath      AS CHARACTER NO-UNDO INIT ?.


/* --- Begin SCM changes --- */
DEFINE VARIABLE scm_ok       AS LOGICAL   NO-UNDO.
DEFINE VARIABLE scm_event    AS CHARACTER NO-UNDO.
DEFINE VARIABLE scm_file     AS CHARACTER NO-UNDO.
/* --- End SCM changes ----- */

/* proc-main */
DO ON STOP UNDO, LEAVE:

  /** ******
   ** Step 0: Initialize Procedure Window stuff.
   ** ******
   **/
  /* Create persistent widget pool for all Procedure Windows. 
     The ASSIGN NO-ERROR clears the ERROR-STATUS handle.
  */
  CREATE WIDGET-POOL {&PW_Pool} PERSISTENT NO-ERROR.
  ASSIGN NO-ERROR.
  
  DO List_Item = 1 TO MAX( 1 , NUM-ENTRIES( p_File_List ) ) :
    /* If File List is empty, get an Untitled procedure name. Otherwise,
       process the file list.
    */
    IF OEIDEIsRunning AND p_Edit_Command = "UNTITLED":U AND NUM-ENTRIES(p_File_List) > 0 THEN
    DO:
        /* Open file in IDE Editor */
        openTextEditor(getProjectName(), p_File_List).
        PW_Opened = TRUE.
        
          /* --- Begin SCM changes --- */
          /* Do custom setup -- this is generally a no-op, but it can
             be used to initialize custom modifications. */
          RUN adecomm/_adeevnt.p (INPUT  {&PW_NAME},
                                  INPUT  "STARTUP", 
                                  INPUT  ?, 
                                  INPUT  ?,
                                  OUTPUT scm_ok ).
                  
          ASSIGN scm_event = "NEW"
                 scm_file  = ? .
                     
          RUN adecomm/_adeevnt.p (INPUT  {&PW_NAME},
                                  INPUT  scm_event, 
                                  INPUT  ?, 
                                  INPUT  scm_file,
                                  OUTPUT scm_ok).
      
          /* --- End SCM changes ----- */
        
    END.
    ELSE DO:
        ASSIGN Web_File = FALSE.
        
        IF NUM-ENTRIES( p_File_List ) = 0 OR p_Edit_Command = "UNTITLED":U
          THEN RUN adecomm/_pwgetun.p ( OUTPUT Proc_Name ).
        ELSE DO:
          ASSIGN Proc_Name = ENTRY( List_Item , p_File_List ).
          IF NUM-ENTRIES(Proc_Name, CHR(3)) = 4 THEN
            ASSIGN Web_File   = TRUE
                   Temp_File  = ENTRY( 2, Proc_Name, CHR(3))
                   Broker_URL = ENTRY( 3, Proc_Name, CHR(3))
                   RelPath    = ENTRY( 4, Proc_Name, CHR(3))
                   Proc_Name  = ENTRY( 1, Proc_Name, CHR(3))
                   RelPath    = (IF RelPath = ? OR RelPath = "" THEN Proc_Name ELSE RelPath).
        END.
        
        /** ******
         ** Step 1: Create the MENU-BAR so we can add it to the window.
         ** ******
         **/
        RUN adecomm/_pwmbar.p ( INPUT NO /* p_Popup */,
                                INPUT IF p_Edit_Command MATCHES "*READ-ONLY*":U THEN "READ-ONLY":U
                                      ELSE "":U,
                                OUTPUT h_menu /* PW Menubar Handle */ ).
    
     
        /** ******
         ** Step 2: Create the Procedure Window (including frame and editor widget)
         ** ******  as well as the additional PW Attributes for persistent data. 
         **         This also attaches default triggers for WINDOW-CLOSE,
         **         WINDOW-RESIZE, and HELP.  Override them if you wish.
         **/
        RUN adecomm/_pwcreat.p ( INPUT  p_Parent_ID /* Parent ID   */ ,
                                 INPUT  {&PW_Name}  /* Window Name */ ,
                                 INPUT  {&PW_Title_Leader} + 
                                        (IF Web_File THEN RelPath ELSE Proc_Name) /* Title */ +
                                        (IF NOT Web_File THEN "" ELSE (CHR(3) + 
                                            Temp_File + CHR(3) + Broker_URL + CHR(3) +
                                            (IF RelPath NE Proc_Name THEN Proc_Name ELSE "")) ),
                                 INPUT  h_menu      /* Menubar     */ ,
                                 OUTPUT h_win       /* Window H    */ ).
        
        /* Get widget handles of Procedure Window and its editor widget. */
        RUN adecomm/_pwgeteh.p ( INPUT h_win , OUTPUT h_ed ).
        ASSIGN h_frame   = h_ed:FRAME.
        ASSIGN h_ed:NAME = (IF Web_File THEN RelPath ELSE Proc_Name).
        
        /* Load up cute icon file */
        IF h_win:LOAD-ICON("adeicon/editor") THEN.
        
        /* Attach popup menu. */
        RUN adecomm/_pwmbar.p ( INPUT  YES    /* p_Popup */,
                                INPUT  "":U,
                                OUTPUT h_menu /* PW Menubar Handle */ ).
        ASSIGN h_ed:POPUP-MENU = h_menu.
         
        /** ******
         ** Step 3: If the current Proc_Name is not Untitled, try to read the file.
         ** ******
         **/
        /* If p_Edit_Command is "UNTITLED" set Proc_Name to (and h_ed:NAME) to
         proper name */
        IF p_Edit_Command = "UNTITLED" AND 
          List_Item > 0 AND List_Item <= NUM-ENTRIES(p_File_List) 
        THEN DO:
          ASSIGN Temp_name = Proc_Name
                 Proc_Name = ENTRY( List_Item , p_File_List ).
          IF NUM-ENTRIES(Proc_Name, CHR(3)) = 3 THEN
            ASSIGN Temp_File  = ENTRY( 2, Proc_Name, CHR(3))
                   Broker_URL = ENTRY( 3, Proc_Name, CHR(3))
                   Proc_Name  = ENTRY( 1, Proc_Name, CHR(3)).
        END.
        
        /* If not Untitled, try to read specified file. */
        IF NOT h_ed:NAME BEGINS {&PW_Untitled} OR p_Edit_Command = "UNTITLED":U THEN
        DO ON STOP UNDO, LEAVE:
            /*  Try to read specified file into editor widget. If successful,
                pw_Editor:NAME and pw_Window:TITLE are updated to reflect file
                name read.  If not successful, delete the PW opened. 
            */
            RUN adecomm/_pwrdfl.p (INPUT  h_ed,
                                   INPUT  ((IF Web_File THEN RelPath ELSE Proc_Name) + 
                                          (IF NOT Web_File THEN ""
                                           ELSE CHR(3) + Temp_File + CHR(3) + 
                                               (IF RelPath NE Proc_Name THEN Proc_Name ELSE "") )),
                                   OUTPUT Read_OK).
            /* If read unsuccessful, delete the PW. */
            IF NOT Read_OK THEN 
              RUN adecomm/_pwdelpw.p ( INPUT h_win ).
            ELSE
              /* Running peditor.i here to set source type of the editor.
               * Rather than change the editor to handle .cls files like 
               * .p files, SetEdBufType now tells the editor to pretend 
               * a .cls is a .p.
               * After an editor reads or saves a file, internally it changes 
               * the source type based on the extension, so we will
               * lose the 4GL syntax highlighting for a .cls file. 
               * Running SetEdBufType here resets the 4GL syntax highlighting.
               */
              /* adecomm/peditor.i */
              RUN SetEdBufType(INPUT h_ed,INPUT Proc_Name).
        
        END.
        /* If read successful or Untitled, enter the window for editing. */
        IF VALID-HANDLE( h_ed ) THEN DO:
          IF p_Edit_Command = "UNTITLED":U THEN 
          ASSIGN Proc_Name = Temp_name
                 h_ed:NAME = Temp_name
                 h_win:TITLE = {&PW_Title_Leader} + Proc_name.
            
          /* --- Begin SCM changes --- */
          /* Do custom setup -- this is generally a no-op, but it can
             be used to initialize custom modifications. */
          RUN adecomm/_adeevnt.p (INPUT  {&PW_NAME},
                                  INPUT  "STARTUP", 
                                  INPUT  STRING( h_win ), 
                                  INPUT  STRING( h_win:PRIVATE-DATA ),
                                  OUTPUT scm_ok ).
                  
          IF h_ed:NAME BEGINS {&PW_Untitled} THEN
            ASSIGN scm_event = "NEW"
                   scm_file  = ? .
          ELSE
            ASSIGN scm_event = "OPEN"
                   scm_file  = h_ed:NAME .
    
          IF p_Edit_Command MATCHES "*READ-ONLY*":U THEN h_ed:READ-ONLY = TRUE.
                     
          RUN adecomm/_adeevnt.p (INPUT  {&PW_NAME},
                                  INPUT  scm_event, 
                                  INPUT  STRING( h_ed ), 
                                  INPUT  scm_file,
                                  OUTPUT scm_ok).
      
          /* --- End SCM changes ----- */
      
          ASSIGN PW_Opened = TRUE.
            /* If wait cursor is on, the APPLY "ENTRY" won't take. So
               be sure its "off".
            */
            RUN adecomm/_setcurs.p ( INPUT "" ).
            APPLY "ENTRY" TO h_ed.
        END.
    END.    
  END. /* DO List_Items */
  
  /** ******
   ** Step 4: Did any PW get opened? If not, open an Untitled PW.
   ** ******
   **/
  IF PW_Opened = FALSE
  THEN RUN adecomm/_pwmain.p (INPUT p_Parent_ID /* PW Parent ID  */ ,
                           INPUT ""          /* Files to open */ ,
                           INPUT ""          /* PW Command    */ ).
  RETURN.
END. /* proc-main */

{ adecomm/peditor.i }   /* Editor procedures. */

/* _pwmain.p - end of file */
/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/******************************************************************************

Procedure: _pwmbar.p

Syntax   :
    RUN adecomm/_pwmbar.p
        ( INPUT  p_Popup    /* Create Popup Menu */,
          INPUT  p_Restrictions /* Char string reflecting restrictions to be made */,
          OUTPUT p_HMenubar /* Menubar Handle */ ).

Purpose  :          
    Create a PROGRESS Procedure Windows Menubar and return its handle.
    Default is POPUP = NO, but caller can change that before realizing
    the menubar or pass p_Popup = TRUE.

Description:
       
       
Parameters:
    INPUT  p_Popup          - Logical - Create as popup = TRUE.
    input  p_Restrictions   - Character - String to reflect restrictions
    OUTPUT p_hMenubar       - Handle of created PW Menubar.

Notes :

Author: John Palazzo

Date  : January, 1994

*****************************************************************************/


DEFINE INPUT  PARAMETER p_Popup        AS LOGICAL   NO-UNDO.
DEFINE INPUT  PARAMETER p_Restrictions AS CHARACTER NO-UNDO.
DEFINE OUTPUT PARAMETER p_hMenubar     AS HANDLE    NO-UNDO.

/* Procedure Window application-global contstants. */
{ adecomm/_pwglob.i }

/* Define various handles.  */
DEFINE VARIABLE h_menu    AS WIDGET NO-UNDO.  /*... Menu-bar             */
DEFINE VARIABLE h_submenu AS WIDGET NO-UNDO.  /*... Sub-Menu             */
DEFINE VARIABLE h_subm    AS WIDGET NO-UNDO.  /*... Sub-Menu             */
DEFINE VARIABLE h         AS WIDGET NO-UNDO.  /*... generic handle       */
DEFINE VARIABLE lIsICFRunning AS LOGICAL   NO-UNDO.
DEFINE VARIABLE lReadOnly AS LOGICAL       NO-UNDO.

/* MAIN */
DO ON STOP UNDO, LEAVE:

/* Establish if Dynamics is running. */
ASSIGN lIsICFRunning = DYNAMIC-FUNCTION("IsICFRunning":U) NO-ERROR.
ASSIGN lIsICFRunning = (lIsICFRunning = YES) NO-ERROR.
IF p_Restrictions MATCHES "*READ-ONLY*":U THEN lReadOnly = TRUE.

/* Create a MENU-BAR */
CREATE MENU h_menu IN WIDGET-POOL {&PW_Pool}
ASSIGN
  POPUP-ONLY = p_Popup
  &IF "{&WINDOW-SYSTEM}" BEGINS "MS-WIN" &THEN
  TRIGGERS:
    ON MENU-DROP PERSISTENT RUN adecomm/_pwemdrp.p.
  END TRIGGERS
  &ENDIF
  .

ASSIGN p_hMenubar = h_menu
       h_submenu  = h_menu.
       

IF NOT p_Popup THEN
DO:
    RUN FileMenu.
    IF NOT lReadOnly THEN RUN EditMenu.
    RUN SearchMenu.    
    IF NOT lReadOnly THEN RUN CompileMenu.
    RUN HelpMenu.
END.
ELSE
DO:
    RUN CompileMenu.
    RUN InsertMenu.
    RUN CreateRule.
    RUN CutCopyPaste.
    RUN CreateRule.
    RUN KeywordHelp.
END.

PROCEDURE FileMenu.

/* Create a File sub-menu... */
CREATE SUB-MENU h_submenu IN WIDGET-POOL {&PW_Pool}
ASSIGN
  LABEL  = "&File"
  PARENT = h_menu.
/*... add menu-items.  ..*/

IF NOT lReadOnly THEN DO:
  CREATE MENU-ITEM h IN WIDGET-POOL {&PW_Pool}
  ASSIGN
    LABEL  = "&New"
    ACCELERATOR = "Shift-F3"
    PARENT = h_submenu
    TRIGGERS:
      ON CHOOSE PERSISTENT RUN adecomm/_pwfile.p ("NEW").
    END TRIGGERS.
END. /* If not read only */

IF NOT lReadOnly THEN DO:
  CREATE MENU-ITEM h IN WIDGET-POOL {&PW_Pool}
  ASSIGN
    LABEL  = "&Open..."
    ACCELERATOR = "F3"
    PARENT = h_submenu
    TRIGGERS:
      ON CHOOSE PERSISTENT RUN adecomm/_pwfile.p ("OPEN").
    END TRIGGERS.
  
  RUN CreateRule.

END. /* If not read only */

IF NOT lReadOnly THEN DO:
  CREATE MENU-ITEM h IN WIDGET-POOL {&PW_Pool}
  ASSIGN
    LABEL  = "New Procedure &Window"
    ACCELERATOR = "Ctrl-F3"
    PARENT = h_submenu
    TRIGGERS:
      ON CHOOSE PERSISTENT RUN adecomm/_pwfile.p ("NEW-PWIN").
    END TRIGGERS.
  
  RUN CreateRule.

END. /* If not read only */

IF NOT lReadOnly THEN DO:
  CREATE MENU-ITEM h IN WIDGET-POOL {&PW_Pool}
  ASSIGN
    LABEL  = "&Save"
    ACCELERATOR = "F6"
    PARENT = h_submenu
    TRIGGERS:
      ON CHOOSE PERSISTENT RUN adecomm/_pwfile.p ("SAVE").
    END TRIGGERS.

END. /* If not read only */

IF NOT lReadOnly THEN DO:
  CREATE MENU-ITEM h IN WIDGET-POOL {&PW_Pool}
  ASSIGN
    LABEL  = "Save &As..."
    ACCELERATOR = "Shift-F6"
    PARENT = h_submenu
    TRIGGERS:
      ON CHOOSE PERSISTENT RUN adecomm/_pwfile.p ("SAVE-AS").
    END TRIGGERS.

END. /* If not read only */

/* IZ 2513. Add the 'Add to Repository' option when Dynamics ICF is running. */
IF lIsICFRunning AND NOT lReadOnly THEN
DO:
  CREATE MENU-ITEM h IN WIDGET-POOL {&PW_Pool}
  ASSIGN
    LABEL  = "Add to &Repository..."
    PARENT = h_submenu
    TRIGGERS:
      ON CHOOSE PERSISTENT RUN adecomm/_pwfile.p ("ADD-REPOS").
    END TRIGGERS.
END.

IF NOT lReadOnly THEN
  RUN CreateRule.

CREATE MENU-ITEM h IN WIDGET-POOL {&PW_Pool}
ASSIGN
  LABEL  = "&Print"
  PARENT = h_submenu
  TRIGGERS:
    ON CHOOSE PERSISTENT RUN adecomm/_pwfile.p ("PRINT").
  END TRIGGERS.

RUN CreateRule.

CREATE MENU-ITEM h IN WIDGET-POOL {&PW_Pool}
ASSIGN
  LABEL  = "&Close Window"
  PARENT = h_submenu
  TRIGGERS:
    ON CHOOSE PERSISTENT RUN adecomm/_pwfile.p ("CLOSE").
  END TRIGGERS.

END PROCEDURE. /* FileMenu */


PROCEDURE EditMenu.
    /* Create an Edit sub-menu... */
    CREATE SUB-MENU h_submenu IN WIDGET-POOL {&PW_Pool}
    ASSIGN
      LABEL  = "&Edit"
      PARENT = h_menu
    &IF "{&WINDOW-SYSTEM}" BEGINS "MS-WIN" &THEN
      TRIGGERS:
        ON MENU-DROP PERSISTENT RUN adecomm/_pwemdrp.p.
      END TRIGGERS
    &ENDIF
      .
    
    RUN CutCopyPaste.
    RUN CreateRule.
    RUN InsertMenu.
END PROCEDURE. /* EditMenu */

PROCEDURE CutCopyPaste.
  /*... add menu-items.  ..*/
  IF NOT p_Popup THEN
  DO:
    CREATE MENU-ITEM h IN WIDGET-POOL {&PW_Pool}
    ASSIGN
      LABEL       = "&Undo"
      ACCELERATOR = IF p_Popup THEN "" ELSE "Ctrl-Z"
      PARENT      = h_submenu
      TRIGGERS:
        ON CHOOSE PERSISTENT RUN adecomm/_pwedit.p ("UNDO").
      END TRIGGERS.
    RUN CreateRule.
  END.

  CREATE MENU-ITEM h IN WIDGET-POOL {&PW_Pool}
  ASSIGN
    LABEL       = "Cu&t"
    ACCELERATOR = IF p_Popup THEN "" ELSE "Ctrl-X"
    PARENT      = h_submenu
    TRIGGERS:
      ON CHOOSE PERSISTENT RUN adecomm/_pwedit.p ("CUT").
    END TRIGGERS.
  CREATE MENU-ITEM h IN WIDGET-POOL {&PW_Pool}
  ASSIGN
    LABEL       = "&Copy"
    ACCELERATOR = IF p_Popup THEN "" ELSE "Ctrl-C"
    PARENT      = h_submenu
    TRIGGERS:
      ON CHOOSE PERSISTENT RUN adecomm/_pwedit.p ("COPY").
    END TRIGGERS.
  CREATE MENU-ITEM h IN WIDGET-POOL {&PW_Pool}
  ASSIGN
    LABEL       = "&Paste"
    ACCELERATOR = IF p_Popup THEN "" ELSE "Ctrl-V"
    PARENT      = h_submenu
    TRIGGERS:
      ON CHOOSE PERSISTENT RUN adecomm/_pwedit.p ("PASTE").
    END TRIGGERS.
END PROCEDURE.

PROCEDURE InsertMenu.  
  IF NOT p_Popup THEN
      ASSIGN h_subm = h_submenu.
  ELSE
  DO:
    /* Create an Edit->Insert sub-menu... */
    CREATE SUB-MENU h_subm IN WIDGET-POOL {&PW_Pool}
    ASSIGN
      LABEL  = "&Insert"
      PARENT = h_submenu
      .
  END.
  
  IF NOT p_Popup THEN
  DO:
      CREATE MENU-ITEM h IN WIDGET-POOL {&PW_Pool}
      ASSIGN
        LABEL       = "&Insert File..."
        PARENT      = h_subm
        TRIGGERS:
          ON CHOOSE PERSISTENT RUN adecomm/_pwedit.p ("INSERT-FILE").
        END TRIGGERS.
          
      CREATE MENU-ITEM h IN WIDGET-POOL {&PW_Pool}
      ASSIGN
        LABEL       = "Insert Fie&lds..."
        PARENT      = h_subm
        TRIGGERS:
          ON CHOOSE PERSISTENT RUN adecomm/_pwedit.p ("INSERT-FIELDS").
        END TRIGGERS.
  END.
  ELSE
  DO:
      CREATE MENU-ITEM h IN WIDGET-POOL {&PW_Pool}
      ASSIGN
        LABEL       = "&Database Fields..."
        PARENT      = h_subm
        TRIGGERS:
          ON CHOOSE PERSISTENT RUN adecomm/_pwedit.p ("INSERT-FIELDS").
        END TRIGGERS.
    
      CREATE MENU-ITEM h IN WIDGET-POOL {&PW_Pool}
      ASSIGN
        LABEL       = "&File Contents..."
        PARENT      = h_subm
        TRIGGERS:
          ON CHOOSE PERSISTENT RUN adecomm/_pwedit.p ("INSERT-FILE").
        END TRIGGERS.
  END.
  
  IF NOT p_PopUP THEN
    RUN CreateRule.
  
  CREATE SUB-MENU h_subm IN WIDGET-POOL {&PW_Pool}
  ASSIGN
    LABEL  = "&Format Selection"
    PARENT = h_submenu.
  
  CREATE MENU-ITEM h IN WIDGET-POOL {&PW_Pool}
  ASSIGN
    LABEL       = "&Indent"
    PARENT      = h_subm
    TRIGGERS:
      ON CHOOSE PERSISTENT RUN adecomm/_pwedit.p ("INDENT-SELECTION").
    END TRIGGERS.
  CREATE MENU-ITEM h IN WIDGET-POOL {&PW_Pool}
  ASSIGN
    LABEL       = "&Unindent"
    PARENT      = h_subm
    TRIGGERS:
      ON CHOOSE PERSISTENT RUN adecomm/_pwedit.p ("UNINDENT-SELECTION").
    END TRIGGERS.
  CREATE MENU-ITEM h IN WIDGET-POOL {&PW_Pool}
  ASSIGN
    LABEL       = "&Comment"
    PARENT      = h_subm
    TRIGGERS:
      ON CHOOSE PERSISTENT RUN adecomm/_pwedit.p ("COMMENT-SELECTION").
    END TRIGGERS.
  CREATE MENU-ITEM h IN WIDGET-POOL {&PW_Pool}
  ASSIGN
    LABEL       = "Unc&omment"
    PARENT      = h_subm
    TRIGGERS:
      ON CHOOSE PERSISTENT RUN adecomm/_pwedit.p ("UNCOMMENT-SELECTION").
    END TRIGGERS.

END PROCEDURE. /* InsertMenu */

  
PROCEDURE SearchMenu.
  /* Create a Search sub-menu... */
  CREATE SUB-MENU h_submenu IN WIDGET-POOL {&PW_Pool} ASSIGN
    LABEL  = "&Search"
    PARENT = h_menu.
  /*... add menu-items.  ..*/
  CREATE MENU-ITEM h IN WIDGET-POOL {&PW_Pool} ASSIGN
    LABEL       = "&Find..."
    ACCELERATOR = "Ctrl-F"
    PARENT      = h_submenu
    TRIGGERS:
      ON CHOOSE PERSISTENT RUN adecomm/_pwsrch.p ("FIND").
    END TRIGGERS.
  CREATE MENU-ITEM h IN WIDGET-POOL {&PW_Pool} ASSIGN
    LABEL       = "Find &Next"
    ACCELERATOR = "F9"
    PARENT      = h_submenu
    TRIGGERS:
      ON CHOOSE PERSISTENT RUN adecomm/_pwsrch.p ("FIND-NEXT").
    END TRIGGERS.
  CREATE MENU-ITEM h IN WIDGET-POOL {&PW_Pool} ASSIGN
    LABEL       = "Find &Previous"
    ACCELERATOR = "Shift-F9"
    PARENT      = h_submenu
    TRIGGERS:
      ON CHOOSE PERSISTENT RUN adecomm/_pwsrch.p ("FIND-PREV").
    END TRIGGERS.
  IF NOT lReadOnly THEN
    CREATE MENU-ITEM h IN WIDGET-POOL {&PW_Pool} ASSIGN
      LABEL       = "&Replace..."
      ACCELERATOR = "Ctrl-R"
      PARENT      = h_submenu
      TRIGGERS:
        ON CHOOSE PERSISTENT RUN adecomm/_pwsrch.p ("REPLACE").
      END TRIGGERS.
  CREATE MENU-ITEM h IN WIDGET-POOL {&PW_Pool} ASSIGN
    SUBTYPE  = "RULE"
    PARENT   = h_submenu.
  CREATE MENU-ITEM h IN WIDGET-POOL {&PW_Pool} ASSIGN
    LABEL       = "&Goto Line..."
    ACCELERATOR = "Ctrl-G"
    PARENT      = h_submenu
    TRIGGERS:
      ON CHOOSE PERSISTENT RUN adecomm/_pwsrch.p ("GOTO-LINE").
    END TRIGGERS.
  
END PROCEDURE. /* SearchMenu */

PROCEDURE CompileMenu.

  IF NOT p_Popup THEN
  DO:
    /* Create a Compile sub-menu... */
    CREATE SUB-MENU h_submenu IN WIDGET-POOL {&PW_Pool} ASSIGN
      LABEL  = "&Compile"
      PARENT = h_menu.
    /*... add menu-items.  ..*/
  END.

  CREATE MENU-ITEM h IN WIDGET-POOL {&PW_Pool} ASSIGN
    LABEL       = "&Run"
    ACCELERATOR = IF p_Popup THEN "" ELSE "F2"
    PARENT      = h_submenu
    TRIGGERS:
      ON CHOOSE PERSISTENT RUN adecomm/_pwcomp.p ("RUN").
    END TRIGGERS.
    
  CREATE MENU-ITEM h IN WIDGET-POOL {&PW_Pool} ASSIGN
    LABEL       = IF p_Popup THEN "Chec&k Syntax" ELSE "&Check Syntax"
    ACCELERATOR = IF p_Popup THEN "" ELSE "Shift-F2"
    PARENT      = h_submenu
    TRIGGERS:
      ON CHOOSE PERSISTENT RUN adecomm/_pwcomp.p ("CHECK-SYNTAX").
    END TRIGGERS.
  /*
  RUN CreateRule.
  CREATE MENU-ITEM h IN WIDGET-POOL {&PW_Pool} ASSIGN
    LABEL       = "Compiler &Messages"
    ACCELERATOR = "Ctrl-E"
    PARENT      = h_submenu
    TRIGGERS:
      /* ON CHOOSE PERSISTENT RUN adecomm/_pwcomp.p ("COMP-MESSAGES"). */
    END TRIGGERS.
  */  
END PROCEDURE. /* CompileMenu */

PROCEDURE HelpMenu.

/* Create a Help sub-menu... */
  CREATE SUB-MENU h_submenu IN WIDGET-POOL {&PW_Pool} ASSIGN
    LABEL  = "&Help"
    SUB-MENU-HELP = TRUE
    PARENT = h_menu.
  /*... add menu-items.  ..*/
  CREATE MENU-ITEM h IN WIDGET-POOL {&PW_Pool} ASSIGN
    LABEL       = "OpenEdge &Master Help"
    ACCELERATOR = ""
    PARENT      = h_submenu
    TRIGGERS:
      ON CHOOSE PERSISTENT RUN adecomm/_pwhelp.p ("MASTER").
    END TRIGGERS.
  CREATE MENU-ITEM h IN WIDGET-POOL {&PW_Pool} ASSIGN
    LABEL       = "Procedure Window &Help Topics"
    ACCELERATOR = ""
    PARENT      = h_submenu
    TRIGGERS:
      ON CHOOSE PERSISTENT RUN adecomm/_pwhelp.p ("TOPICS").
    END TRIGGERS.
  CREATE MENU-ITEM h IN WIDGET-POOL {&PW_Pool} ASSIGN
    SUBTYPE  = "RULE"
    PARENT   = h_submenu.
  CREATE MENU-ITEM h IN WIDGET-POOL {&PW_Pool} ASSIGN
    LABEL       = "M&essages..."
    ACCELERATOR = ""
    PARENT      = h_submenu
    TRIGGERS:
      ON CHOOSE PERSISTENT RUN adecomm/_pwhelp.p ("MESSAGES").
    END TRIGGERS.
  CREATE MENU-ITEM h IN WIDGET-POOL {&PW_Pool} ASSIGN
    LABEL       = "&Recent Messages..."
    ACCELERATOR = ""
    PARENT      = h_submenu
    TRIGGERS:
      ON CHOOSE PERSISTENT RUN adecomm/_pwhelp.p ("RECENT-MESSAGES").
    END TRIGGERS.
END PROCEDURE. /* HelpMenu */

PROCEDURE KeywordHelp.

  /* Create Keyword Help menu-item... */
  CREATE MENU-ITEM h IN WIDGET-POOL {&PW_Pool} ASSIGN
    LABEL       = "Key&word Help"
    ACCELERATOR = ""
    PARENT      = h_submenu
    TRIGGERS:
      ON CHOOSE PERSISTENT RUN adecomm/_pwhelp.p ( INPUT "KEYWORD-HELP" ).
    END TRIGGERS.
END PROCEDURE.


PROCEDURE CreateRule.
  CREATE MENU-ITEM h IN WIDGET-POOL {&PW_Pool} ASSIGN
    SUBTYPE  = "RULE"
    PARENT   = h_submenu.
END PROCEDURE.


END. /* MAIN */
/*********************************************************************
* Copyright (C) 2005 by Progress Software Corporation. All rights    *
* reserved.  Prior versions of this work may contain portions        *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/**************************************************************************
    Procedure:  _pwnew.p
    
    Purpose:    Execute Procedure Window File->New command.

    Syntax :    RUN adecomm/_pwnew.p.

    Parameters:
    Description:
    Notes  :
    Authors: John Palazzo
    Date   : January, 1994
**************************************************************************/

/* Procedure Window Global Defines. */
{ adecomm/_pwglob.i }
{ adecomm/_pwattr.i }

DEFINE VARIABLE pw_Window AS WIDGET-HANDLE NO-UNDO.
DEFINE VARIABLE pw_Editor AS WIDGET-HANDLE NO-UNDO.

DEFINE VARIABLE OK_Close     AS LOGICAL   NO-UNDO.
DEFINE VARIABLE Old_Name     AS CHARACTER NO-UNDO.
DEFINE VARIABLE New_Name     AS CHARACTER NO-UNDO.
DEFINE VARIABLE Private_Data AS CHARACTER NO-UNDO.

/* --- Begin SCM changes --- */
DEFINE VAR scm_ok       AS LOGICAL           NO-UNDO.
/* --- End SCM changes ----- */

DO ON STOP UNDO, LEAVE:
    /* Get widget handles of Procedure Window and its editor widget. */
    RUN adecomm/_pwgetwh.p ( INPUT SELF , OUTPUT pw_Window ).
    RUN adecomm/_pwgeteh.p ( INPUT pw_Window , OUTPUT pw_Editor ).
    
    /* Because _pwclosf.p updates the ed:NAME, store off for later use. */
    ASSIGN Old_Name = pw_Editor:NAME
           New_Name = pw_Editor:NAME.
            
    RUN adecomm/_pwclosf.p ( INPUT pw_Window , INPUT pw_Editor ,
                             INPUT "New" ,
                             OUTPUT OK_Close ) .
    IF OK_Close <> TRUE THEN RETURN.

    /* --- Begin SCM changes --- */
    RUN adecomm/_adeevnt.p
        (INPUT  {&PW_NAME} , INPUT "Before-Close",
         INPUT  STRING( pw_Editor ) , INPUT pw_Editor:NAME ,
         OUTPUT scm_ok ).
    IF scm_ok = FALSE THEN RETURN.
    /* --- End SCM changes ----- */
    
    /* --- Begin SCM changes --- */
    RUN adecomm/_adeevnt.p 
        (INPUT  {&PW_NAME} , INPUT "Close",
         INPUT  STRING( pw_Editor ) , INPUT pw_Editor:NAME , 
         OUTPUT scm_ok ).
    /* --- End SCM changes ----- */

    /* If file was not Untitled, then get a new Untitled procedure name. */
    IF NOT Old_Name BEGINS {&PW_Untitled}
    THEN RUN adecomm/_pwgetun.p ( OUTPUT New_Name ).

    /* Clear buffer and rename to Untitled. */
    /* Clear the compile filename, in case this buffer previously contained
    ** a compiled file.  We will generate a new compile file name when the
    ** new buffer is run.
    */
    ASSIGN pw_Editor:SCREEN-VALUE = ""
           pw_Editor:NAME         = New_Name
           pw_Window:TITLE        = {&PW_Title_Leader} + New_Name
           
           Private_Data           = pw_Editor:PRIVATE-DATA 
		   ENTRY ( {&PW_Temp_Web_File_Pos}, Private_Data ) = ""
           ENTRY ( {&PW_Broker_URL_Pos},    Private_Data ) = ""
           ENTRY ( {&PW_Compile_File_Pos},  Private_Data ) = ""
           ENTRY ( {&PW_Class_Type_Pos},    Private_Data ) = ""
           ENTRY ( {&PW_Class_TmpDir_Pos},  Private_Data ) = ""
           pw_Editor:PRIVATE-DATA = Private_Data.
    
    APPLY "ENTRY":U TO pw_Editor.
    
    /* --- Begin SCM changes --- */
    RUN adecomm/_adeevnt.p 
        (INPUT  {&PW_NAME} , INPUT "New",
         INPUT STRING( pw_Editor ), INPUT ? , 
         OUTPUT scm_ok ).
    /* --- End SCM changes ----- */

END.
/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/**************************************************************************
    Procedure:  _pwnewpw.p
    
    Purpose:    Execute Procedure Window File->New Procedure Window command.

    Syntax :    RUN adecomm/_pwnewpw.p ( INPUT p_Window ).

    Parameters:
    Description:
    Notes  :
    Authors: John Palazzo
    Date   : February, 1994
**************************************************************************/

/* Procedure Window Global Defines. */
{ adecomm/_pwglob.i }

DEFINE INPUT PARAMETER p_Window AS WIDGET NO-UNDO.

DEFINE VARIABLE pw_Window AS WIDGET  NO-UNDO.
DEFINE VARIABLE pw_Editor AS WIDGET  NO-UNDO.
DEFINE VARIABLE Ed_Font   AS INTEGER NO-UNDO.

DEFINE VARIABLE OK_Close     AS LOGICAL   NO-UNDO.
DEFINE VARIABLE Old_Name     AS CHARACTER NO-UNDO.
DEFINE VARIABLE New_Name     AS CHARACTER NO-UNDO.

DO ON STOP UNDO, LEAVE:
    /* Get widget handle of parent PW editor widget. */
    RUN adecomm/_pwgeteh.p ( INPUT p_Window , OUTPUT pw_Editor ).

    /* Store off the parent PW editor font. */
    ASSIGN Ed_Font = pw_Editor:FONT.
            
    /* Open New Procedure Window. */
    RUN adecomm/_pwmain.p (INPUT p_Window:PRIVATE-DATA
                                     /* PW Parent ID    */,
                           INPUT ""  /* Files to open   */,
                           INPUT ""  /* PW Command      */ ).
    /* Get handle of new PW. */
    ASSIGN pw_Window = SESSION:LAST-CHILD.
  
    /* Get handle of new PW editor widget. */
    RUN adecomm/_pwgeteh.p ( INPUT pw_Window , OUTPUT pw_Editor ).
  
    /* Inherit font of parent editor. */
    IF pw_Editor:FONT <> Ed_Font
    THEN ASSIGN pw_Editor:FONT = Ed_Font.

END.
/*********************************************************************
* Copyright (C) 2006 by Progress Software Corporation. All rights    *
* reserved.  Prior versions of this work may contain portions        *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/**************************************************************************
    Procedure:  _pwopen.p
    
    Purpose:    Execute Procedure Window File->Open... command.

    Syntax :    RUN adecomm/_pwopen.p.

    Parameters:
    Description:
    Notes  :
    Authors: John Palazzo
    Date   : January, 1994
**************************************************************************/

/* Procedure Window Global Defines. */
{ adecomm/_pwglob.i }
{ adeweb/web_file.i }

DEFINE VARIABLE pw_Editor AS WIDGET-HANDLE NO-UNDO.
DEFINE VARIABLE pw_Window AS WIDGET-HANDLE NO-UNDO.

DEFINE VARIABLE Dlg_Answer   AS LOGICAL   NO-UNDO.
DEFINE VARIABLE Drop_Count   AS INTEGER   NO-UNDO.
DEFINE VARIABLE File_Name    AS CHARACTER NO-UNDO.     
DEFINE VARIABLE In_Library   AS CHAR      NO-UNDO.
DEFINE VARIABLE lScrap       AS LOGICAL   NO-UNDO.
DEFINE VARIABLE OK_Close     AS LOGICAL   NO-UNDO.
DEFINE VARIABLE Read_OK      AS LOGICAL   NO-UNDO.
DEFINE VARIABLE Remote_File  AS CHARACTER NO-UNDO.     
DEFINE VARIABLE Temp_File    AS CHARACTER NO-UNDO.     
DEFINE VARIABLE Web_File     AS LOGICAL   NO-UNDO.
DEFINE VARIABLE RelPath      AS CHARACTER NO-UNDO.

/* --- Begin SCM changes --- */
DEFINE VAR scm_ok       AS LOGICAL        NO-UNDO.
DEFINE VAR scm_context  AS CHARACTER      NO-UNDO.
DEFINE VAR scm_filename AS CHARACTER      NO-UNDO.
/* --- End SCM changes ----- */

DO ON STOP UNDO, LEAVE:
    /* Get widget handles of Procedure Window and its editor widget. */
    RUN adecomm/_pwgetwh.p ( INPUT SELF , OUTPUT pw_Window ).
    RUN adecomm/_pwgeteh.p ( INPUT pw_Window , OUTPUT pw_Editor ).
    
    RUN adecomm/_pwclosf.p ( INPUT pw_Window, INPUT pw_Editor ,
                             INPUT "Open", OUTPUT OK_Close ).
    IF OK_Close <> TRUE THEN
    DO:
        /* End any dropped-files processing. */
        pw_Window:END-FILE-DROP().
        RETURN.
    END.

    /* --- Begin SCM changes --- */
    RUN adecomm/_adeevnt.p
        (INPUT  {&PW_NAME} , INPUT "Before-Close",
         INPUT STRING( pw_Editor ) , INPUT pw_Editor:NAME ,
         OUTPUT scm_ok ).
    IF scm_ok = FALSE THEN
    DO:
        /* End any dropped-files processing. */
        pw_Window:END-FILE-DROP().
        RETURN.
    END.
    /* --- End SCM changes ----- */
    
    /* --- Begin SCM changes --- */
    ASSIGN scm_context  = STRING( pw_Editor )
           scm_filename = pw_Editor:NAME .
    /* --- End SCM changes ----- */           

    /* Only prompt for a file when there are no dropped-files. */
    IF (pw_Window:NUM-DROPPED-FILES = ?) THEN
    DO:
      IF SEARCH("adeuib/_uibinfo.r":U) <> ? THEN
      RUN adeuib/_uibinfo.p (?, "SESSION":U, "REMOTE":U, 
                             OUTPUT Remote_File) NO-ERROR.
      IF Remote_File = "TRUE":U AND 
        pw_Window:PRIVATE-DATA = "_ab.p":U THEN
        Web_File = TRUE.
          
      IF Web_File THEN DO:
      
        RUN adeweb/_webfile.w ("uib":U, "Open":U, "Open":U, "":U,
                               INPUT-OUTPUT File_Name, OUTPUT Temp_File, 
                               OUTPUT Dlg_Answer) NO-ERROR.
        /* 20060531-011
           handle case where relative name was returned.
        */
        ASSIGN RelPath = ws-get-relative-path (File_Name)
               File_Name =  ws-get-absolute-path (File_Name).
      END.
      ELSE
        RUN adecomm/_getfile.p (pw_Window , "Procedure" , 
                                "Open" , "Open" , "OPEN" , 
                                INPUT-OUTPUT File_Name ,
                                OUTPUT Dlg_Answer).
    END.
    ELSE
      ASSIGN File_Name    = pw_Window:GET-DROPPED-FILE(1)
             Dlg_Answer   = TRUE.
    IF Dlg_Answer = NO THEN RETURN. /* Cancel. */
    
    /* Try to read specified file into editor widget. If successful,
       pw_Editor:NAME and pw_Window:TITLE are updated to reflect file
       name read.
    */
    /* 20060531-011
       handle case where relative name was returned - for web dev mode
    */
    RUN adecomm/_pwrdfl.p ( INPUT  pw_Editor,
                            INPUT ((IF Web_File THEN RelPath ELSE File_Name) + 
                                   (IF NOT Web_File THEN ""
                                    ELSE CHR(3) + Temp_File + CHR(3) + 
                                        (IF RelPath NE File_Name THEN File_Name ELSE "") )),
                            OUTPUT Read_OK).

    IF Read_OK <> FALSE THEN
    DO:
        /* --- Begin SCM changes --- */
        RUN adecomm/_adeevnt.p 
            (INPUT  {&PW_NAME} , INPUT "Close",
             INPUT scm_context , INPUT scm_filename , 
             OUTPUT scm_ok ).
        /* --- End SCM changes ----- */

        /* Resets the 4GL syntax highlighting. Refer to 
         * comment in adecomm/_pwmain.p */
        /* adecomm/peditor.i */
        RUN SetEdBufType(INPUT pw_Editor,INPUT pw_Editor:NAME).
    
        APPLY "ENTRY" TO pw_Editor.

        /* --- Begin SCM changes --- */
        RUN adecomm/_adeevnt.p 
            (INPUT  {&PW_NAME} , INPUT "Open",
             INPUT STRING( pw_Editor ), INPUT pw_Editor:NAME , 
             OUTPUT scm_ok ).
        /* --- End SCM changes ----- */
    END.

    /* If there are more than one dropped-files, open them in their own Procedure Windows. */
    IF (pw_Window:NUM-DROPPED-FILES > 1) THEN
    DO Drop_Count = 2 TO pw_Window:NUM-DROPPED-FILES:
       RUN adecomm/_pwmain.p (INPUT pw_Window:PRIVATE-DATA         /* PW Parent ID  */ ,
                              INPUT pw_Window:GET-DROPPED-FILE(Drop_Count) /* File to open */  ,
                              INPUT ""                             /* PW Command    */ ).
    END.

    /* Always release dropped-files memory. */
    pw_Window:END-FILE-DROP().

END.

{ adecomm/peditor.i }   /* Editor procedures. */
/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/
/********************************************************************/
/* Encrypted code which is part of this file is subject to the      */
/* Possenet End User Software License Agreement Version 1.0         */
/* (the "License"); you may not use this file except in             */
/* compliance with the License. You may obtain a copy of the        */
/* License at http://www.possenet.org/license.html                  */
/********************************************************************/

/**************************************************************************
    Procedure:  _pwprint.p
    
    Purpose:    Execute Procedure Window File->Print command.

    Syntax :    RUN adecomm/_pwprint.p.

    Parameters:
    Description:
    Notes  :
    Authors: John Palazzo
    Date   : January, 1994
**************************************************************************/

/* Procedure Window Global Defines. */
{ adecomm/_pwglob.i }

DEFINE VARIABLE pw_Window AS WIDGET-HANDLE NO-UNDO.
DEFINE VARIABLE pw_Editor AS WIDGET-HANDLE NO-UNDO.

DEFINE VAR Return_Status AS LOGICAL NO-UNDO.
DEFINE VAR Printed       AS LOGICAL NO-UNDO.
DEFINE VAR vModified     AS LOGICAL NO-UNDO.    
DEFINE VAR Tmp_File      AS CHARACTER NO-UNDO.

_PRINT_BLOCK:
DO ON STOP UNDO _PRINT_BLOCK , RETRY _PRINT_BLOCK:
  /* Get widget handles of Procedure Window and its editor widget. */
  RUN adecomm/_pwgetwh.p ( INPUT SELF , OUTPUT pw_Window ).
  RUN adecomm/_pwgeteh.p ( INPUT pw_Window , OUTPUT pw_Editor ).

  IF NOT RETRY THEN
  DO:
    IF pw_Editor:EMPTY THEN
    DO:
      MESSAGE "Nothing in this procedure to print."
            VIEW-AS ALERT-BOX INFORMATION BUTTONS OK
            IN WINDOW pw_Window.
      RETURN.
    END.
    
    /* In Windows, we put up a dialog box. So we don't need the wait. */
    IF NOT SESSION:WINDOW-SYSTEM BEGINS "MS-WIN":U THEN
        RUN adecomm/_setcurs.p ( INPUT "WAIT" ).
    DO ON STOP UNDO, LEAVE:
       RUN adecomm/_tmpfile.p ( "p" , ".ped" , OUTPUT Tmp_File ).
    END.
    ASSIGN vModified         = pw_Editor:MODIFIED
           Return_Status     = pw_Editor:SAVE-FILE( Tmp_File )
           pw_Editor:MODIFIED = vModified
    . /* END ASSIGN */
    RUN SetEdBufType (INPUT pw_Editor, INPUT pw_Editor:NAME).   /* adecomm/peditor.i */
    
    RUN adecomm/_osprint.p ( INPUT pw_Window,
                             INPUT Tmp_File,
                             INPUT pw_Editor:FONT,
                             INPUT 1 +
                              (IF SESSION:CPSTREAM = "utf-8":U THEN 512 ELSE 0),
                             INPUT 0,
                             INPUT 0,
                             OUTPUT Printed ) .
  
  END. /* NOT RETRY */

  OS-DELETE VALUE( Tmp_File ) .
  /* In Windows, we put up a dialog box. So we don't need the wait. */
  IF NOT SESSION:WINDOW-SYSTEM BEGINS "MS-WIN":U THEN
      RUN adecomm/_setcurs.p ( INPUT "" ).
  /* This is just to be sure the user winds up in the editor. */
  APPLY "ENTRY" TO pw_Editor.

END. /* DO ON STOP */

{ adecomm/peditor.i }   /* Editor procedures. */

/* _pwprint.p - end of file */
/*********************************************************************
* Copyright (C) 2005 by Progress Software Corporation. All rights    *
* reserved.  Prior versions of this work may contain portions        *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/**************************************************************************
    Procedure:  _pwrdfl.p
    
    Purpose:    Reads a specified file into a Procedure Window
                editor widget and updates the PW Title bar.
                Updates ED:NAME as well.

    Syntax :    
                RUN adecomm/_pwrdfl.p
                    ( INPUT  p_Editor , INPUT  p_File_Name ,
                      OUTPUT p_Read_OK ).

    Parameters:
    Description:
    Notes  :
    Authors: John Palazzo
    Date   : January, 1994
**************************************************************************/

/* Procedure Window Global Defines. */
{ adecomm/_pwglob.i }
{ adecomm/_pwattr.i }

DEFINE INPUT  PARAMETER p_Editor    AS WIDGET    NO-UNDO.
DEFINE INPUT  PARAMETER p_File_Name AS CHARACTER NO-UNDO.     
DEFINE OUTPUT PARAMETER p_Read_OK   AS LOGICAL   NO-UNDO.

DEFINE VARIABLE Broker_URL   AS CHARACTER NO-UNDO.
DEFINE VARIABLE Dlg_Answer   AS LOGICAL   NO-UNDO.
DEFINE VARIABLE In_Library   AS CHARACTER NO-UNDO.
DEFINE VARIABLE OK_Close     AS LOGICAL   NO-UNDO.
DEFINE VARIABLE Open_Msg     AS CHARACTER NO-UNDO.
DEFINE VARIABLE Private_Data AS CHARACTER NO-UNDO.
DEFINE VARIABLE pw_Window    AS WIDGET    NO-UNDO.
DEFINE VARIABLE Temp_File    AS CHARACTER NO-UNDO.
DEFINE VARIABLE URL_Host     AS CHARACTER NO-UNDO.
DEFINE VARIABLE Web_File     AS LOGICAL   NO-UNDO.
DEFINE VARIABLE File_Ext     AS CHARACTER NO-UNDO.
DEFINE VARIABLE cFullPathWeb AS CHARACTER NO-UNDO.

&SCOPED-DEFINE debug FALSE

IF NUM-ENTRIES(p_File_Name, CHR(3)) eq 3 THEN
  ASSIGN Web_File    = TRUE
         Temp_File   = ENTRY( 2, p_File_Name, CHR(3))
         cFullPathWeb = ENTRY( 3, p_File_Name, CHR(3))
         p_File_Name = ENTRY( 1, p_File_Name, CHR(3)).

DO ON STOP UNDO, LEAVE:

    /* --- Begin SCM changes ----- */
    ASSIGN p_Read_OK = TRUE.
    RUN adecomm/_adeevnt.p 
        ( INPUT {&PW_NAME} ,
          INPUT "Before-Open", INPUT ?, INPUT p_File_Name ,
          OUTPUT p_Read_OK ).
    IF NOT p_Read_OK THEN RETURN.
    /* --- End SCM changes ----- */

    /* Get widget handle of Procedure Window. */
    RUN adecomm/_pwgetwh.p ( INPUT p_Editor , OUTPUT pw_Window ).

    /* Try to read file. */
    ASSIGN p_Read_OK = p_Editor:READ-FILE
      (IF Web_File THEN Temp_File ELSE p_File_Name ) NO-ERROR.
      
    IF (p_Read_OK = FALSE) OR (ERROR-STATUS:NUM-MESSAGES > 0)
    THEN DO:
      ASSIGN In_Library = LIBRARY( p_File_Name ).
      IF ( In_Library <> ? ) THEN
        /* 1. File in R-code Library. */
        ASSIGN Open_Msg = "File is in R-code Library " +
                           In_Library + ".":U .
      ELSE DO:
        /* 2. Path or Filename incorrect. */
        ASSIGN FILE-INFO:FILE-NAME = (IF Web_File THEN Temp_File ELSE p_File_Name).
        IF FILE-INFO:FULL-PATHNAME = ? THEN
            ASSIGN Open_Msg = "The path or filename may be incorrect or " +
                              "the file may not exist.".
        /* 3. No read permissions. */
        ELSE IF INDEX(FILE-INFO:FILE-TYPE , "R":U) = 0 THEN
            ASSIGN Open_Msg = "You do not have read permission.".
        /* 4. File may be too large. */
        ELSE
            ASSIGN Open_Msg = "The file may be too large to open.".
      END.
      MESSAGE p_File_Name skip
              "Cannot open file." SKIP(1)
              Open_Msg
              VIEW-AS ALERT-BOX ERROR BUTTONS OK IN WINDOW pw_Window.
    END.

    IF p_Read_OK = FALSE THEN RETURN.
    
    IF SEARCH("adeuib/_uibinfo.r":U) <> ? THEN
    RUN adeuib/_uibinfo.p (?, "SESSION":U, "URLhost":U, 
                           OUTPUT URL_Host) NO-ERROR.

    /* get the file extension to check for .cls */
    RUN adecomm/_osfext.p ( p_File_Name, OUTPUT File_Ext).

    /* Update information. */
    /* Clear the compile filename, in case this buffer previously contained
    ** a compiled file.  We will generate a new compile file name when the
    ** new buffer is run.
    ** Also clear any Class_Type we have saved, and any Class_TmpDir we have created
    */
    ASSIGN p_Editor:NAME   = p_File_Name
           pw_Window:TITLE = {&PW_Title_Leader} + p_File_Name +
                             (IF Web_File THEN URL_Host ELSE "")
           Private_Data = p_Editor:PRIVATE-DATA 
           ENTRY( {&PW_Compile_File_Pos}, Private_Data ) = ""
           ENTRY( {&PW_Class_Type_Pos}, Private_Data ) = 
                             (IF File_Ext = ".cls":U THEN "?" ELSE "")
           ENTRY( {&PW_Class_TmpDir_Pos}, Private_Data ) = ""
           p_Editor:PRIVATE-DATA = Private_Data.
           
    
    IF Web_File THEN DO:
      IF SEARCH("adeuib/_uibinfo.r":U) <> ? THEN
      RUN adeuib/_uibinfo.p (?, "SESSION":U, "BrokerURL":U, 
                             OUTPUT Broker_URL) NO-ERROR.
      IF Broker_URL ne "" THEN
        ASSIGN Private_Data          = p_Editor:PRIVATE-DATA 
               ENTRY ( {&PW_Broker_URL_Pos}, Private_Data ) = Broker_URL 
               ENTRY ( {&PW_Web_File_Name_Pos}, Private_Data ) = cFullPathWeb
               p_Editor:PRIVATE-DATA = Private_Data.
    END.
END.
/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/**************************************************************************
    Procedure:  _pwresz.p
    
    Purpose:    Resize the Frame and Editor widgets of a Procedure Window.

    Syntax :    RUN adecomm/_pwresz.p.

    Parameters: NONE.  Keys off of the SELF handle.
    
    Description:
        Resize Algorithm:
            1. If Window W or H grew, grow the Frame's W and H accordingly.
            2. Size the field-level editor widget to the window LESS the
               Frame Border Widths.
            3. If Window W or H shrank, shrink the Frame's W and H accordingly.
    
    Notes  : This procedure must be run as a PERSISTENT TRIGGER RUN.  If you
             run it when not in a trigger, the SELF handle will be invalid
             and you will receive a PROGRESS error message.
    
    Authors: Wm.T.Wood
    Date   : July, 1993
    Updated: January, 1994 John Palazzo
**************************************************************************/

DEFINE VARIABLE h       AS WIDGET-HANDLE NO-UNDO.
DEFINE VARIABLE h_frame AS WIDGET-HANDLE NO-UNDO.

IF SELF:TYPE <> "WINDOW" 
THEN MESSAGE "Resize can only work on a window!" VIEW-AS ALERT-BOX ERROR.
ELSE DO:

  /* Assign handle of Editor Frame. */
  ASSIGN h_frame = SELF:FIRST-CHILD.
    
  /* 1. If Window W or H grew, grow the Frame's W and H accordingly. */
  IF h_frame:WIDTH-P < SELF:WIDTH-P   THEN h_frame:WIDTH-P  = SELF:WIDTH-P.
  IF h_frame:HEIGHT-P < SELF:HEIGHT-P THEN h_frame:HEIGHT-P = SELF:HEIGHT-P.
  
  /* 2. Size the field-level editor widget to the window LESS the Frame
     Border Widths.
  */
  ASSIGN h = h_frame:FIRST-CHILD /* field-group   */
         h = h:FIRST-CHILD       /* editor widget */
         h:WIDTH-P  = SELF:WIDTH-P - ( h_frame:BORDER-LEFT + 
                                       h_frame:BORDER-RIGHT )
         h:HEIGHT-P = SELF:HEIGHT-P - ( h_frame:BORDER-TOP + 
                                        h_frame:BORDER-BOTTOM )
         .
  
  /* 3. If Window W or H shrank, shrink the Frame's W and H accordingly. */
  IF h_frame:WIDTH-P > SELF:WIDTH-P   THEN h_frame:WIDTH-P  = SELF:WIDTH-P.
  IF h_frame:HEIGHT-P > SELF:HEIGHT-P THEN h_frame:HEIGHT-P = SELF:HEIGHT-P.

END.
/*********************************************************************
* Copyright (C) 2005 by Progress Software Corporation. All rights    *
* reserved.  Prior versions of this work may contain portions        *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/**************************************************************************
    Procedure:  _pwrun.p
    
    Purpose:    Execute Procedure Window commands
                  Compile->Run
                  Compile->Check Syntax

    Syntax :    RUN adecomm/_pwrun.p (INPUT p_Action).

    Parameters:
    Description:
    Notes   :
    Authors : John Palazzo
    Date    : July, 1995
    Modified: 6/19/98 adams support for 9.0A remote file managment
**************************************************************************/

/* Procedure Window Global Defines. */
{ adecomm/_pwglob.i }
{ adecomm/_pwattr.i }

/* .cls definitions */
{ adecomm/dcmpcls.i }

/* PROGRESS Preprocessor system message number. */
&SCOPED-DEFINE PP-4345      4345

DEFINE INPUT PARAMETER p_Action AS CHARACTER NO-UNDO.

DEFINE NEW GLOBAL SHARED VARIABLE wfRunning     AS CHARACTER NO-UNDO.
DEFINE NEW GLOBAL SHARED VARIABLE h_ade_tool    AS HANDLE    NO-UNDO.

DEFINE VARIABLE h_menu        AS HANDLE    NO-UNDO.
DEFINE VARIABLE h_tool        AS HANDLE    NO-UNDO.
DEFINE VARIABLE pw_Editor     AS HANDLE    NO-UNDO.
DEFINE VARIABLE pw_Window     AS HANDLE    NO-UNDO.

DEFINE VARIABLE app_handle    AS HANDLE    NO-UNDO.
DEFINE VARIABLE Broker_URL    AS CHARACTER NO-UNDO.
DEFINE VARIABLE Cannot_Run    AS LOGICAL   NO-UNDO.
DEFINE VARIABLE Comp_Err      AS INTEGER   NO-UNDO.
DEFINE VARIABLE Comp_File     AS CHARACTER NO-UNDO.
DEFINE VARIABLE Comp_Stopped  AS LOGICAL   NO-UNDO INITIAL TRUE.
DEFINE VARIABLE Dlg_Answer    AS LOGICAL   NO-UNDO.             
DEFINE VARIABLE Error_Col     AS INTEGER   NO-UNDO.
DEFINE VARIABLE Error_File    AS CHARACTER NO-UNDO.
DEFINE VARIABLE Error_Found   AS LOGICAL   NO-UNDO.
DEFINE VARIABLE Error_Msg     AS CHARACTER NO-UNDO.
DEFINE VARIABLE Error_Offset  AS INTEGER   NO-UNDO.
DEFINE VARIABLE Error_Row     AS INTEGER   NO-UNDO.
DEFINE VARIABLE File_Ext      AS CHARACTER NO-UNDO.
DEFINE VARIABLE File_Modified AS LOGICAL   NO-UNDO.
DEFINE VARIABLE File_Name     AS CHARACTER NO-UNDO.
DEFINE VARIABLE Html_File     AS LOGICAL   NO-UNDO.
DEFINE VARIABLE Private_Data   AS CHARACTER NO-UNDO.
DEFINE VARIABLE Proxy_Broker  AS CHARACTER NO-UNDO.
DEFINE VARIABLE Rel_Name      AS CHARACTER NO-UNDO.
DEFINE VARIABLE Remote_File   AS CHARACTER NO-UNDO.
DEFINE VARIABLE Run_Action    AS CHARACTER NO-UNDO.
DEFINE VARIABLE Run_Msg       AS CHARACTER NO-UNDO.
DEFINE VARIABLE Saved_File    AS LOGICAL   NO-UNDO.
DEFINE VARIABLE Web_File      AS LOGICAL   NO-UNDO.
DEFINE VARIABLE IsClass      AS LOGICAL   NO-UNDO.
DEFINE VARIABLE ClassType    AS CHARACTER NO-UNDO.
DEFINE VARIABLE OldClassType AS CHARACTER   NO-UNDO.
DEFINE VARIABLE ClassTmpDir  AS CHARACTER   NO-UNDO.
DEFINE VARIABLE iCtr         AS INTEGER     NO-UNDO.
DEFINE VARIABLE isClassError AS LOGICAL     NO-UNDO.
DEFINE VARIABLE isWrongClass AS LOGICAL     NO-UNDO.
DEFINE VARIABLE lAutoSaveCls AS LOGICAL INIT NO NO-UNDO.
DEFINE VARIABLE cAutoSaveCls AS CHARACTER   NO-UNDO.
DEFINE VARIABLE Run_File     AS CHARACTER   NO-UNDO.
DEFINE VARIABLE lOK          AS LOGICAL     NO-UNDO.

MAIN_BLOCK:
DO ON STOP UNDO, LEAVE:
    /* Get widget handles of Procedure Window and its editor widget. */
    RUN adecomm/_pwgetwh.p ( INPUT SELF , OUTPUT pw_Window ).
    RUN adecomm/_pwgeteh.p ( INPUT pw_Window , OUTPUT pw_Editor ).
    
    ASSIGN Run_Msg = REPLACE(LC(p_Action) , "-syntax":U , "").
    
    IF ( pw_Editor:EMPTY ) THEN
    DO:
        MESSAGE "Nothing in this procedure to " + Run_Msg + ".":U
                VIEW-AS ALERT-BOX INFORMATION BUTTONS OK.
        RETURN.
    END.
    
    /* Put up the wait cursor. */
    RUN adecomm/_setcurs.p ("WAIT":U).

    /* Check if this is a .cls file, and if it has a known ClassType.
     * We store "" as the ClassType if this is NOT a .cls file.
     * We store "?" if this is a .cls file, but we don't know its
     * ClassType yet (i.e. when it has just been loaded).
     * If ClassType is not "", we assume this is a .cls file, 
     * and ClassType reflects the package of the defined class.
     * 20051014-003 If the ClassType is "", check the filename for 
     * the ".cls" extension in the filename before assigning IsClass. */
    ASSIGN
        ClassType = ENTRY( {&PW_Class_Type_Pos},pw_Editor:PRIVATE-DATA )
        IsClass = 
            (IF ClassType = "" THEN 
              (IF pw_Editor:NAME MATCHES "*.cls" THEN TRUE ELSE FALSE) 
             ELSE TRUE)
        ClassType = (IF isClass THEN (IF ClassType = "?" THEN "" ELSE ClassType) ELSE ?)
        OldClassType = ClassType
        Comp_File = ENTRY( {&PW_Compile_File_Pos}, pw_Editor:PRIVATE-DATA ).
        .
    
    /* SAVE_AND_COMPILE_BLOCK explanation
     * This block was implemented to support OO4GL and .cls files.
     * Background:
     * A piece of OO4GL code MUST meet the following criteria in order 
     * to compile correctly:
     * - its filename MUST have a ".cls" extension
     * - the end of its path MUST match the package declared in the CLASS 
     * e.g. CLASS foo.bar MUST have a pathname foo/bar.cls
     * If the compiler compiles OO4GL syntax in a file without a .cls extension, 
     * it will generate error (12622) for a CLASS and (12623) for an INTERFACE.
     * Also, if the compiler compiles a .cls file, and the pathname does NOT
     * match the package declared in the CLASS, it will generate error (12629),
     * and set the COMPILER:CLASS-TYPE attribute to the name of the declared CLASS
     * (note that the COMPILER:CLASS-TYPE attribute is NOT set unless you 
     * compile a file with a .cls extension).
     * Two other things to consider:
     * - when a user enters text into an untitled edit buffer, there is no way to
     *   tell (without compiling) whether the code contains OO4GL syntax or not.
     * - when a user loads a .cls file, there is no way to know what the 
     *   declared package of the class is (without compiling it).
     * This means that to successfully compile OO4GL code we need to determine
     * that it is OO4GL code first (by compiling), and then determine the
     * correct package (by compiling). This means we might need to save the code
     * up to 3 times with different names and compile up to 3 times in order to
     * CHECK SYNTAX or RUN. Rather than re-write the save and compile code 3 times, 
     * we make up to 3 iterations of the SAVE_AND_COMPILE_BLOCK.
     * 
     * To explain how the SAVE_AND_COMPILE_BLOCK (SACB) works, consider the following
     * situations:
     *
     * - untitled buffer, containing non-OO4GL code
     *   On the first pass through SACB, the buffer is saved to a temp file 
     *   with a non-.cls extension. If it compiles without a (12622) or (12623)
     *   error, then we assume it is NOT a .cls file, and leave SACB.
     *   
     * - untitled buffer, containing OO4GL code
     *   On the first pass through SACB, the buffer is saved to a temp file
     *   with a non-.cls extension. The compiler will return a (12622) or 
     *   (12623) error, which indicates this is OO4GL. We then set isClass to 
     *   indicate it is OO4GL, and force another pass of SACB.
     *   On the second pass of SACB, we know the buffer contains OO4GL, 
     *   but we don't know the correct class name. We change the extension of
     *   the temp file to .cls, and save the buffer to this file. The compile
     *   will then generate a (12629) error, indicating the file has the wrong 
     *   pathname for the declared class. We set the ClassType based on 
     *   COMPILER:CLASS-TYPE, and force another pass of SACB.
     *   On the third pass of SACB, we know the buffer contains OO4GL, 
     *   and we know what the classtype (and hence the pathname) should be.
     *   We then create a temporary directory under the SESSION:TEMP-DIR,
     *   and build a directory path to match the classtype of the class.
     *   We then save the buffer to the file in the temporary directory path.
     *   The compiler will then compile the temp file. At this point, 
     *   we leave SACB, to report the outcome of the compile. However, we save
     *   away the classtype and temp dir name for future use.
     *
     * - buffer loaded from a non-.cls file
     *   When loading the non-.cls file, we know the extension is not .cls,
     *   so this is treated the same as an untitled edit buffer. However, if 
     *   the code contains any OO4GL statements, we will not trap the (12622)
     *   or (12623) errors, since the file is already determined as non-OO4GL 
     *   by its extension. Regardless, we leave the SACB to report the outcome
     *   of the compile.
     *
     * - buffer loaded from a .cls file, never previously compiled
     *   When first loading the file, we know it is a class file by its
     *   .cls extension, so we flag this with a classtype of "", and 
     *   set isClass to true. 
     *   On the first pass of SACB, we have a temp file name with a non-.cls 
     *   extension, so we change the extension to .cls, and save the buffer
     *   to this file. We then compile it, which should give us the (12629)
     *   error, and the classtype in COMPILER:CLASS-TYPE. We then force
     *   another pass of SACB.
     *   On the second pass, we know the classtype, and that the file is a class,
     *   so we create a temp dir, and build the appropriate path beneath it to 
     *   match the classtype. We save the buffer to the .cls file in this 
     *   temp dir, and compile it. We then leave SACB, to report the 
     *   outcome of the compile. However, we save away the classtype and 
     *   temp-dir name for future use.
     *
     * - buffer loaded from a .cls file, previously compiled
     *   From previous compiles, we know that this buffer contains OO4GL,
     *   and we know its clastype and the name of the temp dir we have
     *   determined for it. We can go straight to building the appropriate
     *   dir structure underneath the temp dir, saving the buffer to this file,
     *   and compiling. We then leave SACB to report the outcome of the compile.
     *
     * And now for the fun part: remote development.
     * We still have to go through these steps for remote development. We just
     * have to save the buffer to the webspeed agent each pass through SACB,
     * telling it to use a specific save name for the file. Communicating 
     * .cls information with the webspeed agent happens in the following ways:
     * - if the buffer contains OO4GL (either a loaded .cls file, or 
     *   and untitled edit buffer), we pass the classtype as part of the 
     *   Filename param to adecomm/_webcom.w, delimited by a pipe "|".
     *   If we don't know the classtype, we will end up passing "", but 
     *   the existence of the delimiter will indicate that this is an 
     *   OO4GL file.
     * - The agent returns compile errors back through the RETURN-VALUE 
     *   from adecomm/_webcom.w. The RETURN-VALUE will contain the (12622),
     *   (12623) and (12629) errors, and we just parse the RETURN-VALUE
     *   for these errors the same way we parse the local compile output.
     * - If the agent (through _cpyfile.w) detects that COMPILER:CLASS-TYPE
     *   is set, it returns this to adecomm/_webcom.w, returned in the 
     *   first line of the RETURN-VALUE as:
     *     ERROR:CLASSTYPE:<ClassType>
     *   If there is an error, the first line of RETURN-VALUE begins with 
     *   ERROR <linenum>. We simply overload the first (space-delimited)
     *   entry of the RETURN-VALUE by adding our classtype in a colon-delimited 
     *   list, identified by the "CLASSTYPE" 
     *      
     */
    SAVE_AND_COMPILE_BLOCK:
    REPEAT:
        /* Generate a temporary filename for writing editor contents. */
        /* Remember the filename so it will be reused for subsequent runs.
        ** The debugger requires that the filename remain the same within
        ** a session so that breakpoints can be remembered for multiple
        ** files.
        */
        IF Comp_File = "" THEN
        DO:
            /* Generate the unique compiler file name for this buffer. */
            RUN adecomm/_uniqfil.p ( pw_Editor:NAME , ".cmp":U, OUTPUT Comp_File ).
    
            ASSIGN 
              Private_Data = pw_Editor:PRIVATE-DATA 
              ENTRY( {&PW_Compile_File_Pos}, Private_Data ) = Comp_File
              pw_Editor:PRIVATE-DATA = Private_Data.
        END.

        /* if this is a class, change Comp_File to have .cls extension */
        IF (isClass) THEN
        DO:
            /* if we don't know the ClassType yet, replace .cmp with .cls */
            IF (ClassType = "") THEN
            DO:
                /* replace .cmp with .cls */
                ictr = R-INDEX(Comp_File,".cmp":U).
                IF ictr > 0 THEN
                    SUBSTRING(Comp_File,ictr) = ".cls":U.
            END.  /* if ClassType = "" */
            ELSE
            DO: /* ClassType <> "" */
                /* we know the classtype for the .cls file.
                 * We need a temp file with a path that maps to the 
                 * class name */
                /* If we don't have a local temp dir for this, create one */
                ClassTmpDir = ENTRY( {&PW_Class_TmpDir_Pos},pw_Editor:PRIVATE-DATA ).
                IF (ClassTmpDir = "") THEN
                DO:
                    RUN GetUniqueDir(SESSION:TEMP-DIR,"p",?,OUTPUT ClassTmpDir).
                    ASSIGN 
                      Private_Data = pw_Editor:PRIVATE-DATA 
                      ENTRY( {&PW_Class_TmpDir_Pos}, Private_Data ) = ClassTmpDir
                      pw_Editor:PRIVATE-DATA = Private_Data.
                END.
                /* create Comp_File from the directory and classtype */
                RUN GetClassCompileName(
                    ClassTmpDir,
                    (IF pw_Editor:NAME BEGINS {&PW_Untitled} THEN ? ELSE pw_Editor:NAME),
                    ClassType,
                    OUTPUT Comp_File).                
            END.  /* ClassType <> "" */
        END.  /* if isClass */
    
        IF SEARCH("adeuib/_uibinfo.r":U) <> ? THEN
        DO:
          RUN adeuib/_uibinfo.p ( ?, "SESSION":U, "Remote":U, 
                                 OUTPUT Remote_File) NO-ERROR.
          RUN adeuib/_uibinfo.p ( ?, "SESSION":U, "BrokerURL":U, 
                                 OUTPUT Proxy_Broker) NO-ERROR.
        END.
        
        RUN adecomm/_pwfmod.p ( INPUT pw_Editor, OUTPUT File_Modified).
        ASSIGN 
          File_Name  = pw_Editor:NAME
          Broker_URL = ENTRY ( {&PW_Broker_URL_Pos}, pw_Editor:PRIVATE-DATA )
          Run_Msg    = REPLACE(LC(p_Action) , "-":U , "").
          Run_Action = (IF p_Action BEGINS "check":U THEN "checked":U 
                        ELSE LC(p_Action)).
    
        RUN adecomm/_osfext.p ( File_Name, OUTPUT File_Ext).
        IF (File_Ext eq ".htm":U OR File_Ext eq ".html":U) THEN
          Html_File = TRUE.
        
        /* Do we want to run or check a remote web file? */  
        IF (File_Name BEGINS {&PW_Untitled} AND Remote_File eq "TRUE":U) OR
          Html_File OR Broker_URL ne "" THEN DO:
          
          /* Save changes to disk. */
          IF Html_File AND File_Modified THEN
            RUN adecomm/_pwsave.p (INPUT pw_Editor).
    
          /* File must be saved before running. */
          IF p_Action eq "run":U AND File_Modified THEN DO:
            RUN adecomm/_s-alert.p (INPUT-OUTPUT Dlg_Answer, "error":U, "ok":U,
              SUBSTITUTE("&1 has changes which must be saved before running.",
                File_Name)).
            RETURN.
          END.
    
          Web_File = TRUE.
          
          /* Save to a local temp file when checking syntax. */
          IF p_Action eq "check-syntax":U THEN DO:
            ASSIGN Saved_File = pw_Editor:SAVE-FILE (Comp_File) NO-ERROR.
            RUN SetEdBufType (INPUT pw_Editor, INPUT File_Name).    /* adecomm/peditor.i */
            IF NOT Saved_File THEN DO:
              RUN adecomm/_s-alert.p (INPUT-OUTPUT Dlg_Answer, "error":U, "ok":U,
                SUBSTITUTE("Cannot save to this file.  &1 is read-only or the path specified is invalid.",
                Comp_File)).
              RETURN.
            END.
          END.
          
          IF Broker_URL = "" AND Proxy_Broker ne ? THEN
            Broker_URL = Proxy_Broker.

          /* Run or check Web object. */
          /* If checking syntax of a .cls file, send the classtype 
           * with the File_name, delimited by "|":U */
          RUN adeweb/_webcom.w ( 
              ?, Broker_URL, 
              File_Name + 
                (IF p_Action = "check-syntax" AND isClass 
                 THEN "|":U + ClassType ELSE "":U), 
              Run_Msg, OUTPUT Rel_Name, INPUT-OUTPUT Comp_File ).
          IF RETURN-VALUE BEGINS "ERROR:":U THEN
          DO:
              /* check for .cls-related errors */
              /* look for IS_CLASS_ERROR and IS_INTERFACE_ERROR */
              isClassError = 
                  INDEX(RETURN-VALUE,{&IS_CLASS_ERROR}) > 0 OR
                  INDEX(RETURN-VALUE,{&IS_INTERFACE_ERROR}) > 0.
              /* look for WRONG_CLASS_TYPE_ERROR or WRONG_INTERFACE_TYPE_ERROR */
              isWrongClass = 
                  INDEX(RETURN-VALUE,{&WRONG_CLASS_TYPE_ERROR}) > 0 OR
                  INDEX(RETURN-VALUE,{&WRONG_INTERFACE_TYPE_ERROR}) > 0.
              /* if we have IsClassError and this is not a .cls AND
               * this is an untitled edit buffer */
              IF (isClassError AND NOT isClass AND 
                  pw_Editor:NAME BEGINS {&PW_Untitled} ) THEN
              DO:
                  /* mark this as a class with an empty ClassType */
                  ASSIGN 
                      ClassType = ""
                      isClass = TRUE.
                  /* remove the previous Comp_File */
                  OS-DELETE VALUE(Comp_File) NO-ERROR.
                  NEXT SAVE_AND_COMPILE_BLOCK.
              END.
              IF (isClass AND ClassType = "" AND isWrongClass) THEN
              DO:
                  /* check for ERROR:CLASSTYPE:<ClassType> in the RETURN-VALUE */
                  IF (NUM-ENTRIES(ENTRY(1,RETURN-VALUE," ":U),":":U) > 2) THEN
                      ClassType = ENTRY(3,ENTRY(1,RETURN-VALUE," ":U),":").
                  ELSE
                      ClassType = "".  /* something went wrong, classtype was not sent */
                  /* remove the previous Compile_Filename */
                  OS-DELETE VALUE(Comp_File) NO-ERROR.
                  NEXT SAVE_AND_COMPILE_BLOCK.
              END.
              ELSE 
              RUN returnValue (RETURN-VALUE, pw_Editor:NAME, Run_Action, 
                               OUTPUT Dlg_Answer).
          END.  /* if RETURN-VALUE BEGINS "ERROR:" */
          ELSE IF p_Action eq "CHECK-SYNTAX":U THEN
            MESSAGE "Syntax is correct."
              VIEW-AS ALERT-BOX INFORMATION BUTTONS OK.
        END.  /* if run or check remote web file */
        
        /* Compile the contents of the editor widget. */
        ELSE DO:
          RUN adecomm/_pwcmpfl.p (INPUT  pw_Editor      /* Editor handle.   */ ,
                                  INPUT  "CMP_NOERROR"  /* Messages Dest.   */ ,
                                  INPUT  Comp_File      /* Compile file.    */ ,
                                  INPUT  ""             /* Messages file.   */ ,
                                  OUTPUT Comp_Stopped   /* Compile Stopped? */ ).
    
          /* Force out of the DO ON STOP and perform temp file deletions. */
          IF Comp_Stopped THEN STOP.
        END.
    
        ASSIGN Error_Found = COMPILER:ERROR.
        IF ( Error_Found = TRUE ) THEN
        DO:
            ASSIGN 
                isClassError = NO
                isWrongClass = NO.
            /* Check for .cls-related errors */
            DO ictr = 1 TO ERROR-STATUS:NUM-MESSAGES:
              ASSIGN
                isClassError = 
                  (IF ERROR-STATUS:GET-NUMBER(ictr) = {&IS_CLASS_ERROR_NUM} OR
                      ERROR-STATUS:GET-NUMBER(ictr) = {&IS_INTERFACE_ERROR_NUM}
                   THEN TRUE ELSE isClassError)
                isWrongClass = 
                  (IF ERROR-STATUS:GET-NUMBER(ictr) = {&WRONG_CLASS_TYPE_ERROR_NUM} OR
                      ERROR-STATUS:GET-NUMBER(ictr) = {&WRONG_INTERFACE_TYPE_ERROR_NUM}
                   THEN TRUE ELSE isWrongClass).
            END.
            /* if this is not a .cls file and is untitled */
            IF (NOT isClass AND File_Name BEGINS {&PW_Untitled} ) THEN 
            DO:
                /* if the compiler tells us this is a class */
                IF (IsClassError) THEN
                DO:
                  ASSIGN 
                    isClass = TRUE
                    ClassType = "".
                  /* remove the previous Comp_File */
                  OS-DELETE VALUE(Comp_File).
                  /* re-run SAVE_AND_COMPILE_BLOCK */
                  NEXT SAVE_AND_COMPILE_BLOCK.
                END. /* if isClassError */
            END.  /* if not isClass and untitled */
            /* if this is a class, but the last compile showed the wrong classtype 
             * 20050809-041 Only do this if the Wrong Class Type error was raised 
             * on the same file that was being compiled, in case an interface or
             * ancestor class gives the same error. */                      
            ELSE IF (isClass AND isWrongClass AND
                     COMPILER:FILE-NAME = Comp_File) THEN
            DO:
                /* if the previous classtype is "" (just-loaded .cls)
                 * OR the file is an untitled edit buffer containing OO4GL
                 * OR classtype is a subset of COMPILER:CLASS-TYPE (user qualified the classtype)
                 * then we want to save the classname, and redo the save */
                IF (ClassType = "" OR 
                    (File_Name BEGINS {&PW_Untitled}) OR
                    IsValidClassChange(
                        IF (File_Name BEGINS {&PW_Untitled}) THEN ? ELSE File_Name,
                        ClassType,COMPILER:CLASS-TYPE))
                    THEN
                DO:
                    ClassType = COMPILER:CLASS-TYPE.
                    /* remove the previous Comp_File */
                    OS-DELETE VALUE(Comp_File).
                    NEXT SAVE_AND_COMPILE_BLOCK.
                END.
            END.  /* if isClass and ClassType = "" and isWrongClass */

            /* Assign these COMPILER widget attributes to vars to prevent their
               current values from being overwritten by a session compile during
               development.
            */
            ASSIGN Error_File   = COMPILER:FILENAME
                   Error_Row    = COMPILER:ERROR-ROW
                   Error_Col    = COMPILER:ERROR-COLUMN
                   Error_Offset = COMPILER:FILE-OFFSET
                   . /* END ASSIGN */      
            /* If the error occurs in an include file, the names here will not be
               the same.  When this happens, we cannot move to the line with the
               error, because the COMPILER widget is reporting the error values
               relative to the include file, not the file being compiled.  So,
               only move the cursor if the error occurred in the file being
               compiled.
            */
            IF ( Error_File = Comp_File ) THEN
            DO:
              &IF "{&WINDOW-SYSTEM}" BEGINS "MS-WIN" &THEN
               /* LARGE MSW editor does not support :CURSOR-OFFSET. */
               ASSIGN pw_Editor:CURSOR-LINE = Error_Row WHEN Error_Row <> 0
                      pw_Editor:CURSOR-CHAR = Error_Col WHEN Error_Col <> 0.
              &ELSE
               ASSIGN pw_Editor:CURSOR-OFFSET = Error_Offset
                                                WHEN Error_Offset <> 0.
              &ENDIF
            END.
        END.    
        /* if this is a class, and we previously didn't know the classtype, 
         * record it now */
        IF (isClass AND ClassType <> ? AND OldClassType <> ClassType) THEN
        DO:
            /* save .cls related information back to the PRIVATE-DATA */
            ASSIGN
                Private_Data = pw_Editor:PRIVATE-DATA
                ENTRY( {&PW_Class_Type_Pos}, Private_Data ) = ClassType
                /* ENTRY( {&PW_Compile_file_Pos}, Private_Data ) = Comp_File */
                pw_Editor:PRIVATE-DATA = Private_Data.
                
        END.
        /* if we get to here, the compile completed. Leave SAVE_AND_COMPILE_BLOCK */
        LEAVE SAVE_AND_COMPILE_BLOCK.
    END.  /* SAVE_AND_COMPILE_BLOCK */
        
    /* Remove the wait cursor. */
    RUN adecomm/_setcurs.p (INPUT "":U).

    /* WARNING:
       DO NOT USE THE NO-ERROR OPTION ON ANY STATEMENT BETWEEN
       RUN adecomm/_pwcmpfl.p AND THIS CALL TO _errmsgs.p.
       PROCEDURE _errmsgs.p relies on the ERROR-STATUS HANDLE
       TO CORRECTLY REPORT ERRORS.
    */
    /* Display preprocessor and error messages, if any. */
    IF NOT Web_File AND NOT Html_File THEN
      RUN adecomm/_errmsgs.p (INPUT pw_Window ,
                              INPUT Error_File ,
                              INPUT Comp_File ).
        
    IF Error_Found = FALSE AND NOT Web_File AND NOT Html_File THEN
    DO: /* No error. */
    CASE p_Action:

      WHEN "RUN":U THEN
      DO:
        RUN adecomm/_wfrun.p
            ( INPUT "A " + pw_Window:NAME + "," + STRING(pw_Window),
              OUTPUT Cannot_Run ).
        IF Cannot_Run = FALSE THEN
        Execute_Block:
        DO ON STOP UNDO, RETRY:
            ASSIGN h_tool = h_ade_tool.
            /* set up the file to run
             * for a .cls file, this will not be the compile file */
            Run_File = ENTRY( {&PW_Compile_file_Pos}, pw_Editor:PRIVATE-DATA ).
            IF NOT RETRY THEN
            DO:
                IF (isClass) THEN
                DO:
                    /* If .cls file is not saved */
                    IF File_Modified THEN
                    DO:
                        lOK = TRUE.
                        /* get the AutoSaveCls option from the registry */
                        /* This is not very elegant, hitting the registry each
                         * time the user runs the code to check for the AutoSaveCls
                         * value, but as the Procedure Window can run outside AB, 
                         * there is no "global" place to read and write it.
                         */
                        GET-KEY-VALUE SECTION "ProAB":U KEY "AutoSaveCls":U VALUE cAutoSaveCls.
                        lAutoSaveCls = (IF cAutoSaveCls = "Yes":U THEN YES ELSE NO).

                        /* if untitled or not autosave, offer to save */
                        IF (pw_Editor:NAME BEGINS {&PW_Untitled} OR
                            NOT lAutoSaveCls) THEN
                        DO:
                            /* offer to save(-as) */
                            RUN AskToSaveClass(
                                INPUT (IF pw_Editor:NAME BEGINS {&PW_Untitled} THEN YES ELSE NO) /* untitled */,
                                INPUT ClassType, /* package name */
                                INPUT-OUTPUT lAutoSaveCls   /* AutoSaveCls setting  */,
                                OUTPUT lOK).
                            /* if not save, abort run */
                            IF (NOT lOK) THEN
                            DO:
                                /* abort run */
                                LEAVE Execute_Block.
                            END.
                            ELSE IF lAutoSaveCls THEN
                                /* save the AutoSaveCls setting back to the registry */
                                PUT-KEY-VALUE SECTION "ProAB":U 
                                    KEY "AutoSaveCls":U 
                                    VALUE (IF lAutoSaveCls THEN "Yes":U ELSE "No":U) NO-ERROR.
                        END.  /* if untitled or not lAutoSaveCls */
                        /* record whether this was an untitled edit buffer */
                        lOK = (IF pw_Editor:NAME BEGINS {&PW_Untitled} THEN TRUE ELSE FALSE).
                        /* save the file. _pwsave.p will automagically run SaveAs if necessary */
                        RUN adecomm/_pwsave.p (INPUT pw_Editor).
                        /* if the save failed, or was cancelled, leave.
                         * The only reliable way to tell if the save failed is 
                         * if pw_Editor:MODIFIED is true, as _pwsave.p does not
                         * return an error if the user cancels the save-as */
                        IF pw_editor:MODIFIED THEN
                        DO:
                            /* save failed, abort run */
                            LEAVE Execute_Block .
                        END.
                        /* TO DO: if this was an untitled edit buffer, do we need to reset some values? */
                    END.  /* if File_Modified */
                    /* search for this class in the PROPATH */
                    RUN FindClassInPropath(
                        INPUT ClassType,  /* expected classtype */
                        INPUT pw_Editor:NAME, /* name of file */
                        OUTPUT lOK).
                    /* file was not in PROPATH, user aborted */
                    IF (NOT lOK) THEN
                    DO:
                        /* abort run */
                        LEAVE Execute_Block.
                    END.
                    /* build the run stub here */
                    RUN CreateClassStub(Run_File,INPUT ClassType).
                    IF (RETURN-VALUE <> ?) THEN
                    DO:
                        /* TO DO: tidy this up */
                        MESSAGE RETURN-VALUE
                            VIEW-AS ALERT-BOX ERROR BUTTONS OK.
                        LEAVE Execute_Block.
                    END.
                END.  /* if isClass */

              RUN disable_widgets IN h_tool NO-ERROR.
              ASSIGN pw_Window:VISIBLE = FALSE.
              RUN adecomm/_runcode.p
                  ( INPUT Run_File ,
                    INPUT "_PAUSE":U /* Run Flags */ ,
                    INPUT ?     /* p_Stop_Widget */ ,
                    OUTPUT app_handle ) .
            END. 
            RUN enable_widgets IN h_tool NO-ERROR.
            ASSIGN wfRunning = "".
            ASSIGN pw_Window:VISIBLE = TRUE.
         END.  /* Execute_Block */
      END. /* WHEN "RUN":U */

      WHEN "CHECK-SYNTAX":U THEN
         MESSAGE "Syntax is correct."
             VIEW-AS ALERT-BOX INFORMATION BUTTONS OK.
    END CASE.
    END. /* Error_Found = FALSE */
END. /* MAIN_BLOCK - DO ON STOP */

OS-DELETE VALUE ( Comp_File ).
IF (isClass AND Run_File <> ? ) THEN
    OS-DELETE VALUE ( Run_File ) NO-ERROR.
/* remove any directory created for a .cls file */
IF ClassTmpDir <> "" THEN
    OS-DELETE VALUE ( ClassTmpDir ) RECURSIVE.
  
/* If compile stopped, ensure wait cursor is removed. */
IF Comp_Stopped THEN
  RUN adecomm/_setcurs.p (INPUT "":U).

APPLY "ENTRY":U TO pw_Editor.

/* .cls file handling */
{ adecomm/pcmpcls.i }

/* RETURN-VALUE error processing */
{ adecomm/rtnval.i }

{ adecomm/peditor.i }   /* Editor procedures. */

/* _pwrun.p - end of file. */
/*********************************************************************
* Copyright (C) 2005 by Progress Software Corporation. All rights    *
* reserved.  Prior versions of this work may contain portions        *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/**************************************************************************
    Procedure:  _pwsavas.p
    
    Purpose:    Execute Procedure Window File->Save command.

    Syntax :    RUN adecomm/_pwsavas.p (INPUT pw_Editor).

    Parameters:
    Description:
   1.  Test if the file is "untitled".
   2.  If untitled, execute the Save As Dialog, allowing
       user to enter a file name to save.
   3.  Write contents of editor to disk.

    Notes   :
    Authors : John Palazzo
    Date    : January, 1994
    Modified: 6/17/98 adams support for 9.0a remote file management
             05/10/99 tsm   added support for AppBuilder MRU Filelist for
                            unstructured files that can be created from the
                            AppBuilder such as blank, detail and report
                            web objects
**************************************************************************/

/* Procedure Window Global Defines. */
{ adecomm/_pwglob.i }
{ adecomm/_pwattr.i }

/* MRU Filelist Temp Table Definition */
{adeshar/mrudefs.i}

{adeweb/web_file.i}

DEFINE INPUT  PARAMETER pw_Editor   AS WIDGET-HANDLE NO-UNDO.

DEFINE VARIABLE pw_Window AS WIDGET-HANDLE NO-UNDO.

DEFINE VARIABLE AB_License     AS CHARACTER NO-UNDO.
DEFINE VARIABLE Broker_URL     AS CHARACTER NO-UNDO.
DEFINE VARIABLE File_Name      AS CHARACTER NO-UNDO.
DEFINE VARIABLE File_Path      AS CHARACTER NO-UNDO.
DEFINE VARIABLE Dlg_Answer     AS LOGICAL   NO-UNDO.
DEFINE VARIABLE New_Name       AS CHARACTER NO-UNDO.
DEFINE VARIABLE Old_Broker_URL AS CHARACTER NO-UNDO.
DEFINE VARIABLE Option_List    AS CHARACTER NO-UNDO.
DEFINE VARIABLE Private_Data   AS CHARACTER NO-UNDO.
DEFINE VARIABLE Remote_File    AS CHARACTER NO-UNDO.
DEFINE VARIABLE Save_OK        AS LOGICAL   NO-UNDO. 
DEFINE VARIABLE Temp_File      AS CHARACTER NO-UNDO.
DEFINE VARIABLE URL_Host       AS CHARACTER NO-UNDO.
DEFINE VARIABLE Web_File       AS LOGICAL   NO-UNDO.
DEFINE VARIABLE Web_License    AS LOGICAL   NO-UNDO.
DEFINE VARIABLE Web_Untitled   AS LOGICAL   NO-UNDO. 
DEFINE VARIABLE cReturnValue   AS CHARACTER NO-UNDO.
DEFINE VARIABLE cFileWeb       AS CHARACTER NO-UNDO INIT ?.

DO ON STOP UNDO, LEAVE:
    /* Need widget handle of Procedure Window for this editor widget. */
    pw_Window = pw_Editor:WINDOW.

    /* We're about to save to a remote WebSpeed agent if
       1) this procedure window was run from AppBuilder
       2) AppBuilder's Development Mode is remote
       */
    IF SEARCH("adeuib/_uibinfo.r":U) <> ? THEN
    DO:
      RUN adeuib/_uibinfo.p (?, "SESSION":U, "Remote":U, 
                             OUTPUT Remote_File) NO-ERROR.
      RUN adeuib/_uibinfo.p (?, "SESSION":U, "BrokerURL":U, 
                             OUTPUT Broker_URL) NO-ERROR.
      RUN adeuib/_uibinfo.p (?, "SESSION":U, "ABLicense":U, 
                             OUTPUT AB_License) NO-ERROR.
    END.

    IF Remote_File eq "TRUE":U AND 
      pw_Window:PRIVATE-DATA = "_ab.p":U THEN 
      ASSIGN Web_File = TRUE.

    ASSIGN 
      Web_Untitled   = (pw_Editor:NAME BEGINS {&PW_Untitled} AND Web_File)
      File_Name      = (IF pw_Editor:NAME BEGINS {&PW_Untitled} 
                        THEN "" ELSE pw_Editor:NAME)
      Old_Broker_URL = ENTRY ( {&PW_Broker_URL_Pos}, pw_Editor:PRIVATE-DATA )
      Web_License    = AB_License > "1":U.
                             
    /* Handle cases where local file is being saved remotely or remote 
       file is being saved locally.  Strip off the file path, since it 
       will invariably be invalid. */
    IF File_Name ne "" AND File_Name ne ? AND
      ((Remote_File eq "TRUE":U AND Old_Broker_URL eq "") OR
       (Remote_File eq "TRUE":U AND Old_Broker_URL ne Broker_URL) OR
       (Remote_File ne "TRUE":U AND Old_Broker_URL ne "")) THEN DO:
      RUN adecomm/_osprefx.p (File_Name, OUTPUT File_Path, OUTPUT New_Name).
      File_Name = New_Name.
    END.

    IF Web_License AND Web_File THEN DO:

      RUN adeweb/_webfile.w ("uib":U, "saveas":U, "Save As":U, "":U,
                             INPUT-OUTPUT File_Name, OUTPUT Temp_File, 
                             OUTPUT Dlg_Answer) NO-ERROR.

      IF ws-get-save-as-path (INPUT File_Name) NE ? THEN
          /* file name passed by _webfile.w may have the path to construct
             the full name.
          */
          ASSIGN cFileWeb = File_Name
                 File_Name = ws-get-absolute-path (INPUT File_Name).

    END.
    ELSE
      RUN adecomm/_getfile.p ( pw_Window , INPUT "Procedure" ,
                              "Save As" , "Save As" , "SAVE", 
                              INPUT-OUTPUT File_Name ,
                              OUTPUT Dlg_Answer ).       

    IF Dlg_Answer = YES AND File_Name ne ? THEN DO:
      IF Web_File THEN
        Option_List = (IF Web_Untitled THEN CHR(3) + "untitled":U ELSE "").
                   
      /* Save file to disk. */
      RUN adecomm/_pwsavef.p ( INPUT pw_Editor , 
                               INPUT File_Name + 
                                 (IF NOT Web_File THEN "" ELSE Option_List),
                               TRUE /* Save As */, OUTPUT Save_OK ).
      ASSIGN cReturnValue = RETURN-VALUE.                                                    

      IF SEARCH("adeuib/_uibinfo.r":U) <> ? THEN
        RUN adeuib/_uibinfo.p (?, "SESSION":U, "URLhost":U, 
                               OUTPUT URL_Host) NO-ERROR.
      /* If Save_OK is true, the ed:SAVE-FILE was successful and the ed:NAME 
         field has the saved file name. So update the Window title. */
      IF Save_OK THEN DO:
      
        IF Web_License AND Web_File AND (cFileWeb NE ?) THEN DO:
            /* need to make sure we display only the relative path part of 
               the file name
            */
            ASSIGN pw_Editor:NAME = ws-get-relative-path (INPUT cFileWeb).
        END.

        ASSIGN pw_Window:TITLE = {&PW_Title_Leader} + pw_Editor:NAME +
                                 (IF Web_File THEN URL_Host ELSE "").
      END.

      ELSE RETURN.
   
      IF pw_Window:PRIVATE-DATA = "_ab.p":U AND Web_File /*Web_Untitled */ THEN 
        RUN adeshar/_mrulist.p ((IF cFileWeb NE ? THEN cFileWeb ELSE pw_Editor:NAME), 
                                Broker_URL).

      ASSIGN 
        Private_Data           = pw_Editor:PRIVATE-DATA 
        ENTRY ( {&PW_Broker_URL_Pos}, Private_Data ) = 
          (IF Web_File THEN Broker_URL ELSE "")
        /* save the full file name for Web Files */
        ENTRY ( {&PW_Web_File_Name_Pos}, Private_Data ) = 
           (IF Web_File THEN File_Name ELSE "")
          
        pw_Editor:PRIVATE-DATA = Private_Data.
    END.
    ELSE RETURN "ERROR".
END.
RETURN cReturnValue.

/* RETURN-VALUE error processing */
{ adecomm/rtnval.i }

/* _pwsavas.p - end of file */
/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/**************************************************************************
    Procedure:  _pwsave.p
    
    Purpose:    Execute Procedure Window File->Save command.

    Syntax :    RUN adecomm/_pwsave.p (INPUT pw_Editor).

    Parameters:
    Description:
   1.  Test if the file is "untitled".
   2.  If untitled, execute the Save As Dialog, allowing
       user to enter a file name to save.
   3.  Write contents of editor to disk.

    Notes  :
    Authors: John Palazzo
    Date   : January, 1994
**************************************************************************/

/* Procedure Window Global Defines. */
{ adecomm/_pwglob.i }

DEFINE INPUT  PARAMETER pw_Editor   AS WIDGET-HANDLE NO-UNDO.

DEFINE VARIABLE pw_Window AS WIDGET-HANDLE NO-UNDO.

DEFINE VARIABLE File_Name  AS CHARACTER NO-UNDO.
DEFINE VARIABLE SAVE_OK    AS LOGICAL   NO-UNDO. 
DEFINE VARIABLE Dlg_Answer AS LOGICAL   NO-UNDO.

DO ON STOP UNDO, LEAVE:
    /* Need widget handle of Procedure Window for this editor widget. */
    pw_Window = pw_Editor:WINDOW.
           
    /* If Untitled, open Save As dialog box. */
    IF pw_Editor:NAME BEGINS {&PW_Untitled}
    THEN DO:
        /* Save As routine takes care of actually saving the file. */
        RUN adecomm/_pwsavas.p (INPUT pw_Editor).
        RETURN RETURN-VALUE.
    END.
    RUN adecomm/_pwsavef.p ( INPUT pw_Editor , 
                           INPUT pw_Editor:NAME ,
                           FALSE /* Save */, OUTPUT SAVE_OK ).    
    RETURN RETURN-VALUE.                       
                           
    /* This is redundant, since it's already done in _pwsavef.p.
    ASSIGN pw_Window:TITLE = {&PW_Title_Leader} + pw_Editor:NAME. 
    */
END.
/*********************************************************************
* Copyright (C) 2005 by Progress Software Corporation. All rights    *
* reserved.  Prior versions of this work may contain portions        *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/
/**************************************************************************
    Procedure:  _pwsavef.p
    
    Purpose:    Low-level routine to save editor contents to disk file.  If
                saving to a remote WebSpeed agent, this program will save the
                editor contents to a local temp file only.

    Syntax :    RUN adecomm/_pwsavef.p ( INPUT p_Editor , 
                                         INPUT p_File_Selected , 
                                         TRUE [FALSE],
                                         OUTPUT p_Saved_File ) .

    Parameters: p_Editor
                
                p_File_Selected
                  If saving to a WebSpeed agent, this parameter will contain
                  the name of file to save and the local temp file, separated 
                  by CHR(3).
                  
                p_Save_Mode
                  Save As (TRUE) or Save (FALSE)
                
                p_Saved_File
                
    Description:
    Notes   :
    Authors : John Palazzo
    Date    : January, 1994
    Modified: 06/15/98 adams Added 9.0A support for remote file management
              02/23/00 adams Added 9.1B support for converting/compiling HTML 
                             files locally
**************************************************************************/

{src/web/method/cgidefs.i NEW}

/* Procedure Window Global Defines. */
{ adecomm/_pwglob.i }
{ adecomm/_pwattr.i }

DEFINE INPUT  PARAMETER p_Editor         AS WIDGET-HANDLE NO-UNDO.
DEFINE INPUT  PARAMETER p_File_Selected  AS CHARACTER     NO-UNDO.
DEFINE INPUT  PARAMETER p_Save_As        AS LOGICAL       NO-UNDO.
DEFINE OUTPUT PARAMETER p_Saved_File     AS LOGICAL       NO-UNDO.

DEFINE VARIABLE AB_License     AS CHARACTER     NO-UNDO.
DEFINE VARIABLE Broker_URL     AS CHARACTER     NO-UNDO.
DEFINE VARIABLE Compile_File   AS LOGICAL       NO-UNDO.
DEFINE VARIABLE Compile_Prompt AS LOGICAL       NO-UNDO.
DEFINE VARIABLE Convert_File   AS CHARACTER     NO-UNDO.
DEFINE VARIABLE E4GLOptions    AS CHARACTER     NO-UNDO.
DEFINE VARIABLE File_Ext       AS CHARACTER     NO-UNDO.
DEFINE VARIABLE Html_File      AS LOGICAL       NO-UNDO.
DEFINE VARIABLE Local_Host     AS CHARACTER     NO-UNDO.
DEFINE VARIABLE lScrap         AS LOGICAL       NO-UNDO.
DEFINE VARIABLE No_Compile     AS LOGICAL       NO-UNDO.
DEFINE VARIABLE Ok_To_Save     AS LOGICAL       NO-UNDO INITIAL TRUE.
DEFINE VARIABLE Old_Broker_URL AS CHARACTER     NO-UNDO.
DEFINE VARIABLE Option_List    AS CHARACTER     NO-UNDO.
DEFINE VARIABLE Private_Data   AS CHARACTER     NO-UNDO.
DEFINE VARIABLE pw_Window      AS WIDGET-HANDLE NO-UNDO.
DEFINE VARIABLE Rel_Name       AS CHARACTER     NO-UNDO.
DEFINE VARIABLE Remote_File    AS CHARACTER     NO-UNDO.
DEFINE VARIABLE Scrap_File     AS CHARACTER     NO-UNDO.
DEFINE VARIABLE Temp_File      AS CHARACTER     NO-UNDO.
DEFINE VARIABLE URL_Host       AS CHARACTER     NO-UNDO.
DEFINE VARIABLE Web_Action     AS CHARACTER     NO-UNDO.
DEFINE VARIABLE Web_Error      AS LOGICAL       NO-UNDO.
DEFINE VARIABLE Web_File       AS LOGICAL       NO-UNDO.
DEFINE VARIABLE Web_License    AS LOGICAL       NO-UNDO.
DEFINE VARIABLE Web_Object     AS CHARACTER     NO-UNDO.
DEFINE VARIABLE Web_Untitled   AS LOGICAL       NO-UNDO.
DEFINE VARIABLE lOK            AS LOGICAL       NO-UNDO.
DEFINE VARIABLE cValue         AS CHARACTER NO-UNDO.
DEFINE VARIABLE hTempDBLib     AS HANDLE    NO-UNDO.  
DEFINE VARIABLE cRelName       AS CHARACTER NO-UNDO.
DEFINE VARIABLE cTables        AS CHARACTER NO-UNDO.
DEFINE VARIABLE cFileWeb       AS CHARACTER NO-UNDO INIT ?.

/* --- Begin SCM changes --- */
DEFINE VARIABLE scm_ok    AS LOGICAL       NO-UNDO.
/* --- End SCM changes ----- */

DO ON STOP UNDO, LEAVE:
  /* Get widget handles of Procedure Window. */
  RUN adecomm/_pwgetwh.p ( INPUT p_Editor , OUTPUT pw_Window ).

  IF pw_Window:PRIVATE-DATA = "_ab.p":U THEN DO:
    /* This could be part of a remote WebSpeed Save As, in which case we need 
       to save to a local temp file first. */
    IF NUM-ENTRIES( p_File_Selected, CHR(3)) ge 2 THEN
      ASSIGN
        Option_List     = ENTRY( 2, p_File_Selected, CHR(3))
        p_File_Selected = ENTRY( 1, p_File_Selected, CHR(3))
        Web_Untitled    = CAN-DO(Option_List, "untitled":U)
        Option_List     = "".

    /* Check AppBuilder Development Mode. */
    IF SEARCH("adeuib/_uibinfo.r":U) <> ? THEN DO:
      RUN adeuib/_uibinfo.p ( ?, "SESSION":U, "REMOTE":U, 
                              OUTPUT Remote_File ) NO-ERROR.
      RUN adeuib/_uibinfo.p ( ?, "SESSION":U, "BrokerURL":U, 
                              OUTPUT Broker_URL ) NO-ERROR.
      RUN adeuib/_uibinfo.p ( ?, "SESSION":U, "ABLicense":U, 
                              OUTPUT AB_License ) NO-ERROR.
      RUN adeuib/_uibinfo.p ( ?, "SESSION":U, "LocalHost":U, 
                              OUTPUT Local_Host ) NO-ERROR.
    END.

    ASSIGN    
      Old_Broker_URL  = ENTRY({&PW_Broker_URL_Pos}, p_Editor:PRIVATE-DATA)
      Web_License     = AB_License > "1":U.
    
    /* for web files, we store the full path name for the file in the private-date,
       so get it if it's there. Don't do this for save-as since we already get the
       full path name in that case.
    */
    IF NOT p_Save_As THEN
       cFileWeb = ENTRY ( {&PW_Web_File_Name_Pos}, p_Editor:PRIVATE-DATA) NO-ERROR.
    
    IF cFileWeb = ? OR cFileWeb = "" THEN
       cFileWeb =  p_File_Selected.

    /* Get temp file name to use for saving to a remote WebSpeed agent. Either
       we're attempting a SaveAs (in which case the value of Remote_File is
       important) on a new or existing file or we want to Save an existing 
       file. */
    IF (    p_Save_As AND Remote_File eq "TRUE":U) OR
       (NOT p_Save_As AND Old_Broker_URL ne "") OR Web_Untitled THEN DO:
    
      RUN adecomm/_tmpfile.p ( "ws":U, ".tmp":U, OUTPUT Temp_File ).
      Web_File = TRUE.
    END.
    
    IF NOT p_Save_As THEN 
      Broker_URL = IF Old_Broker_URL eq "" THEN Broker_URL ELSE Old_Broker_URL.
      
  END. /* pw_Window:PRIVATE-DATA = "_ab.p":U */
  
  RUN adecomm/_osfext.p ( p_File_Selected, OUTPUT File_Ext ).
  IF (File_Ext eq ".htm":U OR File_Ext eq ".html":U) THEN
    Html_File = TRUE.
    
  /* --- Begin SCM changes --- */
  RUN adecomm/_adeevnt.p 
      (INPUT  {&PW_NAME} , INPUT "Before-Save",
       INPUT STRING( p_Editor ), INPUT p_File_Selected , 
       OUTPUT scm_ok ).
  IF scm_ok = FALSE THEN
  DO:
      ASSIGN p_Saved_File = FALSE.  /* Cancel Save. */
      RETURN.
  END.
  /* --- End SCM changes ----- */

  ASSIGN p_Saved_File = p_Editor:SAVE-FILE 
    ( IF Web_File THEN Temp_File ELSE p_File_Selected ) NO-ERROR.

  IF ( p_Saved_File = FALSE )
  THEN DO:
      MESSAGE p_File_Selected SKIP
        "Cannot save to this file."  SKIP(1)
        "File is read-only or the path specified" SKIP
        "is invalid. Use a different filename."
        VIEW-AS ALERT-BOX WARNING BUTTONS OK IN WINDOW pw_Window.
     RETURN "ERROR":U.
  END.
  ELSE DO:

    RUN SetEdBufType (INPUT p_Editor, INPUT p_File_Selected).   /* adecomm/peditor.i */

    /* Save WebSpeed file remotely and/or compile it. */
    IF Web_License AND (Html_File OR Web_File) THEN DO:
      IF Web_File THEN DO:
        /* Check to see if the file already exists or is writeable for Save.  For
           SaveAs, we already checked in adecomm/_pwsavas.p (adeweb/_webfile.w), 
           so there is no need to do it again. */
        IF NOT p_Save_As THEN DO:
          RUN adeweb/_webcom.w ( ?, Broker_URL, cFileWeb, "saveas:okToSave":U,
                                 OUTPUT Rel_Name, INPUT-OUTPUT Scrap_File ) NO-ERROR.

          /* We're only interested in 'writeable' case, not 'file exists'. */
          IF INDEX(RETURN-VALUE, "Not writeable":U) ne 0 THEN
            RUN returnValue ( RETURN-VALUE, p_File_Selected, "saved", 
                              OUTPUT Ok_To_Save ).
        END.
      END.
      
      IF Web_File OR (NOT Web_File AND Html_File) THEN DO:
        /* Check for special flags indicating whether we should compile. */
        IF Ok_To_Save THEN DO:
          IF Web_File THEN DO: /* remote */
            RUN adeweb/_webcom.w ( ?, Broker_URL, cFileWeb, "save":U,
                                  OUTPUT Rel_Name, INPUT-OUTPUT Temp_File ) NO-ERROR.
            IF INDEX(RETURN-VALUE, "No compile":U) ne 0 THEN
              No_Compile = TRUE.
            ELSE IF INDEX(RETURN-VALUE, "Do compile":U) ne 0 THEN
              Compile_File = TRUE.
            ELSE IF RETURN-VALUE BEGINS "ERROR:":U THEN DO:
              RUN returnValue ( RETURN-VALUE, p_File_Selected, "saved", 
                                OUTPUT lScrap ).
              p_Saved_File = FALSE.
            END.
          END. /* remote */
          ELSE DO: /* local */
            RUN adecomm/_tmpfile.p ("ws", ".cmp":U, OUTPUT Scrap_File).
            E4GLOptions = "".
            RUN webutil/e4gl-gen.p (p_File_Selected, 
                                    INPUT-OUTPUT E4GLOptions, 
                                    INPUT-OUTPUT Scrap_File).
            IF CAN-DO(E4GLOptions, "no-compile":U) THEN
              No_Compile   = TRUE.
            IF CAN-DO(E4GLOptions, "compile":U) THEN
              Compile_File = TRUE.
            OS-DELETE VALUE(Scrap_File).
          END. /* local */
        END. /* Ok_To_Save */
      END.
      OS-DELETE VALUE(Temp_File).

      /* Prompt user to compile the file to rcode if
         1. it's an HTML file and
         2. META wsoption "no-compile" is not present and
         3. META wsoption "compile" is not present and
         4. user has not been prompted before for this file
       */
      IF Html_File AND NOT No_Compile AND NOT Web_Error THEN DO:
        Compile_Prompt  = (ENTRY({&PW_Compile_Prompt_Pos}, 
                             p_Editor:PRIVATE-DATA) BEGINS "YES":U).
        IF NOT Compile_File AND Compile_Prompt THEN
          RUN adecomm/_s-alert.p ( INPUT-OUTPUT Compile_File, "question":U, "yes-no":U,
            "If this file contains SpeedScript you can compile it into a runnable Web object on your WebSpeed agent.^^Do you want to compile it now?" ).
          
        /* Does file contain META "compile" option or has user previously 
           said they want to compile the file when saving? */
        ELSE
          Compile_File = Compile_File OR 
                         ENTRY(2, ENTRY({&PW_Compile_Prompt_Pos}, 
                           p_Editor:PRIVATE-DATA), ":":U) = "YES":U.
      END.

      /* Compile the HTML file to SpeedScript rcode. */
      IF Html_File AND Compile_File AND p_Saved_File AND NOT Web_Error THEN DO:
        Web_Object = SUBSTRING(cFileWeb, 1,
                               R-INDEX(cFileWeb, ".":U),
                               "CHARACTER":U) + "w":U.
      
        /* Check remotely to see if the .w file exists or is writeable. */
        IF Web_File THEN DO:
          RUN adeweb/_webcom.w ( ?, Broker_URL, Web_Object, "COMPILE:okToSave":U,
                                 OUTPUT Rel_Name, INPUT-OUTPUT Temp_File ) NO-ERROR.
          IF RETURN-VALUE BEGINS "ERROR:":U THEN
            RUN returnValue ( RETURN-VALUE, Web_Object, "compiled", 
                              OUTPUT Ok_To_Save ).
        END.
        /* Check locally */
        ELSE IF SEARCH(Web_Object) NE ? THEN
          RUN adecomm/_s-alert.p ( INPUT-OUTPUT Ok_To_Save, "warning":U, "yes-no":U,
            SUBSTITUTE("An intermediate SpeedScript file cannot be created for &1.^^&2 already exists.^Do you want to replace it?",
            p_File_Selected,Web_Object)).

        IF Ok_To_Save THEN DO:
          IF Web_File THEN DO: /* remote */
            /* Create the Web object (.w) and compile it (.r). */
            RUN adeweb/_webcom.w (?, Broker_URL, cFileWeb, "COMPILE":U,
                                OUTPUT Rel_Name, INPUT-OUTPUT Temp_File) NO-ERROR.
            IF RETURN-VALUE BEGINS "ERROR:":U THEN
              RUN returnValue (RETURN-VALUE, p_File_Selected, "compiled", 
                               OUTPUT lScrap ).
          END.
          ELSE DO: /* local */
            E4GLOptions = "".
            RUN webutil/e4gl-gen.p (p_File_Selected, 
                                    INPUT-OUTPUT E4GLOptions, 
                                    INPUT-OUTPUT Web_Object).
            COMPILE VALUE(Web_Object) SAVE NO-ERROR.
            IF COMPILER:ERROR THEN DO:
              RUN adecomm/_tmpfile.p ("ws", ".cmp":U, OUTPUT Scrap_File).
              RUN adecomm/_errmsgs.p (INPUT pw_Window ,
                                      INPUT COMPILER:FILENAME ,
                                      INPUT Scrap_File ).
              OS-DELETE VALUE(Scrap_File).
            END.
            OS-DELETE VALUE(Web_Object).            
          END.
        END.
      END. /* Html_File and Compile_File */
    END. /* Html_File or Web_File */

    IF Web_File THEN
      OS-DELETE VALUE(Temp_File).

    IF SEARCH("adeuib/_uibinfo.r":U) <> ? THEN
      RUN adeuib/_uibinfo.p (?, "SESSION":U, "URLhost":U, 
                             OUTPUT URL_Host) NO-ERROR.

    /* Assign new file name to editor widget and update Window title. */
    IF p_Saved_File THEN
      ASSIGN p_Editor:NAME         = p_File_Selected
             pw_Window:TITLE       = {&PW_Title_Leader} + p_Editor:NAME +
                                     (IF Web_File THEN URL_Host ELSE "")
             Private_Data          = p_Editor:PRIVATE-DATA
             ENTRY( {&PW_Broker_URL_Pos}, Private_Data ) = 
                                     (IF Web_File THEN Broker_URL ELSE "")
                                     
             /* Don't prompt again to compile the HTML file to rcode, but 
                use last response to the prompt or existance of META "compile" 
                option to drive compile feature. */
             ENTRY( {&PW_Compile_Prompt_Pos}, Private_Data ) = "NO:":U +
                                     (IF Compile_File THEN "YES":U ELSE "NO":U)

             /* Clear the compile filename, in case this buffer previously
             ** contained a compiled file.  We will generate a new compile
             ** file name when the new buffer is run.
             */
             ENTRY( {&PW_Compile_File_Pos}, Private_Data ) = ""
             p_Editor:PRIVATE-DATA = Private_Data.
        
    /* Reset the EDIT-CAN-UNDO attribute. */
    ASSIGN p_Editor:EDIT-CAN-UNDO = FALSE.

    /* Integration with the TEMP-DB Maintenance tool */
    IF p_Saved_File AND NOT Web_File AND CONNECTED ("TEMP-DB") THEN
    DO:
      RUN adeuib/_tempdbvalid.p (OUTPUT lOK). /* Check that control file is present in TEMP-DB */
      IF lOK THEN
      DO:          
        GET-KEY-VALUE SECTION  "ProAB":U KEY "TempDBIntegration":U VALUE cValue.
        IF CAN-DO ("true,yes,on",cValue) THEN
        DO:
          GET-KEY-VALUE SECTION  "ProAB":U KEY "TempDBExtension":U VALUE cValue.
          IF cValue > "" AND p_File_Selected MATCHES cValue THEN 
          DO:
            RUN adecomm/_relname.p (INPUT p_File_Selected, INPUT "", OUTPUT cRelName).
            RUN adeuib/_tempdbfind.p (INPUT "SOURCE":U,
                                      INPUT cRelName ,
                                      OUTPUT cTables).
            /* Only update if source file already exists */                          
            IF cTables > "" THEN
            DO:
              hTempDBLib = SESSION:FIRST-PROCEDURE.
              DO WHILE VALID-HANDLE(hTempDBLib) AND hTempDBLib:FILE-NAME NE "adeuib/_tempdblib.p":U:
                 hTempDBLib = hTempDBLib:NEXT-SIBLING.
              END.

              IF NOT VALID-HANDLE(hTempDBLib) THEN
              DO:
                RUN VALUE("adeuib/_tempdblib.p":U) PERSISTENT SET hTempDBLib.
                RUN RebuildImport in hTempDBLib (cRelName).
                IF VALID-HANDLE(hTempDBLib) THEN
                  DELETE PROCEDURE hTempDBLib.
              END.
              ELSE   
                RUN RebuildImport in hTempDBLib (cRelName).

            END.
          END.  /* End if file extension matches */
        END.  /* End if flag is set to yes to do perfrom TEmp-DB rebuild */
      END.  /* End if temp-db is valid */
    END.  /* End If connected Temp-DB */


   
    /* --- Begin SCM changes --- */
    RUN adecomm/_adeevnt.p 
        (INPUT  {&PW_NAME} , INPUT "Save",
         INPUT STRING( p_Editor ), INPUT p_Editor:NAME , 
         OUTPUT scm_ok ).
    /* --- End SCM changes ----- */
    
    RUN adecomm/_setcurs.p ("").
  END. /* p_Saved_File = TRUE */
END.
RETURN.

/* RETURN-VALUE error processing */
{ adecomm/rtnval.i }

{ adecomm/peditor.i }   /* Editor procedures. */

/* _pwsavef.p - end of file */
/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/**************************************************************************
    Procedure:  _pwsrch.p
    
    Purpose:    Execute Procedure Window Search menu commands.

    Syntax :    RUN adecomm/_pwsrch.p ( INPUT p_Action ) .

    Parameters:
    Description:
    Notes  :
    Authors: John Palazzo
    Date   : January, 1994
**************************************************************************/

/* ADE Standards Include. */
&GLOBAL-DEFINE WIN95-BTN YES

{ adecomm/adestds.i }
IF NOT initialized_adestds
THEN RUN adecomm/_adeload.p.

/* Procedure Window Global Defines. */
{ adecomm/_pwglob.i }

/* Procedure Window Attributes include. */
{ adecomm/_pwattr.i }

/* Search defines and procedures. */
{ adecomm/dsearch.i }
{ adecomm/psearch.i }       

DEFINE INPUT PARAMETER p_Action AS CHARACTER NO-UNDO.

DEFINE VARIABLE pw_Window       AS WIDGET-HANDLE NO-UNDO.
DEFINE VARIABLE pw_Editor       AS WIDGET-HANDLE NO-UNDO.
DEFINE VARIABLE hAttr_Field     AS WIDGET-HANDLE NO-UNDO.
DEFINE VARIABLE l_ok            AS LOGICAL       NO-UNDO.
DEFINE VARIABLE h_cwin          AS WIDGET-HANDLE NO-UNDO.


PROCEDURE GetSrchAttr.
/**************************************************************************
    Purpose:    Gets the persistent PW Search Attributes and assigns them
                to the appropriate Common Dialog field variables.

    Syntax :    RUN GetSrchAttr ( INPUT p_Editor , INPUT p_Action ) .

    Parameters:
    Description:
    Notes  :
    Authors: John Palazzo
    Date   : January, 1994
**************************************************************************/

DEFINE INPUT PARAMETER p_Editor AS WIDGET-HANDLE NO-UNDO.
DEFINE INPUT PARAMETER p_Action AS CHARACTER     NO-UNDO.
        
DEFINE VARIABLE hFind_Text      AS WIDGET-HANDLE NO-UNDO.        
DEFINE VARIABLE hRepl_Text      AS WIDGET-HANDLE NO-UNDO.        

DO:
    /* Get the persistent Find Field values. */
    RUN GetFrameAttr ( INPUT p_Editor:FRAME , INPUT {&PW_Find_Text} ,
                       OUTPUT hFind_Text ).
    ASSIGN Find_Text = hFind_Text:PRIVATE-DATA .
    
    IF p_Action BEGINS "FIND"
    THEN DO:
    ASSIGN Find_Direction                 =
                ENTRY( {&PW_Find_Direction_Pos} , p_Editor:PRIVATE-DATA )
           Find_Filters[ Case_Sensitive ] =
              ( ENTRY( {&PW_Find_Case_Pos} , p_Editor:PRIVATE-DATA ) =
                STRING( TRUE , Find_Filters[1]:FORMAT IN FRAME FindText ) )
           Find_Filters[ Wrap_Around ]    =
              ( ENTRY( {&PW_Find_Wrap_pos} , p_Editor:PRIVATE-DATA ) =
                STRING( TRUE , Find_Filters[2]:FORMAT IN FRAME FindText ) )
           .
    END. /* Find */                         
           
    IF p_Action BEGINS "REPLACE"
    THEN DO:
    /* Get the persistent Replace Field values. */
    RUN GetFrameAttr ( INPUT p_Editor:FRAME , INPUT {&PW_Replace_Text} ,
                       OUTPUT hRepl_Text ).
    ASSIGN Replace_Text = hRepl_Text:PRIVATE-DATA .
    
    ASSIGN Replace_Filters[ Case_Sensitive ] =
              ( ENTRY( {&PW_Replace_Case_Pos} , p_Editor:PRIVATE-DATA ) =
                STRING( TRUE , Replace_Filters[1]:FORMAT IN FRAME ReplaceText ) )
           /* Wrap not supported in Replace.
           Replace_Filters[ Wrap_Around ]    =
              ( ENTRY( {&PW_Replace_Wrap_pos} , p_Editor:PRIVATE-DATA ) =
                STRING( TRUE , Replace_Filters[2]:FORMAT IN FRAME ReplaceText ) )
           */
           .
    END. /* Replace */
END.

END PROCEDURE.


PROCEDURE PutSrchAttr.
/**************************************************************************
    Purpose:    Puts the Search Common Dialogs field variable values into
                the persistent PW Search Attributes.

    Syntax :    RUN PutSrchAttr ( INPUT p_Editor , p_Action ) .

    Parameters:
    Description:
    Notes  :
    Authors: John Palazzo
    Date   : January, 1994
**************************************************************************/
        
DEFINE INPUT PARAMETER p_Editor AS WIDGET-HANDLE NO-UNDO.
DEFINE INPUT PARAMETER p_Action AS CHARACTER     NO-UNDO.

DEFINE VARIABLE hFind_Text      AS WIDGET-HANDLE NO-UNDO.
DEFINE VARIABLE hRepl_Text      AS WIDGET-HANDLE NO-UNDO.
DEFINE VARIABLE Private_Data    AS CHARACTER     NO-UNDO.        

DO:
    /* Put the dialog values back into the PW Attribute Fields. */
    RUN GetFrameAttr ( INPUT p_Editor:FRAME , INPUT {&PW_Find_Text} ,
                       OUTPUT hFind_Text ).
    RUN GetFrameAttr ( INPUT p_Editor:FRAME , INPUT {&PW_Replace_Text} ,
                       OUTPUT hRepl_Text ).

    /* Bug workaround - ENTRY statement balks at :PRIVATE-DATA. */
    ASSIGN Private_Data = p_Editor:PRIVATE-DATA.             
    /* FIND */
    ASSIGN hFind_Text:PRIVATE-DATA        = Find_Text
           ENTRY( {&PW_Find_Direction_Pos} , Private_Data )
                = Find_Direction
           ENTRY( {&PW_Find_Case_Pos} , Private_Data )
                = STRING( Find_Filters[Case_Sensitive] )
           ENTRY( {&PW_Find_Wrap_Pos} , Private_Data )
                = STRING( Find_Filters[ Wrap_Around ]  )
           .
    /* REPLACE */
    ASSIGN hRepl_Text:PRIVATE-DATA        = Replace_Text
           ENTRY( {&PW_Replace_Case_Pos} , Private_Data )
                = STRING( Replace_Filters[Case_Sensitive] )
           .
    ASSIGN p_Editor:PRIVATE-DATA = Private_Data.
END.

END PROCEDURE.


/* MAIN */
DO:
  REPEAT ON STOP UNDO, RETRY:
    IF RETRY THEN LEAVE.
    /* Get widget handles of Procedure Window and its editor widget. */
    RUN adecomm/_pwgetwh.p ( INPUT SELF , OUTPUT pw_Window ).
    RUN adecomm/_pwgeteh.p ( INPUT pw_Window , OUTPUT pw_Editor ).

    /* Save current-window handle to restore later. */
    ASSIGN h_cwin         = CURRENT-WINDOW
           CURRENT-WINDOW = pw_Window.               
    
    /* Get the current values of the Search fields. */
    RUN GetSrchAttr ( INPUT pw_Editor , p_Action ).
            
    CASE p_Action:
        WHEN "FIND"      THEN RUN FindText ( pw_Editor ).
           
        WHEN "FIND-NEXT" THEN RUN FindNext ( pw_Editor , FIND-NEXT-OCCURRENCE ).
        
        WHEN "FIND-PREV" THEN RUN FindPrev ( pw_Editor , FIND-PREV-OCCURRENCE ).
        
        WHEN "REPLACE"   THEN RUN ReplaceText ( pw_Editor ).
        
        WHEN "GOTO-LINE" THEN RUN GotoLine ( pw_Editor ).
    END CASE.

    /* Put the current values of the Search fields to the PW attribtes. */
    RUN PutSrchAttr ( INPUT pw_Editor , p_Action ).

    LEAVE.
  END. /* REPEAT */                                                   

  /* Repoint current-window. */
  IF VALID-HANDLE( h_cwin ) THEN ASSIGN CURRENT-WINDOW = h_cwin .
END. /* DO */
/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/**************************************************************************
    Procedure:  _pwwinst.p
    
    Purpose:    Sets the Window State of all Procedure Windows which are
                children of a specified Parent.

    Syntax :    
                RUN adecomm/_pwwinst.p (INPUT p_Parent_ID    ,
                                        INPUT p_Window_State ).

    Parameters:
        p_Parent_ID
            - String value indicating Parent of PW.  This can be any SESSION
              unique string, such as "UIB" or the string of the Parent window
              handle. It must be the same Parent Id used to open the PW.
    Description:
    Notes  :
    Authors: John Palazzo
    Date   : February, 1994
**************************************************************************/

/* Procedure Window Global Defines. */
{ adecomm/_pwglob.i }
  
DEFINE INPUT PARAMETER p_Parent_ID    AS CHARACTER NO-UNDO.
DEFINE INPUT PARAMETER p_Window_State AS INTEGER   NO-UNDO.

DEFINE VARIABLE nxt       AS WIDGET-HANDLE NO-UNDO.
DEFINE VARIABLE pw_Window AS WIDGET-HANDLE NO-UNDO.

/* proc-main */
DO ON STOP UNDO , LEAVE :
  
      ASSIGN nxt = DEFAULT-WINDOW.
      REPEAT WHILE nxt:PREV-SIBLING <> ?: 
          ASSIGN nxt = nxt:PREV-SIBLING.
      END.
     
      REPEAT WHILE nxt <> ?: 
          ASSIGN pw_Window = nxt
                 nxt         = nxt:NEXT-SIBLING
          . /* END ASSIGN */
          /* Is this a Procedure Window and is it a "child window" of the
             Parent window passed? If Yes, change state.
          */
          IF pw_Window:NAME = {&PW_NAME}
             AND pw_Window:PRIVATE-DATA = p_Parent_ID
          THEN DO:                                                           
            CASE p_Window_State:
                WHEN WINDOW-MINIMIZED
                    THEN 
                        ASSIGN pw_Window:WINDOW-STATE = WINDOW-MINIMIZED .
                
                OTHERWISE
                    DO:
                        /* Restore state only if minimized. */
                        IF ( pw_Window:WINDOW-STATE = WINDOW-MINIMIZED )
                        THEN ASSIGN pw_Window:WINDOW-STATE = p_Window_State .
                    END.
            END CASE.
          END. /* IF */
      END. /* REPEAT */
      
END. /* DO ON STOP */
/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/*----------------------------------------------------------------------------

File: _qaredat.p

Description:
   Display _Area and Extent information for the quick index report.  It will go to 
   the currently set output device (e.g., a file, the printer).
 
Input Parameters:
   p_DbId - Id of the _Db record for this database.
   p_area  - The name of the area we're showing or "ALL".

Author: Donna L. McMann

Date Created: 1/5/98
    Modified: 04/09/98 D. McMann changed the area type from a number to the name.
              04/14/00 D. McMann Added long path name support 


----------------------------------------------------------------------------*/

DEFINE INPUT PARAMETER p_DbId AS RECID NO-UNDO.


DEFINE SHARED STREAM rpt.
DEFINE VAR answer AS LOGICAL INITIAL FALSE NO-UNDO.
Define variable Etype    as logical format "Variable/Fixed" NO-UNDO.
DEFINE VARIABLE esize    AS CHARACTER  FORMAT "x(11)"       NO-UNDO.
DEFINE VARIABLE ename    AS CHARACTER  FORMAT "x(30)"       NO-UNDO.
DEFINE VARIABLE epath    AS CHARACTER                       NO-UNDO.
DEFINE VARIABLE epname   AS CHARACTER                       NO-UNDO.
DEFINE VARIABLE atype    AS CHARACTER  FORMAT "x(20)"       NO-UNDO.
DEFINE VARIABLE i        AS INTEGER                         NO-UNDO.
DEFINE VARIABLE areatype AS CHARACTER EXTENT 7              NO-UNDO.
ASSIGN areatype[1] = "Invalid"
       areatype[2] = "Control Recovery"
       areatype[3] = "Before-image"
       areatype[4] = "Transaction Log"
       areatype[5] = "Event Log"
       areatype[6] = "Data"
       areatype[7] = "After-image".

FORM
    _area._area-number label "Area Number"            
    atype  label  "Type" SPACE (5)
    _area-blocksize format ">>>>>9" label "Block Size" SKIP space (5)
     _area-extents format ">>>9" label "Total Extents in Area" SPACE (5)
    _area-name label "Name"
   SKIP
   WITH FRAME areahdr WIDTH 80 USE-TEXT SIDE-LABELS STREAM-IO.

FORM
  space (5)
   _extent-number Label "Extent #"
   etype  Label "Type"
   esize  Label "Size" 
   ename  label "Name"
  WITH FRAME shoextent 
  DOWN USE-TEXT STREAM-IO.

FORM 
    epname FORMAT "x(5)" epath  FORMAT "x(70)" 
    WITH FRAME shopath NO-LABELS DOWN USE-TEXT STREAM-IO.

FORM
  SKIP(1) 
  SPACE(3) _Area._Area-name LABEL "Working on" FORMAT "x(32)" SPACE
  SKIP(1)
  WITH FRAME working_on SIDE-LABELS VIEW-AS DIALOG-BOX 
  TITLE "Generating Report".


/*----------------------------Mainline code--------------------------------*/

SESSION:IMMEDIATE-DISPLAY = yes.

FOR EACH _Area NO-LOCK :
       
   PAGE STREAM rpt.

      DISPLAY _Area._Area-name 
          WITH FRAME working_on.
   
   IF _area-type = 0 THEN
     DISPLAY STREAM rpt _Area._Area-name _area._area-number 
        areatype[_area-type + 1 ] @ atype _area-blocksize _area-extents
        WITH FRAME areahdr.

   ELSE
     DISPLAY STREAM rpt _Area._Area-name _area._area-number 
        areatype[_area-type] @ atype _area-blocksize _area-extents
        WITH FRAME areahdr.
   
  FOR EACH _AreaExtent OF _Area NO-LOCK
     BREAK BY _AreaExtent._Extent-path:
     
     /* Currently you can only have fixed and variable length area extents
        but there is also a raw type.  When this is available this code
        has to change to handle three types FIXED,VARIABLE,RAW
     */   
      IF _extent-size = 0 then 
        assign etype = true
               esize = "N/A".
               
       else 
         assign etype = false
                esize = STRING(_extent-size).

      IF LENGTH(_AreaExtent._extent-path) < 30 THEN
          ASSIGN ename = _AreaExtent._extent-path.
          
     
     ELSE 
        _ename:
        DO i = LENGTH(_AreaExtent._extent-path) TO 1 BY -1:
          IF SUBSTRING(_AreaExtent._extent-path,i,1) = "~/" OR
             SUBSTRING(_AreaExtent._extent-path,i,1) = "~\" THEN DO:         
            ASSIGN ename = SUBSTRING(_AreaExtent._extent-path,i + 1).
            LEAVE _ename.
          END.
      END.

      DISPLAY STREAM rpt
        _AreaExtent._extent-number
        etype 
        esize   
        ename 
        WITH FRAME shoextent.

        DOWN STREAM rpt WITH FRAME shoExtent.
    IF LENGTH(ename) < LENGTH(_AreaExtent._extent-path) THEN DO:
      IF (LENGTH(_AreaExtent._extent-path) - LENGTH(ename) + 1) < 70 THEN DO:
          ASSIGN epath = SUBSTRING(_AreaExtent._extent-path,1,i)
                 epname = "Path: ".
          DISPLAY STREAM rpt epname epname epath WITH FRAME shopath.
          DOWN STREAM rpt WITH FRAME shopath.
      END.
      ELSE DO: 
        ASSIGN ename  = SUBSTRING(_AreaExtent._extent-path,1,i)
               epname = "Path:"
               epath  = SUBSTRING(ename,1,70).

        _getpath:
        DO WHILE TRUE:  
          _ename:
          DO i = LENGTH(epath) TO 1 BY -1:
            IF SUBSTRING(epath,i,1) = "~/" OR SUBSTRING(epath,i,1) = "~\" 
            THEN DO:         
              ASSIGN epath = SUBSTRING(epath,1,i)
                     ename = SUBSTRING(ename,(LENGTH(epath) + 1)).
              LEAVE _ename.
            END.
          END.

          DISPLAY STREAM rpt epname epath WITH FRAME shopath.        
          DOWN STREAM rpt WITH FRAME shopath.
          IF LENGTH(ename) > 0 THEN
             ASSIGN epath = SUBSTRING(ename,1,70)
                    epname = " ".
          ELSE LEAVE _getpath.
        END.
      END.
    END.
     /* Put an extra line in between each Area. */
    IF LAST-OF(_AreaExtent._Extent-path) THEN 
       PUT STREAM rpt UNFORMATTED " " SKIP.
  END.
END.


   HIDE FRAME working_on NO-PAUSE.
   SESSION:IMMEDIATE-DISPLAY = no.

/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/*----------------------------------------------------------------------------

File: qidxrpt.p

Description:
   Quick and dirty area report for both the GUI and character dictionary.

Input Parameters:
   p_DbId    - Id of the _Db record corresponding to the current database
   p_PName   - Physical name of the database
   p_DbType  - Database type (e.g., PROGRESS)

 
Author: Donna McMann

Date Created: 1/5/98
     History:  09/22/99 Corrected help preprocessor variable

----------------------------------------------------------------------------*/

{adecomm/commeng.i}  /* Help contexts */

DEFINE INPUT PARAMETER p_DbId 	 AS RECID NO-UNDO.
DEFINE VAR header_str AS CHAR 	 NO-UNDO.


header_str =  " Storage Areas and extent information ".

RUN adecomm/_report.p 
   (INPUT p_DbId, 
    INPUT header_str,
    INPUT "Quick Storage Area Report",
    INPUT "",
    INPUT "",
    INPUT "adecomm/_qaredat.p",
    INPUT "",
    INPUT {&QUICK_STORAGE_AREA_REPORT}).


RETURN RETURN-VALUE.
/***********************************************************************
* Copyright (C) 2000,2006 by Progress Software Corporation. All rights *
* reserved.  Prior versions of this work may contain portions          *
* contributed by participants of Possenet.                             *
*                                                                      *
***********************************************************************/
/*----------------------------------------------------------------------------

File: _qflddat.p

Description:
   Display _Field information for the quick field report.  It will go to 
   the currently set output device (e.g., a file, the printer).
 
Input Parameters:
   p_DbId  - Id of the _Db record for this database.
   p_Tbl   - The name of the table whose fields we're showing or "ALL"
   p_Order - "a" for alphabetical order or "o" for _Order order. 

Author: Tony Lavinio, Laura Stern

Date Created: 10/02/92

Modifed on 05/31/95 gfs Allow display of hidden tables (not meta-schema).
           06/14/94 gfs Added NO-LOCKs on file accesses.
           05/10/00 DLM Added check of _owner.
           08/25/03 D. McMann Update report for 10.0A
----------------------------------------------------------------------------*/
{ prodict/fhidden.i }

DEFINE INPUT PARAMETER p_DbId  AS RECID NO-UNDO.
DEFINE INPUT PARAMETER p_Tbl   AS CHAR  NO-UNDO.
DEFINE INPUT PARAMETER p_Order AS CHAR  NO-UNDO.

DEFINE SHARED STREAM rpt.

DEFINE BUFFER   bField FOR _Field.
DEFINE BUFFER   bFile  FOR _File.
DEFINE VARIABLE flags  AS  CHARACTER    NO-UNDO.

FORM
   bFile._File-name  LABEL "Table"
   SKIP
   WITH FRAME tblhdr USE-TEXT STREAM-IO SIDE-LABELS.      

FORM
   bField._Field-name FORMAT "x(27)" COLUMN-LABEL "Field Name"
   bField._Data-type  FORMAT "x(10)" COLUMN-LABEL "Data Type"
   flags              FORMAT "x(3)"  COLUMN-LABEL "Flg"
   bField._Format     FORMAT "x(32)" COLUMN-LABEL "Format"
   WITH FRAME shofield STREAM-IO
   DOWN USE-TEXT.

FORM
  SKIP(1) 
  SPACE(3) bFile._File-name LABEL "Working on" FORMAT "x(32)" SPACE
  SKIP(1)
  WITH FRAME working_on SIDE-LABELS VIEW-AS DIALOG-BOX 
  TITLE "Generating Report".


/*=========================Internal Procedures==========================*/

/*---------------------------------------
   Display the data for the record
   in the bField buffer.
---------------------------------------*/
PROCEDURE Display_Rec:
  DEFINE VARIABLE dspdt   AS CHARACTER NO-UNDO.
  
   IF bField._Data-type = "DATETIME" THEN
     ASSIGN dspdt = "datetm".
   ELSE IF bField._Data-type = "DATETIME-TZ" THEN
     ASSIGN dspdt = "datetm-tz".
   ELSE IF bField._Data-type = "INT64" THEN
     ASSIGN dspdt = "I64".
   ELSE 
     ASSIGN dspdt = SUBSTRING(bField._Data-type,1,4,"CHARACTER":u).
   
   IF bField._Data-type <> "Decimal" OR bField._Decimals = ? THEN.
   ELSE 
     ASSIGN dspdt = dspdt + "-" + STRING(bField._Decimals).

   IF bField._Extent > 0 THEN
     ASSIGN dspdt = dspdt + "[" + STRING(bField._Extent) + "]".


   DISPLAY STREAM rpt
      bField._Field-name
      dspdt @ bField._Data-type
  
      /* flags */
      (   (IF bField._Fld-case THEN "c" ELSE "")
        + (IF CAN-FIND(FIRST _Index-field OF bField)
          THEN "i" ELSE "")
        + (IF bField._Mandatory THEN "m" ELSE "")       
      ) @ flags

      bField._Format
      WITH FRAME shofield.
   DOWN STREAM rpt WITH FRAME shofield.
END.


/*============================Mainline Code=============================*/

IF p_Tbl = "ALL" THEN
   SESSION:IMMEDIATE-DISPLAY = yes.

FOR EACH bFile NO-LOCK WHERE bFile._Db-recid = p_DbId AND
               	     (IF p_Tbl = "ALL" THEN (IF NOT fHidden THEN NOT bFile._Hidden ELSE bFile._File-Number > 0)
      	       	     	               ELSE bFile._File-name = p_Tbl)
      	       BY bFile._File-name:
  IF INTEGER(DBVERSION("DICTDB")) > 8 AND
      (bFile._Owner <> "PUB" AND bFile._Owner <> "_FOREIGN") THEN NEXT.
   PAGE STREAM rpt.

   IF p_Tbl = "ALL" THEN
      DISPLAY bFile._File-name WITH FRAME working_on.

   DISPLAY STREAM rpt bFile._File-name WITH FRAME tblhdr.
   
   if INDEX(p_Order, "a") > 0 THEN
      FOR EACH bField OF bFile NO-LOCK USE-INDEX _Field-Name:
	 RUN Display_Rec. 
      END.
   ELSE
      FOR EACH bField OF bFile NO-LOCK USE-INDEX _Field-Position:
	 RUN Display_Rec.
      END.
END.


IF p_Tbl = "ALL" THEN
DO:
   HIDE FRAME working_on NO-PAUSE.
   SESSION:IMMEDIATE-DISPLAY = no.
END.


/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/*----------------------------------------------------------------------------

File: qfldrpt.p

Description:
   Quick and dirty field report for both the GUI and character dictionaries.

Input Parameters:
   p_DbId    - Id of the _Db record corresponding to the current database
   p_PName   - Physical name of the database
   p_DbType  - Database type (e.g., PROGRESS)
   p_TblName - Name of the table or "ALL"
   p_Btns    - Character string indicating which optional buttons
      	       should be visible.  These include "s" for switch files,
      	       "o" for order fields by _Order or "a" to order fields
      	       alphabetically.  So this could be "so", "sa", "o", OR "a".

Returns:
   Indicates actions that occurred within report:
   "s" if Switch file was chosen
   "o" if the last order shown was by order#
   "a" if the last order shown was alphabetical
   So this could be "so", "sa", "o", OR "a".

 
Author: Tony Lavinio, Laura Stern

Date Created: 10/05/92

Modified on 06/14/94 by Gerry Seidl. Added NO-LOCKs to file accesses.
            07/10/98 D. McMann Added check for DBVERSION and_Owner.
            08/28/98 D. McMann Removed check since incorrect db being found
                               and report handles no fields found correctly
            03/29/99 by Mario B      BUG# 99-03-26-19 Changed DBNAME to 
                                     "DICTDB" in _Owner check.
            08/25/03 D. McMann Update report for 10.0A
                               
----------------------------------------------------------------------------*/

{adecomm/commeng.i}  /* Help contexts */

DEFINE INPUT PARAMETER p_DbId 	 AS RECID NO-UNDO.
DEFINE INPUT PARAMETER p_PName 	 AS CHAR  NO-UNDO.
DEFINE INPUT PARAMETER p_DbType  AS CHAR  NO-UNDO.
DEFINE INPUT PARAMETER p_TblName AS CHAR  NO-UNDO.
DEFINE INPUT PARAMETER p_Btns    AS CHAR  NO-UNDO.

DEFINE VAR header_str AS CHAR 	 NO-UNDO.
DEFINE VAR flags      AS CHAR 	 NO-UNDO.
DEFINE VAR permit     AS LOGICAL NO-UNDO.


IF INTEGER(DBVERSION("DICTDB")) > 8 THEN DO:
  FIND _File WHERE _File._File-name = "_File" 
               AND _File._Owner = "PUB" NO-LOCK.
  permit = CAN-DO(_Can-read,USERID("DICTDB")).
  FIND _File WHERE _File._File-name = "_Field" 
               AND _File._Owner = "PUB" NO-LOCK.
  permit = permit AND CAN-DO(_Can-read,USERID("DICTDB")).
END.  
ELSE DO:
  FIND _File "_File" NO-LOCK.
  permit = CAN-DO(_File._Can-read,USERID("DICTDB")).
  FIND _File "_Field" NO-LOCK.
  permit = permit AND CAN-DO(_File._Can-read,USERID("DICTDB")).
END.
  
IF NOT permit THEN DO:
  MESSAGE "You do not have permission to use this option."
    VIEW-AS ALERT-BOX ERROR BUTTONS OK.
  RETURN.
END.

header_str = "Database: " + p_PName + " (" + p_DbType + ")" +
      	     STRING("", "x(8)") + "Table: " + p_TblName.
flags = "Flags: <c>ase sensitive, <i>ndex component, <m>andatory ".

RUN adecomm/_report.p 
   (INPUT p_DbId, 
    INPUT header_str,
    INPUT "Quick Field Report",
    INPUT flags,
    INPUT p_Btns,
    INPUT "adecomm/_qflddat.p",
    INPUT p_TblName,
    INPUT {&Quick_Field_Report}).

RETURN RETURN-VALUE.

/* _qfldrpt.p - end of file */




/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/*----------------------------------------------------------------------------

File: _qidxdat.p

Description:
   Display _Index information for the quick index report.  It will go to 
   the currently set output device (e.g., a file, the printer).
 
Input Parameters:
   p_DbId - Id of the _Db record for this database.
   p_Tbl  - The name of the table whose indexes we're showing or "ALL".

Author: Tony Lavinio, Laura Stern

Date Created: 10/05/92

Modified on 05/31/95 gfs Allow display of hidden tables (not meta-schema).
            06/14/94 gfs Added NO-LOCKs to file accesses.
            01/07/98 DLM Added display of current storage area for PROGRESS
                         databases or N/A for foreign databases.
            04/17/98 DLM Added check for _field-recid > 0 for default index.
            07/23/98 DLM Added DBVERSION and _Owner check
            01/18/00 DLM Added NO-LOCK where missed.
----------------------------------------------------------------------------*/
{ prodict/fhidden.i }

DEFINE INPUT PARAMETER p_DbId AS RECID NO-UNDO.
DEFINE INPUT PARAMETER p_Tbl  AS CHAR  NO-UNDO.

DEFINE SHARED STREAM rpt.
DEFINE VARIABLE flags      AS CHARACTER   NO-UNDO.
DEFINE VARIABLE starea     AS CHARACTER   NO-UNDO.

FORM
   _File._File-name  LABEL "Table"
   SKIP
   WITH FRAME tblhdr NO-ATTR-SPACE USE-TEXT SIDE-LABELS STREAM-IO.

FORM
  flags                   FORMAT "x(5)"  COLUMN-LABEL "Flags"
  _Index._Index-name      FORMAT "x(29)" COLUMN-LABEL "Index Name"
  starea                  FORMAT "x(4)" COLUMN-LABEL "St Area"
  _Index._Num-comp        FORMAT ">>9"   COLUMN-LABEL "Cnt"
  _Index-field._Ascending FORMAT "+/- " COLUMN-LABEL "Fi" SPACE(0)
  _Field._Field-name      FORMAT "x(28)" COLUMN-LABEL "eld Name"
  WITH FRAME shoindex 
  DOWN USE-TEXT STREAM-IO.

FORM
  SKIP(1) 
  SPACE(3) _File._File-name LABEL "Working on" FORMAT "x(32)" SPACE
  SKIP(1)
  WITH FRAME working_on SIDE-LABELS VIEW-AS DIALOG-BOX 
  TITLE "Generating Report".


/*----------------------------Mainline code--------------------------------*/

IF p_Tbl = "ALL" THEN
   SESSION:IMMEDIATE-DISPLAY = yes.

FIND _DB WHERE RECID(_Db) = p_dbId NO-LOCK.

FOR EACH _File NO-LOCK WHERE _File._Db-recid = p_DbId AND
                            (IF p_Tbl = "ALL" THEN (IF NOT fHidden THEN NOT _File._Hidden ELSE _File._File-Number > 0)
                                 ELSE _File._File-name = p_Tbl)
                     BY _File._File-name:
   
   IF INTEGER(DBVERSION("DICTDB")) > 8 
      AND (_File._Owner <> "PUB" AND _File._Owner <> "_FOREIGN") THEN NEXT.

   PAGE STREAM rpt.

   IF p_Tbl = "ALL" THEN
      DISPLAY _File._File-name WITH FRAME working_on.

   DISPLAY STREAM rpt _File._File-name WITH FRAME tblhdr.

   FOR EACH _Index OF _File NO-LOCK BREAK BY _Index._Index-name:
      FIND LAST _Index-field OF _Index NO-LOCK NO-ERROR.
      flags = 
               ( (IF _File._Prime-index = RECID(_Index) 
               THEN "p" ELSE "")
           + (IF _Unique   
               THEN "u" ELSE "")
           + (IF NOT _Active
               THEN "i" ELSE "") 
           + (IF _Index._Wordidx = 1
               THEN "w" ELSE "") 
                 + (IF AVAILABLE _Index-field AND _Index-field._Abbreviate
                     THEN "a" ELSE "") ).
                     
      IF _Db._Db-type = "PROGRESS" THEN DO:    
         /* note: this check may not be needed, but just in case reports need to work against old versions  */
         if INTEGER(DBVERSION("DICTDB")) > 10 then
         do:
             FIND _StorageObject WHERE _StorageObject._DB-recid      = _File._DB-recid  
                                   and _StorageObject._Object-Number = _Index._Idx-num 
                                   AND _StorageObject._Object-type   = 2 
                                   AND _StorageObject._Partitionid   = 0
                                   NO-LOCK NO-ERROR.
             
             
         end.
         else do:
             FIND _StorageObject WHERE _StorageObject._DB-recid      = _File._DB-recid  
                                   and _StorageObject._Object-Number = _Index._Idx-num 
                                   AND _StorageObject._Object-type   = 2 
                                   NO-LOCK NO-ERROR.  
         end.    
         
         IF AVAILABLE _StorageObject THEN
           ASSIGN starea = STRING(_StorageObject._Area-number).
         ELSE
           ASSIGN starea = STRING(_Index._ianum).       
      END.     
      ELSE
          ASSIGN starea = "N/A".
          
      DISPLAY STREAM rpt
          starea
                flags
          _Index._Index-name
                _Index._Num-comp
                WITH FRAME shoindex.

      /* The default index has no fields! so this loop must be separate
               from the FOR EACH _Index loop or we'll get no output.
      */
      FOR EACH _Index-field OF _Index NO-LOCK:
        IF _Index-field._Field-recid > 0 THEN DO:
          FIND _Field where RECID(_Field) = _Index-field._Field-recid NO-LOCK.
              
           DISPLAY STREAM rpt
              _Index-field._Ascending
              _Field._Field-name
              WITH FRAME shoindex.
          DOWN STREAM rpt WITH FRAME shoindex.
        END.
        ELSE 
          DISPLAY STREAM rpt
            _Index-field._Ascending
            "" @ _Field._Field-name
          with frame shoindex.
      END.
      
     /* Put an extra line in between each index. */
     IF LAST-OF(_Index._Index-name) THEN 
        DOWN STREAM rpt 1 WITH FRAME shoindex.
   END.
END.

IF p_Tbl = "ALL" THEN
DO:
   HIDE FRAME working_on NO-PAUSE.
   SESSION:IMMEDIATE-DISPLAY = no.
END.
/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/*----------------------------------------------------------------------------

File: qidxrpt.p

Description:
   Quick and dirty index report for both the GUI and character dictionary.

Input Parameters:
   p_DbId    - Id of the _Db record corresponding to the current database
   p_PName   - Physical name of the database
   p_DbType  - Database type (e.g., PROGRESS)
   p_TblName - Name of the table or "ALL"
   p_Btns    - Character string indicating which optional buttons
      	       should be visible.  These include "s" for switch files and
      	       "o" for order fields.  So to do both you would pass in "so".

Returns:
   "s" (if user asked to switch files) or 
   "".
 
Author: Tony Lavinio, Laura Stern

Date Created: 10/05/92

Modified on 06/14/94 by Gerry Seidl. Added NO-LOCKs to file accesses.
            03/29/99 by Mario B      BUG# 99-03-26-19 Changed DBNAME to 
                                     "DICTDB" in _Owner check.

----------------------------------------------------------------------------*/

{adecomm/commeng.i}  /* Help contexts */

DEFINE INPUT PARAMETER p_DbId 	 AS RECID NO-UNDO.
DEFINE INPUT PARAMETER p_PName 	 AS CHAR  NO-UNDO.
DEFINE INPUT PARAMETER p_DbType  AS CHAR  NO-UNDO.
DEFINE INPUT PARAMETER p_TblName AS CHAR  NO-UNDO.
DEFINE INPUT PARAMETER p_Btns    AS CHAR  NO-UNDO.

DEFINE VAR header_str AS CHAR 	 NO-UNDO.
DEFINE VAR flags      AS CHAR 	 NO-UNDO.
DEFINE VAR permit     AS LOGICAL NO-UNDO.

FIND _DB WHERE RECID(_DB) = p_DbId NO-LOCK.
IF INTEGER(DBVERSION("DICTDB")) > 8 THEN DO:
  FIND _File WHERE _File._File-name = "_Index"
               AND _File._Owner = "PUB"
               NO-LOCK.
  permit = CAN-DO(_File._Can-read,USERID("DICTDB")).
  FIND _File WHERE _File._File-name = "_Field"
               AND _File._Owner = "PUB"
               NO-LOCK.  
  permit = permit AND CAN-DO(_File._Can-read,USERID("DICTDB")).
  FIND _File WHERE _File._File-name = "_Index-Field"
               AND _File._Owner = "PUB"
               NO-LOCK.  
  permit = permit AND CAN-DO(_File._Can-read,USERID("DICTDB")).  
END.
ELSE DO:                        
  FIND _File "_Index" NO-LOCK.
  permit = CAN-DO(_File._Can-read,USERID("DICTDB")).
  FIND _File "_Field" NO-LOCK.
  permit = permit AND CAN-DO(_File._Can-read,USERID("DICTDB")).
  FIND _File "_Index-field" NO-LOCK.
  permit = permit AND CAN-DO(_File._Can-read,USERID("DICTDB")).
END.  
IF NOT permit THEN DO:
   MESSAGE "You do not have permission to use this option."
     VIEW-AS ALERT-BOX ERROR BUTTONS OK.
   RETURN.
END.

IF p_TblName <> "ALL" THEN DO:
  IF INTEGER(DBVERSION("DICTDB")) > 8 THEN DO:
    FIND _File NO-LOCK WHERE _File._Db-recid = p_DbId 
                         AND _File._File-name = p_TblName
                         AND (_File._Owner = "PUB" OR _File._Owner = "_FOREIGN").
    FIND LAST _Index OF _File NO-LOCK NO-ERROR.  
  END.
  ELSE DO:
    FIND _File NO-LOCK WHERE _File._Db-recid = p_DbId 
                         AND _File._File-name = p_TblName.
    FIND LAST _Index OF _File NO-LOCK NO-ERROR.
  END.
  IF NOT AVAILABLE _Index  THEN DO:
    MESSAGE "There are no indexes on this file to look at."
       VIEW-AS ALERT-BOX ERROR BUTTONS OK.
    RETURN.
  END.
END.

header_str = "Database: " + p_PName + " (" + p_DbType + ")" +
      	     STRING("", "x(8)") + "Table: " + p_TblName.
flags = "Flags: <p>rimary, <u>nique, <w>ord, <a>bbreviated, <i>nactive, " +
      	"+ asc, - desc".

RUN adecomm/_report.p 
   (INPUT p_DbId, 
    INPUT header_str,
    INPUT "Quick Index Report",
    INPUT flags,
    INPUT p_Btns,
    INPUT "adecomm/_qidxdat.p",
    INPUT p_TblName,
    INPUT {&Quick_Index_Report}).

RETURN RETURN-VALUE.



/***********************************************************************
* Copyright (C) 2000,2006 by Progress Software Corporation. All rights *
* reserved.  Prior versions of this work may contain portions          *
* contributed by participants of Possenet.                             *
*                                                                      *
***********************************************************************/
/*----------------------------------------------------------------------------

File: query.p

Description:
  This code will bring up the dialog box frame that allows the developer
  to define the files and their query relationships used in a browse.

Input Parameters:
  browser-name    - The name of the browser to be editted
  suppress_dbname - Logical to indicate if dbname should be suppressed
  from qualifications of the db fields in the generated
  4GL code

Output Parameters:
  <none>

Author: Greg O'Connor

Created: 03/23/93 - 12:17 pm

Modified: 2/28/93 by RPR (added dummy vars, auto_check & pcValidState
  needed for adeshar/_qenable.p)

-----------------------------------------------------------------------------*/

{adecomm/browqury.i NEW}
{adecomm/cbvar.i}
{adecomm/adeintl.i}

DEF INPUT  PARAMETER browserName    AS CHARACTER NO-UNDO.
DEF INPUT  PARAMETER suppressDbName AS LOGICAL   NO-UNDO.
DEF INPUT  PARAMETER iState         AS INTEGER   NO-UNDO.
DEF INPUT  PARAMETER flags          AS CHARACTER NO-UNDO.
DEF OUTPUT PARAMETER cancelled      AS LOGICAL   NO-UNDO INITIAL FALSE.

/* Standard End-of-line character */
&SCOPED-DEFINE EOL &IF "{&WINDOW-SYSTEM}" <> "OSF/Motif" &THEN "~r" + &ENDIF CHR(10)

/*--------------------------------------------------------------------------*/
DEFINE VARIABLE v_pick       AS CHARACTER NO-UNDO.
DEFINE VARIABLE iTemp        AS INTEGER   NO-UNDO.
DEFINE VARIABLE auto_check   AS LOGICAL   NO-UNDO.
DEFINE VARIABLE pcValidState AS LOGICAL   NO-UNDO.

DEFINE RECTANGLE RECT-4 {&STDPH_OKBOX}.

FORM
  SKIP ({&TFM_WID})
  SPACE({&HFM_WID}) 
  v_pick 
    VIEW-AS SELECTION-LIST SINGLE INNER-CHARS 32 INNER-LINES 10 
  /* SPACE({&HFM_WID}) */ SKIP

  /** The Standard dialog button **/
  {adecomm/okform.i
    &BOX    = "RECT-4"
    &STATUS =  NO
    &OK     = "bOk"
    &CANCEL = "bCancel" }

  WITH FRAME fr_pick NO-ATTR-SPACE NO-LABELS
  TITLE "Select Related Table":t32
  VIEW-AS DIALOG-BOX.

DEFINE VARIABLE sIndex    AS CHARACTER NO-UNDO.
DEFINE VARIABLE lConstant AS LOGICAL   NO-UNDO.

/* Parameters Definitions ---                                               */

ON CHOOSE OF bHelp DO:
  DO WITH FRAME dialog-1:

    /*****
    CASE TRIM(rsMain:screen-value):
      WHEN "{&join}"  THEN
      /* ON HELP in the Join Builder dialog box */
      RUN adecomm/_adehelp.p ( "ab", "CONTEXT",{&Join_Builder_Dlg_Box}, ? ).
    WHEN "{&Where}" THEN
      /* ON HELP in the Where Builder dialog box */
      RUN adecomm/_adehelp.p ( "ab", "CONTEXT",{&Where_Builder_Dlg_Box}, ? ).
    WHEN "{&Sort}"  THEN
      /* ON HELP in the Sort Selection dialog box */
      RUN adecomm/_adehelp.p ( "ab", "CONTEXT",{&Sort_Selection_Dlg_Box}, ? ).
    WHEN "{&Field}" THEN
      /* ON HELP in the Field Selection dialog box */
      RUN adecomm/_adehelp.p ( "ab", "CONTEXT",{&Field_Selection_Dlg_Box}, ? ).
    WHEN "{&Table}" THEN
      /* ON HELP in the Table Builder dialog box */
      RUN adecomm/_adehelp.p ( "ab", "CONTEXT",{&Table_Builder_Dlg_Box}, ? ).
    END CASE.
    ****/
  END.
END.

{adecomm/cbdrop.i 
  &Frame  = "FRAME dialog-1"
  &CBFill = "eCurrentTable"
  &CBList = "slComboBox"
  &CBBtn  = "bDrop"
  &CBInit = "eCurrentTable"}

/* -----------------------------------------------------------
U1 is posted from cbdrop.i include file.
-------------------------------------------------------------*/
ON U1 OF eCurrentTable, slComboBox DO:
  DO WITH FRAME dialog-1:
    IF (INTEGER (rsMain:screen-value) = {&Where}) OR
      (INTEGER (rsMain:screen-value) = {&Join}) THEN
    DO:
      RUN adecomm/_qset.p ("setComboBoxQuery":u, FALSE).
      IF (INTEGER (rsMain:screen-value) = {&Join}) THEN
        RUN adecomm/_qset.p("SetCustomizeJoin", TRUE).
      ELSE DO:
        /** To set up Undo State **/
        FIND LAST ttWhere WHERE {&Where} = ttWhere.iState
          AND   lLeft:SCREEN-VALUE = ttWhere.cTable NO-ERROR.
        IF AVAILABLE (ttWhere) THEN DO:
          ASSIGN
            cLastField             = ttWhere.cLastField
            {&CurLeft}:sensitive   = ttWhere.lOperator
            {&CurRight}:sensitive  = ttWhere.lOperator.

          RUN load_ops.
        END.
      END.
    END.
    ELSE
      RUN adecomm/_qset.p ("setComboBox":u, FALSE).
  END.
END.

ON CHOOSE OF bFieldFormat DO:
  DO WITH FRAME dialog-1:

    DEFINE VAR cOldformat   AS CHARACTER.
    DEFINE VAR cNewFormat AS CHARACTER.
    DEFINE VAR counter AS INTEGER.

    cOldformat = eFieldFormat:screen-value.

    RUN DB_Field.ip ({&CurRight}:SCREEN-VALUE,"FORMAT",OUTPUT cTemp).

    DO counter = 2 TO NUM-ENTRIES (cTemp):
      cNewFormat = IF counter = 2 THEN ENTRY(counter, cTemp)
                   ELSE cNewFormat + ",":u + ENTRY (counter, cTemp).
    END.

    RUN adecomm/_y-build.p (INTEGER(ENTRY(1, cTemp)),INPUT-OUTPUT cOldFormat).

    eFieldFormat:screen-value = cOldFormat.

    IF (cOldformat <> cNewFormat) THEN
    ASSIGN
      cFieldName = {&CurRight}:SCREEN-VALUE
      cList      = {&CurRight}:LIST-ITEMS
      cTemp      = ENTRY(LOOKUP(cFieldName,cList,{&Sep1}),{&CurData},{&Sep1})
      ENTRY (3, cTemp, {&sep2}) = eFieldFormat:SCREEN-VALUE
      ENTRY (LOOKUP (cFieldName, cList, {&Sep1}), {&CurData}, {&Sep1}) = cTemp
      .
  END.
END.
/* -----------------------------------------------------------
-------------------------------------------------------------*/
ON ENDKEY OF FRAME DIALOG-1 
  cancelled = TRUE.

ON GO OF FRAME DIALOG-1 DO:
  DO WITH FRAME dialog-1:

    /** If auto syntax check is set **/
    IF (tOnOk:screen-value = "yes") THEN DO:

      RUN CheckSyntax.ip (OUTPUT lOK).
      IF NOT lOK THEN
      RUN CheckDisplayWidth.ip (OUTPUT lOK).

      IF lOK THEN
      RETURN NO-APPLY.
    END.

    RUN BuildQuery.ip (OUTPUT _4GLQury).

    ASSIGN
      _TblList = {&TableRight}:LIST-ITEMS
      _OrdList = {&CurSortData}
      _FldList = {&CurFieldData}
      .

    DO i = 1 TO EXTENT (_Where):
      IF i <= NUM-ENTRIES ({&TableRight}:LIST-ITEMS, {&Sep1}) THEN
      ASSIGN
        _Where[i]    = (IF (acWhere [i] > "") THEN  acWhere [i] ELSE ?)
        _JoinCode[i] = (IF (acJoin  [i] > "") THEN  acJoin  [i] ELSE ?)
        .
      ELSE
      ASSIGN
        _Where[i]    = (IF (acWhere [i] > "") THEN  acWhere [i] ELSE ?)
        _JoinCode[i] = (IF (acJoin  [i] > "") THEN  acJoin  [i] ELSE ?)
        .
    END.
  END.
END.
/* Check Syntax ----------------------------------------------
-------------------------------------------------------------*/
ON CHOOSE OF bCheckSyntax DO:
  RUN CheckSyntax.ip (OUTPUT lOK).
  IF NOT lOK THEN
    MESSAGE "No syntax errors.":t48 VIEW-AS ALERT-BOX INFORMATION BUTTONS OK.
END.
/* Change Join Target ----------------------------------------
-------------------------------------------------------------*/
ON CHOOSE OF bTableSwitch
  RUN ChangeJoinTarget.ip.
/* ----------------------------------------------------------
-------------------------------------------------------------*/
ON CHOOSE OF bDebug
  RUN Debug.ip.
/* -----------------------------------------------------------
-------------------------------------------------------------*/
ON "CHOOSE" OF bUp IN FRAME dialog-1 DO:

  DO WITH FRAME dialog-1:
    ASSIGN
      cList = {&CurRight}:LIST-ITEMS
      cTemp = {&CurRight}:SCREEN-VALUE.
    /*
    ** IF it is sort or Field have to move one at a time to keep the cMoreData
    ** in parellel with the :list-items
    */
    IF INTEGER (rsMain:screen-value) = {&Sort} OR
      INTEGER (rsMain:screen-value) = {&Field} THEN DO:
      DO i = 1 TO NUM-ENTRIES (cTemp, {&Sep1}):

        RUN MoveList.ip (TRUE,
          ENTRY(LOOKUP(ENTRY(i,cTemp,{&Sep1}),cList,{&Sep1}),{&CurData},{&Sep1}),
          {&Sep1},
          INPUT-OUTPUT {&CurData}).

        RUN MoveList.ip (TRUE,
          ENTRY (i, cTemp, {&Sep1}),
          {&Sep1},
          INPUT-OUTPUT cList).
      END.
    END.
    ELSE
      RUN MoveList.ip (TRUE, cTemp, {&Sep1}, INPUT-OUTPUT cList).
    /*
    ** Setup List-items and screen values
    */
    ASSIGN
      {&CurRight}:LIST-ITEMS   = cList
      {&CurRight}:SCREEN-VALUE = cTemp
      .
    RUN adecomm/_qset.p ("setUpDown",    TRUE).
    RUN DisplaySort.ip (FALSE, 0, INPUT-OUTPUT eDisplayCode).
    eDisplayCode:SCREEN-VALUE = eDisplayCode.
  END.
END /*TRIGGER*/ .
/* -----------------------------------------------------------
-------------------------------------------------------------*/
ON "CHOOSE" OF bDown IN FRAME dialog-1 DO:
  DO WITH FRAME dialog-1:

    ASSIGN
      cList = {&CurRight}:LIST-ITEMS
      cTemp = {&CurRight}:SCREEN-VALUE.
    /*
    ** IF it is sort or Field have to move one at a time to keep the cMoreData
    ** in parellel with the :list-items
    */
    IF INTEGER (rsMain:screen-value) = {&Sort} OR
      INTEGER (rsMain:screen-value) = {&Field} THEN DO:
      DO i = NUM-ENTRIES (cTemp, {&Sep1}) TO 1 BY -1:
        RUN MoveList.ip (FALSE,
          ENTRY (LOOKUP (ENTRY (i, cTemp, {&Sep1}), cList, {&Sep1}), {&CurData}, {&Sep1}),
          {&Sep1},
          INPUT-OUTPUT {&CurData}).

        RUN MoveList.ip (FALSE,
          ENTRY (i, cTemp, {&Sep1}),
          {&Sep1},
          INPUT-OUTPUT cList).
      END.
    END.
    ELSE
      RUN MoveList.ip (FALSE, cTemp, {&Sep1}, INPUT-OUTPUT cList).
    /*
    ** Setup List-items and screen values
    */
    ASSIGN
      {&CurRight}:LIST-ITEMS   = cList
      {&CurRight}:SCREEN-VALUE = cTemp
      .
    RUN adecomm/_qset.p ("setUpDown",    TRUE).
    RUN DisplaySort.ip (FALSE, 0, INPUT-OUTPUT eDisplayCode).
    eDisplayCode:SCREEN-VALUE = eDisplayCode.
  END /* DO */ .
END /*TRIGGER*/ .

/* -----------------------------------------------------------
-------------------------------------------------------------*/
ON CHOOSE OF bRemove IN FRAME dialog-1
  RUN DefaultActionRight.ip.

/* -----------------------------------------------------------
-------------------------------------------------------------*/
ON CHOOSE OF bAdd IN FRAME dialog-1
  RUN DefaultActionLeft.ip.
/* -----------------------------------------------------------
-------------------------------------------------------------*/
ON LEAVE OF eFieldLabel DO:
  DEFINE VARIABLE cAnswer AS CHARACTER NO-UNDO.

  DO WITH FRAME dialog-1:

    /*  RUN DB_Field.ip ({&CurRight}:SCREEN-VALUE, "LABEL", OUTPUT cTemp). */
    RUN DB_Field.ip (sIndex, "LABEL", OUTPUT cTemp).

    IF (SELF:SCREEN-VALUE <> cTemp) THEN
    ASSIGN
      cFieldName = sIndex
      cList      = {&CurRight}:LIST-ITEMS
      cTemp      = ENTRY(LOOKUP(cFieldName,cList,{&Sep1}),{&CurData},{&Sep1})
      ENTRY(2,cTemp,{&sep2}) = REPLACE(REPLACE(SELF:SCREEN-VALUE,CHR(13),"!"), 
                                 CHR(10), "")
      ENTRY (LOOKUP (cFieldName, cList, {&Sep1}), {&CurData}, {&Sep1}) = cTemp
      .

  END.
END.
/* -----------------------------------------------------------
-------------------------------------------------------------*/
ON LEAVE OF eFieldFormat DO:

  DEFINE VARIABLE counter  AS INTEGER NO-UNDO.
  DEFINE VARIABLE lError   AS LOGICAL NO-UNDO.
  DEFINE VARIABLE cFormat AS CHARACTER NO-UNDO.

  DO WITH FRAME dialog-1:

    RUN DB_LongField.ip (sIndex, "FORMAT",
      OUTPUT cCurrentDB,
      OUTPUT cTableName,
      OUTPUT cFieldName,
      OUTPUT cTemp).

    DO counter = 2 TO NUM-ENTRIES (cTemp):
      cFormat = IF (counter = 2) THEN ENTRY (counter, cTemp)
                ELSE cFormat + ",":u + ENTRY (counter, cTemp).
    END.

    RUN adecomm/_chkfmt.p (INTEGER (ENTRY (1,cTemp)), cFieldName,
      "", SELF:SCREEN-VALUE, OUTPUT counter, OUTPUT lError).
    IF (lError) THEN RETURN NO-APPLY.

    /** Format returns TYPE,FORMAT  **/
    IF (SELF:SCREEN-VALUE <> cFormat) THEN
    ASSIGN
      cFieldName = sIndex
      cList      = {&CurRight}:LIST-ITEMS
      /** Find the item based on screen vlaue **/
      cTemp = ENTRY (LOOKUP (cFieldName, cList, {&Sep1}), {&CurData}, {&Sep1})
      /** Change the FORMAT part **/
      ENTRY (3, cTemp, {&sep2}) = SELF:SCREEN-VALUE				
      /** Put it back  **/
      ENTRY (LOOKUP (cFieldName, cList, {&Sep1}), {&CurData}, {&Sep1}) = cTemp
      .
  END.
END.
/* -----------------------------------------------------------
-------------------------------------------------------------*/
ON CHOOSE OF bEqual         OR
  CHOOSE OF bNotEqual      OR
  CHOOSE OF bLess          OR
  CHOOSE OF bGreater       OR
  CHOOSE OF bLessEqual     OR
  CHOOSE OF bGreaterEqual  OR
  CHOOSE OF bAnd           OR
  CHOOSE OF bOR            OR
  CHOOSE OF bBegins        OR
  CHOOSE OF bMatches       OR
  CHOOSE OF bRange         OR
  CHOOSE OF bList 			OR
  CHOOSE OF bOR            OR
  CHOOSE OF bContains      OR
  CHOOSE OF bXMatches 	   /*	OR
  CHOOSE OF bLike          OR
  CHOOSE OF bxRange 		OR
  CHOOSE OF bXList */ DO:

  DO WITH FRAME dialog-1:

    IF INTEGER (rsMain:screen-value) = {&Join} THEN
      RUN Join.ip (SELF:LABEL, TRUE).
    ELSE DO:
      RUN guess_field (OUTPUT cTemp).
      RUN adecomm/_qwhere.p (SELF:LABEL, cTemp).
    END.
  END.
END.
/* -----------------------------------------------------------
-------------------------------------------------------------*/
ON CHOOSE OF bUndo DO:
  DO WITH FRAME dialog-1:

    DEFINE VARIABLE cTemp AS CHARACTER NO-UNDO. /* scrap */

    /* just in case any junk gets in there */
    FOR EACH ttWhere WHERE INTEGER (rsMain:screen-value) = ttWhere.iState
      AND lLeft:SCREEN-VALUE = ttWhere.cTable AND ttWhere.iSeq > 0
      AND ttWhere.cExpression = "":
      DELETE ttWhere.
    END.

    FIND LAST ttWhere WHERE INTEGER (rsMain:screen-value) = ttWhere.iState
      AND lLeft:SCREEN-VALUE = ttWhere.cTable.

    IF ttWhere.iSeq > 0 THEN DO:
      DELETE ttWhere.
      FIND LAST ttWhere WHERE INTEGER (rsMain:screen-value) = ttWhere.iState
        AND lLeft:SCREEN-VALUE  = ttWhere.cTable.
    END.

    ASSIGN
      eDisplayCode:SCREEN-VALUE  = ttWhere.cExpression
      eDisplayCode:SENSITIVE     = (IF eDisplayCode:screen-value > "" THEN
                                    TRUE ELSE FALSE)
      eDisplayCode:CURSOR-OFFSET = (IF (ttWhere.iOffset > 0) THEN
                                      ttWhere.iOffset
                                    ELSE eDisplayCode:CURSOR-OFFSET)
      bCheckSyntax:SENSITIVE     = (ttWhere.iSeq > 0)
      bUndo:SENSITIVE            =  bCheckSyntax:SENSITIVE
      {&CurLeft}:screen-value    = ""
      {&CurRight}:screen-value   = ""
      {&CurLeft}:sensitive       = ttWhere.lOperator
      {&CurRight}:sensitive      = ttWhere.lOperator
      cLastField                 = ttWhere.cLastField
      .

    IF (INTEGER (rsMain:screen-value) = {&Join}) THEN DO:
      RUN adecomm/_qset.p ("SetOperatorsSensitive.ip",
        NOT ttWhere.lOperator).
      RUN adecomm/_qset.p ("SetJoinOperatorsSensitive.ip",
        NOT ttWhere.lOperator).
      acJoin[LOOKUP({&CurTable},slComboBox:LIST-ITEMS,{&Sep1})] =
        ttWhere.cExpression.
    END.
    ELSE IF (INTEGER(rsMain:screen-value) = {&Where}) THEN DO:
      acWhere[LOOKUP({&CurTable},slComboBox:LIST-ITEMS,{&Sep1})] =
        ttWhere.cExpression.
      RUN load_ops.
    END.
    /*
    IF eDisplayCode:sensitive THEN
    APPLY "ENTRY" TO eDisplayCode.
    */
  END.
END.
/* ----------------------------------------------------------- */
ON ENTRY OF eDisplayCode DO:
  DO WITH FRAME dialog-1:

    IF INTEGER (rsMain:screen-value) = {&Join} OR
      INTEGER (rsMain:screen-value) = {&Where} THEN DO:

      RUN adecomm/_qset.p ("SetOperatorsSensitive.ip", TRUE).
      RUN adecomm/_qset.p ("SetJoinOperatorsSensitive.ip", TRUE).

      ASSIGN
        {&CurLeft}:sensitive       = TRUE.
    END.
  END.
END.
/* -----------------------------------------------------------
------------------------------------------------------------*/
ON LEAVE OF eDisplayCode DO:
  DO WITH FRAME dialog-1:

    IF INTEGER (rsMain:screen-value) = {&Join} OR
      INTEGER (rsMain:screen-value) = {&Where} THEN DO:

      FIND LAST ttWhere WHERE INTEGER (rsMain:screen-value) = ttWhere.iState 
        AND lLeft:SCREEN-VALUE = ttWhere.cTable.

      /*
      ** If from the users point of view we have saved this then
      ** Just leave...
      IF (ttWhere.iOffset      = eDisplayCode:CURSOR-OFFSET  AND
      */
      IF (ttWhere.cExpression  = eDisplayCode:SCREEN-VALUE ) THEN
      RETURN.

      i                        = ttWhere.iSeq.

      CREATE ttWhere.

      ASSIGN
        cLastField                 = TRIM(eDisplayCode:SCREEN-VALUE)
        ttWhere.iState             = INTEGER (rsMain:screen-value)
        ttWhere.cTable             = lLeft:SCREEN-VALUE
        ttWhere.iSeq               = i + 1
        ttWhere.iOffset            = eDisplayCode:CURSOR-OFFSET
        ttWhere.cExpression        = eDisplayCode:SCREEN-VALUE
        ttWhere.lOperator          = TRUE /* ggg This needs work !! */
        bCheckSyntax:SENSITIVE     = TRUE
        bUndo:SENSITIVE            = TRUE
        {&CurLeft}:screen-value    = ""
        {&CurRight}:screen-value   = ""
        {&CurLeft}:sensitive       = ttWhere.lOperator
        {&CurRight}:sensitive      = ttWhere.lOperator.

      /*
      This is bad
      RUN adecomm/_qset.p ("SetOperatorsSensitive.ip",NOT ttWhere.lOperator).
      RUN adecomm/_qset.p ("SetJoinOperatorsSensitive.ip",NOT ttWhere.lOperator).
      */

      IF (INTEGER (rsMain:screen-value) = {&Join}) THEN
        acJoin [LOOKUP ({&CurTable}, slComboBox:List-Items, {&Sep1})] = 
          ttWhere.cExpression.
      ELSE
      IF INTEGER (rsMain:screen-value) = {&Where} THEN
        acWhere [LOOKUP ({&CurTable}, slComboBox:List-Items, {&Sep1})] = 
          ttWhere.cExpression.
    END.
  END.
END.
/* -----------------------------------------------------------
-------------------------------------------------------------*/
ON VALUE-CHANGED OF rsSortDirection DO:
  DO WITH FRAME dialog-1:

    ASSIGN
      cFieldName = {&CurRight}:SCREEN-VALUE
      cList      = {&CurRight}:LIST-ITEMS
      /** Find the item based on screen vlaue **/
      cTemp = ENTRY (LOOKUP (cFieldName, cList, {&Sep1}), {&CurData}, {&Sep1})
      /** Change the sort part **/
      ENTRY (2, cTemp, {&sep2}) = rsSortDirection:SCREEN-VALUE
      /** Put it back  **/
      ENTRY (LOOKUP (cFieldName, cList, {&Sep1}), {&CurData}, {&Sep1}) = cTemp
      .

    RUN DisplaySort.ip (FALSE, 0, INPUT-OUTPUT eDisplayCode).
    eDisplayCode:SCREEN-VALUE = eDisplayCode.
  END.
END.
/* -----------------------------------------------------------
-------------------------------------------------------------*/
ON VALUE-CHANGED OF tJoinable DO:
  DO WITH FRAME dialog-1:

    IF TRIM (tJoinable:screen-value) = "YES" THEN DO:
      ASSIGN
        cTemp                      = {&CurTable}
        {&CurTable}                = REPLACE({&CurTable},"OF":u,"WHERE":u)
        {&CurTable}                = {&CurTable} + " ...":u
        eDisplayCode:SCREEN-VALUE  = ""
        eDisplayCode:sensitive     = TRUE
        {&CurLeft}:sensitive       = TRUE
        {&CurRight}:sensitive      = TRUE
        .
    END.
    ELSE DO:
      IF (eDisplayCode:SCREEN-VALUE  > "") THEN DO:
        MESSAGE "This will delete the current join criteria." SKIP
          "Do you wish to continue ?" 
          VIEW-AS ALERT-BOX INFORMATION BUTTONS YES-NO UPDATE lLogical.

        IF (lLogical <> TRUE) THEN DO:
          tJoinable:screen-value = "YES".
          RETURN.
        END.
      END.

      ASSIGN
        cTemp                      = {&CurTable}
        {&CurTable}                = REPLACE ({&CurTable}, "WHERE", "OF")
        {&CurTable}                = TRIM ({&CurTable},".")
        acJoin [LOOKUP (cTemp, slComboBox:List-Items, {&Sep1})] = ""
        eDisplayCode:SCREEN-VALUE  = ""
        {&CurLeft}:screen-value    = ""
        {&CurRight}:screen-value   = ""
        bCheckSyntax:SENSITIVE     = FALSE
        bUndo:SENSITIVE            = FALSE
        eDisplayCode:sensitive     = FALSE
        {&CurLeft}:sensitive       = FALSE
        {&CurRight}:sensitive      = FALSE
        .

      RUN adecomm/_qset.p ("SetOperatorsSensitive.ip", FALSE).

      FOR EACH ttWhere WHERE {&Join} = ttWhere.iState 
        AND ENTRY (1, cTemp, " ") = ttWhere.cTable 
        AND ttWhere.iSeq > 0:
        DELETE ttWhere.
      END.
    END.

    lOK = whRight[{&table}]:REPLACE ({&CurTable}, cTemp).
    lOK = slComboBox:REPLACE ({&CurTable}, cTemp).

  END.
END.
/* -----------------------------------------------------------
-------------------------------------------------------------*/
ON VALUE-CHANGED OF rsMain DO:

  RUN adecomm/_qenable.p.
  DO WITH FRAME dialog-1:
    CASE TRIM(rsMain:screen-value):
    WHEN "{&Sort}" THEN DO:
      RUN DisplaySort.ip (FALSE, 0, INPUT-OUTPUT eDisplayCode).
      eDisplayCode:SCREEN-VALUE = eDisplayCode.
    END.

    WHEN "{&Join}" THEN
      RUN adecomm/_qset.p("SetCustomizeJoin", TRUE).

    WHEN "{&Where}" THEN DO:
      /** To set up Undo State **/
      FIND LAST ttWhere WHERE {&Where} = ttWhere.iState
        AND   lLeft:SCREEN-VALUE = ttWhere.cTable NO-ERROR.
      IF AVAILABLE (ttWhere) THEN DO:
        ASSIGN
          cLastField             = ttWhere.cLastField
          {&CurLeft}:sensitive   = ttWhere.lOperator
          {&CurRight}:sensitive  = ttWhere.lOperator.

        RUN load_ops.
      END.
    END.

    WHEN "{&Table}" THEN DO:
      RUN BuildQuery.ip (OUTPUT eDisplayCode).
      ASSIGN
        eDisplayCode:SCREEN-VALUE = eDisplayCode
        bCheckSyntax:sensitive    = (IF eDisplayCode <> "" THEN TRUE ELSE FALSE)
        .
    END.
  END CASE.
END.
END.
/* ----------------------------------------------------------- */
/* Main Code Block - Enable Widgets, Exit condition, Clean-up  */
/* ----------------------------------------------------------- */

{adecomm/okrun.i
  &FRAME  = "frame fr_pick"
  &BOX    = "RECT-4"
  &OK     = "bOK"
  &CANCEL = "bCancel"
  }

/* Ensure the interface displays over the window with focus. */
IF VALID-HANDLE(ACTIVE-WINDOW) THEN CURRENT-WINDOW = ACTIVE-WINDOW.

/* Now enable the interface and wait for the exit condition. */

RUN adecomm/_qenable.p. /* init_frame.*/
rsMain:SCREEN-VALUE = STRING (iState).
RUN adecomm/_qenable.p.

/*
* Only build the source if we're starting this session with a table.
*/
IF iState = 1 THEN DO:
  RUN BuildQuery.ip (OUTPUT eDisplayCode).

  ASSIGN
    bCheckSyntax:sensitive = (IF eDisplayCode > "" THEN TRUE ELSE FALSE)
    eDisplayCode:SCREEN-VALUE = eDisplayCode.

END.

DO ON ENDKEY UNDO, LEAVE ON ERROR UNDO, LEAVE:
  WAIT-FOR go OF FRAME dialog-1.
END.

HIDE FRAME DIALOG-1.

/******************************************************************/
/*                     Internal Procedures                        */
/******************************************************************/
/* Check for a selected table */
/* -----------------------------------------------------------
Purpose:
Run Syntax:  RUN <procedure> (INPUT, OUTPUT).
Parameters:  <none>
Notes:
-------------------------------------------------------------*/
PROCEDURE TableRemove.ip:
DEFINE VARIABLE cTempOne   AS CHAR    NO-UNDO.
DEFINE VARIABLE cFldTemp   AS CHAR    NO-UNDO.
DEFINE VARIABLE cFldDelete AS CHAR    NO-UNDO.
DEFINE VARIABLE cFldName   AS CHAR    NO-UNDO.
DEFINE VARIABLE cnt        AS INTEGER NO-UNDO.
DEFINE VARIABLE err        AS LOGICAL NO-UNDO.
DEFINE VARIABLE pos        AS INTEGER NO-UNDO.
DEFINE VARIABLE nxtname    AS CHAR    NO-UNDO.
DEFINE VARIABLE ix         AS INTEGER NO-UNDO.  /* loop index */
DEFINE VARIABLE i          AS INTEGER NO-UNDO.  /* loop index */

DO WITH FRAME dialog-1:

  IF (browserName <> "") THEN RETURN.

  /* Make sure something is selected */
  RUN CheckSelect.ip (OUTPUT iTableNum).
  IF iTableNum = 0 THEN
  RETURN.

  /* Get the selected name from the "picked list". */
  ASSIGN
    cFldTemp = {&CurRight}:screen-value.

  DO iTemp = 1 TO NUM-ENTRIES (cFldTemp, {&Sep1}):

    ASSIGN
      cTableName = ENTRY(iTemp,cFldTemp,{&Sep1}) /* full entry name */
      cTemp      = ENTRY(1,ENTRY(iTemp,cFldTemp,{&Sep1})," ")   /* table name */
      pos        = LOOKUP(cTableName,{&CurRight}:LIST-ITEMS,{&Sep1})
      .

    /*
    ** Check to see if the table is used anywhere else !
    */
    DO j = {&Sort} TO {&Field}:
      cFldDelete = whRight [j]:LIST-ITEMS.
      DO i = 1 TO NUM-ENTRIES (cFldDelete, {&Sep1}):

        IF NUM-ENTRIES (ENTRY (1, cTemp, " "), ".") = 2 THEN
          cFldName = ENTRY (1, ENTRY (i, cFldDelete, {&Sep1}), ".") + "." +
          ENTRY (2, ENTRY (i, cFldDelete, {&Sep1}), ".").
        ELSE
          cFldName = ENTRY (1, ENTRY (i, cFldDelete, {&Sep1}), ".").

        /*
         * IF the table matches or there is only one table selected that is 
         * being deleted then delete the corresponding selected sort of field 
         * stuff from the selection list and the corresponding data
         */
        IF (ENTRY (1, cTemp, " ") = cFldName) OR
          (NUM-ENTRIES ({&CurRight}:LIST-ITEMS, {&Sep1}) = 1) THEN DO:
          RUN adecomm/_delitem.p (whRight[j]:HANDLE,
            ENTRY (i, cFldDelete, {&Sep1}), OUTPUT cnt).

          ENTRY (i, cMoreData [j], {&Sep1}) = "".
        END.
      END.
      /* Collapse the data after deletion */
      cMoreData [j] = TRIM (REPLACE (cMoreData [j], {&Sep1} + {&Sep1}, {&Sep1}), {&Sep1}).
    END.

    RUN adecomm/_delitem.p ({&CurRight}:HANDLE, cTableName, OUTPUT cnt).

    /** Rebuild the table list based on the info in the right list **/
    {&CurRight}:PRIVATE-DATA = ?.

    DO i = 1 TO NUM-ENTRIES ({&CurRight}:LIST-ITEMS, {&Sep1}):
      {&CurRight}:PRIVATE-DATA = (IF {&CurRight}:PRIVATE-DATA = ? THEN ""
      ELSE
      {&CurRight}:PRIVATE-DATA + {&Sep1})  +
      ENTRY(1, ENTRY(i, {&CurRight}:LIST-ITEMS, {&Sep1}), " ").
    END.
    /*
    ** Check to see if the current table in sort or field is what has been
    ** Deleted and if it is reset it to ? cTemp = table only
    */
    DO j = {&Sort} TO {&Field}:
      IF (whLeft[j]:PRIVATE-DATA = cTemp) THEN
      whLeft[j]:PRIVATE-DATA = ?.
    END.
    /*
    ** Check to see if the current table in Join or Where is what has been
    ** Deleted and if it is reset it to ? cTableName full Right Expression
    ** (order OF order-line)
    */
    DO j = {&Join} TO {&Where}:
      IF (whLeft[j]:PRIVATE-DATA = cTableName) THEN
      whLeft[j]:PRIVATE-DATA = ?.
    END.
    /*
    **	Delete all the ttWhere records.
    */
    DO j = {&Join} TO {&Where}:
      FOR EACH ttWhere WHERE j = ttWhere.iState AND cTemp = ttWhere.cTable:
        DELETE ttWhere.
      END.

      IF (j = {&Where}) THEN
      acWhere [pos] = "".
      ELSE
      acJoin  [pos] = "".
    END.
    /*
    ** Insert field back in it's proper place.  Determine the position
    ** this field took in original field list.  Look from this point
    ** down in original list until  find an entry that is still in
    ** the left hand field list.  This is the entry we want to insert
    ** above.
    */
    IF (NUM-ENTRIES (cTemp, ".") > 1) THEN
    ASSIGN
      cTableName = cTemp
      ENTRY (NUM-ENTRIES (cTableName, "."), cTableName, ".") = ""
      cTableName = TRIM (REPLACE (cTableName, "..", "."), ".")
      cTemp      = ENTRY (NUM-ENTRIES (cTemp, "."), cTemp, ".")
      .
    /*
    ** This code assumes that the list on the Left side is in
    **  aplhabetical order and will insert or add accordingly
    */
    DO j = 1 TO NUM-ENTRIES ({&CurLeft}:LIST-ITEMS, {&Sep1}):
      IF (ENTRY (j, {&CurLeft}:LIST-ITEMS, {&Sep1}) > cTemp) THEN
      DO:
        ASSIGN
          err   = {&CurLeft}:INSERT(cTemp,
                    ENTRY(j,{&CurLeft}:LIST-ITEMS,{&Sep1}))
          cTemp = "".
        LEAVE.
      END.
    END.

    IF j > NUM-ENTRIES ({&CurLeft}:LIST-ITEMS, {&Sep1}) THEN
      err = {&CurLeft}:ADD-LAST(cTemp).

    /* Select the cTemp value, making sure it's in view. */
    RUN adecomm/_scroll.p ({&CurLeft}:HANDLE, INPUT cTemp).

  END. /* END DELETE LOOP */
  /*
  ** If we are deleting the first item and there are more items then
  ** remove the stuff on the right of the 2 item which soon will be the
  ** First item
  */
  IF (NUM-ENTRIES (ENTRY (1, {&CurRight}:LIST-ITEMS, {&Sep1}), " ") > 1) THEN
  ASSIGN
    cFieldName = {&CurRight}:LIST-ITEMS
    cTempOne = ENTRY (1, {&CurRight}:LIST-ITEMS, {&Sep1})
    cTempOne = ENTRY (1, cTempOne, " ")
    ENTRY (1, cFieldName, {&Sep1}) = cTempOne
    {&CurRight}:LIST-ITEMS = cFieldName
    .

  ASSIGN
    whLeft  [INTEGER (rsMain:screen-value)]:LIST-ITEMS = {&CurLeft}:LIST-ITEMS.

  /*    message '5'   view-as alert-box error button Ok. */

  DO j = {&Sort} TO {&Field}:
    IF ((NUM-ENTRIES ({&CurLeft}:LIST-ITEMS, {&Sep1}) = 1) AND
      NUM-ENTRIES (whRight [j]:LIST-ITEMS, "."   ) > 1) THEN DO:
      cTemp = whRight [j]:LIST-ITEMS.
      DO i = 1 TO NUM-ENTRIES (cTemp, {&Sep1}):
        ASSIGN
          ENTRY (i, cTemp, {&Sep1}) =
          ENTRY (NUM-ENTRIES (ENTRY (i, cTemp, {&Sep1}), "."),
          ENTRY (i, cTemp, {&Sep1}), ".")
          ENTRY (i, cMoreData [j], {&Sep1}) =
          ENTRY (NUM-ENTRIES (ENTRY (i, cMoreData [j], {&Sep1}), "."),
          ENTRY (i, cMoreData [j], {&Sep1}), ".")
          .
      END.
      whRight [j]:LIST-ITEMS = cTemp.
    END.
  END.

  RUN BuildQuery.ip (OUTPUT eDisplayCode).

  ASSIGN
    eDisplayCode:SCREEN-VALUE = eDisplayCode
    bCheckSyntax:sensitive  	= (IF eDisplayCode <> "" THEN TRUE ELSE FALSE)
    .
END.
END.
/* -----------------------------------------------------------
Purpose:
Run Syntax:  RUN <procedure> (INPUT, OUTPUT).
Parameters:  <none>
Notes:
-------------------------------------------------------------*/
PROCEDURE RightRemove.ip:
DEFINE VARIABLE cArrayList   AS CHARACTER NO-UNDO.
DEFINE VARIABLE cArrayEntry  AS CHARACTER NO-UNDO.
DEFINE VARIABLE lArray       AS LOGICAL   NO-UNDO INIT FALSE.
DEFINE VARIABLE lMatch       AS LOGICAL   NO-UNDO INIT FALSE.
DEFINE VARIABLE cMatch       AS CHARACTER   NO-UNDO INIT FALSE.
DEFINE VARIABLE cName        AS CHARACTER NO-UNDO.
DEFINE VAR cFldName AS CHAR    NO-UNDO.
DEFINE VAR cTempOrg AS CHAR    NO-UNDO.
DEFINE VAR cnt      AS INTEGER NO-UNDO.
DEFINE VAR err      AS LOGICAL NO-UNDO.
DEFINE VAR pos      AS INTEGER NO-UNDO.
DEFINE VAR nxtname  AS CHAR    NO-UNDO.
DEFINE VAR ix       AS INTEGER NO-UNDO.  /* loop index */
DEFINE VAR i        AS INTEGER NO-UNDO.  /* loop index */
DEFINE VAR k        AS INTEGER NO-UNDO.  /* loop index */
DEFINE VAR icurrent AS INTEGER NO-UNDO.  /* loop index */

DO WITH FRAME dialog-1:

  /* Make sure something is selected */
  RUN CheckSelect.ip (OUTPUT iTableNum).
  IF iTableNum = 0 THEN RETURN.

  /* Get the selected name from the "picked list". */
  ASSIGN
    cFldName = {&CurRight}:screen-value
    .

  DO iTemp = 1 TO NUM-ENTRIES (cFldName, {&Sep1}):

    ASSIGN
      cTableName = ENTRY (iTemp, cFldName, {&Sep1})
      cTemp      = ENTRY (1, ENTRY (iTemp, cFldName, {&Sep1}), " ")
      i          = LOOKUP (cTemp, {&CurRight}:LIST-ITEMS, {&Sep1})
      .

    /* Remove this name from the "picked list" */
    RUN adecomm/_delitem.p ({&CurRight}:HANDLE, cTableName, OUTPUT cnt).

    /*    message '21'  view-as alert-box error button Ok. */
    /* Insert field back in it's proper place.  Determine the position
    this field took in original field list.  Look from this point
    down in original list until  find an entry that is still in
    the left hand field list.  This is the entry we want to insert
    above.
    */

    IF ((NUM-ENTRIES (cTemp, ".") > 1) AND
      ({&DisFieldList} <> {&CurTable})) THEN
    ASSIGN
      cTableName = cTemp
      ENTRY (NUM-ENTRIES (cTableName, "."), cTableName, ".") = ""
      cTableName = TRIM (REPLACE (cTableName, "..", "."), ".")
      cTemp      = ENTRY (NUM-ENTRIES (cTemp, "."), cTemp,".")
      .

    IF INTEGER (rsMain:screen-value) = {&Sort} OR
      INTEGER (rsMain:screen-value) = {&Field} THEN DO:
      ASSIGN
        ENTRY (i, {&CurData}, {&Sep1}) = ""
        {&CurData} = TRIM(REPLACE({&CurData},{&Sep1} + {&Sep1},{&Sep1}),{&Sep1})
        .
      RUN DisplaySort.ip (FALSE, 0, INPUT-OUTPUT eDisplayCode).
      eDisplayCode:SCREEN-VALUE = eDisplayCode.
    END.

    /*    message '3' skip '[' {&CurData} ']'    skip
    cTableName
    view-as alert-box error button Ok.  */

    /*
     * IF the current table is not a match to the table part of the deleting 
     * item Next.
     */
    IF ((cTableName <> {&CurTable}) AND (cTableName <> cTemp) AND
      ({&DisFieldList} <> {&CurTable})) THEN NEXT.

    /*
     * IF the field is in the field and we are dealing with the dispplay 
     * field lsit List continue.
     */
    IF (({&DisFieldList} = {&CurTable}) AND
      (CAN-DO (whLeft[{&Field}]:LIST-ITEMS, cTemp))) THEN
    NEXT.

    /*
    ** Adds to the left side and handle array junk...
    */
    RUN adecomm/_collaps.p ({&CurLeft}:HANDLE, cTemp).

    /* Select the cTemp value, making sure it's in view. */
    /*    RUN adecomm/_scroll.p ({&CurLeft}:HANDLE, INPUT cTemp). */
  END.

  ASSIGN
    whLeft  [INTEGER (rsMain:screen-value)]:LIST-ITEMS = {&CurLeft}:LIST-ITEMS.

  DO j = {&Sort} TO {&Field}:
    /*    IF ((NUM-ENTRIES ({&CurLeft}:LIST-ITEMS, {&Sep1}) = 1) AND */
    IF ((NUM-ENTRIES ({&TableRight}:LIST-ITEMS, {&Sep1}) = 1) AND
      NUM-ENTRIES (whRight [j]:LIST-ITEMS, ".") > 1) THEN
    DO:
      cTemp = whRight [j]:LIST-ITEMS.
      DO i = 1 TO NUM-ENTRIES (cTemp, {&Sep1}):
        ASSIGN
          ENTRY (i, cTemp, {&Sep1}) = 
            ENTRY (NUM-ENTRIES (ENTRY (i, cTemp, {&Sep1}), "."),
          ENTRY (i, cTemp, {&Sep1}), ".")
          ENTRY (i, cMoreData [j], {&Sep1}) =
          ENTRY (NUM-ENTRIES (ENTRY (i, cMoreData [j], {&Sep1}), "."),
          ENTRY (i, cMoreData [j], {&Sep1}), ".")
          .
      END.
      whRight [j]:LIST-ITEMS = cTemp.
    END.
  END.
END.
END.
/* -----------------------------------------------------------
Purpose:
Run Syntax:  RUN <procedure> (INPUT, OUTPUT).
Parameters:  <none>
Notes:
-------------------------------------------------------------*/
PROCEDURE CheckSelect.ip:

DEFINE OUTPUT PARAMETER iTblNum AS INTEGER NO-UNDO.

DO WITH FRAME dialog-1:

  IF {&CurRight}:SCREEN-VALUE NE ? THEN
  iTblNum = LOOKUP({&CurRight}:SCREEN-VALUE,
    {&CurRight}:LIST-ITEMS, {&Sep1}).
  IF iTblNum = 0 THEN
  MESSAGE "Please select a table."
    VIEW-AS ALERT-BOX INFORMATION BUTTONS OK.
END.
END.
/* -----------------------------------------------------------
Purpose:
Run Syntax:  RUN <procedure> (INPUT, OUTPUT).
Parameters:  <none>
Notes:
-------------------------------------------------------------*/
/* This routine will remove an entry from the available list, and place
** it at the end of the selected list.
*/
PROCEDURE addTable.ip:
/* name we are looking for.  This may be just a table name or db.table */
DEFINE INPUT PARAMETER p_InName AS CHARACTER NO-UNDO.

DEFINE VARIABLE cnt           AS INTEGER   NO-UNDO.
DEFINE VARIABLE v_DBname      AS CHARACTER NO-UNDO.  /* just the DB name */
DEFINE VARIABLE v_Tblname     AS CHARACTER NO-UNDO.  /* just the table name */
DEFINE VARIABLE v_CurrentName AS CHARACTER NO-UNDO.

/*
** v_CurrentName is the tbl name as it is refered to in this session.
** If only one db is connected, it will be just a table name, else it
** will be a db.table name.
*/

DO WITH FRAME dialog-1:

  iTableNum = NUM-ENTRIES({&CurRight}:LIST-ITEMS, {&Sep1}) + 1.

  IF iTableNum = ? THEN
  iTableNum = 1.

  ASSIGN
    rDbId[iTableNum] = ?
    rTableId[iTableNum] = ?.

  IF NUM-ENTRIES (p_InName, ".") = 1  THEN
  p_InName = {&CurTable} + "." + p_InName.

  /* First find the ids for the table and the database */
  IF NUM-ENTRIES(p_InName, ".") = 2 THEN DO:
    ASSIGN
      v_DBName   = ENTRY(1,p_InName,".")
      v_TblName  = ENTRY(2,p_InName,".").

    RUN adecomm/_getdbid.p (v_dbname, OUTPUT rDbId[iTableNum]).

    IF rDbId[iTableNum] NE ? THEN
    RUN adecomm/_gttblid.p (rDbId[iTableNum], v_TblName, 
                            OUTPUT rTableId[iTableNum]).

    /* if I could not find the db/table id, I will try with just the tblname */
    IF rTableId[iTableNum] = ? THEN
      p_InName = v_TblName.
  END.

  /* if they did not store name, or we could not find it, look for tbl */

  IF rTableId[iTableNum] = ? THEN DO:
    lLogical = YES.
    RUN adecomm/_s-alert.p (INPUT-OUTPUT lLogical, "w", "ok",
      SUBSTITUTE("Table &1 was not found in connected database(s).",p_InName)).
  END.

  /* now remove this entry from the avail list and add it to picked */
  ASSIGN
    v_CurrentName = v_TblName
    cSchema[iTableNum] = (IF rTableId[iTableNum] NE ?
    THEN LDBNAME("DICTDB") ELSE ?)
    .

  /*  RUN adecomm/_delitem.p ({&CurLeft}:HANDLE, v_CurrentName, OUTPUT cnt). */

  IF (NUM-ENTRIES (slComboBox:LIST-ITEMS, {&Sep1}) > 1) THEN
  v_CurrentName = v_DBName + "." + v_CurrentName.

  IF INTEGER (rsMain:screen-value) = {&Table} THEN DO:
    lOK = ?.

    DO i = NUM-ENTRIES ({&CurRight}:LIST-ITEMS, {&Sep1}) TO 1 BY -1:
      ASSIGN
        cFieldName = v_CurrentName
        cTemp = ENTRY (1, ENTRY (i, {&CurRight}:LIST-ITEMS, {&Sep1}), " ").

      RUN adecomm/_qisjoin.p (cFieldName, cTemp, OUTPUT lOk).
      IF (lOK) THEN LEAVE.
    END.

    IF lOk THEN
      cTemp = ENTRY (1, ENTRY (i, {&CurRight}:LIST-ITEMS, {&Sep1}), " ").
    ELSE IF NUM-ENTRIES ({&CurRight}:LIST-ITEMS, {&Sep1}) = 1 THEN
      cTemp = ENTRY (1, {&CurRight}:LIST-ITEMS, {&Sep1}).
    ELSE IF NUM-ENTRIES ({&CurRight}:LIST-ITEMS, {&Sep1}) > 1 THEN DO:
      RUN pickTable.ip ({&CurRight}:PRIVATE-DATA, INPUT-OUTPUT cTemp).
      IF (cTemp = ?) THEN
      RETURN.
    END.

    {&CurRight}:PRIVATE-DATA = (IF {&CurRight}:PRIVATE-DATA = ? THEN ""
                               ELSE {&CurRight}:PRIVATE-DATA + {&Sep1})  
                                 +  v_CurrentName.

    v_CurrentName   = (IF lOk = ? THEN v_CurrentName
                       ELSE IF lOk THEN v_CurrentName + " OF "	+ cTemp
                       ELSE v_CurrentName + " WHERE " + cTemp + " ...").

    lOk = {&CurRight}:ADD-LAST (v_CurrentName).
  END.
  ELSE
    lOk = {&CurRight}:ADD-LAST (v_CurrentName).

  RUN adecomm/_delitem.p ({&CurLeft}:HANDLE, v_TblName, OUTPUT cnt).

  DO j = {&Sort} TO {&Field}:
    IF ((NUM-ENTRIES ({&CurRight}:LIST-ITEMS, {&Sep1}) > 1) AND
      NUM-ENTRIES (whRight [j]:LIST-ITEMS, ".") = 1) THEN
    DO:
      cTemp = whRight [j]:LIST-ITEMS.
      DO i = 1 TO NUM-ENTRIES (cTemp, {&Sep1}):
        ASSIGN
          ENTRY (i, cTemp, {&Sep1}) = 
            ENTRY (1, {&CurRight}:LIST-ITEMS, {&Sep1}) + "." +
            ENTRY (i, cTemp, {&Sep1})
          ENTRY (i, cMoreData [j], {&Sep1}) =
            ENTRY (1, {&CurRight}:LIST-ITEMS, {&Sep1}) + "." + 
            ENTRY (i, cMoreData [j], {&Sep1})
          .
      END.
      whRight [j]:LIST-ITEMS = cTemp.
    END.
  END.
  /*
  ** Create the Where Undo Temp Table.
  */
  DO j = {&Join} TO {&Where}:
    CREATE ttWhere.
    VALIDATE ttWhere.   /* These validates are necessary to force the write  */
    ASSIGN
      ttWhere.iState      = j
      ttWhere.cTable      = ENTRY (1, v_CurrentName, " ")
      ttWhere.iSeq        = 0
      ttWhere.iOffset     = 1
      ttWhere.cExpression = ""   /*** THIS MIGHT HAVE TO BE INITTED LATER ****/
      ttWHere.lOperator   = TRUE
      .

  END.

  RUN BuildQuery.ip (OUTPUT eDisplayCode).

  ASSIGN
    eDisplayCode:SCREEN-VALUE = eDisplayCode
    bCheckSyntax:sensitive  	= (IF eDisplayCode <> "" THEN TRUE ELSE FALSE)
    .
END.
END.
/* -----------------------------------------------------------
Purpose:
Run Syntax:  RUN <procedure> (INPUT, OUTPUT).
Parameters:  <none>
Notes:
-------------------------------------------------------------*/
PROCEDURE FieldFormat.ip.
DEFINE INPUT PARAMETER cList AS CHARACTER.
DEFINE VAR cFormat AS CHARACTER.
DEFINE VAR counter AS INTEGER.

DO WITH FRAME dialog-1:

  IF (cList = ?) OR (NUM-ENTRIES (cList, {&Sep1}) <> 1) THEN DO:
    ASSIGN
      eFieldLabel:SENSITIVE     = FALSE
      eFieldFormat:SENSITIVE    = FALSE
      bFieldFormat:SENSITIVE    = FALSE
      eFieldLabel:SCREEN-VALUE  = ""
      eFieldFormat:SCREEN-VALUE = "".
    RETURN.
  END.

  /*
  ** Get the currenet Label and if it is NOT set get the label's value
  ** from the data base
  */
  IF (ENTRY (2, ENTRY (LOOKUP (cList, {&CurRight}:LIST-ITEMS, {&Sep1}),
    {&CurData}, {&Sep1}), {&sep2}) = "") THEN
    RUN DB_Field.ip (cList, "LABEL", OUTPUT cTemp).
  ELSE
    cTemp = ENTRY (2, ENTRY (LOOKUP (cList, {&CurRight}:LIST-ITEMS, {&Sep1}),
              {&CurData}, {&Sep1}), {&sep2}).

  eFieldLabel:SCREEN-VALUE  = REPLACE (cTemp, "!", CHR(10)).
  /*
  ** Get the currenet Format and if it is NOT set get the Format's value
  ** from the data base
  */
  IF (ENTRY (3, ENTRY (LOOKUP (cList, {&CurRight}:LIST-ITEMS, {&Sep1}),
    {&CurData}, {&Sep1}), {&sep2}) = "") THEN DO:
    RUN DB_Field.ip (cList, "FORMAT", OUTPUT cTemp).
    DO counter = 2 TO NUM-ENTRIES (cTemp):
      cFormat = IF (counter = 2) THEN ENTRY (counter, cTemp)
                ELSE cFormat + ",":u + ENTRY (counter, cTemp).
    END.
    eFieldFormat:SCREEN-VALUE = cFormat. /* DB_Field returns TYPE,FORMAT */
  END.
  ELSE
  eFieldFormat:SCREEN-VALUE =
    ENTRY (3, ENTRY (LOOKUP (cList, {&CurRight}:LIST-ITEMS, {&Sep1}),
      {&CurData}, {&Sep1}), {&sep2}).

  ASSIGN					
    eFieldLabel:SENSITIVE     = TRUE
    eFieldFormat:SENSITIVE    = TRUE
    bFieldFormat:SENSITIVE    = TRUE
    .
END.
END PROCEDURE.
/* -----------------------------------------------------------
Purpose:
Run Syntax:  RUN <procedure> (INPUT, OUTPUT).
Parameters:  <none>
Notes:
-------------------------------------------------------------*/
PROCEDURE DB_Field.ip.
DEFINE INPUT  PARAMETER cList   AS CHARACTER.
DEFINE INPUT  PARAMETER cType   AS CHARACTER.
DEFINE OUTPUT PARAMETER cOutput AS CHARACTER.

RUN DB_LongField.ip (cList, cType,
  OUTPUT cCurrentDB,
  OUTPUT cTableName,
  OUTPUT cFieldName,
  OUTPUT cOutput).

END PROCEDURE.
/* -----------------------------------------------------------
Purpose:
Run Syntax:  RUN <procedure> (INPUT, OUTPUT).
Parameters:  <none>
Notes:
-------------------------------------------------------------*/
PROCEDURE DB_LongField.ip.
DEFINE INPUT   PARAMETER cList   AS CHARACTER.
DEFINE INPUT   PARAMETER cType   AS CHARACTER.
DEFINE OUTPUT  PARAMETER cDataBase   AS CHARACTER.
DEFINE OUTPUT  PARAMETER cTableName   AS CHARACTER.
DEFINE OUTPUT  PARAMETER cFieldName   AS CHARACTER.
DEFINE OUTPUT  PARAMETER cOutput AS CHARACTER.

DO WITH FRAME dialog-1:

  IF (cList = ?) OR (NUM-ENTRIES (cList, {&Sep1}) <> 1) THEN RETURN.

  IF (NUM-ENTRIES (cList, ".") = 3 ) THEN
    cDataBase = ENTRY (1 , cList, ".").

  IF (NUM-ENTRIES (cList, ".") > 1) THEN
  ASSIGN
    cTableName = ENTRY (NUM-ENTRIES (cList, ".") - 1 , cList, ".")
    cFieldName = ENTRY (NUM-ENTRIES (cList, ".")     , cList, ".")
    .
  ELSE
  ASSIGN
    cFieldName = cList
    cTableName = {&CurTable}
    .

  IF (NUM-ENTRIES (cTableName, ".") > 1) THEN
  ASSIGN
    cDataBase = ENTRY (1, cTableName, ".")
    cTableName = ENTRY (NUM-ENTRIES (cTableName, "."), cTableName, ".")
    .

  IF (cDataBase = "") THEN
    cDataBase = LDBNAME (1).

  IF (cType = "LABEL") THEN
    RUN adecomm/_s-schem.p (cDatabase,cTableName,cFieldName,"FIELD:LABEL", 
                            OUTPUT cOutput).
  ELSE
    RUN adecomm/_s-schem.p (cDataBase,cTableName,cFieldName,"FIELD:TYP&FMT", 
                            OUTPUT cOutput).
END.
END PROCEDURE.
/* -----------------------------------------------------------
Purpose:
Run Syntax:  RUN <procedure> (INPUT, OUTPUT).
Parameters:  <none>
Notes:
-------------------------------------------------------------*/
PROCEDURE ValueChangeRight.ip.

ASSIGN
  cTemp  = SELF:SCREEN-VALUE
  sIndex = cTemp.

DO WITH FRAME dialog-1:
  {&CurLeft}:SCREEN-VALUE  = "".

  RUN adecomm/_qset.p ("setUpDown", TRUE).

  IF (INTEGER (rsMain:screen-value) = {&Sort}) THEN DO:
    IF ({&CurRight}:SCREEN-VALUE = ?) OR
      (NUM-ENTRIES ({&CurRight}:SCREEN-VALUE, {&Sep1}) <> 1) THEN
      rsSortDirection:SENSITIVE     = FALSE.
    ELSE
      rsSortDirection:SENSITIVE     = TRUE.

    RUN DisplaySort.ip (FALSE, 0, INPUT-OUTPUT eDisplayCode).

    ASSIGN
      eDisplayCode:SCREEN-VALUE = eDisplayCode
      SELF:SCREEN-VALUE = cTemp.
  END.
  ELSE
  IF (INTEGER (rsMain:screen-value) = {&Field}) THEN
    RUN FieldFormat.ip ({&CurRight}:SCREEN-VALUE).
END.
END.
/* -----------------------------------------------------------
Purpose:
Run Syntax:  RUN <procedure> (INPUT, OUTPUT).
Parameters:  <none>
Notes:
-------------------------------------------------------------*/
PROCEDURE ValueChangeLeft.ip.
DO WITH FRAME dialog-1:

  {&CurRight}:SCREEN-VALUE  = "".

  RUN adecomm/_qset.p ("setUpDown", TRUE).

  IF (INTEGER (rsMain:screen-value) = {&Field}) THEN
    RUN FieldFormat.ip ({&CurRight}:SCREEN-VALUE).
END.
END.
/* -----------------------------------------------------------
Purpose:
Run Syntax:  RUN <procedure> (INPUT, OUTPUT).
Parameters:  <none>
Notes:
-------------------------------------------------------------*/
PROCEDURE DefaultActionRight.ip.

DO WITH FRAME dialog-1:
  IF (INTEGER (rsMain:screen-value) = {&Join}) THEN
    RUN join.ip (lRight:SCREEN-VALUE + "." + SELF:SCREEN-VALUE, FALSE).
  ELSE IF (INTEGER (rsMain:screen-value) = {&Table}) THEN
    RUN tableremove.ip.
  ELSE
    RUN rightremove.ip.

  RUN adecomm/_qset.p ("setUpDown", TRUE).

  IF (INTEGER (rsMain:screen-value) = {&Field}) THEN
  RUN FieldFormat.ip ({&CurRight}:SCREEN-VALUE).
END.
END.
/* -----------------------------------------------------------
Purpose:
Run Syntax:  RUN <procedure> (INPUT, OUTPUT).
Parameters:  <none>
Notes:
-------------------------------------------------------------*/
PROCEDURE DefaultActionLeft.ip.
DEFINE VARIABLE iSelectCount AS INTEGER   NO-UNDO.
DEFINE VARIABLE cSelection   AS CHARACTER NO-UNDO.
DEFINE VARIABLE cArrayList   AS CHARACTER NO-UNDO.
DEFINE VARIABLE cArrayEntry  AS CHARACTER NO-UNDO.
DEFINE VARIABLE iArrayHigh   AS INTEGER   NO-UNDO.
DEFINE VARIABLE iArrayLow    AS INTEGER   NO-UNDO.
DEFINE VARIABLE iArrayNum    AS INTEGER   NO-UNDO.

DO WITH FRAME dialog-1:
  IF {&CurLeft}:screen-value <> ? THEN DO:
    cSelection = {&CurLeft}:screen-value.
    DO iSelectCount = 1 TO NUM-ENTRIES (cSelection, {&Sep1}):
      /** If we are doing table adding  **/
      IF (INTEGER (rsMain:screen-value) = {&Where}) THEN
        RUN LeftWhere.ip.
      ELSE IF (INTEGER (rsMain:screen-value) = {&Join}) THEN
        RUN join.ip (lLeft:SCREEN-VALUE + "." + SELF:SCREEN-VALUE, FALSE).
      /** If we are doing table adding  **/
      ELSE IF (INTEGER (rsMain:screen-value) = {&Table}) THEN
        RUN addTable.ip (ENTRY (iSelectCount, cSelection, {&Sep1})).
      ELSE DO:

      /** If we are doing field or sort adding  **/
        RUN adecomm/_delitem.p ({&CurLeft}:HANDLE,
          ENTRY (iSelectCount, cSelection, {&Sep1}), OUTPUT i).
        ASSIGN
          cTemp = (IF ((INTEGER(NUM-ENTRIES(whRight[{&Table}]:LIST-ITEMS, 
                     {&Sep1})) > 1) AND
                     ({&DisFieldList} <> {&CurTable})) THEN
                     {&CurTable} + ".":u + 
                     ENTRY(iSelectCount,cSelection,{&Sep1}) 
                   ELSE ENTRY (iSelectCount, cSelection, {&Sep1})).
        .
        /*
        ** If it matches the it is an array thing.
        */
        IF cTemp MATCHES ("*[*]*":u) THEN DO:
          ASSIGN
            cTemp      = TRIM(cTemp)
            cArrayList = SUBSTRING(cTemp,INDEX(cTemp,'[':u) + 1,-1,
                                   "CHARACTER":u)
            cArrayList = REPLACE(cArrayList,"]":u,"")
            cTemp      = SUBSTRING(cTemp,1,INDEX(cTemp,'[':u) - 1,"CHARACTER":u)
            .
          /*
          ** Loop through the list base on ,
          */
          DO i = 1 TO NUM-ENTRIES (cArrayList):
            ASSIGN
              cArrayEntry = ENTRY (i, cArrayList)
              iArrayLow   = INTEGER (ENTRY (1, cArrayEntry, '-'))
              iArrayHigh  = INTEGER (ENTRY (NUM-ENTRIES (cArrayEntry, '-'), 
                              cArrayEntry, '-'))
              .
            /*
             * Loop through the list base on X-Y. X is the low number Y is 
             * the high number
             */
            DO j = iArrayLow TO iArrayHigh:

              ASSIGN
                cArrayEntry = cTemp + '[' + STRING (j) + ']' 
                lOk         = {&CurRight}:ADD-LAST (cArrayEntry)
                .
              IF INTEGER (rsMain:screen-value) = {&Field} THEN
                {&CurData} = {&CurData} + (IF ({&CurData} = "") THEN ""
              ELSE
                {&Sep1}) + cArrayEntry + {&sep2} + {&sep2}.
              ELSE IF INTEGER (rsMain:screen-value) = {&Sort} THEN
                {&CurData} = {&CurData} + (IF ({&CurData} = "") THEN ""
              ELSE
                {&Sep1}) + cArrayEntry + {&sep2} + 'yes'.
            END.
          END.
        END.
        ELSE DO:

          lOk = {&CurRight}:ADD-LAST (cTemp).

          IF INTEGER (rsMain:screen-value) = {&Field} THEN
            {&CurData} = {&CurData} + (IF ({&CurData} = "") THEN ""
          ELSE
            {&Sep1}) + cTemp + {&sep2} + {&sep2}.
          ELSE IF INTEGER (rsMain:screen-value) = {&Sort} THEN
            {&CurData} = {&CurData} + (IF ({&CurData} = "") THEN ""
          ELSE
            {&Sep1}) + cTemp + {&sep2} + 'yes'.
        END.

        RUN DisplaySort.ip (FALSE, 0, INPUT-OUTPUT eDisplayCode).
        eDisplayCode:SCREEN-VALUE = eDisplayCode.
      END.
    END.
    ASSIGN
      bAdd:SENSITIVE    = ({&CurLeft}:LIST-ITEMS NE ?)
      rsSortDirection:sensitive  = ({&CurRight}:SCREEN-VALUE NE ?)
      .
  END.
END.
END.
/* -----------------------------------------------------------
Purpose:
Run Syntax:  RUN <procedure> (INPUT, OUTPUT).
Parameters:  <none>
Notes:
-------------------------------------------------------------*/
PROCEDURE CheckDisplayWidth.ip.
DEFINE OUTPUT PARAMETER lError AS LOGICAL INITIAL TRUE NO-UNDO.

DEFINE VARIABLE FldNameList   AS CHAR EXTENT {&MaxTbl} NO-UNDO.
DEFINE VARIABLE FldLabelList  AS CHAR EXTENT {&MaxTbl} NO-UNDO.
DEFINE VARIABLE FldFormatList AS CHAR EXTENT {&MaxTbl} NO-UNDO.
DEFINE VARIABLE i             AS INTEGER   	       NO-UNDO.
DEFINE VARIABLE fmt           AS CHAR                  NO-UNDO.
DEFINE VARIABLE fd-tp         AS INTEGER               NO-UNDO.
DEFINE VARIABLE col-wdth      AS INTEGER               NO-UNDO.
DEFINE VARIABLE tot-wdth      AS INTEGER               NO-UNDO.
DEFINE VARIABLE lFmtError     AS LOGICAL               NO-UNDO.
DEFINE VARIABLE lbl           AS CHAR                  NO-UNDO.

DO WITH FRAME dialog-1:
  ASSIGN
    lError = FALSE
    tot-wdth = 0.

  DO i = 1 TO NUM-ENTRIES ({&CurFieldData}, {&Sep1}):
    IF i > EXTENT (FldNameList) THEN DO:
      MESSAGE 'The BROWSE interface only supports UP TO 20 fields.' SKIP
        'Only the FIRST 20 FIELDS WHERE saved.'.
      LEAVE.
    END.
    ELSE
    ASSIGN				
      FldNameList  [i] = ENTRY (1, ENTRY (i, {&CurFieldData}, {&Sep1}), {&Sep2})
      FldLabelList [i] = ENTRY (2, ENTRY (i, {&CurFieldData}, {&Sep1}), {&Sep2})
      FldFormatList[i] = ENTRY (3, ENTRY (i, {&CurFieldData}, {&Sep1}), {&Sep2})
      .
    IF ((NUM-ENTRIES (FldNameList  [i], ".") = 1) AND
      (NUM-ENTRIES ({&TableRight}:LIST-ITEMS, {&Sep1}) = 1)) THEN
      FldNameList [i] = {&TableRight}:LIST-ITEMS + "." + FldNameList [i].

    IF (NUM-ENTRIES (FldNameList  [i], ".") = 2)  THEN
      FldNameList [i] =  LDBNAME (1) + "." + FldNameList [i].

    RUN adecomm/_s-schem.p (FldNameList[i],"","","FIELD:TYP&FMT",OUTPUT fmt).

    ASSIGN fd-tp = INTEGER(ENTRY(1,fmt)) /* Fld Type 1-ch, 2-da, 3-lo, 4-int  */
      /* ksu 02/23/94 default mode */
      fmt   = SUBSTRING(fmt,3,-1,"CHARACTER":u).  /* Format                   */
    IF FldFormatList[i] NE ? AND FldFormatList[i] NE "" THEN
      fmt = FldFormatList[i].

    IF FldLabelList[i] NE ? AND FldLabelList[i] NE " " THEN
      lbl = FldLabelList[i].
    ELSE
      RUN adecomm/_s-schem.p (FldNameList[i],"","","FIELD:LABEL",OUTPUT lbl).
    IF NUM-ENTRIES(lbl,"!") > 1 THEN
    ASSIGN lbl             = ENTRY(NUM-ENTRIES(lbl,"!"),lbl,"!")
           FldLabelList[i] = lbl.

    RUN adecomm/_chkfmt.p (fd-tp,"",lbl,fmt,OUTPUT col-wdth,OUTPUT lFmtError).
    IF (lFmtError) THEN
      fmt = FILL ("?", col-wdth).

    tot-wdth = tot-wdth + col-wdth.

    IF (tot-wdth > 310) THEN DO:
      MESSAGE "The display width of the all the select fields exceeds 310." SKIP
        "The current display width is " tot-wdth "." SKIP
        "Please remove a field or fields."
        VIEW-AS ALERT-BOX ERROR BUTTONS OK.

      IF rsMain:SCREEN-VALUE <> "{&Field}" THEN DO:
        rsMain:SCREEN-VALUE = "5".
        APPLY "VALUE-CHANGED" TO rsMain.
      END.

      lError = TRUE.
      RETURN.
    END.
  END.
END.
END.
/* -----------------------------------------------------------
Purpose:
Run Syntax:  RUN <procedure> (INPUT, OUTPUT).
Parameters:  <none>
Notes:
-------------------------------------------------------------*/
PROCEDURE MoveList.ip.
DEFINE INPUT        PARAMETER lUp        AS LOGICAL NO-UNDO.
DEFINE INPUT        PARAMETER cValue     AS CHARACTER NO-UNDO.
DEFINE INPUT        PARAMETER cSeperator AS CHARACTER NO-UNDO.
DEFINE INPUT-OUTPUT PARAMETER cList      AS CHARACTER NO-UNDO.

/*  DEFINE VARIABLE cSeperator  AS CHARACTER   NO-UNDO INIT {&Sep1}. */
DEFINE VARIABLE i     AS INTEGER     NO-UNDO.
DEFINE VARIABLE j     AS INTEGER     NO-UNDO.

DO WITH FRAME dialog-1:
  IF (cValue <> ?) THEN DO:
    i = LOOKUP (ENTRY (1, cValue, cSeperator), cList, cSeperator).

    DO j = 1 TO NUM-ENTRIES(cValue, cSeperator):
      ASSIGN
        ENTRY (LOOKUP (ENTRY (j, cValue, cSeperator), cList, cSeperator), 
           cList, cSeperator) = ""
        cList = TRIM (REPLACE (cList, cSeperator + cSeperator, cSeperator), 
           cSeperator).
    END.

    ASSIGN
      cList = TRIM (cList, cSeperator)
      i     = (IF lUp THEN  MAXIMUM (i - 1, 1) ELSE
               MINIMUM (i, NUM-ENTRIES(cList, cSeperator))).

    IF i = 0 THEN
      cList = cValue.
    ELSE DO:
      IF (lUp) THEN
      ENTRY (i, cList, cSeperator) = cValue
        + (IF cList = "" THEN "" ELSE cSeperator + ENTRY(i,cList,cSeperator)).
      ELSE
      ENTRY(i,cList,cSeperator) = ENTRY(i,cList,cSeperator) 
                                + cSeperator + cValue.
    END.
  END /* IF */ .

END /* DO */ .
END.
/* -----------------------------------------------------------
Purpose:
Run Syntax:  RUN <procedure> (INPUT, OUTPUT).
Parameters:  <none>
Notes:
-------------------------------------------------------------*/
PROCEDURE DisplaySort.ip.
DEFINE INPUT PARAMETER lAppend AS LOGICAL NO-UNDO.
DEFINE INPUT PARAMETER iSpace  AS INTEGER NO-UNDO.
DEFINE INPUT-OUTPUT PARAMETER cSort   AS CHARACTER NO-UNDO.

DEFINE VARIABLE cTemp  AS CHARACTER NO-UNDO.
DEFINE VARIABLE cField AS CHARACTER NO-UNDO.

DO WITH FRAME dialog-1:

  IF ((INTEGER (rsMain:screen-value) <> {&Sort}) AND (NOT lAppend)) THEN
  RETURN.

  cTemp = "".

  DO i = 1 TO NUM-ENTRIES ({&CurSortData}, {&Sep1}):
    DO j = 2 TO (i + iSpace):
      cTemp = cTemp + " ".
    END.

    cField = ENTRY (1, ENTRY (i, {&CurSortData}, {&Sep1}), {&sep2}).
    IF (NUM-ENTRIES (cField, ".") = 1) THEN
      cField = ENTRY (1, {&TableRight}:LIST-ITEMS, {&Sep1}) + "." + cField.

    IF (NUM-ENTRIES (cField, ".") = 2) THEN
      cField = LDBNAME (1)  + "." + cField.

    cTemp  =  cTemp + "BY " + cField + " " +
    (IF ENTRY (2, ENTRY (i, {&CurSortData}, {&Sep1}), {&sep2}) = 'yes' THEN
    "" ELSE "DESCENDING") + CHR (10).
  END.

  IF (lAppend) THEN
    cSort = cSort + cTemp.
  ELSE DO:
    cSort = cTemp.

    IF ({&CurRight}:SCREEN-VALUE <> ?) AND
      (NUM-ENTRIES ({&CurRight}:SCREEN-VALUE, {&Sep1}) = 1) THEN
    rsSortDirection:screen-value =
    STRING (ENTRY (2, ENTRY (LOOKUP ({&CurRight}:SCREEN-VALUE,
      {&CurRight}:LIST-ITEMS, {&Sep1}),
      {&CurSortData}, {&Sep1}), {&sep2})).
  END.
END.
END.
/* -----------------------------------------------------------
Purpose:
Run Syntax:  RUN <procedure> (INPUT, OUTPUT).
Parameters:  <none>
Notes:
-------------------------------------------------------------*/
PROCEDURE BuildQuery.ip.
DEFINE OUTPUT PARAMETER cQuery   AS CHARACTER NO-UNDO.

DEFINE VAR cLine AS CHARACTER.
DEFINE VAR lWHere AS LOGICAL.

DO WITH FRAME dialog-1:

  cQuery = "".

  IF NUM-ENTRIES ({&TableRight}:LIST-ITEMS, {&Sep1}) = 0 THEN RETURN.
END.

DO i = 1 TO NUM-ENTRIES ({&TableRight}:LIST-ITEMS, {&Sep1}):
  IF (1 = i) THEN
    cQuery = 'FOR '.
  ELSE
    cQuery = cQuery +  ' NO-LOCK,' + {&EOL} + '      '.

  cLine = ENTRY (i, {&TableRight}:LIST-ITEMS, {&Sep1}).

  /*
  ** If the line ends with ... then there should be a join attached so
  ** rebuild the line based on the join.
  */
  IF (ENTRY (
    NUM-ENTRIES (cLine, " "), cLine, " ")  = "...") AND
    (acJoin [i - 1] <> "") AND (acJoin [i - 1] <> ?) THEN
  ASSIGN
    lWhere = TRUE
    cLine = ENTRY (1, cLine, " ") + " WHERE " + acJoin [i - 1] .
  ELSE
  ASSIGN
    lWhere = FALSE
    cLine = ENTRY (i, {&TableRight}:LIST-ITEMS, {&Sep1}).

  /*
  ** If there is only one data base fully qualify
  */
  IF (NUM-ENTRIES (ENTRY (1, cLine, " "), ".") = 1) AND
    NOT suppressDbName THEN
    ENTRY (1, cLine, " ") = LDBNAME (1) + "." + ENTRY (1, cLine, " ").

  IF (NUM-ENTRIES (cLine, " ") > 2) AND
    (NUM-ENTRIES (ENTRY (3, cLine, " "), ".") = 1) AND
    NOT suppressDbName THEN
    ENTRY (3, cLine, " ") = LDBNAME (1) + "." + ENTRY (3, cLine, " ").

  cQuery = cQuery + 'EACH ' + cLine.

  IF (acWhere [i] <> "") THEN
    IF (lWHere) THEN
      cQuery= cQuery + {&EOL} + "      AND " + acWhere [i].
    ELSE
      cQuery= cQuery + {&EOL} + "      WHERE " + acWhere [i].
END.

IF (i = 1) THEN RETURN.

ASSIGN
  cQuery =  cQuery + ' NO-LOCK'.
  cLine  = ""
  .

RUN DisplaySort.ip (TRUE, 4, INPUT-OUTPUT cLine).

IF (cLine > "") THEN
  cQuery =  cQuery + {&EOL} + RIGHT-TRIM (cLine) + ":".
ELSE
  cQuery =  cQuery + ":".

END.
/* -----------------------------------------------------------
Purpose:
Run Syntax:  RUN <procedure> (INPUT, OUTPUT).
Parameters:  <none>
Notes:
returns TRUE if syntax error
-------------------------------------------------------------*/
PROCEDURE CheckSyntax.ip:
DEFINE OUTPUT PARAMETER lError AS LOGICAL INITIAL TRUE NO-UNDO.

DEFINE VARIABLE cText AS CHARACTER INITIAL "" NO-UNDO.
DEFINE VARIABLE cLine AS CHARACTER            NO-UNDO.
DEFINE VARIABLE cCompOut AS CHARACTER            NO-UNDO.
DEFINE VARIABLE cCompIn  AS CHARACTER            NO-UNDO.

DO WITH FRAME dialog-1:

  RUN adecomm/_tmpfile.p ({&STD_TYP_UIB_TEMPLATE},{&STD_EXT_UIB},
                          OUTPUT cCompIn).

  OUTPUT TO VALUE (cCompIn) NO-ECHO {&NO-MAP}.

  /*
  DO i = 1 TO NUM-ENTRIES ({&CurRight}:LIST-ITEMS, {&Sep1}):
  PUT UNFORMATTED
  'FIND FIRST ':u ENTRY (i, {&CurRight}:LIST-ITEMS, {&Sep1}) '.':u SKIP.
  END.
  */

  lError = FALSE.

  RUN BuildQuery.ip (OUTPUT cText).

  IF (cText = "") OR (cText = "") THEN RETURN.

  PUT CONTROL  cText CHR (10).
  PUT UNFORMATTED "end." SKIP.

  OUTPUT CLOSE.

  RUN adecomm/_tmpfile.p ({&STD_TYP_UIB_TEMPLATE}, {&STD_EXT_UIB}, 
                          OUTPUT cCompOut).

  OUTPUT TO VALUE(cCompOut) KEEP-MESSAGES.
  DO ON ERROR UNDO,LEAVE ON ENDKEY UNDO,LEAVE:
    COMPILE VALUE(cCompIn).
  END.
  OUTPUT CLOSE.

  lError = COMPILER:ERROR.
  IF lError THEN DO:
    INPUT FROM VALUE (cCompOut) NO-ECHO {&NO-MAP}.
    REPEAT:
      IMPORT UNFORMATTED cLine.
      IF cLine MATCHES "* (198)":u THEN NEXT.
      cText = cText 
            + (IF cText = "" THEN "" ELSE CHR(10)) 
            + REPLACE (cLine, cCompIn,"").
    END.
    INPUT CLOSE.
    {&CurLeft}:SCREEN-VALUE  = "".
    {&CurRight}:SCREEN-VALUE = "".
    /*    {&CurRight}:SCREEN-VALUE = ENTRY(COMPILER:ERROR-ROW, {&CurRight}:LIST-ITEMS, {&Sep1}).*/

    RUN adecomm/_qset.p ("setUpDown", TRUE).
    MESSAGE cText VIEW-AS ALERT-BOX ERROR BUTTONS OK.
    /*    RUN edit_where_clause.ip. */
  END.

  /* Clean Up */
  OS-DELETE VALUE (cCompIn)  NO-ERROR.
  OS-DELETE VALUE (cCompOut) NO-ERROR.

END.
END PROCEDURE. /* check_syntax.ip */
/* -----------------------------------------------------------
Purpose:
Run Syntax:  RUN <procedure> (INPUT, OUTPUT).
Parameters:  <none>
Notes:
returns TRUE if syntax error
-------------------------------------------------------------*/
PROCEDURE ChangeJoinTarget.ip:

DEFINE VARIABLE cRight     AS CHARACTER NO-UNDO.
DEFINE VARIABLE cLeft      AS CHARACTER NO-UNDO.
DEFINE VARIABLE cDbRight   AS CHARACTER NO-UNDO.
DEFINE VARIABLE cDbLeft    AS CHARACTER NO-UNDO.
DEFINE VARIABLE cListItems AS CHARACTER NO-UNDO.
DEFINE VARIABLE pos        AS INTEGER NO-UNDO.

DO WITH FRAME dialog-1:

  ASSIGN
    cList      = ""
    cTemp      = {&CurRight}:SCREEN-VALUE
    cListItems = {&CurRight}:LIST-ITEMS
    pos        = LOOKUP (cTemp, cListItems, {&Sep1})
    cLeft      = ENTRY (1, cTemp, " ")
    .

  /* find all potential join candidates */
  DO i = 1 TO NUM-ENTRIES (cListItems, {&Sep1}):
    IF ENTRY(i, {&CurRight}:LIST-ITEMS, {&Sep1}) = cTemp THEN
    LEAVE.
    cList = cList + (IF i = 1 THEN ""
    ELSE
    {&Sep1})
    + ENTRY (1, ENTRY (i, cListItems, {&Sep1})," ").
  END.

  ASSIGN
    cRight = (IF NUM-ENTRIES (cList, {&Sep1}) = 1 THEN 
                cLeft ELSE ENTRY (3, cTemp, " "))
    .

  IF NUM-ENTRIES(cList, {&Sep1}) > 1 THEN
    RUN pickTable.ip (cList, INPUT-OUTPUT cRight).

  IF cRight = ? THEN RETURN ERROR.
  /*
  ** Delete all the ttWhere records. By selecting a new join partner the
  ** users has invaildated the old join criteria so delete it.
  */
  FOR EACH ttWhere WHERE {&Join} = ttWhere.iState AND cLeft = ttWhere.cTable
      AND ttWhere.iSeq > 0 :
    DELETE ttWhere.
  END.

  IF (pos > 1) THEN
    acJoin  [pos - 1] = "".

  RUN adecomm/_qisjoin.p (cRight, cLeft, OUTPUT lOk).

  ASSIGN
    cTemp = ENTRY (1, cTemp, " ")
          + (IF lOK THEN " OF " + cRight
             ELSE " WHERE " + cRight + " ...")
    ENTRY (i, cListItems, {&Sep1}) = cTemp
    {&CurRight}:LIST-ITEMS = cListItems
    {&CurRight}:SCREEN-VALUE = cTemp
    .

  RUN BuildQuery.ip (OUTPUT eDisplayCode).
  eDisplayCode:SCREEN-VALUE = eDisplayCode.

END.
END PROCEDURE. /* changeJoinTarget.ip */
/*--------------------------------------------------------------------------*/

ON DEFAULT-ACTION OF v_pick IN FRAME fr_pick APPLY "GO" TO FRAME fr_pick.

/*--------------------------------------------------------------------------*/
PROCEDURE pickTable.ip:

DEFINE INPUT        PARAMETER ip_list AS CHARACTER NO-UNDO. /* list */
DEFINE INPUT-OUTPUT PARAMETER io_pick AS CHARACTER NO-UNDO. /* value */

ASSIGN
  v_pick:DELIMITER  IN FRAME fr_pick = {&Sep1}
  v_pick:LIST-ITEMS IN FRAME fr_pick = ip_list
  v_pick:SCREEN-VALUE IN FRAME fr_pick = (IF LOOKUP (io_pick, ip_list, {&Sep1}) > 0
  THEN io_pick ELSE ENTRY(1, ip_list, {&Sep1}))
  io_pick = ?.

ENABLE v_pick bOk bCancel WITH FRAME fr_pick.
DO ON ERROR UNDO,LEAVE ON ENDKEY UNDO,LEAVE:
  WAIT-FOR GO OF FRAME fr_pick FOCUS v_pick IN FRAME fr_pick.
  io_pick = v_pick:SCREEN-VALUE IN FRAME fr_pick.
END.
HIDE FRAME fr_pick NO-PAUSE.

END PROCEDURE. /* pick_a_table.ip */
/* -----------------------------------------------------------
Purpose:
Run Syntax:  RUN <procedure> (INPUT, OUTPUT).
Parameters:  <none>
Notes:
returns TRUE if syntax error
-------------------------------------------------------------*/
PROCEDURE Debug.ip:

DO WITH FRAME dialog-1:

  MESSAGE
    'whRight[{&table}]:PRIVATE-DATA' whRight[{&table}]:PRIVATE-DATA SKIP
    'whLeft[{&table}]:PRIVATE-DATA'  whLeft[{&table}]:PRIVATE-DATA  SKIP
    '{&CurLeft}:PRIVATE-DATA'        {&CurLeft}:PRIVATE-DATA        SKIP
    '{&CurData} CURRENT:'   	     {&CurData}                     SKIP
    '{&CurSortData} SORT:'           {&CurSortData}                 SKIP
    '{&CurFieldData} FIELD:'	     {&CurFieldData}                SKIP
    'cMoreData[{&Table}]'            cMoreData[{&Table}]            SKIP
    '{&CurTable} CURRENT TABLE:'     {&CurTable}                    SKIP
    VIEW-AS ALERT-BOX ERROR BUTTONS OK.
END.
END PROCEDURE.
/* -----------------------------------------------------------
Purpose:
Run Syntax:  RUN <procedure> (INPUT, OUTPUT).
Parameters:  <none>
Notes:
-------------------------------------------------------------*/
PROCEDURE Join.ip.

DEFINE INPUT PARAMETER cInsert   AS CHARACTER NO-UNDO.
DEFINE INPUT PARAMETER lOperator AS LOGICAL NO-UNDO.

DO WITH FRAME dialog-1:

  FIND LAST ttWhere WHERE INTEGER (rsMain:screen-value) = ttWhere.iState AND
    lLeft:SCREEN-VALUE = ttWhere.cTable.

  i               = ttWhere.iSeq.
  /* if text selected, merely replace and return */
  /* ksu 02/23/94 LENGTH and SUBSTRING use default mode */
  /* dma 04/17/95 - CURSOR-OFFSET works in RAW mode */
  IF eDisplayCode:SELECTION-TEXT <> "" THEN
    lOK = eDisplayCode:REPLACE-SELECTION-TEXT (cInsert).
  ELSE IF (ttWhere.iOffset > 1 AND
    ttWhere.iOffset < LENGTH(ttWhere.cExpression,"RAW":u)) THEN
  ASSIGN
    eDisplayCode:SCREEN-VALUE  = SUBSTRING(ttWhere.cExpression,1,
                                   ttWhere.iOffset - 1,"RAW":u)
                               + cInsert
                               + SUBSTRING(ttWhere.cExpression,
                                   ttWhere.iOffset,-1,"RAW":u)
    eDisplayCode:CURSOR-OFFSET = ttWhere.iOffset
                               + LENGTH(cInsert,"RAW":U)
    .
  ELSE
  ASSIGN
    eDisplayCode:SCREEN-VALUE = (IF (eDisplayCode:SCREEN-VALUE = ""
                                 OR eDisplayCode:SCREEN-VALUE = ? ) THEN
                                   cInsert
                                 ELSE
                                   eDisplayCode:SCREEN-VALUE + " " + cInsert)
    eDisplayCode:CURSOR-OFFSET = LENGTH(eDisplayCode:SCREEN-VALUE,"RAW":U) + 1
    .

  CREATE ttWhere.

  ASSIGN
    eDisplayCode:sensitive     = (IF eDisplayCode:screen-value > "" THEN 
                                    TRUE ELSE FALSE)
    ttWhere.iState             = INTEGER(rsMain:screen-value)
    ttWhere.cTable             = lLeft:SCREEN-VALUE
    ttWhere.iSeq               = i + 1
    ttWhere.cExpression        = eDisplayCode:SCREEN-VALUE
    ttWhere.iOffset            = eDisplayCode:CURSOR-OFFSET
    ttWhere.lOperator          = lOperator
    {&CurRight}:PRIVATE-DATA   = eDisplayCode:SCREEN-VALUE
    {&CurLeft}:screen-value    = ""
    {&CurRight}:screen-value   = ""
    {&CurLeft}:sensitive       = ttWhere.lOperator
    {&CurRight}:sensitive      = ttWhere.lOperator
    bUndo:SENSITIVE            = TRUE
    bCheckSyntax:SENSITIVE     = TRUE
    acJoin[LOOKUP({&CurTable},slComboBox:List-Items,{&Sep1})]
    = ttWhere.cExpression
    .

  RUN adecomm/_qset.p ("SetOperatorsSensitive.ip", NOT lOperator).

  /*
  IF eDisplayCode:sensitive THEN
  APPLY "ENTRY" TO eDisplayCode.
  */
END.
END PROCEDURE.
/*--------------------------------------------------------------------------*/
PROCEDURE LeftWhere.ip.

DO WITH FRAME dialog-1:

  DEFINE VARIABLE cTemp      AS CHARACTER NO-UNDO. /* scrap */
  DEFINE VARIABLE i          AS INTEGER   NO-UNDO. /* scrap */
  DEFINE VARIABLE cMatchName AS CHARACTER NO-UNDO. /* fieldname pattern match */
  DEFINE VARIABLE cFieldName AS CHARACTER NO-UNDO. /* selected field name */

  &if {&Debug} &then
  MESSAGE "#1 in".
  &endif

  FIND LAST ttWhere WHERE INTEGER (rsMain:screen-value) = ttWhere.iState AND
    lLeft:SCREEN-VALUE = ttWhere.cTable.
  ASSIGN
    i          = ttWhere.iSeq
    cTemp      = TRIM(eDisplayCode:SCREEN-VALUE)
    cFieldName = lLeft:SCREEN-VALUE + "." +
    /*    (IF NUM-ENTRIES({&TableRight}:LIST-ITEMS,{&Sep1} ) = 1 THEN
    IF lFullName THEN
    cTableList + ".":u
    ELSE
    ENTRY (2, cTableList, ".") + ".":u
    ELSE IF lHiden THEN
    LDBNAME("RESULTSDB":u) + ".":u
    ELSE "")
    + */
    {&CurLeft}:SCREEN-VALUE. /* QBF_S ?? */

  /* if text selected, merely replace and return */
  IF eDisplayCode:SELECTION-TEXT <> "" THEN
    lOK = eDisplayCode:REPLACE-SELECTION-TEXT (cFieldName).
  ELSE DO:
    /* if picking field name, check to see if it should replace the last */
    /* field name selected in the editor widget */
    RUN guess_field (OUTPUT cMatchName). /* do NOT put into cLastField */
    IF cMatchName <> ?
      AND (cTemp = cMatchName
      OR cTemp MATCHES "*":u + CHR(10) + "AND ":u + cMatchName
      OR cTemp MATCHES "*":u + CHR(10) + "OR ":u  + cMatchName) THEN DO:

      /* ksu 02/23/94 use default mode */
      cTemp = TRIM(SUBSTRING(" ":u + cTemp,1,
                             R-INDEX(CHR(10) + cTemp,CHR(10)),"CHARACTER":u)).
    END.

    IF (ttWhere.iOffset > 1 AND
      ttWhere.iOffset < LENGTH(ttWhere.cExpression,"RAW":U)) THEN
    ASSIGN
      eDisplayCode:SCREEN-VALUE  = SUBSTRING(ttWhere.cExpression,1,
                                     ttWhere.iOffset - 1,"RAW":u)
                                 + cFieldName
                                 + SUBSTRING(ttWhere.cExpression,
                                     ttWhere.iOffset,-1,"RAW":u)
      eDisplayCode:CURSOR-OFFSET = ttWhere.iOffset
                                 + LENGTH(cFieldName,"RAW":U)
      .
    ELSE
    ASSIGN
      eDisplayCode:SCREEN-VALUE  = (IF cTemp = "" THEN ""
                                    ELSE cTemp + CHR(10)
                                 + (IF TRIM(radio-set-2:SCREEN-VALUE) = "YES" 
                                    THEN "AND" ELSE "OR")
                                 + " ":u) + cFieldName

      eDisplayCode:CURSOR-OFFSET = LENGTH(eDisplayCode:SCREEN-VALUE,
                                     "RAW":U) + 1.
  END.

  CREATE ttWhere.

  ASSIGN
    eDisplayCode:sensitive     = (IF eDisplayCode:screen-value > "" THEN
                                  TRUE ELSE FALSE)
    cLastField                 = cFieldName
    ttWhere.iState             = INTEGER(rsMain:screen-value)
    ttWhere.cTable             = lLeft:SCREEN-VALUE
    ttWhere.iSeq               = i + 1
    ttWhere.cExpression        = eDisplayCode:SCREEN-VALUE
    ttWhere.cLastField         = cLastField
    ttWhere.iOffset            = eDisplayCode:CURSOR-OFFSET
    {&CurLeft}:screen-value    = ""
    {&CurRight}:screen-value   = ""
    {&CurLeft}:sensitive       = ttWhere.lOperator
    {&CurRight}:sensitive      = ttWhere.lOperator
    bCheckSyntax:SENSITIVE     = TRUE
    bUndo:SENSITIVE            = TRUE
    acWhere [LOOKUP ({&CurTable}, slComboBox:List-Items, {&Sep1})] = ttWhere.cExpression
    .

  RUN load_ops.

  /*
  IF eDisplayCode:sensitive THEN
  APPLY "ENTRY" TO eDisplayCode.
  */

  &if {&Debug} &then
  MESSAGE "#1 out".
  &endif
END.
END.
/*--------------------------------------------------------------------------*/
/* try to get the last field listed in the expert window */

PROCEDURE guess_field:

&if {&Debug} &then
MESSAGE "#5 in".
&endif

DEFINE OUTPUT PARAMETER cFieldTarget AS CHARACTER NO-UNDO. /* potential field */

DEFINE VARIABLE cAnswer AS CHARACTER NO-UNDO. /* return value */
DEFINE VARIABLE lHiden AS LOGICAL   NO-UNDO.

DO WITH FRAME dialog-1:

  ASSIGN
    cFieldTarget = TRIM(eDisplayCode:SCREEN-VALUE,
                     " ,()=<>":u + CHR(9) + CHR(10) + CHR(13))
    cFieldTarget = (IF cFieldTarget = "" THEN ? ELSE
                    ENTRY(NUM-ENTRIES(cFieldTarget," ":u),cFieldTarget," ":u)).
  IF /* NUM-ENTRIES(cTableList) = 1 AND*/ INDEX(cFieldTarget,".":u) = 0 THEN
    cFieldTarget = lLeft:SCREEN-VALUE + ".":u + cFieldTarget.
  /*  IF lHiden AND NUM-ENTRIES(cFieldTarget,".":u) = 2 THEN
      cFieldTarget = LDBNAME("RESULTSDB":u) + ".":u + cFieldTarget.
  */

  IF NUM-ENTRIES(cFieldTarget,".":u) <> 3 THEN
  .
  ELSE IF lHiden THEN DO:
    /* if only one db available, quicker to search ourselves. */
    FIND FIRST DICTDB._Db NO-LOCK.
    FIND DICTDB._File OF DICTDB._Db
      WHERE DICTDB._File._File-name = ENTRY(2,cFieldTarget,".":u)
      NO-LOCK NO-ERROR.
    IF AVAILABLE DICTDB._File THEN
    FIND DICTDB._Field OF DICTDB._File
      WHERE DICTDB._Field._Field-name = ENTRY(3,cFieldTarget,".":u)
      NO-LOCK NO-ERROR.
    ELSE
    RELEASE DICTDB._Field. /* just in case... */
    IF NOT AVAILABLE DICTDB._Field THEN
      cFieldTarget = ?.
  END.
  ELSE
  DO:
    /* but if more than one db connected, call professional help. */
    RUN "adecomm/_y-schem.p" (cFieldTarget,"","",OUTPUT cAnswer).
    IF cAnswer = ? THEN
    cFieldTarget = ?.
  END.
  &if {&Debug} &then
  MESSAGE "#5 out".
  &endif
END.
END PROCEDURE. /* guess_field */


/*--------------------------------------------------------------------------*/
/* load up appropriate comparison operators into qbf-p */
PROCEDURE load_ops:

DO WITH FRAME dialog-1:

  &if {&Debug} &then
  MESSAGE "#7 in".
  &endif
  DEFINE VARIABLE iExtent AS INTEGER   NO-UNDO. /* extent */
  DEFINE VARIABLE i AS INTEGER   NO-UNDO. /* scrap */
  DEFINE VARIABLE cListItems AS CHARACTER NO-UNDO. /* list-items string */
  DEFINE VARIABLE cDataType AS CHARACTER NO-UNDO. /* datatype */
  DEFINE VARIABLE cGuessField AS CHARACTER NO-UNDO. /* guessed field name */
  DEFINE VARIABLE lQBW AS LOGICAL   NO-UNDO. /* is qbw field? */

  RUN guess_field (OUTPUT cGuessField). /* returns ? for unknown field name */
  cLastField = (IF cGuessField = ? THEN
  cLastField ELSE
  cGuessField).

  /* if ((NOT lFullName) AND NUM-ENTRIES(cLastField, ".") = 2) then 
   * remove database piece ?
   */
  /*    cLastField = ENTRY (1, cTableList, ".") + "." + cLastField. */

  /* ggg cLastField = lLeft:SCREEN-VALUE + "." + {&CurLeft}:SCREEN-VALUE. */

  IF cLastField <> ? AND cLastField <> "" THEN DO:
    IF (NUM-ENTRIES (cLastField, ".") < 3) THEN
      RUN adecomm/_y-schem.p (cCurrentDb + "." + cLastField,"","",
                              OUTPUT cListItems).
    ELSE
      RUN adecomm/_y-schem.p (cLastField,"","",OUTPUT cListItems).
    ASSIGN
      cDataType = ENTRY(1,cListItems)
      iExtent   = INTEGER(ENTRY(2,cListItems))
      lQBW      = (ENTRY(4,cListItems) = "y":u).
  END.
  cListItems = "".

  /* if data type is datetime or datetime-tz, then set it to date */
  IF CAN-DO("34,40",cDataType) THEN
      cDataType = "2".

  /* if data type is INT64, then set it to INTEGER */
  IF cDataType = "41" THEN
      cDataType = "4".

  /* If field name is unknown, load up everything. */
  /* If selection-text non-null and guess_field = ?, load up everything. */

  DO i = 1 TO EXTENT(acWhereState):
    IF   (cLastField = ?)
      OR (cGuessField = ? AND eDisplayCode:SELECTION-TEXT <> "")
      OR (INDEX(ENTRY(1,acWhereState[i]),"q":u) > 0 AND lQBW)
      OR (INDEX(ENTRY(1,acWhereState[i]),cDataType) > 0          ) THEN
    /*
    cListItems = cListItems + (IF cListItems = "" THEN "" ELSE ",":u)
    + ENTRY(3,acWhereState[i]).
    */
    CASE i:
      WHEN {&bEqual}        THEN bEqual:SENSITIVE        = TRUE.
      WHEN {&bNotEqual}     THEN bNotEqual:SENSITIVE     = TRUE.
      WHEN {&bLess}         THEN bLess:SENSITIVE         = TRUE.
      WHEN {&bGreater}      THEN bGreater:SENSITIVE      = TRUE.
      WHEN {&bLessEqual}    THEN bLessEqual:SENSITIVE    = TRUE.
      WHEN {&bGreaterEqual} THEN bGreaterEqual:SENSITIVE = TRUE.
      WHEN {&bBegins}       THEN bBegins:SENSITIVE       = TRUE.
      WHEN {&bMatches}      THEN bMatches:SENSITIVE      = TRUE.
      /* WHEN {&bLike}        THEN bLike:SENSITIVE         = TRUE.*/
      WHEN {&bRange}        THEN bRange:SENSITIVE        = TRUE.
      WHEN {&bList}         THEN bList:SENSITIVE         = TRUE.
      WHEN {&bXMatches}     THEN bXMatches:SENSITIVE     = TRUE.
      WHEN {&bContains}     THEN bContains:SENSITIVE     = TRUE.
      /* WHEN {&bxRange}      THEN bxRange:SENSITIVE       = TRUE.
         WHEN {&bXList}       THEN bXList:SENSITIVE        = TRUE.*/
      WHEN {&bAnd }         THEN bAnd:SENSITIVE          = TRUE.
      WHEN {&bOr }          THEN bOr:SENSITIVE           = TRUE.
    END CASE.
  ELSE
  CASE i:
    WHEN {&bEqual}          THEN bEqual:SENSITIVE        = FALSE.
    WHEN {&bNotEqual}       THEN bNotEqual:SENSITIVE     = FALSE.
    WHEN {&bLess}           THEN bLess:SENSITIVE         = FALSE.
    WHEN {&bGreater}        THEN bGreater:SENSITIVE      = FALSE.
    WHEN {&bLessEqual}      THEN bLessEqual:SENSITIVE    = FALSE.
    WHEN {&bGreaterEqual}   THEN bGreaterEqual:SENSITIVE = FALSE.
    WHEN {&bBegins}         THEN bBegins:SENSITIVE       = FALSE.
    WHEN {&bMatches}        THEN bMatches:SENSITIVE      = FALSE.
    /* WHEN {&bLike}          THEN bLike:SENSITIVE         = FALSE.*/
    WHEN {&bRange}          THEN bRange:SENSITIVE        = FALSE.
    WHEN {&bList}           THEN bList:SENSITIVE         = FALSE.
    WHEN {&bXMatches}       THEN bXMatches:SENSITIVE     = FALSE.
    WHEN {&bContains}       THEN bContains:SENSITIVE     = FALSE.
    /* WHEN {&bxRange}        THEN bxRange:SENSITIVE       = FALSE.
    WHEN {&bXList}            THEN bXList:SENSITIVE        = FALSE.*/ 
    WHEN {&bAnd }           THEN bAnd:SENSITIVE          = FALSE.
    WHEN {&bOr }            THEN bOr:SENSITIVE           = FALSE.

END CASE.
END.

/*
IF qbf-p:LIST-ITEMS IN FRAME qbf%where <> cListItems THEN
qbf-p:LIST-ITEMS IN FRAME qbf%where = cListItems.
*/
&if {&Debug} &then
MESSAGE "#7 out".
&endif
END.
END PROCEDURE. /* load_ops */
/*--------------------------------------------------------------------------*/
/*
PROCEDURE WhereOperator.ip.

DEFINE INPUT PARAMETER cLabel AS CHARACTER NO-UNDO.

DO with frame dialog-1:

&if {&Debug} &then
message "#3 in".
&endif
DEFINE VARIABLE c4glCode AS CHARACTER NO-UNDO.
DEFINE VARIABLE cTemp AS CHARACTER NO-UNDO. /* scrap */
DEFINE VARIABLE cFormat AS CHARACTER NO-UNDO. /* format */
DEFINE VARIABLE i AS INTEGER   NO-UNDO.
DEFINE VARIABLE iDataType AS INTEGER   NO-UNDO.
DEFINE VARIABLE lInclusive AS LOGICAL   NO-UNDO.

DEFINE VARIABLE iAskRunTime AS INTEGER NO-UNDO. /* ask at runtime flag */

/*  DEFINE VARIABLE qbf_e AS INTEGER   NO-UNDO.  GJO ***/
/*  DEFINE VARIABLE qbf_w AS LOGICAL   NO-UNDO.  GJO ****/

FIND LAST ttWhere WHERE INTEGER (rsMain:screen-value) = ttWhere.iState 
  AND lLeft:SCREEN-VALUE = ttWhere.cTable.

i               = ttWhere.iSeq.

CREATE ttWhere.

ASSIGN
c4glCode        = TRIM(eDisplayCode:SCREEN-VALUE)
ttWhere.iState  = INTEGER (rsMain:screen-value)
ttWhere.cTable  = lLeft:SCREEN-VALUE
ttWhere.iSeq    = i + 1
bUndo:SENSITIVE = TRUE
iAskRunTime     = 1
bCheckSyntax:SENSITIVE = TRUE
.

RUN guess_field (OUTPUT cTemp).
cLastField = (IF cTemp = ? THEN cLastField ELSE cTemp).

DO i = 1 TO EXTENT(acWhereState):
/*    IF qbf-p:SCREEN-VALUE IN FRAME qbf%where = ENTRY(3,acWhereState[i]) THEN LEAVE.*/

/*
message
'['   i ']'skip
'['   cLabel ']'skip
'['   ENTRY (2, acWhereState[i]) ']' skip
'['   acWhereState[i] ']'
view-as alert-box error buttons Ok.
*/
IF cLabel = ENTRY (2, acWhereState[i]) THEN LEAVE.
END.

&if {&Debug} &then
if i > extent(acWhereState) then
  message "#3 out early" skip
  cLabel skip
  ENTRY(2,acWhereState[1])
  view-as alert-box error buttons OK.
&endif

IF i > EXTENT(acWhereState) THEN RETURN.

IF (NUM-ENTRIES (cLastField, ".") < 3) THEN
  RUN adecomm/_y-schem.p (cCurrentDb + "." + cLastField,"","",OUTPUT cTemp).
ELSE
  RUN adecomm/_y-schem.p (cLastField,"","",OUTPUT cTemp).

ASSIGN
  iDataType = INTEGER(ENTRY(1,cTemp))
  /*    qbf_e = INTEGER(ENTRY(2,cTemp)) */
  /*    qbf_w = (ENTRY(4,cTemp) = "y":u) */
  cFormat = ENTRY(2,cTemp,CHR(10)).

CASE SUBSTRING(ENTRY(1,acWhereState[i]),1,1,"CHARACTER":u):
  WHEN "o":u THEN /* get one value of any type */
    CASE iDataType:
      WHEN 1 THEN RUN adecomm/_y-strng.p (iAskRunTime,cFormat,?,OUTPUT cValue,
                                          OUTPUT lInclusive).
      WHEN 2 THEN RUN adecomm/_y-date.p  (iAskRunTime,cFormat,?,OUTPUT cValue,
                                          OUTPUT lInclusive).
      WHEN 34 THEN RUN adecomm/_y-datetime.p (iAskRunTime,cFormat,?,OUTPUT cValue,
                                          OUTPUT lInclusive).
      WHEN 40 THEN RUN adecomm/_y-datetime-tz.p (iAskRunTime,cFormat,?,OUTPUT cValue,
                                          OUTPUT lInclusive).
      WHEN 3 THEN RUN adecomm/_y-logic.p (iAskRunTime,cFormat,?,OUTPUT cValue).
      WHEN 4 OR WHEN 5 THEN
                  RUN "adecomm/_y-num.p" (iAskRunTime,cFormat,?,OUTPUT cValue,
                                          OUTPUT lInclusive).
  END CASE.
  WHEN "u":u THEN /* get one unformatted string value */
    RUN adecomm/_y-strng.p (iAskRunTime,
      "x(":u + STRING(LENGTH(STRING("",cFormat),"RAW":U)) + ")":u,
      ?,OUTPUT cValue,OUTPUT lInclusive).
  WHEN "q":u THEN /* get qbw string */
    RUN adecomm/_y-qbw.p (iAskRunTime,?,?,OUTPUT cValue).
  WHEN "r":u THEN DO: /* get upper & lower range for anything but logical */
    CASE iDataType:
      WHEN 1 THEN RUN adecomm/_y-strng.p (2,cFormat,?,OUTPUT cValue,
                                          OUTPUT lInclusive).
      WHEN 2 THEN RUN adecomm/_y-date.p  (2,cFormat,?,OUTPUT cValue,
                                          OUTPUT lInclusive).
      WHEN 34 THEN RUN adecomm/_y-datetime.p (2,cFormat,?,OUTPUT cValue,
                                          OUTPUT lInclusive).
      WHEN 40 THEN RUN adecomm/_y-datetime-tz.p (2,cFormat,?,OUTPUT cValue,
                                          OUTPUT lInclusive).
      WHEN 4 OR WHEN 5 THEN
                  RUN adecomm/_y-num.p   (2,cFormat,?,OUTPUT cValue,
                                          OUTPUT lInclusive).
    END CASE.
  END.
  WHEN "m":u THEN DO: /* get list of values for anything but logical */
    CASE iDataType:
      WHEN 1 THEN RUN adecomm/_y-strng.p (3,cFormat,?,OUTPUT cValue,
                                          OUTPUT lInclusive).
      WHEN 2 THEN RUN adecomm/_y-date.p  (3,cFormat,?,OUTPUT cValue,
                                          OUTPUT lInclusive).
      WHEN 4 OR WHEN 5 THEN
                  RUN adecomm/_y-num.p   (3,cFormat,?,OUTPUT cValue,
                                          OUTPUT lInclusive).
    END CASE.
  END.
END CASE.

IF cValue = ? THEN RETURN.

/* quoter-ize it */
/*...*/
/* other sequences as well? */

&if {&Debug} &then
message 'greg' cLastField iDataType cValue i SUBSTRING(ENTRY(1,acWhereState[i]),1,1).
&endif

cOperator = ENTRY(2,acWhereState[i]).

cTemp = ?.
IF cValue = "<<ask>>":u THEN DO:
  RUN adecomm/_y-strng.p (1,"x(72)":u,"What question...",OUTPUT cTemp).

  IF cTemp = ? THEN RETURN.

  cValue = '/*':u
         + ENTRY(iDataType,"character,date,logical,integer,decimal":u)
         + ',':u
         + cLastField
         + ',':u
         + cOperator
         + ',:':u
         + SUBSTRING(cTemp,2,LENGTH(cTemp,"CHARACTER":u) - 2,"CHARACTER":u)
         + '*/':u.
END.

CASE cOperator:
     WHEN    "=":u OR WHEN "<>":u
  OR WHEN "<":u OR WHEN "<=":u
  OR WHEN ">":u OR WHEN ">=":u
  OR WHEN "BEGINS":u
  OR WHEN "MATCHES":u
  OR WHEN "AND":u
  OR WHEN "OR":u
  OR WHEN "CONTAINS":u THEN 
  c4glCode = c4glCode + " ":u + cOperator + " ":u + cValue.

  WHEN "LIKE":u THEN DO:
  IF cTemp = ? THEN
    ASSIGN
      cValue = REPLACE(cValue,"*":u,"~~*":u)
      cValue = REPLACE(cValue,".":u,"~~.":u)
      cValue = REPLACE(cValue,"%":u,"*":u)
      cValue = REPLACE(cValue,"_":u,".":u).
      c4glCode = c4glCode + " MATCHES ":u + cValue.
  END.
  WHEN "X-MATCHES":u THEN DO:  /** CONTAINS (QBF) ***/
    IF cTemp = ? THEN
      ASSIGN
        cValue   = '"*':u
                 + SUBSTRING(cValue,2,LENGTH(cValue,"CHARACTER":u) - 2,
                             "CHARACTER":u)
                 + '*"':u
        c4glCode = c4glCode + ' MATCHES ':u + cValue.
  END.
  WHEN "RANGE":u THEN
    IF (lInclusive) THEN
      RUN insert_range (iDataType,"=":u,INPUT-OUTPUT c4glCode).
    ELSE
      RUN insert_range (iDataType,"":u,INPUT-OUTPUT c4glCode).
  WHEN "LIST":u THEN
    IF (lInclusive) THEN
      RUN insert_list (iDataType,"=":u,INPUT-OUTPUT c4glCode).
    ELSE
      RUN insert_list (iDataType,"<>":u,INPUT-OUTPUT c4glCode).
 END CASE.

ASSIGN
  eDisplayCode:SCREEN-VALUE  = c4glCode
  eDisplayCode:CURSOR-OFFSET = LENGTH(c4glCode,"RAW":U) + 1
  eDisplayCode:sensitive     = (IF eDisplayCode:screen-value > "" THEN 
                                TRUE ELSE FALSE)
  ttWhere.cExpression        = c4glCode
  ttWhere.iOffset            = eDisplayCode:CURSOR-OFFSET
  ttWhere.lOperator          = TRUE
  {&CurLeft}:sensitive       = TRUE
  {&CurRight}:sensitive      = TRUE
  acWhere [LOOKUP ({&CurTable}, slComboBox:List-Items, {&Sep1})] = ttWhere.cExpression
.

RUN adecomm/_qset.p ("SetOperatorsSensitive.ip", FALSE).
RUN adecomm/_qset.p ("SetJoinOperatorsSensitive.ip", FALSE).

/*
IF eDisplayCode:sensitive THEN
APPLY "ENTRY" TO eDisplayCode.
*/

&if {&Debug} &then
message "#3 out".
&endif
END.
END.
/* ---------------------------------------------------------------------*/

/*
Appends "(x >_ v1 AND x <_ v2)", where "_" is "=" for inclusive range
or "" for exclusive range.  If can't match field name as last token in
qbf_4, omits parens and produces "x >_ v1 AND x <_ v2" instead.
*/

PROCEDURE insert_range:
DEFINE INPUT        PARAMETER i           AS INTEGER   NO-UNDO. /* NOT USED */
DEFINE INPUT        PARAMETER cExpression AS CHARACTER NO-UNDO.
DEFINE INPUT-OUTPUT PARAMETER c4glCode    AS CHARACTER NO-UNDO.
DEFINE VARIABLE               cTemp       AS CHARACTER NO-UNDO. /* scrap */

/*hack!*/
/*if index(cValue,",") > 0 then substring(cValue,index(cValue,","),1) = chr(10).*/

/*
IF i = 1 THEN
  cTemp = '"':u + REPLACE(ENTRY(1,cValue,CHR(10)),'"':u,'""':u) + '"':u
        + CHR(10)
        + '"':u + REPLACE(ENTRY(2,cValue,CHR(10)),'"':u,'""':u) + '"':u.
ELSE
*/
  cTemp = cValue.

/* tex 02/22/94 tex check to use LENGTH default mode */
IF SUBSTRING(c4glCode,LENGTH(c4glCode,"CHARACTER":u)
  - LENGTH(cLastField,"CHARACTER":u) + 1,"CHARACTER":u) = cLastField THEN
  c4glCode = SUBSTRING(c4glCode,1,LENGTH(c4glCode,"CHARACTER":u)
             - LENGTH(cLastField,"CHARACTER":u),"CHARACTER":u)
           + "(":u
           + cLastField + " >":u + cExpression + " ":u
           + ENTRY(1,cTemp,CHR(10))
           + " AND ":u
           + cLastField + " <":u + cExpression + " ":u
           + ENTRY(2,cTemp,CHR(10))
           + ")":u.
ELSE
  c4glCode = c4glCode + " ":u
           + cLastField + " >":u + cExpression + " ":u
           + ENTRY(1,cTemp,CHR(10))
           + " AND ":u
           + cLastField + " <":u + cExpression + " ":u
           + ENTRY(2,cTemp,CHR(10)).
END PROCEDURE. /* insert_range */

/* ---------------------------------------------------------------------*/
/*
Appends "(x _ v1 ___ x _ v2)", where "_" is "=" for in-list and "<>"
for not-in-list and "___" is "OR" for in-list and "AND" for
not-in-list.  If can't match field name as last token in qbf_4, omits
parens and produces "x _ v1 ___ x _ v2" instead.
*/

PROCEDURE insert_list:
DEFINE INPUT        PARAMETER i AS INTEGER   NO-UNDO. /*** THIS IS NOT USED GJO ****/
DEFINE INPUT        PARAMETER cOperator AS CHARACTER NO-UNDO. /* = or <> */
DEFINE INPUT-OUTPUT PARAMETER c4glClode AS CHARACTER NO-UNDO.

DEFINE VARIABLE cTemp AS CHARACTER NO-UNDO. /* scrap */

cTemp = cValue.

/* from [a,b,c] */
/*       !^!^!  */
/*   to [ = a or n = b or n = c] */
/*       ---!^^^^^^^^!^^^^^^^^!  */

cTemp = ' ':u + cOperator + ' ':u
      + REPLACE( cTemp, CHR(10), CHR(10) 
      + (IF cOperator = "=":u THEN "  OR ":u ELSE "  AND ":u)
      + cLastField + " ":u + cOperator + " ":u).

IF SUBSTRING(c4glClode,LENGTH(c4glClode,"CHARACTER":u)
  - LENGTH(cLastField,"CHARACTER":u) + 1,"CHARACTER":u) = cLastField THEN
  c4glClode = SUBSTRING(c4glClode,1,LENGTH(c4glClode,"CHARACTER":u)
              - LENGTH(cLastField,"CHARACTER":u),"CHARACTER":u)
            + "(":u + cLastField + cTemp + ")":u.
ELSE
  c4glClode = c4glClode + " ":u + cTemp.
END PROCEDURE. /* insert_list */
*/
/* -----------------------------------------------------------
Purpose:
Run Syntax:  RUN <procedure> (INPUT, OUTPUT).
Parameters:  <none>
Notes:
returns TRUE if syntax error
-------------------------------------------------------------*/
PROCEDURE IsJoinable.ip:

DEFINE INPUT        PARAMETER cRight    AS CHARACTER NO-UNDO.
DEFINE INPUT        PARAMETER cLeft     AS CHARACTER NO-UNDO.
DEFINE OUTPUT       PARAMETER lJoinable AS LOGICAL NO-UNDO.

DEFINE VARIABLE cDbRight AS CHARACTER NO-UNDO.
DEFINE VARIABLE cDbLeft  AS CHARACTER NO-UNDO.

/*  DO WITH FRAME dialog-1: */
MESSAGE "cCurrentDb" cCurrentDb SKIP
  "cDbLeft " cDBleft SKIP
  "cDBRigh " cDbRight SKIP
  VIEW-AS ALERT-BOX ERROR BUTTONS OK.

IF (NUM-ENTRIES (cRight, ".") = 1) THEN
ASSIGN
  cDbRight  = cCurrentDb + "." + cRight
  cDbLeft   = cCurrentDb + "." + cLeft.
ELSE
ASSIGN
  cDbRight  = cRight
  cDbLeft   = cLeft.

/* message cDbLeft cDbRight. */
RUN adecomm/_j-test.p (cDbLeft, cDbRight, OUTPUT lOK).
IF NOT lOK THEN
  RUN adecomm/_j-test.p (cDbRight, cDbLeft, OUTPUT lOK).

lJoinable = lOk.

/*END. */
END PROCEDURE.
/* -----------------------------------------------------------
Purpose:
Run Syntax:  RUN <procedure> (INPUT, OUTPUT).
Parameters:  <none>
Notes:
returns TRUE if syntax error
-------------------------------------------------------------*/
PROCEDURE SetCustJoin.ip:

DO WITH FRAME dialog-1:

  IF (lLeft:screen-value > "") THEN DO:

    RUN adecomm/_qisjoin.p (lLeft:screen-value, lRight:screen-value,
                            OUTPUT lOK).
    ASSIGN
      tJoinable:visible   	= lOK.

    IF (ENTRY (2, {&CurTable}, " ") = "OF") THEN /** Change to WHERE **/
      tJoinable:screen-value = STRING (FALSE).
    ELSE
      tJoinable:screen-value = STRING (TRUE).
  END.
  ELSE
  ASSIGN
    tJoinable:visible       = FALSE.
  /*
  tJoinable:sensitive     = FALSE
  tJoinable:screen-value  = STRING (FALSE).
  */

END.
END PROCEDURE.

/* _qinit.p - end of file */


/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/
/*
 * _qisjoin.p
 *
 *    Detirmines if two fields are "OF" joinable
 *
 *  Input Parameters
 *
 *    rightField - The "right" field to be joined
 *
 *   leftField   - THe "left" side of the join
 *
 *  Output Parameters
 *
 *   joinable    - Logical telling if the feilds are OF joinable
 */

{ adecomm/browqury.i }

define input  parameter rightField as character no-undo.
define input  parameter leftField  as character no-undo.
define output parameter joinable   as logical   no-undo.

define variable cDbRight as character no-undo.
define variable cDbLeft  as character no-undo.
define variable isOk     as logical   no-undo.

if (num-entries (rightField, ".") = 1) then
    assign
        cDbRight  = cCurrentDb + "." + rightField
        cDbLeft   = cCurrentDb + "." + leftField
    .
else
    assign
        cDbRight  = rightField
        cDbLeft   = leftField
    .

run "adecomm/_j-test.p" (cDbLeft, cDbRight, output isOk).
if not isOK then run "adecomm/_j-test.p" (cDbRight, cDbLeft, output isOK).

joinable = isOk.

/**********************************************************************
* Copyright (C) 2000,2006 by Progress Software Corporation. All rights*
* reserved.  Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                            *
*                                                                     *
**********************************************************************/

/*----------------------------------------------------------------------------

File: _qseqdat.p

Description:
   Display _Sequence information for the quick sequence report.  It will go 
   to the currently set output device (e.g., a file, the printer).
 
Input Parameters:
   p_DbId - Id of the _Db record for this database.

Author: Tony Lavinio, Laura Stern

Date Created: 10/05/92

Modified on 06/14/94 by Gerry Seidl. Added NO-LOCKs to file accesses.
            08/08/02 D. McMann Eliminated any sequences whose name begins "$" - Peer Direct
            05/25/06 fernando  Added support for large sequences
----------------------------------------------------------------------------*/

DEFINE INPUT PARAMETER p_DbId  AS RECID NO-UNDO.

DEFINE SHARED STREAM rpt.
DEFINE VAR max_min AS INT64 NO-UNDO.
DEFINE VAR large_seq AS LOGICAL NO-UNDO.
define variable lMultitenant as logical no-undo.

FORM
  dictdb._Sequence._Seq-Name  FORMAT "x(32)"  	    COLUMN-LABEL "Sequence Name"
  lMultitenant                                      COLUMN-LABEL "Mlt-!tnt"
  dictdb._Sequence._Seq-init  FORMAT "->>>>>>>>9"  COLUMN-LABEL "Initial!Value"
  dictdb._Sequence._Seq-incr  FORMAT "->>>>>>>>9"  COLUMN-LABEL "Increment"
  max_min              FORMAT "->>>>>>>>>9" COLUMN-LABEL "Max/Min!Value"
  dictdb._Sequence._Cycle-Ok  FORMAT "yes/no"	    COLUMN-LABEL "Cycle?"
  WITH FRAME shoseqs 
  DOWN USE-TEXT STREAM-IO.

FORM
  dictdb._Sequence._Seq-Name  FORMAT "x(32)"  	    COLUMN-LABEL "Sequence Name"
  lMultitenant                                      COLUMN-LABEL "Multi-tenant"
  dictdb._Sequence._Seq-init  FORMAT "->,>>>,>>>,>>>,>>>,>>>,>>9"  COLUMN-LABEL "Initial Value" SKIP
  dictdb._Sequence._Seq-incr  FORMAT "->,>>>,>>>,>>>,>>>,>>>,>>9"  
                       COLUMN-LABEL "Increment"
  max_min              AT 30 FORMAT "->,>>>,>>>,>>>,>>>,>>>,>>9" COLUMN-LABEL "Max/Min Value"
  dictdb._Sequence._Cycle-Ok  FORMAT "yes/no"	    COLUMN-LABEL "Cycle?" SKIP(1)
  WITH FRAME shoseqsl
  DOWN USE-TEXT STREAM-IO.

FIND FIRST dictdb._db WHERE RECID(dictdb._Db) = p_DbId.

/* let's see if we can use the old format based on the values */
IF dictdb._Db._db-res1[1] = 1 THEN DO: 
    /* large sequence support is turned on */

    FIND FIRST dictdb._Sequence NO-LOCK WHERE dictdb._Sequence._Db-recid = p_DbId
                                 AND NOT dictdb._Sequence._Seq-name BEGINS "$" AND
         (dictdb._Sequence._Seq-incr > 999999999 OR
          dictdb._Sequence._Seq-max  > 999999999 OR
          dictdb._Sequence._Seq-min  > 999999999 OR
          dictdb._Sequence._Seq-init > 999999999) NO-ERROR.

    IF AVAILABLE dictdb._Sequence THEN
       /* we will need the expanded report format */
       ASSIGN large_seq = YES.
END.
 
FOR EACH dictdb._Sequence NO-LOCK WHERE dictdb._Sequence._Db-recid = p_DbId
                                  AND NOT dictdb._Sequence._Seq-name BEGINS "$":
   max_min = (IF dictdb._Sequence._Seq-incr > 0 THEN dictdb._Sequence._Seq-max
      	       	     	      	       	 ELSE dictdb._Sequence._Seq-min).
   if integer(dbversion("dictdb")) > 10 then 
       lMultitenant = dictdb._Sequence._Seq-attributes[1].
   else 
       lMultitenant = false.  	       	     	      	       	   
   IF large_seq THEN DO:
       DISPLAY STREAM rpt
          dictdb._Sequence._Seq-Name 
          lMultitenant
          dictdb._Sequence._Seq-init 
          dictdb._Sequence._Seq-incr 
          max_min
          dictdb._Sequence._Cycle-Ok 
          WITH FRAME shoseqsl.
      DOWN STREAM rpt WITH FRAME shoseqsl.
   END.
   ELSE DO:
       DISPLAY STREAM rpt
          dictdb._Sequence._Seq-Name 
          lMultitenant
          dictdb._Sequence._Seq-init 
          dictdb._Sequence._Seq-incr 
          max_min
          dictdb._Sequence._Cycle-Ok 
          WITH FRAME shoseqs.
      DOWN STREAM rpt WITH FRAME shoseqs.
   END.
END.

/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/*----------------------------------------------------------------------------

File: qseqrpt.p

Description:
   Quick and dirty sequence report for both the GUI and character dictionaries.

Input Parameters:
   p_DbId    - Id of the _Db record corresponding to the current database
   p_PName   - Physical name of the database
   p_DbType  - Database type (e.g., PROGRESS)

Author: Tony Lavinio, Laura Stern

Date Created: 10/08/92

Modified on 06/14/94 by Gerry Seidl. Added NO-LOCKs to file accesses.
            07/14/98 by D. McMann Added DBVERSION check and _Owner for _File find
            03/29/99 by Mario B      BUG# 99-03-26-19 Changed DBNAME to 
                                     "DICTDB" in _Owner check.
            08/08/02 by D. McMann Eliminated any sequences whose name begins "$" - Peer Direct
----------------------------------------------------------------------------*/

{adecomm/commeng.i}  /* Help contexts */

DEFINE INPUT PARAMETER p_DbId 	 AS RECID NO-UNDO.
DEFINE INPUT PARAMETER p_PName 	 AS CHAR  NO-UNDO.
DEFINE INPUT PARAMETER p_DbType  AS CHAR  NO-UNDO.

DEFINE VAR header_str AS CHAR NO-UNDO.

FIND _Db WHERE RECID(_Db) = p_DbId NO-LOCK.
IF INTEGER(DBVERSION("DICTDB")) > 8 THEN
  FIND _File WHERE _File._File-name = "_Sequence"
               AND _File._Owner = "PUB" NO-LOCK.
ELSE               
  FIND _File "_Sequence" NO-LOCK.
  
IF NOT CAN-DO(_File._Can-read,USERID("DICTDB")) THEN DO:
  MESSAGE "You do not have permission to use this option."
    VIEW-AS ALERT-BOX ERROR BUTTONS OK.
  RETURN.
END.

FIND LAST _Sequence WHERE _Sequence._Db-recid = p_DbId 
                      AND NOT _Sequence._Seq-name BEGINS "$" NO-LOCK NO-ERROR.
IF NOT AVAILABLE _Sequence THEN DO:
  MESSAGE "There are no sequences in this database to look at."
    VIEW-AS ALERT-BOX ERROR BUTTONS OK.
  RETURN.
END.

header_str = "Database: " + p_PName + " (" + p_DbType + ")".
RUN adecomm/_report.p 
   (INPUT p_DbId, 
    INPUT header_str,
    INPUT "Sequence Report",
    INPUT "",
    INPUT "",
    INPUT "adecomm/_qseqdat.p",
    INPUT "",
    INPUT {&Sequence_Report}).

/* _qseqrpt.p - end of file */



/**********************************************************************
* Copyright (C) 2000,2006 by Progress Software Corporation. All rights*
* reserved.  Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                            *
*                                                                     *
**********************************************************************/

/*----------------------------------------------------------------------------

File: _qtbldat.p

Description:
   Display _File information for the quick table report.  It will go to 
   the currently set output device (e.g., a file, the printer).
 
Input Parameters:
   p_DbId    - Id of the _Db record for this database.

Author: Tony Lavinio, Laura Stern

Date Created: 10/02/92
    
    Modified: 01/07/98 DLM Added display of current storage area.
              07/10/98 DLM Added DBVERSION and _Owner check.
              10/17/03 DLM Added NO-LOCK to _Db find.
              06/15/06 fernando   Adding support for long dump names    

----------------------------------------------------------------------------*/

DEFINE INPUT PARAMETER p_DbId AS RECID NO-UNDO.

DEFINE SHARED STREAM rpt.

DEFINE VARIABLE flags   AS CHARACTER               NO-UNDO.
DEFINE VARIABLE fldcnt  AS INTEGER                 NO-UNDO INITIAL -1.
DEFINE VARIABLE odbtyp  AS CHARACTER               NO-UNDO. /* list of ODBC-types */
DEFINE VARIABLE starea  AS CHARACTER FORMAT "x(4)" NO-UNDO.

FORM
   dictdb._File._File-name  FORMAT "x(29)"  COLUMN-LABEL "Table!Name" 
   starea                            COLUMN-LABEL "St!Area"   
   dictdb._File._Dump-name  FORMAT "x(13)"   COLUMN-LABEL "Dump!Name"
   flags             FORMAT "x(3)"   COLUMN-LABEL "Tbl!Flg" 
   fldcnt            FORMAT ">>>>9"  COLUMN-LABEL "Field!Count"
   dictdb._File._numkey     FORMAT ">>>>9"  COLUMN-LABEL "Index!Count"
   dictdb._File._File-label FORMAT "x(11)"  COLUMN-LABEL "Table!Label" 
   WITH FRAME shotable USE-TEXT STREAM-IO DOWN.

ASSIGN
  odbtyp      = {adecomm/ds_type.i
                  &direction = "ODBC"
                  &from-type = "flags"
                  }.
                  
FIND dictdb._Db WHERE RECID(dictdb._Db) = p_DbId NO-LOCK.
FOR EACH dictdb._File WHERE dictdb._File._Db-recid = p_DbId AND NOT dictdb._File._Hidden:
   IF INTEGER(DBVERSION("DICTDB")) > 8 AND
      (dictdb._File._Owner <> "PUB" AND dictdb._File._Owner <> "_FOREIGN") THEN NEXT.
   
   IF INTEGER(DBVERSION("DICTDB")) > 10 THEN
      flags = (IF dictdb._File._File-Attributes[1] THEN "m" ELSE "").  
   ASSIGN
      flags = (flags + IF dictdb._File._Db-lang > 0 THEN "s" ELSE "")
      flags = (flags + IF dictdb._File._Frozen THEN "f" ELSE "").
    
   IF dictdb._Db._Db-type = "PROGRESS" AND INTEGER(DBVERSION("DICTDB")) > 8 THEN 
   DO:  
     
     /* note: this check may not be needed, but just in case reports need to work against old versions  */
     if INTEGER(DBVERSION("DICTDB")) > 10 then
     do:
         FIND dictdb._StorageObject WHERE dictdb._StorageObject._DB-recid    = dictdb._File._DB-recid  
                                    and dictdb._StorageObject._Object-Number = dictdb._File._File-number 
                                    AND dictdb._StorageObject._Object-type   = 1 
                                    AND dictdb._StorageObject._Partitionid   = 0
                                    NO-LOCK NO-ERROR.
     end.
     else do:
         FIND dictdb._StorageObject WHERE dictdb._StorageObject._DB-recid    = dictdb._File._DB-recid  
                                    and dictdb._StorageObject._Object-Number = dictdb._File._File-number 
                                    AND dictdb._StorageObject._Object-type   = 1 
                                    NO-LOCK NO-ERROR.  
     end.
     IF AVAILABLE dictdb._StorageObject THEN
        ASSIGN starea = STRING(dictdb._StorageObject._Area-number). 
     ELSE 
        ASSIGN starea = STRING(dictdb._File._ianum).
   END.
   ELSE
      ASSIGN starea = "N/A".
 
   DISPLAY STREAM rpt
      dictdb._File._File-name
      starea
      dictdb._File._File-label
      flags
      /* Progress Db's have an extra hidden field that holds the table # 
      	 which gateway Db's don't have.
      */
      (IF dictdb._Db._Db-type = "PROGRESS"
       OR dictdb._Db._Db-type = "AS400" 
       OR CAN-DO(odbtyp,dictdb._Db._Db-type)
				    THEN dictdb._File._numfld - 1
      	       	    ELSE dictdb._File._numfld) @ fldcnt
      dictdb._File._numkey
      dictdb._File._Dump-name
      WITH FRAME shotable.
   DOWN STREAM rpt WITH FRAME shotable.
END.









/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/*----------------------------------------------------------------------------

File: qtblrpt.p

Description:
   Quick and dirty table report for both the GUI and character dictionary.
 
Input Parameters:
   p_DbId   - Id of the _Db record corresponding to the current database
   p_PName  - Physical name of the database
   p_DbType - Database type (e.g., PROGRESS)

Author: Tony Lavinio, Laura Stern

Date Created: 10/05/92
    Modified: 07/10/98 D. McMann Added DBVERSION and _Owner check
              03/29/99 by Mario B      BUG# 99-03-26-19 Changed DBNAME to 
                                       "DICTDB" in _Owner check.

----------------------------------------------------------------------------*/

{adecomm/commeng.i}  /* Help contexts */

DEFINE INPUT PARAMETER p_DbId 	 AS RECID NO-UNDO.
DEFINE INPUT PARAMETER p_PName 	 AS CHAR  NO-UNDO.
DEFINE INPUT PARAMETER p_DbType  AS CHAR  NO-UNDO.

DEFINE VAR header_str AS CHAR NO-UNDO.
DEFINE VAR flags      AS CHAR NO-UNDO.

IF INTEGER(DBVERSION("DICTDB")) > 8 THEN DO:
  FIND dictdb._File WHERE dictdb._File._File-name = "_File"
               AND dictdb._File._Owner = "PUB"
               NO-LOCK.
  IF NOT CAN-DO(dictdb._File._Can-read,USERID("DICTDB")) THEN DO:
    MESSAGE "You do not have permission to use this option."
      VIEW-AS ALERT-BOX ERROR BUTTONS OK.
    RETURN.
  END.

  FIND LAST dictdb._File WHERE (dictdb._File._Owner = "PUB" OR dictdb._File._Owner = "_FOREIGN")
                    AND NOT dictdb._File._Hidden NO-LOCK NO-ERROR.
  IF NOT AVAILABLE _File THEN DO:
    MESSAGE "There are no tables in this database to look at."
      VIEW-AS ALERT-BOX ERROR BUTTONS OK.
    RETURN.
  END.
END.
ELSE DO:
  FIND dictdb._File "_File".
  IF NOT CAN-DO(dictdb._File._Can-read,USERID("DICTDB")) THEN DO:
    MESSAGE "You do not have permission to use this option."
      VIEW-AS ALERT-BOX ERROR BUTTONS OK.
    RETURN.
  END.

  FIND LAST dictdb._File WHERE  NOT dictdb._File._Hidden NO-ERROR.
  IF NOT AVAILABLE dictdb._File THEN DO:
    MESSAGE "There are no tables in this database to look at."
      VIEW-AS ALERT-BOX ERROR BUTTONS OK.
    RETURN.
  END.
END.  

header_str = "Database: " + p_PName + " (" + p_DbType + ")".
flags = "Flags: 'm' = multi-tenant, 'f' = frozen, 's' = a SQL table".
RUN adecomm/_report.p 
   (INPUT p_DbId, 
    INPUT header_str,
    INPUT "Quick Table Report",
    INPUT flags,
    INPUT "",
    INPUT "adecomm/_qtbldat.p",
    INPUT "",
    INPUT {&Quick_Table_Report}).

/* _qtblrpt.p - end of file */





/**********************************************************************
* Copyright (C) 2000-2010 by Progress Software Corporation. All rights*
* reserved. Prior versions of this work may contain portions          *
* contributed by participants of Possenet.                            *
*                                                                     *
**********************************************************************/

/*----------------------------------------------------------------------------

File: qusrdata.p

Description:
   Display _User information for the quick user report.  It will go to 
   the currently set output device (e.g., a file, the printer).
 
Input Parameters:
   p_DbId - Id of the _Db record for this database.

Author: Tony Lavinio, Laura Stern

Date Created: 10/05/92

Modified on 06/14/94 by Gerry Seidl. Added NO-LOCKs to file accesses.
----------------------------------------------------------------------------*/

/* This isn't used because there is no db id in _User record
   but there should be!!! */
DEFINE INPUT PARAMETER p_DbId  AS RECID NO-UNDO.

DEFINE SHARED STREAM rpt.
DEFINE VAR pword AS LOGICAL NO-UNDO.

FORM
  _User._Userid    FORMAT "x(8)"   LABEL "User ID"
  _User._Domain-Name FORMAT "x(32)" LABEL "Domain"
  _User._User-name FORMAT "x(20)"  LABEL "User Name"
  pword            FORMAT "yes/no" LABEL "Pwd?"
  _User._sql-only-user FORMAT "yes/no" COLUMN-LABEL "SQL!only"
  WITH FRAME shousers 
  DOWN USE-TEXT STREAM-IO.

FOR EACH _User NO-LOCK:
   DISPLAY STREAM rpt
      _User._Userid
      _User._Domain-Name
      _User._User-name
      _User._Password <> ENCODE("") @ pword
      _User._sql-only-user
      WITH FRAME shousers.
  DOWN STREAM rpt WITH FRAME shousers.
END.

/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/*----------------------------------------------------------------------------

File: qusrrpt.p

Description:
   Quick and dirty user report for both the GUI and character dictionaries.

Input Parameters:
   p_DbId    - Id of the _Db record corresponding to the current database
   p_PName   - Physical name of the database
   p_DbType  - Database type (e.g., PROGRESS)

Author: Tony Lavinio, Laura Stern

Date Created: 10/05/92

Modified on 06/14/94 by Gerry Seidl. Added NO-LOCKs to file accesses.
            07/14/98 by D. McMann  Added Version check & _Owner to _File finds
            03/29/99 by Mario B      BUG# 99-03-26-19 Changed DBNAME to 
                                     "DICTDB" in _Owner check.
            
----------------------------------------------------------------------------*/

{adecomm/commeng.i}  /* Help contexts */

DEFINE INPUT PARAMETER p_DbId 	 AS RECID NO-UNDO.
DEFINE INPUT PARAMETER p_PName 	 AS CHAR  NO-UNDO.
DEFINE INPUT PARAMETER p_DbType  AS CHAR  NO-UNDO.

DEFINE VAR header_str AS CHAR NO-UNDO.

FIND _Db  WHERE RECID(_Db) = p_DbId NO-LOCK.
IF INTEGER(DBVERSION("DICTDB")) > 8 THEN
  FIND _File WHERE _File._File-name = "_User"
               AND _File._Owner = "PUB" NO-LOCK.
ELSE
  FIND _File "_User" NO-LOCK.
  
IF NOT CAN-DO(_File._Can-read,USERID("DICTDB")) THEN DO:
  MESSAGE "You do not have permission to use this option."
    VIEW-AS ALERT-BOX ERROR BUTTONS OK.
  RETURN.
END.

FIND LAST _User NO-LOCK NO-ERROR.
IF NOT AVAILABLE _User THEN DO:
  MESSAGE "There are no users in this database to look at."
    VIEW-AS ALERT-BOX ERROR BUTTONS OK.
  RETURN.
END.

header_str = "Database: " + p_PName + " (" + p_DbType + ")".
RUN adecomm/_report.p 
   (INPUT p_DbId, 
    INPUT header_str,
    INPUT "User Report",
    INPUT "",
    INPUT "",
    INPUT "adecomm/_qusrdat.p",
    INPUT "",
    INPUT {&User_Report}).

/* _qusrrpt.p - end of file */




/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/*----------------------------------------------------------------------------

File: qviwdata.p

Description:
   Display _View information for the quick view report.  It will go to 
   the currently set output device (e.g., a file, the printer).
 
Input Parameters:
   p_DbId - Id of the _Db record for this database.
   p_View - The name of the view to report on or "ALL".

Author: Tony Lavinio, Laura Stern

Date Created: 10/05/92

Modified on 06/14/94 by Gerry Seidl. Added NO-LOCKs to file accesses.
----------------------------------------------------------------------------*/

/* This isn't used because there is no db id in _View record
   but there should be!!! */
DEFINE INPUT PARAMETER p_DbId AS RECID NO-UNDO.
DEFINE INPUT PARAMETER p_View AS CHAR  NO-UNDO.

DEFINE BUFFER b_View FOR _View.
DEFINE SHARED STREAM rpt.

DEFINE VAR lbls AS CHAR EXTENT 6 NO-UNDO INITIAL
   [ /* 1 */ "   View Name: ",
     /* 2 */ " Base Tables: ",
     /* 3 */ "Where Clause: ",
     /* 4 */ "    View Def: ",
     /* 5 */ "              "
   ].

&GLOBAL-DEFINE LBL_NAME    1
&GLOBAL-DEFINE LBL_BTBLS   2
&GLOBAL-DEFINE LBL_WHERE   3
&GLOBAL-DEFINE LBL_DEF     4
&GLOBAL-DEFINE LBL_EMPTY   5

DEFINE VAR line    AS CHAR    NO-UNDO.
DEFINE VAR groupby AS LOGICAL NO-UNDO.
DEFINE VAR checkop AS LOGICAL NO-UNDO.

FORM
  b_View._View-name FORMAT "x(30)"  COLUMN-LABEL "View Name"
  b_View._Updatable FORMAT "yes/no" COLUMN-LABEL "Update-!able"
  groupby	    FORMAT "yes/no" COLUMN-LABEL "Group!By?"
  checkop	    FORMAT "yes/no" COLUMN-LABEL "Check!Option?"
  WITH FRAME shoviews DOWN USE-TEXT STREAM-IO.

FORM
  line AT 1  FORMAT "x(77)" NO-LABEL
  WITH FRAME shoviewdef NO-ATTR-SPACE DOWN USE-TEXT STREAM-IO.

FORM
  b_View._Can-read   FORMAT "x(64)" LABEL "Can-Read"   COLON 13 SKIP
  b_View._Can-write  FORMAT "x(64)" LABEL "Can-Write"  COLON 13 SKIP
  b_View._Can-create FORMAT "x(64)" LABEL "Can-Create" COLON 13 SKIP
  b_View._Can-delete FORMAT "x(64)" LABEL "Can-Delete" COLON 13 SKIP(1)
  WITH FRAME shoviewsec SIDE-LABELS USE-TEXT STREAM-IO.

FORM
  _View-Col._Vcol-Order FORMAT ">>>>9" COLUMN-LABEL "Order" AT 2
  _View-Col._Col-Name   FORMAT "x(30)" COLUMN-LABEL "View Column Name" 
  _View-Col._Base-Col   FORMAT "x(38)" COLUMN-LABEL "Base Columns"
  WITH FRAME shoviewcols DOWN USE-TEXT STREAM-IO.


/*==========================Internal Procedures==============================*/

/*--------------------------------------------------------------
   Display the value of a comma delimited list or a 
   where clause, splitting it apart if it is longer
   than will fit and making sure to split on a delimiter
   boundary.  Don't display anything if the value is blank.

   Input Parameter:
      p_Str   - The string to display
      p_Label - Label to display on the first line
      p_Delim - The delimiter to split at (e.g., comma or blank)
----------------------------------------------------------------*/
PROCEDURE Display_Value:

&GLOBAL-DEFINE TEXTLEN	63  /* 77 - Max length of label in bytes */

   DEFINE INPUT PARAMETER p_Str   AS CHAR NO-UNDO.
   DEFINE INPUT PARAMETER p_Label AS CHAR NO-UNDO.
   DEFINE INPUT PARAMETER p_Delim AS CHAR NO-UNDO.
   
   DEFINE VAR frst AS LOGICAL NO-UNDO INIT yes.
   DEFINE VAR val  AS CHAR    NO-UNDO.
   DEFINE VAR ix   AS INTEGER NO-UNDO.

   IF p_Str = "" THEN RETURN.

   DO WHILE LENGTH(p_Str,"RAW":U) > {&TEXTLEN}:
      /* Find the last delimiter within the length of text that will fit. */
      ASSIGN
      	 ix    = R-INDEX(SUBSTRING(p_Str,1,{&TEXTLEN},"FIXED":u), p_Delim)
      	 val   = SUBSTRING(p_Str,1,ix - 1,"CHARACTER":u)
      	 p_Str = TRIM(SUBSTRING(p_Str,ix + 1,-1,"CHARACTER":u))
         .

      DISPLAY STREAM rpt 
      	 (IF frst THEN p_Label ELSE lbls[{&LBL_EMPTY}]) + val @ line
      	 WITH FRAME shoviewdef.
      DOWN STREAM rpt WITH FRAME shoviewdef.
      frst = no.
   END.
   DISPLAY STREAM rpt 
      (IF frst THEN p_Label ELSE lbls[{&LBL_EMPTY}]) + p_Str @ line
      WITH FRAME shoviewdef.
   DOWN STREAM rpt WITH FRAME shoviewdef.
END.

/*--------------------------------------------------------------
   Display information for current view in table format.
----------------------------------------------------------------*/
PROCEDURE Display_View_In_Table:
   ASSIGN 
      /* This is based on a kludge - the _Group-By field is used
      	 for two things.  Since views with the group by option cannot
      	 be updateable, if group-by is not null and the view is 
      	 updateable, it means check-option is yes!
      */
      groupby = (IF b_View._Group-by <> ? AND NOT b_View._Updatable 
      	       	THEN yes ELSE no)
      checkop =	(IF b_View._Group-By <> ? AND     b_View._Updatable 
      	        THEN yes ELSE no).
   DISPLAY STREAM rpt 
      	   b_View._View-name
      	   b_View._Updatable
      	   groupby
      	   checkop
      	   WITH FRAME shoviews.
   DOWN STREAM rpt WITH FRAME shoviews.
END.


/*--------------------------------------------------------------
   Display remaining information for current view.
----------------------------------------------------------------*/
PROCEDURE Display_View_Other:
   DISPLAY STREAM rpt lbls[{&LBL_NAME}] + b_View._View-name 
      @ line WITH frame shoviewdef.
   DOWN STREAM rpt WITH FRAME shoviewdef.

   /* Display base tables */
   RUN Display_Value (INPUT b_View._Base-tables, INPUT lbls[{&LBL_BTBLS}],
      	       	      INPUT ",").

   /* Now display the where clause */
   if b_View._Where-cls <> ? THEN
      RUN Display_Value (INPUT b_View._Where-cls, INPUT lbls[{&LBL_WHERE}], 
      	       	      	 INPUT " ").

   /* Now display the whole view definition */
   if b_View._View-def <> ? THEN
      RUN Display_Value (INPUT b_View._View-def, INPUT lbls[{&LBL_DEF}], 
      	       	      	 INPUT " ").

   DISPLAY STREAM rpt
      b_View._Can-read 
      b_View._Can-write 
      b_View._Can-create 
      b_View._Can-delete
      WITH FRAME shoviewsec.

   FOR EACH _View-Col OF b_View NO-LOCK:
      DISPLAY STREAM rpt
      	 _View-Col._Vcol-Order
      	 _View-Col._Col-Name
      	 _View-Col._Base-Col
      	 WITH FRAME shoviewcols.
      DOWN WITH FRAME shoviewcols.
   END.
END.

/*=============================Mainline Code=================================*/

/* First show name and flags for each view in table format */
IF p_View = "ALL" THEN 
   FOR EACH b_View NO-LOCK:
      RUN Display_View_In_Table.
   END.
ELSE DO:
   FIND b_View NO-LOCK WHERE b_View._View-name = p_View.
   RUN Display_View_In_Table.
END.   

DISPLAY STREAM rpt "" @ line with frame shoviewdef.
DOWN STREAM rpt WITH FRAME shoviewdef.

/* Now show details about the view definitions in sections with side labels */
IF p_View = "ALL" THEN 
   FOR EACH b_View NO-LOCK:
      RUN Display_View_Other.
   END.
ELSE 
   RUN Display_View_Other.





/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/*----------------------------------------------------------------------------

File: qviwrpt.p

Description:
   Quick and dirty view report for both the GUI and character dictionary.

Input Parameters:
   p_DbId    - Id of the _Db record corresponding to the current database
   p_PName   - Physical name of the database
   p_DbType  - Database type (e.g., PROGRESS)
   p_View    - The name of the View to report on or "ALL".

Author: Tony Lavinio, Laura Stern

Date Created: 10/07/92

Modified on 06/14/94 by Gerry Seidl. Added NO-LOCKs to file accesses.
            07/14/98 by D. McMann Added DBVERSION check and _Owner to _file find
            03/29/99 by Mario B      BUG# 99-03-26-19 Changed DBNAME to 
                                     "DICTDB" in _Owner check.
            
----------------------------------------------------------------------------*/

{adecomm/commeng.i}  /* Help contexts */

DEFINE INPUT PARAMETER p_DbId 	 AS RECID NO-UNDO.
DEFINE INPUT PARAMETER p_PName 	 AS CHAR  NO-UNDO.
DEFINE INPUT PARAMETER p_DbType  AS CHAR  NO-UNDO.
DEFINE INPUT PARAMETER p_View 	 AS CHAR  NO-UNDO.

DEFINE VAR header_str AS CHAR 	 NO-UNDO.
DEFINE VAR msg#       AS INTEGER NO-UNDO.

DEFINE VARIABLE msgs AS CHARACTER EXTENT 2 NO-UNDO INITIAL [
  /* 1*/ "There are no views in this database to look at.",
  /* 2*/ "You do not have permission to use this option."
].

DO FOR _File,_View:
  FIND _Db WHERE RECID(_Db) = p_DbId NO-LOCK.
  IF INTEGER(DBVERSION("DICTDB")) > 8 THEN
    FIND _File WHERE _File._File-name = "_VIEW"
                 AND _File._Owner = "PUB" NO-LOCK.
  ELSE                 
    FIND _File "_View" NO-LOCK.
    
  FIND FIRST _View NO-LOCK NO-ERROR.
  msg# = (IF NOT AVAILABLE _View THEN 1 ELSE
          IF NOT CAN-DO(_File._Can-read,USERID("DICTDB")) THEN 2 ELSE 0).
  IF msg# > 0 THEN DO:
    MESSAGE msgs[msg#] VIEW-AS ALERT-BOX ERROR BUTTONS OK.
    RETURN.
  END.
END.

header_str = "Database: " + p_PName + " (" + p_DbType + ")".

RUN adecomm/_report.p 
   (INPUT p_DbId, 
    INPUT header_str,
    INPUT "View Report",
    INPUT "",
    INPUT "",
    INPUT "adecomm/_qviwdat.p",
    INPUT p_View,
    INPUT {&SQL_View_Report}).

/* _qviwrpt.p - end of file */




&ANALYZE-SUSPEND _VERSION-NUMBER UIB_v9r12
/* Procedure Description
"Reads the POSSE version from POSSEVersion.XML"
*/
&ANALYZE-RESUME
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _DEFINITIONS Procedure 
/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/
/*------------------------------------------------------------------------
    File        : _readpossever.p
    Purpose     : Reads the POSSE version currently being run by getting
                  the value associated with the "Version" element in
                  either gui/posseversion.xml or src/posseversion.xml

    Syntax      : RUN _readpossever.p (OUTPUT POSSEVersion).

    Description :

    Author(s)   : Gerry Seidl 
    Created     : May 24,2001
    Notes       :
  ----------------------------------------------------------------------*/
/*          This .W file was created with the Progress AppBuilder.      */
/*----------------------------------------------------------------------*/

/* ***************************  Definitions  ************************** */
DEFINE OUTPUT PARAMETER PosseVersion AS CHARACTER  NO-UNDO INITIAL "N/A":U. /* Version value read from Version's text Node */
DEFINE VARIABLE         xmlfile      AS CHARACTER  NO-UNDO. /* Name of xml file */
DEFINE VARIABLE         hVersionFile AS HANDLE     NO-UNDO. /* handle to xml doc */
DEFINE VARIABLE         hNodePosse   AS HANDLE     NO-UNDO. /* POSSE node */
DEFINE VARIABLE         hNodeVer     AS HANDLE     NO-UNDO. /* Node of Version Element */
DEFINE VARIABLE         hNodeValue   AS HANDLE     NO-UNDO. /* Node containing the value of Version Element */
DEFINE VARIABLE         ctr          AS INTEGER    NO-UNDO. /* Misc. counter */

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME


&ANALYZE-SUSPEND _UIB-PREPROCESSOR-BLOCK 

/* ********************  Preprocessor Definitions  ******************** */

&Scoped-define PROCEDURE-TYPE Procedure
&Scoped-define DB-AWARE no



/* _UIB-PREPROCESSOR-BLOCK-END */
&ANALYZE-RESUME



/* *********************** Procedure Settings ************************ */

&ANALYZE-SUSPEND _PROCEDURE-SETTINGS
/* Settings for THIS-PROCEDURE
   Type: Procedure
   Allow: 
   Frames: 0
   Add Fields to: Neither
   Other Settings: CODE-ONLY COMPILE
 */
&ANALYZE-RESUME _END-PROCEDURE-SETTINGS

/* *************************  Create Window  ************************** */

&ANALYZE-SUSPEND _CREATE-WINDOW
/* DESIGN Window definition (used by the UIB) 
  CREATE WINDOW Procedure ASSIGN
         HEIGHT             = 15
         WIDTH              = 60.
/* END WINDOW DEFINITION */
                                                                        */
&ANALYZE-RESUME

 


&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _MAIN-BLOCK Procedure 


/* ***************************  Main Block  *************************** */
/* Locate posseversion.xml 
   NOTE: This xml file should be found in the Propath. The version of the
   file that is found should verify the version of POSSE you are pointed to 
 */
ASSIGN xmlfile = SEARCH("posseinfo.xml":U). /* is it in "gui" ? */
IF xmlfile = ? OR xmlfile = "" THEN DO:
  ASSIGN xmlfile = SEARCH("wrappers/posseinfo.xml":U). /* is it in src/wrappers? */
  IF xmlfile = ? OR xmlfile = "" THEN RETURN. /* We did not find it */
END.

DO:
  /*Create the xml document and load the file */
  CREATE X-DOCUMENT hVersionFile NO-ERROR. 
  hVersionFile:LOAD("FILE":U,xmlfile,FALSE) NO-ERROR. 
  IF ERROR-STATUS:ERROR THEN DO:
    DELETE OBJECT hVersionFile NO-ERROR.
    RETURN.
  END.

  /* Read POSSE node */
  CREATE X-NODEREF hNodePosse NO-ERROR.
  DO ctr = 1 TO hVersionFile:NUM-CHILDREN:
    hVersionFile:GET-CHILD(hNodePosse,ctr) NO-ERROR.
    IF hNodePosse:NAME = "POSSE":U THEN LEAVE.
  END.

  /* Find the "Version" Element */
  CREATE X-NODEREF hNodeVer NO-ERROR.
  DO ctr = 1 TO hNodePosse:NUM-CHILDREN:
    hNodePosse:GET-CHILD(hNodeVer,ctr) NO-ERROR.
    IF hNodeVer:NAME = "Version":U THEN DO:
        RUN GetPOSSEVersion.
        LEAVE.
    END.
  END.

  /* Release memory */
  DELETE OBJECT hNodeVer NO-ERROR.
  DELETE OBJECT hNodePosse NO-ERROR.
  DELETE OBJECT hVersionFile NO-ERROR.
END.
RETURN.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME


/* **********************  Internal Procedures  *********************** */

&IF DEFINED(EXCLUDE-GetPosseVersion) = 0 &THEN

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE GetPosseVersion Procedure 
PROCEDURE GetPosseVersion :
/*------------------------------------------------------------------------------
  Purpose:     Read the POSSE version value of the Version Element
  Parameters:  <none>
  Notes:       
------------------------------------------------------------------------------*/
  DEFINE VARIABLE tmpstr AS CHARACTER NO-UNDO. /* temporary string */
  
  CREATE X-NODEREF hNodeValue NO-ERROR.
  hNodeVer:GET-CHILD(hNodeValue,1) NO-ERROR. /* Assume 1 child for "Version" */
  ASSIGN tmpstr = hNodeValue:NODE-VALUE NO-ERROR.
  IF tmpstr <> ? AND tmpstr <> "" THEN posseversion = TRIM(tmpstr).
  DELETE OBJECT hNodeValue NO-ERROR.

END PROCEDURE.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME

&ENDIF

/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/**************************************************************************
    Procedure:  adecomm/_reg2ini.p
    
    Purpose:   Given a Registry Base Key, it cycles through the sections and 
	creates an ini file. You can specify required sections must be 
	present before the ini file is created.
	THIS IS ONLY FOR MS WINDOWS!!!!
                
    Syntax :
    RUN adetran/pm/_reg2ini.p 
		(INPUT p-basekey, /* Registry Base Key */
		INPUT p-subKey,	 	/* Registry SubKey */
                INPUT p-reqSection,		/* Sections required 
						before generating ini */
                INPUT p-inifile,		/* File into which the Registry
						information should be saved */
                OUTPUT p-error).		/* did it fail? */

    Parameters:
    
	p-baseKey 	- Registry Base Key
			   HKEY_CURRENT_USER, HKEY_CURRENT_USER etc.
	p-subKey 	- Registry Sub Key
			Software/PSC/Progress/8.2a2b
	p-reqSection	- sections that must exist w/in base key for 
			ini creation to be executed. Delimeter must be CHR(4)
			"Fonts" + CHR(4) "Colors"
			Sections must be separated by CHR(4)
	p-iniFile	- ini output file
			"d:/work/test.ini"
	p-error		- were we able to generate the ini successfully?
			true or false

    Description:
    
    Notes  : 
    Authors: 
    Date   : 03/12/97
    Updated: 

	
**************************************************************************/

DEFINE INPUT 	PARAMETER p-baseKey 	AS CHARACTER NO-UNDO.
DEFINE INPUT 	PARAMETER p-subKey 	AS CHARACTER NO-UNDO.
DEFINE INPUT 	PARAMETER p-reqSection 	AS CHARACTER NO-UNDO.
DEFINE INPUT 	PARAMETER p-iniFile	AS CHARACTER NO-UNDO.
DEFINE OUTPUT 	PARAMETER p-error	AS LOGICAL INITIAL no NO-UNDO.

DEFINE VARIABLE l-sections 		AS CHARACTER.
DEFINE VARIABLE l-section-Items     AS CHARACTER.
DEFINE VARIABLE l-cnt   		AS INTEGER.
DEFINE VARIABLE l-cnt2 AS INTEGER.
DEFINE VARIABLE l-line AS CHARACTER FORMAT "x(255)".
DEFINE STREAM   l-outStream.

DEFINE VARIABLE l-sectionName AS CHARACTER FORMAT "x(255)" NO-UNDO.
DEFINE VARIABLE l-itemName AS CHARACTER FORMAT "x(255)" NO-UNDO.
DEFINE VARIABLE l-itemValue AS CHARACTER FORMAT "x(255)" NO-UNDO.
DEFINE VARIABLE l-reqSatisfied AS LOGICAL INITIAL yes NO-UNDO.
DEFINE TEMP-TABLE l-reqTable
	FIELD section AS CHARACTER
	FIELD foundIt AS LOGICAL INITIAL no.

DEFINE VARIABLE ThisMessage 	AS CHARACTER 	NO-UNDO.
DEFINE VARIABLE l-dirName 	AS CHARACTER 	NO-UNDO.
DEFINE VARIABLE l-baseName 	AS CHARACTER 	NO-UNDO.
DEFINE VARIABLE ErrorStatus 	AS LOGICAL 	NO-UNDO.
DEFINE VARIABLE Success 	AS LOGICAL 	NO-UNDO.

/* ----------------------------------------------------------------------- */
IF p-baseKey <> "" AND p-baseKey <> ? THEN
DO:
  LOAD p-subKey BASE-KEY p-baseKey NO-ERROR.
  IF ERROR-STATUS:ERROR THEN DO:
     ASSIGN ThisMessage = "Could not LOAD " 
		+ p-baseKey + " " + p-subKey
		+ " Make sure that it is valid Registry Base Key/Sub-key." .
     RUN adecomm/_s-alert.p (INPUT-OUTPUT ErrorStatus, "W":U, "OK":U, ThisMessage).
     ASSIGN p-error = TRUE.
     RETURN.
  END.
END.
ELSE
DO:
  LOAD p-subKey NO-ERROR.
  IF ERROR-STATUS:ERROR THEN DO:
  ASSIGN ThisMessage = "Could not LOAD " + " " + p-subKey
	+ " Make sure that it is valid Registry Sub-key." .
  RUN adecomm/_s-alert.p (INPUT-OUTPUT ErrorStatus, "W":U, "OK":U, ThisMessage).
  ASSIGN p-error = TRUE.
  RETURN.
END.
END.

USE p-subkey NO-ERROR.
IF ERROR-STATUS:ERROR THEN DO:
  ASSIGN ThisMessage = "Could not USE " 
	 ThisMessage = IF p-baseKey <> "" AND p-baseKey <> ? 
		THEN ThisMessage + p-baseKey 
		ELSE ThisMessage
	 ThisMessage = ThisMessage + " " + p-subKey
		 + " Make sure that it is valid Registry "
	 ThisMessage = IF p-baseKey <> "" AND p-baseKey <> ?
		THEN ThisMessage + "Key/"
		ELSE ThisMessage
	 ThisMessage = ThisMessage + "SubKey."
	.
  RUN adecomm/_s-alert.p (INPUT-OUTPUT ErrorStatus, "W":U, "OK":U, ThisMessage).
  ASSIGN p-error = TRUE.
  RUN ResetEnv.
  RETURN.
END.

GET-KEY-VALUE SECTION ? KEY ? VALUE l-sections.

/* Check to make sure that the required sections are available */
IF p-reqSection <> "":U THEN
DO:
   DO l-cnt = 1 TO NUM-ENTRIES(p-reqSection,CHR(4)):
	IF ENTRY(l-cnt,p-reqSection,CHR(4)) <> "" THEN
	DO:
	   CREATE l-reqTable.
	   ASSIGN l-reqTable.section = TRIM(ENTRY(l-cnt,p-reqSection,CHR(4))).
	END.
   END.

   DO l-cnt = 1 TO NUM-ENTRIES(l-sections):
       ASSIGN l-sectionName = TRIM(ENTRY(l-cnt, l-sections)).
       FIND FIRST l-reqTable WHERE l-reqTable.section = l-sectionName NO-ERROR.
       IF AVAILABLE l-reqTable THEN ASSIGN l-reqTable.foundIt = yes.
   END.
   FIND FIRST l-reqTable WHERE NOT l-reqTable.foundIt NO-ERROR.
   IF AVAILABLE l-reqTable THEN DO:
	p-reqSection = REPLACE (p-reqSection,CHR(4),",":U).
	ThisMessage = "Base key does not contain all required sections [" 
	+ p-reqSection + "]. Environment file not generated.".
      RUN adecomm/_s-alert.p (INPUT-OUTPUT ErrorStatus, "W":U, "OK":U, ThisMessage).
      ASSIGN p-error = TRUE.
      RUN ResetEnv.
      RETURN.
   END.
END. /* requirements satisfied? */

/* Check the ini file */
RUN CheckFile(INPUT p-iniFile, OUTPUT Success).
IF NOT Success THEN DO:
   ASSIGN p-error = TRUE.
   RUN ResetEnv.
   RETURN.
END.
RUN adecomm/_osprefx.p (INPUT p-iniFile, OUTPUT l-dirName, OUTPUT l-basename).
RUN CheckDirectory(INPUT l-dirName, OUTPUT Success).
IF NOT Success THEN DO:
  ASSIGN p-error = TRUE.
  RUN ResetEnv.
  RETURN.
END.
 
OUTPUT STREAM l-outStream TO VALUE(p-inifile) NO-ECHO.

/* Header */
ASSIGN l-line =   ";" + FILL("*",70) + CHR(10)
   + "; " + p-inifile + " generated for TRANMAN II on ":U + STRING(today)
   +	   " at ":U + STRING(time, "hh:mm":U) + CHR(10)
   + "; " + " from Registry "
       l-line = IF p-baseKey <> "" AND p-baseKey <> ? 
		THEN l-line + "Base Key:" + p-baseKey
		ELSE l-line
       l-line = l-line + " SubKey:" + p-subKey + CHR(10)
   + ";" + FILL("*",70) + CHR(10) + CHR(10).
PUT STREAM l-outStream UNFORMATTED l-line.

DO l-cnt = 1 TO NUM-ENTRIES(l-sections):
    ASSIGN l-sectionName = TRIM(ENTRY(l-cnt, l-sections))
           l-line = "[" + l-sectionName + "]" + CHR(10).

    PUT STREAM l-outStream UNFORMATTED l-line.  
    GET-KEY-VALUE SECTION l-sectionName KEY ? VALUE l-section-items.
    DO l-cnt2 = 1 to NUM-ENTRIES(l-section-items):
       ASSIGN l-itemName = TRIM(ENTRY(l-cnt2, l-section-items)).
       GET-KEY-VALUE SECTION l-sectionName KEY l-itemName VALUE l-itemValue.
       ASSIGN l-line = l-itemName + "=" + l-itemValue + CHR(10).
       PUT STREAM l-outStream UNFORMATTED l-line.
    END.
    ASSIGN l-line = CHR(10).
    PUT STREAM l-outStream UNFORMATTED l-line.
END.
OUTPUT STREAM l-outStream CLOSE.
RUN resetEnv.

/* **********************  Internal Procedures  *********************** */

PROCEDURE CheckDirectory :
DEFINE input  parameter FName    as char    no-undo.
DEFINE output parameter pSuccess as logical no-undo init false.
DEFINE var errcode as integer no-undo.
DEFINE var DirName    AS CHARACTER NO-UNDO.
DEFINE var BaseName   AS CHARACTER NO-UNDO.

  RUN adecomm/_osprefx.p (input FName, output DirName, output BaseName).  

  ASSIGN FILE-INFO:FILE-NAME = DirName
        pSuccess = True.
  IF FILE-INFO:FULL-PATHNAME = ? THEN
  DO:
    ASSIGN ThisMessage = "Directory " + "'" + DirName + "'" + " does not exist." + CHR(10) + "Do you want to create it?"
	ErrorStatus = no.
    RUN adecomm/_s-alert.p (INPUT-OUTPUT ErrorStatus, "q":U, "yes-no":U, ThisMessage).
    IF ErrorStatus THEN
    DO:
        RUN adecomm/_oscpath.p (INPUT DirName, OUTPUT errcode).
        ASSIGN psuccess = IF errcode NE 0 THEN FALSE ELSE TRUE.
    END.
    ELSE pSuccess = FALSE.
  end. /* unknown path/file */   
END PROCEDURE.

PROCEDURE CheckFile:
DEFINE input  parameter FName    as char    no-undo.
DEFINE output parameter pSuccess as logical no-undo init false.
DEFINE var errcode as integer no-undo.

  ASSIGN FILE-INFO:FILE-NAME = FName
        pSuccess = True.
  IF FILE-INFO:FULL-PATHNAME <> ? THEN
  DO:
    ASSIGN ThisMessage = "File " + "'" + FName + "'" + " exists." + CHR(10) + "Do you want to overwrite it?"
	ErrorStatus = no.
    RUN adecomm/_s-alert.p (INPUT-OUTPUT ErrorStatus, "q":U, "yes-no":U, ThisMessage).
    IF ErrorStatus THEN pSuccess = TRUE.
    ELSE pSuccess = FALSE.
  end. /* unknown path/file */   
END PROCEDURE.

PROCEDURE ResetEnv:
  USE "" NO-ERROR.
  IF ERROR-STATUS:ERROR THEN DO:
     ASSIGN ThisMessage = "Could not USE '""' " .
     RUN adecomm/_s-alert.p (INPUT-OUTPUT ErrorStatus, "W":U, "OK":U, ThisMessage).
     ASSIGN p-error = TRUE.
  END.
  UNLOAD p-subKey NO-ERROR.
  IF ERROR-STATUS:ERROR THEN DO:
     ASSIGN ThisMessage = "Could not UNLOAD " + p-subKey
		+ " Make sure that it is valid Registry Base Key/Sub-key." .
     RUN adecomm/_s-alert.p (INPUT-OUTPUT ErrorStatus, "W":U, "OK":U, ThisMessage).
     ASSIGN p-error = TRUE.
  END.
END.
&ANALYZE-SUSPEND _VERSION-NUMBER AB_v9r12
&ANALYZE-RESUME
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _DEFINITIONS Procedure 
/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/
/*--------------------------------------------------------------------------
    File        : _relfile.p 
    Purpose     : Check existence of a file 
                  Return relative path if file is in propath.
    Syntax      : 

    Description :
                  
Input Parameters:
   pcFileName     Name of file to test.
   plCheckRemote  logical -  Yes - Check remotely if preferences says so
                             No  - Always check locally 
   pcOptions    Comma separated list of options: 
                - FILE-TYPE Return file-info:file-type after filename with colon                       
                            as separator.
                - One of these "file don't exists" options  
                  YES-NO   - Use yes-no dialog box.                        
                  VERBOSE  - Display error message.                        
                   
                   
                  VERBOSE:<file description>
                          The data after the : will be used instead of "file"
                          in the message.                       
                  YES-NO:<file description>
                          The data after the : will be used instead of "file"
                          in the message.                       
                   
                  MESSAGE:<message>.
                          Complete override of default message.
                          &1 - Will be substituted by URL when remote. 
                          &2 - Will be substituted by filename.       
Output Parameters:
      pcRelname  (OUTPUT CHAR) 
                  The relative pathname. If the file is not
                  found in PROPATH, then this returns pcFileName.
                  
                  If the file does not exist pcRelname will be ?.  
                  
                  _relname.p has the logic that ensures that the filename is 
                  returned with Progress portable slashes.  

    Author(s)   : Haavard Danielsen 
    Created     : 4/1/98
    Notes       : This is a wrapper around adecomm/_relname.p 
                  running it either remotely or locally.                                    
                  
                  Only supports must-exist 
                  
                  If must-be-rel is implemented make sure 
                  must-exist is default.                                      
------------------------------------------------------------------------*/
/*          This .W file was created with the Progress UIB.             */
/*----------------------------------------------------------------------*/

/* ***************************  Definitions  ************************** */

DEFINE INPUT  PARAMETER pcFileName    AS CHARACTER NO-UNDO.
DEFINE INPUT  PARAMETER plCheckRemote AS LOGICAL   NO-UNDO.
DEFINE INPUT  PARAMETER pcOptions     AS CHARACTER NO-UNDO.
DEFINE OUTPUT PARAMETER pcRelName     AS CHARACTER NO-UNDO.

DEFINE VARIABLE cInfo           AS CHARACTER NO-UNDO.
DEFINE VARIABLE lRemote         AS LOGICAL   NO-UNDO.
DEFINE VARIABLE lFileinfo       AS LOGICAL   NO-UNDO.
DEFINE VARIABLE cBrokerURL      AS CHARACTER NO-UNDO.
DEFINE VARIABLE cNotUsed        AS CHARACTER NO-UNDO.
DEFINE VARIABLE cMsg            AS CHARACTER NO-UNDO.
DEFINE VARIABLE cNoFileOption   AS CHARACTER NO-UNDO.
DEFINE VARIABLE cFile           AS CHARACTER NO-UNDO.
DEFINE VARIABLE lQuestion       AS LOG       NO-UNDO.
DEFINE VARIABLE lOk             AS LOG       NO-UNDO.
DEFINE VARIABLE i               AS INTEGER   NO-UNDO.
DEFINE VARIABLE cOptionEntry    AS CHARACTER NO-UNDO.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME


&ANALYZE-SUSPEND _UIB-PREPROCESSOR-BLOCK 

/* ********************  Preprocessor Definitions  ******************** */

&Scoped-define PROCEDURE-TYPE Procedure
&Scoped-define DB-AWARE no



/* _UIB-PREPROCESSOR-BLOCK-END */
&ANALYZE-RESUME



/* *********************** Procedure Settings ************************ */

&ANALYZE-SUSPEND _PROCEDURE-SETTINGS
/* Settings for THIS-PROCEDURE
   Type: Procedure
   Allow: 
   Frames: 0
   Add Fields to: Neither
   Other Settings: CODE-ONLY COMPILE
 */
&ANALYZE-RESUME _END-PROCEDURE-SETTINGS

/* *************************  Create Window  ************************** */

&ANALYZE-SUSPEND _CREATE-WINDOW
/* DESIGN Window definition (used by the UIB) 
  CREATE WINDOW Procedure ASSIGN
         HEIGHT             = 15
         WIDTH              = 60.
/* END WINDOW DEFINITION */
                                                                        */
&ANALYZE-RESUME

 


&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _MAIN-BLOCK Procedure 


/* ***************************  Main Block  *************************** */

IF plCheckRemote THEN
DO:
  RUN adeuib/_uibinfo.p
     (?, 
      "SESSION":U,
      "REMOTE":U, 
      OUTPUT cInfo).
        
  ASSIGN lRemote = CAN-DO("TRUE,YES":U,cInfo).
END.

ASSIGN lFileInfo = CAN-DO(pcOptions,"FILE-INFO":U).        

IF lRemote THEN
DO:   
  RUN adeuib/_uibinfo.p
    (?, 
     "SESSION":U,
     "BrokerURL":U, 
     OUTPUT cBrokerURL).
  
  RUN adeweb/_webcom.w (?,
                        cBrokerURL,
                        pcFileName,
                        "SEARCH":U
                        + (IF lFileInfo THEN ":FILE-INFO":U ELSE "":U),                      
                        OUTPUT pcRelName, 
                        INPUT-OUTPUT cNotUsed).
  OS-DELETE VALUE(cNotUsed). 
  IF RETURN-VALUE BEGINS "ERROR":U THEN RETURN "ERROR":U.   
END.
ELSE
  RUN adecomm/_relname.p (pcFileName, "must-exist":U, OUTPUT pcRelName).


IF pcRelName = ? THEN
DO:
  /* look for the options for file don't exist */ 
  DO i = 1 To NUM-ENTRIES(pcOptions):   
    cOptionEntry = ENTRY(i,pcOptions).
    
    IF cOptionEntry BEGINS "MESSAGE":U
    OR cOptionEntry BEGINS "YES-NO":U
    OR cOptionEntry BEGINS "VERBOSE":U THEN
    DO:
      ASSIGN     
         cNofileOption = cOptionEntry.
      LEAVE.
    END. 
  END. /* do i = 1 to num-entries */
    
  IF cNoFileOption <> "":U THEN     
  DO:
    ASSIGN    /* if "message:<text>" then use <text> */ 
      lQuestion = cNoFileOption BEGINS "YES-NO":U
      cMsg =  IF cOptionEntry BEGINS "MESSAGE":U 
              AND NUM-ENTRIES(cOptionEntry,":":U) > 1 
              THEN ENTRY(2,cOptionEntry,":":U)            
              ELSE "&2 is missing&1."
                   + CHR(10)                   
                   + (IF lQuestion THEN "Do you wish to continue?":U 
                      ELSE "Please enter correct path and filename.":U)   
            
      cFile = /* If there is a : after verbose or yes-no use that instead
                 of 'file' in the message  */
              (IF (cOptionEntry BEGINS "VERBOSE":U OR lQuestion) 
               AND NUM-ENTRIES(cOptionEntry,":":U) > 1 
               THEN ENTRY(2,cOptionEntry,":":U) + " ":U
               ELSE "File ":U)   
               + pcFilename
             
             /* substitute the URL and the filename into the message */  
      cMsg  = SUBSTITUTE(cMsg,
                         IF lRemote 
                         THEN " on URL: " + cBrokerURL
                         ELSE "",
                         cFile).           
   
    IF lQuestion THEN 
    DO:
      MESSAGE 
        cMsg       SKIP      
        VIEW-AS 
        ALERT-BOX 
        WARNING 
        BUTTONS YES-NO
        UPDATE lok.
      IF lOk THEN 
        ASSIGN pcRelName = pcFileName.
       
    END. /* if lquestion */
    ELSE  
      MESSAGE 
        cMsg       SKIP      
          VIEW-AS 
          ALERT-BOX 
          ERROR.             
  END. /* if cNoFileOption  <> '' */
END. /* if pcRelname = ? */
ELSE /* add file-type if file-info is in the optionlist */ 
IF lFileinfo and NOT lRemote THEN
  ASSIGN 
    FILE-INFO:FILE-NAME = pcRelname
    pcRelname = pcRelname + ":"  + FILE-INFO:FILE-TYPE.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME


/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/
/* --------------------------------------------------------------------
   _relname.p -- Returns the PROPATH relative filename for a file.
                 
       p_file          SEARCH for
       ------          ----------
       test.w          test.w, test.r
       .\test          .\test, .\test.r
       c:bin.dir/test  c:bin.dir/test, c:bin.dir/test.r
       test.r          test.r
   
   Input Parameters:
      p_File      (CHAR) Name of file to test.
      p_options   (CHAR) Comma-delimited list of options
                       MUST-EXIST -- file must exist  
                       MUST-BE-REL -- return ? if it is not in the propath even
                                      if it exists.
                   
   Output Parameters:
      p_Relname   (OUTPUT CHAR) The relative pathname. If the file is not
                  found in PROPATH, then this returns p_File.
                  If the file does not exist (and if MUST-EXIST is set)
                  p_relname will be ?.  
                  
                  The output name is always returned with Progress portable
                  slashes.
   
   Author:  Wm.T.Wood
   Created: January, 1997    


Modified on 11/28/00 achlensk - added logic that removes the longest PROPATH from filename, 
                                not the first match.

 --------------------------- Test Code --------------------------------

   def var c as char format "x(30)" INITIAL "adeuib/_uibmain.r".
   DO WHILE c ne "":
     UPDATE c.
     RUN webutil/_relname.p (c, "MUST-EXIST", OUTPUT c).
     MESSAGE c.
   END.

 ---------------------------------------------------------------------- */
DEF INPUT  PARAMETER p_file    AS CHAR NO-UNDO.
DEF INPUT  PARAMETER p_options AS CHAR NO-UNDO.
DEF OUTPUT PARAMETER p_relname AS CHAR NO-UNDO INITIAL ?.    

DEF VAR i               AS INTEGER NO-UNDO.   
DEF VAR cnt             AS INTEGER NO-UNDO.   
DEF VAR dir             AS CHAR    NO-UNDO.   
DEF VAR filename        AS CHAR    NO-UNDO.   
DEF VAR l_must-exist    AS LOGICAL NO-UNDO.   
DEF VAR l_must-be-rel   AS LOGICAL NO-UNDO.   
DEF VAR cLongestProPath AS CHAR    NO-UNDO.


/* If the file does not exist, just return. */
ASSIGN filename             = p_file
       FILE-INFO:FILE-NAME  = filename
       l_must-exist         = (LOOKUP ("MUST-EXIST":U,  p_options) > 0)    
       l_must-be-rel        = (LOOKUP ("MUST-BE-REL":U,  p_options) > 0)    
       .
/* Check for file not found. */
IF FILE-INFO:FULL-PATHNAME ne ?
THEN filename = FILE-INFO:FULL-PATHNAME.
ELSE DO:
  IF l_must-exist THEN RETURN.
END.

/* Make sure the file name uses portable BACK-SLASHES. */
filename = REPLACE (filename, "~\":U, "~/":U). 
    
/* At this point, filename will equal the FULL-PATHNAME of the file (if it
   exists, or the original name, if it does not.  
   Go through the directories in PROPATH looking for one that matches.  */

cnt = NUM-ENTRIES(PROPATH).
DO i = 1 TO cnt:
  dir = ENTRY (i, PROPATH).
  /* Get the full pathname of the directory without any fancy characters. */
  IF dir = "" THEN dir = ".". 
  ASSIGN FILE-INFO:FILE-NAME = dir
         dir = REPLACE (FILE-INFO:FULL-PATHNAME, "~\":U, "~/":U) + "~/":U
         .

  /* Strip the PROPATH dir out of the filename. */
  IF filename BEGINS dir THEN
  ASSIGN cLongestProPath 
  = 
  IF NUM-ENTRIES(dir, '/') > NUM-ENTRIES(cLongestProPath, '/') 
  THEN dir 
  ELSE cLongestProPath.
END.

IF cLongestProPath <> "" THEN
  DO:
  p_relname = SUBSTRING (filename, LENGTH(cLongestProPath, "CHARACTER":U) + 1, -1, "CHARACTER":U).
  RETURN.
  END.

/* If we get here, then the file was not found relative to PROPATH. 
   Return the original name unless it must be in the relative path. */
p_relname = IF l_must-be-rel THEN ? ELSE filename.

/*
 * --- End of File 
 */
 
/*********************************************************************
* Copyright (C) 2000,2009 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/*----------------------------------------------------------------------------

File: report.p

Description:
   Quick and dirty report to the screen with option to print.  This handles
   table, field, index, view and user reports.
 
Input Parameters:
   p_DbId    - Id of the _Db record for this database.
   p_Header  - Text string for the second line of the header.  For 
	       dictionary reports, it should look like
	       "Database: database name (type)           Table: xxxx"
	       with the Table part being optional.
   p_Title   - Title for the dialog box showing the report on the screen.
   p_Flags   - Text string for key to "flags" column, if there is one.
   p_Btns    - Character string indicating which optional buttons
	       should be visible.  These include "s" for switch files,
	       "o" for order fields by _Order or "a" to order fields
	       alphabetically.  
	       So this could be "", "s", "so", "sa", "o", OR "a".
   p_Func    - Function to call to display the report data.
   p_Tbl     - Optional table name for index and field reports. (i.e., may
	       be "".
   p_Help    - The help context for this report.

Outputs:
   Indicates actions that occurred within report:
   "s" if Switch file was chosen
   "o" if Order was active and the last order shown was by order#
   "a" if Order was active and the last order shown was alphabetical
   So this could be "", "s", "so", "sa", "o", OR "a".

Author: Laura Stern

Date Created: 10/02/92

HISTORY
    mcmann      09/19/02    Added support for data width report
	nordhougen  08/22/95    Initialized p_flags:width to its content's 
				length prior to the format calculation 
	hutegger    95/01/19    changed p_flags:format calculation to not
				ignore frame-width anymore
	gfs         07/22/94    Removed MUST-EXIST option from Files dialog.
	gfs         11/10/94    Fixed dimensions so that the dialog fits on
				Jpn WIN

----------------------------------------------------------------------------*/
&GLOBAL-DEFINE WIN95-BTN YES
{adecomm/commeng.i}  /* Help contexts */
{adecomm/adestds.i}  /* Standard layout defines, colors etc. */
{adecomm/adeintl.i}  /* International support */

DEFINE INPUT PARAMETER p_DbId    AS RECID NO-UNDO.
DEFINE INPUT PARAMETER p_Header  AS CHAR  NO-UNDO.
DEFINE INPUT PARAMETER p_Title   AS CHAR  NO-UNDO.
DEFINE INPUT PARAMETER p_Flags   AS CHAR  NO-UNDO.
DEFINE INPUT PARAMETER p_Btns    AS CHAR  NO-UNDO.
DEFINE INPUT PARAMETER p_Func    AS CHAR  NO-UNDO.
DEFINE INPUT PARAMETER p_Tbl     AS CHAR  NO-UNDO.
DEFINE INPUT PARAMETER p_Help    AS INT   NO-UNDO.

DEFINE NEW SHARED STREAM rpt.
DEFINE NEW SHARED STREAM instream.

DEFINE VARIABLE tmpfile     AS CHARACTER NO-UNDO.
DEFINE VARIABLE stat        AS LOGICAL   NO-UNDO.
DEFINE VARIABLE ret_val     AS CHARACTER NO-UNDO INIT "".
DEFINE VARIABLE show_order  AS LOGICAL   NO-UNDO. 
DEFINE VARIABLE show_switch AS LOGICAL   NO-UNDO. 
DEFINE VARIABLE a_or_o      AS CHAR      NO-UNDO INIT "". /* alpha or order# */
DEFINE VARIABLE wid         AS INTEGER   NO-UNDO.
DEFINE VARIABLE btn_col     AS INTEGER   NO-UNDO.
DEFINE VARIABLE btn_ht      AS INTEGER   NO-UNDO.
DEFINE VARIABLE hwidg       AS WIDGET-HANDLE NO-UNDO.
DEFINE VARIABLE inline      AS CHAR      NO-UNDO.

/* Frame variables */
DEFINE VARIABLE edit_widg  AS CHARACTER   NO-UNDO.

DEFINE BUTTON btn_OK    LABEL "OK"     {&STDPH_OKBTN} AUTO-GO.
DEFINE BUTTON btn_Print LABEL "&Print" {&STDPH_OKBTN}.

DEFINE BUTTON btn_Switch LABEL "&Switch Tables..." 
   &IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN SIZE 22 BY 1.125 &ENDIF .
DEFINE BUTTON btn_Order  LABEL "&Change Field Order" 
   &IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN SIZE 22 BY 1.125 &ENDIF .

&IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN
   Define button    btn_Help  label "&Help" {&STDPH_OKBTN}.
   Define rectangle rect_Btns {&STDPH_OKBOX}. /* standard button rectangle */
   &global-define   HLP_BTN  &HELP = "btn_Help"
&ELSE
   &global-define   HLP_BTN  
&ENDIF

/* Variable used only in print options frame */
DEFINE VARIABLE dev  AS CHARACTER   NO-UNDO 
   VIEW-AS RADIO-SET
   RADIO-BUTTONS "Printer", "PRINTER", "File", "F"
   INIT "PRINTER".
DEFINE VARIABLE fil  AS CHARACTER   NO-UNDO.
DEFINE VARIABLE app  AS LOGICAL     NO-UNDO.
DEFINE VARIABLE siz  AS INTEGER     NO-UNDO.

DEFINE BUTTON btn_Cancel LABEL "Cancel" {&STDPH_OKBTN} AUTO-ENDKEY.
DEFINE BUTTON btn_Files  LABEL "&Files..."
   &IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN SIZE 12 by 1 &ENDIF .


/*=================================Forms================================*/

/* Form for editor widget containing the report and option buttons */
FORM
   edit_widg   VIEW-AS EDITOR SCROLLBAR-V
	       /* Make width one less than we want - we add 1 later */
	       &IF "{&WINDOW-SYSTEM}" = "TTY" &THEN
		  SIZE 77 BY 13 
	       &ELSEIF "{&WINDOW-SYSTEM}" BEGINS "MS-WIN" &THEN
		  INNER-CHARS 70 INNER-LINES 17 SCROLLBAR-H LARGE
	       &ELSE
		  INNER-CHARS 75 INNER-LINES 27 SCROLLBAR-H
	       &ENDIF
	       FONT 0  /* fixed font */
   SKIP
   p_Flags     VIEW-AS TEXT
   SKIP({&VM_WIDG})
   btn_Switch SPACE({&HM_BTN}) btn_Order

   {adecomm/okform.i
      &BOX    = rect_btns
      &STATUS = no
      &OK     = btn_OK
      &OTHER = "SPACE({&HM_DBTNG}) btn_Print"
      {&HLP_BTN}
   }

   WITH FRAME report 
      DEFAULT-BUTTON btn_OK CANCEL-BUTTON btn_OK
      NO-LABELS VIEW-AS DIALOG-BOX SCROLLABLE.

FORM 
   SKIP({&TFM_WID})
   
   dev LABEL "&Send Output to"           COLON 17  
   SKIP ({&VM_WID})

   fil NO-LABEL FORMAT "x({&PATH_WIDG})"           AT    19
       VIEW-AS FILL-IN NATIVE SIZE 30 BY 1  {&STDPH_FILL} SPACE(.3)
   btn_Files
   SKIP({&VM_WID})

   app LABEL "&Append to Existing File?" AT    19
       VIEW-AS TOGGLE-BOX 
   SKIP({&VM_WIDG})
   
   siz LABEL "&Page Length" FORMAT ">>9" COLON 17   {&STDPH_FILL}
   "(# Lines, 0 for Continuous)"                          

   {adecomm/okform.i
      &BOX    = rect_btns
      &STATUS = no
      &OK     = btn_OK
      &CANCEL = btn_Cancel
      {&HLP_BTN}
   }

   WITH frame prt_options 
      SIDE-LABELS 
      DEFAULT-BUTTON btn_Ok CANCEL-BUTTON btn_Cancel
      VIEW-AS DIALOG-BOX TITLE "Print Options".


/*==========================Internal Procedures==============================*/

/*-----------------------------------------------------------
   Run the procedure which displays the actual
   schema data to the current output device.
-----------------------------------------------------------*/
PROCEDURE Display_Schema_Info:

   run adecomm/_setcurs.p ("WAIT").
   
   IF (INDEX(p_Btns, "f") > 0 OR INDEX(p_Btns, "w") > 0) THEN 
     ASSIGN a_or_o = p_Btns.
           

   IF p_Tbl = "" THEN
      RUN VALUE(p_Func) (INPUT p_DbId).
   ELSE IF NOT show_order AND (a_or_o <> "F" AND a_or_o <> "W") THEN
      RUN VALUE(p_Func) (INPUT p_DbId, INPUT p_Tbl).
   ELSE
      RUN VALUE(p_Func) (INPUT p_DbId, INPUT p_Tbl, INPUT a_or_o).

   run adecomm/_setcurs.p ("").
END.


/*============================Trigger code===================================*/

/*----- ON CHOOSE of PRINT BUTTON -----*/
ON CHOOSE of btn_Print IN FRAME report
DO:
   /*===================Trigger section for Print===============*/

   /*----- HELP -----*/
   ON HELP of FRAME prt_options
      &IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN
	 OR choose of btn_Help in frame prt_options
      &ENDIF
      RUN adecomm/_adehelp.p ("comm":u,"CONTEXT":u,{&Print_Options},?).

   /*-----WINDOW-CLOSE-----*/
   ON WINDOW-CLOSE OF FRAME prt_options
      apply "END-ERROR" to frame prt_options.

   /*----- OK or GO -----*/
   ON GO OF FRAME prt_OPTIONS DO:
      DEFINE VARIABLE h_datetime AS CHARACTER   NO-UNDO.
      
      ASSIGN dev fil app siz.

      fil = TRIM(fil).
      IF dev <> "PRINTER" THEN DO:
	 IF NOT app THEN DO:
	   FILE-INFO:FILE-NAME = fil.
	   IF FILE-INFO:FULL-PATHNAME NE ? THEN DO:
	     DEF VAR choice AS LOGICAL INITIAL NO.
	     MESSAGE fil "already exists. Overwrite?" VIEW-AS ALERT-BOX QUESTION 
	       BUTTONS YES-NO UPDATE choice.
	     IF NOT choice THEN DO:
	       APPLY "ENTRY" TO fil.
	       RETURN NO-APPLY.
	     END.
	   END.
	 END.
	 /* open the file to make sure we have permission */
	 IF fil BEGINS "|" THEN
	    OUTPUT THROUGH VALUE(SUBSTRING(fil,2,-1,"character":u))
				 PAGE-SIZE VALUE(siz).
	 ELSE IF app THEN
	    OUTPUT TO VALUE(fil) PAGE-SIZE VALUE(siz) APPEND.
	 ELSE
	    OUTPUT TO VALUE(fil) PAGE-SIZE VALUE(siz).
	 OUTPUT CLOSE.
	 dev = fil.
      END.
      /* Originally, we had this include file here. However, it ran
       * the report a second time. And, since this include file is
       * used elsewhere, I've taken the code, modified it and put it
       * right in here. (gfs)
      {adecomm/prtrpt.i
	    &Header = p_Header
	    &Flags  = p_Flags
	    &dev    = dev
	    &app    = app
	    &siz    = siz
	    &Func   = Display_Schema_info} 
      */
      /* Header with Page specification */
      FORM HEADER
	h_datetime FORMAT "x(17)" SPACE(7) "PROGRESS Report"
	"Page" AT 70 PAGE-NUMBER (rpt) FORMAT "ZZ9" SKIP
	p_Header FORMAT "x(80)" SKIP(1)
	p_Flags  FORMAT "x(80)" SKIP
	WITH FRAME page_head_paged
	PAGE-TOP NO-LABELS NO-BOX NO-ATTR-SPACE NO-UNDERLINE USE-TEXT STREAM-IO.

      /* Header for continuous output (no page #) */
      FORM HEADER
	h_datetime FORMAT "x(17)" SPACE(7) "PROGRESS Report" SKIP
	p_Header FORMAT "x(80)" SKIP(1)
	p_Flags  FORMAT "x(80)" SKIP
	WITH FRAME page_head_cont
	PAGE-TOP NO-LABELS NO-BOX NO-ATTR-SPACE NO-UNDERLINE USE-TEXT STREAM-IO.

      run adecomm/_setcurs.p ("WAIT").
      DO ON STOP UNDO, LEAVE:
	IF dev BEGINS "|"
	THEN OUTPUT STREAM rpt
	  THROUGH VALUE(SUBSTRING(dev,2,-1,"character":u)) 
	  PAGE-SIZE VALUE(siz).
	ELSE IF dev = "PRINTER"
	  THEN OUTPUT STREAM rpt TO PRINTER.
	ELSE IF app
	  THEN OUTPUT STREAM rpt TO VALUE(dev) PAGE-SIZE VALUE(siz) APPEND.
	ELSE OUTPUT STREAM rpt TO VALUE(dev) PAGE-SIZE VALUE(siz).
  
	h_datetime = STRING(TODAY) + " " + STRING(TIME,"HH:MM:SS").
  
	if siz = 0 then
	  VIEW STREAM rpt FRAME page_head_cont.
	else     
	  VIEW STREAM rpt FRAME page_head_paged.
  
	/* If 'tmpfile' is loaded, then we already ran the damn
	 * thing! So, let's get the output from there instead of
	 * running it all over again.
	 */
	IF tmpfile NE "" AND tmpfile NE ? THEN
	DO:    
	  INPUT STREAM instream FROM VALUE(tmpfile) NO-ECHO.
	  REPEAT:
	    IMPORT STREAM instream UNFORMATTED inline.
	    IF inline NE "" THEN
	       PUT STREAM rpt UNFORMATTED inline skip.
	    ELSE /* preserve blank lines */
	       PUT STREAM rpt inline skip.
	  END.
	  INPUT STREAM instream CLOSE.
	END.
	ELSE RUN Display_Schema_info.
  
	OUTPUT STREAM rpt CLOSE.
      END.
      run adecomm/_setcurs.p ("").
   
   END.

   /*----- VALUE-CHANGED of DEVICE RADIO SET -----*/
   ON VALUE-CHANGED OF dev IN FRAME prt_options
   DO:
      /* Default to continuous output for terminal, 60 for printer. */
      dev = SELF:SCREEN-VALUE.
      IF dev = "F" /* file */ THEN DO:
	 ASSIGN
	    siz:SCREEN-VALUE IN FRAME prt_options = "0"
	    &IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN
	       fil:SENSITIVE IN FRAME prt_options = yes
	       btn_Files:SENSITIVE IN FRAME prt_options = yes
	       app:SENSITIVE IN FRAME prt_options = yes
	    &ELSE
	       fil:VISIBLE IN FRAME prt_options = yes
	       btn_Files:VISIBLE IN FRAME prt_options = yes
	       app:VISIBLE IN FRAME prt_options = yes
	    &ENDIF
	    .
	 APPLY "ENTRY" TO fil IN FRAME prt_options.
      END.
      ELSE 
	 ASSIGN
	    siz:SCREEN-VALUE IN FRAME prt_options = "60"
	    &IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN
	       fil:SENSITIVE IN FRAME prt_options = no
	       fil:SCREEN-VALUE IN FRAME prt_options = ""
	       btn_Files:SENSITIVE IN FRAME prt_options = no
	       app:SENSITIVE IN FRAME prt_options = no
	       app:SCREEN-VALUE IN FRAME prt_options = "no"
	    &ELSE
	       fil:VISIBLE IN FRAME prt_options = no
	       btn_Files:VISIBLE IN FRAME prt_options = no
	       app:VISIBLE IN FRAME prt_options = no
	    &ENDIF
	    .
   END.

   /*----- HIT of FILE BUTTON -----*/
   on choose of btn_Files in FRAME prt_options
   do:
      Define var name       as char    NO-UNDO.
      Define var picked_one as logical NO-UNDO.
      Define var d_title    as char    NO-UNDO init "Report File".
   
      name = TRIM(fil:screen-value in FRAME prt_options).
      &IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN
	 system-dialog GET-FILE 
		       name 
		       filters            "*" "*"
		       default-extension  ""
		       title           d_title 
		       /*must-exist*/
		       update          picked_one.
      &ELSE
	 run adecomm/_filecom.p
	     ( INPUT "" /* p_Filter */, 
	       INPUT "" /* p_Dir */ , 
	       INPUT "" /* p_Drive */ ,
	       INPUT no /* p_Save_As */ ,
	       INPUT d_title ,
	       INPUT "" /* Dialog Options */ ,
	       INPUT-OUTPUT name,
	       OUTPUT picked_one ). 
      &ENDIF
   
      if picked_one then
	 fil:screen-value in FRAME prt_options = name.
   end.

   /*=======Mainline for Print processing=========*/

   /* Printer is default so adjust file and files button accordingly */
   ASSIGN
      app:SCREEN-VALUE IN FRAME prt_options = "no"
      fil:SCREEN-VALUE IN FRAME prt_options = ""
      &IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN
	 fil:SENSITIVE IN FRAME prt_options = no
	 btn_Files:SENSITIVE IN FRAME prt_options = no
	 app:SENSITIVE IN FRAME prt_options = no
      &ELSE
	 fil:HIDDEN IN FRAME prt_options = yes
	 btn_Files:HIDDEN IN FRAME prt_options = yes
	 app:HIDDEN IN FRAME prt_options = yes
	 fil:SENSITIVE IN FRAME prt_options = yes
	 btn_Files:SENSITIVE IN FRAME prt_options = yes
	 app:SENSITIVE IN FRAME prt_options = yes
      &ENDIF
      .

   ASSIGN
      dev = "Printer"
      siz = 60.
   DISPLAY dev siz WITH FRAME prt_options.

   ENABLE
	 dev
	 siz
	 btn_Ok 
	 btn_Cancel
	 &IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN
	    btn_Help
	 &ENDIF
	 WITH frame prt_options.

   /* Reset tab-order for things that will be enabled later. */
   ASSIGN
      stat = fil:MOVE-AFTER-TAB-ITEM(dev:HANDLE IN FRAME prt_options)
      stat = btn_Files:MOVE-AFTER-TAB-ITEM(fil:HANDLE IN FRAME prt_options)
      stat = app:MOVE-AFTER-TAB-ITEM(btn_Files:HANDLE IN FRAME prt_options).

   DO ON ERROR UNDO, LEAVE  ON ENDKEY UNDO, LEAVE:
      WAIT-FOR CHOOSE of btn_OK in FRAME prt_options OR 
	 GO of frame prt_options FOCUS dev.
   END.
   HIDE FRAME prt_options.   
END.


/*-----WINDOW-CLOSE-----*/
ON WINDOW-CLOSE OF FRAME report
   apply "END-ERROR" to frame report.


/*----- HELP -----*/
ON HELP OF FRAME report 
   &IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN
      OR choose of btn_Help in frame report
   &ENDIF
   RUN "adecomm/_adehelp.p" (INPUT "comm", INPUT "CONTEXT", 
			     INPUT p_Help,
			     INPUT ?).


/*----- ON CHOOSE of SWITCH BUTTON -----*/
ON CHOOSE of btn_Switch IN FRAME report
DO:
   ret_val = "s".
   APPLY "choose" to btn_OK IN FRAME report.
END.


/*----- ON CHOOSE of ORDER BUTTON -----*/
ON CHOOSE of btn_Order IN FRAME report
DO:
   /* This is for fields - redisplay with new order 
      (flip between alphabetical and by order#) 
   */
   a_or_o = (IF a_or_o = "o" THEN "a" ELSE "o").

   run adecomm/_setcurs.p ("WAIT").

   OS-DELETE VALUE(tmpfile).
   OUTPUT STREAM rpt TO VALUE(tmpfile). 
   RUN Display_Schema_info.
   OUTPUT STREAM rpt CLOSE. 

   stat = edit_widg:READ-FILE(tmpfile) IN FRAME report.

   run adecomm/_setcurs.p ("").
END.


/*=============================Mainline code================================*/

/* Run time layout for button area.  
   Do it for print frame here.  This way, it's only done once. Also 
   because, if you do it in the trigger the define for eff_frame_width
   becomes local to the trigger and it screws up second call to okrun.i.
*/
{adecomm/okrun.i  
   &FRAME = "frame prt_options" 
   &BOX   = "rect_Btns"
   &OK    = "btn_OK" 
   &CANCEL = "btn_Cancel"   /* to center for TTY mode */
   {&HLP_BTN}
}

/* Fix up report frame second so that eff_frame_width is available for
   button calculation below.
*/
{adecomm/okrun.i  
   &FRAME  = "frame report" 
   &BOX    = "rect_Btns"
   &OK     = "btn_OK"
   &CANCEL = "btn_Print"   /* to center for TTY mode */
   {&HLP_BTN}
}

/* Adjust contents of frame so everything always fits (3/96 tsn) */
do with frame report:
  assign  
    edit_widg:width-pixel          =  frame report:width-pixel 
			          - frame report:border-left-pixel 
		 	          - frame report:border-right-pixel 
    p_Flags:format in frame report =  substitute("x(&1)", max(1,length(p_Flags,"column":U)))
    p_Flags:width-pixel            =  min(p_Flags:width-pixel
			                , frame report:width-pixel 
			                - frame report:border-left-pixel 
			                - frame report:border-right-pixel
			                - 10
			               )
    /* Center the flags string */
    p_Flags:x in frame report      = (frame report:width-p - p_Flags:width-p - 2) / 2
    .
end.

/* Set up action buttons based on input. */
ASSIGN
   show_switch = (if INDEX(p_Btns, "s") = 0 then no else yes) 
   btn_Switch:hidden in frame report = NOT show_switch
   show_order = (IF INDEX(p_Btns, "o") > 0 OR INDEX(p_Btns, "a") > 0 THEN yes 
                 ELSE no)
   btn_Order:hidden in frame report = NOT show_order.

wid = 0.
IF show_switch THEN
   wid = wid + btn_Switch:WIDTH IN FRAME report.
IF show_order THEN
   ASSIGN
      a_or_o = (IF INDEX(p_BTNS, "o") > 0 THEN "o" ELSE "a")
      wid = wid + btn_Order:WIDTH IN FRAME report.
IF show_switch AND show_order THEN
   wid = wid + {&HM_BTN}.

IF show_order OR show_switch THEN
DO:
   btn_col = (eff_frame_width - wid) / 2.
   IF show_switch THEN
      ASSIGN
	 btn_Switch:COLUMN IN FRAME report = btn_col
	 btn_col = btn_col + btn_Switch:WIDTH IN FRAME report + {&HM_BTN}.
   IF show_order THEN
      ASSIGN
	 btn_Order:COLUMN IN FRAME report = btn_col.
END.
ELSE DO:
   /* We have to move everything up to squish out the space for the
      buttons that aren't there!.
   */
   ASSIGN
      hwidg = btn_Switch:HANDLE in FRAME report
      btn_ht = btn_Switch:HEIGHT IN FRAME report /* + {&VM_WIDG}*/ .

   DO WHILE (hwidg NE ?):
      ASSIGN
	 hwidg:ROW = hwidg:ROW - btn_ht
	 hwidg     = hwidg:NEXT-SIBLING.
   END.

   ASSIGN
      FRAME report:SCROLLABLE = false
      &IF {&OKBOX} &THEN
	 rect_Btns:ROW IN FRAME report = rect_Btns:ROW IN FRAME report - btn_ht
      &ELSE
	 FRAME report:RULE-ROW = FRAME report:RULE-ROW - btn_ht
      &ENDIF
      FRAME report:HEIGHT = FRAME report:HEIGHT - btn_ht.
END.

/* Make a name for a temp table to use to store report so we can view it
   with an editor widget.  Display the data to the file.  
*/
run adecomm/_tmpfile.p (INPUT "", INPUT ".dct", OUTPUT tmpfile).

/* Do the work */
OUTPUT STREAM rpt TO VALUE(tmpfile). 
RUN Display_Schema_info.
OUTPUT STREAM rpt CLOSE. 

/* Show the report in the editor widget. */
ASSIGN
   edit_widg:PFCOLOR IN FRAME report = 0
   edit_widg:READ-ONLY IN FRAME report = yes
   edit_widg:SENSITIVE IN FRAME report = yes /* need this due to a GUI bug */  
   FRAME report:TITLE = p_Title
   stat = edit_widg:READ-FILE(tmpfile) IN FRAME report.

/* display frame only if report could be read into the editor-widget (TH) */

IF stat
 THEN DO:
  display p_Flags with frame report.
  ENABLE edit_widg 
       btn_Switch when show_switch
       btn_Order  when show_order
       btn_OK 
       btn_Print 
       &IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN
	  btn_Help
       &ENDIF
   WITH FRAME report.

  DO ON ERROR UNDO, LEAVE  ON ENDKEY UNDO, LEAVE:
    WAIT-FOR CHOOSE of btn_OK IN FRAME report OR
	    GO OF FRAME report
      FOCUS edit_widg.
  END.

END.

/* Close up shop. */
OS-DELETE VALUE(tmpfile).
HIDE FRAME report NO-PAUSE.
HIDE MESSAGE NO-PAUSE.

RETURN ret_val + a_or_o.

/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/
/* --------------------------------------------------------------------
   _rsearch.p -- Acts like the function SEARCH, except it also looks for
                 r-code for a file. For example, for:
       p_file          SEARCH for
       ------          ----------
       test.w          test.w, test.r
       .\test          .\test, .\test.r
       c:bin.dir/test  c:bin.dir/test, c:bin.dir/test.r
       test.r          test.r
   
   Parameters:
      p_File  (INPUT CHAR) Name of file to test.
      p_Seach (OUTPT CHAR) The result of the SEARCH.   
   
   Author:  Wm.T.Wood
   Created: April 1996    
 --------------------------- Test Code --------------------------------

   def var c as char format "x(30)" INITIAL "adeuib/_uibmain.p".
   DO WHILE c ne "":
     UPDATE c.
     RUN adecomm/r-search.p (c, OUTPUT c).
     MESSAGE c.
   END.

 ---------------------------------------------------------------------- */
DEF INPUT PARAMETER  p_file   AS CHAR NO-UNDO.
DEF OUTPUT PARAMETER p_search AS CHAR NO-UNDO.    

DEF VAR end-of-path AS INTEGER NO-UNDO.
DEF VAR last-dot    AS INTEGER NO-UNDO.

/* Make sure the file name uses portable BACK-SLASHES. */
p_file = REPLACE (p_file, "~\":U, "~/":U). 

/* Is the simple file name found already? */
p_Search = SEARCH(p_file). 

IF p_Search eq ? THEN DO:
  /* Look from the end of the file-name for the last character of the path.
   * That is, look for the latter of ":" or "/" in a file name like:
   *           c:test.w, or adeuib/_uibmode.p
   */
  end-of-path = MAX (R-INDEX(p_file, ":":U), R-INDEX(p_file, "~/":U)).
  
  /* Now look for the last "." */ 
  last-dot = R-INDEX (p_file, ".":U).
  
  /* Make sure this "." is not in the path 
    (i.e. watch out for c:\bin.win\test). */
  if last-dot < end-of-path THEN last-dot = 0.
  
  /* Break off the extenstion. */
  IF last-dot > 0 THEN 
    p_file = SUBSTRING(p_file, 1, last-dot - 1, "CHARACTER":U).  
    
  /* Check for r-code. */
  p_Search = SEARCH (p_file + ".r":U).
END.

/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/
/*----------------------------------------------------------------------------

File: _ruler.p

Description:
  Build a ruler frame and retrun the frame handle

INPUT Parameters
  The window to parent the ruler frame to.

INPUT-OUTPUT Parameters

OUTPUT Parameters
  The ruler frame 

Author: Greg O'Connor

Date Created: 08/10/93 

Modification History:

----------------------------------------------------------------------------*/
DEFINE INPUT  PARAMETER wWindow   AS WIDGET NO-UNDO.
DEFINE OUTPUT PARAMETER wFrameOut AS WIDGET NO-UNDO.

DEFINE VARIABLE wFrame1    AS WIDGET NO-UNDO.
DEFINE VARIABLE wFrame2    AS WIDGET NO-UNDO.
DEFINE VARIABLE wRectFrame AS WIDGET NO-UNDO.
DEFINE VARIABLE wRect1     AS WIDGET NO-UNDO.
DEFINE VARIABLE wRectTop   AS WIDGET NO-UNDO.
DEFINE VARIABLE wRectLeft  AS WIDGET NO-UNDO.
DEFINE VARIABLE wText      AS WIDGET NO-UNDO.
DEFINE VARIABLE wTextSave  AS WIDGET NO-UNDO.
DEFINE VARIABLE wTextNum   AS WIDGET NO-UNDO.
DEFINE VARIABLE wFillin    AS WIDGET NO-UNDO.
DEFINE VARIABLE cTest      AS CHARACTER NO-UNDO.
DEFINE VARIABLE i          AS INTEGER NO-UNDO.
DEFINE VARIABLE iSave      AS INTEGER NO-UNDO.
DEFINE VARIABLE iLen       AS INTEGER NO-UNDO.
DEFINE VARIABLE iTotal     AS INTEGER NO-UNDO INIT 0.
DEFINE VARIABLE iFields    AS INTEGER NO-UNDO INIT 0.
DEFINE VARIABLE cTextHandleList  AS CHARACTER NO-UNDO.

&SCOPED-DEFINE topBottom 3
&SCOPED-DEFINE rightLeft 4
&SCOPED-DEFINE smallFont 5

IF (wWindow:TYPE <> "WINDOW") THEN
  IF (wWindow:TYPE <> "FRAME") THEN
	DO:
	  message '_ruler argument one must be of TYPE window' skip
	          'or frame. Argument one is TYPE' wWindow:TYPE '.'
			  view-as alert-box error buttons Ok.
	  RETURN.
	END.
   	
CREATE FRAME wFrame1
  ASSIGN
    BOX     = FALSE
    OVERLAY = TRUE
    PARENT  = IF (wWindow:TYPE = "WINDOW") THEN wWindow ELSE wWindow:PARENT
    X       = 0
    Y       = 0
    HEIGHT-CHARS   = 2
    WIDTH-PIXELS   = 2 /* wWindow:WIDTH-PIXELS*/.

cTest = "a".
CREATE TEXT wTextSave
  ASSIGN
    FRAME         = wFrame1
    FORMAT        ="x(1)"
    AUTO-RESIZE   = TRUE
    X             = 0 
    Y             = 0
    VISIBLE       = FALSE
	FONT          = 0
    SCREEN-VALUE   = cTest.

cTest = "a".
CREATE FILL-IN wFillin
  ASSIGN
    FRAME         = wFrame1
    FORMAT        ="x(1)"
    AUTO-RESIZE   = TRUE
    X             = 0 
    Y             = 0
    VISIBLE       = FALSE
    SCREEN-VALUE   = cTest.

IF (wWindow:TYPE = "WINDOW") THEN
DO:
	CREATE FRAME wFrame2
	  ASSIGN
	    BOX     = FALSE
	    OVERLAY = TRUE
	    PARENT  = wWindow
	    X       = 0
	    Y       = 0
		/*
		** The min size a frame can be is the size of a fillin which is bigger than 
		** the size of text becuase of decoration. If the ruler and the margin
		** fit in the the fillin space the use it. 
		*/
	    HEIGHT-PIXELS  = (IF ((wFillin:HEIGHT-PIXELS - wTextSave:HEIGHT-PIXELS) > 
		                     {&topBottom}) THEN wFillin:HEIGHT-PIXELS + 1
						 ELSE
	                        wTextSave:HEIGHT-PIXELS + ({&topBottom} * 2) + 2
						 )
	    WIDTH-PIXELS   = wWindow:WIDTH-PIXELS.
	
	view wFrame2.

	CREATE RECTANGLE wRectFrame
	  ASSIGN
	    X             = 0
	    Y             = 0
	    WIDTH-PIXELS  = wFrame2:WIDTH-PIXELS 
	    HEIGHT-PIXELS = wFrame2:HEIGHT-PIXELS
	    FRAME         = wFrame2
	    bgcolor       = 8
	    fgcolor       = 8
	    filled        = TRUE
		.
END.
ELSE IF (wWindow:TYPE = "FRAME") THEN
DO:

	CREATE RECTANGLE wRectFrame
	  ASSIGN
	    X             = 0
	    Y             = 0
		/*
		** The min size a frame can be is the size of a fillin which is bigger than 
		** the size of text becuase of decoration. If the ruler and the margin
		** fit in the the fillin space the use it. 
		*/
	    HEIGHT-PIXELS  = (IF ((wFillin:HEIGHT-PIXELS - wTextSave:HEIGHT-PIXELS) > 
		                     {&topBottom}) THEN wFillin:HEIGHT-PIXELS + 1
						 ELSE
	                        wTextSave:HEIGHT-PIXELS + ({&topBottom} * 2) + 2
						 )
	    WIDTH-PIXELS   = wWindow:virtual-WIDTH-PIXELS
	    FRAME         = wWindow
	    bgcolor       = 8
	    fgcolor       = 8
	    filled        = TRUE
		.
END.


CREATE TEXT wTextNum
  ASSIGN
    FRAME         = wRectFrame:FRAME
    FORMAT        ="x(1)"
    AUTO-RESIZE   = TRUE
    Y             = 0
    X             = 0
	FONT          = {&SmallFont}
    SCREEN-VALUE  = cTest
	VISIBLE       = FALSE
	.

CREATE RECTANGLE wRect1 /* White middle middle line */
  ASSIGN
	WIDTH-PIXELS  = wRectFrame:WIDTH-PIXELS  - {&rightLeft}
    HEIGHT-PIXELS = 1 
    FRAME         = wRectFrame:FRAME
    bgcolor       = 0
    fgcolor       = 0
    filled        = FALSE
    X             = {&rightleft}
	Y             = wRectFrame:HEIGHT-PIXELS / 2 - 1
	.

CREATE RECTANGLE wRect1 /* Black middle bottom line */
  ASSIGN
	WIDTH-PIXELS  = wRectFrame:WIDTH-PIXELS  - {&rightLeft}
    HEIGHT-PIXELS = 1 
    FRAME         = wRectFrame:FRAME
    bgcolor       = 15
    fgcolor       = 15
    filled        = FALSE
    X             = {&rightleft}
	Y             = wRectFrame:HEIGHT-PIXELS / 2 - 2
	.

CREATE RECTANGLE wRect1 /* Grey middle top line */
  ASSIGN
	WIDTH-PIXELS  = wRectFrame:WIDTH-PIXELS  - {&rightLeft}
    HEIGHT-PIXELS = 1 
    FRAME         = wRectFrame:FRAME
    bgcolor       = 7
    fgcolor       = 7
    filled        = FALSE
    X             = {&rightleft}
	Y             = wRectFrame:HEIGHT-PIXELS / 2 
	.

CREATE RECTANGLE wRect1 /* black top line */
  ASSIGN
	WIDTH-PIXELS  = wRectFrame:WIDTH-PIXELS 
    HEIGHT-PIXELS = 1 
    FRAME         = wRectFrame:FRAME
    bgcolor       = 0
    fgcolor       = 0
    filled        = FALSE
    X             = 0
	Y             = 0
	.

CREATE RECTANGLE wRect1 /* White top line */
  ASSIGN
	WIDTH-PIXELS  = wRectFrame:WIDTH-PIXELS 
    HEIGHT-PIXELS = 1 
    FRAME         = wRectFrame:FRAME
    bgcolor       = 15
    fgcolor       = 15
    filled        = FALSE
    X             = 0
	Y             = 1
	.

CREATE RECTANGLE wRect1 /* Grey bottom line */
  ASSIGN
	WIDTH-PIXELS  = wRectFrame:WIDTH-PIXELS 
    HEIGHT-PIXELS = 1 
    FRAME         = wRectFrame:FRAME
    bgcolor       = 7
    fgcolor       = 7
    filled        = FALSE
    X             = 0
    Y             = wRectFrame:HEIGHT-PIXELS - 1
	.

ASSIGN
  iTotal = {&rightLeft}
  iSave  = wTextNum:height-pixels
  .

DO i = 0 TO wRectFrame:WIDTH-PIXELS / wTextSave:WIDTH-PIXELS:

	IF (i MOD 10) = 0 THEN
 	DO:
	  ASSIGN
  	    iLen          = wRectFrame:HEIGHT-PIXELS / 2.
	  CREATE TEXT wTextNum
	    ASSIGN
	      FRAME         = wRectFrame:FRAME
	      FORMAT        ="x(1)"
	      AUTO-RESIZE   = TRUE 
 	      Y             = MAX (iLen - iSave - 1, 0)
	      X             = {&rightLeft} + i * wTextSave:WIDTH-PIXELS + 1
          bgcolor       = 8
	   	  FONT          = {&smallFont}
	      SCREEN-VALUE   = STRING (i / 10)
		.
	    ASSIGN
		  wTextNum:HEIGHT-PIXELS = wTextNum:HEIGHT-PIXELS - 6
		  wTextNum:Y             = wTextNum:Y + 2
		  .
	END.
	ELSE IF (i MOD 5) <> 0 THEN
	  iLen          = wRectFrame:HEIGHT-PIXELS / 6 - 1.
	ELSE
	  iLen          = wRectFrame:HEIGHT-PIXELS / 3 - 1.

    iTotal = {&rightLeft} + i * wTextSave:WIDTH-PIXELS + 1.
	IF (iTotal > wRectFrame:WIDTH-PIXELS) THEN
	  NEXT.

	CREATE RECTANGLE wRectTop /* top line */
	  ASSIGN
	    Y             = IF (i MOD 10) = 0 THEN
   	   					  wRectFrame:HEIGHT-PIXELS / 2 - 5
						ELSE
   	   					  wRectFrame:HEIGHT-PIXELS / 2 
	    X             = {&rightLeft} + i * wTextSave:WIDTH-PIXELS
	    WIDTH-PIXELS  = 1
	    HEIGHT-PIXELS = iLen
	    FRAME         = wRectFrame:FRAME
	    bgcolor       = 0
	    fgcolor       = 0
	    filled        = FALSE
		.
	
	CREATE RECTANGLE wRect1 /* White (bottom and left line) */
	  ASSIGN
	    HEIGHT-PIXELS = iLen
	    Y             = wRectTop:Y

	    HEIGHT-PIXELS  = IF (i MOD 10) = 0 THEN
   	   					  wRectFrame:HEIGHT-PIXELS / 2 - 4
						ELSE
   	   					  iLen 
	    Y             = wRectFrame:HEIGHT-PIXELS / 2 
	    X             = wRectTop:X + 1
	    WIDTH-PIXELS  = 1
	    FRAME         = wRectFrame:FRAME
	    bgcolor       = 15
	    fgcolor       = 15
	    filled        = FALSE
		.
	
END.

  wFrameOut = wRectFrame:FRAME.

RETURN.
/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/
/*-----------------------------------------------------------------------------

  File: _runard.p

  Description: Runs e.Report Designer.

  Input Parameters:
      <none>

  Output Parameters:
      <none>

  Author: Gerry Seidl

  Modified on 
     05/04/99 by gfs - Created
     01/06/00 by gfs - Changed to create a .bat file defining PROGRESS env vars
 *---------------------------------------------------------------------------*/
DEFINE VARIABLE locard   AS CHARACTER NO-UNDO.
DEFINE VARIABLE DLCValue AS CHARACTER NO-UNDO.

GET-KEY-VALUE SECTION "Startup":U KEY "DLC":U VALUE DLCValue.
IF DLCValue = ? THEN DLCValue = OS-GETENV("DLC":U).

RUN adecomm/_locard.p(OUTPUT locard).
IF locard <> ? THEN DO:
    OUTPUT TO ard.bat.
      PUT UNFORMATTED "@echo off":U SKIP.
      PUT UNFORMATTED "set DLC=":U + DLCValue SKIP.
      PUT UNFORMATTED "set PROMSGS=":U + DLCValue + "~\promsgs":U SKIP.
      PUT UNFORMATTED "set PROCFG=":U + DLCValue + "~\progress.cfg":U SKIP.
      PUT UNFORMATTED "path=":U + DLCValue + "~\bin;":U + DLCValue + ";%path%":U SKIP.
      PUT UNFORMATTED FILE-INFO:FULL-PATHNAME SKIP.
    OUTPUT CLOSE.

    /* Execute the batch file */
    OS-COMMAND NO-WAIT VALUE("ard.bat":U).
END.
RETURN.
&ANALYZE-SUSPEND _VERSION-NUMBER AB_v10r12
&ANALYZE-RESUME
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _DEFINITIONS Procedure 
/*********************************************************************
* Copyright (C) 2005,2009 by Progress Software Corporation. All rights    *
* reserved.  Prior versions of this work may contain portions        *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/**************************************************************************
    Procedure   : _runcode.p
    
    Purpose     : ADE routine to run code. Handles running code as
                  persistent or non-peristent.

    Syntax      :
    
        RUN adecomm/_runcode.p ( INPUT  p_RunFile    ,
                                 INPUT  p_RunFlags ,
                                 INPUT  p_Stop_Widget ,
                                 OUTPUT p_hProc ) .

    Parameters  :

      INPUT:
  
      p_RunFile
            Name of operating system file to run.
            
      p_RunFlags
            Controls various run characteristics.
        
        _PERSISTENT
            Tells routine whether to run specified file persistently or not.
            
            Not Present: Run code non-persistently. Persistent procedures
            created by the running code are deleted afterwards.
                    
            Present: Run code persistently. If you pass a valid handle
            for p_Stop_Widget, persistent procedures created by the
            running code are deleted after the run. If p_Stop_Widget
            is not a valid-handle, the persistent procedures are NOT
            deleted.
        
        _PAUSE
            ADE Tool calls and a tool running an os file directly
            should never pause after running.  This allows for control
            of that behavoir.
                        
        _KEEP-WIDGETS
            If not present, create a widget-pool before running
            code and delete that widget-pool after running code.

        _TOFRONT
            Tells routine to bring the run window to front.

      p_Stop_Widget
            Handle of widget to WAIT-FOR CHOOSE when running code
            persistently.  Must be a BUTTON or MENU-ITEM.
            
            If passed in as Unknown (?), the WAIT-FOR is not performed.
            See Notes below for more details.

      OUTPUT:
    
      p_hProc
            Procedure handle when file is run persistently.
                 
    Notes       :
        This routine builds a table of PERSISTENT PROCEDURE handles which 
        exist prior to running user code.  After running user code, it
        automatically deletes all PERSISTENT PROCEDURES that are not
        part of the table (ie, those created while running user code)
        IF the code was run non-persistently or the caller passed in
        a valid p_Stop_Widget.
        
        This routine also builds a tables of AppServer and Socket handles
        that exist prior to running user code.  After running user code, it
        automatically deletes all AppServer and Socket handles that are not
        part of the table (ie, those created while running user code).
        
        
    Authors     : John Palazzo
    Created     : May, 1994
    Modified by : jep on 10/20/99 - Delete user AppServer and Sockets.
                  wtw on 09/11/95 - Cleanup the ADM-BROKER after a run.
                  jep on 08/04/95 - Support Unknown p_Stop_Widget value.
                  jep on 07/03/95 - Handle WINDOW-CLOSE for DEFAULT-WINDOW.
                  gfs on 01/18/94 - Added check for ADEPersistent in DeleteProc
**************************************************************************/

/* ***************************  Definitions  ************************** */

/* -- Preprocessor Definitions ---------------------------------------- */
&IF DEFINED(ADEICONDIR) = 0 &THEN
 {adecomm/icondir.i}
&ENDIF

/* -- Parameter Definitions ------------------------------------------- */
DEFINE INPUT  PARAMETER p_RunFile     AS CHARACTER NO-UNDO.
DEFINE INPUT  PARAMETER p_RunFlags    AS CHARACTER NO-UNDO.
DEFINE INPUT  PARAMETER p_Stop_Widget AS WIDGET    NO-UNDO.
DEFINE OUTPUT PARAMETER p_hProc       AS HANDLE    NO-UNDO.

/* -- Local Definitions ----------------------------------------------- */
/* WebSpeed stream and new global definitions. Customers who edit and
   recompile _runcode.p can comment out this include line if they
   do not have WebSpeed. */
{ src/web/method/cgidefs.i NEW}

DEFINE TEMP-TABLE PersistProc NO-UNDO
    FIELD hProc     AS HANDLE
    INDEX ObjHandle IS PRIMARY hProc.
    
DEFINE TEMP-TABLE PersistProcDelete NO-UNDO
    FIELD hProc      AS HANDLE
    FIELD isDelete   as logical 
    FIELD isADETool  as logical
    FIELD SuperString as char
    INDEX ObjHandle IS PRIMARY hProc
    INDEX isDELETE  isDelete.

DEFINE TEMP-TABLE AppServer   NO-UNDO
    FIELD hServer   AS HANDLE
    INDEX ObjHandle IS PRIMARY hServer.

DEFINE TEMP-TABLE ASocket     NO-UNDO
    FIELD hSocket   AS HANDLE
    INDEX ObjHandle IS PRIMARY hSocket.

DEFINE TEMP-TABLE AServSocket     NO-UNDO
    FIELD hSocket   AS HANDLE
    INDEX ObjHandle IS PRIMARY hSocket.

DEFINE TEMP-TABLE AClass NO-UNDO
    FIELD rClass AS Progress.Lang.Object
    INDEX ObjHandle IS PRIMARY rClass.

DEFINE VARIABLE v_RunPersist  AS LOGICAL     NO-UNDO INITIAL FALSE.
DEFINE VARIABLE v_Pause       AS LOGICAL     NO-UNDO INITIAL TRUE.
DEFINE VARIABLE v_KeepWidgets AS LOGICAL     NO-UNDO INITIAL FALSE.
DEFINE VARIABLE v_MoveToFront AS LOGICAL     NO-UNDO INITIAL FALSE.
DEFINE VARIABLE hCurWin       AS HANDLE      NO-UNDO.
DEFINE VARIABLE hWindow       AS HANDLE      NO-UNDO.  
DEFINE VARIABLE Delete_Proc   AS HANDLE      NO-UNDO.
DEFINE VARIABLE Def_Private   AS CHARACTER   NO-UNDO.
DEFINE VARIABLE v_Logical     AS LOGICAL     NO-UNDO.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME


&ANALYZE-SUSPEND _UIB-PREPROCESSOR-BLOCK 

/* ********************  Preprocessor Definitions  ******************** */

&Scoped-define PROCEDURE-TYPE Procedure
&Scoped-define DB-AWARE no



/* _UIB-PREPROCESSOR-BLOCK-END */
&ANALYZE-RESUME



/* *********************** Procedure Settings ************************ */

&ANALYZE-SUSPEND _PROCEDURE-SETTINGS
/* Settings for THIS-PROCEDURE
   Type: Procedure
   Allow: 
   Frames: 0
   Add Fields to: Neither
   Other Settings: CODE-ONLY COMPILE
 */
&ANALYZE-RESUME _END-PROCEDURE-SETTINGS

/* *************************  Create Window  ************************** */

&ANALYZE-SUSPEND _CREATE-WINDOW
/* DESIGN Window definition (used by the UIB) 
  CREATE WINDOW Procedure ASSIGN
         HEIGHT             = 8.33
         WIDTH              = 54.8.
/* END WINDOW DEFINITION */
                                                                        */
&ANALYZE-RESUME

 


&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _MAIN-BLOCK Procedure 


/* ***************************  Main Block  *************************** */
/* Initialize RunFlags. */
ASSIGN v_RunPersist   = CAN-DO(p_RunFlags, "_PERSISTENT":U)
       v_Pause        = CAN-DO(p_RunFlags, "_PAUSE":U)
       v_KeepWidgets  = CAN-DO(p_RunFlags, "_KEEP-WIDGETS":U)
       v_MoveToFront  = CAN-DO(p_RunFlags, "_TOFRONT":U)
       NO-ERROR. /* END ASSIGN */
         
REPEAT ON QUIT       , LEAVE
       ON STOP   UNDO, LEAVE
       ON ERROR  UNDO, LEAVE
       ON ENDKEY UNDO, LEAVE :

  /* Build table of existing Persistent procedures. Delete ones not in
     table after user's code completes. */
  RUN BuildPersistProc.
  /* Build table of existing AppServer connections. Delete ones not in
     table after user's code completes. */
  RUN BuildAppServer.
  /* Build table of existing Socket connections. Delete ones not in
     table after user's code completes. */
  RUN BuildSocket.
  /* Build table of existing Class instances. Delete ones not in 
     table after user's code completes. */
  RUN BuildClass.

  /* Reset Progress Session defaults for execute window. */
  RUN SessionDefaults ( INPUT DEFAULT-WINDOW ) .

  ASSIGN DEFAULT-WINDOW:SENSITIVE   = TRUE
         hCurWin                    = CURRENT-WINDOW
         CURRENT-WINDOW             = DEFAULT-WINDOW
         . /* END ASSIGN */

  IF v_MoveToFront THEN
  DO:
      DEFINE VARIABLE lAlwaysOnTop AS LOGICAL    NO-UNDO.
      
      hWindow = IF VALID-HANDLE(DEFAULT-WINDOW) THEN DEFAULT-WINDOW ELSE hCurWin.
      lAlwaysOnTop          = hWindow:ALWAYS-ON-TOP.
      hWindow:ALWAYS-ON-TOP = TRUE.
      hWindow:ALWAYS-ON-TOP = lAlwaysOnTop.
  END.

  /* Ensure the Tool does not have focus when running user's code by
     "killing" FOCUS - that is, making it null.
  */
  RUN KillFocus ( INPUT DEFAULT-WINDOW ,
                  INPUT DEFAULT-WINDOW:FIRST-CHILD ).

  /* Allow user to close Run window with click on close icon. */
  ASSIGN Def_Private = DEFAULT-WINDOW:PRIVATE-DATA.
  ON WINDOW-CLOSE OF DEFAULT-WINDOW
  DO:
    ASSIGN DEFAULT-WINDOW:PRIVATE-DATA = "END-ERROR":U.
    APPLY "END-ERROR" TO DEFAULT-WINDOW.
  END.
  /* Add purple Progress icon. */
  ASSIGN v_Logical = DEFAULT-WINDOW:LOAD-ICON("adeicon/progress.ico") NO-ERROR.

  IF NOT v_KeepWidgets THEN CREATE WIDGET-POOL .

  IF v_RunPersist = FALSE THEN
    RUN VALUE( p_RunFile ).
  ELSE
  DO:
    /* Run the user's file persistent. */
    RUN VALUE( p_RunFile ) PERSISTENT SET p_hProc.
        
    /* If the user has already deleted their own persistent procedure,
       then we don't wait in our window.  We take it to mean the user
       has nothing to run persistently.
    */
    IF VALID-HANDLE( p_hProc ) AND VALID-HANDLE( p_Stop_Widget ) THEN
    DO:
      /* If valid, we will use the persistent procedure's current window to
         check for events which close the window and hence close the
         persistent procedure.
      */
      ASSIGN hCurWin = IF VALID-HANDLE(p_hProc:CURRENT-WINDOW)
                       THEN p_hProc:CURRENT-WINDOW
                       ELSE DEFAULT-WINDOW. 
      /* In addition to waiting for CHOOSE of the stop widget, we also
         wait for the events most likely to close a persistent window:
         WINDOW-CLOSE and CLOSE.  By default, if the user does a Window Close 
         (Alt+F4) in a persistent window, the .w code sends a CLOSE event
         which we detect here along with WINDOW-CLOSE and force a STOP.
      */
      WAIT-FOR    WINDOW-CLOSE,CLOSE OF p_hProc 
               OR WINDOW-CLOSE,CLOSE OF hCurWin
               OR CHOOSE             OF p_Stop_Widget.
    END.
    
  END.
  
  LEAVE.

END. /* REPEAT */

REPEAT ON QUIT       , LEAVE
       ON STOP   UNDO, LEAVE
       ON ERROR  UNDO, LEAVE
       ON ENDKEY UNDO, LEAVE :
  /* Only pause in a window which is visible and user has requested to pause. */
  /* However, if user clicks Close icon, close with no pause. */
  IF ( DEFAULT-WINDOW:VISIBLE = TRUE ) AND ( v_Pause = TRUE ) AND
     ( DEFAULT-WINDOW:PRIVATE-DATA <> "END-ERROR")
  THEN PAUSE IN WINDOW DEFAULT-WINDOW
             MESSAGE "Procedure complete. Press space bar to continue.".
  LEAVE.
END.
ASSIGN DEFAULT-WINDOW:PRIVATE-DATA = Def_Private.

/* Delete Persistent Procedures created by running user code. */
IF v_RunPersist = FALSE OR
   VALID-HANDLE( p_Stop_Widget ) THEN RUN DeletePersistProc.

/* Delete AppServer and Socket connections created by running user code
   (done after DeletePersistProc call above to allow PPs to use the
    AppServer and/or Socket if needed during their cleanup).
   Also delete any class instances created by running the user code. 
*/
RUN DeleteAppServer.
RUN DeleteSocket.
RUN DeleteClass.

/* Find the ADM-BROKER and ask it to clean itself up. */
RUN cleanup-ADM-broker.

/* Delete any widgets created dynamically in the default widget-pool. */
IF NOT v_KeepWidgets THEN DELETE WIDGET-POOL.
    
/* Reset Progress Session defaults for execute window. */
RUN SessionDefaults ( INPUT DEFAULT-WINDOW ) .

/* Reset major attributes for default/run window (font, title etc. */
RUN DefWinReset ( INPUT DEFAULT-WINDOW ).
IF VALID-HANDLE(hCurWin) THEN
  ASSIGN CURRENT-WINDOW = hCurWin.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME


/* **********************  Internal Procedures  *********************** */

&IF DEFINED(EXCLUDE-BuildAppServer) = 0 &THEN

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE BuildAppServer Procedure 
PROCEDURE BuildAppServer :
/*------------------------------------------------------------------------------
  Purpose:    Build a table of existing AppServer connections. After user's
              code runs, any ones in addition to these are user created and
              will be deleted before ending.     
  Parameters:  <none>
  Notes:       
------------------------------------------------------------------------------*/
  DEFINE VARIABLE hAppServer  AS HANDLE NO-UNDO.

  ASSIGN hAppServer = SESSION:FIRST-SERVER.

  DO WHILE VALID-HANDLE( hAppServer ):
    CREATE AppServer.
    ASSIGN AppServer.hServer = hAppServer
           hAppServer        = hAppServer:NEXT-SIBLING.
  END.
END PROCEDURE.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME

&ENDIF

&IF DEFINED(EXCLUDE-BuildClass) = 0 &THEN

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE BuildClass Procedure 
PROCEDURE BuildClass :
/*------------------------------------------------------------------------------
  Purpose:    Build a table of existing class instances. After user's
              code runs, any ones in addition to these are user created and
              will be deleted before ending.     
  Parameters:  <none>
  Notes:       
------------------------------------------------------------------------------*/
  DEFINE VARIABLE rObj AS Progress.Lang.Object NO-UNDO.

  ASSIGN rObj = SESSION:FIRST-OBJECT.
  DO WHILE VALID-OBJECT(rObj):
      CREATE AClass.
      ASSIGN 
        AClass.rClass = rObj
        rObj = rObj:NEXT-SIBLING.
  END.
END PROCEDURE.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME

&ENDIF

&IF DEFINED(EXCLUDE-BuildPersistProc) = 0 &THEN

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE BuildPersistProc Procedure 
PROCEDURE BuildPersistProc :
/*------------------------------------------------------------------------------
  Purpose:  Build a table of existing Persistent Procedures. After user's
            code runs, any ones in addition to these are user created and
            will be deleted before ending.     
  Parameters:  <none>
  Notes:       
------------------------------------------------------------------------------*/
  DEFINE VARIABLE hProcedure AS HANDLE NO-UNDO.

  ASSIGN hProcedure = SESSION:FIRST-PROCEDURE.

  DO WHILE VALID-HANDLE( hProcedure ):
    CREATE PersistProc.
    ASSIGN PersistProc.hProc = hProcedure
           hProcedure        = hProcedure:NEXT-SIBLING.
  END.

END PROCEDURE.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME

&ENDIF

&IF DEFINED(EXCLUDE-BuildSocket) = 0 &THEN

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE BuildSocket Procedure 
PROCEDURE BuildSocket :
/*------------------------------------------------------------------------------
  Purpose:    Build a table of existing Socket connections. After user's
              code runs, any ones in addition to these are user created and
              will be deleted before ending.    
  Parameters:  <none>
  Notes:       
------------------------------------------------------------------------------*/
  DEFINE VARIABLE hSocket     AS HANDLE NO-UNDO.

  ASSIGN hSocket = SESSION:FIRST-SOCKET.

  DO WHILE VALID-HANDLE( hSocket ):
    CREATE ASocket.
    ASSIGN ASocket.hSocket = hSocket
           hSocket         = hSocket:NEXT-SIBLING.
  END.

  ASSIGN hSocket = SESSION:FIRST-SERVER-SOCKET.

  DO WHILE VALID-HANDLE( hSocket ):
    CREATE AServSocket.
    ASSIGN AServSocket.hSocket = hSocket
           hSocket             = hSocket:NEXT-SIBLING.
  END.
END PROCEDURE.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME

&ENDIF

&IF DEFINED(EXCLUDE-cleanup-ADM-broker) = 0 &THEN

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE cleanup-ADM-broker Procedure 
PROCEDURE cleanup-ADM-broker :
/*------------------------------------------------------------------------------
  Purpose:   Look at all remaining procedures. If any are ADM-BROKER's, 
             then ask them to clean themselves up. 
  Parameters:  <none>
  Notes:       
------------------------------------------------------------------------------*/
  DEFINE VARIABLE hProcedure AS HANDLE NO-UNDO. 
  DEFINE VARIABLE cType      AS CHAR   NO-UNDO.

  ASSIGN hProcedure = SESSION:FIRST-PROCEDURE.
  DO WHILE VALID-HANDLE( hProcedure ):  
    /* If it is of TYPE = "ADM-BROKER" then it is a procedure we want
       to deal with. */
    RUN get-attribute IN hProcedure ('TYPE':U) NO-ERROR. 
    cType = IF ERROR-STATUS:ERROR THEN ? ELSE RETURN-VALUE.
    IF cType eq 'ADM-Broker':U THEN RUN cleanup-links IN hProcedure NO-ERROR.

    /* Get the next persistent procedure. */
    ASSIGN hProcedure = hProcedure:NEXT-SIBLING.
  END.

END PROCEDURE.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME

&ENDIF

&IF DEFINED(EXCLUDE-ContainerObjects) = 0 &THEN

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE ContainerObjects Procedure 
PROCEDURE ContainerObjects :
/*------------------------------------------------------------------------------
  Purpose:     Find all contained objects and their super procedures 
  Parameters:  <none>
  Notes:       
------------------------------------------------------------------------------*/
  DEFINE INPUT PARAMETER phProc as HANDLE no-undo.
  DEFINE OUTPUT PARAMETER pcProcs as CHAR NO-UNDO.
   
  DEF VAR cType    AS CHARACTER NO-UNDO.
  DEF VAR cObjects AS CHARACTER NO-UNDO.
  DEF VAR i        AS INTEGER   NO-UNDO.
  DEF VAR hObject  AS HANDLE    No-UNDO.
  
  pcprocs = phProc:SUPER-PROCEDURES.
  
  cType = DYNAMIC-FUNCTION("getObjectType":U in phProc)  NO-ERROR.
  IF cType = "SmartWindow":U THEN
  DO:
    cObjects = DYNAMIC-FUNCTION("getContainerTarget":U in phProc).
    IF cObjects > "" THEN
       pcprocs = pcprocs + (IF pcprocs = "" then "" else ",") + cObjects.
    /* Now derive the super procedures */   
    DO i = 1 to NUM-ENTRIES(cObjects):
      hObject = WIDGET-HANDLE(ENTRY(i,cObjects)) NO-ERROR.
      IF VALID-HANDLE(hObject) AND hObject:SUPER-PROCEDURES > "" THEN
         pcprocs = pcprocs + (IF pcprocs = "" then "" else ",") 
                         + hObject:SUPER-PROCEDURES.
    END.
  END. 
   
END PROCEDURE.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME

&ENDIF

&IF DEFINED(EXCLUDE-DefWinReset) = 0 &THEN

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE DefWinReset Procedure 
PROCEDURE DefWinReset :
/*--------------------------------------------------------------------------
    Purpose:        Resets a window's attributes to the Progress 
                    Initial window defaults.

    Run Syntax:     RUN DefWinReset( INPUT p_Window ).

    Parameters:     INPUT p_Window  - Window to reset.

    Description:
    Notes:
  --------------------------------------------------------------------------*/

    DEFINE INPUT PARAMETER p_Window AS WIDGET-HANDLE NO-UNDO.
    
    DEFINE VAR Default_Win AS WIDGET-HANDLE NO-UNDO.
    
    /* proc-main */
    REPEAT ON STOP UNDO, RETRY:
        IF ( SESSION:WINDOW-SYSTEM = "TTY" ) THEN
        DO:
            ASSIGN p_Window:MENUBAR = ?.
            RETURN.
        END.
        
        IF NOT RETRY
        THEN DO:
            CREATE WINDOW Default_Win.
            ASSIGN
                p_Window:FONT    = Default_Win:FONT
                p_Window:BGCOLOR = Default_Win:BGCOLOR
                p_Window:FGCOLOR = Default_Win:FGCOLOR
                p_Window:TITLE   = Default_Win:TITLE
                p_Window:MENUBAR = ?
                p_Window:VIRTUAL-WIDTH   = Default_Win:VIRTUAL-WIDTH
                p_Window:VIRTUAL-HEIGHT  = Default_Win:VIRTUAL-HEIGHT
                p_Window:MAX-WIDTH   = Default_Win:MAX-WIDTH
                p_Window:MAX-HEIGHT  = Default_Win:MAX-HEIGHT
                p_Window:MIN-WIDTH   = Default_Win:MIN-WIDTH
                p_Window:MIN-HEIGHT  = Default_Win:MIN-HEIGHT
                p_Window:WIDTH   = Default_Win:WIDTH
                p_Window:HEIGHT  = Default_Win:HEIGHT
            . /* END-ASSIGN */
        END.
        DELETE WIDGET Default_Win.
        LEAVE.
    END.
    
END PROCEDURE.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME

&ENDIF

&IF DEFINED(EXCLUDE-DeleteAppServer) = 0 &THEN

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE DeleteAppServer Procedure 
PROCEDURE DeleteAppServer :
/*------------------------------------------------------------------------------
  Purpose:  Delete user-created AppServer connections by deleting the ones not
            in the table (ie, not present before running user's code).    
  Parameters:  <none>
  Notes:       
------------------------------------------------------------------------------*/
  DEFINE VARIABLE hAppServer AS HANDLE NO-UNDO.
  DEFINE VARIABLE hDelServer AS HANDLE NO-UNDO.

  ASSIGN hAppServer = SESSION:FIRST-SERVER.

  DO WHILE VALID-HANDLE( hAppServer ):
    hDelServer = hAppServer.
    hAppServer = hAppServer:NEXT-SIBLING.
    FIND FIRST AppServer WHERE AppServer.hServer = hDelServer NO-ERROR.
    IF NOT AVAILABLE AppServer THEN
    DO:
      hDelServer:DISCONNECT() NO-ERROR.
      DELETE OBJECT hDelServer NO-ERROR.
    END.
  END.

END PROCEDURE.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME

&ENDIF

&IF DEFINED(EXCLUDE-DeleteClass) = 0 &THEN

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE DeleteClass Procedure 
PROCEDURE DeleteClass :
/*------------------------------------------------------------------------------
  Purpose:  Delete user-created class instances by deleting the ones not
            in the table (ie, not present before running user's code). 
  Parameters:  <none>
  Notes:       
------------------------------------------------------------------------------*/
    DEFINE VARIABLE rObj AS Progress.Lang.Object NO-UNDO.
    DEFINE VARIABLE rDel AS Progress.Lang.Object NO-UNDO.

&IF "{&OPSYS}" <> "UNIX" &THEN
    /* OE00190506: Force .NET garbage collection if the CLR has been loaded */
    IF SESSION:DOTNET-CLR-LOADED = TRUE THEN
    DO:
        System.GC:Collect().
        System.GC:WaitForPendingFinalizers().
        System.GC:Collect().
    END.
&ENDIF 

    ASSIGN rObj = SESSION:FIRST-OBJECT.
    
    DO WHILE VALID-OBJECT(rObj):
        ASSIGN
            rDel = rObj
            rObj = rObj:NEXT-SIBLING.
        FIND FIRST AClass WHERE AClass.rClass = rDel NO-ERROR.
        IF NOT AVAILABLE AClass THEN
            DELETE OBJECT rDel NO-ERROR.
    END.
END PROCEDURE.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME

&ENDIF

&IF DEFINED(EXCLUDE-DeletePersistProc) = 0 &THEN

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE DeletePersistProc Procedure 
PROCEDURE DeletePersistProc :
/*------------------------------------------------------------------------------
  Purpose:     Delete user-created Persistent Procedures by deleting the ones 
               not in the table (ie, not present before running user's code). 
  Parameters:  <none>
  Notes:       
------------------------------------------------------------------------------*/
  DEFINE VARIABLE hProcedure  AS HANDLE     NO-UNDO.
  DEFINE VARIABLE cProcs      AS CHAR       NO-UNDO.
  DEFINE VARIABLE i           AS INTEGER    NO-UNDO.
  DEFINE VARIABLE cObjectType AS CHARACTER  NO-UNDO.
  DEFINE VARIABLE lSuper      AS LOGICAL    NO-UNDO.

  ASSIGN hProcedure = SESSION:FIRST-PROCEDURE.
  
  DO WHILE VALID-HANDLE( hProcedure ):
    FIND FIRST PersistProc WHERE PersistProc.hProc = hProcedure NO-ERROR.
    IF NOT AVAILABLE PersistProc THEN
      ASSIGN Delete_Proc = hProcedure.
    ELSE
       ASSIGN Delete_Proc = ?.              
   
    ASSIGN hProcedure = hProcedure:NEXT-SIBLING.
    /* Store all procedures in a temp table to be flagged for deletion later */
    IF VALID-HANDLE(Delete_Proc) THEN
    DO:
      CREATE PersistProcDelete.
      ASSIGN PersistProcDelete.hProc = Delete_proc
             PersistProcDelete.isDelete = LOOKUP("ADEPersistent",Delete_Proc:INTERNAL-ENTRIES) EQ 0
             PersistProcDelete.isADETool = LOOKUP("ADEPersistent",Delete_Proc:INTERNAL-ENTRIES) NE 0.
      /* Calculate the super procedures for ADETool Objects */
      IF PersistProcDelete.isADETool THEN
      DO:
          /* This will retrieve the objects super procs, and it's contained objects if it's a smartWindow */
         RUN ContainerObjects in THIS-PROCEDURE (Delete_proc, OUTPUT cProcs).
         ASSIGN PersistProcDelete.superString = cProcs.
      END.
    END.

  END. /* End looping through procedure */
  /* Now flag any procedures used as non deletable */
  DEFINE BUFFER BuffPersist FOR PersistProcDelete.
  
  FOR EACH PersistProcDelete WHERE PersistProcDelete.isADETool:
    FOR EACH BuffPersist WHERE NOT BuffPersist.isADETool:
       /* If the list of deleted procedures is a super procedure or contained object of the AdeTool, do not delete it */
       IF LOOKUP(STRING(BuffPersist.hProc), PersistProcDelete.SuperString) NE 0 THEN
          ASSIGN BuffPersist.isDelete = NO.
    END.
    
  END.  
    
  FOR EACH PersistProcDelete WHERE PersistProcDelete.isDelete:      
    lSuper = FALSE.
    IF VALID-HANDLE(PersistProcDelete.hProc) THEN 
    DO:
      ASSIGN 
        cObjectType = ?
        cObjectType = {fn getObjectType PersistProcDelete.hProc} NO-ERROR. 
      IF cObjectType > '':U AND cObjectType <> 'SUPER':U THEN
        RUN destroyObject IN PersistProcDelete.hProc NO-ERROR.
      ELSE 
        lSuper = TRUE.
    END.
    IF NOT lSuper THEN
    DO:
      IF  VALID-HANDLE(PersistProcDelete.hProc) 
      AND LOOKUP("dispatch":U,PersistProcDelete.hProc:INTERNAL-ENTRIES) NE 0 THEN
        RUN dispatch IN PersistProcDelete.hProc ('destroy':U).
    
      ELSE IF VALID-HANDLE(PersistProcDelete.hProc) THEN 
        APPLY "CLOSE":U TO PersistProcDelete.hProc.
    
      IF VALID-HANDLE(PersistProcDelete.hProc) THEN
        DELETE PROCEDURE PersistProcDelete.hProc .    

      DELETE PersistProcDelete. 
    END.
  END.
  
  /* Delete supers last  */
  FOR EACH PersistProcDelete WHERE PersistProcDelete.isDelete:      
    IF VALID-HANDLE(PersistProcDelete.hProc) THEN
      DELETE PROCEDURE PersistProcDelete.hProc.        
  END.

  EMPTY TEMP-TABLE PersistProcDelete.

END PROCEDURE.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME

&ENDIF

&IF DEFINED(EXCLUDE-DeleteSocket) = 0 &THEN

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE DeleteSocket Procedure 
PROCEDURE DeleteSocket :
/*------------------------------------------------------------------------------
  Purpose:  Delete user-created Socket connections by deleting the ones not
            in the table (ie, not present before running user's code). 
  Parameters:  <none>
  Notes:       
------------------------------------------------------------------------------*/
  DEFINE VARIABLE hSocket    AS HANDLE NO-UNDO.
  DEFINE VARIABLE hDelSocket AS HANDLE NO-UNDO.

  ASSIGN hSocket = SESSION:FIRST-SOCKET.

  DO WHILE VALID-HANDLE( hSocket ):
    hDelSocket = hSocket.
    hSocket = hSocket:NEXT-SIBLING.
    FIND FIRST ASocket WHERE ASocket.hSocket = hDelSocket NO-ERROR.
    IF NOT AVAILABLE ASocket THEN
    DO:
      hDelSocket:DISCONNECT() NO-ERROR.
      DELETE OBJECT hDelSocket NO-ERROR.
    END.
  END.

  ASSIGN hSocket = SESSION:FIRST-SERVER-SOCKET.

  DO WHILE VALID-HANDLE( hSocket ):
    hDelSocket = hSocket.
    hSocket = hSocket:NEXT-SIBLING.
    FIND FIRST AServSocket WHERE AServSocket.hSocket = hDelSocket NO-ERROR.
    IF NOT AVAILABLE AServSocket THEN
    DO:
      hDelSocket:DISABLE-CONNECTIONS() NO-ERROR.
      DELETE OBJECT hDelSocket NO-ERROR.
    END.
  END.
  
END PROCEDURE.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME

&ENDIF

&IF DEFINED(EXCLUDE-KillFocus) = 0 &THEN

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE KillFocus Procedure 
PROCEDURE KillFocus :
/*--------------------------------------------------------------------------
    Purpose:        Kills FOCUS so its no longer in a Tool's window.

    Run Syntax:
        RUN KillFocus ( INPUT p_Execute_Window ,
                        INPUT p_hFrame ).
                        
    Parameters:
    
    Description:
        1. Ensures the Tool does not have focus
           when it becomes disabled before running user's code.
        2. User can no longer access the Tool's handle via
           FOCUS or FRAME-VALUE when their code runs.
    
    Notes:
        1. To move focus out of Tool, we move focus into a temp editor
           widget and then delete the widget.  Also...
        2. We Apply entry to the execute window.
        
        One and Two together move FOCUS out to nowhere (null focus) and
        deacticates FRAME-VALUE until user actives it. 
        
        This only works for GUI, not TTY.
  --------------------------------------------------------------------------*/
  
  DEFINE INPUT PARAMETER p_Execute_Window  AS WIDGET-HANDLE NO-UNDO.
  DEFINE INPUT PARAMETER p_hFrame          AS WIDGET-HANDLE NO-UNDO.

  DEFINE VARIABLE hTempEd                  AS WIDGET-HANDLE NO-UNDO.
  
  
  DO ON STOP UNDO, LEAVE:
  
      /* Create a temp editor widget. We'll put focus in it, then destroy
         it before running user's code. This ensures the Tool will not
         have focus when the user's code runs. User can no longer access
         the Tool's handle via FOCUS or FRAME-VALUE when their code runs.
      */
      CREATE FRAME p_hFrame
        ASSIGN PARENT = p_Execute_Window
               HIDDEN = TRUE.
             
      CREATE EDITOR hTempEd
        ASSIGN HIDDEN    = TRUE
               FRAME     = p_hFrame
               SENSITIVE = TRUE
        . /* ASSIGN */  
        
      APPLY "ENTRY" TO hTempED.
      ASSIGN hTempEd:SENSITIVE = FALSE.
  
  END. /* DO ON STOP */
  
  /* Destory the temp focus editor.  Progress puts focus nowhere, so the
     Tool will not have it. Note the VALID-HANDLE check prevents the
     DELETE WIDGET from executing if some stop condition occurred
     before hTempEd got created.
  */
  IF VALID-HANDLE( hTempEd ) THEN
      DELETE WIDGET hTempED.
  IF VALID-HANDLE( p_Execute_Window ) THEN
      APPLY "ENTRY" TO p_Execute_Window.
  IF VALID-HANDLE(p_hFrame) THEN
      DELETE WIDGET p_hFrame.
  
  RETURN.
END PROCEDURE.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME

&ENDIF

&IF DEFINED(EXCLUDE-SessionDefaults) = 0 &THEN

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE SessionDefaults Procedure 
PROCEDURE SessionDefaults :
/*--------------------------------------------------------------------------
    Purpose:     Reset Progress Session defaults for specfied window.
    Run Syntax:     RUN SessionDefaults ( INPUT p_Window ).
    Parameters:     p_Window : Handle to window to set session defaults.
    Description:
    Notes:
  --------------------------------------------------------------------------*/

  DEFINE INPUT PARAMETER p_Window AS WIDGET-HANDLE NO-UNDO.

  DEFINE VAR Temp_Var   AS LOGICAL NO-UNDO.
  DEFINE VAR Immed_Disp AS LOGICAL NO-UNDO.

  /* Most important after run.  Must be sure user wait state is cleared. */
  ASSIGN 
      Temp_Var = SESSION:SET-WAIT-STATE("")
      Temp_Var = p_Window:LOAD-MOUSE-POINTER("")
      NO-ERROR . /* END ASSIGN */

  /* Hide the execute window. */
  HIDE p_Window.
   
  /* Clear the execute window.      */
  HIDE ALL NO-PAUSE IN WINDOW p_Window .
  /* Clear previous messages.*/
  HIDE MESSAGE NO-PAUSE IN WINDOW p_Window .

  /* Reset Status Input and Default to PROGRESS defaults. */
  /* Needed to force display of status using IMMEDIATE-DISPLAY. */
  ASSIGN Immed_Disp = SESSION:IMMEDIATE-DISPLAY
         SESSION:IMMEDIATE-DISPLAY = TRUE.
  STATUS DEFAULT IN WINDOW p_Window .
  STATUS INPUT  IN WINDOW p_Window .
  ASSIGN SESSION:IMMEDIATE-DISPLAY = Immed_Disp.
   /* Default PAUSE processsing.      */   PAUSE IN WINDOW p_Window BEFORE-HIDE.
  
  /* Be certain to reset to default Progress Environment File. */
  USE "" NO-ERROR.
       
  /* In TTY, Use Message area for R-T errors. GUI: Use Alert-Boxes. */
  ASSIGN SESSION:SYSTEM-ALERT-BOXES = ( SESSION:WINDOW-SYSTEM <> "TTY" ) .
  
  /* Set DATA-ENTRY-RETURN to appropriate default for window system. */
  ASSIGN SESSION:DATA-ENTRY-RETURN  = ( SESSION:WINDOW-SYSTEM = "TTY" ) . 
  
  &IF ( "{&WINDOW-SYSTEM}" <> "TTY" ) &THEN
  /* Bring the default execution window (DEFAULT-WINDOW) topmost.  This
     does not mean its made visible.  It just means that if the user displays
     or gets input from it, by default the window will be brought to the
     top.  See bug 92-12-23-023. jep */
  ASSIGN Temp_Var = p_Window:MOVE-TO-TOP().
  &ENDIF

  &IF ( "{&WINDOW-SYSTEM}" <> "TTY" ) &THEN
  /* Set the ALT-TAB icon for the session. */
  SESSION:LOAD-ICON({&ADEICON-DIR} + "progress.ico":U) NO-ERROR.
  &ENDIF

END PROCEDURE.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME

&ENDIF

/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/
/*-----------------------------------------------------------------------------

  File: _rundwb.p

  Description: Runs Actuate Developer Workbench.

  Input Parameters:
      <none>

  Output Parameters:
      <none>

  Author: Gerry Seidl

  Modified on 
     05/04/99 by gfs - Created
     01/06/00 by gfs - Changed to create a .bat file defining PROGRESS env vars
 *---------------------------------------------------------------------------*/
DEFINE VARIABLE locdwb   AS CHARACTER NO-UNDO.
DEFINE VARIABLE DLCValue AS CHARACTER NO-UNDO.

GET-KEY-VALUE SECTION "Startup":U KEY "DLC":U VALUE DLCValue.
IF DLCValue = ? THEN DLCValue = OS-GETENV("DLC":U).

RUN adecomm/_locdwb.p(OUTPUT locdwb).
IF locdwb <> ? THEN DO:
    OUTPUT TO dwb.bat.
      PUT UNFORMATTED "@echo off":U SKIP.
      PUT UNFORMATTED "set DLC=":U + DLCValue SKIP.
      PUT UNFORMATTED "set PROMSGS=":U + DLCValue + "~\promsgs":U SKIP.
      PUT UNFORMATTED "set PROCFG=":U + DLCValue + "~\progress.cfg":U SKIP.
      PUT UNFORMATTED "path=":U + DLCValue + "~\bin;":U + DLCValue + ";%path%":U SKIP.
      PUT UNFORMATTED FILE-INFO:FULL-PATHNAME SKIP.
    OUTPUT CLOSE.

    /* Execute the batch file */
    OS-COMMAND NO-WAIT VALUE("dwb.bat":U).
END.
RETURN.
/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/
/* s-alert.p - alert box routine */

/*
Input text comes in 'pi_text' parameter, and may be any length.
This program splits it up into 45-character chunks, breaking at
spaces.  Embedded '^' marks get translated into line-feeds (like
in column-labels).

pi_type the the type of alert box to use.
  pi_type = "e*" -> error
  pi_type = "i*" -> information
  pi_type = "m*" -> message
  pi_type = "q*" -> question
  pi_type = "w*" -> warning

pi_butn is the type of button(s) to use.
pio_ans is the initial value and also the result.
  pi_butn = "YES-NO"        -> pio_ans = TRUE/FALSE
  pi_butn = "YES-NO-CANCEL" -> pio_ans = TRUE/FALSE/?
  pi_butn = "OK"            -> pio_ans = TRUE
  pi_butn = "OK-CANCEL"     -> pio_ans = TRUE/?
  pi_butn = "RETRY-CANCEL"  -> pio_ans = TRUE/?

End-error handling:
  If there is a "CANCEL" button, then the result will be as if the user
  pressed the "CANCEL" button.  If there is NO "CANCEL" button but
  there is a "NO" button, then the result will be as if the user
  pressed the "NO" button.  If there is only the "OK" button, then the
  result will be as if the user selected the "OK" button.
*/

/* Moved this code to _s-alert2.p for PDSAB integration. By- Rajinder Kamboj */
&Scoped-define IDE-IS-SUPPORTED         
{adecomm/oeideservice.i}  
{adecomm/_s-alert2.p}  /*********************************************************************
* Copyright (C) 2005 by Progress Software Corporation. All rights    *
* reserved.  Prior versions of this work may contain portions        *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/
/* _s-schem.p - extract schema information (see also a-schema.p) */

/*
Keep this program small.  Move any big and clumsy information
extractions into a-schema.p.

DICTDB used to be QBF$0 gjo.
*/

DEFINE QUERY qDb FOR DICTDB._db FIELDS(). 

DEFINE INPUT  PARAMETER cDbName AS CHARACTER NO-UNDO. /* ldbname */
DEFINE INPUT  PARAMETER cFieldName AS CHARACTER NO-UNDO. /* filename */
DEFINE INPUT  PARAMETER cField-IndexNmae AS CHARACTER NO-UNDO. /* fieldname/indexname */
DEFINE INPUT  PARAMETER cInfoType AS CHARACTER NO-UNDO. /* information type */
DEFINE OUTPUT PARAMETER cAnswer AS CHARACTER NO-UNDO. /* response */

DEFINE VARIABLE qbf-h AS DECIMAL NO-UNDO.
DEFINE VARIABLE qbf-j AS INTEGER NO-UNDO.
DEFINE VARIABLE qbf-k AS INTEGER NO-UNDO.
DEFINE VARIABLE qbf-l AS INTEGER NO-UNDO.

/* ldbname,filename,fieldname can come in cDbName+cFieldName+cField-IndexNmae, */
/* or as a combined entries in cDbName or cDbName+cFieldName */
ASSIGN
  cAnswer = cDbName
        + (IF cFieldName = "" THEN "" ELSE ".":u + cFieldName)
        + (IF cField-IndexNmae = "" THEN "" ELSE ".":u + cField-IndexNmae)
  cAnswer = SUBSTRING(cAnswer,1,INDEX(cAnswer + "[":u,"[":u) - 1,"CHARACTER":u)
          /*strip off subscript*/
  cDbName = SUBSTRING(cAnswer,1,INDEX(cAnswer + ".":u,".":u) - 1,"CHARACTER":u)
  cAnswer = SUBSTRING(cAnswer,INDEX(cAnswer,".":u) + 1,-1,"CHARACTER":u)
  cFieldName = SUBSTRING(cAnswer,1,INDEX(cAnswer + ".":u,".":u) - 1,
                         "CHARACTER":u)
  cField-IndexNmae = SUBSTRING(cAnswer,INDEX(cAnswer,".":u) + 1,-1,
                               "CHARACTER":u)
  cAnswer = ?.

IF LDBNAME(cDbName) = ? THEN RETURN.

/* if not pointing to correct db, fix situation and call self */
/* recursively.  this will also leave things set for the next */
/* time this guy is called. */
IF LDBNAME("DICTDB":u) <> SDBNAME(cDbName) THEN DO:
  CREATE ALIAS "DICTDB":u FOR DATABASE VALUE(SDBNAME(cDbName)).
  RUN "adecomm/_s-schem.p" (cDbName,cFieldName,cField-IndexNmae,cInfoType,OUTPUT cAnswer).
  RETURN.
END.

/* now point to correct _db record */
OPEN QUERY qDb FOR EACH DICTDB._Db
  WHERE DICTDB._Db._Db-name =
    (IF DBTYPE(cDbName) = "PROGRESS":u THEN ? ELSE LDBNAME(cDbName))
  NO-LOCK.

GET NEXT qDb.

/* do relevant index cursor positions */
IF CAN-DO("FILE:*,FIELD:*,INDEX:*":u,cInfoType) AND AVAILABLE DICTDB._Db THEN DO:
  IF INTEGER(DBVERSION("DICTDB":U)) > 8 THEN
    FIND DICTDB._File OF DICTDB._Db
      WHERE LOOKUP(DICTDB._FILE._OWNER,"PUB,_FOREIGN":U) > 0 AND
                   DICTDB._File._File-name = cFieldName NO-LOCK NO-ERROR.
  ELSE
    FIND DICTDB._File OF DICTDB._Db
      WHERE DICTDB._File._File-name = cFieldName NO-LOCK NO-ERROR.
END.
IF CAN-DO("FIELD:*":u,cInfoType) AND AVAILABLE DICTDB._File THEN
  FIND DICTDB._Field OF DICTDB._File
    WHERE DICTDB._Field._Field-name = cField-IndexNmae NO-LOCK NO-ERROR.
IF CAN-DO("INDEX:*":u,cInfoType) AND AVAILABLE DICTDB._File THEN
  FIND DICTDB._Index OF DICTDB._File
    WHERE DICTDB._Index._Index-name = cField-IndexNmae NO-LOCK.

/*--------------------------------------------------------------------------*/
IF cInfoType BEGINS "DB:":u THEN DO:
  CASE SUBSTRING(cInfoType,4,-1,"CHARACTER":u):
    WHEN "RECID":u THEN
      cAnswer = STRING(RECID(DICTDB._Db)).
    WHEN "CHECKSUM":u THEN DO:
      qbf-h = 0.
      FOR EACH DICTDB._File OF DICTDB._Db
        WHERE DICTDB._File._File-num > 0:
        IF INTEGER(DBVERSION("DICTDB":U)) > 8 THEN DO:
          IF LOOKUP(DICTDB._FILE._OWNER,"PUB,_FOREIGN":U) = 0 THEN NEXT.
        END.
        qbf-h = qbf-h + DICTDB._File._Last-change.
      END.
      cAnswer = STRING(qbf-h).
    END.
    WHEN "ANY-FIELD":u THEN
      cAnswer = STRING(
              CAN-FIND(DICTDB._Field
                WHERE DICTDB._Field._Field-name BEGINS cField-IndexNmae)
              ,"y/n":u)
            + STRING(
              CAN-FIND(FIRST DICTDB._Field
                WHERE DICTDB._Field._Field-name BEGINS cField-IndexNmae)
              ,"y/n":u).
  END CASE.
END.

ELSE
/*--------------------------------------------------------------------------*/

IF cInfoType BEGINS "FILE:":u THEN DO:
  cInfoType = SUBSTRING(cInfoType,6,-1,"CHARACTER":u).
  IF cInfoType = "RECID":u THEN
    cAnswer = STRING(RECID(DICTDB._File)).
  ELSE
  IF cInfoType BEGINS "MISC2:":u THEN
    cAnswer = DICTDB._File._Fil-misc2[INTEGER(SUBSTRING(cInfoType,7,-1,
                                                        "CHARACTER":u))].
  ELSE
  IF cInfoType = "DESC":u THEN
    cAnswer = (IF NOT AVAILABLE DICTDB._File THEN ?
               ELSE IF DICTDB._File._Desc = ? THEN ""
               ELSE DICTDB._File._Desc).
  ELSE
  IF cInfoType BEGINS "HAS-TYPE:":u THEN
    cAnswer = STRING(
            CAN-FIND(FIRST DICTDB._Field OF DICTDB._File
              WHERE DICTDB._Field._dtype = INTEGER(SUBSTRING(cInfoType,10,-1,
                                                             "CHARACTER":u))
                AND DICTDB._Field._Extent = 0)
            ,"y/n":u).
  ELSE
  IF cInfoType = "STAMP":u THEN cAnswer = STRING(DICTDB._File._Last-change).
  ELSE
  IF cInfoType = "CRC":u THEN cAnswer = STRING(DICTDB._File._Crc).
  ELSE
  IF cInfoType = "CAN-READ":u THEN
    cAnswer = (IF AVAILABLE DICTDB._File THEN 
                 DICTDB._File._Can-Read ELSE "!*":u).
  ELSE
  IF cInfoType = "CAN-WRITE":u THEN
    cAnswer = (IF AVAILABLE DICTDB._File THEN 
                 DICTDB._File._Can-Write ELSE "!*":u).
  ELSE
  IF cInfoType = "CAN-CREATE":u THEN
    cAnswer = (IF AVAILABLE DICTDB._File 
                 THEN DICTDB._File._Can-Create ELSE "!*":u).
  ELSE
  IF cInfoType = "CAN-DELETE":u THEN
    cAnswer = (IF AVAILABLE DICTDB._File THEN 
                 DICTDB._File._Can-Delete ELSE "!*":u).
  ELSE
  IF cInfoType = "VALEXP":u THEN
    cAnswer = (IF AVAILABLE DICTDB._File THEN 
                 DICTDB._File._ValExp ELSE ?).

END.

ELSE
/*--------------------------------------------------------------------------*/

IF cInfoType BEGINS "FIELD:":u THEN DO:
  CASE SUBSTRING(cInfoType,7,-1,"CHARACTER":u):
    WHEN "RECID":u THEN
      cAnswer = STRING(RECID(DICTDB._Field)).
    WHEN "TYP&FMT":u THEN
      cAnswer = (IF AVAILABLE DICTDB._Field THEN
                STRING(DICTDB._Field._dtype) + ",":u + DICTDB._Field._Format
              ELSE
                "0,":u).
    WHEN "CAN-READ":u THEN
      cAnswer = (IF AVAILABLE DICTDB._Field THEN
                DICTDB._Field._Can-Read
              ELSE
                "!*":u).
    WHEN "EXTENT":u THEN
      cAnswer = STRING(DICTDB._Field._Extent).
    WHEN "COL-LABEL":U THEN
      cAnswer = DICTDB._Field._Col-label.
    WHEN "LABEL":u THEN
      cAnswer = (IF DICTDB._Field._Col-label <> ? THEN
                DICTDB._Field._Col-label
              ELSE IF DICTDB._Field._Label <> ? THEN
                DICTDB._Field._Label
              ELSE
                DICTDB._Field._Field-name).
    WHEN "INDEX-FIELD":u THEN
      cAnswer = STRING(
              CAN-FIND(FIRST DICTDB._Index-field OF DICTDB._Field)
              ,"y/n":u).
    WHEN "INITIAL" THEN
      cAnswer = DICTDB._Field._INITIAL.
    WHEN "QBW-FIELD":u THEN DO:
      cAnswer = STRING(DICTDB._Field._dtype)  + ",":u  
            + STRING(DICTDB._Field._Extent) + ",n":u.
      FOR EACH DICTDB._Index-field OF DICTDB._Field NO-LOCK,
        FIRST DICTDB._Index OF DICTDB._Index-field WHERE
    	  CAN-FIND (DICTDB._Field WHERE DICTDB._Field._Field-name = "_Wordidx")
          AND DICTDB._Index._Wordidx > 0 NO-LOCK:
        ENTRY(3,cAnswer) = "y":u.
        LEAVE.
      END.  /* For EACH DICTDB._Index-field */
    END.  /* WHEN QBW-FIELD */
    WHEN "VIEW-AS" THEN
      cAnswer = DICTDB._Field._VIEW-AS.
  END CASE.
END.

ELSE
/*--------------------------------------------------------------------------*/

IF cInfoType BEGINS "INDEX:":u THEN DO:
  cInfoType = SUBSTRING(cInfoType,7,-1,"CHARACTER":u).
  IF cInfoType = "RECID":u THEN cAnswer = STRING(RECID(DICTDB._Index)).
END.

/*--------------------------------------------------------------------------*/
RETURN.

/* _s-schem.p - end of file */



/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/*----------------------------------------------------------------------------

File: _scroll.p

Description:
   Scroll the specified selection list so that the item with the given value 
   will be in view.

Input Parameters:
   p_List  - The widget handle of the selection list.
   p_Val   - The value of the item we want to scroll into view.

Author: Laura Stern

Date Created: 07/10/92 

----------------------------------------------------------------------------*/

/* Modifications

   02.26.93 jep
            Added bug 93-02-26-039 code workaround.  When bug is fixed,
            this code can be removed.
*/

Define INPUT PARAMETER p_List as widget-handle 	NO-UNDO.
Define INPUT PARAMETER p_Val  as char  	     	NO-UNDO.

Define var pos 	    as integer NO-UNDO.
Define var top_item as integer NO-UNDO.
Define var val      as char    NO-UNDO.
Define var err 	    as logical NO-UNDO.
Define var num_rows as integer NO-UNDO.


/* Determine which entry to position at the top so that p_Val is visible. */

pos      = p_List:Lookup(p_Val).
num_rows = p_List:inner-lines.

/* Bug 93-02-26-039 requires this workaround for TTY. */
IF ( num_rows = ? ) THEN num_rows = p_List:HEIGHT-CHARS.

if ( pos < num_rows ) then
   top_item = 1.
else
   top_item = pos - num_rows + 1.

/* Scroll that item to the top. */
val = p_List:entry(top_item).
err = p_List:scroll-to-item(val).



/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/
/*-----------------------------------------------------------------------------

  File: _selindx.p

  Description: 
      Ask the user for the index of a array.

  Input Parameters:
      pi_array   -  the name of the array.
      pi_extent  -  the extent of the array.

  Output Parameters:
      p_index - the selected index (? if nothing chosen or user cancels)
  
  Author: Wm. T. Wood

  Created: 4/28/93
-----------------------------------------------------------------------------*/
/*             This .W file was created with the Progress UIB.               */
/*---------------------------------------------------------------------------*/
&GLOBAL-DEFINE WIN95-BTN YES
{adecomm/adestds.i}
{adecomm/commeng.i}   /* Help pre-processor directives                       */

/* Define Parameters. */
DEFINE INPUT  PARAMETER  pi_array     AS CHAR            NO-UNDO.
DEFINE INPUT  PARAMETER  pi_extent    AS INTEGER         NO-UNDO.
DEFINE OUTPUT PARAMETER  p_index      AS INTEGER         NO-UNDO.

/* _UIB-CODE-BLOCK-END */

/* Definitions of the field level widgets                               */
DEFINE VARIABLE choice AS INTEGER NO-UNDO {&STDPH_FILL}
   FORMAT ">,>>9" LABEL "Choose Index".

DEFINE VARIABLE comment AS CHAR FORMAT "X(45)" NO-UNDO.
&IF {&OKBOX} &THEN
DEFINE RECTANGLE RECT-1 {&STDPH_OKBOX}.
&ENDIF
 
DEFINE BUTTON b_ok AUTO-GO LABEL "OK" {&STDPH_OKBTN}.

DEFINE BUTTON b_cancel AUTO-ENDKEY LABEL "Cancel"  {&STDPH_OKBTN}.

DEFINE BUTTON b_help  LABEL "&Help" {&STDPH_OKBTN}.

/* Definitions of the frame widgets                                     */
DEFINE FRAME f_index
     SKIP ({&TFM_WID}) SPACE({&HFM_WID})
     comment NO-LABEL VIEW-AS TEXT
     choice  COLON 25
     { adecomm/okform.i 
       &BOX    = RECT-1
       &OK     = b_ok
       &CANCEL = b_cancel
       &HELP   = b_help }
    WITH VIEW-AS DIALOG-BOX  SIDE-LABELS TITLE "Choose Index"
         DEFAULT-BUTTON b_ok.

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _MAIN-BLOCK f_index 

/* Standard run-time layout */
{ adecomm/okrun.i 
       &FRAME  = "FRAME f_index"
       &BOX    = RECT-1
       &OK     = b_ok
       &CANCEL = b_cancel
       &HELP   = b_help }

/* Standard UIB stuff for dialog boxes - including WINDOW-CLOSE = END-ERROR  */

&Global-define SKP ""

PAUSE 0 BEFORE-HIDE.

/* WINDOW-CLOSE event will issue END-ERROR to the frame      */
ON WINDOW-CLOSE OF FRAME f_index APPLY "END-ERROR":U TO SELF.

/* ----------------------------------------------------------- */
/*                        TRIGGERS                             */
/* ----------------------------------------------------------- */

/* Standard Help Trigger */
ON CHOOSE OF b_help IN FRAME f_index OR HELP OF FRAME f_index
   RUN adecomm/_adehelp.p ( "comm", "CONTEXT", {&Choose_Index_Dlg_Box}, ? ).

/* Exit gracefully - Note that b_ok is AUTO-GO */
ON GO OF FRAME f_index DO:
  ASSIGN choice.
  IF choice < 1 or choice > pi_extent THEN DO:
    MESSAGE "The array index must be between 1 and" 
            TRIM(STRING(pi_extent,">>>,>>9."))
          VIEW-AS ALERT-BOX ERROR BUTTONS OK.
    RETURN  NO-APPLY.
  END.
  ELSE p_index = choice. 
END.
   
/* ----------------------------------------------------------- */
/* Main Code Block - Enable Widgets, Exit condition, Clean-up  */
/* ----------------------------------------------------------- */
ASSIGN choice  = 1
       comment = pi_array + " is an array with extent " +
                 TRIM(STRING(pi_extent,">>>,>>9.")).
DISPLAY comment VIEW-AS TEXT
        choice
   WITH FRAME f_index.

UPDATE choice b_ok b_cancel b_help WITH FRAME f_index.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME

/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/*--------------------------------------------------------------------

File: prodict/misc/_setalia.p

Description:
    
    Sets DICTDB alias to Database number p_db-num
            
Input-Parameters:
    p_db-num    number of db to set alias to

Output-Parameters:
    none
    
Used/Modified Shared Objects:
    none
    
Author: Tom Hutegger

History:
    hutegger    94/04/12    creation

                            
--------------------------------------------------------------------*/
/*h-*/

/*----------------------------  DEFINES  ---------------------------*/

define input parameter p_db-num     as integer.

/*------------------------  INT.-PROCEDURES  -----------------------*/

/*---------------------------  MAIN-CODE  --------------------------*/

if LDBNAME(p_db-num) <> ?
 then create alias DICTDB for database value(LDBNAME(p_db-num)).

/*------------------------------------------------------------------*/
/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/*----------------------------------------------------------------------------

File: _setcurs.p

Description:
   Sets the cursor on all windows and on any dialog box frames that are
   currently on the screen.
    
Input Parameters:
   p_cursor - name of cursor to use.  This should be either
      	      "WAIT" or "".

Output Parameters:
   <none>

Author: Wm.T.Wood, Laura Stern

Date Created: May 14, 1993

Modified:

----------------------------------------------------------------------------*/

DEFINE INPUT PARAMETER p_cursor  AS CHAR    	   NO-UNDO.

DEFINE VAR ldummy AS LOGICAL NO-UNDO.

&IF "{&WINDOW-SYSTEM}" ne "TTY" &THEN
   &IF "{&WINDOW-SYSTEM}" BEGINS "MS-WIN" &THEN
      /* Set the Wait state, which changes the cursor automatically */
      ldummy = SESSION:SET-WAIT-STATE(IF p_cursor = "WAIT" THEN "GENERAL" 
      	       	     	      	       	     	      	   ELSE "").
   &ELSE /* Motif */
      /* Cycle through all current Progress windows */
      RUN set_window_cursors (SESSION).
      
      /* set_window_cursors: Recursively cycle though all childen of the
         input widget setting the cursors or windows and dialog-boxes.  
         If any child is another window, then recursively call. */
      PROCEDURE set_window_cursors:
        DEF INPUT PARAMETER hParent AS WIDGET NO-UNDO.
        
        DEF VAR hChild AS WIDGET NO-UNDO.
        
        hChild = hParent:FIRST-CHILD.
        DO WHILE hChild NE ?:
	  /* Load the pointer on WINDOWS and DIALOG-BOXES. */
          CASE hChild:TYPE:
            WHEN "DIALOG-BOX" THEN 
	      ASSIGN ldummy = hChild:LOAD-MOUSE-POINTER(p_cursor).
      	    WHEN "WINDOW" THEN DO:
	      ASSIGN ldummy = hChild:LOAD-MOUSE-POINTER(p_cursor).
      	      RUN set_window_cursors (INPUT hChild).
      	    END.
      	  END CASE.
	 
          /* Move to next child. */
	  hChild = hChild:NEXT-SIBLING.
	END.
      END PROCEDURE.
   &ENDIF
&ENDIF

&ANALYZE-SUSPEND _VERSION-NUMBER UIB_v8r12 GUI
/* Procedure Description
"SmartObject/Template CueCard Driver"
*/
&ANALYZE-RESUME
&Scoped-define WINDOW-NAME w_smbr-cue
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _DEFINITIONS w_smbr-cue 
/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/
/*------------------------------------------------------------------------

  File: _so-cue.w

  Description: Cue Card for SmartObjects - intended to be invoked via 
               INLINE XFTR.

               The XFTR which calls this program for cue-card support should
               code the XFTR as follows: 
               (See ADM templates viewer.w, browser.w & query.w for real
                examples of the XFTR).
            
The structure of the code block is as follows:
...
/* Actions: <realize> ? <destroy> ? <write> */
/* <subjectname/title for cuecard window>,helpfile,context#
Text to display in the cue card editor...
...
...
*/  

where     
  helpfile is a string which defines the help file to use with
           a call to SYSTEM-HELP. If "ab" is specified, special
           handling occurs through adecomm/_adehelp.p

  context  is a number which identifies the specific help context
           to call within the 'helpfile'. If missing, or '?', then
           'CONTENTS' will be assumed.
               
  Input Parameters:
      trg-recid (INT)  - RECID of _TRG record cast to an INT
      trg-code  (CHAR) - code block of the _TRG

  Output Parameters:
      <none>

  Author: Gerry Seidl

  Created: 3/14/95

------------------------------------------------------------------------*/
/*          This .W file was created with the Progress UIB.             */
/*----------------------------------------------------------------------*/

/* Create an unnamed pool to store all the widgets created 
     by this procedure. This is a good default which assures
     that this procedure's triggers and internal procedures 
     will execute in this procedure's storage, and that proper
     cleanup will occur on deletion of the procedure. */

CREATE WIDGET-POOL.

/* ***************************  Definitions  ************************** */

{ adecomm/adefext.i }   /* Defines Preprocessor variables   */
{ adecomm/_adetool.i}
{adecomm/oeideservice.i} 
/* Parameters Definitions ---                                           */
/* trg-code contains a string in the form of:
   type of object/title for window, text file for cue text */
DEFINE INPUT        PARAMETER trg-recid AS INTEGER   NO-UNDO.
DEFINE INPUT-OUTPUT PARAMETER trg-code  AS CHARACTER NO-UNDO. 

DEFINE VARIABLE  firstline    AS CHARACTER NO-UNDO.
DEFINE VARIABLE  subject      AS CHARACTER NO-UNDO.
DEFINE VARIABLE  h            AS HANDLE    NO-UNDO.
DEFINE VARIABLE  tcode        AS CHARACTER NO-UNDO.
DEFINE VARIABLE  sctn         AS CHARACTER NO-UNDO INITIAL "ProUIB".
DEFINE VARIABLE  dlist        AS CHARACTER NO-UNDO.
DEFINE VARIABLE  hlpcontext   AS INTEGER   NO-UNDO INITIAL ?.
DEFINE VARIABLE  hlpfile      AS CHARACTER NO-UNDO INITIAL ?.
DEFINE VARIABLE  cResult      AS CHARACTER NO-UNDO INITIAL NO.
DEFINE VARIABLE  hUIB         AS HANDLE    NO-UNDO.
DEFINE VARIABLE  user-ret-val AS CHARACTER NO-UNDO.

/* If we are opening a Template file, then DON'T RUN THE CUECARD.  Use the
   standard UIB call to see if the current code record is in a Template file. */
RUN adeuib/_uibinfo.p (trg-recid, ?, "TEMPLATE", OUTPUT cResult).
IF cResult eq STRING(yes) THEN RETURN.
 
/* This procedure must run PERSISTENT.  If it was called any other way then
   do it correctly. */     
  
IF NOT THIS-PROCEDURE:PERSISTENT THEN DO:
  RUN adecomm/_so-cue.w PERSISTENT (INPUT trg-recid, INPUT-OUTPUT trg-code).
  RETURN.
END.
ELSE DO:
  ASSIGN   
     h         = SESSION:FIRST-PROCEDURE
     tcode     = TRIM(trg-code)
     firstline = ENTRY(1,tcode,CHR(10))
     subject   = TRIM(SUBSTRING(firstline,3,
                   LENGTH(firstline,"CHARACTER":u) - 2,"CHARACTER")).

  /* Let's see if there is help stuff to process */
  IF NUM-ENTRIES(subject) > 1 THEN DO:
    ASSIGN hlpfile = ENTRY(2,subject).
    IF NUM-ENTRIES(subject) > 2 THEN
      ASSIGN hlpcontext = INT(ENTRY(3,subject)).
    ASSIGN subject = ENTRY(1,subject).
  END.

  /* If meant to be destroyed then delete the _XFTR and _TRG */
  IF TRIM(ENTRY(2, tcode,CHR(10))) = "Destroy on next read */" THEN DO:
    RUN adeuib/_accsect.p ("DELETE",?,?,INPUT-OUTPUT trg-recid,INPUT-OUTPUT trg-code).
    DELETE PROCEDURE THIS-PROCEDURE.
    RETURN.
  END.
  /* Check to see if a cue is already running for this object. If so, delete this one */
  DO WHILE VALID-HANDLE(h):
    IF ENTRY(1, h:PRIVATE-DATA) = "CUE-CARD"      AND
       ENTRY(2, h:PRIVATE-DATA) = subject         AND
                              h NE THIS-PROCEDURE THEN 
    DO:
      /* There is already one running! Kill this one. */
      APPLY "CLOSE" TO THIS-PROCEDURE.
      RETURN.
    END.
    ASSIGN h = h:NEXT-SIBLING. /* next procedure */
  END.
END.

if not OEIDEisRunning then
do:
/* If cue cards are OFF or this one is in the exception list, kill it! */
    GET-KEY-VALUE SECTION sctn KEY "Disabled_Cue_Cards" VALUE dlist.
    RUN adeuib/_uibinfo.p (?, "SESSION", "USE_CUECARDS", OUTPUT user-ret-val).
    IF user-ret-val = "FALSE" OR CAN-DO (dlist, subject) THEN DO:
       DELETE PROCEDURE THIS-PROCEDURE.
       RETURN.
    END.
    IF dlist = ? THEN dlist = "".
end.    

/* Local Variable Definitions ---                                       */
DEFINE VARIABLE l         AS LOGICAL NO-UNDO.
DEFINE VARIABLE i         AS WIDGET  NO-UNDO.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME


&ANALYZE-SUSPEND _UIB-PREPROCESSOR-BLOCK 

/* ********************  Preprocessor Definitions  ******************** */

&Scoped-define PROCEDURE-TYPE WINDOW
&Scoped-define DB-AWARE no

/* Name of first Frame and/or Browse and/or first Query                 */
&Scoped-define FRAME-NAME f_cuecard

/* Standard List Definitions                                            */
&Scoped-Define ENABLED-OBJECTS b_close b_Help e_cue-text t_show 
&Scoped-Define DISPLAYED-OBJECTS e_cue-text t_show 

/* Custom List Definitions                                              */
/* List-1,List-2,List-3,List-4,List-5,List-6                            */

/* _UIB-PREPROCESSOR-BLOCK-END */
&ANALYZE-RESUME



/* ***********************  Control Definitions  ********************** */

/* Define the widget handle for the window                              */
DEFINE VAR w_smbr-cue AS WIDGET-HANDLE NO-UNDO.

/* Definitions of the field level widgets                               */
DEFINE BUTTON b_close 
     LABEL "&Close" 
     SIZE 6.8 BY 1
     FONT 4.

DEFINE BUTTON b_Help 
     LABEL "&Help" 
     SIZE 6.8 BY 1
     FONT 4.

DEFINE VARIABLE e_cue-text AS CHARACTER 
     VIEW-AS EDITOR SCROLLBAR-VERTICAL
     SIZE 46.6 BY 7.14
     FONT 4 NO-UNDO.

DEFINE VARIABLE t_show AS LOGICAL INITIAL no 
     LABEL "&Don't show me this again." 
     VIEW-AS TOGGLE-BOX
     SIZE 29.6 BY .95
     FONT 4 NO-UNDO.


/* ************************  Frame Definitions  *********************** */

DEFINE FRAME f_cuecard
     b_close AT ROW 1.24 COL 34
     b_Help AT ROW 1.24 COL 41.6
     e_cue-text AT ROW 2.52 COL 1.6 NO-LABEL
     t_show AT ROW 9.67 COL 2.6
    WITH 1 DOWN NO-BOX KEEP-TAB-ORDER OVERLAY 
         SIDE-LABELS NO-UNDERLINE THREE-D 
         AT COL 1 ROW 1
         SIZE 48 BY 9.84.


/* *********************** Procedure Settings ************************ */

&ANALYZE-SUSPEND _PROCEDURE-SETTINGS
/* Settings for THIS-PROCEDURE
   Type: WINDOW
   Allow: Basic,DB-Fields,Browse,Window
 */
&ANALYZE-RESUME _END-PROCEDURE-SETTINGS

/* *************************  Create Window  ************************** */

&ANALYZE-SUSPEND _CREATE-WINDOW
IF SESSION:DISPLAY-TYPE = "GUI":U THEN
  CREATE WINDOW w_smbr-cue ASSIGN
         HIDDEN             = YES
         TITLE              = "Cue Card"
         HEIGHT             = 9.86
         WIDTH              = 48
         MAX-HEIGHT         = 9.86
         MAX-WIDTH          = 48
         VIRTUAL-HEIGHT     = 9.86
         VIRTUAL-WIDTH      = 48
         SHOW-IN-TASKBAR    = no
         MIN-BUTTON         = no
         MAX-BUTTON         = no
         RESIZE             = no
         SCROLL-BARS        = no
         STATUS-AREA        = no
         BGCOLOR            = ?
         FGCOLOR            = ?
         KEEP-FRAME-Z-ORDER = yes
         THREE-D            = yes
         FONT               = 4
         MESSAGE-AREA       = no
         SENSITIVE          = yes.
ELSE {&WINDOW-NAME} = CURRENT-WINDOW.

&IF '{&WINDOW-SYSTEM}' NE 'TTY' &THEN
IF NOT w_smbr-cue:LOAD-ICON("adeicon/cue":U) THEN
    MESSAGE "Unable to load icon: adeicon/cue"
            VIEW-AS ALERT-BOX WARNING BUTTONS OK.
&ENDIF
/* END WINDOW DEFINITION                                                */
&ANALYZE-RESUME



/* ***********  Runtime Attributes and AppBuilder Settings  *********** */

&ANALYZE-SUSPEND _RUN-TIME-ATTRIBUTES
/* SETTINGS FOR WINDOW w_smbr-cue
  NOT-VISIBLE,,RUN-PERSISTENT                                           */
/* SETTINGS FOR FRAME f_cuecard
                                                                        */
ASSIGN 
       e_cue-text:READ-ONLY IN FRAME f_cuecard        = TRUE.

IF SESSION:DISPLAY-TYPE = "GUI":U AND VALID-HANDLE(w_smbr-cue)
THEN w_smbr-cue:HIDDEN = yes.

/* _RUN-TIME-ATTRIBUTES-END */
&ANALYZE-RESUME

 



/* ************************  Control Triggers  ************************ */

&Scoped-define SELF-NAME w_smbr-cue
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL w_smbr-cue w_smbr-cue
ON WINDOW-CLOSE OF w_smbr-cue /* Cue Card */
DO:
  ASSIGN {&WINDOW-NAME}:HIDDEN = yes.
END.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME


&Scoped-define SELF-NAME b_close
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL b_close w_smbr-cue
ON CHOOSE OF b_close IN FRAME f_cuecard /* Close */
DO:
  ASSIGN {&WINDOW-NAME}:HIDDEN = yes.
END.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME


&Scoped-define SELF-NAME b_Help
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL b_Help w_smbr-cue
ON CHOOSE OF b_Help IN FRAME f_cuecard /* Help */
OR HELP OF {&WINDOW-NAME}
DO:
  IF hlpfile = "AB" OR hlpfile = "UIB" THEN
    RUN adecomm/_adehelp.p ("AB", "CONTEXT", hlpcontext, ?).
  ELSE DO:
    IF hlpfile NE "" AND hlpfile NE ? THEN
      IF hlpcontext NE ? THEN
        SYSTEM-HELP hlpfile CONTEXT hlpcontext.
      ELSE
        SYSTEM-HELP hlpfile CONTENTS.
    ELSE  MESSAGE "Use the cue cards to get more information about a process or object.  Press Close to dismiss the card."
    VIEW-AS ALERT-BOX INFORMATION BUTTONS OK.
  END.
END.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME


&Scoped-define SELF-NAME t_show
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL t_show w_smbr-cue
ON VALUE-CHANGED OF t_show IN FRAME f_cuecard /* Don't show me this again. */
DO:
  DEFINE VARIABLE tlist AS CHARACTER NO-UNDO.
  
  ASSIGN dlist = dlist + (IF dlist NE "" THEN "," + subject ELSE subject).
  PUT-KEY-VALUE SECTION sctn KEY "Disabled_Cue_Cards" VALUE dlist NO-ERROR.
  GET-KEY-VALUE SECTION sctn KEY "Disabled_Cue_Cards" VALUE tlist.
  IF dlist NE tlist THEN 
    RUN adeshar/_puterr.p (INPUT "Cue Card", INPUT {&WINDOW-NAME}:HANDLE).
  RUN adeuib/_uibinfo.p (?, "SESSION", 
                         "_user_hints=?", OUTPUT user-ret-val).
  APPLY "CLOSE" TO THIS-PROCEDURE.
END.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME


&UNDEFINE SELF-NAME

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _MAIN-BLOCK w_smbr-cue 


/* ***************************  Main Block  *************************** */

/* Find UIB's main window so we can parent the cue card window to it */
ASSIGN h = SESSION:FIRST-CHILD.
DO WHILE VALID-HANDLE(h):
  IF h:TYPE = "WINDOW" THEN IF h:TITLE = "{&UIB_NAME}" THEN
    hUIB = h.
  ASSIGN h = h:NEXT-SIBLING.
END.

/* Set CURRENT-WINDOW: this will parent dialog-boxes and frames.        */
ASSIGN THIS-PROCEDURE:CURRENT-WINDOW = {&WINDOW-NAME}
       {&WINDOW-NAME}:PARENT         = (IF VALID-HANDLE(hUIB) THEN hUIB ELSE ?).

/* The CLOSE event can be used from inside or outside the procedure to  */
/* terminate it.                                                        */
ON CLOSE OF THIS-PROCEDURE 
   RUN disable_UI.

/* These events will close the window and terminate the procedure.      */
/* (NOTE: this will override any user-defined triggers previously       */
/*  defined on the window.)                                             
ON WINDOW-CLOSE OF {&WINDOW-NAME} DO:
  APPLY "CLOSE":U TO THIS-PROCEDURE.
  RETURN NO-APPLY.
END.*/

ON ENDKEY, END-ERROR OF {&WINDOW-NAME} ANYWHERE DO:
  APPLY "CLOSE":U TO THIS-PROCEDURE.
  RETURN NO-APPLY.
END.

/* Best default for GUI applications is...                              */
PAUSE 0 BEFORE-HIDE.

/* Now enable the interface and wait for the exit condition.            */
/* (NOTE: handle ERROR and END-KEY so cleanup code will always fire.    */
MAIN-BLOCK:
DO ON ERROR   UNDO MAIN-BLOCK, LEAVE MAIN-BLOCK
   ON END-KEY UNDO MAIN-BLOCK, LEAVE MAIN-BLOCK:
   Assign e_cue-text                  = 
          TRIM(SUBSTRING(tcode,LENGTH(firstline,"CHARACTER":u) + 1,-1,"CHARACTER"))
          ENTRY(NUM-ENTRIES(e_cue-text,CHR(10)), e_cue-text, CHR(10) ) = "".    
   if OEIDEisRunning then
   do:
      ShowCueCard(subject + " Cue Card",e_cue-text).
      IF THIS-PROCEDURE:PERSISTENT THEN DELETE PROCEDURE THIS-PROCEDURE.
      return.
   end.   
   else
   do:   
     ASSIGN
       {&WINDOW-NAME}:TITLE        = subject + " Cue Card"
       THIS-PROCEDURE:PRIVATE-DATA = "CUE-CARD," + subject.
      RUN enable_UI.
      RUN create_image.
      RUN pos-win.
      IF NOT THIS-PROCEDURE:PERSISTENT THEN
        WAIT-FOR "WINDOW-CLOSE" OF {&WINDOW-NAME}.
    end.    
END.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME


/* **********************  Internal Procedures  *********************** */

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE create_image w_smbr-cue 
PROCEDURE create_image :
/* -----------------------------------------------------------
  Purpose:     Create cue card image.
  Parameters:  <none>
  Notes:       
-------------------------------------------------------------*/
DO WITH FRAME f_cuecard:  
  CREATE IMAGE i
   ASSIGN X                 = 4
          Y                 = 1
          FRAME             = FRAME f_cuecard:HANDLE
          width-pixels      = 157
          height-pixels     = 36
          HIDDEN            = NO
          CONVERT-3D-COLORS = YES.

  l = i:LOAD-IMAGE("adeicon/cuecard").
END.  
END PROCEDURE.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE disable_UI w_smbr-cue _DEFAULT-DISABLE
PROCEDURE disable_UI :
/*------------------------------------------------------------------------------
  Purpose:     DISABLE the User Interface
  Parameters:  <none>
  Notes:       Here we clean-up the user-interface by deleting
               dynamic widgets we have created and/or hide 
               frames.  This procedure is usually called when
               we are ready to "clean-up" after running.
------------------------------------------------------------------------------*/
  /* Delete the WINDOW we created */
  IF SESSION:DISPLAY-TYPE = "GUI":U AND VALID-HANDLE(w_smbr-cue)
  THEN DELETE WIDGET w_smbr-cue.
  IF THIS-PROCEDURE:PERSISTENT THEN DELETE PROCEDURE THIS-PROCEDURE.
END PROCEDURE.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE enable_UI w_smbr-cue _DEFAULT-ENABLE
PROCEDURE enable_UI :
/*------------------------------------------------------------------------------
  Purpose:     ENABLE the User Interface
  Parameters:  <none>
  Notes:       Here we display/view/enable the widgets in the
               user-interface.  In addition, OPEN all queries
               associated with each FRAME and BROWSE.
               These statements here are based on the "Other 
               Settings" section of the widget Property Sheets.
------------------------------------------------------------------------------*/
  DISPLAY e_cue-text t_show 
      WITH FRAME f_cuecard IN WINDOW w_smbr-cue.
  ENABLE b_close b_Help e_cue-text t_show 
      WITH FRAME f_cuecard IN WINDOW w_smbr-cue.
  {&OPEN-BROWSERS-IN-QUERY-f_cuecard}
END PROCEDURE.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE pos-win w_smbr-cue 
PROCEDURE pos-win :
/* -----------------------------------------------------------
  Purpose:     Position the window in the lower right corner.
  Parameters:  <none>
  Notes:       
-------------------------------------------------------------*/
  DEFINE VARIABLE h     AS HANDLE        NO-UNDO.
  DEFINE VARIABLE w     AS WIDGET-HANDLE NO-UNDO.
  DEFINE VARIABLE wlist AS CHARACTER     NO-UNDO.
  DEFINE VARIABLE cueX  AS INTEGER       NO-UNDO.
  DEFINE VARIABLE cueY  AS INTEGER       NO-UNDO.
  DEFINE VARIABLE i     AS INTEGER       NO-UNDO.
  /* special adjustment for Win95 TaskBar */
  DEFINE VARIABLE TBOrientation AS CHARACTER NO-UNDO.
  DEFINE VARIABLE TBHeight      AS INTEGER   NO-UNDO.
  DEFINE VARIABLE TBWidth       AS INTEGER   NO-UNDO.
  DEFINE VARIABLE AutoHide      AS LOGICAL   NO-UNDO.

  RUN adeshar/_taskbar.p (OUTPUT TBOrientation, OUTPUT TBHeight,
                          OUTPUT TBWIdth,       OUTPUT AutoHide).
  
  ASSIGN cueX = SESSION:WIDTH-P -  {&WINDOW-NAME}:WIDTH-P - 2 * SESSION:PIXELS-PER-COLUMN
         cueY = SESSION:HEIGHT-P - {&WINDOW-NAME}:HEIGHT-P - 1.5 * SESSION:PIXELS-PER-ROW
         .
  /* Adjust for taskbar */
  IF NOT AutoHide THEN DO:
    IF TBOrientation = "BOTTOM" THEN cueY = cueY - TBHeight.
    IF TBOrientation = "RIGHT"  THEN cueX = cueX - TBWidth.
  END.
  
  /* Find all existing cue windows besides this one */
  h = SESSION:FIRST-PROCEDURE.
  DO WHILE VALID-HANDLE(h):
    IF ENTRY(1, h:PRIVATE-DATA) = "CUE-CARD"      AND
                              h NE THIS-PROCEDURE THEN 
    DO:
      w = h:CURRENT-WINDOW.
      /* If the user moved the window, we will leave it alone */
      IF (INT(ENTRY(1,w:PRIVATE-DATA)) < w:X + 50  AND
          INT(ENTRY(1,w:PRIVATE-DATA)) > w:X - 50) AND
         (INT(ENTRY(2,w:PRIVATE-DATA)) < w:Y + 50  AND
          INT(ENTRY(2,w:PRIVATE-DATA)) > w:Y - 50) THEN
      DO: /* user didn't move it */
        wlist = wlist + 
                (IF wlist = "" THEN STRING(w:HANDLE) ELSE "," + STRING(w:HANDLE)).
      END.
    END.
    ASSIGN h = h:NEXT-SIBLING. /* next procedure */
  END.
  /* Reposition existing cue windows */
  IF NUM-ENTRIES(wlist) > 0 THEN
  DO i = NUM-ENTRIES(wlist) TO 1 BY -1:
    w = WIDGET-HANDLE(ENTRY(i,wlist)).
    IF VALID-HANDLE(w) THEN
      ASSIGN w:X = cueX - ( i * SESSION:PIXELS-PER-COLUMN)
             w:Y = cueY - ( i * SESSION:PIXELS-PER-ROW)
             w:PRIVATE-DATA = STRING(w:X) + "," + STRING(w:Y)
             l = w:MOVE-TO-TOP().
  END.
  ASSIGN
    {&WINDOW-NAME}:X            = cueX
    {&WINDOW-NAME}:Y            = cueY
    {&WINDOW-NAME}:HIDDEN       = NO
    {&WINDOW-NAME}:PRIVATE-DATA = STRING({&WINDOW-NAME}:X) + "," + STRING({&WINDOW-NAME}:Y)
    l = {&WINDOW-NAME}:MOVE-TO-TOP().
END PROCEDURE.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME

/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/**************************************************************************
    Procedure:  _so-cued.p


    Purpose:    Dismiss cue card window upon .W close (XFTR)
                (See adecomm/_so-cue.w for XFTR definition)
                
    Parameters: trg-recid (INT) - RECID(_TRG)
                trg-Code (CHAR) - code block

    Description:
    Notes  :
    Authors: Gerry Seidl
    Date   : 3/15/95
**************************************************************************/

DEFINE INPUT        PARAMETER trg-recid AS INTEGER   NO-UNDO.
DEFINE INPUT-OUTPUT PARAMETER trg-code  AS CHARACTER NO-UNDO.

DEFINE VARIABLE h                       AS WIDGET    NO-UNDO.
DEFINE VARIABLE hnext                   AS WIDGET    NO-UNDO.
DEFINE VARIABLE c                       AS INTEGER   NO-UNDO.
DEFINE VARIABLE cnt                     AS INTEGER   NO-UNDO.
DEFINE VARIABLE firstline               AS CHARACTER NO-UNDO.
DEFINE VARIABLE i                       AS INTEGER   NO-UNDO.
DEFINE VARIABLE subject                 AS CHARACTER NO-UNDO.
DEFINE VARIABLE tcode                   AS CHARACTER NO-UNDO.
DEFINE VARIABLE cProcList               AS CHARACTER NO-UNDO.
DEFINE VARIABLE cProcType               AS CHARACTER NO-UNDO.

ASSIGN   
   h         = SESSION:FIRST-PROCEDURE
   tcode     = TRIM(trg-code)
   firstline = ENTRY(1,tcode,CHR(10))
   subject   = TRIM(SUBSTRING(firstline,3,
                 LENGTH(firstline,"CHARACTER":u) - 2,"CHARACTER")).

IF NUM-ENTRIES(subject) > 1 THEN ASSIGN subject = ENTRY(1,subject).

/* If there is more than one of this type up, leave it up.  Get a list of
   Procedures from the UIB and check each type. */
RUN adeuib/_uibinfo.p (INPUT ?,               /* pi_context: not known      */
                       INPUT "SESSION",       /* p_name: get "Session" info */
                       INPUT "PROCEDURES",    /* p_request: all proc. id's  */
                       OUTPUT cProcList).
cnt = NUM-ENTRIES (cProcList).
DO i = 1 TO cnt:
  /* Get the type of each procedure */
  RUN adeuib/_uibinfo.p (INPUT INTEGER(ENTRY(i,cProcList)),  /* context */
                         INPUT ?,                            /* not needed */
                         INPUT "TYPE",                       /* request */
                         OUTPUT cProcType).
   IF cProcType eq subject THEN c = c + 1.
END.

IF c > 1 THEN RETURN.

DO WHILE VALID-HANDLE(h):
  IF ENTRY(1,h:PRIVATE-DATA) = "CUE-CARD " AND
     ENTRY(2,h:PRIVATE-DATA) = subject     THEN 
  DO:
    ASSIGN hnext = h:NEXT-SIBLING.
    APPLY "CLOSE" TO h.   
  END.
  IF VALID-HANDLE(h) THEN
    ASSIGN h = h:NEXT-SIBLING.  
  ELSE h = hnext.
END.
RETURN.
/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/**************************************************************************
    Procedure:  _so-cuew.p


    Purpose:    Deletes the cue card for this object upon .W write (XFTR)

    Parameters: recid-trg (INT) - RECID(_TRG)
                trg-Code (CHAR) - code block

    Description:
    Notes  :
    Authors: Gerry Seidl
    Date   : 3/16/95
**************************************************************************/

DEFINE INPUT        PARAMETER recid-trg AS INTEGER   NO-UNDO.
DEFINE INPUT-OUTPUT PARAMETER trg-Code  AS CHARACTER NO-UNDO.

DEFINE VARIABLE  firstline AS CHARACTER NO-UNDO.
DEFINE VARIABLE  tcode     AS CHARACTER NO-UNDO.
DEFINE VARIABLE  cInfo     AS CHARACTER NO-UNDO.

/* Ask the UIB if the procedure for the current trigger record is in a TEMPLATE */
RUN adeuib/_uibinfo.p (INPUT recid-trg,   /* pi_context: of the code  */
                       INPUT ?,           /* p_name: not needed        */
                       INPUT "TEMPLATE",  /* p_request: all proc. id's */
                       OUTPUT cInfo).
/* Is this a TEMPLATE? If so return. */
IF cInfo eq "yes" THEN RETURN.

ASSIGN
   tcode     = TRIM(trg-code)
   firstline = ENTRY(1,tcode,CHR(10)).

/* If this .W is not the template, change the code block to:
"/* <object-name>
Destroy on next read */"
 * so that the next time the .W is read in, _so-cue.w will delete it
 */
ASSIGN trg-Code = firstline + CHR(10) + "Destroy on next read */".

RETURN. 
/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/
/*------------------------------------------------------------------------

  File: _solink.w

  Description: Given smart object handles, it determines if objects 
     should be linked
     The following 'illegal' matches are handled:
 
** ALLOWS dynamic objects with NO fields to be linked to anything

 * querySmartBrowser -> Data Link -> smartDataBrowser
 * SmartDataObject   -> Data Link -> smartDataBrowser
     if SmartDataObject already has another 
        SmartDataObject   -> Data Link -> smartDataBrowser
 * Commit Panel -> Commit  -> SmartDataObject with no updateable fields
 * Update Panel -> TableIO -> visual (SmartDataBrowser, SmartDataViewer) 
      with no enabled fields 

     Returns NO  if above criteria fails
     Returns YES if above criteria succeeds 
     Returns ?   if we can not determine if match 
                   (ie. ERROR when running functions, ? returned from functions)
  Input Parameters:
      ph_1stObject       handle of first  smart object
      ph_2ndObject       handle of second smart object 
      pc_link-type       What type of link are we attempting 
      pl_details         Do they want details? 
  Output Parameters:
      pl_objectsLink    logical  
  Author: SLK
  Created: 12/98

------------------------------------------------------------------------*/
/* ***************************  Definitions  ************************** */

/* Parameters Definitions ---                                           */
DEFINE INPUT  PARAMETER ph_1stObject        AS HANDLE              NO-UNDO.
DEFINE INPUT  PARAMETER ph_2ndObject        AS HANDLE              NO-UNDO.
DEFINE INPUT  PARAMETER pc_link-type        AS CHARACTER           NO-UNDO.
DEFINE INPUT  PARAMETER pl_details          AS LOGICAL             NO-UNDO.
DEFINE OUTPUT PARAMETER pl_objectsLink      AS LOGICAL INIT YES    NO-UNDO.
DEFINE OUTPUT PARAMETER pc_errorMsg         AS CHARACTER           NO-UNDO.

/* Local Variable Definitions ---                                       */
DEFINE VARIABLE c_1stObjType                AS CHARACTER           NO-UNDO.
DEFINE VARIABLE c_2ndObjType                AS CHARACTER           NO-UNDO.
DEFINE VARIABLE l_1stObjIsQueryObject       AS LOGICAL             NO-UNDO.
DEFINE VARIABLE l_2ndObjIsQueryObject       AS LOGICAL             NO-UNDO.
DEFINE VARIABLE h_Temp                      AS HANDLE              NO-UNDO.
DEFINE VARIABLE l_Temp                      AS LOGICAL             NO-UNDO.
DEFINE VARIABLE c_Temp                      AS CHARACTER           NO-UNDO.

/* ******************************************************************** */

/* determine the type of object */
ASSIGN
   c_1stObjType = DYNAMIC-FUNCTION("getObjectType":U IN ph_1stObject) 
   c_2ndObjType = DYNAMIC-FUNCTION("getObjectType":U IN ph_2ndObject)
   l_1stObjIsQueryObject = DYNAMIC-FUNCTION("getQueryObject":U IN ph_1stObject) 
   l_2ndObjIsQueryObject = DYNAMIC-FUNCTION("getQueryObject":U IN ph_2ndObject)
   pl_objectsLink = ?
   NO-ERROR.

/* QuerySmartBrowser -> Data Link -> smartDataBrowser */
IF CAN-DO("Data":U,pc_link-type) AND
   (c_1stObjType = "smartDataBrowser":U AND 
    c_2ndObjType = "smartDataBrowser":U AND
    (l_1stObjIsQueryObject OR
    l_2ndObjIsQueryObject)) AND
    (NOT (l_1stObjIsQueryObject AND l_2ndObjIsQueryObject)) THEN 
DO:
   ASSIGN pl_objectsLink = NO
            pc_errorMsg = pc_link-type +
               " link two SmartDataBrowsers. They cannot share a query.".       
   RETURN.
END.

/* Commit Panel -> Commit  -> SmartDataObject with no updateable fields
 */
IF CAN-DO("Commit":U,pc_link-type) AND
   ((c_1stObjType = "smartPanel":U 
     AND c_2ndObjType = "smartDataObject":U) OR
    (c_1stObjType = "smartDataObject":U 
     AND c_2ndObjType = "smartPanel":U)) THEN 
DO:
   ASSIGN 
      h_Temp = IF c_1stObjType = "SmartDataObject":U 
                    THEN ph_1stObject
                    ELSE ph_2ndObject
      c_Temp = DYNAMIC-FUNCTION("getUpdatableColumns":U IN h_Temp)
   NO-ERROR.

   /* If we get an error when getting UpdatableColumns, then link fails
    * If we get a blank or ? then let's test if the object is dynamic
    * If dynamic (no fields in the object), then link possible , else not
    */
   IF ERROR-STATUS:ERROR THEN ASSIGN pl_objectsLink = NO.
   IF c_Temp = "" OR c_Temp = ? THEN
   DO: /* Determine if dynamic object */
      ASSIGN
         c_Temp = DYNAMIC-FUNCTION("getDataColumns":U IN h_Temp)
      NO-ERROR.
      IF ERROR-STATUS:ERROR OR (c_Temp <> "":U AND c_Temp <> ?) THEN 
      ASSIGN pl_objectsLink = NO.
   END.

   IF NOT pl_objectsLink THEN 
   DO:
      ASSIGN 
          pc_errorMsg = pc_link-type + " link a SmartPanel with a SmartDataObject "
             + " with no updateable fields.".       
      RETURN.
   END. /* No Updateable fields */
END.

/* Update Panel -> TableIO -> visual (SmartDataBrowser, SmartDataViewer)
 *    with no enabled fields
 */
IF CAN-DO("TableIO":U,pc_link-type) AND
   ((c_1stObjType = "smartPanel":U 
     AND CAN-DO("smartDataViewer,smartDataBrowser",c_2ndObjType)) OR
    (CAN-DO("smartDataViewer,smartDataBrowser",c_1stObjType) 
     AND c_2ndObjType = "smartPanel":U)) AND 
    ( NOT (l_1stObjIsQueryObject OR l_2ndObjIsQueryObject)) THEN
DO:
   ASSIGN 
      h_Temp = IF CAN-DO("smartDataViewer,smartDataBrowser":U,c_1stObjType) 
                    THEN ph_1stObject
                    ELSE ph_2ndObject
      c_Temp = DYNAMIC-FUNCTION("getEnabledFields":U IN h_Temp)
   NO-ERROR.
   /* If we get an error when getting UpdatableColumns, then link fails
    * If we get a blank or ? then let's test if the object is dynamic
    * If dynamic (no fields in the object), then link possible , else not
    */
   IF ERROR-STATUS:ERROR THEN ASSIGN pl_objectsLink = NO.
   IF c_Temp = "" OR c_Temp = ? THEN
   DO: /* Determine if dynamic object */
      ASSIGN
         c_Temp = DYNAMIC-FUNCTION("getDisplayedFields":U IN h_Temp)
      NO-ERROR.
      IF ERROR-STATUS:ERROR OR (c_Temp <> "":U AND c_Temp <> ?) THEN 
      ASSIGN pl_objectsLink = NO.
   END.
   IF NOT pl_objectsLink THEN
   DO:
      pc_errorMsg = pc_link-type + " link a SmartPanel with a VisualObject "
             + " with no enabled fields.".       
      RETURN.
   END.
END.
&ANALYZE-SUSPEND _VERSION-NUMBER UIB_v9r12
&ANALYZE-RESUME
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _DEFINITIONS Procedure 
/***********************************************************************
* Copyright (C) 2005-2006 by Progress Software Corporation. All rights *
* reserved.  Prior versions of this work may contain portions          *
* contributed by participants of Possenet.                             *
*                                                                      *
***********************************************************************/
/*------------------------------------------------------------------------

  File: _somatch.w

  Description: Given smart object handles, it determines if objects match
     The following matches are handled:
 
 * querySmartBrowser = objectType = "smartDataBrowser" AND isQueryObject
 * 
 * NO Signature Check is not supported link : Data, Update
 * NO Signature Check 2 queryObjects, Data Link 
 *                    smartData->Data->smartData
 *                    smartData->Data->querySmartBrowser
 *                    querySmartBrowser->Data->smartData
 *                    querySmartBrowser->Data->querySmartBrowser
 * NO Signature Check if no queryObjects
 * NO Signature Check 1 querySmartBrowser 1 smartDataBrowser
 *                    querySmartBrowser->Data->smartDataBrowser
 * NO Signature Check if dynamic objects

 * STRICT tt signature
 *        getDataSignature(queryObject) = getDataSignature(visualObject)
 *   smartData->Data->smartDataBrowser

 * LENIENT field exists signature
 *   getDisplayedColumns(visualObject) in getDataColumns(queryObject) 
 *
 *   smartData->Data->smartDataViewer   
 *   querySmartBrowser->Data->smartDataViewer   
 *    

 * LENIENT enabled exists updatable signature
 *   getEnabledFlds(visualObject) in getUpdatableFlds(queryObject) 
 *
 *   smartDataViewer->Update->smartData
 *   smartDataBrowser->Update->smartData
 *   queryDataBrowser->Update->smartData
 *

     Returns YES if above criteria succeed
             "" for error message
     Returns NO  if above criteria does not succeed
             error message
     Returns ?   if we can not determine if match 
                   (ie. ERROR when running functions, ? returned from functions)
  Input Parameters:
      ph_1stObject       handle of first  smart object
      ph_2ndObject       handle of second smart object 
      pc_link-type       What type of link are we attempting 
      pl_details         Do they want details? 
  Output Parameters:
      pl_objectsMatch    logical  
  Author: SLK
  Created: 3/98

------------------------------------------------------------------------*/
/* ***************************  Definitions  ************************** */

/* Parameters Definitions ---                                           */
DEFINE INPUT  PARAMETER ph_1stObject        AS HANDLE              NO-UNDO.
DEFINE INPUT  PARAMETER ph_2ndObject        AS HANDLE              NO-UNDO.
DEFINE INPUT  PARAMETER pc_link-type        AS CHARACTER           NO-UNDO.
DEFINE INPUT  PARAMETER pl_details          AS LOGICAL             NO-UNDO.
DEFINE OUTPUT PARAMETER pl_objectsMatch     AS LOGICAL INIT YES    NO-UNDO.
DEFINE OUTPUT PARAMETER pc_errorMsg         AS CHARACTER           NO-UNDO.

/* Local Variable Definitions ---                                       */
DEFINE VARIABLE c_VisualSignature           AS CHARACTER           NO-UNDO.
DEFINE VARIABLE c_1stObjType                AS CHARACTER           NO-UNDO.
DEFINE VARIABLE c_QuerySignature            AS CHARACTER           NO-UNDO.
DEFINE VARIABLE c_2ndObjType                AS CHARACTER           NO-UNDO.
DEFINE VARIABLE c_EnabledFlds               AS CHARACTER           NO-UNDO.
DEFINE VARIABLE c_SQueryColumns             AS CHARACTER           NO-UNDO.
DEFINE VARIABLE c_SVisualColumns            AS CHARACTER           NO-UNDO.
DEFINE VARIABLE c_SQueryColumnsExp          AS CHARACTER           NO-UNDO.
DEFINE VARIABLE c_SVisualColumnsExp         AS CHARACTER           NO-UNDO.
DEFINE VARIABLE c_UpdatableFlds             AS CHARACTER           NO-UNDO.
DEFINE VARIABLE cnt                         AS INTEGER             NO-UNDO.
DEFINE VARIABLE cDataType                   AS CHARACTER           NO-UNDO.
DEFINE VARIABLE cTemp                       AS CHARACTER           NO-UNDO.
DEFINE VARIABLE h_SVisualObject             AS HANDLE              NO-UNDO.
DEFINE VARIABLE h_SQueryObject              AS HANDLE              NO-UNDO.
DEFINE VARIABLE i                           AS INTEGER             NO-UNDO.
DEFINE VARIABLE iDataType                   AS INTEGER             NO-UNDO.
DEFINE VARIABLE l_1stObjIsQueryObject       AS LOGICAL             NO-UNDO.
DEFINE VARIABLE l_2ndObjIsQueryObject       AS LOGICAL             NO-UNDO.

DEFINE VARIABLE is_enabled          AS LOGICAL                     NO-UNDO.
DEFINE VARIABLE is_errorFld         AS LOGICAL                     NO-UNDO.
DEFINE VARIABLE cblank              AS CHARACTER INITIAL " "       NO-UNDO.
DEFINE VARIABLE enableMark          AS CHARACTER INITIAL "e"       NO-UNDO.
DEFINE VARIABLE errorMark           AS CHARACTER INITIAL "*"       NO-UNDO.
DEFINE VARIABLE updatableMark       AS CHARACTER INITIAL "u"       NO-UNDO.

DEFINE TEMP-TABLE ttMismatch
   FIELD posLoc                 AS INTEGER        
   FIELD visualFld              AS CHARACTER      LABEL "Visual Object Fields"
   FIELD queryCol               AS CHARACTER      LABEL "Query Object Columns"
.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME


&ANALYZE-SUSPEND _UIB-PREPROCESSOR-BLOCK 

/* ********************  Preprocessor Definitions  ******************** */

&Scoped-define PROCEDURE-TYPE Procedure
&Scoped-define DB-AWARE no



/* _UIB-PREPROCESSOR-BLOCK-END */
&ANALYZE-RESUME


/* ************************  Function Prototypes ********************** */

&IF DEFINED(EXCLUDE-unqualifyDataTableColumns) = 0 &THEN

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION-FORWARD unqualifyDataTableColumns Procedure 
FUNCTION unqualifyDataTableColumns RETURNS CHARACTER
  (INPUT phDataObject AS HANDLE,
   INPUT pcFields     AS CHARACTER)  FORWARD.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME

&ENDIF


/* *********************** Procedure Settings ************************ */

&ANALYZE-SUSPEND _PROCEDURE-SETTINGS
/* Settings for THIS-PROCEDURE
   Type: Procedure
   Allow: 
   Frames: 0
   Add Fields to: Neither
   Other Settings: CODE-ONLY COMPILE
 */
&ANALYZE-RESUME _END-PROCEDURE-SETTINGS

/* *************************  Create Window  ************************** */

&ANALYZE-SUSPEND _CREATE-WINDOW
/* DESIGN Window definition (used by the UIB) 
  CREATE WINDOW Procedure ASSIGN
         HEIGHT             = 10.81
         WIDTH              = 53.2.
/* END WINDOW DEFINITION */
                                                                        */
&ANALYZE-RESUME

 


&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _MAIN-BLOCK Procedure 


/* ***************************  Main Block  *************************** */

/* determine the type of object */
ASSIGN
   c_1stObjType = DYNAMIC-FUNCTION("getObjectType":U IN ph_1stObject) 
   c_2ndObjType = DYNAMIC-FUNCTION("getObjectType":U IN ph_2ndObject)
   l_1stObjIsQueryObject = DYNAMIC-FUNCTION("getQueryObject":U IN ph_1stObject) 
   l_2ndObjIsQueryObject = DYNAMIC-FUNCTION("getQueryObject":U IN ph_2ndObject)
   pl_objectsMatch = ?
   NO-ERROR.

/* 
 * querySmartBrowser = objectType = "smartDataBrowser" AND isQueryObject
 * 
 * NO Signature Check is not supported link : Data, Update
 * NO Signature Check 2 queryObjects, Data Link 
 *                    smartData->Data->smartData
 *                    smartData->Data->querySmartBrowser
 *                    querySmartBrowser->Data->smartData
 *                    querySmartBrowser->Data->querySmartBrowser
 * NO Signature Check if no queryObjects
 * NO Signature Check 1 querySmartBrowser 1 smartDataBrowser
 *                    querySmartBrowser->Data->smartDataBrowser
 */
IF (NOT CAN-DO("Data,Update,Filter":U,pc_link-type))
  OR
   (l_1stObjIsQueryObject AND
    l_2ndObjIsQueryObject AND
    pc_link-type = "Data":U)
  OR 
    (NOT (l_1stObjIsQueryObject OR l_2ndObjIsQueryObject)) 
  OR
   (c_1stObjType = "smartDataBrowser":U AND 
    c_2ndObjType = "smartDataBrowser":U AND
    (l_1stObjIsQueryObject OR
    l_2ndObjIsQueryObject))
THEN RETURN.

/* 
 * STRICT tt signature
 *        getDataSignature(queryObject) = getDataSignature(visualObject)
 *   smartData->Data->smartDataBrowser
 */
IF CAN-DO("Data":U,pc_link-type) AND
  ((c_1stObjType = "smartDataBrowser":U AND c_2ndObjType = "smartDataObject":U) OR
   (c_1stObjType = "smartDataObject":U        AND c_2ndObjType = "smartDataBrowser":U)) AND
   (NOT (l_1stObjIsQueryObject AND l_2ndObjIsQueryObject)) THEN
DO:

   ASSIGN 
      h_SQueryObject  =  IF l_1stObjIsQueryObject THEN 
                            ph_1stObject
                         ELSE 
                            ph_2ndObject
      h_SVisualObject =  IF l_1stObjIsQueryObject THEN 
                            ph_2ndObject
                         ELSE 
                            ph_1stObject
      c_VisualSignature = DYNAMIC-FUNCTION("getDataSignature":U IN h_SVisualObject)
      c_QuerySignature = DYNAMIC-FUNCTION("getDataSignature":U IN h_SQueryObject)
   NO-ERROR.
   /* If we get any kind of error or the answer is ? then there is no match */
   IF ERROR-STATUS:ERROR THEN ASSIGN pl_objectsMatch =  ?.
   /* If ? or "" then assume dynamic then leave as unknown */
   ELSE IF c_VisualSignature = ? OR  c_VisualSignature = "":U OR
        c_QuerySignature = ?  OR  c_QuerySignature = "":U
   THEN ASSIGN pl_objectsMatch =  ?.
   ELSE IF c_VisualSignature <> c_QuerySignature THEN
   DO:  /* NO */
      ASSIGN pl_objectsMatch = NO.

      /* Only if an advisor will be displayed will be attempt to check the fields */
      IF pl_details THEN
      DO:
         ASSIGN
             c_SQueryColumns  = DYNAMIC-FUNCTION("getDataColumns":U IN h_SQueryObject)
             c_SVisualColumns = DYNAMIC-FUNCTION("getDisplayedFields":U IN h_SVisualObject)
             pc_errorMsg       = "For a Temp-Table signature match, the temp-table definition "
                                + "in each object must be an exact match of each other "
                                + "(order, name and data type)."
                                + "The visual object contains the following field(s):"
         NO-ERROR.

         /****** Expand the visual fields  - adding order and data type */
         DO cnt = 1 TO NUM-ENTRIES(c_SVisualColumns):
            ASSIGN 
               cTemp = ENTRY(cnt,c_SVisualColumns)
               cDataType = SUBSTRING(c_VisualSignature,cnt + cnt - 1,2).
            RUN adecomm/_datatyp.p (INPUT INTEGER(cDataType), OUTPUT cDataType).
            ASSIGN
               pc_errorMsg = pc_errorMsg + CHR(10) 
                             + "    ":U + STRING(cnt,">>>>9") + " ":U
                             + cTemp  + " ":U 
                             + cDataType.
         END. /* Visual Columns */
   
         ASSIGN pc_errorMsg = pc_errorMsg + CHR(10) + CHR(10)
                           + "The query object contains the following column(s):".
         /****** Expand the query columns  - adding order and data type */
         DO cnt = 1 TO NUM-ENTRIES(c_SQueryColumns):
            ASSIGN 
               cTemp = ENTRY(cnt,c_SQueryColumns)
               cDataType = SUBSTRING(c_QuerySignature,cnt + cnt - 1,2).
            RUN adecomm/_datatyp.p (INPUT INTEGER(cDataType), OUTPUT cDataType).
            ASSIGN
               pc_errorMsg = pc_errorMsg + CHR(10) 
                             + "    ":U + STRING(cnt,">>>>9") + " ":U
                             + cTemp  + " ":U 
                             + cDataType.
         END. /* Query Columns */
      END. /* pl_details */
   END. /* NO */
   ELSE
   DO:  /* YES */
      ASSIGN pl_objectsMatch =  YES
             pc_errorMsg = "":U.
   END. /* YES */
   RETURN.
END. /* Strict signature check */


/*
 * LENIENT field exists signature
 *   getDisplayedColumns(visualObject) in getDataColumns(queryObject) 
 *
 *   smartData->Data->smartDataViewer   
 *   querySmartBrowser->Data->smartDataViewer   
 2yy*    
 *"SmartDataViewer vcust.w needs field(s) xxx, which SmartDataObject dcust.w
  cannot provide.".
 */
IF CAN-DO("Data,Filter":U,pc_link-type) AND
   (((CAN-DO("smartDataViewer,SmartFilter,SmartDataField":U,c_1stObjType)) AND 
     (CAN-DO("smartDataObject,smartDataBrowser":U,c_2ndObjType) AND 
      l_2ndObjIsQueryObject))
    OR
    ((CAN-DO("smartDataViewer,SmartFilter,SmartDataField":U,c_2ndObjType)) AND 
     (CAN-DO("smartDataObject,smartDataBrowser":U,c_1stObjType) AND 
      l_1stObjIsQueryObject))) THEN
DO:

   ASSIGN h_SQueryObject  =  IF l_1stObjIsQueryObject 
                             THEN ph_1stObject
                             ELSE ph_2ndObject
          h_SVisualObject =  IF l_1stObjIsQueryObject
                             THEN ph_2ndObject
                             ELSE ph_1stObject
          c_SQueryColumns  = DYNAMIC-FUNCTION("getDataColumns":U IN h_SQueryObject)
          c_SVisualColumns = DYNAMIC-FUNCTION("getDisplayedFields":U IN h_SVisualObject)
   NO-ERROR.
   
   IF ERROR-STATUS:ERROR THEN 
      ASSIGN pl_objectsMatch = ?.
   /* If ? or "" then assume dynamic then leave as unknown */
   ELSE IF c_SVisualColumns = "":U OR c_SVisualColumns = ? OR
           c_SQueryColumns = "":U  OR c_SQueryColumns = ? THEN
      ASSIGN pl_objectsMatch = ?.
   ELSE
   DO:
      ASSIGN pl_objectsMatch = YES.

       /*The DataView always qualifies the field names with the entity name (i.e.: eCustomer.name), but
         a viewer built on a SDO does not qualify the field names, therefore the signature won't match.
         If the data-source is a DataView (getObjectType = "SmartDataObject and getDBAware = NO),
         and the viewer was built on a SDO (columns are not qualified, INDEX(".",c_SVisualColumns) = 0) then
         we have to unqualify the column names.*/
       IF DYNAMIC-FUNCTION('getObjectType':U IN h_SQueryObject) = "SmartDataObject":U AND
          DYNAMIC-FUNCTION('getDBAware':U IN h_SQueryObject) = FALSE AND
          INDEX(c_SVisualColumns,".") = 0 THEN
          ASSIGN c_SQueryColumns = unqualifyDataTableColumns(h_SQueryObject, c_SQueryColumns).

      /* A visualization that does not use ANY queryObject fields 
       * still successfully matches a queryObject... meaning we can
       * still use that viewer with that queryObject
       */
      IF c_SVisualColumns <> "":U THEN
      DO cnt = 1 TO NUM-ENTRIES(c_SVisualColumns):
         cTemp = ENTRY(cnt,c_SVisualColumns).
         IF NOT CAN-DO(c_SQueryColumns,cTemp) THEN    
         DO:
            ASSIGN pl_objectsMatch = NO.
            IF NOT pl_details THEN LEAVE.
         END. /* Can't find viewer field in DO */
      END. /* cycle through viewer fields */
      IF pl_objectsMatch = NO AND pl_details THEN
      DO:
         ASSIGN pc_errorMsg = 
            "For the Displayed-Field signature match, all the visual object's fields must be a subset of the query object's columns."
            + "The visual object needs field(s):".
         DO cnt = 1 TO NUM-ENTRIES(c_SVisualColumns):
            ASSIGN cTemp = ENTRY(cnt,c_SVisualColumns).
            IF NOT CAN-DO(c_SQueryColumns,cTemp) THEN
               ASSIGN    pc_errorMsg = pc_errorMsg + CHR(10) + "   ":U + cTemp. 
         END. /* VisualColumns */
         ASSIGN pc_errorMsg = pc_errorMsg + CHR(10) + 
           "which the query object cannot provide.".
      END. 
   END. /* No error or ? */
   RETURN.
END. /* Visualization / queryObject */


/*  
 * LENIENT enabled exists updatable signature
 *   getEnabledFlds(visualObject) in getUpdatableFlds(queryObject) 
 *
 *   smartDataViewer->Update->smartData
 *   smartDataBrowser->Update->smartData
 *   queryDataBrowser->Update->smartData
 */
IF CAN-DO("Update":U,pc_link-type) AND 
   ((c_1stObjType = "smartDataObject":U AND
    (CAN-DO("smartDataViewer,smartDataBrowser":U,c_2ndObjType)))
    OR
    (c_2ndObjType = "smartDataObject":U AND
    (CAN-DO("smartDataViewer,smartDataBrowser":U,c_1stObjType)))) THEN
DO:
    IF l_1stObjIsQueryObject AND l_2ndObjIsQueryObject THEN
    DO:
       IF c_1stObjType = "smartDataObject":U THEN
         ASSIGN h_SQueryObject  =  ph_1stObject
                h_SVisualObject =  ph_2ndObject
         .
      ELSE
         ASSIGN h_SQueryObject  =  ph_2ndObject
                h_SVisualObject =  ph_1stObject.
      .
    END.
    ELSE
      ASSIGN h_SQueryObject  =  IF l_1stObjIsQueryObject 
                             THEN ph_1stObject
                             ELSE ph_2ndObject
          h_SVisualObject =  IF l_1stObjIsQueryObject
                             THEN ph_2ndObject
                             ELSE ph_1stObject.

    ASSIGN
        c_updatableFlds = DYNAMIC-FUNCTION("getUpdatableColumns":U IN h_SQueryObject)
        c_EnabledFlds = DYNAMIC-FUNCTION("getEnabledFields":U IN h_SVisualObject)
      NO-ERROR.
      IF ERROR-STATUS:ERROR THEN
         ASSIGN  pl_objectsMatch = ?.
   /* If ? or "" then assume dynamic then leave as unknown */
      ELSE IF c_EnabledFlds   = "":U OR c_EnabledFlds   = ? OR
              c_UpdatableFlds = "":U OR c_UpdatableFlds = ? THEN 
         ASSIGN  pl_objectsMatch = ?.
      ELSE
      DO:

       /*The DataView always qualifies the field names with the entity name (i.e.: eCustomer.name), but
         a viewer built on a SDO does not qualify the field names, therefore the signature won't match.
         If the data-source is a DataView (getObjectType = "SmartDataObject and getDBAware = NO),
         and the viewer was built on a SDO (columns are not qualified, INDEX(".",c_SVisualColumns) = 0) then
         we have to unqualify the column names.*/
       IF DYNAMIC-FUNCTION('getObjectType':U IN h_SQueryObject) = "SmartDataObject":U AND
          DYNAMIC-FUNCTION('getDBAware':U IN h_SQueryObject) = FALSE AND
          INDEX(c_EnabledFlds,".") = 0 THEN
          ASSIGN c_updatableFlds = unqualifyDataTableColumns(h_SQueryObject, c_updatableFlds).

         /* A visualization that does not have ANY enabled fields 
          * still successfully matches a queryObject's updatable fields... 
          * meaning we can still use that viewer with that queryObject
          */
         IF c_EnabledFlds <> "":U THEN
         DO cnt = 1 TO NUM-ENTRIES(c_EnabledFlds):
            cTemp = ENTRY(cnt,c_EnabledFlds).
            IF NOT CAN-DO(c_updatableFlds,cTemp) THEN    
            DO:
                ASSIGN pl_objectsMatch = NO.
                IF NOT pl_details THEN LEAVE.
            END.
         END.

         IF pl_objectsMatch = NO AND pl_details THEN
         DO:
            ASSIGN
               pc_errorMsg = "For a Enabled Field signature match all the Visual object's "
                            + "enabled fields must be a subset of the SmartDataObject's "
                            + "updatable columns." 
                            + CHR(10)
                            + "The visual object has the enabled field(s):".

         DO cnt = 1 TO NUM-ENTRIES(c_EnabledFlds):
            cTemp = ENTRY(cnt,c_EnabledFlds).
            IF NOT CAN-DO(c_updatableFlds,cTemp) THEN 
               ASSIGN pc_errorMsg = pc_errorMsg + CHR(10) + "   ":U + cTemp.
            END. /* VisualColumns */
         END.
            ASSIGN pc_errorMsg = pc_errorMsg + CHR(10) 
               + "which are not updatable in the SmartDataObject.":U.
         END.
  RETURN.
END. /* Update Link */

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME


/* ************************  Function Implementations ***************** */

&IF DEFINED(EXCLUDE-unqualifyDataTableColumns) = 0 &THEN

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION unqualifyDataTableColumns Procedure 
FUNCTION unqualifyDataTableColumns RETURNS CHARACTER
  (INPUT phDataObject AS HANDLE,
   INPUT pcFields     AS CHARACTER) :
/*-------------------------------------------------------------------------------
   Purpose: Returns an unqualified list of the fields.
Parameters: phDataObject: Handle of the data-source object
            pcFields:     List of qualified fields to be unqualified.
    
    Notes:  Only fields that are qualified with the DataTable will be unqualified
-------------------------------------------------------------------------------*/
DEFINE VARIABLE iField        AS INTEGER    NO-UNDO.
DEFINE VARIABLE cField        AS CHARACTER  NO-UNDO.
DEFINE VARIABLE cReturnFields AS CHARACTER  NO-UNDO.
DEFINE VARIABLE cDataTable    AS CHARACTER  NO-UNDO.

{get DataTable cDataTable phDataObject}.

DO iField = 1 TO NUM-ENTRIES(pcFields):
    ASSIGN cField = ENTRY(iField, pcFields).
    
    IF ENTRY(1, cField, ".") NE cDataTable THEN
        NEXT.

    ASSIGN cReturnFields = cReturnFields + ENTRY(2, cField, ".") + ",".
END.

RETURN TRIM(cReturnFields, ",").

END FUNCTION.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME

&ENDIF

/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/
/*
** Program:         adecomm/_sortstr.p
** Author:          Robert Ryan
** Date:            3/15/94
** Purpose:         Sorts an input list, usually file names
**
** Input-output:    pSortString - any string separated by a delimter
** Input            pDelim - delimiter character (if blank, comma used)
*/

define input-output parameter pSortString as char.
define input        parameter pDelim as char.
define var          i as integer no-undo. 
define temp-table   _SORTSTR
                    field fSortString as char.


if pDelim = "" then pDelim = ",".
if num-entries(pSortString,pDelim) = 1 then return.

do i = 1 to num-entries(pSortString,pDelim):
  create _SORTSTR.
  _SORTSTR.fSortString = entry(i,pSortString,pDelim).
end.

pSortString = "".
for each _SORTSTR by fSortString:
  pSortString = if pSortString = "" then _SORTSTR.fSortString
                else pSortString + pDelim + _SORTSTR.fSortString.
end.
/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/
/***************************************************************************
    Procedure:      _srchhlp.p
    Purpose:        ADE Help API for Common Editor Search Routines.

    Run Syntax:     RUN adecomm/_srchhlp.p ( INPUT p_Help_On ) .

    Parameters:

          INPUT p_Help_On
                The SYSTEM-HELP <context-string> for which you want help.

                For example, the context string of the Find dialog
                box is Find_Dialog_Box.  This is converted to the
                appropriate SYSTEM-HELP <context-number>.

    Description:
    Notes:
***************************************************************************/

/* adecomm/_srchhlp.p */

DEFINE INPUT PARAMETER p_Help_On      AS CHARACTER NO-UNDO .

{ adecomm/commeng.i }

DEFINE VAR             vHelp_Context  AS INTEGER   NO-UNDO .

REPEAT ON STOP UNDO, LEAVE: /* proc-main */

    CASE p_Help_On :

        /*--------------- Search Help ---------------*/
        WHEN "Find_Dialog_Box"
    	    THEN vHelp_Context = {&Find_Dialog_Box} .

        WHEN "Replace_Dialog_Box"
    	    THEN vHelp_Context = {&Replace_Dialog_Box} .

        WHEN "Goto_Line_Dialog_Box"
            THEN vHelp_Context = {&Goto_Line_Dialog_Box} .

    END CASE .

    RUN adecomm/_adehelp.p
        ( INPUT "comm" , INPUT "CONTEXT" , INPUT vHelp_Context , INPUT ? ) .
    LEAVE.

END. /* proc-main */
/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/
/*----------------------------------------------------------------------------

File: _statdsp.p

Description:
	Display a message in a status region.

INPUT Parameters
  wFrame	-	The status frame created from _status.p.
  iPos		- 	The status region to display the message in.
  cMessage	-	The message.


INPUT-OUTPUT Parameters

OUTPUT Parameters

Author: Greg O'Connor

Date Created: 08/10/93 

Modification History:

----------------------------------------------------------------------------*/
DEFINE INPUT  PARAMETER wFrame    AS WIDGET    NO-UNDO.
DEFINE INPUT  PARAMETER iPos      AS INTEGER   NO-UNDO.
DEFINE INPUT  PARAMETER cMessage  AS CHARACTER NO-UNDO.

DEFINE VARIABLE wRect1     AS WIDGET NO-UNDO.
DEFINE VARIABLE i          AS INTEGER NO-UNDO.

if not valid-handle(wFrame) then return.

IF iPos > NUM-ENTRIES (wFrame:PRIVATE-DATA) THEN
  RETURN.

ASSIGN
  wRect1 = wFrame:FIRST-CHILD
  wRect1 = (IF wRect1 <> ? THEN wRect1:FIRST-CHILD ELSE wRect1)
  .
DO WHILE wRect1 <> ?:

/*  message  
  INTEGER (ENTRY (i, wFrame2:PRIVATE-DATA )) skip
  STRING (wRect1) skip 
  STRING (wRect1:HANDLE) skip 
  STRING (wRect1:TYPE) skip 
  STRING (wRect1) = ENTRY (i, wFrame2:PRIVATE-DATA ) .
*/


  IF (STRING (wRect1) = ENTRY (iPos, wFrame:PRIVATE-DATA )) THEN DO:
    /*
     * Massage the string. '&' characters are treated like there are in
     * buttons. They get chewed up and turned into "underline the
     * next character".
     */

    &if "{&WINDOW-SYSTEM}" BEGINS "MS-WIN" &then

      wRect1:SCREEN-VALUE = replace(cMessage, "&", "&&").

    &else

      i = index(cMessage, "&").

      if i > 0 then
        wRect1:SCREEN-VALUE = 
          replace(SUBSTRING(cMessage,1,i,"CHARACTER":u),"&":u,"&&":u)
        + SUBSTRING(cMessage,i + 1,-1,"CHARACTER":u).
      else
        wRect1:SCREEN-VALUE = cMessage.
    &endif
  END.


wRect1 = wRect1:NEXT-SIBLING.

END.
/*********************************************************************
* Copyright (C) 2005 by Progress Software Corporation. All rights    *
* reserved.  Prior versions of this work may contain portions        *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/
/*----------------------------------------------------------------------------

File: 

Description:
  Create a status bar for a window.

INPUT Parameters
  wWindow	- The window to parent the status bar to
  cLen		- A character list of how many and how long a status
        	  box should be.
		  "30,10" will create a status bar with two status
		  boxes 30 and 10 characters long.
  lTopLine      - Logical for determining if top line should be shown.
  iFont         - Font number for status message text.  If ?, system font is used 

INPUT-OUTPUT Parameters

OUTPUT Parameters
  wFrameOut 	- The status frame.
  iFieldsOut	- The number of fields that where actually created.

Author: Greg O'Connor

Date Created: 08/10/93 

Modification History:

12/6/96 gfs  Removed hardcoded BGCOLOR=8 and make frame three-d. This all was 
             done so that a change to the 3D color in Windows95 would show 
             through
5/20/94 ryan Added support for topline and font size

----------------------------------------------------------------------------*/
DEFINE INPUT  PARAMETER wWindow   AS WIDGET    NO-UNDO.
DEFINE INPUT  PARAMETER cLen      AS CHARACTER NO-UNDO.
DEFINE INPUT  PARAMETER lTopLine  AS LOGICAL   NO-UNDO.
DEFINE INPUT  PARAMETER iFont     AS INTEGER   NO-UNDO.
DEFINE OUTPUT PARAMETER wFrameOut AS WIDGET    NO-UNDO.
DEFINE OUTPUT PARAMETER iFieldOut AS INTEGER   NO-UNDO.


DEFINE VARIABLE wFrame2    AS WIDGET NO-UNDO.
DEFINE VARIABLE wRectFrame AS WIDGET NO-UNDO.
DEFINE VARIABLE wRect1     AS WIDGET NO-UNDO.
DEFINE VARIABLE wRectTop   AS WIDGET NO-UNDO.
DEFINE VARIABLE wRectLeft  AS WIDGET NO-UNDO.
DEFINE VARIABLE wText      AS WIDGET NO-UNDO.
DEFINE VARIABLE cText      AS CHARACTER INITIAL "12345678901234567890" NO-UNDO. 
DEFINE VARIABLE cTopColor  AS INTEGER INIT 15 NO-UNDO.
DEFINE VARIABLE iFontSize  AS INTEGER INIT 0 NO-UNDO.
DEFINE VARIABLE i          AS INTEGER NO-UNDO.
DEFINE VARIABLE iFormat    AS INTEGER NO-UNDO.
DEFINE VARIABLE iTotal     AS INTEGER NO-UNDO INIT 0.
DEFINE VARIABLE iFields    AS INTEGER NO-UNDO INIT 0.
DEFINE VARIABLE cTextHandleList  AS CHARACTER NO-UNDO.

&SCOPED-DEFINE topBottom 3
&SCOPED-DEFINE rightLeft 6

ASSIGN
  cTopColor = IF lTopLine THEN 15 ELSE 8
  iFontSize = IF iFont = ? THEN 1 ELSE iFont.

CREATE FRAME wFrame2
  ASSIGN
    BOX        = FALSE
    OVERLAY    = TRUE
    PARENT     = wWindow
    X          = 0
    Y          = 0
    THREE-D    = YES
    SCROLLABLE = NO
   /*
    The min size a frame can be is the size of a fillin which is bigger than 
    the size of text because of decoration. If the status bar and the margin
    fit in the the fillin space the use it. Otherwise compute the hieght based
    on the size plus top and bottom margin + a pixel or two so the rectanges are
    not over written by passing a screen value to the text widgets at run time
    */
    HEIGHT-PIXELS  = (IF ((SESSION:PIXELS-PER-ROW -
                           FONT-TABLE:GET-TEXT-HEIGHT-PIXELS(iFontSize)) > 
	                      {&topBottom}) 
                       THEN SESSION:PIXELS-PER-ROW + 1
                       ELSE FONT-TABLE:GET-TEXT-HEIGHT-PIXELS(iFontSize) +
                           ({&topBottom} * 2) + 3)
    WIDTH-PIXELS   = wWindow:WIDTH-PIXELS.
wFrame2:Y = wWindow:HEIGHT-PIXELS - wFrame2:HEIGHT-PIXELS.

CREATE RECTANGLE wRectFrame
  ASSIGN
    X             = 0
    Y             = iTotal
    WIDTH-PIXELS  = wFrame2:WIDTH-PIXELS 
    HEIGHT-PIXELS = wFrame2:HEIGHT-PIXELS
    FRAME         = wFrame2
    fgcolor       = 8
    filled        = false
    .

CREATE RECTANGLE wRect1 /* Black top line */
  ASSIGN
    WIDTH-PIXELS  = wFrame2:WIDTH-PIXELS 
    HEIGHT-PIXELS = 1 
    FRAME         = wFrame2
    bgcolor       = cTopColor
    fgcolor       = cTopColor
    filled        = FALSE
    X             = 0
    Y             = 0
    .

iTotal = 0.

DO i = 1 TO NUM-ENTRIES (cLen):
  iFormat = INTEGER (ENTRY (i, cLen)).

  IF ((iFormat * (FONT-TABLE:GET-TEXT-WIDTH-PIXELS(cTEXT,iFontSize) / 20)) + iTotal) >
      wFrame2:WIDTH-PIXELS THEN
	NEXT.

  iFields = iFields + 1.

  /* Create the Text as if it is in the default font.  This will size the text
     as if it had a format "X(iFormat)".  Note that we really want to size it
     based on the font we are going to be using (but this will cause some 
     compatibility problems with old code.  So we will size it the old way, and
     then change to the new font and make sure we use all the usable space. 
     (wood 6/95) */ 
  CREATE TEXT wText
    ASSIGN
      FRAME         = wFrame2
      FORMAT        = SUBSTITUTE("x(&1)",ENTRY (i, cLen))
      HEIGHT-PIXELS = wFrame2:HEIGHT-PIXELS - (({&topbottom} + 1) * 2)
      bgcolor       = wRectFrame:bgcolor
      /* Make sure not to cover the rectangles. */
      X             = iTotal + {&rightLeft} + 2 
      Y             = {&topBottom} + 1           
      .
   /* Fix the size of the text widget, then change the font and format so the
      text fills the space allocated. */
  ASSIGN wText:AUTO-RESIZE = no
         wText:FORMAT      = "X(256)"
         wText:FONT        = iFontSize
         .
	
  cTextHandleList = IF NUM-ENTRIES (cTextHandleList) = 0 
    THEN STRING (wText:HANDLE) 
    ELSE cTextHandleList + "," + STRING (wText:HANDLE).
	
  CREATE RECTANGLE wRect1 /* White (bottom and left line) */
    ASSIGN
      WIDTH-PIXELS  = wText:WIDTH-PIXELS  + ({&rightLeft} * 2)
      HEIGHT-PIXELS = wFrame2:HEIGHT-PIXELS - ({&topBottom} * 2) 
      FRAME         = wFrame2
      bgcolor       = 15
      fgcolor       = 15
      filled        = FALSE
      X             = iTotal + {&rightLeft}
      Y             = wText:Y - 1
      .	
	
  CREATE RECTANGLE wRectTop /* top black line */
    ASSIGN
      Y             = wRect1:Y
      X             = iTotal + {&rightLeft}
      WIDTH-PIXELS  = wRect1:WIDTH-PIXELS
      HEIGHT-PIXELS = 1
      FRAME         = wFrame2
      bgcolor       = 0
      fgcolor       = 0
      filled        = FALSE
		.
	
  CREATE RECTANGLE wRectLeft /*left black line */
    ASSIGN
      X             = iTotal + {&rightLeft}
      Y             = wRect1:Y
      WIDTH-PIXELS  = 1
      HEIGHT-PIXELS = wRect1:HEIGHT-PIXELS
      FRAME         = wFrame2
      bgcolor       = 0
      fgcolor       = 0
      filled        = FALSE
      .

  iTotal =  wRect1:X + wRect1:WIDTH-PIXELS /* + {&topBottom} + 1*/.
END.
ASSIGN
  wFrameOut = wFrame2
  wRect1:WIDTH-PIXELS   = wFrame2:WIDTH-PIXELS - (wRect1:X + {&rightLeft})
  wRectTop:WIDTH-PIXELS = wRect1:WIDTH-PIXELS
  NO-ERROR.

ASSIGN
  wFrame2:PRIVATE-DATA = cTextHandleList
  iFieldOut = iFields
  .

RETURN.

/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/*----------------------------------------------------------------------------

File: _tblbrws.p

Description:
   Browse the tables for a given database. This database must
   be aliased to DICTDB before this routine is called.  If the database
   is a foreign database, the schema holder database must have this alias.
   This procedure must be run persistently.
   
Input Parameters: (for the calling programs)
   p_dlg       - Frame handle needed to parent the frame created in this 
                 procedure.
   parent-proc - Handle of the calling dialog so that we can run its
                 internal procedures (methods).
   p_multi     - Logical: True if multiple items can be returned.
   p_rw        - The row of the browse within its parent (p_dlg).
   p_tc        - The column of the brwose within its parent (p_dlg).
   p_DbId      - The recid of the _Db record which corresponds to the
                 database that we want the tables from.
   p_Filters   - Comma delimited character string with with things (like
                 Sybase Buffers) that should be filtered out.
   in-value    - Comma delimited list of tables to select initially
             
Output Parameters:
   h_tbl_brws - Handle of browse created in this routine.
   p_Stat     - Set to true if list is retrieved (even if there were no tables
      	         this is successful).  Set to false, if user doesn't have access
      	         to tables.

Author: Ross Hunter

Date Created: 08/08/95 

----------------------------------------------------------------------------*/
{adecomm/_adetool.i} /* Identify this procedure as part of the ADE */

{adecomm/tblbrws.i &HGHT = "6.9" &WDTH = "25" &FLDS = "NO"}

/* _tblbrws.p - end of file */

/*********************************************************************
* Copyright (C) 2000,2008 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/*----------------------------------------------------------------------------

File: tbllist.p

Description:
   Fill a selection list with tables for a given database.  This database
   must be aliased to DICTDB before this routine is called.  If the database
   is a foreign database, the schema holder database must have this alias.

Input Parameters:
   p_List   - Handle of the selection list widget to add to.
   p_Hidden - Flag - set to yes if we want hidden tables in the list, or 
      	      no to hide hidden tables.
   p_DbId   - The recid of the _Db record which corresponds to the database
      	      that we want the tables from.
   p_Type   - This is what you want in the list.  Developers can add more
      	      types as they are needed.
              ""  = just add the name of the table
              "D" = add db.table  NOTE: This will cause p_DBID to be ignored
              and all databases in this physical database will be used.
   p_Filter - Comma delimited character string with with things (like Sybase
              Buffers) that should be filtered out.
             
Output Parameters:
   p_Stat   - Set to true if list is retrieved (even if there were no tables
      	      this is successful).  Set to false, if user doesn't have access
      	      to tables.

Author: Laura Stern

Date Created: 06/15/92 
    Modified: 04/20/98 Added logic to skip views created by SQL92 D. McMann
              05/20/98 Added logic to check DBVERSION so that code will run
                       against an 8 database. D. McMann
              07/10/98 Added logic to Check DBVERSION and _Owner on _File finds
                       D. McMann
              06/26/08 fernando Remove encryption tables from list         
----------------------------------------------------------------------------*/

DEFINE INPUT  PARAMETER p_List    AS WIDGET-HANDLE   NO-UNDO.
DEFINE INPUT  PARAMETER p_Hidden  AS LOGICAL         NO-UNDO.
DEFINE INPUT  PARAMETER p_DbId    AS RECID           NO-UNDO.
DEFINE INPUT  PARAMETER p_Type    AS CHARACTER       NO-UNDO.
DEFINE INPUT  PARAMETER p_filters AS CHARACTER       NO-UNDO.
DEFINE OUTPUT PARAMETER p_Stat 	  AS LOGICAL         NO-UNDO.

DEFINE VARIABLE err        AS LOGICAL   NO-UNDO.
DEFINE VARIABLE filtered   AS LOGICAL   NO-UNDO.
DEFINE VARIABLE v_OutItem  AS CHARACTER NO-UNDO.
DEFINE VARIABLE v_DBName   AS CHARACTER NO-UNDO.
DEFINE VARIABLE widg       AS WIDGET    NO-UNDO.

&SCOPED-DEFINE  INVALID_SCHEMA_TABLES "_sec-db-policy,_sec-obj-policy,_sec-pwd-policy":U

IF INTEGER(DBVERSION("DICTDB":u)) > 8 THEN 
  FIND DICTDB._File WHERE DICTDB._File._File-name = "_File":u
                      AND DICTDB._File._Owner = "PUB":u
                      NO-LOCK.
ELSE                      
  FIND DICTDB._File "_File":u NO-LOCK.
  
IF NOT CAN-DO(DICTDB._File._Can-Read, USERID("DICTDB":u)) THEN DO:
  MESSAGE "You do not have permission to see any table information."
    VIEW-AS ALERT-BOX ERROR buttons OK.
  p_Stat = FALSE.
  RETURN.
END.

/* Find each file in this database.  Remember, if the progress Db is 
   acting as a schema holder, files for more than one database may 
   exist in this one physical database.  */

/* it is ok if they did not pass down an id.  We will use the default db */
IF p_DbID = ? THEN /* get the id of the database they picked */
  RUN adecomm/_getdbid.p (LDBNAME("DICTDB":u), OUTPUT p_DBID).

ASSIGN
  widg = p_List:parent 	/* gives me the group */
  widg = widg:parent.  	/* gives me the frame */

RUN adecomm/_setcurs.p ("WAIT":u).

FOR EACH DICTDB._DB WHERE
    /* p_Type = "D" will look in all _DB records */
    RECID(DICTDB._DB) = p_DBID OR p_Type = "D":u NO-LOCK:

  v_DBName = (IF DICTDB._DB._DB-Name = ? THEN
     LDBNAME("DICTDB":u) ELSE DICTDB._DB._DB-Name).

  FOR EACH DICTDB._File FIELDS(_File-num _File-name _Owner _Hidden _Tbl-type) OF DICTDB._DB
      WHERE CAN-DO(DICTDB._File._Can-Read, USERID("DICTDB":u)) NO-LOCK:
    IF INTEGER(DBVERSION("DICTDB":u)) > 8  AND DICTDB._File._Tbl-type = "V"
      THEN NEXT.
      
    IF INTEGER(DBVERSION("DICTDB":u)) > 8 AND (DICTDB._File._Owner <> "PUB":u AND DICTDB._File._Owner <> "_FOREIGN":u)
       THEN NEXT.
        
    /* make sure we only see hidden tables when requested */
    IF (p_Hidden OR (NOT DICTDB._File._Hidden)) THEN DO:

      /* Check filters - currently only the Sybase buffer filter is available */
      IF p_Filters = "":U THEN filtered = FALSE.
      ELSE DO:
        /* Since the file structure for V6 is different from V7 we must call */
        /* The correct version of _is_buffx.p                                */
        IF INTEGER(DBVERSION("DICTDB")) < 7 THEN
          RUN adecomm/_filter6.p (INPUT RECID(DICTDB._FILE),
                                  p_Filters,
                                  OUTPUT filtered).
        ELSE
          RUN adecomm/_filter7.p (INPUT RECID(DICTDB._FILE),
                                  p_Filters,
                                  OUTPUT filtered).
      END.

      /* filter these schema tables out (hidden) */
      IF DICTDB._File._Hidden AND CAN-DO({&INVALID_SCHEMA_TABLES},DICTDB._File._File-name) THEN
          filtered = TRUE.

      IF NOT filtered OR filtered = ? THEN DO:
        CASE p_Type:
          WHEN "D":u THEN v_OutItem = v_DBName + ".":u + DICTDB._File._File-name.
          OTHERWISE v_OutItem = DICTDB._File._File-name.
        END.

        /* add it to the list */
        IF (p_List:PRIVATE-DATA = ? OR 
        	NOT CAN-DO (p_List:PRIVATE-DATA, TRIM(v_OutItem))) THEN 
          err = p_List:ADD-LAST(v_OutItem).
      END.  /* Get this file name */
    END.  /* end of if p_Hidden */
  END. /* end of for each dictdb._file */
END.  /* for each dictdb._db */

RUN adecomm/_setcurs.p ("").
p_Stat = TRUE.

/* _tbllist.p - end of file */




/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/
/*----------------------------------------------------------------------------

File: tblsel.p

Description:
  This is just like _fldsel.p except it only allows the user
  to pick tables.

INPUT Parameters
p_Multi    - Should they be allowed to select multiple items.
p_TT       - ? if temp-tables need to be included
             Otherwise a comma delitted list where each entry has the form:
             _like-db._like-table|_name
             The _like-db and _like-table are real database.table combinations
             and _name is either the name of the temp-table that is like
             _like-table or ? if it is the same.


INPUT-OUTPUT Parameters
p_DBName   - The name of the database the schema was picked from.  May
             may optionally be passed in to default the database.
p_TblNames - The name of the table selection.  Optional to pass in default.

OUTPUT Parameters
p_OK       - Did they press OK to get out?

Author: Ross Hunter
Created: 08/08/95 
Updated: 01/06/99 adams Selected Databases selection-list item should default 
                        to first item in the list.

----------------------------------------------------------------------------*/

&GLOBAL-DEFINE WIN95-BTN YES
{adecomm/commeng.i}  /* Help contexts */
{adecomm/adestds.i}  /* Standard layout stuff, colors etc. */
{adecomm/getdbs.i &NEW="NEW"}
{adecomm/tt-brws.i "NEW"}

DEFINE INPUT        PARAMETER p_Multi    AS LOGICAL   NO-UNDO.
DEFINE INPUT        PARAMETER p_TT       AS CHARACTER NO-UNDO.
DEFINE INPUT-OUTPUT PARAMETER p_DBName   AS CHARACTER NO-UNDO.
DEFINE INPUT-OUTPUT PARAMETER p_TblNames AS CHARACTER NO-UNDO.
DEFINE OUTPUT       PARAMETER p_OK       AS LOGICAL   NO-UNDO INITIAL FALSE.

&global-define TCOL   26
&global-define FWidth 54

DEFINE VAR h_tbl_brws   AS HANDLE  NO-UNDO.
DEFINE VAR new-proc     AS HANDLE  NO-UNDO.  
DEFINE VAR old-proc     AS HANDLE  NO-UNDO.
DEFINE VAR v_dbid       AS RECID   NO-UNDO.
DEFINE VAR v_access     AS LOGICAL NO-UNDO.
DEFINE VAR v_OldDictDb  AS CHAR    NO-UNDO INITIAL ?.  /* saved name of dictdb */
DEFINE VAR repos        AS RECID   NO-UNDO INITIAL ?. 
DEFINE VAR tbl-col      AS DECIMAL NO-UNDO INITIAL {&TCOL}.

DEFINE VAR t_int        AS INTEGER NO-UNDO.
DEFINE VAR t_log        AS LOGICAL NO-UNDO.
DEFINE VAR t_char       AS CHAR    NO-UNDO.

DEFINE BUTTON b_ok      LABEL "OK"      {&STDPH_OKBTN} AUTO-GO.
DEFINE BUTTON b_cancel  LABEL "Cancel"  {&STDPH_OKBTN} AUTO-ENDKEY.
DEFINE BUTTON b_Help    LABEL "&Help"   {&STDPH_OKBTN}.
DEFINE VARIABLE wintitle AS CHARACTER NO-UNDO INIT "Table Selector".
DEFINE QUERY  db-browse FOR s_ttb_db.
DEFINE BROWSE db-browse QUERY db-browse NO-LOCK
       DISPLAY s_ttb_db.ldbnm FORMAT "X(40)"
    WITH NO-ROW-MARKERS NO-COLUMN-SCROLLING SIZE 20.5 BY 6.9 NO-LABELS.

/* Dialog Button Box */
&IF {&OKBOX} &THEN
   DEFINE RECTANGLE rect_Btn_Box {&STDPH_OKBOX}.
&ENDIF


FORM 
   SKIP({&TFM_WID})
  "Databases:"  AT 3       view-as TEXT
  "Tables:"     AT {&TCOL} view-as TEXT 
   SKIP({&VM_WID})

  db-browse      AT 3
  
  { adecomm/okform.i
      &BOX    ="rect_Btn_Box"
      &OK     ="b_OK"
      &CANCEL ="b_Cancel"
      &HELP   ="b_Help" 
  }
  with frame schemapk 
      
      &if DEFINED(IDE-IS-RUNNING) = 0  &then 
       view-as dialog-box title wintitle
      &else
      no-box three-d 
      &endif 
      no-labels  default-button b_OK cancel-button b_Cancel WIDTH {&FWidth}.

FRAME schemapk:HIDDEN = TRUE.

{adeuib/ide/dialoginit.i "FRAME schemapk:handle"}
&if DEFINED(IDE-IS-RUNNING) <> 0  &then
   dialogService:View().
&endif
/*-------------------------------Triggers------------------------------------*/

/*-----WINDOW-CLOSE-----*/
on window-close of frame schemapk DO:
   DELETE PROCEDURE old-proc.
   APPLY "END-ERROR" TO FRAME schemapk.
END.

/*----- SELECTION of OK BUTTON or GO -----*/
ON GO OF FRAME schemapk DO:   /* or OK btn 'cause its auto-go */
  RUN load-private-data IN old-proc.
  ASSIGN p_ok       = true
         p_DBName   = s_ttb_db.ldbnm 
         p_TblNames = h_tbl_brws:PRIVATE-DATA.
end.

/*----- VALUE-CHANGED DB LIST -----*/
ON VALUE-CHANGED OF db-browse IN FRAME schemapk DO:
    RUN load_tables (INPUT "":U).
END.


/*----- DEFAULT-ACTION of tbl_browse -----*/
PROCEDURE table-browse-def-act.
   apply "GO" to frame schemapk.
END.


/*----- HELP -----*/
on HELP of frame schemapk OR choose of b_Help in frame schemapk
   RUN "adecomm/_adehelp.p" (INPUT "comm", INPUT "CONTEXT", 
                             INPUT {&Table_Selection},
                             INPUT ?).


/*----------------------------Mainline code----------------------------------*/

{ adecomm/okrun.i
    &FRAME  = "FRAME schemapk"
    &BOX    = "rect_Btn_Box"
    &OK     = "b_OK"
    &HELP   = "b_Help"
}

/* save the pointer to the current dictdb */
if connected("dictdb") then
v_olddictdb = ldbname("dictdb").

/* Fill up the database selection list */
RUN adecomm/_getdbs.p.

/*  Unless this is called from the _ttmaint.w procedure, remove the
    temp-db record because it is used for defining 
    temp-tables not for selecting from them                         */
IF p_TT NE "_ttmaint.w" THEN DO:
  FIND s_ttb_db WHERE s_ttb_db.ldbnm = "TEMP-DB":U NO-ERROR.
  IF AVAILABLE s_ttb_db THEN DELETE s_ttb_db.
END.
ELSE DO:
  /* If it is being called from _ttmaint.w don't let the user use an
     actual database named "TEMP-TABLES".   */
  FIND s_ttb_db WHERE s_ttb_db.ldbnm = "TEMP-TABLES":U NO-ERROR.
  IF AVAILABLE s_ttb_db THEN DO:
    MESSAGE 'You have a database with a logical name of "TEMP-TABLES".' SKIP
            'Since "TEMP-TABLES" is reserved as the logical name of' SKIP
            'the virtual database containing temp-tables, it will be' SKIP
            'ignored as a source of temp-table definitions.  To use' SKIP
            'the tables in this database as temp-table definitions,' SKIP
            'disconnect and reconnect giving the database the logical' SKIP
            'name "TEMP-DB".' VIEW-AS ALERT-BOX WARNING.
    DELETE s_ttb_db.
  END.
END.

/* If there are temp-tables defined then let the user choose from them 
   unless this is being called from _ttmaint.w                        */
IF p_TT NE ? AND p_TT NE "_ttmaint.w" THEN DO:
  /* Create psuedo db for temp-table definitions */
  CREATE s_ttb_db.
  ASSIGN s_ttb_db.ldbnm = "Temp-Tables":U
         s_ttb_db.sdbnm = s_ttb_db.ldbnm
         s_ttb_db.dbnr  = 99999
         s_ttb_db.empty = FALSE.
END.

FIND s_ttb_db WHERE s_ttb_db.ldbnm = p_DBName NO-ERROR.
IF NOT AVAILABLE s_ttb_db OR s_ttb_db.empty THEN
  FIND FIRST s_ttb_db WHERE NOT s_ttb_db.empty NO-ERROR.
IF AVAILABLE s_ttb_db THEN repos = RECID(s_ttb_db).     
ELSE DO:
  MESSAGE "No connected database has any tables." VIEW-AS ALERT-BOX ERROR.
  RETURN.
END.

OPEN QUERY db-browse FOR EACH s_ttb_db WHERE NOT s_ttb_db.empty.
t_log = db-browse:SET-REPOSITIONED-ROW(1,"CONDITIONAL":U).

/* Reposition to the database "Temp-Table", if any. This addresses the
   situation in which the user is connected to a physical database and has 
   defined a database "temp-table" and wants to see the temp-table tables 
   first.  See "Create psuedo db for temp-table definitions" above.
   (bug 98-11-30-056) */
IF repos NE ? THEN DO:
  FIND s_ttb_db WHERE s_ttb_db.ldbnm = p_DBName NO-ERROR.
  IF NOT AVAILABLE s_ttb_db OR s_ttb_db.empty THEN
    FIND FIRST s_ttb_db WHERE NOT s_ttb_db.empty NO-ERROR.
END.
  
/* Open table browse */
RUN load_tables (INPUT p_TblNames).

ENABLE db-browse
       b_ok
       b_cancel
       b_Help
  with frame schemapk.

FRAME schemapk:HIDDEN = FALSE.
&scoped-define CANCEL-EVENT U2
{adeuib/ide/dialogstart.i b_ok b_cancel wintitle}
/* Select initial db */
IF repos NE ? THEN REPOSITION db-browse TO RECID repos.
ELSE t_log = db-browse:SELECT-ROW(1).

DO ON ERROR UNDO, LEAVE  ON ENDKEY UNDO, LEAVE:
    &if DEFINED(IDE-IS-RUNNING) = 0  &then
        WAIT-FOR CHOOSE OF b_ok IN FRAME schemapk 
              OR GO OF FRAME schemapk.
    &ELSE
        WAIT-FOR "choose" of b_ok in frame schemapk 
              or "u2" of this-procedure
              or GO OF FRAME schemapk.       
        if cancelDialog THEN UNDO, LEAVE.  
    &endif
   
END.

HIDE FRAME schemapk.
IF VALID-HANDLE(old-proc) THEN DELETE PROCEDURE old-proc.
RETURN.
 
/**********************************************************************/
/*                      Internal Procedures                           */
/**********************************************************************/

PROCEDURE load_tables:
 /* ------------------------------------------------------------
    RUN load_tables.
    
    Populate shared browse tbl-browse based on fields from the db pointed
    to by repos.  Initially select the tables based on the valueof ivalue,
    or if ivalue is "" then pick the first table in tbl-browse for single 
    select lists and no table for multiselect lists.
    ------------------------------------------------------------ */
  DEFINE INPUT PARAMETER ivalue  AS CHARACTER                    NO-UNDO.
  DEFINE VARIABLE cur-ent AS CHARACTER                           NO-UNDO.
  DEFINE VARIABLE i       AS INTEGER                             NO-UNDO.
  DEFINE VARIABLE r-table AS CHARACTER                           NO-UNDO.

  IF s_ttb_db.sdbnm NE "Temp-Tables":U THEN DO:
    IF LDBNAME("DICTDB":U) NE s_ttb_db.sdbnm THEN
      CREATE ALIAS DICTDB FOR DATABASE VALUE(s_ttb_db.sdbnm).
    
    RUN adecomm/_getdbid.p (INPUT s_ttb_db.ldbnm, OUTPUT v_DBID).

    /* if we could not find the id, we got a problem */
    IF v_DBID = ? THEN DO:
      t_log = FALSE.
      run adecomm/_s-alert.p
        (input-output t_log, "i", "ok",
        SUBSTITUTE("Database &1 was not found.", s_ttb_db.ldbnm)).
      IF VALID-HANDLE(old-proc) THEN DELETE PROCEDURE old-proc.
      RETURN.  /* no read permission on fields */
    END.

    /* Everything is in order, open the shared query for tbl-browse */
    RUN adecomm/_tblbrws.p PERSISTENT SET new-proc
           (INPUT FRAME schemapk:HANDLE,
            INPUT THIS-PROCEDURE,
            INPUT p_multi,
            INPUT db-browse:ROW,
            INPUT tbl-col,
            INPUT v_DBId,
            INPUT "BUFFER,FUNCTION,PACKAGE,PROCEDURE,SEQUENCE":U,
            INPUT ivalue,
            OUTPUT h_tbl_brws,
           OUTPUT v_access).
  END.  /* If not a picking from a temp-table */
  ELSE DO:
     /* User wants to select from defined temp tables.  Build temp table
        definitions needed to simulate tables and fields.               */
     
     /* First see if we have already built the temp-table info          */
     IF NOT CAN-FIND(FIRST _tt-tbl) THEN DO:
       DO i = 1 TO NUM-ENTRIES(p_TT):
         CREATE _tt-tbl.
         ASSIGN cur-ent         = ENTRY(i, p_TT)
                _tt-tbl.tt-name = ENTRY(2, cur-ent, "|":U)
                r-table         = ENTRY(2, ENTRY(1, cur-ent, "|":U), ".":U).
         IF _tt-tbl.tt-name = "?":U THEN _tt-tbl.tt-name = r-table.
         CREATE ALIAS "DICTDB":U FOR
                DATABASE VALUE(SDBNAME(ENTRY(1, cur-ent, ".":U))).
         /* Build the field records for this table */       
         RUN adecomm/_bldfld.w (INPUT RECID(_tt-tbl), INPUT r-table).
       END. /* Do i = 1 to num-entries(p_TT) */
     END.  /* If we haven't already built these records */

     /* The table and field tt records are made, browse them */ 
     RUN adecomm/_ttblbrs.p PERSISTENT SET new-proc
           (INPUT FRAME schemapk:HANDLE,
            INPUT THIS-PROCEDURE,
            INPUT p_multi,
            INPUT db-browse:ROW,
            INPUT tbl-col,
            INPUT v_DBId,
            INPUT ivalue,
            OUTPUT h_tbl_brws,
            OUTPUT v_access).
  END. /* Else picking from a temp-table */
          
  IF NOT v_access THEN DO:
    IF VALID-HANDLE(old-proc) THEN DELETE PROCEDURE old-proc.
    IF VALID-HANDLE(new-proc) THEN DELETE PROCEDURE new-proc.
    RETURN.  /* No read permission on fields */
  END.
  IF VALID-HANDLE(old-proc) THEN DELETE PROCEDURE old-proc.
  old-proc = new-proc.
END.
/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/*----------------------------------------------------------------------------

File: _tfbrws.p

Description:
   Browse the tables and fields for a given database. This database must
   be aliased to DICTDB before this routine is called.  If the database
   is a foreign database, the schema holder database must have this alias.
   This procedure must be run persistently.

Input Parameters:
   p_dlg       - Frame handle needed to parent the frame created in this 
                 procedure.
   parent-proc - Handle of the calling dialog so that we can run its
                 internal procedures (methods).
   p_multi     - Logical: True if multiple items can be returned.
   p_rw        - The row of the browse within its parent (p_dlg).
   p_tc        - The column of the brwose within its parent (p_dlg).
   p_DbId      - The recid of the _Db record which corresponds to the
                 database that we want the tables from.
   p_Filters   - Comma delimited character string with with things (like
                 Sybase Buffers) that should be filtered out.
   in-value    - Comma delimited list of tables to select initially
   p_DType     - ? if not a specific data-type
             
Output Parameters:
   h_tbl_brws - Handle of table browse created in this routine.
   h_fld_brws - Handle of field browse created in this routine.
   p_Stat     - Set to true if list is retrieved (even if there were no tables
      	         this is successful).  Set to false, if user doesn't have access
      	         to tables.

Author: Ross Hunter

Date Created: 08/08/95 

----------------------------------------------------------------------------*/
{adecomm/_adetool.i} /* Identify this procedure as part of the ADE */

{adecomm/tblbrws.i &HGHT = "6.9" &WDTH = "18.5"  &FLDS = "YES"}

/* _tfbrws.p - end of file */

/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/
/*----------------------------------------------------------------------------

File: _tmpfile.p

Description:
	 Creates an available temp file name. The name is a complete
	 name that includes the path.

Input Parameters: 
	 
	 user_chars:   Characters that can be used to distinguish a temp
				 file from another temp file in the same application.
				 
	 extension:    The file extension that is to be added to the file,
						including the "."
	 
Output Parameters:
	
	 name:         The name of the file

Author: D. Lee

Date Created: 1993

----------------------------------------------------------------------------*/

define input  parameter user_chars as character no-undo.
define input  parameter extension  as character no-undo.
define output parameter name       as character no-undo.

define var base           as integer.
define var check_name     as character.

/*
 * Loop until we find a name that hasn't been used. In theory, if the
 * temp directory gets filled, this could be an infinite loop. But, the
 * likelihood of that is low.
 */
check_name = "something".
 
do while check_name <> ?:
  /* Take the lowest 5 digits (change the format so that everything works out to have exactly 5
     characters. */
  ASSIGN
    base = ( TIME * 1000 + ETIME ) MODULO 100000
    name = STRING(base,"99999":U).
  
  /* Add in the extension and directory into the name. */
  name = SESSION:TEMP-DIR + "p" + name + user_chars + extension.

  check_name = SEARCH(name).
END.

/* _tmpfile.p - end of file */

/*********************************************************************
* Copyright (C) 2005 by Progress Software Corporation. All rights    *
* reserved.  Prior versions of this work may contain portions        *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/*----------------------------------------------------------------------------

File: adecomm/_toollic.p

Description:

This file is part of the trio of toolmenu.i, toolrun.i, _toollic.p.  These
files together will build the standard tools menu used by all the
ADE applications.

Usage:

Include {adecomm/toolmenu.i} with your other menu defines. See toolmenu.i
for any arguments.

Include {adecomm/toolrun.i} after your menubar definition.  This file
should only be run once per menubar.  See toolrun.i for any arguments.

----------------------------------------------------------------------------*/

DEFINE VARIABLE locdwb AS CHARACTER NO-UNDO. /* Actuate WB location, or ? */
DEFINE VARIABLE locard AS CHARACTER NO-UNDO. /* Actuate RD location, or ? */

/*-----------------------------  DEFINE MENUS   -----------------------------*/

{ adecomm/toolmenu.i }

/*-----------------------------  DEFINE MENUS   -----------------------------*/

IF ade_licensed[1] = ? THEN DO:

    &IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN
    IF SEARCH("_admin.p") <> ? OR SEARCH("_admin.r") <> ? THEN
        ade_licensed[{&ADMIN_IDX}] = {&INSTALLED}.
    ELSE
        ade_licensed[{&ADMIN_IDX}] = {&NOT_AVAIL}.
    &ENDIF

    IF SEARCH("_dict.p") <> ? OR SEARCH("_dict.r") <> ? THEN
        ade_licensed[{&DICT_IDX}] = {&INSTALLED}.
    ELSE
        ade_licensed[{&DICT_IDX}] = {&NOT_AVAIL}.

    IF SEARCH("_edit.p") <> ? OR SEARCH("_edit.r") <> ? THEN
        ade_licensed[{&EDIT_IDX}] = {&INSTALLED}.
    ELSE
        ade_licensed[{&EDIT_IDX}] = {&NOT_AVAIL}.

    IF SEARCH("protools/_protool.p") <> ? OR
       SEARCH("protools/_protool.r") <> ? THEN
        ade_licensed[{&PTOOL_IDX}] = {&INSTALLED}.
    ELSE
        ade_licensed[{&PTOOL_IDX}] = {&NOT_AVAIL}.

    &IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN
    IF GET-LICENSE("UIB") = 0 OR GET-LICENSE("Workshop") = 0 THEN DO:
      /* Either the traditional UIB or the traditional WebSpeed Workshop is
         licensed.  Has the AB been installed?                              */
        IF SEARCH("_ab.p") <> ? OR SEARCH("_ab.r") <> ? THEN
            ade_licensed[{&UIB_IDX}] = {&INSTALLED}.
        ELSE
            ade_licensed[{&UIB_IDX}] = {&LICENSED}.
    END.
    ELSE
        ade_licensed[{&UIB_IDX}] = {&NOT_AVAIL}.
    &ENDIF

    &IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN
    IF GET-LICENSE("RESULTS") = 0 THEN DO:
        IF SEARCH("results.p") <> ? OR SEARCH("results.r") <> ? THEN
            ade_licensed[{&RPT_IDX}] = {&INSTALLED}.
        ELSE
            ade_licensed[{&RPT_IDX}] = {&LICENSED}.
    END.
    ELSE
        ade_licensed[{&RPT_IDX}] = {&NOT_AVAIL}.
    &ENDIF

    /*Do not include Report Writer in version 10 and above*/
    &IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN
    IF GET-LICENSE("REPORT-WRITER") = 0 AND 
       INTEGER(substring(PROVERSION,1,INDEX(PROVERSION,".":U) - 1)) < 10 THEN DO:
        IF SEARCH("_rbuild.p") <> ? OR SEARCH("_rbuild.r") <> ? THEN
            ade_licensed[{&RB_IDX}] = {&INSTALLED}.
        ELSE
            ade_licensed[{&RB_IDX}] = {&LICENSED}.
    END.
    ELSE
        ade_licensed[{&RB_IDX}] = {&NOT_AVAIL}.
    &ENDIF

    &IF "{&WINDOW-SYSTEM}" BEGINS "MS-WIN" &THEN
    IF GET-LICENSE("TRANSLATION-MGR") = 0 THEN DO:
        IF SEARCH("_tran.p") <> ? OR SEARCH("_tran.r") <> ? THEN
            ade_licensed[{&TRAN_IDX}] = {&INSTALLED}.
        ELSE
            ade_licensed[{&TRAN_IDX}] = {&LICENSED}.
    END.
    ELSE
        ade_licensed[{&TRAN_IDX}] = {&NOT_AVAIL}.
    &ENDIF

    &IF "{&WINDOW-SYSTEM}" BEGINS "MS-WIN" &THEN
    IF GET-LICENSE("VISUAL-TRANSLATOR") = 0 THEN DO:
        IF SEARCH("_vtran.p") <> ? OR SEARCH("_vtran.r") <> ? THEN
            ade_licensed[{&VTRAN_IDX}] = {&INSTALLED}.
        ELSE
            ade_licensed[{&VTRAN_IDX}] = {&LICENSED}.
    END.
    ELSE
        ade_licensed[{&VTRAN_IDX}] = {&NOT_AVAIL}.
    &ENDIF

    IF GET-LICENSE("COMPILER-TOOL") = 0 THEN DO:
        IF SEARCH("_comp.p") <> ? OR SEARCH("_comp.r") <> ? THEN
            ade_licensed[{&COMP_IDX}] = {&INSTALLED}.
        ELSE
            ade_licensed[{&COMP_IDX}] = {&LICENSED}.
    END.
    ELSE
        ade_licensed[{&COMP_IDX}] = {&NOT_AVAIL}.

    IF GET-LICENSE("DEBUGGER") = 0 THEN DO:
        IF SEARCH("java/progress.jar") <> ? THEN
            ade_licensed[{&DBG_IDX}] = {&INSTALLED}.
        ELSE
            ade_licensed[{&DBG_IDX}] = {&LICENSED}.
    END.
    ELSE
        ade_licensed[{&DBG_IDX}] = {&NOT_AVAIL}.
    
    IF GET-LICENSE("Workshop") = 0 THEN DO:
        IF SEARCH("adeweb/_abrunwb.p") <> ? 
        OR SEARCH("adeweb/_abrunwb.r") <> ? THEN
            ade_licensed[{&WTOOL_IDX}] = {&INSTALLED}.
        ELSE
            ade_licensed[{&WTOOL_IDX}] = {&LICENSED}.
    END.
    ELSE
      ade_licensed[{&WTOOL_IDX}] = {&NOT_AVAIL}.

    &IF "{&WINDOW-SYSTEM}" BEGINS "MS-WIN" &THEN
        RUN adecomm/_locdwb.p (OUTPUT locdwb).
        IF locdwb <> ? THEN
            ade_licensed[{&DWB_IDX}] = {&INSTALLED}.
        ELSE
            ade_licensed[{&DWB_IDX}] = {&NOT_AVAIL}.
    &ENDIF

    &IF "{&WINDOW-SYSTEM}" BEGINS "MS-WIN" &THEN
        RUN adecomm/_locard.p (OUTPUT locard).
        IF locard <> ? THEN
            ade_licensed[{&ARD_IDX}] = {&INSTALLED}.
        ELSE
            ade_licensed[{&ARD_IDX}] = {&NOT_AVAIL}.
    &ENDIF

    &IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN
    IF SEARCH("auditing/_apmt.p") <> ? OR SEARCH("auditing/_apmt.r") <> ? THEN
        ade_licensed[{&APMT_IDX}] = {&INSTALLED}.
    ELSE
        ade_licensed[{&APMT_IDX}] = {&NOT_AVAIL}.
    &ENDIF

    &IF {&DEBUG} &THEN
    MESSAGE 
        "ADMIN" ade_licensed[{&ADMIN_IDX}] SKIP
        "DICT"  ade_licensed[{&DICT_IDX}]  SKIP
        "EDIT"  ade_licensed[{&EDIT_IDX}]  SKIP
        "UIB"   ade_licensed[{&UIB_IDX}]   SKIP
        "RPT"   ade_licensed[{&RPT_IDX}]   SKIP
        "RB"    ade_licensed[{&RB_IDX}]    SKIP
        "TRAN"  ade_licensed[{&TRAN_IDX}]  SKIP
        "VTRAN" ade_licensed[{&VTRAN_IDX}] SKIP
        "COMP"  ade_licensed[{&COMP_IDX}]  SKIP
        "DBG"   ade_licensed[{&DBG_IDX}]   SKIP
        "PTOOL" ade_licensed[{&PTOOL_IDX}] SKIP
        "WTOOL" ade_licensed[{&WTOOL_IDX}] SKIP
        "DWB"   ade_licensed[{&DWB_IDX}]   SKIP
        "ARD"   ade_licensed[{&ARD_IDX}]   SKIP
        "APMT"  ade_licensed[{&APMT_IDX}]   SKIP
        VIEW-AS ALERT-BOX INFORMATION BUTTONS OK.
    &ENDIF
END.

/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/
/*------------------------------------------------------------------------

  File: _topmost.p

  Description: Defines a window to be TOP-MOST or not.

  Input Parameters:
       usrhwnd (int) - hWnd of Progress window client area
       mode    (log) - turn TOP-MOST on or off

  Output Parameters:
       rc (int)      - return code (non-zero = ok)

  Author: Gerry Seidl

  Created: Sept 9, 1994 
  
  Modified by: GFS 05/08/95 Cleaned up.
               GFS 01/15/96 Ported to WIN32
------------------------------------------------------------------------*/
DEFINE INPUT  PARAMETER usrhwnd AS INTEGER NO-UNDO. /* hWnd of window (really client area only) */
DEFINE INPUT  PARAMETER mode    AS LOGICAL NO-UNDO. /* yes = on, no = off */
DEFINE OUTPUT PARAMETER rc      AS INTEGER NO-UNDO. /* non-zero = ok */

DEFINE VARIABLE topmost         AS INTEGER NO-UNDO.
DEFINE VARIABLE flags           AS INTEGER NO-UNDO INITIAL  3.  /* 0x0001 OR 0x0002 */  
DEFINE VARIABLE parent          AS INTEGER NO-UNDO.             /* hold parent hWnd */

IF OPSYS = "WIN32" THEN DO:
  RUN GetParent ( INPUT usrhwnd, OUTPUT parent).

  RUN SetWindowPos ( INPUT  parent,
                       INPUT  (IF mode THEN -1 ELSE -2),
                       INPUT  0,
                       INPUT  0,
                       INPUT  0,
                       INPUT  0,
                       INPUT  flags,
                       OUTPUT rc ).
END.
ELSE DO:
  RUN GetParent16 ( INPUT usrhwnd, OUTPUT parent).

  RUN SetWindowPos16 ( INPUT  parent,
                     INPUT  (IF mode THEN -1 ELSE -2),
                     INPUT  0,
                     INPUT  0,
                     INPUT  0,
                     INPUT  0,
                     INPUT  flags,
                     OUTPUT rc ).
END.

/* 32bit DLLs */
PROCEDURE SetWindowPos EXTERNAL "user32.dll":
  DEFINE INPUT PARAMETER hWnd            AS LONG.
  DEFINE INPUT PARAMETER hWndInsertAfter AS LONG.
  DEFINE INPUT PARAMETER x               AS LONG.
  DEFINE INPUT PARAMETER y               AS LONG.
  DEFINE INPUT PARAMETER cx              AS LONG.
  DEFINE INPUT PARAMETER cy              AS LONG.
  DEFINE INPUT PARAMETER wflags          AS LONG.   
  DEFINE RETURN PARAMETER rc             AS LONG.
END.

PROCEDURE GetParent EXTERNAL "user32.dll":
  DEFINE INPUT  PARAMETER hWnd1           AS LONG.
  DEFINE RETURN PARAMETER hWnd2           AS LONG.
END. 
              
/* 16bit DLLs */
PROCEDURE SetWindowPos16 EXTERNAL "user.exe" ORDINAL 232:
  DEFINE INPUT PARAMETER hWnd            AS SHORT.
  DEFINE INPUT PARAMETER hWndInsertAfter AS SHORT.
  DEFINE INPUT PARAMETER x               AS SHORT.
  DEFINE INPUT PARAMETER y               AS SHORT.
  DEFINE INPUT PARAMETER cx              AS SHORT.
  DEFINE INPUT PARAMETER cy              AS SHORT.
  DEFINE INPUT PARAMETER wflags          AS SHORT.   
  DEFINE RETURN PARAMETER rc             AS SHORT.
END.

PROCEDURE GetParent16 EXTERNAL "user.exe" ORDINAL 46:
  DEFINE INPUT  PARAMETER hWnd1           AS SHORT.
  DEFINE RETURN PARAMETER hWnd2           AS SHORT.
END.

/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/*----------------------------------------------------------------------------

File: _treldat.p

Description:
   Display table relations to the currently set output device (e.g., a file, 
   the printer).
 
Input Parameters:
   p_DbId    - Id of the _Db record for this database.
   p_Tbl     - The table to show relations for or "ALL"

Author: Tony Lavinio, Laura Stern

Date Created: 10/12/92

Modified on 05/31/95 gfs Allow display of hidden tables (not meta-schema).
            06/14/94 gfs Added NO-LOCKs to file accesses.
            07/10/98 DLM Added DBVERSION and _Owner check
----------------------------------------------------------------------------*/
{ prodict/fhidden.i }

DEFINE INPUT PARAMETER p_DbId  AS RECID NO-UNDO.
DEFINE INPUT PARAMETER p_Tbl   AS CHAR  NO-UNDO.

DEFINE SHARED STREAM rpt.

DEFINE WORKFILE g_relate NO-UNDO
  FIELD g_owner  LIKE _File._File-name
  FIELD g_member LIKE _File._File-name
  FIELD g_idx    LIKE _Index._Index-name.

DEFINE BUFFER g_mfile  FOR _File.
DEFINE BUFFER g_xfield FOR _Field.
DEFINE BUFFER g_xfile  FOR _File.

DEFINE VARIABLE noway    AS LOGICAL NO-UNDO.
DEFINE VARIABLE line     AS CHAR    NO-UNDO.  

FORM
  line FORMAT "x(77)" NO-LABEL
  WITH FRAME rptline DOWN NO-BOX USE-TEXT STREAM-IO.

FORM 
  SKIP(1)
  SPACE(3) g_mfile._File-name LABEL "Working on" FORMAT "x(32)" SPACE
  SKIP(1)
  WITH FRAME working_on SIDE-LABELS VIEW-AS DIALOG-BOX 
  TITLE "Generating Report".

/*-----------------------------Mainline code---------------------------*/

FIND _DB WHERE RECID(_Db) = p_DbId NO-LOCK.
IF INTEGER(DBVERSION("DICTDB")) > 8 THEN DO:
  FIND _File WHERE  _File._File-name = "_File" 
               AND _File._Owner = "PUB" NO-LOCK.
  noway = CAN-DO(_Can-read,USERID("DICTDB")).
  FIND _File WHERE _File._File-name = "_Field" 
               AND _File._Owner = "PUB" NO-LOCK.
  noway = noway AND CAN-DO(_Can-read,USERID("DICTDB")).
  FIND _File WHERE  _File._File-name = "_Index" 
               AND _File._Owner = "PUB" NO-LOCK.
  noway = noway AND CAN-DO(_Can-read,USERID("DICTDB")).
  FIND _File WHERE _File._File-name = "_Index-field" 
               AND _File._Owner = "PUB" NO-LOCK.
  noway = noway AND CAN-DO(_Can-read,USERID("DICTDB")).
END.  
ELSE DO:
  FIND _File "_File" NO-LOCK.
  noway = CAN-DO(_Can-read,USERID("DICTDB")).
  FIND _File "_Index" NO-LOCK.
  noway = noway AND CAN-DO(_Can-read,USERID("DICTDB")).
  FIND _File "_Field" NO-LOCK.
  noway = noway AND CAN-DO(_Can-read,USERID("DICTDB")).
END.  

IF NOT noway THEN DO:
  MESSAGE "You do not have permission to use this option"
      VIEW-AS ALERT-BOX ERROR BUTTONS OK.
  RETURN.
END.

IF p_Tbl = "ALL" THEN
  SESSION:IMMEDIATE-DISPLAY = yes.

FOR EACH g_mfile NO-LOCK
  WHERE g_mfile._Db-recid = p_DbId
  AND (IF p_Tbl = "ALL" THEN (IF NOT fHidden THEN NOT _Hidden ELSE g_mfile._File-Number > 0)
                        ELSE g_mfile._File-name = p_Tbl):
  IF INTEGER(DBVERSION("DICTDB")) > 8 AND
    (g_mfile._Owner <> "PUB" AND g_mfile._Owner <> "_FOREIGN") THEN NEXT.
    
  IF p_Tbl = "ALL" THEN
    DISPLAY g_mfile._File-name WITH FRAME working_on.

  /* Clear work file */
  FOR EACH g_relate NO-LOCK: DELETE g_relate.  END.

  FOR
    EACH _Index       WHERE _Unique,
    EACH _File        OF _Index WHERE _File._File-num > 0,
    EACH _Index-field OF _Index,
    EACH _Field       OF _Index-field NO-LOCK:

    IF _Index-seq = 1 THEN
      FOR EACH g_xfield WHERE g_xfield._Field-name = _Field._Field-name
        AND RECID(g_xfield) <> RECID(_Field),
        EACH g_xfile OF g_xfield NO-LOCK:
        IF g_mfile._File-name <> _File._File-name
          AND g_mfile._File-name <> g_xfile._File-name THEN NEXT.
        CREATE g_relate.
        ASSIGN
          g_relate.g_owner  = _File._File-name
          g_relate.g_member = g_xfile._File-name
          g_relate.g_idx    = _Index._Index-name.
      END.
    ELSE
      FOR EACH g_relate
        WHERE g_idx = _Index._Index-name AND g_owner = _File._File-name,
        EACH g_xfile WHERE g_xfile._File-name = g_member NO-LOCK:
        IF NOT CAN-FIND(g_xfield OF g_xfile
          WHERE g_xfield._Field-name = _Field._Field-name) 
          AND available g_relate
          THEN DELETE g_relate.
      END.
  END.

  FOR EACH g_relate NO-LOCK BREAK BY g_owner BY g_member:
    IF NOT (FIRST-OF(g_member) AND LAST-OF(g_member)) THEN DELETE g_relate.
  END.

  DISPLAY STREAM rpt g_mfile._File-nam + ":" @ line WITH FRAME rptline.
  DOWN STREAM rpt WITH FRAME rptline.
  line= ?.

  FOR EACH g_relate NO-LOCK WHERE g_owner = g_mfile._File-name BY g_owner:
    line = "  " + g_member + " OF " + g_owner + " ".
    FIND g_xfile NO-LOCK WHERE g_xfile._db-recid = p_DbId
                           AND g_xfile._File-name = g_owner
                           AND (g_xfile._Owner = "PUB" OR g_xfile._Owner = "_FOREIGN").
    FIND _Index OF g_xfile NO-LOCK WHERE _Index-name = g_idx.
    FOR EACH _Index-field OF _Index,EACH _Field OF _Index-field NO-LOCK:
      line = line + STRING(_Index-seq > 1,",/(") + _Field-name.
    END.
    line = line + ")".
    DISPLAY STREAM rpt line WITH FRAME rptline.
    DOWN STREAM rpt WITH FRAME rptline.
  END.

  FOR EACH g_relate NO-LOCK 
        WHERE g_member = g_mfile._File-name BY g_member:
    line = "  " + g_member + " OF " + g_owner + " ".
    FIND g_xfile NO-LOCK WHERE g_xfile._db-recid = p_DbId
                           AND g_xfile._File-name = g_owner
                           AND (g_xfile._Owner = "PUB" OR g_xfile._Owner = "_FOREIGN").
    FIND _Index OF g_xfile NO-LOCK WHERE _Index-name = g_idx.
    FOR EACH _Index-field OF _Index,EACH _Field OF _Index-field NO-LOCK:
      line = line + STRING(_Index-seq > 1,",/(") + _Field-name.
    END.
    line = line + ")".
    DISPLAY STREAM rpt line WITH FRAME rptline.
    DOWN STREAM rpt WITH FRAME rptline.
  END.

  IF line = ? THEN DO:
    DISPLAY STREAM rpt "   No relations found for this file." 
      @ line WITH FRAME rptline.
    DOWN STREAM rpt 2 WITH FRAME rptline.
  END.
  ELSE
    DOWN STREAM rpt 1 WITH FRAME rptline.
END.

IF p_Tbl = "ALL" THEN DO:
  HIDE FRAME working_on NO-PAUSE. 
  SESSION:IMMEDIATE-DISPLAY = no.
END.

/* _treldat.p - end of file */



/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/*----------------------------------------------------------------------------

File: trelrpt.p

Description:
   Invoke table relations report for both the GUI and Char dictionaries.
 
Input Parameters:
   p_DbId    - Id of the _Db record corresponding to the current database
   p_PName   - Physical name of the database
   p_DbType  - Database type (e.g., PROGRESS)
   p_TblName - Name of the table or "ALL".
   p_Btns    - Character string indicating which optional buttons
      	       should be visible.  These include "s" for switch files.
      	       So this could be "" OR "s"

Author: Tony Lavinio, Laura Stern

Date Created: 10/12/92

Modified on 06/14/94 by Gerry Seidl. Added NO-LOCKs to file accesses.
            07/10/98 by D. McMann    Added DBVERSION and _Owner check.
            03/29/99 by Mario B      BUG# 99-03-26-19 Changed DBNAME to 
                                     "DICTDB" in _Owner check.
----------------------------------------------------------------------------*/

{adecomm/commeng.i}  /* Help contexts */

DEFINE INPUT PARAMETER p_DbId    AS RECID NO-UNDO.
DEFINE INPUT PARAMETER p_PName 	 AS CHAR  NO-UNDO.
DEFINE INPUT PARAMETER p_DbType  AS CHAR  NO-UNDO.
DEFINE INPUT PARAMETER p_TblName AS CHAR  NO-UNDO.
DEFINE INPUT PARAMETER p_Btns    AS CHAR  NO-UNDO.

DEFINE VAR header_str AS CHAR 	 NO-UNDO.
DEFINE VAR permit     AS LOGICAL NO-UNDO.

FIND _DB WHERE RECID(_Db) = p_DbId NO-LOCK.
IF INTEGER(DBVERSION("DICTDB")) > 8 THEN DO:
  FIND _File WHERE _File._File-name = "_File" 
               AND _File._Owner = "PUB" NO-LOCK.
  permit = CAN-DO(_Can-read,USERID("DICTDB")).
  FIND _File WHERE _File._File-name = "_Field" 
               AND _File._Owner = "PUB" NO-LOCK.
  permit = permit AND CAN-DO(_Can-read,USERID("DICTDB")).
  FIND _File WHERE _File._File-name = "_Index" 
               AND _File._Owner = "PUB" NO-LOCK.
  permit = permit AND CAN-DO(_Can-read,USERID("DICTDB")).
  
END.  
ELSE DO:
  FIND _File "_File" NO-LOCK.
  permit = CAN-DO(_Can-read,USERID("DICTDB")).
  FIND _File "_Index" NO-LOCK.
  permit = permit AND CAN-DO(_Can-read,USERID("DICTDB")).
  FIND _File "_Field" NO-LOCK.
  permit = permit AND CAN-DO(_Can-read,USERID("DICTDB")).
END.  
IF NOT permit THEN DO:
  MESSAGE "You do not have permission to use this option"
    VIEW-AS ALERT-BOX ERROR BUTTONS OK.
  RETURN.
END.

header_str = "Database: " + p_PName + " (" + p_DbType + ")" +
      	     STRING("", "x(8)") + "Table: " + p_TblName.

RUN adecomm/_report.p 
   (INPUT p_DbId, 
    INPUT header_str,
    INPUT "Table Relations Report",
    INPUT "",
    INPUT p_Btns,
    INPUT "adecomm/_treldat.p",
    INPUT p_TblName,
    INPUT {&Table_Relations_Report}).

RETURN RETURN-VALUE.

/* _trelrpt.p - end of file */ 





/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/*----------------------------------------------------------------------------

File: _trigdat.p

Description:
   Produce a report on all the schema triggers that indicate where the 
   specified procedure is found (full path) and what the CRC status is.

Input Parameters:
   p_DbId    - Id of the _Db record for this database.

Author: Laura Stern

Date Created: 11/18/92 

Modified on 06/14/94 by Gerry Seidl. Added NO-LOCKs to file accesses.
            07/10/98 by D. McMann    Added DBVERSION and _Owner check.
----------------------------------------------------------------------------*/


DEFINE INPUT PARAMETER p_DbId AS RECID NO-UNDO.

DEFINE SHARED STREAM rpt.

Define var crc_val as integer NO-UNDO.
Define var name	   as char    NO-UNDO.
Define var event   as char    NO-UNDO.
Define var proc    as char    NO-UNDO.
Define var crc     as char    NO-UNDO.
Define var any_t   as logical NO-UNDO.  /* any table triggers listed */.
Define var any_f   as logical NO-UNDO.  /* any field triggers listed  */
Define var flags   as char    NO-UNDO.

FORM
   name  FORMAT "x(18)"  COLUMN-LABEL "Table/Field Name"
   event FORMAT "x(6)"   COLUMN-LABEL "Event"
   crc   FORMAT "x(5)"   COLUMN-LABEL "Check!CRC"
   flags FORMAT "x(5)"   COLUMN-LABEL "Flags"
   proc  FORMAT "x(38)"  COLUMN-LABEL "Procedure"
   WITH FRAME shotrig USE-TEXT STREAM-IO DOWN.

FIND _Db WHERE RECID(_Db) = p_DbId NO-LOCK.

/* Go through all tables */
for each _File NO-LOCK where _File._Db-recid = p_DbId:
   IF INTEGER(DBVERSION("DICTDB")) > 8 AND 
     (_File._Owner <> "PUB" AND _File._Owner <> "_FOREIGN")
       THEN NEXT.
   any_t = no.
   for each _File-trig of _File NO-LOCK: 
      assign
      	 name = (if NOT any_t then _File._File-name else "")
      	 any_t = yes
      	 event = ( if _File-trig._Event begins "REPLICATION"
      	             then "RP-" + substring(_File-trig._Event,13,-1,"character")
      	             else _File-trig._Event
      	         )
      	 proc = SEARCH(_File-trig._Proc-Name)
      	 rcode-info:filename = proc
      	 crc_val = rcode-info:crc-value
      	 crc = (if _File-trig._Trig-CRC = ? then "no" else "yes")
      	 flags = (if _File-trig._Override then "*" else "") + 
      	       	 (if crc = "yes" AND crc_val = ? then "nr" else "") +
      	       	 (if crc = "yes" AND crc_val <> ? AND
      	       	     crc_val <> _File-trig._Trig-CRC
      	       	     then "m" else "")
      	 .

      /* In case procedure is in a library, just display name even though
      	 we couldn't find the file.
      */
      if proc = ? then proc = _File-trig._Proc-Name.

      display STREAM rpt
      	 name event crc flags proc with frame shotrig.
      down STREAM rpt with frame shotrig.
   end.

   /* Field info will be interspersed throughout the report, each
      under the table it belongs to.
   */
   for each _Field of _File NO-LOCK:

      any_f = no.
      for each _Field-trig of _Field NO-LOCK:
      	 /* If the table name hasn't been listed yet, display it so user
      	    knows what tables these fields belong to. 
      	 */
      	 if NOT any_t then
      	 do:
      	    display STREAM rpt
      	       _File._File-name @ name with frame shotrig.
      	    down STREAM rpt with frame shotrig.
      	    any_t = yes.
      	 end.
      	 
	 assign
      	    /* field name will be indented slightly from file name */
      	    name = (if NOT any_f then "  " + _Field._Field-Name else "")
      	    any_f = yes
	    event = _Field-trig._Event
	    proc = SEARCH(_Field-trig._Proc-Name)
	    rcode-info:filename = proc
	    crc_val = rcode-info:crc-value
	    crc = (if _Field-trig._Trig-CRC = ? then "no" else "yes")
      	    flags = (if _Field-trig._Override then "*" else "") + 
      	       	    (if crc = "yes" AND crc_val = ? then "nr" else "") +
      	       	    (if crc = "yes" AND crc_val <> ? AND
      	       	     	crc_val <> _Field-trig._Trig-CRC
      	       	     	then "m" else "")
      	 .
   
      /* In case procedure is in a library, just display name even though
      	 we couldn't find the file.
      */
      if proc = ? then proc = _Field-trig._Proc-Name.

	 display STREAM rpt
	    name event crc flags proc with frame shotrig.
	 down STREAM rpt with frame shotrig.
      end.
   end.

   /* Put an extra line between tables */   
   down STREAM rpt with frame shotrig.
end.




/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/*----------------------------------------------------------------------------

File: trigrpt.p

Description:
   Trigger report for both the GUI and character dictionary.
 
Input Parameters:
   p_DbId   - Id of the _Db record corresponding to the current database
   p_PName  - Physical name of the database
   p_DbType - Database type (e.g., PROGRESS)

Author: Laura Stern

Date Created: 11/19/92

Modified on 06/14/94 by Gerry Seidl. Added NO-LOCKs on file accesses.
            07/10/98    D. McMann    Added DBVERSION and _Owner check
            03/29/99    Mario B      BUG# 99-03-26-019, see comment below, also changed 
                                     DBNAME to DICTDB on conditional expression that 
                                     tests for db version.
----------------------------------------------------------------------------*/

{adecomm/commeng.i}  /* Help contexts */

DEFINE INPUT PARAMETER p_DbId 	 AS RECID NO-UNDO.
DEFINE INPUT PARAMETER p_PName 	 AS CHAR  NO-UNDO.
DEFINE INPUT PARAMETER p_DbType  AS CHAR  NO-UNDO.

DEFINE VAR header_str AS CHAR 	 NO-UNDO.
DEFINE VAR flags      AS CHAR 	 NO-UNDO.
DEFINE VAR can_see    AS LOGICAL NO-UNDO init yes.

IF INTEGER(DBVERSION("DICTDB")) > 8 THEN 
DO:
  FIND _File WHERE _File._File-name = "_File" 
               AND _File._Owner = "PUB" NO-LOCK.
  IF NOT CAN-DO(_File._Can-read,USERID("DICTDB")) THEN can_see = no.
  IF can_see THEN DO:
    FIND _File WHERE _File._File-name = "_File-trig" 
                 AND _File._Owner = "PUB" NO-LOCK.
    IF NOT CAN-DO(_File._Can-read,USERID("DICTDB")) THEN can_see = no.
  END.
  IF can_see THEN DO:
    FIND _File WHERE _File._File-name = "_Field-trig" 
                 AND _File._Owner = "PUB" NO-LOCK.
    IF NOT CAN-DO(_File._Can-read,USERID("DICTDB")) THEN can_see = no.
  END.
END.
ELSE DO:
  FIND _File "_File" NO-LOCK.
  IF NOT CAN-DO(_File._Can-read,USERID("DICTDB")) THEN can_see = no.
  IF can_see THEN DO:
    FIND _File "_File-trig" NO-LOCK.
    IF NOT CAN-DO(_File._Can-read,USERID("DICTDB")) THEN can_see = no.
  END.
  IF can_see THEN DO:
    FIND _File "_Field-trig" NO-LOCK.
    IF NOT CAN-DO(_File._Can-read,USERID("DICTDB")) THEN can_see = no.
  END.
END.  
IF NOT can_see THEN DO:
  MESSAGE "You do not have permission to use this option."
    VIEW-AS ALERT-BOX ERROR BUTTONS OK.
  RETURN.
END.

ASSIGN can_see = FALSE.

IF INTEGER(DBVERSION("DICTDB")) > 8 THEN 
DO:

  FOR EACH _File WHERE (_File._Owner = "PUB" OR _File._Owner = "_FOREIGN")
                   NO-LOCK.
    FIND LAST _File-trig OF _File NO-LOCK NO-ERROR.
    IF NOT AVAILABLE _File-trig THEN DO:
      FIND LAST _Field-trig OF _File NO-LOCK NO-ERROR.
      IF AVAILABLE _Field-trig THEN ASSIGN can_see = TRUE.
    END.
    ELSE ASSIGN can_see = true.
    IF can_see THEN LEAVE.
  END.    
END.
ELSE do:
  FIND LAST _File-trig NO-LOCK NO-ERROR.
  IF NOT AVAILABLE _File-trig THEN DO: 
    FIND LAST _Field-trig NO-LOCK NO-ERROR.
    IF NOT AVAILABLE _Field-trig THEN
       ASSIGN can_see = TRUE.   
  END.
  ELSE ASSIGN can_see = TRUE.  
/* BUG# 99-03-26-019.  This leaves the procedure.  We're going to leave the    *
 * block on the very next statement "END" anyway, so what purpose could this   *
 * have served here?  Seems the intent was probably to leave the block.        *
 * IF can_see THEN LEAVE.                                                      */

END.  

IF NOT can_see THEN DO:
   MESSAGE "There are no triggers in this database to look at."
     	VIEW-AS ALERT-BOX ERROR BUTTONS OK.
    RETURN.
END.

header_str = "Database: " + p_PName + " (" + p_DbType + ")".
flags = "Flags: * = overridable, 'm' = mismatched crc, 'nr' = no r-code found".
RUN adecomm/_report.p 
   (INPUT p_DbId, 
    INPUT header_str,
    INPUT "Trigger Report",
    INPUT flags,
    INPUT "",
    INPUT "adecomm/_trigdat.p",
    INPUT "",
    INPUT {&Trigger_Report}).

/* _trigrpt.p - end of file */





/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/*----------------------------------------------------------------------------

File: _tblbrws.p

Description:
   Browse the tables for a given database. This database must
   be aliased to DICTDB before this routine is called.  If the database
   is a foreign database, the schema holder database must have this alias.
   This procedure must be run persistently.
   
Input Parameters: (for the calling programs)
   p_dlg       - Frame handle needed to parent the frame created in this 
                 procedure.
   parent-proc - Handle of the calling dialog so that we can run its
                 internal procedures (methods).
   p_multi     - Logical: True if multiple items can be returned.
   p_rw        - The row of the browse within its parent (p_dlg).
   p_tc        - The column of the brwose within its parent (p_dlg).
   p_DbId      - The recid of the _Db record which corresponds to the
                 database that we want the tables from.
   in-value    - Comma delimited list of tables to select initially
             
Output Parameters:
   h_tbl_brws - Handle of browse created in this routine.
   p_Stat     - Set to true if list is retrieved (even if there were no tables
      	         this is successful).  Set to false, if user doesn't have access
      	         to tables.

Author: Ross Hunter

Date Created: 11/01/96 

----------------------------------------------------------------------------*/
{adecomm/_adetool.i} /* Identify this procedure as part of the ADE */
{adecomm/tt-brws.i}  /* Temp-tables to browse                      */

{adecomm/ttblbrws.i &HGHT = "6.9" &WDTH = "25" &FLDS = "NO"}

/* _ttblbrs.p - end of file */

/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/*----------------------------------------------------------------------------

File: _tfbrws.p

Description:
   Browse the tables and fields for a given database. This database must
   be aliased to DICTDB before this routine is called.  If the database
   is a foreign database, the schema holder database must have this alias.
   This procedure must be run persistently.

Input Parameters:
   p_dlg       - Frame handle needed to parent the frame created in this 
                 procedure.
   parent-proc - Handle of the calling dialog so that we can run its
                 internal procedures (methods).
   p_multi     - Logical: True if multiple items can be returned.
   p_rw        - The row of the browse within its parent (p_dlg).
   p_tc        - The column of the brwose within its parent (p_dlg).
   p_DbId      - The recid of the _Db record which corresponds to the
                 database that we want the tables from.
   in-value    - Comma delimited list of tables to select initially
   p_DType     - ? if not a specific data-type
             
Output Parameters:
   h_tbl_brws - Handle of table browse created in this routine.
   h_fld_brws - Handle of field browse created in this routine.
   p_Stat     - Set to true if list is retrieved (even if there were no tables
      	         this is successful).  Set to false, if user doesn't have access
      	         to tables.

Author: Ross Hunter

Date Created: 11/01/96

----------------------------------------------------------------------------*/
{adecomm/_adetool.i} /* Identify this procedure as part of the ADE */
{adecomm/tt-brws.i}  /* Temp-tables to browse                      */

{adecomm/ttblbrws.i &HGHT = "6.9" &WDTH = "18.5"  &FLDS = "YES"}

/* _ttfbrws.p - end of file */

/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/*--------------------------------------------------------------------
File: _ttysr.p

Description:
    This routine is part of the UIB Character Run Window capability,
    which consists of the following procedures, scripts/batch files:

    * adeuib/_ttyss.p  PROGRESS
          Establishes the PROGRESS Winchar client session by calling
          _progres directly (Windows).
          Writes the RUN messages via the character message/command
          file (e.g., p12345m.tty) to the PROGRESS Character session.

    * adecomm/_ttysr.p  PROGRESS
          Startup procedure of the PROGRESS Character session which
          executes the UIB temp file in the Character Run Window
          (xterm under Motif; DOS Shell under Windows).

    * adeuib/_ttysx.p  PROGRESS
          Closes the Character Run Window by deleting the command .tty file.

    * $DLC/bin/ttysx     /dev/sh
          Executes the UIB Character Run Window as a UNIX character client
          in an xterm window.

    * <run_tty_name>  UNIX/DOS-file
          Used as message/command channel between UIB and its Character Run
          Window. Has the form "p12345m.tty".
                                                     
Input-Parameters:

Output-Parameters:
    
Author:  John Palazzo, adapted from 7.3A (Tom Hutegger).
    
History:
    jep         94/10/24    Updated for running under Unix and DOS.
    hutegger    94/02/04    Created.
--------------------------------------------------------------------*/        

/*----------------------------  PREPROCESSOR ---------------------------*/

DEFINE VARIABLE dlc_dir      AS CHARACTER                 NO-UNDO.
DEFINE VARIABLE dlcbin_dir   AS CHARACTER                 NO-UNDO.
DEFINE VARIABLE tty_command  AS CHARACTER                 NO-UNDO.
DEFINE VARIABLE db_connects  AS CHARACTER                 NO-UNDO.
DEFINE VARIABLE cmd_i        AS INTEGER                   NO-UNDO.
DEFINE VARIABLE os_slash     AS CHARACTER                 NO-UNDO.

DEFINE VARIABLE command      AS CHARACTER FORMAT "x(72)"  NO-UNDO.
DEFINE VARIABLE cmd_line     AS CHARACTER FORMAT "x(256)" NO-UNDO.
DEFINE VARIABLE run_tty_name AS CHARACTER FORMAT "x(40)"  NO-UNDO.
DEFINE VARIABLE debug_set    AS LOGICAL                   NO-UNDO.
DEFINE VARIABLE tty_init     AS LOGICAL                   NO-UNDO.
DEFINE VARIABLE code_page    AS CHARACTER                 NO-UNDO.

/*--------------------  LANGUAGE-DEPENDENCIES  ---------------------*/

DEFINE VARIABLE errmsg       AS CHARACTER FORMAT "x(72)" EXTENT 5
   INITIAL [
   /*  1 */ "Received no procedure.  Exiting...      ",                 
   /*  2 */ "Initializing Character Run Window...    ",
   /*  3 */ "           Cannot find file:            ",                 
   /*  4 */ "       Received unknown command:        ",
   /*  5 */ "Procedure complete. Waiting for next run."
           ].
   /*       "....+....1....+....22....+....1....+...."        */

DEFINE VARIABLE errstat       AS CHARACTER FORMAT "x(10)" EXTENT 2
    INITIAL [
   /*  1 */ "unknown-command",
   /*  2 */ "unknown-file"                      ].


/*-----------------------------  FORMS  ----------------------------*/

FORM
  command skip
  cmd_line  format "x(76)"
  with centered row 12
  overlay no-labels
  title "  ERROR  "
  frame fehler.
  
FORM
  command skip
  cmd_line  format "x(76)"
  with centered row 2
  overlay no-labels
  title "  Status  "
  frame protocol.

MAIN:
DO:

/* Initialize some variables. */
/* For run_tty_name, on UNIX we could query OS-GETENV("RUN_TTY_NAME")
   as well. For consistency, we'll read the SESSION:PARAM like we do
   for DOS.
*/
ASSIGN run_tty_name = SESSION:PARAM
       tty_init     = TRUE
. /* END ASSIGN */

/* If we didn't get the base name of the UIB's TTY message file, report
   an error and QUIT.
*/
IF run_tty_name = "" OR run_tty_name = ? THEN
DO:
    DISPLAY
        errmsg[1] @ command WITH FRAME fehler.
    QUIT.
END.

/* Initialize some more variables. */

GET-KEY-VALUE SECTION "WinChar Startup" KEY "DLC" VALUE dlc_dir.
IF dlc_dir = ? OR dlc_dir = "" THEN
  ASSIGN dlc_dir = OS-GETENV ("DLC").
IF dlc_dir = ? THEN
  ASSIGN dlc_dir = "c:/dlc".


ASSIGN tty_command  = run_tty_name
       os_slash     = ( IF LOOKUP(OPSYS , "MSDOS,WIN32":u) > 0
                        THEN "~\" ELSE "/" )
       dlcbin_dir   = dlc_dir + os_slash + "bin" + os_slash
       code_page    = SESSION:STREAM
. /* END ASSIGN */

TTY_RUN:
REPEAT WHILE cmd_line <> "OK-EXIT"
       ON QUIT,       LEAVE TTY_RUN
       ON STOP  UNDO, LEAVE TTY_RUN
       ON ERROR UNDO, LEAVE TTY_RUN:

    HIDE ALL NO-PAUSE.
    DISPLAY
        errmsg[IF tty_init then 2 else 5] @ command
        WITH FRAME protocol.
    IF tty_init = TRUE THEN
        ASSIGN tty_init = FALSE.
        
    /* Now loop and wait until the UIB session sends a message. */
    READ_COMMAND:
    DO WHILE TRUE:
        /* Pause a second to allow time for UIB session to write its command
           message into the message file.
        */
        PAUSE 1 NO-MESSAGE. 
        /* If the tty message file has been deleted, that indicates its
           time to terminate the tty client session.
        */
        IF ( SEARCH( tty_command ) = ? ) THEN LEAVE TTY_RUN.
        
        /* Read the contents of the command file and take action. */ 
        INPUT FROM VALUE( tty_command ) NO-ECHO.
        IMPORT UNFORMATTED cmd_line.
        
        /* Check the command file's stream code page. If its not the
           same as this session's, we must reopen the file with the
           correct stream code page. 
           
           The stream code page for the command file is the first
           item in the command string.
           
           For example:  "ibm850|RUN|p12345|DB=-db demo -ld demo"
        */
        ASSIGN code_page = ENTRY( 1 , cmd_line , "|") .
        IF code_page <> SESSION:STREAM THEN
        DO:
            INPUT CLOSE.
            INPUT FROM VALUE( tty_command ) NO-ECHO CONVERT SOURCE code_page.
            IMPORT UNFORMATTED cmd_line.
        END.
        INPUT CLOSE.

        /* Remove the stream code page information and its delimiter
           from the cmd_line.
        */
        ASSIGN cmd_line = REPLACE( cmd_line , code_page + "|" , "" ).
        
        /* If we received a message back from the UIB session, then we exit
           the loop and process the command.
        */
        IF cmd_line BEGINS "RUN" THEN LEAVE READ_COMMAND.
    END. 

    /* If there are databases to connect, cmd_line has the form:
          RUN|p12345|DB=-db demo -ld demo -db sports -ld sports

       We strip out database connection information into db_connects and use it
       in a CONNECT statement. If there are no databases to connect, the "|DB="
       will not be in the command string.
    */
    ASSIGN cmd_i = INDEX( cmd_line , "|DB=" )
    . /* END ASSIGN */
    IF ( cmd_i <> 0 ) THEN DO:
        db_connects = SUBSTRING(cmd_line,cmd_i + LENGTH("|DB=":u,"CHARACTER":u),
                                -1,"CHARACTER":u).

        /* CheckConnected removes from the db connection list any db's that
           are already connected. This can happen if the user specifies
           databases in the PROGRESS default parameter file startup.pf.
        */
        IF NUM-DBS > 0 THEN
            RUN CheckConnected ( INPUT-OUTPUT db_connects ).

        /* Connect the databases. */
        IF ( db_connects <> "" ) THEN
        DO ON STOP  UNDO TTY_RUN, LEAVE TTY_RUN
           ON ERROR UNDO TTY_RUN, LEAVE TTY_RUN:
            CONNECT VALUE( db_connects ).
        END.
        /* Strip off the database connect info from cmd_line, leaving
           RUN|p12345.
        */
        ASSIGN cmd_line = SUBSTRING(cmd_line,1,cmd_i - 1,"CHARACTER":u).
    END.

    /* Parse the UIB TTY command. */    
    ASSIGN
        cmd_i   = INDEX(cmd_line,"|":u)
        command = (IF cmd_i = 0 THEN cmd_line
                   ELSE SUBSTRING(cmd_line,1,cmd_i - 1,"CHARACTER":u))
        cmd_line = SUBSTRING(cmd_line,cmd_i + 1,-1,"CHARACTER":u)
    . /* END ASSIGN */

    /* Process and execute the command, such as run the UIB temp file. */
    CASE command:
    
        WHEN "RUN" OR WHEN "RUN-DEBUG" THEN DO:
            IF SEARCH( cmd_line ) <> ? THEN DO:
                HIDE ALL NO-PAUSE.
                DO ON STOP UNDO, LEAVE:
                    /* Without this set to true, Progress messages can flash
                       by and be unreadble.
                    */
                    ASSIGN SESSION:SYSTEM-ALERT-BOXES = TRUE.
                    IF command = "RUN-DEBUG" THEN
                        ASSIGN debug_set = DEBUGGER:INITIATE()
                               debug_set = DEBUGGER:SET-BREAK( cmd_line , -1).

                    RUN VALUE( cmd_line ).
                END.
                ASSIGN cmd_line = "OK".
      
                /* Clean up after a Debugger Run */
                IF command = "RUN-DEBUG" THEN
                     ASSIGN DEBUGGER:VISIBLE = FALSE
                            debug_set        = DEBUGGER:CLEAR().
            END.
            ELSE DO:
              PAUSE 0 NO-MESSAGE.
              DISPLAY
                errmsg[3] @ command 
                SUBSTRING(cmd_line,
                  MAXIMUM(LENGTH(cmd_line,"CHARACTER":u) - 26,1),-1,
                  "CHARACTER":u) @ cmd_line
              WITH FRAME fehler.
              ASSIGN cmd_line = errstat[2].
            END.
        END.
        
        WHEN "OK-EXIT" THEN ASSIGN cmd_line = "OK-EXIT".
        
        OTHERWISE DO:
            PAUSE 0 NO-MESSAGE.
            DISPLAY errmsg[4] @ command cmd_line with frame fehler.
            ASSIGN cmd_line = errstat[1].
        END.
    END. /* CASE */
   
   IF SEARCH( tty_command ) <> ? THEN DO:
       /* Add the stream code page to command string. */
       ASSIGN cmd_line = code_page + "|" + cmd_line .
       OUTPUT TO VALUE( tty_command ) UNBUFFERED NO-ECHO
                 CONVERT TARGET code_page .
       PUT UNFORMATTED cmd_line SKIP.
       OUTPUT CLOSE.
   END.

END.    /* TTY_RUN: REPEAT */

/* Clean up UIB tty session and quit Progress DOS client. */
HIDE ALL NO-PAUSE.
OS-DELETE VALUE( tty_command ).
QUIT.

END. /* MAIN */


PROCEDURE CheckConnected .
  /* Given a db connection list, return a db connection list without
     the databases that are already connected.
  */
  DEFINE INPUT-OUTPUT PARAMETER p_db_connects AS CHARACTER NO-UNDO.

  DEFINE VARIABLE ldb_name AS CHARACTER NO-UNDO.
  DEFINE VARIABLE db_entry AS CHARACTER NO-UNDO.
  DEFINE VARIABLE db_i     AS INTEGER   NO-UNDO.

  DO db_i = 1 TO NUM-DBS:
      IF p_db_connects = "" THEN LEAVE.
      ASSIGN ldb_name = LDBNAME( db_i ).
      IF DBTYPE( ldb_name ) <> "PROGRESS":U THEN NEXT.
      /* If the connected database is also on our list, remove it. */
      IF INDEX( p_db_connects , "-ld " + ldb_name ) > 0 THEN
      DO:
          ASSIGN db_entry = "-db " + PDBNAME( db_i ) + " " +
                            "-ld " + ldb_name .
          /* Remove this db from the connect list passed. */
          ASSIGN p_db_connects = TRIM(REPLACE(p_db_connects , db_entry , "")) .
      END.
  END.

END PROCEDURE.
/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/*----------------------------------------------------------------------------

File: valname.p

Description:
   Check to see that a name entered by the user is a valid PROGRESS 
   identifier.
 
Input Parameter:
   p_name      	  - The name to check
   p_allow_blanks - True if name can be blank or unknown.  Often we want
      	       	    to allow this so the user can TAB to the cancel button,
      	       	    for example.  However, if the field is defaulted to
      	       	    start with, the user must intentionally blank it out.  
      	       	    If he does so, we will flag it as an error.

Ouput Parameter:
   p_okay - Set to True if name is valid.

Author: Tony Lavinio, Laura Stern

Date Created: ? 

----------------------------------------------------------------------------*/

define input  parameter p_name 	       as char NO-UNDO.
define input  parameter p_allow_blanks as logical NO-UNDO.
define output parameter p_okay         as logical NO-UNDO.

define var i as integer NO-UNDO.

if p_name = "" OR p_name = ? OR p_name = "?" then
do:
   if p_allow_blanks then
      p_okay = true.
   else do:
      p_okay = false.
      message "Please enter a value for the name." SKIP
      	      "It may not be left blank or unknown."
      	      view-as ALERT-BOX ERROR buttons OK.
   end.
   return.
end.

p_okay = false.
IF LENGTH(p_name,"RAW":U) > 32 then
   message "This name is too long." SKIP
      	   "Please enter a name that has 32 characters or less."
      	    view-as ALERT-BOX ERROR buttons OK.

else if SUBSTRING(p_name,1,1,"CHARACTER":u) < "A":u OR 
        SUBSTRING(p_name,1,1,"CHARACTER":u) > "Z":u THEN
   message "A valid PROGRESS identifier must start with a letter." SKIP
      	   "Please enter another name."
      	    view-as ALERT-BOX ERROR buttons OK.

else if KEYWORD(p_name) <> ? then
   message "This name is a PROGRESS keyword." SKIP
      	   "Please enter another name."
      	    view-as ALERT-BOX ERROR buttons OK.

else do:
   p_okay = true.
   do i = 2 to LENGTH(p_name,"RAW":u) while p_okay:
      p_okay = INDEX("#$%&-_0123456789ETAONRISHDLFCMUGYPWBVKXJQZ",
		     SUBSTRING(p_name,i,1,"CHARACTER":u)) > 0.
   end.
   if NOT p_okay then
      message "This name contains at least one invalid character: " + 
      	      SUBSTRING(p_name,i - 1,1,"CHARACTER":u)  SKIP
      	      "Please enter another name."
      	       view-as ALERT-BOX ERROR buttons OK.
end.



/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/*----------------------------------------------------------------------------

File: _valpnam.p

Description:
   Check if an internal procedure name is a valid PROGRESS Internal
   Procedure name. OR check if an external name is valid for PROGRESS
   to recognize.
 
Input Parameter:
   p_name         - The PROGRESS internal procedure name to check.

   p_show_message - If TRUE, invalid name messages are displayed.
                    If FALSE, no messages are displayed.

   p_options      - 

          "_INTERNAL" - Check for valid internal procedure name.

          "_EXTERNAL" - Check for valid external procedure name.

Ouput Parameter:
   p_okay - Set to True if name is valid.

Author: John Palazzo

Date Created: May, 1995

----------------------------------------------------------------------------*/

DEFINE INPUT  PARAMETER p_name         AS CHARACTER    NO-UNDO.
DEFINE INPUT  PARAMETER p_show_message AS LOGICAL      NO-UNDO.
DEFINE INPUT  PARAMETER p_options      AS CHARACTER    NO-UNDO.
DEFINE OUTPUT PARAMETER p_okay         AS LOGICAL      NO-UNDO.

DEFINE VARIABLE temp-file       AS CHARACTER    NO-UNDO.       
DEFINE VARIABLE Invalid_Chars   AS CHARACTER    NO-UNDO
                INITIAL "?()=|~{~}<>:, ".
DEFINE VARIABLE i               AS INTEGER      NO-UNDO.

DO ON STOP UNDO, LEAVE: /* MAIN */
    /* Do not support commas in external procedure names. */
    IF p_options = "_EXTERNAL":U THEN ASSIGN Invalid_Chars = ",".
    
    ASSIGN p_name = TRIM(p_name).
    IF p_name = "" OR p_name = ? THEN
    DO:
      IF p_show_message THEN
      MESSAGE "Please enter a value for the name." SKIP
              "It may not be left blank or unknown."
              VIEW-AS ALERT-BOX WARNING IN WINDOW ACTIVE-WINDOW.
      RETURN.
    END.
    
    IF p_options = "_INTERNAL":U AND
       (p_name BEGINS "." OR R-INDEX(p_name, ".") = LENGTH(p_name, "CHARACTER":U)) THEN
    DO:
      IF p_show_message THEN
      MESSAGE "Procedure names cannot begin or end with a period." SKIP
              "Please enter another name."
               VIEW-AS ALERT-BOX WARNING IN WINDOW ACTIVE-WINDOW.
      RETURN.
    END.
    
    ASSIGN p_okay = TRUE.
    DO i = 1 to LENGTH(p_name,"CHARACTER":u) WHILE p_okay:
       ASSIGN p_okay = INDEX(Invalid_Chars ,
                             SUBSTRING(p_name,i,1,"CHARACTER":u)) = 0.
    END.
    IF NOT p_okay AND p_show_message THEN
       MESSAGE p_name SKIP(1)
              "This name contains at least one invalid character: " + 
               SUBSTRING(p_name,i - 1,1,"CHARACTER":u)  SKIP
              "Please enter another name."
              VIEW-AS ALERT-BOX WARNING IN WINDOW ACTIVE-WINDOW.
    RETURN.
END.
/***********************************************************************
* Copyright (C) 2005-2006 by Progress Software Corporation. All rights *
* reserved.  Prior versions of this work may contain portions          *
* contributed by participants of Possenet.                             *
*                                                                      *
***********************************************************************/

/*----------------------------------------------------------------------------

File: _viewas.p

Description:   
   Display and handle the dialog box for specifying a VIEW-AS clause for
   this field.

Input Parameter:
   p_ReadOnly  - True if box should be non-modifiable.
   p_DType     - The currently selected datatype for this field (code #)
   p_DTypeStr  - The character string value of the datatype.

Input-Output Parameter:
   p_Viewas    - The current view-as phrase

Output Parameter:
   p_Modified  - Set to yes if a modification was made, no otherwise.

Author: Laura Stern

Date Created: 08/04/92 
     Modified 06/18/98 Change DTYPE_RAW from 6 to 8 DLM
     Mario B. 12/4/98 Added syntax for LIST-ITEM-PAIRS to COMBO-BOX and
                      SELECTION-LIST.  Modified LIST-ITEMS for consistency.
     D McMann 03/16/99 Changed number of buffer-line for tty editor
  K. McIntosh 09/09/04 Ensure that nothing displays in dialog for field of
                       foreign data-type    
----------------------------------------------------------------------------*/
&GLOBAL-DEFINE WIN95-BTN YES
{adecomm/adestds.i}
{adecomm/adeintl.i}
{adecomm/commeng.i}

Define INPUT            PARAMETER p_ReadOnly as logical NO-UNDO.
Define INPUT            PARAMETER p_DType    as integer NO-UNDO.
Define INPUT            PARAMETER p_DTypeStr as char    NO-UNDO.
Define INPUT-OUTPUT PARAMETER p_Viewas   as char    NO-UNDO.
Define OUTPUT       PARAMETER p_Modified as logical NO-UNDO init no.

/* Symbolic constants for dtype values. These match the underlying dtype
   value. */
&global-define           DTYPE_CHARACTER   1
&global-define           DTYPE_DATE        2
&global-define           DTYPE_LOGICAL     3
&global-define           DTYPE_INTEGER     4
&global-define           DTYPE_DECIMAL     5
&global-define           DTYPE_RAW         8
&global-define           DTYPE_RECID       7
&global-define 	         DTYPE_DATETM      34
&global-define 	         DTYPE_DATETMTZ    40
&global-define 	         DTYPE_INT64       41

Define stream viewas.

/* Each entry is a comma delimited list containing the set of view-as
   widgets that make sense for the data type.
*/
DEFINE VARIABLE ViewAs_Relevant AS CHARACTER EXTENT 9 NO-UNDO INITIAL
   [/* character */  "COMBO-BOX,EDITOR,FILL-IN,RADIO-SET,SELECTION-LIST,TEXT",
    /* date             */  "COMBO-BOX,FILL-IN,RADIO-SET,TEXT",
    /* logical          */  "COMBO-BOX,FILL-IN,RADIO-SET,TEXT,TOGGLE-BOX",
    /* integer          */  "COMBO-BOX,FILL-IN,RADIO-SET,SLIDER,TEXT",
    /* decimal          */  "COMBO-BOX,FILL-IN,RADIO-SET,TEXT",
    /* recid            */  "COMBO-BOX,FILL-IN,RADIO-SET,TEXT",
    /* datetime         */  "FILL-IN",
    /* datetime-tz      */  "FILL-IN",
    /* int64            */  "COMBO-BOX,FILL-IN,RADIO-SET"
   ].

/* Index into ViewAs_Relevant array - will be set based on the data type. */
Define var ix_DTypes as integer NO-UNDO.

/* Form fields */
Define var ViewAs_Choices as char NO-UNDO 
   &IF "{&WINDOW-SYSTEM}" = "TTY" &THEN
      view-as SELECTION-LIST SINGLE INNER-CHARS 15 INNER-LINES 4 SCROLLBAR-V.
   &ELSE
      view-as SELECTION-LIST SINGLE INNER-CHARS 16 INNER-LINES 6.
   &ENDIF

Define var syntax as char NO-UNDO
   view-as EDITOR INNER-CHARS 54 
      &IF "{&WINDOW-SYSTEM}" = "TTY" &THEN
         INNER-LINES 4 BUFFER-LINES 9
      &ELSE
               INNER-LINES 7
      &ENDIF
      .

Define button btn_Ok          label "OK"     {&STDPH_OKBTN} AUTO-GO.
Define button btn_Cancel label "Cancel" {&STDPH_OKBTN} AUTO-ENDKEY.
Define button btn_Copy   
   &IF "{&WINDOW-SYSTEM}" = "TTY" &THEN
      label "Copy Syntax" size 13 by 1.
   &ELSE
      label "&Copy Selected Syntax" size 22 by 1.125.
   &ENDIF

&IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN
   Define button    btn_Help label "&Help" {&STDPH_OKBTN}.
   Define rectangle rect_Btns {&STDPH_OKBOX}.
&ENDIF
FORM
   &IF "{&WINDOW-SYSTEM}" = "TTY" &THEN 
      "Enter VIEW-AS phrase here:       " view-as TEXT at  2 
      SKIP

      p_Viewas  VIEW-AS EDITOR SCROLLBAR-VERTICAL
                INNER-CHARS 73 INNER-LINES 5 
                BUFFER-LINES 6                                    at  2
      SKIP(1)
   
      "To see syntax, select a widget type.       " view-as TEXT at  2 
      btn_Copy at 48
      SKIP
   
      ViewAs_Choices at  2 SPACE(2)
      syntax                                             
   
      {adecomm/okform.i
         &STATUS = no
         &OK     = btn_OK
         &CANCEL = btn_Cancel}
   &ELSE
      SKIP ({&TFM_WID})
      "Enter VIEW-AS phrase here:" view-as TEXT at  2 
      SKIP
   
      p_Viewas  VIEW-AS EDITOR SCROLLBAR-VERTICAL
                INNER-CHARS 70 INNER-LINES 6
                {&STDPH_ED4GL_SMALL}                        at  2
   
      SKIP({&VM_WIDG})
   
      "To see syntax, select a widget type.     " view-as TEXT at  2 
      SKIP({&VM_WID})
   
      ViewAs_Choices at  2 SPACE(2)
      syntax 
      SKIP({&VM_WID})

      btn_Copy at 1 /* will be centered later */

      {adecomm/okform.i
         &BOX    = rect_btns
         &STATUS = no
         &OK     = btn_OK
         &CANCEL = btn_Cancel
         &HELP   = btn_Help}
   &ENDIF

   with frame fld_viewas NO-LABELS 
      DEFAULT-BUTTON btn_OK CANCEL-BUTTON btn_Cancel
      view-as DIALOG-BOX TITLE "View-As Phrase".


/*===============================Triggers====================================*/

/*-----WINDOW-CLOSE-----*/
on window-close of frame fld_viewas
   apply "END-ERROR" to frame fld_viewas.


/*----- SELECTION of OK BUTTON or GO -----*/
on GO of frame fld_viewas  /* or OK because of AUTO-GO */
do:
   Define var tmpfile as char NO-UNDO.
   Define var val     as char NO-UNDO.

   /* If nothing was there in the first place, nothing will change.
      Otherwise, the user's view-as phrase will be replaced with 
      the unknown value.
   */
   val = TRIM(p_Viewas:screen-value in frame fld_viewas).
   if val = "" OR val = "?" OR val = ? then 
   do:
      /* If user comes in with nothing and leaves with nothing, 
               leave modified as no.
      */
      if p_Viewas <> "" AND p_Viewas <> "?" AND p_Viewas <> ? then 
               p_Modified = yes.
      p_Viewas:screen-value in frame fld_viewas = ?.
      return.
   end.

   &IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN 
      run adecomm/_setcurs.p ("WAIT").
   &ENDIF
   run adecomm/_tmpfile.p (INPUT "", INPUT ".dct", OUTPUT tmpfile).
   output stream viewas TO VALUE(tmpfile) {&NO-MAP}.

   put stream viewas CONTROL
      "DEFINE VAR x AS " p_DTypeStr 
      CHR(10)
      p_Viewas:screen-value in frame fld_viewas
      CHR(10).

   output stream viewas CLOSE.

   compile VALUE(tmpfile) NO-ERROR.
   OS-DELETE VALUE(tmpfile).
   &IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN 
      run adecomm/_setcurs.p ("").
   &ENDIF

   if compiler:error then 
   do:
      message "Your VIEW-AS phrase contains a syntax error." SKIP
                    "This statement does not compile:" SKIP(1)
                    "DEFINE VAR x AS" p_DTypeStr SKIP
                    p_Viewas:screen-value in frame fld_viewas SKIP(1)
                    error-status:get-message(1)
                    view-as alert-box error buttons OK.

      p_Viewas:CURSOR-OFFSET in frame fld_viewas = 
        INTEGER(compiler:FILE-OFFSET) - 17 - LENGTH(p_DTypeStr,"CHARACTER":u).
      apply "entry" to p_Viewas in frame fld_viewas.
      return NO-APPLY.
   end.
   else p_Modified = yes.
end.


/*----- VALUE-CHANGED of VIEWAS_CHOICES -----*/
on value-changed of ViewAs_Choices in frame fld_viewas
do:
   Define var cr as char NO-UNDO.  /* Carriage return */

   cr = CHR(10).

   /* Fill 4GL Editor widget with appropriate syntax for this widget
      type. */
   case SELF:screen-value:
      when "COMBO-BOX" then
               syntax:screen-value in frame fld_viewas = 
                  "VIEW-AS COMBO-BOX" + cr +
                  "  [LIST-ITEMS value [,value] ... |" + cr +
            "   LIST-ITEM-PAIRS label,value [,label,value] ...]" + cr +
                  "  [~{SIZE-PIXELS | SIZE-CHARS | SIZE~} width BY height]" + cr +
                  "  [INNER-LINES height]" + cr +
                  "  [SORT] [SUBTYPE]" + cr +
            "  [TOOLTIP <tooltip>]".

      when "FILL-IN" then
               syntax:screen-value in frame fld_viewas = 
                  "VIEW-AS FILL-IN [NATIVE]" + cr +
                  "  [~{SIZE-PIXELS | SIZE-CHARS | SIZE~} width BY height]" + cr +
            "  TOOLTIP <tooltip>]".

      when "EDITOR" then
               syntax:screen-value in frame fld_viewas = 
                  "VIEW-AS EDITOR" + cr +
                  "  ~{~{SIZE-PIXELS | SIZE-CHARS | SIZE~} width BY height |" + cr +
                  "   INNER-CHARS num-chars INNER-LINES num-lines~}" + cr +
                  "  [SCROLLBAR-HORIZONTAL] [SCROLLBAR-VERTICAL]" + cr +
                  "  [MAX-CHARS chars] [NO-WORD-WRAP] [LARGE]" + cr +
                  "  [BUFFER-CHARS chars] [BUFFER-LINES lines]" + cr +
            "  [NO-BOX]" + cr +
            "  [TOOLTIP <tooltip>]".

      when "RADIO-SET" then
               syntax:screen-value in frame fld_viewas = 
                  "VIEW-AS RADIO-SET" + cr +
                  "  RADIO-BUTTONS label, value [,label, value] ..." + cr +
                  "  [HORIZONTAL [EXPAND] | VERTICAL]" + cr +
                  "  [~{SIZE-PIXELS | SIZE-CHARS | SIZE~} width BY height]" + cr +
            "  [TOOLTIP <tooltip>]".

      when "SELECTION-LIST" then
               syntax:screen-value in frame fld_viewas = 
                  "VIEW-AS SELECTION-LIST" + cr +
                  "  ~{~{SIZE-PIXELS | SIZE-CHARS | SIZE~} width BY height |" + cr +
                  "   INNER-CHARS num-chars INNER-LINES num-lines~}~}" + cr +
                  "  [SINGLE | MULTIPLE] [NO-DRAG] [SORT]" + cr +
                  "  [SCROLLBAR-HORIZONTAL]" + cr +
            "  [SCROLLBAR-VERTICAL]" + cr +
                  "  [LIST-ITEMS value [,value] ... |" + cr +
            "   LIST-ITEM-PAIRS label,value [,label,value] ...]" + cr +
            "  [TOOLTIP <tooltip>]".

      when "SLIDER" then
               syntax:screen-value in frame fld_viewas = 
                  "VIEW-AS SLIDER" + cr +
                  "  MAX-VALUE max-value MIN-VALUE min-value" + cr +
                  "  [HORIZONTAL | VERTICAL]" + cr +
                  "  [~{SIZE-PIXELS | SIZE-CHARS | SIZE~} width BY height]" + cr +
            "  [NO-CURRENT-VALUE] [LARGE-TO-SMALL]" + cr +
            "  [TIC-MARKS LEFT|RIGHT|TOP|BOTTOM|NONE|BOTH" + cr +
            "    [FREQUENCY n]]" + cr +
            "  [TOOLTIP <tooltip>]".

      when "TEXT" then
               syntax:screen-value in frame fld_viewas = 
                  "VIEW-AS TEXT" + cr +
                  "  [~{SIZE-PIXELS | SIZE-CHARS | SIZE~} width BY height]" + cr +
            "  [TOOLTIP <tooltip>]".

      when "TOGGLE-BOX" then
               syntax:screen-value in frame fld_viewas = 
                  "VIEW-AS TOGGLE-BOX" + cr +
                  "  [~{SIZE-PIXELS | SIZE-CHARS | SIZE~} width BY height]" + cr +
            "  [TOOLTIP <tooltip>]".
   end.
end.

/*----- CHOOSE of BUTTON COPY -----*/
on choose of btn_Copy in frame fld_viewas
do:
   Define var synhdl  as widget-handle NO-UNDO.
   Define var viewhdl as widget-handle NO-UNDO.
   Define var copytxt as char          NO-UNDO.
   Define var stat    as logical       NO-UNDO.

   synhdl = syntax:HANDLE in frame fld_viewas.
   viewhdl = p_Viewas:HANDLE in frame fld_viewas.

   &IF "{&WINDOW-SYSTEM}" = "TTY" &THEN
      copytxt = synhdl:screen-value.
      viewhdl:screen-value = "".
      stat = viewhdl:insert-string (copytxt).
      apply "entry" to viewhdl.
   &ELSE 
      if synhdl:text-selected then 
      do:
         apply "entry" to synhdl.
         copytxt = synhdl:selection-text.
         apply "entry" to viewhdl.
         /* you can't select text in destination and then select in source
            and have both stay selected so don't bother with replace.
         */
         stat = viewhdl:insert-string (copytxt).
      end.
   &ENDIF
end.

/*----- HELP -----*/
&IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN 
   on HELP of frame fld_viewas OR choose of btn_Help in frame fld_viewas
      RUN "adecomm/_adehelp.p" ("comm", "CONTEXT", 
                                                  {&View_as_Phrase_Dlg_Box}, ?).
&ENDIF


/*==============================Mainline Code================================*/

Define var ix_types  as integer NO-UNDO.
Define var len       as integer NO-UNDO.
Define var widgtype  as char    NO-UNDO.


/* Fill the choices list with the appropriate view-as types.  Don't presume
   to know what the preprocess DTYPE values are, i.e. that they will match
   the index into the ViewAs_Relevant array (actually RECID doesn't).  
*/
ix_DTypes = (if p_DType = {&DTYPE_CHARACTER} then 1 else
             if p_DType = {&DTYPE_DATE}      then 2 else
             if p_DType = {&DTYPE_LOGICAL}   then 3 else
             if p_DType = {&DTYPE_INTEGER}   then 4 else
             if p_DType = {&DTYPE_DECIMAL}   then 5 else
             if p_DType = {&DTYPE_RECID}     then 6 else
             if p_DType = {&DTYPE_DATETM}    then 7 else
             if p_DType = {&DTYPE_DATETMTZ}  then 8 ELSE
             if p_DType = {&DTYPE_INT64}     then 9 ELSE
                   0). /* the 0 case should never happen, 
                          unless it's a foreign data-type */

IF ix_DTypes NE 0 THEN DO:
  ViewAs_Choices:LIST-ITEMS in frame fld_viewas= ViewAs_Relevant[ix_DTypes].

  /* If there is already a value, select the widget choice which matches
     the view-as syntax (if any). 
  */
  if p_Viewas = "" OR p_Viewas = ? then
    Viewas_Choices = ENTRY(1, Viewas_Relevant[ix_DTypes]).
  else do:
    find_match:
    do ix_types = 1 to NUM-ENTRIES(ViewAs_Relevant[ix_DTypes]):
      widgtype = ENTRY(ix_types, ViewAs_Relevant[ix_DTypes]).

      /* All syntax strings should start with the 8 characters:
               "VIEW-AS ", so start at pos 9 and check if there's a match 
               with this type. 
      */
      len = LENGTH(widgtype,"CHARACTER":u).
      if SUBSTRING(p_Viewas,9,len,"CHARACTER":u) = widgtype then
      do:
               ViewAs_Choices = widgtype.
               leave find_match. 
      end.         
    end.
  end.
END.

/* Run time layout for button area. */
&IF "{&WINDOW-SYSTEM}" = "TTY" &THEN
   {adecomm/okrun.i  
      &BOX    = "rect_Btns"
      &FRAME  = "FRAME fld_viewas"
      &OK     = "btn_OK"
      &CANCEL = "btn_Cancel"}
&ELSE
   {adecomm/okrun.i  
      &FRAME = "frame fld_viewas" 
      &BOX   = "rect_Btns"
      &OK    = "btn_OK" 
      &HELP  = "btn_Help"
   }
&ENDIF

p_Viewas:RETURN-INSERT = yes. /* So Return doesn't hit dflt button in editor */
syntax:read-only in frame fld_viewas = yes.
&IF "{&WINDOW-SYSTEM}" = "TTY" &THEN
   /* It looks better 1 row down  for tty */
   syntax:row in frame fld_viewas = syntax:row in frame fld_viewas + 1.
&ELSE
   btn_Copy:column in frame fld_viewas = 
      (frame fld_viewas:width - btn_Copy:width) / 2.
&ENDIF

/* display stuff and cause syntax to show for selected widget */
display Viewas_Choices p_Viewas with frame fld_viewas.
Viewas_Choices:sensitive in frame fld_viewas = yes.
apply "value-changed" to Viewas_Choices in frame fld_viewas.

do ON ERROR UNDO,LEAVE ON ENDKEY UNDO,LEAVE ON STOP UNDO, LEAVE:
   set  p_Viewas           when NOT p_ReadOnly
        &IF "{&WINDOW-SYSTEM}" = "TTY" &THEN
                btn_Copy       when NOT p_ReadOnly
              &ENDIF
        ViewAs_Choices   when NOT p_ReadOnly
              syntax          
        &IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN
                btn_Copy       when NOT p_ReadOnly
              &ENDIF
              btn_OK           when NOT p_ReadOnly
              btn_Cancel
              &IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN
                btn_Help
              &ENDIF
              with frame fld_viewas.

   if NOT p_ReadOnly then
      /* Remove any line feeds (which we get on WINDOWS) */
      p_Viewas = replace (p_Viewas, CHR(13), "").
end.

hide frame fld_viewas.




/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/**************************************************************************
    Procedure:  _wfrun.p
                                       
    Purpose:    Checks to see if another tool is already 'run'ning a 
                procedure. If so, return error. If not, set global var
                called wfRunning to the tools name.
                
                Performs same check to TRANSACTION.

    Syntax :    RUN adecomm/_wfrun.p ( INPUT toolname , OUTPUT rcode ).

    Parameters:
        toolname : Name of calling ADE tool
        rcode    : return code (is something else running?)
    Description:
    Notes  :
    Authors: Gerry Seidl
    Date   : 12/16/94
**************************************************************************/
DEFINE NEW GLOBAL SHARED VARIABLE wfRunning     AS CHARACTER NO-UNDO.

DEFINE INPUT  PARAMETER toolname   AS CHARACTER              NO-UNDO.
DEFINE OUTPUT PARAMETER rcode      AS LOGICAL   INITIAL YES  NO-UNDO.

DEFINE VARIABLE tool_running       AS LOGICAL                NO-UNDO.
DEFINE VARIABLE tool_name          AS CHARACTER              NO-UNDO.

ASSIGN tool_running = (wfRunning <> "" AND wfRunning <> toolname).
IF tool_running OR TRANSACTION THEN
DO:
    ASSIGN tool_name = wfRunning.
    ASSIGN tool_name = ENTRY(1, tool_name) NO-ERROR.
    IF tool_running THEN
    MESSAGE "Cannot run." tool_name "is already running application code."
        VIEW-AS ALERT-BOX ERROR BUTTONS OK IN WINDOW ACTIVE-WINDOW.
    ELSE
    MESSAGE "Cannot run. A transaction is currently active."
        VIEW-AS ALERT-BOX ERROR BUTTONS OK IN WINDOW ACTIVE-WINDOW.
    ASSIGN rcode = YES.
END.
ELSE
    ASSIGN wfRunning = toolname
           rcode     = NO.
/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/
/*----------------------------------------------------------------------------

File: _wincolr.p

Description:
    Get the current Windows foreground & background colors and update two
    unused COLOR-TABLE slots temporarily.  These values are not written to
    the registry, but used for display only by the Choose Color dialog 
    (adecomm/_chscolr.p).

Input Parameters:
    ppfgcolor: (INT) _L parent foreground COLOR-TABLE value
    ppbgcolor: (INT) _L parent background COLOR-TABLE value

Output Parameters:
    pfgcolor:  (INT) New parent foreground value if _L parent is unknown
    pbgcolor   (INT) New parent background value if _L parent if unknown

Author:  D.M.Adams
Created: 08/24/99
----------------------------------------------------------------------------*/          

DEFINE INPUT  PARAMETER ppbgcolor AS INTEGER   NO-UNDO.
DEFINE INPUT  PARAMETER ppfgcolor AS INTEGER   NO-UNDO.
DEFINE OUTPUT PARAMETER pbgcolor  AS INTEGER   NO-UNDO.
DEFINE OUTPUT PARAMETER pfgcolor  AS INTEGER   NO-UNDO.

DEFINE VARIABLE iBGColor  AS INTEGER   NO-UNDO. /* Windows window color */
DEFINE VARIABLE iFGColor  AS INTEGER   NO-UNDO. /* Windows text color */

RUN GetSysColor (8, OUTPUT iFGColor). /* window */
RUN GetSysColor (5, OUTPUT iBGColor). /* text */

/* Set foreground color. Find first unused color slot. */
IF ppfgcolor EQ ? THEN DO:
  DO pfgcolor = 1 TO 255:
    IF COLOR-TABLE:GET-RGB-VALUE(pfgcolor) = 0 THEN LEAVE.
  END.
  IF pfgcolor = 255 THEN DO:
   pfgcolor = ?.
   RETURN.
  END.
  ASSIGN
    COLOR-TABLE:NUM-ENTRIES = pfgcolor + 2
    pfgcolor                = pfgcolor + 1.

  COLOR-TABLE:SET-DYNAMIC(pfgcolor, yes).
  COLOR-TABLE:SET-RGB-VALUE(pfgcolor,iFGColor).
END.
ELSE
  pfgcolor = ppfgcolor.

/* Set background color. Find next unused color slot. */
IF ppbgcolor = ? THEN DO:
  DO pbgcolor = pfgcolor TO 255:
    IF COLOR-TABLE:GET-RGB-VALUE(pbgcolor) = 0 THEN LEAVE.
  END.
  IF pbgcolor = 255 THEN DO:
    pbgcolor = ?.
    RETURN.
  END.
  ASSIGN
    COLOR-TABLE:NUM-ENTRIES = pbgcolor + 2
    pbgcolor                = pbgcolor + 1.

  COLOR-TABLE:SET-DYNAMIC(pbgcolor, yes).
  COLOR-TABLE:SET-RGB-VALUE(pbgcolor,iBGColor).
END.
ELSE
  pbgcolor = ppbgcolor.

/* Win32 API calls */
PROCEDURE GetSysColor EXTERNAL "user32.dll":
  DEFINE INPUT  PARAMETER nIndex    AS LONG.
  DEFINE RETURN PARAMETER iWinColor AS HANDLE TO LONG.
END.

/* Do not erase (dma)
  ASSIGN 
    iRed    = (iWinColor MODULO 256)
    iGreen  = ((iWinColor - iRed) / 256) MODULO 256
    iBlue   = (((iWinColor - iRed) / 256) - iGreen)
    .
*/

/* _wincolr.p - end of file */
&ANALYZE-SUSPEND _VERSION-NUMBER UIB_v8r2 GUI
/* Procedure Description
"Basic Window Template

Use this template to create a new window. Alter this default template or create new ones to accomodate your needs for different default sizes and/or attributes."
*/
&ANALYZE-RESUME
&Scoped-define WINDOW-NAME WinMenu
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _DEFINITIONS WinMenu 
/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/
/*------------------------------------------------------------------------
    File   : adecomm/_winmenu.w

    Purpose: Window Menu Manager Object manages a Window Menu's
             Active Window items.

    Notes  : 

    1.  The Window Menu and Active Window Items

        The Window menu's Active Window menu items are listed on
        the Window menu as follows:

             &Window
             +------------------+
             | Hide Palette     |
             +------------------+
             | &1 Title:1       |   
             |>&2 Title:2       |
             |    ....          |
             | &9 Title:9       |
             | &More Windows... |
             +------------------+

        * The Ampersand (&) indicates the menu access (mnemonic) keys.

        * The Window menu Active Window menu items are identified as the
          items starting from the bottom of the Window menu and going
          up until either there are no more items (all Window menu items
          are Active Window items) or until the first menu RULE is found.

          Given the example above, Hide Palette is not an Active Window
          menu item, but the items 1..9 and More are Active Window items.

        * The Window menu lists only 9 active windows. The menu labels are
          generally the Active Window Title Text. All active window items
          are check items. The (>) character in the example indicates
          the window that the user is currently active in.

        * If there are more than 9 active windows, a More Windows item
          displays as the last Window menu item. If the window the user
          is active in is not shown in the Window menu, the More Windows
          option is checked.

        * Choosing More Windows displays the Select Window dialog which
          lists the Active Window Titles in the order the windows were
          opened - from first opened to last.

        * When the user selects an active window from the Window menu or
          in the Select Window dialog, the Application should make the
          chosen window the active window. If the chosen window is an
          active window item on the Window menu, that item becomes checked.
          If it is not on the Window menu (i.e., part of More Windows),
          then More Windows becomes checked.


    2.  Window Menu Manager Object Responsibilities

        The Window Menu Manager Object Responsibilities are:

            * Add and remove active window menu items to/from a Window
              menu when called to do so by the Application.

            * Automatically renumber, check the active window menu
              item, and display/remove the More Windows menu item as
              active window items are added and removed by the Application.

            * Add new item's label text to Active window delimited list
              maintained in the MoreWindows NAME attribute and then
              make the MoreWindow the checked item.

              The delimited list maintained in the :NAME attribute to allow
              the Window Menu Object  to build the list to display in the Select
              Window dialog box.
              
            * Active Window items are identified by checking :PRIVATE-DATA
              = Unknown (?).

            * Attaches a callback trigger to the calling hProc using
              WinMenuChoose. The input to this procedure is the Label
              of the active window item chosen by the user.
              
              PROCEDURE WinMenuChoose must be maintained and properly
              written by the caller.

            * Displays the Select Windows dialog when the user
              chooses the More Windows option. Then calls PROCEDURE
              WinMenuChoose with the selected window title string.

    Author : J. Palazzo
    Created: April, 1995
    Updated:
------------------------------------------------------------------------*/
/*          This .W file was created with the Progress UIB.             */
/*----------------------------------------------------------------------*/

/* Create an unnamed pool to store all the widgets created 
     by this procedure. This is a good default which assures
     that this procedure's triggers and internal procedures 
     will execute in this procedure's storage, and that proper
     cleanup will occur on deletion of the procedure. */

CREATE WIDGET-POOL.

/* ***************************  Definitions  ************************** */

DEFINE VAR Object-Name  AS CHARACTER INIT "_WINMENU"         NO-UNDO.
DEFINE VAR Ampersand    AS CHARACTER INIT "&"                NO-UNDO.
DEFINE VAR Nul          AS CHARACTER INIT ""                 NO-UNDO.
DEFINE VAR Delim        AS CHARACTER INIT ","                NO-UNDO.
DEFINE VAR Space_Char   AS CHARACTER INIT " "                NO-UNDO.
DEFINE VAR MoreWindows  AS CHARACTER INIT "&More Windows..." NO-UNDO.
DEFINE VAR hLastItem    AS HANDLE                            NO-UNDO.
DEFINE VAR MaxNum       AS INTEGER INIT 9                    NO-UNDO.
DEFINE VAR NextNum      AS INTEGER                           NO-UNDO.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME


&ANALYZE-SUSPEND _UIB-PREPROCESSOR-BLOCK 

/* ********************  Preprocessor Definitions  ******************** */

&Scoped-define PROCEDURE-TYPE Window

/* Name of first Frame and/or Browse and/or first Query                 */
&Scoped-define FRAME-NAME DEFAULT-FRAME

/* Custom List Definitions                                              */
/* List-1,List-2,List-3,List-4,List-5,List-6                            */

/* _UIB-PREPROCESSOR-BLOCK-END */
&ANALYZE-RESUME



/* ***********************  Control Definitions  ********************** */

/* Define the widget handle for the window                              */
DEFINE VAR WinMenu AS WIDGET-HANDLE NO-UNDO.

/* Menu Definitions                                                     */
DEFINE SUB-MENU m_File 
       MENU-ITEM m_File_New     LABEL "&New"           ACCELERATOR "SHIFT-F3"
       MENU-ITEM m_Change_Item  LABEL "&Change Name..."
       MENU-ITEM m_Set_Active   LABEL "Set &Active"   
       MENU-ITEM m_Delete_Item  LABEL "&Delete Item..."
       MENU-ITEM m_File_Exit    LABEL "E&xit"         .

DEFINE SUB-MENU m_Window 
       MENU-ITEM m_Hide_Palette LABEL "Hide &Palette" .

DEFINE MENU MENU-BAR-WinMenu MENUBAR
       SUB-MENU  m_File         LABEL "&File"         
       SUB-MENU  m_Window       LABEL "&Window"       .


/* ************************  Frame Definitions  *********************** */

DEFINE FRAME DEFAULT-FRAME
    WITH 1 DOWN NO-BOX KEEP-TAB-ORDER OVERLAY 
         SIDE-LABELS NO-UNDERLINE THREE-D 
         AT COL 1 ROW 1
         SIZE 80 BY 16.

 

/* *********************** Procedure Settings ************************ */

&ANALYZE-SUSPEND _PROCEDURE-SETTINGS
/* Settings for THIS-PROCEDURE
   Type: Window
   Allow: Basic,Browse,DB-Fields,Window,Query
 */
&ANALYZE-RESUME _END-PROCEDURE-SETTINGS

/* *************************  Create Window  ************************** */

&ANALYZE-SUSPEND _CREATE-WINDOW
IF SESSION:DISPLAY-TYPE = "GUI":U THEN
  CREATE WINDOW WinMenu ASSIGN
         HIDDEN             = YES
         TITLE              = "Window Menu Object"
         HEIGHT             = 16
         WIDTH              = 80
         MAX-HEIGHT         = 16
         MAX-WIDTH          = 80
         VIRTUAL-HEIGHT     = 16
         VIRTUAL-WIDTH      = 80
         RESIZE             = yes
         SCROLL-BARS        = no
         STATUS-AREA        = no
         BGCOLOR            = ?
         FGCOLOR            = ?
         KEEP-FRAME-Z-ORDER = yes
         THREE-D            = yes
         MESSAGE-AREA       = no
         SENSITIVE          = yes.
ELSE {&WINDOW-NAME} = CURRENT-WINDOW.

ASSIGN {&WINDOW-NAME}:MENUBAR    = MENU MENU-BAR-WinMenu:HANDLE.
&ANALYZE-RESUME


/* ***************  Runtime Attributes and UIB Settings  ************** */

&ANALYZE-SUSPEND _RUN-TIME-ATTRIBUTES
/* SETTINGS FOR WINDOW WinMenu
  VISIBLE,,RUN-PERSISTENT                                               */
IF SESSION:DISPLAY-TYPE = "GUI":U AND VALID-HANDLE(WinMenu)
THEN WinMenu:HIDDEN = yes.

/* _RUN-TIME-ATTRIBUTES-END */
&ANALYZE-RESUME

 




/* ************************  Control Triggers  ************************ */

&Scoped-define SELF-NAME WinMenu
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL WinMenu WinMenu
ON END-ERROR OF WinMenu /* Window Menu Object */
OR ENDKEY OF {&WINDOW-NAME} ANYWHERE DO:
  RUN ClosePW.
  APPLY "CLOSE":U TO THIS-PROCEDURE.
  RETURN NO-APPLY.
END.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME


&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL WinMenu WinMenu
ON WINDOW-CLOSE OF WinMenu /* Window Menu Object */
DO:
  /* These events will close the window and terminate the procedure.      */
  /* (NOTE: this will override any user-defined triggers previously       */
  /*  defined on the window.)                                             */
  APPLY "CLOSE":U TO THIS-PROCEDURE.
  RETURN NO-APPLY.
END.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME


&Scoped-define SELF-NAME m_Change_Item
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL m_Change_Item WinMenu
ON CHOOSE OF MENU-ITEM m_Change_Item /* Change Name... */
DO:
  DEFINE VAR hItem      AS HANDLE   NO-UNDO.
  DEFINE VAR OldLabel   AS CHAR     FORMAT "x(30)" NO-UNDO.
  DEFINE VAR NewLabel   AS CHAR     FORMAT "x(30)" NO-UNDO.
  DEFINE VAR hWinMenu   AS HANDLE NO-UNDO.
  
  ASSIGN hItem = SELF:PARENT        /* File Menu */
         hItem = hItem:NEXT-SIBLING /* Window Menu */
         hWinMenu = hItem
         hItem = hWinMenu:LAST-CHILD
         OldLabel = hItem:NAME
         NewLabel = hItem:NAME.
         
  UPDATE OldLabel NewLabel
    WITH FRAME f VIEW-AS DIALOG-BOX IN WINDOW ACTIVE-WINDOW.
  
  RUN WinMenuChangeName IN THIS-PROCEDURE
      (INPUT hWinMenu ,
       INPUT OldLabel ,
       INPUT NewLabel ).
       
END.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME


&Scoped-define SELF-NAME m_Delete_Item
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL m_Delete_Item WinMenu
ON CHOOSE OF MENU-ITEM m_Delete_Item /* Delete Item... */
DO:
  DEFINE VAR hItem          AS HANDLE   NO-UNDO.
  DEFINE VAR hWinMenu       AS HANDLE   NO-UNDO.
  DEFINE VAR ActiveWindows  AS CHARACTER FORMAT "x(60)" 
                            VIEW-AS EDITOR SIZE 60 BY 5 NO-UNDO.
  DEFINE VAR ActiveItem     AS CHARACTER FORMAT "x(40)" NO-UNDO.
  
  ASSIGN hItem = SELF:PARENT        /* File Menu */
         hItem = hItem:NEXT-SIBLING /* Window Menu */
         hWinMenu = hItem
         . /* END ASSIGN */         

  RUN WinMenuGetActive IN THIS-PROCEDURE
      (OUTPUT ActiveWindows , OUTPUT ActiveItem ).
  
  UPDATE ActiveWindows SKIP
         ActiveItem
    WITH FRAME f VIEW-AS DIALOG-BOX IN WINDOW ACTIVE-WINDOW.

  RUN WinMenuRebuild IN THIS-PROCEDURE
      (INPUT hWinMenu ,
       INPUT ActiveWindows ,
       INPUT ActiveItem ,
       INPUT THIS-PROCEDURE ).
       
END.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME


&Scoped-define SELF-NAME m_File_Exit
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL m_File_Exit WinMenu
ON CHOOSE OF MENU-ITEM m_File_Exit /* Exit */
DO:
  APPLY "WINDOW-CLOSE" TO {&WINDOW-NAME} .
END.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME


&Scoped-define SELF-NAME m_File_New
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL m_File_New WinMenu
ON CHOOSE OF MENU-ITEM m_File_New /* New */
DO:
  DEFINE VAR hMenuItem  AS HANDLE NO-UNDO.
  

/*  RUN NewPW IN THIS-PROCEDURE. */
  
  RUN WinMenuAddItem IN THIS-PROCEDURE
     (INPUT   MENU m_Window:HANDLE ,
      INPUT   "Procedure Untitled:" + STRING( RANDOM(1,9) , "9") ,
      INPUT   THIS-PROCEDURE ).

END.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME


&Scoped-define SELF-NAME m_Set_Active
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL m_Set_Active WinMenu
ON CHOOSE OF MENU-ITEM m_Set_Active /* Set Active */
DO:
  DEFINE VAR hItem      AS HANDLE   NO-UNDO.
  DEFINE VAR hWinMenu   AS HANDLE   NO-UNDO.
  DEFINE VAR ItemName   AS CHAR     FORMAT "x(30)" NO-UNDO.
  
  ASSIGN hItem = SELF:PARENT        /* File Menu */
         hItem = hItem:NEXT-SIBLING /* Window Menu */
         hWinMenu = hItem
         hItem = hItem:FIRST-CHILD  /* Hide Palette */
         hItem = hItem:NEXT-SIBLING /* Rule */
         hItem = hItem:NEXT-SIBLING
         ItemName = hItem:NAME
         . /* END ASSIGN */         
  
  UPDATE ItemName
    WITH FRAME f VIEW-AS DIALOG-BOX IN WINDOW ACTIVE-WINDOW.
  
  RUN WinMenuSetActive IN THIS-PROCEDURE
      ( INPUT hWinMenu , INPUT ItemName ).
       
END.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME


&UNDEFINE SELF-NAME

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _MAIN-BLOCK WinMenu 


/* ***************************  Main Block  *************************** */

/* This reference prevents the adecomm/_runcode.p procedure from deleting
   this persistent procedure.
*/
{adecomm/_adetool.i}

/* Don't set CURRENT-WINDOW. Dialog boxes should use ACTIVE-WINDOW. */
ASSIGN THIS-PROCEDURE:CURRENT-WINDOW = {&WINDOW-NAME}.

/* The CLOSE event can be used from inside or outside the procedure to  */
/* terminate it.                                                        */
ON CLOSE OF THIS-PROCEDURE 
   RUN disable_UI.

/* Best default for GUI applications is...                              */
PAUSE 0 BEFORE-HIDE.

/* Now enable the interface and wait for the exit condition.            */
/* (NOTE: handle ERROR and END-KEY so cleanup code will always fire.    */
MAIN-BLOCK:
DO ON ERROR   UNDO MAIN-BLOCK, LEAVE MAIN-BLOCK
   ON END-KEY UNDO MAIN-BLOCK, LEAVE MAIN-BLOCK:

  /* Enable the UI only of the window is not suppresed. */
  IF NOT {&WINDOW-NAME}:HIDDEN THEN
    RUN enable_UI.
  IF NOT THIS-PROCEDURE:PERSISTENT THEN
    WAIT-FOR CLOSE OF THIS-PROCEDURE.
END.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME


/* **********************  Internal Procedures  *********************** */

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE Change_Name WinMenu 
PROCEDURE Change_Name :
/*------------------------------------------------------------------------------
  Purpose:     
  Parameters:  <none>
  Notes:       
------------------------------------------------------------------------------*/
  DEFINE INPUT PARAMETER p_hMenuItem  AS HANDLE     NO-UNDO.
         /* Handle to Window menu Item to change label. */ 
  DEFINE INPUT PARAMETER p_OldName   AS CHARACTER  NO-UNDO.
         /* Old Menu Item Name text. */ 
  DEFINE INPUT PARAMETER p_NewName   AS CHARACTER  NO-UNDO.
         /* New Menu Item Name text. */ 

  DEFINE VAR hWinMenu  AS HANDLE NO-UNDO.
  DEFINE VAR hMenuItem AS HANDLE NO-UNDO.

  MAIN:
  DO:
    
    /* If the item to change is stored in the MoreWindow active
       window name list, update the list only. Note that when
       a Null is passed, treat it like removing the item. That's
       what the TRIM(REPLACE) does (kills double commas).
       
       Otherwise, change the label of the menu item passed by the caller.
    */
    IF ( p_hMenuItem:LABEL = MoreWindows ) THEN
    DO: 
        ASSIGN p_hMenuItem:NAME = REPLACE( p_hMenuItem:NAME ,
                                           p_OldName , p_NewName )
               p_hMenuItem:NAME = TRIM( REPLACE( p_hMenuItem:NAME, ",," , ","), ",")
        . /* END ASSIGN */
    END.
    ELSE
    DO:
        /* Change the menu item label. */
        ASSIGN p_hMenuItem:LABEL = REPLACE( p_hMenuItem:LABEL ,
                                            p_OldName , p_NewName )
               p_hMenuItem:NAME = p_NewName
               . /* END ASSIGN */
    END.
    RETURN.
    
  END. /* MAIN */
  
END PROCEDURE.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME


&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE ChooseItem WinMenu 
PROCEDURE ChooseItem :
/*------------------------------------------------------------------------------
  Purpose:     
  Parameters:  <none>
  Notes:       
------------------------------------------------------------------------------*/
  DEFINE INPUT PARAMETER p_hMenuItem AS HANDLE      NO-UNDO.
         /* Handle to Window menu Item to "choose". */ 
  DEFINE INPUT  PARAMETER p_hProc    AS HANDLE      NO-UNDO.
         /* Handle to Procedure Object for the Window Menu. */ 

  DEFINE VAR hWinMenu  AS HANDLE NO-UNDO.
  DEFINE VAR hMenuItem AS HANDLE NO-UNDO.
  DEFINE VAR ItemName  AS CHAR   NO-UNDO.
  
  MAIN:
  DO ON STOP UNDO, LEAVE :
    
    IF (p_hMenuItem:LABEL = MoreWindows) THEN
    DO:
        RUN ChooseMoreWindows IN THIS-PROCEDURE
            ( INPUT p_hMenuItem , INPUT p_hProc , OUTPUT ItemName ).
        IF (ItemName = ?) OR (ItemName = "") THEN
        DO:
            ASSIGN SELF:CHECKED = NOT SELF:CHECKED .
            RETURN.
        END.
    END.        
    ELSE
        ASSIGN ItemName = p_hMenuItem:NAME .
        
    RUN WinMenuSetActive IN THIS-PROCEDURE
        (INPUT p_hMenuItem:PARENT /* Window menu */ ,
         INPUT ItemName ).
    RUN WinMenuChoose IN p_hProc ( INPUT ItemName ).
    
  END. /* MAIN */
  
END PROCEDURE.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME


&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE ChooseMoreWindows WinMenu 
PROCEDURE ChooseMoreWindows :
/*------------------------------------------------------------------------------
  Purpose:     
  Parameters:  <none>
  Notes:       
------------------------------------------------------------------------------*/
  DEFINE INPUT  PARAMETER p_hMoreWindows AS HANDLE      NO-UNDO.
         /* Handle to Window menu More Windows Item. */ 
  DEFINE INPUT  PARAMETER p_hProc    AS HANDLE      NO-UNDO.
         /* Handle to Procedure Object for the Window Menu. */ 
  DEFINE OUTPUT PARAMETER p_ItemName     AS CHARACTER   NO-UNDO.
         /* Name of selected window. */ 

  DEFINE VAR ActiveWindows  AS CHARACTER NO-UNDO.

  MAIN:
  DO ON STOP UNDO, LEAVE :
    RUN WinMenuGetActive IN p_hProc
        (OUTPUT ActiveWindows , OUTPUT p_ItemName).
     
    RUN adecomm/_winmore.w (INPUT ActiveWindows , INPUT-OUTPUT p_ItemName ).

  END. /* MAIN */
  
END PROCEDURE.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME


&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE ClosePW WinMenu 
PROCEDURE ClosePW :
/*------------------------------------------------------------------------------
  Purpose:     
  Parameters:  <none>
  Notes:       
------------------------------------------------------------------------------*/
  DEFINE VAR OK_Close   AS LOGICAL NO-UNDO.
  
    /* Perform a Close All for any open Procedure Windows belonging to
       this object.
    */
    REPEAT ON STOP UNDO, LEAVE:
      RUN adecomm/_pwexit.p ( INPUT Object-Name /* PW Parent ID */ ,
                              OUTPUT OK_Close ).
      LEAVE.
    END.
    /* Cancel the close event. */
    IF OK_Close <> TRUE THEN RETURN ERROR.

END PROCEDURE.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME


&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE CreateMenuItem WinMenu 
PROCEDURE CreateMenuItem :
/*------------------------------------------------------------------------------
  Purpose:     
  Parameters:  <none>
  Notes:       
------------------------------------------------------------------------------*/

  DEFINE INPUT  PARAMETER p_hWinMenu  AS HANDLE     NO-UNDO.
  DEFINE INPUT  PARAMETER p_Name      AS CHARACTER  NO-UNDO.
  DEFINE INPUT  PARAMETER p_Data      AS CHARACTER  NO-UNDO.
  DEFINE INPUT  PARAMETER p_Label     AS CHARACTER  NO-UNDO.
  DEFINE INPUT  PARAMETER p_hProc     AS HANDLE     NO-UNDO.
  DEFINE OUTPUT PARAMETER p_hMenuItem AS HANDLE     NO-UNDO.
  
  /* MAIN */
  DO :
        CREATE MENU-ITEM p_hMenuItem
          ASSIGN TOGGLE-BOX     = TRUE
                 NAME           = p_Name
                 PRIVATE-DATA   = p_Data
                 LABEL          = p_Label
                 PARENT         = p_hWinMenu
          TRIGGERS:
                 ON VALUE-CHANGED
                    PERSISTENT RUN ChooseItem IN THIS-PROCEDURE
                                   (INPUT p_hMenuItem , INPUT p_hProc).
          END TRIGGERS
        . /* END CREATE */
        
  END. /* MAIN */


END PROCEDURE.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME


&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE disable_UI WinMenu _DEFAULT-DISABLE
PROCEDURE disable_UI :
/*------------------------------------------------------------------------------
  Purpose:     DISABLE the User Interface
  Parameters:  <none>
  Notes:       Here we clean-up the user-interface by deleting
               dynamic widgets we have created and/or hide 
               frames.  This procedure is usually called when
               we are ready to "clean-up" after running.
------------------------------------------------------------------------------*/
  /* Delete the WINDOW we created */
  IF SESSION:DISPLAY-TYPE = "GUI":U AND VALID-HANDLE(WinMenu)
  THEN DELETE WIDGET WinMenu.
  IF THIS-PROCEDURE:PERSISTENT THEN DELETE PROCEDURE THIS-PROCEDURE.
END PROCEDURE.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME


&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE enable_UI WinMenu _DEFAULT-ENABLE
PROCEDURE enable_UI :
/*------------------------------------------------------------------------------
  Purpose:     ENABLE the User Interface
  Parameters:  <none>
  Notes:       Here we display/view/enable the widgets in the
               user-interface.  In addition, OPEN all queries
               associated with each FRAME and BROWSE.
               These statements here are based on the "Other 
               Settings" section of the widget Property Sheets.
------------------------------------------------------------------------------*/
  VIEW FRAME DEFAULT-FRAME IN WINDOW WinMenu.
  {&OPEN-BROWSERS-IN-QUERY-DEFAULT-FRAME}
  VIEW WinMenu.
END PROCEDURE.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME


&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE GetItemHandle WinMenu 
PROCEDURE GetItemHandle :
/*----------------------------------------------------------------------
    Purpose   : Set a Window menu item as the only checked menu item.
    Notes     : Caller can run this procedure when a window becomes
                the active window.
----------------------------------------------------------------------*/

  DEFINE INPUT  PARAMETER p_hWinMenu  AS HANDLE    NO-UNDO.
         /* Handle to Window menu. */ 
  DEFINE INPUT  PARAMETER p_ItemName  AS CHARACTER NO-UNDO.
         /* Menu Item Name text. Typically the active window's title. */ 
  DEFINE OUTPUT PARAMETER p_hMenuItem AS HANDLE    NO-UNDO.
         /* Handle to Menu Item. */

  DEFINE VARIABLE hLastItem     AS HANDLE NO-UNDO.
  
  MAIN:
  DO ON STOP UNDO, LEAVE :

    /*------------------------------------------------------------
      Search from the last item on the Window menu up until
      either there are no more menu items or until first
      menu RULE is encountered. The RULE indicates the end of
      Active Window menu items.
    ------------------------------------------------------------*/
    IF NOT VALID-HANDLE( p_hWinMenu ) THEN RETURN.
    ASSIGN p_hMenuItem = p_hWinMenu:LAST-CHILD
           hLastItem   = p_hWinMenu:LAST-CHILD
           . /* END ASSIGN */
    
    /* Check active items 1..9 for the item. */
    DO WHILE VALID-HANDLE( p_hMenuItem )
             AND ( p_hMenuItem:SUBTYPE <> "RULE":U )
             AND ( p_hMenuItem:PRIVATE-DATA <> ? )
             AND ( p_hMenuItem:NAME <> p_ItemName ):
      ASSIGN p_hMenuItem = p_hMenuItem:PREV-SIBLING
             . /* END ASSIGN */
    END.
    IF VALID-HANDLE(p_hMenuItem)
       AND ( p_hMenuItem:SUBTYPE <> "RULE":U )
       AND ( p_hMenuItem:PRIVATE-DATA <> ? ) THEN RETURN.
    
    /* Otherwise, the item is a MoreWindows item, so return MoreWindows
       menu item handle.
    */
    IF (hLastItem:LABEL = MoreWindows) THEN
        ASSIGN p_hMenuItem = hLastItem.
    ELSE
        ASSIGN p_hMenuItem = ?.
        
  END. /* MAIN */

END PROCEDURE.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME


&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE NewPW WinMenu 
PROCEDURE NewPW :
/*------------------------------------------------------------------------------
  Purpose:     
  Parameters:  <none>
  Notes:       
------------------------------------------------------------------------------*/

DO ON STOP UNDO, LEAVE:
    RUN adecomm/_pwmain.p (INPUT Object-Name
                                   /* PW Parent ID    */,
                         INPUT ""  /* Files to open   */,
                         INPUT ""  /* PW Command      */ ).
END.
END PROCEDURE.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME


&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE SetChecked WinMenu 
PROCEDURE SetChecked :
/*----------------------------------------------------------------------
    Purpose   : Set a Window menu item as the active window.
    Notes     : Caller can run this procedure when a window becomes
                the active window.
----------------------------------------------------------------------*/

  DEFINE INPUT PARAMETER p_hMenuItem AS HANDLE NO-UNDO.
         /* Handle to Window menu Item to set as the checked item. */ 

  DEFINE VAR hWinMenu  AS HANDLE NO-UNDO.
  DEFINE VAR hMenuItem AS HANDLE NO-UNDO.

  MAIN:
  DO ON STOP UNDO, LEAVE :
    
    IF NOT VALID-HANDLE( p_hMenuItem ) THEN RETURN.

    /*------------------------------------------------------------
      Search from the last item on the Window menu up until
      either there are no more menu items or until first
      menu RULE is encountered. The RULE indicates the end of
      Active Window menu items.

      Uncheck each Active Window menu item except for p_hMenuItem.
      That menu item gets checked.
    ------------------------------------------------------------*/
    ASSIGN hWinMenu  = p_hMenuItem:PARENT
           hMenuItem = hWinMenu:LAST-CHILD
           . /* END ASSIGN */
    
    DO WHILE VALID-HANDLE( hMenuItem )
             AND ( hMenuItem:SUBTYPE <> "RULE":U )
             AND ( hMenuItem:PRIVATE-DATA <> ? ):
      ASSIGN hMenuItem:CHECKED = ( hMenuItem = p_hMenuItem )
             hMenuItem         = hMenuItem:PREV-SIBLING
             . /* END ASSIGN */
    END.
  END. /* MAIN */

END PROCEDURE.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME


&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE WinMenuAddItem WinMenu 
PROCEDURE WinMenuAddItem :
/*----------------------------------------------------------------------
    Purpose   : Add a Window menu Open Window menu item.
    Notes     : Run this procedure as the part of a File->Open process
                that opens a window you want on the Window menu.
----------------------------------------------------------------------*/

  DEFINE INPUT  PARAMETER p_hWinMenu  AS HANDLE    NO-UNDO.
         /* Handle to Window menu. */ 
  DEFINE INPUT  PARAMETER p_ItemLabel AS CHARACTER NO-UNDO.
         /* Menu Item Label text. Typically the window's title. */ 
  DEFINE INPUT  PARAMETER p_hProc    AS HANDLE    NO-UNDO.
         /* Handle to Procedure object for the Window. */ 
  
  DEFINE VAR hMenuItem AS HANDLE    NO-UNDO.
         /* Handle to Window menu item created. */ 
  DEFINE VAR hRule     AS HANDLE    NO-UNDO.
  
  MAIN:
  DO:
  
    IF NOT VALID-HANDLE( p_hWinMenu ) OR ( p_ItemLabel = Nul )
    THEN RETURN.

    ASSIGN hLastItem = p_hWinMenu:LAST-CHILD
           . /* END ASSIGN */
    IF hLastItem:LABEL = MoreWindows THEN RETURN.
    ELSE    
      DO:
        /*------------------------------------------------------------
          If the last item's PRIVATE-DATA is not Unknown, then
          treat it as a Window menu item this object needs to track.
          Since it is the last menu item, strip out the active window
          number. Otherwise, initialize as 1 and create a RULE above
          the first active window item.
        ------------------------------------------------------------*/
        /*------------------------------------------------------------
          Note: Substring starts at two to skip the (&) in the label
          and get right to the Window number.
        ------------------------------------------------------------*/
        IF (hLastItem:PRIVATE-DATA <> ?) THEN 
          NextNum  = INTEGER(SUBSTRING(hLastItem:LABEL,2,1,"CHARACTER":u)) + 1.
        ELSE DO:
            ASSIGN NextNum = 1.
            CREATE MENU-ITEM hRule
            ASSIGN SUBTYPE        = "RULE"
                   NAME           = "RULE":U
                   PRIVATE-DATA   = "RULE":U
                   PARENT         = p_hWinMenu
            . /* END CREATE */
        END.

        /*------------------------------------------------------------
          Add a numbered item to the Windows menu and make it the
          checked item.  If there are already the maximum nine (9)
          items, create the item as the MoreWindows item.
        ------------------------------------------------------------*/
        RUN CreateMenuItem IN THIS-PROCEDURE
            (INPUT p_hWinMenu               ,
             INPUT p_ItemLabel  /* :NAME */  ,
             INPUT p_ItemLabel /* :PRIVATE-DATA */ ,
             INPUT p_ItemLabel  /* :LABEL */ ,
             INPUT p_hProc     ,
             OUTPUT hMenuItem ).
        
        IF ( NextNum <= MaxNum ) THEN
          ASSIGN hMenuItem:LABEL = ( Ampersand
                                       + STRING( NextNum , "9" ) + Space_Char
                                       + p_ItemLabel ) .
        ELSE
          ASSIGN hMenuItem:LABEL        = MoreWindows
                 hMenuItem:NAME         = MoreWindows
                 hMenuItem:PRIVATE-DATA = MoreWindows
                 . /* END ASSIGN */
          
        RUN SetChecked IN THIS-PROCEDURE ( INPUT hMenuItem ) .
      END. /* OTHERWISE NOT MoreWindow */
      
  END. /* MAIN */

END PROCEDURE.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME


&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE WinMenuChangeName WinMenu 
PROCEDURE WinMenuChangeName :
/*------------------------------------------------------------------------------
  Purpose:     
  Parameters:  <none>
  Notes:       
------------------------------------------------------------------------------*/
  DEFINE INPUT  PARAMETER p_hWinMenu  AS HANDLE    NO-UNDO.
         /* Handle to Window menu. */ 
  DEFINE INPUT PARAMETER p_OldName   AS CHARACTER  NO-UNDO.
         /* Old Menu Item Name text. */ 
  DEFINE INPUT PARAMETER p_NewName   AS CHARACTER  NO-UNDO.
         /* New Menu Item Name text. */ 

  DEFINE VAR hMenuItem AS HANDLE NO-UNDO.

  MAIN:
  DO:
    RUN GetItemHandle ( INPUT p_hWinMenu , INPUT p_OldName , OUTPUT hMenuItem ).
    
    IF NOT VALID-HANDLE(hMenuItem) OR (hMenuItem:LABEL = MoreWindows) THEN RETURN.
    
    RUN Change_Name IN THIS-PROCEDURE
        (INPUT hMenuItem ,
         INPUT p_OldName ,
         INPUT p_NewName ).
         
  END. /* MAIN */
  
END PROCEDURE.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME


&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE WinMenuChoose WinMenu 
PROCEDURE WinMenuChoose :
/*------------------------------------------------------------------------------
  Purpose:     
  Parameters:  <none>
  Notes:       
------------------------------------------------------------------------------*/
  DEFINE INPUT PARAMETER p_ItemName AS CHARACTER      NO-UNDO.
         /* Name of wctive window menu item chosen. */ 
    
  MESSAGE "NAME = " p_ItemName
    VIEW-AS ALERT-BOX IN WINDOW ACTIVE-WINDOW.

END PROCEDURE.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME


&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE WinMenuGetActive WinMenu 
PROCEDURE WinMenuGetActive :
/*------------------------------------------------------------------------------
  Purpose:     
  Parameters:  <none>
  Notes:       
------------------------------------------------------------------------------*/

  DEFINE OUTPUT PARAMETER p_ActiveWindows AS CHARACTER  NO-UNDO.
         /* Handle to Window menu. */ 
  DEFINE OUTPUT PARAMETER p_ActiveItem    AS CHARACTER  NO-UNDO.

  DEFINE VAR hMenuItem AS HANDLE NO-UNDO.
  
  DO:
    ASSIGN hMenuItem = MENU m_Window:FIRST-CHILD.
    
    DO WHILE VALID-HANDLE( hMenuItem ) :
      IF ( hMenuItem:SUBTYPE <> "RULE":U )
         AND ( hMenuItem:PRIVATE-DATA <> ? )
         AND (hMenuItem:LABEL <> MoreWindows) THEN
          ASSIGN p_ActiveWindows = p_ActiveWindows + Delim + hMenuItem:NAME .
             
      ASSIGN hMenuItem   = hMenuItem:NEXT-SIBLING .
    END.
    ASSIGN p_ActiveWindows = TRIM(p_ActiveWindows , Delim)
           p_ActiveItem    = ENTRY( 1 , p_ActiveWindows )
           . /* END ASSIGN */
  END.
  
END PROCEDURE.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME


&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE WinMenuRebuild WinMenu 
PROCEDURE WinMenuRebuild :
/*------------------------------------------------------------------------------
  Purpose:    Rebuild the Window menu active window items and assign
              one as the current active window.
  Parameters:  
  Notes:       
------------------------------------------------------------------------------*/

  DEFINE INPUT PARAMETER p_hWinMenu      AS HANDLE    NO-UNDO.
         /* Handle to Window menu. */ 
  DEFINE INPUT PARAMETER p_ActiveWindows AS CHARACTER NO-UNDO.
         /* Delimited List of Active Window Names. */ 
  DEFINE INPUT PARAMETER p_ActiveItem    AS CHARACTER NO-UNDO.
         /* The Active Window Name to make the checked/active window. */
  DEFINE INPUT  PARAMETER p_hProc        AS HANDLE    NO-UNDO.
         /* Handle to Procedure object for the Window. */ 

  DEFINE VAR hMenuItem   AS HANDLE      NO-UNDO.
  DEFINE VAR hDeleteItem AS HANDLE      NO-UNDO.
  DEFINE VAR vItem       AS INTEGER     NO-UNDO.
  
  DO:
    ASSIGN hMenuItem = p_hWinMenu:FIRST-CHILD.
    
    /* Delete any existing active window items. */
    DO WHILE VALID-HANDLE( hMenuItem ) :
      IF ( hMenuItem:PRIVATE-DATA <> ? ) THEN
      DO:
        ASSIGN hDeleteItem = hMenuItem
               hMenuItem   = hMenuItem:NEXT-SIBLING
               . /* END ASSIGN */
        DELETE WIDGET hDeleteItem.
      END.
      ELSE
        ASSIGN hMenuItem   = hMenuItem:NEXT-SIBLING .
    END.
    
    /* Rebuild the active window items. */
    DO vItem = 1 TO NUM-ENTRIES( p_ActiveWindows ) :
        RUN WinMenuAddItem IN THIS-PROCEDURE
            (INPUT   p_hWinMenu ,
             INPUT   ENTRY( vItem , p_ActiveWindows ) ,
             INPUT   p_hProc ).
    END.
    
    /* Set the current active window as checked. */
    RUN WinMenuSetActive IN THIS-PROCEDURE
        ( INPUT p_hWinMenu , INPUT p_ActiveItem ).
    
    RETURN.
            
  END.
  
END PROCEDURE.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME


&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE WinMenuSetActive WinMenu 
PROCEDURE WinMenuSetActive :
/*----------------------------------------------------------------------
    Purpose   : Set a Window menu item as the only checked menu item.
    Notes     : Caller can run this procedure when a window becomes
                the active window.
----------------------------------------------------------------------*/

  DEFINE INPUT  PARAMETER p_hWinMenu  AS HANDLE    NO-UNDO.
         /* Handle to Window menu. */ 
  DEFINE INPUT  PARAMETER p_ItemName  AS CHARACTER NO-UNDO.
         /* Menu Item Name text. Typically the active window's title. */ 

  DEFINE VAR hMenuItem AS HANDLE NO-UNDO.

  MAIN:
  DO ON STOP UNDO, LEAVE :
    
    RUN GetItemHandle IN THIS-PROCEDURE
        (INPUT p_hWinMenu , INPUT p_ItemName , OUTPUT hMenuItem ).

    IF VALID-HANDLE( hMenuItem ) THEN
        RUN SetChecked IN THIS-PROCEDURE (INPUT hMenuItem ).
    
  END. /* MAIN */

END PROCEDURE.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME


&ANALYZE-SUSPEND _VERSION-NUMBER UIB_v7r11 GUI
/* Procedure Description
"Basic Dialog-Box Template

Use this template to create a new dialog-box. Alter this default template or create new ones to accomodate your needs for different default sizes and/or attributes."
*/
&ANALYZE-RESUME
&Scoped-define WINDOW-NAME Dialog-Frame
&Scoped-define FRAME-NAME Dialog-Frame
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _DEFINITIONS Dialog-Frame 
/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/
/*------------------------------------------------------------------------
    File   : adecomm/_winmore.w

    Purpose: More Windows dialog box called when user selectes More Windows...
             option on a Window menu.
             

    Notes  : 

    1.  Window Menu Manager Object takes care of calling this dialog.
        See adecomm/_winmenu.w.

    Author : J. Palazzo
    Created: April, 1995
    Updated:
------------------------------------------------------------------------*/
/*          This .W file was created with the Progress UIB.             */
/*----------------------------------------------------------------------*/
/* ***************************  Definitions  ************************** */
{adecomm/adestds.i}        /* Standared ADE Preprocessor Directives */
IF NOT initialized_adestds
THEN RUN adecomm/_adeload.p.

{adecomm/commeng.i}          /* Help File Preprocessor Directives       */

/* ***************************  Definitions  ************************** */

/* Parameters Definitions ---                                           */
&IF DEFINED(UIB_is_Running) NE 0 &THEN
DEFINE VAR p_ActiveList    AS CHARACTER
       INIT "/users/devp/jep/7/ade/dialog-1.w,Procedure:2,Proc:3" NO-UNDO.
DEFINE VAR p_WindowName    AS CHARACTER INIT "Procedure:2" NO-UNDO.
&ELSE
DEFINE INPUT        PARAMETER p_ActiveList    AS CHARACTER NO-UNDO.
DEFINE INPUT-OUTPUT PARAMETER p_WindowName    AS CHARACTER NO-UNDO.
&ENDIF

/* Local Variable Definitions ---                                       */

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME


&ANALYZE-SUSPEND _UIB-PREPROCESSOR-BLOCK 

/* ********************  Preprocessor Definitions  ******************** */

&Scoped-define PROCEDURE-TYPE DIALOG-BOX

/* Name of first Frame and/or Browse and/or first Query                 */
&Scoped-define FRAME-NAME Dialog-Frame

/* Standard List Definitions                                            */
&Scoped-Define ENABLED-OBJECTS ActiveWindows 
&Scoped-Define DISPLAYED-OBJECTS ActiveWindows 

/* Custom List Definitions                                              */
/* List-1,List-2,List-3,List-4,List-5,List-6                            */

/* _UIB-PREPROCESSOR-BLOCK-END */
&ANALYZE-RESUME



/* ***********************  Control Definitions  ********************** */

/* Define a dialog box                                                  */
DEFINE VARIABLE ActiveWindows AS CHARACTER 
     VIEW-AS SELECTION-LIST SINGLE SCROLLBAR-VERTICAL 
     SIZE 60 BY 6 NO-UNDO.


/* ************************  Frame Definitions  *********************** */

DEFINE FRAME Dialog-Frame
     ActiveWindows AT ROW 2.19 COL 2 NO-LABEL
     "Select Window:" VIEW-AS TEXT
          SIZE 16 BY .54 AT ROW 1.38 COL 2
     SPACE(44.66) SKIP(6.51)
    WITH VIEW-AS DIALOG-BOX KEEP-TAB-ORDER 
         SIDE-LABELS NO-UNDERLINE THREE-D  SCROLLABLE 
         TITLE "More Windows".

 

/* *********************** Procedure Settings ************************ */

&ANALYZE-SUSPEND _PROCEDURE-SETTINGS
/* Settings for THIS-PROCEDURE
   Type: DIALOG-BOX
 */
&ANALYZE-RESUME _END-PROCEDURE-SETTINGS


/* ***************  Runtime Attributes and UIB Settings  ************** */

&ANALYZE-SUSPEND _RUN-TIME-ATTRIBUTES
ASSIGN 
       FRAME Dialog-Frame:SCROLLABLE       = FALSE.

/* _RUN-TIME-ATTRIBUTES-END */
&ANALYZE-RESUME

 




/* ************************  Control Triggers  ************************ */

&Scoped-define SELF-NAME Dialog-Frame
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL Dialog-Frame Dialog-Frame
ON WINDOW-CLOSE OF FRAME Dialog-Frame /* More Windows */
DO:
 APPLY "END-ERROR":U TO SELF.
END.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME


&Scoped-define SELF-NAME ActiveWindows
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL ActiveWindows Dialog-Frame
ON DEFAULT-ACTION OF ActiveWindows IN FRAME Dialog-Frame
DO:
  APPLY "GO" TO FRAME {&FRAME-NAME} .
  RETURN.
END.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME


&UNDEFINE SELF-NAME

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _MAIN-BLOCK Dialog-Frame 


/* ***************************  Main Block  *************************** */

/* Parent the dialog-box to the ACTIVE-WINDOW, if there is no parent.   */
IF VALID-HANDLE(ACTIVE-WINDOW) AND FRAME {&FRAME-NAME}:PARENT eq ?
THEN FRAME {&FRAME-NAME}:PARENT = ACTIVE-WINDOW.

/* ADE okbar.i places standard ADE OK-CANCEL-HELP buttons.              */
{adecomm/okbar.i &TOOL = "COMM"
                 &CONTEXT = {&Create_Database} }

/* Now enable the interface and wait for the exit condition.            */
/* (NOTE: handle ERROR and END-KEY so cleanup code will always fire.    */
MAIN-BLOCK:
DO ON ERROR   UNDO MAIN-BLOCK, RETRY MAIN-BLOCK
   ON END-KEY UNDO MAIN-BLOCK, RETRY MAIN-BLOCK
   ON STOP    UNDO MAIN-BLOCK, RETRY MAIN-BLOCK :
  
  IF RETRY THEN
  DO:
    ASSIGN p_WindowName = "".
    LEAVE MAIN-BLOCK.
  END.
  
  RUN SetInitValues IN THIS-PROCEDURE.
  RUN enable_UI.
  WAIT-FOR GO OF FRAME {&FRAME-NAME}.
  
  ASSIGN p_WindowName = ActiveWindows:SCREEN-VALUE IN FRAME {&FRAME-NAME} .
END.

&IF DEFINED(UIB_is_Running) NE 0 &THEN
MESSAGE p_WindowName VIEW-AS ALERT-BOX IN WINDOW ACTIVE-WINDOW.
&ENDIF

RUN disable_UI.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME


/* **********************  Internal Procedures  *********************** */

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE disable_UI Dialog-Frame _DEFAULT-DISABLE
PROCEDURE disable_UI :
/*------------------------------------------------------------------------------
  Purpose:     DISABLE the User Interface
  Parameters:  <none>
  Notes:       Here we clean-up the user-interface by deleting
               dynamic widgets we have created and/or hide 
               frames.  This procedure is usually called when
               we are ready to "clean-up" after running.
------------------------------------------------------------------------------*/
  /* Hide all frames. */
  HIDE FRAME Dialog-Frame.
END PROCEDURE.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME


&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE enable_UI Dialog-Frame _DEFAULT-ENABLE
PROCEDURE enable_UI :
/*------------------------------------------------------------------------------
  Purpose:     ENABLE the User Interface
  Parameters:  <none>
  Notes:       Here we display/view/enable the widgets in the
               user-interface.  In addition, OPEN all queries
               associated with each FRAME and BROWSE.
               These statements here are based on the "Other 
               Settings" section of the widget Property Sheets.
------------------------------------------------------------------------------*/
  DISPLAY ActiveWindows 
      WITH FRAME Dialog-Frame.
  ENABLE ActiveWindows 
      WITH FRAME Dialog-Frame.
  {&OPEN-BROWSERS-IN-QUERY-Dialog-Frame}
END PROCEDURE.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME


&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE SetInitValues Dialog-Frame 
PROCEDURE SetInitValues :
/*------------------------------------------------------------------------------
  Purpose:     
  Parameters:  <none>
  Notes:       
------------------------------------------------------------------------------*/
  DEFINE VAR RetValue AS LOGICAL NO-UNDO.
  
  DO WITH FRAME {&FRAME-NAME}:
    ASSIGN ActiveWindows:LIST-ITEMS = p_ActiveList
           ActiveWindows            = p_WindowName
           . /* END ASSIGN */
           
  END.
  
END PROCEDURE.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME


/***********************************************************************
* Copyright (C) 2000,2007,2012 by Progress Software Corporation. All rights *
* reserved. Prior versions of this work may contain portions           *
* contributed by participants of Possenet.                             *
*                                                                      *
***********************************************************************/
/*
  Procedure:    adecomm/_winsys.p
  Author:       R. Ryan 
  Created:      1/95
  Purpose:      written by Bob Ryan (from gfs's API examples) to
                provide basic windows' system information to better
                help tech support
              
  Modified on 01/15/95 by gfs - ported to Win32
              01/29/98 by gfs - fixed up second line message
              04/18/98 by gfs - Increased format of numerics
              07/24/98 by gfs - State real O/S in message
              12/16/99 by gfs - Reworked O/S message to say Win2000 instead
                                on WinNT. Also, changed version info to format:
                                (<major>.<minor>.<build>:<SP svcpack#>)
*/          

DEFINE OUTPUT PARAMETER pLabel1 AS CHARACTER.
DEFINE OUTPUT PARAMETER pLabel2 AS CHARACTER.

IF OPSYS EQ "WIN32" THEN DO:
  DEFINE VARIABLE lpmemorystatus AS MEMPTR.
  DEFINE VARIABLE lpsysteminfo   AS MEMPTR.
  DEFINE VARIABLE procnum        AS INTEGER   NO-UNDO.
  DEFINE VARIABLE proctype       AS CHARACTER NO-UNDO.
  DEFINE VARIABLE TotPhysMem     AS INT64     NO-UNDO.
  DEFINE VARIABLE FreePhysMem    AS INT64   NO-UNDO.
  DEFINE VARIABLE lpVersionInfo  AS MEMPTR.
  DEFINE VARIABLE MajorVersion   AS INTEGER   NO-UNDO.
  DEFINE VARIABLE MinorVersion   AS INTEGER   NO-UNDO.
  DEFINE VARIABLE BuildNumber    AS INTEGER   NO-UNDO.
  DEFINE VARIABLE PlatformId     AS INTEGER   NO-UNDO.
  DEFINE VARIABLE ProductType    AS INTEGER   NO-UNDO.
  DEFINE VARIABLE Other          AS CHARACTER NO-UNDO.
  DEFINE VARIABLE OSstr          AS CHARACTER NO-UNDO.

&SCOPED-DEFINE VER_PLATFORM_WIN32_NT      2
&SCOPED-DEFINE VER_NT_WORKSTATION         1

  /* set up pointers */
  SET-SIZE(lpmemorystatus)   = 64.  /* sizeof(MEMORYSTATUSEX) */
  PUT-LONG(lpmemorystatus,1) = 64.  /* dwLength */
  SET-SIZE(lpVersionInfo)    = 156. /* sizeof(OSVERSIONINFOEX) */
  PUT-LONG(lpVersionInfo,1)  = 156. /* dwOSVersionInfoSize */

  CASE PROCESS-ARCHITECTURE :
      WHEN 32 THEN
        SET-SIZE(lpsysteminfo) = 36.  /* sizeof(SYSTEM_INFO) in 32-bit process */
      WHEN 64 THEN
        SET-SIZE(lpsysteminfo) = 48.  /* sizeof(SYSTEM_INFO) in 64-bit process */
  END CASE.

  /* Call Windows API */
  RUN GlobalMemoryStatusEx (INPUT-OUTPUT lpmemorystatus).
  RUN GetNativeSystemInfo (INPUT-OUTPUT lpsysteminfo).
  RUN GetVersionExA (INPUT-OUTPUT lpVersionInfo).
 
  /* Extract data from pointers */
  ASSIGN
    TotPhysMem   = GET-INT64(lpmemorystatus,9)  / 1024  /* ullTotalPhys */
    FreePhysMem  = GET-INT64(lpmemorystatus,17) / 1024  /* ullAvailPhys */
    ProcNum      = GET-SHORT(lpsysteminfo,1).           /* wProcessorArchitecture */

  CASE procnum:
    WHEN 0 THEN ProcType = "x86".  /* PROCESSOR_ARCHITECTURE_INTEL */
    WHEN 6 THEN ProcType = "IA64". /* PROCESSOR_ARCHITECTURE_IA64 */
    WHEN 9 THEN ProcType = "x64".  /* PROCESSOR_ARCHITECTURE_AMD64 */
    OTHERWISE ProcType = "unknown architecture".
  END CASE.

  ASSIGN
    MajorVersion = GET-LONG(lpVersionInfo,5)     /* dwMajorVersion */
    MinorVersion = GET-LONG(lpVersionInfo,9)     /* dwMinorVersion */
    BuildNumber  = GET-LONG(lpVersionInfo,13)    /* dwBuildNumber */
    PlatformId   = GET-LONG(lpVersionInfo,17)    /* dwPlatformId */
    ProductType  = GET-BYTE(lpVersionInfo,155)   /* wProductType */
    Other        = GET-STRING(lpVersionInfo,21). /* szCSDVersion */

  CASE MajorVersion:
      WHEN 4 THEN ASSIGN OSstr = "WinNT ":U.
      WHEN 5 THEN
        CASE MinorVersion:
          /* Values 1 and 2 can be one of several versions of Windows but
          ** we have always just reported XP and it's not worth doing all
          ** of the work required to identify each one individually.
          */
          WHEN 0 THEN ASSIGN OSstr = "Windows 2000 ":U.
          WHEN 1 OR WHEN 2 THEN ASSIGN OSstr = "Windows XP ":U.
        END CASE.
      WHEN 6 THEN
        CASE MinorVersion:
          WHEN 0 THEN ASSIGN OSstr = IF ProductType = {&VER_NT_WORKSTATION} THEN "Windows Vista ":U ELSE "Windows Server 2008 ":U.
          WHEN 1 THEN ASSIGN OSstr = IF ProductType = {&VER_NT_WORKSTATION} THEN "Windows 7 ":U ELSE "Windows Server 2008 R2 ":U.
          WHEN 2 THEN ASSIGN OSstr = IF ProductType = {&VER_NT_WORKSTATION} THEN "Windows 8 ":U ELSE "Windows Server 2012 ":U.
        END CASE.
  END CASE.

  ASSIGN  OSstr = OSstr + "(" + 
          STRING(MajorVersion) + "." + 
          STRING(MinorVersion) + 
          (IF STRING(BuildNumber) NE ? THEN "." + STRING(BuildNumber) ELSE "").

  IF Other NE ? AND Other NE "" THEN 
   ASSIGN OSstr = OSstr + ":" + REPLACE(Other,"Service Pack":U,"SP":U).

  ASSIGN pLabel1 = OSstr + ")":U + " on ":U + ProcType NO-ERROR.
  ASSIGN pLabel2 = "Phys. memory: " + TRIM(STRING(TotPhysMem, ">>>,>>>,>>9K")) + " with "
                   + TRIM(STRING(FreePhysMem, ">>>,>>>,>>9K free")) NO-ERROR.
 
  /* free pointers */
  SET-SIZE(lpmemorystatus) = 0.
  SET-SIZE(lpsysteminfo)   = 0.
  SET-SIZE(lpVersionInfo)  = 0.  

END.

/*
** Procedures ..............
*/

/* Win32 API calls */
PROCEDURE GetVersionExA EXTERNAL "kernel32.dll":
  DEFINE INPUT-OUTPUT PARAMETER lpVersionInfo AS MEMPTR.
END.

PROCEDURE GlobalMemoryStatusEx EXTERNAL "kernel32.dll":
  DEFINE INPUT-OUTPUT PARAMETER lpmemorystatus AS MEMPTR.
END.

PROCEDURE GetNativeSystemInfo EXTERNAL "kernel32.dll":
  DEFINE INPUT-OUTPUT PARAMETER lpSystemInfo AS MEMPTR.
END.
/***********************************************************************
* Copyright (C) 2005-2006 by Progress Software Corporation. All rights *
* reserved.  Prior versions of this work may contain portions          *
* contributed by participants of Possenet.                             *
*                                                                      *
***********************************************************************/
/*----------------------------------------------------------------------------

File: _y-build.p

Description:
    Format Assistant - Helps the user enter a format for a variable.

ADE Tools That use this:
    UIB - called from property sheets for fill-ins (adeuib/_prpfill.p)
    
Input Parameters:
    iipType: dataType of variable 
              1-character 2-date 3-logical 4-integer 5-decimal 7-recid 
              34-datetime 40-datetime-tz 41-INT64
    
Input-Output Parameters:
    ciopFormat: the resulting format

Author: Tony Lavinio

Modified:
  wood  10-05-93  Added standard header to file.
  ryan  06-06-94  Sliding dec format eliminated, leading zeros option
                  boxes changed to radio-set, added support for European
                  format
  tsm   04/12/99  Added support for various Intl Numeric Formats (in addition
                  to American and European).  Check session numeric-decimal-point 
                  and numeric-separator to determine if adecomm/_convert is 
                  called rather than checking if European or American.  And 
                  changed call to adecomm/_convert to support converting from 
                  American to non-American (A-TO-N) and non-American to American 
                  (N-TO-A), rather than American to European and vice versa. 
                  Used session numeric-decimal-point and numeric-separator to set
                  standard formats and to create and display the format based 
                  on user's choices.     
  tsm   06/01/99  Set "Use Thousands Separator" toggle box based on whether
                  SESSION:NUMERIC-SEPARATOR is in the format instead of ","          
            

Test Code: -----------------------------------------------------------------
  def var test as char initial "->>,>>9.99" no-undo.
  run adecomm/_y-build.p (1, INPUT-OUTPUT test).
  message "OUTPUT:" test.
----------------------------------------------------------------------------*/

/* _y-build.p - format assistant */
&GLOBAL-DEFINE WIN95-BTN YES
{ adecomm/adestds.i }
{ adecomm/commeng.i }
{ adecomm/oeideservice.i}

DEFINE INPUT        PARAMETER iipType    AS INTEGER   NO-UNDO.
DEFINE INPUT-OUTPUT PARAMETER ciopFormat AS CHARACTER NO-UNDO.

DEFINE VARIABLE new_format AS CHARACTER NO-UNDO. 
DEFINE VARIABLE caption    AS CHARACTER NO-UNDO.                 

DEFINE VARIABLE qbf-c      AS CHARACTER NO-UNDO. /* scrap */
DEFINE VARIABLE qbf-h      AS HANDLE    NO-UNDO. /* scrap */
DEFINE VARIABLE qbf-i      AS INTEGER   NO-UNDO. /* scrap */
DEFINE VARIABLE qbf-t1     AS CHARACTER VIEW-AS TEXT.
DEFINE VARIABLE qbf-t2     AS CHARACTER VIEW-AS TEXT.
DEFINE VARIABLE qbf-t3     AS CHARACTER VIEW-AS TEXT.
DEFINE VARIABLE qbf-t4     AS CHARACTER VIEW-AS TEXT.
DEFINE VARIABLE qbf-t5     AS CHARACTER VIEW-AS TEXT.
DEFINE VARIABLE qbf-t6     AS CHARACTER VIEW-AS TEXT.
DEFINE VARIABLE qbf-t7     AS CHARACTER VIEW-AS TEXT.
DEFINE VARIABLE qbf-t8     AS CHARACTER VIEW-AS TEXT.
DEFINE VARIABLE qbf-t9     AS CHARACTER VIEW-AS TEXT.

DEFINE RECTANGLE rect-1 {&STDPH_OKBOX}.
DEFINE BUTTON bOk       {&STDPH_OKBTN} LABEL "   OK   ":c8 AUTO-GO.
DEFINE BUTTON bCancel   {&STDPH_OKBTN} LABEL " Cancel ":c8 AUTO-ENDKEY.
DEFINE BUTTON bHelp     {&STDPH_OKBTN} LABEL "&Help".
DEFINE BUTTON qbf-df    {&STDPH_OKBTN} LABEL "&Standard":c9.

DEFINE VARIABLE counter    AS INTEGER NO-UNDO. 
DEFINE VARIABLE lError     AS LOGICAL NO-UNDO. 

DEFINE VARIABLE isInt64    AS LOGICAL NO-UNDO INITIAL FALSE.

DEFINE VARIABLE notAmerican  AS LOGICAL  NO-UNDO.
DEFINE VARIABLE frameHandle as handle   NO-UNDO.

IF iipType = 7 THEN iipType = 4. /*  7 is recid */

IF iipType = 41 THEN
    ASSIGN isInt64 = TRUE
           iipType = 4.  /*41 is INT64, it will behave like integers*/

caption = "Format":U.

/*--------------------------------------------------------------------------*/
/* character */

DEFINE VARIABLE qbf-s AS CHARACTER NO-UNDO. /* string variable */
DEFINE VARIABLE in-qbf-i AS LOGICAL INITIAL FALSE NO-UNDO.  /* A flag */

FORM
  SKIP({&TFM_WID})
  "Character &Format:":t18 AT 4 VIEW-AS TEXT SKIP
  new_Format FORMAT "x(9999)" NO-LABEL VIEW-AS FILL-IN SIZE 30 BY 1
  {&STDPH_FILL} AT 4

  qbf-i FORMAT ">>>>9":u NO-LABEL
        VIEW-AS FILL-IN SIZE 6 BY 1 {&STDPH_FILL} AT ROW 3.5 COL 4
  "&Width":t12 VIEW-AS TEXT SIZE 8 BY 1 AT ROW 3.5 COL 12 SKIP (.5)
  qbf-s VIEW-AS RADIO-SET VERTICAL RADIO-BUTTONS
    "Allow Any &Character","X",
    "&Allow Letters and Numbers Only","N",
    "Allow &Letters Only","A",
    "Allow Letters and Con&vert to Caps","!",
    "Allow &Numbers Only","9"  AT 15

  {adecomm/okform.i
    &BOX    = "rect-1"
    &STATUS =  no
    &OK     = "bOk"
    &CANCEL = "bCancel"
    &OTHER  = "qbf-df"
    &HELP   = "bHelp" }

  WITH FRAME qbf%char 
  &if DEFINED(IDE-IS-RUNNING) = 0  &then
     TITLE caption
     VIEW-AS DIALOG-BOX
  &else
     no-box
  &endif 
     NO-LABELS THREE-D
     DEFAULT-BUTTON bOk  .

  {adecomm/okrun.i  
     &FRAME  = "frame qbf%char" 
     &BOX    = "rect-1"
     &OK     = "bOK" 
     &OTHER  = "qbf-df"
     &HELP   = "bHelp" }

ON "Alt-F" OF FRAME qbf%char ANYWHERE
  APPLY "ENTRY" TO NEW_FORMAT IN FRAME qbf%char.
  
ON "Alt-W" OF FRAME qbf%char ANYWHERE
  APPLY "ENTRY" TO qbf-i IN FRAME qbf%char.
  
ON WINDOW-CLOSE OF FRAME qbf%char
  APPLY "END-ERROR" TO SELF.             

ON HELP OF FRAME qbf%char OR CHOOSE OF bHelp IN FRAME qbf%char
  RUN adecomm/_adehelp.p ("comm", "CONTEXT", 
                          {&Numeric_Format_Char_Dlg_Box}, ?).

ON ENTRY OF qbf-i IN FRAME qbf%char
  ASSIGN in-qbf-i = TRUE.
  
ON LEAVE OF qbf-i IN FRAME qbf%char DO:              
  ASSIGN in-qbf-i = FALSE.
  IF INTEGER(qbf-i:screen-value) > 4096 THEN DO:
      /*
      ** Note: 16k is an arbitrary limit to detect when a format is too large
      ** for the UIB/Results to handle without increasing the -s parm
      */
      MESSAGE qbf-i:screen-value "is too large for a character format." VIEW-AS ALERT-BOX WARNING.
      ASSIGN
        qbf-i:SCREEN-VALUE = STRING(qbf-i)
        qbf-i:AUTO-ZAP     = True.
      RETURN NO-APPLY.
  END.
    
  IF qbf-i <> INPUT FRAME qbf%char qbf-i THEN
    APPLY "VALUE-CHANGED" TO qbf-s IN FRAME qbf%char.
END.

ON VALUE-CHANGED OF qbf-s IN FRAME qbf%char
  ASSIGN
    qbf-s = qbf-s:SCREEN-VALUE IN FRAME qbf%char
    qbf-i = MAXIMUM(INPUT FRAME qbf%char qbf-i,1)
    new_Format:SCREEN-VALUE IN FRAME qbf%char
          = (IF qbf-i < 4 THEN
              FILL(qbf-s,qbf-i)
            ELSE
              qbf-s + "(":u + STRING(INPUT FRAME qbf%char qbf-i) + ")":u
            ).

ON LEAVE OF new_Format IN FRAME qbf%char DO:
  /* These lines are necessary to avoid the necessity of clicking twice in
     bHelp and qbf-s.                                                      */
  IF LAST-EVENT:WIDGET-ENTER = bHelp:HANDLE IN FRAME qbf%char THEN RETURN. 
  IF LAST-EVENT:WIDGET-ENTER = qbf-s:HANDLE IN FRAME qbf%char THEN RETURN. 

  IF SELF:MODIFIED THEN DO:
    RUN adecomm/_chkfmt.p (1, "", "", SELF:SCREEN-VALUE, 
                           OUTPUT counter, OUTPUT lError).

    IF counter > 4096 THEN DO:
      /*
      ** Note: 16k is an arbitrary limit to detect when a format is too large
      ** for the UIB/Results to handle without increasing the -s parm
      */
      MESSAGE new_format:screen-value "is too large for a character format." VIEW-AS ALERT-BOX WARNING.
      ASSIGN
         new_format:SCREEN-VALUE = new_format
         new_format:AUTO-ZAP     = True.
      RETURN NO-APPLY.
    END.
     
    IF (lError) THEN DO:
      APPLY "ENTRY" TO new_Format.
      new_Format:AUTO-ZAP = True.
      RETURN NO-APPLY.  
    END.
    new_Format = SELF:SCREEN-VALUE.
    RUN explore_charformat (new_Format).
  END.
END.

ON CHOOSE OF qbf-df IN FRAME qbf%char
  ASSIGN
    new_Format:SCREEN-VALUE IN FRAME qbf%char = "x(8)":u
    qbf-i:SCREEN-VALUE IN FRAME qbf%char      = 
      STRING(8,qbf-i:FORMAT IN FRAME qbf%char)
    qbf-s:SCREEN-VALUE IN FRAME qbf%char      = "x":u.

ON GO OF FRAME qbf%char OR CHOOSE OF bOk IN FRAME qbf%char DO:
  IF in-qbf-i THEN APPLY "LEAVE" TO qbf-i IN FRAME qbf%char.
  APPLY "LEAVE" TO new_Format IN FRAME qbf%char.
  ciopFormat = new_Format:SCREEN-VALUE IN FRAME qbf%char.
END.


/*--------------------------------------------------------------------------*/
/* date */

DEFINE VARIABLE qbf-d AS CHARACTER NO-UNDO. /* date variable */

FORM
  SKIP({&TFM_WID})
  qbf-t9 FORMAT "x(13)":u AT 4 VIEW-AS TEXT SKIP (.2)
  new_Format FORMAT "x(256)" NO-LABEL VIEW-AS FILL-IN SIZE 30 BY 1
    {&STDPH_FILL} AT 4

  SKIP(.3)

  qbf-d VIEW-AS RADIO-SET VERTICAL RADIO-BUTTONS
    "99/99/99":u	,"99/99/99":u	 ,
    "99-99-99":u	,"99-99-99":u	 ,
    "99.99.99":u	,"99.99.99":u	 ,
    "99/99/9999":u	,"99/99/9999":u	 ,
    "99-99-9999":u	,"99-99-9999":u	 ,
    "99.99.9999":u	,"99.99.9999":u	 ,
    "999999":u		,"999999":u		 ,
    "99999999":u	,"99999999":u	 AT 25

  {adecomm/okform.i
    &BOX    = "rect-1"
    &STATUS =  no
    &OK     = "bOk"
    &CANCEL = "bCancel"
    &OTHER  = "qbf-df"
    &HELP   = "bHelp" }

  WITH FRAME qbf%date 
  &if DEFINED(IDE-IS-RUNNING) = 0  &then
     TITLE caption
     VIEW-AS DIALOG-BOX
  &else
     no-box
  &endif 
     NO-LABELS THREE-D DEFAULT-BUTTON bOk.
  {adecomm/okrun.i  
    &FRAME  = "frame qbf%date" 
    &BOX    = "rect-1"
    &OK     = "bOK" 
    &OTHER  = "qbf-df"
    &HELP   = "bHelp" }

ON ALT-D OF FRAME qbf%date
   APPLY "ENTRY":u TO new_Format IN FRAME qbf%date.

/*--------------------------------------------------------------------------*/

ON WINDOW-CLOSE OF FRAME qbf%date
  APPLY "END-ERROR" TO SELF.             

ON HELP OF FRAME qbf%date OR CHOOSE OF bhelp IN FRAME qbf%date
  RUN "adecomm/_adehelp.p" ("comm", "CONTEXT", 
                            {&Numeric_Format_Date_Dlg_Box}, ?).

ON VALUE-CHANGED OF qbf-d IN FRAME qbf%date
  new_Format:SCREEN-VALUE IN FRAME qbf%date = 
    TRIM(qbf-d:SCREEN-VALUE IN FRAME qbf%date).

ON CHOOSE OF qbf-df IN FRAME qbf%date
  ASSIGN
    new_Format:SCREEN-VALUE IN FRAME qbf%date = "99/99/99":u
    qbf-d:SCREEN-VALUE IN FRAME qbf%date      = "99/99/99":u.

ON LEAVE OF new_Format IN FRAME qbf%date DO:
  IF LAST-EVENT:WIDGET-ENTER = bHelp:HANDLE IN FRAME qbf%date THEN RETURN. 
  IF LAST-EVENT:WIDGET-ENTER = qbf-d:HANDLE IN FRAME qbf%date THEN RETURN. 

  IF SELF:MODIFIED THEN DO:
    RUN adecomm/_chkfmt.p (2, "", "", SELF:SCREEN-VALUE, 
                           OUTPUT counter, OUTPUT lError).
    IF (lError) THEN DO:
      APPLY "ENTRY" TO new_Format.
      new_Format:AUTO-ZAP = True.
      RETURN NO-APPLY.  
    END.
    new_Format = SELF:SCREEN-VALUE.
  END.
END.

ON GO OF FRAME qbf%date OR CHOOSE OF bOk IN FRAME qbf%date DO:
  APPLY "LEAVE" TO new_Format IN FRAME qbf%date.
  ciopFormat = TRIM(new_Format:SCREEN-VALUE IN FRAME qbf%date).
END.

/*--------------------------------------------------------------------------*/
/* datetime */

DEFINE VARIABLE qbf-inc-tm     AS LOGICAL   NO-UNDO. /* include time variable */
DEFINE VARIABLE qbf-tm         AS CHARACTER NO-UNDO. /* datetime variable */
DEFINE VARIABLE qbf-dec-pl-sec AS INTEGER   NO-UNDO. /* decimal places for seconds */
DEFINE VARIABLE qbf-12-hr      AS LOGICAL   NO-UNDO. /* 12 hour format */

FORM
  SKIP({&TFM_WID})
  qbf-t9 FORMAT "x(20)":u AT 4 VIEW-AS TEXT SKIP (.2)
  new_Format FORMAT "x(256)" NO-LABEL VIEW-AS FILL-IN SIZE 33 BY 1
    {&STDPH_FILL} AT 4 SKIP (.3)

  qbf-d VIEW-AS RADIO-SET VERTICAL RADIO-BUTTONS
    "99/99/99":u	,"99/99/99":u	 ,
    "99-99-99":u	,"99-99-99":u	 ,
    "99.99.99":u	,"99.99.99":u	 ,
    "99/99/9999":u	,"99/99/9999":u	 ,
    "99-99-9999":u	,"99-99-9999":u	 ,
    "99.99.9999":u	,"99.99.9999":u	 ,
    "999999":u		,"999999":u		 ,
    "99999999":u	,"99999999":u	 AT 10

  qbf-inc-tm LABEL "Include time" VIEW-AS TOGGLE-BOX AT 35 SKIP(.2)

  qbf-tm VIEW-AS RADIO-SET VERTICAL RADIO-BUTTONS
    "HH":u       ,"HH":u       ,
    "HH:MM":u    ,"HH:MM":u    ,
    "HH:MM:SS":u ,"HH:MM:SS":u  AT ROW 4.6 COL 35 SKIP(.2)

  "Decimal places for seconds:" AT 35 

  qbf-dec-pl-sec FORMAT "9" VIEW-AS COMBO-BOX SIZE-CHARS 10 BY 1 LIST-ITEMS 0,1,2,3 AT 35 SKIP(.2)

  qbf-12-hr LABEL "12 hour format (AM/PM)" VIEW-AS TOGGLE-BOX AT 35

  {adecomm/okform.i
    &BOX    = "rect-1"
    &STATUS =  no
    &OK     = "bOk"
    &CANCEL = "bCancel"
    &OTHER  = "qbf-df"
    &HELP   = "bHelp" }

  WITH FRAME qbf%datetime 
&if DEFINED(IDE-IS-RUNNING) = 0  &then
  VIEW-AS DIALOG-BOX
  TITLE caption
&else
  no-box 
&endif
  NO-LABELS THREE-D
  DEFAULT-BUTTON bOk. 
  
  {adecomm/okrun.i  
    &FRAME  = "frame qbf%datetime" 
    &BOX    = "rect-1"
    &OK     = "bOK" 
    &OTHER  = "qbf-df"
    &HELP   = "bHelp" }

ON ALT-D OF FRAME qbf%datetime
   APPLY "ENTRY":u TO new_Format IN FRAME qbf%datetime.

/*--------------------------------------------------------------------------*/

ON WINDOW-CLOSE OF FRAME qbf%datetime
  APPLY "END-ERROR" TO SELF.             

ON HELP OF FRAME qbf%datetime OR CHOOSE OF bhelp IN FRAME qbf%datetime
  RUN "adecomm/_adehelp.p" ("comm", "CONTEXT", 
                            {&Numeric_Format_DateTime_Dlg_Box}, ?).

ON VALUE-CHANGED OF qbf-d IN FRAME qbf%datetime
  RUN setNewFormat4DateTime.

ON CHOOSE OF qbf-df IN FRAME qbf%datetime DO:
  ASSIGN
      qbf-d:SCREEN-VALUE = "99/99/9999":u
      qbf-inc-tm:CHECKED = TRUE
      qbf-tm:SCREEN-VALUE = "HH:MM:SS":u
      qbf-dec-pl-sec:SCREEN-VALUE = '3'
      qbf-12-hr:CHECKED = FALSE.
  RUN setNewFormat4DateTime.
  APPLY "VALUE-CHANGED" TO qbf-inc-tm.
END.

ON LEAVE OF new_Format IN FRAME qbf%datetime DO:
  IF LAST-EVENT:WIDGET-ENTER = bHelp:HANDLE IN FRAME qbf%datetime THEN RETURN. 
  IF LAST-EVENT:WIDGET-ENTER = qbf-d:HANDLE IN FRAME qbf%datetime THEN RETURN. 

  IF SELF:MODIFIED THEN DO:
    RUN adecomm/_chkfmt.p (34, "", "", SELF:SCREEN-VALUE, 
                           OUTPUT counter, OUTPUT lError).
    IF (lError) THEN DO:
      APPLY "ENTRY" TO new_Format.
      new_Format:AUTO-ZAP = True.
      RETURN NO-APPLY.  
    END.
    new_Format = SELF:SCREEN-VALUE.
  END.
END.

ON GO OF FRAME qbf%datetime OR CHOOSE OF bOk IN FRAME qbf%datetime DO:
  APPLY "LEAVE" TO new_Format IN FRAME qbf%datetime.
  ciopFormat = TRIM(new_Format:SCREEN-VALUE IN FRAME qbf%datetime).
END.

/*--------------------------------------------------------------------------*/
/* datetime-tz */

DEFINE VARIABLE qbf-inc-tz AS LOGICAL    NO-UNDO. /* Include Time Zone */

FORM
  SKIP({&TFM_WID})
  qbf-t9 FORMAT "x(20)":u AT 4 VIEW-AS TEXT SKIP (.2)
  new_Format FORMAT "x(256)" NO-LABEL VIEW-AS FILL-IN SIZE 45 BY 1
    {&STDPH_FILL} AT 4 SKIP (.3)

  qbf-d VIEW-AS RADIO-SET VERTICAL RADIO-BUTTONS
    "99/99/99":u	,"99/99/99":u	 ,
    "99-99-99":u	,"99-99-99":u	 ,
    "99.99.99":u	,"99.99.99":u	 ,
    "99/99/9999":u	,"99/99/9999":u	 ,
    "99-99-9999":u	,"99-99-9999":u	 ,
    "99.99.9999":u	,"99.99.9999":u	 ,
    "999999":u		,"999999":u		 ,
    "99999999":u	,"99999999":u	 AT 10

  qbf-inc-tm LABEL "Include time" VIEW-AS TOGGLE-BOX AT 35 SKIP(.2)

  qbf-tm VIEW-AS RADIO-SET VERTICAL RADIO-BUTTONS
    "HH":u       ,"HH":u       ,
    "HH:MM":u    ,"HH:MM":u    ,
    "HH:MM:SS":u ,"HH:MM:SS":u  AT ROW 4.6 COL 35 SKIP(.2)

  "Decimal places for seconds:" AT 35 

  qbf-dec-pl-sec FORMAT "9" VIEW-AS COMBO-BOX SIZE-CHARS 10 BY 1 LIST-ITEMS 0,1,2,3 AT 35 SKIP(.2)

  qbf-12-hr LABEL "12 hour format (AM/PM)" VIEW-AS TOGGLE-BOX AT 35 SKIP(.2)

  qbf-inc-tz LABEL "Include time zone" VIEW-AS TOGGLE-BOX AT 35

  {adecomm/okform.i
    &BOX    = "rect-1"
    &STATUS =  no
    &OK     = "bOk"
    &CANCEL = "bCancel"
    &OTHER  = "qbf-df"
    &HELP   = "bHelp" }

  WITH FRAME qbf%datetimetz 
&if DEFINED(IDE-IS-RUNNING) = 0  &then
  VIEW-AS DIALOG-BOX
  TITLE caption
&else
  no-box 
&endif
  NO-LABELS 
  THREE-D
  DEFAULT-BUTTON bOk .

  {adecomm/okrun.i  
    &FRAME  = "frame qbf%datetimetz" 
    &BOX    = "rect-1"
    &OK     = "bOK" 
    &OTHER  = "qbf-df"
    &HELP   = "bHelp" }

ON ALT-D OF FRAME qbf%datetimetz
   APPLY "ENTRY":u TO new_Format IN FRAME qbf%datetimetz.

/*--------------------------------------------------------------------------*/

ON WINDOW-CLOSE OF FRAME qbf%datetimetz
  APPLY "END-ERROR" TO SELF.             

ON HELP OF FRAME qbf%datetimetz OR CHOOSE OF bhelp IN FRAME qbf%datetimetz
  RUN "adecomm/_adehelp.p" ("comm", "CONTEXT", 
                            {&Numeric_Format_DateTimeTz_Dlg_Box}, ?).

ON VALUE-CHANGED OF qbf-d IN FRAME qbf%datetimetz
  RUN setNewFormat4DateTimeTZ.

ON CHOOSE OF qbf-df IN FRAME qbf%datetimetz DO:
  ASSIGN
      qbf-d:SCREEN-VALUE = "99/99/9999":u
      qbf-inc-tm:CHECKED = TRUE
      qbf-tm:SCREEN-VALUE = "HH:MM:SS":u
      qbf-dec-pl-sec:SCREEN-VALUE = '3'
      qbf-12-hr:CHECKED = FALSE
      qbf-inc-tz:CHECKED = TRUE.
  RUN setNewFormat4DateTimeTZ.
  APPLY "VALUE-CHANGED" TO qbf-inc-tm.
END.

ON LEAVE OF new_Format IN FRAME qbf%datetimetz DO:
  IF LAST-EVENT:WIDGET-ENTER = bHelp:HANDLE IN FRAME qbf%datetimetz THEN RETURN. 
  IF LAST-EVENT:WIDGET-ENTER = qbf-d:HANDLE IN FRAME qbf%datetimetz THEN RETURN. 

  IF SELF:MODIFIED THEN DO:
    RUN adecomm/_chkfmt.p (40, "", "", SELF:SCREEN-VALUE, 
                           OUTPUT counter, OUTPUT lError).
    IF (lError) THEN DO:
      APPLY "ENTRY" TO new_Format.
      new_Format:AUTO-ZAP = True.
      RETURN NO-APPLY.  
    END.
    new_Format = SELF:SCREEN-VALUE.
  END.
END.

ON GO OF FRAME qbf%datetimetz OR CHOOSE OF bOk IN FRAME qbf%datetimetz DO:
  APPLY "LEAVE" TO new_Format IN FRAME qbf%datetimetz.
  ciopFormat = TRIM(new_Format:SCREEN-VALUE IN FRAME qbf%datetimetz).
END.

/*--------------------------------------------------------------------------*/
/* logical */

DEFINE VARIABLE qbf-l1 AS CHARACTER NO-UNDO. /* logical (true) variable */
DEFINE VARIABLE qbf-l2 AS CHARACTER NO-UNDO. /* logical (false) variable */

 
FORM
  SKIP({&TFM_WID})
  qbf-t1 FORMAT "x(18)":u  AT 10 VIEW-AS TEXT SKIP
  new_Format FORMAT "x(256)" VIEW-AS FILL-IN SIZE 30 BY 1 {&STDPH_FILL} AT 10
 
  qbf-t2 FORMAT "x(32)":u  AT 10 VIEW-AS TEXT SKIP
  qbf-l1 FORMAT "x(30)":u  AT 10
  SKIP(.5)
  qbf-t3 FORMAT "x(32)":u  AT 10 VIEW-AS TEXT SKIP
  qbf-l2 FORMAT "x(30)":u  AT 10

  {adecomm/okform.i
    &BOX    = "rect-1"
    &STATUS =  no
    &OK     = "bOk"
    &CANCEL = "bCancel"
    &OTHER  = "qbf-df"
    &HELP   = "bHelp" }

  WITH FRAME qbf%logi 
&if DEFINED(IDE-IS-RUNNING) = 0  &then
  VIEW-AS DIALOG-BOX
  TITLE caption
&else
  no-box 
&endif
  NO-LABELS THREE-D
  DEFAULT-BUTTON bOk. 

  {adecomm/okrun.i  
    &FRAME  = "frame qbf%logi" 
    &BOX    = "rect-1"
    &OK     = "bOK" 
    &OTHER  = "qbf-df"
    &HELP   = "bHelp" }

                               
ON ALT-L OF FRAME qbf%logi
   APPLY "ENTRY":u TO new_format IN FRAME qbf%logi.

ON ALT-T OF FRAME qbf%logi
   APPLY "ENTRY":u TO qbf-l1     IN FRAME qbf%logi.

ON ALT-F OF FRAME qbf%logi
   APPLY "ENTRY":u TO qbf-l2     IN FRAME qbf%logi.

/*--------------------------------------------------------------------------*/

ON WINDOW-CLOSE OF FRAME qbf%logi
  APPLY "END-ERROR" TO SELF.             

ON HELP OF FRAME qbf%logi OR CHOOSE OF bHelp IN FRAME qbf%logi
  RUN adecomm/_adehelp.p ("comm", "CONTEXT", 
      	       	     	  {&Numeric_Format_Logical_Dlg_Box}, ?).

ON ENTRY,LEAVE OF qbf-l1 IN FRAME qbf%logi, qbf-l2 iN FRAME qbf%logi
  new_Format:SCREEN-VALUE IN FRAME qbf%logi =
    qbf-l1:SCREEN-VALUE IN FRAME qbf%logi + "/":u + 
    qbf-l2:SCREEN-VALUE IN FRAME qbf%logi.
 
ON CHOOSE OF qbf-df IN FRAME qbf%logi
  ASSIGN
    new_Format:SCREEN-VALUE IN FRAME qbf%logi = "yes/no":u
    qbf-l1:SCREEN-VALUE IN FRAME qbf%logi     = "yes":u
    qbf-l2:SCREEN-VALUE IN FRAME qbf%logi     = "no":u
  .

ON LEAVE OF new_Format IN FRAME qbf%logi DO:
  IF LAST-EVENT:WIDGET-ENTER = bHelp:HANDLE IN FRAME qbf%logi THEN RETURN. 
  IF LAST-EVENT:WIDGET-ENTER = qbf-l1:HANDLE IN FRAME qbf%logi THEN RETURN. 

  IF SELF:MODIFIED THEN DO:
     RUN adecomm/_chkfmt.p (3, "", "", SELF:SCREEN-VALUE, 
                            OUTPUT counter, OUTPUT lError).
    IF (lError) THEN DO:
      APPLY "ENTRY" TO new_Format.
      new_Format:AUTO-ZAP = True.
      RETURN NO-APPLY.  
    END.
    ASSIGN
      new_Format          = SELF:SCREEN-VALUE 
      qbf-l1:screen-value = if num-entries(new_format,"/":U) > 1 then
                            entry(1,new_format,"/":U) else new_format
      qbf-l2:screen-value = if num-entries(new_format,"/":U) > 1 then
                            entry(2,new_format,"/":U) else new_format.
  END.
END.

ON GO OF FRAME qbf%logi OR CHOOSE OF bOk IN FRAME qbf%logi DO:
  APPLY "LEAVE" TO new_Format IN FRAME qbf%logi.
  ciopFormat = TRIM(new_Format:SCREEN-VALUE IN FRAME qbf%logi).
END.

/*--------------------------------------------------------------------------*/
/* integer/decimal */

DEFINE VARIABLE dec_separator as char no-undo.
DEFINE VARIABLE tho_separator as char no-undo.
DEFINE VARIABLE conv_fmt      as char no-undo.

DEFINE VARIABLE qbf-na AS LOGICAL   NO-UNDO.  /* use leading ***'s */
DEFINE VARIABLE qbf-nb AS LOGICAL   NO-UNDO.  /* show zero as '' (not '0') */
DEFINE VARIABLE qbf-nc AS LOGICAL   NO-UNDO.  /* use thousands separator */
DEFINE VARIABLE qbf-nd AS INTEGER   NO-UNDO.  /* number of decimal places */
DEFINE VARIABLE qbf-nl AS CHARACTER NO-UNDO.  /* leading text string */
DEFINE VARIABLE qbf-nn AS INTEGER   NO-UNDO.  /* total number of digits */
DEFINE VARIABLE qbf-np AS INTEGER   NO-UNDO. /* Positive/Negative handling */
                        
DEFINE VARIABLE qbf-ns AS LOGICAL   NO-UNDO.  /* sliding decimal format */
DEFINE VARIABLE qbf-nt AS CHARACTER NO-UNDO.  /* trailing text string */
DEFINE VARIABLE qbf-nz AS LOGICAL   NO-UNDO.  /* suppress leading zeros */
DEFINE VARIABLE qbf-zr AS INTEGER   NO-UNDO.  /* Zero radio-set */

ASSIGN
  dec_separator = SESSION:NUMERIC-DECIMAL-POINT
  tho_separator = SESSION:NUMERIC-SEPARATOR.

/* Determine whether the numeric format is non-American and sets notAmerican
   variable which is used to determine whether to call _convert.p or not */
IF tho_separator NE "," OR dec_separator NE "." THEN notAmerican = yes.
ELSE notAmerican = no.

FORM
  SKIP({&TFM_WID})
  qbf-t4 FORMAT "x(18)":u  AT 2 VIEW-AS TEXT SKIP({&VM_WID})
  new_Format FORMAT "x(256)" AT 2 VIEW-AS FILL-IN SIZE 30 BY 1 {&STDPH_FILL} 
     SKIP({&VM_WIDG})
  qbf-nn FORMAT ">>9":u VIEW-AS FILL-IN {&STDPH_FILL} AT 2
  qbf-t5 FORMAT "x(30)":u VIEW-AS TEXT SKIP({&VM_WID})
  qbf-nd FORMAT ">>9":u VIEW-AS FILL-IN {&STDPH_FILL} AT 2 
  qbf-t6 FORMAT "x(30)":u VIEW-AS TEXT SKIP({&VM_WID})
  qbf-nc VIEW-AS TOGGLE-BOX LABEL "&Use Thousand's Separator ///":t30 
   AT 2 SKIP({&VM_WIDG}) 
  qbf-zr VIEW-AS RADIO-SET VERTICAL RADIO-BUTTONS
    "Suppress Leading Zeros":t30   ,1,
    "Show As Zero":t30             ,2,
    "Show As Asterisk":t30         ,3
    AT 2 SKIP (.75)
  qbf-t7 FORMAT "x(24)":u VIEW-AS TEXT AT 2 SKIP({&VM_WID})
  qbf-nl FORMAT "x(30)":u VIEW-AS FILL-IN  {&STDPH_FILL} AT 2 SKIP({&VM_WID})
  qbf-t8 FORMAT "x(24)":u VIEW-AS TEXT AT 2 SKIP({&VM_WID})
  qbf-nt FORMAT "x(30)":u VIEW-AS FILL-IN  {&STDPH_FILL} AT 2 

  {adecomm/okform.i
    &BOX    = "rect-1"
    &STATUS =  no
    &OK     = "bOk"
    &CANCEL = "bCancel"
    &OTHER  = "qbf-df"
    &HELP   = "bHelp" }

  qbf-np VIEW-AS RADIO-SET VERTICAL RADIO-BUTTONS
    "Show Leading Sign Always"	          , 01,
    "Show Leading Sign on Negatives Only"   , 02,
    "Show Trailing Sign Always"	          , 03,
    "Show Trailing Sign on Negatives Only"  , 04,
    "Show Negative Numbers in Parentheses"  , 05,
    "Show Negatives With Trailing 'CR'"     , 06,
    "Show Negatives With Trailing 'DB'"     , 07,
    "Show Negatives With Trailing 'DR'"     , 08,
    "Show Negatives With Trailing 'cr '"    , 09,
    "Show Negatives With Trailing 'db '"    , 10,
    "Show Negatives With Trailing 'dr '"    , 11,
    "Allow Positive Numbers Only"           , 12   
    &IF LOOKUP("{&OPSYS}" , "MSDOS,WIN32":u) = 0
    &THEN 
       SIZE 42 by 13.5 
    &ELSE
       SIZE 42 by 12                                
    &ENDIF
    &IF "{&WINDOW-SYSTEM}" BEGINS "MS-WIN" &THEN
      AT ROW-OF new_Format COLUMN 40 
    &ELSE
      AT ROW-OF new_Format - .5 COLUMN 40
    &ENDIF

  WITH FRAME qbf%numb 
&if DEFINED(IDE-IS-RUNNING) = 0  &then
  VIEW-AS DIALOG-BOX
  TITLE caption
&else
  no-box 
&endif
  NO-LABELS SCROLLABLE THREE-D
  DEFAULT-BUTTON bOk. 

ASSIGN qbf-t5:HEIGHT IN FRAME qbf%numb = qbf-nn:HEIGHT
       qbf-t6:HEIGHT IN FRAME qbf%numb = qbf-nd:HEIGHT.


  {adecomm/okrun.i  
    &FRAME  = "frame qbf%numb" 
    &BOX    = "rect-1"
    &OK     = "bOK" 
    &OTHER  = "qbf-df"
    &HELP   = "bHelp" }

ON ALT-F OF FRAME qbf%numb
   APPLY "ENTRY":u TO new_Format IN FRAME qbf%numb.

ON ALT-N OF FRAME qbf%numb
   APPLY "ENTRY":u TO qbf-nn     IN FRAME qbf%numb.

ON ALT-D OF FRAME qbf%numb
   APPLY "ENTRY":u TO qbf-nd     IN FRAME qbf%numb.

ON ALT-L OF FRAME qbf%numb
   APPLY "ENTRY":u TO qbf-nl     IN FRAME qbf%numb.

ON ALT-T OF FRAME qbf%numb
   APPLY "ENTRY":u TO qbf-nt     IN FRAME qbf%numb.

ON WINDOW-CLOSE OF FRAME qbf%numb
  APPLY "END-ERROR" TO SELF.             

ON HELP OF FRAME qbf%numb OR CHOOSE OF bHelp IN FRAME qbf%numb
  RUN adecomm/_adehelp.p ("comm", "CONTEXT", 
      	       	     	  {&Numeric_Format_Number_Dlg_Box}, ?).

/*--------------------------------------------------------------------------*/

ON LEAVE OF new_Format IN FRAME qbf%numb DO: 
  RUN check_numb_format.
  IF RETURN-VALUE = "error" THEN RETURN NO-APPLY.
END.

ON 
  VALUE-CHANGED OF qbf-nc IN FRAME qbf%numb
  OR VALUE-CHANGED OF qbf-zr IN FRAME qbf%numb
  OR VALUE-CHANGED OF qbf-np IN FRAME qbf%numb 
DO:
/*message "before assign" qbf-np qbf-np:screen-value view-as alert-box.*/
  ASSIGN
    qbf-nc = INPUT FRAME qbf%numb qbf-nc
    qbf-nn = INPUT FRAME qbf%numb qbf-nn
    qbf-np = INTEGER(qbf-np:screen-value)
    qbf-zr = INTEGER(qbf-zr:screen-value)
    qbf-nz = IF qbf-zr = 1 THEN True ELSE False
    qbf-nb = IF qbf-zr = 2 THEN True ELSE False
    qbf-na = IF qbf-zr = 3 THEN True ELSE False.
  RUN construct_format (OUTPUT new_Format).
  DISPLAY new_Format WITH FRAME qbf%numb.
END.


ON LEAVE OF qbf-nd IN FRAME qbf%numb 
  OR LEAVE OF qbf-nn IN FRAME qbf%numb 
  OR LEAVE OF qbf-nl IN FRAME qbf%numb
  OR LEAVE OF qbf-nt IN FRAME qbf%numb DO:


  DEFINE VARIABLE qbf_c   AS CHARACTER CASE-SENSITIVE NO-UNDO.
  define variable i       as integer    no-undo.
  define variable badChar as logical    no-undo. 
  define variable TestDigits as integer no-undo.    
                   
  if integer(qbf-nn:screen-value) > 256 then do:      
    message "The format cannot exceed 256 characters," skip
    "including punctuation characters." view-as alert-box warning. 
    assign
      qbf-nn:screen-value = "256"
      qbf-nn:auto-zap     = true.
    return no-apply.
  end.


  IF    qbf-nn = INPUT FRAME qbf%numb qbf-nn
    AND qbf-nd = INPUT FRAME qbf%numb qbf-nd
    AND qbf-nl = INPUT FRAME qbf%numb qbf-nl
    AND qbf-nt = INPUT FRAME qbf%numb qbf-nt THEN RETURN.

  /* If user changed the number of decimal digits, reset the total
     digits based on how much this grew or shrunk from previous 
     value.
  */
  IF SELF = qbf-nd:HANDLE IN FRAME qbf%numb THEN 
    ASSIGN
      qbf-nn = MIN(qbf-nn + (INPUT FRAME qbf%numb qbf-nd - qbf-nd), 50)
      qbf-nn:SCREEN-VALUE IN FRAME qbf%numb = STRING(qbf-nn,">>>9":u).

  ASSIGN
    qbf-nn = INPUT FRAME qbf%numb qbf-nn
    qbf-nd = INPUT FRAME qbf%numb qbf-nd
    qbf-nl = INPUT FRAME qbf%numb qbf-nl
    qbf-nt = INPUT FRAME qbf%numb qbf-nt.

  /*
   * Check the leading and trailing strings for "bad" characters.
   */

  badChar = false.
  do i = 1 to LENGTH(qbf-nl,"CHARACTER":u):

    qbf_c = SUBSTRING(qbf-nl,i,1,"CHARACTER":u).
    if index("+-<>,.*zZ01923456789", qbf_c) > 0 then do:
        badChar = true.
        leave.
    end.

  end.
  
  qbf-nl = qbf-nl + " ". /* used as separator */
  
  if badChar = true then do:
      message "The Leading Text String" qbf-nl "contains the" skip
              "character" qbf_c ". This character is not allowed" skip
              "in a leading text string."
      view-as alert-box.
      return no-apply.

  end.

  badChar = false.
  DO i = 1 to LENGTH(qbf-nt,"CHARACTER":u):

    qbf_c = SUBSTRING(qbf-nt,i,1,"CHARACTER":u).
    IF INDEX("+-<>,.*zZ01923456789", qbf_c) > 0 then do:

       badChar = true.
       leave.
    END.
  END.

  IF iipType = 4 THEN DO:
    IF isInt64 THEN
    DO:
        IF qbf-nn > 18 THEN DO:
           MESSAGE "INT64 values cannot have more than 18 digits."
                VIEW-AS ALERT-BOX ERROR.
           RETURN NO-APPLY.
       END.
    END.
    ELSE IF qbf-nn > 10 THEN
    DO:
        MESSAGE "Integer values cannot have more than 10 digits."
            VIEW-AS ALERT-BOX ERROR.
        RETURN NO-APPLY.
    END.
  END. /*IF iipType = 4 THEN DO*/
  ELSE IF iipType = 5 AND qbf-nn > 50 THEN DO:
    MESSAGE "Decimal values cannot have more than 50 digits."
        VIEW-AS ALERT-BOX ERROR.
    RETURN NO-APPLY.
  END.
  
  if badChar = true then do:

      message "The Trailing Text String" qbf-nl "contains the" skip
              "character" qbf_c ". This character is not allowed" skip
              "in a trailing text string."
      view-as alert-box.
      return no-apply.

  end.

  IF SELF = qbf-nn:HANDLE IN FRAME qbf%numb THEN 
    IF qbf-nn < qbf-nd THEN
      ASSIGN
      	qbf-nd = qbf-nn
        qbf-nd:SCREEN-VALUE IN FRAME qbf%numb = STRING(qbf-nd,">>>9":u).

  RUN construct_format (OUTPUT qbf_c).
  new_Format:SCREEN-VALUE IN FRAME qbf%numb = qbf_c.
END.

ON CHOOSE OF qbf-df IN FRAME qbf%numb DO:

  IF iipType = 4 THEN  /* integer */
    new_Format:SCREEN-VALUE = IF notAmerican THEN "->":U + tho_separator + ">>>":U + tho_separator + ">>9":U
                              ELSE "->,>>>,>>9":U.
  ELSE  /* decimal */
    new_Format:SCREEN-VALUE = IF notAmerican THEN "->>":U + tho_separator + ">>9":U + dec_separator + "99":U
                              ELSE "->>,>>9.99":U.
  ASSIGN
    qbf-nc:screen-value      = STRING(TRUE)   
    qbf-nd:screen-value      = STRING((IF iipType = 4 THEN 0 ELSE 2))
    qbf-nl:screen-value      = ""
    qbf-nn:screen-value      = STRING(7)
    qbf-np:screen-value      = STRING(2)
    qbf-nt:screen-value      = ""
    qbf-nz                   = new_Format:screen-value BEGINS ">" OR
                               new_Format:screen-value BEGINS "Z"
    qbf-zr                   = 1
    qbf-zr:screen-value      = string(qbf-zr)
    qbf-nt                   = "".
END.

ON GO OF FRAME qbf%numb OR CHOOSE OF bOk IN FRAME qbf%numb DO:
  RUN check_numb_format.
  IF RETURN-VALUE = "error" THEN RETURN NO-APPLY.
  ciopFormat = TRIM(new_Format:SCREEN-VALUE IN FRAME qbf%numb).
END.

ON VALUE-CHANGED OF qbf-inc-tm IN FRAME qbf%datetime
DO:
    ASSIGN
        qbf-inc-tm
        qbf-tm
        qbf-tm:SENSITIVE = qbf-inc-tm = TRUE
        qbf-dec-pl-sec:SENSITIVE = qbf-inc-tm = TRUE AND qbf-tm = "HH:MM:SS"
        qbf-12-hr:SENSITIVE = qbf-inc-tm = TRUE.
    RUN setNewFormat4DateTime.
    RETURN.
END.

ON VALUE-CHANGED OF qbf-tm IN FRAME qbf%datetime
DO:
    ASSIGN
        qbf-tm
        qbf-dec-pl-sec:SENSITIVE = qbf-tm = "HH:MM:SS".
    RUN setNewFormat4DateTime.
    RETURN.
END.

ON VALUE-CHANGED OF qbf-dec-pl-sec IN FRAME qbf%datetime
DO:
    RUN setNewFormat4DateTime.
    RETURN.
END.

ON VALUE-CHANGED OF qbf-12-hr IN FRAME qbf%datetime
DO:
    RUN setNewFormat4DateTime.
    RETURN.
END.

ON VALUE-CHANGED OF qbf-inc-tm IN FRAME qbf%datetimetz
DO:
    ASSIGN
        qbf-inc-tm
        qbf-tm
        qbf-tm:SENSITIVE = qbf-inc-tm = TRUE
        qbf-dec-pl-sec:SENSITIVE = qbf-inc-tm = TRUE AND qbf-tm = "HH:MM:SS"
        qbf-12-hr:SENSITIVE = qbf-inc-tm = TRUE
        qbf-inc-tz:SENSITIVE = qbf-inc-tm = TRUE.
    RUN setNewFormat4DateTimeTZ.
    RETURN.
END.

ON VALUE-CHANGED OF qbf-tm IN FRAME qbf%datetimetz
DO:
    ASSIGN
        qbf-tm
        qbf-dec-pl-sec:SENSITIVE = qbf-tm = "HH:MM:SS".
    RUN setNewFormat4DateTimeTZ.
    RETURN.
END.

ON VALUE-CHANGED OF qbf-dec-pl-sec IN FRAME qbf%datetimetz
DO:
    RUN setNewFormat4DateTimeTZ.
    RETURN.
END.

ON VALUE-CHANGED OF qbf-12-hr IN FRAME qbf%datetimetz
DO:
    RUN setNewFormat4DateTimeTZ.
    RETURN.
END.

ON VALUE-CHANGED OF qbf-inc-tz IN FRAME qbf%datetimetz
DO:
    RUN setNewFormat4DateTimeTZ.
    RETURN.
END.

/*-- main ----------------------------*/

ASSIGN qbf-i:WIDTH IN FRAME qbf%char = qbf-i:WIDTH IN FRAME qbf%char + .5.

/* used to define on choose of cancel and apply in dialoginit.i */
&SCOPED-DEFINE CANCEL-EVENT U2

new_Format = ciopFormat. /* Copy INPUT-OUTPUT parameter into local variable */
CASE iipType:
  WHEN 1 THEN DO: /* character ---------------------------------------------*/
     &if DEFINED(IDE-IS-RUNNING) <> 0  &then
    {adeuib/ide/dialoginit.i "frame qbf%char:handle"}
     dialogService:View().
     &endif
    
    
    IF new_Format = ? OR new_Format = "" THEN new_Format = "x(8)":u.
    ASSIGN
      qbf-i = LENGTH(STRING("",new_Format),"RAW":u)
      qbf-i:SCREEN-VALUE IN FRAME qbf%char = STRING(qbf-i,">>>>9":u)
    &if defined(IDE-IS-RUNNING) = 0 &THEN
      FRAME qbf%char:THREE-D = SESSION:THREE-D
    &ENDIF  
      .
     
    IF INDEX("xna!9":u,SUBSTRING(new_Format,1,1,"CHARACTER":u)) > 0 THEN
      qbf-s:SCREEN-VALUE IN FRAME qbf%char = SUBSTRING(new_Format,1,1,
                                                       "CHARACTER":u).

    ENABLE new_Format qbf-i qbf-s bOk bCancel qbf-df bHelp WITH FRAME qbf%char.
    APPLY "ENTRY" TO qbf-i IN FRAME qbf%char.
    new_Format:SCREEN-VALUE IN FRAME qbf%char = new_Format.
    
    {adeuib/ide/dialogstart.i bok bcancel caption "in frame qbf%char}.
    DO ON ERROR UNDO,LEAVE ON ENDKEY UNDO,LEAVE:
        &if DEFINED(IDE-IS-RUNNING) = 0  &then
        WAIT-FOR GO OF FRAME qbf%char.
        &ELSE
        WAIT-FOR GO OF FRAME qbf%char or "u2" of this-procedure.       
        if cancelDialog THEN UNDO, LEAVE.  
        &endif      
    END.
    HIDE FRAME qbf%char NO-PAUSE.
  END.
  WHEN 2 THEN DO: /* date --------------------------------------------------*/
     &if DEFINED(IDE-IS-RUNNING) <> 0  &then
    {adeuib/ide/dialoginit.i "frame qbf%date:handle"}
     dialogService:View().
     &endif
    IF new_Format = ? OR new_Format = "" THEN new_Format = "99/99/99":u.
    RUN date_settings (OUTPUT qbf-d,OUTPUT qbf-i).

    ASSIGN
      qbf-d = "99/99/99,99-99-99,99.99.99,":u
            + (IF qbf-d MATCHES "..y":u THEN
                "99/99/9999,99-99-9999,99.99.9999":u
              ELSE IF qbf-d MATCHES "y..":u THEN
                "9999/99/99,9999-99-99,9999.99.99":u
              ELSE
                "99/9999/99,99-9999-99,99.9999.99":u)
            + ",999999,99999999":u
      qbf-t9 = "&Date Format:":t13

      &if defined(IDE-IS-RUNNING) = 0 &THEN
      FRAME qbf%date:THREE-D = SESSION:THREE-D
      &endif

      qbf-h  = qbf-d:HANDLE IN FRAME qbf%date
      qbf-c  = ""
      .
 
    /* interweave qbf-d values to create new radio-set values, i.e.
       "label1,value1,label2,value2..." */ 
    DO qbf-i = 1 TO NUM-ENTRIES(qbf-d):
      qbf-c = qbf-c + (IF qbf-i > 1 THEN ",":u ELSE "")
            + ENTRY(qbf-i,qbf-d) + ",":u + ENTRY(qbf-i,qbf-d).
    END.
    qbf-h:RADIO-BUTTONS = qbf-c.

    DISPLAY qbf-t9
      WITH FRAME qbf%date.

    ENABLE new_Format qbf-d bOk bCancel qbf-df bHelp WITH FRAME qbf%date.
    APPLY "ENTRY" TO qbf-d IN FRAME qbf%date.

    IF LOOKUP(new_Format,qbf-d) > 0 THEN
      qbf-d:SCREEN-VALUE IN FRAME qbf%date = new_Format.

    new_Format:SCREEN-VALUE IN FRAME qbf%date = new_Format.
    {adeuib/ide/dialogstart.i bok bcancel caption "in frame qbf%date}.
    DO ON ERROR UNDO,LEAVE ON ENDKEY UNDO,LEAVE:
        &if DEFINED(IDE-IS-RUNNING) = 0  &then
        WAIT-FOR GO OF FRAME qbf%date.
        &ELSE
        WAIT-FOR GO OF FRAME qbf%date or "u2" of this-procedure.       
        if cancelDialog THEN UNDO, LEAVE.  
        &endif      
    END.
    HIDE FRAME qbf%date NO-PAUSE.
  END.
  WHEN 34 THEN DO: /* datetime ---------------------------------------------*/
    &if DEFINED(IDE-IS-RUNNING) <> 0  &then
    {adeuib/ide/dialoginit.i "frame qbf%datetime:handle"}
     dialogService:View().
     &endif
    IF new_Format = ? OR new_Format = "" THEN new_Format = "99/99/99 HH:MM:SS":u.
    RUN date_settings (OUTPUT qbf-d,OUTPUT qbf-i).

    ASSIGN
      qbf-d = "99/99/99,99-99-99,99.99.99,":u
            + (IF qbf-d MATCHES "..y":u THEN
                "99/99/9999,99-99-9999,99.99.9999":u
              ELSE IF qbf-d MATCHES "y..":u THEN
                "9999/99/99,9999-99-99,9999.99.99":u
              ELSE
                "99/9999/99,99-9999-99,99.9999.99":u)
            + ",999999,99999999":u
      qbf-t9 = "&DateTime Format:":t20
        &if defined(IDE-IS-RUNNING) = 0 &THEN
      FRAME qbf%datetime:THREE-D = SESSION:THREE-D
        &endif
      qbf-h  = qbf-d:HANDLE IN FRAME qbf%datetime
      qbf-c  = ""
      .

    /* interweave qbf-d values to create new radio-set values, i.e.
       "label1,value1,label2,value2..." */ 
    DO qbf-i = 1 TO NUM-ENTRIES(qbf-d):
      qbf-c = qbf-c + (IF qbf-i > 1 THEN ",":u ELSE "")
            + ENTRY(qbf-i,qbf-d) + ",":u + ENTRY(qbf-i,qbf-d).
    END.
    qbf-h:RADIO-BUTTONS = qbf-c.

    /* determine time values from new_Format */
    ASSIGN
        qbf-tm = IF new_Format MATCHES "*HH:MM:SS*"
                 THEN "HH:MM:SS"
                 ELSE IF new_Format MATCHES "*HH:MM*"
                      THEN "HH:MM"
                      ELSE IF new_Format MATCHES "*HH*"
                           THEN "HH"
                           ELSE ""
        qbf-inc-tm = qbf-tm > ""
        qbf-dec-pl-sec = IF new_Format MATCHES "*HH:MM:SS.SSS*"
                         THEN 3
                         ELSE IF new_Format MATCHES "*HH:MM:SS.SS*"
                              THEN 2
                              ELSE IF new_Format MATCHES "*HH:MM:SS.S*"
                                   THEN 1
                                   ELSE 0
        qbf-12-hr = new_Format MATCHES "*AM*".

    DISPLAY qbf-t9 qbf-inc-tm qbf-tm qbf-dec-pl-sec qbf-12-hr
      WITH FRAME qbf%datetime.

    ENABLE new_Format qbf-d qbf-inc-tm bOk bCancel qbf-df bHelp WITH FRAME qbf%datetime.
        
    APPLY "ENTRY" TO qbf-d IN FRAME qbf%datetime.

    IF LOOKUP(ENTRY(1,new_Format," "),qbf-d) > 0 THEN
      qbf-d:SCREEN-VALUE IN FRAME qbf%datetime = ENTRY(1,new_Format," ").

    RUN setNewFormat4DateTime.
    APPLY "VALUE-CHANGED":U TO qbf-inc-tm IN FRAME qbf%datetime.

    {adeuib/ide/dialogstart.i bok bcancel caption "in frame qbf%datetime}.
    DO ON ERROR UNDO,LEAVE ON ENDKEY UNDO,LEAVE:
        &if DEFINED(IDE-IS-RUNNING) = 0  &then
        WAIT-FOR GO OF FRAME qbf%datetime.
        &ELSE
        WAIT-FOR GO OF FRAME qbf%datetime or "u2" of this-procedure.       
        if cancelDialog THEN UNDO, LEAVE.  
        &endif
    END.
    HIDE FRAME qbf%datetime NO-PAUSE.
  END.
  WHEN 40 THEN DO: /* datetimetz -------------------------------------------*/
     &if DEFINED(IDE-IS-RUNNING) <> 0  &then
    {adeuib/ide/dialoginit.i "frame qbf%datetimetz:handle"}
     dialogService:View().
     &endif
   
    IF new_Format = ? OR new_Format = "" THEN new_Format = "99/99/99 HH:MM:SS":u.
    RUN date_settings (OUTPUT qbf-d,OUTPUT qbf-i).

    ASSIGN
      qbf-d = "99/99/99,99-99-99,99.99.99,":u
            + (IF qbf-d MATCHES "..y":u THEN
                "99/99/9999,99-99-9999,99.99.9999":u
              ELSE IF qbf-d MATCHES "y..":u THEN
                "9999/99/99,9999-99-99,9999.99.99":u
              ELSE
                "99/9999/99,99-9999-99,99.9999.99":u)
            + ",999999,99999999":u
      qbf-t9 = "&DateTime-TZ Format:":t20
        &if defined(IDE-IS-RUNNING) = 0 &THEN
      FRAME qbf%datetimetz:THREE-D = SESSION:THREE-D
        &endif
      qbf-h  = qbf-d:HANDLE IN FRAME qbf%datetimetz
      qbf-c  = ""
      .

    /* interweave qbf-d values to create new radio-set values, i.e.
       "label1,value1,label2,value2..." */ 
    DO qbf-i = 1 TO NUM-ENTRIES(qbf-d):
      qbf-c = qbf-c + (IF qbf-i > 1 THEN ",":u ELSE "")
            + ENTRY(qbf-i,qbf-d) + ",":u + ENTRY(qbf-i,qbf-d).
    END.
    qbf-h:RADIO-BUTTONS = qbf-c.

    /* determine time values from new_Format */
    ASSIGN
        qbf-tm = IF new_Format MATCHES "*HH:MM:SS*"
                 THEN "HH:MM:SS"
                 ELSE IF new_Format MATCHES "*HH:MM*"
                      THEN "HH:MM"
                      ELSE IF new_Format MATCHES "*HH*"
                           THEN "HH"
                           ELSE ""
        qbf-inc-tm = qbf-tm > ""
        qbf-dec-pl-sec = IF new_Format MATCHES "*HH:MM:SS.SSS*"
                         THEN 3
                         ELSE IF new_Format MATCHES "*HH:MM:SS.SS*"
                              THEN 2
                              ELSE IF new_Format MATCHES "*HH:MM:SS.S*"
                                   THEN 1
                                   ELSE 0
        qbf-12-hr = new_Format MATCHES "*AM*"
        qbf-inc-tz = new_Format MATCHES "*+HH:MM*".

    DISPLAY qbf-t9 qbf-inc-tm qbf-tm qbf-dec-pl-sec qbf-12-hr qbf-inc-tz
      WITH FRAME qbf%datetimetz.

    ENABLE new_Format qbf-d qbf-inc-tm bOk bCancel qbf-df bHelp WITH FRAME qbf%datetimetz.

    APPLY "ENTRY" TO qbf-d IN FRAME qbf%datetimetz.

    IF LOOKUP(ENTRY(1,new_Format," "),qbf-d) > 0 THEN
      qbf-d:SCREEN-VALUE IN FRAME qbf%datetimetz = ENTRY(1,new_Format," ").

    RUN setNewFormat4DateTimeTZ.
    APPLY "VALUE-CHANGED":U TO qbf-inc-tm.
    {adeuib/ide/dialogstart.i bok bcancel caption "in frame qbf%datetimetz}.
    DO ON ERROR UNDO,LEAVE ON ENDKEY UNDO,LEAVE:
           &if DEFINED(IDE-IS-RUNNING) = 0  &then
        WAIT-FOR GO OF FRAME qbf%datetimetz.
            &ELSE
        WAIT-FOR GO OF FRAME qbf%datetimetz  or "u2" of this-procedure.       
        if cancelDialog THEN UNDO, LEAVE.  
            &endif
    END.
    HIDE FRAME qbf%datetimetz NO-PAUSE.
  END.
  WHEN 3 THEN DO: /* logical -----------------------------------------------*/
     &if DEFINED(IDE-IS-RUNNING) <> 0  &then
    {adeuib/ide/dialoginit.i "frame qbf%logi:handle"}
     dialogService:View().
     &endif
    IF new_Format = ? OR new_Format = "" OR
    NUM-ENTRIES(new_Format,"/":U) NE 2 THEN
       new_Format = "yes/no":u.

    ASSIGN
      qbf-t1 = "&Logical Format:":t18
      qbf-t2 = "Display This When &TRUE:":t32
      qbf-t3 = "Display This When &FALSE:":t32
        &if defined(IDE-IS-RUNNING) = 0 &THEN
      FRAME qbf%logi:THREE-D = SESSION:THREE-D
        &endif
      .
    
    DISPLAY qbf-t1 qbf-t2 qbf-t3
         WITH FRAME qbf%logi.

    ENABLE new_Format qbf-l1 qbf-l2 bOk bCancel qbf-df bHelp 
      WITH FRAME qbf%logi.

    APPLY "ENTRY" TO qbf-l1 IN FRAME qbf%logi.

    IF NUM-ENTRIES(new_Format,"/":u) = 2 THEN
      ASSIGN
        qbf-l1:SCREEN-VALUE IN FRAME qbf%logi     = ENTRY(1,new_Format,"/":u)
        qbf-l2:SCREEN-VALUE IN FRAME qbf%logi     = ENTRY(2,new_Format,"/":u)
        new_Format:SCREEN-VALUE IN FRAME qbf%logi = new_Format
      .

     {adeuib/ide/dialogstart.i bok bcancel caption "in frame qbf%logi}.
    DO ON ERROR UNDO,LEAVE ON ENDKEY UNDO,LEAVE:
           &if DEFINED(IDE-IS-RUNNING) = 0  &then
        WAIT-FOR GO OF FRAME qbf%logi.
           &ELSE
        WAIT-FOR GO OF FRAME qbf%logi or "u2" of this-procedure.       
             
        if cancelDialog THEN UNDO, LEAVE.  
            &endif 
    END.
    HIDE FRAME qbf%logi NO-PAUSE.
  END.
  WHEN 4 OR WHEN 5 THEN DO: /* integer/decimal -----------------------------*/
     &if DEFINED(IDE-IS-RUNNING) <> 0  &then
    {adeuib/ide/dialoginit.i "frame qbf%numb:handle"}
     dialogService:View().
     &endif
   IF new_Format = ? OR new_Format = "" THEN DO:
      IF iipType = 4 THEN  /* integer */
        new_Format = IF notAmerican THEN "->":U + tho_separator + ">>>":U + tho_separator + ">>9":U
                     ELSE "->,>>>,>>9":U.
      ELSE  /* decimal */
        new_Format = IF notAmerican THEN "->>":U + tho_separator + ">>9":U + dec_separator + "99":U
                     ELSE "->>,>>9.99":U.
    END.  /* if new_format = ? or "" */                    
                
    RUN explore_format (new_Format).

    ASSIGN
      /* qbf-nc VIEW-AS TOGGLE-BOX LABEL "Use thousand's separator ///":t32 */
      qbf-c  = qbf-nc:LABEL IN FRAME qbf%numb
      qbf-i  = INDEX(qbf-c,"///":u)
      qbf-t4 = "Number &Format:":t18
      qbf-t5 = "Total &Number of Digits:":t30
      qbf-t6 = "Number of &Decimal Places:":t30
      qbf-t7 = "&Leading Text String:":t24
      qbf-t8 = "&Trailing Text String:":t24
        &if defined(IDE-IS-RUNNING) = 0 &THEN
      FRAME qbf%numb:THREE-D = SESSION:THREE-D
        &endif
      .
       
     IF qbf-i > 0 THEN
      ASSIGN
        SUBSTRING(qbf-c,qbf-i,3,"CHARACTER":u) = "'":u + tho_separator + "'":u
        qbf-nc:LABEL IN FRAME qbf%numb         = qbf-c.
  

    ASSIGN
      qbf-nn:SCREEN-VALUE IN FRAME qbf%numb     = STRING(qbf-nn,">>>9":u)
      qbf-nn:WIDTH IN FRAME qbf%numb            = qbf-nn:WIDTH IN FRAME qbf%numb + .5
      qbf-nd:SCREEN-VALUE IN FRAME qbf%numb     = STRING(qbf-nd,">>>9":u)
      qbf-nd:WIDTH IN FRAME qbf%numb            = qbf-nd:WIDTH IN FRAME qbf%numb + .5
      new_Format:SCREEN-VALUE IN FRAME qbf%numb = new_Format
        &if defined(IDE-IS-RUNNING) = 0 &THEN
      FRAME qbf%numb:THREE-D = SESSION:THREE-D
        &endif
      .

    DISPLAY qbf-nc qbf-zr qbf-nl qbf-nt qbf-np 
            qbf-t4 qbf-t5 qbf-t6 qbf-t7 qbf-t8
      WITH FRAME qbf%numb.
    
    IF iipType EQ 5 THEN    
      ENABLE
        new_Format qbf-nn qbf-nd qbf-nc qbf-zr qbf-nl qbf-nt qbf-np
        bOk bCancel qbf-df bHelp
      WITH FRAME qbf%numb.
    ELSE 
      ENABLE
        new_Format qbf-nn qbf-nc qbf-zr qbf-nl qbf-nt qbf-np
        bOk bCancel qbf-df bHelp
      WITH FRAME qbf%numb.

     APPLY "ENTRY":U TO qbf-nn IN FRAME qbf%numb.

    {adeuib/ide/dialogstart.i bok bcancel caption "in frame qbf%numb}.
    DO ON ERROR UNDO,LEAVE ON ENDKEY UNDO,LEAVE:
           &if DEFINED(IDE-IS-RUNNING) = 0  &then
        WAIT-FOR GO OF FRAME qbf%numb.
           &ELSE
        WAIT-FOR GO OF FRAME qbf%numb or "u2" of this-procedure.       
        if cancelDialog THEN UNDO, LEAVE.  
           &endif 
    END.                                
    
    HIDE FRAME qbf%numb NO-PAUSE.
  END.
END CASE.

RETURN.
/*--- Procedures --------------------------------------------------------------*/

PROCEDURE check_numb_format:
  DEFINE VAR h_fmt AS WIDGET-HANDLE.

  h_fmt = new_Format:HANDLE IN FRAME qbf%numb.
  IF LAST-EVENT:WIDGET-ENTER = bHelp:HANDLE IN FRAME qbf%numb THEN RETURN. 

  IF h_fmt:MODIFIED THEN DO:
    /*
    ** First, make sure if you are checking the format against the compiler
    ** that the format is back in American notation.
    */
    IF notAmerican THEN 
      RUN adecomm/_convert.p ("N-TO-A", h_fmt:SCREEN-VALUE, tho_separator, dec_separator, 
        OUTPUT conv_fmt).
    ELSE
      conv_fmt = h_fmt:SCREEN-VALUE.
      
    RUN adecomm/_chkfmt.p (4, "", "", conv_fmt, 
                           OUTPUT counter, OUTPUT lError).
    IF (lError) THEN DO:
      APPLY "ENTRY" TO new_Format.
      h_fmt:AUTO-ZAP = True.
      RETURN "error".
    END.

    new_Format = h_fmt:SCREEN-VALUE.
    RUN explore_format (new_Format).
  
    ASSIGN
      qbf-nn:SCREEN-VALUE IN FRAME qbf%numb = STRING(qbf-nn,">>>9":u)
      qbf-nd:SCREEN-VALUE IN FRAME qbf%numb = STRING(qbf-nd,">>>9":u) 
      .

    DISPLAY
      qbf-nc qbf-zr qbf-nl qbf-nt qbf-np 
      WITH FRAME qbf%numb.
  END.

  RETURN "".
END.

PROCEDURE setNewFormat4DateTime:
    DO WITH FRAME qbf%datetime:
        ASSIGN
            qbf-inc-tm
            qbf-tm
            qbf-dec-pl-sec
            qbf-12-hr.
        IF qbf-inc-tm THEN DO:
            new_Format = qbf-h:SCREEN-VALUE + " " + qbf-tm.
            IF qbf-tm = "HH:MM:SS" AND qbf-dec-pl-sec > 0 THEN
                new_Format = new_Format + "." + FILL("S",qbf-dec-pl-sec).
            IF qbf-12-hr THEN
                new_Format = new_Format + " AM".
        END.
        ELSE
            new_Format = qbf-h:SCREEN-VALUE.
        DISPLAY new_Format.
    END.
END PROCEDURE.

PROCEDURE setNewFormat4DateTimeTZ:
    DO WITH FRAME qbf%datetimetz:
        ASSIGN
            qbf-inc-tm
            qbf-tm
            qbf-dec-pl-sec
            qbf-12-hr
            qbf-inc-tz.
        IF qbf-inc-tm THEN DO:
            new_Format = qbf-h:SCREEN-VALUE + " " + qbf-tm.
            IF qbf-tm = "HH:MM:SS" AND qbf-dec-pl-sec > 0 THEN
                new_Format = new_Format + "." + FILL("S",qbf-dec-pl-sec).
            IF qbf-12-hr THEN
                new_Format = new_Format + " AM ".
            IF qbf-inc-tz THEN
                new_Format = new_Format + "+HH:MM".
        END.
        ELSE
            new_Format = qbf-h:SCREEN-VALUE.
        DISPLAY new_Format.
    END.
END PROCEDURE.


PROCEDURE explore_charformat: 
  DO WITH FRAME qbf%char:
  DEFINE INPUT PARAMETER qbf_f AS CHARACTER NO-UNDO. /* format to analyze */

  CASE SUBSTRING(TRIM(qbf_f),1,1,"CHARACTER":u):
    WHEN "n":u THEN qbf-s = "n":u.
    WHEN "a":u THEN qbf-s = "a":u.
    WHEN "!":u THEN qbf-s = "!":u.
    WHEN "9":u THEN qbf-s = "9":u.
    OTHERWISE qbf-s = "x".
  END CASE.
  
  ASSIGN
    qbf-s:SCREEN-VALUE = qbf-s
    qbf-i              = counter
    qbf-i:SCREEN-VALUE = STRING(qbf-i).
  END.
END.

PROCEDURE explore_format:
  DEFINE INPUT PARAMETER qbf_f AS CHAR CASE-SENSITIVE NO-UNDO. /* format to analyze */

  DEFINE VARIABLE qbf_c AS CHARACTER CASE-SENSITIVE NO-UNDO. /* format */
  DEFINE VARIABLE qbf_i AS INTEGER                  NO-UNDO. /* loop   */
  DEFINE VARIABLE qbf_s AS INTEGER                  NO-UNDO. /* state  */


  ASSIGN
    qbf_c  = new_Format
    qbf-nb = TRUE
    qbf-nd = 0
    qbf-nl = ""
    qbf-nn = 0
    qbf-nt = ""
    qbf-nz = qbf_f BEGINS ">":u OR new_Format BEGINS "Z":u

    qbf-np = if qbf_f matches "*cr":u then 9
             else if qbf_f matches "*CR":u then 6
             else if qbf_f matches "*db":u then 10
             else if qbf_f matches "*DB":u then 7
             else if qbf_f matches "*dr":u then 11
             else if qbf_f matches "*DR":u then 8
             else if qbf_f matches "*(*)":u then 5
             else if qbf_f matches "+*":u then 1
             else if qbf_f matches "-*":u then 2
             else if qbf_f matches "*+":u then 3
             else if qbf_f matches "*-":u then 4
             else 12.
              
  /* strip off what we know is part of the format */
  CASE qbf-np:
    WHEN 5 THEN
      qbf_f = SUBSTRING(qbf_f,2,LENGTH(qbf_f,"CHARACTER":u) - 2,"CHARACTER":u).
    WHEN 1 OR WHEN 2 THEN
      qbf_f = SUBSTRING(qbf_f,2,-1,"CHARACTER":u).
    WHEN 3 OR WHEN 4 THEN
      qbf_f = SUBSTRING(qbf_f,1,LENGTH(qbf_f,"CHARACTER":u) - 1,"CHARACTER":u).
    WHEN 12 THEN
      .
    OTHERWISE
      qbf_f = SUBSTRING(qbf_f,1,LENGTH(qbf_f,"CHARACTER":u) - 2,"CHARACTER":u).
  END CASE.

  DO qbf_i = 1 TO LENGTH(qbf_f,"CHARACTER":u):
    CASE qbf_s:
      WHEN 0 OR WHEN 1 THEN DO:
        IF   SUBSTRING(qbf_f,qbf_i,2,"CHARACTER":u) = "9":u + dec_separator 
          OR SUBSTRING(qbf_f,qbf_i,2,"CHARACTER":u) = "9":u THEN 
          qbf-nb = FALSE.

        IF SUBSTRING(qbf_f,qbf_i,1,"CHARACTER":u) = ">":u OR
           SUBSTRING(qbf_f,qbf_i,1,"CHARACTER":u) = "Z":u THEN 
          qbf-nz  = TRUE.
        IF SUBSTRING(qbf_f,qbf_i,1,"CHARACTER":u) = tho_separator THEN 
          qbf_s = 1.
        ELSE
        IF INDEX("9Z*>":u,SUBSTRING(qbf_f,qbf_i,1,"CHARACTER":u)) > 0 THEN
          ASSIGN
            qbf_s  = 1
            qbf-nn = qbf-nn + 1.
        ELSE
        IF SUBSTRING(qbf_f,qbf_i,1,"CHARACTER":u) = dec_separator THEN 
          qbf_s = 2.
        ELSE
        IF qbf_s = 1 THEN qbf_s = 9.
        IF qbf_s = 0 AND SUBSTRING(qbf_f,qbf_i,1,"CHARACTER":u) <> "(":u THEN
          qbf-nl = qbf-nl + SUBSTRING(qbf_f,qbf_i,1,"CHARACTER":u).
        IF qbf_s = 9 THEN 
          qbf_i = qbf_i - 1. /* backup one and try again */
      END.
      WHEN 2 THEN DO:
        IF INDEX("9Z<":u,SUBSTRING(qbf_f,qbf_i,1,"CHARACTER":u)) > 0 THEN 
          qbf-nd = qbf-nd + 1.
        ELSE
        IF SUBSTRING(qbf_f,qbf_i,1,"CHARACTER":u) <> tho_separator THEN 
          qbf_s = 9.
        IF qbf_s = 9 THEN qbf_i = qbf_i - 1. /* backup one and try again */
      END.
      WHEN 9 THEN DO:
        IF SUBSTRING(qbf_f,qbf_i,1,"CHARACTER":u) <> ")":u THEN
          qbf-nt = qbf-nt + SUBSTRING(qbf_f,qbf_i,1,"CHARACTER":u).
      END.
    END CASE.
  END.

  IF qbf-np = 12
    AND qbf-nl MATCHES "*(":u
    AND qbf-nt BEGINS ")":u THEN
    ASSIGN
      qbf-nl = SUBSTRING(qbf-nl,1,LENGTH(qbf-nl,"CHARACTER":u) - 1,
                         "CHARACTER":u)
      qbf-nt = SUBSTRING(qbf-nt,2,-1,"CHARACTER":u)
      qbf-np = 5.

  /* Always set the number of decimal places to 0 for INTEGERs */
  IF iipType eq 4 THEN qbf-nd = 0.
  
  ASSIGN
  
    qbf-nz = INDEX(qbf_f,">":U) > 0
    qbf-na = INDEX(qbf_f,"*":U) > 0
    qbf-nn = MIN(qbf-nn + qbf-nd,50)
    qbf-nc = INDEX(qbf_f,SESSION:NUMERIC-SEPARATOR) > 0
    qbf-zr = if qbf-na then 3 else
             if qbf-nz then 1 else 2.
END PROCEDURE. /* explore_format */

/*--------------------------------------------------------------------------*/

PROCEDURE construct_format:
  DEFINE OUTPUT PARAMETER qbf_f AS CHARACTER INITIAL "" NO-UNDO.
  DEFINE VARIABLE qbf_c AS CHARACTER NO-UNDO. /* fill character */
  DEFINE VARIABLE qbf_i AS INTEGER   NO-UNDO. /* scrap/loop */
  DEFINE VARIABLE qbf_w AS INTEGER   NO-UNDO. /* number width */

  ASSIGN
    qbf_w = MAXIMUM(qbf-nn - qbf-nd,0)
    qbf_c = (IF qbf-na THEN "*":u ELSE STRING(qbf-nz,">/9":u)).
  IF qbf-nc THEN
    DO qbf_i = 1 TO qbf_w:
      qbf_f = (IF qbf_i < qbf_w AND qbf_i MODULO 3 = 0 THEN tho_separator
              ELSE "")
            + qbf_c
            + qbf_f.
    END.
  ELSE
    qbf_f = FILL(qbf_c,qbf_w).
  IF qbf_w > 0 AND NOT qbf-nb THEN 
    SUBSTRING(qbf_f,LENGTH(qbf_f,"CHARACTER":u),1,"CHARACTER":u) = "9":u.
  qbf_f = qbf-nl
        + ENTRY(qbf-np,"+,-,,,(,,,,,,,":U)
        + qbf_f
        + (IF qbf-nd = 0 THEN "" ELSE
          dec_separator + FILL(STRING(qbf-ns,"</9":u),qbf-nd))
        + (if qbf-np = 3 then "+" else
           if qbf-np = 4 then "-" else
           if qbf-np = 5 then ")" else
           if qbf-np = 6 then "CR" else
           if qbf-np = 7 then "DB" else
           if qbf-np = 8 then "DR" else
           if qbf-np = 9 then "cr" else
           if qbf-np = 10 then "db" else
           if qbf-np = 11 then "dr" else "")
        + qbf-nt.

END PROCEDURE. /* construct_format */

/*--------------------------------------------------------------------------*/
       /* + ENTRY(qbf-np, ",,+,-,),CR,DB,DR,cr,db,dr,":U) */

/* returns -d <mdy> setting and -yy <nnnn> setting */

PROCEDURE date_settings:
  DEFINE OUTPUT PARAMETER qbf_m AS CHARACTER         NO-UNDO.
  DEFINE OUTPUT PARAMETER qbf_y AS INTEGER INITIAL ? NO-UNDO.

  DEFINE VARIABLE qbf_i AS INTEGER NO-UNDO. /* scrap */

  DO qbf_i = 1900 TO 2000 WHILE qbf_y = ?:
    IF LENGTH(STRING(DATE(1,1,qbf_i)),"CHARACTER":u) = 8
      AND LENGTH(STRING(DATE(1,1,qbf_i + 99)),"CHARACTER":u) = 8
      THEN qbf_y = qbf_i.
  END.
  DO qbf_i = 1000 TO 1900 WHILE qbf_y = ?:
    IF LENGTH(STRING(DATE(1,1,qbf_i)),"CHARACTER":u) = 8
      AND LENGTH(STRING(DATE(1,1,qbf_i + 99)),"CHARACTER":u) = 8
      THEN qbf_y = qbf_i.
  END.
  DO qbf_i = 2000 TO 9900 WHILE qbf_y = ?:
    IF LENGTH(STRING(DATE(1,1,qbf_i)),"CHARACTER":u) = 8
      AND LENGTH(STRING(DATE(1,1,qbf_i + 99)),"CHARACTER":u) = 8
      THEN qbf_y = qbf_i.
  END.

  /*
  qbf_m = ENTRY(LOOKUP(STRING(DATE(2,1,qbf_y + 3)),
          "01/02/03,01/03/02,02/01/03,02/03/01,03/01/02,03/02/01":u),
          "dmy,dym,mdy,myd,ydm,ymd":u).
  */
  qbf_m = SESSION:DATE-FORMAT.
END PROCEDURE. /* date_settings */

/*--------------------------------------------------------------------------*/

/* _y-build.p - end of file */

/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/
/* _y-date.p - enter a date literal */

{ adecomm/y-const.i
  &DefaultFormat="99/99/99"
  &DataType     ="DATE"
  &Message      ="Enter Date Value"
  &Function     ="DATE"
  &InitialValue ="TODAY"
  &PackageOne   ="STRING(MONTH(v_one),'99':u) + '/':u
                 + STRING(DAY(v_one),'99':u) + '/':u
                 + STRING(YEAR(v_one),'9999':u)"
  &PackageTwo   ="STRING(MONTH(v_one),'99':u) + '/':u
                 + STRING(DAY(v_one),'99':u) + '/':u
                 + STRING(YEAR(v_one),'9999':u)
                 + CHR(10)
                 + STRING(MONTH(v_two),'99':u) + '/':u
                 + STRING(DAY(v_two),'99':u) + '/':u
                 + STRING(YEAR(v_two),'9999':u)"
}

RETURN.

/* _y-date.p - end of file */
/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/
/* _y-logic.p - enter a logical literal */
&GLOBAL-DEFINE WIN95-BTN YES
{ adecomm/adestds.i } 
{ adecomm/commeng.i }  /* Help contexts */

&SCOPED-DEFINE FRAME-NAME qbf%logical
/*
pi_mode =  1 -> get a single value from the user
        =  2 -> unsupported for _y-logic.p
        =  3 -> unsupported for _y-logic.p
        =  4 -> unsupported for _y-logic.p
If the pi_mode number is negative, then support the ask-at-run-time mode.
*/
DEFINE INPUT  PARAMETER pi_mode AS INTEGER   NO-UNDO. /* 1, 2 or >2 */
DEFINE INPUT  PARAMETER pi_fmt  AS CHARACTER NO-UNDO. /* format */
DEFINE INPUT  PARAMETER pi_text AS CHARACTER NO-UNDO. /* message */
DEFINE OUTPUT PARAMETER po_out  AS CHARACTER NO-UNDO INITIAL ?. /* value */

DEFINE VARIABLE v_one   AS LOGICAL NO-UNDO. /* value holder */
DEFINE VARIABLE v_width AS INTEGER NO-UNDO. /* new width of literal text */
DEFINE VARIABLE v_false AS HANDLE  NO-UNDO. /* 'false' radio-item */
DEFINE VARIABLE v_true  AS HANDLE  NO-UNDO. /* 'true' radio-item */
DEFINE VARIABLE v_wh    AS HANDLE  NO-UNDO.

DEFINE BUTTON qbf-ok   LABEL "   OK   ":c15 {&STDPH_OKBTN} AUTO-GO.
DEFINE BUTTON qbf-ee   LABEL " Cancel ":c15 {&STDPH_OKBTN} AUTO-ENDKEY.
DEFINE BUTTON qbf-help LABEL "&Help":c15   {&STDPH_OKBTN}. 
/*DEFINE BUTTON qbf-rt   LABEL "  Ask When Run  ":c16.*/

DEFINE RECTANGLE rect_btns {&STDPH_OKBOX}.

OUTPUT TO TERMINAL. /* needed for RESULTS use */

FORM
  SKIP(.5)
  SPACE(2)
  v_one LABEL "Logical Value"
    VIEW-AS RADIO-SET VERTICAL RADIO-BUTTONS
    "&YES (or TRUE)":t32 ,TRUE,
    "&NO  (or FALSE)":t32 ,FALSE
  SPACE(2) /*SKIP(.5)
  SPACE(2) qbf-ok qbf-ee SPACE(2) qbf-rt */

  { adecomm/okform.i 
    &BOX    = rect_btns
    &STATUS = NO
    &OK     = qbf-ok
    &CANCEL = qbf-ee}
    /*&HELP   = qbf-help}*/

  WITH FRAME {&FRAME-NAME} SIDE-LABELS OVERLAY NO-ATTR-SPACE
  DEFAULT-BUTTON qbf-ok CANCEL-BUTTON qbf-ee
  TITLE "Enter Constant":t32 VIEW-AS DIALOG-BOX.

/*----------------------------------------------------------------------*/

/*
ON CHOOSE OF qbf-rt IN FRAME {&FRAME-NAME} DO:
  ASSIGN
    po_out = "<<ask>>":u
    v_wh   = SELF:FRAME.
  APPLY "END-ERROR" TO v_wh.
END.
*/

/*----------------------------------------------------------------------*/

{ adecomm/okrun.i 
  &FRAME = "FRAME {&FRAME-NAME}"
  &BOX   = rect_btns
  &OK    = qbf-ok}
  /*&HELP  = qbf-help}*/

ASSIGN
  v_true                                = v_one:handle IN FRAME {&FRAME-NAME}
  v_one                                 = TRUE
  /*qbf-rt:VISIBLE IN FRAME {&FRAME-NAME} = (pi_mode < 0)*/
  .

IF pi_text <> ? THEN DO:
  CREATE TEXT v_wh
    ASSIGN
      FORMAT       = SUBSTITUTE("x(&1)":u,LENGTH(pi_text,"RAW":U))
      SCREEN-VALUE = pi_text
      FRAME        = FRAME {&FRAME-NAME}:HANDLE.

  v_width = v_wh:WIDTH-PIXELS.
  DELETE WIDGET v_wh.
  ASSIGN
    v_one:TITLE IN FRAME {&FRAME-NAME} = pi_text
    v_wh                               = v_one:HANDLE IN FRAME {&FRAME-NAME}
    v_wh:SCREEN-VALUE                  = pi_text
    v_wh:WIDTH-PIXELS                  = v_width.
END.

/*
IF pi_mode > 0 THEN
  qbf-ee:X IN FRAME {&FRAME-NAME} = v_true:X
                                  + v_true:WIDTH-PIXELS
                                  - qbf-ee:WIDTH-PIXELS IN FRAME {&FRAME-NAME}.
*/

DO ON ERROR UNDO,LEAVE ON ENDKEY UNDO,LEAVE:
  UPDATE
    v_one qbf-ok qbf-ee
    /*qbf-rt WHEN pi_mode < 0*/
    WITH FRAME {&FRAME-NAME}.

  po_out = TRIM(STRING(v_one,"TRUE/FALSE":u)).
END.

HIDE FRAME {&FRAME-NAME} NO-PAUSE.

RETURN.

/* _y-logic.p - end of file */

/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/
/* _y-num.p - enter a number literal */

{ adecomm/y-const.i
  &DefaultFormat = "->>>>>>>>9.99"
  &DataType      = "DECIMAL DECIMALS 10"
  &Message       = "Enter Numeric Value"
  &Function      = "DECIMAL"
  &InitialValue  = "0"
  &PackageOne    = "REPLACE(STRING(v_one), ',':u, '.':u)"
  &PackageTwo    = "REPLACE(STRING(v_one), ',':u, '.':u) + CHR(10)
                  + REPLACE(STRING(v_two), ',':u, '.':u)"
}

RETURN.

/* _y-num.p - end of file */
/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/
/*
 * _y-qbw.p - enter a query-by-words expression string
 */

/*
For example:
  comput* science ! (comput* & (art ! graph*))

Will find:
  "The Science of Computer" as well as "Best Computer Science Book,"
  "Art and Crafts in Computer Publications," "Graphical Way of
  Computation".  It will not find "Computer Sciences" since it looks
  for an exact match to the word science without the "s" at the end.
*/
&GLOBAL-DEFINE WIN95-BTN YES
{adecomm/adestds.i}
{adecomm/commeng.i}

OUTPUT TO TERMINAL. /* needed for RESULTS use */

DEFINE INPUT  PARAMETER pi_mode AS INTEGER             NO-UNDO. /* 1, 2 or >2 */DEFINE INPUT  PARAMETER pi_fmt  AS CHARACTER           NO-UNDO. /* format */
DEFINE INPUT  PARAMETER pi_text AS CHARACTER           NO-UNDO. /* Message */
DEFINE OUTPUT PARAMETER po_out  AS CHARACTER INITIAL ? NO-UNDO. /* value */
/*
pi_mode =  1 -> get a single value from the user
        =  2 -> unsupported for _y-qbw.p
        =  3 -> unsupported for _y-qbw.p
        =  4 -> unsupported for _y-qbw.p
If the pi_mode number is negative, then support the ask-at-run-time mode.
*/

DEFINE VARIABLE v_wh AS WIDGET-HANDLE NO-UNDO. /* for aligning buttons */

DEFINE VARIABLE qbf-i  AS INTEGER   NO-UNDO. /* scrap */
DEFINE VARIABLE qbf-l  AS LOGICAL   NO-UNDO. /* scrap */
DEFINE VARIABLE v_text AS CHARACTER NO-UNDO. /* text */
DEFINE VARIABLE v_one  AS CHARACTER NO-UNDO. /* value holder */

DEFINE BUTTON qbf-ok   LABEL "OK"     {&STDPH_OKBTN} AUTO-GO.
DEFINE BUTTON qbf-ee   LABEL "Cancel" {&STDPH_OKBTN} AUTO-ENDKEY.
DEFINE BUTTON qbf-help LABEL "&Help"   {&STDPH_OKBTN}.
define variable cTitle  as character no-undo init "Enter Contains String":t32.
DEFINE RECTANGLE rect_btns            {&STDPH_OKBOX}.

FORM
  SKIP({&TFM_WID})
  v_text FORMAT "x(40)":u AT 2 SKIP

  v_one AT 2
    VIEW-AS EDITOR INNER-CHARS 64 INNER-LINES 6 SKIP({&VM_WIDG})

  {adecomm/okform.i
    &BOX    = "rect_btns"
    &STATUS =  no
    &OK     = "qbf-ok"
    &CANCEL = "qbf-ee"
    &HELP   = "qbf-help" }

  WITH FRAME qbf%qbw NO-LABELS NO-ATTR-SPACE
  DEFAULT-BUTTON qbf-ok 
  CANCEL-BUTTON qbf-ee
   &if DEFINED(IDE-IS-RUNNING) = 0 &then
  TITLE cTitle VIEW-AS DIALOG-BOX
   &else
        NO-BOX
   &endif
  .

ON GO OF FRAME qbf%qbw DO:
  IF INPUT FRAME qbf%qbw v_one = "" THEN DO:
    RUN adecomm/_s-alert.p (INPUT-OUTPUT qbf-l, "warning", "ok",
      "Contains string cannot be blank.  A blank value will prevent all " +
      "records from being selected.").
    RETURN NO-APPLY.
  END.

  IF INPUT FRAME qbf%qbw v_one BEGINS "*":u THEN DO:
    RUN adecomm/_s-alert.p (INPUT-OUTPUT qbf-l, "warning", "ok",
      "Contains string cannot begin with an asterisk, but may be used as " +
      "a trailing wildcard, for example 'sales*'.").
    RETURN NO-APPLY.
  END.
  
  po_out = '"':u + REPLACE(v_one:SCREEN-VALUE,'"':u,'""':u) + '"':u.
END.

ON HELP OF FRAME qbf%qbw OR CHOOSE OF qbf-help IN FRAME qbf%qbw 
   RUN "adecomm/_adehelp.p" ("comm", "CONTEXT", {&Enter_Query_By_Dlg_Box}, ?).

ON WINDOW-CLOSE OF FRAME qbf%qbw
  APPLY "END-ERROR" TO SELF.

ASSIGN 
  v_one:RETURN-INSERTED IN FRAME qbf%qbw = TRUE
  v_text:SCREEN-VALUE IN FRAME qbf%qbw   = "Enter string value:":t50.

/* Run time layout for button area.  This defines eff_frame_width */
{adecomm/okrun.i  
   &FRAME = "frame qbf%qbw" 
   &BOX   = "rect_btns"
   &OK    = "qbf-ok" 
   &HELP  = "qbf-help" }

&if DEFINED(IDE-IS-RUNNING) <> 0 &then    
  {adeuib/ide/dialoginit.i "FRAME qbf%qbw:handle}
&endif

ENABLE v_one qbf-ok qbf-ee qbf-help WITH FRAME qbf%qbw.

&if DEFINED(IDE-IS-RUNNING) <> 0 &then   
   &scoped-define CANCEL-EVENT U3
   {adeuib/ide/dialogstart.i qbf-ok qbf-ee ctitle}
   dialogService:SizeToFit().
&endif     
DO ON ERROR UNDO,LEAVE ON ENDKEY UNDO,LEAVE:
    &if DEFINED(IDE-IS-RUNNING) <> 0 &then   
    WAIT-FOR GO OF FRAME qbf%qbw or "{&CANCEL-EVENT}" of this-procedure. 
    &else 
     WAIT-FOR GO OF FRAME qbf%qbw.
    &endif  
END.

HIDE FRAME qbf%qbw NO-PAUSE.

RETURN.

/* _y-qbw.p - end of file */

/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/
/* _y-schem.p - extract field schema information (see also [as]-schema.p) 

  Modified: 07/10/98 D. McMann Added DBVERSION and _Owner check.

*/

DEFINE INPUT  PARAMETER pi_dbname AS CHARACTER NO-UNDO. /* dbname */
DEFINE INPUT  PARAMETER pi_table  AS CHARACTER NO-UNDO. /* tablename */
DEFINE INPUT  PARAMETER pi_field  AS CHARACTER NO-UNDO. /* fieldname */
DEFINE OUTPUT PARAMETER po_info   AS CHARACTER INITIAL ? NO-UNDO. /* response */

/*
This tables a dbname, tablename and fieldname and returns:

  ? if the field does not exist, or a complex string.

The complex string can be accessed by:

  INTEGER(ENTRY(1,x)) = _dtype
  INTEGER(ENTRY(2,x)) = _Extent
  ENTRY(3,x)          = "y" if any type of index component, "n" otherwise
  ENTRY(4,x)          = "y" is word-index component, "n" otherwise
  ENTRY(5,x)          = "y" is mandatory, "n" otherwise
  ENTRY(2,x,CHR(10))  = _Format
  ENTRY(3,x,CHR(10))  = _Col-label, or _Label, or _Field-name

(The latter is the RESULTS defaults for getting the label of a field
for a report.)
*/

/* dbname,tablename,fieldname can come in pi_dbname+pi_table+pi_field, */
/* or as a combined entries in pi_dbname or pi_dbname+pi_table */
IF NUM-ENTRIES(pi_dbname,".":u) = 3 THEN
  ASSIGN
    pi_field  = ENTRY(3,pi_dbname,".":u)
    pi_table  = ENTRY(2,pi_dbname,".":u)
    pi_dbname = ENTRY(1,pi_dbname,".":u).
IF NUM-ENTRIES(pi_dbname,".":u) = 2 THEN
  ASSIGN
    pi_table  = ENTRY(2,pi_dbname,".":u)
    pi_dbname = ENTRY(1,pi_dbname,".":u).
IF NUM-ENTRIES(pi_table,".":u) = 2 THEN
  ASSIGN
    pi_field = ENTRY(2,pi_table,".":u)
    pi_table = ENTRY(1,pi_table,".":u).

IF LDBNAME(pi_dbname) = ? THEN RETURN.

/* Strip off [n] for array fields. */
IF INDEX(pi_field,"[":u) > 0 THEN
  pi_field = SUBSTRING(pi_field,1,INDEX(pi_field,"[":u) - 1,"CHARACTER":u).

/* if not pointing to correct db, fix situation and call self */
/* recursively.  this will also leave things set for the next */
/* time this guy is called. */
IF LDBNAME("DICTDB":u) <> SDBNAME(pi_dbname) THEN DO:
  CREATE ALIAS "DICTDB":u FOR DATABASE VALUE(SDBNAME(pi_dbname)).
  RUN VALUE(PROGRAM-NAME(1)) (pi_dbname,pi_table,pi_field,OUTPUT po_info).
  RETURN.
END.

/* now point to correct _Db,_File,_Field records */
FIND DICTDB._Db
  WHERE DICTDB._Db._Db-name =
    (IF DBTYPE(pi_dbname) = "PROGRESS":u THEN ? ELSE LDBNAME(pi_dbname))
  NO-LOCK NO-ERROR.
IF NOT AVAILABLE DICTDB._Db THEN RETURN.

IF INTEGER(DBVERSION("DICTDB":U)) > 8 THEN DO:
  FIND DICTDB._File OF DICTDB._Db
    WHERE DICTDB._File._File-name = pi_table 
      AND (DICTDB._File._Owner = "PUB" OR DICTDB._File._Owner = "_FOREIGN")
      NO-LOCK NO-ERROR.
  IF NOT AVAILABLE DICTDB._File THEN RETURN.
END.
ELSE DO:
  FIND DICTDB._File OF DICTDB._Db
    WHERE DICTDB._File._File-name = pi_table NO-LOCK NO-ERROR.
  IF NOT AVAILABLE DICTDB._File THEN RETURN.
END.  

FIND DICTDB._Field OF DICTDB._File
    WHERE DICTDB._Field._Field-name = pi_field NO-LOCK NO-ERROR.
IF NOT AVAILABLE DICTDB._Field THEN RETURN.

po_info = STRING(DICTDB._Field._dtype)
        + ",":u
        + STRING(DICTDB._Field._Extent)
        + ",":u
        + STRING(CAN-FIND(FIRST DICTDB._Index-field OF DICTDB._Field),"y/n":u)
        + ",n,":u
        + STRING(DICTDB._Field._Mandatory,"y/n":u)
        + ",":u
        + CHR(10)
        + DICTDB._Field._Format
        + CHR(10)
        + (IF DICTDB._Field._Col-label <> ? THEN
            DICTDB._Field._Col-label
          ELSE IF DICTDB._Field._Label <> ? THEN
            DICTDB._Field._Label
          ELSE
            DICTDB._Field._Field-name).

/* if word index defined, set that also */
FOR EACH DICTDB._Index-field OF DICTDB._Field NO-LOCK,
  FIRST DICTDB._Index OF DICTDB._Index-field WHERE
    CAN-FIND (DICTDB._Field WHERE DICTDB._Field._Field-name = "_Wordidx")
    AND DICTDB._Index._Wordidx > 0 NO-LOCK:
  ENTRY(4,po_info) = "y":u.
  LEAVE.
END.

RETURN.

/* _y-schem.p - end of file */


/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/
/* _y-strng.p - enter a string literal */

{ adecomm/y-const.i
  &DefaultFormat="x(40)"
  &DataType     ="CHARACTER"
  &Message      ="Enter String Value"
  &Function     =" "
  &InitialValue ="''"
  &PackageOne   ="'""':u + REPLACE(v_one,'""':u,'""""':u) + '""':u"
  &PackageTwo   ="'""':u + REPLACE(v_one,'""':u,'""""':u) + '""':u
                 + CHR(10)
                 + '""':u + REPLACE(v_two,'""':u,'""""':u) + '""':u"
}

RETURN.

/* _y-strng.p - end of file */
/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/*----------------------------------------------------------------------------

File: adefext.i

Description:
	
	Defines all the product names and file extensions.

Author: David Lee

Date Created: May 26, 1993

Modifications
  9/16/93 wood   changed "Freeze Frame" to "FreezeFrame" (conforms to doc).
          
----------------------------------------------------------------------------*/

&GLOBAL ADEFEXTI "" /* allow to check if this file has already been included */

/* ------------------------ APPLICATION NAMES  ----------------------------- */

/* Application Names */

&GLOBAL-DEFINE  UIB_NAME        AppBuilder
&GLOBAL-DEFINE  UIB_SHORT_NAME  AB

&GLOBAL-DEFINE  FF_NAME         FreezeFrame

/* --------------------------- TEMP FILE EXTENSIONS ------------------------ */

&GLOBAL-DEFINE  STD_TYP_UIB_BROWSER   "br"
&GLOBAL-DEFINE  STD_TYP_UIB_DUP       "dp"
&GLOBAL-DEFINE  STD_TYP_UIB_DUP       "dp"
&GLOBAL-DEFINE  STD_TYP_UIB_CLIP      "cb"
&GLOBAL-DEFINE  STD_TYP_UIB_LAST      "ef"
&GLOBAL-DEFINE  STD_TYP_UIB_RADIO     "rb"
&GLOBAL-DEFINE  STD_TYP_UIB_DBFIELD   "db"
&GLOBAL-DEFINE  STD_TYP_UIB_COMPILE   "cf"
&GLOBAL-DEFINE  STD_TYP_UIB_TEMPLATE  "ct"
&GLOBAL-DEFINE  STD_EXT_UIB           ".ab"
&GLOBAL-DEFINE  STD_EXT_UIB_QS        ".qs"
&GLOBAL-DEFINE  STD_EXT_UIB_WVX       ".wrx"

&GLOBAL-DEFINE  STD_EXT_FF            ".ff"


/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/*---------------------------------------------------------------------------

File: adeintl.i

Description: Provides definitions for international support
---------------------------------------------------------------------------*/

&GLOBAL-DEFINE NO-MAP	NO-MAP
   
/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/
/*----------------------------------------------------------------------------

File: adestds.i

Description:
         Defines standard colors and fonts to be used by all ADE applications.
         
         Defines standard offsets and margins for the ADE.

         This file is included when you need to use the variables defined
         here for your ADE dialog boxes.
         
         It is included in the ADE wrappers as well.  The ADE wrappers
         must also run the adecomm/_adeload.p routine after including
         this file to load the ADE default colors and fonts.

         The DEFINE NEW GLOBAL SHARED declaration defines and initializes
         the vars only the first time referenced.  Subsequent inclusion
         and refernece to this file has no affect on the values of the vars
         (because they are GLOBAL).  

         This file is part of a trio: adestds.i okform.i okrun.i.  This file 
         should be included to provide standard margins and offsets to be 
         used by the ADE.  For more information on this, see the document 
         design\ade\misc\sullivan.doc.

         This file contains pre-processor definitions that should be used for
         consistent user interface layout across dialog boxes.

	Defines all the product names

Author: Wm.T.Wood + Ravi-Chandar Ramalingam + Mike Pacholec

Date Created: January 14, 1993
          
         05-05-93 mikep Merged standard offsets/margins with this file
         05-10-93 jep   Converted vars to DEFINE NEW GLOBAL SHARED
         05-11-93 dlee  Add app name for UIB
         05-11-93 mikep remove underscores from globals (disturbing ccall)
         05-14-93 mikep changed editor phrase handing
         05-17-93 wood  remove quotes from definition for UIB_SHORT_NAME
	 05-19-93 ravi  changed UIB-name to Window Builder and added new
		        copyright information which will not require us to
			type this log as it will be a part of RCS/SCC log
----------------------------------------------------------------------------*/
&GLOBAL ADESTDSI "" /* allow to check if this file has already been included */

/* Include the file extensions and application names file */

{adecomm/adefext.i}

DEFINE NEW GLOBAL SHARED VARIABLE initialized_adestds AS LOGICAL 
       INITIAL no NO-UNDO.
   /* designates whether the resource file has already been read for these */
   /* files */

/* ---------------------------- ADE COLORS --------------------------------- */
/*        Standard Color Variables to be used by ADE dialog boxes            */

/* used as the bgcolor for the section dividers (title bands) */
DEFINE NEW GLOBAL SHARED VARIABLE std_div_fgcolor AS INTEGER 
       INITIAL 15 NO-UNDO. /* white */
DEFINE NEW GLOBAL SHARED VARIABLE std_div_bgcolor AS INTEGER 
       INITIAL 1  NO-UNDO. /* blue */
        
/* used as the bgcolor for the button section separator (rectangle 
   behind the OK CANCEL row) */
DEFINE NEW GLOBAL SHARED VARIABLE std_okbox_fgcolor AS INTEGER 
       INITIAL 1 NO-UNDO. /* blue */
DEFINE NEW GLOBAL SHARED VARIABLE std_okbox_bgcolor AS INTEGER 
       INITIAL ? NO-UNDO. /* grey */
        
/* used as the bgcolor/fgcolor for any fillin fields or editor widgets used
   for standard data entry */
DEFINE NEW GLOBAL SHARED VARIABLE std_fillin_fgcolor AS INTEGER 
       INITIAL 0  NO-UNDO. /* black */
&IF DEFINED(USE-3D) = 0 OR "{&WINDOW-SYSTEM}" = "OSF/Motif" &THEN
DEFINE NEW GLOBAL SHARED VARIABLE std_fillin_bgcolor AS INTEGER 
       INITIAL 8 NO-UNDO. /* gray */
&ELSE
DEFINE VARIABLE std_fillin_bgcolor AS INTEGER 
       INITIAL ? NO-UNDO. /* White */
&ENDIF
       
/* used as the bgcolor/fgcolor for any editor widgets used for extended
   4GL program entry like the section editor and procedure editor */
DEFINE NEW GLOBAL SHARED VARIABLE std_ed4gl_fgcolor AS INTEGER 
       INITIAL ?  NO-UNDO. /* default */
DEFINE NEW GLOBAL SHARED VARIABLE std_ed4gl_bgcolor AS INTEGER 
       INITIAL ?  NO-UNDO.  /* default */
        
/* used as the bgcolor/fgcolor for any editor widgets not used for extended
   4GL program entry like the query builder or dictionary validation */
DEFINE NEW GLOBAL SHARED VARIABLE std_ed4gl_small_fgcolor AS INTEGER 
       INITIAL 0 NO-UNDO. /* black */
&IF DEFINED(USE-3D) = 0 OR "{&WINDOW-SYSTEM}" = "OSF/Motif" &THEN
DEFINE NEW GLOBAL SHARED VARIABLE std_ed4gl_small_bgcolor AS INTEGER 
       INITIAL 8 NO-UNDO. /* grey */
&ELSE
DEFINE VARIABLE std_ed4gl_small_bgcolor AS INTEGER 
       INITIAL ? NO-UNDO. /* White */
&ENDIF        
/* ---------------------------- ADE FONTS ---------------------------------- */
/* Standard Font Variables to be used by ADE applications (and dialog boxes) */

DEFINE NEW GLOBAL SHARED VARIABLE fixed_font AS INTEGER INITIAL 0 NO-UNDO.
   /* used where a fixed font is needed (eg. in a selection list) */
   /* (this will be FONT 0).  It should be the same as the        */
   /* DefaultFixedFont */

DEFINE NEW GLOBAL SHARED VARIABLE std_font AS INTEGER INITIAL 1 NO-UNDO.
   /* proportional font used for most text and input fields (FONT 1) */
   /* (This should be the same as FONT ? = Default Font).  We need   */
   /* this if we every want to make a integer fill-in in the default */
   /* variable font. */

DEFINE NEW GLOBAL SHARED VARIABLE editor_font AS INTEGER INITIAL 2 NO-UNDO.
   /* used for most ADE editor widgets (FONT 2).  Usually this will  */
   /* be a smaller fixed font */
   /* Used ONLY for editor-widgets that will contain 4GL-Code! All */
   /* other editor-widgets are to be treated like standard fill-ins */

DEFINE NEW GLOBAL SHARED VARIABLE editor_tab AS INTEGER INITIAL 4 NO-UNDO.
   /* Sets default ADE editor tab stop value. */
   
/* ----------------------- ADE 'RUN' indicator ----------------------------- */

DEFINE NEW GLOBAL SHARED VARIABLE h_ade_tool AS HANDLE    NO-UNDO.
   /* The active ADE tool assigns its procedure handle to this var. This     */
   /* allows Procedure Windows to disable the active ADE tool.               */
   /* The ADE tool assigns its proc handle at startup, when it runs          */
   /* enable_widgets, and assigns to ? (unknown) when it runs disable_widgets*/

DEFINE NEW GLOBAL SHARED VARIABLE wfRunning  AS CHARACTER NO-UNDO.
   /* Any ADE tool which 'runs' a program will use this flag to indicate that*/
   /* they are in the middle of doing so by placing its name into this var.  */
   
/* ------------------- GENERIC MARGINS AND WIDTHS  ------------------------- */
/* generic and button specific minimum margins within a frame */

&GLOBAL-DEFINE PATH_WIDG 255 /* Supported length of the full path name */

&GLOBAL VM_WID        0.1 /* minimum vertical margin between widgets within
                             the same group  - only required for widgets 
                             that would otherwise touch like fillins under
                             Windows */

&IF "{&WINDOW-SYSTEM}" = "TTY" &THEN
 &GLOBAL VM_WIDG      1   /* minimum vertical margin between widget groups */
&ELSE
 &GLOBAL VM_WIDG      0.5 /* minimum vertical margin between widget groups */
&ENDIF

&GLOBAL HM_WIDG       2.5 /* minimum horizontal margin between widget groups */
&GLOBAL HM_BTN        0.5 /* horizontal margin between buttons in the same 
                             group */
&GLOBAL HM_BTNG       2.5 /* horizontal margin between button groups */

&IF "{&WINDOW-SYSTEM}" = "OSF/Motif" &THEN
 &GLOBAL HM_DBTN      0   /* horizontal margin between default buttons in the 
                             same group. Def. btn. mote is more than enough */
 &GLOBAL HM_DBTNG     2   /* horizontal margin between default button groups */
&ELSE
 &GLOBAL HM_DBTN      {&HM_BTN}  /* horizontal margin between default buttons 
      	       	     	      	    in the same group */
 &GLOBAL HM_DBTNG     {&HM_BTNG} /* horizontal margin between default button 
      	       	     	      	    groups */
&ENDIF

/* generic margins relating to the frame */
&IF "{&WINDOW-SYSTEM}" = "TTY" &THEN
 &GLOBAL TFM_WID      1   /* minimum top frame margin between the top of the 
                             frame and any widget */
 &GLOBAL TFM_ROW      2   /* row that corresponds to a widget after skipping
                             TFM_WID */
&ELSE
 &GLOBAL TFM_WID      0.5 /* minimum top frame margin between the top of the 
                             frame and any widget */
 &GLOBAL TFM_ROW      1.5 /* row that corresponds to a widget after skipping
                             TFM_WID */
&ENDIF

&GLOBAL HFM_WID       1   /* minimum horizontal frame margin between the left
                             and right sides of the frame and any widget */

/* ----------------- OK CANCEL HELP BUTTON STANDARDS  ---------------------- */

/* 
** standards particular to the ok button row and the button separator 
*/

&IF "{&WINDOW-SYSTEM}" = "TTY" &THEN
 &GLOBAL W_OKBTN      4  /* width  of the ok button and others in that row */
 &GLOBAL H_OKBTN      1.00 /* height of the ok button and others in that row */
 &GLOBAL WHEN_HELP    WHEN SESSION:DISPLAY-TYPE <> "TTY":u
&ELSEIF DEFINED(WIN95-BTN) &THEN
 &GLOBAL W_OKBTN      15 /* width  of the ok button and others in that row */
 &GLOBAL H_OKBTN      1.125 /* height of the ok button and others in that row */
&ELSEIF "{&WINDOW-SYSTEM}" BEGINS "MS-WIN" &THEN
 &GLOBAL W_OKBTN      10 /* width  of the ok button and others in that row */
 &GLOBAL H_OKBTN      1.00 /* height of the ok button and others in that row */
&ELSE
 &GLOBAL W_OKBTN      10 /* width  of the ok button and others in that row */
 &GLOBAL H_OKBTN      1.00 /* height of the ok button and others in that row */
&ENDIF

/* Since there's no button box on TTY or Motif, OK margin can be smaller. */
&IF "{&WINDOW-SYSTEM}" BEGINS "MS-WIN" &THEN
 &GLOBAL AT_OKBTN     AT 3 /* leave a 3 PPU margin between the ok button and 
                              the left edge of the frame */
&ELSE
 &GLOBAL AT_OKBTN     AT 2 /* leave a 2 PPU margin between the ok button and 
                              the left edge of the frame */
&ENDIF

/* use this format phrase for the ok button and others in that row on GUI */
&IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN
 &GLOBAL STDPH_OKBTN     SIZE {&W_OKBTN} BY {&H_OKBTN} MARGIN-EXTRA DEFAULT
&ELSE
 &GLOBAL STDPH_OKBTN
&ENDIF

/* ---------------------------- OK BOX STANDARDS  -------------------------- */

/* standards for the ok box for the bottom row of buttons */
&GLOBAL VM_OKBOX      0.25 /* vertical margin between the ok box and any widget
                            above, and the ok box and the bottom of the frame */
&GLOBAL AT_OKBOX      AT 2 /* leave a 1 PPU margin between the left edge of the
                              ok box and the frame */
&IF DEFINED(WIN95-BTN) &THEN
 &GLOBAL IVM_OKBOX    0.30 /* inner vertical margin for the button separator 
                              Windows: The inner margin between the buttons 
                              and the top or bottom of the sullivan box. */
&ELSE
 &GLOBAL IVM_OKBOX    0.25 /* This looks better in this case */
&ENDIF

&IF "{&WINDOW-SYSTEM}" = "OSF/Motif" &THEN
 &GLOBAL HFM_OKBOX    0 /* effectively, the horizontal frame margin between 
      	       	     	 frame and help btn since there's no ok box */
&ELSE
 &GLOBAL HFM_OKBOX    1 /* horizontal frame margin for the ok box */
&ENDIF
                                                                         
&IF DEFINED(WIN95-BTN) &THEN
  &GLOBAL OKBOX       0
&ELSEIF "{&WINDOW-SYSTEM}" BEGINS "MS-WIN" &THEN
 &GLOBAL OKBOX        1
&ELSE
 &GLOBAL OKBOX        0  /* don't do for Motif or TTY */
&ENDIF 

/* use this format phrase for the rectangle used as the ok box */
&GLOBAL STDPH_OKBOX   FGC std_okbox_fgcolor SIZE {&IVM_OKBOX} BY {&IVM_OKBOX} EDGE-PIXELS 2 NO-FILL

/* ---------------------- OTHER STANDARD PHRASES  -------------------------- */

/* Use this for fillin fields, or any editor widgets that are for data entry. 
   Do not use for editor widgets used for 4GL program entry. (see below) */
&GLOBAL STDPH_FILL   bgc std_fillin_bgcolor fgc std_fillin_fgcolor 
&GLOBAL STDPH_COMBO  {&STDPH_FILL} 
&GLOBAL STDPH_EDITOR {&STDPH_FILL}

/* Use this phrase for any editor widget that is used for 4GL program entry,
   and that widget is the focus for data entry.  This is the value the 
   customers will be able to modify in their PROGRESS.INI files.  */
&GLOBAL STDPH_ED4GL       bgc std_ed4gl_bgcolor fgc std_ed4gl_fgcolor font editor_font 

/* Use this phrase for any editor widget that is used for 4GL program entry,
   and that widget is NOT the focus for data entry. */
&GLOBAL STDPH_ED4GL_SMALL bgc std_ed4gl_small_bgcolor fgc std_ed4gl_small_fgcolor font editor_font 

/* Use this phrase when you want to force a fixed font at compile time on
   a selection list or editor widget. */
&GLOBAL STDPH_FIX    FONT 0

/* Use this phrase for section dividers (title bands). */
&GLOBAL STDPH_SDIV   bgc std_div_bgcolor fgc std_div_fgcolor 

/* Use this phrase for any non-ok buttons. */
&GLOBAL STDPH_BTN    /* not mandated */

/* Use this for bgcolor of read-only editors */
&GLOBAL READ-ONLY_BGC  8

/*********************************************************************
* Copyright (C) 2000-2007 by Progress Software Corporation. All rights *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/
/**************************************************************
   Procedure: adewrap.i
    Function: Provide a runtime context sensitive entry point
              to the ADE Tools.
      Author: John Harris

***************************************************************
 *************************************************************/

/*
** Parameters:	&TTY	  TTY Procedure
**		&MOTIF	  OSF/Motif (GUI) Procedure
**		&MSWIN	  MS-Windows Procedure
**              &SETCURS  Cursor to set (use adecomm/_setcurs.p ("{&SETCURS}")
**                        the assumption is that the calling routine will
**                        reset it.  [Just used in MOTIF and MSWIN.]
*/

/* ADE Standards Include. */
{ adecomm/adestds.i}

/* If this is WebSpeed, exit */
IF SESSION:CLIENT-TYPE = "WEBSPEED" THEN RETURN ERROR.

/* This is done only once at startup of the ade.  This code runs and  
   loads up the colors and fonts
*/
IF NOT initialized_adestds THEN
  RUN adecomm/_adeload.p.

/* if started from the operating system, prompt for login ids */
IF PROGRAM-NAME(2) = ? AND "{&PRODUCT}" <> "RESULTS" THEN DO:
  RUN _prostar.p.

END.

IF SESSION:WINDOW-SYSTEM = "TTY" AND '{&TTY}' <> "" THEN
  RUN value("{&TTY}") .
ELSE IF (SESSION:WINDOW-SYSTEM = "OSF/Motif" AND '{&MOTIF}' <> "") OR
        (SESSION:WINDOW-SYSTEM BEGINS "MS-WIN" AND '{&MSWIN}' <> "") THEN
  /* There are two cases:
     1) where we want to surround the run with SETCURS (&SETCURS = WAIT)
     2) where we do not.   */
  &IF "{&SETCURS}" eq "" &THEN
    IF SESSION:WINDOW-SYSTEM = "OSF/Motif" 
    THEN RUN value("{&MOTIF}") .
    ELSE RUN value("{&MSWIN}") .
  &ELSE
    DO ON STOP UNDO, RETRY ON ERROR UNDO, RETRY ON ENDKEY UNDO, RETRY:
      IF NOT RETRY THEN DO:
        RUN adecomm/_setcurs.p ("{&SETCURS}").
        IF SESSION:WINDOW-SYSTEM = "OSF/Motif" 
        THEN RUN value("{&MOTIF}") .
        ELSE RUN value("{&MSWIN}") .
      END.
      /* Restore the cursor */
      RUN adecomm/_setcurs.p ("").
    END.
  &ENDIF
ELSE DO:
  DEFINE VARIABLE t_log AS LOGICAL NO-UNDO.

  RUN adecomm/_s-alert.p (INPUT-OUTPUT t_log, "i", "ok",
    SUBSTITUTE("This application does not run in &1 environments.",
    SESSION:WINDOW-SYSTEM)).
END.

IF RETURN-VALUE = "RETURN" THEN
  RETURN.

IF PROGRAM-NAME(2) = ? THEN
  QUIT.
ELSE
  RETURN.

/* adewrap.i - end of file */

/*********************************************************************
* Copyright (C) 2005 by Progress Software Corporation. All rights    *
* reserved.  Prior versions of this work may contain portions        *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/
/* adecomm/appserv.i checks to see if the persistent procedure adecomm/as-utils.w
                     has been started up, and if not, it starts it and then makes
                     is a SUPER procedure of the calling procedure.
                     
   Created: 11/26/97 by Ross Hunter
                                                                                 */

&IF DEFINED(APP-SERVER-VARS) = 0 &THEN
&GLOBAL-DEFINE APP-SERVER-VARS yes
DEFINE NEW GLOBAL SHARED VARIABLE appSrvUtils AS HANDLE                NO-UNDO.
&ENDIF

IF NOT VALID-HANDLE(appSrvUtils) THEN
  RUN adecomm/as-utils.w PERSISTENT SET appSrvUtils.

THIS-PROCEDURE:ADD-SUPER-PROCEDURE(appSrvUtils).


/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/
/* adecomm/appsrvtt.i Contains the definition for the AppServer Service
                      temp-table

   This definition is declared "NEW GLOBAL" in adecomm/as-utils.w which is 
   called once per PROGRESS session.  adecomm/as-utils is also responsible
   for loading the records when it is called.  protools/as-partn.w is
   responsible for maintaining and dumping the record in the table.  Any
   procedure needing to connect or disconnect needs to call methods in
   adecomm/as-utils.w to lookup information in AppSrv-TT.
   
   Created 11/26/97 by Ross Hunter                                          
   Modified:
     05/09/2000 BSG  Support for multiple partition types and Server URLs */
   
DEFINE {1} SHARED TEMP-TABLE AppSrv-TT
       FIELD Partition     AS CHARACTER FORMAT "X(25)"
       FIELD Host          AS CHARACTER FORMAT "X(15)"  /* NS -H parameter      */
       FIELD Service       AS CHARACTER FORMAT "X(15)"  /* NS -S parameter      */
       FIELD Configuration AS LOGICAL   FORMAT "Remote/Local"
       FIELD Security      AS LOGICAL   FORMAT "Prompt/No"
       FIELD Info          AS CHARACTER LABEL  "AppServer Information"
                                               FORMAT "X(255)"
       FIELD AS-Handle     AS HANDLE                    /* Handle if connected  */
       FIELD App-Service   AS CHARACTER LABEL  "Application Service" FORMAT "X(25)"
       FIELD Conn-Count    AS INTEGER   LABEL  "Pseudo connections" INITIAL 0
       FIELD PartitionType AS CHARACTER FORMAT "X(10)" 
       FIELD ServerURL     AS CHARACTER FORMAT "X(255)"
       FIELD Parameters    AS CHARACTER FORMAT "X(255)"
    INDEX Partition IS PRIMARY UNIQUE Partition
    INDEX App-Service App-Service
    INDEX PartitionType PartitionType.


&ANALYZE-SUSPEND _VERSION-NUMBER UIB_v9r12
&ANALYZE-RESUME
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _DEFINITIONS Procedure 
/*********************************************************************
* Copyright (C) 2005 by Progress Software Corporation. All rights    *
* reserved.  Prior versions of this work may contain portions        *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/
/*--------------------------------------------------------------------------
    File        : adecomm/as-utils.w
    Purpose     : Appserver Utilities

    Syntax      :

    Description : Utilities to aid in the deployment of distributed applications

    Author(s)   : Ross Hunter
    Created     : 12/01/97
    Notes       :
    
    Modified    : 
      05/10/2000  - BSG - JMS Support. Multiple Partition Types.
      06/01/2000  - GFS - Fixed problem with not passing URLs
  ------------------------------------------------------------------------*/
/*          This .W file was created with the Progress UIB.             */
/*----------------------------------------------------------------------*/

/* ***************************  Definitions  ************************** */
{adecomm/appsrvtt.i "NEW GLOBAL"}
{adecomm/_adetool.i}

DEFINE VARIABLE usr-id AS CHARACTER FORMAT "X(256)":U 
     LABEL "User ID" 
     VIEW-AS FILL-IN 
     SIZE 23 BY 1 TOOLTIP "Enter your User ID" NO-UNDO.

DEFINE VARIABLE psswrd AS CHARACTER FORMAT "X(256)":U 
     LABEL "Password" 
     VIEW-AS FILL-IN 
     SIZE 23 BY 1 TOOLTIP "Enter your password" NO-UNDO.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME


&ANALYZE-SUSPEND _UIB-PREPROCESSOR-BLOCK 

/* ********************  Preprocessor Definitions  ******************** */

&Scoped-define PROCEDURE-TYPE Procedure
&Scoped-define DB-AWARE no



/* _UIB-PREPROCESSOR-BLOCK-END */
&ANALYZE-RESUME


/* ************************  Function Prototypes ********************** */

&IF DEFINED(EXCLUDE-definedPartitions) = 0 &THEN

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION-FORWARD definedPartitions Procedure 
FUNCTION definedPartitions RETURNS CHARACTER
  ( /* parameter-definitions */ )  FORWARD.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME

&ENDIF

&IF DEFINED(EXCLUDE-getASConnectString) = 0 &THEN

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION-FORWARD getASConnectString Procedure 
FUNCTION getASConnectString RETURNS CHARACTER
  ( BUFFER bAppSrvTT FOR AppSrv-TT )  FORWARD.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME

&ENDIF

&IF DEFINED(EXCLUDE-getJMSPartitions) = 0 &THEN

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION-FORWARD getJMSPartitions Procedure 
FUNCTION getJMSPartitions RETURNS CHARACTER
  ( /* parameter-definitions */ )  FORWARD.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME

&ENDIF

&IF DEFINED(EXCLUDE-getJMSPtnInfo) = 0 &THEN

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION-FORWARD getJMSPtnInfo Procedure 
FUNCTION getJMSPtnInfo RETURNS CHARACTER
  ( INPUT cPartition AS CHARACTER )  FORWARD.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME

&ENDIF

&IF DEFINED(EXCLUDE-getPartitionsByType) = 0 &THEN

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION-FORWARD getPartitionsByType Procedure 
FUNCTION getPartitionsByType RETURNS CHARACTER
  ( INPUT cType AS CHARACTER )  FORWARD.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME

&ENDIF

&IF DEFINED(EXCLUDE-getServiceHandle) = 0 &THEN

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION-FORWARD getServiceHandle Procedure 
FUNCTION getServiceHandle RETURNS HANDLE
  ( pcService AS CHARACTER )  FORWARD.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME

&ENDIF


/* *********************** Procedure Settings ************************ */

&ANALYZE-SUSPEND _PROCEDURE-SETTINGS
/* Settings for THIS-PROCEDURE
   Type: Procedure
   Allow: 
   Frames: 0
   Add Fields to: Neither
   Other Settings: CODE-ONLY COMPILE
 */
&ANALYZE-RESUME _END-PROCEDURE-SETTINGS

/* *************************  Create Window  ************************** */

&ANALYZE-SUSPEND _CREATE-WINDOW
/* DESIGN Window definition (used by the UIB) 
  CREATE WINDOW Procedure ASSIGN
         HEIGHT             = 22.81
         WIDTH              = 62.2.
/* END WINDOW DEFINITION */
                                                                        */
&ANALYZE-RESUME

 


&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _MAIN-BLOCK Procedure 


/* ***************************  Main Block  *************************** */

/* The first thing to do is load up the service records into the
   AppSrv-TT.  This is only done here and this adecomm/as-utils.w
   should only be called once per session so there never should be
   any records already there.  But it is cheap to check it anyway.     */

IF CAN-FIND(FIRST AppSrv-TT) THEN
  MESSAGE "The Application Server Service Table has been previously defined."
          VIEW-AS ALERT-BOX ERROR.
ELSE
  RUN loadPartitionInfo.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME


/* **********************  Internal Procedures  *********************** */

&IF DEFINED(EXCLUDE-appServerConnect) = 0 &THEN

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE appServerConnect Procedure 
PROCEDURE appServerConnect :
/*------------------------------------------------------------------------------
  Purpose:  appServerConnect calls the AppServer CONNECT method.  The extra
            layer facilitates the switching between running locally and running
            remotely (through AppServer Technology) at run time without
            modifying source code.  This is achieved by managing service name
            records in the AppSrv-TT temp-table.
  Parameters:  service_name    the name of partition or service name to be 
                               connected.
               security_prompt Yes causes a prompt for a userid/password which
                               is included in the AppServer CONNECT method.
                               No passes blanks to the AppServer.
               app_server_info Any string is put into the 4Th argument of the
                               AppServer CONNECT method.
               conn-hdl        The connection handle for the AppServer session
  Notes:  
------------------------------------------------------------------------------*/

DEFINE INPUT  PARAMETER partition_name  AS CHARACTER                    NO-UNDO.
DEFINE INPUT  PARAMETER security_prompt AS LOGICAL                      NO-UNDO.
DEFINE INPUT  PARAMETER app_server_info AS CHARACTER                    NO-UNDO.
DEFINE OUTPUT PARAMETER conn-hdl        AS HANDLE                       NO-UNDO.

DEFINE VARIABLE ret         AS LOGICAL                                  NO-UNDO.
DEFINE VARIABLE cConnString AS CHARACTER                                NO-UNDO.
DEFINE BUFFER   xAppSrv-TT  FOR AppSrv-TT.
DEFINE VARIABLE lcancel     AS LOGICAL                                  NO-UNDO.

FIND FIRST AppSrv-TT WHERE AppSrv-TT.Partition = partition_name NO-ERROR.
IF NOT AVAILABLE AppSrv-TT THEN DO:
  MESSAGE "Attempt to connect a partition named" partition_name + "."
          SKIP
          "This partition is not currently defined in the"
          "Service Parameter Maintenance tool." VIEW-AS ALERT-BOX ERROR.
          RETURN "ERROR".
END.  /* If not record is available for this partiton */

IF AppSrv-TT.PartitionType <> "A":U THEN
DO:
  MESSAGE "Attempt to connect a partition named" partition_name + "."
          SKIP
          "This partition is not defined as an AppServer Partition in the"
          "Service Parameter Maintenance tool." VIEW-AS ALERT-BOX ERROR.
          RETURN "ERROR".
END.

/* Determine whether or not to override the defaults */
IF security_prompt = ? THEN security_prompt = AppSrv-TT.Security.
IF app_server_info = ? THEN app_server_info = AppSrv-TT.Info.

IF VALID-HANDLE(AppSrv-TT.AS-HANDLE) AND
   AppSrv-TT.AS-HANDLE = SESSION:HANDLE THEN
   AppSrv-TT.AS-Handle = ?.

/* Return the Session handle if this service isn't remote */
IF NOT AppSrv-TT.Configuration THEN DO:  /* Remote = true : Local = false */
  ASSIGN AppSrv-TT.AS-HANDLE = SESSION:HANDLE
         conn-hdl            = SESSION:HANDLE.
  RETURN.
END.  /* If this service is to be run locally */

/* We have found the record, return the handle if it is already connected */
ASSIGN conn-hdl             = AppSrv-TT.AS-Handle
       AppSrv-TT.Conn-Count = AppSrv-TT.Conn-Count + 1.
IF VALID-HANDLE(conn-hdl) AND
   conn-hdl:CONNECTED() THEN 
    RETURN.  /* Return the existing handle */
ELSE  /* This is now an invalid AppServer Handle */
DO:
  IF conn-hdl NE ? AND            
     conn-hdl NE SESSION:HANDLE THEN                          /* If we are dealing with an AppServer handle */
  DO:
    IF VALID-HANDLE(conn-hdl) THEN
    DO:
      DELETE OBJECT conn-hdl NO-ERROR.                          /* delete the handle to the server object and */
    END.
    FOR EACH xAppSrv-TT WHERE xAppSrv-TT.AS-Handle = conn-hdl:  /* make sure any other references to this handle */
      ASSIGN xAppSrv-TT.AS-Handle = ?.                          /* are set to unknown */
    END.
  END.
END.

conn-hdl = ?.

/* See if any other partition with the same AppService is connected - if so
   use that handle                                                        */
FIND FIRST xAppSrv-TT WHERE xAppSrv-TT.App-Service = AppSrv-TT.App-Service AND
                            xAppSrv-TT.Partition  NE AppSrv-TT.Partition AND
                            VALID-HANDLE(xAppSrv-TT.AS-HANDLE) NO-ERROR.
IF AVAILABLE xAppSrv-TT THEN DO:
  conn-hdl = xAppSrv-TT.AS-Handle.
  IF conn-hdl:CONNECTED() THEN DO:
    ASSIGN AppSrv-TT.AS-Handle = xAppSrv-TT.AS-Handle.
    RETURN.
  END.
  ELSE
  DO:
    DELETE OBJECT conn-hdl NO-ERROR.                          
    ASSIGN conn-hdl = ?
           xAppSrv-TT.AS-Handle = ?.
  END.
END.  /* We found another partition that is currently connected to this AppService */


/* We need to make a connection. */
CREATE SERVER conn-hdl.

/*  Check to see if we need to prompt for userid/password */
IF security_prompt THEN DO:
  IF NUM-DBS > 0 THEN RUN adecomm/get-user.p (OUTPUT usr-id).
  RUN security_prompt (OUTPUT lCancel).
  IF lcancel THEN DO:       /* user pressed cancel when prompted for userid and pw */
    ASSIGN conn-hdl = ?.
    RETURN 'ERROR'.
  END.
END.

cConnString = getASConnectString(BUFFER AppSrv-TT).

/* Do the connection */
ASSIGN ret = conn-hdl:CONNECT(cConnString, usr-id, psswrd, app_server_info).
IF NOT ret THEN DO:
  MESSAGE "Unable to connect to the AppServer for the" AppSrv-TT.App-Service
          "service." VIEW-AS ALERT-BOX ERROR.
  ASSIGN conn-hdl = SESSION:HANDLE.
  RETURN "ERROR".
END.

AppSrv-TT.AS-HANDLE = conn-hdl.

END PROCEDURE.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME

&ENDIF

&IF DEFINED(EXCLUDE-appServerDisconnect) = 0 &THEN

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE appServerDisconnect Procedure 
PROCEDURE appServerDisconnect :
/*------------------------------------------------------------------------------
  Purpose:     To disconnect from a named service (a Partition)
  Parameters:  service_name  The name of the service to be disconnected from
  Notes:       
------------------------------------------------------------------------------*/
  DEFINE INPUT PARAMETER partition_name AS CHARACTER                     NO-UNDO.

  DEFINE VARIABLE        ret            AS LOGICAL                       NO-UNDO.
  DEFINE BUFFER          xAppSrv-TT     FOR AppSrv-TT.

  FIND FIRST AppSrv-TT WHERE AppSrv-TT.Partition = partition_name NO-ERROR.
  
  IF NOT AVAILABLE AppSrv-TT THEN RETURN.

  /* This was being run locally don't disconnect, just null out the handle */ 
  IF NOT VALID-HANDLE(AppSrv-TT.AS-Handle) OR
     (AppSrv-TT.AS-Handle = SESSION:HANDLE) THEN DO:
    AppSrv-TT.AS-Handle = ?.
    RETURN.
  END.

  AppSrv-TT.Conn-Count = AppSrv-TT.Conn-Count - 1.
  
  IF AppSrv-TT.Conn-Count < 1 THEN DO:  /* This partition is tapped out - disconnect it */
    /* Check to see if another partition is still using the connection */
    IF CAN-FIND(FIRST xAppSrv-TT WHERE xAppSrv-TT.App-Service = AppSrv-TT.App-Service AND
                                       xAppSrv-TT.Partition  NE partition_name AND
                                       VALID-HANDLE(xAppSrv-TT.AS-Handle)) THEN DO:
      AppSrv-TT.AS-Handle = ?.         /* Keep the connection for this other partition */
      RETURN.
    END. /* Found another active connection */
 
    /* Disconnect here */
    ret = AppSrv-TT.AS-Handle:DISCONNECT().
    IF ret THEN DO:  /* Disconnection was succesful */
      DELETE OBJECT AppSrv-TT.AS-HANDLE.
      AppSrv-TT.AS-Handle = ?.
    END.
    ELSE MESSAGE "There is an error disconnecting from the" AppSrv-TT.App-Service
                 "AppServer Service." VIEW-AS ALERT-BOX ERROR.
  END. /* If the partition has no active connections (Conn-Count < 1) */
END PROCEDURE.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME

&ENDIF

&IF DEFINED(EXCLUDE-loadPartitionInfo) = 0 &THEN

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE loadPartitionInfo Procedure 
PROCEDURE loadPartitionInfo :
/*------------------------------------------------------------------------------
  Purpose:     
  Parameters:  <none>
  Notes:       
------------------------------------------------------------------------------*/
DEFINE VARIABLE tt-file AS CHARACTER                             NO-UNDO.

tt-file = SEARCH("appsrvtt.d":U).
IF tt-file ne ? THEN DO:  /* We found the file */
  INPUT FROM value(tt-file) NO-ECHO.
  REPEAT TRANSACTION:
    CREATE AppSrv-TT.
    IMPORT AppSrv-TT.Partition 
           AppSrv-TT.Host
           AppSrv-TT.Service
           AppSrv-TT.Configuration
           AppSrv-TT.Security
           AppSrv-TT.Info
           AppSrv-TT.App-Service
           AppSrv-TT.PartitionType
           AppSrv-TT.ServerURL
           AppSrv-TT.Parameters.
    IF AppSrv-TT.App-Service = "":U THEN /* Convert from 9.0A to 9.0B */
      AppSrv-TT.App-Service = AppSrv-TT.Partition.
    IF AppSrv-TT.PartitionType = "":U THEN
      AppSrv-TT.PartitionType = "A":U.
    ASSIGN AppSrv-TT.AS-Handle = ?.
    VALIDATE AppSrv-TT.
  END. /* Repeat */
  INPUT CLOSE.
END. /* If we found the appsrvtt.d file */

END PROCEDURE.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME

&ENDIF

&IF DEFINED(EXCLUDE-savePartitionInfo) = 0 &THEN

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE savePartitionInfo Procedure 
PROCEDURE savePartitionInfo :
/*------------------------------------------------------------------------------
  Purpose:     
  Parameters:  <none>
  Notes:       
------------------------------------------------------------------------------*/
OUTPUT TO appsrvtt.d.
FOR EACH AppSrv-TT NO-LOCK:
  /* This next 3 lines shouldn't be necessary, but there seems to be a bug
     in the updatable browse */
  IF AppSrv-TT.App-Service = "" AND AppSrv-TT.Host = "" AND
     AppSrv-TT.Service = "" AND AppSrv-TT.Configuration = NO THEN
    DELETE AppSrv-TT.
  ELSE
    EXPORT AppSrv-TT.Partition
           AppSrv-TT.Host
           AppSrv-TT.Service
           AppSrv-TT.Configuration
           AppSrv-TT.Security
           AppSrv-TT.Info
           AppSrv-TT.App-Service
           AppSrv-TT.PartitionType
           AppSrv-TT.ServerURL
           AppSrv-TT.Parameters.
END.  /* For Each */
OUTPUT CLOSE.

END PROCEDURE.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME

&ENDIF

&IF DEFINED(EXCLUDE-security_prompt) = 0 &THEN

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE security_prompt Procedure 
PROCEDURE security_prompt :
/*------------------------------------------------------------------------------
  Purpose:  Prompts for userid and password   
  Parameters:  returns lCancel = TRUE if cancel was pressed.
               returns lCancel = FALSE if ok was pressed.
  Notes:       
------------------------------------------------------------------------------*/
DEFINE OUTPUT PARAMETER lCancel AS LOGICAL              NO-UNDO.
DEFINE BUTTON Btn_Cancel AUTO-END-KEY 
     LABEL "Cancel" 
     SIZE 15 BY 1.14
     BGCOLOR 8 .

DEFINE BUTTON Btn_Help 
     LABEL "&Help" 
     SIZE 15 BY 1.14
     BGCOLOR 8 .

DEFINE BUTTON Btn_OK AUTO-GO 
     LABEL "OK" 
     SIZE 15 BY 1.14
     BGCOLOR 8 .



/* ************************  Frame Definitions  *********************** */

DEFINE FRAME Security-Dialog
     usr-id AT ROW 1.71 COL 11 COLON-ALIGNED
     psswrd AT ROW 2.91 COL 11 COLON-ALIGNED PASSWORD-FIELD
     Btn_OK AT ROW 1.52 COL 42
     Btn_Cancel AT ROW 2.76 COL 42
     Btn_Help AT ROW 4.76 COL 42
     SPACE(1.99) SKIP(0.28)
    WITH VIEW-AS DIALOG-BOX KEEP-TAB-ORDER 
         SIDE-LABELS NO-UNDERLINE THREE-D  SCROLLABLE 
         TITLE "Security Check"
         DEFAULT-BUTTON Btn_OK CANCEL-BUTTON Btn_Cancel.

  ASSIGN lCancel = TRUE.        
  UPDATE usr-id psswrd Btn_OK Btn_Cancel Btn_Help 
         WITH FRAME Security-Dialog.
  ASSIGN lCancel = FALSE.       /* If we get to here then OK was pressed (not cancel)*/
  HIDE FRAME Security-Dialog.

END PROCEDURE.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME

&ENDIF

/* ************************  Function Implementations ***************** */

&IF DEFINED(EXCLUDE-definedPartitions) = 0 &THEN

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION definedPartitions Procedure 
FUNCTION definedPartitions RETURNS CHARACTER
  ( /* parameter-definitions */ ) :
/*------------------------------------------------------------------------------
  Purpose:  Returns a list of defined Partitions (separated by CHR(3))
    Notes: 
    Modifications: 
       05/09/00 - BSG - Changed to use getPartitionsByType
------------------------------------------------------------------------------*/

  RETURN getPartitionsByType("A":U).

END FUNCTION.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME

&ENDIF

&IF DEFINED(EXCLUDE-getASConnectString) = 0 &THEN

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION getASConnectString Procedure 
FUNCTION getASConnectString RETURNS CHARACTER
  ( BUFFER bAppSrvTT FOR AppSrv-TT ) :
/*------------------------------------------------------------------------------
  Purpose:  Creates the connect string for the AppServer connect method
    Notes:  
------------------------------------------------------------------------------*/
  DEFINE VARIABLE lDirect AS LOGICAL INITIAL ? NO-UNDO.

  /* If the direct connection parameters are blank, don't make a 
     direct connection */
  IF (bAppSrvTT.Host = "":U OR bAppSrvTT.Host = ?) AND
     (bAppSrvTT.Service = "":U OR bAppSrvTT.Service = ?) AND
     (bAppSrvTT.App-Service = "":U OR bAppSrvTT.App-Service = ?) THEN
    lDirect = NO.
  
  /* If the URL parameters are blank, use a direct connetion */
  IF (bAppSrvTT.ServerURL = "":U OR bAppSrvTT.ServerURL = ?)  THEN
    lDirect = YES.
  ELSE 
    lDirect = NO. /* Either WEBCLIENT or 4GL client using a URL */

  /* If we haven't decided the type of connection, decide from the 
     new CLIENT-TYPE attribute */
  IF lDirect = ? AND
      SESSION:CLIENT-TYPE <> "WebClient":U THEN
    lDirect = YES.

  /* Return the appropriate connection string */
  IF lDirect THEN 
    RETURN (IF bAppSrvTT.Host        NE "":U THEN " -H ":U + bAppSrvTT.Host ELSE "":U) +
           (IF bAppSrvTT.Service     NE "":U THEN " -S ":U + bAppSrvTT.Service ELSE "":U) +
           (IF bAppSrvTT.App-Service NE "":U THEN " -AppService ":U + bAppSrvTT.App-Service ELSE "":U)
           + " ":U + bAppSrvTT.Parameters.
  ELSE 
    RETURN "-URL ":U + bAppSrvTT.ServerURL + " ":U + bAppSrvTT.Parameters.
END FUNCTION.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME

&ENDIF

&IF DEFINED(EXCLUDE-getJMSPartitions) = 0 &THEN

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION getJMSPartitions Procedure 
FUNCTION getJMSPartitions RETURNS CHARACTER
  ( /* parameter-definitions */ ) :
/*------------------------------------------------------------------------------
  Purpose:  Returns a CHR(3) delimited list of JMS partition names  
    Notes:  
------------------------------------------------------------------------------*/
  RETURN getPartitionsByType("J":U).

END FUNCTION.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME

&ENDIF

&IF DEFINED(EXCLUDE-getJMSPtnInfo) = 0 &THEN

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION getJMSPtnInfo Procedure 
FUNCTION getJMSPtnInfo RETURNS CHARACTER
  ( INPUT cPartition AS CHARACTER ) :
/*------------------------------------------------------------------------------
  Purpose:  Gets the URL and connection string for the JMS Partition Connection
    Notes:  
------------------------------------------------------------------------------*/
  DEFINE BUFFER lAppSrvTT FOR AppSrv-TT.

  FIND FIRST lAppSrvTT WHERE lAppSrvTT.Partition = cPartition NO-ERROR.
  IF NOT AVAILABLE lAppSrvTT THEN
     RETURN "?":U + CHR(3) + "Partition not defined".

  IF lAppSrvTT.PartitionType <> "J":U THEN
     RETURN "?":U + CHR(3) + "Not a JMS Partition".

  RETURN getASConnectString(BUFFER lAppSrvTT) + CHR(3) + lAppSrvTT.Info.

END FUNCTION.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME

&ENDIF

&IF DEFINED(EXCLUDE-getPartitionsByType) = 0 &THEN

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION getPartitionsByType Procedure 
FUNCTION getPartitionsByType RETURNS CHARACTER
  ( INPUT cType AS CHARACTER ) :
/*------------------------------------------------------------------------------
  Purpose:  Returns a CHR(3) delimited list of partitions of a particular type
    Notes:  
------------------------------------------------------------------------------*/
  DEFINE VARIABLE cPartitionList AS CHARACTER  NO-UNDO.
  
  FOR EACH AppSrv-TT NO-LOCK
    WHERE AppSrv-TT.PartitionType = cType:
    cPartitionList = cPartitionList 
                   + (IF cPartitionList = "":U THEN "":U ELSE CHR(3))
                   + AppSrv-TT.Partition.
  END.
            
  RETURN cPartitionList.   /* Function return value. */

END FUNCTION.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME

&ENDIF

&IF DEFINED(EXCLUDE-getServiceHandle) = 0 &THEN

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION getServiceHandle Procedure 
FUNCTION getServiceHandle RETURNS HANDLE
  ( pcService AS CHARACTER ) :
/*------------------------------------------------------------------------------
  Purpose: Retrieve the current server connection
    Notes: Implemented to be able to get the handle without calling 
           appServerConnect and adding to the count that is used by 
           appServerDisconnect to check wheter it can disconnect.........            
------------------------------------------------------------------------------*/
  FIND FIRST AppSrv-TT WHERE AppSrv-TT.Partition = pcService NO-ERROR.
  IF AVAIL AppSrv-TT THEN
    RETURN AppSrv-TT.AS-HANDLE.  
  ELSE 
    RETURN ?.

END FUNCTION.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME

&ENDIF

/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/
/*-----------------------------------------------------------------------------

  File: browqury.i

  Description: 
   This code will bring up the dialog box frame that allows the developer
   to define the files and their query relationships used in a browse.

  Input Parameters:
      <none>

  Output Parameters:
      <none>

  Author: Greg O'Connor

  Created: 03/23/93 - 12:17 pm

-----------------------------------------------------------------------------*/
&Global-Define Debug FALSE /*TRUE*/

{ adecomm/qurywidg.i }
{ adecomm/adestds.i }
/*
** The five main states of the query builder as returned by rsmain:screen-value
*/
&Global-Define Table         1
&Global-Define Join          2
&Global-Define Where         3
&Global-Define Sort          4
&Global-Define Field         5
&Global-Define Max-function  5

&Global-Define CurRight     whRight   [INTEGER (rsMain:screen-value)]
&Global-Define TableRight   whRight   [{&Table}]
&Global-Define CurLeft      whLeft    [INTEGER (rsMain:screen-value)]
&Global-Define CurData      cMoreData [INTEGER (rsMain:screen-value)]
&Global-Define CurSortData  cMoreData [{&Sort}]
&Global-Define CurFieldData cMoreData [{&Field}]
&Global-Define CurTable     eCurrentTable:SCREEN-VALUE 

&Global-Define DisFieldList  "<<Selected Fields>>"
/* Temp Table for WHERE builder */

DEFINE {1} SHARED TEMP-TABLE ttWhere NO-UNDO
  FIELD iState      AS INTEGER         /* Screen State */
  FIELD cTable      AS CHARACTER       /* Table Name */
  FIELD iSeq        AS INTEGER         /* sequence */
  FIELD cExpression AS CHARACTER       /* Expression */
  FIELD cLastField  AS CHARACTER       /* Where Last Field */
  FIELD iOffset     AS INTEGER         /* Display Offset */
  FIELD lOperator   AS LOGICAL         /* Operator State */
  INDEX ttWhere-index IS PRIMARY UNIQUE iState cTable iSeq.

/* internal variables */
DEFINE {1} SHARED VARIABLE cOperator  AS CHARACTER NO-UNDO. /* comparison operator  */
DEFINE {1} SHARED VARIABLE cLastField AS CHARACTER NO-UNDO. /* last field referenced */
DEFINE {1} SHARED VARIABLE cValue     AS CHARACTER NO-UNDO. /* value                */
/*
** These DEFINE {1} SHAREDs and acWhereState are use to controll the operators that
** are available in the WHERE builder.
*/
&Global-Define bEqual	         1
&Global-Define bNotEqual	 2
&Global-Define bLess		 3
&Global-Define bGreater	     	 4
&Global-Define bLessEqual	 5
&Global-Define bGreaterEqual	 6
&Global-Define bBegins		 7
&Global-Define bMatches		 8
&Global-Define bContains	 9
&Global-Define bXMatches	 10 
&Global-Define bContainsQBF	 11
&Global-Define bRange		 12
&Global-Define bXRange		 13	
&Global-Define bList		 14	
&Global-Define bXList		 15	
&Global-Define bAnd 		 16	
&Global-Define bOr  		 17	

&Global-Define lEqual	         "=" 
&Global-Define lNotEqual	 "<>" 
&Global-Define lLess		 "<" 
&Global-Define lGreater	     	 ">" 
&Global-Define lLessEqual	 "<=" 
&Global-Define lGreaterEqual	 ">=" 
&Global-Define lBegins		 "Begins" 
&Global-Define lMatches		 "Matches" 
&Global-Define lContains 	 "Contains" 
&Global-Define lXMatches	 "Like"  
&Global-Define lContainsQBF	 "Contains (QBF)" 
&Global-Define lRange		 "Range" 
&Global-Define lXRange		 "X-Range" 	
&Global-Define lList		 "List" 	
&Global-Define lXList		 "X-List" 	
&Global-Define lAnd              "AND"
&Global-Define lOr               "OR"
/*
Each string consists of three parts: control, expression and UI.
The control portion includes the following embedded codes:
  "o" = ask for a single value
  "r" = ask for an upper and a lower bound
  "u" = ask for value w/o using dictionary format string
  "q" = query by words
  "m" = ask for multiple values
  "1" .. "5" = datatypes allowed (none for QBW)
*/
DEFINE {1} SHARED VARIABLE acWhereState AS CHARACTER EXTENT 17 NO-UNDO.
ASSIGN
  acWhereState[{&bEqual}]        = "o12345," + {&lEqual} + "," +
                                    "Equal             " +  " ( = )":u
  acWhereState[{&bNotEqual}]     = "o12345," + {&lNotEqual} + "," +
                                    "Not Equal        " + " ( <> )":u
  acWhereState[{&bLess}]         = "o1245,"  + {&lLess} + "," +
                                    "Less Than         " + " ( < )":u
  acWhereState[{&bGreater}]      = "o1245,"  + {&lGreater} + "," +
                                    "Less or Equal    "  + " ( <= )":u
  acWhereState[{&bLessEqual}]    = "o1245,"  + {&lLessEqual} + "," +
                                    "Greater Than      " +  " ( > )":u
  acWhereState[{&bGreaterEqual}] = "o1245,"  + {&lGreaterEqual} + "," +
                                    "Greater or Equal "  + " ( >= )":u
  acWhereState[{&bBegins}]       = "u1,"     + {&lBegins} + "," +
                                    "Begins                  "
  acWhereState[{&bMatches}]      = "u1,"     + {&lMatches} + "," +
                                    "Matches                 "
  acWhereState[{&bContains}]     = "q,"      + {&lContains} + "," +
                                    "Contains              " +  " (SQL)":u
  acWhereState[{&bXMatches}]     = "u1,"     + {&lXMatches} + "," +
                                    "Contains                "
  acWhereState[{&bContainsQBF}]  = "q,"      + {&lContainsQBF} + "," +
                                    "Contains          " +  " (QBW)":u
  acWhereState[{&bRange}]        = "r1245,"  + {&lRange} + "," +
                                    "Range (Inclusive)       "
  acWhereState[{&bXRange}]       = "r1245,"  + {&lXRange} + "," +
                                    "Range (Exclusive)       "
  acWhereState[{&bList}]         = "m1245,"  + {&lList} + "," +
                                    "In List of Values       "
  acWhereState[{&bXList}]        = "m1245,"  + {&lXList} + "," +
                                    "Not In List of Values   "
  acWhereState[{&bAnd}]          = "3,"      + {&lAnd} + "," + "x"
  acWhereState[{&bOr}]           = "3,"      + {&lOr} + "," + "x".
											     
/* DEFINE {1} SHARED a dialog box                                                      */
											     
/* Definitions of the field level widgets                               */
DEFINE RECTANGLE RECT-1
     EDGE-PIXELS 1 	  
     SIZE-CHAR 67.4 BY 1.1 {&STDPH_FILL}.

DEFINE RECTANGLE RECT-3 {&STDPH_OKBOX}.

&Global-Define partialFeatures	 1

DEFINE {1} SHARED VARIABLE rsMain AS INTEGER 
     VIEW-AS RADIO-SET HORIZONTAL  
     RADIO-BUTTONS 
                   &if defined(partialFeatures) = 0 &then
                       "Table   ",{&Table},
                   &endif
                       "Join",    {&Join}
                      ,"Where",   {&Where}
                   &if defined(partialFeatures) = 0 &then
                       ,"Sort",    {&Sort}
                       ,"Fields",  {&Field}     
                   &endif
     SIZE 62 BY .95 
     BGCOLOR 8 FGCOLOR 0 NO-UNDO. 

DEFINE {1} SHARED VARIABLE RADIO-SET-2 AS LOGICAL 
     VIEW-AS RADIO-SET HORIZONTAL  
     RADIO-BUTTONS "AND",TRUE,"OR",FALSE NO-UNDO.

DEFINE {1} SHARED VARIABLE rsSortDirection AS LOGICAL 
     VIEW-AS RADIO-SET HORIZONTAL  
     RADIO-BUTTONS "Ascending",TRUE,
                   "Descending",FALSE  NO-UNDO.
				  
DEFINE BUTTON bEqual 	      SIZE-CHAR 4.14  BY 1      LABEL {&lEqual	       }.
DEFINE BUTTON bNotEqual       SIZE-CHAR 4.14  BY 1      LABEL {&lNotEqual	   }.
DEFINE BUTTON bLess 	      SIZE-CHAR 4.14  BY 1      LABEL {&lLess		   }.
DEFINE BUTTON bGreater 	      SIZE-CHAR 4.14  BY 1      LABEL {&lGreater	   }.
DEFINE BUTTON bLessEqual      SIZE-CHAR 4.14  BY 1      LABEL {&lLessEqual     }.
DEFINE BUTTON bGreaterEqual   SIZE-CHAR 4.14  BY 1      LABEL {&lGreaterEqual  }.
DEFINE BUTTON bBegins 	      SIZE-CHAR 10.25 BY 1      LABEL {&lBegins	       }.
DEFINE BUTTON bMatches 	      SIZE-CHAR 10.25 BY 1      LABEL {&lMatches	   }.
DEFINE BUTTON bXMatches       SIZE-CHAR 10.25 BY 1      LABEL {&lXMatches	   }.
DEFINE BUTTON bContains	      SIZE-CHAR 10.25 BY 1      LABEL {&lContains      }.
DEFINE BUTTON bRange 	      SIZE-CHAR 10.25 BY 1      LABEL {&lRange	       }.
DEFINE BUTTON bXRange 	      SIZE-CHAR 10.25 BY 1      LABEL {&lXRange	       }.
DEFINE BUTTON bContainsQBF    SIZE-CHAR 21.5  BY 1      LABEL {&lContainsQBF   }.
DEFINE BUTTON bXList 	      SIZE-CHAR 10.25 BY 1      LABEL {&lXList		   }.
DEFINE BUTTON bList 	      SIZE-CHAR 10.25 BY 1      LABEL {&lList	       }.
DEFINE BUTTON bAnd		      SIZE-CHAR 8.5   BY 1      LABEL {&lAnd	       }.
DEFINE BUTTON bOr		      SIZE-CHAR 8.5   BY 1      LABEL {&lOr 	       }.
DEFINE BUTTON bUp             SIZE-CHAR 12    BY 1      LABEL "Move up" .
DEFINE BUTTON bDown           SIZE-CHAR 12    BY 1      LABEL "Move Down" .
DEFINE BUTTON bTableSwitch    SIZE-CHAR 25    BY 1	    LABEL "Switch Join Partners.." .
DEFINE BUTTON bAdd 	      SIZE-CHAR 12.14  BY 1      LABEL "Add >>" .
DEFINE BUTTON bRemove 	      SIZE-CHAR 12.14  BY 1      LABEL "<< Remove" .
DEFINE BUTTON bHelp 	      {&STDPH_OKBTN}            LABEL "&Help".
DEFINE BUTTON bDebug 	      {&STDPH_OKBTN}            LABEL "&Debug".
DEFINE BUTTON bOk 		      {&STDPH_OKBTN}            LABEL "OK" AUTO-GO.
DEFINE BUTTON bCancel 	      {&STDPH_OKBTN}            LABEL "Cancel" AUTO-ENDKEY.
DEFINE BUTTON bCheckSyntax    SIZE-CHAR 6     BY 1      LABEL "Now" .
DEFINE BUTTON bFieldFormat    SIZE-CHAR 16    BY 1 	    LABEL "Format Help..." .
DEFINE BUTTON bUndo 	      {&STDPH_OKBTN}            LABEL "Undo" .

DEFINE BUTTON bDrop IMAGE-UP FILE "btn-down-arrow".

DEFINE {1} SHARED VARIABLE slComboBox AS CHARACTER NO-UNDO
   VIEW-AS SELECTION-LIST SINGLE SCROLLBAR-V
     SIZE-CHAR 30 BY 5.5 .

DEFINE {1} SHARED VARIABLE eDisplayCode AS CHARACTER 
     VIEW-AS EDITOR scrollbar-vertical
     SIZE-CHAR 66 BY 3 {&STDPH_EDITOR}.

DEFINE {1} SHARED VARIABLE eCurrentTable AS CHARACTER 
     format "x(72)" Label "Table" 
     view-as fill-in size 29 by 1 {&STDPH_FILL}.

DEFINE {1} SHARED VARIABLE eFieldFormat AS CHARACTER 
     format "x(27)" Label "Format" {&STDPH_FILL}.

DEFINE {1} SHARED VARIABLE eFieldLabel AS CHARACTER 
     VIEW-AS EDITOR   scrollbar-vertical
     SIZE-CHAR 28 BY 2  Label " Label" {&STDPH_FILL}.

DEFINE {1} SHARED variable l_label-2 as character 
       view-as text format "x(25)"
       init "Selected Tables && Joins:". 
       
DEFINE {1} SHARED variable lCombineUsing as character 
       view-as text format "x(15)".
       
DEFINE {1} SHARED variable lBrowseLabel as character 
       view-as text format "x(66)" {&STDPH_SDIV}.

DEFINE {1} SHARED variable lRight as character 
       view-as text format "x(25)".

DEFINE {1} SHARED variable lLeft as character 
       view-as text format "x(25)".

DEFINE {1} SHARED variable lSyntax as character 
       view-as text format "x(15)" init "Check Syntax:".

DEFINE {1} SHARED variable lInclusive as character 
       view-as text format "x(25)" init "Inclusive:".

DEFINE {1} SHARED variable lExclusive as character 
       view-as text format "x(25)" init "Exclusive:".

DEFINE {1} SHARED variable tJoinable as LOGICAL 
       view-as toggle-box label "Customize Join".

DEFINE {1} SHARED variable tOnOk as LOGICAL 
       view-as toggle-box label "On OK".

DEFINE {1} SHARED variable lOnOk as character 
       view-as text init "On OK".

/* Definitions of the frame widgets                                     */
DEFINE {1} SHARED FRAME DIALOG-1
     RECT-1             AT ROW 1     COL 1
     rsMain             AT ROW 1.1   COL 5 /* MSW */ NO-LABEL
     eCurrentTable      AT ROW 2.4   COL 10 
	 bDrop              AT ROW 2.25  COL 48 NO-LABEL
	 tJoinable			AT ROW 2.5   COL 51
	 slComboBox         AT ROW 2.25  COL 1  NO-LABEL

     l_label-2 VIEW-AS TEXT no-label AT ROW 3.75 COL 32

/** The left and right selection lists labels ***/
     lLeft          	AT ROW 3.75  COL 2  NO-LABEL
     lRight          	AT ROW 3.75  COL 42 NO-LABEL
/** The left and right selection lists ***/
/** The Add and Remove buttons in between the selection lists **/
     bAdd               AT ROW 4.5   COL 29
     bRemove            AT ROW 5.6     COL 29
/** The Operators for Join ***/
     bEqual		        AT ROW 4.5   COL 31
     bNotEqual			AT ROW 4.5   COL 35.4
     bLess				AT ROW 5.6   COL 31
     bGreater			AT ROW 5.6   COL 35.4
     bLessEqual			AT ROW 6.7   COL 31
     bGreaterEqual		AT ROW 6.7   COL 35.4
     bAnd				AT ROW 7.8   COL 31
     bOr				AT ROW 8.9   COL 31
/** The Operators for Where ***/
     bBegins 			AT ROW 5.6   COL 42
     bMatches 			AT ROW 6.7   COL 42
     bList 				AT ROW 7.8   COL 42 
     bXMatches 			AT ROW 5.6   COL 53
     bContains			AT ROW 6.7   COL 53
     bRange 			AT ROW 7.8   COL 53

/*     bContains 			AT ROW 10    COL 42 
     lInclusive			AT ROW 6.7   COL 42 NO-LABEL 
     lExclusive			AT ROW 8.9   COL 42	NO-LABEL
     bXList 			AT ROW 10    COL 42 
     bxRange 			AT ROW 10     COL 53
*/

     bTableSwitch       AT ROW 10.25  COL 42.5

     bUp                AT ROW 7.9 /*9.65*/  COL 29 /* 40 */
     bDown              AT ROW 9   /*9.65*/  COL 29 /* 56 */
     rsSortDirection    AT ROW 10.25 COL 41 NO-LABEL
     edisplaycode       AT ROW 12.25 COL 2  NO-LABEL
     lBrowseLabel       AT ROW 11.5  COL 2  NO-LABEL
     eFieldLabel        AT ROW 12.85 COL 3
     eFieldFormat       AT ROW 15    COL 2.25
     bFieldFormat       AT ROW 15    COL 39

     lCombineUsing      AT ROW 15.4    COL 3 NO-LABEL
     RADIO-SET-2        AT ROW 16.1    COL 4 NO-LABEL

     bUndo              AT ROW 16      COL 22
     lSyntax            AT ROW 16      COL 37 NO-LABEL 
     bCheckSyntax       AT ROW 16      COL 51 
     tOnOk              AT ROW 16      COL 58 NO-LABEL 
/** The Standard dialog button **/
     {adecomm/okform.i
	     &BOX    = "RECT-3"
         &STATUS =  no
		 &OK     = "bOk"
		 &CANCEL = "bCancel"
		 &OTHER  = "SPACE({&HM_DBTNG}) bDebug"
		 &HELP   = "bHelp"
	 }
   WITH VIEW-AS DIALOG-BOX DEFAULT-BUTTON bOk
   SIDE-LABELS  SCROLLABLE. 
 
/* Local Variable Definitions ---                                            */

DEFINE VARIABLE i                      AS INTEGER   NO-UNDO.
DEFINE VARIABLE j                      AS INTEGER   NO-UNDO.
DEFINE {1} SHARED VARIABLE lOk         AS LOGICAL   NO-UNDO.
DEFINE {1} SHARED VARIABLE lLogical    AS LOGICAL   NO-UNDO.
DEFINE {1} SHARED VARIABLE cTemp       AS CHARACTER NO-UNDO.
DEFINE {1} SHARED VARIABLE cList       AS CHARACTER NO-UNDO.
DEFINE {1} SHARED VARIABLE cDbName     AS CHARACTER NO-UNDO.
DEFINE {1} SHARED VARIABLE cFieldName  AS CHARACTER NO-UNDO.
DEFINE {1} SHARED VARIABLE cTableName  AS CHARACTER NO-UNDO.

DEFINE {1} SHARED VARIABLE cSortData   AS CHARACTER NO-UNDO.
DEFINE {1} SHARED VARIABLE cFieldData  AS CHARACTER NO-UNDO.
/**/
DEFINE {1} SHARED VARIABLE iTableNum   AS INTEGER   NO-UNDO.
DEFINE {1} SHARED VARIABLE rDbId       AS REC       NO-UNDO EXTENT {&MaxTbl}. /* DB recid */
DEFINE {1} SHARED VARIABLE rTableId    AS REC       NO-UNDO EXTENT {&MaxTbl}. /* Tbl recid */
DEFINE {1} SHARED VARIABLE cSchema     AS CHARACTER NO-UNDO EXTENT {&MaxTbl}. /* schema db */

DEFINE {1} SHARED VARIABLE whLeft      AS WIDGET    NO-UNDO EXTENT {&Max-function}.
DEFINE {1} SHARED VARIABLE whRight     AS WIDGET    NO-UNDO EXTENT {&Max-function}.
DEFINE {1} SHARED VARIABLE cMoreData   AS CHARACTER NO-UNDO EXTENT {&Max-function}.
DEFINE {1} SHARED VARIABLE cCurrentDb  AS CHARACTER NO-UNDO.

DEFINE {1} SHARED VARIABLE acWhere     AS CHARACTER EXTENT 100 NO-UNDO.
DEFINE {1} SHARED VARIABLE acJoin      AS CHARACTER EXTENT 100 NO-UNDO.

/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/*----------------------------------------------------------------------------

File: cbcdrop.i  (Combo Box Code Drop)

Description:
   This file contains only the in-line code that controls a drop-down combo 
   box.

   A drop-down combo box is one that contains a fill-in field, a button 
   and a selection list where the list will drop down (become visible)
   or pull up (become invisible) when the button or the fill-in are clicked on.

   This variety of drop combo box will not allow any value to be displayed 
   in the fill-in that is not in the drop down list.

Arguments:
   &Frame   - The name of the frame that the combo box appears in, 
      	      e.g., "frame foo".
   &CBFill  - The variable that is the fill-in field part of the
      	      combo box.
   &CBList  - The variable that is the selection list part of the
      	      combo box.
   &CBBtn   - The button that is the button component of the combo box.
      	      This should have been defined with IMAGE-UP FILE "adeicon/cbbtn".
   &CBInit  - The initial value of the combo box.  e.g., if the list
      	      values are known and they are "May","June","July", set
      	      this to ""June"" to have June be selected when the combo
      	      box is first displayed.  If this is set to the null
      	      string, the first item in the list is selected.

How to use this include file:
   This file should be included when you want to enable and position
   the combo box widgets - e.g. just before you are about to display 
   the frame.
   
   None of the combo box pieces need to be enabled by the caller
   (though the fill-in and button can be) The selection list variable
   should not be enabled by the caller.

   The fill-in, list and button variables need to be included 
   in the FORM but only the fill-in need be given a position.

Author: Laura Stern

Date Created: 03/06/92 

----------------------------------------------------------------------------*/

assign
   /* see choose of button trigger for explanation of these 2 */
   CB_ETime = 0
   CB_JustLeftList = false

   CB_x = {&CBFill}:x in {&Frame}
   CB_y = {&CBFill}:y in {&Frame}
   CB_width  = {&CBFill}:width-pixels in {&Frame}
   CB_height = {&CBFill}:height-pixels in {&Frame}

   /* Position the button directly next to the fill-in field. */   
   {&CBBtn}:x in {&Frame} = CB_x + CB_width 
   {&CBBtn}:y in {&Frame} = CB_y
   
   /* Set sensitivity and visibility of widgets */
   {&CBList}:hidden in {&Frame} = yes
   {&CBBtn}:hidden  in {&Frame} = no
   {&CBFill}:sensitive in {&Frame} = yes
   {&CBBtn}:sensitive  in {&Frame} = yes
   {&CBList}:sensitive in {&Frame} = yes

   /* Position the list directly below the fill-in field and make
      sure it's width is the same.  Setting of the width is particularly
      important w/ a proportional spaced font where the list is sized
      differently than a fill-in unless you use view-as fill-in phrase 
      with size option and use size on list as well.
   */
   {&CBList}:x in {&Frame} = CB_x
   {&CBList}:y in {&Frame} = CB_y + CB_height
   {&CBList}:width-pixels in {&Frame} = CB_width 
   .

/* Initialize fill-in field */
if {&CBInit} <> "" then
   {&CBFill} = {&CBInit}.
else
   {&CBFill} = {&CBList}:entry(1) in {&Frame}.

/* For drop combos, the value of the fill must equal a value in the
   drop list.  If CBFill = ? that means there's nothing in the list
   yet, and caller is not ready to display anything yet.
*/
if {&CBFill} = ? then
   {&CBFill} = "".
else 
   /* Put fillin value in frame widget.  Don't use DISPLAY to avoid
      display of the frame - leave this up to caller to control.
   */
   assign
      {&CBFill}:screen-value in {&Frame} = {&CBFill}
      {&CBList}:screen-value in {&Frame} = {&CBFill}.

/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/*----------------------------------------------------------------------------

File: cbcdropx.i  (Combo Box Code Dropx)

Description:
   This file contains only the in-line code that controls an editable 
   drop-down combo box.

   A drop-down combo box is one that contains a fill-in field, a button 
   and a selection list where the list will drop down (become visible)
   or pull up (become invisible) when the button or the fill-in are clicked on.

   This variety of drop combo box will allow a value to be displayed 
   in the fill-in that is not in the drop down list.

Arguments:
   &Frame   - The name of the frame that the combo box appears in, 
      	      e.g., "frame foo".
   &CBFill  - The variable that is the fill-in field part of the
      	      combo box.
   &CBList  - The variable that is the selection list part of the
      	      combo box.
   &CBBtn   - The button that is the button component of the combo box.
      	      This should have been defined with IMAGE-UP FILE "adeicon/cbbtn".
   &CBInit  - The initial value of the combo box.  e.g., if the list
      	      values are known and they are "May","June","July", set
      	      this to ""June"" to have June be selected when the combo
      	      box is first displayed.  If this is set to the null
      	      string, the first item in the list is selected.

How to use this include file:
   This file should be included when you want to enable and position
   the combo box widgets - e.g. just before you are about to display 
   the frame.

   None of the combo box pieces need to be SENSITIVE by the caller
   (though the fill-in and button can be) The selection list variable
   should not be SENSITIVE by the caller.

   The fill-in, list and button variables need to be included 
   in the FORM but only the fill-in need be given a position.


Author: Laura Stern

Date Created: 07/29/92 

----------------------------------------------------------------------------*/



/*-------------------------Initialization code--------------------------*/

assign
   /* see CHOOSE of button trigger for explanation of these 2 */
   CB_ETime = 0
   CB_JustLeftList = false

   CB_x = {&CBFill}:x in {&Frame}
   CB_y = {&CBFill}:y in {&Frame}
   CB_width  = {&CBFill}:width-pixels in {&Frame}
   CB_height = {&CBFill}:height-pixels in {&Frame}
   
   /* Position the button directly next to the fill-in field. */   
   {&CBBtn}:x in {&Frame} = CB_x + CB_width 
   {&CBBtn}:y in {&Frame} = CB_y
   
   /* Set sensitivity and visibility of widgets */
   {&CBList}:hidden in {&Frame} = yes
   {&CBBtn}:hidden in {&Frame} = no
   {&CBFill}:sensitive in {&Frame} = yes
   {&CBBtn}:sensitive  in {&Frame} = yes
   {&CBList}:sensitive in {&Frame} = yes

   /* Position the list directly below the fill-in field and make
      sure it's width is the same.  Setting of the width is particularly
      important w/ a proportional spaced font where the list is sized
      differently than a fill-in unless you use view-as fill-in phrase 
      with size option and use size on list as well.
   */
   {&CBList}:x in {&Frame} = CB_x
   {&CBList}:y in {&Frame} = CB_y + CB_height
   {&CBList}:width-pixels in {&Frame} = CB_width
   .
   
if {&CBInit} <> "" then
   {&CBFill} = {&CBInit}.
else
   {&CBFill} = {&CBList}:entry(1) in {&Frame}.

/* Since this type of combo allows a fill-in value that's not in the
   list - avoid an error and don't do CHOOSE if the init value is
   not in there.
*/
if {&CBFill} = ? then {&CBFill} = "".
if ( {&CBFill} <> "" AND
     {&CBList}:lookup({&CBFill}) in {&Frame} <> 0) then
   {&CBList}:screen-value in {&Frame} = {&CBFill}.

/* Put fillin value in frame widget.  Don't use DISPLAY to avoid
   display of the frame - leave this up to caller to control.
*/
{&CBFill}:screen-value in {&Frame} = {&CBFill}.





/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/*----------------------------------------------------------------------------

File: cbcomm.i (Combo Box Common)

Description: This contains triggers and internal procedures that
   are common between the drop.i code and the dropx.i code.

Author: Laura Stern

Date Created: 06/07/92 

---------------------------------------------------------------------------*/


/*======================Internal Procedures=============================*/

&IF DEFINED(CB_PROCS) = 0 &THEN	 /* So procs aren't defined twice */
&global-define CB_PROCS	   1

/*------------------------------------------------------------------
   Move the cursor up or down in the select list.

   Input Parameters:
      move_down    - If true, move it cursor down, otherwise move it up.
      p_list       - The selection list widget handle.
      p_fill       - The fill-in widget handle.
      notify_widg  - The application widget to notify if list value
      	       	     changed.

------------------------------------------------------------------*/
Procedure CB_Move_Cursor:

   define input parameter move_down   as logical       NO-UNDO.
   define input parameter p_list      as widget-handle NO-UNDO.
   define input parameter p_fill      as widget-handle NO-UNDO.
   define input parameter notify_widg as widget-handle NO-UNDO.

   define var val  as char.
   define var ix   as integer.
   define var orig as integer.

   assign
      val = p_list:screen-value
      ix = p_list:lookup(val) 
      orig = ix.
   
   if move_down then do:
      if ix < p_list:num-items then 
      	 assign
	    ix = ix + 1
	    p_list:screen-value = p_list:entry(ix).
   end.
   else do:
      if ix > 1 then 
      	 assign
	    ix = ix - 1
	    p_list:screen-value = p_list:entry(ix).
   end.

   if ix <> orig then do:
      p_fill:screen-value = p_list:screen-value.

      /* Notify application of change */
      apply "U1" to notify_widg.
   end.
end.


/*---------------------------------------------------------
   Toggle the down state of the select list.

   Input Parameters:
      p_list - The selection list widget handle.
---------------------------------------------------------*/
Procedure CB_Toggle_List:

   define input parameter p_list as widget-handle NO-UNDO.

   define var stat as logical NO-UNDO.

   /* Toggle "down" state of list box. */
   if p_list:visible = yes then
      p_list:visible = no.
   else do:
      assign   
      	 p_list:visible = yes
      	 stat = p_list:move-to-top().

      /* Give list box focus so user can use the keyboard for selection */
      apply "entry" to p_list.
   end.
end.

&ENDIF


/*==============================Triggers================================*/

/*----- CURSOR DOWN of FILL -----*/
on CURSOR-DOWN of {&CBFill} in {&Frame}
do:
   /* Move down through select list even though user 
      can't see it. Fill-in will reflect the value. */
   run CB_Move_Cursor (INPUT true, 
      	       	       INPUT {&CBList}:HANDLE in {&Frame},
      	       	       INPUT {&CBFill}:HANDLE in {&Frame},
      	       	       INPUT {&CBList}:HANDLE in {&Frame}).
   return NO-APPLY.
end.


/*----- CURSOR UP of FILL -----*/
on CURSOR-UP of {&CBFill} in {&Frame}
do:
   /* Move up through select list even though user 
      can't see it. Fill-in will reflect the value. */
   run CB_Move_Cursor (INPUT false, 
      	       	       INPUT {&CBList}:HANDLE in {&Frame},
      	       	       INPUT {&CBFill}:HANDLE in {&Frame},
      	       	       INPUT {&CBList}:HANDLE in {&Frame}).
   return NO-APPLY.
end.


/*----- CHOOSE of LIST ITEM -----*/
on value-changed of {&CBList} in {&Frame}
do:
   /* Reflect selection in fill-in. */
   if SELF:screen-value = ? then
      display "" @ {&CBFill} with {&Frame}.
   else
      display SELF:screen-value @ {&CBFill} with {&Frame}.

   /* Hide the list and make sure it no longer has focus. */
   {&CBList}:visible in {&Frame} = no.
   apply "entry" to {&CBFill} in {&Frame}.

   /* Notify the application of the change. */
   apply "U1" to {&CBFill} in {&Frame}.
end.


/*----- DEFAULT-ACTION (Return) on SELECTION-LIST-----*/
on default-action of {&CBList} in {&Frame}
do:
   /* Note: the selection hasn't changed.  Just cause the list to
      pull up.  Normally double click will also generate the
      default-action event but the actions taken on single click 
      (value-changed) will prevent the double click from coming in.
      Even if it did - this code is still appropriate.
   */
   {&CBList}:visible in {&Frame} = no.
end.


/*----- ALT-UP or ALT-DOWN -----*/
on ALT-CURSOR-UP, ALT-CURSOR-DOWN of {&CBFill} in {&Frame}
   /* This is the keyboard way of Toggling "down" state of list box. */
   Run CB_Toggle_List (INPUT {&CBList}:HANDLE in {&Frame}).


/*----- ALT-UP or ALT-DOWN -----*/
on ALT-CURSOR-UP, ALT-CURSOR-DOWN of {&CBLIST} in {&Frame}
do:
   /* This is the keyboard way of Toggling "down" state of list box. */
   Run CB_Toggle_List (INPUT {&CBList}:HANDLE in {&Frame}).

   /* Without this, focus will move to the next widget, and in this 
      case, we want it to stay within the combo box.
   */
   apply "entry" to {&CBFill} in {&Frame}.
end.


/*----- CHOOSE of BUTTON -----*/
on choose of {&CBBtn} in {&Frame}
do:
   /* If we just left the list it is already pulled up, so just reset
      the flag.  See ENTER of BUTTON trigger for more explanation */
   if CB_JustLeftList then
      CB_JustLeftList = false.
   else
      /* Toggle "down" state of list box. */
      Run CB_Toggle_List (INPUT {&CBList}:HANDLE in {&Frame}).
end.


/*----- ENTER of BUTTON -----*/
on entry of {&CBBtn} in {&Frame}
do:
   define var e_time as integer NO-UNDO.

   /* If the list box is down and we hit the button, we want to pull
      the list up.  Clicking the button will also cause a leave event
      on the list.  In general on leave of list, due to tabbing off it
      for example, we pull it up. However, if the leave from the list box
      was because we hit the button, then the list box has been pulled up
      already and we don't want to drop it down again.  The only way we
      can know that this has happened is to compare elapsed time. 
      If less than x milliseconds has elapsed since the time we left the
      list and the time of this button entry event (when we click on the 
      button we get entry event first and then selection) then we know that
      the list leave was caused by the button click!
   */
   if CB_ETime <> 0 then
      e_time = ETIME(false) - CB_ETime.

   if (CB_ETime <> 0) AND (e_time < 80) then
      CB_JustLeftList = true.
   else 
      CB_JustLeftList = false.
end.


/*----- LEAVE of LIST ----- */
on leave of {&CBList} in {&Frame}
do:
   /* Pull up the list, and mark the time that this happened. */
   assign
      {&CBList}:visible in {&Frame} = no
      CB_ETime = ETIME(false).
end.


/*-------------------------------------------------------------
   We can't tell the difference between clicking on an item
   with the mouse and using the cursor keys to move down to the
   next item (they both generate value-changed event).  However,
   we want the behavior to be different in each case.  Using the
   cursors should not cause the list to hide. So we have to
   handle the cursor keys ourselves.
-------------------------------------------------------------*/

/*----- CURSOR DOWN of LIST ----*/
on cursor-down of {&CBList} in {&Frame}
do:
   run CB_Move_Cursor (INPUT true, 
      	       	       INPUT {&CBList}:HANDLE in {&Frame},
      	       	       INPUT {&CBFill}:HANDLE in {&Frame},
      	       	       INPUT {&CBFill}:HANDLE in {&Frame}).
   return no-apply.
end.


/*----- CURSOR UP of LIST ----*/
on cursor-up of {&CBList} in {&Frame}
do:
   run CB_Move_Cursor (INPUT false, 
      	       	       INPUT {&CBList}:HANDLE in {&Frame},
      	       	       INPUT {&CBFill}:HANDLE in {&Frame},
      	       	       INPUT {&CBFill}:HANDLE in {&Frame}).
   return no-apply.
end.


/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/*----------------------------------------------------------------------------

File: cbdown.i

Description:
   This file contains both in-line code and trigger code that 
   controls a down-always combo box.  A down-always combo box is one 
   that contains a fill-in field and a selection list where the
   list is always visible.

Arguments:
   &Frame   - The name of the frame that the combo box appears in, 
      	      e.g., "foo".
   &CBFill  - The variable that is the fill-in field part of the
      	      combo box.
   &CBList  - The variable that is the selection list part of the
      	      combo box.
   &CBInit  - The initial value of the combo box.  e.g., if the list
      	      values are known and they are "May","June","July", set
      	      this to ""June"" to have June be selected when the combo
      	      box is first displayed.  If this is set to the null
      	      string, the first item in the list is selected.

Events Generated:
   U1 may be sent to either the fill-in widget or the selection list
   widget when the selection list value has changed.  You must have a
   trigger on both in order to detect this correctly.

How to use this include file:
   This file should be included before the frame is made visible
   but after the FORM definition, if there is one.
   
   None of the combo box pieces need to be enabled by the caller
   but either of them can be.

   The fill-in and list variables need to be included in the
   FORM but only the fill-in needs to be given a position.


Author: Laura Stern

Date Created: 03/06/92 

----------------------------------------------------------------------------*/


/*------------------------------Triggers--------------------------------*/

/*----- LEAVE of FILL -----*/
on leave of {&CBFill} in {&Frame}
do:
   define var lst_val as char NO-UNDO.

   /* If the value entered in the fill-in prefix-matches a value in the
      select list, reset it's value to be the full selection list value. 
      Otherwise, we'll leave it alone. */
   lst_val = {&CBList}:screen-value in {&Frame}.
   if lst_val BEGINS SELF:screen-value then
      {&CBFill}:screen-value in {&Frame} = lst_val.
end.


/*----- ON ANY-PRINTABLE (ASCII) of FILL -----*/
on ANY-PRINTABLE of {&CBFill} in {&Frame}
do:
   define var fill_val  as char	    NO-UNDO. /* Fill-in value */
   define var curr_val  as char     NO-UNDO. /* Current value of select-list */
   define var lst_val   as char	    NO-UNDO. /* Value of a select list item */
   define var ix      	as integer  NO-UNDO. /* Loop index */
   define var start  	as integer  NO-UNDO. /* Index into select list */
   define var found     as logical  NO-UNDO. /* Did we find a prefix match? */

   curr_val = {&CBList}:screen-value in {&Frame}.
   if curr_val = ? then return.  /* return if list is empty. */

   /* See if we can find a prefix match between the fill-in value,
      including the character the user just typed, and a select list item.
      If there is no match then the selection is left as is.  Otherwise,
      the selection is changed.
      Add the key just typed to get the value to be matched. The last key
      typed won't be in the fill-in yet until we return from this trigger.
   */
   assign
      fill_val = (if SELF:AUTO-ZAP then CHR(LASTKEY) 
      	       	                   else SELF:screen-value + CHR(LASTKEY))
      found = false
      /* Start searching from the currently selected item */
      start = {&CBList}:lookup(curr_val) in {&Frame}.  

   do ix = start to {&CBList}:NUM-ITEMS in {&Frame} while NOT found:
      lst_val = {&CBList}:ENTRY(ix) in {&Frame}.
      if lst_val BEGINS fill_val then
         found = true.
   end.

   /* If we haven't found a match yet, wrap around to the top of the
      list and continue searching. */
   do ix = 1 to start - 1 while NOT found:
      lst_val = {&CBList}:ENTRY(ix) in {&Frame}.
      if lst_val BEGINS fill_val then
         found = true.
   end.

   if found then
   do:
      /* If we found a match other than the one already selected,
      	 set selection and make sure this item's in view.  Then notify
      	 application. 
      */
      if lst_val <> curr_val then
      do:
	 {&CBList}:screen-value in {&Frame} = lst_val.
	 run adecomm/_scroll.p (INPUT {&CBList}:HANDLE in {&Frame}, 
			       INPUT lst_val).
   
	 /* Notify application of selection change. Since I can't apply
	    an event to myself (the fill widget), apply to the list */
	 apply "U1" to {&CBList} in {&Frame}.
      end.
   end.
end.


/*----- SELECTION of LIST ITEM -----*/
on value-changed of {&CBList} in {&Frame}
do:
   /* Reflect selection in fill-in. */
   if SELF:screen-value = ? then
      {&CBFill}:screen-value in {&Frame} = "".
   else 
      {&CBFill}:screen-value in {&Frame} = SELF:screen-value.

   /* Notify application of selection change. Since I can't apply
      an event to myself (the fill widget), apply to the fill (make
      sure it's enabled first. */
   {&CBFill}:sensitive in {&Frame} = yes.
   apply "U1" to {&CBFill} in {&Frame}.
end.


/*----- ON ANY-PRINTABLE (ASCII) of SELECT LIST -----*/
/*----- Do 1st letter navigation (only Motif doesn't do it natively -----*/
&IF "{&WINDOW-SYSTEM}" = "OSF/Motif" &THEN 
on ANY-PRINTABLE of {&CBList} in {&Frame} 
do:
   Define var lst_val as char NO-UNDO.

   run adecomm/_lstnav.p (INPUT {&CBList}:HANDLE in {&Frame},
      	       	     	 OUTPUT lst_val).

   if lst_val <> ? then
   do:
      /* Show the matching item in the fill-in */
      {&CBFill}:screen-value in {&Frame} = lst_val.

      /* Notify application of selection change. Since I can't apply
	 an event to myself send it to the fill widget.
      */
      {&CBFill}:sensitive in {&Frame} = yes.
      apply "U1" to {&CBFill} in {&Frame}.
   end.
end.
&ENDIF


/*-------------------------Initialization code--------------------------*/

/* Position the list box just below the fill-in. */
CB_x = {&CBFill}:x in {&Frame}.
CB_y = {&CBFill}:y in {&Frame}.
CB_height = {&CBFill}:height-pixels in {&Frame}.

{&CBList}:x in {&Frame} = CB_x.
{&CBList}:y in {&Frame} = CB_y + CB_height.

/* Initialize the list value */
if {&CBInit} <> "" then
   {&CBFill} = {&CBInit}.
else
   if {&CBList}:NUM-ITEMS > 0 then {&CBFill} = {&CBList}:entry(1) in {&Frame}.
{&CBList}:screen-value in {&Frame} = {&CBFill}.

/* Put fillin value in frame widget.  Don't use DISPLAY to avoid
   display of the frame - leave this up to caller to control.
*/
{&CBFill}:screen-value in {&Frame} = {&CBFill}.

{&CBFill}:sensitive in {&Frame} = yes.
{&CBList}:sensitive in {&Frame} = yes.








/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/*----------------------------------------------------------------------------

File: cbdrop.i

Description:
   This file contains both in-line code and trigger code that 
   controls a drop-down combo box.

   A drop-down combo box is one that contains a fill-in field, a button 
   and a selection list where the list will drop down (become visible)
   or pull up (become invisible) when the button or the fill-in are clicked on.

   This variety of drop combo box will not allow any value to be displayed 
   in the fill-in that is not in the drop down list.

Arguments:
   &Frame   - The name of the frame that the combo box appears in, 
      	      e.g., "frame foo".
   &CBFill  - The variable that is the fill-in field part of the
      	      combo box.
   &CBList  - The variable that is the selection list part of the
      	      combo box.
   &CBBtn   - The button that is the button component of the combo box.
      	      This should have been defined with IMAGE-UP FILE "adeicon/cbbtn".
   &CBInit  - The initial value of the combo box.  e.g., if the list
      	      values are known and they are "May","June","July", set
      	      this to ""June"" to have June be selected when the combo
      	      box is first displayed.  If this is set to the null
      	      string, the first item in the list is selected.

Events Generated:
   U1 may be sent to either the fill-in widget or the selection list
   widget when the selection list value has changed.  You must have a
   trigger on both in order to detect this correctly.

How to use this include file:
   This file should be included before the frame is made visible
   but after the FORM definition, if there is one. 
   
   None of the combo box pieces need to be ENABLEd by the caller
   (though the fill-in and button can be) The selection list variable
   should not be ENABLEd by the caller.

   The fill-in, list and button variables need to be included 
   in the FORM but only the fill-in need be given a position.


Author: Laura Stern

Date Created: 03/06/92 

----------------------------------------------------------------------------*/

/* triggers */
{adecomm/cbtdrop.i &Frame  = "{&Frame}"
      	       	   &CBFill = "{&CBFill}"
		   &CBList = "{&CBList}"
		   &CBBtn  = "{&CBBtn}"
		   &CBInit = "{&CBInit}"}


/* Initialization code */
{adecomm/cbcdrop.i &Frame  = "{&Frame}"
      	       	   &CBFill = "{&CBFill}"
		   &CBList = "{&CBList}"
		   &CBBtn  = "{&CBBtn}"
		   &CBInit = "{&CBInit}"}



/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/*----------------------------------------------------------------------------

File: cbdropx.i

Description:
   This file contains both in-line code and trigger code that 
   controls an editable drop-down combo box.

   A drop-down combo box is one that contains a fill-in field, a button 
   and a selection list where the list will drop down (become visible)
   or pull up (become invisible) when the button or the fill-in are clicked on.

   This variety of drop combo box will allow a value to be displayed 
   in the fill-in that is not in the drop down list.

Arguments:
   &Frame   - The name of the frame that the combo box appears in, 
      	      e.g., "frame foo".
   &CBFill  - The variable that is the fill-in field part of the
      	      combo box.
   &CBList  - The variable that is the selection list part of the
      	      combo box.
   &CBBtn   - The button that is the button component of the combo box.
      	      This should have been defined with IMAGE-UP FILE "adeicon/cbbtn".
   &CBInit  - The initial value of the combo box.  e.g., if the list
      	      values are known and they are "May","June","July", set
      	      this to ""June"" to have June be selected when the combo
      	      box is first displayed.  If this is set to the null
      	      string, the first item in the list is selected.

Events Generated:
   U1 may be sent to either the fill-in widget or the selection list
   widget when the selection list value has changed.  You must have a
   trigger on both in order to detect this correctly.

How to use this include file:
   This file should be included before the frame is made visible
   but after the FORM definition, if there is one. 
   
   None of the combo box pieces need to be ENABLEd by the caller
   (though the fill-in and button can be) The selection list variable
   should not be ENABLEd by the caller.

   The fill-in, list and button variables need to be included 
   in the FORM but only the fill-in need be given a position.


Author: Laura Stern

Date Created: 07/29/92 

----------------------------------------------------------------------------*/


/* triggers */
{adecomm/cbtdropx.i &Frame  = "{&Frame}"
      	       	    &CBFill = "{&CBFill}"
		    &CBList = "{&CBList}"
		    &CBBtn  = "{&CBBtn}"
		    &CBInit = "{&CBInit}"}


/* Initialization code */
{adecomm/cbcdropx.i &Frame  = "{&Frame}"
      	       	    &CBFill = "{&CBFill}"
		    &CBList = "{&CBList}"
		    &CBBtn  = "{&CBBtn}"
		    &CBInit = "{&CBInit}"}


/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/*----------------------------------------------------------------------------

File: cbtdrop.i (Combo Box Triggers Drop)

Description:
   This file contains only the trigger code controls a drop-down combo box.

   A drop-down combo box is one that contains a fill-in field, a button 
   and a selection list where the list will drop down (become visible)
   or pull up (become invisible) when the button or the fill-in are clicked on.

   This variety of drop combo box will not allow any value to be displayed 
   in the fill-in that is not in the drop down list.

Arguments:
   &Frame   - The name of the frame that the combo box appears in, 
      	      e.g., "frame foo".
   &CBFill  - The variable that is the fill-in field part of the
      	      combo box.
   &CBList  - The variable that is the selection list part of the
      	      combo box.
   &CBBtn   - The button that is the button component of the combo box.
      	      This should have been defined with IMAGE-UP FILE "adeicon/cbbtn".
   &CBInit  - The initial value of the combo box.  e.g., if the list
      	      values are known and they are "May","June","July", set
      	      this to ""June"" to have June be selected when the combo
      	      box is first displayed.  If this is set to the null
      	      string, the first item in the list is selected.

Events Generated:
   U1 may be sent to either the fill-in widget or the selection list
   widget when the selection list value has changed.  You must have a
   trigger on both in order to detect this correctly.

How to use this include file:
   This file should be included any time after the FORM definition but
   before the frame is enabled.
   
   None of the combo box pieces need to be enabled by the caller
   (though the fill-in and button can be) The selection list variable
   should not be enabled by the caller.

   The fill-in, list and button variables need to be included 
   in the FORM but only the fill-in need be given a position.

Author: Laura Stern

Date Created: 03/06/92 

----------------------------------------------------------------------------*/

/* triggers and internal procedures common between this and
   cbtdropx.i (most of the code is in here).
*/
{adecomm/cbcomm.i
   &Frame  = "{&Frame}"
   &CBFill = "{&CBFill}"
   &CBList = "{&CBList}"
   &CBBtn  = "{&CBBtn}"
}


/*==============================Triggers================================*/

/*----- ON BACKSPACE, DELETE of FILL -----*/

on BACKSPACE, DEL, SHIFT-BACKSPACE, 
   CTRL-BACKSPACE, CTRL-DEL of {&CBFill} in {&Frame}
   /* Prevent any modification of fill-in value */
   return NO-APPLY.


/*----- ON ANY-PRINTABLE (ASCII) of FILL -----*/
on ANY-PRINTABLE of {&CBFill} in {&Frame}, {&CBList} in {&Frame} 
do:
   Define var lst_val as char NO-UNDO.

   run adecomm/_lstnav.p (INPUT {&CBList}:HANDLE in {&Frame},
      	       	     	 OUTPUT lst_val).

   if lst_val <> ? then
   do:
      /* Show the matching item in the fill-in */
      {&CBFill}:screen-value in {&Frame} = lst_val.

      /* Notify application of selection change. Since I can't apply
	 an event to myself send it to whatever the other widget is.
      */
      if SELF:type = "SELECTION-LIST" then
      	 apply "U1" to {&CBFill} in {&Frame}.
      else
      	 apply "U1" to {&CBList} in {&Frame}.
   end.

   /* Prevent the last character typed from appearing in the fill-in. 
      The only thing that should change the fill-in value is finding
      a match. */
   return NO-APPLY.
end.


/*----- MOUSE-DOWN on FILL -----*/
on "MOUSE-SELECT-DOWN" of {&CBFill} in {&Frame}
   run CB_Toggle_List (INPUT {&CBList}:HANDLE in {&Frame}).


/*----- MOUSE-UP on FILL -----*/
on "MOUSE-SELECT-UP" of {&CBFill} in {&Frame}
do:
   /* Prevent focus from moving to fill if the list box is down since
      we want the list box to have focus. */
   if {&CBList}:visible in {&Frame} = yes then
      return NO-APPLY.
   else
      return.
end.





/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/*----------------------------------------------------------------------------

File: cbtdropx.i (Combo Box Triggers Dropx)

Description:
   This file contains only the trigger code controls an editable drop-down 
   combo box.

   A drop-down combo box is one that contains a fill-in field, a button 
   and a selection list where the list will drop down (become visible)
   or pull up (become invisible) when the button or the fill-in are clicked on.

   This variety of drop combo box will allow a value to be displayed 
   in the fill-in that is not in the drop down list.

Arguments:
   &Frame   - The name of the frame that the combo box appears in, 
      	      e.g., "frame foo".
   &CBFill  - The variable that is the fill-in field part of the
      	      combo box.
   &CBList  - The variable that is the selection list part of the
      	      combo box.
   &CBBtn   - The button that is the button component of the combo box.
      	      This should have been defined with IMAGE-UP FILE "adeicon/cbbtn".
   &CBInit  - The initial value of the combo box.  e.g., if the list
      	      values are known and they are "May","June","July", set
      	      this to ""June"" to have June be selected when the combo
      	      box is first displayed.  If this is set to the null
      	      string, the first item in the list is selected.

Events Generated:
   U1 may be sent to either the fill-in widget or the selection list
   widget when the selection list value has changed.  You must have a
   trigger on both in order to detect this correctly.

How to use this include file:
   This file should be included before the frame is made visible
   but after the FORM definition, if there is one. 
   
   None of the combo box pieces need to be SENSITIVE by the caller
   (though the fill-in and button can be) The selection list variable
   should not be SENSITIVE by the caller.

   The fill-in, list and button variables need to be included 
   in the FORM but only the fill-in need be given a position.

Author: Laura Stern

Date Created: 07/29/92 

----------------------------------------------------------------------------*/

/* triggers and internal procedures common between this and
   cbtdropx.i (most of the code is in here).
*/
{adecomm/cbcomm.i
   &Frame  = "{&Frame}"
   &CBFill = "{&CBFill}"
   &CBList = "{&CBList}"
   &CBBtn  = "{&CBBtn}"
}


/*==============================Triggers================================*/

/*----- LEAVE of FILL -----*/
on leave of {&CBFill} in {&Frame}
do:
   if SELF:screen-value <> "" then 
   do:
      /* If the fill-in value matches an item in the list, set 
      	 selection to that list item and make sure it will be
      	 in view then next time the list is dropped down. */
      if {&CBList}:lookup(SELF:screen-value) in {&Frame} <> 0 then
      do:
      	 {&CBList}:screen-value in {&Frame} = SELF:screen-value.
      	 run adecomm/_scroll.p (INPUT {&CBList}:HANDLE in {&Frame},
			       INPUT SELF:screen-value).
      end.
   end.

   /* Notify the application of the change (even when it's blank). */
   apply "U1" to {&CBList} in {&Frame}.
end.

/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/*----------------------------------------------------------------------------

File: cbvar.i

Description:
   These variables are used to control the positioning of combo box
   components.

Author: Laura Stern

Date Created: 03/06/92 

----------------------------------------------------------------------------*/

Define {1} var CB_ETime	       as integer NO-UNDO.
Define {1} var CB_JustLeftList as logical NO-UNDO.

Define {1} var CB_x       as integer NO-UNDO.
Define {1} var CB_y	  as integer NO-UNDO.
Define {1} var CB_width   as integer NO-UNDO.
Define {1} var CB_height  as integer NO-UNDO.

/***********************************************************************
* Copyright (C) 2005,2006,2009 by Progress Software Corporation. All rights *
* reserved.  Prior versions of this work may contain portions          *
* contributed by participants of Possenet.                             *
*                                                                      *
***********************************************************************/

/* commeng.i */


/* This include file defines the help context strings that 
   PROGRESS tools use to display help topics from the 
   COMMxxx.HLP file. 
   
   Please contact Documentation to make changes to this file. 
   Thanks. 
*/

/*
   The form used in this file is:

	   <Name of the Help Topic>
	   &Global-define <context-string> <context-number>

*/


/* ON HELP in the Create Database dialog box */
&Global-define Create_Database 49153

/* ON HELP in the Connect Database dialog box */
&Global-define Connect_Database 49154

/* ON HELP in the Detailed Table Report dialog box */
&Global-define Detailed_Table_Report 49155

/* ON HELP in the Quick Table Report dialog box */
&Global-define Quick_Table_Report 49156

/* ON HELP in the Quick Field Report dialog box */
&Global-define Quick_Field_Report 49157

/* ON HELP in the Quick Index Report dialog box */
&Global-define Quick_Index_Report 49158

/* ON HELP in the SQL View Report dialog box */
&Global-define SQL_View_Report 49159

/* ON HELP in the Sequence Report dialog box */
&Global-define Sequence_Report 49160

/* ON HELP in the Trigger Report dialog box */
&Global-define Trigger_Report 49161

/* ON HELP in the User Report dialog box */
&Global-define User_Report 49162

/* ON HELP in the Table Relations Report dialog box */
&Global-define Table_Relations_Report 49163

/* ON HELP in the Storage Areas Report dialog box */
&Global-define Quick_Storage_Area_Report 15

/* ON HELP in the Report Options dialog box */
&Global-define Report_Options 49164

/* ON HELP in the Print Options dialog box */
&Global-define Print_Options 49165

/* ON HELP in the Menu Accelerators dialog box */
&Global-define Menu_Accelerators 49166

/* ON HELP in the Record Menu Accelerators dialog box */
&Global-define Record_Menu_Accelerators 49167

/* ON HELP in the Field Selection dialog box */
&Global-define Field_Selection 49168

/* ON HELP in the Table Selection dialog box */
&Global-define Table_Selection 49169

/* ON HELP in the Multi Field Selection dialog box */
&Global-define Multi_Field_Selection 49170

/* ON HELP in the Font dialog box */
&Global-define Font_Dlg_Box 49171

/* ON HELP in the Color dialog box */
&Global-define Color_Dlg_Box 49172

	/* Moved to UIB Help */
	/* ON HELP in the Query Properties dialog box */
	/* &Global-define Query_Properties 49173 */

	/* ON HELP in the Build WHERE Clause dialog box */
	/* &Global-define Build_WHERE_Clause 49174 */

	/* ON HELP in the Join Builder dialog box */
	/* &Global-define Join_Builder 49175 */

/* ON HELP in the Enter Constant Range dialog box */
&Global-define Enter_Constant_Range 49176

/* ON HELP in the Enter Constant Date dialog box */
&Global-define Enter_Constant_Date 49177

/* ON HELP in the Enter Constant Number dialog box */
&Global-define Enter_Constant_Number 49178

/* ON HELP in the Enter Constant String dialog box */
&Global-define Enter_Constant_String 49179

/* ON HELP in the Enter Constant Logical dialog box */
&Global-define Enter_Constant_Logical 49180

/* ON HELP in the Enter Constants List dialog box */
&Global-define Enter_Constants_List 49181

/* ON CHOOSE of Help->Messages */
&Global-define Messages_Dlg_Box 49182

/* ON CHOOSE of Help->Recent Messages */
&Global-define Recent_Msgs_Dlg_Box 49183

/* ON CHOOSE of Help->Keyboard */
&Global-define Editor_Keys_Dlg_Box 49184

/* ON HELP in the PROGRESS Runtime Key Bindings dialog box */
&Global-define Runtime_Keys_Dlg_Box 49185

/* ON HELP in the Find dialog box */
&Global-define Find_Dialog_Box 49186

/* ON HELP in the Replace dialog box */
&Global-define Replace_Dialog_Box 49187

/* ON HELP in the GoTo-Line dialog box */
&Global-define Goto_Line_Dialog_Box 49188

/* ON HELP in Field String Attributes dialog box--Char and GUI dictionaries */
&Global-define Field_String_Attributes_Dlg_Box 49189

/* ON HELP in the Session Information dialog box--Admin - via report code */
&Global-define Session_Information_Dlg_Box 49190

/* ON HELP in the Choose Index dialog box */
&Global-define Choose_Index_Dlg_Box 49191

/* ON HELP in the File Open dialog boxes (character only) */
&Global-define Chr_Get_File_Dlg_Box 49192

/* ON HELP in the Open dialog box (character only) */
&Global-define Chr_Open_Dlg_Box 49193

/* ON HELP in the Login window */
&Global-define Login_Window 49194

/* ON HELP in the Numeric Format Date dialog box */
&Global-define Numeric_Format_Date_Dlg_Box 49195

/* ON HELP in the Numeric Format Logical dialog box */
&Global-define Numeric_Format_Logical_Dlg_Box 49196

/* ON HELP in the Numeric Format Number dialog box */
&Global-define Numeric_Format_Number_Dlg_Box 49197

/* ON HELP in the Numeric Format Char dialog box */
&Global-define Numeric_Format_Char_Dlg_Box 49198

/* ON HELP in the Save As dialog box (character only) */
&Global-define Chr_Save_As_Dlg_Box 49199

/* ON HELP in Inventory -- Open Orders by Customer dialog box (Test Drive only) */
&GLOBAL-DEFINE Inventory_Open_Orders_Rpt 49200

/* ON HELP in Inventory -- Item Listing dialog box (Test Drive only) */
&GLOBAL-DEFINE Inventory_Item_Listing_Rpt 49201

/* ON HELP in Inventory -- Customer Data dialog box (Test Drive only) */
&GLOBAL-DEFINE Customer_Information_Rpt 49202

/* ON HELP in Configuration Information dialog box (for showcfg.exe only) */
&GLOBAL-DEFINE Config_Info_Dlg_Box 49203

/* Moved from DICTENG*/
/* ON HELP in View-As Phrase dialog box */
&GLOBAL-DEFINE View_as_Phrase_Dlg_Box 49204

/* New for 7.3A */
/* ON HELP in Find File dialog box.  There are 3 variations on
   this. 
      Find File -- Just shows TEXT
      Find Template -- Shows TEXT or CODE
      Find Image -- Just shows IMAGE */
&GLOBAL-DEFINE Find_File_Dlg_Box 49205
&GLOBAL-DEFINE Find_Template_Dlg_Box 49205
&GLOBAL-DEFINE Find_Image_Dlg_Box 49205

/* ON HELP in Edit Path dialog box */
&GLOBAL-DEFINE Edit_Path_Dlg_Box 49206

/* ON HELP in Calculated Fields Editor dialog box */
&GLOBAL-DEFINE Calc_Field_Dlg_Box 49207

/* ON HELP-->Contents from Procedure Window */
&GLOBAL-DEFINE Procedure_Window_Contents 49208

/* ON HELP in Procedure Window */
&GLOBAL-DEFINE Procedure_Window_Help 49209

/* ON HELP-->Menu Commands from Procedure Window */
&GLOBAL-DEFINE Procedure_Window_Menu_Commands 49210

/* THREE CONTEXT IDs FOR COMPILER MESSAGE WINDOW--FOR THE FUTURE....*/
/* ON HELP-->Contents from Compiler Message Window */
/* &GLOBAL-DEFINE Compiler_Message_Window_Contents 49211 */

/* ON HELP in Compiler Message Window */
/* &GLOBAL-DEFINE Compiler_Message_Window_Help 49212 */

/* ON HELP-->Menu Commands from Compiler Message Window */
/* &GLOBAL-DEFINE Compiler_Message_Window_Menu_Commands 49213 */

/* ON HELP in the Record Layout dialog box */
&GLOBAL-DEFINE Record_Layout_Dlg_Box 49214

/* Moved from uibeng for 7.3A */
/* ON HELP in the Enter Query-By-Words String dialog box */
&GLOBAL-DEFINE Enter_Query_By_Dlg_Box 49215

/* ON HELP in the Add Directory to Path dialog box */
&GLOBAL-DEFINE Add_Dir_Path_Dlg_Box 49216

/* Help How To topic (called from Proc Window Help menu) */
&GLOBAL-DEFINE Proc_Win_How_To 49217

/*New for 8.0a */
&GLOBAL-DEFINE Choose_VBX_Controls_Dlg_Box 49287
&GLOBAL-DEFINE Choose_SmartObject_Dlg_Box 49288

/* New for 9.0A */

/* Multi-Field mapping dialog (adecomm/_mfldmap.p) */
&GLOBAL-DEFINE Multi_Field_DB 49354

/*New Report Data Width */
&GLOBAL-DEFINE Verify_Data_Width_Report_Dialog_Box 62

/* New for 10.0B */

/* ON HELP in the Numeric Format DateTime dialog box */
&Global-define Numeric_Format_DateTime_Dlg_Box 63

/* ON HELP in the Numeric Format DateTime dialog box */
&Global-define Numeric_Format_DateTimeTz_Dlg_Box 64

/* New for 10.1A */   
/* Custom Audit Data Filter Report Dialog box */
&GLOBAL-DEFINE Custom_Audit_Data_Filter_Report_Dialog_Box 35

/* OpenEdge Auditing Reports Dialog Box */
&GLOBAL-DEFINE Date_Range_Auditing_Reports_Dialog_Box 36

/* OpenEdge Auditing Report Options Dialog Box */
&GLOBAL-DEFINE OpenEdge_Auditing_Report_Options_dialog_box  65

/* New for 10.1B */

/* View-as property dialog for browse columns view-as attribute */
&GLOBAL-DEFINE Viewas_Attribute_Dialog_Box 71000

/* New for 10.2B */

/* Encryption Policies Detailed Report */
&GLOBAL-DEFINE Detailed_Encryption_Policy_Report_Dialog_Box 66

/* Alternate Buffer Pool Quick Report */
&GLOBAL-DEFINE Quick_Alternate_Buffer_Pool_Report 67

/* Encryption Policies Quick Report */
&GLOBAL-DEFINE Quick_Encryption_Policy_Report_Dialog_Box 68
/*********************************************************************
* Copyright (C) 2005 by Progress Software Corporation. All rights    *
* reserved.  Prior versions of this work may contain portions        *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/
/*------------------------------------------------------------------------
  File: convcp.p
  
  Description:       MIME-to-Progress code page translation
  Input Parameters:  MIME code page, defined by IANA
  Output Parameters: Progress code page equivalent, else input parameter pcFromPage
                     (which means that name was not on the list)
  Notes:             Code page list is accurate as of 7 February 2001.
  
  Updated: 10/01/2001 swatt@progress.com
             Intial version
           10/01/2001 adams@progress.com
             Adapted for POSSE coding standards
           07/09/04  Changed it to return input parameter if name not on the list. 
             
------------------------------------------------------------------------*/
DEFINE INPUT  PARAMETER pcFromPage AS CHARACTER  NO-UNDO.
DEFINE INPUT  PARAMETER pcAction   AS CHARACTER  NO-UNDO.
DEFINE OUTPUT PARAMETER pcCodePage AS CHARACTER  NO-UNDO.

DEFINE VARIABLE cMimeList AS CHARACTER  NO-UNDO INITIAL
"windows-1250,windows-1251,windows-1252,windows-1253,windows-1254,windows-1255,windows-1256,windows-1257,windows-1258,TIS-620,Big5,EUC-JP,GB_2312-80,IBM037,IBM273,IBM277,IBM278,IBM284,IBM297,IBM437,IBM500,IBM850,IBM851,IBM852,IBM857,IBM00858,IBM861,IBM862,IBM866,ISO-8859-1,ISO-8859-10,ISO-8859-15,ISO-8859-2,ISO-8859-3,ISO-8859-4,ISO-8859-5,ISO-8859-6,ISO-8859-7,ISO-8859-8,ISO-8859-9,KOI8-R,KS_C_5601-1987,hp-roman8,Shift_JIS,UTF-8,GB18030,GBK":U.
DEFINE VARIABLE cProgList AS CHARACTER  NO-UNDO INITIAL
"1250,1251,1252,1253,1254,1255,1256,1257,1258,620-2533,BIG-5,EUCJIS,GB2312,IBM037,IBM273,IBM277,IBM278,IBM284,IBM297,IBM437,IBM500,IBM850,IBM851,IBM852,IBM857,IBM858,IBM861,IBM862,IBM866,ISO8859-1,ISO8859-10,ISO8859-15,ISO8859-2,ISO8859-3,ISO8859-4,ISO8859-5,ISO8859-6,ISO8859-7,ISO8859-8,ISO8859-9,KOI8-R,KSC5601,ROMAN-8,SHIFT-JIS,UTF-8,GB18030,CP936":U.

CASE pcAction:
  /* Progress-to-MIME conversion */
  WHEN "toMime":U THEN DO:
    IF pcFromPage = ? THEN
      /* Return the entire MIME codepage list */
      ASSIGN pcCodePage = cMimeList.
    ELSE DO:
      /* Return the desired MIME codepage equivalent */
      ASSIGN  
        pcCodePage = ENTRY(1 + LOOKUP(pcFromPage, cProgList), pcFromPage + "," + cMimeList).
    END.
  END.
  /* MIME-to-Progress conversion */
  WHEN "toProg":U   THEN DO:
    IF pcFromPage = ? THEN
      /* Return the entire Progress codepage list */
      ASSIGN pcCodePage = cProgList.
    ELSE DO:
      /* Return the desired Progress codepage equivalent */
      ASSIGN  
        pcCodePage = ENTRY(1 + LOOKUP(pcFromPage, cMimeList), pcFromPage + "," + cProgList).
    END.
  END.
END CASE.

/* convcp.p - end of file */
/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/*--------------------------------------------------------------------------
  dedit.i
  Edit Defines for Editor
--------------------------------------------------------------------------*/

/* Tool should set these to their tool name to adhere to
   application style standards.
*/
DEFINE VARIABLE Edit_Error_Title     AS CHAR INIT "Error"   NO-UNDO.
DEFINE VARIABLE Edit_Selection_Start AS INTEGER INIT ? NO-UNDO.
DEFINE VARIABLE Edit_Selection_End   AS INTEGER INIT ? NO-UNDO.

/* Support for Insert Fields */
DEFINE VARIABLE Ed_Schema_Prefix   AS INTEGER   NO-UNDO.
DEFINE VARIABLE Ed_Schema_Database AS CHARACTER NO-UNDO.
DEFINE VARIABLE Ed_Schema_Table    AS CHARACTER NO-UNDO.

&IF DEFINED(ED_POPUP) <> 0 &THEN
/* Editor Popup Menu Definitions                                        */
DEFINE SUB-MENU m_Insert_Menu 
    &IF {&ED_POPUP} = "SE_POPUP" &THEN
       MENU-ITEM m_DB_Fields    LABEL "&Database Fields..."
       MENU-ITEM m_Event_Name   LABEL "&Event Name..."
       MENU-ITEM m_Procedure_Call LABEL "Procedure &Call..."
       MENU-ITEM m_Preprocessor_Name LABEL "&Preprocessor Name..."
       MENU-ITEM m_Query        LABEL "&Query..."     
       MENU-ITEM m_Object_Name  LABEL "&Object Name..."
       RULE
       MENU-ITEM m_File_Contents LABEL "&File Contents..."
       MENU-ITEM m_File_Name    LABEL "File &Name..." .
    &ELSE
       MENU-ITEM m_DB_Fields     LABEL "&Database Fields..."
       MENU-ITEM m_File_Contents LABEL "&File Contents...".
    &ENDIF

DEFINE SUB-MENU m_Format_Menu 
       MENU-ITEM m_Indent       LABEL "&Indent"       
       MENU-ITEM m_UnIndent     LABEL "&Unindent"
       MENU-ITEM m_Comment      LABEL "&Comment"      
       MENU-ITEM m_UnComment    LABEL "Unc&omment"  .

DEFINE MENU mnu_EdPopup
    &IF {&ED_POPUP} = "PE_POPUP" &THEN
       MENU-ITEM m_Run          LABEL "&Run"
    &ENDIF
       MENU-ITEM m_Check_Syntax LABEL "Chec&k Syntax"
       SUB-MENU  m_Insert_Menu  LABEL "&Insert"       
       SUB-MENU  m_Format_Menu  LABEL "&Format Selection"
       RULE
       MENU-ITEM m_Cut          LABEL "Cu&t"
       MENU-ITEM m_Copy         LABEL "&Copy"
       MENU-ITEM m_Paste        LABEL "&Paste"
       RULE
       MENU-ITEM m_Keyword_Help LABEL "Key&word Help"
       .
       
PROCEDURE EdPopupDrop.
/*---------------------------------------------------------------------------
    Syntax     RUN EdPopupDrop ( INPUT p_Editor ) .
   
    Purpose    On the MENU-DROP event for the Editor Popup Menu,
               set the enable/disable state of the Edit Menu selections. 
    
    Remarks    The p_Editor widget is presumed to be of :TYPE = "EDITOR".
    
    Return Values  NONE.
---------------------------------------------------------------------------*/
  DEFINE INPUT PARAMETER p_Editor AS HANDLE NO-UNDO.
  
    /* Works well under MS-WINDOWS only. */
    DEFINE VAR Read_Only        AS LOGICAL NO-UNDO.
    DEFINE VAR Text_Is_Selected AS LOGICAL NO-UNDO.

    ASSIGN
        Read_Only        = p_Editor:READ-ONLY
        Text_Is_Selected = p_Editor:TEXT-SELECTED
       
        SUB-MENU  m_Insert_Menu:SENSITIVE = (NOT Read_Only)

        SUB-MENU  m_Format_Menu:SENSITIVE = /* TRUE IF... */
                        ( NOT Read_Only ) AND ( Text_Is_Selected )
        
        MENU-ITEM m_Cut:SENSITIVE IN MENU mnu_EdPopup  = /* TRUE IF... */
                        ( NOT Read_Only ) AND ( Text_Is_Selected )

        MENU-ITEM m_Copy:SENSITIVE IN MENU mnu_EdPopup = /* TRUE IF...*/
                        ( Text_Is_Selected  )
                            
        MENU-ITEM m_Paste:SENSITIVE IN MENU mnu_EdPopup = /* TRUE IF... */
                        ( p_Editor:EDIT-CAN-PASTE ) AND ( NOT Read_Only )
        
        MENU-ITEM m_Check_Syntax:SENSITIVE IN MENU mnu_EdPopup = /* TRUE IF...*/
                        ( NOT Read_Only )
    . /* END ASSIGN. */

END PROCEDURE.

&ENDIF
/*********************************************************************
* Copyright (C) 2011 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/*----------------------------------------------------------------------------

File: deltable.i

Description:
   Delete a file (i.e., table) definition and all associated indexes,
   fields and triggers.

Argument: 
   {&alias} - alias for the database containing the file to delete - of
      	      the form "DB."  The argument may be omitted if working on 
      	      the current database.
 
Author: Tony Lavinio (annotated by Laura Stern)

Date Created: 02/24/92 

----------------------------------------------------------------------------*/

FOR EACH {&alias}_Constraint OF {&alias}_File:
  FOR EACH {&alias}_Constraint-Keys WHERE recid({&alias}_Constraint) = {&alias}_Constraint-Keys._con-recid:
    DELETE {&alias}_Constraint-Keys.
  END.
  DELETE {&alias}_Constraint.
END.
FOR EACH {&alias}_Index OF {&alias}_File:
  FOR EACH {&alias}_Index-field OF {&alias}_Index:
    DELETE {&alias}_Index-field.
  END.
  DELETE {&alias}_Index.
END.
FOR EACH {&alias}_File-trig OF {&alias}_File:
  DELETE {&alias}_File-trig.
END.
FOR EACH {&alias}_Field OF {&alias}_File:
  FOR EACH {&alias}_Field-trig OF {&alias}_Field:
    DELETE {&alias}_Field-trig.
  END.
  DELETE {&alias}_Field.
END.
FOR EACH {&alias}_Partition-Set WHERE {&alias}_Partition-Set._Object-number = {&alias}_File._File-Num:
  FOR EACH {&alias}_Partition-Set-Detail OF {&alias}_Partition-Set:
    DELETE {&alias}_Partition-Set-Detail.
  END.
  DELETE {&alias}_Partition-Set.
END.

DELETE {&alias}_File.
/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/*----------------------------------------------------------------------------

File: dfldlist.i

Description: 
   This is the piece of code that actually does the work for _getdlst.p - 
   to fill up a selection list with field names.  It is in a .i so that 
   we can avoid the overhead of calling an internal procedure for each field.
   This overhead adds up when you are dealing with very large databases.
Author: SLK Stern, Warren Bare Greg O'Connor
Date Created: 02/98
Copied from fldlist.i
-----------------------------------------------------------------------------*/


ASSIGN v_BldLine = "":U.
DO v_ItemCnt = 1 to LENGTH(p_Items,"CHARACTER":u):
    CASE SUBSTRING(p_Items,v_ItemCnt,1,"CHARACTER":u):
      WHEN "T" THEN v_BldLine = v_BldLine + STRING(sdoData.fTable,"x(9)":U).
      WHEN "F" THEN v_BldLine = v_BldLine + STRING(sdoData.fFormat,"x(15)":u).
      WHEN "1" THEN v_BldLine = v_BldLine + STRING(sdoData.fName,"x(32)":u).
      WHEN "2" THEN v_BldLine = v_BldLine + STRING(sdoData.fTable + "." + sdoData.fName,"x(64)":u).
      WHEN "3" THEN v_BldLine = v_BldLine + STRING(sdoData.fName,"x(70)":u).
    END CASE.
END.

DO i = 1 to NUM-ENTRIES(v_BldLine):
   err = p_List:ADD-LAST(ENTRY(i,TRIM(v_BLdLine))).
END.
/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/
/*
 * DIRSRCH.I
 *
 * This is the header for dirsrch.dll.  For quick and dirty directory 
 * searches.
 *
 * PROCEDURE NAME:  dir_search_dll
 *     PARAMETERS:  search-dir  :  Directory to search in, can be relative, use /../../, etc.
 *                  file-spec   :  comma delimited list of file types, can have trailing comma
 *                                 e.g: " foo?ar.*  ,  *.p, "
 *                  file-list   :  A MEMPTR *PRE-ALLOCATED* to hold the comma delimited list
 *                  list-size   :  Num bytes allocated to the file-list.  Don't exceed 32K.
 *                  miss-count  :  Returned as the number of files that didn't fit in the list.
 *                  error-val   :  0 if there were no errors.
 *                                 1- file list buffer is too small
 *                                 2- file list buffer is too big
 *                                 3- invalid path given
 *                                 4- drive is invaild
 *                                 5- directory on drive is invaild
 *                                 6- malloc failed (yeow!)
 */
 
PROCEDURE file_search EXTERNAL "dirsrch.dll":
 DEFINE INPUT        PARAMETER Search-Dir   AS HANDLE TO CHARACTER.
 DEFINE INPUT        PARAMETER File-Spec    AS HANDLE TO CHARACTER.
 DEFINE INPUT-OUTPUT PARAMETER File-List    AS MEMPTR.
 DEFINE INPUT        PARAMETER List-Size    AS LONG.          
 DEFINE OUTPUT       PARAMETER Missed-Count AS HANDLE TO LONG.
 DEFINE RETURN       PARAMETER Error-Val    AS SHORT.         
END PROCEDURE.

/* 
  Since this can get complex and ugly, here's a sample usage:
  (also grep through adeuib for some real uses of it)
  
  DEF VAR list-mem    AS MEMPTR.
  DEF VAR list-char   AS CHARACTER.
  DEF VAR list-size   AS INT       INIT 400.  /* 400 chars or about 40 files */
  DEF VAR srch-dir    AS CHARACTER INIT "~\tmp".
  DEF VAR missed-file AS INT.
  DEF VAR error       AS INT.
  DEF VAR sl          AS CHAR VIEW-AS SELECTION-LIST SIZE 30 BY 10.
  
  SET-SIZE(list-mem) = list-size.
  
  RUN file_search (srch-dir, 
                   "srt*.*, lib*.*, *.uib, ",
                   INPUT-OUTPUT list-mem,
                   list-size,
                   OUTPUT missed-file,
                   OUTPUT error).
                   
  IF error <> 0 THEN
     DO:
     MESSAGE "Error in directory search.".
     LEAVE.
     END.
     
  list-char = GET-STRING(list-mem,1).  /* Copy into char var */
  
  SET-SIZE(list-mem) = 0.              /* Free the mem */

  FORM sl WITH FRAME test.
  sl:LIST-ITEMS = list-char.
  UPDATE sl WITH FRAME test.     
     
*/
/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/*--------------------------------------------------------------------

File: adecomm/ds_type.i

Usage:
    <int-type> = {adecomm/ds_type.i
                     &direction = "itoe"
                     &from-type = "ixt-type"
                     }
    <ext-type> = {adecomm/ds_type.i
                     &direction = "etoi"
                     &from-type = "int-type"
                     }

Description:   
    Function to convert internal to external db-type
    the result is the converted db-type         OR
    supply the list of all internal or external db-types
            
call:
    
Text-Parameters:
    &direction      "etoi"  (external to internal)      OR
                    "etype" (list of external types)    OR
                    "itoe"  (internal to external)      OR
                    "itype" (list of internal types)    OR
                    "ODBC"  (list of internal ODBC-types)
    &from-type      db-type to be converted             OR
                    dummy-variable

Included in:
    adecomm/_dbconnx.p
    prodict/user/usermenu.i
        
Author: Tom Hutegger

History:
    mcmann      00/03/20    Added MSS
    mcmann      99/03/25    Changed direction = odbc to contain proper ones and added
                            MSSQLSRV to others
    pittman     96/06/05    added DB2-DRDA as new ODBC-based DS
    hutegger    95/11/16    added MSSQLSRV as new ODBC-based DS
    pittman     95/05/xx    added DB2      as new ODBC-based DS
    hutegger    94/07/25    extented with "itype" and "etype"
    hutegger    94/05/18    creation
    
--------------------------------------------------------------------*/ 
/*h-*/

/*------------------------------------------------------------------*/ 
/* NOTE: all lists have to be in the same order and all sets in sync! */
      
IF      "{&direction}" = "etoi"
 THEN ENTRY(LOOKUP({&from-type},
/* list of all external names */
    "AS/400,MSS,ODBC,ORACLE,PROGRESS"),
/* list of all internal names */
    "AS400,MSS,ODBC,ORACLE,PROGRESS")

ELSE IF "{&direction}" = "itoe"
 THEN ENTRY(LOOKUP({&from-type},
/* list of all internal names */
    "AS400,MSS,ODBC,ORACLE,PROGRESS"),
/* list of all external names */
    "AS/400,MSS,ODBC,ORACLE,PROGRESS")

ELSE IF "{&direction}" = "odbc"
 THEN /* list of all ODBC-DataServers (internal names) */
    "MSS,ODBC"


ELSE IF "{&direction}" = "itype"
 THEN /* list of all internal names */
    "AS400,MSS,ODBC,ORACLE,PROGRESS"

 ELSE /* list of all external names */
    "AS/400,MSS,ODBC,ORACLE,PROGRESS"

/*------------------------------------------------------------------*/
      


/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/*--------------------------------------------------------------------------
  dsearch.i
  Search  Defines for Editor 
  
  p_Buffer  WIDGET-HANDLE to edit buffer to operate on.
--------------------------------------------------------------------------*/

/* Tool should set these to their tool name to adhere to 
   application style standards. 
*/
DEFINE VARIABLE Search_Info_Title  AS CHAR INIT "Information" NO-UNDO.
DEFINE VARIABLE Search_Quest_Title AS CHAR INIT "Question?"   NO-UNDO.

DEFINE VARIABLE Find_Flags       AS INTEGER NO-UNDO.
DEFINE VARIABLE Find_Criteria    AS INTEGER NO-UNDO.
DEFINE VARIABLE Find_Command     AS INTEGER NO-UNDO.
DEFINE VARIABLE Replace_Flags    AS INTEGER NO-UNDO.
DEFINE VARIABLE Replace_Criteria AS INTEGER NO-UNDO.
DEFINE VARIABLE Replace_Command  AS INTEGER NO-UNDO.

DEFINE VARIABLE Search_All       AS LOGICAL NO-UNDO. /* UIB Section Editor */

DEFINE VARIABLE Find_Text AS CHARACTER LABEL "&Find What"
  FORMAT "x(128)" VIEW-AS FILL-IN SIZE 40 By 1 {&STDPH_FILL} NO-UNDO.
DEFINE VARIABLE Replace_Text AS CHARACTER LABEL "&Replace With"
  FORMAT "x(128)" VIEW-AS FILL-IN SIZE 40 By 1 {&STDPH_FILL} NO-UNDO.

DEFINE VAR Find_Direction AS CHAR LABEL "Direction" INIT "DOWN"
	VIEW-AS RADIO-SET HORIZONTAL
		RADIO-BUTTONS "&Up",   "UP",
			      "&Down", "DOWN" .

DEFINE VARIABLE Wrap_Find         AS LOGICAL NO-UNDO.
DEFINE VARIABLE Text_Found        AS LOGICAL NO-UNDO.
DEFINE VARIABLE Last_Replace_Find AS INTEGER NO-UNDO.
DEFINE VARIABLE Find_Executed     AS LOGICAL NO-UNDO.
/* Set to TRUE on first executed Find. */

/* These three used to confirm replace when text to be replaced is selected. */
DEFINE VARIABLE Find_Sel_Text  AS CHAR NO-UNDO.
DEFINE VARIABLE Find_Sel_Start AS INTEGER NO-UNDO.
DEFINE VARIABLE Find_Sel_End   AS INTEGER NO-UNDO.


/* Find and Find/Replace Filter Types. */
DEFINE VARIABLE Case_Sensitive    AS INTEGER INITIAL 1 NO-UNDO.
DEFINE VARIABLE Wrap_Around       AS INTEGER INITIAL 2 NO-UNDO.

DEFINE VARIABLE Find_Filters AS LOGICAL EXTENT 2
  INITIAL ["FALSE","TRUE"]
  LABEL "Match &Case":L20,
        "&Wrap at Beginning/End":L20
  VIEW-AS TOGGLE-BOX NO-UNDO.

DEFINE VARIABLE Replace_Filters AS LOGICAL EXTENT 2
  INITIAL ["FALSE","TRUE"]
  LABEL "Match &Case":L15,
        "&Wrap at End":L15
  VIEW-AS TOGGLE-BOX NO-UNDO.

DEFINE VARIABLE Search_Filters AS LOGICAL EXTENT 2
  INITIAL ["FALSE"]
  LABEL "Search A&ll Sections":L25,
        "Unknown Feature":L25
  VIEW-AS TOGGLE-BOX NO-UNDO.

DEFINE BUTTON btn_Find_OK LABEL "OK"
    {&STDPH_OKBTN} AUTO-GO.
    
DEFINE BUTTON btn_Find_Cancel LABEL "Cancel"
    {&STDPH_OKBTN} AUTO-ENDKEY.

DEFINE BUTTON btn_Find_Help LABEL "&Help"
    {&STDPH_OKBTN}.

/* Dialog Button Box */
&IF {&OKBOX} &THEN
DEFINE RECTANGLE FT_Btn_Box    {&STDPH_OKBOX}.
&ENDIF

def var vDirection AS CHAR LABEL "Direction" VIEW-AS FILL-IN SIZE 1 BY 1.

/*---------------- Find Text Dialog Box ----------------*/    
FORM
    SKIP( {&TFM_WID} )
      Find_Text {&AT_OKBOX}
      SKIP( {&VM_WIDG} )
      Find_Filters[ 1 /* Match Case */ ] {&AT_OKBOX} 
      SKIP( {&VM_WID} )
      Find_Filters[2 /* Wrap_Around */ ] {&AT_OKBOX} 
      "Direction:" VIEW-AS TEXT 
          AT ROW-OF Find_Filters[1] + {&VM_WID}
             COL-OF Find_Filters[1] + 35
      SKIP( {&VM_WID} )
      Find_Direction NO-LABEL AT ROW-OF Find_Filters[ 2 ]
                                 COL-OF Find_Filters[ 2 ] + 35
      SKIP( {&VM_WIDG} )
    { adecomm/okform.i
        &BOX    ="FT_Btn_Box"
        &OK     ="btn_Find_OK"
        &CANCEL ="btn_Find_Cancel"
        &OTHER  =" "
        &HELP   ="btn_Find_Help" 
    }
    WITH FRAME FindText 
         VIEW-AS DIALOG-BOX TITLE "Find" SIDE-LABELS
                 DEFAULT-BUTTON btn_Find_OK
                 CANCEL-BUTTON  btn_Find_Cancel.
    { adecomm/okrun.i
        &FRAME  = "FRAME FindText"
        &BOX    = "FT_Btn_Box"
        &OK     = "btn_Find_OK"
        &CANCEL = "btn_Find_Cancel"
        &HELP   = "btn_Find_Help"
    }
    
/*---------------- Replace Dialog Box ----------------*/    
  DEFINE BUTTON btn_Replace_OK LABEL "OK"
    {&STDPH_OKBTN} AUTO-GO.
  
  DEFINE BUTTON btn_Replace_Cancel LABEL "Cancel"
    {&STDPH_OKBTN} AUTO-ENDKEY.
  
  DEFINE BUTTON btn_Replace_All LABEL "Replace &All"
    SIZE &IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN 15 &ELSE 13 &ENDIF
         BY {&H_OKBTN} MARGIN-EXTRA DEFAULT.
  
  DEFINE BUTTON btn_Replace_Help  LABEL "&Help"
    {&STDPH_OKBTN}.

  /* Dialog Button Box */
  &IF {&OKBOX} &THEN
  DEFINE RECTANGLE RT_Btn_Box    {&STDPH_OKBOX}.
  &ENDIF
				
  FORM
      SKIP( {&TFM_WID} )
      Find_Text COLON 14
      SKIP( {&VM_WID} )
      Replace_Text COLON 14
      SKIP( {&VM_WIDG} )
      Replace_Filters[1 /* Case_Sensitive */] {&AT_OKBOX}
/* Wrap not currently supported for Replace. 
      SKIP( {&VM_WID} )
      Replace_Filters[2 /* Wrap_Around */] {&AT_OKBOX}
*/
      &IF DEFINED(SEARCH_ALL) <> 0 &THEN
      SKIP( {&VM_WID} )
      Search_Filters[1] {&AT_OKBOX}
      &ENDIF
    { adecomm/okform.i
        &BOX    ="RT_Btn_Box"
        &OK     ="btn_Replace_OK"
        &CANCEL ="btn_Replace_Cancel"
        &OTHER  ="SPACE( {&HM_BTNG} ) btn_Replace_All"
        &HELP   ="btn_Replace_Help" 
    }
    WITH FRAME ReplaceText SIDE-LABELS
         VIEW-AS DIALOG-BOX TITLE "Replace"
                 DEFAULT-BUTTON btn_Replace_OK
                 CANCEL-BUTTON  btn_Replace_Cancel.
    { adecomm/okrun.i
        &FRAME  = "FRAME ReplaceText"
        &BOX    = "RT_Btn_Box"
        &OK     = "btn_Replace_OK"
        &CANCEL = "btn_Replace_Cancel"
        &OTHER  = "btn_Replace_All"
        &HELP   = "btn_Replace_Help"
    }


/*---------------- Goto-Line Related ----------------*/

DEFINE VAR Goto_Line AS INTEGER LABEL "&Line Number"
    FORMAT ">>>>>>9".
    
DEFINE BUTTON btn_GL_OK     LABEL "OK" AUTO-GO         {&STDPH_OKBTN} .
DEFINE BUTTON btn_GL_Cancel LABEL "Cancel" AUTO-ENDKEY {&STDPH_OKBTN} .
DEFINE BUTTON btn_GL_Help   LABEL "&Help"              {&STDPH_OKBTN} .
    
/* Dialog Button Box */
&IF {&OKBOX} &THEN
DEFINE RECTANGLE GL_Btn_Box    {&STDPH_OKBOX}.
&ENDIF

/* Dialog Box */    
FORM
    SKIP( {&TFM_WID} )
    Goto_Line {&AT_OKBOX} {&STDPH_FILL}
    { adecomm/okform.i
        &BOX    ="GL_Btn_Box"
        &OK     ="btn_GL_OK"
        &CANCEL ="btn_GL_Cancel"
        &HELP   ="btn_GL_Help" 
    }
    WITH FRAME Goto_Line
         VIEW-AS DIALOG-BOX TITLE "Goto Line" SIDE-LABELS
                 DEFAULT-BUTTON btn_GL_OK
                 CANCEL-BUTTON  btn_GL_Cancel.

{ adecomm/okrun.i
    &FRAME  = "FRAME Goto_Line"
    &BOX    = "GL_Btn_Box"
    &OK     = "btn_GL_OK"
    &CANCEL = "btn_GL_Cancel"
    &HELP   = "btn_GL_Help"
}
def var i_recid as int no-undo.
/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/
/***************************************************************************
ToolProgName= tools/ebrwedit.p

Parameters:{&File}       = File Name
           {&Frame_Name} = Frame Name
           {&Fields}     = Fields to enable in the frame
           {&SField}     = Field to scroll on - this should go away
           {&Where}      = where clause for find
           {&Lock_Type}  = find lock type

    NOTES:
 The program calling this must also include ebrowse.def

****************************************************************************
\****************************************************************************/

/* add recid to the frame -- this will be a hidden field */
form 
  i_recid no-label at row 1 column 1 with frame {&frame_name}.

on cursor-up of {&sfield} in frame {&frame_name} USING {&file}
do:
  if frame-line({&frame_name}) > 1 then
  do:
    up 1 with frame {&frame_name}.
    apply "entry" to {&SField} in frame {&frame_name}.
  end.

  else  /* we are on the first line */
  if input frame {&frame_name} i_recid > 0 THEN
  do:
    RUN recid{&frame_name}.
    RUN prev{&frame_name}.
    if available({&file}) then
    do:
      scroll down with frame {&frame_name}.
      RUN display{&frame_name}.
      /* I should be able to get rid of the next two lines */
      enable {&sfield} with frame {&frame_name}.
      i_recid:visible in frame {&frame_name} = no.
      apply "entry" to {&SField} in frame {&frame_name}.
    end.
  end.
  return error.
end.

on cursor-down of {&sfield} in frame {&frame_name} USING {&file}
do:
  if frame-line({&frame_name}) < frame-down({&frame_name}) then
  do:
    down 1 with frame {&frame_name}.
    apply "entry" to {&SField} in frame {&frame_name}.
  end.

  else  /* we are on the last line */
  if input frame {&frame_name} i_recid > 0 THEN
  do:
    RUN recid{&frame_name}.  /* find recid */
    RUN next{&frame_name}.  /* find next */
    if available({&file}) then
    do:
      scroll up with frame {&frame_name}.
      RUN display{&frame_name}.
      /* I should be able to get rid of the next two lines */
      enable {&sfield} with frame {&frame_name}.
      i_recid:visible in frame {&frame_name} = no.
      apply "entry" to {&SField} in frame {&frame_name}.
    end.
  end.
  return error.
end.

on page-up of frame {&frame_name} USING {&file}
do:
end.

on page-down of frame {&frame_name} USING {&file}
do:
end.

/* display record */
procedure display{&frame_name} USING {&file}:
  {&DisplaySetUp}
  display {&fields} recid({&file}) @ i_recid with frame {&frame_name}.
end.

/* find next */
procedure next{&frame_name} USING {&file}:
  find next {&file} WHERE {&where} {&lock_type} no-error.
end.

/* find prev */
procedure prev{&frame_name} USING {&file}:
  find prev {&file} WHERE {&where} {&lock_type} no-error.
end.

/* find first */
procedure first{&frame_name} USING {&file}:
  find first {&file} WHERE {&where} {&lock_type} no-error.
end.

/* find by recid */
procedure recid{&frame_name} USING {&file}:
  find {&file} WHERE
    RECID({&file}) = input frame {&frame_name} i_recid {&lock_type}.
end.

/* remove a line from the screen  -- returns with i_recid = removed recid */
procedure del{&frame_name} USING {&file}:
  assign input frame {&frame_name} i_recid.

  scroll from-current up with frame {&frame_name}.

  /* was this the last and only record on the screen */
  if frame-line({&frame_name}) = 1 AND
    input frame {&frame_name} i_recid = 0 then
  do:
    run recid{&frame_name}.
    run prev{&frame_name}.
    if available {&file} then
    run disp{&frame_name}.
  end.
  else  /* find last rec, and display the next -- usually on last line */
  do:
    /* go to the  second to last line last line */
    down FRAME-DOWN({&Frame_Name}) - FRAME-LINE({&Frame_Name}) - 1
      with frame {&Frame_Name}.

    /* go up (if needed) to the last line with a record on it */
    Do while input frame {&frame_name} i_recid = 0 AND
        frame-line({&frame_name}) > 1:
      up 1 with frame {&Frame_name}.
    end.

    /* find this record, and display the next in the next iteration */
    if input frame {&frame_name} i_recid > 0 then
    do:
      run recid{&frame_name}.
      run next{&frame_name}.
      if available {&file} then
      run disp{&frame_name}.
    end.
  end.
    
end.

/* view the frame and enable all iterations */
procedure view{&frame_name} USING {&file}:
  clear frame {&frame_name} all no-pause.
  view frame {&frame_name}.
  activate frame {&frame_name}.
  RUN first{&frame_name}.
  do while available({&file}) AND
      frame-line({&frame_name}) < frame-down({&frame_name}):
    if input frame {&frame_name} i_recid > 0 then
    down 1 with frame {&frame_name}.
    RUN display{&frame_name}.
    enable {&sfield} with frame {&frame_name}.
    i_recid:visible in frame {&frame_name} = no.
    RUN next{&frame_name}.
  end.
end.
/*********************************************************************
* Copyright (C) 2000,2012 by Progress Software Corporation. All rights *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/
/*
Procedure:    adecomm/fileinfo.i
Author:       Steve Texin, Robert Ryan
Created:      2/95
Purpose:      Initializes the fileinfo.dll that returns file size
              and various date information for the modified date.
              The various date TOkens can be ASsembled in different
              combinations TO create an international date.  
              
              This DLL is best used in combination with the 
              'dirsrch.dll' which returns files for a direcTOry
              and filter.  For each file that dirsrch returns, you
              can pASs this file-spec TO file_info.   

*/

/*
 * FILEINFO.I
 *
 * PROCEDURE NAME:  file_info
 *     PARAMETERS:  
 *                  file-spec               : path TO file
 *                  file-year, mon, day     : ptr TO short
 *                  file-hour, min, sec     : ptr TO short
 *                  file-length             : ptr TO long
 *                  error-val               : ptr TO short
 *                                            0 - if there were no errors.
 *                                            1 - cant open file
 *                                            2 - cant get status
 *
 * USAGE:           run LoadFileInfo.
 *                  run file_info (...).
 *                  run FreeLibrary (hThisDLL).

 */
 
DEFINE VAR hThisDLL AS INTEGER no-undo.

/* 32bit API */
PROCEDURE LoadLibraryA EXTERNAL "KERNEL32.DLL":
    DEFINE INPUT  PARAMETER dllname AS MEMPTR.
    DEFINE RETURN PARAMETER hdll    AS LONG.
END.

PROCEDURE FreeLibrary EXTERNAL "KERNEL32.DLL":
    DEFINE INPUT PARAMETER hdll     AS LONG.
END.


PROCEDURE LoadFileInfo :
  DEFINE VARIABLE ThisDLL AS CHARACTER INITIAL "fileinfo.dll" NO-UNDO.
  DEFINE VARIABLE pDLL   AS MEMPTR.
  
  SET-SIZE(pDLL) = length(ThisDLL) + 1.
  PUT-STRING(pDLL,1) = ThisDLL.
  RUN LoadLibraryA(pDLL, OUTPUT hThisDLL). 
  SET-SIZE(pDLL) = 0.
END.

PROCEDURE UnloadDLL : 
  RUN FreeLibrary (hThisDLL).
END.

/* Win32 API */
PROCEDURE file_info EXTERNAL "fileinfo.dll":
 DEFINE INPUT    PARAMETER File-path    AS CHARACTER.
 DEFINE OUTPUT   PARAMETER file-year    AS HANDLE TO LONG.
 DEFINE OUTPUT   PARAMETER file-mon     AS HANDLE TO LONG.
 DEFINE OUTPUT   PARAMETER file-day     AS HANDLE TO LONG.
 DEFINE OUTPUT   PARAMETER file-hour    AS HANDLE TO LONG.
 DEFINE OUTPUT   PARAMETER file-min     AS HANDLE TO LONG.
 DEFINE OUTPUT   PARAMETER file-sec     AS HANDLE TO LONG.
 DEFINE OUTPUT   PARAMETER file-size    AS HANDLE TO LONG.
 DEFINE OUTPUT   PARAMETER error        AS HANDLE TO LONG.
END PROCEDURE.

/*
DEFINE VARIABLE file-year AS INTEGER.
DEFINE VARIABLE file-mon AS INTEGER.
DEFINE VARIABLE file-day AS INTEGER.
DEFINE VARIABLE file-hour AS INTEGER.
DEFINE VARIABLE file-min AS INTEGER.
DEFINE VARIABLE file-sec AS INTEGER.
DEFINE VARIABLE file-size AS INTEGER.    
DEFINE VARIABLE error AS INTEGER.   
*/
/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/*----------------------------------------------------------------------------

File: fldlist.i

Description: 
   This is the piece of code that actually does the work for _fldlist.p - 
   to fill up a selection list with field names.  It is in a .i so that 
   we can avoid the overhead of calling an internal procedure for each field.
   This overhead adds up when you are dealing with very large databases.

Author: Laura Stern, Warren Bare Greg O'Connor

Date Created: 05/25/93
-----------------------------------------------------------------------------*/

ASSIGN
  v_BldLine = ""
  lInclude = TRUE.

DO v_ItemCnt = 1 to LENGTH(p_Items,"CHARACTER":u):

  IF p_CallBack <> "" THEN DO:

    RUN VALUE (p_CallBack) (v_DbName + "." + _File._File-name , bField._Field-name, 
                           USERID(v_DbName), OUTPUT lInclude).
  END. 

  IF lInclude THEN
    CASE SUBSTRING(p_Items,v_ItemCnt,1,"CHARACTER":u):
      WHEN "T" THEN v_BldLine = v_BldLine 
                              + STRING((if p_usetbl = ? THEN _File._File-name
                                                        ELSE p_usetbl),"x(20)":u).
      WHEN "F" THEN v_BldLine = v_BldLine 
                              + STRING(bField._Format,"x(15)":u).
      WHEN "1" THEN v_BldLine = v_BldLine 
                              + STRING(bField._Field-name,"x(32)":u).
      WHEN "2" THEN v_BldLine = v_BldLine 
                              + STRING((if p_usetbl = ? THEN _File._File-name
                                                        ELSE p_usetbl) + ".":u 
                              + bField._Field-name,"x(64)":u).
      WHEN "3" THEN v_BldLine = v_BldLine 
                              + STRING(v_DBName + ".":u
                                + (if p_usetbl = ? THEN _File._File-name
                                                        ELSE p_usetbl) + ".":u
                                + bField._Field-name,"x(70)":u).
    END CASE.
END.

IF (p_ExpandExtent > 0) AND (DICTDB.bField._Extent > 0) THEN
  if p_ExpandExtent = 1 then
   v_BldLine = TRIM(v_BldLine) + "[1-":u 
             + STRING (DICTDB.bField._Extent) + "]":u.
  else do:

     /*
      * Add *extent* number of entries to the list. And since we're putting
      * multiple entries restart the _vBldLine.
      */

     assign
         sep = ""
         fName = trim(v_BldLine)
         v_BldLine = ""
     .

     do i = 1 to DICTDB.bField._Extent:
         assign
             v_BldLine = v_BldLine + sep + fName + "[" + string(i) + "]"
             sep = ","
         .
     end.

  end.

/* Don't add an item if it's in the private data list. */
IF ((p_List:Private-data = ? OR p_List:Private-data = "" OR
    NOT CAN-DO (p_List:Private-data, TRIM(v_BldLine))) AND lInclude) THEN 

    do i = 1 to num-entries(v_BldLine):
        err = p_List:add-last(entry(i, TRIM(v_BldLine))).
    end.

/* fldlist.i - end of file */

&ANALYZE-SUSPEND _VERSION-NUMBER UIB_v8r12
&ANALYZE-RESUME
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _DEFINITIONS Procedure 
/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/
/*--------------------------------------------------------------------------
    File        : adecomm/get-user
    Purpose     : Returns the user-id.  This should only be called if a DB
                  is connected.  Without this, a run-time error that DICTDB
                  is not connected will occur if the application attempts to
                  run some code that references the USERID function when a
                  DB is not connected.

    Syntax      : IF NUM-DBS > 0 THEN RUN adecomm/get-user (INPUT usr-id).

    Description :

    Author(s)   : Ross Hunter
    Created     : 12/1/97
    Notes       :
  ------------------------------------------------------------------------*/
/*          This .W file was created with the Progress UIB.             */
/*----------------------------------------------------------------------*/

/* ***************************  Definitions  ************************** */
DEFINE OUTPUT PARAMETER usr-id AS CHARACTER                         NO-UNDO.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME


&ANALYZE-SUSPEND _UIB-PREPROCESSOR-BLOCK 

/* ********************  Preprocessor Definitions  ******************** */

&Scoped-define PROCEDURE-TYPE Procedure



/* _UIB-PREPROCESSOR-BLOCK-END */
&ANALYZE-RESUME



/* *********************** Procedure Settings ************************ */

&ANALYZE-SUSPEND _PROCEDURE-SETTINGS
/* Settings for THIS-PROCEDURE
   Type: Procedure
   Allow: 
   Frames: 0
   Add Fields to: Neither
   Other Settings: CODE-ONLY COMPILE
 */
&ANALYZE-RESUME _END-PROCEDURE-SETTINGS

/* *************************  Create Window  ************************** */

&ANALYZE-SUSPEND _CREATE-WINDOW
/* DESIGN Window definition (used by the UIB) 
  CREATE WINDOW Procedure ASSIGN
         HEIGHT             = 1.99
         WIDTH              = 40.
/* END WINDOW DEFINITION */
                                                                        */
&ANALYZE-RESUME
 



&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _MAIN-BLOCK Procedure 


/* ***************************  Main Block  *************************** */
ASSIGN usr-id = USERID.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME


/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/*--------------------------------------------------------------------

File: adecomm/getdbs.i

Description:
    
    definition of s_ttb_db - Temp-Table
            
Input-Parameters:
    none

Output-Parameters:
    none
    
included in:
    adecomm/_getdbs.p
    adecomm/_getfdbs.p
    prodict/_dctsget.p
    adedict/DB/_getdbs.p

    
Author: Tom Hutegger

History:
    hutegger    95/06   creation
    hutegger    95/08   added dbrcd, empty and dspnm fields

                            
--------------------------------------------------------------------*/
/*h-*/

def {&new} shared temp-table   s_ttb_db
        field               cnnctd      as logical   format "yes/no"
        field               dbnr        as integer   format "zz9"
        field               dbtyp       as character format "x(12)"
        field               dspnm       as character format "x(20)"
        field               ldbnm       as character format "x(12)"
        field               pdbnm       as character format "x(40)"
        field               sdbnm       as character format "x(12)"
        field               vrsn        as character format "x"
        field               empty       as logical   format "yes/no"
        field               dbrcd       as recid
        field               local       as logical   format "local/holder"
        index               upi         is primary unique
                                        dbnr ldbnm.

/*------------------------------------------------------------------*/
/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/
/*
** Program:         icondir.i (from _fndfile.p)
** Author:          Robert Ryan
** Date:            6/10/94
**
** Description:     Defines a global variable for adecion so that Progress
**                  doesn't continue to search Propath for the icon directory
** Inputs:          none - this is an include file
** Outputs:         global preprocessor {&ADEICON-DIR} references _ADEIconDir
**                  global preprocessor {&BITMAP-EXT} bitmap extension for O/S
**                  global preprocessor {&ICON-EXT} icon extension for O/S
*/
&GLOBAL ADEICONDIR "" /* allow to check if this file has already been included */

&IF DEFINED(ADEICON-DIR) = 0 &THEN
  DEFINE NEW GLOBAL SHARED VARIABLE _ADEIconDir AS CHAR NO-UNDO.

  &IF "{&WINDOW-SYSTEM}" BEGINS "MS-WIN" &THEN  
     &GLOBAL BITMAP-EXT .bmp   /* .bmps are standard for ADE buttons           */
     &GLOBAL ICON-EXT   .ico   /* .icos are used for desktop & minimized       */ 
  &ELSE
     &GLOBAL BITMAP-EXT .xpm   /* usually xpm - sometimes xbm                  */
     &GLOBAL ICON-EXT   .xpm   /* usually xpm - sometimes xbm                  */
  &ENDIF

  IF _ADEIconDir = ? OR _ADEIconDir = "" THEN _ADEIconDir = "adeicon/".

  &GLOBAL ADEICON-DIR _ADEIconDir   /* The Qualified path of the icon directory      */
&ENDIF
/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/
/*----------------------------------------------------------------------------

File: lstdef1.i

Description:
    Includes all the definitions needed for a choice in a single pick list
    to be moved up or down one slot

Arguments
   
Author: David Lee

Date Created: 03/04/93
----------------------------------------------------------------------------*/


&IF (DEFINED(lstdef1) = 0)
&THEN

DEFINE VARIABLE lst_choice       AS CHARACTER NO-UNDO. /* value from widget */
DEFINE VARIABLE lst_pick_list    AS CHARACTER NO-UNDO. /* list in widget */
DEFINE VARIABLE lst_index        AS INTEGER   NO-UNDO.
DEFINE VARIABLE lstup_i          AS INTEGER   NO-UNDO.

&SCOPED-DEFINE lstdef1 1
&ENDIF

/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/
/*----------------------------------------------------------------------------

File: lstdn1.i

Description:
    Shift an item "down" one in a select list.

Arguments:

   &choice       - THe current selection
   &pick_list    - The list.
   &choice_index - The index position of the user's choice
   
Author: David Lee

Date Created: 03/04/93
----------------------------------------------------------------------------*/

DO:
  /* Pull out the selected string from its current slot */ 
  DO lstup_i = 1 TO NUM-ENTRIES({&choice},CHR(3)):
    ASSIGN
      ENTRY(LOOKUP(ENTRY(lstup_i,{&choice},CHR(3)),{&pick_list},CHR(3)),
        {&pick_list},CHR(3)) = ""
      {&pick_list} = REPLACE({&pick_list},CHR(3) + CHR(3),CHR(3)).
  END.

  /* And now add the chosen item back into the list */
  ASSIGN
    {&pick_list} = TRIM({&pick_list},CHR(3))
    {&choice_index} = MINIMUM({&choice_index},NUM-ENTRIES({&pick_list},CHR(3))).
    
    IF {&choice_index} = 0 THEN
      {&pick_list} = {&choice}.
    ELSE
      ENTRY({&choice_index},{&pick_list},CHR(3)) =
        ENTRY({&choice_index},{&pick_list},CHR(3)) + CHR(3) + {&choice}.
END.

/* lstdn.i - end of file */

/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/
/*----------------------------------------------------------------------------

File: lstup.i

Description:
    Generic include to shift an item "up" one in an array that represents
    a select list. This include does not directly access the widget.

Arguments:

   &choice       - The current selection
   &pick_list    - The pick list
   &choice_index - The index postion of the users choice 

Author: David Lee

Date Created: 03/04/93
-----------------------------------------------------------------------------*/

DO:
  /* Pull out the selected string from its current slot */ 

    {&pick_list} = {&pick_list} + CHR(3).

  DO lstup_i = 1 TO NUM-ENTRIES({&choice},CHR(3)):
    ASSIGN
    ENTRY(LOOKUP(ENTRY(lstup_i,{&choice},CHR(3)),{&pick_list},CHR(3)), 
      {&pick_list},CHR(3)) = ""
     {&pick_list} = TRIM(REPLACE({&pick_list},CHR(3) + CHR(3),CHR(3))).
  END.
 
  /* Did we leave CHR(3) hanging off list? If so, trash it */
  IF ASC(SUBSTRING({&pick_list},
    LENGTH({&pick_list},"CHARACTER":u),1,"CHARACTER":u)) = 3 THEN
     {&pick_list} = SUBSTRING({&pick_list},1,
                     LENGTH({&pick_list},"CHARACTER":u) - 1,"CHARACTER":u).

  /* And now add the chosen item back into the list */
  ASSIGN
    {&choice_index} = MAXIMUM({&choice_index} - 1, 1)
    ENTRY({&choice_index},{&pick_list},CHR(3)) =
          {&choice} + (IF {&pick_list} = "" THEN "" ELSE CHR(3) 
                       + ENTRY({&choice_index},{&pick_list},CHR(3))).

END.

/* lstup.i - end of file */

/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/* PROGRAM: okbar.i
**
** This file adds the standard OK/CANCEL/HELP button bar to the bottom of a
** dialog box created in the UIB.  This file should be included at the top
** of the Main-Code-Block.
** This file acts as a front end for the trio: adestds.i okform.i okrun.i. 
** For more information on this, see the document
** design\ade\misc\sullivan.doc.
**
** PARAMETERS:
** &BOX      widget name of the rectangle to be used for the background box
**           (optional)
** &OK       widget name of the ok button     (optional)
** &CANCEL   widget name of the cancel button (optional)
** &OTHER    4GL for any intervening buttons  (optional)
** &HELP     widget name of the help button   (optional)
** &TOOL     The name of the tool (eg uib) for use in the
**           help trigger
** &CONTEXT  Name of the help context string.
**           [both &TOOL and &CONTEXT must be available if you
**            want a help trigger.]
** If the names are not given explicitly, then default values of
** rect_btn_bar, btn_OK, btn_cancel, and btn_help will be defined.
*/
/* ADE standards are required stdui.i for this file */
&IF DEFINED(ADESTDSI) = 0 &THEN
{ adecomm/adestds.i }
&ENDIF

/* Set defaults for Names */
&IF DEFINED(BOX) eq 0 &THEN     &SCOPED-DEFINE BOX rect_btn_bar 
&ENDIF
&IF DEFINED(OK) eq 0 &THEN      &SCOPED-DEFINE OK btn_OK
&ENDIF
&IF DEFINED(CANCEL) eq 0 &THEN  &SCOPED-DEFINE CANCEL btn_cancel
&ENDIF
/* NOTE: Help is a keyword so we can't ask for DEFINED(help)*/
&IF "{&HELP}" eq "" &THEN       &SCOPED-DEFINE HELP btn_help
&ENDIF

/* standard button rectangle */
&IF {&OKBOX} &THEN
DEFINE RECTANGLE rect_btn_bar {&STDPH_OKBOX}.
&ENDIF

/* Buttons for the bottom of the screen                                      */
DEFINE BUTTON {&OK}      LABEL "OK":C12     {&STDPH_OKBTN} AUTO-GO.
DEFINE BUTTON {&CANCEL}  LABEL "Cancel":C12 {&STDPH_OKBTN} AUTO-ENDKEY.
DEFINE BUTTON {&HELP}    LABEL "&Help":C12  {&STDPH_OKBTN}.
/* Add these to the frame */
DEFINE FRAME {&FRAME-NAME} 
  {adecomm/okform.i}
  WITH DEFAULT-BUTTON {&OK} CANCEL-BUTTON {&CANCEL} .
  
/* Do run-time layout.  ok_run.i lays out width.  We need to also do 
   HEIGHT-P. */
{adecomm/okrun.i 
  &FRAME = "FRAME {&FRAME-NAME}"
  }

/* Adjust the height based on the position of the OK button and the relavent
   borders (standard borders plus dialog-box border). */
ASSIGN FRAME {&FRAME-NAME}:SCROLLABLE = no
       FRAME {&FRAME-NAME}:HEIGHT     = ({&OK}:ROW  - 1) + {&OK}:HEIGHT + 
       FRAME {&FRAME-NAME}:BORDER-TOP + FRAME {&FRAME-NAME}:BORDER-BOTTOM +
       /* if there is an ok box, skip to allow for it below the buttons */
       &IF {&OKBOX} &THEN {&IVM_OKBOX} + &ENDIF
       /* skip a margin below the box or the buttons */
       {&VM_OKBOX}
       .

/* Add a standard ADE help trigger */
&IF DEFINED(TOOL) ne 0 AND DEFINED(CONTEXT) ne 0 &THEN
/* Standard Help Trigger */
ON CHOOSE OF {&HELP} OR HELP OF FRAME {&FRAME-NAME} DO:
   RUN adecomm/_adehelp.p ("{&TOOL}", "CONTEXT", {&CONTEXT}, "").
END.

&ENDIF

/* Enable these new buttons */
ENABLE {&OK} {&CANCEL} {&HELP} {&WHEN_HELP} WITH FRAME {&FRAME-NAME}.

/* Make sure the OK button is the default button. */
ASSIGN FRAME {&FRAME-NAME}:DEFAULT-BUTTON = {&OK}:HANDLE.

/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/* PROGRAM: okform.i
**
** This file is part of a trio: adestds.i okform.i okrun.i.  This file should
** be included at the end of a FORM statement to provide a standardized look
** for the OK CANCEL bar.  For more information on this, see the document
** design\ade\misc\sullivan.doc.
**
** PARAMETERS:
** &BOX      widget name of the rectangle to be used for the background box
** &STATUS   set to yes if a status line appears above the bottom row of buttons
** &OK       widget name of the ok button
** &CANCEL   widget name of the cancel button (optional)
** &OTHER    4GL for any intervening buttons (optional)
** &HELP     widget name of the help button (optional - e.g. for tty)
*/

/* stdui.i is required for this file */
/* this statement chucks core - reported as bug 93-04-30-27 
&IF DEFINED(ADESTDSI) = 0 &THEN
{ adecomm/adestds.i }
&ENDIF
*/

    /* if there is a status area, use a smaller vertical margin */
    &IF "{&STATUS}" = "yes" &THEN
    skip({&VM_WID}) 
    &ELSE
    skip({&VM_WIDG})
    &ENDIF

    /* if there is a Sullivan blue box, place it here.  The box will take
       up .25 PPU of vertical height.  If the box does not exist, then skip
       this height explicitly */
    &IF {&OKBOX} &THEN
    {&BOX} {&AT_OKBOX}
    skip(0)
    &ELSE
    skip({&IVM_OKBOX}) 
    &ENDIF

    /* place the OK, Cancel buttons, then any intervening buttons, followed by
       help */
    {&OK} {&AT_OKBTN}  
    &IF "{&CANCEL}" <> "" &THEN
      space({&HM_DBTN}) {&CANCEL} 
    &ENDIF
    {&OTHER}
    &IF "{&HELP}" <> "" &THEN
      space({&HM_DBTNG}) {&HELP} space({&HFM_OKBOX})
    &ENDIF

    /* if there is an ok box, skip to allow for it below the buttons */
    &IF {&OKBOX} &THEN
    skip({&IVM_OKBOX}) 
    &ENDIF

    /* skip a margin below the box or the buttons */
    skip({&VM_OKBOX})


/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/* PROGRAM: okrun.i
**
** This file is part of a trio: adestds.i okform.i okrun.i.  This file should
** be included to provide the runtime layout for the OK CANCEL bar.  For more 
** information on this, see the document design\ade\misc\sullivan.doc.
**
** PARAMETERS:
** &FRAME    widget name of the frame containing the okform.i
** &BOX      widget name of the rectangle to be used for the background box
** &OK       widget name of the ok button
** &CANCEL   widget name of the cancel button (only need for tty w/ no help btn)
** &OTHER    widget name any intervening buttons (optional)
** &HELP     widget name of the help button
** &FORCEDEF force defines of local variables
*/

/* stdui.i is required for this file */
&IF DEFINED(ADESTDSI) = 0 &THEN
  { adecomm/adestds.i } 
&ENDIF

&IF DEFINED(OKRUN_VARS) = 0 OR "{&FORCEDEF}" = "yes" &THEN
  DEFINE VARIABLE eff_frame_width AS DECIMAL.  /* effective frame width */
  DEFINE VARIABLE vwidget         AS HANDLE.   /* general widget handle */
  &GLOBAL OKRUN_VARS ""
&ENDIF

/* Increase the compile defined frame width by 1 PPU. */
{&FRAME}:WIDTH-CHARS = {&FRAME}:WIDTH-CHARS + {&HFM_WID}. 
eff_frame_width = {&FRAME}:WIDTH-CHARS - 
                  {&FRAME}:BORDER-LEFT-CHARS - 
                  {&FRAME}:BORDER-RIGHT-CHARS.

/* adjust the size of the box */
&IF {&OKBOX} &THEN
  /* adjust the ok box to the width of the frame for Windows */
  vwidget              = {&BOX}:HANDLE IN {&FRAME}.
  vwidget:HEIGHT-CHARS = {&OK}:HEIGHT-CHARS IN {&FRAME} + ({&IVM_OKBOX} * 2).
  vwidget:WIDTH-CHARS  = eff_frame_width - ({&HFM_OKBOX} * 2).
&ENDIF

&IF "{&HELP}" <> "" &THEN
  /* runtime adjust the help button to the right of the frame */
  vwidget        = {&HELP}:HANDLE IN {&FRAME}.
  vwidget:column = eff_frame_width - vwidget:WIDTH-CHARS - {&HFM_OKBOX}.
&ENDIF
&IF "{&WINDOW-SYSTEM}" = "TTY" &THEN
  /* Starting in 8.0B, handle TTY this way (jep 2/8/96):
        - Hide HELP button.
        - If only OK or OK-CANCEL, then center them.
        - If OTHER button, then leave all buttons flush left.
  */
    &IF "{&HELP}" <> "" &THEN
      {&HELP}:VISIBLE IN {&FRAME} = NO.
    &ENDIF
    &IF "{&OTHER}" = "" &THEN
      &IF "{&CANCEL}" <> "" &THEN
        {&OK}:COLUMN IN {&Frame}     = (eff_frame_width -
                                       {&OK}:WIDTH-CHARS IN {&FRAME} - 
                                       {&CANCEL}:WIDTH-CHARS IN {&FRAME} - 
                                       {&HM_DBTNG}) / 2.
        {&CANCEL}:COLUMN IN {&FRAME} = {&OK}:COLUMN IN {&FRAME} + 
  	                             {&OK}:WIDTH-CHARS IN {&FRAME} + 
  	                             {&HM_DBTNG}.
      &ELSE
        {&OK}:COLUMN IN {&FRAME}     = (eff_frame_width -
                                       {&OK}:WIDTH-CHARS IN {&FRAME}) / 2.
      &ENDIF
    &ENDIF
&ENDIF

&IF "{&USE-3D}" = "" &THEN
IF NOT {&FRAME}:VISIBLE AND {&FRAME}:THREE-D NE SESSION:THREE-D THEN
  ASSIGN {&FRAME}:THREE-D = IF SESSION:THREE-D THEN TRUE ELSE FALSE.
&ELSEIF "{&USE-3D}" = "YES" &THEN  
  /* Add THREE-D to the static frame definition.  This is preferred to
     setting a run-time value. */
  DEFINE {&FRAME} WITH THREE-D.
&ENDIF

ASSIGN std_fillin_bgcolor = IF SESSION:THREE-D THEN ? ELSE 8.

/*
 * This last section is for RESULTS. We need it as a workaround to insure
 * that the watch cursor, turned on by the Menu Subsystem, gets turned off.
 * This shouldn't affect any other application.
 */
&IF DEFINED(TURN-OFF-CURSOR) &THEN
  RUN adecomm/_setcurs.p ("").
&ENDIF

/* okrun.i - end of file */

/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/
/*----------------------------------------------------------------------------

File: osnul.i

Description:
   This include file will place the name of the system null device in the
   one parameter that is passed.

Example:
  {adecomm/osnul.i v_TheNulDevice}
  OUTPUT TO VALUE(v_TheNulDevice).

Author: Tony Lavinio

Date Created: 07/21/92

----------------------------------------------------------------------------*/
 
ASSIGN {1} = "nul":u.
IF OPSYS = "UNIX"  THEN {1} = "/dev/null":u.
/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/
/********************************************************************/
/* Encrypted code which is part of this file is subject to the      */
/* Possenet End User Software License Agreement Version 1.0         */
/* (the "License"); you may not use this file except in             */
/* compliance with the License. You may obtain a copy of the        */
/* License at http://www.possenet.org/license.html                  */
/********************************************************************/

/**************************************************************************
  pedit.i 
  Edit  Procedures for Editor
***************************************************************************/

&IF "{&WINDOW-SYSTEM}" <> "TTY":U &THEN
PROCEDURE EditUndo.
/*---------------------------------------------------------------------------

    Syntax       RUN EditUndo ( INPUT p_Buffer ) .
    
    Purpose      Undoes the last edit action.
    
    Remarks      The p_Buffer is presumed to be of :TYPE = "EDITOR".
               
    Return Value NONE.

---------------------------------------------------------------------------*/

  DEFINE INPUT PARAMETER p_Buffer AS WIDGET-HANDLE NO-UNDO .

  DO ON STOP UNDO, LEAVE ON ERROR UNDO, LEAVE :

    IF p_Buffer:EDIT-CAN-UNDO THEN p_Buffer:EDIT-UNDO().

  END. /* DO ON STOP */
  
/* We don't need to do this for functions implemented via editor widget.
  /* Put focus back in editor widget. */
  APPLY "ENTRY" TO p_Buffer.
*/
  
END PROCEDURE.  /* EditUndo. */

&ENDIF


PROCEDURE EditCut.
/*---------------------------------------------------------------------------

    Syntax       RUN EditCut ( INPUT p_Buffer ) .
    
    Purpose      Copies the contents of the current selection to the OS's
                 Native Clipboard, overwriting the clipboards previous contents,
                 and then deletes the current selection and its contents.
    
    Remarks      The p_Buffer is presumed to be of :TYPE = "EDITOR".
               
    Return Value NONE.

---------------------------------------------------------------------------*/

  DEFINE INPUT PARAMETER p_Buffer AS WIDGET-HANDLE NO-UNDO .

  DEFINE VAR Status_Error   AS LOGICAL       NO-UNDO.
  DEFINE VAR vWindow        AS WIDGET-HANDLE NO-UNDO.
  DEFINE VAR Clip_Multiple  AS LOGICAL       NO-UNDO INIT FALSE.
  
  &IF "{&WINDOW-SYSTEM}" <> "TTY":U &THEN
  ASSIGN Status_Error = p_Buffer:EDIT-CUT() NO-ERROR.
  &ELSE
  DO ON STOP UNDO, LEAVE ON ERROR UNDO, LEAVE :
    /* ADE only works with a single clipboard format - text only. */
    ASSIGN Clip_Multiple     = CLIPBOARD:MULTIPLE
           CLIPBOARD:MULTIPLE = FALSE.
    RUN SelectSetEnd( INPUT p_Buffer ) .
    IF ( p_Buffer:TEXT-SELECTED = TRUE ) THEN
    DO: /* Text is selected. */
        /* Can Progress ditem handle the text to be cut? */
        ASSIGN CLIPBOARD:VALUE = p_Buffer:SELECTION-TEXT NO-ERROR.
      
        IF ( ERROR-STATUS:NUM-MESSAGES > 0 ) THEN
        DO:
            ASSIGN vWindow = p_Buffer:FRAME
                   vWindow = vWindow:PARENT   /* Window */
            . /* ASSIGN */

            MESSAGE "Text is too large to cut." SKIP(1)
                    ERROR-STATUS:GET-MESSAGE(1)
                    VIEW-AS ALERT-BOX ERROR BUTTONS OK IN WINDOW vWindow.
        END.
        ELSE DO:
            ASSIGN Status_Error = p_Buffer:REPLACE-SELECTION-TEXT("").
        END.
        RUN DeselectText ( INPUT p_Buffer ).
    END.
  END. /* DO ON STOP */
  /* Restore clipboard multiple value. */
  ASSIGN  CLIPBOARD:MULTIPLE = Clip_Multiple. 
  
  /* Put focus back in editor widget. */
  APPLY "ENTRY" TO p_Buffer.
  &ENDIF
  
END PROCEDURE.  /* EditCut. */

PROCEDURE EditCopy.
/*---------------------------------------------------------------------------

    Syntax       RUN EditCopy ( INPUT p_Buffer ) .
    
    Purpose      Copies the contents of the current selection to the OS's
                 Native Clipboard, overwriting its previous contents.
  
    Remarks      The p_Buffer widget is presumed to be of :TYPE = "EDITOR".
               
    Return Value NONE.

---------------------------------------------------------------------------*/

  DEFINE INPUT PARAMETER p_Buffer AS WIDGET-HANDLE NO-UNDO .
  
  DEFINE VAR Status_Error   AS LOGICAL       NO-UNDO.
  DEFINE VAR vWindow        AS WIDGET-HANDLE NO-UNDO.
  DEFINE VAR Clip_Multiple  AS LOGICAL       NO-UNDO INIT FALSE.
  
  &IF "{&WINDOW-SYSTEM}" <> "TTY":U &THEN
  ASSIGN Status_Error = p_Buffer:EDIT-COPY() NO-ERROR.
  &ELSE
  DO ON STOP UNDO, LEAVE ON ERROR UNDO, LEAVE :
    /* ADE only works with a single clipboard format - text only. */
    ASSIGN Clip_Multiple     = CLIPBOARD:MULTIPLE
           CLIPBOARD:MULTIPLE = FALSE.
    RUN SelectSetEnd( INPUT p_Buffer ) .
    IF p_Buffer:TEXT-SELECTED THEN
    DO: /* Text is selected. */      
        /* Can Progress ditem handle the text to be cut? */
        ASSIGN CLIPBOARD:VALUE = p_Buffer:SELECTION-TEXT NO-ERROR.
        IF ( ERROR-STATUS:NUM-MESSAGES > 0 ) THEN
        DO:
            ASSIGN vWindow = p_Buffer:FRAME
                   vWindow = vWindow:PARENT   /* Window */
            . /* ASSIGN */
            MESSAGE "Text is too large to copy." SKIP(1)
                    ERROR-STATUS:GET-MESSAGE(1)
                    VIEW-AS ALERT-BOX ERROR BUTTONS OK IN WINDOW vWindow.
        END.
        RUN DeselectText ( INPUT p_Buffer ).
    END.
  END. /* DO ON STOP */
  
  /* Restore clipboard multiple value. */
  ASSIGN  CLIPBOARD:MULTIPLE = Clip_Multiple. 
  
  /* Put focus back in editor widget. */
  APPLY "ENTRY" TO p_Buffer.
  &ENDIF

END PROCEDURE.  /* EditCopy. */


PROCEDURE EditPaste.
/*---------------------------------------------------------------------------

    Syntax       RUN EditPaste ( INPUT p_Buffer ).
    
    Purpose      Inserts the contents of the OS's clipboard at the current
                 position (insert point).  Does not change the clipboard's
                 contents.
    
    Remarks      The p_Buffer widget is presumed to be of :TYPE = "EDITOR".
               
    Return Value NONE.

---------------------------------------------------------------------------*/
  
  DEFINE INPUT PARAMETER p_Buffer AS WIDGET-HANDLE NO-UNDO .

  DEFINE VAR Status_Error   AS LOGICAL NO-UNDO.
  DEFINE VAR Paste_Text     AS CHAR    NO-UNDO.
  DEFINE VAR vWindow        AS WIDGET  NO-UNDO.
  DEFINE VAR Clip_Multiple  AS LOGICAL NO-UNDO INIT FALSE.
  
  &IF "{&WINDOW-SYSTEM}" <> "TTY":U &THEN
  IF p_Buffer:EDIT-CAN-PASTE THEN
    ASSIGN Status_Error = p_Buffer:EDIT-PASTE() NO-ERROR.
  &ELSE

  DO ON STOP UNDO, LEAVE ON ERROR UNDO, LEAVE :
    /* ADE only works with a single clipboard format - text only. */
    ASSIGN Clip_Multiple     = CLIPBOARD:MULTIPLE
           CLIPBOARD:MULTIPLE = FALSE.
  
    IF CLIPBOARD:NUM-FORMATS > 0 THEN  /* Clipboard not empty. */
    DO:
      ASSIGN vWindow = p_Buffer:FRAME
             vWindow = vWindow:PARENT   /* Window */
      . /* ASSIGN */

      RUN SelectSetEnd( INPUT p_Buffer ) .

      /* Can Progress ditem handle the text to be pasted? */
      ASSIGN Paste_Text = CLIPBOARD:VALUE NO-ERROR.
      IF ( ERROR-STATUS:NUM-MESSAGES > 0 ) THEN
      DO:
            MESSAGE "Text is too large to paste." SKIP(1)
                    ERROR-STATUS:GET-MESSAGE(1)
                    VIEW-AS ALERT-BOX ERROR BUTTONS OK IN WINDOW vWindow.
      END.
      ELSE DO:
         /* If something selected, replace it with clipboard value. */
        IF p_Buffer:TEXT-SELECTED THEN
             ASSIGN Status_Error = 
                    p_Buffer:REPLACE-SELECTION-TEXT( CLIPBOARD:VALUE ) .
        ELSE /* Insert pasted text at current insert point. */
             ASSIGN Status_Error = 
                    p_Buffer:INSERT-STRING( CLIPBOARD:VALUE ) .
        IF ( Status_Error = FALSE )
        THEN MESSAGE "Cannot paste.  Editor is full."
                  VIEW-AS ALERT-BOX ERROR BUTTONS OK IN WINDOW vWindow.
      END.

      RUN DeselectText ( INPUT p_Buffer ).
    END .
  END. /* DO ON STOP */
  
  /* Restore clipboard multiple value. */
  ASSIGN  CLIPBOARD:MULTIPLE = Clip_Multiple. 
  
  /* Put focus back in editor widget. */
  APPLY "ENTRY" TO p_Buffer.
  &ENDIF
  
END PROCEDURE.  /* EditPaste. */

PROCEDURE IndentSelection:
/*---------------------------------------------------------------------------

    Syntax       RUN IndentSelection ( INPUT p_Buffer, INPUT pi_indent ) .
    
    Purpose      Indent the selected text in the p_Buffer Editor widget
                 by pi_indent.
    Remarks      The p_Buffer widget is presumed to be of :TYPE = "EDITOR".
                 The value or pi_indent can be
                      >0       Indent that much 
                      0        Return (do nothing)
                      <0       Remove the indent
               
    Return Value NONE.

---------------------------------------------------------------------------*/

  DEFINE INPUT PARAMETER p_Buffer  AS WIDGET-HANDLE NO-UNDO .
  DEFINE INPUT PARAMETER pi_indent AS INTEGER       NO-UNDO .
  
  DEFINE VAR Status_Error   AS LOGICAL NO-UNDO.
  DEFINE VAR New_Text       AS CHAR    NO-UNDO.
  DEFINE VAR vWindow        AS WIDGET  NO-UNDO.
  DEFINE VAR start          AS INTEGER NO-UNDO.
  DEFINE VAR First_Indent   AS INTEGER NO-UNDO.
  DEFINE VAR Last_Char      AS CHAR    NO-UNDO.
  DEFINE VAR IndentDone     AS LOGICAL NO-UNDO.
    
  DO ON STOP UNDO, LEAVE ON ERROR UNDO, LEAVE :

    &IF "{&WINDOW-SYSTEM}" = "TTY" &THEN
    RUN SelectSetEnd( INPUT p_Buffer ) .
    &ENDIF
   
    /* adecomm/peditor.i */
    RUN Indent_Selection (INPUT p_Buffer, INPUT pi_indent, OUTPUT IndentDone).
    IF IndentDone THEN RETURN.
    
    IF p_Buffer:TEXT-SELECTED AND pi_indent NE 0
    THEN DO: /* Text is selected and there is something to do */
    
        /* Can Progress ditem handle the text to be indented? */
        ASSIGN New_Text = p_Buffer:SELECTION-TEXT NO-ERROR.
        IF ( ERROR-STATUS:NUM-MESSAGES > 0 )
        THEN DO:
            ASSIGN vWindow = p_Buffer:FRAME
                   vWindow = vWindow:PARENT   /* Window */
            . /* ASSIGN */
            MESSAGE "Selection is too large to indent." SKIP(1)
                    ERROR-STATUS:GET-MESSAGE(1)
                    VIEW-AS ALERT-BOX ERROR BUTTONS OK IN WINDOW vWindow.
        END.
        ELSE DO:
             ASSIGN start = p_Buffer:SELECTION-START. 
             
             /* If last character is EOL, go one character before it for selection end.
                Otherwise, indent is added to following line as well. */
             ASSIGN Last_Char = SUBSTRING(p_Buffer:SELECTION-TEXT, LENGTH(p_Buffer:SELECTION-TEXT, "CHARACTER":u)).
             IF Last_Char = CHR(10) THEN
             DO:
                 ASSIGN Status_Error = p_Buffer:SET-SELECTION(start, p_Buffer:SELECTION-END - 1) NO-ERROR.
                 ASSIGN New_Text = p_Buffer:SELECTION-TEXT NO-ERROR.
             END.

             IF pi_indent > 0   /* Indent */
             THEN ASSIGN New_Text = REPLACE(New_Text,CHR(10), CHR(10) + FILL(" ",pi_indent))
                         New_Text = FILL(" ", pi_indent) + New_Text.
             ELSE DO:           /* Unindent */
                ASSIGN New_Text = REPLACE(New_Text,CHR(10) + FILL(" ", ABS(pi_indent)), CHR(10)).
                /* Find the first n-spaces and remove them. */
                ASSIGN First_Indent = INDEX(New_Text , FILL(" ", ABS(pi_indent))).
                ASSIGN SUBSTRING(New_Text, First_Indent, ABS(pi_indent)) = "" NO-ERROR.
             END.
             
             ASSIGN Status_Error = p_Buffer:REPLACE-SELECTION-TEXT( New_Text) .

             ASSIGN Status_Error = p_Buffer:SET-SELECTION(start, start + LENGTH(New_Text,"CHARACTER")).
       END.
       &IF "{&WINDOW-SYSTEM}" = "TTY" &THEN
       RUN DeselectText ( INPUT p_Buffer ).
       &ENDIF      
    END.
  END. /* DO ON STOP */
  
  /* Put focus back in editor widget. */
  APPLY "ENTRY" TO p_Buffer.

END PROCEDURE.  /* IndentSelection */


PROCEDURE CommentSelection:
/*---------------------------------------------------------------------------

    Syntax       RUN CommentSelection ( INPUT p_Buffer, INPUT pl_comment ) .
    
    Purpose      Comment/Uncomment the selected text in the p_Buffer Editor 
                 widget.
    Remarks      The p_Buffer widget is presumed to be of :TYPE = "EDITOR".
                 The value or pl_comment is logical and can be can be
                      YES   Add Comments
                      NO    Remove Comments
               
    Return Value NONE.

---------------------------------------------------------------------------*/

  DEFINE INPUT PARAMETER p_Buffer   AS WIDGET-HANDLE NO-UNDO .
  DEFINE INPUT PARAMETER pl_comment AS LOGICAL       NO-UNDO .
  
  DEFINE VAR Status_Error   AS LOGICAL NO-UNDO.
  DEFINE VAR New_Text       AS CHAR    NO-UNDO.
  DEFINE VAR vWindow        AS WIDGET  NO-UNDO.
  DEFINE VAR start          AS INTEGER NO-UNDO.
  DEFINE VAR Comment_Start  AS INTEGER NO-UNDO.
  DEFINE VAR Comment_End    AS INTEGER NO-UNDO.
  DEFINE VAR Can_Uncomment  AS LOGICAL NO-UNDO.
  DEFINE VAR Last_Char      AS CHAR    NO-UNDO.
  DEFINE VAR CommmentDone   AS LOGICAL NO-UNDO.
  DEFINE VAR line_count     AS INTEGER NO-UNDO.
  DEFINE VAR comment_text   AS CHAR    NO-UNDO.
  DEFINE VAR line_text      AS CHAR    NO-UNDO.
  DEFINE VAR comment_lines  AS INTEGER NO-UNDO.

  DO ON STOP UNDO, LEAVE ON ERROR UNDO, LEAVE :

    &IF "{&WINDOW-SYSTEM}" = "TTY" &THEN
    RUN SelectSetEnd( INPUT p_Buffer ) .
    &ENDIF
   
    /* adecomm/peditor.i */
    RUN Comment_Selection (INPUT p_Buffer, INPUT pl_comment, OUTPUT CommmentDone ).
    IF CommmentDone THEN RETURN.

    IF p_Buffer:TEXT-SELECTED
    THEN DO: /* Text is selected  */      
        ASSIGN vWindow = p_Buffer:FRAME
               vWindow = vWindow:PARENT  /* Window */
               .
        
        /* Excluding white space, determine if the selected text starts
           with "/*" and ends with "*/". */
        ASSIGN New_Text = TRIM(p_Buffer:SELECTION-TEXT) NO-ERROR.
        IF ( ERROR-STATUS:NUM-MESSAGES = 0 ) THEN
            ASSIGN Comment_Start = INDEX( New_Text , "/*":u )
                   Comment_End   = R-INDEX( New_Text , "*/":u )
                   Can_Uncomment = (Comment_Start = 1 AND
                                    Comment_End = LENGTH(New_Text, "CHARACTER":u) - 1)
                   NO-ERROR.

        /* Get the actual comment start and comment end locations. */
        ASSIGN Comment_Start = INDEX( p_Buffer:SELECTION-TEXT , "/*":u ) NO-ERROR.
        ASSIGN Comment_End   = R-INDEX( p_Buffer:SELECTION-TEXT , "*/":u ) NO-ERROR.
                   
        /* Can Progress ditem handle the text to be cut? */
        ASSIGN New_Text = p_Buffer:SELECTION-TEXT NO-ERROR.
        IF ( ERROR-STATUS:NUM-MESSAGES > 0 )
        THEN DO:
            MESSAGE "Selection is too large to comment." SKIP(1)
                    ERROR-STATUS:GET-MESSAGE(1)
                    VIEW-AS ALERT-BOX ERROR BUTTONS OK IN WINDOW vWindow.
        END.
        ELSE IF pl_comment eq NO AND NOT Can_Uncomment
        THEN DO: 
            MESSAGE 'Cannot uncomment selection.' SKIP
                    'Selected text must start with /* and end with */.'
                    VIEW-AS ALERT-BOX ERROR BUTTONS OK IN WINDOW vWindow.
        END.
        ELSE DO:
             ASSIGN start = p_Buffer:SELECTION-START.

             /* If last character is EOL, go one character before it for selection end.
                Otherwise, end comment is added to following line. */
             ASSIGN Last_Char = SUBSTRING(p_Buffer:SELECTION-TEXT, LENGTH(p_Buffer:SELECTION-TEXT, "CHARACTER":u)).
             IF Last_Char = CHR(10) THEN
             DO:
                 ASSIGN Status_Error = p_Buffer:SET-SELECTION(start, p_Buffer:SELECTION-END - 1) NO-ERROR.
                 ASSIGN New_Text = p_Buffer:SELECTION-TEXT NO-ERROR.
             END.

             /* If we are going to comment the section, then surround the 
                text with '/**/'. For multiple lines, enclose each line in
                comments. Reverse the process when we uncomment. */
             IF pl_comment EQ yes
             THEN DO:
               comment_lines = NUM-ENTRIES(New_Text, CHR(10)).
               COMMENT_CODE:
               DO line_count = 1 TO NUM-ENTRIES(New_Text, CHR(10)):
                 line_text = ENTRY(line_count, New_Text, CHR(10)).
                 /* If the last element in the selection is a blank line, we don't comment
                    it because its really just a blank line following the selection text. */
                 IF FALSE /* line_count = comment_lines AND TRIM(line_text) = "" */ THEN LEAVE COMMENT_CODE.
                 ELSE DO:
                   IF comment_lines > 1 THEN DO: /* Comment a line. */
                     /* If its a blank line, add two spaces to it for compatibility with
                        advanced editor. */
                     IF TRIM(line_text) = "" THEN DO: /* Blank line. */
                       comment_text = comment_text + "/* " + RIGHT-TRIM(line_text) + "  " + " */".
                     END.
                     ELSE DO: /* Not a blank line. */
                       comment_text = comment_text + "/* " + RIGHT-TRIM(line_text) + " */".
                     END.
                     /* Don't add carriage return to last line. It gets one from the selection replacement. */
                     IF line_count < comment_lines THEN comment_text = comment_text + CHR(10).
                   END.
                   ELSE /* Comment portion of a line. */
                     comment_text = comment_text + "/* " + line_text + " */".
                 END.
               END.
               ASSIGN New_Text = comment_text.
             END.
             ELSE DO:
               comment_lines = NUM-ENTRIES(New_Text, CHR(10)).
               UNCOMMENT_CODE:
               DO line_count = 1 TO NUM-ENTRIES(New_Text, CHR(10)):
                 line_text = ENTRY(line_count, New_Text, CHR(10)).
                 IF TRIM(line_text) = "" THEN /* Don't uncomment blank lines. */
                   comment_text = comment_text + line_text.
                 ELSE DO:
                     /* Get the actual comment start and comment end locations and then
                        remove the comment characters. */
                     ASSIGN Comment_End   = R-INDEX( line_text , " */":u ) NO-ERROR.
                     ASSIGN SUBSTRING( line_text , Comment_End , LENGTH( " */":u, "CHARACTER":u ) ) = "*/":u NO-ERROR.
                     ASSIGN Comment_End   = R-INDEX( line_text , "*/":u ) NO-ERROR.
                     ASSIGN SUBSTRING( line_text , Comment_End , LENGTH( "*/":u, "CHARACTER":u ) ) = "" NO-ERROR.
                     ASSIGN Comment_Start = INDEX( line_text , "/* ":u ) NO-ERROR.
                     ASSIGN SUBSTRING( line_text , Comment_Start, LENGTH( "/* ":u, "CHARACTER":u ) ) = "/*":u NO-ERROR.
                     ASSIGN Comment_Start = INDEX( line_text , "/*":u ) NO-ERROR.
                     ASSIGN SUBSTRING( line_text , Comment_Start, LENGTH( "/*":u, "CHARACTER":u ) ) = "" NO-ERROR.
                     comment_text = comment_text + line_text.
                     /* Add carriage return when one or more lines is selected but not for
                        the last line. Thats added by replace-selection-text. -jep */
                     IF comment_lines > 1 AND line_count < comment_lines THEN
                       comment_text = comment_text + CHR(10).
                 END.
                 /* Support uncommenting of pre-9.1A comments. */
                 ASSIGN comment_text = REPLACE(comment_text, CHR(10) + " * ", CHR(10) ).
               END.
               ASSIGN New_Text = comment_text.
             END.
             
             ASSIGN Status_Error = p_Buffer:REPLACE-SELECTION-TEXT( New_Text ).
             ASSIGN Status_Error = p_Buffer:SET-SELECTION(start, p_Buffer:CURSOR-OFFSET).
       END.
       &IF "{&WINDOW-SYSTEM}" = "TTY" &THEN
       RUN DeselectText ( INPUT p_Buffer ).
       &ENDIF      
    END.
  END. /* DO ON STOP */
  
  /* Put focus back in editor widget. */
  APPLY "ENTRY" TO p_Buffer.

END PROCEDURE.  /* CommentSelection */


PROCEDURE CommentBox:
/*---------------------------------------------------------------------------

    Syntax       RUN CommentBox ( INPUT p_Buffer, INPUT pl_comment ) .
    
    Purpose      Box Comment/Uncomment the selected text in the p_Buffer Editor.

    Remarks      The p_Buffer widget is presumed to be of :TYPE = "EDITOR".
                 The value or pl_comment is logical and can be can be
                      YES   Add Comments
                      NO    Remove Comments
                      
                 Box Uncomment is not currently supported.

---------------------------------------------------------------------------*/

  DEFINE INPUT  PARAMETER p_Buffer    AS WIDGET-HANDLE NO-UNDO.
  DEFINE INPUT  PARAMETER pl_comment  AS LOGICAL       NO-UNDO.
  
  DEFINE VAR Status_Error   AS LOGICAL NO-UNDO.
  DEFINE VAR New_Text       AS CHAR    NO-UNDO.
  DEFINE VAR vWindow        AS WIDGET  NO-UNDO.
  DEFINE VAR start          AS INTEGER NO-UNDO.
  DEFINE VAR Comment_Start  AS INTEGER NO-UNDO.
  DEFINE VAR Comment_End    AS INTEGER NO-UNDO.
  DEFINE VAR Can_Uncomment  AS LOGICAL NO-UNDO.
  DEFINE VAR Last_Char      AS CHAR    NO-UNDO.
  DEFINE VAR CommmentDone   AS LOGICAL NO-UNDO.
  DEFINE VAR line_count     AS INTEGER NO-UNDO.
  DEFINE VAR comment_text   AS CHAR    NO-UNDO.
  DEFINE VAR line_text      AS CHAR    NO-UNDO.
  DEFINE VAR comment_lines  AS INTEGER NO-UNDO.
  DEFINE VAR max_line_width AS INTEGER NO-UNDO.

  DO ON STOP UNDO, LEAVE ON ERROR UNDO, LEAVE :

    &IF "{&WINDOW-SYSTEM}" = "TTY" &THEN
    RUN SelectSetEnd( INPUT p_Buffer ) .
    &ENDIF
   
    /* adecomm/peditor.i */
    RUN Comment_Box (INPUT p_Buffer, INPUT pl_comment, OUTPUT CommmentDone ).
    IF CommmentDone THEN RETURN.

    IF p_Buffer:TEXT-SELECTED
    THEN DO: /* Text is selected  */      
        ASSIGN vWindow = p_Buffer:FRAME
               vWindow = vWindow:PARENT  /* Window */
               .
        
        /* Excluding white space, determine if the selected text starts
           with "/*" and ends with "*/". */
        ASSIGN New_Text = TRIM(p_Buffer:SELECTION-TEXT) NO-ERROR.
        IF ( ERROR-STATUS:NUM-MESSAGES = 0 ) THEN
            ASSIGN Comment_Start = INDEX( New_Text , "/*":u )
                   Comment_End   = R-INDEX( New_Text , "*/":u )
                   Can_Uncomment = (Comment_Start = 1 AND
                                    Comment_End = LENGTH(New_Text, "CHARACTER":u) - 1)
                   NO-ERROR.

        /* Get the actual comment start and comment end locations. */
        ASSIGN Comment_Start = INDEX( p_Buffer:SELECTION-TEXT , "/*":u ) NO-ERROR.
        ASSIGN Comment_End   = R-INDEX( p_Buffer:SELECTION-TEXT , "*/":u ) NO-ERROR.
                   
        /* Can Progress ditem handle the text to be cut? */
        ASSIGN New_Text = p_Buffer:SELECTION-TEXT NO-ERROR.
        IF ( ERROR-STATUS:NUM-MESSAGES > 0 )
        THEN DO:
            MESSAGE "Selection is too large to comment." SKIP(1)
                    ERROR-STATUS:GET-MESSAGE(1)
                    VIEW-AS ALERT-BOX ERROR BUTTONS OK IN WINDOW vWindow.
        END.
        ELSE IF pl_comment eq NO AND NOT Can_Uncomment
        THEN DO: 
            MESSAGE 'Cannot uncomment selection.' SKIP
                    'Selected text must start with /* and end with */.'
                    VIEW-AS ALERT-BOX ERROR BUTTONS OK IN WINDOW vWindow.
        END.
        ELSE DO:
             ASSIGN start = p_Buffer:SELECTION-START.

             /* If last character is EOL, go one character before it for selection end.
                Otherwise, end comment is added to following line. */
             ASSIGN Last_Char = SUBSTRING(p_Buffer:SELECTION-TEXT, LENGTH(p_Buffer:SELECTION-TEXT, "CHARACTER":u)).
             IF Last_Char = CHR(10) THEN
             DO:
                 ASSIGN Status_Error = p_Buffer:SET-SELECTION(start, p_Buffer:SELECTION-END - 1) NO-ERROR.
                 ASSIGN New_Text = p_Buffer:SELECTION-TEXT NO-ERROR.
             END.

             /* If we are going to comment the section, then surround the 
                text with '/**/'. For multiple lines, enclose each line in
                comments. Reverse the process when we uncomment. */
             IF pl_comment EQ yes
             THEN DO:
               /* First scan the lines to comment for the maximum line width. */
               comment_lines = NUM-ENTRIES(New_Text, CHR(10)).
               COMMENT_CODE:
               DO line_count = 1 TO NUM-ENTRIES(New_Text, CHR(10)):
                 line_text = ENTRY(line_count, New_Text, CHR(10)).
                 max_line_width = MAX(max_line_width, LENGTH(line_text, "CHARACTER":U)).
               END.
               comment_text = " " + REPLACE(new_text, CHR(10), CHR(10) + " ":U).
               /* Now add a comment box line before and after the selected text. */
               comment_text = "/*":u + FILL('*':u, MAX(max_line_width, 1)) + CHR(10) +
                              comment_text + CHR(10) +
                              FILL('*':u, MAX(max_line_width, 1)) + "*/":u NO-ERROR.
                              
               New_Text = comment_text.
             END.
             ELSE DO:
               /* Uncomment Box not supported. */
             END.
             ASSIGN Status_Error = p_Buffer:REPLACE-SELECTION-TEXT( New_Text ).
             ASSIGN Status_Error = p_Buffer:SET-SELECTION(start, p_Buffer:CURSOR-OFFSET).
       END.
       &IF "{&WINDOW-SYSTEM}" = "TTY" &THEN
       RUN DeselectText ( INPUT p_Buffer ).
       &ENDIF      
    END.
  END. /* DO ON STOP */
  
  /* Put focus back in editor widget. */
  APPLY "ENTRY" TO p_Buffer.

END PROCEDURE.  /* CommentBox */


PROCEDURE InsertFile.
  /*--------------------------------------------------------------------------
    Purpose:        Executes the INSERT command, which reads a file into the
                    current cursor position of the current editor file.

    Run Syntax:     RUN InsertFile ( INPUT p_Buffer ).

    Parameters:
	INPUT
		p_Buffer	WIDGET-HANDLE
	                Edit Buffer handle to insert file into.

    Description:

    Notes:
  ---------------------------------------------------------------------------*/

  DEFINE INPUT PARAMETER p_Buffer AS WIDGET-HANDLE NO-UNDO .

  DEFINE VARIABLE Dlg_Answer   AS LOGICAL   NO-UNDO.
  DEFINE VARIABLE File_Name    AS CHARACTER NO-UNDO.
  DEFINE VARIABLE h_cwin       AS WIDGET    NO-UNDO.
  DEFINE VARIABLE Insert_File  AS CHARACTER NO-UNDO.
  DEFINE VARIABLE Insert_OK    AS LOGICAL   NO-UNDO.
  DEFINE VARIABLE Pressed_OK   AS LOGICAL   NO-UNDO.
  DEFINE VARIABLE Remote_File  AS CHARACTER NO-UNDO.
  DEFINE VARIABLE vWindow      AS WIDGET    NO-UNDO.
  DEFINE VARIABLE Web_File     AS LOGICAL   NO-UNDO.
  
  INSERT_BLOCK:
  DO WHILE TRUE ON STOP UNDO , LEAVE :
  
    ASSIGN 
      vWindow        = p_Buffer:FRAME
      vWindow        = vWindow:PARENT /* Window */
      h_cwin         = CURRENT-WINDOW /* Save current-window to restore later. */
      CURRENT-WINDOW = vWindow.
           
    /* Insert file on remote WebSpeed agent. */
    IF SEARCH("adeuib/_uibinfo.r":U) <> ? THEN
        RUN adeuib/_uibinfo.p (?, "SESSION":U, "REMOTE":U, 
                               OUTPUT Remote_File) NO-ERROR.
    IF Remote_File = "TRUE":U AND vWindow:PRIVATE-DATA = "_ab.p":U THEN
      RUN adeweb/_webfile.w ("uib":U, "Open":U, "Open":U, "":U,
                             INPUT-OUTPUT File_Name, OUTPUT Insert_File, 
                             OUTPUT Pressed_OK) NO-ERROR.
    
    /* Insert local file. */
    ELSE
      RUN adeedit/_dlggetf.p 
        ( INPUT "Insert File" ,
          INPUT NO ,
          INPUT 1 /* Initial_Filter */ ,
          INPUT-OUTPUT Insert_File ,
          OUTPUT Pressed_OK ) .
  
    IF ( Pressed_OK = NO ) THEN LEAVE INSERT_BLOCK.

    ASSIGN Insert_OK = p_Buffer:INSERT-FILE( Insert_File ) NO-ERROR.
    IF ( Insert_OK = NO ) THEN
      RUN adecomm/_s-alert.p (INPUT-OUTPUT Dlg_Answer, "error":U, "ok":U,
        SUBSTITUTE("&1^Unable to find or open file.^^The file may not exist or may be too large to insert into the current buffer.", 
        Insert_File)).
    LEAVE INSERT_BLOCK.
    
  END.  /* DO INSERT_BLOCK. */

  /* Repoint current-window. */
  IF VALID-HANDLE( h_cwin ) THEN ASSIGN CURRENT-WINDOW = h_cwin .

  APPLY "ENTRY":U TO p_Buffer .
  RETURN.

END PROCEDURE.  /* InsertFile. */

PROCEDURE FieldSelector.
  /*--------------------------------------------------------------------------
    Purpose:        Allows user to select database fields to insert
                    into the current buffer.

    Run Syntax:     RUN FieldSelector.

    Parameters:     

    Description:

    Notes:
  ---------------------------------------------------------------------------*/
  DEFINE INPUT PARAMETER p_Buffer AS WIDGET-HANDLE NO-UNDO.
  
  DEFINE VARIABLE v_Schema_Fields AS CHARACTER NO-UNDO.
  DEFINE VARIABLE Function_Return AS LOGICAL   NO-UNDO.
  DEFINE VARIABLE OK_Pressed      AS LOGICAL   NO-UNDO.
  DEFINE VARIABLE h_cwin          AS WIDGET    NO-UNDO.
  DEFINE VARIABLE vWindow         AS WIDGET    NO-UNDO.

  /*--------------------------------------------------------------------------
     Make sure the tool can be found.
  ---------------------------------------------------------------------------*/
  DO ON STOP UNDO, LEAVE:
    ASSIGN vWindow = p_Buffer:FRAME
           vWindow = vWindow:PARENT   /* Window */
    . /* ASSIGN */
    /* Save current-window handle to restore later. */
    ASSIGN h_cwin         = CURRENT-WINDOW
           CURRENT-WINDOW = vWindow.
    
    RUN adecomm/_fldsel.p
    ( INPUT TRUE /* p_Multi */ ,
      INPUT ?    /* data type */ ,
      INPUT ?    /* tt info */ ,
      INPUT-OUTPUT Ed_Schema_Prefix ,
      INPUT-OUTPUT Ed_Schema_Database ,
      INPUT-OUTPUT Ed_Schema_Table ,
      INPUT-OUTPUT v_Schema_Fields ,
      OUTPUT OK_Pressed )   NO-ERROR.
  END. /* DO ON STOP */
  
  /* Repoint current-window. */
  IF VALID-HANDLE( h_cwin ) THEN ASSIGN CURRENT-WINDOW = h_cwin .

  IF OK_Pressed = FALSE THEN RETURN.  /* User cancelled Schema Pick. */
 
  /*--------------------------------------------------------------------------
     If text is selected, replace it with field list.  Otherwise, insert 
     field list at current insert point.
  ---------------------------------------------------------------------------*/
  v_Schema_Fields = REPLACE( v_Schema_Fields , "," , " " ).
  IF ( p_Buffer:TEXT-SELECTED )
    THEN Function_Return = p_Buffer:REPLACE-SELECTION-TEXT( v_Schema_Fields ).
    ELSE Function_Return = p_Buffer:INSERT-STRING( v_Schema_Fields ).

END PROCEDURE.  /* FieldSelector. */


&IF "{&WINDOW-SYSTEM}" = "TTY" &THEN
/* These Procedures are used for text selection in TTY only. */
PROCEDURE SelectSetStart.
  /*--------------------------------------------------------------------------
    Purpose:        Sets the selection start mark for TTY Editor.

    Run Syntax:     RUN SelectSetStart( INPUT p_Buffer ).

    Parameters:
        INPUT
            p_Buffer    WIDGET-HANDLE
                Edit Buffer handle.

    Description:

    Notes:
  ---------------------------------------------------------------------------*/

  DEFINE INPUT PARAMETER p_Buffer AS WIDGET-HANDLE NO-UNDO .
  
  DEFINE VARIABLE Error_Status AS LOGICAL NO-UNDO.
  
  IF ( SESSION:WINDOW-SYSTEM <> "TTY" ) THEN RETURN.

  IF ( p_Buffer:EMPTY )
  THEN RUN DeselectText( INPUT p_Buffer ).
  ELSE DO:
      Edit_Selection_Start = p_Buffer:CURSOR-OFFSET .
      Edit_Selection_End   = ?.
  END.

END PROCEDURE .

PROCEDURE SelectSetEnd.
  /*--------------------------------------------------------------------------
    Purpose:        Sets the selection end mark for TTY Editor.

    Run Syntax:     RUN SelectSetEnd( INPUT p_Buffer ).

    Parameters:
        INPUT
            p_Buffer    WIDGET-HANDLE
                Edit Buffer handle.

    Description:

    Notes:
  ---------------------------------------------------------------------------*/

  DEFINE INPUT PARAMETER p_Buffer AS WIDGET-HANDLE NO-UNDO .

  DEFINE VARIABLE Error_Status AS LOGICAL NO-UNDO .

  IF ( SESSION:WINDOW-SYSTEM <> "TTY" ) THEN RETURN.

  IF ( p_Buffer:EMPTY ) OR ( Edit_Selection_Start = ? )
  THEN RUN DeselectText( INPUT p_Buffer ).
  ELSE DO:
      Edit_Selection_End  = p_Buffer:CURSOR-OFFSET .
      Error_Status        = p_Buffer:SET-SELECTION( Edit_Selection_Start ,
                                                    Edit_Selection_End ) .
  END.

END PROCEDURE .


PROCEDURE DeselectText .
  /*--------------------------------------------------------------------------
    Purpose:        Deselects any currently Selected Text (Used for TTY Only).

    Run Syntax:     RUN DeselectText( INPUT p_Buffer ).

    Parameters:
        INPUT
            p_Buffer    WIDGET-HANDLE
                Edit Buffer handle.

    Description:

    Notes:
  ---------------------------------------------------------------------------*/

  DEFINE INPUT PARAMETER p_Buffer AS WIDGET-HANDLE NO-UNDO .
  
  DEFINE VARIABLE Error_Status AS LOGICAL NO-UNDO.


  IF ( SESSION:WINDOW-SYSTEM <> "TTY" ) THEN RETURN.

  Edit_Selection_Start = ?.
  Edit_Selection_End   = ?.  
  IF ( p_Buffer:EMPTY ) THEN RETURN.

  Error_Status         = p_Buffer:CLEAR-SELECTION().

END PROCEDURE .

/* TTY Only PROCEDURES */
&ENDIF

PROCEDURE EditHelp .
/*---------------------------------------------------------------------------
    Purpose:    Invokes PROGRESS On-Line Language Reference Help to
                search for keyword help on code selected in an editor
                widget.
                
    Syntax:     RUN EditHelp ( INPUT p_Editor    ,
                               INPUT p_Tool_Name ,
                               INPUT p_Context ) .

    Parameters:
    
    Description:
                If p_Editor has text selected, partial help is invoked to
                search for the selected text in the Progress On-line Language 
                Reference.  Otherwise, help is invoked for the specified
                ADE Tool (p_Tool_Name) and context (p_Context).
    Notes  :
                This internal procedure calls an external procedure
                adecomm/_kwhelp.p with the same parameters to perform
                the actual Keyword Help processing. See that procedure
                for further details on parameters, comments, etc..

    Authors: John Palazzo
---------------------------------------------------------------------------*/

DEFINE INPUT PARAMETER p_Editor    AS WIDGET-HANDLE NO-UNDO.
DEFINE INPUT PARAMETER p_Tool_Name AS CHARACTER     NO-UNDO.
DEFINE INPUT PARAMETER p_Context   AS INTEGER       NO-UNDO.

DO ON STOP UNDO, LEAVE:

    RUN adecomm/_kwhelp.p ( INPUT p_Editor    ,
                            INPUT p_Tool_Name ,
                            INPUT p_Context ) .
END.

END PROCEDURE.


PROCEDURE ApplyTab.
/*---------------------------------------------------------------------------
    Syntax      
        RUN ApplyTab ( INPUT p_Editor ,
                       INPUT p_Return_Error ).
    
    Purpose     
        Inserts a Tab-space into an editor widget.
    
    Description
        Instead of a TAB CHAR, this routine inserts enough spaces
        to position the text cursor at a "tab stop". If text is selected,
        its indented to next tab stop, provided selection starts at leftmost
        margin of edit area. Otherwise, selected text is indented by a full
        tab.
                
    Remarks      
        The p_Editor widget is presumed to be of :TYPE = "EDITOR".
                
        Here is a sample call.  The example is for a simple
        UI Trigger.
                
            ON TAB,CTRL-TAB OF e IN FRAME y
            DO:
              RUN ApplyTab( e:HANDLE , NO ).
              RETURN NO-APPLY.
            END.
            
        For a PERSISTENT Trigger, here is a sample call:
        
            ON TAB,CTRL-TAB PERSISTENT
                RUN ApplyTab( e:HANDLE , YES ). 

               
    Return Value NONE.
---------------------------------------------------------------------------*/

  DEFINE INPUT PARAMETER p_Editor       AS WIDGET-HANDLE.
  DEFINE INPUT PARAMETER p_Return_Error AS LOGICAL.
  
  DEFINE VAR Tab_Char AS CHAR    INIT " " NO-UNDO.
  DEFINE VAR Tab_Stop AS INTEGER INIT 4   NO-UNDO.
  DEFINE VAR Tab_Over AS INTEGER NO-UNDO.
  DEFINE VAR Temp     AS LOGICAL NO-UNDO.
  DEFINE VAR TabDone  AS LOGICAL NO-UNDO.

  DO:
  &IF ( "{&WINDOW-SYSTEM}" <> "TTY" ) &THEN

  &IF DEFINED(ADESTDSI) <> 0 &THEN
  ASSIGN Tab_Stop = editor_tab WHEN editor_tab <> ?. /* From adestds.i */
  &ENDIF

  /* adecomm/peditor.i */
  RUN Apply_Tab ( INPUT p_Editor , OUTPUT TabDone ).
  IF TabDone THEN RETURN.
                 
  IF ( p_Editor:TEXT-SELECTED ) THEN
  DO: /* Text selected: Indent it. */
      ASSIGN Tab_Over = LENGTH(p_Editor:SELECTION-TEXT, "CHARACTER":u) -
                        LENGTH(LEFT-TRIM(p_Editor:SELECTION-TEXT), "CHARACTER":u) NO-ERROR.
      IF Tab_Over > 0 THEN
      DO:
        ASSIGN Tab_Over = ( Tab_Stop - ( Tab_Over MOD Tab_Stop ) ) /*  + 1 */ .
        ASSIGN Tab_Over = ( Tab_Over - Tab_Stop ) WHEN Tab_Over > Tab_Stop.
      END.
      ELSE
        Tab_Over = Tab_Stop.
      RUN IndentSelection (INPUT p_Editor , INPUT Tab_Over).
  END.
  ELSE
  DO: /* Otherwise, insert TAB.    */ 
      ASSIGN Tab_Over = ( Tab_Stop - ( p_Editor:CURSOR-CHAR MOD Tab_Stop ) ) + 1.
      ASSIGN Tab_Over = ( Tab_Over - Tab_Stop ) WHEN Tab_Over > Tab_Stop.
      ASSIGN Temp = p_Editor:INSERT-STRING( FILL(Tab_Char , Tab_Over) ).
  END.
  
  &ELSE
  /* In TTY, so just execute the TTY editor widget insert-tab method. */
  Temp = p_Editor:INSERT-TAB().
  &ENDIF
  
  END.
  
  IF p_Return_Error THEN RETURN ERROR.
END PROCEDURE.


PROCEDURE ApplyBackTab .
/*---------------------------------------------------------------------------
    Syntax      
        RUN ApplyBackTab ( INPUT p_Editor ,
                           INPUT p_Return_Error ).
    
    Purpose     
        Moves cursor back to a space tab-stop in an editor widget.

    Description
        If text is selected, its unindented to next tab stop, provided
        selection starts at leftmost margin of edit area. Otherwise,
        selected text is unindented by a full tab.
        
    Remarks      
        The p_Editor widget is presumed to be of :TYPE = "EDITOR".
                
        Here is a sample call.  The example is for a simple
        UI Trigger.
                
            ON BACK-TAB,SHIFT-TAB OF e IN FRAME y
            DO:
              RUN ApplyBackTab( e:HANDLE , NO ).
              RETURN NO-APPLY.
            END.
            
        For a PERSISTENT Trigger, here is a sample call:
        
            ON BACK-TAB,SHIFT-TAB PERSISTENT
                RUN ApplyBackTab( e:HANDLE , YES ). 

    Return Value NONE.
---------------------------------------------------------------------------*/

  DEFINE INPUT PARAMETER p_Editor       AS WIDGET-HANDLE.
  DEFINE INPUT PARAMETER p_Return_Error AS LOGICAL.

  DEFINE VAR Tab_Char AS CHAR    INIT " " NO-UNDO.
  DEFINE VAR Tab_Stop AS INTEGER INIT 4   NO-UNDO.
  DEFINE VAR Tab_Over AS INTEGER NO-UNDO.
  DEFINE VAR Tab_Back AS INTEGER NO-UNDO.
  DEFINE VAR Temp     AS LOGICAL NO-UNDO.
  DEFINE VAR BackTabDone AS LOGICAL NO-UNDO.

  &IF ( "{&WINDOW-SYSTEM}" = "TTY" ) &THEN
  Temp = p_Editor:INSERT-BACKTAB().
  &ELSE
  DO:

    &IF DEFINED(ADESTDSI) <> 0 &THEN
    ASSIGN Tab_Stop = editor_tab WHEN editor_tab <> ?. /* From adestds.i */
    &ENDIF

    /* adecomm/peditor.i */
    RUN Apply_BackTab ( INPUT p_Editor , OUTPUT BackTabDone ).
    IF BackTabDone THEN RETURN.

    IF ( p_Editor:TEXT-SELECTED ) THEN
    DO: /* Text selected: Unindent it. */
      ASSIGN Tab_Over = LENGTH(p_Editor:SELECTION-TEXT, "CHARACTER":u) -
                        LENGTH(LEFT-TRIM(p_Editor:SELECTION-TEXT), "CHARACTER":u) NO-ERROR.
      IF Tab_Over > 0 THEN
      DO:
        ASSIGN Tab_Over = ( Tab_Stop - ( Tab_Over MOD Tab_Stop ) ) /*  + 1 */ .
        ASSIGN Tab_Over = ( Tab_Over - Tab_Stop ) WHEN Tab_Over > Tab_Stop.
      END.
      ELSE
        Tab_Over = Tab_Stop.
      ASSIGN Tab_Back = Tab_Over.
      RUN IndentSelection (INPUT p_Editor , INPUT - (Tab_Back) ).
    END.
    ELSE
    DO: /* Otherwise, backtab.    */ 
      Tab_Over = ( Tab_Stop - ( p_Editor:CURSOR-CHAR MOD Tab_Stop ) ) + 1.
      Tab_Back = ( Tab_Stop - ( Tab_Over MOD Tab_Stop ) ).
      IF ( p_Editor:CURSOR-CHAR - Tab_Back < 1 )
      THEN
          ASSIGN p_Editor:CURSOR-CHAR = 1 NO-ERROR.   
      ELSE
          ASSIGN p_Editor:CURSOR-CHAR = ( p_Editor:CURSOR-CHAR - Tab_Back ) NO-ERROR.
    END.

  END.
  &ENDIF

  IF p_Return_Error THEN RETURN ERROR.
END PROCEDURE.

/* Additional editor procedures. */
{adecomm/peditor.i}
/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/*----------------------------------------------------------------------

File: prtrpt.i

Description:
   Code to set up correct output device and headers for printing.

Arguments:
   &Header - page header string
   &Flags  - Flags string
   &dev    - output device
   &app    - append option
   &siz    - page size
   &Func   - Call to routine that's generates report.
 
Author: Laura Stern

Date Created: 10/12/92

History:
    hutegger    95/05   Added PRINTER-support (output to printer...)
    
----------------------------------------------------------------------*/
/*h-*/

DEFINE VARIABLE h_datetime AS CHARACTER   NO-UNDO.

/* Header with Page specification */
FORM HEADER
   h_datetime FORMAT "x(17)" SPACE(7) "PROGRESS Report"
     "Page" AT 70 PAGE-NUMBER (rpt) FORMAT "ZZZ9" SKIP
   {&Header} FORMAT "x(80)" SKIP(1)
   {&Flags}  FORMAT "x(80)" SKIP
   WITH FRAME page_head_paged
   PAGE-TOP NO-LABELS NO-BOX NO-ATTR-SPACE NO-UNDERLINE USE-TEXT STREAM-IO.

/* Header for continuous output (no page #) */
FORM HEADER
   h_datetime FORMAT "x(17)" SPACE(7) "PROGRESS Report"
   SKIP
   {&Header} FORMAT "x(80)" SKIP(1)
   {&Flags}  FORMAT "x(80)" SKIP
   WITH FRAME page_head_cont
   PAGE-TOP NO-LABELS NO-BOX NO-ATTR-SPACE NO-UNDERLINE USE-TEXT STREAM-IO.

run adecomm/_setcurs.p ("WAIT").
DO ON STOP UNDO, LEAVE:
  IF {&dev} BEGINS "|"
   THEN OUTPUT STREAM rpt
        THROUGH VALUE(SUBSTRING({&dev},2,-1,"character":u)) 
	PAGE-SIZE VALUE({&siz}).
  ELSE IF {&dev} = "PRINTER"
   THEN OUTPUT STREAM rpt TO PRINTER.
  ELSE IF {&app}
   THEN OUTPUT STREAM rpt TO VALUE({&dev}) PAGE-SIZE VALUE({&siz}) APPEND.
   ELSE OUTPUT STREAM rpt TO VALUE({&dev}) PAGE-SIZE VALUE({&siz}).
  
  h_datetime = STRING(TODAY) + " " + STRING(TIME,"HH:MM:SS").
  
  if {&siz} = 0 then
     VIEW STREAM rpt FRAME page_head_cont.
  else	 
     VIEW STREAM rpt FRAME page_head_paged.
  
  RUN {&Func}.
  
  OUTPUT STREAM rpt CLOSE.
END.
run adecomm/_setcurs.p ("").

/*--------------------------------------------------------------------*/
/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/*****************************************************************************
  File        : pruntool.i
  Purpose     : Internal Procedures for determining if procedures are
                running, etc.

  Syntax      : 
                  { adecomm/pruntool.i }
                  
  Description : 

  Notes:

  Author      : John Palazzo
  Date Created: 04/02/93
*****************************************************************************/


PROCEDURE ProgramIsRunning .
/*----------------------------------------------------------------------------
  Purpose     : Returns TRUE if a specified procedure is actively running
                in the PROGRESS session.  Returns FALSE otherwise.
  Syntax      : 
                  RUN ProgramIsRunning( INPUT  p_Program_Name , 
                                        OUTPUT p_Program_IsRunning ) .
                  
  Description : 
  
  Author      : John Palazzo
  Date Created: 04/02/93
----------------------------------------------------------------------------*/

    DEFINE INPUT  PARAMETER p_Program_Name      AS CHAR .
    DEFINE OUTPUT PARAMETER p_Program_IsRunning AS LOGICAL.

    DEFINE VAR Programs_List AS CHAR .
    DO : /* proc-main */
        
        RUN ProgramsRunning( OUTPUT Programs_List ) .
        p_Program_IsRunning = ( LOOKUP( p_Program_Name , Programs_List ) > 0 ).
    
    END . /* proc-main */
    
END PROCEDURE .


PROCEDURE ProgramsRunning .
/*----------------------------------------------------------------------------
  Purpose     : Returns comma-delimited list of procedure names the current 
                PROGRESS session is actively running.
  Syntax      : 
                  RUN ProgramsRunning ( OUTPUT p_Programs_List ) .
                  
  Description : Loops through PROGRAM-NAME function and builds comma-delimited
                list.  DOES include itself in the list.

  Author      : John Palazzo
  Date Created: 04/02/93
----------------------------------------------------------------------------*/

    DEFINE OUTPUT PARAMETER p_Programs_List AS CHAR .

    DEFINE VAR ProgramN AS INTEGER .

 
    DO : /* proc-main */

        ASSIGN
            ProgramN = 1 
            .
        REPEAT WHILE ( PROGRAM-NAME( ProgramN ) <> ? ) :
            MESSAGE PROGRAM-NAME( ProgramN ) 
                VIEW-AS ALERT-BOX.
            p_Programs_List = p_Programs_List + "," + PROGRAM-NAME( ProgramN ) .
            ProgramN        = ProgramN + 1 .
        END . /* DO WHILE */

    END . /* proc-main */
    
END PROCEDURE .

PROCEDURE RunBy.
/*----------------------------------------------------------------------------
  Purpose     : Returns the name of the calling procedure.

  Syntax      : 
                  RUN RunBy ( INPUT p_Level , OUTPUT p_Program_Name ) .
                  
  Description : p_Level is the level up from the current program that
                you want to know the calling program name.

  Author      : John Palazzo
  Date Created: 09/08/95
----------------------------------------------------------------------------*/

  DEFINE INPUT  PARAMETER p_Level         AS INTEGER   NO-UNDO .
  DEFINE OUTPUT PARAMETER p_Program_Name  AS CHARACTER NO-UNDO INITIAL ?.

  DEFINE VAR ProgramN AS INTEGER NO-UNDO.
  DEFINE VAR Num_Runs AS INTEGER NO-UNDO.
 
  DO : /* proc-main */
      IF p_Level = 0 THEN RETURN.
       
      /* Start above this internal procedure and it caller. */
      ASSIGN ProgramN = 3 .
      
      IF p_Level = ? THEN
      DO:
        DO WHILE TRUE:
          IF PROGRAM-NAME(ProgramN) <> ? THEN
            ASSIGN ProgramN = ProgramN + 1.
          ELSE
          DO:
            ASSIGN p_Program_Name = PROGRAM-NAME(ProgramN - 1).
            LEAVE.
          END.
        END.
        RETURN.
      END.

      DO WHILE ( PROGRAM-NAME( ProgramN ) <> ? ) :
        IF NUM-ENTRIES(PROGRAM-NAME(ProgramN) , " ":U) = 1 THEN
        DO:
          ASSIGN Num_Runs = Num_Runs + 1.
          IF Num_Runs = p_Level THEN
          DO:
              ASSIGN p_Program_Name = PROGRAM-NAME(ProgramN).
              RETURN.
          END.
        END.
        
        ASSIGN ProgramN = ProgramN + 1.
        IF PROGRAM-NAME(ProgramN) = ? THEN
        DO:
            ASSIGN p_Program_Name = PROGRAM-NAME(ProgramN - 1).
            RETURN.
        END.
      END . /* DO WHILE */

  END . /* proc-main */
  
END PROCEDURE .

/*  DEFINE VAR l_Level         AS INTEGER   NO-UNDO .
 *   DEFINE VAR l_Program_Name  AS CHARACTER NO-UNDO .
 * 
 * run runby ( 1 , OUTPUT l_Program_Name ).
 * message l_Program_Name view-as alert-box title "Run By".
 * */
/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/***************************************************************************
  psearch.i
  Search Procedures for Editor.
***************************************************************************/

/* jep note source-editor - temp define */
&SCOPED-DEFINE FIND-REPEAT-LAST 64

PROCEDURE FindText.
 
/*--------------------------------------------------------------------------
    Purpose:        Executes the FIND command, which allows user to
                    search for specific text strings in the edit buffer.

    Run Syntax:     RUN FindText (INPUT p_Buffer ) .

    Parameters:
    
          INPUT
                    p_Buffer  (WIDGET-HANDLE)
                            Handle to edit buffer to perform Find on.

    Description:

    Notes:
        <EDITOR>:SEARCH Invalid Flag combinations are:

        (FIND-NEXT-OCCURRENCE + FIND-PREV-OCCURRENCE)  or  (FIND-GLOBAL)
 
---------------------------------------------------------------------------*/

  DEFINE INPUT PARAMETER p_Buffer AS WIDGET-HANDLE NO-UNDO.

  DEFINE VAR vWindow        AS WIDGET-HANDLE NO-UNDO.
  
  ON HELP OF FRAME FindText ANYWHERE
    RUN adecomm/_srchhlp.p( INPUT "Find_Dialog_Box" ).
  ON CHOOSE OF btn_Find_Help IN FRAME FindText 
    RUN adecomm/_srchhlp.p( INPUT "Find_Dialog_Box" ).

  ON GO OF FRAME FindText 
  DO:
    HIDE FRAME FindText NO-PAUSE.
    
    Find_Command = IF Find_Direction:SCREEN-VALUE IN FRAME FindText = "DOWN"
                    THEN FIND-NEXT-OCCURRENCE
                    ELSE FIND-PREV-OCCURRENCE.
    ASSIGN
      Find_Text = INPUT FRAME FindText Find_Text
      INPUT FRAME FindText Find_Filters[1]
      INPUT FRAME FindText Find_Filters[2]
      INPUT FRAME FindText Find_Direction
      Find_Executed = TRUE.
    
    /* Allow user to search for question mark ( ? ). Needs special handling. */
    RUN MakeQMark ( INPUT-OUTPUT Find_Text , INPUT p_Buffer:LARGE ).
    RUN FindAssign ( OUTPUT Find_Criteria ) .
    RUN FindAgain (INPUT p_Buffer , 
                   INPUT Find_Command , INPUT Find_Criteria ).
  END.

  ON WINDOW-CLOSE OF FRAME FindText
  DO:
    APPLY "END-ERROR" TO FRAME FindText.
  END.
                                           
  &IF ( "{&WINDOW-SYSTEM}" <> "TTY" ) &THEN
  /* If text is selected (highlighted), use as default Find_Text. GUI Only. */
  IF p_Buffer:TEXT-SELECTED
      THEN ASSIGN Find_Text = p_Buffer:SELECTION-TEXT .
  &ENDIF
    
  DLG_FIND:
  DO ON ENDKEY UNDO DLG_FIND , LEAVE DLG_FIND : 
    ASSIGN vWindow    = p_Buffer:FRAME
           vWindow    = vWindow:PARENT   /* Window */
           Search_All = FALSE
    . /* ASSIGN */

    DISPLAY
      Find_Direction Find_Filters[1] 
      Find_Direction Find_Filters[2] 
      WITH FRAME FindText IN WINDOW vWindow.
    ENABLE ALL EXCEPT btn_Find_Help WITH FRAME FindText.
    ENABLE btn_Find_Help {&WHEN_HELP} WITH FRAME FindText.
    UPDATE Find_Text WITH FRAME FindText.
  END.

  HIDE FRAME FindText NO-PAUSE.
  APPLY "ENTRY" TO p_Buffer .

END PROCEDURE.        /* FindText */



PROCEDURE ReplaceText.
 
/*--------------------------------------------------------------------------
    Purpose:        Executes the REPLACE command, which allows user to
                    search for specific text strings in the edit buffer
                    and replace them with different strings.

    Run Syntax:     RUN ReplaceText ( INPUT p_Buffer ) .

    Parameters:
          INPUT
                    p_Buffer  (WIDGET-HANDLE)
                            Handle to edit buffer to perform Replace on.

    Description:

    Notes:

        <EDITOR>:REPLACE Invalid Flag combinations are:

            (FIND-NEXT-OCCURRENCE + FIND-PREV-OCCURRENCE)  or
            (SELECT) or (FIND-GLOBAL + FIND-WRAP-AROUND)
 
---------------------------------------------------------------------------*/
  
  DEFINE INPUT PARAMETER p_Buffer AS WIDGET-HANDLE NO-UNDO.

  DEFINE VAR vWindow        AS WIDGET-HANDLE NO-UNDO.
  DEFINE VAR Pressed_Cancel AS LOGICAL       NO-UNDO.
  DEFINE VAR Case_Text      AS CHARACTER CASE-SENSITIVE NO-UNDO.
  DEFINE VAR mystat         AS LOGICAL      NO-UNDO.
  ON HELP OF FRAME ReplaceText ANYWHERE
    RUN adecomm/_srchhlp.p ( INPUT "Replace_Dialog_Box" ).
  ON CHOOSE OF btn_Replace_Help IN FRAME ReplaceText 
    RUN adecomm/_srchhlp.p ( INPUT "Replace_Dialog_Box" ).

  ON WINDOW-CLOSE OF FRAME ReplaceText
  DO:
    APPLY "END-ERROR" TO FRAME ReplaceText.
  END.
  
  ON GO OF FRAME ReplaceText 
  DO:
    HIDE FRAME ReplaceText NO-PAUSE.

    ASSIGN
        Find_Text    = INPUT FRAME ReplaceText Find_Text
        Replace_Text = INPUT FRAME ReplaceText Replace_Text
        INPUT FRAME ReplaceText Replace_Filters[1]
/* Wrap not currently supported for Replace.
        INPUT FRAME ReplaceText Replace_Filters[2]
*/
        &IF DEFINED(SEARCH_ALL) <> 0 &THEN
        INPUT FRAME ReplaceText Search_Filters[1]
        &ENDIF
     . /* END ASSIGN */
    
    /* Supports searching multiple "sections", ie Section Editor. */
    ASSIGN Search_All = Search_Filters[1].
    
    /* Allow user to search for question mark ( ? ). Needs special handling. */
    RUN MakeQMark ( INPUT-OUTPUT Find_Text , INPUT p_Buffer:LARGE ).
    /* For replace text, convert unknown value to single question mark only. */
    IF Replace_Text = ? THEN
        ASSIGN Replace_Text = "?".

    &IF ( "{&WINDOW-SYSTEM}" <> "TTY" ) &THEN
    /* If case sensitive search and text selected does not match exactly the
       text user entered, clear internal var to skip selected text.
       taj: bug 19981015-051 also clear the 'real' selection so it will
       re-select it later.
     */
    ASSIGN Case_Text = Find_Sel_Text.
    IF Replace_Filters[1] AND (Find_Text <> Case_Text) THEN DO:
        mystat = p_buffer:CLEAR-SELECTION().
        ASSIGN Find_Sel_Text = "".
    END.
    &ENDIF

    IF ( SESSION:WINDOW-SYSTEM = "TTY" ) THEN
        APPLY "ENTRY" TO p_Buffer.  /* Focus must be here for replace. */
    RUN ReplaceConfirm ( INPUT p_Buffer ).    
  END.        /* Replace OK Pressed. */

  ON CHOOSE OF btn_Replace_All IN FRAME ReplaceText
  DO:
    ASSIGN
        Find_Text    = INPUT FRAME ReplaceText Find_Text
        Replace_Text = INPUT FRAME ReplaceText Replace_Text
        INPUT FRAME ReplaceText Replace_Filters[1]
/* Wrap not currently supported for Replace.
        INPUT FRAME ReplaceText Replace_Filters[2]
*/
        &IF DEFINED(SEARCH_ALL) <> 0 &THEN
        INPUT FRAME ReplaceText Search_Filters[1]
        &ENDIF
     . /* END ASSIGN */
    
    /* Supports searching multiple "sections", ie Section Editor. */
    ASSIGN Search_All = Search_Filters[1].

    HIDE FRAME ReplaceText NO-PAUSE.
    RUN ReplaceAll ( INPUT p_Buffer ) .
    
  END.        /* Replace OK Pressed. */

  DO: /* Replace Main */
    ASSIGN  Replace_Criteria    = 0
            Last_Replace_Find   = FIND-NEXT-OCCURRENCE + FIND-SELECT
            Find_Sel_Text       = p_Buffer:SELECTION-TEXT
          &IF NOT "{&WINDOW-SYSTEM}" BEGINS "MS-WIN" &THEN
          /* MSW LARGE ED does not support SELECTION-START/END.  Under MSW,
             the Editor widget maintains a highlight, so we don't need
             to set them. */
            Find_Sel_Start      = p_Buffer:SELECTION-START
            Find_Sel_End        = p_Buffer:SELECTION-END
          &ENDIF
    . /* END ASSIGN. */

    &IF ( "{&WINDOW-SYSTEM}" <> "TTY" ) &THEN
    /* Supported under GUI platforms only. */
    IF ( Find_Sel_Text <> "" ) THEN ASSIGN Find_Text = Find_Sel_Text .
    &ENDIF
   
    ASSIGN vWindow = p_Buffer:FRAME
           vWindow = vWindow:PARENT   /* Window */
    . /* ASSIGN */

    /* Global Search in Section Editor always sets to False. */
    ASSIGN Search_Filters[1] = FALSE.
    
    DISPLAY  Replace_Filters[1]
/* Wrap not currently supported for Replace. */
/*           Replace_Filters[2]              */
             &IF DEFINED(SEARCH_ALL) <> 0 &THEN
             Search_Filters[1]
             &ENDIF
             WITH FRAME ReplaceText IN WINDOW vWindow.
    ENABLE ALL EXCEPT btn_Replace_Help WITH FRAME ReplaceText.
    ENABLE btn_Replace_Help {&WHEN_HELP} WITH FRAME ReplaceText.

    DLG_REPLACE:
    DO ON STOP   UNDO DLG_REPLACE , RETRY DLG_REPLACE
       ON ENDKEY UNDO DLG_REPLACE , RETRY DLG_REPLACE :
      IF RETRY THEN
      DO:
        ASSIGN Pressed_Cancel = TRUE.
        LEAVE DLG_REPLACE.
      END.
      UPDATE Find_Text Replace_Text
            GO-ON ( CHOOSE OF btn_Replace_All )
            WITH FRAME ReplaceText.
    END.
    
    HIDE FRAME ReplaceText NO-PAUSE.
    APPLY "ENTRY" TO p_Buffer .

    IF Search_All AND Pressed_Cancel THEN RETURN "_CANCEL":U.

  END. /* Replace Main */
  
END PROCEDURE.        /* ReplaceText */



PROCEDURE ReplaceConfirm .
 
/*--------------------------------------------------------------------------
    Purpose:        Executes the REPLACE CONFIRM command, which confirms
                    with user before replacing each occurrence of the Find 
                    Text with the Replace Text.

    Run Syntax:     RUN ReplaceConfirm ( INPUT p_Buffer ) .

    Parameters:
          INPUT
                    p_Buffer  (WIDGET-HANDLE)
                            Handle to edit buffer to perform Replace on.

    Description:

    Notes:

        <EDITOR>:REPLACE Invalid Flag combinations are:

            (FIND-NEXT-OCCURRENCE + FIND-PREV-OCCURRENCE)  or
            (SELECT) or (FIND-GLOBAL + FIND-WRAP-AROUND)
 
---------------------------------------------------------------------------*/
    DEFINE INPUT PARAMETER p_Buffer AS WIDGET-HANDLE NO-UNDO.
    
    DEFINE VAR Confirm_Replace  AS LOGICAL NO-UNDO INIT YES.
    DEFINE VAR Return_Status    AS LOGICAL NO-UNDO.
    DEFINE VAR First_Occurrence AS LOGICAL NO-UNDO.
    DEFINE VAR Found_One        AS LOGICAL NO-UNDO.
    DEFINE VAR Return_Value     AS CHAR    NO-UNDO.
    DEFINE VAR vWindow          AS WIDGET-HANDLE NO-UNDO.

    ASSIGN vWindow = p_Buffer:FRAME
           vWindow = vWindow:PARENT   /* Window */
    . /* ASSIGN */
    
    ASSIGN Replace_Command   = FIND-NEXT-OCCURRENCE + FIND-SELECT
           Last_Replace_Find = Replace_Command.
    /* Assigns Replace_Criteria. */
    RUN ReplaceAssign.
    ASSIGN Replace_Flags = Replace_Command + Replace_Criteria.
    
    ASSIGN Wrap_Find        = NO
           First_Occurrence = TRUE
    . /* END ASSIGN. */
    Continue_Search:
    DO WHILE TRUE:
        /* taj 19981015-051: check if find_text is equal to what is
         * really selected (don't just compare it to find_sel_text
         * which was created for case-sensitive checks). 
         */
      IF ( First_Occurrence ) AND ( SESSION:WINDOW-SYSTEM <> "TTY" )
         AND ( Find_Text <> "" ) AND ( Find_Text = p_buffer:SELECTION-TEXT )
      THEN DO:
          /* If text already selected, don't skip it. */
          ASSIGN Text_Found       = TRUE
          &IF NOT "{&WINDOW-SYSTEM}" BEGINS "MS-WIN" &THEN
          /* MSW LARGE ED does not support SET-SELECTION.  Under MSW,
             the Editor widget maintains a highlight, so we don't need
             to set it. */
                 Return_Status    = p_Buffer:SET-SELECTION( Find_Sel_Start, 
                                                            Find_Sel_End )
          &ENDIF
          . /* END ASSIGN. */
      END.
      ELSE
          ASSIGN Text_Found = p_Buffer:SEARCH(Find_Text, Replace_Flags ) .
   
      IF Text_Found 
      THEN DO:
        ASSIGN Found_One = TRUE.
        ASSIGN Confirm_Replace = YES.
        &IF ( "{&WINDOW-SYSTEM}" = "TTY" ) &THEN
        RUN ChrReplacePrompt( OUTPUT Confirm_Replace ).
        &ELSE
        DO ON STOP UNDO, LEAVE:
            MESSAGE "Replace this occurrence?"
                    VIEW-AS ALERT-BOX QUESTION BUTTONS YES-NO-CANCEL
                            UPDATE Confirm_Replace IN WINDOW vWindow.
        END.
        &ENDIF

        CASE Confirm_Replace :
            /* User pressed Cancel. */
            WHEN ? 
                THEN DO:
                  IF Search_All THEN ASSIGN Return_Value = "_CANCEL":U + STRING(Found_One).
                  LEAVE Continue_Search.
                END.
            /* Replace current occurrence of selected text. */
            WHEN YES
               THEN DO:
                 ASSIGN Return_Status = 
                        p_Buffer:REPLACE-SELECTION-TEXT(Replace_Text) NO-ERROR.
                 IF ( Return_Status = FALSE )
                 THEN MESSAGE "Cannot replace. Editor is full."
                      VIEW-AS ALERT-BOX ERROR BUTTONS OK IN WINDOW vWindow. 
               END.
            /* No replace, continue searching. No-op here. */        
            OTHERWISE
                DO:
                  IF Search_All THEN ASSIGN Return_Value = "_SKIP":U + STRING(Found_One).
                END.
        END CASE.
        
      END.  /* Text_Found */
      ELSE 
      DO:
        IF Search_All THEN ASSIGN Return_Value = STRING(Text_Found) + STRING(Found_One).
        ELSE DO:
          IF First_Occurrence THEN
            MESSAGE "Find text not found."
              VIEW-AS ALERT-BOX INFORMATION BUTTONS OK IN WINDOW vWindow.
          ELSE
            MESSAGE "Replace complete."
              VIEW-AS ALERT-BOX INFORMATION BUTTONS OK IN WINDOW vWindow.
        END.
        LEAVE Continue_Search.
      END.
      ASSIGN First_Occurrence = FALSE.
      
    END.   /* Continue_Search */
    IF Search_All THEN RETURN Return_Value.
END PROCEDURE.        /* ReplaceConfirm */
  

&IF ( "{&WINDOW-SYSTEM}" = "TTY" ) &THEN
PROCEDURE ChrReplacePrompt.
/*----------------------------------------------------------------------------

    Purpose :   Character UI Search->Replace Prompt.

    Syntax  :   RUN ChrReplacePrompt( OUTPUT p_Return_Value ).

    Parameters:
----------------------------------------------------------------------------*/

    DEFINE OUTPUT PARAMETER p_Return_Value AS LOGICAL INIT ?.

    DEFINE VAR v_Response       AS CHARACTER FORMAT "!" NO-UNDO.
    DEFINE VAR Appl_Alert_Boxes AS LOGICAL INIT ?       NO-UNDO.
    DEFINE VAR h_bar            AS HANDLE               NO-UNDO.

    on ANY-PRINTABLE,GO,RETURN,ENTER,END-ERROR of focus
    do:
      assign v_Response = last-event:function.
      if ( lookup( v_Response, "Y,N,C,GO,RETURN,ENTER,END-ERROR, " ) > 0 ) then
      do:
        if ( lookup( v_Response , "Y,GO,RETURN,ENTER, " ) > 0 ) then
          assign p_Return_Value = YES.
        else if ( v_Response = "N" ) then
          assign p_Return_Value = NO.
        else if ( lookup( v_Response , "C,END-ERROR" ) > 0 ) then
          assign p_Return_Value = ?.
        apply "U1":u to focus.
      end.
      else bell.

      return no-apply.
    end.

    repeat on stop   undo, RETRY
           on error  undo, retry
           on endkey undo, retry :

        if not retry then
        do:
            assign v_Response = "Y".
            hide message no-pause.
            /* If user has this set to TRUE, then our replace message
               will appear in an alert box and screw everything up.
               So we ensure its FALSE and we reset on the way out.
            */
            assign Appl_Alert_Boxes         = SESSION:APPL-ALERT-BOXES
                   SESSION:APPL-ALERT-BOXES = FALSE.
            /* Turn off the active window menubar to prevent any
               accelerators from firing. - jep */
            assign h_bar           = active-window:menubar
                   h_bar:SENSITIVE = FALSE NO-ERROR.
            message "Replace this occurrence (Y-Yes, N-No, C-Cancel)?" .
            assign SESSION:APPL-ALERT-BOXES = Appl_Alert_Boxes.
            /* wait-for needed to keep cursor on the current text to
               be replaced. */
            wait-for U1 of focus.
        end.
        else
            assign p_Return_value = ?.

        /* Reset this setting to what user had it at. */
        if Appl_Alert_Boxes <> ?
        then assign SESSION:APPL-ALERT-BOXES = Appl_Alert_Boxes.

        /* Turn the active window menubar back on. */
        assign h_bar           = active-window:menubar
               h_bar:SENSITIVE = TRUE NO-ERROR.
        assign h_bar = active-window NO-ERROR.
        leave.
    end.

END PROCEDURE.
&ENDIF

PROCEDURE ReplaceAll .
 
/*--------------------------------------------------------------------------
    Purpose:        Executes the REPLACE ALL command, which replaces all
                    occurrences of the Find Text with the Replace Text
                    string.

    Run Syntax:     RUN ReplaceAll ( INPUT p_Buffer ) .

    Parameters:
          INPUT
                    p_Buffer  (WIDGET-HANDLE)
                            Handle to edit buffer to perform Replace on.

    Description:

    Notes:

        <EDITOR>:REPLACE Invalid Flag combinations are:

            (FIND-NEXT-OCCURRENCE + FIND-PREV-OCCURRENCE)  or
            (SELECT) or (FIND-GLOBAL + FIND-WRAP-AROUND)
 
---------------------------------------------------------------------------*/
    DEFINE INPUT PARAMETER p_Buffer AS WIDGET-HANDLE NO-UNDO.

    DEFINE VAR vWindow          AS WIDGET-HANDLE NO-UNDO.

    ASSIGN vWindow = p_Buffer:FRAME
           vWindow = vWindow:PARENT   /* Window */
    . /* ASSIGN */
    
    ASSIGN Replace_Command   = FIND-GLOBAL
           Last_Replace_Find = Replace_Command .
    /* Assigns Replace_Criteria. */    
    RUN ReplaceAssign.
    
    
    ASSIGN Replace_Flags = Replace_Command + Replace_Criteria.

    ASSIGN Text_Found = p_Buffer:REPLACE(Find_Text, Replace_Text, Replace_Flags).
    IF Search_All THEN RETURN "_REPLACE-ALL":U + STRING(Text_Found).

    IF NOT Text_Found THEN
      MESSAGE "Find text not found."
        VIEW-AS ALERT-BOX INFORMATION BUTTONS OK IN WINDOW vWindow.
    ELSE
      MESSAGE "Replace All complete." p_Buffer:NUM-REPLACED "occurrences replaced."
        VIEW-AS ALERT-BOX INFORMATION BUTTONS OK IN WINDOW vWindow.

END PROCEDURE.        /* ReplaceAll */


PROCEDURE FindAssign.
 
/*--------------------------------------------------------------------------
    Purpose:        Assigns the Find Text and Find Criteria.

    Run Syntax:     RUN FindAssign ( OUTPUT p_Find_Criteria ) .

    Parameters:
    
   Description:
   
    Notes:
 
---------------------------------------------------------------------------*/
  DEFINE OUTPUT PARAMETER p_Find_Criteria AS INTEGER NO-UNDO .

  DO:
    ASSIGN
        p_Find_Criteria = FIND-SELECT

        p_Find_Criteria = IF Find_Filters[Case_Sensitive]
                          THEN p_Find_Criteria + FIND-CASE-SENSITIVE
                          ELSE p_Find_Criteria

        p_Find_Criteria = IF Find_Filters[Wrap_Around]
                          THEN p_Find_Criteria + FIND-WRAP-AROUND
                          ELSE p_Find_Criteria
    . /* END ASSIGN. */
  END.
                     
END PROCEDURE.        /* FindAssign */


PROCEDURE ReplaceAssign.
 
/*--------------------------------------------------------------------------
    Purpose:        Assigns the Find/Replace Text and Find/Replace Criteria.

    Run Syntax:     RUN ReplaceAssign.

    Parameters:
    
   Description:
   
    Notes:
 
---------------------------------------------------------------------------*/

  ASSIGN
    Replace_Criteria = 0
  
    Replace_Criteria = IF Replace_Filters[Case_Sensitive]
                       THEN Replace_Criteria + FIND-CASE-SENSITIVE
                       ELSE Replace_Criteria
  . /* END ASSIGN. */
  
END PROCEDURE.        /* ReplaceAssign */


PROCEDURE FindNext.
/*--------------------------------------------------------------------------
    Purpose:        Executes the FIND NEXT command.

    Run Syntax:     RUN FindNext ( INPUT p_Buffer , INPUT p_Find_Criteria).

    Parameters:
        p_Buffer p_Find_Criteria

    Description:

    Notes:
---------------------------------------------------------------------------*/

  DEFINE INPUT PARAMETER p_Buffer AS WIDGET-HANDLE NO-UNDO.
  DEFINE INPUT PARAMETER p_Find_Criteria AS INTEGER NO-UNDO.

  /* Set basic Find Criteria. */
  RUN FindAssign ( OUTPUT p_Find_Criteria ) .
  &IF ( "{&WINDOW-SYSTEM}" <> "TTY" ) &THEN
  /* Supported under GUI only. */
  /* Assign Find Text the Currently Selected text, if any. */
  Find_Text = ( IF p_Buffer:TEXT-SELECTED
                   THEN p_Buffer:SELECTION-TEXT
                   ELSE Find_Text ) .
  &ENDIF
  /* Allow user to search for question mark ( ? ). Needs special handling. */
  RUN MakeQMark ( INPUT-OUTPUT Find_Text , INPUT p_Buffer:LARGE ).
  RUN FindAgain (INPUT p_Buffer ,
                 INPUT FIND-NEXT-OCCURRENCE + {&FIND-REPEAT-LAST}, INPUT p_Find_Criteria).

END PROCEDURE.          /* FindNext */



PROCEDURE FindPrev.
/*--------------------------------------------------------------------------
    Purpose:        Executes the FIND PREVIOUS command.

    Run Syntax:     RUN FindPrev (INPUT p_Buffer , INPUT p_Find_Criteria).

    Parameters:
        p_Buffer p_Find_Criteria

    Description:

    Notes:
 
---------------------------------------------------------------------------*/

  DEFINE INPUT PARAMETER p_Buffer AS WIDGET-HANDLE NO-UNDO.
  DEFINE INPUT PARAMETER p_Find_Criteria AS INTEGER NO-UNDO.

  /* Set basic Find Criteria. */
  RUN FindAssign ( OUTPUT p_Find_Criteria ) .
  &IF ( "{&WINDOW-SYSTEM}" <> "TTY" ) &THEN
  /* Supported under GUI only. */
  /* Assign Find Text the Currently Selected text, if any. */
  Find_Text = ( IF p_Buffer:TEXT-SELECTED
                   THEN p_Buffer:SELECTION-TEXT
                   ELSE Find_Text ) .
  &ENDIF

  /* Allow user to search for question mark ( ? ). Needs special handling. */
  RUN MakeQMark ( INPUT-OUTPUT Find_Text , INPUT p_Buffer:LARGE ).
  RUN FindAgain (INPUT p_Buffer ,
                 INPUT FIND-PREV-OCCURRENCE + {&FIND-REPEAT-LAST}, INPUT p_Find_Criteria).

END PROCEDURE.          /* FindPrev */



PROCEDURE FindAgain.
 
/*--------------------------------------------------------------------------
    Purpose:        Re-Executes the previous FIND command.

    Run Syntax:     RUN FindAgain ( INPUT p_Buffer ,
                                        INPUT p_Again_Find_Command ,
                                    INPUT p_Again_Find_Criteria ).

    Parameters:
        
    Description:

    Notes:
 
---------------------------------------------------------------------------*/

  DEFINE INPUT PARAMETER p_Buffer               AS WIDGET-HANDLE NO-UNDO.
  DEFINE INPUT PARAMETER p_Again_Find_Command  AS INTEGER NO-UNDO.
  DEFINE INPUT PARAMETER p_Again_Find_Criteria AS INTEGER NO-UNDO.
  
  DEFINE VARIABLE Again_Find_Flags AS INTEGER NO-UNDO.
  DEFINE VARIABLE First_Occurrence AS LOGICAL NO-UNDO.
  DEFINE VARIABLE vWindow          AS WIDGET-HANDLE NO-UNDO.

    ASSIGN vWindow = p_Buffer:FRAME
           vWindow = vWindow:PARENT   /* Window */
    . /* ASSIGN */
    

    ASSIGN Again_Find_Flags = p_Again_Find_Command + p_Again_Find_Criteria
           Wrap_Find        = NO
    . /* END ASSIGN. */

    Continue_Search:
    DO WHILE TRUE:

      ASSIGN Text_Found = p_Buffer:SEARCH(Find_Text, Again_Find_Flags)  .
      IF (Search_All = TRUE) THEN RETURN STRING(Text_Found).

      IF Text_Found THEN LEAVE Continue_Search.
      MESSAGE "Find text not found."
        VIEW-AS ALERT-BOX INFORMATION BUTTONS OK IN WINDOW vWindow.
      LEAVE Continue_Search.
      
    END.   /* Continue_Search */
      
END PROCEDURE.          /* FindAgain */


PROCEDURE MakeQMark.
/*--------------------------------------------------------------------------
    Purpose:        Makes the unknown value a question mark and allows for
                    proper searching of the literal "?".

    Run Syntax:     RUN MakeQMark ( INPUT-OUTPUT p_String , INPUT p_Large ).

    Parameters:
        
    Description:
       If string is Unknown Value, convert it to a single Question Mark for
       All platforms, except MSW LARGE editor - convert to two qmarks.
       This is because the MSW LARGE Editor treats ? as a wildcard, whereas
       two are taken to mean the literal ?. 

       This allows user to search for instances of a question mark in their
       code.
       
    Notes:
---------------------------------------------------------------------------*/

    DEFINE INPUT-OUTPUT PARAMETER p_String AS CHARACTER NO-UNDO.
    DEFINE INPUT        PARAMETER p_Large  AS LOGICAL   NO-UNDO.

    IF p_String = ? OR p_String = "?" THEN
      ASSIGN p_String = IF ( SESSION:WINDOW-SYSTEM BEGINS "MS-WIN" AND
                              p_Large = TRUE )
                        THEN "??"
                        ELSE "?".

END PROCEDURE.


PROCEDURE GotoLine.
/*--------------------------------------------------------------------------
    Purpose:
        Executes GOTO-LINE command, allowing user to move the text
        cursor to a specified line number within the edit buffer.

    Run Syntax:    
        RUN GotoLine (INPUT p_Buffer ) . 

    Parameters:

    Description:

    Notes:
--------------------------------------------------------------------------*/

  DEFINE INPUT PARAMETER p_Buffer AS WIDGET-HANDLE NO-UNDO.
  
  DEFINE VARIABLE vWindow         AS WIDGET-HANDLE NO-UNDO.

  ON HELP OF FRAME Goto_Line ANYWHERE
    RUN adecomm/_srchhlp.p ( INPUT "Goto_Line_Dialog_Box" ).
  ON CHOOSE OF btn_GL_Help IN FRAME Goto_Line
    RUN adecomm/_srchhlp.p ( INPUT "Goto_Line_Dialog_Box" ).

  &IF "{&WINDOW-SYSTEM}" = "TTY" &THEN
  ON RETURN,ENTER OF Goto_Line IN FRAME Goto_Line
      APPLY "GO" TO FRAME Goto_Line.
  &ENDIF

  ON GO OF FRAME Goto_Line
  DO:
    HIDE FRAME Goto_Line NO-PAUSE.
    ASSIGN Goto_Line = INPUT FRAME Goto_Line Goto_Line.
    RUN MoveCursor ( INPUT p_Buffer , INPUT Goto_Line ).
  END.

  Goto_Line = p_Buffer:CURSOR-LINE.
  DLG_GOTO:
  DO ON STOP   UNDO DLG_GOTO, LEAVE DLG_GOTO
     ON ERROR  UNDO DLG_GOTO, LEAVE DLG_GOTO
     ON ENDKEY UNDO DLG_GOTO, LEAVE DLG_GOTO:
    
    ASSIGN vWindow = p_Buffer:FRAME
           vWindow = vWindow:PARENT   /* Window */
    . /* ASSIGN */

    
    UPDATE Goto_Line btn_GL_OK btn_GL_Cancel btn_GL_Help {&WHEN_HELP}
           GO-ON( GO,WINDOW-CLOSE ) 
           WITH FRAME Goto_Line IN WINDOW vWindow.
  
  END.

  HIDE FRAME Goto_Line NO-PAUSE.
  APPLY "ENTRY" TO p_Buffer.

END.        /* GotoLine */


PROCEDURE MoveCursor.
/*--------------------------------------------------------------------------
    Purpose:        Moves editor cursor to a specified line number, column 1.
    Run Syntax:     RUN MoveCursor ( INPUT p_Buffer , INPUT p_Cursor_Line ).

    Parameters:     p_Buffer p_Cursor_Line

    Description:
        If entered line is greater than number of lines in buffer, then
        move to EOF.

        If entered line 0, goto line 1.

    Notes:
 
--------------------------------------------------------------------------*/
    DEFINE INPUT PARAMETER p_Buffer      AS WIDGET-HANDLE NO-UNDO.
    DEFINE INPUT PARAMETER p_Cursor_Line AS INTEGER       NO-UNDO.

    DEFINE VARIABLE Move_to_EOF AS LOGICAL NO-UNDO.

    IF p_Buffer:EMPTY THEN RETURN.
    /* If entered line is greater than number of lines in buffer, then
       move to EOF. */
    IF p_Cursor_Line > p_Buffer:NUM-LINES
        THEN ASSIGN Move_to_EOF = p_Buffer:MOVE-TO-EOF().
    ELSE DO:
    /* If entered line 0, goto line 1. */
        IF ( p_Cursor_Line < 1 ) THEN ASSIGN p_Cursor_Line = 1.

        ASSIGN p_Buffer:CURSOR-LINE = p_Cursor_Line.
    END.

END PROCEDURE. /* MoveCursor */
/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/
/*----------------------------------------------------------------------------

File: qurywidg.i

Description:

Input Parameters:
   <None>

Output Parameters:
   <None>

Author: Greg O'Connor

Date Created: 1992 

----------------------------------------------------------------------------*/

/* Max tables in query definition */

&Glob MaxTbl 20 
/* &Global-Define MaxTbl       20 */
/* Make sure the seperator char is not a '!' which will conflict for lable stuff*/
&Global-Define Sep1          CHR (3)
&Global-Define Sep2          CHR (4)


/* Browser Props */

DEFINE {1} SHARED VARIABLE _4GLQury      AS CHAR                       NO-UNDO.
           /* 4GL code defining query              */
           
DEFINE {1} SHARED VARIABLE _UIB_4GLQury  AS CHAR                       NO-UNDO.
           /* 4GL code defining query              */
DEFINE {1} SHARED VARIABLE _TblList      AS CHAR                       NO-UNDO.
           /* List of tables in query              */
           
DEFINE {1} SHARED VARIABLE _FldList      AS CHAR                       NO-UNDO.
           /* List of fields selected for browse   */
           
DEFINE {1} SHARED VARIABLE _OrdList      AS CHAR                       NO-UNDO.
          /* List of fields in BREAK BY phrase     */
          
DEFINE {1} SHARED VARIABLE _JoinTo       AS INTEGER  EXTENT {&MaxTbl}  NO-UNDO.
          /* Parent Table                          */
         
DEFINE {1} SHARED VARIABLE _JoinCode     AS CHAR     EXTENT {&MaxTbl}  NO-UNDO.
         /* 4GL Join Code                          */
         
DEFINE {1} SHARED VARIABLE _Where        AS CHAR     EXTENT {&MaxTbl}  NO-UNDO.
         /* 4GL Where Code                         */
/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/*************************************************************
  RETURN-VALUE processing for Procedure Window.  Used by
  adeweb/_webcom.w (_pwsavef.p and _pwsavas.p) to display
  Remote File Management messages.
  
**************************************************************/

PROCEDURE returnValue:
  DEFINE INPUT  PARAMETER pReturnValue AS CHARACTER NO-UNDO.
  DEFINE INPUT  PARAMETER pFileName    AS CHARACTER NO-UNDO.
  DEFINE INPUT  PARAMETER pAction      AS CHARACTER NO-UNDO.
  DEFINE OUTPUT PARAMETER pOkToSave    AS LOGICAL   NO-UNDO INITIAL TRUE.
  
  DEFINE VARIABLE cAction      AS CHARACTER NO-UNDO.
  DEFINE VARIABLE cReturnValue AS CHARACTER NO-UNDO.
  DEFINE VARIABLE lScrap       AS LOGICAL   NO-UNDO.
  
  IF INDEX(pReturnValue,"Not writeable":U) ne 0 THEN 
  DO:
    pOkToSave = FALSE.
    RUN adecomm/_s-alert.p (INPUT-OUTPUT lScrap, "warning":U, "ok":U,
      SUBSTITUTE("&1^Cannot save to this file.^^File is read-only or the path specified is invalid.", 
      pFileName)).
    RETURN.
  END.

  IF INDEX(pReturnValue,"File exists":U) ne 0 THEN 
  DO:
    pOkToSave = FALSE. 

    MESSAGE pFileName "already exists." SKIP
      "Do you want to replace it?"
      VIEW-AS ALERT-BOX WARNING BUTTONS YES-NO UPDATE pOkToSave.
    RETURN.
  END.

  ASSIGN
    cAction      = IF pAction ne "" THEN pAction 
                   ELSE IF NUM-ENTRIES(ENTRY(1, pReturnValue, CHR(10)), " ":U) ge 3 THEN
                          ENTRY(3, ENTRY(1, pReturnValue, CHR(10)), " ":U) 
                   ELSE pAction
    cReturnValue = SUBSTRING(pReturnValue, INDEX(pReturnValue,CHR(10)) + 1,
                            -1, "CHARACTER":U).

  RUN adecomm/_s-alert.p (INPUT-OUTPUT lScrap, "error":U, "ok":U,
    SUBSTITUTE("&1 could not be &2 for the following reason:^^&3",
    pFileName, cAction, cReturnValue)).
    
END PROCEDURE.

/* rtnval.i - end of file */
/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/*----------------------------------------------------------------------------

File: tblbrws.i

Description:
   Browse the tables for a given database. This .i is included in both
   _tblbrws.p and _tfbrws.p  The only reason is that browses can't be
   resized at run time.

Arguments:
   &HGHT       - Height of the browse
   &WDTH       - Width of the browse
   &FLDS       - "YES" if selecting fields, "NO" if just tables.  {&FLDS} is
                 used to turn on/off gobs of code at compile time.
   
Input Parameters: (for the calling programs)
   p_dlg       - Frame handle needed to parent the frame created in this 
                 procedure.
   parent-proc - Handle of the calling dialog so that we can run its
                 internal procedures (methods).
   p_multi     - Logical: True if multiple items can be returned.
   p_rw        - The row of the browse within its parent (p_dlg).
   p_tc        - The column of the brwose within its parent (p_dlg).
   p_DbId      - The recid of the _Db record which corresponds to the
                 database that we want the tables from.
   p_Filters   - Comma delimited character string with with things (like
                 Sybase Buffers) that should be filtered out.
   in-value    - Comma delimited list of tables to select initially
   p_DType     - ? if not a specific Datatype
             
Output Parameters:
   h_tbl_brws - Handle of table browse created in this routine.
   h_fld_brws - Handle of field browse created in this routine. (Turned on by
                 the {&FLDS} preprocessor.
   p_Stat     - Set to true if list is retrieved (even if there were no tables
      	         this is successful).  Set to false, if user doesn't have access
      	         to tables.

Author: Ross Hunter

Date Created: 08/08/95 

----------------------------------------------------------------------------*/

DEFINE INPUT  PARAMETER p_dlg       AS HANDLE          NO-UNDO.
DEFINE INPUT  PARAMETER parent_proc AS HANDLE          NO-UNDO.
DEFINE INPUT  PARAMETER p_multi     AS LOGICAL         NO-UNDO.
DEFINE INPUT  PARAMETER p_rw        AS DECIMAL         NO-UNDO.
DEFINE INPUT  PARAMETER p_tc        AS DECIMAL         NO-UNDO.
DEFINE INPUT  PARAMETER p_DbId      AS RECID           NO-UNDO.
DEFINE INPUT  PARAMETER p_filters   AS CHARACTER       NO-UNDO.
DEFINE INPUT  PARAMETER in-value    AS CHARACTER       NO-UNDO.

/* ----------------------------------------------------------------- */
/*                        FOR FIELDS ONLY                            */
/* ----------------------------------------------------------------- */
&IF "{&FLDS}" = "YES" &THEN
DEFINE INPUT  PARAMETER p_DType     AS CHARACTER       NO-UNDO.
&ENDIF            /* End of fields only input parameter definitions  */

DEFINE OUTPUT PARAMETER h_tbl_brws  AS HANDLE          NO-UNDO.

/* ----------------------------------------------------------------- */
/*                        FOR FIELDS ONLY                            */
/* ----------------------------------------------------------------- */
/* just for syntax check ... */
&if "{&wdth)}" = "" and "{&hght}" = "" &then
  &scop hght 10
  &scop wdth  50
&endif    

&IF "{&FLDS}" = "YES" &THEN
DEFINE OUTPUT PARAMETER h_fld_brws  AS HANDLE          NO-UNDO.
&ENDIF           /* End of fields only output parameter definitions  */

DEFINE OUTPUT PARAMETER p_Stat 	    AS LOGICAL         NO-UNDO.


DEFINE QUERY  tbl-browse-m FOR DICTDB._FILE SCROLLING.
DEFINE BROWSE tbl-browse-m QUERY tbl-browse-m NO-LOCK
       DISPLAY DICTDB._FILE._FILE-NAME
    WITH NO-ROW-MARKERS NO-COLUMN-SCROLLING MULTIPLE
         SIZE {&WDTH} BY {&HGHT} NO-LABELS.
DEFINE QUERY  tbl-browse-s FOR DICTDB._FILE SCROLLING.
DEFINE BROWSE tbl-browse-s QUERY tbl-browse-s NO-LOCK
       DISPLAY DICTDB._FILE._FILE-NAME
    WITH NO-ROW-MARKERS NO-COLUMN-SCROLLING SINGLE
         SIZE {&WDTH} BY {&HGHT} NO-LABELS.

DEFINE VARIABLE cur-rec    AS RECID     NO-UNDO.
DEFINE VARIABLE i          AS INTEGER   NO-UNDO.
DEFINE VARIABLE multi-tbl  AS LOGICAL   NO-UNDO.

IF INTEGER(DBVERSION("DICTDB")) > 8 THEN
  FIND DICTDB._File WHERE LOOKUP(DICTDB._FILE._OWNER,"PUB,_FOREIGN":U) > 0 AND
                                 DICTDB._FILE._FILE-NAME = "_File":u NO-LOCK.
ELSE
  FIND DICTDB._FILE WHERE DICTDB._FILE._FILE-NAME = "_File":U NO-LOCK.

IF NOT CAN-DO(DICTDB._File._Can-Read, USERID("DICTDB":u)) THEN DO:
  MESSAGE "You do not have permission to see any table information."
    VIEW-AS ALERT-BOX ERROR buttons OK.
  p_Stat = FALSE.
  RETURN.
END.                                            

DEFINE FRAME frm-m
  tbl-browse-m
  WITH 1 DOWN NO-BOX OVERLAY THREE-D AT ROW 2 COLUMN 17.

DEFINE FRAME frm-s
  tbl-browse-s
  WITH 1 DOWN NO-BOX OVERLAY THREE-D AT ROW 2 COLUMN 17.

multi-tbl = p_multi.
IF "{&FLDS}" = "YES" THEN multi-tbl = FALSE.

IF multi-tbl THEN  
  ASSIGN FRAME frm-m:FRAME  = p_dlg
         FRAME frm-m:ROW    = p_rw
         FRAME frm-m:COLUMN = p_tc
         p_Stat             = FRAME frm-m:MOVE-TO-TOP()
         FRAME frm-m:HIDDEN = NO
         h_tbl_brws         = tbl-browse-m:HANDLE.
ELSE
  ASSIGN FRAME frm-s:FRAME  = p_dlg
         FRAME frm-s:ROW    = p_rw
         FRAME frm-s:COLUMN = p_tc
         p_Stat             = FRAME frm-s:MOVE-TO-TOP()
         FRAME frm-s:HIDDEN = NO
         h_tbl_brws         = tbl-browse-s:HANDLE.

/* ----------------------------------------------------------------- */
/*                        FOR TABLES ONLY                            */
/* ----------------------------------------------------------------- */
&IF "{&FLDS}" = "NO" &THEN
ON DEFAULT-ACTION OF tbl-browse-m OR DEFAULT-ACTION OF tbl-browse-s DO:
  RUN table-browse-def-act IN parent_proc.
END.
&ENDIF                             /* End of For tables only trigger */

/* Find each file in this database.  Remember, if the progress Db is 
   acting as a schema holder, files for more than one database may 
   exist in this one physical database.  */
RUN adecomm/_setcurs.p ("WAIT":u).

FIND DICTDB._DB WHERE RECID(DICTDB._DB) = p_DBID NO-LOCK.
IF INTEGER(DBVERSION("DICTDB")) > 8 THEN DO:
  IF multi-tbl THEN 
    OPEN QUERY tbl-browse-m FOR EACH DICTDB._FILE NO-LOCK 
       WHERE LOOKUP(DICTDB._FILE._OWNER,"PUB,_FOREIGN":U) > 0 AND
             CAN-DO(DICTDB._File._Can-Read, USERID("DICTDB":U)) AND
             NOT DICTDB._FILE._HIDDEN AND
             (DICTDB._FILE._FOR-TYPE = ? OR
              NOT CAN-DO(p_filters,DICTDB._File._FOR-TYPE)) BY DICTDB._File._FILE-NAME.
  ELSE
    OPEN QUERY tbl-browse-s FOR EACH DICTDB._FILE NO-LOCK 
       WHERE LOOKUP(DICTDB._FILE._OWNER,"PUB,_FOREIGN":U) > 0 AND
             CAN-DO(DICTDB._File._Can-Read, USERID("DICTDB":U)) AND
             NOT DICTDB._FILE._HIDDEN AND
             (DICTDB._FILE._FOR-TYPE = ? OR
              NOT CAN-DO(p_filters,DICTDB._File._FOR-TYPE)) BY DICTDB._File._FILE-NAME.
END.  /* If DB > 8 */
ELSE DO:
  IF multi-tbl THEN 
    OPEN QUERY tbl-browse-m FOR EACH DICTDB._FILE NO-LOCK 
       WHERE CAN-DO(DICTDB._File._Can-Read, USERID("DICTDB":U)) AND
             NOT DICTDB._FILE._HIDDEN AND
             (DICTDB._FILE._FOR-TYPE = ? OR
              NOT CAN-DO(p_filters,_File._FOR-TYPE)) BY DICTDB._File._FILE-NAME.
  ELSE
    OPEN QUERY tbl-browse-s FOR EACH DICTDB._FILE NO-LOCK 
       WHERE CAN-DO(DICTDB._File._Can-Read, USERID("DICTDB":U)) AND
             NOT DICTDB._FILE._HIDDEN AND
             (DICTDB._File._FOR-TYPE = ? OR
              NOT CAN-DO(p_filters,DICTDB._File._FOR-TYPE)) BY DICTDB._File._FILE-NAME.

END.

IF NUM-ENTRIES(in-value) > 0 THEN DO:  /* SELECT these tables in the browse */
  DO i = 1 TO NUM-ENTRIES(in-value):
    IF INTEGER(DBVERSION("DICTDB")) > 8 THEN
      FIND DICTDB._FILE NO-LOCK
               WHERE LOOKUP(DICTDB._FILE._OWNER,"PUB,_FOREIGN":U) > 0 AND
                     CAN-DO(DICTDB._FILE._Can-Read, USERID("DICTDB":U)) AND
                            NOT DICTDB._FILE._HIDDEN AND
                            (DICTDB._FILE._FOR-TYPE = ? OR
                             NOT CAN-DO(p_filters,_File._FOR-TYPE)) AND
                             DICTDB._FILE._FILE-NAME = ENTRY(i,in-value) NO-ERROR.
    ELSE
      FIND DICTDB._FILE NO-LOCK
               WHERE CAN-DO(DICTDB._FILE._Can-Read, USERID("DICTDB":U)) AND
                            NOT DICTDB._FILE._HIDDEN AND
                            (DICTDB._FILE._FOR-TYPE = ? OR
                             NOT CAN-DO(p_filters,_File._FOR-TYPE)) AND
                             DICTDB._FILE._FILE-NAME = ENTRY(i,in-value) NO-ERROR.
    IF AVAILABLE DICTDB._FILE THEN DO:
      cur-rec = RECID(DICTDB._FILE).
      IF multi-tbl THEN REPOSITION tbl-browse-m TO RECID cur-rec.
      ELSE REPOSITION tbl-browse-s TO RECID cur-rec.
      p_Stat = h_tbl_brws:SELECT-FOCUSED-ROW().
    END.
  END.
  /* Now reposition to the first one */
  ASSIGN p_Stat  = h_tbl_brws:SET-REPOSITIONED-ROW(1,"CONDITIONAL").
  /* Sometimes with multiple db's the wrong DB is selected */
  IF h_tbl_brws:NUM-SELECTED-ROWS > 0 THEN DO:
    ASSIGN p_Stat  = h_tbl_brws:FETCH-SELECTED-ROW(1)
           cur-rec = RECID(DICTDB._FILE).
    IF multi-tbl THEN REPOSITION tbl-browse-m TO RECID cur-rec.
    ELSE REPOSITION tbl-browse-s TO RECID cur-rec.
  END. /* If there are any selected rows. */
END.           

RUN adecomm/_setcurs.p ("").
IF multi-tbl THEN ENABLE tbl-browse-m WITH FRAME frm-m.
ELSE ENABLE tbl-browse-s WITH FRAME frm-s.


/* ----------------------------------------------------------------- */
/*                        FOR FIELDS ONLY                            */
/* ----------------------------------------------------------------- */ 

&IF "{&FLDS}" = "YES" &THEN          /* A fields browse is necessary */

DEFINE TEMP-TABLE tbl-fld NO-UNDO
  FIELD fld-nm AS CHARACTER FORMAT "X(40)"
  INDEX fld-nm IS PRIMARY UNIQUE fld-nm.
  
DEFINE QUERY  fld-browse-m FOR tbl-fld SCROLLING.
DEFINE BROWSE fld-browse-m QUERY fld-browse-m
       DISPLAY tbl-fld.fld-nm
    WITH NO-ROW-MARKERS NO-COLUMN-SCROLLING MULTIPLE
         SIZE {&WDTH} BY {&HGHT} NO-LABELS.
DEFINE QUERY  fld-browse-s FOR tbl-fld SCROLLING.
DEFINE BROWSE fld-browse-s QUERY fld-browse-s
       DISPLAY tbl-fld.fld-nm
    WITH NO-ROW-MARKERS NO-COLUMN-SCROLLING SINGLE
         SIZE {&WDTH} BY {&HGHT} NO-LABELS.

DEFINE VARIABLE cur-fld    AS RECID     NO-UNDO.

DEFINE FRAME ffrm-m
  fld-browse-m
  WITH 1 DOWN NO-BOX OVERLAY THREE-D AT ROW 2 COLUMN 30.

DEFINE FRAME ffrm-s
  fld-browse-s
  WITH 1 DOWN NO-BOX OVERLAY THREE-D AT ROW 2 COLUMN 30.

IF p_multi THEN  
  ASSIGN FRAME ffrm-m:FRAME  = p_dlg
         FRAME ffrm-m:ROW    = p_rw
         FRAME ffrm-m:COLUMN = p_tc + 20
         p_Stat             = FRAME ffrm-m:MOVE-TO-TOP()
         FRAME ffrm-m:HIDDEN = NO
         h_fld_brws         = fld-browse-m:HANDLE.
ELSE
  ASSIGN FRAME ffrm-s:FRAME  = p_dlg
         FRAME ffrm-s:ROW    = p_rw
         FRAME ffrm-s:COLUMN = p_tc + 20
         p_Stat             = FRAME ffrm-s:MOVE-TO-TOP()
         FRAME ffrm-s:HIDDEN = NO
         h_fld_brws         = fld-browse-s:HANDLE.

ON DEFAULT-ACTION OF fld-browse-m OR DEFAULT-ACTION OF fld-browse-s DO:
  RUN field-browse-def-act IN parent_proc.
END.

ON VALUE-CHANGED OF tbl-browse-s DO:
  FOR EACH tbl-fld:
    DELETE tbl-fld.
  END.
  cur-rec = RECID(DICTDB._FILE).
  run open_fld_browse.
END. 

/* Find each fields of this file in this database.  Remember, if the
   progress Db is acting as a schema holder, files for more than one
   database may exist in this one physical database.  */
RUN adecomm/_setcurs.p ("WAIT":u).

IF NOT AVAILABLE DICTDB._FILE THEN DO:
  IF INTEGER(DBVERSION("DICTDB")) > 8 THEN DO:
    IF cur-rec NE ? THEN
       FIND DICTDB._FILE NO-LOCK WHERE LOOKUP(DICTDB._FILE._OWNER,"PUB,_FOREIGN":U) > 0 AND
                                RECID(DICTDB._FILE) = cur-rec NO-ERROR.
    IF NOT AVAILABLE DICTDB._FILE THEN
      FIND FIRST DICTDB._FILE NO-LOCK 
         WHERE LOOKUP(DICTDB._FILE._OWNER,"PUB,_FOREIGN":U) > 0 AND
               CAN-DO(DICTDB._FILE._Can-Read, USERID("DICTDB":U)) AND
               NOT DICTDB._FILE._HIDDEN AND
               (DICTDB._FILE._FOR-TYPE = ? OR
                NOT CAN-DO(p_filters,_File._FOR-TYPE)).
  END.
  ELSE DO: /* DBVERSION = 8 */
    IF cur-rec NE ? THEN
       FIND DICTDB._FILE NO-LOCK WHERE RECID(DICTDB._FILE) = cur-rec NO-ERROR.
    IF NOT AVAILABLE DICTDB._FILE THEN
      FIND FIRST DICTDB._FILE NO-LOCK 
         WHERE CAN-DO(DICTDB._FILE._Can-Read, USERID("DICTDB":U)) AND
               NOT DICTDB._FILE._HIDDEN AND
               (DICTDB._FILE._FOR-TYPE = ? OR
                NOT CAN-DO(p_filters,_File._FOR-TYPE)).
  END.
END.

RUN open_fld_browse.

RUN adecomm/_setcurs.p ("").
IF p_multi THEN ENABLE fld-browse-m WITH FRAME ffrm-m.
ELSE ENABLE fld-browse-s WITH FRAME ffrm-s.

&ENDIF     /* End of Fields only setup */

p_Stat = TRUE.


PROCEDURE load-private-data:
  DEFINE VAR i AS INTEGER NO-UNDO.

  /* Load table browse */
  DO i = 1 TO h_tbl_brws:NUM-SELECTED-ROWS:
    ASSIGN p_Stat = h_tbl_brws:FETCH-SELECTED-ROW(i)
           h_tbl_brws:PRIVATE-DATA = (IF i = 1
                                      THEN DICTDB._FILE._FILE-NAME
                                      ELSE (h_tbl_brws:PRIVATE-DATA +
                                           ",":U + DICTDB._FILE._FILE-NAME)).
  END.
  
  &IF "{&FLDS}" = "YES" &THEN
    /* Load field browse */
    DO i = 1 TO h_fld_brws:NUM-SELECTED-ROWS:
      ASSIGN p_Stat = h_fld_brws:FETCH-SELECTED-ROW(i)
             h_fld_brws:PRIVATE-DATA = (IF i = 1
                                        THEN tbl-fld.fld-nm
                                        ELSE (h_fld_brws:PRIVATE-DATA +
                                             ",":U + tbl-fld.fld-nm)).
    END.
  &ENDIF
END.

/* ----------------------------------------------------------------- */
/*                        FOR FIELDS ONLY                            */
/* ----------------------------------------------------------------- */
&IF "{&FLDS}" = "YES" &THEN   /* Procedures necessary only for
                                 Field selection version       */
                                 
PROCEDURE open_fld_browse.
  IF p_DType = ? THEN DO:
    FOR EACH _FIELD OF DICTDB._FILE NO-LOCK
             WHERE CAN-DO(_Field._Can-Read, USERID("DICTDB":U)):
      CREATE tbl-fld.
      ASSIGN tbl-fld.fld-nm = _FIELD._FIELD-NAME + 
                              IF _FIELD._EXTENT > 1 THEN "[1-" + 
                                       TRIM(STRING(_FIELD._EXTENT)) + "]"
                              ELSE "".
    END.
  END. /* Select all fields */
  
  ELSE DO:
    FOR EACH _FIELD OF DICTDB._FILE NO-LOCK
             WHERE _Field._DATA-TYPE = p_DType AND
                   CAN-DO(_Field._Can-Read, USERID("DICTDB":U)):
      CREATE tbl-fld.
      ASSIGN tbl-fld.fld-nm = _FIELD._FIELD-NAME + 
                              IF _FIELD._EXTENT > 1 THEN "[1-" + 
                                       TRIM(STRING(_FIELD._EXTENT)) + "]"
                              ELSE "".
    END.
  END. /* Only select the correct data-type */
  IF p_multi THEN 
    OPEN QUERY fld-browse-m FOR EACH tbl-fld.
  ELSE
    OPEN QUERY fld-browse-s FOR EACH tbl-fld.
END.

PROCEDURE select-all:
  DEFINE VAR tmp-rec AS RECID   NO-UNDO.
  DEFINE VAR t_log   AS LOGICAL NO-UNDO.

  IF NOT p_multi THEN RETURN.  /* Safety check */
    
  h_fld_brws:REFRESHABLE = FALSE.  /* Stop any flashing */
  /* Save current position */
  cur-fld = IF AVAILABLE tbl-fld THEN RECID(tbl-fld) ELSE ? .

  /* Initialize the loop with first field */
  FIND FIRST tbl-fld NO-ERROR.
  IF AVAILABLE tbl-fld THEN tmp-rec = RECID(tbl-fld).
  ELSE tmp-rec = ?.
  
  rpt-blk:        /* Loop through records to select all */
  REPEAT ON END-KEY UNDO, LEAVE:
    IF tmp-rec ne ? THEN DO:
      REPOSITION fld-browse-m TO RECID tmp-rec.
      ASSIGN t_log = h_fld_brws:SELECT-FOCUSED-ROW().
      FIND NEXT tbl-fld NO-ERROR.
      IF AVAILABLE tbl-fld THEN tmp-rec = RECID(tbl-fld).
      ELSE tmp-rec = ?.
    END.
    ELSE LEAVE rpt-blk.
  END. /* REPEAT */

  /* Reposition back to where it was */
  IF cur-fld = ? THEN DO:
    FIND FIRST tbl-fld NO-ERROR.
    IF AVAILABLE tbl-fld THEN cur-fld = RECID(tbl-fld).
  END.
  IF cur-fld NE ? THEN REPOSITION fld-browse-m TO RECID cur-fld.

  h_fld_brws:REFRESHABLE = TRUE.
END.

&ENDIF     /* End of Field related procedures */

/* tblbrws.i - end of file */


/*********************************************************************
* Copyright (C) 2007 by Progress Software Corporation. All rights    *
* reserved.  Prior versions of this work may contain portions        *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/*----------------------------------------------------------------------------

File: adecomm/toolmenu.i

Description:

This file is part of the quartet of toolmenu.i, toolrun.i, toolsupp.i, _toollic.p.
These files together will build the standard tools menu used by all the
ADE applications.

Usage:

Include {adecomm/toolmenu.i} with your other menu defines. 

Include {adecomm/toolrun.i} after your menubar definition.  This file
should only be run once per menubar.  See toolrun.i for any arguments.

If you have any custom tools you want added to the tools menu

Arguments:

{ adecomm/toolmenu.i 
      /* &EXCLUDE_ADMIN=yes */
      /* &EXCLUDE_DICT=yes */
      /* &EXCLUDE_EDIT=yes */
      /* &CUSTOM_TOOLS =
               "MENU-ITEM mi_section_editor LABEL ""Section Editor...""
                RULE" */
}

&EXCLUDE_*    The calling tool should exclude itself from the menu.
&DEF_TRIGGERS Pass this argument to define menu triggers when the static
              menu items are defined. Pass as Yes or No.
&PERSISTENT   Pass in conjunction with DEF_TRIGGERS when you want triggers
              defined with menus to be persistent.

Author: 
Mike Pacholec

Date Created: 
May 21, 1993
          
Change Log:
06/29/99 jep   add trigger blocks for the static trigger definitions. Supports
               Advanced Editor features.
05/07/99 gfs   added Actuate products DWB and ARD
04/09/99 tsm   added run-dblist internal procedure to run protools/_dblist.w
               persistently
04-16-98 hd    added WTOOL_IDX for WebTools support
11/11/97 drh   Made the DEFINE SUB-MENU totally gone for UIB to accomodate
               9.0 "morphing menu", when called from UIB menus are mostly
               dynamic
01-29-96 jep   Removed PLIB_IDX / Proclib support
06-29-95 jep   added PTOOL_IDX for PRO*Tools support
05-21-93 mikep created and tested with Dictionary
05-26-92 mikep cache get-license, check call stack
05-26-92 wood  added &CUSTOM_TOOLS

----------------------------------------------------------------------------*/


/*-----------------------------  DEFINE MENUS   -----------------------------*/

&GLOB ADMIN_IDX  1
&GLOB DICT_IDX   2
&GLOB EDIT_IDX   3
&GLOB UIB_IDX    4
&GLOB RPT_IDX    5
&GLOB TRAN_IDX   6
&GLOB COMP_IDX   7
&GLOB DBG_IDX    8
&GLOB RB_IDX     9
&GLOB VTRAN_IDX  10
&GLOB PTOOL_IDX  11
&GLOB WTOOL_IDX  12
&GLOB DWB_IDX    13
&GLOB ARD_IDX    14
&GLOB APMT_IDX   15
&GLOB TOOL_COUNT 15

&GLOB NOT_AVAIL    0
&GLOB LICENSED     1
&GLOB INSTALLED    2

DEFINE NEW GLOBAL SHARED VARIABLE ade_licensed AS INTEGER EXTENT {&TOOL_COUNT} 
    INITIAL [ ? ] NO-UNDO.

/*-----------------------------  DEFINE MENUS   -----------------------------*/

&IF DEFINED(EXCLUDE_UIB) = 0 &THEN
DEFINE SUB-MENU mnu_Tools
    {&CUSTOM_TOOLS}   /* Add any special menu-items first */
&ENDIF
&IF DEFINED(EXCLUDE_DICT) = 0 AND DEFINED(EXCLUDE_UIB) = 0 &THEN
    MENU-ITEM mnu_dict     LABEL "&Data Dictionary"              
    &IF DEFINED(DEF_TRIGGERS) &THEN
    TRIGGERS:
      ON CHOOSE {&PERSISTENT} RUN _RunTool( INPUT "_dict.p" ).
    END.
    &ENDIF
&ENDIF
&IF DEFINED(EXCLUDE_EDIT) = 0 AND DEFINED(EXCLUDE_UIB) = 0 &THEN
    MENU-ITEM mnu_editor   LABEL "Procedure &Editor"
    &IF DEFINED(DEF_TRIGGERS) &THEN
    TRIGGERS:
      ON CHOOSE {&PERSISTENT} RUN _RunTool( INPUT "_edit.p" ).
    END.
    &ENDIF
&ENDIF
&IF "{&WINDOW-SYSTEM}" <> "TTY" AND DEFINED(EXCLUDE_ADMIN) = 0 
                                AND DEFINED(EXCLUDE_UIB) = 0 &THEN
    MENU-ITEM mnu_admin    LABEL "Data &Administration" 
    &IF DEFINED(DEF_TRIGGERS) &THEN
    TRIGGERS:
      ON CHOOSE {&PERSISTENT} RUN _RunTool( INPUT "_admin.p" ).
    END.
    &ENDIF
&ENDIF
&IF "{&WINDOW-SYSTEM}" = "TTY" &THEN
    MENU-ITEM mnu_OS_Shell LABEL "&OS Shell"
&ENDIF
&IF "{&WINDOW-SYSTEM}" <> "TTY" AND DEFINED(EXCLUDE_UIB) = 0 &THEN
    MENU-ITEM mnu_ProTools LABEL "&PRO*Tools"
    TRIGGERS:
      ON CHOOSE PERSISTENT RUN run-protool.
    END TRIGGERS.
&ENDIF
/* APMT only available on GUI - data admin, data dict, Proc Editor and UIB only */
&IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN
    &if DEFINED(EXCLUDE_UIB) = 0 AND (DEFINED(EXCLUDE_ADMIN) <> 0 OR
                                      DEFINED(EXCLUDE_EDIT) <> 0 OR
                                      DEFINED(EXCLUDE_DICT) <> 0) &THEN
        MENU-ITEM mnu_apmt    LABEL "Audit Policy &Maintenance"  
        &IF DEFINED(DEF_TRIGGERS) &THEN
        TRIGGERS:
          ON CHOOSE {&PERSISTENT} RUN auditing/_apmt.p.
        END.
        &ENDIF
    &ENDIF
&ENDIF
/* Assembly References only available on GUI - Proc Editor only */
&IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN
    &if DEFINED(EXCLUDE_EDIT) <> 0 &THEN
        MENU-ITEM mnu_asmref    LABEL "A&ssembly References"  
        &IF DEFINED(DEF_TRIGGERS) &THEN
        TRIGGERS:
          ON CHOOSE {&PERSISTENT} RUN run-asmref.
        END.
        &ENDIF
    &ENDIF
&ENDIF
.

/* Define this procedure once and call it from the persistent procedure
   this is necessary to get around the problem of not being able to run
   a persistent procedure from a dynamic persistent trigger.              */
PROCEDURE run-protool:
  RUN "protools/_protool.p" PERSISTENT.
END.  /* PROCEDURE run-protool */

PROCEDURE run-dblist:
  RUN "protools/_dblist.w" PERSISTENT.
END.  /* PROCEDURE run-dblist */

PROCEDURE run-apmt:
    RUN auditing/_apmt.p.
END.

&IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN
PROCEDURE run-asmref:
    DEFINE VARIABLE dlcValue AS CHARACTER NO-UNDO. /* DLC */
    DEFINE VARIABLE retval AS INTEGER NO-UNDO.
    DEFINE VARIABLE exeValue AS CHARACTER NO-UNDO.

    IF OPSYS = "Win32":U THEN /* Get DLC from Registry */
      GET-KEY-VALUE SECTION "Startup":U KEY "DLC":U VALUE dlcValue.

    IF (dlcValue = "" OR dlcValue = ?) THEN DO:
      ASSIGN dlcValue = OS-GETENV("DLC":U). /* Get DLC from environment */
      IF (dlcValue = "" OR dlcValue = ?) THEN DO: /* Still nothing? */
        RETURN.
      END.
    END.

    exeValue = dlcValue + "\bin\proasmref.exe".

    RUN ProExec(exeValue,
                1 /* SW_SHOWNORMAL */,
                1 /* Wait (modal) */,
                1 /* unused */,
                OUTPUT retval).

    IF retval = 2 THEN
        MESSAGE "Assembly References tool not found:" exeValue
            VIEW-AS ALERT-BOX.
    ELSE
        IF retval <> 0 THEN
            MESSAGE "Error" retval "launching Assembly References tool:" 
                exeValue VIEW-AS ALERT-BOX.
END.

PROCEDURE ProExec EXTERNAL "PROEXEC.DLL" CDECL:
    DEFINE INPUT PARAMETER prog_name AS CHARACTER.
    DEFINE INPUT PARAMETER prog_style AS LONG.
    DEFINE INPUT PARAMETER wait_for_me as LONG.
    DEFINE INPUT PARAMETER num_seconds as SHORT.
    DEFINE RETURN PARAMETER return_value as LONG.
END.
&ENDIF /* "{&WINDOW-SYSTEM}" <> "TTY" */
/*********************************************************************
* Copyright (C) 2005 by Progress Software Corporation. All rights    *
* reserved.  Prior versions of this work may contain portions        *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/*----------------------------------------------------------------------------

File: adecomm/toolrun.i

Description:

This file is part of the quartet of toolmenu.i, toolrun.i, toolsupp, _toollic.p.
These files together will build the standard tools menu used by all the
ADE applications.

Usage:

Include {adecomm/toolmenu.i} with your other menu defines.  See toolmenu.i
for any arguments.

Include {adecomm/toolrun.i} after your menubar definition.  This file
should only be run once per menubar.  When being called from the AB
(DEFINED(EXCLUDE_UIB) <> 0) there is no need to also include toolsupp.i as
this file includes it for you.  In the AB it needed to be broken out as
this file is included inside of an internal procedure (mode_morph) thereby
making it illegal to define the internal procedure utilities required by
this file (_RunTool and tools_check_call_stack).

This file will attempt to RUN enable_widgets and disable_widgets.  These
should be internal procedures in the file which includes toolrun.i.  
These procedures should perform any specific operations that your application
must do to prepare for running another application.  One example is 
resetting CURRENT-WINDOW back to your application's current window in
procedure enable_widgets.

Items on the Tool menu are enabled or disabled based on a number of states:
1. licensed or not - not visible if not licensed (use GET-LICENSE)
2. installed or not - grayed out if not installed (use SEARCH for _edit.p, ...).
3. tty or not - not visible if not applicable (use preprocessor)
4. in the call stack already or not - grays out of already in call stack 
  (Tran Mgr will not show up on the Editor Tools menu if _tran.p can be 
   found in the call tree - use PROGRAM-NAME)
5. in that tool already or not - not visible if not (Editor does not have 
   Editor on Tools menu - use preprocessor)

There is also a 6th condition to handle a RUN not on the tools menu.

6. if self is already in the call stack, display a message and set the
   tool_bomb variable to let includer handle the exit

Arguments:

{ adecomm/toolrun.i 
      &MENUBAR="mnb_Desktop"
      /* &EXCLUDE_ADMIN=yes */
      /* &EXCLUDE_DICT=yes */
      /* &EXCLUDE_EDIT=yes */
      /* &EXCLUDE_UIB=yes */
      /* &EXCLUDE_RPT=yes */
      /* &EXCLUDE_TRAN=yes */
      /* &EXCLUDE_VTRAN=yes */
      /* &EXCLUDE_COMP=yes */
      /* &ENABLE_WIDGETS_PROC = alternate enable routine [optional]  */
      /* &DISABLE_WIDGETS_PROC = alternate disable routine [optional] */
      /* &DISABLE_ONLY = on choose of tool, call disable routine
                                           only - [optional (for dictionary)] */
      /* &PERSISTENT=PERSISTENT = makes triggers persistent, default is scoped */
      /* &TOOL_RUN=yes */
}

&MENUBAR    - name the menubar that contains the toolmenu.i include.
&EXCLUDE_*  - The calling tool should exclude itself from the menu.
&TOOL_RUN   - If passed/define, indicates toolrun.i has been included once
              already. Use by Procedure Editor to attach both static and
              dynamic mnu_Tools menus to support Advanced Editing Options
              features.

NOTE: This procedure defines two local variables
        tool_bomb - set true if the current tool should not be running
        tool_pgm_list - list of tools running (used to define triggers).

Author: Mike Pacholec

Date Created: May 21, 1993
          
Change Log:
08-19-01 jep   For EXLCUDE_UIB menu items, added support for h_sm handle to specify
               dynamic Tools menu parent in place of static mnu_Tools reference.
               Part of ICF support. jep-icf
06-29-99 jep   Added TOOL_RUN support for including file a second time.
               See above notes.
05-07-99 gfs   Added Actuate DWB and ARD
04-16-98 hd    Added WebTools  
11-14097 drh   Made many of the menu items dynamic when called from the UIB
01-29-96 jep   Removed Proclib tool from tool set (PLIB).
09-05-95 jep   Correct calls to VTRAN.
06-29-95 jep   Corrected PROT*Tools menu handling to be consistent.
05-17-95 jep   Added Visual Translator Tool (VTRAN) - supplemental tool for
               Tran Man II.
06-23-94 jep   Improved message about running a tool more than once.
06-25-93 jep   Corrected COMP_ENTRYPT from procomp.p to _procomp.p.
06-03-93 stern Added DISABLE_ONLY argument.
06-01-93 mikep re-enabled check for > 1 run of a tool
05-26-93 mikep cache get-license, check call stack
05-26-93 wood  removed WIDGET-POOL; Moved i and pgm_name into internal
               procedure tools_check_call_stack.
               Added optional parameter ENABLE_WIDGETS_PROC and
               DISABLE_WIDGETS_PROC to replace calls to enable_widgets
               and disable_widgets.
05-25-93 mikep disable non-installed menu items
05-21-93 mikep created and tested with Dictionary

----------------------------------------------------------------------------*/

&SCOP ADMIN_ENTRYPT "prodict/_dictc.p"
&IF "{&WINDOW-SYSTEM}" = "TTY" &THEN
&SCOP DICT_ENTRYPT  "prodict/_dictc.p"
&ELSE
&SCOP DICT_ENTRYPT  "adedict/_dictg.p"
&ENDIF
&SCOP EDIT_ENTRYPT  "adeedit/_proedit.p"
&SCOP UIB_ENTRYPT   "adeuib/_uibmain.p"
&SCOP RPT_ENTRYPT   "aderes/aderes.p"
&SCOP RB_ENTRYPT    "aderb/_startrb.p"
&SCOP TRAN_ENTRYPT  "adetran/pm/_pmmain.p"
&SCOP VTRAN_ENTRYPT "adetran/vt/_main.p"
&SCOP COMP_ENTRYPT  "adecomp/_procomp.p"
&SCOP APMT_ENTRYPT  "auditing/_apmt.p"

&IF DEFINED(EXCLUDE_UIB) = 0 AND DEFINED(TOOL_RUN) = 0 &THEN
  DEFINE VARIABLE tool_pgm_list AS CHARACTER                          NO-UNDO.
  DEFINE VARIABLE tool_bomb     AS LOGICAL                            NO-UNDO.
&ENDIF


/*--------------------------------------------------------------------------*/
IF ade_licensed[1] = ? THEN
    RUN adecomm/_toollic.p.

/*--------------------- Check the call stack ----------------------------*/

RUN tools_check_call_stack.

/* FIX - Once all tools check for tool_bomb this should be uncommented.
IF tool_bomb THEN RETURN.
*/


/*--------------------- DICTIONARY MENU PROCESSING --------------------------*/

&IF DEFINED(EXCLUDE_DICT) = 0 AND DEFINED(EXCLUDE_UIB) = 0 &THEN
  IF ade_licensed[{&DICT_IDX}] <> {&INSTALLED} OR 
     CAN-DO(tool_pgm_list, {&DICT_ENTRYPT}) 
  THEN MENU-ITEM mnu_dict:SENSITIVE IN MENU mnu_Tools = No.
  ELSE ON CHOOSE OF MENU-ITEM mnu_dict IN MENU mnu_Tools
                    {&PERSISTENT} RUN _RunTool( INPUT "_dict.p" ).

&ELSEIF DEFINED(EXCLUDE_DICT) = 0 AND DEFINED(EXCLUDE_UIB) <> 0 &THEN
  CREATE MENU-ITEM mnu_dict ASSIGN LABEL = "&Data Dictionary"         PARENT = h_sm
         TRIGGERS: ON CHOOSE PERSISTENT RUN _RunTool(INPUT "_dict.p"). END TRIGGERS.

&ENDIF

/*--------------------- EDITOR MENU PROCESSING --------------------------*/

&IF DEFINED(EXCLUDE_EDIT) = 0 AND DEFINED(EXCLUDE_UIB) = 0 &THEN
  IF ade_licensed[{&EDIT_IDX}] <> {&INSTALLED} OR 
     CAN-DO(tool_pgm_list, {&EDIT_ENTRYPT}) 
  THEN MENU-ITEM mnu_editor:SENSITIVE IN MENU mnu_Tools = No.
  ELSE ON CHOOSE OF MENU-ITEM mnu_editor IN MENU mnu_Tools
                   {&PERSISTENT} RUN _RunTool( INPUT "_edit.p" ).

&ELSEIF DEFINED(EXCLUDE_EDIT) = 0 AND DEFINED(EXCLUDE_UIB) <> 0 &THEN
  CREATE MENU-ITEM mnu_editor ASSIGN LABEL = "Procedure &Editor"      PARENT = h_sm
         TRIGGERS: ON CHOOSE PERSISTENT RUN choose_editor IN _h_UIB. END TRIGGERS.

&ENDIF

/*--------------------- ADMIN MENU PROCESSING --------------------------*/

&IF "{&WINDOW-SYSTEM}" <> "TTY" AND DEFINED(EXCLUDE_ADMIN) = 0 AND DEFINED(EXCLUDE_UIB) = 0 &THEN
  IF ade_licensed[{&ADMIN_IDX}] <> {&INSTALLED} OR 
     CAN-DO(tool_pgm_list, {&ADMIN_ENTRYPT}) 
  THEN MENU-ITEM mnu_admin:SENSITIVE IN MENU mnu_Tools = No.
  ELSE ON CHOOSE OF MENU-ITEM mnu_admin IN MENU mnu_Tools
                   {&PERSISTENT} RUN _RunTool( INPUT "_admin.p" ).

&ELSEIF DEFINED(EXCLUDE_ADMIN) = 0 AND DEFINED(EXCLUDE_UIB) <> 0 &THEN
  CREATE MENU-ITEM mnu_admin ASSIGN LABEL = "Data &Administration"     PARENT = h_sm
         TRIGGERS: ON CHOOSE PERSISTENT RUN _RunTool(INPUT "_admin.p"). END TRIGGERS.
  mnu_admin:SENSITIVE = (ade_licensed[{&ADMIN_IDX}] = {&INSTALLED} AND
                            NOT CAN-DO(tool_pgm_list, {&ADMIN_ENTRYPT})).

&ENDIF
/*--------------------- PRO*TOOLS MENU PROCESSING --------------------------*/

&IF "{&WINDOW-SYSTEM}" <> "TTY" AND DEFINED(EXCLUDE_UIB) = 0 &THEN
  IF ade_licensed[{&PTOOL_IDX}] <> {&INSTALLED}
  THEN MENU-ITEM mnu_protools:SENSITIVE IN MENU mnu_Tools = No.
  ELSE ON CHOOSE OF MENU-ITEM mnu_protools IN MENU mnu_Tools
                 RUN "protools/_protool.p" PERSISTENT.

&ELSEIF DEFINED(EXCLUDE_UIB) <> 0 &THEN
  CREATE MENU-ITEM mnu_protools ASSIGN LABEL = "&PRO*Tools"  PARENT = h_sm
         TRIGGERS:
           ON CHOOSE PERSISTENT RUN run-protool.
         END TRIGGERS.
  mnu_protools:SENSITIVE = (ade_licensed[{&PTOOL_IDX}] = {&INSTALLED}).

&ENDIF

/*--------------------- APMT MENU PROCESSING --------------------------*/

/* only available on GUI - data admin, data dict, proc editor and UIB only */

&IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN
&IF (DEFINED(EXCLUDE_DICT) <> 0 OR DEFINED(EXCLUDE_ADMIN) <> 0 OR 
    DEFINED(EXCLUDE_EDIT) <> 0) AND DEFINED(EXCLUDE_UIB) = 0 &THEN

  IF ade_licensed[{&APMT_IDX}] <> {&INSTALLED} OR 
     CAN-DO(tool_pgm_list, {&APMT_ENTRYPT}) THEN 
     MENU-ITEM mnu_apmt:SENSITIVE IN MENU mnu_Tools = No.
  ELSE DO:
      ON CHOOSE OF MENU-ITEM mnu_apmt IN MENU mnu_Tools
                    {&PERSISTENT} RUN "auditing/_apmt.p".
  END.

&ELSEIF DEFINED(EXCLUDE_UIB) <> 0 &THEN

  &IF DEFINED(TOOL_RUN) = 0 &THEN
  DEFINE VARIABLE mnu_apmt_wh AS WIDGET-HANDLE.
  &ENDIF
  CREATE MENU-ITEM mnu_apmt_wh ASSIGN LABEL = "Audit Policy &Maintenance" PARENT = h_sm
         TRIGGERS: 
            ON CHOOSE PERSISTENT RUN run-apmt.
         END TRIGGERS.

  IF ade_licensed[{&APMT_IDX}] <> {&INSTALLED} OR 
     CAN-DO(tool_pgm_list, {&APMT_ENTRYPT}) 
  THEN
     mnu_apmt_wh:SENSITIVE = No.

&ENDIF
&ENDIF


/*--------------------- Tool Menu Internal Procecdures ------------------*/

/*------------------------------ OS SHELL -------------------------------*/

&IF "{&WINDOW-SYSTEM}" = "TTY" &THEN
ON CHOOSE OF MENU-ITEM mnu_OS_Shell IN MENU mnu_Tools
DO:
    DO ON STOP UNDO, RETRY:
        IF NOT RETRY
        THEN DO:
            RUN disable_widgets.
            OS-COMMAND.
        END.
        RUN enable_widgets.
    END.
END.
&ENDIF

/*---------------------- AB MENU PROCESSING --------------------------*/

&IF "{&WINDOW-SYSTEM}" <> "TTY" AND DEFINED(EXCLUDE_UIB) = 0 &THEN
IF ade_licensed[{&UIB_IDX}] <> {&NOT_AVAIL} THEN DO:

    &IF DEFINED(TOOL_RUN) = 0 &THEN
    DEFINE VARIABLE mnu_uib_wh AS WIDGET-HANDLE.
    &ENDIF
    CREATE MENU-ITEM mnu_uib_wh
        ASSIGN 
            LABEL       = "App&Builder"
            PARENT      = MENU mnu_Tools:HANDLE IN MENU {&MENUBAR}
    TRIGGERS:
        ON CHOOSE {&PERSISTENT} RUN _RunTool( INPUT "_ab.p" ).
    END TRIGGERS.
    IF ade_licensed[{&UIB_IDX}] <> {&INSTALLED} OR 
       CAN-DO(tool_pgm_list, {&UIB_ENTRYPT}) 
    THEN
        mnu_uib_wh:SENSITIVE = No.
END.
&ENDIF

/*--------------------- WEBTOOLS MENU PROCESSING --------------------------*/
&IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN
&IF DEFINED(TOOL_RUN) = 0 &THEN
DEFINE VARIABLE mnu_webtools AS WIDGET-HANDLE NO-UNDO.
&ENDIF
IF ade_licensed[{&WTOOL_IDX}] <> {&NOT_AVAIL} THEN 
DO:
  CREATE MENU-ITEM mnu_webtools 
    ASSIGN LABEL  = "&WebT&ools" 
           PARENT = &IF DEFINED(EXCLUDE_UIB) = 0 &THEN MENU mnu_Tools:HANDLE IN MENU {&MENUBAR}
                    &ELSE h_sm &ENDIF
         TRIGGERS:
           ON CHOOSE PERSISTENT RUN adeweb/_abrunwb.p("workshop").
         END TRIGGERS.
  mnu_webtools:SENSITIVE = (ade_licensed[{&WTOOL_IDX}] = {&INSTALLED}).
END.
&ENDIF

/*--------------------- RB MENU PROCESSING --------------------------*/
&IF "{&WINDOW-SYSTEM}" BEGINS "MS-WIN" &THEN

&IF "{&WINDOW-SYSTEM}" <> "TTY" AND DEFINED(EXCLUDE_RB) = 0 &THEN
IF ade_licensed[{&RB_IDX}] <> {&NOT_AVAIL} THEN DO:

    &IF DEFINED(TOOL_RUN) = 0 &THEN
    DEFINE VARIABLE mnu_rb_wh AS WIDGET-HANDLE.
    &ENDIF
    CREATE MENU-ITEM mnu_rb_wh
        ASSIGN 
            LABEL       = "Report B&uilder"
            PARENT      = &IF DEFINED(EXCLUDE_UIB) = 0 &THEN MENU mnu_Tools:HANDLE IN MENU {&MENUBAR}
                          &ELSE h_sm &ENDIF
    TRIGGERS:
        ON CHOOSE {&PERSISTENT} RUN _RunTool( INPUT "_rbuild.p" ).
    END TRIGGERS.
    IF ade_licensed[{&RB_IDX}] <> {&INSTALLED} OR 
       CAN-DO(tool_pgm_list, {&RB_ENTRYPT}) 
    THEN
        mnu_rb_wh:SENSITIVE = No.
END.
&ENDIF
&ENDIF

/*--------------------- RW MENU PROCESSING --------------------------*/

&IF "{&WINDOW-SYSTEM}" <> "TTY" AND DEFINED(EXCLUDE_RPT) = 0 &THEN
IF ade_licensed[{&RPT_IDX}] <> {&NOT_AVAIL} THEN DO:

    &IF DEFINED(TOOL_RUN) = 0 &THEN
    DEFINE VARIABLE mnu_rpt_wh AS WIDGET-HANDLE.
    &ENDIF
    CREATE MENU-ITEM mnu_rpt_wh
        ASSIGN 
            LABEL       = "&RESULTS"
            PARENT      = &IF DEFINED(EXCLUDE_UIB) = 0 &THEN MENU mnu_Tools:HANDLE IN MENU {&MENUBAR}
                          &ELSE h_sm &ENDIF
    TRIGGERS:
        ON CHOOSE {&PERSISTENT} RUN _RunTool( INPUT "results.p" ).
    END TRIGGERS.
    IF ade_licensed[{&RPT_IDX}] <> {&INSTALLED} OR 
       CAN-DO(tool_pgm_list, {&RPT_ENTRYPT}) 
    THEN
        mnu_rpt_wh:SENSITIVE = No.
END.
&ENDIF

/*--------------------- TRANMAN MENU PROCESSING --------------------------*/

&IF "{&WINDOW-SYSTEM}" BEGINS "MS-WIN" AND DEFINED(EXCLUDE_TRAN) = 0 &THEN
IF ade_licensed[{&TRAN_IDX}] <> {&NOT_AVAIL} THEN DO:

    &IF DEFINED(TOOL_RUN) = 0 &THEN
    DEFINE VARIABLE mnu_tran_wh AS WIDGET-HANDLE.
    &ENDIF
    CREATE MENU-ITEM mnu_tran_wh
        ASSIGN 
            LABEL       = "&Translation Manager"
            PARENT      = &IF DEFINED(EXCLUDE_UIB) = 0 &THEN MENU mnu_Tools:HANDLE IN MENU {&MENUBAR}
                          &ELSE h_sm &ENDIF
    TRIGGERS:
        ON CHOOSE {&PERSISTENT} RUN _RunTool( INPUT "_tran.p" ).
    END TRIGGERS.
    IF ade_licensed[{&TRAN_IDX}] <> {&INSTALLED} OR 
       CAN-DO(tool_pgm_list, {&TRAN_ENTRYPT}) 
    THEN
        mnu_tran_wh:SENSITIVE = No.
END.
&ENDIF

/*------------ VISUAL TRANSLATOR MENU PROCESSING --------------------------*/

&IF "{&WINDOW-SYSTEM}" BEGINS "MS-WIN" AND DEFINED(EXCLUDE_VTRAN) = 0 &THEN
IF ade_licensed[{&VTRAN_IDX}] <> {&NOT_AVAIL} THEN DO:

    &IF DEFINED(TOOL_RUN) = 0 &THEN
    DEFINE VARIABLE mnu_vtran_wh AS WIDGET-HANDLE.
    &ENDIF
    CREATE MENU-ITEM mnu_vtran_wh
        ASSIGN
            LABEL       = "&Visual Translator"
            PARENT      = &IF DEFINED(EXCLUDE_UIB) = 0 &THEN MENU mnu_Tools:HANDLE IN MENU {&MENUBAR}
                          &ELSE h_sm &ENDIF
    TRIGGERS:
        ON CHOOSE {&PERSISTENT} RUN _RunTool( INPUT "_vtran.p").
    END TRIGGERS.
    IF ade_licensed[{&VTRAN_IDX}] <> {&INSTALLED} OR
       CAN-DO(tool_pgm_list, {&VTRAN_ENTRYPT})
    THEN
        mnu_vtran_wh:SENSITIVE = No.
END.
&ENDIF

/*--------------------- COMPILER MENU PROCESSING --------------------------*/

&IF DEFINED(EXCLUDE_COMP) = 0 &THEN
IF ade_licensed[{&COMP_IDX}] <> {&NOT_AVAIL} THEN DO:

    &IF DEFINED(TOOL_RUN) = 0 &THEN
    DEFINE VARIABLE mnu_comp_wh AS WIDGET-HANDLE.
    &ENDIF
    CREATE MENU-ITEM mnu_comp_wh
        ASSIGN 
            LABEL       = "Application &Compiler"
            PARENT      = &IF DEFINED(EXCLUDE_UIB) = 0 &THEN MENU mnu_Tools:HANDLE IN MENU {&MENUBAR}
                          &ELSE h_sm &ENDIF
    TRIGGERS:
        ON CHOOSE {&PERSISTENT} RUN _RunTool( INPUT "_comp.p" ).
    END TRIGGERS.
    IF ade_licensed[{&COMP_IDX}] <> {&INSTALLED} OR  
       CAN-DO(tool_pgm_list, {&COMP_ENTRYPT}) 
    THEN
        mnu_comp_wh:SENSITIVE = No.
END.
&ENDIF

/*--------------------- DWB MENU PROCESSING --------------------------*/

&IF "{&WINDOW-SYSTEM}" BEGINS "MS-WIN" &THEN
IF ade_licensed[{&DWB_IDX}] <> {&NOT_AVAIL} THEN DO:
    &IF DEFINED(TOOL_RUN) = 0 &THEN
    DEFINE VARIABLE mnu_dwb_wh AS WIDGET-HANDLE.
    &ENDIF
        
    CREATE MENU-ITEM mnu_dwb_wh
        ASSIGN 
            LABEL       = "Actuate Developer &Workbench"
            PARENT      = &IF DEFINED(EXCLUDE_UIB) = 0 &THEN MENU mnu_Tools:HANDLE IN MENU {&MENUBAR}
                          &ELSE h_sm &ENDIF
    TRIGGERS:
        ON CHOOSE {&PERSISTENT} RUN adecomm/_rundwb.p.
    END TRIGGERS.
END.
&ENDIF

/*--------------------- ARD MENU PROCESSING --------------------------*/

&IF "{&WINDOW-SYSTEM}" BEGINS "MS-WIN" &THEN
IF ade_licensed[{&ARD_IDX}] <> {&NOT_AVAIL} THEN DO:
    &IF DEFINED(TOOL_RUN) = 0 &THEN
    DEFINE VARIABLE mnu_ard_wh AS WIDGET-HANDLE.
    &ENDIF
        
    CREATE MENU-ITEM mnu_ard_wh
        ASSIGN 
            LABEL       = "e.Report Des&igner"
            PARENT      = &IF DEFINED(EXCLUDE_UIB) = 0 &THEN MENU mnu_Tools:HANDLE IN MENU {&MENUBAR}
                          &ELSE h_sm &ENDIF
    TRIGGERS:
        ON CHOOSE {&PERSISTENT} RUN adecomm/_runard.p.
    END TRIGGERS.
END.
&ENDIF

&IF DEFINED(EXCLUDE_UIB) = 0 AND DEFINED(TOOL_RUN) = 0 &THEN
  &IF DEFINED(DISABLE_ONLY) NE 0 &THEN
     {adecomm/toolsupp.i 
               &DISABLE_WIDGETS_PROC = {&DISABLE_WIDGETS_PROC}
               &DISABLE_ONLY = {&DISABLE_ONLY} }
   &ELSE
     {adecomm/toolsupp.i}
   &ENDIF
&ENDIF



/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/*----------------------------------------------------------------------------

File: adecomm/toolsupp.i

Description:

This file is part of the foursome of toolmenu.i, toolrun.i, toolsupp.i,
_toollic.p.  These files together will build the standard tools menu used by
all the ADE applications.

Usage:

adecomm/toolsupp.i used to be part of toolrun.i which has traditionally been
included in the "Main procedure" part of each tool.  It contains two support
procedures (_RunTool and tools_check_call_stack) to support the creation of
tools menu at run-time based on which tools have been licensed.  In 9.0 the
UIB needs to dynamically morph the menus so the UIB needs to have a "mode-morph"
procedure to set up the tools menu.  This "internal" procedure cannot define
other internal procedures, so toolsupp.i was created so that the UIB can move
these procedure definitions "outside" of the "mode-morph" procedure.


NOTE: These procedures need two local variables
        tool_bomb - set true if the current tool should not be running
        tool_pgm_list - list of tools running (used to define triggers).  */


PROCEDURE _RunTool.
/*----------------------------------------------------------------------------
  Purpose     : Runs an ADE Tool.  Tool to run cannot have Run-Time Parameters
                or arguments.
  Syntax      :
                  RUN _RunTool( INPUT  p_Program_Name ) .

  Description :

  Author      : J. Palazzo
----------------------------------------------------------------------------*/

    DEFINE INPUT PARAMETER p_Program_Name  AS CHARACTER NO-UNDO.

    /* DISABLE_WIDGETS_PROC is still used in adedict/_dictg.p */

    &IF DEFINED(DISABLE_ONLY) NE 0 &THEN
        &IF DEFINED(DISABLE_WIDGETS_PROC) EQ 0  
        &THEN RUN disable_widgets (INPUT p_Program_Name).
        &ELSE RUN {&DISABLE_WIDGETS_PROC} (INPUT p_Program_Name). &ENDIF
    &ELSE   
       REPEAT ON STOP UNDO, RETRY:
           IF NOT RETRY
           THEN DO:
               &IF DEFINED(DISABLE_WIDGETS_PROC) EQ 0  
               &THEN RUN disable_widgets.
               &ELSE RUN {&DISABLE_WIDGETS_PROC} . &ENDIF
               RUN VALUE( p_Program_Name ).
           END.
           &IF DEFINED(ENABLE_WIDGETS_PROC) EQ 0 
           &THEN RUN enable_widgets.
           &ELSE RUN {&ENABLE_WIDGETS_PROC} . &ENDIF
           LEAVE.
       END. /* REPEAT RETRY */
    &ENDIF
    
END PROCEDURE.

 
PROCEDURE tools_check_call_stack:
    /* --------------------------------------------------------------------
       This procedure is defined to minimize the use of Local variables in
       toolrun.i which might conflict with the calling program.
       It checks what ADE tools are running and 
     --------------------------------------------------------------------*/
    DEFINE VARIABLE i          AS INTEGER NO-UNDO INITIAL 1.
    DEFINE VARIABLE pgm_name   AS CHAR NO-UNDO.
    DEFINE VARIABLE this_tool  AS CHAR NO-UNDO.
    DEFINE VARIABLE this_count AS INTEGER INITIAL 0.

    &IF     DEFINED(EXCLUDE_ADMIN) <> 0 &THEN this_tool = {&ADMIN_ENTRYPT}.
    &ELSEIF DEFINED(EXCLUDE_DICT)  <> 0 &THEN this_tool = {&DICT_ENTRYPT}.
    &ELSEIF DEFINED(EXCLUDE_EDIT)  <> 0 &THEN this_tool = {&EDIT_ENTRYPT}.
    &ELSEIF DEFINED(EXCLUDE_UIB)   <> 0 &THEN this_tool = {&UIB_ENTRYPT}.
    &ELSEIF DEFINED(EXCLUDE_RPT)   <> 0 &THEN this_tool = {&RPT_ENTRYPT}.
    &ELSEIF DEFINED(EXCLUDE_RB)    <> 0 &THEN this_tool = {&RB_ENTRYPT}.
    &ELSEIF DEFINED(EXCLUDE_TRAN)  <> 0 &THEN this_tool = {&TRAN_ENTRYPT}.
    &ELSEIF DEFINED(EXCLUDE_VTRAN) <> 0 &THEN this_tool = {&VTRAN_ENTRYPT}.
    &ELSEIF DEFINED(EXCLUDE_COMP)  <> 0 &THEN this_tool = {&COMP_ENTRYPT}.
    &ELSE
        this_tool = ?.
    &ENDIF

    pgm_name = PROGRAM-NAME(i).
    i = i + 1.
    DO WHILE (pgm_name <> ?):
        IF pgm_name = this_tool THEN DO:
           this_count = this_count + 1.
           IF this_count > 1 THEN DO:
             MESSAGE "This tool is already running. PROGRESS cannot run more than" 
                      &IF "{&WINDOW-SYSTEM}" BEGINS "MS-WIN" &THEN &ELSE SKIP &ENDIF
                      "one copy of an ADE tool."
                      VIEW-AS ALERT-BOX ERROR.
             ASSIGN tool_bomb = True.
           END.
        END.
        ASSIGN
            tool_pgm_list = tool_pgm_list + "," + pgm_name
            pgm_name = PROGRAM-NAME(i)
            i = i + 1.
    END.

    &IF {&DEBUG} &THEN
    MESSAGE "tool_pgm_list" tool_pgm_list 
        VIEW-AS ALERT-BOX INFORMATION BUTTONS OK.
    &ENDIF

END PROCEDURE.


/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/*----------------------------------------------------------------------------

File: trigdlg.i

Description:
   Some standard definitions and triggers for the dictionary trigger 
   editor and UIB section editor.

Arguments:
   &Insert_Lbl - Label for the Insert button
   &Insert_Wid - Width for the insert button
   &Apply_Action - Then text string for the Apply Action 
                   (usually "Save" or "Store") 

Author: Laura Stern

Date Created: 05/11/93
----------------------------------------------------------------------------*/

/* Widget definitions */

define button btn_cut      label "Cu&t"		  size 9 BY 1.125.
define button btn_copy     label "&Copy"	         size 9 BY 1.125.
define button btn_paste    label "&Paste"	         size 9 BY 1.125.
     
define button btn_find     label "&Find..."	  size 9 BY 1.125.
define button btn_next     label "&>"		  size 3 BY 1.125.
define button btn_prev     label "&<"		  size 3 BY 1.125.

define button btn_replace  label "&Replace..."     size 12 BY 1.125.
define button btn_insert   label "{&Insert_Lbl}"   size {&Insert_Wid} BY 1.125.

define button btn_delete   label "&Delete"         size 9 BY 1.125.
define button btn_revert   label "Re&vert"         size 9 BY 1.125.

define button btn_now      label "No&w"            size 6 BY 1.125.

define var tgl_syntax_lbl as char    init "Check Syntax:" no-undo
      	   format "x(13)".
define var tgl_syntax 	  as logical label "&On {&Apply_Action}"  no-undo
      	   view-as TOGGLE-BOX.

&global-define TRIG_LAYOUT   SKIP({&VM_WIDG})                 ~
      	       	     	     btn_cut   at 2 SPACE({&HM_BTN})  ~
			     btn_copy	    SPACE({&HM_BTN})  ~
			     btn_paste	    SPACE({&HM_BTNG}) ~
			     btn_find	    SPACE({&HM_BTN})  ~
			     btn_prev	    SPACE({&HM_BTN})  ~
			     btn_next	    SPACE({&HM_BTN})  ~
			     btn_replace    SPACE({&HM_BTNG}) ~
			     btn_insert	                      ~
			     SKIP({&VM_WID})                  ~
      	       	     	     "Trigger:" at 3                  ~
                             btn_delete                       ~
			     btn_revert     SPACE({&HM_WIDG}) ~
			     tgl_syntax_lbl no-label SPACE(0) ~
			     btn_now                          ~
			     tgl_syntax

/* Widget handle to the text editor widget - must be set by includer. */
define var h_Editor as widget-handle no-undo.

/*--------------------------------------------------------------
   Do some runtime frame layout.

   Input Parameters:
      p_FrameWid - internal width of the frame
      p_Lbl      - widget handle of check syntax label widget
      p_Btn    	 - widget handle of check syntax button
      p_Tgl    	 - widget handle of check syntax toggle
      p_Rect   	 - widget handle of separator rectangle 
      	           between the button section and rest of frame
--------------------------------------------------------------*/
procedure Adjust_Trig_Layout:

   define input parameter p_FrameWid as decimal       no-undo.
   define input parameter p_Lbl      as widget-handle no-undo.
   define input parameter p_Btn      as widget-handle no-undo.
   define input parameter p_Tgl      as widget-handle no-undo.
   define input parameter p_Rep      as widget-handle no-undo.
   define input parameter p_Nex      as widget-handle no-undo.
   define input parameter p_Pre      as widget-handle no-undo.
   define input parameter p_Fin      as widget-handle no-undo.
   define input parameter p_Ins      as widget-handle no-undo.
   define input parameter p_Cop      as widget-handle no-undo.
   define input parameter p_Pas      as widget-handle no-undo.
   define input parameter p_Del      as widget-handle no-undo.
   define input parameter p_Rev      as widget-handle no-undo.

   define var w_col as decimal no-undo.
   define var diff  as decimal no-undo.

   assign
      /* Move syntax label, button and toggle over (right justified) */
      w_col = p_FrameWid - (p_Lbl:width + p_Btn:width + p_Tgl:width)
      diff          = w_col - p_Lbl:col
      p_Lbl:col     = p_Lbl:col + diff - .5
      p_LBL:WIDTH   = p_Lbl:WIDTH + .5
      p_Btn:col     = p_Btn:col + diff
      p_Tgl:col     = p_Tgl:col + diff

      p_Rep:col     = p_Rep:col + 1.5
      p_Nex:col     = p_Nex:col + 1.5
      p_Pre:col     = p_Pre:col + 1.5
      p_Fin:col     = p_Fin:col + 1.5
      p_Ins:col     = p_Btn:col
      p_Del:col     = p_Cop:col
      p_Rev:col     = p_Pas:col
      p_Ins:WIDTH   = p_Tgl:col + p_Tgl:WIDTH - p_Ins:col
   
      h_Editor:width = p_FrameWid.
end.



/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/*----------------------------------------------------------------------------

File: trigtrig.i

Description:
   The standard editing triggers to support the trigger editor in the
   dictionary and the UIB section editor.

   This requires that trigdlg.i be included first which defines the
   standard button widgets such as btn_cut and h_Editor.  But this
   must come after the frame definition.

Arguments:
   &Frame - e.g., "Frame trigedit"

Author: Laura Stern

Date Created: 05/12/93
----------------------------------------------------------------------------*/

/*----- CHOOSE of BUTTON CUT-----*/
on choose of btn_cut in {&Frame}
do:
   apply "entry" to h_Editor.
   run EditCut (h_Editor).
end.

/*----- CHOOSE of BUTTON COPY -----*/
on choose of btn_copy in {&Frame}
do:
   apply "entry" to h_Editor.
   run EditCopy (h_Editor).
end.


/*----- CHOOSE of BUTTON PASTE -----*/
on choose of btn_paste in {&Frame}
do:
   apply "entry" to h_Editor.
   run EditPaste (h_Editor).
end.


/*----- CHOOSE of BUTTON FIND -----*/
on choose of btn_find in {&Frame}
   run FindText (h_Editor).


/*----- CHOOSE of BUTTON FIND NEXT -----*/
on choose of btn_next in {&Frame}
   run FindNext (h_Editor, Find_Criteria).


/*----- CHOOSE of BUTTON FIND PREVIOUS -----*/
on choose of btn_prev in {&Frame}
   run FindPrev (h_Editor, Find_Criteria).


/*----- CHOOSE of BUTTON REPLACE -----*/
on choose of btn_replace in {&Frame}
   run ReplaceText (h_Editor).

/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/
/* This is the definitions of temp-tables built solely to use in the
   schema pickers to deal with temp-tables in the UIB.
   
   Created: 11/03/96
   Author:  D. Ross Hunter                                         */

DEFINE {1} SHARED TEMP-TABLE _tt-tbl NO-UNDO
       FIELD tt-name AS CHARACTER FORMAT "X(32)"
       FIELD like-db AS CHARACTER
       FIELD like-table AS CHARACTER
       FIELD table-type AS CHARACTER
       INDEX tt-name IS PRIMARY UNIQUE tt-name.
DEFINE {1} SHARED TEMP-TABLE _tt-fld NO-UNDO
       FIELD tt-fld   AS CHARACTER FORMAT "X(32)"
       FIELD tt-recid AS RECID
       INDEX tt-rec-fld IS PRIMARY UNIQUE tt-recid tt-fld.
/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/*----------------------------------------------------------------------------

File: tblbrws.i

Description:
   Browse the tables for a given database. This .i is included in both
   _tblbrws.p and _tfbrws.p  The only reason is that browses can't be
   resized at run time.

Arguments:
   &HGHT       - Height of the browse
   &WDTH       - Width of the browse
   &FLDS       - "YES" if selecting fields, "NO" if just tables.  {&FLDS} is
                 used to turn on/off gobs of code at compile time.

Input Parameters: (for the calling programs)
   p_dlg       - Frame handle needed to parent the frame created in this
                 procedure.
   parent-proc - Handle of the calling dialog so that we can run its
                 internal procedures (methods).
   p_multi     - Logical: True if multiple items can be returned.
   p_rw        - The row of the browse within its parent (p_dlg).
   p_tc        - The column of the brwose within its parent (p_dlg).
   p_DbId      - The recid of the _Db record which corresponds to the
                 database that we want the tables from.
   in-value    - Comma delimited list of tables to select initially
   p_DType     - ? if not a specific Datatype
             
Output Parameters:
   h_tbl_brws - Handle of table browse created in this routine.
   h_fld_brws - Handle of field browse created in this routine. (Turned on by
                 the {&FLDS} preprocessor.
   p_Stat     - Set to true if list is retrieved (even if there were no tables
      	         this is successful).  Set to false, if user doesn't have access
      	         to tables.

Author: Ross Hunter

Date Created: 08/08/95 

----------------------------------------------------------------------------*/

DEFINE INPUT  PARAMETER p_dlg       AS HANDLE          NO-UNDO.
DEFINE INPUT  PARAMETER parent_proc AS HANDLE          NO-UNDO.
DEFINE INPUT  PARAMETER p_multi     AS LOGICAL         NO-UNDO.
DEFINE INPUT  PARAMETER p_rw        AS DECIMAL         NO-UNDO.
DEFINE INPUT  PARAMETER p_tc        AS DECIMAL         NO-UNDO.
DEFINE INPUT  PARAMETER p_DbId      AS RECID           NO-UNDO.
DEFINE INPUT  PARAMETER in-value    AS CHARACTER       NO-UNDO.

/* ----------------------------------------------------------------- */
/*                        FOR FIELDS ONLY                            */
/* ----------------------------------------------------------------- */
&IF "{&FLDS}" = "YES" &THEN
DEFINE INPUT  PARAMETER p_DType     AS CHARACTER       NO-UNDO.
&ENDIF            /* End of fields only input parameter definitions  */

DEFINE OUTPUT PARAMETER h_tbl_brws  AS HANDLE          NO-UNDO.

/* ----------------------------------------------------------------- */
/*                        FOR FIELDS ONLY                            */
/* ----------------------------------------------------------------- */
&IF "{&FLDS}" = "YES" &THEN
DEFINE OUTPUT PARAMETER h_fld_brws    AS HANDLE          NO-UNDO.
&ENDIF           /* End of fields only output parameter definitions  */

DEFINE OUTPUT PARAMETER p_Stat 	    AS LOGICAL         NO-UNDO.


DEFINE QUERY  tbl-browse-m FOR _tt-tbl SCROLLING.
DEFINE BROWSE tbl-browse-m QUERY tbl-browse-m NO-LOCK
       DISPLAY _tt-tbl.tt-name
    WITH NO-ROW-MARKERS NO-COLUMN-SCROLLING MULTIPLE
         SIZE {&WDTH} BY {&HGHT} NO-LABELS.
DEFINE QUERY  tbl-browse-s FOR _tt-tbl SCROLLING.
DEFINE BROWSE tbl-browse-s QUERY tbl-browse-s NO-LOCK
       DISPLAY _tt-tbl.tt-name
    WITH NO-ROW-MARKERS NO-COLUMN-SCROLLING SINGLE
         SIZE {&WDTH} BY {&HGHT} NO-LABELS.

DEFINE VARIABLE cur-rec    AS RECID     NO-UNDO.
DEFINE VARIABLE i          AS INTEGER   NO-UNDO.
DEFINE VARIABLE multi-tbl  AS LOGICAL   NO-UNDO.

DEFINE FRAME frm-m
  tbl-browse-m
  WITH 1 DOWN NO-BOX OVERLAY THREE-D AT ROW 2 COLUMN 17.

DEFINE FRAME frm-s
  tbl-browse-s
  WITH 1 DOWN NO-BOX OVERLAY THREE-D AT ROW 2 COLUMN 17.

multi-tbl = p_multi.
IF "{&FLDS}" = "YES" THEN multi-tbl = FALSE.

IF multi-tbl THEN  
  ASSIGN FRAME frm-m:FRAME  = p_dlg
         FRAME frm-m:ROW    = p_rw
         FRAME frm-m:COLUMN = p_tc
         p_Stat             = FRAME frm-m:MOVE-TO-TOP()
         FRAME frm-m:HIDDEN = NO
         h_tbl_brws         = tbl-browse-m:HANDLE.
ELSE
  ASSIGN FRAME frm-s:FRAME  = p_dlg
         FRAME frm-s:ROW    = p_rw
         FRAME frm-s:COLUMN = p_tc
         p_Stat             = FRAME frm-s:MOVE-TO-TOP()
         FRAME frm-s:HIDDEN = NO
         h_tbl_brws         = tbl-browse-s:HANDLE.

/* ----------------------------------------------------------------- */
/*                        FOR TABLES ONLY                            */
/* ----------------------------------------------------------------- */
&IF "{&FLDS}" = "NO" &THEN
ON DEFAULT-ACTION OF tbl-browse-m OR DEFAULT-ACTION OF tbl-browse-s DO:
  RUN table-browse-def-act IN parent_proc.
END.
&ENDIF                             /* End of For tables only trigger */

/* Find each file in this database.  Remember, if the progress Db is 
   acting as a schema holder, files for more than one database may 
   exist in this one physical database.  */
RUN adecomm/_setcurs.p ("WAIT":u).

IF multi-tbl THEN 
  OPEN QUERY tbl-browse-m FOR EACH _tt-tbl NO-LOCK.
ELSE
  OPEN QUERY tbl-browse-s FOR EACH _tt-tbl NO-LOCK.

IF NUM-ENTRIES(in-value) > 0 THEN DO:  /* SELECT these tables in the browse */
  DO i = 1 TO NUM-ENTRIES(in-value):
    FIND _tt-tbl NO-LOCK
               WHERE _tt-tbl.tt-name = ENTRY(i,in-value) NO-ERROR.
    IF AVAILABLE _tt-tbl THEN DO:
      cur-rec = RECID(_tt-tbl).
      IF multi-tbl THEN REPOSITION tbl-browse-m TO RECID cur-rec.
      ELSE REPOSITION tbl-browse-s TO RECID cur-rec.
      p_Stat = h_tbl_brws:SELECT-FOCUSED-ROW().
    END.
  END.
  /* Now reposition to the first one */
  ASSIGN p_Stat  = h_tbl_brws:SET-REPOSITIONED-ROW(1,"CONDITIONAL").
  /* Sometimes with multiple db's the wrong DB is selected */
  IF h_tbl_brws:NUM-SELECTED-ROWS > 0 THEN DO:
    ASSIGN p_Stat  = h_tbl_brws:FETCH-SELECTED-ROW(1)
           cur-rec = RECID(_tt-tbl).
    IF multi-tbl THEN REPOSITION tbl-browse-m TO RECID cur-rec.
    ELSE REPOSITION tbl-browse-s TO RECID cur-rec.
  END. /* If there are any selected rows. */
END.           

RUN adecomm/_setcurs.p ("").
IF multi-tbl THEN ENABLE tbl-browse-m WITH FRAME frm-m.
ELSE ENABLE tbl-browse-s WITH FRAME frm-s.


/* ----------------------------------------------------------------- */
/*                        FOR FIELDS ONLY                            */
/* ----------------------------------------------------------------- */ 

&IF "{&FLDS}" = "YES" &THEN          /* A fields browse is necessary */

DEFINE QUERY  fld-browse-m FOR _tt-fld SCROLLING.
DEFINE BROWSE fld-browse-m QUERY fld-browse-m
       DISPLAY _tt-fld.tt-fld
    WITH NO-ROW-MARKERS NO-COLUMN-SCROLLING MULTIPLE
         SIZE {&WDTH} BY {&HGHT} NO-LABELS.
DEFINE QUERY  fld-browse-s FOR _tt-fld SCROLLING.
DEFINE BROWSE fld-browse-s QUERY fld-browse-s
       DISPLAY _tt-fld.tt-fld
    WITH NO-ROW-MARKERS NO-COLUMN-SCROLLING SINGLE
         SIZE {&WDTH} BY {&HGHT} NO-LABELS.

DEFINE VARIABLE cur-fld    AS RECID     NO-UNDO.

DEFINE FRAME ffrm-m
  fld-browse-m
  WITH 1 DOWN NO-BOX OVERLAY THREE-D AT ROW 2 COLUMN 30.

DEFINE FRAME ffrm-s
  fld-browse-s
  WITH 1 DOWN NO-BOX OVERLAY THREE-D AT ROW 2 COLUMN 30.

IF p_multi THEN  
  ASSIGN FRAME ffrm-m:FRAME  = p_dlg
         FRAME ffrm-m:ROW    = p_rw
         FRAME ffrm-m:COLUMN = p_tc + 20
         p_Stat             = FRAME ffrm-m:MOVE-TO-TOP()
         FRAME ffrm-m:HIDDEN = NO
         h_fld_brws         = fld-browse-m:HANDLE.
ELSE
  ASSIGN FRAME ffrm-s:FRAME  = p_dlg
         FRAME ffrm-s:ROW    = p_rw
         FRAME ffrm-s:COLUMN = p_tc + 20
         p_Stat             = FRAME ffrm-s:MOVE-TO-TOP()
         FRAME ffrm-s:HIDDEN = NO
         h_fld_brws         = fld-browse-s:HANDLE.

ON DEFAULT-ACTION OF fld-browse-m OR DEFAULT-ACTION OF fld-browse-s DO:
  RUN field-browse-def-act IN parent_proc.
END.

ON VALUE-CHANGED OF tbl-browse-s DO:
  cur-rec = RECID(_tt-tbl).
  run open_fld_browse.
END. 

/* Find each fields of this file in this database.  Remember, if the
   progress Db is acting as a schema holder, files for more than one
   database may exist in this one physical database.  */
RUN adecomm/_setcurs.p ("WAIT":u).

IF NOT AVAILABLE _tt-tbl THEN DO:
  IF cur-rec NE ? THEN FIND _tt-tbl NO-LOCK
                           WHERE RECID(_tt-tbl) = cur-rec NO-ERROR.
  IF NOT AVAILABLE _tt-tbl THEN DO:
    FIND FIRST _tt-tbl NO-LOCK.
    cur-rec = RECID(_tt-tbl).
  END. 
END.
ELSE cur-rec = RECID(_tt-tbl).

RUN open_fld_browse.

RUN adecomm/_setcurs.p ("").
IF p_multi THEN ENABLE fld-browse-m WITH FRAME ffrm-m.
ELSE ENABLE fld-browse-s WITH FRAME ffrm-s.

&ENDIF     /* End of Fields only setup */

p_Stat = TRUE.


PROCEDURE load-private-data:
  DEFINE VAR i AS INTEGER NO-UNDO.

  /* Load table browse */
  DO i = 1 TO h_tbl_brws:NUM-SELECTED-ROWS:
    ASSIGN p_Stat = h_tbl_brws:FETCH-SELECTED-ROW(i)
           h_tbl_brws:PRIVATE-DATA = (IF i = 1
                                      THEN _tt-tbl.tt-name
                                      ELSE (h_tbl_brws:PRIVATE-DATA +
                                           ",":U + _tt-tbl.tt-name)).
  END.
  
  &IF "{&FLDS}" = "YES" &THEN
    /* Load field browse */
    DO i = 1 TO h_fld_brws:NUM-SELECTED-ROWS:
      ASSIGN p_Stat = h_fld_brws:FETCH-SELECTED-ROW(i)
             h_fld_brws:PRIVATE-DATA = (IF i = 1
                                        THEN _tt-fld.tt-fld
                                        ELSE (h_fld_brws:PRIVATE-DATA +
                                             ",":U + _tt-fld.tt-fld)).
    END.
  &ENDIF
END.

/* ----------------------------------------------------------------- */
/*                        FOR FIELDS ONLY                            */
/* ----------------------------------------------------------------- */
&IF "{&FLDS}" = "YES" &THEN   /* Procedures necessary only for
                                 Field selection version       */
                                 
PROCEDURE open_fld_browse.
  IF p_multi THEN 
    OPEN QUERY fld-browse-m FOR EACH _tt-fld
         WHERE _tt-fld.tt-recid = cur-rec.
  ELSE
    OPEN QUERY fld-browse-s FOR EACH _tt-fld
         WHERE _tt-fld.tt-recid = cur-rec.
END.

PROCEDURE select-all:
  DEFINE VAR tmp-rec AS RECID   NO-UNDO.
  DEFINE VAR t_log   AS LOGICAL NO-UNDO.

  IF NOT p_multi THEN RETURN.  /* Safety check */
    
  h_fld_brws:REFRESHABLE = FALSE.  /* Stop any flashing */
  /* Save current position */
  cur-fld = IF AVAILABLE _tt-fld THEN RECID(_tt-fld) ELSE ? .

  /* Initialize the loop with first field */
  FIND FIRST _tt-fld WHERE _tt-fld.tt-recid = cur-rec NO-ERROR.
  IF AVAILABLE _tt-fld THEN tmp-rec = RECID(_tt-fld).
  ELSE tmp-rec = ?.
  
  rpt-blk:        /* Loop through records to select all */
  REPEAT ON END-KEY UNDO, LEAVE:
    IF tmp-rec ne ? THEN DO:
      REPOSITION fld-browse-m TO RECID tmp-rec.
      ASSIGN t_log = h_fld_brws:SELECT-FOCUSED-ROW().
      FIND NEXT _tt-fld WHERE _tt-fld.tt-recid = cur-rec NO-ERROR.
      IF AVAILABLE _tt-fld THEN tmp-rec = RECID(_tt-fld).
      ELSE tmp-rec = ?.
    END.
    ELSE LEAVE rpt-blk.
  END. /* REPEAT */

  /* Reposition back to where it was */
  IF cur-fld = ? THEN DO:
    FIND FIRST _tt-fld WHERE _tt-fld.tt-recid = cur-rec NO-ERROR.
    IF AVAILABLE _tt-fld THEN cur-fld = RECID(_tt-fld).
  END.
  IF cur-fld NE ? THEN REPOSITION fld-browse-m TO RECID cur-fld.

  h_fld_brws:REFRESHABLE = TRUE.
END.

&ENDIF     /* End of Field related procedures */

/* tblbrws.i - end of file */

/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/
/*----------------------------------------------------------------------------

File: uibpref.i

Description:
    Temp-Table definitions for UIB preference settings.

Input Parameters:
   <None>

Output Parameters:
   <None>

Author: Gerry Seidl

Date Created: 1995

----------------------------------------------------------------------------*/

DEFINE {1} SHARED TEMP-TABLE _uib_prefs                             NO-UNDO
    FIELD _user_dfltwindow      AS LOGICAL      INITIAL TRUE
                                VIEW-AS TOGGLE-BOX
                                LABEL "Create a Default &Window at Startup"
    FIELD _user_advisor         AS LOGICAL      INITIAL TRUE
                                VIEW-AS TOGGLE-BOX
                                LABEL "Display &Advisor Messages"
    FIELD _user_hints           AS LOGICAL      INITIAL TRUE
                                VIEW-AS TOGGLE-BOX
                                LABEL "Display &Cue Cards"
    .  /* _uib-prefs    is the record that says what the user prefs are  */
/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/* utilhlp.i */


/* This include file defines the help context strings that 
   PROGRESS tools use to display help topics from the 
   UTILxxx.HLP file. 
   
   Please contact Documentation to make changes to this file. 
   Thanks. 
*/

/*
   The form used in this file is:

	   <Name of the Help Topic>
	   &Global-define <context-string> <context-number>

*/


/* On HELP in the PROGRESS EUC dialog box */
&GLOBAL-DEFINE PROGRESS_EUC_Dlg_Box 49153

/* On HELP in the Product List dialog box */
&GLOBAL-DEFINE Product_List_Dlg_Box 49154

/* On HELP in the Link Script Executable Names dialog box */
&GLOBAL-DEFINE Link_Script_Executable_Names_Dlg_Box 49155

/* On HELP in the Configurable Elements dialog box */
&GLOBAL-DEFINE Configurable_Elements_Dlg_Box 49156

/* The Contents help topic for PROBUILD */
&GLOBAL-DEFINE Main_Contents_PROBUILD 49157

/* On HELP in the Object Files dialog box */
&GLOBAL-DEFINE Object_Files_Dlg_Box 49158

&ANALYZE-SUSPEND _VERSION-NUMBER UIB_v9r12
&ANALYZE-RESUME
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _DEFINITIONS Procedure 
/*********************************************************************
* Copyright (C) 2000,2008 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/
/*------------------------------------------------------------------------
    File        : xmlschema.p
    Purpose     : Import/export the XML schema

    Syntax      :

    Description :

    Updated     : 04/18/00 adams@progress.com
                    Intial version
                  02/10/02 adams@progress.com
                    Repaired memory leak
    Notes       : Namespaces are not fully supported.
  ----------------------------------------------------------------------*/
/*          This .p file was created with the Progress AppBuilder.      */
/*----------------------------------------------------------------------*/

/* Create an unnamed pool to store all the widgets created 
     by this procedure. This is a good default which assures
     that this procedure's triggers and internal procedures 
     will execute in this procedure's storage, and that proper
     cleanup will occur on deletion of the procedure. */
CREATE WIDGET-POOL.

/* ***************************  Definitions  ************************** */

{ adecomm/xmlwidg.i }

DEFINE VARIABLE cPrefix     AS CHARACTER  NO-UNDO.
DEFINE VARIABLE cSimpleType AS CHARACTER  NO-UNDO INITIAL
"binary,boolean,byte,century,date,decimal,double,ENTITY,ENTITIES,float,ID,~
IDREF,IDREFS,int,integer,language,long,month,Name,NCName,negativeInteger,~
NMTOKEN,NMTOKENS,nonNegativeInteger,nonPositiveInteger,NOTATION,~
positiveInteger,QName,recurringDate,recurringDay,recurringDuration,short,~
string,time,timeDuration,timeInstant,timePeriod,unsignedByte,unsignedInt,~
unsignedLong,unsignedShort,uriReference,year":U.
DEFINE VARIABLE gcSmartB2B  AS CHARACTER  NO-UNDO.
DEFINE VARIABLE hDoc        AS HANDLE     NO-UNDO.
DEFINE VARIABLE hRoot       AS HANDLE     NO-UNDO.
DEFINE VARIABLE iCounter    AS INTEGER    NO-UNDO. /* child counter */
DEFINE VARIABLE iLastNode   AS INTEGER    NO-UNDO.
DEFINE VARIABLE iPCounter   AS INTEGER    NO-UNDO. /* parent counter */
DEFINE VARIABLE ix          AS INTEGER    NO-UNDO.
DEFINE VARIABLE lReturn     AS LOGICAL    NO-UNDO.

DEFINE BUFFER buf_tData FOR tData.
DEFINE BUFFER buf_tNode FOR tNode.

/* Keep track of XML Schema nodes that are mapped multiple times in an
   instance document. (adams) */
DEFINE TEMP-TABLE tMapping
  FIELD cField  AS CHARACTER CASE-SENSITIVE
  FIELD cParent AS CHARACTER CASE-SENSITIVE
  FIELD iHits   AS INTEGER
  INDEX cField cField cParent.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME


&ANALYZE-SUSPEND _UIB-PREPROCESSOR-BLOCK 

/* ********************  Preprocessor Definitions  ******************** */

&Scoped-define PROCEDURE-TYPE Procedure
&Scoped-define DB-AWARE no



/* _UIB-PREPROCESSOR-BLOCK-END */
&ANALYZE-RESUME


/* ************************  Function Prototypes ********************** */

&IF DEFINED(EXCLUDE-createNodeRef) = 0 &THEN

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION-FORWARD createNodeRef Procedure 
FUNCTION createNodeRef RETURNS HANDLE
  ( /* parameter-definitions */ )  FORWARD.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME

&ENDIF

&IF DEFINED(EXCLUDE-deleteObject) = 0 &THEN

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION-FORWARD deleteObject Procedure 
FUNCTION deleteObject RETURNS HANDLE
  ( hObject AS HANDLE )  FORWARD.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME

&ENDIF

&IF DEFINED(EXCLUDE-getContainer) = 0 &THEN

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION-FORWARD getContainer Procedure 
FUNCTION getContainer RETURNS CHARACTER
  ( /* parameter-definitions */ )  FORWARD.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME

&ENDIF

&IF DEFINED(EXCLUDE-getDataType) = 0 &THEN

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION-FORWARD getDataType Procedure 
FUNCTION getDataType RETURNS CHARACTER
  ( INPUT pKey AS INTEGER )  FORWARD.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME

&ENDIF

&IF DEFINED(EXCLUDE-getNodeHandle) = 0 &THEN

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION-FORWARD getNodeHandle Procedure 
FUNCTION getNodeHandle RETURNS HANDLE
  ( INPUT pNode AS INTEGER )  FORWARD.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME

&ENDIF

&IF DEFINED(EXCLUDE-getSchemaType) = 0 &THEN

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION-FORWARD getSchemaType Procedure 
FUNCTION getSchemaType RETURNS CHARACTER
  ( /* parameter-definitions */ )  FORWARD.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME

&ENDIF

&IF DEFINED(EXCLUDE-setContainer) = 0 &THEN

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION-FORWARD setContainer Procedure 
FUNCTION setContainer RETURNS LOGICAL
  ( INPUT pValue AS CHARACTER )  FORWARD.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME

&ENDIF

&IF DEFINED(EXCLUDE-setPrefix) = 0 &THEN

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION-FORWARD setPrefix Procedure 
FUNCTION setPrefix RETURNS LOGICAL
  ( /* parameter-definitions */ )  FORWARD.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME

&ENDIF

&IF DEFINED(EXCLUDE-trimPrefix) = 0 &THEN

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION-FORWARD trimPrefix Procedure 
FUNCTION trimPrefix RETURNS CHARACTER
  ( INPUT pValue AS CHARACTER )  FORWARD.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME

&ENDIF


/* *********************** Procedure Settings ************************ */

&ANALYZE-SUSPEND _PROCEDURE-SETTINGS
/* Settings for THIS-PROCEDURE
   Type: Procedure
   Allow: 
   Frames: 0
   Add Fields to: Neither
   Other Settings: CODE-ONLY
 */
&ANALYZE-RESUME _END-PROCEDURE-SETTINGS

/* *************************  Create Window  ************************** */

&ANALYZE-SUSPEND _CREATE-WINDOW
/* DESIGN Window definition (used by the UIB) 
  CREATE WINDOW Procedure ASSIGN
         HEIGHT             = 19.24
         WIDTH              = 60.
/* END WINDOW DEFINITION */
                                                                        */
&ANALYZE-RESUME

 


&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _MAIN-BLOCK Procedure 


/* ***************************  Main Block  *************************** */
RUN initializeObject.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME


/* **********************  Internal Procedures  *********************** */

&IF DEFINED(EXCLUDE-addNodesRec) = 0 &THEN

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE addNodesRec Procedure 
PROCEDURE addNodesRec :
/*------------------------------------------------------------------------------
  Purpose:     
  Parameters:  <none>
  Notes:       
------------------------------------------------------------------------------*/
  DEFINE INPUT  PARAMETER pAbstract             AS CHARACTER  NO-UNDO.
  DEFINE INPUT  PARAMETER pAttributeFormDefault AS CHARACTER  NO-UNDO.
  DEFINE INPUT  PARAMETER pBase                 AS CHARACTER  NO-UNDO.
  DEFINE INPUT  PARAMETER pBlockValue           AS CHARACTER  NO-UNDO.
  DEFINE INPUT  PARAMETER pContent              AS CHARACTER  NO-UNDO.
  DEFINE INPUT  PARAMETER pDataForm             AS CHARACTER  NO-UNDO.
  DEFINE INPUT  PARAMETER pDataType             AS CHARACTER  NO-UNDO.
  DEFINE INPUT  PARAMETER pDataValue            AS CHARACTER  NO-UNDO.
  DEFINE INPUT  PARAMETER pDefaultValue         AS CHARACTER  NO-UNDO.
  DEFINE INPUT  PARAMETER pDerivedBy            AS CHARACTER  NO-UNDO.
  DEFINE INPUT  PARAMETER pElement              AS CHARACTER  NO-UNDO.
  DEFINE INPUT  PARAMETER pElementFormDefault   AS CHARACTER  NO-UNDO.
  DEFINE INPUT  PARAMETER pEquivClass           AS CHARACTER  NO-UNDO.
  DEFINE INPUT  PARAMETER pFinal                AS CHARACTER  NO-UNDO.
  DEFINE INPUT  PARAMETER pMapConversion        AS CHARACTER  NO-UNDO.
  DEFINE INPUT  PARAMETER pMapFile              AS CHARACTER  NO-UNDO.
  DEFINE INPUT  PARAMETER pMapLink              AS CHARACTER  NO-UNDO.
  DEFINE INPUT  PARAMETER pMapName              AS CHARACTER  NO-UNDO.
  DEFINE INPUT  PARAMETER pMapObject            AS CHARACTER  NO-UNDO.
  DEFINE INPUT  PARAMETER pMapParameter         AS INTEGER    NO-UNDO.
  DEFINE INPUT  PARAMETER pMapType              AS CHARACTER  NO-UNDO.
  DEFINE INPUT  PARAMETER pMapUpdate            AS CHARACTER  NO-UNDO.
  DEFINE INPUT  PARAMETER pMaxOccurs            AS CHARACTER  NO-UNDO.
  DEFINE INPUT  PARAMETER pMinOccurs            AS CHARACTER  NO-UNDO.
  DEFINE INPUT  PARAMETER pModel                AS CHARACTER  NO-UNDO.
  DEFINE INPUT  PARAMETER pNameSpace            AS CHARACTER  NO-UNDO.
  DEFINE INPUT  PARAMETER pNode                 AS INTEGER    NO-UNDO.
  DEFINE INPUT  PARAMETER pNodeName             AS CHARACTER  NO-UNDO.
  DEFINE INPUT  PARAMETER pNullable             AS CHARACTER  NO-UNDO.
  DEFINE INPUT  PARAMETER pOrder                AS CHARACTER  NO-UNDO.
  DEFINE INPUT  PARAMETER pParentName           AS CHARACTER  NO-UNDO.
  DEFINE INPUT  PARAMETER pParentNode           AS INTEGER    NO-UNDO.
  DEFINE INPUT  PARAMETER pProcessContents      AS CHARACTER  NO-UNDO.
  DEFINE INPUT  PARAMETER pRef                  AS CHARACTER  NO-UNDO.
  DEFINE INPUT  PARAMETER pSchemaLocation       AS CHARACTER  NO-UNDO.
  DEFINE INPUT  PARAMETER pSchemaPath           AS CHARACTER  NO-UNDO.
  DEFINE INPUT  PARAMETER pTargetNamespace      AS CHARACTER  NO-UNDO.
  DEFINE INPUT  PARAMETER pUseValue             AS CHARACTER  NO-UNDO.
  DEFINE INPUT  PARAMETER pXNodeRef             AS HANDLE     NO-UNDO.
  
  CREATE tNode.
  ASSIGN
    tNode.abstract             = pAbstract
    tNode.attributeFormDefault = pAttributeFormDefault
    tNode.base                 = pBase
    tNode.blockValue           = pBlockValue
    tNode.content              = pContent
    tNode.dataForm             = pDataForm
    tNode.dataType             = pDataType
    tNode.dataValue            = pDataValue
    tNode.defaultValue         = pDefaultValue
    tNode.derivedBy            = pDerivedBy
    tNode.element              = pElement
    tNode.elementFormDefault   = pElementFormDefault
    tNode.equivClass           = pEquivClass
    tNode.final                = pFinal
    tNode.mapConversion        = pMapConversion
    tNode.mapFile              = pMapFile
    tNode.mapLink              = pMapLink
    tNode.mapName              = pMapName
    tNode.mapUpdate            = pMapUpdate
    tNode.objectName           = pMapObject
    tNode.mapParameter         = pMapParameter
    tNode.mapType              = pMapType
    tNode.maxOccurs            = pMaxOccurs
    tNode.minOccurs            = pMinOccurs
    tNode.model                = pModel
    tNode.nameSpace            = pNameSpace
    tNode.node                 = pNode
    tNode.nodeName             = pNodeName
    tNode.nullable             = pNullable
    tNode.order                = pOrder
    tNode.parentName           = pParentName
    tNode.parentNode           = pParentNode
    tNode.processContents      = pProcessContents
    tNode.ref                  = pRef
    tNode.schemaLocation       = pSchemaLocation
    tNode.schemaPath           = pSchemaPath
    tNode.targetNamespace      = pTargetNamespace
    tNode.useValue             = pUseValue
    tNode.xNodeRef             = pXNodeRef.
    
END PROCEDURE.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME

&ENDIF

&IF DEFINED(EXCLUDE-expandNodes) = 0 &THEN

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE expandNodes Procedure 
PROCEDURE expandNodes :
/*------------------------------------------------------------------------------
  Purpose:     
  Parameters:  <none>
  Updates:     04/18/01 thomas.wurl@taste-consulting.de
               07/23/01 Meyer Nassim
                 Sort nodes in schema, not alpha, order.
                 To do this, we need to define a local buffer for tNode, scoped 
                 to this internal procedure, and 'BY tNode.Node' to WHERE clause 
                 of dynamic query.
  ------------------------------------------------------------------------------*/
  DEFINE INPUT  PARAMETER pName  AS CHARACTER  NO-UNDO. /* parent nodeName  */
  DEFINE INPUT  PARAMETER pNode  AS INTEGER    NO-UNDO. /* parent node      */
  DEFINE INPUT  PARAMETER pNType AS CHARACTER  NO-UNDO. /* parent node type */ 
  DEFINE INPUT  PARAMETER pDType AS CHARACTER  NO-UNDO. /* parent data type */
  DEFINE INPUT  PARAMETER pPath  AS CHARACTER  NO-UNDO. /* document path    */
  DEFINE INPUT  PARAMETER pRef   AS CHARACTER  NO-UNDO. /* reference        */
  
  DEFINE VARIABLE cBase     AS CHARACTER  NO-UNDO.
  DEFINE VARIABLE cDocPath  AS CHARACTER  NO-UNDO.
  DEFINE VARIABLE cName     AS CHARACTER  NO-UNDO.
  DEFINE VARIABLE cType     AS CHARACTER  NO-UNDO.
  DEFINE VARIABLE cWhere    AS CHARACTER  NO-UNDO.
  DEFINE VARIABLE hQuery    AS HANDLE     NO-UNDO.
  DEFINE VARIABLE iNode     AS INTEGER    NO-UNDO.
  DEFINE VARIABLE lReturn   AS LOGICAL    NO-UNDO.
  
  /* Procedure is called recursively, so use a buffer that is scoped to this 
     procedure. (thomas.wurl@taste-consulting.de 04/18/01) */
  DEFINE BUFFER tNode for tNode.

  hQuery = ?.
  CREATE QUERY hQuery.
  hQuery:SET-BUFFERS(BUFFER tNode:HANDLE).

  /* Sort by node number (thomas.wurl@taste-consulting.de 02/26/01) */
  cWhere = "FOR EACH tNode WHERE tNode.parentName = '":U +
           (     IF pRef <> ""  THEN pRef   /*books.xsd*/
            ELSE IF pDType = "" THEN pName  /*report.xsd*/
            ELSE                     pDType /*po.xsd*/) +
           "' BY tNode.Node":U.
  hQuery:QUERY-PREPARE(cWhere).
  hQuery:QUERY-OPEN.

  REPEAT:
    hQuery:GET-NEXT.
    IF hQuery:QUERY-OFF-END THEN LEAVE.
    
    /* Update parent dataType */
    IF tNode.element = "simpleType":U THEN DO:
      FIND FIRST buf_tData WHERE buf_tData.node = pNode NO-ERROR.
      IF AVAILABLE buf_tData THEN
        buf_tData.dataType = trimPrefix(tNode.base).
    END.

    IF tNode.nodeName = "" AND tNode.ref = "" THEN NEXT.

    ASSIGN
      cDocPath = pPath + "/":U + 
                 (IF tNode.nodeName <> "" THEN tNode.nodeName ELSE tNode.ref)
      cName    = (IF CAN-DO("attributeGroup,group":U,tNode.element) THEN
                    pName ELSE tNode.nodeName)
      cType    = tNode.dataType
      iNode    = (IF CAN-DO("attributeGroup,group":U,tNode.element) THEN
                    pNode ELSE tNode.node).

    IF NOT CAN-DO("attributeGroup,group":U,tNode.element) AND 
      (tNode.nodeName <> "" OR tNode.ref <> "") THEN DO:
      CREATE tData.
      BUFFER-COPY tNode TO tData.
      ASSIGN
        tData.parentNode   = pNode
        tData.parentName   = pName
        tData.documentPath = cDocPath 
        iLastNode          = iLastNode + 1
        tData.node         = iLastNode
        iNode              = iLastNode.
     
      IF INDEX(tData.element,":":U) > 0 THEN
        tData.element      = trimPrefix(tData.element).

      IF INDEX(tData.dataType,":":U) > 0 THEN
        tData.dataType     = trimPrefix(tData.dataType).

      /* Update tData dataType based on ref attribute */
      IF tData.ref <> "" THEN DO:
        ASSIGN
          cName          = tData.ref
          tData.nodeName = cName.

        /* TBD: Need better selection criteria, since nodeName is not 
           unique. (adams) */
        FIND FIRST buf_tNode WHERE buf_tNode.nodeName = cName NO-ERROR.
        IF AVAILABLE buf_tNode AND buf_tNode.dataType <> "" THEN
          ASSIGN
            cType          = buf_tNode.dataType
            tData.dataType = trimPrefix(cType).
      END.

      /* Update tData datatype based on type attribute */
      IF NOT CAN-DO(cSimpleType, tData.dataType) THEN DO:
        FIND FIRST buf_tNode
          WHERE buf_tNode.nodeName = tData.dataType AND
                buf_tNode.element  = "simpleType":U NO-ERROR.
        IF AVAILABLE buf_tNode AND buf_tNode.base <> "" THEN
          tData.dataType = trimPrefix(buf_tNode.base).
      END.
      
      /* Extract mapping data where this schema node is mapped to multiple 
         instance nodes */
      IF NUM-ENTRIES(tNode.mapFile) > 1 THEN
        RUN extractMapping.
    END.

    /* Drill down for more children */
    RUN expandNodes(/* name     */ cName, 
                    /* node     */ iNode, 
                    /* element  */ tNode.element,
                    /* datatype */ cType,
                    /* docpath  */ cDocPath,
                    /* ref      */ tNode.ref).
  END. /* REPEAT */
  
  hQuery:QUERY-CLOSE().
  hQuery = deleteObject(hQuery).

END PROCEDURE.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME

&ENDIF

&IF DEFINED(EXCLUDE-extractMapping) = 0 &THEN

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE extractMapping Procedure 
PROCEDURE extractMapping :
/*------------------------------------------------------------------------------
  Purpose:     
  Parameters:  <none>
  Notes:       This code uses current tData row
------------------------------------------------------------------------------*/
  /* Commercial version uses tNode.  Chambers uses tData.  This is better,
     since calling procedure is looping through tNode recs. */
  
  FIND FIRST tMapping WHERE 
    tMapping.cField  = tData.nodeName AND
    tMapping.cParent = tData.parentName NO-ERROR.
  IF NOT AVAILABLE tMapping THEN DO:
    CREATE tMapping.
    ASSIGN 
      tMapping.cField  = tData.nodeName
      tMapping.cParent = tData.parentName.
  END.

  ASSIGN
    tMapping.iHits      = tMapping.iHits + 1
    tData.mapFile       = ENTRY(tMapping.iHits, tData.mapFile)
    tData.mapName       = ENTRY(tMapping.iHits, tData.mapName)
    tData.objectName    = ENTRY(tMapping.iHits, tData.objectName)
    tData.mapType       = ENTRY(tMapping.iHits, tData.mapType).
    
  IF tData.mapConversion <> "" THEN
    tData.mapConversion = ENTRY(tMapping.iHits, tData.mapConversion).
    
  IF tData.mapLink <> "" THEN
    tData.mapLink       = ENTRY(tMapping.iHits, tData.mapLink).
    
  IF tData.mapParameter <> 0 THEN
    tData.mapParameter  = INTEGER(ENTRY(tMapping.iHits, 
                            STRING(tData.mapParameter))).
    
  IF tData.mapUpdate <> "" THEN
    tData.mapUpdate     = ENTRY(tMapping.iHits, tData.mapUpdate).
  
END PROCEDURE.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME

&ENDIF

&IF DEFINED(EXCLUDE-getChild) = 0 &THEN

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE getChild Procedure 
PROCEDURE getChild :
/*------------------------------------------------------------------------------
  Purpose:     Parse XML Schema format elements and attribute nodes
  Parameters:  <none>
  Notes:       
------------------------------------------------------------------------------*/
  DEFINE INPUT  PARAMETER hParent     AS HANDLE    NO-UNDO. /* parent handle  */
  DEFINE INPUT  PARAMETER pParent     AS INTEGER   NO-UNDO. /* parent node    */
  DEFINE INPUT  PARAMETER cParent     AS CHARACTER NO-UNDO. /* parent name    */
  DEFINE INPUT  PARAMETER pSchemaPath AS CHARACTER NO-UNDO. /* schema path    */
  
  DEFINE VARIABLE cAbstract             AS CHARACTER  NO-UNDO.
  DEFINE VARIABLE cAttr                 AS CHARACTER  NO-UNDO.
  DEFINE VARIABLE cAttributeFormDefault AS CHARACTER  NO-UNDO.
  DEFINE VARIABLE cBase                 AS CHARACTER  NO-UNDO.
  DEFINE VARIABLE cBlockValue           AS CHARACTER  NO-UNDO.
  DEFINE VARIABLE cBlockDefault         AS CHARACTER  NO-UNDO.
  DEFINE VARIABLE cContent              AS CHARACTER  NO-UNDO.
  DEFINE VARIABLE cDataForm             AS CHARACTER  NO-UNDO.
  DEFINE VARIABLE cDataType             AS CHARACTER  NO-UNDO.
  DEFINE VARIABLE cDataValue            AS CHARACTER  NO-UNDO.
  DEFINE VARIABLE cDefaultValue         AS CHARACTER  NO-UNDO.
  DEFINE VARIABLE cDerivedBy            AS CHARACTER  NO-UNDO.
  DEFINE VARIABLE cElement              AS CHARACTER  NO-UNDO.
  DEFINE VARIABLE cElementFormDefault   AS CHARACTER  NO-UNDO.
  DEFINE VARIABLE cEquivClass           AS CHARACTER  NO-UNDO.
  DEFINE VARIABLE cFinal                AS CHARACTER  NO-UNDO.
  DEFINE VARIABLE cFinalDefault         AS CHARACTER  NO-UNDO.
  DEFINE VARIABLE cFixed                AS CHARACTER  NO-UNDO.
  DEFINE VARIABLE cID                   AS CHARACTER  NO-UNDO.
  DEFINE VARIABLE cMapConversion        AS CHARACTER  NO-UNDO.
  DEFINE VARIABLE cMapFile              AS CHARACTER  NO-UNDO.
  DEFINE VARIABLE cMapLink              AS CHARACTER  NO-UNDO.
  DEFINE VARIABLE cMapName              AS CHARACTER  NO-UNDO.
  DEFINE VARIABLE cMapObject            AS CHARACTER  NO-UNDO.
  DEFINE VARIABLE cMapType              AS CHARACTER  NO-UNDO.
  DEFINE VARIABLE cMapUpdate            AS CHARACTER  NO-UNDO.
  DEFINE VARIABLE cMaxOccurs            AS CHARACTER  NO-UNDO.
  DEFINE VARIABLE cMinOccurs            AS CHARACTER  NO-UNDO.
  DEFINE VARIABLE cModel                AS CHARACTER  NO-UNDO.
  DEFINE VARIABLE cNameSpace            AS CHARACTER  NO-UNDO.
  DEFINE VARIABLE cNodeName             AS CHARACTER  NO-UNDO.
  DEFINE VARIABLE cNullable             AS CHARACTER  NO-UNDO.
  DEFINE VARIABLE cOrder                AS CHARACTER  NO-UNDO.
  DEFINE VARIABLE cProcessContents      AS CHARACTER  NO-UNDO.
  DEFINE VARIABLE cRef                  AS CHARACTER  NO-UNDO.
  DEFINE VARIABLE cRefer                AS CHARACTER  NO-UNDO.
  DEFINE VARIABLE cSchemaLocation       AS CHARACTER  NO-UNDO.
  DEFINE VARIABLE cTargetNamespace      AS CHARACTER  NO-UNDO.
  DEFINE VARIABLE cUseValue             AS CHARACTER  NO-UNDO.
  DEFINE VARIABLE cVersion              AS CHARACTER  NO-UNDO.
  DEFINE VARIABLE hNodeRef              AS HANDLE     NO-UNDO.
  
  DEFINE VARIABLE iMapParameter         AS INTEGER    NO-UNDO INITIAL ?.
  DEFINE VARIABLE ix                    AS INTEGER    NO-UNDO.
  DEFINE VARIABLE tmpcParent            AS CHARACTER  NO-UNDO.
  DEFINE VARIABLE tmpPath               AS CHARACTER  NO-UNDO.
  DEFINE VARIABLE tmppParent            AS INTEGER    NO-UNDO.

  child-loop:
  REPEAT ix = 1 TO hParent:NUM-CHILDREN:
    hNodeRef = createNodeRef().
    
    lReturn = hParent:GET-CHILD(hNodeRef, ix) NO-ERROR.
    IF NOT lReturn OR lReturn = ? OR 
      (lReturn AND hNodeRef:SUBTYPE <> "element":U) THEN DO:
      hNodeRef = deleteObject(hNodeRef).
      NEXT child-loop.
    END.
  
    RELEASE tNode.
    
    ASSIGN
      cAbstract             = ""
      cAttributeFormDefault = ""
      cBase                 = ""
      cBlockValue           = ""
      cBlockDefault         = ""
      cContent              = ""
      cDataForm             = ""
      cDataType             = ""
      cDataValue            = ""
      cDefaultValue         = ""
      cDerivedBy            = ""
      cElement              = hNodeRef:name
      cElementFormDefault   = ""
      cEquivClass           = ""
      cFinal                = ""
      cFinalDefault         = ""
      cFixed                = ""
      cID                   = ""
      cMapConversion        = ""
      cMapFile              = ""
      cMapLink              = ""
      cMapName              = ""
      cMapObject            = ""
      iMapParameter         = ?
      cMapType              = ""
      cMapUpdate            = ""
      cMaxOccurs            = ""
      cMinOccurs            = ""
      cNameSpace            = ""
      cNodeName             = ""
      cNullable             = ""
      cProcessContents      = ""
      cRef                  = ""
      cRefer                = ""
      cSchemaLocation       = ""
      cTargetNamespace      = ""
      cUseValue             = ""
      cVersion              = ""
      .
    
    CASE trimPrefix(cElement):
      WHEN "all":U THEN DO: 
        ASSIGN
          cID         = hNodeRef:GET-ATTRIBUTE("id":U)
          cMaxOccurs  = hNodeRef:GET-ATTRIBUTE("maxOccurs":U)
          cMinOccurs  = hNodeRef:GET-ATTRIBUTE("minOccurs":U).
      END.
      WHEN "annotation":U THEN DO:
        hNodeRef = deleteObject(hNodeRef).
        NEXT child-loop. /* TBD */
      END.
      WHEN "any":U THEN DO:
        hNodeRef = deleteObject(hNodeRef).
        NEXT child-loop. /* TBD */
        /* ASSIGN
          cID              = hNodeRef:GET-ATTRIBUTE("id":U)
          cMaxOccurs       = hNodeRef:GET-ATTRIBUTE("maxOccurs":U)
          cMinOccurs       = hNodeRef:GET-ATTRIBUTE("minOccurs":U)
          cNameSpace       = hNodeRef:GET-ATTRIBUTE("nameSpace":U)
          cProcessContents = hNodeRef:GET-ATTRIBUTE("processContents":U). */
      END.
      WHEN "anyAttribute":U THEN DO:
        hNodeRef = deleteObject(hNodeRef).
        NEXT child-loop. /* TBD */
        /* ASSIGN
          cID              = hNodeRef:GET-ATTRIBUTE("id":U)
          cProcessContents = hNodeRef:GET-ATTRIBUTE("processContents":U)
          cNamespace       = hNodeRef:GET-ATTRIBUTE("nameSpace":U). */
      END.
      WHEN "appInfo":U THEN DO:
        hNodeRef = deleteObject(hNodeRef).
        NEXT child-loop. /* TBD */
      END.
      WHEN "attribute":U THEN DO:
        ASSIGN
          cDataForm          = hNodeRef:GET-ATTRIBUTE("form":U)
          cDataType          = hNodeRef:GET-ATTRIBUTE("type":U)
          cDataValue         = hNodeRef:GET-ATTRIBUTE("value":U)
          cID                = hNodeRef:GET-ATTRIBUTE("id":U)
          cNodeName          = hNodeRef:GET-ATTRIBUTE("name":U)
          cRef               = hNodeRef:GET-ATTRIBUTE("ref":U)
          cUseValue          = hNodeRef:GET-ATTRIBUTE("use":U).
      END.
      WHEN "attributeGroup":U THEN DO:
        ASSIGN
          cID         = hNodeRef:GET-ATTRIBUTE("id":U)
          cNodeName   = hNodeRef:GET-ATTRIBUTE("name":U)
          cRef        = hNodeRef:GET-ATTRIBUTE("ref":U).
          
        /* Experimental 
        IF cNodeName = "" THEN
          cNodeName = cRef.
        */
      END.
      WHEN "choice":U THEN DO:
        ASSIGN
          cID         = hNodeRef:GET-ATTRIBUTE("id":U)
          cMaxOccurs  = hNodeRef:GET-ATTRIBUTE("maxOccurs":U)
          cMinOccurs  = hNodeRef:GET-ATTRIBUTE("minOccurs":U).
      END.
      WHEN "complexType":U OR 
      WHEN "type":U THEN DO: /* node with children */
        ASSIGN
          cAbstract   = hNodeRef:GET-ATTRIBUTE("abstract":U)
          cBase       = hNodeRef:GET-ATTRIBUTE("base":U)
          cBlockValue = hNodeRef:GET-ATTRIBUTE("block":U)
          cContent    = hNodeRef:GET-ATTRIBUTE("content":U)
          cDerivedBy  = hNodeRef:GET-ATTRIBUTE("derivedBy":U)
          cFinal      = hNodeRef:GET-ATTRIBUTE("final":U)
          cID         = hNodeRef:GET-ATTRIBUTE("id":U)
          cNodeName   = hNodeRef:GET-ATTRIBUTE("name":U).
      END.
      WHEN "documentation":U THEN DO:
        hNodeRef = deleteObject(hNodeRef).
        NEXT child-loop. /* TBD */
      END.
      WHEN "element":U THEN DO: /* child node */
        ASSIGN
          cAbstract     = hNodeRef:GET-ATTRIBUTE("abstract":U)
          cBlockValue   = hNodeRef:GET-ATTRIBUTE("block":U)
          cDataForm     = hNodeRef:GET-ATTRIBUTE("form":U)
          cDataType     = hNodeRef:GET-ATTRIBUTE("type":U)
          cDefaultValue = hNodeRef:GET-ATTRIBUTE("default":U)
          cEquivClass   = hNodeRef:GET-ATTRIBUTE("equivClass":U)
          cFinal        = hNodeRef:GET-ATTRIBUTE("final":U)
          cFixed        = hNodeRef:GET-ATTRIBUTE("fixed":U)
          cID           = hNodeRef:GET-ATTRIBUTE("id":U)
          cMaxOccurs    = hNodeRef:GET-ATTRIBUTE("maxOccurs":U)
          cMinOccurs    = hNodeRef:GET-ATTRIBUTE("minOccurs":U)
          cNodeName     = hNodeRef:GET-ATTRIBUTE("name":U)
          cNullable     = hNodeRef:GET-ATTRIBUTE("nullable":U)
          cRef          = hNodeRef:GET-ATTRIBUTE("ref":U).
          
        /*IF cNodeName = "" THEN
          cNodeName = cRef.
        */
      END.
      WHEN "enumeration":U THEN  DO:
        hNodeRef = deleteObject(hNodeRef).
        NEXT child-loop. /* TBD */
      END.
      WHEN "field":U THEN  DO:
        hNodeRef = deleteObject(hNodeRef).
        NEXT child-loop. /* TBD */
      END.
      WHEN "group":U THEN DO:  
        ASSIGN
          cID        = hNodeRef:GET-ATTRIBUTE("id":U)
          cMaxOccurs = hNodeRef:GET-ATTRIBUTE("maxOccurs":U)
          cMinOccurs = hNodeRef:GET-ATTRIBUTE("minOccurs":U)
          cNodeName  = hNodeRef:GET-ATTRIBUTE("name":U)
          cRef       = hNodeRef:GET-ATTRIBUTE("ref":U).
          
        /*IF cNodeName = "" THEN
          cNodeName = cRef.
        */
      END.
      WHEN "import":U THEN DO:
        hNodeRef = deleteObject(hNodeRef).
        NEXT child-loop. /* TBD */
        /* ASSIGN
          cSchemaLocation = hNodeRef:GET-ATTRIBUTE("schemaLocation":U). */
      END.
      WHEN "include":U THEN DO:
        hNodeRef = deleteObject(hNodeRef).
        NEXT child-loop. /* TBD */
       /* ASSIGN
          cNameSpace      = hNodeRef:GET-ATTRIBUTE("nameSpace":U)
          cSchemaLocation = hNodeRef:GET-ATTRIBUTE("schemaLocation":U). */
      END.
      WHEN "key":U THEN DO:
        hNodeRef = deleteObject(hNodeRef).
        NEXT child-loop. /* TBD */
        /* ASSIGN
          cID       = hNodeRef:GET-ATTRIBUTE("id":U)
          cNodeName = hNodeRef:GET-ATTRIBUTE("name":U). */
      END.
      WHEN "keyref":U THEN DO:
        hNodeRef = deleteObject(hNodeRef).
        NEXT child-loop. /* TBD */
       /* ASSIGN
          cID       = hNodeRef:GET-ATTRIBUTE("id":U)
          cNodeName = hNodeRef:GET-ATTRIBUTE("name":U)
          cRefer    = hNodeRef:GET-ATTRIBUTE("refer":U). */
      END.
      WHEN "length":U THEN DO:
        hNodeRef = deleteObject(hNodeRef).
        NEXT child-loop. /* TBD */
      END.
      WHEN "maxInclusive":U THEN DO:
        hNodeRef = deleteObject(hNodeRef).
        NEXT child-loop. /* TBD */
      END.
      WHEN "maxLength":U THEN DO:
        hNodeRef = deleteObject(hNodeRef).
        NEXT child-loop. /* TBD */
      END.
      WHEN "minInclusive":U THEN DO:
        hNodeRef = deleteObject(hNodeRef).
        NEXT child-loop. /* TBD */
      END.
      WHEN "minLength":U THEN DO:
        hNodeRef = deleteObject(hNodeRef).
        NEXT child-loop. /* TBD */
      END.
      WHEN "pattern":U THEN DO:
        hNodeRef = deleteObject(hNodeRef).
        NEXT child-loop. /* TBD */
      END.
      WHEN "schema":U THEN DO:
        ASSIGN 
          cAttributeFormDefault = hNodeRef:GET-ATTRIBUTE("attributeFormDefault":U)
          cBlockDefault         = hNodeRef:GET-ATTRIBUTE("blockDefault":U)
          cElementFormDefault   = hNodeRef:GET-ATTRIBUTE("elementFormDefault":U)
          cFinalDefault         = hNodeRef:GET-ATTRIBUTE("finalDefault":U)
          cID                   = hNodeRef:GET-ATTRIBUTE("id":U)
          cTargetNamespace      = hNodeRef:GET-ATTRIBUTE("targetNamespace":U)
          cVersion              = hNodeRef:GET-ATTRIBUTE("version":U).
      END.
      WHEN "selector":U THEN DO:
        hNodeRef = deleteObject(hNodeRef).
        NEXT child-loop. /* TBD */
      END.
      WHEN "sequence":U THEN DO: 
        ASSIGN
          cID        = hNodeRef:GET-ATTRIBUTE("id":U)
          cMaxOccurs = hNodeRef:GET-ATTRIBUTE("maxOccurs":U)
          cMinOccurs = hNodeRef:GET-ATTRIBUTE("minOccurs":U).
      END.
      WHEN "simpleType":U THEN DO:
        ASSIGN      
          cBase      = hNodeRef:GET-ATTRIBUTE("base":U)
          cDerivedBy = hNodeRef:GET-ATTRIBUTE("derivedBy":U)
          cNodeName  = hNodeRef:GET-ATTRIBUTE("name":U).
      END.
      WHEN "unique":U THEN DO:
        hNodeRef = deleteObject(hNodeRef).
        NEXT child-loop. /* TBD */
        /* ASSIGN
          cID         = hNodeRef:GET-ATTRIBUTE("id":U)
          cNodeName   = hNodeRef:GET-ATTRIBUTE("name":U). */
      END.
      OTHERWISE DO:
        hNodeRef = deleteObject(hNodeRef).
        NEXT child-loop.
      END.
    END CASE.
    
    /* Read XML Schema mapping information. */
    ASSIGN
      cMapConversion = hNodeRef:GET-ATTRIBUTE("psc:conversion")
      cMapFile       = hNodeRef:GET-ATTRIBUTE("psc:file")
      cMapLink       = hNodeRef:GET-ATTRIBUTE("psc:link")
      cMapName       = hNodeRef:GET-ATTRIBUTE("psc:name")
      cMapObject     = hNodeRef:GET-ATTRIBUTE("psc:object")
      cMapType       = hNodeRef:GET-ATTRIBUTE("psc:type")
      cMapUpdate     = hNodeRef:GET-ATTRIBUTE("psc:update")
      cElement       = trimPrefix(cElement)
      iMapParameter  = INTEGER(hNodeRef:GET-ATTRIBUTE("psc:parameter"))
      iCounter       = iCounter + 1
      iPCounter      = iCounter
      /*
      tmpPath        = (IF cNodeName = "" THEN pSchemaPath ELSE 
                          pSchemaPath + "/":U + cNodeName).
      */
      tmpPath        = pSchemaPath +
                       (     IF cRef <> ""      THEN "/":U + cRef
                        ELSE IF cNodeName <> "" THEN "/":U + cNodeName
                        ELSE "").

    RUN addNodesRec (/* abstract             */ cAbstract,
                     /* attributeFormDefault */ cAttributeFormDefault,
                     /* base                 */ cBase,
                     /* blockValue           */ cBlockValue,
                     /* content              */ cContent,
                     /* dataForm             */ cDataForm,
                     /* dataType             */ cDataType,
                     /* dataValue            */ cDataValue,
                     /* defaultValue         */ cDefaultValue,
                     /* derivedBy            */ cDerivedBy,
                     /* element              */ cElement,
                     /* elementFormDefault   */ cElementFormDefault,
                     /* equivClass           */ cequivClass,
                     /* final                */ cFinal,
                     /* mapConversion        */ cMapConversion,
                     /* mapFile              */ cMapFile,
                     /* mapLink              */ cMapLink,
                     /* mapName              */ cMapName,
                     /* mapObject            */ cMapObject,
                     /* mapParameter         */ iMapParameter,
                     /* mapType              */ cMapType,
                     /* mapUpdate            */ cMapUpdate,
                     /* maxOccurs            */ cMaxOccurs,
                     /* minOccurs            */ cMinOccurs,
                     /* model                */ cModel,
                     /* nameSpace            */ cNameSpace,
                     /* node                 */ iCounter,
                     /* nodeName             */ cNodeName,
                     /* nullable             */ cNullable,
                     /* order                */ cOrder,
                     /* parentName           */ cParent,
                     /* parentNode           */ pParent,
                     /* processContents      */ cProcessContents,
                     /* ref                  */ cRef,
                     /* schemaLocation       */ cSchemaLocation,
                     /* schemaPath           */ tmpPath,
                     /* targetNamespace      */ cTargetNamespace,
                     /* useValue             */ cUseValue,
                     /* xNodeRef             */ hNodeRef).
      
    ASSIGN
      tmpcParent = (IF cNodeName = "" THEN cParent ELSE cNodeName)
      tmppParent = (IF cNodeName = "" THEN pParent ELSE iPCounter).

    RUN getChild (hNodeRef, tmppParent, tmpcParent, tmpPath).
  END. /* child-loop */

END PROCEDURE.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME

&ENDIF

&IF DEFINED(EXCLUDE-initializeObject) = 0 &THEN

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE initializeObject Procedure 
PROCEDURE initializeObject :
/*------------------------------------------------------------------------------
  Purpose:     
  Parameters:  <none>
  Notes:       
------------------------------------------------------------------------------*/

END PROCEDURE.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME

&ENDIF

&IF DEFINED(EXCLUDE-loadSchema) = 0 &THEN

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE loadSchema Procedure 
PROCEDURE loadSchema :
/*------------------------------------------------------------------------------
  Purpose:     
  Parameters:  <none>
  Notes:   
  14-Aug-01 Fix LOAD method to search for .xmc or .xmp in the PROPATH.    
------------------------------------------------------------------------------*/
  DEFINE INPUT  PARAMETER pXMLFile     AS CHARACTER  NO-UNDO.
  DEFINE INPUT  PARAMETER pDelete      AS LOGICAL    NO-UNDO. /* after load */
  DEFINE OUTPUT PARAMETER TABLE-HANDLE hNode.   /* tNode - schema structure */
  DEFINE OUTPUT PARAMETER TABLE-HANDLE hData.   /* tData - data structure */
  DEFINE OUTPUT PARAMETER TABLE-HANDLE hSchema. /* tSchema - <SCHEMA> attributes*/

  DEFINE VARIABLE iRoot   AS INTEGER    NO-UNDO. /* root node */
  DEFINE VARIABLE cFormat AS CHARACTER  NO-UNDO.
  DEFINE VARIABLE lReturn AS LOGICAL    NO-UNDO.

    CREATE X-DOCUMENT hDoc.
    CREATE X-NODEREF hRoot.
    
    /* Read in XML schema file without validation - look for the file anywhere in the PROPATH (MN 14/8/01) */
    lReturn = hDoc:LOAD("file":U, SEARCH(pXMLFile), FALSE) NO-ERROR.
    IF ERROR-STATUS:ERROR OR lReturn = ? OR lReturn = FALSE THEN DO:
      RUN reset.
      RETURN ERROR ERROR-STATUS:GET-MESSAGE(1).
    END.
    
    /* Get root node. */
    lReturn = hDoc:GET-DOCUMENT-ELEMENT(hRoot) NO-ERROR.
    IF ERROR-STATUS:ERROR OR lReturn = ? OR lReturn = FALSE OR 
      (VALID-HANDLE(hRoot) AND INDEX(hRoot:NAME, "SCHEMA":U) = 0) OR
      (VALID-HANDLE(hRoot) AND hRoot:NUM-CHILDREN = 0) THEN DO:
      RUN reset.
      RETURN ERROR ERROR-STATUS:GET-MESSAGE(1).
    END.
  
    ASSIGN
      cFormat   = getSchemaType(). /* creates <SCHEMA> attribute records */
    ASSIGN
      lReturn   = setPrefix() NO-ERROR.
    IF cFormat = ? THEN DO:
      RUN reset.
      RETURN ERROR ERROR-STATUS:GET-MESSAGE(1).
    END.
      
    /* Create root temp-table record */
    RUN addNodesRec (/* abstract             */ "",
                     /* attributeFormDefault */ "",
                     /* base                 */ "",
                     /* blockValue           */ "",
                     /* content              */ "",
                     /* dataForm             */ "",
                     /* dataType             */ "",
                     /* dataValue            */ "",
                     /* defaultValue         */ "",
                     /* derivedBy            */ "",
                     /* element              */ hRoot:name,
                     /* elementFormDefault   */ "",
                     /* equivClass           */ "",
                     /* final                */ "",
                     /* mapConversion        */ "",
                     /* mapFile              */ "",
                     /* mapLink              */ "",
                     /* mapName              */ "",
                     /* mapObject            */ "",
                     /* mapParameter         */ "",
                     /* mapType              */ "",
                     /* mapUpdate            */ "",
                     /* maxOccurs            */ "",
                     /* minOccurs            */ "",
                     /* model                */ "",
                     /* nameSpace            */ "",
                     /* node                 */ iCounter,
                     /* nodeName             */ hRoot:GET-ATTRIBUTE("name":U),
                     /* nullable             */ "",
                     /* order                */ "",
                     /* parentName           */ "",
                     /* parentNode           */ iPCounter,
                     /* processContents      */ "",
                     /* ref                  */ "",
                     /* schemaLocation       */ "",
                     /* schemaPath           */ hRoot:GET-ATTRIBUTE("name":U),
                     /* targetNamespace      */ "",
                     /* useValue             */ "",
                     /* xNodeRef             */ hRoot).
    
    /* Find child nodes */
    RUN getChild(/* parent handle      */ hRoot, 
                 /* parent node        */ iPCounter, 
                 /* parent name        */ hRoot:GET-ATTRIBUTE("name":U),
                 /* parent schema path */ hRoot:GET-ATTRIBUTE("name":U)).
  
    /* Find root node.  Multiple root nodes are not supported. */
    FOR EACH tNode WHERE tNode.node > 0 AND tNode.parentNode = 0:
      IF trimPrefix(tNode.element) = "element" AND
        NOT CAN-DO(cSimpleType, trimPrefix(tNode.dataType)) THEN DO:
        iRoot = tNode.node.
        LEAVE.
      END.
    END.
    
    /* Seed tData, expand nodes, create data structure file from schema */
    FIND tNode WHERE tNode.node = iRoot NO-ERROR.
    IF NOT AVAILABLE tNode THEN DO:
      RUN reset.
      RETURN ERROR ERROR-STATUS:GET-MESSAGE(1).
    END.
    ELSE DO:
      CREATE tData.
      BUFFER-COPY tNode TO tData.
      FIND LAST buf_tNode.
      ASSIGN
        tData.documentPath = ("/":U + tData.nodeName)
        iLastNode          = buf_tNode.node.
    
      RUN expandNodes(/* name     */ tNode.nodeName, 
                      /* node     */ tNode.node, 
                      /* element  */ tNode.element,
                      /* datatype */ tNode.dataType,
                      /* docpath  */ tData.documentPath,
                      /* ref      */ tData.ref).
    END. 
    
  ASSIGN
      hNode   = TEMP-TABLE tNode:HANDLE
      hData   = TEMP-TABLE tData:HANDLE
      hSchema = TEMP-TABLE tSchema:HANDLE.
      
  IF pDelete THEN DO:
    hdoc = deleteObject(hdoc).
    hroot = DELETEObject(hroot).
  END.
  
END PROCEDURE.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME

&ENDIF

&IF DEFINED(EXCLUDE-reset) = 0 &THEN

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE reset Procedure 
PROCEDURE reset :
/*------------------------------------------------------------------------------
  Purpose:     
  Parameters:  <none>
  Notes:       
------------------------------------------------------------------------------*/

  deleteObject(hDoc).
  deleteObject(hRoot).

  /* Delete X-NODEREF objects */
  FOR EACH tNode:
    deleteObject(tNode.xNodeRef).
  END.
  
  EMPTY TEMP-TABLE tNode    NO-ERROR.
  EMPTY TEMP-TABLE tData    NO-ERROR.
  EMPTY TEMP-TABLE tSchema  NO-ERROR.
  EMPTY TEMP-TABLE tMapping NO-ERROR.

  ASSIGN
    hDoc      = ?
    hRoot     = ?
    iCounter  = 0
    iPCounter = 0 NO-ERROR.

END PROCEDURE.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME

&ENDIF

&IF DEFINED(EXCLUDE-saveSchema) = 0 &THEN

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE saveSchema Procedure 
PROCEDURE saveSchema :
/*------------------------------------------------------------------------------
  Purpose:     
  Parameters:  <none>
  Notes:       
------------------------------------------------------------------------------*/
  DEFINE INPUT  PARAMETER pSaveFile AS CHARACTER  NO-UNDO.
  DEFINE INPUT  PARAMETER TABLE FOR tData.   /* data structure */

  DEFINE VARIABLE cAttrs      AS CHARACTER  NO-UNDO.
  
  DEFINE VARIABLE cConversion AS CHARACTER  NO-UNDO.
  DEFINE VARIABLE cExtension  AS CHARACTER  NO-UNDO.
  DEFINE VARIABLE cFile       AS CHARACTER  NO-UNDO.
  DEFINE VARIABLE cLink       AS CHARACTER  NO-UNDO.
  DEFINE VARIABLE cName       AS CHARACTER  NO-UNDO.
  DEFINE VARIABLE cObject     AS CHARACTER  NO-UNDO.
  DEFINE VARIABLE cParameter  AS CHARACTER  NO-UNDO.
  DEFINE VARIABLE cType       AS CHARACTER  NO-UNDO.
  DEFINE VARIABLE cUpdate     AS CHARACTER  NO-UNDO.
  
  DEFINE VARIABLE hAttr       AS HANDLE     NO-UNDO.
  DEFINE VARIABLE hChild      AS HANDLE     NO-UNDO.
  DEFINE VARIABLE hNode       AS HANDLE     NO-UNDO.
  DEFINE VARIABLE lMultiple   AS LOGICAL    NO-UNDO.
  DEFINE VARIABLE lReturn     AS LOGICAL    NO-UNDO.
  
  DEFINE BUFFER buf_data FOR tData.
  
  RUN adecomm/_setcurs.p ("WAIT":U).
  RUN adecomm/_osfext.p (pSaveFile, OUTPUT cExtension).
  
  /* Create namespace */
  hRoot:SET-ATTRIBUTE("xmlns:psc":U, 
    "urn:schemas-progress-com:data-mapping:91D").
    
  /* Update root attributes */
  IF getContainer() <> "" THEN
    hRoot:SET-ATTRIBUTE("psc:container":U, getContainer()).
  ELSE
    hRoot:REMOVE-ATTRIBUTE("psc:container":U) NO-ERROR.
    
  IF gcSmartB2B <> "" THEN
    hRoot:SET-ATTRIBUTE("psc:smartb2b":U, gcSmartB2B).
  ELSE
    hRoot:REMOVE-ATTRIBUTE("psc:smartb2b":U).
  
  /* Clear out any previously saved attributes */
  FOR EACH tNode:
    hChild  = tNode.xNodeRef.
    
    IF hChild:GET-ATTRIBUTE("psc:conversion":U) <> "" THEN
      hChild:REMOVE-ATTRIBUTE("psc:conversion":U) NO-ERROR.
      
    IF hChild:GET-ATTRIBUTE("psc:file":U) <> "" THEN
      hChild:REMOVE-ATTRIBUTE("psc:file":U) NO-ERROR.
    
    IF hChild:GET-ATTRIBUTE("psc:link":U) <> "" THEN
      hChild:REMOVE-ATTRIBUTE("psc:link":U) NO-ERROR.
    
    IF hChild:GET-ATTRIBUTE("psc:name":U) <> "" THEN
      hChild:REMOVE-ATTRIBUTE("psc:name":U) NO-ERROR.
    
    IF hChild:GET-ATTRIBUTE("psc:object":U) <> "" THEN
      hChild:REMOVE-ATTRIBUTE("psc:object":U) NO-ERROR.
    
    IF hChild:GET-ATTRIBUTE("psc:parameter":U) <> "" THEN
      hChild:REMOVE-ATTRIBUTE("psc:parameter":U) NO-ERROR.
    
    IF hChild:GET-ATTRIBUTE("psc:type":U) <> "" THEN
      hChild:REMOVE-ATTRIBUTE("psc:type":U) NO-ERROR.
    
    IF hChild:GET-ATTRIBUTE("psc:update":U) <> "" THEN
      hChild:REMOVE-ATTRIBUTE("psc:update":U) NO-ERROR.
  END.
  
  FOR EACH tNode WHERE tNode.instance > 0:
    tNode.instance = 0.
  END.
  
  /* Update all child nodes */
  FOR EACH tData, EACH tNode WHERE tNode.xNodeRef = tData.xNodeRef:
    ASSIGN
      hChild         = tData.xNodeRef
      lMultiple      = CAN-FIND(FIRST tMapping WHERE 
                         tMapping.cField  = tNode.nodeName AND
                         tMapping.cParent = tNode.parentName)
      tNode.instance = (IF lMultiple THEN tNode.instance + 1 ELSE 0).
    
    IF (tData.mapConversion <> "" OR lMultiple) THEN DO:
      ASSIGN
        cConversion = hChild:GET-ATTRIBUTE("psc:conversion":U)
        cConversion = cConversion + 
                     (IF cConversion <> "" OR (lMultiple AND tNode.instance > 1)
                        THEN ",":U ELSE "") +
                      tData.mapConversion.
      hChild:SET-ATTRIBUTE("psc:conversion":U, cConversion) NO-ERROR.
    END.
    
    IF tData.mapFile <> "" OR lMultiple THEN DO:
      ASSIGN
        cFile = hChild:GET-ATTRIBUTE("psc:file":U)
        cFile = cFile + 
               (IF cFile <> "" OR (lMultiple AND tNode.instance > 1) 
                 THEN ",":U ELSE "") + 
                tData.mapFile.
      hChild:SET-ATTRIBUTE("psc:file":U, cFile) NO-ERROR.
    END.
    
    /* not used
    IF tData.mapLink <> "" OR lMultiple THEN DO:
      ASSIGN
        cLink = hChild:GET-ATTRIBUTE("psc:link":U)
        cLink = cLink + (IF cLink = "" THEN "" ELSE ",":U) + tData.mapLink.
      hChild:SET-ATTRIBUTE("psc:link":U, cLink) NO-ERROR.
    END.
    */
    
    IF tData.mapName <> "" OR lMultiple THEN DO:
      ASSIGN
        cName = hChild:GET-ATTRIBUTE("psc:name":U)
        cName = cName + 
               (IF cName <> "" OR (lMultiple AND tNode.instance > 1) 
                  THEN ",":U ELSE "") + 
                tData.mapName.
      hChild:SET-ATTRIBUTE("psc:name":U, cName) NO-ERROR.
    END.
    
    IF tData.objectName <> "" OR lMultiple THEN DO:
      ASSIGN
        cObject = hChild:GET-ATTRIBUTE("psc:object":U)
        cObject = cObject + 
                 (IF cObject <> "" OR (lMultiple AND tNode.instance > 1)
                    THEN ",":U ELSE "") + 
                  tData.objectName.
      hChild:SET-ATTRIBUTE("psc:object":U, cObject) NO-ERROR.
    END.
    
    IF ((tData.mapParameter <> ? AND tData.mapParameter <> 0) OR lMultiple) AND 
      CAN-DO("function,procedure":U, tData.mapType) THEN DO:
      ASSIGN
        cParameter = hChild:GET-ATTRIBUTE("psc:parameter":U)
        cParameter = cParameter + 
                    (IF cParameter <> "" OR (lMultiple AND tNode.instance > 1)
                       THEN ".":U ELSE "") + 
                     STRING(tData.mapParameter).
      hChild:SET-ATTRIBUTE("psc:parameter":U, cParameter) NO-ERROR.
    END.
    
    IF tData.mapType <> "" OR lMultiple THEN DO:
      ASSIGN
        cType = hChild:GET-ATTRIBUTE("psc:type":U)
        cType = cType + 
               (IF cType <> "" OR (lMultiple AND tNode.instance > 1) 
                  THEN ",":U ELSE "") + 
                tData.mapType.
      hChild:SET-ATTRIBUTE("psc:type":U, cType) NO-ERROR.
    END.
    
    IF (tData.mapUpdate <> "" OR lMultiple) 
      AND cExtension <> ".xmp":U THEN DO:
      ASSIGN
        cUpdate = hChild:GET-ATTRIBUTE("psc:update":U)
        cUpdate = cUpdate + 
                 (IF cUpdate <> "" OR (lMultiple AND tNode.instance > 1) 
                    THEN ",":U ELSE "") + 
                  tData.mapUpdate.
      hChild:SET-ATTRIBUTE("psc:update":U, cUpdate) NO-ERROR.
    END.
  END.

  hDoc:SAVE("file":U, pSaveFile).

  RUN adecomm/_setcurs.p ("":U).
  
END PROCEDURE.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME

&ENDIF

&IF DEFINED(EXCLUDE-setSmartB2B) = 0 &THEN

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE setSmartB2B Procedure 
PROCEDURE setSmartB2B :
/*------------------------------------------------------------------------------
  Purpose:     
  Parameters:  <none>
  Notes:       
------------------------------------------------------------------------------*/
  DEFINE INPUT  PARAMETER cSmartB2B AS CHARACTER  NO-UNDO.

  gcSmartB2B = cSmartB2B.
  
END PROCEDURE.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME

&ENDIF

/* ************************  Function Implementations ***************** */

&IF DEFINED(EXCLUDE-createNodeRef) = 0 &THEN

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION createNodeRef Procedure 
FUNCTION createNodeRef RETURNS HANDLE
  ( /* parameter-definitions */ ) :
/*------------------------------------------------------------------------------
  Purpose:  
    Notes:  
------------------------------------------------------------------------------*/
  DEFINE VARIABLE hNodeRef AS HANDLE     NO-UNDO.

  CREATE X-NODEREF hNodeRef.

  RETURN hNodeRef.

END FUNCTION.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME

&ENDIF

&IF DEFINED(EXCLUDE-deleteObject) = 0 &THEN

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION deleteObject Procedure 
FUNCTION deleteObject RETURNS HANDLE
  ( hObject AS HANDLE ) :
/*------------------------------------------------------------------------------
  Purpose:  
    Notes:  
------------------------------------------------------------------------------*/

  IF VALID-HANDLE(hObject) THEN
    DELETE OBJECT hObject NO-ERROR.
  hObject = ?.

  RETURN hObject.

END FUNCTION.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME

&ENDIF

&IF DEFINED(EXCLUDE-getContainer) = 0 &THEN

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION getContainer Procedure 
FUNCTION getContainer RETURNS CHARACTER
  ( /* parameter-definitions */ ) :
/*------------------------------------------------------------------------------
  Purpose:  
    Notes:  
------------------------------------------------------------------------------*/
  DEFINE VARIABLE cContainer AS CHARACTER  NO-UNDO.
  
  FIND FIRST tSchema WHERE tSchema.attrName = "psc:container":U NO-ERROR.
  IF AVAILABLE tSchema THEN
    cContainer = tSchema.attrValue.
    
  RETURN cContainer.

END FUNCTION.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME

&ENDIF

&IF DEFINED(EXCLUDE-getDataType) = 0 &THEN

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION getDataType Procedure 
FUNCTION getDataType RETURNS CHARACTER
  ( INPUT pKey AS INTEGER ) :
/*------------------------------------------------------------------------------
  Purpose:  
    Notes:  
------------------------------------------------------------------------------*/

  FIND tData WHERE tData.node = pKey NO-ERROR.

  RETURN (IF AVAILABLE tData THEN tData.dataType ELSE "").

END FUNCTION.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME

&ENDIF

&IF DEFINED(EXCLUDE-getNodeHandle) = 0 &THEN

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION getNodeHandle Procedure 
FUNCTION getNodeHandle RETURNS HANDLE
  ( INPUT pNode AS INTEGER ) :
/*------------------------------------------------------------------------------
  Purpose:  
    Notes:  
------------------------------------------------------------------------------*/
  FIND FIRST tData WHERE tData.node = pNode NO-ERROR.
  IF AVAILABLE tData THEN
    RETURN tData.xNodeRef.
  ELSE
    RETURN ?.

END FUNCTION.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME

&ENDIF

&IF DEFINED(EXCLUDE-getSchemaType) = 0 &THEN

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION getSchemaType Procedure 
FUNCTION getSchemaType RETURNS CHARACTER
  ( /* parameter-definitions */ ) :
/*------------------------------------------------------------------------------
  Purpose:  
    Notes:  
------------------------------------------------------------------------------*/
  DEFINE VARIABLE cAttrName AS CHARACTER  NO-UNDO
    INITIAL "xmlns,xmlns:xsd,targetNamespace":U.
    
  /* One value now, but will expand in the future (adams) */
  DEFINE VARIABLE cAttrValue AS CHARACTER  NO-UNDO
    INITIAL "http://www.w3.org/1999/XMLSchema":U.

  DEFINE VARIABLE cReturn   AS CHARACTER  NO-UNDO INITIAL ?.
  DEFINE VARIABLE iPos      AS INTEGER    NO-UNDO.
  DEFINE VARIABLE ix        AS INTEGER    NO-UNDO.
  DEFINE VARIABLE lFound    AS LOGICAL    NO-UNDO.
  
  EMPTY TEMP-TABLE tSchema.
  
  DO ix = 1 TO NUM-ENTRIES(hRoot:ATTRIBUTE-NAMES):
    CREATE tSchema.
    ASSIGN
      tSchema.attrName  = ENTRY(ix, hRoot:ATTRIBUTE-NAMES)
      tSchema.attrValue = hRoot:GET-ATTRIBUTE(tSchema.attrName).
      
    /* Find the schema type. */
    IF NOT lFound AND      
      CAN-DO(cAttrName, tSchema.attrName) AND
      CAN-DO(cAttrValue, tSchema.attrValue) THEN DO:
        ASSIGN
          iPos    = LOOKUP(cAttrValue, tSchema.attrValue)
          cReturn = ENTRY(iPos, cAttrValue)
          lFound  = TRUE.
        LEAVE.
    END.
  END.
    
  RETURN cReturn.

END FUNCTION.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME

&ENDIF

&IF DEFINED(EXCLUDE-setContainer) = 0 &THEN

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION setContainer Procedure 
FUNCTION setContainer RETURNS LOGICAL
  ( INPUT pValue AS CHARACTER ) :
/*------------------------------------------------------------------------------
  Purpose:  
    Notes:  
------------------------------------------------------------------------------*/
  DEFINE VARIABLE lReturn    AS LOGICAL    NO-UNDO.
  
  FIND FIRST tSchema WHERE tSchema.attrName = "psc:container":U NO-ERROR.
  IF AVAILABLE tSchema THEN DO:
    IF pValue = "" OR pValue = ? THEN DO:
      DELETE tSchema.
      RETURN TRUE.
    END.
  END.
  ELSE IF pValue <> "" AND pValue <> ? THEN DO:
    CREATE tSchema.
    ASSIGN
      tSchema.attrName = "psc:container":U.
  END.
  IF AVAILABLE tSchema THEN
    tSchema.attrValue = pValue.
  
  RETURN TRUE.   /* Function return value. */

END FUNCTION.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME

&ENDIF

&IF DEFINED(EXCLUDE-setPrefix) = 0 &THEN

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION setPrefix Procedure 
FUNCTION setPrefix RETURNS LOGICAL
  ( /* parameter-definitions */ ) :
/*------------------------------------------------------------------------------
  Purpose:  Return the prefix that is associated with the XML schema namespace.
    Notes:  
------------------------------------------------------------------------------*/

  cPrefix = (IF NUM-ENTRIES(hRoot:NAME, ":":U) = 1 THEN "" ELSE
               ENTRY(1, hRoot:NAME, ":":U)).
             
  RETURN TRUE.

END FUNCTION.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME

&ENDIF

&IF DEFINED(EXCLUDE-trimPrefix) = 0 &THEN

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION trimPrefix Procedure 
FUNCTION trimPrefix RETURNS CHARACTER
  ( INPUT pValue AS CHARACTER ) :
/*------------------------------------------------------------------------------
  Purpose:  
    Notes:  
------------------------------------------------------------------------------*/

  RETURN TRIM(TRIM(pValue, cPrefix), ":":U).

END FUNCTION.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME

&ENDIF

/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/
/*----------------------------------------------------------------------------

File: xmlwidg.i

Description:
    Universal WebSpeed XML temp-table definitions.

Updated: 05/01/00 adams@progress.com
           Initial version
         02/09/02 adams@progress.com
           Modified tNode indexes

----------------------------------------------------------------------------*/

/* tNode - XML schema node structure */
DEFINE TEMP-TABLE tNode NO-UNDO
  FIELD abstract             AS CHARACTER  LABEL "Abstract"
  FIELD attributeFormDefault AS CHARACTER  LABEL "Attribute Form Default"
  FIELD base                 AS CHARACTER  LABEL "Base"
  FIELD blockValue           AS CHARACTER  LABEL "Block"
  FIELD content              AS CHARACTER  LABEL "Content"
  FIELD dataForm             AS CHARACTER  LABEL "Form"
  FIELD dataKey              AS RECID      LABEL "Data Key" /*TV*/
  FIELD dataType             AS CHARACTER  LABEL "Type"
  FIELD dataValue            AS CHARACTER  LABEL "Value"
  FIELD defaultValue         AS CHARACTER  LABEL "Default"
  FIELD derivedBy            AS CHARACTER  LABEL "Derived By"
  FIELD documentPath         AS CHARACTER  LABEL "Document Path"
  FIELD element              AS CHARACTER  LABEL "Element"
  FIELD elementFormDefault   AS CHARACTER  LABEL "Element Form Default"
  FIELD equivClass           AS CHARACTER  LABEL "Equivalent Class"
  FIELD final                AS CHARACTER  LABEL "Final"
  FIELD instance             AS INTEGER    LABEL "Instances"
  FIELD mapConversion        AS CHARACTER  LABEL "Map Conversion Function"
  FIELD mapFile              AS CHARACTER  LABEL "Object Path" /*map*/
  FIELD mapLink              AS CHARACTER  LABEL "SmartLink" /*map*/
  FIELD mapName              AS CHARACTER  LABEL "Map I/O Name" /*map*/
  FIELD mapParameter         AS INTEGER    LABEL "Map I/O Parameter" /*map*/
    INITIAL ?
  FIELD mapType              AS CHARACTER  LABEL "Map I/O Type" /*map*/
    /* source/target: column, function, procedure */
  FIELD mapUpdate            AS CHARACTER  LABEL "Consumer Update" /*map*/
  FIELD maxOccurs            AS CHARACTER  LABEL "Maximum Occurances"
  FIELD minOccurs            AS CHARACTER  LABEL "Minimum Occurances"
  FIELD model                AS CHARACTER  LABEL "Model"
  FIELD nameSpace            AS CHARACTER  LABEL "Namespace"
  FIELD node                 AS INTEGER    LABEL "Node ID"
  FIELD nodeName             AS CHARACTER  LABEL "Name" CASE-SENSITIVE
  FIELD nullable             AS CHARACTER  LABEL "Nullable"
  FIELD objectName           AS CHARACTER  LABEL "Object Name" /*map*/
  FIELD order                AS CHARACTER  LABEL "Order"
  FIELD parentName           AS CHARACTER  LABEL "Parent Name" CASE-SENSITIVE
  FIELD parentNode           AS INTEGER    LABEL "Parent ID"
  FIELD processContents      AS CHARACTER  LABEL "Process Contents"
  FIELD ref                  AS CHARACTER  LABEL "Reference"
  FIELD schemaLocation       AS CHARACTER  LABEL "Schema Location"
  FIELD schemaPath           AS CHARACTER  LABEL "Schema Path"
  FIELD targetNamespace      AS CHARACTER  LABEL "Target Namespace"
  FIELD tvNode               AS COM-HANDLE LABEL "TreeView Node"
  FIELD useValue             AS CHARACTER  LABEL "Use"
  FIELD xNodeRef             AS HANDLE     LABEL "X Node Handle"
  
  INDEX node IS PRIMARY node parentNode /* added parentNode (adams) */
  INDEX xNodeRef xNodeRef
  INDEX parentName parentName nodeName
  INDEX parentNode parentNode element /* used by adm2/b2b.p chambers */
  INDEX tvNode tvNode
  INDEX documentPath documentPath
  /* Both parentName and element are used together with nodeName for
     searching.  Since likelihood of nodeName used more than once is low
     and cost of additional indexes is high, we'll go with single index
     (adams) */
  INDEX nodename nodename /* chambers */
  .
  
/* tSchema - XML schema <SCHEMA> node attributes */
DEFINE TEMP-TABLE tSchema NO-UNDO
  FIELD attrName             AS CHARACTER LABEL "Name"
  FIELD attrValue            AS CHARACTER LABEL "Value"
  index attrname is primary attrname /* chambers */
  .

/* tData - XML node structure as it appears in data file format */
DEFINE TEMP-TABLE tData NO-UNDO LIKE tNode.
  
/* xmlwidg.i - end of file */
/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/* y-const.i - shell for constant-entry routines */
&GLOBAL-DEFINE WIN95-BTN YES
{adecomm/adestds.i}
{aderes/reshlp.i}    /* RESULTS help  */
{adecomm/commeng.i}  /* Help contexts */

/*
Used in _y-date.p, _y-num.p and _y-strng.p, which are called by
y-where.p (where-builder) and s-exp.p (expression builder).

Parameters are:
  DefaultFormat - format to use when pi_fmt = ?
  DataType      - datatype & modifiers for def var stmt
  InitialValue  - initial value
  PackageOne    - how to convert value to canonical 4gl string for return
  PackageTwo    - same, but for two values
  Message       - "Enter <datatype> Value" string
  Function      - DECIMAL, DATE or STRING - to convert CHARACTER to {&DataType}
*/

OUTPUT TO TERMINAL. /* needed for RESULTS use */

DEFINE INPUT  PARAMETER pi_mode AS INTEGER             NO-UNDO. /* 1,2 or >2 */
DEFINE INPUT  PARAMETER pi_fmt  AS CHARACTER           NO-UNDO. /* format */
DEFINE INPUT  PARAMETER pi_text AS CHARACTER           NO-UNDO. /* Message */
DEFINE OUTPUT PARAMETER po_out  AS CHARACTER INITIAL ? NO-UNDO. /* value */
DEFINE OUTPUT PARAMETER po_inclusive AS LOGICAL INITIAL YES NO-UNDO. 
/*
pi_mode =  1 -> get a single value from the user
        =  2 -> get two values - upper and lower range limits
        =  3 -> get a list of values for in-list function
        =  4 -> get a list of values for not-in-list function
        =  5 -> same as pi_mode = 1, for RESULTS Ask At Run Time
If the pi_mode number is negative, then support the ask-at-run-time mode.
*/

DEFINE VARIABLE qbf-h  AS INTEGER     NO-UNDO. /* help define */
DEFINE VARIABLE qbf-i  AS INTEGER     NO-UNDO. /* scrap */
DEFINE VARIABLE qbf-l  AS LOGICAL     NO-UNDO. /* scrap */
DEFINE VARIABLE qbf-s  AS CHARACTER   NO-UNDO. /* selection-list */
DEFINE VARIABLE v_text AS CHARACTER   NO-UNDO. /* text */
DEFINE VARIABLE v_more AS CHARACTER   NO-UNDO. /* more text */
DEFINE VARIABLE v_one  AS {&DataType} NO-UNDO. /* value holder */
DEFINE VARIABLE v_two  AS {&DataType} NO-UNDO. /* 2nd value holder */

DEFINE BUTTON qbf-ok   LABEL "OK"      {&STDPH_OKBTN} AUTO-GO.
DEFINE BUTTON qbf-ee   LABEL "Cancel"  {&STDPH_OKBTN} AUTO-ENDKEY.
DEFINE BUTTON qbf-help LABEL "&Help"   {&STDPH_OKBTN}. 
DEFINE BUTTON qbf-ad   LABEL "&Add"    {&STDPH_OKBTN}.
DEFINE BUTTON qbf-ch   LABEL "&Change" {&STDPH_OKBTN}.
DEFINE BUTTON qbf-rm   LABEL "&Remove" {&STDPH_OKBTN}.

DEFINE RECTANGLE rect_btns {&STDPH_OKBOX}.
define variable WtitleConstant as character initial "Enter Constant":t32.
define variable WtitleConstantRange as character initial "Enter Constant":t32.
define variable WtitleListConstant as character initial "Enter List of Constants":t32.

FORM
  SKIP({&TFM_WID})
  SPACE(1) v_text FORMAT "x(50)":u VIEW-AS TEXT SKIP
  SPACE(1) v_one  FORMAT "{&DefaultFormat}":u  SKIP({&VM_WIDG})

  {adecomm/okform.i
    &BOX    = rect_btns
    &STATUS = no
    &OK     = qbf-ok
    &CANCEL = qbf-ee
    &HELP   = qbf-help }

  WITH FRAME qbf%one NO-LABELS NO-ATTR-SPACE THREE-D WIDTH 55
  DEFAULT-BUTTON qbf-ok CANCEL-BUTTON qbf-ee
  &if DEFINED(IDE-IS-RUNNING) = 0 &then
  TITLE WtitleConstant  VIEW-AS DIALOG-BOX
   &else
        NO-BOX
   &endif 
  .

FORM
  SKIP({&TFM_WID})
  SPACE(1) v_text FORMAT "x(50)":u VIEW-AS TEXT SKIP
  SPACE(1) v_one  FORMAT "{&DefaultFormat}":u SKIP({&VM_WIDG})
  SPACE(1) v_more FORMAT "x(50)":u VIEW-AS TEXT SKIP
  SPACE(1) v_two  FORMAT "{&DefaultFormat}":u SKIP({&VM_WIDG})
  SPACE(1) po_inclusive VIEW-AS TOGGLE-BOX LABEL "&Inclusive"

  {adecomm/okform.i
    &BOX    = rect_btns
    &STATUS = no
    &OK     = qbf-ok
    &CANCEL = qbf-ee
    &HELP   = qbf-help }

  WITH FRAME qbf%two NO-LABELS NO-ATTR-SPACE THREE-D WIDTH 55
  DEFAULT-BUTTON qbf-ok CANCEL-BUTTON qbf-ee
  &if DEFINED(IDE-IS-RUNNING) = 0 &then
  TITLE WtitleConstantRange VIEW-AS DIALOG-BOX
   &else
        NO-BOX
   &endif
  .

/*
Enter a value:
<____________________>

          +------------------------+
          |    "xxxxxxxx"          |
[_Add__]  | OR "xxxxxxx"           |
          | OR "xxxxx"             |
[Change]  | OR "xxxxxxxxxx"        |
          | OR "xxxx"              |
[Remove]  | OR "xxxxxxxxxxx"       |
          | OR "xxxxxxxx"          |
          +------------------------+

[__OK__] [Cancel] [Help]
*/
FORM
  SKIP({&TFM_WID}) SPACE(1)
  v_text FORMAT "x(50)":u VIEW-AS TEXT SKIP({&VM_WID}) SPACE(1) 
  v_one  FORMAT "{&DefaultFormat}":u SKIP({&VM_WID}) SPACE(1) 
  qbf-ad at 4 SPACE ({&HM_BTN}) 
  qbf-ch SPACE ({&HM_BTN}) 
  qbf-rm SKIP({&VM_WID}) SPACE(1) 

  qbf-s  VIEW-AS SELECTION-LIST INNER-CHARS 48 INNER-LINES 8
    SCROLLBAR-VERTICAL SCROLLBAR-HORIZONTAL

  SKIP({&TFM_WID}) SPACE(1) 
  po_inclusive VIEW-AS TOGGLE-BOX LABEL "&Inclusive"

  {adecomm/okform.i
    &BOX    = rect_btns
    &STATUS = no
    &OK     = qbf-ok
    &CANCEL = qbf-ee
    &HELP   = qbf-help }

  WITH FRAME qbf%thr NO-LABELS NO-ATTR-SPACE THREE-D WIDTH 55
  DEFAULT-BUTTON qbf-ok CANCEL-BUTTON qbf-ee
  &if DEFINED(IDE-IS-RUNNING) = 0 &then
  TITLE WtitleListConstant VIEW-AS DIALOG-BOX
   &else
        NO-BOX
   &endif
  .

ON GO OF FRAME qbf%thr OR CHOOSE OF qbf-ok IN FRAME qbf%thr DO:
  IF qbf-s:LOOKUP(INPUT FRAME qbf%thr v_one) = 0 AND
    (IF "{&Function}":u <> "date":u THEN
       INPUT FRAME qbf%thr v_one <> {&InitialValue} 
     ELSE
       INPUT FRAME qbf%thr v_one <> "") THEN
    qbf-l = qbf-s:ADD-LAST(v_one:SCREEN-VALUE IN FRAME qbf%thr) 
                  IN FRAME qbf%thr.

  ASSIGN
    po_out       = qbf-s:LIST-ITEMS IN FRAME qbf%thr
    po_Inclusive = IF po_Inclusive:SCREEN-VALUE IN FRAME qbf%thr = "yes" 
                   THEN TRUE ELSE FALSE
    v_one:SCREEN-VALUE IN FRAME qbf%thr = ENTRY(1, po_out)
    qbf-ch:SENSITIVE IN FRAME qbf%thr = qbf-s:SCREEN-VALUE IN FRAME qbf%thr NE ?
    qbf-rm:SENSITIVE IN FRAME qbf%thr = qbf-s:SCREEN-VALUE IN FRAME qbf%thr NE ?    .
    /* this gets out of format-checking when v_one is blank? */
END.

ON CHOOSE OF qbf-ad IN FRAME qbf%thr DO:
  RUN is_new_value (OUTPUT qbf-l).
  IF qbf-l THEN DO:
    qbf-l = qbf-s:ADD-LAST(v_one:SCREEN-VALUE IN FRAME qbf%thr) 
      IN FRAME qbf%thr.
    ASSIGN 
      v_one:SCREEN-VALUE IN FRAME qbf%thr = 
        (IF "{&Function}":u = "date":u THEN "" ELSE STRING({&InitialValue}))
      qbf-ch:SENSITIVE IN FRAME qbf%thr = 
        qbf-s:SCREEN-VALUE IN FRAME qbf%thr NE ?
      qbf-rm:SENSITIVE IN FRAME qbf%thr = 
        qbf-s:SCREEN-VALUE IN FRAME qbf%thr NE ?.
  END.
  APPLY "ENTRY":u TO v_one IN FRAME qbf%thr. 
END.

ON CHOOSE OF qbf-ch IN FRAME qbf%thr DO:
  RUN is_new_value (OUTPUT qbf-l).
  IF qbf-l THEN
    ASSIGN
      qbf-l = (IF qbf-s:SCREEN-VALUE IN FRAME qbf%thr = ? THEN
        qbf-s:ADD-LAST(v_one:SCREEN-VALUE IN FRAME qbf%thr) IN FRAME qbf%thr
        ELSE
          qbf-s:REPLACE(v_one:SCREEN-VALUE IN FRAME qbf%thr,
          qbf-s:SCREEN-VALUE IN FRAME qbf%thr) IN FRAME qbf%thr)
          v_one:SCREEN-VALUE IN FRAME qbf%thr = STRING({&InitialValue})
      qbf-ch:SENSITIVE IN FRAME qbf%thr = 
        qbf-s:SCREEN-VALUE IN FRAME qbf%thr NE ?
      qbf-rm:SENSITIVE IN FRAME qbf%thr = 
        qbf-s:SCREEN-VALUE IN FRAME qbf%thr NE ?
      .
  APPLY "ENTRY":u TO v_one IN FRAME qbf%thr.
END.

ON CHOOSE OF qbf-rm IN FRAME qbf%thr DO:
  IF qbf-s:SCREEN-VALUE <> ? THEN
    qbf-l = qbf-s:DELETE(qbf-s:SCREEN-VALUE).

  IF v_one:SCREEN-VALUE <> ? THEN
    v_one:SCREEN-VALUE = "".
  ASSIGN 
    qbf-ch:SENSITIVE IN FRAME qbf%thr = 
      qbf-s:SCREEN-VALUE IN FRAME qbf%thr NE ?
    qbf-rm:SENSITIVE IN FRAME qbf%thr = 
      qbf-s:SCREEN-VALUE IN FRAME qbf%thr NE ?.

  APPLY "ENTRY":u TO v_one.
END.

ON VALUE-CHANGED OF qbf-s IN FRAME qbf%thr DO:
  v_one:SCREEN-VALUE IN FRAME qbf%thr = qbf-s:SCREEN-VALUE IN FRAME qbf%thr.
  ASSIGN qbf-ch:SENSITIVE IN FRAME qbf%thr = qbf-s:SCREEN-VALUE NE ""
         qbf-rm:SENSITIVE IN FRAME qbf%thr = qbf-s:SCREEN-VALUE NE "".
  APPLY "ENTRY":u TO v_one IN FRAME qbf%thr.
END.

/*---------------------------------------------------------------------------*/
 
IF pi_fmt <> ? THEN DO:
  ASSIGN
    pi_fmt = REPLACE(REPLACE(pi_fmt,"%":u,"":u),",":u,"":u) 
    v_one:FORMAT IN FRAME qbf%one = pi_fmt
    v_one:FORMAT IN FRAME qbf%two = pi_fmt        
    
    v_two:FORMAT IN FRAME qbf%two = pi_fmt
    v_one:FORMAT IN FRAME qbf%thr = pi_fmt

    /* This prevents the g,p,j,y descenders from getting chopped off */
    v_one:HEIGHT IN FRAME qbf%one = 1
    v_one:HEIGHT IN FRAME qbf%two = 1
    v_two:HEIGHT IN FRAME qbf%two = 1
    v_one:HEIGHT IN FRAME qbf%thr = 1

    v_one:WIDTH IN FRAME qbf%one = MIN(v_one:WIDTH IN FRAME qbf%one, 50)
    v_one:WIDTH IN FRAME qbf%two = MIN(v_one:WIDTH IN FRAME qbf%two, 50)
    v_two:WIDTH IN FRAME qbf%two = MIN(v_two:WIDTH IN FRAME qbf%two, 50)
    v_one:WIDTH IN FRAME qbf%thr = MIN(v_one:WIDTH IN FRAME qbf%thr, 50).
END.
ELSE IF "{&DataType}" BEGINS "CHAR":U THEN
   ASSIGN v_one:FORMAT IN FRAME qbf%one = "X(250)":U
          v_one:FORMAT IN FRAME qbf%two = "X(250)":U
          v_one:FORMAT IN FRAME qbf%thr = "X(250)":U
          v_two:FORMAT IN FRAME qbf%two = "X(250)":U.

pi_mode = ABSOLUTE(pi_mode).

CASE ENTRY(1,"{&DataType}":u," ":u):
  WHEN "DATE":u    THEN
    ASSIGN qbf-h = {&Enter_Constant_Date}
           v_one:COLUMN IN FRAME qbf%one = 18
           v_one:COLUMN IN FRAME qbf%two = 18
           v_one:COLUMN IN FRAME qbf%thr = 18
           v_two:COLUMN IN FRAME qbf%two = 18.
  WHEN "DECIMAL":u THEN
    ASSIGN qbf-h = {&Enter_Constant_Number}
           v_one:COLUMN IN FRAME qbf%one = 18
           v_one:COLUMN IN FRAME qbf%two = 18
           v_one:COLUMN IN FRAME qbf%thr = 18
           v_two:COLUMN IN FRAME qbf%two = 18.
  OTHERWISE
    ASSIGN qbf-h = {&Enter_Constant_String}
           v_one:WIDTH IN FRAME qbf%one = 50
           v_one:WIDTH IN FRAME qbf%two = 50
           v_one:WIDTH IN FRAME qbf%thr = 50
           v_two:WIDTH IN FRAME qbf%two = 50.
END CASE.

IF pi_mode = 1 OR pi_mode = 5 THEN DO: /*-------------*/ 
  ASSIGN
    v_text = (IF pi_text = ? THEN TRIM("{&Message}":t55) + ":":u ELSE pi_text)

    v_one                           = {&InitialValue}
    v_text:FORMAT IN FRAME qbf%one  = "x(":u 
                                    + STRING(LENGTH(v_text,"RAW":U) + 1) 
                                    + ")":u
    v_text:SCREEN-VALUE IN FRAME qbf%one = v_text
    qbf-i                           = v_text:X IN FRAME qbf%one
                                    + MAXIMUM(
                                        v_text:WIDTH-PIXELS IN FRAME qbf%one,
                                        v_one:WIDTH-PIXELS IN FRAME qbf%one 
                                    + 10,
      /* This is based on the postion of the cancel button
      ** plus the width of that button plus the magin expressed
      ** in PPU and then convert into pixels
      ** assumption is cancel button is 1 PPU high */
      qbf-help:x + qbf-help:width-pixels 
                + (qbf-help:height-pixels * {&VM_OKBOX} * 2)).
/*
    FRAME qbf%one:WIDTH-PIXELS      = qbf-i. */
    
  IF pi_mode = 5 THEN 
    ASSIGN 
      FRAME qbf%one:TITLE = "Ask At Run Time Prompt":t32
      qbf-h               = {&Ask_At_Run_Time_Prompt_Dlg_Box}.    

  &if DEFINED(IDE-IS-RUNNING) = 0 &then    
  ASSIGN FRAME qbf%thr:PARENT = ACTIVE-WINDOW.
  &else  
  {adeuib/ide/dialoginit.i "FRAME qbf%one:handle}
   &endif
  /* Run time layout for button area.  This defines eff_frame_width */
  {adecomm/okrun.i  
     &FRAME = "FRAME qbf%one" 
     &BOX   = "rect_btns"
     &OK    = "qbf-ok"
     &HELP  = "qbf-help" }

  ON HELP OF FRAME qbf%one OR CHOOSE OF qbf-help IN FRAME qbf%one
    RUN adecomm/_adehelp.p (IF pi_mode = 5 THEN "res":u ELSE "comm":u, 
                            "CONTEXT":u, qbf-h, ?).

  ON WINDOW-CLOSE OF FRAME qbf%one
    APPLY "END-ERROR":u TO SELF.

  DO ON ERROR UNDO,LEAVE ON ENDKEY UNDO,LEAVE:
    v_one:WIDTH IN FRAME qbf%one = v_one:WIDTH IN FRAME qbf%one + 1.
    
     &if DEFINED(IDE-IS-RUNNING) <> 0 &then   
     &scoped-define CANCEL-EVENT U3
     {adeuib/ide/dialogstart.i qbf-ok qbf-ee WtitleConstant}
     display v_one
               WITH FRAME qbf%one.
     enable v_one qbf-ok qbf-ee qbf-help   
               WITH FRAME qbf%one.
     WAIT-FOR GO OF FRAME qbf%one or choose of qbf-ok or "{&CANCEL-EVENT}" of this-procedure focus v_one.   
     if cancelDialog then undo, leave.  
     assign FRAME qbf%one v_one.
     &undefine CANCEL-EVENT

     &else
    UPDATE
      v_one qbf-ok qbf-ee qbf-help 
      WITH FRAME qbf%one.
    &endif   
    &IF "{&DataType}" EQ "CHARACTER" &THEN
    IF v_one = ? THEN v_one = "".
    &ENDIF
    po_out = {&PackageOne}.
  END.
END.
ELSE IF pi_mode = 2 THEN DO: /*----------------------------------------*/
  ASSIGN
    v_text = (IF pi_text = ? THEN
               TRIM("Enter &Lower Bound":t40) + ":":u
             ELSE
               ENTRY(1,pi_text,CHR(10))
             )
    v_more = (IF pi_text = ? THEN
               TRIM("and &Upper Bound":t40)   + ":":u
             ELSE
               ENTRY(2,pi_text,CHR(10))
             )
    v_one                          = {&InitialValue}
    v_two                          = {&InitialValue}
    v_text:FORMAT IN FRAME qbf%two = "x(":u 
                                   + STRING(LENGTH(v_text,"RAW":U) + 1) 
                                   + ")":u
    v_more:FORMAT IN FRAME qbf%two = "x(":u 
                                   + STRING(LENGTH(v_more,"RAW":U) + 1) 
                                   + ")":u
    v_text:SCREEN-VALUE  IN FRAME qbf%two = v_text
    v_more:SCREEN-VALUE  IN FRAME qbf%two = v_more
    qbf-i                          = v_text:X IN FRAME qbf%two
                                   + MAXIMUM(
                                       v_text:WIDTH-PIXELS IN FRAME qbf%two,
                                       v_more:WIDTH-PIXELS IN FRAME qbf%two,
                                       v_one:WIDTH-PIXELS IN FRAME qbf%two + 10,
      /* This is based on the postion of the help button
      ** plus the widht of that button plus the magin expressed
      ** in PPU and then convert into pixels
      ** assumption is help button is 1 PPU high */
      qbf-help:X + qbf-help:WIDTH-PIXELS 
                 + (qbf-help:HEIGHT-PIXELS * {&VM_OKBOX} * 2)).
/*
    FRAME qbf%two:WIDTH-PIXELS     = qbf-i. */
  &if DEFINED(IDE-IS-RUNNING) = 0 &then    
  ASSIGN FRAME qbf%two:PARENT = ACTIVE-WINDOW.
  &else  
  {adeuib/ide/dialoginit.i "FRAME qbf%two:handle}
   &endif
  /* Run time layout for button area.  This defines eff_frame_width */
  {adecomm/okrun.i  
    &FRAME = "FRAME qbf%two" 
    &BOX   = "rect_btns"
    &OK    = "qbf-ok"
    &HELP  = "qbf-help" }

  ON ALT-L OF FRAME qbf%two
    APPLY "ENTRY":u TO v_one IN FRAME qbf%two.

  ON ALT-U OF FRAME qbf%two
    APPLY "ENTRY":u TO v_two IN FRAME qbf%two.

  ON HELP OF FRAME qbf%two OR CHOOSE OF qbf-help IN FRAME qbf%two 
    RUN adecomm/_adehelp.p ("comm":u, "CONTEXT":u, {&Enter_Constant_Range}, ?).

  ON WINDOW-CLOSE OF FRAME qbf%two
    APPLY "END-ERROR" TO SELF.

  DO ON ERROR UNDO,LEAVE ON ENDKEY UNDO,LEAVE:
    ASSIGN v_one:WIDTH IN FRAME qbf%two = v_one:WIDTH IN FRAME qbf%two + 1
           v_two:WIDTH IN FRAME qbf%two = v_two:WIDTH IN FRAME qbf%two + 1.
    &if DEFINED(IDE-IS-RUNNING) <> 0 &then   
     &scoped-define CANCEL-EVENT U5
     {adeuib/ide/dialogstart.i  qbf-ok qbf-ee  WtitleConstantRange}
     display v_one v_two po_Inclusive WITH FRAME qbf%two.
     enable v_one v_two po_Inclusive qbf-ok qbf-ee qbf-help WITH FRAME qbf%two.
     WAIT-FOR GO OF FRAME qbf%two or choose of qbf-ok or "{&CANCEL-EVENT}" of this-procedure focus v_one.   
     if cancelDialog then undo, leave.  
     assign FRAME qbf%two v_one  FRAME qbf%two v_two FRAME qbf%two po_Inclusive.
     &undefine CANCEL-EVENT
     &else       
    UPDATE
      v_one v_two po_Inclusive qbf-ok qbf-ee qbf-help 
      WITH FRAME qbf%two.
    &endif
    &IF "{&DataType}" EQ "CHARACTER" &THEN
    IF v_one = ? THEN v_one = "?":U.
    IF v_two = ? THEN v_two = "?":U.
    &ENDIF

    IF v_one > v_two THEN DO:
      MESSAGE "The Lower Bound may not be greater than the Upper Bound."
              VIEW-AS ALERT-BOX ERROR.
      UNDO, RETRY.
    END.
    IF NOT po_Inclusive AND v_one = v_two THEN DO:
      MESSAGE "The Lower Bound may not be equal to the Upper Bound," SKIP
              "unless inclusive is checked." VIEW-AS ALERT-BOX ERROR.
      UNDO, RETRY.
    END.
    
    ASSIGN
      po_Inclusive = IF po_Inclusive:SCREEN-VALUE IN FRAME qbf%two = "yes" 
                     THEN TRUE ELSE FALSE
      po_out       = {&PackageTwo}.
  END.
END.
ELSE DO: /*-----------------------------------------------------------------*/
  ASSIGN
/*  FRAME qbf%thr:WIDTH                = v_one:WIDTH-CHARS IN FRAME qbf%thr
                                       + 20 */
    std_fillin_bgcolor                 = IF SESSION:THREE-D THEN ? ELSE 8

    /* This is based on the position of the help button plus the width of
       that button plus the margin expressed in PPU and then converted 
       into pixels.  Assumption is help button is 1 PPU high. */
    qbf-i = MAXIMUM(
            v_text:WIDTH-PIXELS IN FRAME qbf%thr,
            v_one:WIDTH-PIXELS IN FRAME qbf%thr + 10,
            qbf-s:WIDTH-PIXELS IN FRAME qbf%thr,
            qbf-rm:X + qbf-help:WIDTH-PIXELS 
              + (qbf-help:HEIGHT-PIXELS * {&VM_OKBOX} * 2))

/*    FRAME qbf%thr:WIDTH-PIXELS         = qbf-i 
                                       + (qbf-s:X IN FRAME qbf%thr * 2) */
    v_one:FORMAT IN FRAME qbf%thr = REPLACE(v_one:FORMAT IN FRAME qbf%thr,"!":U,
                                            "X":U).

  &if DEFINED(IDE-IS-RUNNING) = 0 &then    
  ASSIGN FRAME qbf%thr:PARENT = ACTIVE-WINDOW.
  &else  
  {adeuib/ide/dialoginit.i "FRAME qbf%thr:handle}
   &endif
  /* Run time layout for button area.  This defines eff_frame_width */
  {adecomm/okrun.i  
     &FRAME = "FRAME qbf%thr" 
     &BOX   = "rect_btns"
     &OK    = "qbf-ok"
     &HELP  = "qbf-help" }

  /* do this after okrun.i, since this will realize frame qbf%thr, making
     it impossible to set three-d */
  ASSIGN
/*  qbf-s:INNER-CHARS IN FRAME qbf%thr   = v_one:WIDTH-CHARS IN FRAME qbf%thr */
    v_text                               = (IF pi_text = ? 
                                            THEN TRIM("{&Message}":t55) + ":":u 
                                            ELSE pi_text)
    v_text:FORMAT IN FRAME qbf%thr       = "x(":u 
                                         + STRING(LENGTH(v_text,"RAW":U) + 1) 
                                         + ")":u
    v_text:SCREEN-VALUE IN FRAME qbf%thr = v_text
    v_one                                = {&InitialValue}
    .

  ON HELP OF FRAME qbf%thr OR CHOOSE OF qbf-help IN FRAME qbf%thr
    RUN adecomm/_adehelp.p ("comm":u, "CONTEXT":u, {&Enter_Constants_List}, ?).

  ON WINDOW-CLOSE OF FRAME qbf%thr
    APPLY "END-ERROR" TO SELF.

  po_out = ?.
  DO ON ERROR UNDO,LEAVE ON ENDKEY UNDO,LEAVE:
    ASSIGN v_one:WIDTH IN FRAME qbf%thr = v_one:WIDTH IN FRAME qbf%thr + 1.
    
     &if DEFINED(IDE-IS-RUNNING) <> 0 &then   
      &scoped-define CANCEL-EVENT U5
     {adeuib/ide/dialogstart.i  qbf-ok qbf-ee WtitleListConstant}
     display  v_one qbf-ad qbf-ch WHEN qbf-s:SCREEN-VALUE IN FRAME qbf%thr NE ?
              qbf-rm WHEN qbf-s:SCREEN-VALUE IN FRAME qbf%thr NE ?  
              
               WITH FRAME qbf%thr.
     enable  v_one qbf-ad qbf-ch WHEN qbf-s:SCREEN-VALUE IN FRAME qbf%thr NE ?
              qbf-rm WHEN qbf-s:SCREEN-VALUE IN FRAME qbf%thr NE ?  
              qbf-s qbf-ok qbf-ee qbf-help po_Inclusive
               WITH FRAME qbf%thr.
     WAIT-FOR GO OF FRAME qbf%thr or choose of qbf-ok or "{&CANCEL-EVENT}" of this-procedure focus v_one.   
     if cancelDialog then undo, leave.  
     assign FRAME qbf%thr v_one. 
     &undefine CANCEL-EVENT
    &else
    UPDATE
      v_one qbf-ad qbf-ch WHEN qbf-s:SCREEN-VALUE IN FRAME qbf%thr NE ?
                   qbf-rm WHEN qbf-s:SCREEN-VALUE IN FRAME qbf%thr NE ? 
                   qbf-s qbf-ok qbf-ee qbf-help po_Inclusive
      WITH FRAME qbf%thr.
    &endif  
    po_out = REPLACE(po_out,",":u,CHR(10)).
  END.

  DO qbf-i = 1 TO NUM-ENTRIES(po_out,CHR(10)):
    ASSIGN
      v_one        = {&Function}(ENTRY(qbf-i,po_out,CHR(10)))
      po_Inclusive = IF po_Inclusive:SCREEN-VALUE IN FRAME qbf%thr = "yes" 
                     THEN TRUE ELSE FALSE
      ENTRY(qbf-i,po_out,CHR(10)) = {&PackageOne}.
  END.
END. /*---------------------------------------------------------------------*/

HIDE FRAME qbf%one NO-PAUSE.
HIDE FRAME qbf%two NO-PAUSE.
HIDE FRAME qbf%thr NO-PAUSE.

/*---------------------------------------------------------------------------*/
PROCEDURE is_new_value:
  DEFINE OUTPUT PARAMETER qbf_o AS LOGICAL INITIAL FALSE NO-UNDO.
  DEFINE VARIABLE qbf_v AS CHARACTER     NO-UNDO.
  DEFINE VARIABLE qbf_s AS WIDGET-HANDLE NO-UNDO.

  ASSIGN
    qbf_v = v_one:SCREEN-VALUE IN FRAME qbf%thr
    qbf_s = qbf-s:HANDLE IN FRAME qbf%thr
    qbf_o = (qbf_s:LOOKUP(qbf_v) = 0 OR qbf_s:LOOKUP(qbf_v) = ?)
            AND qbf_v <> ?
            AND qbf_v <> "".

END PROCEDURE. /* is_new_value */

/* y-const.i - end of file */

/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/
/* _y-datetime-tz.p - enter a datetime-tz literal */

{ adecomm/y-const.i
  &DefaultFormat="99/99/9999 HH:MM:SS.SSS+HH:MM"
  &DataType     ="DATETIME-TZ"
  &Message      ="Enter DateTime-Tz Value"
  &Function     ="DATETIME-TZ"
  &InitialValue ="NOW"
  &PackageOne   ="'DATETIME-TZ(' + CHR(34) + STRING(v_one,'99/99/9999 HH:MM:SS.SSS+HH:MM':u) + CHR(34) + ')'"
  &PackageTwo   ="'DATETIME-TZ(' + CHR(34) + STRING(v_one,'99/99/9999 HH:MM:SS.SSS+HH:MM':u) + CHR(34) + ')'
                + CHR(10)
                + 'DATETIME-TZ(' + CHR(34) + STRING(v_two,'99/99/9999 HH:MM:SS.SSS+HH:MM':u) + CHR(34) + ')'"
}

RETURN.

/* _y-datetime-tz.p - end of file */
/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/
/* _y-datetime.p - enter a datetime literal */

{ adecomm/y-const.i
  &DefaultFormat="99/99/9999 HH:MM:SS.SSS"
  &DataType     ="DATETIME"
  &Message      ="Enter DateTime Value"
  &Function     ="DATETIME"
  &InitialValue ="?"
  &PackageOne   ="'DATETIME(' + CHR(34) + STRING(v_one,'99/99/9999 HH:MM:SS.SSS':u) + CHR(34) + ')'"
  &PackageTwo   ="'DATETIME(' + CHR(34) + STRING(v_one,'99/99/9999 HH:MM:SS.SSS':u) + CHR(34) + ')'
                + CHR(10)
                + 'DATETIME(' + CHR(34) + STRING(v_two,'99/99/9999 HH:MM:SS.SSS':u) + CHR(34) + ')'"
}

RETURN.

/* _y-datetime.p - end of file */
/*************************************************************/
/* Copyright (c) 1984-2006,2008-2010 by Progress Software Corporation  */
/*                                                           */
/* All rights reserved.  No part of this program or document */
/* may be  reproduced in  any form  or by  any means without */
/* permission in writing from PROGRESS Software Corporation. */
/*************************************************************/
/*------------------------------------------------------------------------

  File: adecomm/_auddat.p

  Description: This program is the heart of the audit report.  It
               takes a number of input parameters, creates a 
               proDataSet with the expected audit data or client
               authentication data, then generates a file with either
               formatted text or xml. 

  Input Parameters:
      piReport    The specific report that's being run
      pcFileName  Filename to save .xml output to
      pcFilter    Filter Criterea for the selected report
      pcDbName    Logical Name of Database to report against
      plDetail    Display Detail or Summary report
      plReprint   Reuse existing data or generate it from scratch

  Output Parameters:
      <none>

  Author: Kenneth S. McIntosh

  Created: June 9,2005
  History:
      kmcintos Aug 1, 2005   Fixed a number of initial bugs with xml 
                             audit reports.
      kmcintos Aug 17, 2005  Added ELSE condition to userid check for 
                             Database Admin report 20050803-020.
      kmcintos Sep 1, 2005   Changed to use shared buffers for dataset
                             20050901-009.
      kmcintos Sept 19, 2005 Fixed client session buffer name parameter
                             passed to createDataset 20050919-006.
      kmcintos Sept 19, 2005 Added processing for events 10500-10611 
                             20050919-021.
      fernando Oct  31, 2005 Support for auditing streamed mode
      fernando Nov  03, 2005 Support for dump/load audit events                
      kmcintos Jan  03, 2006 Fixed printing bug and reformatted for readability
                             20051116-043.
      fernando Apr  10, 2006 Adjust reports - _event-detail may now be empty 20060404-014
      fernando Sep  21, 2006 Fixing issue with client session report
      fernando Aug  11, 2008 Fixing _Transaction-id format
      fernando Dec  23, 2008 Support for encryption events
      fernando Jun  18, 2009 Support for encryption events
      fernando 01/05/2010    Expanding transaction id format
------------------------------------------------------------------------*/
DEFINE INPUT  PARAMETER piReport   AS INTEGER     NO-UNDO.
DEFINE INPUT  PARAMETER pcFileName AS CHARACTER   NO-UNDO.
DEFINE INPUT  PARAMETER pcFilter   AS CHARACTER   NO-UNDO.
DEFINE INPUT  PARAMETER pcDbName   AS CHARACTER   NO-UNDO.
DEFINE INPUT  PARAMETER plDetail   AS LOGICAL     NO-UNDO.
DEFINE INPUT  PARAMETER plReprint  AS LOGICAL     NO-UNDO.

DEFINE SHARED STREAM reportStream.

DEFINE VARIABLE cLine        AS CHARACTER   NO-UNDO.
DEFINE VARIABLE gcDateFormat AS CHARACTER   NO-UNDO.
DEFINE VARIABLE gcNumSep     AS CHARACTER   NO-UNDO.
DEFINE VARIABLE gcNumDec     AS CHARACTER   NO-UNDO.
DEFINE VARIABLE i            AS INTEGER     NO-UNDO.

DEFINE VARIABLE ghDDBuff     AS HANDLE      NO-UNDO.
DEFINE VARIABLE ghAEBuff     AS HANDLE      NO-UNDO.
DEFINE VARIABLE ghADBuff     AS HANDLE      NO-UNDO.
DEFINE VARIABLE ghADVBuff    AS HANDLE      NO-UNDO.
DEFINE VARIABLE ghCSBuff     AS HANDLE      NO-UNDO.
DEFINE VARIABLE ghAPBuff     AS HANDLE      NO-UNDO.
DEFINE VARIABLE ghFileBuff   AS HANDLE      NO-UNDO.
DEFINE VARIABLE ghFieldBuff  AS HANDLE      NO-UNDO.
DEFINE VARIABLE ghIndexBuff  AS HANDLE      NO-UNDO.
DEFINE VARIABLE ghSRoleBuff  AS HANDLE      NO-UNDO.
DEFINE VARIABLE ghSGRBuff    AS HANDLE      NO-UNDO.
DEFINE VARIABLE ghUserBuff   AS HANDLE      NO-UNDO.
DEFINE VARIABLE ghAFEBuff    AS HANDLE      NO-UNDO.
DEFINE VARIABLE ghAFIBuff    AS HANDLE      NO-UNDO.
DEFINE VARIABLE ghAEVBuff    AS HANDLE      NO-UNDO.
DEFINE VARIABLE ghFilTrgBuff AS HANDLE      NO-UNDO.
DEFINE VARIABLE ghFldTrgBuff AS HANDLE      NO-UNDO.
DEFINE VARIABLE ghIdxFldBuff AS HANDLE      NO-UNDO.
DEFINE VARIABLE ghSeqBuff    AS HANDLE      NO-UNDO.
DEFINE VARIABLE ghDbOptBuff  AS HANDLE      NO-UNDO.
DEFINE VARIABLE ghDbDtlBuff  AS HANDLE      NO-UNDO.
DEFINE VARIABLE ghSecASBuff  AS HANDLE      NO-UNDO.
DEFINE VARIABLE ghSecADBuff  AS HANDLE      NO-UNDO.
DEFINE VARIABLE ghTabAuth    AS HANDLE      NO-UNDO.
DEFINE VARIABLE ghColAuth    AS HANDLE      NO-UNDO.
DEFINE VARIABLE ghSeqAuth    AS HANDLE      NO-UNDO.
DEFINE VARIABLE ghDbAuth     AS HANDLE      NO-UNDO.
DEFINE VARIABLE cTemp1       AS CHARACTER   NO-UNDO.
DEFINE VARIABLE cTemp2       AS CHARACTER   NO-UNDO.
DEFINE VARIABLE cTemp3       AS CHARACTER   NO-UNDO.

DEFINE VARIABLE glWriteXml   AS LOGICAL     NO-UNDO.
DEFINE VARIABLE glImmedDisp  AS LOGICAL     NO-UNDO.

ASSIGN gcDateFormat             = SESSION:DATE-FORMAT
       gcNumSep                 = SESSION:NUMERIC-SEPARATOR
       gcNumDec                 = SESSION:NUMERIC-DECIMAL-POINT
       SESSION:DATE-FORMAT      = "mdy"
       SESSION:NUMERIC-FORMAT   = "American"
       glImmedDisp              = SESSION:IMMEDIATE-DISPLAY.

{adecomm/aud-tts.i}
{adecomm/aud-evts.i}
{adecomm/rptvar.i}

/*=================================Forms===================================*/

/* For general long text strings.  line is formatted as appropriate. */
FORM cLine FORMAT "x(90)" NO-LABEL
  WITH FRAME reportLine NO-ATTR-SPACE DOWN WIDTH 90
                        NO-BOX USE-TEXT STREAM-IO.

FORM SKIP(1) WITH FRAME skipFrame NO-ATTR-SPACE DOWN
                                  NO-BOX USE-TEXT STREAM-IO.

FORM SKIP(1)  
     "Working on:"       VIEW-AS TEXT SKIP
     "   "               VIEW-AS TEXT 
     audData._event-name FORMAT "x(45)" 
                         NO-LABEL VIEW-AS TEXT SKIP(1)
  WITH FRAME statusFrame SIDE-LABELS VIEW-AS DIALOG-BOX
                         &IF "{&WINDOW-SYSTEM}" NE "TTY" &THEN 
                           THREE-D &ENDIF
                         TITLE "Generating Report".

FORM SKIP(1) 
     audData._audit-data-guid FORMAT "x(45)" 
                              COLON 28 
                              VIEW-AS TEXT SKIP
     audData._transaction-id  FORMAT "->>>>>>>>>9" 
                              COLON 28 
                              VIEW-AS TEXT SKIP
     audData._transaction-seq FORMAT ">>>>>ZZZ"
                              COLON 28 
                              VIEW-AS TEXT SKIP
     audData._audit-date-time FORMAT "99/99/9999 HH:MM:SS AM" 
                              COLON 28 
                              VIEW-AS TEXT SKIP
     audData._event-name      FORMAT "x(50)" 
                              COLON 28 
                              VIEW-AS TEXT SKIP
     audData._event-type      FORMAT "x(50)" 
                              COLON 28 
                              VIEW-AS TEXT SKIP
     audData._db-guid         FORMAT "x(45)" 
                              COLON 28 
                              VIEW-AS TEXT SKIP
     audData._db-description  FORMAT "x(50)" 
                              COLON 28 
                              VIEW-AS TEXT SKIP
     audData._database-connection-id
                              FORMAT "x(50)" 
                              COLON 28 
                              VIEW-AS TEXT SKIP
     audData._client-session-uuid
                              FORMAT "x(50)" 
                              COLON 28 
                              VIEW-AS TEXT SKIP
     audData._Audit-data-security-level-name
                              FORMAT "x(50)" 
                              COLON 28 
                              VIEW-AS TEXT SKIP
     audData._data-sealed     FORMAT "x(50)" 
                              COLON 28 
                              VIEW-AS TEXT SKIP
  WITH FRAME summaryFrame SIDE-LABELS STREAM-IO
                          NO-ATTR-SPACE USE-TEXT NO-BOX DOWN.

FORM audDataValue._field-name       COLON 11 SKIP
     audDataValue._data-type-name   COLON 11 SKIP
     audDataValue._old-string-value COLON 11 SKIP
     audDataValue._new-string-value COLON 11 SKIP(1)
    WITH FRAME detailFrame
               SIDE-LABELS STREAM-IO NO-ATTR-SPACE 
               NO-BOX DOWN.

/*===========================Mainline code=================================*/

glWriteXml = INDEX(pcFileName,".xml") > 0.

IF plReprint = FALSE THEN DO:

  DISPLAY "Creating secondary buffers for query..."
          @ audData._event-name
      WITH FRAME statusFrame.
      
  RUN createSecondaryBuffers ( INPUT pcDbName,
                               INPUT piReport ). 

  DISPLAY "Creating dataset..." @ audData._event-name
        WITH FRAME statusFrame.
  RUN buildDataset ( INPUT  piReport,
                     INPUT  pcFileName,
                     INPUT  pcDbName,
                     INPUT  pcFilter,
                     OUTPUT ghDataSet ).

  DISPLAY "Fetching Data..." @ audData._event-name 
      WITH FRAME statusFrame.

  ghDataSet:FILL().

END.
ELSE DO:
    /* check if we have to populate the AudDataValue table, in case we are 
       reprinting with details, and the last time we printed only summary 
       information.
         
       We do add the AudDataValue table to the dataset when printing summary 
       only, so we do read any aud-data-value records related but we do NOT 
       process the data in the _aud-audit-data._Event-detail field (which is 
       the default place for recording the audit data). Now, if we are printing
       details, we have to read ALL the data values to report them, so we need
       to read the _Event-detail, to make sure we display all the correct info.
       
       This is an unusual case (printing summary to screen and then details to 
       a file), but we allow it, and therefore we have to deal with it. This is
       so that we try not to slow down the generation of the report when we are
       only reporting summary information with the time we would spend 
       processing the _Event-detail field and creating AudDataValue records.
    */
    IF ((plDetail OR glWriteXml) /*XML is always detailed */ AND 
        VALID-HANDLE(ghDataSet) AND 
        ghDataSet:PRIVATE-DATA = "no") THEN DO:

        /* remember we are doing detail now */
        ghDataSet:PRIVATE-DATA = "yes".

        /* fill with data from the _event-detail field */
        FOR EACH bAudData NO-LOCK:
            RUN audDataValueFromEventDetail 
                ( INPUT BUFFER bAudData:HANDLE, 
                  INPUT DATASET-HANDLE ghDataSet BY-REFERENCE ).
        END.

    END.

END.

IF glWriteXml THEN DO:
  DISPLAY "Writing XML file..." @ audData._event-name
      WITH FRAME statusFrame.
  ghDataSet:WRITE-XML("FILE",pcFileName,TRUE,"UTF-8",?,TRUE,TRUE).
END.
ELSE DO:
  /* OE00125768 -don't print report if custom report to terminal
     (in which case file name is blank)
  */
  IF NOT (piReport EQ 12 AND pcFileName EQ "") THEN DO:
      DISPLAY "Building report file..." @ audData._event-name
          WITH FRAME statusFrame.
      RUN printReport.
  END.
END.

DISPLAY "Restoring default settings..." @ audData._event-name
    WITH FRAME statusFrame.
    
SESSION:DATE-FORMAT = gcDateFormat.
SESSION:SET-NUMERIC-FORMAT(gcNumSep,gcNumDec).
SESSION:IMMEDIATE-DISPLAY = glImmedDisp.

HIDE FRAME statusFrame.

RETURN "".

/*==========================Internal Procedures==============================*/

PROCEDURE printReport:
  DEFINE VARIABLE cTruncLine   AS CHARACTER   NO-UNDO.
  
  DEFINE VARIABLE iAudDataRecs AS INTEGER     NO-UNDO.
  DEFINE VARIABLE iAudDVRecs   AS INTEGER     NO-UNDO.
  
  DISPLAY STREAM reportStream WITH FRAME skipFrame.
  DISPLAY STREAM reportStream WITH FRAME skipFrame.
  
  cLine = FILL(" ",10) + FILL("*",20) + "Summary Information" +
          FILL("*",20) + FILL(" ",10).

  DISPLAY STREAM reportStream WITH FRAME skipFrame.
  IF NOT plDetail THEN DO:
    DISPLAY STREAM reportStream cLine WITH FRAME reportLine.
    DISPLAY STREAM reportStream WITH FRAME skipFrame.
  END.

  DISPLAY STREAM reportStream WITH FRAME skipFrame.
  /* display records in chronological order and by transaction id in descending order */
  FOR EACH audData NO-LOCK
      BY _audit-date-time DESC
      BY _Transaction-id DESC
      BY _Transaction-sequence DESC:
    DISPLAY "Processing event " + audData._event-name 
            @ audData._event-name
        WITH FRAME statusFrame.
    
    iAudDataRecs = iAudDataRecs + 1.
    
    DISPLAY audData._event-name WITH FRAME statusFrame.

    IF plDetail THEN DO:
      cLine = FILL(" ",10) + FILL("*",20) + "Summary Information" +
              FILL("*",20) + FILL(" ",10).

      DISPLAY STREAM reportStream cLine WITH FRAME reportLine.
      DISPLAY STREAM reportStream WITH FRAME skipFrame.
    END.

    cLine = audData._formatted-event-context.
    cTruncLine = cLine.
    DO WHILE cTruncLine NE "":
      cTruncLine = truncateLine(INPUT-OUTPUT cLine,{&DATA-WIDTH}).
      DISPLAY STREAM reportStream "   " + cTruncLine @ cLine 
          WITH FRAME reportLine.
      IF cTruncLine NE "" THEN
        DOWN STREAM reportStream WITH FRAME reportLine.
    END.
    DISPLAY STREAM reportStream WITH FRAME skipFrame.

    IF plDetail THEN DO:
      cLine = FILL(" ",10) + FILL("*",23) + "Event Details:" +
              FILL("*",22) + FILL(" ",10).
      DISPLAY STREAM reportStream cLine WITH FRAME reportLine.
      DOWN STREAM reportStream WITH FRAME reportLine.

      DISPLAY STREAM reportStream audData._audit-data-guid
                                  audData._transaction-id
                                  audData._transaction-seq
                                  audData._audit-date-time
                                  audData._event-name
                                  audData._event-type
                                  audData._db-guid
                                  audData._db-description
                                  audData._database-connection-id
                                  audData._client-session-uuid
                                  audData._Audit-data-security-level-name
                                  audData._data-sealed
            WITH FRAME summaryFrame.
      
      DISPLAY STREAM reportStream WITH FRAME skipFrame.
      
      IF CAN-FIND(FIRST audDataValue OF audData) THEN DO:
        cLine = FILL(" ",5) + FILL("*",20) + "Changed Fields" + 
                FILL("*",20) + FILL(" ",5).
        DISPLAY STREAM reportStream cLine WITH FRAME reportLine.
        DOWN STREAM reportStream WITH FRAME reportLine.
        DISPLAY STREAM reportStream WITH FRAME skipFrame.
      END.

      FOR EACH audDataValue WHERE audDataValue._audit-data-guid EQ 
                                  audData._audit-data-guid NO-LOCK:
        iAudDVRecs = iAudDVRecs + 1.
        DISPLAY STREAM reportStream audDataValue._field-name
                                    audDataValue._data-type-name
                                    audDataValue._old-string-value
                                    audDataValue._new-string-value
            WITH FRAME detailFrame.
        DISPLAY STREAM reportStream WITH FRAME skipFrame.
      END.
    END. /* If Detail Report */
    cLine = FILL("-",{&DATA-WIDTH}).
    DISPLAY STREAM reportStream cLine WITH FRAME reportLine.
    DOWN STREAM reportStream WITH FRAME reportLine.
    DISPLAY STREAM reportStream WITH FRAME skipFrame.
    
  END. /* FOR EACH audData */
  IF iAudDataRecs > 0 THEN DO:
    cLine = STRING(iAudDataRecs) + " Audit Data records processed".
    DISPLAY STREAM reportStream cLine WITH FRAME reportLine.
    DOWN STREAM reportStream WITH FRAME reportLine.
    cLine = STRING(iAudDVRecs) + " Audit Data Value records processed".
    DISPLAY STREAM reportStream cLine WITH FRAME reportLine.
    DOWN STREAM reportStream WITH FRAME reportLine.
    DISPLAY STREAM reportStream WITH FRAME skipFrame.
  END.
  ELSE DO:
    cLine = "No Audit Data records were found that match your criteria".
    DISPLAY STREAM reportStream cLine WITH FRAME reportLine.
    DOWN STREAM reportStream WITH FRAME reportLine.
  END.
  HIDE FRAME statusFrame.
END PROCEDURE.

PROCEDURE buildDataset:
  DEFINE INPUT  PARAMETER piReport   AS INTEGER     NO-UNDO.
  DEFINE INPUT  PARAMETER pcFileName AS CHARACTER   NO-UNDO.
  DEFINE INPUT  PARAMETER pcDbName   AS CHARACTER   NO-UNDO.
  DEFINE INPUT  PARAMETER pcFilter   AS CHARACTER   NO-UNDO.
  DEFINE OUTPUT PARAMETER phDataSet  AS HANDLE      NO-UNDO.

  DEFINE VARIABLE lWhere     AS LOGICAL     NO-UNDO.
  DEFINE VARIABLE lAudQry    AS LOGICAL     NO-UNDO.

  DEFINE VARIABLE iEvent     AS INTEGER     NO-UNDO.

  DEFINE VARIABLE cQuery     AS CHARACTER   NO-UNDO.
  DEFINE VARIABLE cEvent     AS CHARACTER   NO-UNDO.
  DEFINE VARIABLE cBaseQry   AS CHARACTER   NO-UNDO.
  DEFINE VARIABLE cEventList AS CHARACTER   NO-UNDO.
  DEFINE VARIABLE cTblList   AS CHARACTER   NO-UNDO
      INITIAL "bAudData,bAudDataValue".
  DEFINE VARIABLE cTopTbl    AS CHARACTER   NO-UNDO.

  DEFINE VARIABLE hQuery     AS HANDLE      NO-UNDO.
  
  ASSIGN lAudQry    = TRUE.
  CASE piReport:
    WHEN 1 THEN 
      ASSIGN cEventList = "{&AUD_POL_MNT}".
    WHEN 2 THEN 
      ASSIGN cEventList = "{&SCH_CHGS}".
    WHEN 3 THEN
      ASSIGN cEventList = "{&AUD_ARCHV}".
    WHEN 4 THEN
      ASSIGN cEventList = "{&DATA_ADMIN}".
    WHEN 5 THEN
      ASSIGN cEventList = "{&USER_MAINT}".
    WHEN 6 THEN
      ASSIGN cEventList = "{&SEC_PERM_MNT}".
    WHEN 7 THEN
      ASSIGN cEventList = "{&DBA_MAINT}".
    WHEN 8 THEN
      ASSIGN cEventList = "{&AUTH_SYS}".
    WHEN 9 THEN
        ASSIGN lAudQry    = FALSE
               cTblList   = "bClientSess".
    WHEN 10 THEN
      ASSIGN cEventList = "{&DB_ADMIN}".
    WHEN 11 THEN
      ASSIGN cEventList = "{&DB_ACCESS}".
    WHEN 13 THEN
      ASSIGN cEventList = "{&ENC_POL_MNT}".
    WHEN 14 THEN
      ASSIGN cEventList = "{&ENC_KEY_MNT}".
    WHEN 15 THEN
      ASSIGN cEventList = "{&ENC_ADMIN}".
  END CASE.

  cTopTbl   = ENTRY(1,cTblList).

  /* the code below was calling the method on the temp-table handle, but it should
     have been on the buffer-handle of the temp-table. However, table is static, so
     can use the statement instead.
  */
  EMPTY TEMP-TABLE audData NO-ERROR.
  EMPTY TEMP-TABLE audDataValue NO-ERROR.
  EMPTY TEMP-TABLE clientSess NO-ERROR.

  RUN createDataSet ( INPUT  cTblList,
                      INPUT  pcDbName,
                      INPUT  pcFilter,
                      OUTPUT phDataSet ).

  /* If this is one of the 'canned' audit queries, append the list of 
     event-ids to the query */
  IF (lAudQry = TRUE) AND
     (piReport NE 12) THEN DO: 
    /* Get the handle to the top query in the prodataset.  This serves
       the _aud-audit-data table */
    hQuery = phDataSet:GET-BUFFER-HANDLE(cTopTbl):DATA-SOURCE:QUERY.
    cBaseQry = hQuery:PREPARE-STRING.

    cQuery = ENTRY(1,cBaseQry).
    lWhere = (INDEX(cQuery,"WHERE") = 0).

    /* If the _aud-audit-data section of the query contains no 'WHERE', i.e.
       if the user didn't specify any date range criteria, add the 'WHERE' 
       up front */
    IF lWhere THEN
      cQuery = cQuery + " WHERE ".
    ELSE 
      cQuery = cQuery + " AND (".

    DO iEvent = 1 TO NUM-ENTRIES(cEventList):
      cEvent = ENTRY(iEvent,cEventList).
    
      cQuery = cQuery + 
               (IF INDEX(cEvent,"-") > 0 THEN
                  " (_event-id >= " + ENTRY(1,cEvent,"-") + " AND " +
                  "  _event-id <= " + ENTRY(2,cEvent,"-") + ")"
                ELSE 
                  " _event-id = " + cEvent) +
               (IF iEvent LT NUM-ENTRIES(cEventList) THEN 
                  " OR" 
                ELSE 
                  "").
    END.
    IF NOT lWhere THEN cQuery = cQuery + ")".
  
    ENTRY(1,cBaseQry) = cQuery.
    hQuery:QUERY-PREPARE(cBaseQry).
  END.

END PROCEDURE.

PROCEDURE createDataSet:
  DEFINE INPUT  PARAMETER pcTables  AS CHARACTER   NO-UNDO.
  DEFINE INPUT  PARAMETER pcDbName  AS CHARACTER   NO-UNDO.
  DEFINE INPUT  PARAMETER pcFilter  AS CHARACTER   NO-UNDO.
  DEFINE OUTPUT PARAMETER phDataSet AS HANDLE      NO-UNDO.

  DEFINE VARIABLE iTable        AS INTEGER     NO-UNDO.

  DEFINE VARIABLE hDataRelation AS HANDLE      NO-UNDO EXTENT 2.

  /* Individual Temp-Table buffer handles */
  DEFINE VARIABLE htADBuff      AS HANDLE      NO-UNDO.
  DEFINE VARIABLE htADVBuff     AS HANDLE      NO-UNDO.
  DEFINE VARIABLE htCSBuff      AS HANDLE      NO-UNDO.

  /* Individual DB Buffer handles - for the Data-Sources */
  DEFINE VARIABLE hADBuff       AS HANDLE      NO-UNDO.
  DEFINE VARIABLE hCSBuff       AS HANDLE      NO-UNDO EXTENT 3.
  DEFINE VARIABLE hAEBuff       AS HANDLE      NO-UNDO EXTENT 3.
  DEFINE VARIABLE hADVBuff      AS HANDLE      NO-UNDO EXTENT 3.
  DEFINE VARIABLE hDDBuff       AS HANDLE      NO-UNDO EXTENT 3.

  /* Data-Source handles*/
  DEFINE VARIABLE hClientSess   AS HANDLE      NO-UNDO.
  DEFINE VARIABLE hAudData      AS HANDLE      NO-UNDO.
  DEFINE VARIABLE hAudDataVal   AS HANDLE      NO-UNDO.

  DEFINE VARIABLE cTableHdls    AS CHARACTER   NO-UNDO.
  DEFINE VARIABLE cTable        AS CHARACTER   NO-UNDO.
  DEFINE VARIABLE cTopFilter    AS CHARACTER   NO-UNDO.

  /* Individual Data-Source Query handles */
  DEFINE VARIABLE hCSQuery      AS HANDLE      NO-UNDO.
  DEFINE VARIABLE hADQuery      AS HANDLE      NO-UNDO.
  DEFINE VARIABLE hADVQuery     AS HANDLE      NO-UNDO.

  CREATE DATASET phDataSet IN WIDGET-POOL "datasetPool".
  phDataSet:NAME = "dictRepDataSet".

  /* remember if we are doing detail mode now */
  phDataSet:PRIVATE-DATA = STRING(plDetail).

  DO iTable = 1 TO NUM-ENTRIES(pcTables):
    cTable = ENTRY(iTable,pcTables).
    CASE cTable:
      WHEN "bAudData" THEN DO:
        htADBuff = BUFFER bAudData:HANDLE.
        phDataSet:ADD-BUFFER(htADBuff).

        /* If the query begins with WHERE it came from the custom filter
           in which case it's already formatted */
        IF pcFilter BEGINS "WHERE" OR pcFilter EQ "" THEN
          cTopFilter = " " + pcFilter.
        ELSE
          cTopFilter = (IF pcFilter EQ "All" THEN 
                          "" 
                        ELSE
                          " WHERE (DATE(_aud-audit-data._audit-date-time) >= " +
                          ENTRY(1,pcFilter)                                   + 
                          " AND DATE(_aud-audit-data._audit-date-time) <= "  +
                          ENTRY(2,pcFilter) + ") ").
        
        CREATE DATA-SOURCE hAudData IN WIDGET-POOL "datasetPool".

        CREATE BUFFER hADBuff    FOR TABLE pcDbName + "._aud-audit-data"
                                         IN WIDGET-POOL "datasetPool". 
        CREATE BUFFER hDDBuff[1] FOR TABLE pcDbName + "._db-detail"
                                         IN WIDGET-POOL "datasetPool".
        CREATE BUFFER hCSBuff[1] FOR TABLE pcDbName + "._client-session"
                                         IN WIDGET-POOL "datasetPool".
        CREATE BUFFER hAEBuff[1] FOR TABLE pcDbName + "._aud-event"
                                         IN WIDGET-POOL "datasetPool".

        hAudData:ADD-SOURCE-BUFFER(hADBuff,"_audit-data-guid").
        hAudData:ADD-SOURCE-BUFFER(hDDBuff[1],"_db-guid").
        hAudData:ADD-SOURCE-BUFFER(hCSBuff[1],"_client-session-uuid").
        hAudData:ADD-SOURCE-BUFFER(hAEBuff[1],"_event-id").

        htADBuff:ATTACH-DATA-SOURCE(hAudData,
                                    "_db-detail._db-description,_db-description," +
                                    "_client-session._client-name,_client-name," +
                                    "_aud-event._event-description,_event-description," +
                                    "_aud-event._event-name,_event-name," + 
                                    "_aud-event._event-type,_event-type").
        CREATE QUERY hADQuery IN WIDGET-POOL "datasetPool".
        hADQuery:SET-BUFFERS(hADBuff,
                             hDDBuff[1],
                             hCSBuff[1],
                             hAEBuff[1]).
        hAudData:QUERY = hADQuery.
        hADQuery:PRIVATE-DATA = 
            "FOR EACH _aud-audit-data" + cTopFilter + ", "   +
            "FIRST _db-detail OUTER-JOIN "                   +
            "WHERE _db-detail._db-guid EQ "                  +
            "_aud-audit-data._db-guid, "                     +
            "FIRST _client-session OUTER-JOIN "              + 
            "WHERE _client-session._client-session-uuid EQ " +
            "_aud-audit-data._client-session-uuid, "         +
            "FIRST _aud-event OUTER-JOIN "                   +
            "WHERE _aud-event._event-id EQ "                 +
            "_aud-audit-data._event-id SHARE-LOCK "          +
            "BY _audit-date-time "                           + 
            "BY _transaction-id "                            +
            "BY _transaction-sequence".
        hADQuery:QUERY-PREPARE(hADQuery:PRIVATE-DATA).

        /* Setup Callback Procedures */
        htADBuff:SET-CALLBACK-PROCEDURE("AFTER-ROW-FILL",
                                        "audDataAfterRowFill",
                                        THIS-PROCEDURE).
      END.
      WHEN "bAudDataValue" THEN DO:

        htADVBuff = BUFFER bAudDataValue:HANDLE.
        phDataSet:ADD-BUFFER(htADVBuff).

        IF iTable > 1 THEN DO:
          hDataRelation[1] = phDataSet:ADD-RELATION(htADBuff,htADVBuff,
                                                    "_audit-data-guid,_audit-data-guid").
          hDataRelation[1]:NESTED = TRUE.
        END.

        CREATE DATA-SOURCE hAudDataVal IN WIDGET-POOL "datasetPool".

        CREATE BUFFER hADVBuff[1] FOR TABLE pcDbName + 
                                            "._aud-audit-data-value"
                                            IN WIDGET-POOL "datasetPool".
        hAudDataVal:ADD-SOURCE-BUFFER(hADVBuff[1],"_audit-data-guid").
        htADVBuff:ATTACH-DATA-SOURCE(hAudDataVal).

        CREATE QUERY hADVQuery IN WIDGET-POOL "datasetPool".
        hADVQuery:SET-BUFFERS(hADVBuff[1]).
        hAudDataVal:QUERY = hADVQuery.

        hADVQuery:PRIVATE-DATA = "FOR EACH _aud-audit-data-value SHARE-LOCK " +
                                 "WHERE _aud-audit-data-value._audit-data-guid EQ " +
                                 "bAudData._audit-data-guid".
        hADVQuery:QUERY-PREPARE(hADVQuery:PRIVATE-DATA).

        /* Setup Callback Procedures */
        htADVBuff:SET-CALLBACK-PROCEDURE("AFTER-ROW-FILL",
                                        "audDataValueAfterRowFill",
                                        THIS-PROCEDURE).
      END.
      WHEN "bClientSess" THEN DO:
        htCSBuff = BUFFER bClientSess:HANDLE.
        phDataSet:ADD-BUFFER(htCSBuff).
        
        cTopFilter = (IF pcFilter EQ "All" THEN 
                        "" 
                      ELSE
                        " WHERE (DATE(_client-session._auth-date-time) >= " +
                        ENTRY(1,pcFilter)                                   + 
                        " AND DATE(_client-session._auth-date-time) <= "  +
                        ENTRY(2,pcFilter) + ") ").

        IF iTable > 1 THEN DO:
          hDataRelation[2] = phDataSet:ADD-RELATION(htADBuff,htCSBuff,
                                                    "_client-session-uuid," +
                                                    "_client-session-uuid").
          hDataRelation[2]:NESTED = TRUE.

        END.

        CREATE DATA-SOURCE hClientSess IN WIDGET-POOL "datasetPool".

        CREATE BUFFER hCSBuff[2] FOR TABLE pcDbName + 
                                           "._client-session"
                                           IN WIDGET-POOL "datasetPool".
        CREATE BUFFER hDDBuff[2] FOR TABLE pcDbName + 
                                           "._db-detail"
                                           IN WIDGET-POOL "datasetPool".

        hClientSess:ADD-SOURCE-BUFFER(hCSBuff[2],"_client-session-uuid").
        hClientSess:ADD-SOURCE-BUFFER(hDDBuff[2],"_db-guid").
        htCSBuff:ATTACH-DATA-SOURCE(hClientSess,
                                    "_db-detail._db-description,_db-description").

        CREATE QUERY hCSQuery IN WIDGET-POOL "datasetPool".
        hCSQuery:SET-BUFFERS(hCSBuff[2],
                             hDDBuff[2]).
        hClientSess:QUERY = hCSQuery.

        IF iTable > 1 THEN
          hCSQuery:PRIVATE-DATA = "FOR EACH _client-session " +
                                  "WHERE _client-session._client-session-uuid EQ " +
                                  "bAudData._client-session-uuid, " +
                                  "FIRST _db-detail OUTER-JOIN " +
                                  "WHERE _db-detail._db-guid EQ " +
                                  "_client-session._db-guid " +
                                  "SHARE-LOCK".
        ELSE
          hCSQuery:PRIVATE-DATA = "FOR EACH _client-session SHARE-LOCK " + 
                                  cTopFilter + "," +
                                  "FIRST _db-detail OUTER-JOIN " +
                                  "WHERE _db-detail._db-guid EQ " +
                                  "_client-session._db-guid " +
                                  "SHARE-LOCK".
                                  
        hCSQuery:QUERY-PREPARE(hCSQuery:PRIVATE-DATA).

        /* Setup Callback Procedures */
        htCSBuff:SET-CALLBACK-PROCEDURE("AFTER-ROW-FILL",
                                        "clientSessAfterRowFill",
                                        THIS-PROCEDURE).
      END.
    END CASE.
  END.
END PROCEDURE.

PROCEDURE clientSessAfterRowFill:
  DEFINE INPUT PARAMETER DATASET-HANDLE phDataSet.

  DEFINE VARIABLE hCSBuff    AS HANDLE      NO-UNDO.
  DEFINE VARIABLE hDDBuff    AS HANDLE      NO-UNDO.

  DEFINE VARIABLE iSecLevel  AS INTEGER     NO-UNDO.

  hCSBuff = phDataSet:GET-BUFFER-HANDLE("bClientSess").

  iSecLevel = INTEGER(hCSBuff::_audit-data-security-level).
  
  IF hCSBuff::_db-description EQ ? OR
     hCSBuff::_db-description EQ "" THEN
    hCSBuff::_db-description = "Original database not available".

  CASE iSecLevel:
    WHEN 1 THEN
      hCSBuff::_audit-data-security-level-name = "Message Digest".
    WHEN 2 THEN
      hCSBuff::_audit-data-security-level-name = "DB Passkey".
    OTHERWISE
      hCSBuff::_audit-data-security-level-name = "No Additional Security".
  END CASE.
END PROCEDURE.

PROCEDURE audDataAfterRowFill:
  DEFINE INPUT PARAMETER DATASET-HANDLE phDataSet.

  DEFINE VARIABLE iSecLevel   AS INTEGER     NO-UNDO.
  DEFINE VARIABLE iEntry      AS INTEGER     NO-UNDO.
  
  DEFINE VARIABLE cEventId    AS CHARACTER   NO-UNDO.
  DEFINE VARIABLE cContext    AS CHARACTER   NO-UNDO.
  DEFINE VARIABLE cAudTbl     AS CHARACTER   NO-UNDO.
  DEFINE VARIABLE cGuid       AS CHARACTER   NO-UNDO.
  DEFINE VARIABLE cAppTbl     AS CHARACTER   NO-UNDO.
  DEFINE VARIABLE cAppFld     AS CHARACTER   NO-UNDO.
  DEFINE VARIABLE cEvtId      AS CHARACTER   NO-UNDO.
  DEFINE VARIABLE cPolName    AS CHARACTER   NO-UNDO.
  DEFINE VARIABLE cRunOpt     AS CHARACTER   NO-UNDO.
  DEFINE VARIABLE cCommand    AS CHARACTER   NO-UNDO.
  DEFINE VARIABLE cEntity     AS CHARACTER   NO-UNDO.
  DEFINE VARIABLE cToEntity   AS CHARACTER   NO-UNDO.
  DEFINE VARIABLE cUser       AS CHARACTER   NO-UNDO.
  DEFINE VARIABLE cVerb       AS CHARACTER   NO-UNDO.
  DEFINE VARIABLE cOwner      AS CHARACTER   NO-UNDO.
  DEFINE VARIABLE cEvent      AS CHARACTER   NO-UNDO.
  DEFINE VARIABLE cIndex      AS CHARACTER   NO-UNDO.
  DEFINE VARIABLE cRole       AS CHARACTER   NO-UNDO.
  DEFINE VARIABLE cRoleDesc   AS CHARACTER   NO-UNDO.
  DEFINE VARIABLE cGrantee    AS CHARACTER   NO-UNDO.
  DEFINE VARIABLE cGrantor    AS CHARACTER   NO-UNDO.
  DEFINE VARIABLE cSeqName    AS CHARACTER   NO-UNDO.
  DEFINE VARIABLE cUserId     AS CHARACTER   NO-UNDO.
  DEFINE VARIABLE cTable      AS CHARACTER   NO-UNDO.
  DEFINE VARIABLE cPerm       AS CHARACTER   NO-UNDO.
  DEFINE VARIABLE cOption     AS CHARACTER   NO-UNDO.
  DEFINE VARIABLE cType       AS CHARACTER   NO-UNDO.
  
  DEFINE VARIABLE hADBuff     AS HANDLE      NO-UNDO.
  DEFINE VARIABLE hDBBuff     AS HANDLE      NO-UNDO.
  
  DEFINE VARIABLE lPolName    AS LOGICAL     NO-UNDO.

  hADBuff = phDataSet:GET-BUFFER-HANDLE("bAudData").
  hDBBuff = hADBuff:DATA-SOURCE:GET-SOURCE-BUFFER(1).

  iSecLevel = INTEGER(hADBuff::_audit-data-security-level).
  
  CASE iSecLevel:
    WHEN 1 THEN
      hADBuff::_audit-data-security-level-name = "Message Digest".
    WHEN 2 THEN
      hADBuff::_audit-data-security-level-name = "DB Passkey".
    OTHERWISE
      hADBuff::_audit-data-security-level-name = "No Additional Security".
  END CASE.

  hADBuff::_data-sealed = (hDBBuff::_data-seal NE "" AND 
                           hDBBuff::_data-seal NE ?).
     
  /* Need to find the context and event group records and populate the
     fields for these. These are recursive joins back on the same table */

  /* read context if any exists */
  IF hADBuff::_Application-context-id <> "" THEN DO:
    ghADBuff:FIND-FIRST("WHERE _audit-data-guid = ~'" +
                        hADBuff::_Application-context-id + "~'",
                        NO-LOCK) NO-ERROR.
    IF ghADBuff:AVAILABLE THEN
      hADBuff::_application-context-summary = ghADBuff::_Event-context.
  END.

  /* read audit event group if any exists */
  IF hADBuff::_audit-event-group <> "" THEN DO:
    ghADBuff:FIND-FIRST("WHERE _audit-data-guid = ~'" +
                          hADBuff::_audit-event-group + "~'",
                        NO-LOCK) NO-ERROR.
    IF ghADBuff:AVAILABLE THEN
      hADBuff::_audit-event-group-name = ghADBuff::_Event-context.
  END.

  /* Need to nicely re-format event context for more meaningful display
     on a report this is just a sample - custom code is required to handle
     the various known context formats */
  ASSIGN cEventId = STRING(hADBuff::_event-id)
         cUserId  = (IF hADBuff::_user-id NE "" AND 
                         hADBuff::_user-id NE ? THEN 
                        " by " + hADBuff::_user-id ELSE "").

  /* these may error out */
  ASSIGN cContext = ENTRY(2,hADBuff::_event-context,CHR(6))
         cTable   = ENTRY(1,hADBuff::_Event-context,CHR(6)) NO-ERROR.

  /* Default to same as unformatted event context for cases where hit
     an unknown format */
  CASE cEventId:
    WHEN "100" THEN DO: /* _user create */
      IF (ENTRY(1,cContext,CHR(7)) > "?") = TRUE THEN DO:
        cContext = ENTRY(1,cContext,CHR(7)) NO-ERROR.
        ghUserBuff:FIND-BY-ROWID(TO-ROWID(cContext),
                                 NO-LOCK) NO-ERROR.
        IF ghUserBuff:AVAILABLE THEN
          cContext = " for " + ghUserBuff::_userid.
        ELSE cContext = "".
      END.
      ELSE cContext = "".

      hADBuff::_formatted-event-context = 
            "New User Record created" + cContext + cUserId.
    END.
    WHEN "101" THEN /* _user update */
      hADBuff::_formatted-event-context = 
            "User account for " + cContext +
            " modified" + cUserId NO-ERROR.
    WHEN "102" THEN /* _user delete */
      hADBuff::_formatted-event-context = 
            "User " + cContext +
            " deleted" + cUserId NO-ERROR.
    WHEN "210" THEN /* sql grant dba */
      hADBuff::_formatted-event-context = 
            "SQL user " + cContext +
            " granted DBA" + cUserId NO-ERROR.
    WHEN "211" THEN /* sql dba updated */
      hADBuff::_formatted-event-context = 
            "SQL user " + cContext +
            "'s DBA permissions modified" + cUserId NO-ERROR.
    WHEN "212" THEN /* sql revoke dba */
      hADBuff::_formatted-event-context = 
            "SQL user " + cContext +
            "'s DBA permissions revoked" + cUserId NO-ERROR.
    WHEN "300" THEN DO: /* Audit policy create _aud-audit-policy or
                                               _aud-file-policy  or
                                               _aud-field-policy or
                                               _aud-event-policy record */
      cTable = ENTRY(NUM-ENTRIES(cTable,"."),cTable,".").
      CASE cTable:
        WHEN "_aud-audit-policy"  THEN DO: /* Create Audit Policy */
          cAudTbl = "Audit Policy".
          IF (ENTRY(1,cContext,CHR(7)) > "?") = TRUE THEN DO:
            cContext = ENTRY(1,cContext,CHR(7)) NO-ERROR.
            
            ghAPBuff:FIND-BY-ROWID(TO-ROWID(cContext),NO-LOCK) NO-ERROR.
            IF ghAPBuff:AVAILABLE THEN
              cContext = " ~"" + ghAPBuff::_audit-policy-name + "~" ".
            ELSE cContext = " record ".
          END.
          ELSE cContext = " record ".
        END. /* Create Audit Policy */
        WHEN "_aud-file-policy" THEN DO: /* Create Table Policy */
          cAudTbl = "Table Policy".
          IF (ENTRY(1,cContext,CHR(7)) > "?") = TRUE THEN DO:
            cContext = ENTRY(1,cContext,CHR(7)) NO-ERROR.
            
            ghAFIBuff:FIND-BY-ROWID(TO-ROWID(cContext),NO-LOCK) NO-ERROR.
            IF ghAFIBuff:AVAILABLE THEN DO:
              cContext = " for table ~"" + ghAFIBuff::_owner + "." +
                         ghAFIBuff::_file-name + "~" ".
              ghAPBuff:FIND-FIRST("WHERE _audit-policy-guid EQ ~'" +
                                  ghAFIBuff::_audit-policy-guid + "~'",
                                  NO-LOCK) NO-ERROR.
              IF ghAPBuff:AVAILABLE THEN
                cPolName = ", in policy ~"" + ghAPBuff::_audit-policy-name + 
                           "~"" + (IF cUserId NE "" THEN ", " ELSE " ").
              ELSE cPolName = " (Audit Policy GUID=~"" + 
                              ghAFIBuff::_audit-policy-guid + "~") ".
            END.
            ELSE cContext = " record ".
          END.
          ELSE cContext = " record ".
        END. /* Create Table Policy */
        WHEN "_aud-field-policy" THEN DO:  /* Create Field Policy */
          cAudTbl = "Field Policy".
          IF (ENTRY(1,cContext,CHR(7)) > "?") = TRUE THEN DO:
            cContext = ENTRY(1,cContext,CHR(7)) NO-ERROR.
            
            ghAFEBuff:FIND-BY-ROWID(TO-ROWID(cContext),NO-LOCK) NO-ERROR.
            IF ghAFEBuff:AVAILABLE THEN DO:
              cContext = " for field ~"" + ghAFEBuff::_file-name + "." +
                         ghAFEBuff::_field-name + "~" ".
              ghAPBuff:FIND-FIRST("WHERE _audit-policy-guid EQ ~'" +
                                  ghAFEBuff::_audit-policy-guid + "~'",
                                  NO-LOCK) NO-ERROR.
              IF ghAPBuff:AVAILABLE THEN
                cPolName = ", in policy ~"" + 
                           ghAPBuff::_audit-policy-name + "~"" +
                           (IF cUserId NE "" THEN ", " ELSE " ").
              ELSE cPolName = " (Audit Policy GUID=~"" + 
                              ghAFEBuff::_audit-policy-guid + "~") ".
            END.
            ELSE cContext = " record ".
          END.
          ELSE cContext = " record ".
        END.  /* Create Field Policy */
        WHEN "_aud-event-policy" THEN DO:  /* Create Event Policy */
          cAudTbl = "Event Policy".
          IF (ENTRY(1,cContext,CHR(7)) > "?") = TRUE THEN DO:
            cContext = ENTRY(1,cContext,CHR(7)) NO-ERROR.
            
            ghAEVBuff:FIND-BY-ROWID(TO-ROWID(cContext),NO-LOCK) NO-ERROR.
            IF ghAEVBuff:AVAILABLE THEN DO:
              ghAEBuff:FIND-FIRST("WHERE _event-id EQ " + 
                                  STRING(ghAEVBuff::_event-id),
                                  NO-LOCK) NO-ERROR.
              IF ghAEBuff:AVAILABLE THEN
                cEvent = ghAEBuff::_event-name.
              ELSE cEvent = STRING(ghAEVBuff::_event-id).

              cContext = " for event ~"" + cEvent + "~" ".
              ghAPBuff:FIND-FIRST("WHERE _audit-policy-guid EQ ~'" +
                                  ghAFEBuff::_audit-policy-guid + "~'",
                                  NO-LOCK) NO-ERROR.
              IF ghAPBuff:AVAILABLE THEN
                cPolName = ", in policy ~"" + 
                           ghAPBuff::_audit-policy-name + "~"" +
                           (IF cUserId NE "" THEN ", " ELSE " ").
              ELSE cPolName = " (Audit Policy GUID=~"" + 
                              ghAFIBuff::_audit-policy-guid + "~") ".
            END.
            ELSE cContext = " record ".
          END.
          ELSE cContext = " record ".
        END.  /* Create Event Policy */
      END CASE.
        
      hADBuff::_formatted-event-context = 
          cAudTbl + cContext + "created" + cPolName + cUserId.
    END. /* Audit policy table create events */
    WHEN "301" THEN DO: /* Modify record in audit policy type table */
      cTable = ENTRY(NUM-ENTRIES(cTable,"."),cTable,".").

      CASE cTable:
        WHEN "_aud-audit-policy" THEN DO: /* Modify Audit Policy */
          cPolName = ENTRY(1,cContext,CHR(7)) NO-ERROR.
          cContext = "Audit Policy ~"" + cPolName + "~" modified".
        END. /* Modify Audit Policy */
        WHEN "_aud-file-policy" THEN DO: /* Modify File Policy */
          ASSIGN cAppTbl  = ENTRY(3,cContext,CHR(7)) + "." + 
                            ENTRY(2,cContext,CHR(7))
                 cGuid = ENTRY(1,cContext,CHR(7)) NO-ERROR.

          ghAPBuff:FIND-FIRST("WHERE _audit-policy-guid = ~'" +
                              cGuid + "~'",NO-LOCK) NO-ERROR.
          IF ghAPBuff:AVAILABLE THEN
            cPolName = ", in policy ~"" + 
                       ghAPBuff::_audit-policy-name + "~", ".
          ELSE cPolName = " (Audit Policy GUID=~"" + cGuid + "~") ".

          cContext = "Table Policy for ~"" + cAppTbl + "~"" + 
                     cPolName + "modified".
        END. /* Modify File Policy */
        WHEN "_aud-field-policy" THEN DO:  /* Modify Field Policy */
          ASSIGN cAppTbl  = ENTRY(3,cContext,CHR(7)) + "." + 
                            ENTRY(2,cContext,CHR(7))
                 cAppFld  = ENTRY(4,cContext,CHR(7))
                 cGuid = ENTRY(1,cContext,CHR(7)) NO-ERROR.

          ghAPBuff:FIND-FIRST("WHERE _audit-policy-guid = ~'" +
                              cGuid + "~'",NO-LOCK) NO-ERROR.
          IF ghAPBuff:AVAILABLE THEN
            cPolName = ", in policy ~"" + 
                       ghAPBuff::_audit-policy-name + "~", ".
          ELSE cPolName = " (Audit Policy GUID=~"" + cGuid + "~") ".

          cContext = "Field Policy for ~"" + cAppTbl + "." + 
                     cAppFld + "~"" + cPolName + "modified".
        END.  /* Modify Field Policy */
        WHEN "_aud-event-policy" THEN DO: /* Modify Event Policy */
          ASSIGN cGuid    = ENTRY(1,cContext,CHR(7))
                 cEventId = ENTRY(2,cContext,CHR(7)) NO-ERROR.

          ghAEBuff:FIND-FIRST("WHERE _event-id = " + cEventId,
                              NO-LOCK) NO-ERROR.
          ghAPBuff:FIND-FIRST("WHERE _audit-policy-guid = ~'" +
                              cGuid + "~'",NO-LOCK) NO-ERROR.

          IF ghAPBuff:AVAILABLE THEN
            cPolName = ", in policy ~"" + 
                       ghAPBuff::_audit-policy-name + "~", ".
          ELSE cPolName = " (Audit Policy GUID=~"" + cGuid + "~") ".

          cContext = "Event Policy for audit event ~"" +
                     (IF ghAEBuff:AVAILABLE THEN ghAEBuff::_event-name
                      ELSE cEventId) + "~"" + cPolName + "modified".
        END. /* Modify Event Policy */
      END CASE.

      hADBuff::_formatted-event-context = cContext + cUserId.
    END. /* Modify record in audit policy type table */
    WHEN "302" THEN DO: /* Delete record from audit policy type table */
      cTable = ENTRY(NUM-ENTRIES(cTable,"."),cTable,".").

      CASE cTable:
        WHEN "_aud-audit-policy" THEN /* Delete Audit Policy */
          cContext = "Audit Policy ~"" + ENTRY(1,cContext,CHR(7)) +
                     "~" deleted".
        WHEN "_aud-file-policy" THEN DO: /* Delete File Policy */
          ASSIGN cAppTbl  = ENTRY(3,cContext,CHR(7)) + "." + 
                            ENTRY(2,cContext,CHR(7))
                 cGuid = ENTRY(1,cContext,CHR(7)).

          ghAPBuff:FIND-FIRST("WHERE _audit-policy-guid = ~'" +
                              cGuid + "~'",NO-LOCK) NO-ERROR.
          IF ghAPBuff:AVAILABLE THEN
            ASSIGN lPolName = TRUE 
                   cPolName = " from policy ~"" + 
                              ghAPBuff::_audit-policy-name + "~"".
          ELSE cPolName = " (Audit Policy GUID=~"" + cGuid + "~")".

          cContext = "Table Policy for ~"" + cAppTbl + "~"" + 
                     (IF NOT lPolName THEN cPolName ELSE "" ) + " deleted".
        END. /* Delete File Policy */
        WHEN "_aud-field-policy" THEN DO: /* Delete Field Policy */
          ASSIGN cAppTbl  = ENTRY(3,cContext,CHR(7)) + "." + 
                            ENTRY(2,cContext,CHR(7))
                 cAppFld  = ENTRY(4,cContext,CHR(7))
                 cGuid    = ENTRY(1,cContext,CHR(7)) NO-ERROR.

          ghAPBuff:FIND-FIRST("WHERE _audit-policy-guid = ~'" +
                              cGuid + "~'",NO-LOCK) NO-ERROR.
          IF ghAPBuff:AVAILABLE THEN
            ASSIGN lPolName = TRUE 
                   cPolName = " from policy ~"" + 
                              ghAPBuff::_audit-policy-name + "~"".
          ELSE cPolName = " (Audit Policy GUID=~"" + cGuid + "~")".

          cContext = "Field Policy for ~"" + cAppTbl + "." +
                     cAppFld + "~"" + 
                     (IF NOT lPolName THEN cPolName ELSE "" ) + " deleted".
        END. /* Delete Field Policy */
        WHEN "_aud-event-policy" THEN DO: /* Delete Event Policy */
          ASSIGN cGuid = ENTRY(1,cContext,CHR(7))
                 cEventId = ENTRY(2,cContext,CHR(7)) NO-ERROR.

          ghAEBuff:FIND-FIRST("WHERE _event-id = " + cEventId,
                              NO-LOCK) NO-ERROR.
          ghAPBuff:FIND-FIRST("WHERE _audit-policy-guid = ~'" +
                              cGuid + "~'",NO-LOCK) NO-ERROR.

          IF ghAPBuff:AVAILABLE THEN
            ASSIGN lPolName = TRUE 
                   cPolName = " from policy ~"" + 
                              ghAPBuff::_audit-policy-name + "~"".
          ELSE cPolName = " (Audit Policy GUID=~"" + cGuid + "~")".

          cContext = "Event Policy for audit event ~"" +
                     (IF ghAEBuff:AVAILABLE THEN ghAEBuff::_event-name
                      ELSE cEventId) + "~"" + 
                     (IF NOT lPolName THEN cPolName ELSE "" ) + " deleted".
        END.  /* Delete Event Policy */
      END CASE.

      hADBuff::_formatted-event-context = 
          cContext + (IF lPolName THEN cPolName ELSE "" ) + cUserId.
    END. /* Delete record from audit policy type table */
    WHEN "400" THEN DO: /* SQL Table Privilege Created */
      IF (ENTRY(1,cContext,CHR(7)) > "?") = TRUE THEN DO:
        cContext = ENTRY(1,cContext,CHR(7)) NO-ERROR.
         
        ghTabAuth:FIND-BY-ROWID(TO-ROWID(cContext),NO-LOCK) NO-ERROR.
        IF ghTabAuth:AVAILABLE THEN
          cContext = " granted to " + ghTabAuth::_grantee + 
                     " for table " + ghTabAuth::_tblowner + "." +
                     ghTabAuth::_tbl + 
                     (IF ghTabAuth::_grantor > "" THEN 
                        " by " + ghTabAuth::_grantor 
                      ELSE cUserId).
      END.
      ELSE cContext = " created" + cUserId.

      hADBuff::_formatted-event-context = 
           "SQL Table privilege" + cContext.
    END.
    WHEN "401" THEN DO: /* SQL Table Privilege Modified */
      IF (ENTRY(1,cContext,CHR(7)) > "?") = TRUE THEN DO:
        ASSIGN cAppTbl  = ENTRY(1,cContext,CHR(7)) + "." +
                          ENTRY(2,cContext,CHR(7))
               cGrantee = ENTRY(3,cContext,CHR(7)) NO-ERROR.

        cContext = cGrantee + "~'s SQL Table privilege, for table " +
                   cAppTbl + ", modified".
      END.
      ELSE cContext = "SQL Table privilege modified".

      hADBuff::_formatted-event-context = cContext + cUserId.
    END.
    WHEN "402" THEN DO: /* SQL Table Privilege Deleted */
      IF (ENTRY(1,cContext,CHR(7)) > "?") = TRUE THEN DO:
        ASSIGN cAppTbl  = ENTRY(1,cContext,CHR(7)) + "." +
                          ENTRY(2,cContext,CHR(7))
               cGrantee = ENTRY(3,cContext,CHR(7)) NO-ERROR.
        
        cContext = cGrantee + "~'s SQL Table privilege, for table " +
                   cAppTbl + ", revoked".
      END.
      ELSE cContext = "SQL Table privilege revoked".

      hADBuff::_formatted-event-context = cContext + cUserId.
    END.
    WHEN "410" THEN DO: /* SQL Column Privilege Created */
      IF (ENTRY(1,cContext,CHR(7)) > "?") = TRUE THEN DO:
        cContext = ENTRY(1,cContext,CHR(7)) NO-ERROR.
         
        ghColAuth:FIND-BY-ROWID(TO-ROWID(cContext),NO-LOCK) NO-ERROR.
        IF ghColAuth:AVAILABLE THEN
          cContext = " granted to " + ghColAuth::_grantee + 
                     " for column " + ghColAuth::_tblowner + "." +
                     ghColAuth::_tbl + "." + ghColAuth::_col +
                     (IF ghColAuth::_grantor > "" THEN 
                        " by " + ghColAuth::_grantor 
                      ELSE cUserId).
      END.
      ELSE cContext = " created" + cUserId.

      hADBuff::_formatted-event-context = 
           "SQL Column privilege" + cContext. 
    END.
    WHEN "411" THEN DO: /* SQL Column Privilege Modified */
      IF (ENTRY(1,cContext,CHR(7)) > "?") = TRUE THEN DO:
        ASSIGN cAppFld  = ENTRY(1,cContext,CHR(7)) + "." +
                          ENTRY(2,cContext,CHR(7)) + "." +
                          ENTRY(3,cContext,CHR(7))
               cGrantee = ENTRY(4,cContext,CHR(7)) NO-ERROR.

        cContext = cGrantee + "~'s SQL Column privilege, for column " +
                   cAppFld + ", modified".
      END.
      ELSE cContext = "SQL Column privilege modified".

      hADBuff::_formatted-event-context = cContext + cUserId.
    END.
    WHEN "412" THEN DO: /* SQL Column Privilege Deleted */
      IF (ENTRY(1,cContext,CHR(7)) > "?") = TRUE THEN DO:
        ASSIGN cAppFld  = ENTRY(1,cContext,CHR(7)) + "." +
                          ENTRY(2,cContext,CHR(7)) + "." + 
                          ENTRY(3,cContext,CHR(7))
               cGrantee = ENTRY(4,cContext,CHR(7)) NO-ERROR.
        
        cContext = cGrantee + "~'s SQL Column privilege, for column " +
                   cAppFld + ", revoked".
      END.
      ELSE cContext = "SQL Column privilege revoked".

      hADBuff::_formatted-event-context = cContext + cUserId.
    END.
    WHEN "420" THEN DO: /* SQL Sequence Privilege Created */
      IF (ENTRY(1,cContext,CHR(7)) > "?") = TRUE THEN DO:
        cContext = ENTRY(1,cContext,CHR(7)) NO-ERROR.
         
        ghSeqAuth:FIND-BY-ROWID(TO-ROWID(cContext),NO-LOCK) NO-ERROR.
        IF ghSeqAuth:AVAILABLE THEN
          cContext = " granted to " + ghSeqAuth::_grantee + 
                     " for sequence " + ghSeqAuth::_Seqowner + "." +
                     ghSeqAuth::_seq-name +
                     (IF ghSeqAuth::_grantor > "" THEN 
                        " by " + ghSeqAuth::_grantor 
                      ELSE cUserId).
      END.
      ELSE cContext = " created" + cUserId.

      hADBuff::_formatted-event-context = 
           "SQL Sequence privilege" + cContext. 
    END.
    WHEN "421" THEN DO: /* SQL Sequence Privilege Modified */
      IF (ENTRY(1,cContext,CHR(7)) > "?") = TRUE THEN DO:
        ASSIGN cSeqName = ENTRY(1,cContext,CHR(7)) + "." +
                          ENTRY(2,cContext,CHR(7)) + "."
               cGrantee = ENTRY(3,cContext,CHR(7)) NO-ERROR.

        cContext = cGrantee + "~'s SQL Sequence privilege, for sequence " +
                   cSeqName + ", modified".
      END.
      ELSE cContext = "SQL Sequence privilege modified".

      hADBuff::_formatted-event-context = cContext + cUserId.
    END.
    WHEN "422" THEN /* SQL Sequence Privilege Deleted */
      hADBuff::_formatted-event-context = hADBuff::_event-context.
    WHEN "500" THEN DO: /* Create _sec-authentication-system */
      IF (ENTRY(1,cContext,CHR(7)) > "?") = TRUE THEN DO:

        cContext = ENTRY(1,cContext,CHR(7)).
        ghSecASBuff:FIND-BY-ROWID(TO-ROWID(cContext),NO-LOCK) NO-ERROR.
        IF ghSecASBuff:AVAILABLE THEN
          cContext = "Security Authentication System, with Domain Type ~"" +
                     ghSecASBuff::_domain-type + "~:, created".
        ELSE cContext = "Security Authentication System created".
      END.
      ELSE cContext = "Security Authentication System created".

      hADBuff::_formatted-event-context = cContext + cUserId.
    END. /* Create _sec-authentication-system */
    WHEN "501" THEN DO: /* Update _sec-authentication-system */
      cContext = "Security Authentication System " +
                 cContext + " has been modified".

      hADBuff::_formatted-event-context = cContext + cUserId.
    END. /* Update _sec-authentication-system */
    WHEN "502" THEN DO: /* Delete _sec-authentication-system */
      cContext = "Security Authentication System " +
                 cContext + " has been deleted".

      hADBuff::_formatted-event-context = cContext + cUserId.
    END.
    WHEN "505" THEN DO: /* Create _sec-authentication-domain */
      IF (ENTRY(1,cContext,CHR(7)) > "?") = TRUE THEN DO:
        cContext = ENTRY(1,cContext,CHR(7)).
        ghSecADBuff:FIND-BY-ROWID(TO-ROWID(cContext),NO-LOCK) NO-ERROR.
        IF ghSecADBuff:AVAILABLE THEN
          cContext = "Security Authentication Domain " +
                     ghSecADBuff::_domain-name + " created".
        ELSE cContext = "Security Authentication Domain created".
      END.
      ELSE cContext = "Security Authentication Domain created".

      hADBuff::_formatted-event-context = cContext + cUserId.
    END. /* Create _sec-authentication-domain */
    WHEN "506" THEN DO: /* Update _sec-authentication-domain */
      cContext = "Security Authentication Domain " +
                 cContext + " has been modified".

      hADBuff::_formatted-event-context = cContext + cUserId.
    END. /* Update _sec-authentication-domain */
    WHEN "507" THEN DO: /* Delete _sec-authentication-domain */
      cContext = "Security Authentication Domain " +
                 cContext + " has been deleted".

      hADBuff::_formatted-event-context = cContext + cUserId.
    END. /* Delete _sec-authentication-domain */
    WHEN "510" THEN DO: /* Create security role record 
                           (_sec-role) Not Implemented */
      IF (ENTRY(1,cContext,CHR(7)) > "?") = TRUE THEN DO:
        cContext = ENTRY(1,cContext,CHR(7)) NO-ERROR.

        ghSRoleBuff:FIND-BY-ROWID(TO-ROWID(cContext),NO-LOCK) NO-ERROR.
        IF ghSRoleBuff:AVAILABLE THEN
          cContext = "New Security Role ~"" + ghSRoleBuff::_role-description +
                     "~" (" + ghSRoleBuff::_role-name + ") created".
        ELSE cContext = "New Security Role Created".
      END.
      ELSE cContext = "New Security Role Created".

      hADBuff::_formatted-event-context = cContext + cUserId.
    END. /* Create security role record */
    WHEN "511" THEN DO: /* Update security role record 
                           (_sec-role) Not Implemented */
      cRole = cContext NO-ERROR.
             
      ghSRoleBuff:FIND-FIRST("WHERE _role-name = ~"" +
                             cRole + "~"",NO-LOCK) NO-ERROR.
      IF ghSRoleBuff:AVAILABLE THEN
        cRoleDesc = "~"" + ghSRoleBuff::_role-description + 
                    "~" (" + cRole + ") ".
      ELSE 
        cRoleDesc = "~"" + cRole + "~"".
        
      hADBuff::_formatted-event-context = 
          "Role " + cRoleDesc + " modified" + cUserId.
    END. /* Update security role record */
    WHEN "512" THEN DO: /* Delete security role record 
                           (_sec-role) Not Implemented */
      hADBuff::_formatted-event-context = 
        "Role ~"" + cRole + "~" " + "deleted" + cUserId.
    END. /* Delete security role record */
    WHEN "515" THEN DO: /* Create security permissions record 
                           (_sec-granted-role) */
      IF (ENTRY(1,cContext,CHR(7)) > "?") = TRUE THEN DO:
        cContext = ENTRY(1,cContext,CHR(7)) NO-ERROR.

        ghSGRBuff:FIND-BY-ROWID(TO-ROWID(cContext),NO-LOCK) NO-ERROR.
        IF ghSGRBuff:AVAILABLE THEN DO:
          ghSRoleBuff:FIND-FIRST("WHERE _role-name EQ ~"" +
                                 ghSGRBuff::_role-name + "~"",NO-LOCK) NO-ERROR.
          IF ghSRoleBuff:AVAILABLE THEN
            cPerm = ghSRoleBuff::_role-description + " (" + 
                    ghSRoleBuff::_role-name + ")".
          ELSE cPerm = ghSGRBuff::_role-name.

          cContext = cPerm + " granted to " + ghSGRBuff::_grantee + 
                     " by " + ghSGRBuff::_grantor.
        END.
        ELSE cContext = "New permission record created" + cUserId.
      END.
      ELSE cContext = "New permission record created" + cUserId.
      hADBuff::_formatted-event-context = cContext.
    END. /* Create security permissions record  */
    WHEN "516" THEN DO: /* Update security permissions record 
                           (_sec-granted-role) */
      ASSIGN cRole    = ENTRY(1,cContext,CHR(7))
             cGrantee = ENTRY(2,cContext,CHR(7))
             cGrantor = ENTRY(3,cContext,CHR(7)) NO-ERROR.
             
      ghSRoleBuff:FIND-FIRST("WHERE _role-name = ~'" +
                             cRole + "~'",NO-LOCK) NO-ERROR.
      IF ghSRoleBuff:AVAILABLE THEN
        cRoleDesc = "~"" + ghSRoleBuff::_role-description + 
                    "~" (" + cRole + ") ".
      ELSE cRole.

      hADBuff::_formatted-event-context = 
          cGrantee + "~'s " + cRoleDesc + 
          " permission (Granted by: " + cGrantor + 
          ") has been modified" + cUserId.
    END. /* Update security permissions record */
    WHEN "517" THEN DO: /* Delete security permissions record 
                           (_sec-granted-role) */
      ASSIGN cRole    = ENTRY(1,cContext,CHR(7))
             cGrantee = ENTRY(2,cContext,CHR(7))
             cGrantor = ENTRY(3,cContext,CHR(7)) NO-ERROR.
             
      ghSRoleBuff:FIND-FIRST("WHERE _role-name = ~'" +
                             cRole + "~'",NO-LOCK) NO-ERROR.
      IF ghSRoleBuff:AVAILABLE THEN
        cRoleDesc = "~"" + ghSRoleBuff::_role-description + 
                    "~" (" + cRole + ") ".
      ELSE cRole.

      hADBuff::_formatted-event-context = 
          cGrantee + "~'s " + cRoleDesc + 
          " permission (Granted by: " + cGrantor + 
          ") has been revoked" + cUserId.
    END. /* Delete security permissions record */
    WHEN "5000" THEN DO: /* Schema - Create DB Table */
      cOwner   = ENTRY(2,cContext,CHR(7)) NO-ERROR.
      IF (ENTRY(1,cContext,CHR(7)) > "?") = TRUE THEN DO:
        cContext = ENTRY(1,cContext,CHR(7)) NO-ERROR.
        
        ghFileBuff:FIND-BY-ROWID(TO-ROWID(cContext),NO-LOCK) NO-ERROR.
        IF ghFileBuff:AVAILABLE THEN
          cContext = "Table " + ghFileBuff::_owner + "." +
                     ghFileBuff::_file-name + " created".
        ELSE cContext = "New table created".
      END.
      ELSE cContext = "New table created".

      hADBuff::_formatted-event-context = cContext + cUserId.
    END. /* Create DB Table */
    WHEN "5001" THEN DO: /* Schema - Create Table Trigger */
      IF (ENTRY(1,cContext,CHR(7)) > "?") = TRUE THEN DO:
        cContext = ENTRY(1,cContext,CHR(7)) NO-ERROR.

        ghFilTrgBuff:FIND-BY-ROWID(TO-ROWID(cContext),NO-LOCK) NO-ERROR.
        IF ghFilTrgBuff:AVAILABLE THEN DO:
          ghFileBuff:FIND-FIRST("WHERE RECID(_file) EQ " +
                                STRING(ghFilTrgBuff::_file-recid),
                                NO-LOCK) NO-ERROR.
          IF ghFileBuff:AVAILABLE THEN
            cAppTbl = " for table " + ghFileBuff::_owner + "." +
                      ghFileBuff::_file-name.
          ELSE cAppTbl = " (Table RECID=~"" + 
                         STRING(ghFilTrgBuff::_file-recid) + "~")".

          cContext = ghFilTrgBuff::_event + " trigger added to table" + 
                     cAppTbl.
        END.
        ELSE cContext = "New table trigger created".
      END.
      ELSE cContext = "New table trigger created".

      hADBuff::_formatted-event-context = cContext + cUserId.
    END. /* Create Table Trigger */
    WHEN "5002" THEN DO: /* Schema - Create Table Field */
      IF (ENTRY(1,cContext,CHR(7)) > "?") = TRUE THEN DO:
        cContext = ENTRY(1,cContext,CHR(7)) NO-ERROR.

        ghFieldBuff:FIND-BY-ROWID(TO-ROWID(cContext),NO-LOCK) NO-ERROR.
        IF ghFieldBuff:AVAILABLE THEN DO:
          ghFileBuff:FIND-FIRST("WHERE RECID(_file) EQ " +
                                STRING(ghFieldBuff::_file-recid),
                                NO-LOCK) NO-ERROR.
          IF ghFileBuff:AVAILABLE THEN
            cAppTbl = ghFileBuff::_owner + "." +
                      ghFileBuff::_file-name.
          ELSE cAppTbl = "(Table RECID=~"" + 
                         STRING(ghFieldBuff::_file-recid) + "~")".

          cContext = "Field ~"" + ghFieldBuff::_field-name + 
                     "~" created in table " + cAppTbl.
        END.
        ELSE cContext = "New field created".
      END.
      ELSE cContext = "New field created".

      hADBuff::_formatted-event-context = cContext + cUserId.
    END. /* Create Table Field */
    WHEN "5003" THEN DO: /* Schema - Create Field Trigger */
      IF (ENTRY(1,cContext,CHR(7)) > "?") = TRUE THEN DO:
        cContext = ENTRY(1,cContext,CHR(7)) NO-ERROR.

        ghFldTrgBuff:FIND-BY-ROWID(TO-ROWID(cContext),NO-LOCK) NO-ERROR.
        IF ghFldTrgBuff:AVAILABLE THEN DO:
          ghFieldBuff:FIND-FIRST("WHERE RECID(_field) EQ " +
                                 STRING(ghFldTrgBuff::_field-recid),
                                 NO-LOCK) NO-ERROR.
          IF ghFieldBuff:AVAILABLE THEN DO:
            ghFileBuff:FIND-FIRST("WHERE RECID(_file) EQ " +
                                  STRING(ghFieldBuff::_file-recid),
                                  NO-LOCK) NO-ERROR.
            IF ghFileBuff:AVAILABLE THEN
              cAppFld = ghFileBuff::_owner + "." + 
                        ghFileBuff::_file-name + "." + 
                        ghFieldBuff::_field-name.
            ELSE cAppFld = ghFieldBuff::_field-name + 
                           " in table (Table RECID=~"" + 
                           STRING(ghFieldBuff::_file-recid) + "~")".
          END. /* Field record still exists */
          ELSE cAppFld = " (Field RECID=~"" + 
                         STRING(ghFldTrgBuff::_field-recid) + "~") ".

          cContext = ghFldTrgBuff::_event + " trigger added for field " + 
                     cAppFld.
        END. /* Field Trigger record still exists */
        ELSE cContext = "New field trigger added for field (Field ROWID=~"" +
                        cContext + "~")".
      END. /* Context info available */
      ELSE cContext = "New field trigger created".

      hADBuff::_formatted-event-context = cContext + cUserId.
    END. /* Create Field Trigger */
    WHEN "5004" THEN DO: /* Schema - Create Table Index */
      IF (ENTRY(1,cContext,CHR(7)) > "?") = TRUE THEN DO:
        cContext = ENTRY(1,cContext,CHR(7)) NO-ERROR.

        ghIndexBuff:FIND-BY-ROWID(TO-ROWID(cContext),NO-LOCK) NO-ERROR.
        IF ghIndexBuff:AVAILABLE THEN DO:
          ghFileBuff:FIND-FIRST("WHERE RECID(_file) EQ " +
                                STRING(ghIndexBuff::_file-recid),
                                NO-LOCK) NO-ERROR.
          cIndex = ghFileBuff::_owner + "." + ghFileBuff::_file-name + "." +
                   ghIndexBuff::_index-name.
          cContext = "Index " + cIndex + " created".
        END.
        ELSE cContext = "New index (Index ROWID=~"" +
                        cContext + "~") created".
      END.
      ELSE cContext = "New index created".

      hADBuff::_formatted-event-context = cContext + cUserId.
    END. /* Create Table Index */
    WHEN "5005" THEN DO: /* Schema - Add Field to Index */
      IF (ENTRY(1,cContext,CHR(7)) > "?") = TRUE THEN DO:
        cContext = ENTRY(1,cContext,CHR(7)) NO-ERROR.

        ghIdxFldBuff:FIND-BY-ROWID(TO-ROWID(cContext),NO-LOCK) NO-ERROR.
        IF ghIdxFldBuff:AVAILABLE THEN DO:
          ghIndexBuff:FIND-FIRST("WHERE RECID(_index) EQ " +
                                STRING(ghIdxFldBuff::_index-recid),
                                NO-LOCK) NO-ERROR.
          IF ghIndexBuff:AVAILABLE THEN DO:
            ghFileBuff:FIND-FIRST("WHERE RECID(_file) EQ " +
                                  STRING(ghIndexBuff::_file-recid),
                                  NO-LOCK) NO-ERROR.
            cIndex = ghFileBuff::_owner + "." +
                     ghFileBuff::_file-name + "." +
                     ghIndexBuff::_index-name.
          END.
          ELSE cIndex = "(Index RECID=~"" + 
                        STRING(ghIdxFldBuff::_index-recid) + "~")".

          ghFieldBuff:FIND-FIRST("WHERE RECID(_field) EQ " +
                                 STRING(ghIdxFldBuff::_field-recid),
                                 NO-LOCK) NO-ERROR.
          IF ghFieldBuff:AVAILABLE THEN
            cAppFld = ghFieldBuff::_field-name.
          ELSE DO: 
            IF cIndex BEGINS "(" THEN
              ASSIGN cIndex  = RIGHT-TRIM(cIndex,")") + ", Field RECID=~"" +
                               STRING(ghIdxFldBuff::_field-recid) + "~")"
                     cAppFld = "".
            ELSE 
              cAppFld = " (Field RECID=~"" + 
                        STRING(ghIdxFldBuff::_field-recid) + "~") ".
          END.

          cContext = "Index field" + cAppFld + "added to index " + cIndex.
        END.
        ELSE cContext = "New index field added (Index-Field ROWID=~"" +
                        cContext + "~")".
      END.
      ELSE cContext = "New index field added".

      hADBuff::_formatted-event-context = cContext + cUserId.
    END. /* Add Field to Index */
    WHEN "5010" THEN DO: /* Schema - Modify DB Table */
      ASSIGN cAppTbl  = ENTRY(1,cContext,CHR(7))
             cOwner   = ENTRY(2,cContext,CHR(7)) NO-ERROR.

      hADBuff::_formatted-event-context = 
        "Table " + cOwner + "." + cAppTbl + " modified" + cUserId.
    END. /* Modify DB Table */
    WHEN "5011" THEN DO: /* Schema - Modify Table Trigger  */
      ASSIGN cAppTbl  = ENTRY(1,cContext,CHR(7))
             cEvent   = ENTRY(2,cContext,CHR(7)) NO-ERROR.

      ghFileBuff:FIND-FIRST("WHERE RECID(_file) EQ " + cAppTbl,
                            NO-LOCK) NO-ERROR.
      IF ghFileBuff:AVAILABLE THEN
        cAppTbl = ghFileBuff::_owner + "." + 
                  ghFileBuff::_file-name.
      ELSE cAppTbl = "(Table RECID=~"" + cAppTbl + "~")".

      hADBuff::_formatted-event-context = 
        cEvent + " trigger, for table " + cAppTbl + ", modified" + cUserId.
    END. /* Modify Table Trigger  */
    WHEN "5012" THEN DO: /* Schema - Modify Table Field */
      ASSIGN cAppTbl  = ENTRY(1,cContext,CHR(7))
             cAppFld  = ENTRY(2,cContext,CHR(7)) NO-ERROR.

      ghFileBuff:FIND-FIRST("WHERE RECID(_file) EQ " + cAppTbl,
                            NO-LOCK) NO-ERROR.
      IF ghFileBuff:AVAILABLE THEN
        cAppFld = ghFileBuff::_owner + "." + 
                  ghFileBuff::_file-name + "." +
                  cAppFld.
      ELSE cAppFld = cAppFld + ", in table (Table RECID=~"" + cAppTbl + "~"),".

      hADBuff::_formatted-event-context = 
        "Field " + cAppFld + " modified" + cUserId.
    END. /* Modify Table Field */
    WHEN "5013" THEN DO: /* Schema - Modify Field Trigger */
      ASSIGN cAppTbl  = ENTRY(1,cContext,CHR(7))
             cAppFld  = ENTRY(2,cContext,CHR(7))
             cEvent   = ENTRY(3,cContext,CHR(7)) NO-ERROR.

      ghFieldBuff:FIND-FIRST("WHERE RECID(_field) EQ " + cAppFld,
                             NO-LOCK) NO-ERROR.
      IF ghFieldBuff:AVAILABLE THEN DO:
        ghFileBuff:FIND-FIRST("WHERE RECID(_file) EQ " + cAppTbl,
                              NO-LOCK) NO-ERROR.
        cAppFld = ghFileBuff::_owner + "." + ghFileBuff::_file-name + 
                  "." + ghFieldBuff::_field-name.
      END.
      ELSE cAppFld = "(Table RECID=~"" + cAppTbl + "~", Field RECID=~"" +
                     cAppFld + "~")".
      
      hADBuff::_formatted-event-context = 
        cEvent + " field trigger for field " + cAppFld + " modified" + cUserId.
    END. /* Modify Field Trigger */
    WHEN "5014" THEN DO: /* Schema - Modify Table Index */
      ASSIGN cAppTbl  = ENTRY(1,cContext,CHR(7))
             cIndex   = ENTRY(2,cContext,CHR(7)) NO-ERROR.

      ghFileBuff:FIND-FIRST("WHERE RECID(_file) EQ " + cAppTbl,
                            NO-LOCK) NO-ERROR.
      IF ghFileBuff:AVAILABLE THEN
        cIndex  = ghFileBuff::_owner + "." + 
                  ghFileBuff::_file-name + "." + cIndex.
      ELSE cIndex = cIndex + ", in table (Table RECID=~"" + cAppTbl + "~"),".

      hADBuff::_formatted-event-context = 
        "Index " + cIndex + " modified" + cUserId.
    END. /* Modify Table Index */
    WHEN "5015" THEN DO: /* Schema - Modify Index Field */
      ASSIGN cIndex   = ENTRY(1,cContext,CHR(7))
             cAppFld  = ENTRY(2,cContext,CHR(7)) NO-ERROR.

      ghIndexBuff:FIND-FIRST("WHERE RECID(_index) EQ " + cIndex,
                             NO-LOCK) NO-ERROR.
      IF ghIndexBuff:AVAILABLE THEN DO:
        ghFileBuff:FIND-FIRST("WHERE RECID(_file) EQ " +
                              STRING(ghIndexBuff::_file-recid),NO-LOCK)
                             NO-ERROR.
        cIndex = ghFileBuff::_owner + "." + 
                 ghFileBuff::_file-name + 
                 "." + ghIndexBuff::_index-name.
      END.
      ELSE cIndex  = "(Index RECID=~"" + cIndex + "~")".

      ghFieldBuff:FIND-FIRST("WHERE RECID(_field) EQ " + cAppFld,
                             NO-LOCK) NO-ERROR.
      IF ghFieldBuff:AVAILABLE THEN
        cAppFld = ghFieldBuff::_field-name.
      ELSE DO:
        IF cIndex BEGINS "(" THEN
          ASSIGN cIndex  = RIGHT-TRIM(cIndex,")") + 
                           ", Field RECID=~"" + cAppFld + ")"
                 cAppFld = "".
        ELSE cAppFld = "(Field RECID=~"" + cAppFld + "~")".
      END.
      hADBuff::_formatted-event-context = 
        "Index Field " + cAppFld + ", in index " + cIndex + 
        ", modified" + cUserId.
    END. /* Modify Index Field */
    WHEN "5020" THEN DO: /* Schema - Delete DB Table */
      ASSIGN cAppTbl  = ENTRY(1,cContext,CHR(7))
             cOwner   = ENTRY(2,cContext,CHR(7)) NO-ERROR.

      hADBuff::_formatted-event-context = 
        "Table " + cOwner + "." + cAppTbl + " deleted" + cUserId.
    END. /* Delete DB Table */
    WHEN "5021" THEN DO: /* Schema - Delete Table Trigger */
      ASSIGN cAppTbl  = ENTRY(1,cContext,CHR(7))
             cEvent   = ENTRY(2,cContext,CHR(7)) NO-ERROR.

      ghFileBuff:FIND-FIRST("WHERE RECID(_file) EQ " + cAppTbl,
                            NO-LOCK) NO-ERROR.
      IF ghFileBuff:AVAILABLE THEN
        cAppTbl = ghFileBuff::_owner + "." + 
                  ghFileBuff::_file-name.
      ELSE cAppTbl = "(Table RECID=~"" + cAppTbl + "~")".
      
      hADBuff::_formatted-event-context = 
        cEvent + " table trigger, for table " + cAppTbl + ", deleted" + 
        cUserId.
    END. /* Delete Table Trigger */
    WHEN "5022" THEN DO: /* Schema - Delete Table Field */
      ASSIGN cAppTbl  = ENTRY(1,cContext,CHR(7))
             cAppFld  = ENTRY(2,cContext,CHR(7)) NO-ERROR.

      ghFileBuff:FIND-FIRST("WHERE RECID(_file) EQ " + cAppTbl,
                            NO-LOCK) NO-ERROR.
      IF ghFileBuff:AVAILABLE THEN
        ASSIGN cAppFld = ghFileBuff::_owner + "." + ghFileBuff::_file-name + 
                         cAppFld
               cAppTbl = "".
      ELSE cAppTbl = " from table (Table RECID=~"" + cAppTbl + "~")".

      hADBuff::_formatted-event-context = 
        "Field " + cAppFld + " deleted" + cAppTbl + cUserId.
    END. /* Delete Table Field */
    WHEN "5023" THEN DO: /* Schema - Delete Field Trigger */
      ASSIGN cAppTbl = ENTRY(1,cContext,CHR(7))
             cAppFld = ENTRY(2,cContext,CHR(7))
             cEvent  = ENTRY(3,cContext,CHR(7)) NO-ERROR.

      ghFieldBuff:FIND-FIRST("WHERE RECID(_field) EQ " + cAppFld,
                             NO-LOCK) NO-ERROR.
      ghFileBuff:FIND-FIRST("WHERE RECID(_file) EQ " + cAppTbl,
                            NO-LOCK) NO-ERROR.
      IF ghFileBuff:AVAILABLE THEN DO:
        IF ghFieldBuff:AVAILABLE THEN
          cAppFld = ghFileBuff::_owner + "." + 
                    ghFileBuff::_file-name + "." + 
                    ghFieldBuff::_field-name + ", ".
        ELSE
          cAppFld = "(Field RECID=~"" + cAppFld + "~"), in table " + 
                    ghFileBuff::_owner + "." + ghFileBuff::_file-name.
      END.
      ELSE
        cAppFld = "(Table RECID=~"" + cAppTbl + "~", Field RECID=~"" +
                  cAppFld + "~")".

      hADBuff::_formatted-event-context = 
        cEvent + " field trigger, for field " + cAppFld + ", deleted" + 
        cUserId.
    END. /* Delete Field Trigger */
    WHEN "5024" THEN DO: /* Schema - Delete Table Index */
      ASSIGN cAppTbl  = ENTRY(1,cContext,CHR(7))
             cIndex   = ENTRY(2,cContext,CHR(7)) NO-ERROR.

      ghFileBuff:FIND-FIRST("WHERE RECID(_file) EQ " + cAppTbl,
                            NO-LOCK) NO-ERROR.
      IF ghFileBuff:AVAILABLE THEN
        ASSIGN cIndex  = ghFileBuff::_owner + "." + ghFileBuff::_file-name + 
                         "." + cIndex
               cAppTbl = "".
      ELSE cAppTbl = " from table (Table RECID=~"" + cAppTbl + "~")".

      hADBuff::_formatted-event-context = 
        "Index " + cIndex + " deleted" + cAppTbl + cUserId.
    END. /* Delete Table Index */
    WHEN "5025" THEN DO: /* Schema - Delete Index Field */
      ASSIGN cIndex   = ENTRY(1,cContext,CHR(7))
             cAppFld  = ENTRY(2,cContext,CHR(7)) NO-ERROR.

      ghIndexBuff:FIND-FIRST("WHERE RECID(_index) EQ " + cIndex,
                             NO-LOCK) NO-ERROR.
      IF ghIndexBuff:AVAILABLE THEN DO:
        ghFileBuff:FIND-FIRST("WHERE RECID(_file) EQ " +
                              STRING(ghIndexBuff::_file-recid),NO-LOCK)
                             NO-ERROR.
        IF ghFileBuff:AVAILABLE THEN
          cIndex = ghFileBuff::_owner + "." + 
                   ghFileBuff::_file-name + "." + 
                   ghIndexBuff::_index-name.
        ELSE cIndex = ghIndexBuff::_index-name + 
                      " (Table RECID=~"" + 
                      STRING(ghIndexBuff::_file-recid) + "~")".
      END.
      ELSE
        cIndex = "(Index RECID=~"" + cIndex + "~")".

      ghFieldBuff:FIND-FIRST("WHERE RECID(_field) EQ " + cAppFld,
                             NO-LOCK) NO-ERROR.
      IF ghFieldBuff:AVAILABLE THEN
        cAppFld = ghFieldBuff::_field-name.
      ELSE cAppFld = "(Field RECID=~"" + cAppFld + "~")".

      hADBuff::_formatted-event-context = 
        "Index Field " + cAppFld + " removed from index " + cIndex + cUserId.
    END. /* Delete Index Field */
    WHEN "5030" THEN DO: /* Schema - Create DB Sequence */
      IF (ENTRY(1,cContext,CHR(7)) > "?") = TRUE THEN DO:
        cContext = ENTRY(1,cContext,CHR(7)) NO-ERROR.

        ghSeqBuff:FIND-BY-ROWID(TO-ROWID(cContext),NO-LOCK) NO-ERROR.
        IF ghSeqBuff:AVAILABLE THEN
          cContext = "New Sequence ~"" + ghSeqBuff::_seq-owner + "." +
                     ghSeqBuff::_seq-name + "~" created".
        ELSE cContext = "New Sequence created".
      END.
      ELSE cContext = "New Sequence created".

      hADBuff::_formatted-event-context = cContext + cUserId.
    END.
    WHEN "5031" THEN DO: /* Schema - Modify DB Sequence */
      ghSeqBuff:FIND-FIRST("WHERE _seq-name EQ ~'" +
                           cContext,NO-LOCK) NO-ERROR.
      IF ghSeqBuff:AVAILABLE THEN
        cContext = ghSeqBuff::_seq-owner + "." + ghSeqBuff::_seq-name.
      
      hADBuff::_formatted-event-context = 
        "Sequence " + cContext + " modified" + cUserId.
    END.
    WHEN "5032" THEN /* Schema - Delete DB Sequence */
      hADBuff::_formatted-event-context = 
        "Sequence " + cContext + " deleted" + cUserId.
    WHEN "5040" THEN DO: /* Schema - DB Property Created */
      IF (ENTRY(1,cContext,CHR(7)) > "?") = TRUE THEN DO:
        cContext = ENTRY(1,cContext,CHR(7)) NO-ERROR.

        IF cTable EQ "PUB._db-option" OR
           cTable EQ "_db-option" THEN DO:
          ghDbOptBuff:FIND-BY-ROWID(TO-ROWID(cContext),NO-LOCK) NO-ERROR.
          IF ghDbOptBuff:AVAILABLE THEN
            cContext = "Database option ~"" + ghDbOptBuff::_db-option-code +
                       "~" added (Option Type: " + 
                       STRING(ghDbOptBuff::_db-option-type) + ")".
          ELSE cContext = "New Database Option added".
        END.
        ELSE DO:
          ghDbDtlBuff:FIND-BY-ROWID(TO-ROWID(cContext),NO-LOCK) NO-ERROR.
          IF ghDbDtlBuff:AVAILABLE THEN
            cContext = "New Database Identification record created, with " +
                       "database identifier ~"" + ghDbDtlBuff::_db-guid +
                       "~" (DB Passkey Assigned: " +
                       (IF STRING(ghDbDtlBuff::_db-mac-key) NE "020000" THEN 
                          "Yes" ELSE "No") + ")".
          ELSE cContext = "New Database Identification record created".
        END.
      END.
      ELSE IF cTable EQ "PUB._db-option" OR
              cTable EQ "_db-option" THEN
        cContext = "New Database Option added".
      ELSE cContext = "New Database Identification record created".

      hADBuff::_formatted-event-context = cContext + cUserId.
    END.
    WHEN "5041" THEN DO: /* Schema - DB Property Updated */
      IF cTable EQ "PUB._db-option" OR
         cTable EQ "_db-option" THEN DO:
        ASSIGN cType   = ENTRY(1,cContext,CHR(7)) 
               cOption = ENTRY(2,cContext,CHR(7)) NO-ERROR.

        IF cType EQ "1" THEN
          cContext = "Auditing Option " + cOption + " has been modified".
        ELSE IF cType EQ "2" THEN
          cContext = "Security Option " + cOption + " has been modified".
        ELSE 
          cContext = "Database Option " + cOption + " (Option Type: " +
                     cType + ") has been modified".
        
      END.
      ELSE DO:
        ASSIGN cGuid    = cContext
               cContext = "Database Identification record, with DB " +
                          "Identifier ~"" + cGuid + "~", has been modified".

        ghDbDtlBuff:FIND-FIRST("WHERE _db-guid = ~'" +
                               cGuid + "~'",NO-LOCK) NO-ERROR.
        IF ghDbDtlBuff:AVAILABLE THEN
          cContext = cContext + " (DB Passkey Assigned: " +
                     (IF STRING(ghDbDtlBuff::_db-mac-key) NE "020000" THEN 
                        "Yes" ELSE "No") + ")".
      END.
        
      hADBuff::_formatted-event-context = cContext + cUserId.
    END.
    WHEN "10000" THEN DO: /* Enable Auditing */
      cRunOpt = unQuote(hADBuff::_event-detail,
                        "~"").
      
      ASSIGN cUser = (IF hADBuff::_user-id NE "" THEN hADBuff::_user-id
                      ELSE (IF INDEX(cRunOpt,"-U") > 0 THEN
                              ENTRY(LOOKUP("-U",cRunOpt," ") + 1,cRunOpt," ")
                              ELSE ""))
             cUser = (IF cUser NE "" THEN " by " ELSE "") + cUser.

      hADBuff::_formatted-event-context = 
         "Auditing Enabled for " + ENTRY(2,cRunOpt," ") + cUser.
    END.
    WHEN "10001" THEN DO: /* Disable Auditing */
      cRunOpt = unQuote(hADBuff::_event-detail,
                        "~"").
      
      ASSIGN cUser = (IF hADBuff::_user-id NE "" THEN hADBuff::_user-id
                      ELSE (IF INDEX(cRunOpt,"-U") > 0 THEN
                              ENTRY(LOOKUP("-U",cRunOpt," ") + 1,cRunOpt," ")
                              ELSE ""))
             cUser = (IF cUser NE "" THEN " by " ELSE "") + cUser.

      hADBuff::_formatted-event-context = 
         "Auditing Disabled for " + ENTRY(2,cRunOpt," ") + cUser.
    END.
    WHEN "10010" THEN /* Commit Audit Policy Changes */
      hADBuff::_formatted-event-context = 
          "Audit Policy changes committed".
    WHEN "10100" OR /* Start DB - _mprosrv */
    WHEN "10101"    /* Stop DB - _mprshut */ THEN DO:
        
        /* detail info may be empty, in which case, we have nothing to add other than the event itself */
        IF hADBuff::_event-detail = "" THEN DO:
            IF cEventId EQ "10100"  THEN
                cRunOpt = "Started".
            ELSE
                cRunOpt = "Shut down".

            hADBuff::_formatted-event-context = "Database " + cRunOpt.

        END.
        ELSE DO:
        
              cRunOpt = unQuote(hADBuff::_event-detail, "~"").

              IF cEventId EQ "10101" THEN
                 hADBuff::_formatted-event-context = "Database " + cRunOpt.
              ELSE DO:
        
                     hADBuff::_formatted-event-context = "Database " + ENTRY(1, cRunOpt, ".").
                  
                     ASSIGN i = INDEX (cRunOpt, ".")
                                  hADBuff::_formatted-event-context = hADBuff::_formatted-event-context +
                                            ", with effective parameters " + QUOTER (TRIM(SUBSTRING(cRunOpt, i + 2))).
              END.
        END.
    END.
    WHEN "10202" OR /* Binary Dump - proutil dump */
    WHEN "10203" OR /* Binary Load - proutil load */
    WHEN "10205" OR /* Table Move - proutil tablemove */ 
    WHEN "10206" OR /* Index Move - proutil idxmove */
    WHEN "10208" OR /* Index Rebuild - proutil idxbuild */
    WHEN "10209"    /* Area Truncate - proutil truncate area */ THEN DO:
      cRunOpt = formatCommandLine(hADBuff::_event-detail).

      cUser = (IF hADBuff::_user-id NE "" THEN hADBuff::_user-id
               ELSE (IF INDEX(cRunOpt,"-U") > 0 THEN
                       ENTRY(LOOKUP("-U",cRunOpt," ") + 1,cRunOpt," ")
                     ELSE "")).

      IF cEventId EQ "10202" OR
         cEventId EQ "10205" OR
         cEventId EQ "10206" THEN
        ASSIGN cCommand  = "Binary Dump" 
                            WHEN cEventId EQ "10202"
               cCommand  = "Table Move"  
                            WHEN cEventId EQ "10205"
               cCommand  = "Index Move"  
                            WHEN cEventId EQ "10206"
               iEntry    = LOOKUP("-C",cRunOpt," ") + 2
               cEntity   = ENTRY(iEntry,cRunOpt," ")
               cToEntity = ENTRY(iEntry + 1,cRunOpt," ")
               cVerb     = " dumping " + cEntity + " to " 
                                    WHEN cEventId EQ "10202"
               cVerb     = " moving "  + cEntity + " to " 
                                    WHEN cEventId EQ "10205"
               cVerb     = " moving "  + cEntity + " to " 
                                    WHEN cEventId EQ "10206" NO-ERROR.
      ELSE IF cEventId EQ "10203" OR 
              cEventId EQ "10208" THEN
        ASSIGN cCommand = "Binary Load"   
                            WHEN cEventId EQ "10203"
               cCommand = "Index Rebuild" 
                            WHEN cEventId EQ "10208"
               iEntry   = LOOKUP("-C",cRunOpt," ") + 2
               cEntity  = ENTRY(iEntry,cRunOpt," ") NO-ERROR.
      ELSE IF cEventId EQ "10209" THEN
        ASSIGN cCommand = "Truncate Area"
               iEntry   = LOOKUP("-C",cRunOpt," ") + 3
               cEntity  = ENTRY(iEntry,cRunOpt," ") NO-ERROR.

      IF cUser NE "" THEN
        hADBuff::_formatted-event-context = 
          cUser + " performed a " + cCommand + " operation on the database" +
          cVerb + cToEntity + ".".
      ELSE
       hADBuff::_formatted-event-context = cCommand + " operation performed on the database. "  + cRunOpt.

      hADBuff::_event-detail            = cRunOpt.
    END.
    WHEN "10211" THEN DO: /* SQL Table Dump */
      cRunOpt = formatCommandLine(hADBuff::_event-detail).

      hADBuff::_event-detail            = cRunOpt.

      IF INDEX(hADBuff::_event-context,CHR(7)) > 0 THEN
        hADBuff::_formatted-event-context = 
            "Table " + ENTRY(2,hADBuff::_event-context,CHR(7)) +
            " dumped from sql." NO-ERROR.
      ELSE hADBuff::_formatted-event-context = hADBuff::_event-context.
    END.
    WHEN "10212" THEN DO: /* SQL Table Load */
      cRunOpt = formatCommandLine(hADBuff::_event-detail).

      hADBuff::_event-detail            = cRunOpt.

      IF INDEX(hADBuff::_event-context,CHR(7)) > 0 THEN
        hADBuff::_formatted-event-context = 
            "Table " + ENTRY(2,hADBuff::_event-context,CHR(7)) +
            " loaded from sql." NO-ERROR.
      ELSE hADBuff::_formatted-event-context = hADBuff::_event-context.
    END.
    WHEN "10213" OR       /* Application Data Dump */
    WHEN "10214" THEN DO: /* Application Data Load */

        cUser = IF hADBuff::_user-id NE "" THEN hADBuff::_user-id ELSE "".
        
        IF cEventId = "10213" THEN
            cVerb = " dumped" + (IF cUser NE "" THEN " data " ELSE " ") + "from database ".
        ELSE
            cVerb = " loaded" + (IF cUser NE "" THEN " data " ELSE " ") + "into database ".

        IF cUser NE "" THEN
            cVerb = cUser + cVerb.
        ELSE
            cVerb = "Data" + cVerb.

        cCommand = SUBSTRING(hADBuff::_event-context,INDEX(hADBuff::_event-context, ".") + 1).

        hADBuff::_formatted-event-context = cVerb + QUOTER(ENTRY(1,hADBuff::_event-context,".")) +
            ", table " + QUOTER(REPLACE(cCommand,CHR(7),", ")).

    END.
    WHEN "10301" THEN DO: /* Dump Audit Data */
        cRunOpt = formatCommandLine(hADBuff::_event-detail).

        cUser = (IF hADBuff::_user-id NE "" THEN hADBuff::_user-id
                 ELSE (IF INDEX(cRunOpt,"-U") > 0 THEN
                         ENTRY(LOOKUP("-U",cRunOpt," ") + 1,cRunOpt," ")
                      ELSE "")).

        hADBuff::_event-detail            = cRunOpt.

        IF cUser NE "" THEN
            hADBuff::_formatted-event-context = 
                      cUser + " dumped audit data from database " +
                      QUOTER(hADBuff::_event-context).
        ELSE
            hADBuff::_formatted-event-context = 
                      "Audit data dumped from database " +
                      QUOTER(hADBuff::_event-context).

        /* event detail may be empty */
        IF  hADBuff::_Event-Detail NE "" THEN DO:
        
            IF LOOKUP("auditarchive", hADBuff::_Event-Detail, " ") > 0 THEN DO:
               i = INDEX(hADBuff::_Event-Detail,"auditarchive") + 12.
    
               hADBuff::_formatted-event-context = hADBuff::_formatted-event-context +
                        ', through the "audit archive" utility'.
    
               cCommand = TRIM(SUBSTRING(hADBuff::_Event-Detail,i)).
               IF cCommand NE "" THEN
                   hADBuff::_formatted-event-context = hADBuff::_formatted-event-context +
                   ", with options " + QUOTER(cCommand).
               ELSE
                   hADBuff::_formatted-event-context = hADBuff::_formatted-event-context +
                   ", with no optional parameters".
    
            END.
    
            IF ENTRY(1,hADBuff::_Event-Detail," ") = "Data" AND
               ENTRY(2,hADBuff::_Event-Detail," ") = "Administration" THEN DO:
    
               hADBuff::_formatted-event-context = hADBuff::_formatted-event-context +
                        ', through the "Data Administration" tool'.
    
               /* log the date range if specified */
               IF NUM-ENTRIES(hADBuff::_Event-Detail," ") = 4 THEN
                   hADBuff::_formatted-event-context = hADBuff::_formatted-event-context +
                         " (date range: " + ENTRY(3,hADBuff::_Event-Detail," ") +
                         " " + ENTRY(4,hADBuff::_Event-Detail," ")  + ").".
            END.
        END.
    END.
    WHEN "10302" THEN DO: /* Load Audit Data */
        cRunOpt = formatCommandLine(hADBuff::_event-detail).

        cUser = (IF hADBuff::_user-id NE "" THEN hADBuff::_user-id
                 ELSE (IF INDEX(cRunOpt,"-U") > 0 THEN
                         ENTRY(LOOKUP("-U",cRunOpt," ") + 1,cRunOpt," ")
                      ELSE "")).

        hADBuff::_event-detail            = cRunOpt.

        IF cUser NE "" THEN
            hADBuff::_formatted-event-context = 
                      cUser + " loaded audit data into database " +
                      QUOTER(hADBuff::_event-context).
        ELSE
            hADBuff::_formatted-event-context = 
                      "Audit data loaded into database " +
                      QUOTER(hADBuff::_event-context).

        /* event detail may be empty */
        IF  hADBuff::_Event-Detail NE "" THEN DO:
            IF ENTRY(1,hADBuff::_Event-Detail," ") = "Data" AND
               ENTRY(2,hADBuff::_Event-Detail," ") = "Administration" THEN
               hADBuff::_formatted-event-context = hADBuff::_formatted-event-context +
                        ', through the "Data Administration" tool'.
            ELSE
               hADBuff::_formatted-event-context = hADBuff::_formatted-event-context +
                         ', through the "audit archive" utility'.
        END.
    END.
    WHEN "10303" OR           /* Dump Audit Policy */
    WHEN "10304" THEN DO:     /* Load Audit Policy */ 

      ASSIGN cCommand = REPLACE(SUBSTRING(hADBuff::_event-context,INDEX(hADBuff::_event-context,".") + 1), CHR(7), ", ").

      IF hADBuff::_event-detail NE "" THEN DO:
      
          IF cEventId = "10303" THEN
              cVerb = " of database " + ENTRY(1,hADBuff::_event-detail) + " dumped".
          ELSE
              cVerb = " loaded into database " + ENTRY(1,hADBuff::_event-detail).
      END.
      ELSE DO:
          IF cEventId = "10303" THEN
              cVerb = " dumped".
          ELSE
              cVerb = " loaded".
     END.
     
     hADBuff::_formatted-event-context = "Audit Policy " + 
               QUOTER(cCommand) + cVerb + ", from " + QUOTER(ENTRY(1, hADBuff::_event-context, ".")).

      IF NUM-ENTRIES(hADBuff::_event-detail) > 1 THEN
         cVerb = ", in " + ENTRY(2,hADBuff::_event-detail) + " format".
      ELSE
         cVerb = "".

      hADBuff::_formatted-event-context = hADBuff::_formatted-event-context + cVerb.

    END.
    WHEN "10500" THEN
      hADBuff::_formatted-event-context = "User " +
          hADBuff::_event-context + " successfully set as Database User".
    WHEN "10501" THEN 
      hADBuff::_formatted-event-context = "Failed to set User " +
          hADBuff::_event-context + " as Database User".
    WHEN "10510" THEN
      hADBuff::_formatted-event-context = "User " +
          hADBuff::_event-context + " successfully logged in to the Database".
    WHEN "10511" THEN
      hADBuff::_formatted-event-context = "User " +
          hADBuff::_event-context + " successfully logged out of the Database".
    WHEN "10512" THEN
      hADBuff::_formatted-event-context = "User " +
          hADBuff::_event-context + ": Attempted login failed!".
    WHEN "10520" THEN DO:
      hADBuff::_formatted-event-context = "SQL User: " + 
            (IF hADBuff::_user-id NE ? AND hADBuff::_user-id NE "" THEN
                hADBuff::_user-id + " s" ELSE "S") + 
                  "uccessfully logged in to the Database".
    END.
    WHEN "10521" THEN
      hADBuff::_formatted-event-context = "SQL User: " +
            (IF hADBuff::_user-id NE ? AND hADBuff::_user-id NE "" THEN
                hADBuff::_user-id + " s" ELSE "S")
                + "uccessfully logged out of the Database".
    WHEN "10522" THEN
      hADBuff::_formatted-event-context = "SQL User: " +
                                "Attempted login failed!".
    WHEN "10600" THEN
      hADBuff::_formatted-event-context = 
        (IF hADBuff::_user-id NE ? AND
            hADBuff::_user-id NE "" THEN "User " + hADBuff::_user-id + " s"
         ELSE "S") + "uccessfully connected to " +
        hADBuff::_event-context.
    WHEN "10601" THEN
      hADBuff::_formatted-event-context = 
        (IF hADBuff::_user-id NE ? AND
            hADBuff::_user-id NE "" THEN "User " + hADBuff::_user-id + " s"
         ELSE "S") + "uccessfully disconnected from " +
        hADBuff::_event-context.
    WHEN "10610" THEN DO:
       IF hADBuff::_user-id NE ? AND hADBuff::_user-id NE "" THEN
          hADBuff::_formatted-event-context = "SQL User: " + 
                                hADBuff::_user-id + 
                                " successfully connected to the database".
       ELSE
          hADBuff::_formatted-event-context =
                    "A SQL Client successfully connected to the database".
    END.
    WHEN "10611" THEN DO:
        IF hADBuff::_user-id NE ? AND hADBuff::_user-id NE "" THEN
           hADBuff::_formatted-event-context = "SQL User: " + 
                     hADBuff::_user-id +
                     " successfully disconnected from the database".
        ELSE
           hADBuff::_formatted-event-context =
                      "A SQL Client successfully disconnected from the database".
    END.
    WHEN "11000" OR WHEN "11001" THEN DO:

        /* detail may be empty if event level is not full  */
        IF cEventId = "11000" AND 
            hADBuff::_event-detail NE ? AND 
            hADBuff::_event-detail NE "" THEN DO:
           cRunOpt = unQuote(ENTRY(3,hADBuff::_event-detail,":"),"~"").
           IF cRunOpt NE "" AND cRunOpt NE ? THEN
              cRunOpt = " (Parameters: " + cRunOpt + ")".
        END.
        ELSE 
            cRunOpt = "".
    
        ASSIGN cUser = (IF hADBuff::_user-id NE "" THEN hADBuff::_user-id
                              ELSE (IF INDEX(cRunOpt,"-U") > 0 THEN
                                      ENTRY(LOOKUP("-U",cRunOpt," ") + 1,cRunOpt," ")
                                      ELSE ""))
                     cUser = (IF cUser NE "" THEN " by " ELSE "") + cUser.
    
        /* detail may be empty if event level is not full  */
        IF hADBuff::_event-detail NE "" AND hADBuff::_event-detail NE ? THEN DO:
            IF ENTRY(1,hADBuff::_event-detail,":") = "pass" THEN DO:
                IF cEventId = "11000" THEN
                   hADBuff::_formatted-event-context = "Encryption Enabled for".
                ELSE
                    hADBuff::_formatted-event-context = "Encryption Disabled for".
            END.
            ELSE DO:
                IF cEventId = "11000" THEN
                   hADBuff::_formatted-event-context = "Enable encryption utility failed for".
                ELSE
                   hADBuff::_formatted-event-context = "Disable encryption utility failed for".
            END.
        END.
        ELSE DO:
            /* we don't know if it passed or failed, just report on the execution */
            IF cEventId = "11000" THEN
               hADBuff::_formatted-event-context = "Encryption Enabled utility executed for".
            ELSE
               hADBuff::_formatted-event-context = "Encryption Disabled utility executed for".
        END.

        hADBuff::_formatted-event-context =  hADBuff::_formatted-event-context + " "
                                             + TRIM(hADBuff::_event-context) /* db-name */
                                             + cRunOpt + cUser.
    END.
    WHEN "11100" THEN DO:
        hADBuff::_formatted-event-context = "Created key store " + hADBuff::_event-context.
    END.
    WHEN "11101" THEN DO:
        hADBuff::_formatted-event-context = "Key store deleted " + hADBuff::_event-context + cUserId.
    END.
    WHEN "11102" THEN DO:
        hADBuff::_formatted-event-context = "Key store " + hADBuff::_event-context
                                             + " opened" + cUserId.
    END.
    WHEN "11103" THEN DO:
        hADBuff::_formatted-event-context = "Encryption key changed for key store " 
                                                + hADBuff::_event-context + cUserId.
    END.
    WHEN "11104" THEN DO:
        hADBuff::_formatted-event-context = "Cipher changed for key store " 
                                             + hADBuff::_event-context.

        IF hADBuff::_event-detail NE ? AND hADBuff::_event-detail NE ""  THEN
            hADBuff::_formatted-event-context =  hADBuff::_formatted-event-context + " to " + 
                                                 ENTRY(2,hADBuff::_event-detail,CHR(7)).
         
        hADBuff::_formatted-event-context =  hADBuff::_formatted-event-context + cUserId.
    END.
    WHEN "11105" THEN DO:
        hADBuff::_formatted-event-context = "Admin passphrase changed for key store " 
                                             + hADBuff::_event-context + cUserId.
    END.
    WHEN "11105" THEN DO:
        hADBuff::_formatted-event-context = "User passphrase changed for key store " 
                                             + hADBuff::_event-context + cUserId.
    END.
    WHEN "11106" THEN DO:
        hADBuff::_formatted-event-context = "Admin passphrase changed for key store " 
                                             + hADBuff::_event-context + cUserId.
    END.
    WHEN "11107" THEN DO:
        hADBuff::_formatted-event-context = "Database key store entry created for " 
                                             + ENTRY(1,hADBuff::_event-context, CHR(6)) 
                                             + cUserId.
    END.
    WHEN "11108" THEN DO:
        hADBuff::_formatted-event-context = "Database key store entry updated for " 
                                             + ENTRY(1,hADBuff::_event-context, CHR(6))
                                             + cUserId.
    END.
    WHEN "11109" THEN DO:
        hADBuff::_formatted-event-context = "Database key store entry deleted for " 
                                             + ENTRY(1,hADBuff::_event-context, CHR(6))
                                             + cUserId.
    END.
    WHEN "11110" THEN DO:
        hADBuff::_formatted-event-context = "Database key store entry read for " 
                                             + ENTRY(1,hADBuff::_event-context, CHR(6))
                                             + cUserId.
    END.
    WHEN "11111" THEN DO:
        hADBuff::_formatted-event-context = "Failed to open key store " 
                                             + hADBuff::_event-context + cUserId.
    END.
    WHEN "11112" THEN DO:
        hADBuff::_formatted-event-context = "Failed to create key store entry for " 
                                             + hADBuff::_event-context + cUserId.
    END.
    WHEN "11113" THEN DO:
        hADBuff::_formatted-event-context = "Failed to update key store entry for " 
                                             + ENTRY(1,hADBuff::_event-context, CHR(6))
                                             + cUserId.
    END.
    WHEN "11114" THEN DO:
        hADBuff::_formatted-event-context = "Failed to delete key store entry for " 
                                             + ENTRY(1,hADBuff::_event-context, CHR(6))
                                             + cUserId.
    END.
    WHEN "11200" THEN DO:
        hADBuff::_formatted-event-context = "Auto-start key store file " 
                                             + hADBuff::_event-context + " created" + cUserId.
    END.
    WHEN "11201" THEN DO:
        hADBuff::_formatted-event-context = "Auto-start key store file " 
                                             + hADBuff::_event-context + " deleted" + cUserId.
    END.
    WHEN "11202" THEN DO:
        hADBuff::_formatted-event-context = "Auto-start key store file " 
                                             + hADBuff::_event-context + " opened" + cUserId.
    END.
    WHEN "11203" THEN DO:
        hADBuff::_formatted-event-context = "Auto-start key store file " 
                                             + hADBuff::_event-context + " recovered" + cUserId.
    END.
    WHEN "11204" THEN DO:
        hADBuff::_formatted-event-context = "Auto-start key store file " 
                                             + hADBuff::_event-context + " updated" + cUserId.
    END.
    WHEN "11205" THEN DO:
        hADBuff::_formatted-event-context = "Failed to open auto-start key store file " 
                                             + hADBuff::_event-context + cUserId.
    END.
    WHEN "11206" THEN DO:
        hADBuff::_formatted-event-context = "Failed to update auto-start key store file " 
                                             + hADBuff::_event-context + cUserId.
    END.
    WHEN "11207" THEN DO:
        hADBuff::_formatted-event-context = "Failed to recover auto-start key store file " 
                                             + hADBuff::_event-context + cUserId.
    END.
    WHEN "11300" THEN DO:
        hADBuff::_formatted-event-context = "Encryption state scan started".

        /* if we have details, it has the object name */
        IF hADBuff::_event-detail NE "" AND hADBuff::_event-detail NE ? THEN
            hADBuff::_formatted-event-context = hADBuff::_formatted-event-context 
                                             + " for " + QUOTER(hADBuff::_event-detail).

        hADBuff::_formatted-event-context = hADBuff::_formatted-event-context 
                                            + " on " + hADBuff::_event-context + cUserId.
    END.
    WHEN "11301" THEN DO:
        hADBuff::_formatted-event-context = "Encryption state update started".

        /* if we have details, it has the object name */
        IF hADBuff::_event-detail NE "" AND hADBuff::_event-detail NE ? THEN
            hADBuff::_formatted-event-context = hADBuff::_formatted-event-context 
                                             + " for " + QUOTER(hADBuff::_event-detail).

        hADBuff::_formatted-event-context = hADBuff::_formatted-event-context 
                                            + " on " + hADBuff::_event-context + cUserId.
    END.
    WHEN "11400" THEN DO:
        cTemp1 = ENTRY(2, hADBuff::_event-context, CHR(6)).

        RUN audGetDataValueFromEventDetail(hADBuff, INPUT "_Dbpol-ciphername", OUTPUT cTemp2).

        /* shouldn't happen, but just in case */
        IF cTemp2 = "NULL_NULL_NULL" THEN
            cTemp2 = "".

        hADBuff::_formatted-event-context = "Database encryption policy version "
                                             + ENTRY(2, cTemp1, CHR(7)) 
                                             + (IF cTemp2 NE "" THEN " (cipher: " + cTemp2 + ")" ELSE "")
                                             + " created" + cUserId.
    END.
    WHEN "11401" THEN DO:
        cTemp1 = ENTRY(2, hADBuff::_event-context, CHR(6)).
        hADBuff::_formatted-event-context = "Database encryption policy version "
                                             + ENTRY(2, cTemp1, CHR(7)) + " updated" 
                                             + cUserId.
    END.
    WHEN "11402" THEN DO:
        cTemp1 = ENTRY(2, hADBuff::_event-context, CHR(6)).
        hADBuff::_formatted-event-context = "Database encryption policy version "
                                             + ENTRY(2, cTemp1, CHR(7)) + " deleted" 
                                             + cUserId.
    END.
    WHEN "11500" OR 
        WHEN "11501" OR
        WHEN "11502" THEN DO:

         IF cEventId = "11500" THEN
            cTemp3 = " created".
         ELSE IF cEventId = "11501" THEN
            cTemp3 = " updated".
         ELSE
            cTemp3 = " deleted".

        cTemp1 = ENTRY(2, hADBuff::_event-context, CHR(6)).

        hADBuff::_formatted-event-context = "Encryption policy version "
                                            +  ENTRY(3, cTemp1, CHR(7)). 

        cTemp2 = ENTRY(2,  cTemp1, CHR(7)) /* obj type */.
        CASE cTemp2:
            WHEN "T" THEN
                cTemp2 = "table".
            WHEN "I" THEN
                cTemp2 = "index".
            WHEN "L" THEN
                cTemp2 = "lob".
            WHEN "A" THEN
                cTemp2 = "area".
        END CASE.

        /* the object / area name */
        cTemp1 = ENTRY(1, cTemp1, CHR(7)).
        IF cTemp1 BEGINS "PUB." THEN
            cTemp1 = SUBSTRING(cTemp1,5).

        IF cTemp1 NE "" AND cTemp2 NE "" THEN DO:
            IF cTemp2 = "table" OR cTemp2 = "area" THEN
                cTemp1 = QUOTER(cTemp1).
            ELSE DO:
                CASE NUM-ENTRIES(cTemp1, "."):
                    WHEN 2 THEN
                        cTemp1 = QUOTER(ENTRY(2, cTemp1, ".")) + " of " + QUOTER(ENTRY(1, cTemp1, ".")).
                    WHEN 3 THEN
                        cTemp1 = QUOTER(ENTRY(3, cTemp1, ".")) + " of " 
                                 + QUOTER(ENTRY(1, cTemp1, ".") + "." + ENTRY(2, cTemp1, ".")).
                END CASE.
            END.
    
            hADBuff::_formatted-event-context = hADBuff::_formatted-event-context 
                                                 + " for " + cTemp2 /* obj type */
                                                 + " " + cTemp1 /* obj/area name */
                                                 + cTemp3. 
            
            cTemp2 = "".
    
            IF cEventId = "11500" THEN DO:
                /* get cipher name if creating new object policy */
                RUN audGetDataValueFromEventDetail(hADBuff, INPUT "_Objpol-ciphername", OUTPUT cTemp2).
        
                IF cTemp2 = ? THEN
                    cTemp2 = "".
    
                IF cTemp2 NE "" THEN DO:
                    IF cTemp2 = "NULL_NULL_NULL" THEN
                       cTemp2 = " (encryption disabled)".
                    ELSE
                       cTemp2 = " with cipher " + cTemp2.
                END.
            END.
        END.
        ELSE DO:
            /* must be template record deleted during disableencryption */
            cTemp2 = "".
            hADBuff::_formatted-event-context = "Template record for encryption policy" + cTemp3.
        END.

        hADBuff::_formatted-event-context =  hADBuff::_formatted-event-context + cTemp2 + cUserId.
    END.
    WHEN "11600" THEN DO:
        cTemp1 = ENTRY(2, hADBuff::_event-context, CHR(6)).

        hADBuff::_formatted-event-context = "Database passphrase policy version " 
                                             + ENTRY(2, cTemp1, CHR(7)) + " created" + cUserId.
    END.
    WHEN "11601" THEN DO:
        cTemp1 = ENTRY(2, hADBuff::_event-context, CHR(6)).
        hADBuff::_formatted-event-context = "Database passphrase policy version " 
                                             + ENTRY(2, cTemp1, CHR(7)) + " updated" + cUserId.
    END.
    WHEN "11602" THEN DO:
        cTemp1 = ENTRY(2, hADBuff::_event-context, CHR(6)).
        hADBuff::_formatted-event-context = "Database passphrase policy version " 
                                             + ENTRY(2, cTemp1, CHR(7)) + " deleted" + cUserId.
    END.
    OTHERWISE 
      hADBuff::_formatted-event-context = hADBuff::_event-context.
  END CASE.
  hADBuff::_event-context           = REPLACE(hADBuff::_event-context,
                                              CHR(7),
                                              "CHR(7)").
  hADBuff::_event-context           = REPLACE(hADBuff::_event-context,
                                              CHR(6),
                                              "CHR(6)").

  /* check if we need to process the _Event-detail field for streamed fields on db events */
  /* only do it if doing detailed report or XML (XML is always detailed) */
  IF plDetail OR glWriteXml THEN
     RUN audDataValueFromEventDetail
         ( INPUT hADBuff, 
           DATASET-HANDLE phDataSet BY-REFERENCE ).

END PROCEDURE.


PROCEDURE audDataValueFromEventDetail:
  /* Procedure:   audDataValueFromEventDetail
   * 
   * Description: Read the value of the _Event-detail field for db events, and 
                  create audit data children records in the bAudDataValue 
   *              temp-table.
  */ 

  DEFINE INPUT PARAMETER hADBuff AS HANDLE NO-UNDO. /* handle of bAudData 
                                                       buffer */
  DEFINE INPUT PARAMETER DATASET-HANDLE phDataSet.

  DEFINE VARIABLE hADVBuff   AS HANDLE    NO-UNDO.
  DEFINE VARIABLE iLoop      AS INTEGER   NO-UNDO.
  DEFINE VARIABLE numEntries AS INTEGER   NO-UNDO.
  DEFINE VARIABLE cEntry     AS CHARACTER NO-UNDO.

  /* This is (and should be) only called if plDetail is TRUE */

  /* don't do this for events on encryption policy tables */
  IF hADBuff::_event-id >= 11400 AND hADBuff::_event-id <= 11602  THEN
     RETURN.

  /* check if this _Event-detail contains info for a db event. We will check 
     if the data follows the format defined for db events of 4 entries 
     separated by chr(6).
     
     It may contain more than one entry separated by chr(7), but we just need 
     to check the first one to see if it's a db event.
  */
  IF NUM-ENTRIES(ENTRY(1,hADBuff::_Event-detail,CHR(7)),CHR(6)) = 4 THEN DO:

    hADVBuff = phDataSet:GET-BUFFER-HANDLE("bAudDataValue").

    /* when recording method is non-streamed, the database records the 
       string "?" instead of the unknown value in the old and/or new value 
       fields, so set literal-question so that the report contains the same 
       information regardless of the recording method.
    */
    IF NOT hADVBuff:BUFFER-FIELD('_old-string-value'):LITERAL-QUESTION THEN
      ASSIGN 
        hADVBuff:BUFFER-FIELD('_old-string-value'):LITERAL-QUESTION  = TRUE
        hADVBuff:BUFFER-FIELD('_new-string-value'):LITERAL-QUESTION  = TRUE.

    numEntries = NUM-ENTRIES(hADBuff::_Event-detail,CHR(7)).

    /* loop through all field changes - separated by chr(7) */
    REPEAT iLoop = 1 TO numEntries:
      
      cEntry = ENTRY(iLoop,hADBuff::_Event-detail,CHR(7)).

      /* If entry is empty, it must be that the last entry had chr(7) at the
         end as well.
           
         If not, then something is very wrong 
      */
      IF cEntry = ? OR cEntry = "" THEN
        LEAVE.

      hADVBuff:BUFFER-CREATE().
         
      ASSIGN hADVBuff::_audit-data-guid           = hADBuff::_audit-data-guid
             hADVBuff::_continuation-sequence     = 0
             hADVBuff::_audit-data-security-level = 
                                       hADBuff::_audit-data-security-level
             hADVBuff::_field-name = ENTRY(1,cEntry,CHR(6))
             hADVBuff::_data-type-code = ENTRY(2,cEntry,CHR(6))
             hADVBuff::_old-string-value = ENTRY(3,cEntry,CHR(6))
             hADVBuff::_new-string-value = ENTRY(4,cEntry,CHR(6)).

      /* if the new and/or old values are for an array, remove the chr(8) 
         character */
      IF INDEX(hADVBuff::_old-string-value,CHR(8)) > 0 AND 
         INDEX(hADVBuff::_old-string-value,"E[":U) > 0 THEN
        ASSIGN 
          hADVBuff::_old-string-value = REPLACE(hADVBuff::_old-string-value, 
                                                CHR(8), 
                                                " ":U).

      IF INDEX(hADVBuff::_new-string-value,CHR(8)) > 0 AND 
         INDEX(hADVBuff::_new-string-value,"E[":U) > 0 THEN
        ASSIGN 
          hADVBuff::_new-string-value = REPLACE(hADVBuff::_new-string-value,
                                                CHR(8), 
                                                " ":U).

      /* now call the procedure to populate data type and security level 
         descriptions */
      RUN audDataValueAfterRowFill ( DATASET-HANDLE phDataSet BY-REFERENCE ).

    END.

    /* clear _Event-detail since we have created records for each fields 
       change - This is so that we don't log it in case the user dumps it to 
       XML file, since the data value records we created and will be dumped.
    */
    hADBuff::_Event-detail = "".
  END.

END PROCEDURE.

PROCEDURE audGetDataValueFromEventDetail:
  /* Procedure:   audGetDataValueFromEventDetail
   * 
   * Description: Read the value of a specific field in the _Event-detail
   *              field
  */ 

  DEFINE INPUT PARAMETER hADBuff AS HANDLE NO-UNDO. /* handle of bAudData 
                                                       buffer */
  DEFINE INPUT  PARAMETER cFieldName AS CHAR NO-UNDO.
  DEFINE OUTPUT PARAMETER cOutValue  AS CHAR NO-UNDO.

  DEFINE VARIABLE hADVBuff   AS HANDLE    NO-UNDO.
  DEFINE VARIABLE iLoop      AS INTEGER   NO-UNDO.
  DEFINE VARIABLE numEntries AS INTEGER   NO-UNDO.
  DEFINE VARIABLE cEntry     AS CHARACTER NO-UNDO.

  /* We will check if the data follows the format defined for db events of 4 entries 
     separated by chr(6).
     
     It may contain more than one entry separated by chr(7), but we just need 
     to check the first one to see if it's a db event.
  */
  IF NUM-ENTRIES(ENTRY(1,hADBuff::_Event-detail,CHR(7)),CHR(6)) = 4 THEN DO:

    numEntries = NUM-ENTRIES(hADBuff::_Event-detail,CHR(7)).

    /* loop through all field changes - separated by chr(7) */
    REPEAT iLoop = 1 TO numEntries:
      
      cEntry = ENTRY(iLoop,hADBuff::_Event-detail,CHR(7)).

      /* If entry is empty, it must be that the last entry had chr(7) at the
         end as well.
           
         If not, then something is very wrong 
      */
      IF cEntry = ? OR cEntry = "" THEN
        LEAVE.
         
      IF ENTRY(1,cEntry,CHR(6)) = cFieldName THEN DO:
          cOutValue = ENTRY(4,cEntry,CHR(6)).
          LEAVE.
      END.
    END.
  END.

END PROCEDURE.

PROCEDURE audDataValueAfterRowFill:
  DEFINE INPUT PARAMETER DATASET-HANDLE phDataSet.

  DEFINE VARIABLE hADVBuff   AS HANDLE      NO-UNDO.

  DEFINE VARIABLE iSecLevel  AS INTEGER     NO-UNDO.
  DEFINE VARIABLE iDTypeCode AS INTEGER     NO-UNDO.

  hADVBuff = phDataSet:GET-BUFFER-HANDLE("bAudDataValue").

  iSecLevel = INTEGER(hADVBuff::_audit-data-security-level).
  CASE iSecLevel:
    WHEN 1 THEN
      hADVBuff::_audit-data-security-level-name = "Message Digest".
    WHEN 2 THEN
      hADVBuff::_audit-data-security-level-name = "DB Passkey".
    OTHERWISE
      hADVBuff::_audit-data-security-level-name = "No Additional Security".
  END CASE.

  iDTypeCode = INTEGER(hADVBuff::_data-type-code).
  CASE iDTypeCode:
    WHEN 1 THEN
      hADVBuff::_data-type-name = "Character".
    WHEN 2 THEN
      hADVBuff::_data-type-name = "Date".
    WHEN 3 THEN
      hADVBuff::_data-type-name = "Logical".
    WHEN 4 THEN
      hADVBuff::_data-type-name = "Integer".
    WHEN 5 THEN
      hADVBuff::_data-type-name = "Decimal".
    WHEN 7 THEN
      hADVBuff::_data-type-name = "Recid".
    WHEN 8 THEN
      hADVBuff::_data-type-name = "Raw".
    WHEN 11 THEN
      hADVBuff::_data-type-name = "Memptr".
    WHEN 13 THEN
      hADVBuff::_data-type-name = "Rowid".
    WHEN 18 THEN
      hADVBuff::_data-type-name = "Blob".
    WHEN 19 THEN
      hADVBuff::_data-type-name = "Clob".
    WHEN 34 THEN
      hADVBuff::_data-type-name = "Datetime".
    WHEN 39 THEN
      hADVBuff::_data-type-name = "Longchar".
    WHEN 40 THEN
      hADVBuff::_data-type-name = "Datetime-TZ".
    WHEN 41 THEN
        hADVBuff::_data-type-name = "Int64".
    OTHERWISE
      hADVBuff::_data-type-name = "Unknown".
  END CASE.

  /* for blob and clob fields, clear up the old and new value string in case
     they have garbage in them, since we don't support them (for now)
  */
  IF iDTypeCode = 18 OR iDTypeCode = 19 THEN
      ASSIGN hADVBuff::_old-string-value = ""
             hADVBuff::_new-string-value = "".

  /* if the new and/or old values are for an array, remove the chr(8) character for reporting */
  IF INDEX(hADVBuff::_old-string-value,CHR(8)) > 0 AND 
     INDEX(hADVBuff::_old-string-value,"E[":U) > 0 THEN
     ASSIGN hADVBuff::_old-string-value = REPLACE(hADVBuff::_old-string-value, 
                                                  CHR(8), 
                                                  " ":U).

  IF INDEX(hADVBuff::_new-string-value,CHR(8)) > 0 AND 
     INDEX(hADVBuff::_new-string-value,"E[":U) > 0 THEN
    ASSIGN hADVBuff::_new-string-value = REPLACE(hADVBuff::_new-string-value, 
                                                 CHR(8), 
                                                 " ":U).

END PROCEDURE.

PROCEDURE createSecondaryBuffers:
  DEFINE INPUT  PARAMETER pcDbName AS CHARACTER   NO-UNDO.
  DEFINE INPUT  PARAMETER piReport AS INTEGER     NO-UNDO.

  CASE piReport:
    WHEN 1 THEN DO:
      CREATE BUFFER ghAPBuff  FOR TABLE pcDbName + "._aud-audit-policy"
                                             IN WIDGET-POOL "datasetPool".
      CREATE BUFFER ghAEBuff  FOR TABLE pcDbName + "._aud-event"
                                             IN WIDGET-POOL "datasetPool".
      CREATE BUFFER ghAFIBuff FOR TABLE pcDbName + "._aud-file-policy"
                                             IN WIDGET-POOL "datasetPool".
      CREATE BUFFER ghAFEBuff FOR TABLE pcDbName + "._aud-field-policy"
                                             IN WIDGET-POOL "datasetPool".
      CREATE BUFFER ghAEVBuff FOR TABLE pcDbName + "._aud-event-policy"
                                             IN WIDGET-POOL "datasetPool".
    END.
    WHEN 2 THEN DO:
      CREATE BUFFER ghFileBuff   FOR TABLE pcDbName + "._file"
                                             IN WIDGET-POOL "datasetPool".
      CREATE BUFFER ghFilTrgBuff FOR TABLE pcDbName + "._file-trig"
                                             IN WIDGET-POOL "datasetPool".
      CREATE BUFFER ghFieldBuff  FOR TABLE pcDbName + "._field"
                                             IN WIDGET-POOL "datasetPool".
      CREATE BUFFER ghFldTrgBuff FOR TABLE pcDbName + "._field-trig"
                                             IN WIDGET-POOL "datasetPool".
      CREATE BUFFER ghIndexBuff  FOR TABLE pcDbName + "._index"
                                             IN WIDGET-POOL "datasetPool".
      CREATE BUFFER ghIdxFldBuff FOR TABLE pcDbName + "._index-field"
                                             IN WIDGET-POOL "datasetPool".
      CREATE BUFFER ghSeqBuff    FOR TABLE pcDbName + "._sequence"
                                             IN WIDGET-POOL "datasetPool".
      CREATE BUFFER ghDbOptBuff  FOR TABLE pcDbName + "._db-option"
                                             IN WIDGET-POOL "datasetPool".
      CREATE BUFFER ghDbDtlBuff  FOR TABLE pcDbName + "._db-detail"
                                             IN WIDGET-POOL "datasetPool".
    END.
    WHEN 5 THEN
      CREATE BUFFER ghUserBuff FOR TABLE pcDbName + "._user"
                                             IN WIDGET-POOL "datasetPool".
    WHEN 6 THEN DO:
      CREATE BUFFER ghSRoleBuff  FOR TABLE pcDbName + "._sec-role"
                                             IN WIDGET-POOL "datasetPool".
      CREATE BUFFER ghSGRBuff    FOR TABLE pcDbName + "._sec-granted-role"
                                             IN WIDGET-POOL "datasetPool".
    END.
    WHEN 7 THEN DO:                                                         
      CREATE BUFFER ghTabAuth    FOR TABLE pcDbName + "._systabauth"
                                             IN WIDGET-POOL "datasetPool".
      CREATE BUFFER ghColAuth    FOR TABLE pcDbName + "._syscolauth"
                                             IN WIDGET-POOL "datasetPool".
      CREATE BUFFER ghSeqAuth    FOR TABLE pcDbName + "._sysseqauth"
                                             IN WIDGET-POOL "datasetPool".
      CREATE BUFFER ghDbAuth     FOR TABLE pcDbName + "._sysdbauth"
                                             IN WIDGET-POOL "datasetPool".
    END.
    WHEN 8 THEN DO:
      CREATE BUFFER ghSecASBuff  FOR TABLE pcDbName + 
                                           "._sec-authentication-system"
                                             IN WIDGET-POOL "datasetPool".
      CREATE BUFFER ghSecADBuff  FOR TABLE pcDbName + 
                                           "._sec-authentication-domain"
                                             IN WIDGET-POOL "datasetPool".
    END.
    WHEN 12 THEN DO:
      CREATE BUFFER ghAPBuff     FOR TABLE pcDbName + "._aud-audit-policy"
                                             IN WIDGET-POOL "datasetPool".
      CREATE BUFFER ghAEBuff     FOR TABLE pcDbName + "._aud-event"
                                             IN WIDGET-POOL "datasetPool".
      CREATE BUFFER ghAFIBuff    FOR TABLE pcDbName + "._aud-file-policy"
                                             IN WIDGET-POOL "datasetPool".
      CREATE BUFFER ghAFEBuff    FOR TABLE pcDbName + "._aud-field-policy"
                                             IN WIDGET-POOL "datasetPool".
      CREATE BUFFER ghAEVBuff    FOR TABLE pcDbName + "._aud-event-policy"
                                             IN WIDGET-POOL "datasetPool".
      CREATE BUFFER ghFileBuff   FOR TABLE pcDbName + "._file"
                                             IN WIDGET-POOL "datasetPool".
      CREATE BUFFER ghFilTrgBuff FOR TABLE pcDbName + "._file-trig"
                                             IN WIDGET-POOL "datasetPool".
      CREATE BUFFER ghFieldBuff  FOR TABLE pcDbName + "._field"
                                             IN WIDGET-POOL "datasetPool".
      CREATE BUFFER ghFldTrgBuff FOR TABLE pcDbName + "._field-trig"
                                             IN WIDGET-POOL "datasetPool".
      CREATE BUFFER ghIndexBuff  FOR TABLE pcDbName + "._index"
                                             IN WIDGET-POOL "datasetPool".
      CREATE BUFFER ghIdxFldBuff FOR TABLE pcDbName + "._index-field"
                                             IN WIDGET-POOL "datasetPool".
      CREATE BUFFER ghSeqBuff    FOR TABLE pcDbName + "._sequence"
                                             IN WIDGET-POOL "datasetPool".
      CREATE BUFFER ghDbOptBuff  FOR TABLE pcDbName + "._db-option"
                                             IN WIDGET-POOL "datasetPool".
      CREATE BUFFER ghDbDtlBuff  FOR TABLE pcDbName + "._db-detail"
                                             IN WIDGET-POOL "datasetPool".
      CREATE BUFFER ghUserBuff   FOR TABLE pcDbName + "._user"
                                             IN WIDGET-POOL "datasetPool".
      CREATE BUFFER ghSRoleBuff  FOR TABLE pcDbName + "._sec-role"
                                             IN WIDGET-POOL "datasetPool".
      CREATE BUFFER ghSGRBuff    FOR TABLE pcDbName + "._sec-granted-role"
                                             IN WIDGET-POOL "datasetPool".
      CREATE BUFFER ghSecASBuff  FOR TABLE pcDbName + 
                                           "._sec-authentication-system"
                                             IN WIDGET-POOL "datasetPool".
      CREATE BUFFER ghSecADBuff  FOR TABLE pcDbName + 
                                           "._sec-authentication-domain"
                                             IN WIDGET-POOL "datasetPool".
      CREATE BUFFER ghTabAuth    FOR TABLE pcDbName + "._systabauth"
                                             IN WIDGET-POOL "datasetPool".
      CREATE BUFFER ghColAuth    FOR TABLE pcDbName + "._syscolauth"
                                             IN WIDGET-POOL "datasetPool".
      CREATE BUFFER ghSeqAuth    FOR TABLE pcDbName + "._sysseqauth"
                                             IN WIDGET-POOL "datasetPool".
      CREATE BUFFER ghDbAuth     FOR TABLE pcDbName + "._sysdbauth"
                                             IN WIDGET-POOL "datasetPool".
    END.
  END CASE.

  IF piReport NE 9 THEN
  CREATE BUFFER ghADBuff FOR TABLE pcDbName + "._aud-audit-data"
                                             IN WIDGET-POOL "datasetPool".
END PROCEDURE.

&Scoped-define WINDOW-NAME CURRENT-WINDOW
&Scoped-define FRAME-NAME Dialog-Frame
/*************************************************************/
/* Copyright (c) 1984-2005,2008 by Progress Software Corporation  */
/*                                                           */
/* All rights reserved.  No part of this program or document */
/* may be  reproduced in  any form  or by  any means without */
/* permission in writing from PROGRESS Software Corporation. */
/*************************************************************/

/*------------------------------------------------------------------------

  File: adecomm/_auddfilt.p

  Description: Date Range Filter for Audit, or client session, Data.

  Input Parameters:
      pcMode    -   This parameter descibes the mode in which this 
                    dialog should run.  The mode should be one of the 
                    following:
                    
                    1-15 Modes 1 through 15 tell the utility that this
                         dialog has been called by an Auditing Report.
                         
                         Auditing Reports require only Audit Reader 
                         permissions to run.
                         
                    "y"  Mode y indicates that this was called from the
                         "Dump Audit Data" option in the Data Administration
                         Tool.  
                         
                         Mode y requires Audit Archiver permissions to run.
  Output Parameters:
      pcData    -   Used to return the date range to the user.

  Author: Kenneth S. McIntosh

  Created: March 11,2005
  
  History: 
    kmcintos June 7, 2005  Added context help for dialog and removed appbuilder 
                           friendly code.
    kmcintos July 19, 2005 Fixed security stuff and adapted for general usage 
                           to be used with auditing reports.
    kmcintos Oct 28, 2005  Changed help context id depending on usage.
    fernando Dec 23, 2008  Reports for encryption
------------------------------------------------------------------------*/
/*          This .W file was created with the Progress AppBuilder.       */
/*----------------------------------------------------------------------*/

/* ***************************  Definitions  ************************** */

CREATE WIDGET-POOL.

/* Parameters Definitions ---                                           */

DEFINE INPUT  PARAMETER pcMode AS CHARACTER   NO-UNDO.
DEFINE OUTPUT PARAMETER pcData AS CHARACTER   NO-UNDO.

/* Local Variable Definitions ---                                       */

&GLOBAL-DEFINE DATE-RANGE fiStartDate fiEndDate
&GLOBAL-DEFINE TEXT-LINES txtLine1 txtLine2 txtLine3 txtLine4 txtLine5

{prodict/user/uservar.i}
{prodict/sec/sec-func.i}
{adecomm/commeng.i}   

DEFINE VARIABLE cRoles     AS CHARACTER   NO-UNDO.
  
DEFINE VARIABLE iContextId AS INTEGER     NO-UNDO.

cRoles = getPermissions(USERID("DICTDB"),pcMode).

/* If dumping audit data */
IF pcMode EQ "y" THEN DO: 
  IF NOT CAN-DO(cRoles,"_sys.audit.archive") THEN DO:
    MESSAGE "You must have Audit Archiver permissions to access this " +
            "Dump Option!"
         VIEW-AS ALERT-BOX ERROR BUTTONS OK.
 
    pcData = ?.
    RETURN.
  END.
END.
/* If running an audit report */
ELSE IF CAN-DO("1,2,3,4,5,6,7,8,9,10,11,13,14,15",pcMode) THEN DO:
  IF cRoles NE "dba,w"                       AND
     NOT CAN-DO(cRoles,"_sys.audit.admin")   AND
     NOT CAN-DO(cRoles,"_sys.audit.archive") AND
     NOT CAN-DO(cRoles,"_sys.audit.read")    THEN DO:

    MESSAGE "You must have a minimum of Audit Reader permissions to access " +
            "this option."
        VIEW-AS ALERT-BOX ERROR BUTTONS OK.

    pcData = ?.
    RETURN.
  END.
END.
ELSE DO:
  MESSAGE "Permission Denied!" SKIP(1)
          "You have called this dialog from an unsupported tool."
      VIEW-AS ALERT-BOX ERROR BUTTONS OK.

  pcData = ?.
  RETURN.
END.

DEFINE VARIABLE ghBuffer    AS HANDLE      NO-UNDO.

DEFINE VARIABLE lImmedDisp   AS LOGICAL     NO-UNDO.

DEFINE VARIABLE gcDateFormat AS CHARACTER   NO-UNDO.
DEFINE VARIABLE gcNumSep     AS CHARACTER   NO-UNDO.
DEFINE VARIABLE gcNumDec     AS CHARACTER   NO-UNDO.
DEFINE VARIABLE gcTitle      AS CHARACTER   NO-UNDO.
DEFINE VARIABLE gcFunction   AS CHARACTER   NO-UNDO FORMAT "x(50)"
       EXTENT 15
       INITIAL ["Audit Policy Changes",
                "Schema Changes",
                "Audit Data Administration",
                "Application Data Administration",
                "User Maintenance",
                "Security Permissions Changes",
                "SQL DBA Changes",
                "Authentication Systems Changes",
                "Client Session Authentication",
                "Database Utilities",
                "Database Access",
                ?, /* not used - for custom report */
                "Encryption Policy Changes", 
                "Key Store Changes",
                "Database Encryption Administration"].

ASSIGN gcDateFormat           = SESSION:DATE-FORMAT
       gcNumSep               = SESSION:NUMERIC-SEPARATOR
       gcNumDec               = SESSION:NUMERIC-DECIMAL-POINT
       SESSION:DATE-FORMAT    = "mdy"
       SESSION:NUMERIC-FORMAT = "American".

IF pcMode = "9" THEN DO:
  CREATE BUFFER ghBuffer FOR TABLE "DICTDB._client-session".
  gcTitle = "Date Range - " + gcFunction[INTEGER(pcMode)].
  &IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN
    iContextId = {&Date_Range_Auditing_Reports_Dialog_Box}.
  &ENDIF
END.
ELSE IF pcMode = "y" THEN DO:
  CREATE BUFFER ghBuffer FOR TABLE "DICTDB._aud-audit-data".
  gcTitle = "Date Range - Dump Audit Data".
  &IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN 
    iContextId = {&Dump_Audit_Data_Filter_Dialog_Box}.
  &ENDIF
END.
ELSE IF CAN-DO("1,2,3,4,5,6,7,8,9,10,11,12,13,14,15",pcMode) THEN DO:
  CREATE BUFFER ghBuffer FOR TABLE "DICTDB._aud-audit-data".
  gcTitle = "Date Range - " + gcFunction[INTEGER(pcMode)].
  &IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN 
    iContextId = {&Date_Range_Auditing_Reports_Dialog_Box}.
  &ENDIF
END.

/* ********************  Preprocessor Definitions  ******************** */

&Scoped-define PROCEDURE-TYPE Dialog-Box
&Scoped-define DB-AWARE no

&Scoped-define LAYOUT-VARIABLE CURRENT-WINDOW-layout

/* Name of designated FRAME-NAME and/or first browse and/or first query */
&Scoped-define FRAME-NAME Dialog-Frame

/* Standard List Definitions                                            */
&Scoped-Define ENABLED-OBJECTS rsChoice fiStartDate fiEndDate btnOk btnCancel txtDateRange 
&Scoped-Define DISPLAYED-OBJECTS rsChoice fiStartDate fiEndDate txtDateRange 

/* Define a variable to store the name of the active layout.            */
DEFINE VAR CURRENT-WINDOW-layout AS CHAR INITIAL "Master Layout":U NO-UNDO.

/* ***********************  Control Definitions  ********************** */

/* Definitions of the field level widgets                               */
DEFINE VARIABLE fiEndDate AS DATE FORMAT "99/99/9999":U
     LABEL "End Date" 
     VIEW-AS FILL-IN 
     &IF '{&WINDOW-SYSTEM}' = 'TTY':U &THEN SIZE 16 BY 1
     &ELSE SIZE 16.4 BY 1 &ENDIF NO-UNDO.

DEFINE VARIABLE fiStartDate AS DATE FORMAT "99/99/9999":U
     LABEL "Start Date" 
     VIEW-AS FILL-IN 
     &IF '{&WINDOW-SYSTEM}' = 'TTY':U &THEN SIZE 16 BY 1
     &ELSE SIZE 16.4 BY 1 &ENDIF NO-UNDO.

DEFINE VARIABLE txtDateRange AS CHARACTER FORMAT "X(256)":U INITIAL "Date Range:" 
      VIEW-AS TEXT 
     &IF '{&WINDOW-SYSTEM}' = 'TTY':U &THEN SIZE 18 BY 1
     &ELSE SIZE 18 BY .62 &ENDIF
     FONT 6 NO-UNDO.

DEFINE VARIABLE rsChoice AS INTEGER 
     VIEW-AS RADIO-SET VERTICAL
     RADIO-BUTTONS 
          "Select All", 1,
          "Select Some", 2
     &IF '{&WINDOW-SYSTEM}' = 'TTY':U &THEN SIZE 20 BY 3
     &ELSE SIZE 20 BY 1.91 &ENDIF NO-UNDO.

DEFINE RECTANGLE RECT-2
     EDGE-PIXELS 2 GRAPHIC-EDGE  NO-FILL
     &IF '{&WINDOW-SYSTEM}' = 'TTY':U &THEN SIZE 62 BY 1
     &ELSE SIZE 61.6 BY 1.38 &ENDIF.

DEFINE BUTTON btnOk     LABEL "OK" SIZE 11 BY .95 AUTO-GO.

DEFINE BUTTON btnCancel LABEL "Cancel" SIZE 11 BY .95.

&IF '{&WINDOW-SYSTEM}' <> 'TTY':U &THEN
  DEFINE BUTTON btnHelp   LABEL "&Help" SIZE 11 BY .95.
&ENDIF

/* ************************  Frame Definitions  *********************** */

DEFINE FRAME Dialog-Frame
     rsChoice
          &IF '{&WINDOW-SYSTEM}' = 'TTY':U &THEN AT ROW 2 COL 2
          &ELSE AT ROW 1.71 COL 3 &ENDIF NO-LABEL
     txtDateRange
          &IF '{&WINDOW-SYSTEM}' = 'TTY':U &THEN AT ROW 5 COL 2
          &ELSE AT ROW 3.95 COL 2.8 &ENDIF NO-LABEL
     fiStartDate
          &IF '{&WINDOW-SYSTEM}' = 'TTY':U &THEN AT ROW 6 COL 12 COLON-ALIGNED
          &ELSE AT ROW 4.86 COL 11.8 COLON-ALIGNED &ENDIF
     fiEndDate
          &IF '{&WINDOW-SYSTEM}' = 'TTY':U &THEN AT ROW 6 COL 43 COLON-ALIGNED
          &ELSE AT ROW 4.86 COL 43 COLON-ALIGNED &ENDIF
     btnOk
          &IF '{&WINDOW-SYSTEM}' = 'TTY':U &THEN AT ROW 9 COL 20
          &ELSE AT ROW 6.38 COL 3.4 &ENDIF
     btnCancel
          &IF '{&WINDOW-SYSTEM}' = 'TTY':U &THEN AT ROW 9 COL 32
          &ELSE AT ROW 6.38 COL 15.2 &ENDIF
     &IF '{&WINDOW-SYSTEM}' <> 'TTY':U &THEN
       btnHelp AT ROW 6.38 COL 52 
       RECT-2 AT ROW 6.14 COL 2.4 
     &ENDIF
     SPACE(1.19) SKIP(0.28)
    WITH VIEW-AS DIALOG-BOX KEEP-TAB-ORDER DEFAULT-BUTTON btnOk
         SIDE-LABELS NO-UNDERLINE THREE-D SCROLLABLE CENTERED
         TITLE gcTitle.


/* ***********  Runtime Attributes and AppBuilder Settings  *********** */
ASSIGN FRAME Dialog-Frame:SCROLLABLE = FALSE
       FRAME Dialog-Frame:HIDDEN     = TRUE.

IF SESSION:DISPLAY-TYPE = 'TTY':U  THEN 
  RUN CURRENT-WINDOW-layouts (INPUT 'Standard Character':U) NO-ERROR.

/* ************************  Control Triggers  ************************ */

ON WINDOW-CLOSE OF FRAME Dialog-Frame
  APPLY "END-ERROR" TO SELF.

&IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN
  ON CHOOSE OF btnHelp IN FRAME Dialog-Frame /* Help */ OR 
     HELP   OF FRAME {&FRAME-NAME} 
    RUN "adecomm/_adehelp.p" ( INPUT "admn", 
                               INPUT "CONTEXT", 
                               INPUT iContextId,
                               INPUT ?).
&ENDIF

ON VALUE-CHANGED OF rsChoice IN FRAME Dialog-Frame DO:
  DEFINE VARIABLE lFound AS LOGICAL     NO-UNDO.

  IF SELF:SCREEN-VALUE = "1" THEN
    DISABLE {&DATE-RANGE} WITH FRAME {&FRAME-NAME}.
  ELSE DO:
    IF "9" = pcMode THEN DO:
      lFound = ghBuffer:FIND-FIRST("USE-INDEX _auth-time",NO-LOCK) NO-ERROR.
      IF (lFound = TRUE) THEN DO:
        fiStartDate:SCREEN-VALUE = STRING(DATE(ghBuffer::_authentication-date-time)).
        lFound = ghBuffer:FIND-LAST("USE-INDEX _auth-time",NO-LOCK) NO-ERROR.
        IF (lFound = TRUE) THEN
          fiEndDate:SCREEN-VALUE = STRING(DATE(ghBuffer::_authentication-date-time)).
      END.
    END.
    ELSE DO:
      lFound = ghBuffer:FIND-FIRST("USE-INDEX _Audit-time",NO-LOCK) NO-ERROR.
      IF (lFound = TRUE) THEN DO:
        fiStartDate:SCREEN-VALUE = STRING(DATE(ghBuffer::_audit-date-time)).
        lFound = ghBuffer:FIND-LAST("USE-INDEX _Audit-time",NO-LOCK) NO-ERROR.
        IF (lFound = TRUE) THEN
          fiEndDate:SCREEN-VALUE = STRING(DATE(ghBuffer::_audit-date-time)).
      END.
    END.
    ENABLE {&DATE-RANGE} WITH FRAME {&FRAME-NAME}.
    APPLY "ENTRY" TO fiStartDate IN FRAME {&FRAME-NAME}.
  END.
END.

ON CHOOSE OF btnOk IN FRAME Dialog-Frame 
  APPLY "GO" TO FRAME {&FRAME-NAME}.

ON END-ERROR OF FRAME Dialog-Frame DO:
  ASSIGN SESSION:DATE-FORMAT = gcDateFormat
         pcData              = ?.
  SESSION:SET-NUMERIC-FORMAT(gcNumSep,gcNumDec).
END.

ON GO OF FRAME Dialog-Frame DO:
  IF rsChoice:SCREEN-VALUE = "1" THEN
    pcData = "All".
  ELSE pcData = STRING(fiStartDate:SCREEN-VALUE) + "," +
                     STRING(fiEndDate:SCREEN-VALUE).
  SESSION:DATE-FORMAT       = gcDateFormat.
  SESSION:SET-NUMERIC-FORMAT(gcNumSep,gcNumDec).
END.

ON CHOOSE OF btnCancel IN FRAME Dialog-Frame 
  APPLY "WINDOW-CLOSE" TO FRAME {&FRAME-NAME}.

/* ***************************  Main Block  *************************** */

/* Parent the dialog-box to the ACTIVE-WINDOW, if there is no parent.   */
IF VALID-HANDLE(ACTIVE-WINDOW) AND FRAME {&FRAME-NAME}:PARENT eq ? THEN 
  FRAME {&FRAME-NAME}:PARENT = ACTIVE-WINDOW.

/* Now enable the interface and wait for the exit condition.            */
/* (NOTE: handle ERROR and END-KEY so cleanup code will always fire.    */
MAIN-BLOCK:
DO ON ERROR   UNDO MAIN-BLOCK, LEAVE MAIN-BLOCK
   ON END-KEY UNDO MAIN-BLOCK, LEAVE MAIN-BLOCK:
   
  PAUSE 0 NO-MESSAGE.
  lImmedDisp = SESSION:IMMEDIATE-DISPLAY.
  SESSION:IMMEDIATE-DISPLAY = TRUE.

  RUN enable_UI.
  APPLY 'VALUE-CHANGED' TO rsChoice IN FRAME {&FRAME-NAME}.
  WAIT-FOR GO OF FRAME {&FRAME-NAME}.
END.
SESSION:IMMEDIATE-DISPLAY = lImmedDisp.
RUN disable_UI.

/* **********************  Internal Procedures  *********************** */

PROCEDURE disable_UI :
/*------------------------------------------------------------------------------
  Purpose:     DISABLE the User Interface
  Parameters:  <none>
  Notes:       Here we clean-up the user-interface by deleting
               dynamic widgets we have created and/or hide 
               frames.  This procedure is usually called when
               we are ready to "clean-up" after running.
------------------------------------------------------------------------------*/
  /* Hide all frames. */
  HIDE FRAME Dialog-Frame.
END PROCEDURE.

PROCEDURE enable_UI :
/*------------------------------------------------------------------------------
  Purpose:     ENABLE the User Interface
  Parameters:  <none>
  Notes:       Here we display/view/enable the widgets in the
               user-interface.  In addition, OPEN all queries
               associated with each FRAME and BROWSE.
               These statements here are based on the "Other 
               Settings" section of the widget Property Sheets.
------------------------------------------------------------------------------*/
  DISPLAY rsChoice fiStartDate fiEndDate txtDateRange 
      WITH FRAME Dialog-Frame.
  
  ENABLE {&ENABLED-OBJECTS}
         &IF "{&WINDOW-SYSTEM}" NE "TTY" &THEN
           btnHelp RECT-2 &ENDIF
      WITH FRAME Dialog-Frame.
  VIEW FRAME Dialog-Frame.
  
END PROCEDURE.

PROCEDURE CURRENT-WINDOW-layouts:
  DEFINE INPUT PARAMETER layout AS CHARACTER                     NO-UNDO.
  DEFINE VARIABLE lbl-hndl AS WIDGET-HANDLE                      NO-UNDO.
  DEFINE VARIABLE widg-pos AS DECIMAL                            NO-UNDO.

  /* Copy the name of the active layout into a variable accessible to   */
  /* the rest of this file.                                             */
  CURRENT-WINDOW-layout = layout.

  CASE layout:
    WHEN "Master Layout" THEN DO WITH FRAME {&FRAME-NAME}:
      ASSIGN &IF '{&WINDOW-SYSTEM}' NE 'TTY':U &THEN
               FRAME Dialog-Frame:HIDDEN       = yes &ENDIF
             FRAME Dialog-Frame:HEIGHT         = 6.81 + 
                                                 FRAME Dialog-Frame:BORDER-TOP + 
                                                 FRAME Dialog-Frame:BORDER-BOTTOM
             FRAME Dialog-Frame:WIDTH          = 64.2 + 
                                                 FRAME Dialog-Frame:BORDER-LEFT + 
                                                 FRAME Dialog-Frame:BORDER-RIGHT.

      ASSIGN btnCancel:HIDDEN                  = yes
             btnCancel:COL                     = 15.2
             btnCancel:HEIGHT                  = .95
             btnCancel:ROW                     = 6.38
             btnCancel:HIDDEN                  = no.

      &IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN
        ASSIGN btnHelp:HIDDEN                  = yes
               btnHelp:COL                     = 52
               btnHelp:HEIGHT                  = .95
               btnHelp:ROW                     = 6.38
               btnHelp:HIDDEN                  = no
               btnHelp:HIDDEN                  = no.

        ASSIGN RECT-2:HIDDEN                   = yes
               RECT-2:COL                      = 2.4
               RECT-2:HEIGHT                   = 1.38
               RECT-2:ROW                      = 6.14
               RECT-2:WIDTH                    = 61.6
               RECT-2:HIDDEN                   = no.
      &ENDIF
                                               
      ASSIGN btnOk:HIDDEN                      = yes
             btnOk:COL                         = 3.4
             btnOk:HEIGHT                      = .95
             btnOk:ROW                         = 6.38
             btnOk:HIDDEN                      = no.

      ASSIGN fiEndDate:HIDDEN                  = yes
             widg-pos                          = fiEndDate:ROW  
             fiEndDate:ROW                     = 4.86
             lbl-hndl                          = fiEndDate:SIDE-LABEL-HANDLE  
             lbl-hndl:ROW                      = lbl-hndl:ROW + 
                                                 fiEndDate:ROW - widg-pos
             fiEndDate:WIDTH                   = 16.4
             fiEndDate:HIDDEN                  = no.

      ASSIGN fiStartDate:HIDDEN                = yes
             widg-pos                          = fiStartDate:COL  
             fiStartDate:COL                   = 13.8
             lbl-hndl                          = fiStartDate:SIDE-LABEL-HANDLE  
             lbl-hndl:COL                      = lbl-hndl:COL + 
                                                 fiStartDate:COL - widg-pos
             widg-pos                          = fiStartDate:ROW  
             fiStartDate:ROW                   = 4.86
             lbl-hndl                          = fiStartDate:SIDE-LABEL-HANDLE  
             lbl-hndl:ROW                      = lbl-hndl:ROW + 
                                                 fiStartDate:ROW - widg-pos
             fiStartDate:WIDTH                 = 16.4
             fiStartDate:HIDDEN                = no.

      ASSIGN rsChoice:HIDDEN                   = yes
             rsChoice:COL                      = 3
             rsChoice:HEIGHT                   = 1.91
             rsChoice:ROW                      = 1.71
             rsChoice:HIDDEN                   = no.

      ASSIGN txtDateRange:HIDDEN               = yes
             txtDateRange:COL                  = 2.8
             txtDateRange:HEIGHT               = .62
             txtDateRange:ROW                  = 3.95
             txtDateRange:HIDDEN               = no.

      ASSIGN FRAME Dialog-Frame:VIRTUAL-HEIGHT = 10.76
                    WHEN FRAME Dialog-Frame:SCROLLABLE
             FRAME Dialog-Frame:VIRTUAL-WIDTH  = 64.20
                    WHEN FRAME Dialog-Frame:SCROLLABLE
             &IF '{&WINDOW-SYSTEM}' NE 'TTY':U &THEN
               FRAME Dialog-Frame:HIDDEN       = no &ENDIF.

    END.  /* Master Layout Layout Case */

    WHEN "Standard Character":U THEN DO WITH FRAME {&FRAME-NAME}:
      ASSIGN &IF '{&WINDOW-SYSTEM}' NE 'TTY':U &THEN
               FRAME Dialog-Frame:HIDDEN       = yes &ENDIF
             FRAME Dialog-Frame:HEIGHT         = 9 + 
                                                 FRAME Dialog-Frame:BORDER-TOP + 
                                                 FRAME Dialog-Frame:BORDER-BOTTOM
             FRAME Dialog-Frame:WIDTH          = 64 + 
                                                 FRAME Dialog-Frame:BORDER-LEFT + 
                                                 FRAME Dialog-Frame:BORDER-RIGHT 
           NO-ERROR.

      ASSIGN btnCancel:HIDDEN                  = yes
             btnCancel:COL                     = 32
             btnCancel:HEIGHT                  = 1
             btnCancel:ROW                     = 9
             btnCancel:HIDDEN                  = no NO-ERROR.

      ASSIGN btnOk:HIDDEN                      = yes
             btnOk:COL                         = 20
             btnOk:HEIGHT                      = 1
             btnOk:ROW                         = 9
             btnOk:HIDDEN                      = no NO-ERROR.

      ASSIGN fiEndDate:HIDDEN                  = yes
             widg-pos                          = fiEndDate:ROW  
             fiEndDate:ROW                     = 6
             lbl-hndl                          = fiEndDate:SIDE-LABEL-HANDLE  
             lbl-hndl:ROW                      = lbl-hndl:ROW + 
                                                 fiEndDate:ROW - widg-pos
             fiEndDate:WIDTH                   = 16
             fiEndDate:HIDDEN                  = no NO-ERROR.

      ASSIGN fiStartDate:HIDDEN                = yes
             widg-pos                          = fiStartDate:COL  
             fiStartDate:COL                   = 14
             lbl-hndl                          = fiStartDate:SIDE-LABEL-HANDLE  
             lbl-hndl:COL                      = lbl-hndl:COL + 
                                                 fiStartDate:COL - widg-pos
             widg-pos                          = fiStartDate:ROW  
             fiStartDate:ROW                   = 6
             lbl-hndl                          = fiStartDate:SIDE-LABEL-HANDLE  
             lbl-hndl:ROW                      = lbl-hndl:ROW + 
                                                 fiStartDate:ROW - widg-pos
             fiStartDate:WIDTH                 = 16
             fiStartDate:HIDDEN                = no NO-ERROR.

      ASSIGN rsChoice:HIDDEN                   = yes
             rsChoice:COL                      = 2
             rsChoice:HEIGHT                   = 3
             rsChoice:ROW                      = 2
             rsChoice:HIDDEN                   = no NO-ERROR.

      ASSIGN txtDateRange:HIDDEN               = yes
             txtDateRange:COL                  = 2
             txtDateRange:HEIGHT               = 1
             txtDateRange:ROW                  = 5
             txtDateRange:HIDDEN               = no NO-ERROR.

      ASSIGN FRAME Dialog-Frame:VIRTUAL-HEIGHT = 11.00
                    WHEN FRAME Dialog-Frame:SCROLLABLE
             FRAME Dialog-Frame:VIRTUAL-WIDTH  = 64.00
                    WHEN FRAME Dialog-Frame:SCROLLABLE
             &IF '{&WINDOW-SYSTEM}' NE 'TTY':U &THEN
               FRAME Dialog-Frame:HIDDEN       = no &ENDIF NO-ERROR.

    END.  /* Standard Character Layout Case */

  END CASE.
END PROCEDURE.  /* CURRENT-WINDOW-layouts */
/*************************************************************/
/* Copyright (c) 1984-2005,2008,2010 by Progress Software Corporation  */
/*                                                           */
/* All rights reserved.  No part of this program or document */
/* may be  reproduced in  any form  or by  any means without */
/* permission in writing from PROGRESS Software Corporation. */
/*************************************************************/
/*----------------------------------------------------------------------------

File: adecomm/_auddtl.p

Description:
   Details frame for displaying audit data and audit data values.
   Called by selecting a record in Custom Filter browse.
 
Input Parameters:
   prRowid - Rowid of record to display
   pcTable - Table name to display
   phQuery - Handle to the query for the audData browse   
   
Author: Kenneth S. McIntosh

Date Created: August 19, 2005
History:
      fernando Aug  11, 2008 Fixing _Transaction-id format
      fernando 01/05/2010    Expanding _Transaction-id format

----------------------------------------------------------------------------*/
{adecomm/commeng.i}  /* Help contexts */
{adecomm/adestds.i}  /* Standard layout defines, colors etc. */
{adecomm/adeintl.i}  /* International support */
{adecomm/aud-tts.i}  /* Audit Data Temp-Tables */

DEFINE INPUT  PARAMETER prRowid AS ROWID       NO-UNDO.
DEFINE INPUT  PARAMETER pcTable AS CHARACTER   NO-UNDO.
DEFINE INPUT  PARAMETER phQuery AS HANDLE      NO-UNDO.

DEFINE VARIABLE grCurrentData AS ROWID       NO-UNDO.
DEFINE VARIABLE grCurrentVal  AS ROWID       NO-UNDO.

DEFINE VARIABLE gcReportType  AS CHARACTER   NO-UNDO.
DEFINE VARIABLE rsSortVals    AS CHARACTER   NO-UNDO
  VIEW-AS RADIO-SET
    RADIO-BUTTONS "Field Name","_field-name",
                  "Continuation Sequence","cs",
                  "Data Type","_data-type-name"
    HORIZONTAL.
DEFINE VARIABLE gcLastSort    AS CHARACTER   NO-UNDO.

DEFINE VARIABLE glEnd         AS LOGICAL     NO-UNDO.

DEFINE BUTTON btnOk      LABEL "OK"       {&STDPH_OKBTN} AUTO-GO.
DEFINE BUTTON btnNext    LABEL "&Next"    {&STDPH_OKBTN}.
DEFINE BUTTON btnPrev    LABEL "&Prev"    {&STDPH_OKBTN}.
DEFINE BUTTON btnFirst   LABEL "&First"   {&STDPH_OKBTN}.
DEFINE BUTTON btnLast    LABEL "&Last"    {&STDPH_OKBTN}.

&IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN
  DEFINE BUTTON    btnHelp  LABEL "&Help" {&STDPH_OKBTN}.
  DEFINE RECTANGLE rectBtns {&STDPH_OKBOX}. /* standard button rectangle */
  
  &GLOBAL-DEFINE HLP_BTN  &HELP = "btnHelp"
  &GLOBAL-DEFINE SPC      10
  &GLOBAL-DEFINE SUMMARY guiSummaryFrame
  &GLOBAL-DEFINE DETAIL  guiDetailFrame
&ELSE
  &GLOBAL-DEFINE HLP_BTN  
  &GLOBAL-DEFINE SPC     5 
  &GLOBAL-DEFINE SUMMARY ttySummaryFrame
  &GLOBAL-DEFINE DETAIL  ttyDetailFrame
&ENDIF

DEFINE QUERY qAudDataValue   FOR audDataValue SCROLLING.

DEFINE BROWSE bAudDataValue QUERY qAudDataValue
        DISPLAY audDataValue._field-name
                audDataValue._continuation-sequence
                audDataValue._data-type-name
        &IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN
          ENABLE audDataValue._field-name &ENDIF
        WITH WIDTH &IF "{&WINDOW-SYSTEM}" = "TTY" &THEN 76 2
                   &ELSE 98 5 &ENDIF DOWN FONT 0 
                   EXPANDABLE SCROLLBAR-VERTICAL .

/*=========================== Forms ====================================*/

&IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN
  FORM SKIP(1) 
     audData._audit-data-guid FORMAT "x(30)" 
                              COLON 33
                              VIEW-AS TEXT SKIP
     audData._transaction-id  FORMAT "->>>>>>>>>9"
                              COLON 33 
                              VIEW-AS TEXT SKIP
     audData._transaction-seq FORMAT ">>>>>ZZZ"
                              COLON 33 
                              VIEW-AS TEXT SKIP
     audData._audit-date-time FORMAT "99/99/9999 HH:MM:SS AM" 
                              COLON 33 
                              VIEW-AS TEXT SKIP
     audData._event-name      FORMAT "x(40)" 
                              COLON 33 
                              VIEW-AS TEXT SKIP
     audData._event-type      FORMAT "x(40)" 
                              COLON 33 
                              VIEW-AS TEXT SKIP
     audData._db-guid         FORMAT "x(45)" 
                              COLON 33 
                              VIEW-AS TEXT SKIP
     audData._db-description  FORMAT "x(40)" 
                              COLON 33 
                              VIEW-AS TEXT SKIP
     audData._database-connection-id
                              FORMAT "x(40)" 
                              COLON 33 
                              VIEW-AS TEXT SKIP
     audData._client-session-uuid
                              FORMAT "x(40)" 
                              COLON 33 
                              VIEW-AS TEXT SKIP
     audData._Audit-data-security-level-name
                              FORMAT "x(35)" 
                              LABEL "Security Level"
                              COLON 33 
                              VIEW-AS TEXT SKIP
     audData._data-sealed     FORMAT "Yes/No" 
                              COLON 33 
                              VIEW-AS TEXT SKIP(1)
     bAudDataValue

     {adecomm/okform.i
      &BOX    = rectBtns
      &STATUS = no
      &OK     = btnOK
      &OTHER  = " SPACE({&SPC}) btnFirst btnPrev btnNext btnLast "
      {&HLP_BTN}
     } 

  WITH FRAME guiSummaryFrame SIDE-LABELS 
                             WIDTH 100 
                             NO-ATTR-SPACE  
                             DOWN FONT 0
                             CANCEL-BUTTON btnOK SCROLLABLE
                             VIEW-AS DIALOG-BOX
                             TITLE "OpenEdge Custom Audit Filter Report".
&ELSE
  FORM  
     audData._audit-data-guid FORMAT "x(27)" 
                              COLON 18
                              VIEW-AS TEXT SKIP
     audData._transaction-id  FORMAT "->>>>>>>>>9" 
                              COLON 18 
                              VIEW-AS TEXT 
     audData._transaction-seq FORMAT "ZZZ"  
                              COLON 60
                              VIEW-AS TEXT 
                              LABEL "Txn Sequence" SKIP
     audData._Audit-data-security-level-name
                              FORMAT "x(33)"
                              LABEL "Security Level"
                              COLON 18
                              VIEW-AS TEXT
     audData._data-sealed     FORMAT "Yes/No"
                              LABEL "Sealed?"
                              COLON 60
                              VIEW-AS TEXT SKIP
     audData._audit-date-time FORMAT "99/99/9999 HH:MM:SS AM" 
                              COLON 18
                              VIEW-AS TEXT SKIP
     audData._event-name      FORMAT "x(25)" 
                              COLON 18 
                              VIEW-AS TEXT
     audData._event-type      FORMAT "x(15)"
                              COLON 60
                              VIEW-AS TEXT
     audData._db-guid         FORMAT "x(27)" 
                              COLON 18 
                              VIEW-AS TEXT
                              LABEL "Db Identifier" SKIP
     audData._db-description  FORMAT "x(55)" 
                              COLON 18
                              LABEL "Db Description" SKIP
     audData._database-connection-id
                              FORMAT "x(27)" 
                              COLON 18 
                              VIEW-AS TEXT 
                              LABEL "Db Connection Id" SKIP
     audData._client-session-uuid
                              FORMAT "x(27)" 
                              COLON 18
                              VIEW-AS TEXT
                              LABEL "Client Sess UUID" SKIP
     rsSortVals               LABEL "Sort by" SKIP
     bAudDataValue            

     {adecomm/okform.i
      &BOX    = rectBtns
      &STATUS = no
      &OK     = btnOK
      &OTHER  = " SPACE({&SPC}) btnFirst btnPrev btnNext btnLast "
      {&HLP_BTN}
     } 

  WITH FRAME ttySummaryFrame SIDE-LABELS 
                             WIDTH 78
                             NO-ATTR-SPACE  
                             DOWN FONT 0
                             CANCEL-BUTTON btnOK SCROLLABLE
                             VIEW-AS DIALOG-BOX
                             TITLE "OpenEdge Custom Audit Filter Report"
                             ROW 1.

&ENDIF

&IF "{&WINDOW-SYSTEM}" = "TTY" &THEN 
  BROWSE bAudDataValue:HELP    = 
        "Select record and hit " + KBLABEL("RETURN") + " to view details...".
&ELSE
  BROWSE bAudDataValue:TOOLTIP = 
        "Double-Click or hit " + KBLABEL("RETURN") + " to view details...".
  audDataValue._field-name:READ-ONLY IN BROWSE bAudDataValue = TRUE.
&ENDIF

FORM audDataValue._audit-data-guid  FORMAT "x(30)"
                                    LABEL "Audit data guid"
                                    VIEW-AS TEXT
                                    COLON 25
     audDataValue._continuation-sequence FORMAT "->9"
                                    LABEL "Event Sequence"
                                    VIEW-AS TEXT
                                    COLON 25 
     audDataValue._field-name       FORMAT "x(30)"
                                    VIEW-AS TEXT
                                    COLON 25 
     audDataValue._data-type-name   FORMAT "x(30)"
                                    VIEW-AS TEXT
                                    COLON 25
     audDataValue._old-string-value FORMAT "x(30)"
                                    VIEW-AS EDITOR
                                            SIZE 60 BY 3
                                    COLON 25 
     audDataValue._new-string-value FORMAT "x(30)"
                                    VIEW-AS EDITOR
                                            SIZE 60 BY 3
                                    COLON 25 SKIP(1)

    {adecomm/okform.i
      &BOX    = rectBtns
      &STATUS = no
      &OK     = btnOK
      &OTHER  = "SPACE({&SPC}) btnFirst btnPrev btnNext btnLast "
      {&HLP_BTN}
     }

    WITH FRAME guiDetailFrame SIDE-LABELS
                           NO-ATTR-SPACE USE-TEXT
                           WIDTH &IF "{&WINDOW-SYSTEM}" = "TTY" &THEN 78
                                 &ELSE 100 &ENDIF
                           DOWN CANCEL-BUTTON btnOK
                           SCROLLABLE FONT 0
                           VIEW-AS DIALOG-BOX
                           TITLE "OpenEdge Custom Audit Filter Report". 

FORM audDataValue._audit-data-guid  FORMAT "x(30)"
                                    LABEL "Audit data guid"
                                    VIEW-AS TEXT
                                    COLON 25
     audDataValue._continuation-sequence FORMAT "->9"
                                    LABEL "Event Sequence"
                                    VIEW-AS TEXT
                                    COLON 25 
     audDataValue._field-name       FORMAT "x(30)"
                                    VIEW-AS TEXT
                                    COLON 25 
     audDataValue._data-type-name   FORMAT "x(30)"
                                    VIEW-AS TEXT
                                    COLON 25
     audDataValue._old-string-value FORMAT "x(30)"
                                    VIEW-AS EDITOR
                                            SIZE 50 BY 3
                                    COLON 25 
     audDataValue._new-string-value FORMAT "x(30)"
                                    VIEW-AS EDITOR
                                            SIZE 50 BY 3
                                    COLON 25 SKIP(1)

    {adecomm/okform.i
      &BOX    = rectBtns
      &STATUS = no
      &OK     = btnOK
      &OTHER  = "SPACE({&SPC}) btnFirst btnPrev btnNext btnLast "
      {&HLP_BTN}
     }

    WITH FRAME ttyDetailFrame SIDE-LABELS
                           NO-ATTR-SPACE USE-TEXT
                           WIDTH &IF "{&WINDOW-SYSTEM}" = "TTY" &THEN 78
                                 &ELSE 100 &ENDIF
                           DOWN CANCEL-BUTTON btnOK
                           SCROLLABLE FONT 0
                           VIEW-AS DIALOG-BOX
                           TITLE "OpenEdge Custom Audit Filter Report". 

&IF "{&WINDOW-SYSTEM}" = "TTY" &THEN
  rsSortVals:HELP IN FRAME ttySummaryFrame = "Select item to sort browse. (" +
                                             KBLABEL("CTRL-R") +
                                             " to reverse direction)".
&ENDIF

/*===========================Control Triggers=============================*/
ON START-SEARCH OF BROWSE bAudDataValue DO:
  DEFINE VARIABLE hCol AS HANDLE      NO-UNDO.

  hCol = SELF:CURRENT-COLUMN.
  RUN resortQuery ( INPUT hCol:NAME ).
  APPLY "END-SEARCH" TO SELF.
END.

ON DEFAULT-ACTION OF BROWSE bAudDataValue DO:
  IF NOT AVAILABLE audDataValue THEN
    RETURN NO-APPLY.

  grCurrentVal = ROWID(audDataValue).

  gcReportType = "audDataValue".

  RUN initializeUI ( INPUT grCurrentVal  ).
  HIDE FRAME {&DETAIL}.

  gcReportType = "audData".
END.

&IF "{&WINDOW-SYSTEM}" = "TTY" &THEN
  ON VALUE-CHANGED OF rsSortVals IN FRAME {&SUMMARY}
    RUN resortQuery ( INPUT SELF:SCREEN-VALUE ).

  ON CTRL-R OF rsSortVals IN FRAME {&SUMMARY}
    RUN resortQuery ( INPUT SELF:SCREEN-VALUE ).
&ENDIF

ON CHOOSE OF btnOk IN FRAME {&SUMMARY} OR
   GO     OF          FRAME {&SUMMARY}
  glEnd = TRUE.

ON CHOOSE OF btnLast IN FRAME {&SUMMARY} DO:
  DEFINE VARIABLE rTempRow AS ROWID       NO-UNDO.

  DEFINE VARIABLE hBuffer  AS HANDLE      NO-UNDO.

  hBuffer = phQuery:GET-BUFFER-HANDLE(1).

  phQuery:GET-LAST() NO-ERROR.

  IF NOT hBuffer:AVAILABLE THEN DO:
    MESSAGE "You have reached the last Audit Data record."
        VIEW-AS ALERT-BOX INFO BUTTONS OK.
    RETURN NO-APPLY.
  END.

  rTempRow = hBuffer:ROWID.
  FIND audData WHERE ROWID(audData) = rTempRow NO-LOCK NO-ERROR.
  RUN showAudData.
  grCurrentData = ROWID(audData).
END.

ON CHOOSE OF btnNext IN FRAME {&SUMMARY} DO:
  DEFINE VARIABLE rTempRow AS ROWID       NO-UNDO.

  DEFINE VARIABLE hBuffer  AS HANDLE      NO-UNDO.

  hBuffer = phQuery:GET-BUFFER-HANDLE(1).

  phQuery:REPOSITION-TO-ROWID(grCurrentData).
  phQuery:GET-NEXT() NO-ERROR.

  IF NOT hBuffer:AVAILABLE THEN DO:
    MESSAGE "You have reached the last Audit Data record."
        VIEW-AS ALERT-BOX INFO BUTTONS OK.
    RETURN NO-APPLY.
  END.

  rTempRow = hBuffer:ROWID.
  FIND audData WHERE ROWID(audData) = rTempRow NO-LOCK NO-ERROR.
  RUN showAudData.
  grCurrentData = ROWID(audData).
END.

ON CHOOSE OF btnPrev IN FRAME {&SUMMARY} DO:
  DEFINE VARIABLE rTempRow AS ROWID       NO-UNDO.

  DEFINE VARIABLE hBuffer  AS HANDLE      NO-UNDO.

  hBuffer = phQuery:GET-BUFFER-HANDLE(1).

  phQuery:REPOSITION-TO-ROWID(grCurrentData).
  phQuery:GET-PREV() NO-ERROR.

  IF NOT hBuffer:AVAILABLE THEN DO:
    MESSAGE "You have reached the first Audit Data record."
        VIEW-AS ALERT-BOX INFO BUTTONS OK.
    RETURN NO-APPLY.
  END.

  rTempRow = hBuffer:ROWID.
  FIND audData WHERE ROWID(audData) = rTempRow NO-LOCK NO-ERROR.
  RUN showAudData.
  grCurrentData = ROWID(audData).
END.

ON CHOOSE OF btnFirst IN FRAME {&SUMMARY} DO:
  DEFINE VARIABLE rTempRow AS ROWID       NO-UNDO.

  DEFINE VARIABLE hBuffer  AS HANDLE      NO-UNDO.

  hBuffer = phQuery:GET-BUFFER-HANDLE(1).

  phQuery:GET-FIRST() NO-ERROR.

  IF NOT hBuffer:AVAILABLE THEN DO:
    MESSAGE "You have reached the first Audit Data record."
        VIEW-AS ALERT-BOX INFO BUTTONS OK.
    RETURN NO-APPLY.
  END.

  rTempRow = hBuffer:ROWID.
  FIND audData WHERE ROWID(audData) = rTempRow NO-LOCK NO-ERROR.
  RUN showAudData.
  grCurrentData = ROWID(audData).
END.

ON CHOOSE OF btnNext IN FRAME {&DETAIL} DO:
  QUERY qAudDataValue:REPOSITION-TO-ROWID(grCurrentVal).
  QUERY qAudDataValue:GET-NEXT() NO-ERROR.
  
  IF NOT AVAILABLE audDataValue THEN DO:
    MESSAGE "You have reached the last Audit Data Value record."
        VIEW-AS ALERT-BOX INFO BUTTONS OK.
    RETURN NO-APPLY.
  END.
  RUN showAudDataValue.
  grCurrentVal = ROWID(audDataValue).
END.

ON CHOOSE OF btnLast IN FRAME {&DETAIL} DO:
  QUERY qAudDataValue:GET-LAST() NO-ERROR.
  
  IF NOT AVAILABLE audDataValue THEN DO:
    MESSAGE "You have reached the last Audit Data Value record."
        VIEW-AS ALERT-BOX INFO BUTTONS OK.
    RETURN NO-APPLY.
  END.
  RUN showAudDataValue.
  grCurrentVal = ROWID(audDataValue).
END.

ON CHOOSE OF btnPrev IN FRAME {&DETAIL} DO:
  QUERY qAudDataValue:REPOSITION-TO-ROWID(grCurrentVal).
  QUERY qAudDataValue:GET-PREV() NO-ERROR.
  
  IF NOT AVAILABLE audDataValue THEN DO:
    MESSAGE "You have reached the first Audit Data Value  record."
        VIEW-AS ALERT-BOX INFO BUTTONS OK.
    RETURN NO-APPLY.
  END.
  RUN showAudDataValue.
  grCurrentVal = ROWID(audDataValue).
END.

ON CHOOSE OF btnFirst IN FRAME {&DETAIL} DO:
  QUERY qAudDataValue:GET-FIRST() NO-ERROR.
  
  IF NOT AVAILABLE audDataValue THEN DO:
    MESSAGE "You have reached the first Audit Data Value  record."
        VIEW-AS ALERT-BOX INFO BUTTONS OK.
    RETURN NO-APPLY.
  END.
  RUN showAudDataValue.
  grCurrentVal = ROWID(audDataValue).
END.

/*=============================Main Block===============================*/
MAIN-BLK:
DO ON ERROR  UNDO MAIN-BLK, LEAVE MAIN-BLK 
   ON ENDKEY UNDO MAIN-BLK, LEAVE MAIN-BLK:
  /* Fix up report frame */
  {adecomm/okrun.i  
     &FRAME  = "FRAME {&SUMMARY}" 
     &BOX    = "rectBtns"
     &OK     = "btnOK"
     &OTHER  = " SPACE({&SPC}) btnFirst btnPrev btnNext btnLast "
     {&HLP_BTN}
  }

  /* Fix up detail frame */
  {adecomm/okrun.i  
     &FRAME  = "FRAME {&DETAIL}" 
     &BOX    = "rectBtns"
     &OK     = "btnOK"
     &OTHER  = " SPACE({&SPC}) btnFirst btnPrev btnNext btnLast "
     {&HLP_BTN}
  }

  grCurrentData = prRowid.
  gcReportType = pcTable.
  RUN initializeUI ( INPUT prRowid ).
END.

/*======================Internal Procedures=============================*/

PROCEDURE initializeUI:
  DEFINE INPUT  PARAMETER prRowid AS ROWID       NO-UNDO.

  VIEW FRAME {&SUMMARY}.

  IF gcReportType EQ "audData" THEN DO:
    FIND audData WHERE ROWID(audData) = prRowid NO-LOCK NO-ERROR.
    IF NOT AVAILABLE audData THEN RETURN "No Record".

    RUN showAudData.

    REPEAT ON ERROR  UNDO, LEAVE
           ON ENDKEY UNDO, LEAVE:
      WAIT-FOR DEFAULT-ACTION OF          FRAME {&SUMMARY} OR
               CHOOSE         OF btnOk IN FRAME {&SUMMARY} OR
               GO             OF          FRAME {&SUMMARY}
              FOCUS bAudDataValue.
      IF glEnd = TRUE THEN LEAVE.
    END.
  END.
  ELSE DO:
    FIND audDataValue WHERE ROWID(audDataValue) = prRowid NO-LOCK NO-ERROR.
    IF NOT AVAILABLE audDataValue THEN RETURN "No Record".

    RUN showAudDataValue.

    DO ON ERROR  UNDO, LEAVE 
       ON ENDKEY UNDO, LEAVE:
      WAIT-FOR CHOOSE OF btnOK IN FRAME {&DETAIL} OR
               GO     OF          FRAME {&DETAIL}
              FOCUS audDataValue._old-string-value.
    END.
    HIDE FRAME {&DETAIL}.
  END.
END PROCEDURE.

PROCEDURE resortQuery:
  DEFINE INPUT  PARAMETER pcColumn AS CHARACTER   NO-UNDO.

  DEFINE VARIABLE cSort  AS CHARACTER   NO-UNDO.

  DEFINE VARIABLE hQuery AS HANDLE      NO-UNDO.

  CASE pcColumn:
    WHEN "cs" THEN DO:
      IF gcLastSort = pcColumn THEN
        ASSIGN cSort      = " BY _continuation-sequence DESC"
               gcLastSort = "_continuation-sequence DESC".
      ELSE 
        ASSIGN cSort      = " BY _continuation-sequence "
               gcLastSort = "_continuation-sequence".
    END.
    OTHERWISE DO:
      IF gcLastSort = pcColumn THEN
        ASSIGN cSort      = " BY " + pcColumn + " DESC" + 
                            " BY _continuation-sequence" 
               gcLastSort = pcColumn + " DESC".
      ELSE 
        ASSIGN cSort      = " BY " + pcColumn + 
                            " BY _continuation-sequence"
               gcLastSort = pcColumn.
    END.
  END CASE.

  hQuery = QUERY qAudDataValue:HANDLE.

  hQuery:QUERY-CLOSE.
  hQuery:QUERY-PREPARE("FOR EACH audDataValue NO-LOCK " + 
                       "WHERE audDataValue._audit-data-guid EQ ~"" +
                       audData._audit-data-guid + "~"" + cSort).
  hQuery:QUERY-OPEN().
END PROCEDURE.

PROCEDURE showAudData:
  DISPLAY audData._audit-data-guid
          audData._transaction-id
          audData._transaction-seq
          audData._Audit-data-security-level-name
          audData._data-sealed
          audData._audit-date-time
          audData._event-name
          audData._event-type
          audData._db-guid
          audData._db-description
          audData._database-connection-id
          audData._client-session-uuid
          audData._Audit-data-security-level-name
          audData._data-sealed
          &IF "{&WINDOW-SYSTEM}" = "TTY" &THEN 
            rsSortVals &ENDIF
      WITH FRAME {&SUMMARY}.

  OPEN QUERY qAudDataValue FOR EACH audDataValue NO-LOCK
      WHERE audDataValue._audit-data-guid EQ audData._audit-data-guid
            BY _continuation-sequence.

  gcLastSort = "_continuation-sequence".

  ENABLE &IF "{&WINDOW-SYSTEM}" = "TTY" &THEN 
             rsSortVals &ENDIF
           bAudDataValue
           btnOk 
           btnFirst
           btnPrev
           btnNext
           btnLast
           &IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN 
             btnHelp &ENDIF
        WITH FRAME {&SUMMARY}.
END PROCEDURE.

PROCEDURE showAudDataValue:
  DISPLAY audDataValue._audit-data-guid
          audDataValue._continuation-sequence
          audDataValue._field-name
          audDataValue._data-type-name
          audDataValue._old-string-value
          audDataValue._new-string-value
      WITH FRAME {&DETAIL}.

  ENABLE audDataValue._old-string-value
         audDataValue._new-string-value
         btnOk 
         btnFirst
         btnPrev
         btnNext
         btnLast
         &IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN 
           btnHelp &ENDIF
      WITH FRAME {&DETAIL}.

  audDataValue._old-string-value:READ-ONLY IN FRAME {&DETAIL} = TRUE.
  audDataValue._new-string-value:READ-ONLY IN FRAME {&DETAIL} = TRUE.
END PROCEDURE.
/*************************************************************/
/* Copyright (c) 1984-2005,2008 by Progress Software Corporation  */
/*                                                           */
/* All rights reserved.  No part of this program or document */
/* may be  reproduced in  any form  or by  any means without */
/* permission in writing from PROGRESS Software Corporation. */
/*************************************************************/
/*----------------------------------------------------------------------------

File: adecomm/_audrpt.p

Description:
   Report template for auditing reports.
 
Input Parameters:
   pcDbRecid - Recid of the _Db record corresponding to the current database
   pcDbName  - Logical name of the database
   piReport  - Numeric Identifier of the report being called
               1    = Track Audit Policy Changes
               2    = Track Database Schema Changes
               3    = Track Audit Data Administration (Dump/Load)
               4    = Track Application Data Administration (Dump/Load)
               5    = Track User Account Changes
               6    = Track Security Permissions Changes
               7    = Track SQL Permissions Changes
               8    = Track Authentication System Changes
               9    = Client Session Authentication Report
               10   = Database Administration Report (Utilities)
               11   = Database Access Report (Login/Logout/etc...)
               12   = Custom Audit Data Filter
               13   = Encryption Policy Changes
               14   = Key-store Changes 
               15   = Database Encryption Administration (Utilities)

   pcFilter  - Date Range Filter criterea for the selected report
   
Author: Kenneth S. McIntosh

Date Created: June 7, 2005
History:

     kmcintos  Jan  03, 2006  Fixed printing bug 20051116-043.
     fernando  Dec  23, 2008  Support for Encryption reports
----------------------------------------------------------------------------*/
&GLOBAL-DEFINE WIN95-BTN YES

{adecomm/commeng.i}      /* Help contexts */
{adecomm/adestds.i}      /* Standard layout defines, colors etc. */
{adecomm/adeintl.i}      /* International support */

DEFINE INPUT  PARAMETER prDbRecid AS RECID       NO-UNDO.
DEFINE INPUT  PARAMETER pcDbName  AS CHARACTER   NO-UNDO.
DEFINE INPUT  PARAMETER piReport  AS INTEGER     NO-UNDO.
DEFINE INPUT  PARAMETER pcFilter  AS CHARACTER   NO-UNDO.

DEFINE NEW SHARED STREAM reportStream.

DEFINE VARIABLE lXmlFile     AS LOGICAL     NO-UNDO INITIAL TRUE.
DEFINE VARIABLE lOverwrite   AS LOGICAL     NO-UNDO.

DEFINE VARIABLE rsDevice     AS CHARACTER   NO-UNDO VIEW-AS RADIO-SET
    RADIO-BUTTONS "Terminal","T",
                  "Printer","P",
                  "File (XML)","Fx",
                  "File (Text)","Ft"
    INITIAL "T".

DEFINE VARIABLE hReport      AS HANDLE      NO-UNDO.

DEFINE BUTTON btnOk      LABEL "OK"       {&STDPH_OKBTN} AUTO-GO.
DEFINE BUTTON btnCancel  LABEL "Cancel"   {&STDPH_OKBTN} AUTO-ENDKEY.
DEFINE BUTTON btnFile    LABEL "&Files..." 
   &IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN SIZE 15 by 1.125 &ENDIF.

&IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN
  DEFINE BUTTON    btnHelp  LABEL "&Help" {&STDPH_OKBTN}.
  DEFINE RECTANGLE rectBtns {&STDPH_OKBOX}. /* standard button rectangle */
  &GLOBAL-DEFINE HLP_BTN  &HELP = "btnHelp"
&ELSE
   &GLOBAL-DEFINE HLP_BTN  
&ENDIF

{adecomm/rptvar.i}   /* Common Variables */

/*-------------------------------Forms------------------------------------*/
FORM SKIP({&TFM_WID})
     rsDevice   LABEL "&Send Output to" COLON 16 SKIP({&VM_WIDG})
     fiFileName LABEL "File Name" FORMAT "x({&PATH_WIDG})" 
                &IF "{&WINDOW-SYSTEM}" NE "TTY" &THEN 
                  AT ROW 5 COL 8 &ELSE COLON 16 &ENDIF
                VIEW-AS FILL-IN NATIVE 
                        SIZE 35 BY 1 {&STDPH_FILL} SPACE(.3)
     &IF "{&WINDOW-SYSTEM}" NE "TTY" &THEN
       cbPrinter  LABEL "Printer" 
                  FORMAT "x({&PATH_WIDG})" 
                  AT ROW 5 COL 11
     &ENDIF
     btnFile  AT 54 SKIP({&VM_WID})
     tbAppend   LABEL "&Append to Existing File?" AT 19
               VIEW-AS TOGGLE-BOX SKIP({&VM_WIDG})
     fiPgLength LABEL "&Page Length" 
                FORMAT ">>9" 
                COLON 16 {&STDPH_FILL}
     "(# Lines, 0 for Continuous)" SKIP({&VM_WIDG})
     txtReport[piReport] LABEL "Report" 
                         VIEW-AS TEXT 
                         COLON 16 SKIP({&VM_WIDG})
     rsDetail LABEL "Orientation" COLON 16
   {adecomm/okform.i
      &BOX    = rectBtns
      &STATUS = no
      &OK     = btnOK
      &CANCEL = btnCancel
      {&HLP_BTN}
   }
   WITH FRAME printOptions
      SIDE-LABELS 
      DEFAULT-BUTTON btnOK CANCEL-BUTTON btnCancel
      VIEW-AS DIALOG-BOX TITLE "OpenEdge Auditing Report Options".

&IF "{&WINDOW-SYSTEM}" NE "TTY" &THEN
  cbPrinter:LIST-ITEMS   = SESSION:GET-PRINTERS().
  cbPrinter:SCREEN-VALUE = SESSION:PRINTER-NAME.
  cbPrinter:VISIBLE      = FALSE.
&ENDIF

/*-----------------------------Triggers------------------------------------*/

/*----- OK or GO -----*/
ON GO OF FRAME printOptions DO:
  DEFINE VARIABLE lChoice AS LOGICAL     NO-UNDO.

  ASSIGN rsDevice
         fiFileName
         &IF "{&WINDOW-SYSTEM}" NE "TTY" &THEN cbPrinter &ENDIF
         fiPgLength
         tbAppend
         rsDetail.

  IF rsDevice BEGINS "F" THEN DO:
    IF fiFileName NE "" AND 
       fiFileName NE ? THEN
      ASSIGN fiFileName = TRIM(fiFileName)
             lXmlFile   = (rsDevice = "Fx").
    ELSE DO:
      MESSAGE "You must enter a filename!"
          VIEW-AS ALERT-BOX ERROR BUTTONS OK.
      APPLY "ENTRY" TO fiFileName IN FRAME printOptions.
      RETURN NO-APPLY.
    END.

    IF NOT tbAppend THEN DO:
      FILE-INFO:FILE-NAME = fiFileName.
      IF FILE-INFO:FULL-PATHNAME NE ? THEN DO:
        MESSAGE fiFileName "already exists. Overwrite?"
            VIEW-AS ALERT-BOX QUESTION BUTTONS YES-NO
                              UPDATE lOverwrite.
        IF NOT lOverwrite THEN DO:
          APPLY "ENTRY" TO fiFileName.
          RETURN NO-APPLY.
        END. /* Not overwrite */
      END. /* File Exists */
    END. /* Not Append */
    rsDevice = "F" + (IF lXmlFile THEN "x" ELSE "t") +
               CHR(1) + fiFileName.
  END. /* If rsDevice BEGINS F */
  &IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN
  ELSE IF rsDevice = "P" THEN
    rsDevice = "P" + CHR(1) + cbPrinter. &ENDIF
  ELSE IF rsDevice = "T" THEN
    rsDevice = "T" + CHR(1) + "".
  
  HIDE FRAME printOptions.

  RUN adecomm/_praudrpt.p ( INPUT rsDevice,
                            INPUT piReport,
                            INPUT pcFilter,
                            INPUT tbAppend,
                            INPUT fiPgLength,
                            INPUT pcDbName,
                            INPUT rsDetail ).

END. /* GO of frame printOptions */

/*----- VALUE-CHANGED of DEVICE RADIO SET -----*/
ON VALUE-CHANGED OF rsDevice IN FRAME printOptions DO:
   
   ASSIGN rsDevice.
   ASSIGN lXmlFile         = (rsDevice = "Fx")
          tbAppend:CHECKED = FALSE.

   IF rsDevice BEGINS "F" /* file */ THEN DO WITH FRAME printOptions:
     ASSIGN btnFile:LABEL             = "&Files..."
            fiFileName:SCREEN-VALUE   = cDefaultFile + 
                          (IF lXmlFile THEN ".xml" ELSE ".txt")
            fiFileName:VISIBLE        = TRUE
            fiPgLength:SCREEN-VALUE   = "0"
            fiPgLength:SENSITIVE      = FALSE
            tbAppend:SENSITIVE        = (NOT lXmlFile)
            fiPgLength:SENSITIVE      = (NOT lXmlFile)
            rsDetail:SCREEN-VALUE     = (IF lXmlFile THEN "yes" ELSE rsDetail:SCREEN-VALUE)
            rsDetail:SENSITIVE        = (NOT lXmlFile)
            &IF "{&WINDOW-SYSTEM}" = "TTY" &THEN 
              btnFile:VISIBLE         = TRUE
              btnFile:SENSITIVE       = TRUE
            &ELSE
              cbPrinter:VISIBLE       = FALSE
              fiFileName:SENSITIVE    = TRUE
              btnFile:SENSITIVE       = TRUE
            &ENDIF .
   END. /* Output to File */
   ELSE DO WITH FRAME printOptions:
      &IF "{&WINDOW-SYSTEM}" = "TTY" &THEN 
            ASSIGN fiFileName:VISIBLE      = FALSE
                   btnFile:VISIBLE         = FALSE
      &ELSE
            ASSIGN fiFileName:SENSITIVE    = FALSE
      &ENDIF 
                   fiFileName:SCREEN-VALUE = ""
                   tbAppend:SENSITIVE      = FALSE
                   fiPgLength:SENSITIVE    = TRUE
                   rsDetail:SENSITIVE      = TRUE.

      IF rsDevice = "T" THEN
            ASSIGN fiPgLength:SCREEN-VALUE = "0"
                   btnFile:SENSITIVE       = FALSE
                   &IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN
                     cbPrinter:SENSITIVE   = FALSE
                   &ENDIF .
      ELSE IF rsDevice = "P" THEN
            ASSIGN fiPgLength:SCREEN-VALUE  = "60"
                   &IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN
                     cbPrinter:VISIBLE      = TRUE        
                     cbPrinter:SCREEN-VALUE = SESSION:PRINTER-NAME
                     fiFileName:VISIBLE     = FALSE
                     cbPrinter:SENSITIVE    = TRUE
                     btnFile:SENSITIVE      = TRUE
                     btnFile:LABEL          = "Printer Setup"
                   &ENDIF .
   END. /* Output to Terminal or Printer */
END. /* Value-Changed of rsDevice */

ON RETURN OF rsDevice IN FRAME printOptions
  APPLY "GO" TO FRAME printOptions.
  
&IF "{&WINDOW-SYSTEM}" NE "TTY" &THEN
  ON VALUE-CHANGED OF cbPrinter IN FRAME printOptions
    SESSION:PRINTER-NAME = SELF:SCREEN-VALUE.
&ENDIF 
      
/*----- CHOOSE of btnFile -----*/
ON CHOOSE OF btnFile IN FRAME printOptions DO:
  DEFINE VARIABLE cName       AS CHARACTER    NO-UNDO.
  DEFINE VARIABLE lPickedOne  AS LOGICAL      NO-UNDO.
  DEFINE VARIABLE cTitle      AS CHARACTER    NO-UNDO INITIAL "Report File".
  DEFINE VARIABLE cFilters    AS CHARACTER    NO-UNDO.
  
  lXmlFile = (rsDevice = "Fx").
               
  IF rsDevice BEGINS "F" THEN DO:
    cName = TRIM(fiFileName:SCREEN-VALUE IN FRAME printOptions).
    &IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN
      IF lXmlFile THEN
        SYSTEM-DIALOG GET-FILE           cName 
                      FILTERS            "XML Files  (*.xml)" "*.xml"
                      DEFAULT-EXTENSION  ".xml"
                      TITLE              cTitle
                      UPDATE             lPickedOne.
      ELSE
        SYSTEM-DIALOG GET-FILE           cName
                      FILTERS            "Text Files (*.txt)" "*.txt",
                                         "All Files  (*.*)"   "*.*"
                      DEFAULT-EXTENSION  ".txt"
                      TITLE              cTitle
                      UPDATE             lPickedOne.
    &ELSE
      RUN adecomm/_filecom.p ( INPUT "" /* p_Filter */, 
                               INPUT "" /* p_Dir */, 
                               INPUT "" /* p_Drive */,
                               INPUT no /* File Open */,
                               INPUT cTitle,
                               INPUT "" /* Dialog Options */,
                               INPUT-OUTPUT cName,
                               OUTPUT lPickedOne ). 
    &ENDIF

    IF lPickedOne THEN DO WITH FRAME printOptions:
      ASSIGN fiFileName:SCREEN-VALUE = cName
             lXmlFile                = (rsDevice = "Fx")                                      tbAppend:SENSITIVE      = (NOT lXmlFile)
             fiPgLength:SENSITIVE    = (NOT lXmlFile)
             rsDetail:SENSITIVE      = (NOT lXmlFile).
    END.
  END. /* If device = File */
  ELSE IF rsDevice = "P" THEN DO:
    &IF "{&WINDOW-SYSTEM}" NE "TTY" &THEN
      SYSTEM-DIALOG PRINTER-SETUP.
      cbPrinter:SCREEN-VALUE IN FRAME printOptions = SESSION:PRINTER-NAME.
    &ENDIF
  END. /* If device = Printer */
END. /* CHOOSE of btnFile */

&IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN
  ON HELP OF FRAME printOptions OR 
     CHOOSE OF btnHelp IN FRAME printOptions
    RUN adecomm/_adehelp.p ( INPUT "comm", 
                             INPUT "CONTEXT", 
                             INPUT {&OpenEdge_Auditing_Report_Options_dialog_box},
                             INPUT ? ).
&ENDIF
/*-------------------------------Mainline code-----------------------------*/

RUN printOptions.

PROCEDURE printOptions:
  /* "File" related fields start insensitive or hidden by default */
  ASSIGN &IF "{&WINDOW-SYSTEM}" = "TTY" &THEN 
           fiFileName:HIDDEN    IN FRAME printOptions = TRUE
           btnFile:HIDDEN       IN FRAME printOptions = TRUE
           fiFileName:SENSITIVE IN FRAME printOptions = TRUE
           btnFile:SENSITIVE    IN FRAME printOptions = TRUE
         &ELSE
           fiFileName:SENSITIVE IN FRAME printOptions = FALSE
           cbPrinter:SENSITIVE  IN FRAME printOptions = FALSE
           btnFile:SENSITIVE    IN FRAME printOptions = FALSE
           cbPrinter:VISIBLE    IN FRAME printOptions = FALSE
         &ENDIF .

  /* Run time layout for button area. */
  {adecomm/okrun.i  
    &FRAME  = "FRAME printOptions" 
    &BOX    = "rectBtns"
    &OK     = "btnOk" 
    &Cancel = "btnCancel"
    {&HLP_BTN} }

  DISPLAY rsDevice
          fiPgLength
          txtReport[piReport]
          rsDetail
      WITH FRAME printOptions.

  /* Need fixed array element to get the handle of the Report fill-in in the 
     frame, and we don't know what that element will be rill runtime, so we 
     have to walk the frame's widget tree to get it's handle. */
  hReport = FRAME printOptions:FIRST-CHILD:FIRST-CHILD NO-ERROR.
  WIDG-BLK:
  DO WHILE VALID-HANDLE(hReport):
    IF CAN-QUERY(hReport,"LABEL") AND 
      hReport:LABEL = "Report" THEN LEAVE WIDG-BLK.
    hReport= hReport:NEXT-SIBLING.
  END.

  &IF "{&WINDOW-SYSTEM}" NE "TTY" &THEN 
    hReport:TOOLTIP   = txtReport[piReport].
  &ELSE
    hReport:READ-ONLY = TRUE.
  &ENDIF

  ENABLE rsDevice 
         fiFileName
         cbPrinter
         btnFile
         tbAppend
         fiPgLength 
         txtReport[piReport] WHEN SESSION:DISPLAY-TYPE = "TTY"
         rsDetail
         btnOk 
         btnCancel
         &IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN btnHelp &ENDIF
      WITH FRAME printOptions.

  &IF "{&WINDOW-SYSTEM}" NE "TTY" &THEN
    ASSIGN btnFile:SENSITIVE    = FALSE
           fiFileName:SENSITIVE = FALSE
           cbPrinter:SENSITIVE  = FALSE
           cbPrinter:VISIBLE    = FALSE
  &ELSE
    ASSIGN btnFile:VISIBLE      = FALSE
           fiFileName:VISIBLE   = FALSE
           cbPrinter:VISIBLE    = FALSE
  &ENDIF 
           tbAppend:SENSITIVE   = FALSE.

  APPLY "VALUE-CHANGED" TO rsDevice IN FRAME printOptions.

  /* If user chose print and there's a problem with the printer, 
     Progress may generate a STOP condition - so trap that so
     we don't get kicked out of the whole application.  */
  DO ON ERROR UNDO, LEAVE ON ENDKEY UNDO, LEAVE ON STOP UNDO, LEAVE:
    WAIT-FOR CHOOSE OF btnOk IN FRAME printOptions OR 
             GO OF FRAME printOptions 
             FOCUS rsDevice. 
        /* Possibly change this back after beta 1 */
  END.

  HIDE FRAME printOptions.
  RETURN RETURN-VALUE.
END PROCEDURE.
&Scoped-define WINDOW-NAME CURRENT-WINDOW
/*********************************************************************
* Copyright (C) 2005,2010 by Progress Software Corporation. All rights    *
* reserved.  Prior versions of this work may contain portions        *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/*------------------------------------------------------------------------

  File: adecomm/_cust-filt.p

  Description: This dialog allows users the ability to define a granular 
               filter on audit data

  Input Parameters:
      pcDbName   -   Name of the database that will be filtered

  Output Parameters:
      pcFilter   -   Formatted query filter, based on user defined criteria

  Author: Kenneth S. McIntosh

  Created: July 18, 2005
  History:
      kmcintos  July 22, 2005  Removed AUTO-GO option from Apply button
                               20050722-024.
      kmcintos  Aug 8, 2005    Added context sensitive help 20050808-028.
      kmcintos  Aug 17, 2005   Fixed problem with context filtering
                               20050804-021.
      fernando  01/05/2010     Expand format for transaction id                         
------------------------------------------------------------------------*/
/*          This .W file was created with the Progress AppBuilder.       */
/*----------------------------------------------------------------------*/

{adecomm/commeng.i}

/* ***************************  Definitions  ************************** */

/* Parameters Definitions ---                                           */

DEFINE INPUT  PARAMETER pcDbName AS CHARACTER   NO-UNDO.
DEFINE OUTPUT PARAMETER pcFilter AS CHARACTER   NO-UNDO.

DEFINE VARIABLE gcDateFormat AS CHARACTER   NO-UNDO.
DEFINE VARIABLE gcNumSep     AS CHARACTER   NO-UNDO.
DEFINE VARIABLE gcNumDec     AS CHARACTER   NO-UNDO.

DEFINE VARIABLE giContOff    AS INTEGER     NO-UNDO.
DEFINE VARIABLE giSysOff     AS INTEGER     NO-UNDO.

ASSIGN gcDateFormat           = SESSION:DATE-FORMAT
       gcNumSep               = SESSION:NUMERIC-SEPARATOR
       gcNumDec               = SESSION:NUMERIC-DECIMAL-POINT
       SESSION:DATE-FORMAT    = "mdy"
       SESSION:NUMERIC-FORMAT = "American".

/* Local Variable Definitions ---                                       */

/* ********************  Preprocessor Definitions  ******************** */

/* Name of designated FRAME-NAME and/or first browse and/or first query */
&Scoped-define FRAME-NAME auditFilter

/* Standard List Definitions                                            */
&Scoped-Define ENABLED-OBJECTS fiDateFrom fiDateTo fiUserId fiEvtIdFrom fiEvtIdTo fiTxnId fiSystem btnSep1 fiContext btnSep2 rsOperator btnApply btnCancel
&Scoped-Define DISPLAYED-OBJECTS fiDateFrom fiDateTo fiUserId fiEvtIdFrom fiEvtIdTo fiTxnId fiContext rsOperator lblDateRange lblEvtIdRange lblContext lblMisc

/* ***********************  Control Definitions  ********************** */

/* Define a dialog box                                                  */

/* Definitions of the field level widgets                               */
DEFINE BUTTON btnApply 
     LABEL "&Apply" 
     &IF '{&WINDOW-SYSTEM}' = 'TTY':U &THEN SIZE 11 BY 1
     &ELSE SIZE 11 BY .95 &ENDIF
     BGCOLOR 8 .

DEFINE BUTTON btnSep1 
     &IF '{&WINDOW-SYSTEM}' = 'TTY':U &THEN 
       LABEL "SEP" SIZE 5 BY 1
     &ELSE 
       LABEL "<SEP>" SIZE 8 BY .95 
     &ENDIF.

DEFINE BUTTON btnSep2
     &IF '{&WINDOW-SYSTEM}' = 'TTY':U &THEN 
       LABEL "SEP" SIZE 5 BY 1
     &ELSE 
       LABEL "<SEP>" SIZE 8 BY .95 
     &ENDIF.

DEFINE BUTTON btnCancel 
     LABEL "Cancel" 
     &IF '{&WINDOW-SYSTEM}' = 'TTY':U &THEN SIZE 11 BY 1
     &ELSE SIZE 11 BY .95 &ENDIF
     BGCOLOR 8 .

DEFINE VARIABLE lblContext AS CHARACTER FORMAT "X(256)":U 
     INITIAL "Event Context Info" 
     VIEW-AS TEXT 
     &IF '{&WINDOW-SYSTEM}' = 'TTY':U &THEN SIZE 22 BY 1
     &ELSE SIZE 22 BY .62 &ENDIF NO-UNDO.
     
DEFINE VARIABLE fiSystem AS CHARACTER FORMAT "X(256)":U 
     LABEL "System Context" 
     VIEW-AS FILL-IN 
     &IF '{&WINDOW-SYSTEM}' = 'TTY':U &THEN SIZE 50 BY 1
     &ELSE SIZE 52 BY 1 &ENDIF NO-UNDO.
     
DEFINE VARIABLE fiContext AS CHARACTER FORMAT "X(256)":U 
     LABEL "Policy Context" 
     VIEW-AS FILL-IN 
     &IF '{&WINDOW-SYSTEM}' = 'TTY':U &THEN SIZE 50 BY 1
     &ELSE SIZE 52 BY 1 &ENDIF NO-UNDO.

DEFINE VARIABLE fiDateFrom AS DATE FORMAT "99/99/9999":U INITIAL ? 
     LABEL "From Date" 
     VIEW-AS FILL-IN 
     &IF '{&WINDOW-SYSTEM}' = 'TTY':U &THEN SIZE 22 BY 1
     &ELSE SIZE 22 BY 1 &ENDIF NO-UNDO.

DEFINE VARIABLE fiDateTo AS DATE FORMAT "99/99/9999":U INITIAL ? 
     LABEL "To Date" 
     VIEW-AS FILL-IN 
     &IF '{&WINDOW-SYSTEM}' = 'TTY':U &THEN SIZE 22 BY 1
     &ELSE SIZE 22 BY 1 &ENDIF NO-UNDO.

DEFINE VARIABLE fiEvtIdFrom AS INTEGER FORMAT ">>>>>>9":U INITIAL 0 
     LABEL "From Id" 
     VIEW-AS FILL-IN 
     &IF '{&WINDOW-SYSTEM}' = 'TTY':U &THEN SIZE 22 BY 1
     &ELSE SIZE 22 BY 1 &ENDIF NO-UNDO.

DEFINE VARIABLE fiEvtIdTo AS INTEGER FORMAT ">>>>>>9":U INITIAL 0 
     LABEL "To Id" 
     VIEW-AS FILL-IN 
     &IF '{&WINDOW-SYSTEM}' = 'TTY':U &THEN SIZE 22 BY 1
     &ELSE SIZE 22 BY 1 &ENDIF NO-UNDO.

DEFINE VARIABLE fiTxnId AS INT64 FORMAT ">>>>>>>>>9":U INITIAL 0 
     LABEL "Transaction Id" 
     VIEW-AS FILL-IN 
     &IF '{&WINDOW-SYSTEM}' = 'TTY':U &THEN SIZE 22 BY 1
     &ELSE SIZE 22 BY 1 &ENDIF NO-UNDO.

DEFINE VARIABLE fiUserId AS CHARACTER FORMAT "X(256)":U 
     LABEL "User Id" 
     VIEW-AS FILL-IN 
     &IF '{&WINDOW-SYSTEM}' = 'TTY':U &THEN SIZE 22 BY 1
     &ELSE SIZE 22 BY 1 &ENDIF NO-UNDO.

DEFINE VARIABLE lblDateRange AS CHARACTER FORMAT "X(256)":U 
     INITIAL "Audit Date Range" 
     VIEW-AS TEXT 
     &IF '{&WINDOW-SYSTEM}' = 'TTY':U &THEN SIZE 18 BY 1
     &ELSE SIZE 22 BY .62 &ENDIF NO-UNDO.

DEFINE VARIABLE lblMisc AS CHARACTER FORMAT "X(256)":U 
     INITIAL "Miscellaneous" 
     VIEW-AS TEXT 
     &IF '{&WINDOW-SYSTEM}' = 'TTY':U &THEN SIZE 18 BY 1
     &ELSE SIZE 22 BY .62 &ENDIF NO-UNDO.
     
DEFINE VARIABLE lblEvtIdRange AS CHARACTER FORMAT "X(256)":U 
     INITIAL "Audit Event Id Range" 
     VIEW-AS TEXT 
     &IF '{&WINDOW-SYSTEM}' = 'TTY':U &THEN SIZE 22 BY 1
     &ELSE SIZE 22 BY .62 &ENDIF NO-UNDO.

DEFINE VARIABLE rsOperator AS CHARACTER
     VIEW-AS RADIO-SET HORIZONTAL
     RADIO-BUTTONS 
          "BEGINS", "BEGINS",
          "MATCHES", "MATCHES",
          "EQUALS", "EQ"
     &IF '{&WINDOW-SYSTEM}' = 'TTY':U &THEN SIZE 52 BY 3
     &ELSE SIZE 52 BY .71 &ENDIF NO-UNDO.

&IF "{&WINDOW-SYSTEM}" NE "TTY" &THEN
  DEFINE BUTTON btnHelp 
           LABEL "&Help" 
           SIZE 11 BY .95
           BGCOLOR 8 .

  DEFINE RECTANGLE RECT-1
       EDGE-PIXELS 2 GRAPHIC-EDGE  NO-FILL   
       SIZE 78.6 BY 1.52.
&ENDIF

/* ************************  Frame Definitions  *********************** */

DEFINE FRAME auditFilter 
     &IF "{&WINDOW-SYSTEM}" NE "TTY" &THEN SKIP(.1) &ENDIF
     
     lblDateRange 
          &IF '{&WINDOW-SYSTEM}' = 'TTY':U &THEN
            TO 51 NO-LABEL
          &ELSE
            TO 55 NO-LABEL
          &ENDIF
     fiDateFrom
          &IF '{&WINDOW-SYSTEM}' = 'TTY':U &THEN 
            AT ROW 2 COL 12 COLON-ALIGNED
            HELP "Enter starting date for query"
          &ELSE 
            AT ROW 1.9 COL 18 COLON-ALIGNED 
          &ENDIF
     fiDateTo 
          &IF '{&WINDOW-SYSTEM}' = 'TTY':U &THEN 
            AT ROW 2 COL 50 COLON-ALIGNED
            HELP "Enter ending date for query" SKIP(1)
          &ELSE
            AT ROW 1.9 COL 55 COLON-ALIGNED SKIP(.5) 
          &ENDIF 
          
     lblEvtIdRange TO 53 NO-LABEL
     fiEvtIdFrom
          &IF '{&WINDOW-SYSTEM}' = 'TTY':U &THEN 
            AT ROW 5 COL 12 COLON-ALIGNED
            HELP "Enter starting event id for query"
          &ELSE 
            AT ROW 4.1 COL 18 COLON-ALIGNED 
          &ENDIF
     fiEvtIdTo
          &IF '{&WINDOW-SYSTEM}' = 'TTY':U &THEN 
            AT ROW 5 COL 50 COLON-ALIGNED
            HELP "Enter ending event id for query" SKIP(1)
          &ELSE
            AT ROW 4.1 COL 55 COLON-ALIGNED SKIP(.5)
          &ENDIF 
          
     lblMisc
          &IF '{&WINDOW-SYSTEM}' = 'TTY':U &THEN
            TO 52 NO-LABEL
          &ELSE
            TO 57 NO-LABEL
          &ENDIF
     fiUserId
          &IF '{&WINDOW-SYSTEM}' = 'TTY':U &THEN 
            AT ROW 8 COL 12 COLON-ALIGNED
            HELP "Enter user id for query"
          &ELSE AT ROW 6.3 COL 18 COLON-ALIGNED &ENDIF
     fiTxnId
          &IF '{&WINDOW-SYSTEM}' = 'TTY':U &THEN 
            AT ROW 8 COL 50 COLON-ALIGNED 
            HELP "Enter transaction id for query" SKIP(1)
          &ELSE 
            AT ROW 6.3 COL 55 COLON-ALIGNED SKIP(.5) 
          &ENDIF
          
     lblContext 
       &IF "{&WINDOW-SYSTEM}" = "TTY" &THEN 
         TO 54 NO-LABEL
       &ELSE
         TO 55 NO-LABEL
       &ENDIF
     fiSystem
          &IF '{&WINDOW-SYSTEM}' = 'TTY':U &THEN 
            AT ROW 11 COL 18 COLON-ALIGNED
            HELP "Enter system context string for query"
          &ELSE 
            AT ROW 8.5 COL 18 COLON-ALIGNED 
          &ENDIF
     btnSep1
          &IF '{&WINDOW-SYSTEM}' = 'TTY':U &THEN 
            AT ROW 11 COL 71
            HELP "Press to insert a separator character"
          &ELSE AT ROW 8.5 COL 72 &ENDIF
     fiContext
          &IF '{&WINDOW-SYSTEM}' = 'TTY':U &THEN 
            AT ROW 12 COL 18 COLON-ALIGNED
            HELP "Enter policy context string for query"
          &ELSE 
            AT ROW 9.5 COL 18 COLON-ALIGNED 
          &ENDIF
     btnSep2
          &IF '{&WINDOW-SYSTEM}' = 'TTY':U &THEN 
            AT ROW 12 COL 71
            HELP "Press to insert a separator character"
          &ELSE AT ROW 9.5 COL 72 &ENDIF
     rsOperator
          &IF '{&WINDOW-SYSTEM}' = 'TTY':U &THEN 
            AT ROW 13 COL 20
            HELP "Choose operator to use for context string"
          &ELSE AT ROW 10.8 COL 20 &ENDIF NO-LABEL
     btnApply
          &IF '{&WINDOW-SYSTEM}' = 'TTY':U &THEN 
            AT ROW 15 COL 27
            HELP "Press to apply filter criteria"
          &ELSE AT ROW 12.42 COL 3 &ENDIF
     btnCancel
          &IF '{&WINDOW-SYSTEM}' = 'TTY':U &THEN 
            AT ROW 15 COL 39
            HELP "Press, or hit ENDKEY, to cancel"
          &ELSE AT ROW 12.42 COL 15.2 &ENDIF
     &IF "{&WINDOW-SYSTEM}" NE "TTY" &THEN
       btnHelp AT ROW 12.42 COL 67.4
       RECT-1 AT ROW 12.13 COL 1.4 &ENDIF
     SPACE(0.79) SKIP(0.24)
    WITH &IF "{&WINDOW-SYSTEM}" NE "TTY" &THEN 
         VIEW-AS DIALOG-BOX &ENDIF KEEP-TAB-ORDER
         SIDE-LABELS NO-UNDERLINE THREE-D  SCROLLABLE 
         TITLE "Custom Audit Data Filter".

ASSIGN FRAME auditFilter:SCROLLABLE = FALSE
       FRAME auditFilter:HIDDEN     = TRUE
       fiSystem:TOOLTIP             = "Enter system context string for query"
       fiContext:TOOLTIP            = "Enter policy context string for query".

/* ************************  Control Triggers  ************************ */

ON WINDOW-CLOSE OF FRAME auditFilter 
  APPLY "END-ERROR":U TO SELF.

ON LEAVE OF fiContext IN FRAME auditFilter
  giContOff = fiContext:CURSOR-OFFSET.

ON LEAVE OF fiSystem IN FRAME auditFilter
  giSysOff = fiSystem:CURSOR-OFFSET.

ON CHOOSE OF btnSep1 IN FRAME auditFilter DO:
  DEFINE VARIABLE cTempVal AS CHARACTER   NO-UNDO.

  cTempVal = fiSystem:SCREEN-VALUE.

  IF giSysOff = 0 THEN
    giSysOff = LENGTH(cTempVal).
  
  fiSystem:SCREEN-VALUE = SUBSTRING(cTempVal,1,giSysOff - 1) + 
                           '<SEP>' +
                           SUBSTRING(cTempVal,giSysOff).

  APPLY "ENTRY" TO fiSystem IN FRAME auditFilter.
  ASSIGN fiSystem:CURSOR-OFFSET = giSysOff + 5
         giSysOff               = giSysOff + 5.
END.

ON CHOOSE OF btnSep2 IN FRAME auditFilter DO:
  DEFINE VARIABLE cTempVal AS CHARACTER   NO-UNDO.

  cTempVal = fiContext:SCREEN-VALUE.

  IF giContOff = 0 THEN
    giContOff = LENGTH(cTempVal).

  fiContext:SCREEN-VALUE = SUBSTRING(cTempVal,1,giContOff - 1) + 
                           '<SEP>' +
                           SUBSTRING(cTempVal,giContOff).

  APPLY "ENTRY" TO fiContext IN FRAME auditFilter.
  ASSIGN fiContext:CURSOR-OFFSET = giContOff + 5
         giContOff               = giContOff + 5.
END.

&IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN
  ON CHOOSE OF btnHelp IN FRAME {&FRAME-NAME} OR 
     HELP   OF FRAME {&FRAME-NAME} 
    RUN "adecomm/_adehelp.p" ( INPUT "admn", 
                               INPUT "CONTEXT", 
                               INPUT {&Custom_Audit_Data_Filter_Report_Dialog_Box},
                               INPUT ?).
&ENDIF

ON CHOOSE OF btnApply IN FRAME auditFilter 
  APPLY "GO" TO FRAME {&FRAME-NAME}.

ON END-ERROR OF FRAME auditFilter DO:
  ASSIGN SESSION:DATE-FORMAT = gcDateFormat
         pcFilter            = ?.
  SESSION:SET-NUMERIC-FORMAT(gcNumSep,gcNumDec).
END.

ON GO OF FRAME auditFilter DO:
  DEFINE VARIABLE lContinue AS LOGICAL     NO-UNDO.
  DEFINE VARIABLE cContext  AS CHARACTER   NO-UNDO.
  DEFINE VARIABLE cSystem   AS CHARACTER   NO-UNDO.

  /* Check each section for changes by the user */

  /* Date Range stuff */
  IF fiDateFrom:SCREEN-VALUE NE "" THEN
    pcFilter = (IF fiDateTo:SCREEN-VALUE NE "" THEN "(" ELSE "") + 
               "DATE(_audit-date-time) >= DATE(~"" + 
               fiDateFrom:SCREEN-VALUE + "~")".

  IF fiDateTo:SCREEN-VALUE NE "" THEN
    pcFilter = pcFilter + (IF pcFilter NE "" THEN " AND " ELSE "") +
               "DATE(_audit-date-time) <= DATE(~"" + 
               fiDateTo:SCREEN-VALUE + "~")" +
               (IF fiDateFrom:SCREEN-VALUE NE "" THEN ")" ELSE "").

  IF fiUserId:SCREEN-VALUE NE "" THEN
    pcFilter = pcFilter + (IF pcFilter NE "" THEN " AND " ELSE "") +
               "_user-id = ~'" + fiUserId:SCREEN-VALUE + "~'".

  IF fiEvtIdFrom:SCREEN-VALUE NE "0" THEN
    pcFilter = pcFilter + (IF pcFilter NE "" THEN " AND " ELSE "") +
               (IF fiEvtIdTo:SCREEN-VALUE NE "0" THEN "(" ELSE "") +
               "_event-id >= " + fiEvtIdFrom:SCREEN-VALUE.

  IF fiEvtIdTo:SCREEN-VALUE NE "0" THEN
    pcFilter = pcFilter + (IF pcFilter NE "" THEN " AND " ELSE "") +
               "_event-id <= " + fiEvtIdTo:SCREEN-VALUE +
               (IF fiEvtIdFrom:SCREEN-VALUE NE "0" THEN ")" ELSE "").

  IF fiTxnId:SCREEN-VALUE NE "0" THEN
    pcFilter = pcFilter + (IF pcFilter NE "" THEN " AND " ELSE "") +
               "_transaction-id = " + fiTxnId:SCREEN-VALUE.

  IF fiSystem:SCREEN-VALUE NE "" THEN
    cSystem  = REPLACE(fiSystem:SCREEN-VALUE,"<SEP>",CHR(7)).
  IF fiContext:SCREEN-VALUE NE "" THEN
    cContext = REPLACE(fiContext:SCREEN-VALUE,"<SEP>",CHR(7)).

  IF cSystem NE "" THEN
    pcFilter = pcFilter + (IF pcFilter NE "" THEN " AND " ELSE "") +
               "ENTRY(1,_event-context,CHR(6)) " + rsOperator:SCREEN-VALUE + 
               " ~'" + cSystem + "~'".

  IF cContext NE "" THEN
    pcFilter = pcFilter + (IF pcFilter NE "" THEN " AND " ELSE "") +
               "ENTRY(2,_event-context,CHR(6)) " + rsOperator:SCREEN-VALUE + 
               " ~'" + cContext + "~'".

  IF pcFilter NE "" THEN
    pcFilter = "WHERE " + pcFilter.
  ELSE DO:
    MESSAGE "You have specified no filter criteria for this report." SKIP(1)
            "If you choose to continue, the report could take a long time " +
            "to generate and could exceed platform specific file size " +
            "limitations."  SKIP(1)
            "Select Yes to generate the report without filters.  Select No " +
            "to return to the filter dialog to enter filter criteria."
        VIEW-AS ALERT-BOX WARNING BUTTONS YES-NO 
                          TITLE "Continue?" UPDATE lContinue.
    IF NOT lContinue THEN DO:
      APPLY "ENTRY" TO fiDateFrom.
      RETURN NO-APPLY.
    END.
  END.
  SESSION:DATE-FORMAT       = gcDateFormat.
  SESSION:SET-NUMERIC-FORMAT(gcNumSep,gcNumDec).
END.

ON CHOOSE OF btnCancel IN FRAME auditFilter 
  APPLY "WINDOW-CLOSE" TO FRAME {&FRAME-NAME}.

/* ***************************  Main Block  *************************** */

/* Parent the dialog-box to the ACTIVE-WINDOW, if there is no parent.   */
IF VALID-HANDLE(ACTIVE-WINDOW) AND FRAME {&FRAME-NAME}:PARENT eq ?
THEN FRAME {&FRAME-NAME}:PARENT = ACTIVE-WINDOW.


/* Now enable the interface and wait for the exit condition.            */
/* (NOTE: handle ERROR and END-KEY so cleanup code will always fire.    */
MAIN-BLOCK:
DO ON ERROR   UNDO MAIN-BLOCK, LEAVE MAIN-BLOCK
   ON END-KEY UNDO MAIN-BLOCK, LEAVE MAIN-BLOCK:
  RUN enable_UI.
  RUN initializeUI.
  WAIT-FOR GO OF FRAME {&FRAME-NAME}.
END.
RUN disable_UI.

/* **********************  Internal Procedures  *********************** */
PROCEDURE disable_UI :
/*------------------------------------------------------------------------------
  Purpose:     DISABLE the User Interface
  Parameters:  <none>
  Notes:       Here we clean-up the user-interface by deleting
               dynamic widgets we have created and/or hide 
               frames.  This procedure is usually called when
               we are ready to "clean-up" after running.
------------------------------------------------------------------------------*/
  /* Hide all frames. */
  HIDE FRAME auditFilter.
END PROCEDURE.

PROCEDURE enable_UI :
/*------------------------------------------------------------------------------
  Purpose:     ENABLE the User Interface
  Parameters:  <none>
  Notes:       Here we display/view/enable the widgets in the
               user-interface.  In addition, OPEN all queries
               associated with each FRAME and BROWSE.
               These statements here are based on the "Other 
               Settings" section of the widget Property Sheets.
------------------------------------------------------------------------------*/
  DISPLAY {&DISPLAYED-OBJECTS} WITH FRAME auditFilter.
  ENABLE {&ENABLED-OBJECTS} &IF "{&WINDOW-SYSTEM}" NE "TTY" &THEN
                              RECT-1 btnHelp &ENDIF
      WITH FRAME auditFilter.
  
  VIEW FRAME auditFilter.
END PROCEDURE.

PROCEDURE initializeUI :
/*------------------------------------------------------------------------------
  Purpose:     Setup defaults and initialize the user interface
  Parameters:  <none>
  Notes:       
------------------------------------------------------------------------------*/
  FRAME {&FRAME-NAME}:TITLE = FRAME {&FRAME-NAME}:TITLE +
                              " (" + pcDbName + ")".
  ASSIGN fiDateFrom:SCREEN-VALUE IN FRAME {&FRAME-NAME} = ?
         fiDateTo:SCREEN-VALUE IN FRAME {&FRAME-NAME}   = ?.
END PROCEDURE.
/*************************************************************/
/* Copyright (c) 1984-2005 by Progress Software Corporation  */
/*                                                           */
/* All rights reserved.  No part of this program or document */
/* may be  reproduced in  any form  or by  any means without */
/* permission in writing from PROGRESS Software Corporation. */
/*************************************************************/
DEFINE INPUT PARAMETER piDim AS INTEGER NO-UNDO.
DEFINE OUTPUT PARAMETER pcExtent AS CHAR EXTENT. 

RUN VALUE('getDim' + STRING(piDim)) IN TARGET-PROCEDURE (OUTPUT pcExtent) NO-ERROR. 
IF ERROR-STATUS:ERROR THEN
   MESSAGE
      "Procedure" program-name(1) "cannot create" piDim "extents."
      "Maximum number is" 
      STRING(NUM-ENTRIES(TARGET-PROCEDURE:INTERNAL-ENTRIES)) + "."
     VIEW-AS ALERT-BOX WARNING.

PROCEDURE getDim1 PRIVATE:  DEF OUTPUT param c AS CHAR EXTENT 1. END.
PROCEDURE getDim2 PRIVATE:  DEF OUTPUT param c AS CHAR EXTENT 2. END.
PROCEDURE getDim3 PRIVATE:  DEF OUTPUT param c AS CHAR EXTENT 3. END.
PROCEDURE getDim4 PRIVATE:  DEF OUTPUT param c AS CHAR EXTENT 4. END.
PROCEDURE getDim5 PRIVATE:  DEF OUTPUT param c AS CHAR EXTENT 5. END.
PROCEDURE getDim6 PRIVATE:  DEF OUTPUT param c AS CHAR EXTENT 6. END.
PROCEDURE getDim7 PRIVATE:  DEF OUTPUT param c AS CHAR EXTENT 7. END.
PROCEDURE getDim8 PRIVATE:  DEF OUTPUT param c AS CHAR EXTENT 8. END.
PROCEDURE getDim9 PRIVATE:  DEF OUTPUT param c AS CHAR EXTENT 9. END.
PROCEDURE getDim10 PRIVATE: DEF OUTPUT param c AS CHAR EXTENT 10. END.
PROCEDURE getDim11 PRIVATE: DEF OUTPUT param c AS CHAR EXTENT 11. END.
PROCEDURE getDim12 PRIVATE: DEF OUTPUT param c AS CHAR EXTENT 12. END.
PROCEDURE getDim13 PRIVATE: DEF OUTPUT param c AS CHAR EXTENT 13. END.
PROCEDURE getDim14 PRIVATE: DEF OUTPUT param c AS CHAR EXTENT 14. END.
PROCEDURE getDim15 PRIVATE: DEF OUTPUT param c AS CHAR EXTENT 15. END.
PROCEDURE getDim16 PRIVATE: DEF OUTPUT param c AS CHAR EXTENT 16. END.
PROCEDURE getDim17 PRIVATE: DEF OUTPUT param c AS CHAR EXTENT 17. END.
PROCEDURE getDim18 PRIVATE: DEF OUTPUT param c AS CHAR EXTENT 18. END.
PROCEDURE getDim19 PRIVATE: DEF OUTPUT param c AS CHAR EXTENT 19. END.
PROCEDURE getDim20 PRIVATE: DEF OUTPUT param c AS CHAR EXTENT 20. END.
PROCEDURE getDim21 PRIVATE: DEF OUTPUT param c AS CHAR EXTENT 21. END.
PROCEDURE getDim22 PRIVATE: DEF OUTPUT param c AS CHAR EXTENT 22. END.
PROCEDURE getDim23 PRIVATE: DEF OUTPUT param c AS CHAR EXTENT 23. END.
PROCEDURE getDim24 PRIVATE: DEF OUTPUT param c AS CHAR EXTENT 24. END.
PROCEDURE getDim25 PRIVATE: DEF OUTPUT param c AS CHAR EXTENT 25. END.
PROCEDURE getDim26 PRIVATE: DEF OUTPUT param c AS CHAR EXTENT 26. END.
PROCEDURE getDim27 PRIVATE: DEF OUTPUT param c AS CHAR EXTENT 27. END.
PROCEDURE getDim28 PRIVATE: DEF OUTPUT param c AS CHAR EXTENT 28. END.
PROCEDURE getDim29 PRIVATE: DEF OUTPUT param c AS CHAR EXTENT 29. END.
PROCEDURE getDim30 PRIVATE: DEF OUTPUT param c AS CHAR EXTENT 30. END.
PROCEDURE getDim31 PRIVATE: DEF OUTPUT param c AS CHAR EXTENT 31. END.
PROCEDURE getDim32 PRIVATE: DEF OUTPUT param c AS CHAR EXTENT 32. END.
PROCEDURE getDim33 PRIVATE: DEF OUTPUT param c AS CHAR EXTENT 33. END.
PROCEDURE getDim34 PRIVATE: DEF OUTPUT param c AS CHAR EXTENT 34. END.
PROCEDURE getDim35 PRIVATE: DEF OUTPUT param c AS CHAR EXTENT 35. END.
PROCEDURE getDim36 PRIVATE: DEF OUTPUT param c AS CHAR EXTENT 36. END.
PROCEDURE getDim37 PRIVATE: DEF OUTPUT param c AS CHAR EXTENT 37. END.
PROCEDURE getDim38 PRIVATE: DEF OUTPUT param c AS CHAR EXTENT 38. END.
PROCEDURE getDim39 PRIVATE: DEF OUTPUT param c AS CHAR EXTENT 39. END.
PROCEDURE getDim40 PRIVATE: DEF OUTPUT param c AS CHAR EXTENT 40. END.
PROCEDURE getDim41 PRIVATE: DEF OUTPUT param c AS CHAR EXTENT 41. END.
PROCEDURE getDim42 PRIVATE: DEF OUTPUT param c AS CHAR EXTENT 42. END.
PROCEDURE getDim43 PRIVATE: DEF OUTPUT param c AS CHAR EXTENT 43. END.
PROCEDURE getDim44 PRIVATE: DEF OUTPUT param c AS CHAR EXTENT 44. END.
PROCEDURE getDim45 PRIVATE: DEF OUTPUT param c AS CHAR EXTENT 45. END.
PROCEDURE getDim46 PRIVATE: DEF OUTPUT param c AS CHAR EXTENT 46. END.
PROCEDURE getDim47 PRIVATE: DEF OUTPUT param c AS CHAR EXTENT 47. END.
PROCEDURE getDim48 PRIVATE: DEF OUTPUT param c AS CHAR EXTENT 48. END.
PROCEDURE getDim49 PRIVATE: DEF OUTPUT param c AS CHAR EXTENT 49. END.
PROCEDURE getDim50 PRIVATE: DEF OUTPUT param c AS CHAR EXTENT 50. END.
PROCEDURE getDim51 PRIVATE: DEF OUTPUT param c AS CHAR EXTENT 51. END.
PROCEDURE getDim52 PRIVATE: DEF OUTPUT param c AS CHAR EXTENT 52. END.
PROCEDURE getDim53 PRIVATE: DEF OUTPUT param c AS CHAR EXTENT 53. END.
PROCEDURE getDim54 PRIVATE: DEF OUTPUT param c AS CHAR EXTENT 54. END.
PROCEDURE getDim55 PRIVATE: DEF OUTPUT param c AS CHAR EXTENT 55. END.
PROCEDURE getDim56 PRIVATE: DEF OUTPUT param c AS CHAR EXTENT 56. END.
PROCEDURE getDim57 PRIVATE: DEF OUTPUT param c AS CHAR EXTENT 57. END.
PROCEDURE getDim58 PRIVATE: DEF OUTPUT param c AS CHAR EXTENT 58. END.
PROCEDURE getDim59 PRIVATE: DEF OUTPUT param c AS CHAR EXTENT 59. END.
PROCEDURE getDim60 PRIVATE: DEF OUTPUT param c AS CHAR EXTENT 60. END.
 
&ANALYZE-SUSPEND _VERSION-NUMBER AB_v10r12
&ANALYZE-RESUME
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _DEFINITIONS Procedure 
/***********************************************************************
* Copyright (C) 2005,2013 by Progress Software Corporation. All rights *
* reserved.  Prior versions of this work may contain portions          *
* contributed by participants of Possenet.                             *
*                                                                      *
************************************************************************/

/*--------------------------------------------------------------------------
    Purpose     : Run system-dialog get-file and return relative path 
                  if possible. 
                  - Supports dynamic number of filters 
    Syntax      :
    Description :  used by  _opnfile when not remote
 
    Parameters  : 
     INPUT        ptitle  - Title of dialog 
     INPUT        pfilter - COMMA separated string with filters.
                            MUST have the real filter in parenthesis.                                                            
                            USE Semicolon to separate filters ! 
                            Example "ALl Source(*.p;*.i;*.w),R-code files (*.r)". 
     INPUT-OUTPUT pfile   - filename, set to "" if nothing is found.
       
    Author(s)   : Havard Danielsen
    Created     : Feb 1998
    Notes       : Currently maximum 6 filters.
                  Could easily be extended.                   
  ------------------------------------------------------------------------*/
/*          This .W file was created with the Progress UIB.             */
/*----------------------------------------------------------------------*/

/* ***************************  Definitions  ************************** */

DEFINE INPUT        PARAMETER pTitle  AS CHARACTER NO-UNDO.
DEFINE INPUT        PARAMETER pFilter AS CHARACTER NO-UNDO.
DEFINE INPUT-OUTPUT PARAMETER pFile   AS CHARACTER NO-UNDO.
 
{adecomm/oeideservice.i} 
 
DEFINE VAR PickedOne  AS LOGICAL   NO-UNDO.
DEFINE VAR Path       AS CHARACTER NO-UNDO.
DEFINE VAR TempFile   AS CHARACTER NO-UNDO.
DEFINE VAR i          AS INTEGER   NO-UNDO.
DEFINE VAR gDelimiter AS CHARACTER INIT ",":U NO-UNDO.
define variable cPickedFile as character no-undo.
/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME


&ANALYZE-SUSPEND _UIB-PREPROCESSOR-BLOCK 

/* ********************  Preprocessor Definitions  ******************** */

&Scoped-define PROCEDURE-TYPE Procedure
&Scoped-define DB-AWARE no



/* _UIB-PREPROCESSOR-BLOCK-END */
&ANALYZE-RESUME


/* ************************  Function Prototypes ********************** */

&IF DEFINED(EXCLUDE-getFilter) = 0 &THEN

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION-FORWARD getFilter Procedure 
FUNCTION getFilter RETURNS CHARACTER
  ( pin as int)  FORWARD.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME

&ENDIF

&IF DEFINED(EXCLUDE-getFilterText) = 0 &THEN

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION-FORWARD getFilterText Procedure 
FUNCTION getFilterText RETURNS CHARACTER
  ( pin as int)  FORWARD.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME

&ENDIF


/* *********************** Procedure Settings ************************ */

&ANALYZE-SUSPEND _PROCEDURE-SETTINGS
/* Settings for THIS-PROCEDURE
   Type: Procedure
   Allow: 
   Frames: 0
   Add Fields to: Neither
   Other Settings: CODE-ONLY COMPILE
 */
&ANALYZE-RESUME _END-PROCEDURE-SETTINGS

/* *************************  Create Window  ************************** */

&ANALYZE-SUSPEND _CREATE-WINDOW
/* DESIGN Window definition (used by the UIB) 
  CREATE WINDOW Procedure ASSIGN
         HEIGHT             = 15
         WIDTH              = 60.
/* END WINDOW DEFINITION */
                                                                        */
&ANALYZE-RESUME

 


&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _MAIN-BLOCK Procedure 


/* ***************************  Main Block  *************************** */
/* Remove slash, SYSTEM-DIALOG GET_GILE Aborts if / is used in file name */
pFile = REPLACE (pFile,"/":U,"~\":U).

/* 
getFilterText() returns the entry from the comma separated 
input parameter pFilter.
   
getFilter strips the part in the parenthesis. 
   
The use of a function makes the System dialog overlook it 
if it is blank. (Magic ! ) 
*/  
DialogBlock:
do while true:                
    SYSTEM-DIALOG GET-FILE pFile 
        FILTERS getFilterText(1) getFilter(1),           
                getFilterText(2) getFilter(2),
                getFilterText(3) getFilter(3),
                getFilterText(4) getFilter(4),
                getFilterText(5) getFilter(5),
                getFilterText(6) getFilter(6),
                getFilterText(7) getFilter(7),
                getFilterText(8) getFilter(8),
                getFilterText(9) getFilter(9)
    
        DEFAULT-EXTENSION  getFilter(1)
        TITLE              pTitle
        MUST-EXIST
        USE-FILENAME
        UPDATE             PickedOne.  

    /* See if it can be located in the PROPATH */
    IF PickedOne then
    do: 
        cPickedFile = pFile.
        /*  resolve relative path from full path file 
            prompts if relative name shadowed by other file in propath */
        run adecomm/_resolvepath.p (input-output pfile).
        if pfile > "" then 
           leave.   
        pfile = cPickedfile.   
    end.
    else do: 
        pFile = "":U.
        leave.
    end.     
end.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME


/* ************************  Function Implementations ***************** */

&IF DEFINED(EXCLUDE-getFilter) = 0 &THEN

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION getFilter Procedure 
FUNCTION getFilter RETURNS CHARACTER
  ( pin as int) :
/*------------------------------------------------------------------------------
  Purpose:  
    Notes:  
------------------------------------------------------------------------------*/
  Def var a as char.
  Def var rp as int.
  Def var lp as int.
  Assign 
    a  = getFilterText(pin)
    lp = index(a,'(') + 1
    rp = index(a,')').
  
  RETURN if lp > 1 and rp > lp 
         then (substr(a,lp,rp - lp))
         else "":U.
  
END FUNCTION.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME

&ENDIF

&IF DEFINED(EXCLUDE-getFilterText) = 0 &THEN

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION getFilterText Procedure 
FUNCTION getFilterText RETURNS CHARACTER
  ( pin as int) :
/*------------------------------------------------------------------------------
  Purpose:  
    Notes:  
------------------------------------------------------------------------------*/
  RETURN if num-entries(pfilter,gDelimiter) >= pin 
         then entry(pin,pfilter,gDelimiter)
         else "":U. 
END FUNCTION.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME

&ENDIF

/*************************************************************/
/* Copyright (c) 1984-2005,2008,2010 by Progress Software Corporation  */
/*                                                           */
/* All rights reserved.  No part of this program or document */
/* may be  reproduced in  any form  or by  any means without */
/* permission in writing from PROGRESS Software Corporation. */
/*************************************************************/
/*----------------------------------------------------------------------------

File: adecomm/_praudrpt.p

Description:
   Quick and dirty report to the screen with option to print.  
   This template is used for all auditing reports.
 
Input Parameters:
   pcDevice     - Output device. This is a list of "output type" followed by 
                  "output destination" separated by a CHR(1) character. The
                  expected output types follow:
                  T = TERMINAL
                  P = PRINTER
                  F = FILE
   piReport     - Numeric Identifier of the report being called
                  1    = Track Audit Policy Changes
                  2    = Track Database Schema Changes
                  3    = Track Audit Data Administration (Dump/Load)
                  4    = Track Application Data Administration (Dump/Load)
                  5    = Track User Account Changes
                  6    = Track Security Permissions Changes
                  7    = Track SQL Permissions Changes
                  8    = Track Authentication System Changes
                  9    = Client Session Authentication Report
                  10   = Database Administration Report (Utilities)
                  11   = Database Access Report (Login/Logout/etc...)
                  12   = Custom Audit Data Filter
                  13   = Encryption Policy Changes
                  14   = Key-store Changes 
                  15   = Database Encryption Administration (Utilities)
                  
   pcFilter     - Date Range filter criterea for the selected report
   plAppend     - Whether or not to append an existing file
   piPgLength   - Page length, for output
   pcDbName     - Logical Database Name for report
   plDetail     - Display Detail information in the report

Author: Kenneth S. McIntosh

Date Created: June 8, 2005

History:
  kmcintos  Sept 19, 2005  Added temp file list to keep track of legitimate 
                           tmp files to remove on the way out 20050919-022.  
  kmcintos  Oct 26, 2005   Encapsulated generateReport to avoid file 
                           conflicts 20050920-013.
  kmcintos  Dec 29, 2005   Fixed truncation issues 20051116-041.
  kmcintos  Jan 03, 2006   Fixed printing issue 20051116-043.
  fernando  Dec 23, 2008   Support for encryption
  fernando  01/05/2010     Expand transaction id format
----------------------------------------------------------------------------*/
CREATE WIDGET-POOL "datasetPool".

&GLOBAL-DEFINE WIN95-BTN YES
{adecomm/commeng.i}      /* Help contexts */
{adecomm/adestds.i}      /* Standard layout defines, colors etc. */
{adecomm/adeintl.i}      /* International support */
{adecomm/aud-tts.i NEW}  /* Audit Data Temp-Tables */

DEFINE INPUT  PARAMETER pcDevice     AS CHARACTER   NO-UNDO.
DEFINE INPUT  PARAMETER piReport     AS INTEGER     NO-UNDO.
DEFINE INPUT  PARAMETER pcFilter     AS CHARACTER   NO-UNDO.
DEFINE INPUT  PARAMETER plAppend     AS LOGICAL     NO-UNDO.
DEFINE INPUT  PARAMETER piPgLength   AS INTEGER     NO-UNDO.
DEFINE INPUT  PARAMETER pcDbName     AS CHARACTER   NO-UNDO.
DEFINE INPUT  PARAMETER plDetail     AS LOGICAL     NO-UNDO.

DEFINE NEW SHARED STREAM reportStream.
DEFINE NEW SHARED STREAM inputStream.

DEFINE VARIABLE cTempFile    AS CHARACTER   NO-UNDO.
DEFINE VARIABLE cInput       AS CHARACTER   NO-UNDO.
DEFINE VARIABLE rsDevice     AS CHARACTER   NO-UNDO 
                                VIEW-AS RADIO-SET
                                RADIO-BUTTONS "Printer", "P", 
                                              "File (XML)", "Fx",
                                              "File (Text)", "Ft"
                                INITIAL "Printer".
DEFINE VARIABLE rsSortData   AS CHARACTER   NO-UNDO 
                                VIEW-AS RADIO-SET
                                RADIO-BUTTONS 
                                    "Event Date/Time","_audit-date-time",
                                    "Event Id","_event-id",
                                    "User Id","_user-id",
                                    "Transaction Id","_transaction-id"
                                HORIZONTAL.
DEFINE VARIABLE gcReportTtl  AS CHARACTER   NO-UNDO.
DEFINE VARIABLE gcLastSort   AS CHARACTER   NO-UNDO.
DEFINE VARIABLE edReport     AS CHARACTER   NO-UNDO.
DEFINE VARIABLE cTmpFileList AS CHARACTER   NO-UNDO.

DEFINE VARIABLE lStatus      AS LOGICAL     NO-UNDO.
DEFINE VARIABLE glXmlFile    AS LOGICAL     NO-UNDO.
DEFINE VARIABLE lOverwrite   AS LOGICAL     NO-UNDO.
DEFINE VARIABLE glReportGend AS LOGICAL     NO-UNDO.

DEFINE VARIABLE hReport      AS HANDLE      NO-UNDO.

DEFINE VARIABLE gdtDateTime  AS DATETIME    NO-UNDO.

{adecomm/rptvar.i}

DEFINE BUTTON btnPrint   LABEL "&Print"   {&STDPH_OKBTN}.
DEFINE BUTTON btnOk      LABEL "OK"       {&STDPH_OKBTN} AUTO-GO.
DEFINE BUTTON btnCancel  LABEL "Cancel"   {&STDPH_OKBTN} AUTO-ENDKEY.
DEFINE BUTTON btnFile    LABEL "&Files..." 
   &IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN SIZE 15 by 1.125 &ENDIF.

&IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN
  DEFINE BUTTON    btnHelp  LABEL "&Help" {&STDPH_OKBTN}.
  DEFINE RECTANGLE rectBtns {&STDPH_OKBOX}. /* standard button rectangle */

  &GLOBAL-DEFINE HLP_BTN  &HELP = "btnHelp"
&ELSE
  &GLOBAL-DEFINE HLP_BTN  
  
&ENDIF

DEFINE QUERY qAudData FOR audData SCROLLING.

DEFINE BROWSE bAudData QUERY qAudData
    DISPLAY audData._audit-date-time
            audData._event-id
            audData._user-id FORMAT "x(18)"
            audData._transaction-id FORMAT "->>>>>>>>>9"
    &IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN
     LABEL "Txn Id" ENABLE audData._audit-date-time &ENDIF
    WITH WIDTH &IF "{&WINDOW-SYSTEM}" = "TTY" &THEN 76 6
               &ELSE 102 12 &ENDIF DOWN FONT 0 
         FIT-LAST-COLUMN SCROLLBAR-VERTICAL.
               
/*=================================Forms================================*/

FORM SKIP(1)
     &IF "{&WINDOW-SYSTEM}" = "TTY" &THEN 
       audData._formatted-event-context FONT 0
                                        LABEL "Event Detail" SKIP
       rsSortData                       LABEL "Sort by" SKIP 
     &ENDIF
     bAudData 
     &IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN
       SKIP
       audData._formatted-event-context FONT 0
                                        LABEL "Event Detail" SKIP
     &ENDIF
     
     {adecomm/okform.i
      &BOX    = rectBtns
      &STATUS = no
      &OK     = btnOK
      &OTHER  = "SPACE({&HM_DBTNG}) btnPrint"
      {&HLP_BTN}
     } 

    WITH FRAME fAudData WIDTH &IF "{&WINDOW-SYSTEM}" = "TTY" &THEN 78
                              &ELSE 100 &ENDIF
                        CANCEL-BUTTON btnOK
                        SIDE-LABELS SCROLLABLE
                        VIEW-AS DIALOG-BOX
                        TITLE "OpenEdge Custom Audit Filter Report".
                              
/* Form for editor widget containing the report and option buttons */
FORM edReport VIEW-AS EDITOR SCROLLBAR-VERTICAL
              /* Make width one less than we want - we add 1 later */
              &IF "{&WINDOW-SYSTEM}" = "TTY" &THEN
                SIZE 77 BY 13 
              &ELSE
                INNER-CHARS 90 INNER-LINES 17 SCROLLBAR-HORIZONTAL LARGE
              &ENDIF FONT 0 /* fixed font */ SKIP
   
   {adecomm/okform.i
      &BOX    = rectBtns
      &STATUS = no
      &OK     = btnOK
      &OTHER = "SPACE({&HM_DBTNG}) btnPrint"
      {&HLP_BTN}
   }
   WITH FRAME reportFrame WIDTH 77
              DEFAULT-BUTTON btnOK CANCEL-BUTTON btnOK
              NO-LABELS VIEW-AS DIALOG-BOX SCROLLABLE.

FORM SKIP({&TFM_WID})
     rsDevice                       LABEL "&Send Output to" 
                                    COLON 16 SKIP({&VM_WIDG})
     fiFileName                     LABEL "File Name" 
                                    FORMAT "x({&PATH_WIDG})" 
                                    &IF "{&WINDOW-SYSTEM}" NE "TTY" &THEN 
                                      AT ROW 4.5 COL 8 &ELSE COLON 16 &ENDIF
                                      VIEW-AS FILL-IN NATIVE 
                                      SIZE 35 BY 1 {&STDPH_FILL} SPACE(.3)
     &IF "{&WINDOW-SYSTEM}" NE "TTY" &THEN
       cbPrinter                    LABEL "Printer" 
                                    FORMAT "x({&PATH_WIDG})" 
                                    AT ROW 4.5 COL 11
     &ENDIF
     btnFile                        AT 54 SKIP({&VM_WID})
     tbAppend                       LABEL "&Append to Existing File?" AT 19
                                    VIEW-AS TOGGLE-BOX SKIP({&VM_WIDG})
     fiPgLength                     LABEL "&Page Length" 
                                    FORMAT ">>9" 
                                    COLON 16 {&STDPH_FILL}
     "(# Lines, 0 for Continuous)"  SKIP({&VM_WIDG})
     txtReport[piReport]            LABEL "Report" 
                                    VIEW-AS TEXT COLON 16 
                                    SKIP({&VM_WIDG})
     rsDetail                       LABEL "Orientation" COLON 16

   {adecomm/okform.i
      &BOX    = rectBtns
      &STATUS = no
      &OK     = btnOK
      &CANCEL = btnCancel
      {&HLP_BTN}
   }

   WITH FRAME printOptions
              SIDE-LABELS DEFAULT-BUTTON btnOK 
                          CANCEL-BUTTON btnCancel
              VIEW-AS DIALOG-BOX 
                      TITLE "OpenEdge Auditing Report Options".

ASSIGN rsDevice    = ENTRY(1,pcDevice,CHR(1))
       fiFileName  = (IF rsDevice BEGINS "F" THEN 
                        ENTRY(2,pcDevice,CHR(1))
                      ELSE "")
       glXmlFile   = (rsDevice = "Fx")
       rsDetail    = plDetail
       tbAppend    = plAppend
       fiPgLength  = piPgLength
       gcReportTtl = txtReport[piReport] + ": " + 
                     (IF rsDetail THEN " (Detail)" ELSE " (Summary)").
       
&IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN
  cbPrinter:LIST-ITEMS    = SESSION:GET-PRINTERS().
  cbPrinter               = (IF rsDevice = "P" THEN 
                               ENTRY(2,pcDevice,CHR(1))
                             ELSE SESSION:PRINTER-NAME).
  cbPrinter:VISIBLE       = FALSE.
  BROWSE bAudData:TOOLTIP = "Double-Click or hit " + 
                            KBLABEL("RETURN") + " to view details...".
  audData._audit-date-time:READ-ONLY IN BROWSE bAudData = TRUE.
&ELSE
  BROWSE bAudData:HELP    = "Select record and hit " + 
                            KBLABEL("RETURN") + " to view details...".
  rsSortData:HELP IN FRAME fAudData = "Select item to sort browse. (" +
                                      KBLABEL("CTRL-R") + 
                                      " to reverse direction)".
&ENDIF

/*============================Trigger code===================================*/

/*----- CHOOSE of Print Button in reportFrame -----*/
ON CHOOSE OF btnPrint IN FRAME reportFrame OR
   CHOOSE OF btnPrint IN FRAME fAudData    DO:
  /*===================Trigger section for Print===============*/
  &IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN 
    /*----- HELP -----*/
    ON HELP OF FRAME printOptions OR 
       CHOOSE OF btnHelp IN FRAME printOptions
      RUN adecomm/_adehelp.p ( INPUT "comm":u,
                               INPUT "CONTEXT":u,
                               INPUT {&OpenEdge_Auditing_Report_Options_dialog_box},
                               INPUT ? ).
  &ENDIF
  
  /*-----WINDOW-CLOSE-----*/
  ON WINDOW-CLOSE OF FRAME printOptions
    APPLY "END-ERROR" TO FRAME printOptions.

  /*----- OK or GO -----*/
  ON GO OF FRAME printOptions DO:
    ASSIGN rsDevice
           fiFileName
           &IF "{&WINDOW-SYSTEM}" NE "TTY" &THEN cbPrinter &ENDIF
           fiPgLength
           tbAppend.

    IF rsDevice BEGINS "F" THEN DO:
      IF fiFileName NE "" AND 
         fiFileName NE ? THEN
        ASSIGN fiFileName = TRIM(fiFileName)
               glXmlFile  = (rsDevice = "Fx").
      ELSE DO:
        MESSAGE "You must enter a filename!"
            VIEW-AS ALERT-BOX ERROR BUTTONS OK.
        APPLY "ENTRY" TO fiFileName IN FRAME printOptions.
        RETURN NO-APPLY.
      END. /* Filename is blank */

      IF NOT tbAppend THEN DO:
        FILE-INFO:FILE-NAME = fiFileName.
        IF FILE-INFO:FULL-PATHNAME NE ? THEN DO:
          MESSAGE fiFileName "already exists. Overwrite?"
              VIEW-AS ALERT-BOX QUESTION BUTTONS YES-NO
                                UPDATE lOverwrite.
          IF NOT lOverwrite THEN DO:
            APPLY "ENTRY" TO fiFileName.
            RETURN NO-APPLY.
          END. /* Not overwrite */
        END. /* File Exists */
      END. /* Not Append */
    END. /* If device = f */
  
    RUN generateReport ( INPUT &IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN
                                 (IF rsDevice NE "P" THEN 
                                    fiFileName
                                  ELSE cbPrinter)
                               &ELSE fiFileName &ENDIF,
                         INPUT rsDevice,
                         INPUT rsDetail,
                         INPUT tbAppend,
                         INPUT fiPgLength,
                         INPUT FALSE,
                         INPUT piReport ).
  END. /* GO of frame printOptions */
  
  /* VALUE-CHANGED of Detail radio-set */
  ON VALUE-CHANGED OF rsDetail IN FRAME printOptions DO:
    ASSIGN rsDetail.

    gcReportTtl = txtReport[piReport] + ": " + 
                  (IF rsDetail THEN " (Detail)" ELSE " (Summary)").
    IF rsDetail NE plDetail THEN
      glReportGend = FALSE.
  END.

  /*----- VALUE-CHANGED of DEVICE RADIO SET -----*/
  ON VALUE-CHANGED OF rsDevice IN FRAME printOptions DO:
   
    ASSIGN rsDevice.
    ASSIGN glXmlFile        = (rsDevice = "Fx")
           tbAppend:CHECKED = FALSE.

    IF rsDevice BEGINS "F" /* file */ THEN DO WITH FRAME printOptions:

      /* make sure we regenerate it if choosing XML and the orientation
         was set to 'summary'
      */
      IF glXmlFile AND NOT plDetail AND 
         rsDetail:INPUT-VALUE = NO /* summary */ THEN DO:
      
         ASSIGN glReportGend = NO
                plDetail = YES.
      END.

      ASSIGN btnFile:LABEL            = "&Files..."
            fiFileName:SCREEN-VALUE   = cDefaultFile + 
                       (IF glXmlFile THEN ".xml" ELSE ".txt")
            fiFileName:VISIBLE        = TRUE
            fiPgLength:SCREEN-VALUE   = "0"
            fiPgLength:SENSITIVE      = (NOT glXmlFile)
            tbAppend:SENSITIVE        = (NOT glXmlFile)
            rsDetail:SENSITIVE        = (NOT glXmlFile)
            rsDetail:SCREEN-VALUE     = (IF glXmlFile THEN "yes" ELSE rsDetail:SCREEN-VALUE)
            &IF "{&WINDOW-SYSTEM}" = "TTY" &THEN 
              btnFile:VISIBLE         = TRUE
              btnFile:SENSITIVE       = TRUE
            &ELSE
              cbPrinter:VISIBLE       = FALSE
              fiFileName:SENSITIVE    = TRUE
              btnFile:SENSITIVE       = TRUE
            &ENDIF .
    END. /* Output to File */
    ELSE DO WITH FRAME printOptions:
      &IF "{&WINDOW-SYSTEM}" = "TTY" &THEN 
            ASSIGN fiFileName:VISIBLE      = FALSE
                   btnFile:VISIBLE         = FALSE
      &ELSE
            ASSIGN fiFileName:SENSITIVE    = FALSE
      &ENDIF 
                   fiFileName:SCREEN-VALUE = ""
                   tbAppend:SENSITIVE      = FALSE
                   rsDetail:SENSITIVE      = TRUE
                   fiPgLength:SENSITIVE    = TRUE.

      IF rsDevice = "T" THEN
            ASSIGN fiPgLength:SCREEN-VALUE = "0"
                   btnFile:SENSITIVE       = FALSE
                   glXmlFile               = FALSE
                   &IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN
                     cbPrinter:SENSITIVE   = FALSE
                   &ENDIF .
      ELSE IF rsDevice = "P" THEN
            ASSIGN fiPgLength:SCREEN-VALUE  = "60"
                   glXmlFile                = FALSE
                   &IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN
                     cbPrinter:VISIBLE      = TRUE        
                     cbPrinter:SCREEN-VALUE = SESSION:PRINTER-NAME
                     fiFileName:VISIBLE     = FALSE
                     cbPrinter:SENSITIVE    = TRUE
                     btnFile:SENSITIVE      = TRUE
                     btnFile:LABEL          = "Printer Setup"
                   &ENDIF .
    END. /* Output to Terminal or Printer */
  END. /* Value-Changed of rsDevice */

  &IF "{&WINDOW-SYSTEM}" NE "TTY" &THEN
    ON VALUE-CHANGED OF cbPrinter IN FRAME printOptions
      SESSION:PRINTER-NAME = SELF:SCREEN-VALUE.
  &ENDIF 
        
  /*----- CHOOSE of FILE BUTTON -----*/
  ON CHOOSE OF btnFile IN FRAME printOptions DO:
    DEFINE VARIABLE cName       AS CHARACTER    NO-UNDO.
    DEFINE VARIABLE lPickedOne  AS LOGICAL      NO-UNDO.
    DEFINE VARIABLE cTitle      AS CHARACTER    NO-UNDO INITIAL "Report File".

    glXmlFile = (rsDevice = "Fx").
    IF rsDevice BEGINS "F" THEN DO:
      cName = TRIM(fiFileName:SCREEN-VALUE IN FRAME printOptions).
      &IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN
        IF glXmlFile THEN
          SYSTEM-DIALOG GET-FILE           cName 
                        FILTERS            "XML Files  (*.xml)" "*.xml"
                        DEFAULT-EXTENSION  ".xml"
                        TITLE              cTitle
                        UPDATE             lPickedOne.
        ELSE
          SYSTEM-DIALOG GET-FILE           cName
                        FILTERS            "Text Files (*.txt)" "*.txt",
                                           "All Files  (*.*)"   "*.*"
                        DEFAULT-EXTENSION  ".txt"
                        TITLE              cTitle
                        UPDATE             lPickedOne.
      &ELSE
        RUN adecomm/_filecom.p ( INPUT "" /* p_Filter */, 
                                 INPUT "" /* p_Dir */, 
                                 INPUT "" /* p_Drive */,
                                 INPUT FALSE /* File Open */,
                                 INPUT cTitle,
                                 INPUT "" /* Dialog Options */,
                                 INPUT-OUTPUT cName,
                                 OUTPUT lPickedOne ). 
      &ENDIF

      IF lPickedOne THEN DO WITH FRAME printOptions:
        ASSIGN fiFileName:SCREEN-VALUE = cName
               glXmlFile               = (rsDevice = "Fx")
               tbAppend:SENSITIVE      = (NOT glXmlFile)
               rsDetail:SENSITIVE      = (NOT glXmlFile)
               fiPgLength:SENSITIVE    = (NOT glXmlFile).
      END.
    END. /* If device = File */
    ELSE IF rsDevice = "P" THEN DO:
      &IF "{&WINDOW-SYSTEM}" NE "TTY" &THEN
        SYSTEM-DIALOG PRINTER-SETUP.
        cbPrinter:SCREEN-VALUE IN FRAME printOptions = SESSION:PRINTER-NAME.
      &ENDIF
    END. /* If device = Printer */
  END. /* Choose of files button */

  /*=======Mainline for Print processing=========*/

  DISPLAY rsDevice 
          fiFileName
          tbAppend
          fiPgLength 
          txtReport[piReport]
          rsDetail
      WITH FRAME printOptions.

  /* Need fixed array element to get the handle of the Report fill-in in the 
   frame, and we don't know what that element will be rill runtime, so we 
   have to walk the frame's widget tree to get it's handle. */
  hReport = FRAME printOptions:FIRST-CHILD:FIRST-CHILD NO-ERROR.
  WIDG-BLK:
  DO WHILE VALID-HANDLE(hReport):
    IF CAN-QUERY(hReport,"LABEL") AND 
      hReport:LABEL = "Report" THEN LEAVE WIDG-BLK.
    hReport= hReport:NEXT-SIBLING.
  END.

  &IF "{&WINDOW-SYSTEM}" NE "TTY" &THEN 
    hReport:TOOLTIP   = txtReport[piReport].
  &ELSE
    hReport:READ-ONLY = TRUE.
  &ENDIF

  ENABLE rsDevice 
         fiFileName
         &IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN cbPrinter &ENDIF
         btnFile
         tbAppend
         fiPgLength 
         rsDetail
         btnOk 
         btnCancel
         &IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN btnHelp &ENDIF
    WITH FRAME printOptions.

  APPLY "VALUE-CHANGED" TO rsDevice IN FRAME printOptions.
  DO ON ERROR UNDO, LEAVE  ON ENDKEY UNDO, LEAVE:
    WAIT-FOR CHOOSE of btnOK in FRAME printOptions OR 
             GO OF FRAME printOptions 
             FOCUS rsDevice.
  END.
  HIDE FRAME printOptions.   
END. /* On CHOOSE Of btnPrint */

/*-----WINDOW-CLOSE-----*/
ON WINDOW-CLOSE OF FRAME reportFrame
  APPLY "END-ERROR" TO FRAME reportFrame.

/*-----WINDOW-CLOSE-----*/
ON WINDOW-CLOSE OF FRAME fAudData
  APPLY "END-ERROR" TO FRAME fAudData.

&IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN
  /*----- HELP -----*/
  ON HELP OF FRAME reportFrame OR 
     CHOOSE OF btnHelp IN FRAME reportFrame
    RUN "adecomm/_adehelp.p" ( INPUT "comm", 
                               INPUT "CONTEXT", 
                               INPUT {&OpenEdge_Auditing_Report_Options_dialog_box},
                               INPUT ? ).
&ENDIF

&IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN
  /*----- HELP -----*/
  ON HELP OF FRAME fAudData OR 
     CHOOSE OF btnHelp IN FRAME fAudData
    RUN "adecomm/_adehelp.p" ( INPUT "comm", 
                               INPUT "CONTEXT", 
                               INPUT 0,
                               INPUT ? ).

  ON START-SEARCH OF BROWSE bAudData DO:
    DEFINE VARIABLE hCol AS HANDLE      NO-UNDO.

    hCol = SELF:CURRENT-COLUMN.
    RUN resortQuery ( INPUT hCol:NAME ).
    APPLY "END-SEARCH" TO SELF.
  END.
&ENDIF

ON DEFAULT-ACTION OF BROWSE bAudData DO:
  IF NOT AVAILABLE audData THEN
    RETURN NO-APPLY.

  RUN adecomm/_auddtl.p ( INPUT ROWID(audData),
                          INPUT "audData",
                          INPUT QUERY qAudData:HANDLE ).
END.

&IF "{&WINDOW-SYSTEM}" = "TTY" &THEN
  ON VALUE-CHANGED OF rsSortData IN FRAME fAudData
    RUN resortQuery ( INPUT SELF:SCREEN-VALUE ).
  
  ON CTRL-R OF rsSortData IN FRAME fAudData
    RUN resortQuery ( INPUT SELF:SCREEN-VALUE ).
&ENDIF

ON VALUE-CHANGED OF BROWSE bAudData DO:
  IF NOT AVAILABLE audData THEN LEAVE.
    
  DISPLAY audData._formatted-event-context
     WITH FRAME fAudData.
END.
                                                     
/*=============================Mainline code================================*/

/* Run time layout for button area.  
   Do it for print frame here.  This way, it's only done once. Also 
   because, if you do it in the trigger the define for eff_frame_width
   becomes local to the trigger and it screws up second call to okrun.i.
*/
{adecomm/okrun.i  
   &FRAME = "FRAME printOptions" 
   &BOX   = "rectBtns"
   &OK    = "btnOK" 
   &CANCEL = "btnCancel"   /* to center for TTY mode */
   {&HLP_BTN}
}

/* Fix up report frame second so that eff_frame_width is available for
   button calculation below.
*/
{adecomm/okrun.i  
   &FRAME  = "FRAME reportFrame" 
   &BOX    = "rectBtns"
   &OK     = "btnOK"
   &CANCEL = "btnPrint"   /* to center for TTY mode */
   {&HLP_BTN}
}

/* Fix up report frame second so that eff_frame_width is available for
   button calculation below.
*/
{adecomm/okrun.i  
   &FRAME  = "FRAME fAudData" 
   &BOX    = "rectBtns"
   &OK     = "btnOK"
   &CANCEL = "btnPrint"   /* to center for TTY mode */
   {&HLP_BTN}
}

IF piReport NE 12 AND
   NOT glXmlFile THEN DO:

  /* Do the work */
  RUN generateReport ( INPUT &IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN
                               (IF rsDevice NE "P" THEN 
                                  fiFileName
                                ELSE cbPrinter)
                             &ELSE fiFileName &ENDIF,
                       INPUT rsDevice,
                       INPUT rsDetail,
                       INPUT tbAppend,
                       INPUT fiPgLength,
                       INPUT TRUE,
                       INPUT piReport ).
     
  IF rsDevice = "T" THEN DO:
    edReport:WIDTH-PIXELS = FRAME reportFrame:WIDTH-PIXELS - 
                            FRAME reportFrame:BORDER-LEFT-PIXEL - 
                            FRAME reportFrame:BORDER-RIGHT-PIXEL.
    FRAME reportFrame:SCROLLABLE = FALSE.
    RUN editorReport.
  END.
 
END. /* Not xml output */
ELSE RUN generateReport ( INPUT &IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN
                                  (IF rsDevice NE "P" THEN 
                                     fiFileName
                                   ELSE cbPrinter)
                                &ELSE fiFileName &ENDIF,
                          INPUT rsDevice,
                          INPUT rsDetail,
                          INPUT tbAppend,
                          INPUT fiPgLength,
                          INPUT TRUE,
                          INPUT piReport ).

IF piReport EQ 12 AND 
   rsDevice EQ "T" THEN
  RUN browseReport.

DELETE WIDGET-POOL "datasetPool".

/* proDataset objects do not get destroyed in widget pools.  This needs to 
   be destroyed explicitly. */
IF VALID-HANDLE(ghDataSet) THEN
  DELETE OBJECT ghDataSet.

/*==========================Internal Procedures==============================*/

PROCEDURE generateReport:
  /*   Purpose: Runs the report generation procedure */
  DEFINE INPUT  PARAMETER pcFileName AS CHARACTER   NO-UNDO.
  DEFINE INPUT  PARAMETER pcDevice   AS CHARACTER   NO-UNDO.
  DEFINE INPUT  PARAMETER plDetail   AS LOGICAL     NO-UNDO.
  DEFINE INPUT  PARAMETER plAppend   AS LOGICAL     NO-UNDO.
  DEFINE INPUT  PARAMETER pipgLength AS INTEGER     NO-UNDO.
  DEFINE INPUT  PARAMETER plFirstRun AS LOGICAL     NO-UNDO.
  DEFINE INPUT  PARAMETER piReport   AS INTEGER     NO-UNDO.
 
  DEFINE VARIABLE cOutFile AS CHARACTER   NO-UNDO.
  DEFINE VARIABLE cInFile  AS CHARACTER   NO-UNDO.

  DEFINE VARIABLE lXmlFile AS LOGICAL     NO-UNDO.

  lXmlFile = pcDevice = "Fx".
  
  gdtDateTime = NOW.

  RUN adecomm/_setcurs.p ("WAIT").
  
  /* Adjust contents of frame so everything always fits */
  IF pcDevice EQ "T" THEN DO WITH FRAME reportFrame:
    IF piReport NE 12 THEN DO:
      /* Generate a name for a tempfile to use to store report so we can view it
         with an editor widget.  Display the data to the file.  
      */
      RUN adecomm/_tmpfile.p ( INPUT "", 
                               INPUT ".dct", 
                               OUTPUT cOutFile ).
      /* Add to list of files to cleanup later */
      cTmpFileList = cTmpFileList + (IF cTmpFileList NE "" THEN "," ELSE "") +
                     cOutFile.

      /* This is used by external procedures */
      cTempFile = cOutFile.
    END.
  END. 
  ELSE IF pcDevice BEGINS "F" THEN
    ASSIGN cTempFile = pcFileName
           cOutFile  = pcFileName.
  
  IF NOT pcDevice EQ "P" AND
     cOutFile     NE "" THEN DO:
    
    /* Open the file to make sure we have permission */
    IF cOutFile BEGINS "|" THEN
      OUTPUT THROUGH VALUE(SUBSTRING(cOutFile,2,-1,"CHARACTER":U))
             PAGE-SIZE VALUE(piPgLength).
    ELSE IF plAppend THEN
      OUTPUT TO VALUE(cOutFile) PAGE-SIZE VALUE(piPgLength) APPEND.
    ELSE IF NOT glXmlFile THEN
      OUTPUT TO VALUE(cOutFile) PAGE-SIZE VALUE(fiPgLength).
    ELSE
      OUTPUT TO VALUE(cOutFile).

    OUTPUT CLOSE.
  END. /* Not printer output */
  
  /* XML Output requires no header, cannot be paged and page size 
     is also meaningless, so don't go here for xml files. */
  IF NOT lXmlFile    AND
     (cOutFile NE "" OR
      pcDevice EQ "P") THEN DO:
    IF piPgLength > 0 THEN
      /* Header with Page specification */
      FORM HEADER gdtDateTime "OpenEdge Auditing Report" 
                  "Page" AT &IF "{&WINDOW-SYSTEM}" = "TTY" &THEN 60
                            &ELSE 70 &ENDIF PAGE-NUMBER(reportStream) 
                            FORMAT "ZZ9" SKIP
                  gcReportTtl VIEW-AS TEXT FORMAT "x(77)"
        WITH FRAME page_head_paged
             PAGE-TOP NO-LABELS NO-BOX NO-ATTR-SPACE
             NO-UNDERLINE USE-TEXT STREAM-IO.
    ELSE
      /* Header with no Page specification */
      FORM HEADER gdtDateTime "OpenEdge Auditing Report" SKIP
                  gcReportTtl VIEW-AS TEXT FORMAT "x(77)" 
          WITH FRAME page_head_not_paged
               PAGE-TOP NO-LABELS NO-BOX NO-ATTR-SPACE
               NO-UNDERLINE USE-TEXT STREAM-IO.

    IF cOutFile BEGINS "|" THEN 
      OUTPUT STREAM reportStream THROUGH 
                    VALUE(SUBSTRING(pcDevice,2,-1,"CHARACTER":U)) 
                    PAGE-SIZE VALUE(piPgLength).
    ELSE IF pcDevice BEGINS "P" THEN DO:
      IF pcFileName > '' THEN
        OUTPUT STREAM reportStream TO PRINTER VALUE(pcFileName) 
              PAGE-SIZE VALUE(piPgLength).
      ELSE
        OUTPUT STREAM reportStream TO PRINTER PAGE-SIZE VALUE(piPgLength).
    END.
    ELSE IF plAppend THEN 
      OUTPUT STREAM reportStream TO VALUE(cOutFile) 
                    PAGE-SIZE VALUE(piPgLength) APPEND.
    ELSE
      OUTPUT STREAM reportStream TO VALUE(cOutFile) 
                    PAGE-SIZE VALUE(piPgLength).
      
    IF piPgLength > 0 THEN
        VIEW STREAM reportStream FRAME page_head_paged.
     ELSE 
        VIEW STREAM reportStream FRAME page_head_not_paged.
    
    DO ON STOP UNDO, LEAVE:
      gdtDateTime = NOW.
      
      /* If the report was already generated then let's get the output 
         from the tempfile instead of running it all over again. */
      IF glReportGend THEN DO:    
        IF cTmpFileList > "" THEN
          cInFile = ENTRY(NUM-ENTRIES(cTmpFileList),cTmpFileList).

        IF cInFile EQ "" THEN DO:
          RUN adecomm/_auddat.p ( INPUT piReport,
                                  INPUT cOutFile,
                                  INPUT pcFilter,
                                  INPUT pcDbName,
                                  INPUT plDetail,
                                  INPUT (NOT plFirstRun) ).
          glReportGend = TRUE.
        END. /* Can't find input filename */
        ELSE DO:
          INPUT STREAM inputStream FROM VALUE(cInFile) NO-ECHO.
          REPEAT:
            IMPORT STREAM inputStream UNFORMATTED cInput.
            PUT STREAM reportStream UNFORMATTED cInput SKIP.
            /* make the output be the same as if you generated the report 
               straight to the text file. */
            IF cInput = "" THEN
               PUT STREAM reportStream UNFORMATTED SKIP(1).
          END.
          INPUT STREAM inputStream CLOSE.
        END. /* Can find input filename */
      END. /* If Report File was already generated */
      ELSE DO:
        RUN adecomm/_auddat.p ( INPUT piReport,
                                INPUT (IF pcDevice EQ "P" THEN 
                                         pcFileName ELSE cOutFile),
                                INPUT pcFilter,
                                INPUT pcDbName,
                                INPUT rsDetail,
                                INPUT (NOT plFirstRun) ).
        glReportGend = TRUE.
      END.

      OUTPUT STREAM reportStream CLOSE.
    END. /* Do on stop */
    
  END. /* Not xml file */
  ELSE DO:
    IF glReportGend THEN 
      ghDataset:WRITE-XML("FILE",cOutFile,TRUE,"UTF-8",?,TRUE,TRUE).
    ELSE
      RUN adecomm/_auddat.p ( INPUT piReport,
                              INPUT cOutFile,
                              INPUT pcFilter,
                              INPUT pcDbName,
                              INPUT rsDetail,
                              INPUT (NOT plFirstRun) ).
  END. 

  RUN adecomm/_setcurs.p ("").
END PROCEDURE.

PROCEDURE browseReport:
  gcLastSort = "_audit-date-time".
  RUN resortQuery ( INPUT gcLastSort ).

  IF NOT AVAILABLE audData THEN DO:
    MESSAGE "No records were found that match your criteria"
        VIEW-AS ALERT-BOX INFO.
    RETURN "".
  END.

  DISPLAY audData._formatted-event-context
  &IF "{&WINDOW-SYSTEM}" = "TTY" &THEN
    rsSortData 
  &ENDIF
  WITH FRAME fAudData.

  ENABLE &IF "{&WINDOW-SYSTEM}" = "TTY" &THEN 
           audData._formatted-event-context rsSortData &ENDIF
         bAudData
         &IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN
           audData._formatted-event-context &ENDIF
         btnOk
         btnPrint
         &IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN
           btnHelp &ENDIF
     WITH FRAME fAudData.

  audData._formatted-event-context:READ-ONLY IN FRAME fAudData = TRUE.

  &IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN
    audData._formatted-event-context:BGCOLOR = 8. &ENDIF

  DO ON ERROR UNDO, LEAVE  ON ENDKEY UNDO, LEAVE:
    WAIT-FOR CHOOSE OF btnOK IN FRAME fAudData OR
             GO     OF          FRAME fAudData
        FOCUS bAudData.
  END.
END PROCEDURE.

PROCEDURE editorReport:
  DEFINE VARIABLE iFile AS INTEGER     NO-UNDO.

  /* Show the report in the editor widget. */
  ASSIGN edReport:PFCOLOR   IN FRAME reportFrame = 0
         edReport:READ-ONLY IN FRAME reportFrame = TRUE
         edReport:SENSITIVE IN FRAME reportFrame = TRUE
         FRAME reportFrame:TITLE                 = txtReport[piReport].

  lStatus = edReport:READ-FILE(cTempFile) IN FRAME reportFrame NO-ERROR.

  /* Display frame only if report could be read into the editor-widget */
  IF lStatus THEN DO:
    ENABLE edReport 
           btnOK 
           btnPrint 
           &IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN
                 btnHelp
           &ENDIF
        WITH FRAME reportFrame.
      
    DO ON ERROR UNDO, LEAVE  ON ENDKEY UNDO, LEAVE:
      WAIT-FOR CHOOSE OF btnOK IN FRAME reportFrame OR
               GO     OF          FRAME reportFrame
          FOCUS edReport.
    END.
      
    /* Close up shop. */
    DO iFile = 1 TO NUM-ENTRIES(cTmpFileList):
      FILE-INFO:FILE-NAME = ENTRY(iFile,cTmpFileList).
      IF FILE-INFO:FILE-NAME NE ? THEN
        OS-DELETE VALUE(FILE-INFO:FULL-PATHNAME).
    END.
    HIDE FRAME reportFrame NO-PAUSE.
    HIDE MESSAGE NO-PAUSE.
  END. /* If file was read into editor */
END PROCEDURE.

PROCEDURE resortQuery:
  DEFINE INPUT  PARAMETER pcColumn AS CHARACTER   NO-UNDO.

  DEFINE VARIABLE cSort  AS CHARACTER   NO-UNDO.

  DEFINE VARIABLE hQuery AS HANDLE      NO-UNDO.
  
  CASE pcColumn:
    WHEN "_audit-date-time" THEN DO:
      IF gcLastSort = pcColumn THEN
        ASSIGN cSort      = " BY " + pcColumn + " DESC"
               gcLastSort = pcColumn + " DESC".
      ELSE 
        ASSIGN cSort      = " BY " + pcColumn
               gcLastSort = pcColumn.
    END.
    OTHERWISE DO:
      IF gcLastSort = pcColumn THEN
        ASSIGN cSort      = " BY " + pcColumn + " DESC" + 
                            " BY _audit-date-time DESC" 
               gcLastSort = pcColumn + " DESC".
      ELSE 
        ASSIGN cSort      = " BY " + pcColumn + 
                            " BY _audit-date-time DESC"
               gcLastSort = pcColumn.
    END.
  END CASE.

  hQuery = QUERY qAudData:HANDLE.

  hQuery:QUERY-CLOSE.
  hQuery:QUERY-PREPARE("FOR EACH audData NO-LOCK" + cSort).
  hQuery:QUERY-OPEN().
END PROCEDURE.

/*************************************************************/
/* Copyright (c) 1984-2005,2008 by Progress Software Corporation  */
/*                                                           */
/* All rights reserved.  No part of this program or document */
/* may be  reproduced in  any form  or by  any means without */
/* permission in writing from PROGRESS Software Corporation. */
/*************************************************************/
/*------------------------------------------------------------------------

  File: adecomm/aud-evts.i

  Description: Defines lists of numbers that pertain to specific types
               of recorded audit data.

  Input Parameters:
      <none>

  Output Parameters:
      <none>

  Author: Kenneth S. McIntosh

  Created: June 9,2005
  
  History:
     fernando  12/23/08  Support for encryption events
     
------------------------------------------------------------------------*/

&GLOBAL-DEFINE AUD_POL_MNT  300-302,10010,10303-10304
&GLOBAL-DEFINE SCH_CHGS     5000-5041
&GLOBAL-DEFINE AUD_ARCHV    10300-10302
&GLOBAL-DEFINE DATA_ADMIN   10213-10214
&GLOBAL-DEFINE USER_MAINT   100-102
&GLOBAL-DEFINE SEC_PERM_MNT 510-517,10305
&GLOBAL-DEFINE DBA_MAINT    210-212,400-422
&GLOBAL-DEFINE AUTH_SYS     500-507
&GLOBAL-DEFINE DB_ADMIN     10100-10212,10000-10001
&GLOBAL-DEFINE DB_ACCESS    10500-10611
&GLOBAL-DEFINE ENC_POL_MNT  11400-11402,11500-11502,11600-11602
&GLOBAL-DEFINE ENC_KEY_MNT  11100-11114,11200-11207
&GLOBAL-DEFINE ENC_ADMIN    11000,11001,11300,11301
/*************************************************************/
/* Copyright (c) 1984-2006,2011 by Progress Software Corporation  */
/*                                                           */
/* All rights reserved.  No part of this program or document */
/* may be  reproduced in  any form  or by  any means without */
/* permission in writing from PROGRESS Software Corporation. */
/*************************************************************/
/*------------------------------------------------------------------------

  File: adecomm/aud-tts.i

  Description: Defines the temp-tables used for fetching audit data for
               auditing reports.

  Input Parameters:
      <none>

  Output Parameters:
      <none>

  Author: Kenneth S. McIntosh

  Created: June 20,2005

  History:
    kmcintos Sep 1, 2005   Added shared buffers to workaround core bug
                           (core bug # 20050830-017) 20050901-009.
    fernando Dec 23,2005   Removed before-table dom shared temp-tables
------------------------------------------------------------------------*/

DEFINE {1} SHARED VARIABLE ghDataSet    AS HANDLE      NO-UNDO.

DEFINE {1} SHARED TEMP-TABLE clientSess NO-UNDO
    FIELD _Client-session-uuid           AS CHARACTER 
                                            LABEL "Client session uuid" 
                                            FORMAT "X(28)"
                                            CASE-SENSITIVE
    FIELD _Client-name                   AS CHARACTER 
                                            LABEL "Client name" 
                                            FORMAT "X(35)"
    FIELD _User-id                       AS CHARACTER 
                                            LABEL "User id" 
                                            FORMAT "X(35)"
    FIELD _Authentication-date-time      AS DATETIME-TZ 
                                            LABEL "Authentication date/time" 
                                            FORMAT "99/99/9999 HH:MM:SS.SSS+HH:MM" 
                                            INITIAL "?"
    FIELD _Server-uuid                   AS CHARACTER 
                                            LABEL "Server uuid" 
                                            FORMAT "X(28)"
                                            CASE-SENSITIVE
    FIELD _Authentication-domain-type    AS CHARACTER 
                                            LABEL "Authentication domain type" 
                                            FORMAT "X(35)"
    FIELD _Authentication-domain-name    AS CHARACTER 
                                            LABEL "Authentication domain name" 
                                            FORMAT "X(70)"
    FIELD _Db-guid                       AS CHARACTER 
                                            LABEL "Database guid" 
                                            FORMAT "X(28)"
                                            CASE-SENSITIVE
    FIELD _Db-description                AS CHARACTER 
                                            LABEL "Database description" 
                                            FORMAT "X(70)"
    FIELD _Session-custom-detail         AS CHARACTER 
                                            LABEL "Session custom detail" 
                                            FORMAT "X(3000)"
                            VIEW-AS EDITOR SIZE 70 BY 8 SCROLLBAR-VERTICAL 
                                    LARGE MAX-CHARS 3000
    FIELD _Audit-data-security-level     AS INTEGER 
                                            LABEL "Audit data security level" 
                                            FORMAT "->9" INITIAL "0"
                            VIEW-AS COMBO-BOX INNER-LINES 5 
                                    LIST-ITEM-PAIRS "No Additional Security",0,
                                                    "Message Digest",1,
                                                    "DB Passkey",2 
                                    DROP-DOWN-LIST SIZE 37 BY 1    
    FIELD _Audit-data-security-level-name AS CHARACTER 
                                            LABEL "Data security level name" 
                                            FORMAT "X(28)"
    FIELD _Data-sealed                   AS LOGICAL
                                            LABEL "Data sealed" 
                                            VIEW-AS TOGGLE-BOX
    
    INDEX _Auth-time _Authentication-date-time
    INDEX _Db-guid _Db-guid
    INDEX _Session-uuid IS PRIMARY UNIQUE _Client-session-uuid
    INDEX _Userid _User-id.

DEFINE {1} SHARED TEMP-TABLE audDataValue NO-UNDO
    FIELD _Audit-data-guid               AS CHARACTER 
                                            LABEL "Audit data guid" 
                                            FORMAT "X(28)"
                                            CASE-SENSITIVE
    FIELD _Field-name                    AS CHARACTER 
                                            LABEL "Field name" 
                                            FORMAT "X(32)"
    FIELD _Continuation-sequence         AS INTEGER 
                                            LABEL "Continuation sequence" 
                                            FORMAT "->9" INITIAL "0"
    FIELD _Data-type-code                AS INTEGER 
                                            LABEL "Data type code" 
                                            FORMAT "->9" INITIAL "0"
                            VIEW-AS COMBO-BOX INNER-LINES 5 
                                    LIST-ITEM-PAIRS "Character",1,
                                                    "Date",2,
                                                    "Logical",3,
                                                    "Integer",4,
                                                    "INT64",41,
                                                    "Decimal",5,
                                                    "Recid",7,
                                                    "Raw",8,
                                                    "Memptr",11,
                                                    "Rowid",13,
                                                    "Blob",18,
                                                    "Clob",19,
                                                    "Datetime",34,
                                                    "Longchar",39,
                                                    "Datetime-TZ",40 
                                    DROP-DOWN-LIST SIZE 37 BY 1    
    FIELD _Data-type-name                AS CHARACTER 
                                            LABEL "Data type" 
                                            FORMAT "X(20)" 
    FIELD _Old-string-value              AS CHARACTER 
                                            LABEL "Old value" 
                                            FORMAT "X(3000)"
                            VIEW-AS EDITOR SIZE 60 BY 2
                                    LARGE MAX-CHARS 3000
    FIELD _New-string-value              AS CHARACTER 
                                            LABEL "New value" 
                                            FORMAT "X(3000)"
                            VIEW-AS EDITOR SIZE 60 BY 2
                                    LARGE MAX-CHARS 3000
    FIELD _Audit-data-security-level     AS INTEGER 
                                            LABEL "Audit data security level" 
                                            FORMAT "->9" INITIAL "0"
                            VIEW-AS COMBO-BOX INNER-LINES 5 
                                    LIST-ITEM-PAIRS "No Additional Security",0,
                                                    "Message Digest",1,
                                                    "DB Passkey",2 
                                    DROP-DOWN-LIST SIZE 37 BY 1    
    FIELD _Audit-data-security-level-name AS CHARACTER 
                                            LABEL "Data security level name" 
                                            FORMAT "X(28)" 
    FIELD _Data-sealed                   AS LOGICAL
                                            LABEL "Data sealed" 
                                            VIEW-AS TOGGLE-BOX
    INDEX _Continuation-seq IS PRIMARY UNIQUE _Audit-data-guid
                                              _Field-name
                                              _Continuation-sequence
    INDEX _Field-name _Field-name.

DEFINE {1} SHARED TEMP-TABLE audData NO-UNDO
    FIELD _Audit-date-time               AS DATETIME-TZ 
                                            LABEL "Audit date / time" 
                                        FORMAT "99/99/9999 HH:MM:SS.SSS+HH:MM" 
                                            INITIAL "?"
    FIELD _Event-description             AS CHARACTER 
                                            LABEL "Event description" 
                                            FORMAT "X(50)"
    FIELD _User-id                       AS CHARACTER 
                                            LABEL "User id" 
                                            FORMAT "X(35)"
    FIELD _Formatted-event-context        AS CHARACTER 
                                            LABEL "Formatted event context" 
                                            FORMAT "X(200)" 
                                            VIEW-AS EDITOR 
                                              INNER-CHARS 60 
                                              INNER-LINES 3 
                                              LARGE MAX-CHARS 200
    FIELD _Db-description                 AS CHARACTER 
                                            LABEL "Database description" 
                                            FORMAT "X(70)" 
    FIELD _Transaction-id                AS INTEGER 
                                            LABEL "Transaction id" 
                                            FORMAT "->>>>>>>9" INITIAL "0"
    FIELD _Transaction-sequence          AS INTEGER 
                                            LABEL "Transaction sequence" 
                                            FORMAT "->>>>>>>9" INITIAL "0"
    FIELD _Client-name                    AS CHARACTER 
                                            LABEL "Client name" 
                                            FORMAT "X(70)"
    FIELD _Audit-event-group             AS CHARACTER 
                                            LABEL "Audit event group" 
                                            FORMAT "X(28)"
                                            CASE-SENSITIVE
    FIELD _Audit-event-group-name         AS CHARACTER 
                                            LABEL "Event group name" 
                                            FORMAT "X(70)"
    FIELD _Application-context-id        AS CHARACTER 
                                            LABEL "Application context id" 
                                            FORMAT "X(28)"
                                            CASE-SENSITIVE
    FIELD _Application-context-summary    AS CHARACTER 
                                            LABEL "Application context summary" 
                                            FORMAT "X(70)" 
    FIELD _Audit-data-guid               AS CHARACTER 
                                            LABEL "Audit data guid" 
                                            FORMAT "X(28)"
                                            CASE-SENSITIVE
    FIELD _Database-connection-id        AS CHARACTER 
                                            LABEL "Database connection id" 
                                            FORMAT "X(28)"
    FIELD _Event-id                      AS INTEGER 
                                            LABEL "Event id" 
                                            FORMAT "->>>>>9" INITIAL "0"
    FIELD _Event-detail                  AS CHARACTER 
                                            LABEL "Event detail" 
                                            FORMAT "X(3000)"
                            VIEW-AS EDITOR SIZE 70 BY 8 SCROLLBAR-VERTICAL 
                                    LARGE MAX-CHARS 3000
    FIELD _Audit-custom-detail           AS CHARACTER 
                                            LABEL "Audit custom detail" 
                                            FORMAT "X(3000)"
                            VIEW-AS EDITOR SIZE 70 BY 8 SCROLLBAR-VERTICAL 
                                    LARGE MAX-CHARS 3000
    FIELD _Audit-data-security-level     AS INTEGER 
                                            LABEL "Audit data security level" 
                                            FORMAT "->9" INITIAL "0"
                            VIEW-AS COMBO-BOX INNER-LINES 5 
                                    LIST-ITEM-PAIRS "No Additional Security",0,
                                                    "Message Digest",1,
                                                    "DB Passkey",2 
                                    DROP-DOWN-LIST SIZE 37 BY 1    
    FIELD _Audit-data-security-level-name AS CHARACTER 
                                            LABEL "Audit Data Security Level" 
                                            FORMAT "X(28)"
    FIELD _Client-session-uuid           AS CHARACTER 
                                            LABEL "Client session uuid" 
                                            FORMAT "X(28)"
                                            CASE-SENSITIVE
    FIELD _Db-guid                       AS CHARACTER 
                                            LABEL "Database guid" 
                                            FORMAT "X(28)"
                                            CASE-SENSITIVE
    FIELD _Event-context                 AS CHARACTER 
                                            LABEL "Event context" 
                                            FORMAT "X(200)"
                            VIEW-AS EDITOR SIZE 70 BY 3 SCROLLBAR-VERTICAL 
                                    LARGE MAX-CHARS 200
    FIELD _Data-sealed                   AS LOGICAL
                                            LABEL "Data Seal Generated" 
                                            VIEW-AS TOGGLE-BOX
    FIELD _Event-Name                    AS CHARACTER
                                            LABEL "Event Name"
                                            FORMAT "x(50)"
    FIELD _Event-Type                    AS CHARACTER
                                            LABEL "Event Type"
                                            FORMAT "x(20)"
    INDEX _AppContext-Id _Application-context-id
    INDEX _Audit-time _Audit-date-time
    INDEX _Connection-id _Database-connection-id 
                         _Client-session-uuid
    INDEX _Data-guid IS UNIQUE _audit-data-guid
    INDEX _main-idx IS PRIMARY UNIQUE _audit-date-time DESC _event-id DESC _Audit-data-guid
   /* INDEX _Event-context _Event-context */
    INDEX _Event-group _Audit-event-group
                       _Db-guid
                       _Transaction-id
                       _Transaction-sequence
    INDEX _EventId _Event-id
    INDEX _Userid _User-id.

DEFINE {1} SHARED BUFFER bClientSess   FOR clientSess.
DEFINE {1} SHARED BUFFER bAudData      FOR audData.
DEFINE {1} SHARED BUFFER bAudDataValue FOR audDataValue.
/*************************************************************/
/* Copyright (c) 1984-2005 by Progress Software Corporation  */
/*                                                           */
/* All rights reserved.  No part of this program or document */
/* may be  reproduced in  any form  or by  any means without */
/* permission in writing from PROGRESS Software Corporation. */
/*************************************************************/

/**************************************************************************
    Procedure:  dcmpcls.i
    
    Purpose:    Preprocessor Defines for handling compilation of .cls files

    Syntax :    { adecomm/dcmpcls.i }

    Parameters:
    
    Description:
        Defines some constants for use when determining the outcome of 
        a compile relating to .cls files, and whether the compiled code
        contained OO4GL syntax or not.

        There are 3 errors we are interested in re: OO4GL:
        - 12622 and 12623 
          - these define whether a file without a .cls extension 
            contained OO4GL code (CLASS and INTERFACE, respectively).
        - 12629 and 12855
          - this indicates that a file with a .cls extension contained
            a different package than the pathname of the file
            (CLASS and INTERFACE, respectively).
      
        Depending on the circumstances, we might need to check for the 
        error number as an integer or as a string. These preprocessors
        define both.

        For more information, refer to the SAVE_AND_COMPILE_BLOCK 
        comment in adeedit/pcompile.i and adecomm/_pwrun.p

    Notes  :
    Authors: 
    Date   : May 2005
**************************************************************************/


/* .cls-related error message pre-processors */

&GLOBAL-DEFINE IS_CLASS_ERROR "(12622)":U
&GLOBAL-DEFINE IS_INTERFACE_ERROR "(12623)":U
&GLOBAL-DEFINE WRONG_CLASS_TYPE_ERROR "(12629)":U
&GLOBAL-DEFINE WRONG_INTERFACE_TYPE_ERROR "(12855)":U
&GLOBAL-DEFINE IS_CLASS_ERROR_NUM 12622
&GLOBAL-DEFINE IS_INTERFACE_ERROR_NUM 12623
&GLOBAL-DEFINE WRONG_CLASS_TYPE_ERROR_NUM 12629
&GLOBAL-DEFINE WRONG_INTERFACE_TYPE_ERROR_NUM 12855

/* FORWARD declaration of functions */
FUNCTION IsValidClassChange RETURN LOGICAL (
    INPUT cFileName AS CHAR,
    INPUT cCurrentClassType AS CHAR,
    INPUT cCompileClassType AS CHAR) FORWARD.
/*************************************************************/
/* Copyright (c) 1984-2012 by Progress Software Corporation  */
/*                                                           */
/* All rights reserved.  No part of this program or document */
/* may be  reproduced in  any form  or by  any means without */
/* permission in writing from PROGRESS Software Corporation. */
/*************************************************************/
/*------------------------------------------------------------------------
    File        : oeideservice.i
    Purpose     : Function prototypes for oeideservice.p

    Syntax      : {adecomm/oeideservice.i}

    Description : 

    Author(s)   : egarcia
    Created     :
    Notes       :
  ----------------------------------------------------------------------*/
  
  
/* Code is only included once */

&IF DEFINED(OEIDESERVICE_I) = 0 &THEN
&GLOBAL-DEFINE OEIDESERVICE_I

/* ***************************  Definitions  ************************** */
&IF DEFINED(IN-CLASS) <> 0 &THEN 
&SCOPED-DEFINE METHOD method public static final void Init(): 
&SCOPED-DEFINE METHOD-END end. 
&SCOPED-DEFINE NO-NEW 
&ENDIF

&IF DEFINED(NO-NEW) = 0 &THEN 
&SCOPED-DEFINE NEW new global shared
&ELSE 
&SCOPED-DEFINE STAT static
&SCOPED-DEFINE NEW static

&ENDIF
/* 
 * OEIDEIsRunning   Flag indicating that the OpenEdge IDE is running
 * hOEIDEService    Handle to the oeideservice.p persistent procedure
 */
define {&NEW} var OEIDEIsRunning as logical    no-undo.
define {&NEW} var hOEIDEService  as handle     no-undo.

define {&STAT} variable cProcName                   as character  no-undo initial "adecomm/oeideservice.p":U.


/* ********************  Preprocessor Definitions  ******************** */

&GLOBAL-DEFINE VIEW_ACTIVATE 1
&GLOBAL-DEFINE VIEW_VISIBLE  2
&GLOBAL-DEFINE VIEW_CREATE   3


/* **********************  Forward Declarations  ********************** */

&IF DEFINED(OEIDE-EXCLUDE-PROTOTYPES) = 0 &THEN

function activateWindow returns logical 
         (phWindow as handle) in hOEIDEService.

function checkSyntaxInIde returns logical 
    ( phWindow as handle) in hOEIDEService.

function runUIBCommand returns logical 
    ( phWindow as handle, 
      pcCommand as char)       
      in hOEIDEService.

function runDialog returns logical 
    ( phWindow as handle, 
      pcDialogCommand as char)       
      in hOEIDEService.

function checkHelp returns logical
         (pcContextId as character )  
         in hOEIDEService.

function showHelp returns logical
         (pcContextId as character )  
         in hOEIDEService.
 
function showView returns logical 
         (viewId      as character,
          secondaryId as character,
          mode        as integer)
         in hOEIDEService.

function hideView returns logical 
         (viewId      as character,
          secondaryId as character)
         in hOEIDEService.
         
function setViewTitle returns logical 
         (viewId      as character,
          secondaryId as character,
          viewTitle   as character)
         in hOEIDEService.         

function displayEmbeddedWindow returns logical 
         (viewId      as character,
          secondaryId as character,
          hWindow     as handle)
         in hOEIDEService.

function setEmbeddedWindow returns logical 
         (viewId      as character,
          secondaryId as character,
          hWindow     as handle)
         in hOEIDEService.
         
function getProjectName returns character 
         ()
         in hOEIDEService.
         
function getProjectDisplayName returns character 
         ()
         in hOEIDEService.
         
function gotoPage returns logical
         (phWindow as handle,
          piPage as int) 
          in hOEIDEService.
          
function keyPressed returns logical 
    ( phWindow as handle,
      pcKey    as character) 
      in hOEIDEService.
      
function openEditor returns logical
         (cProjectName  as character,
          cFileName     as character,
          cLinkedFile   as character,
          hWindowHandle as handle)
         in hOEIDEService.

function openDesignEditor returns logical 
         (projectName  as character,
          fileName     as character)
          in hOEIDEService.        
               
function openTextEditor returns logical 
          (cProjectName  as character,
           cFileName     as character )  
           in hOEIDEService.             
              
function openDynamicsEditor returns logical 
          (cProjectName  as character,
           cFileName     as character)  
           in hOEIDEService.      

function openPropertySheet returns logical 
          (windowHandle  as handle)  
           in hOEIDEService.     
               
function viewSource returns logical 
    ( phWindow as handle,
      wName AS CHARACTER,
      wType AS CHARACTER,
      wSection AS CHARACTER,
      wTrigger AS CHARACTER) in hOEIDEService.

function saveEditor returns logical 
         (projectName   as character,
          fileName      as character,
          ask_file_name as logical)
         in hOEIDEService.         

function closeEditor returns logical 
         (projectName  as character,
          fileName     as character,
          saveChanges  as logical)
         in hOEIDEService.         

function findAndSelect returns logical 
         (projectName  as character,
          fileName     as character,
          cText        as character,
          activateEditor as logical)
         in hOEIDEService.         

function createLinkedFile returns character 
         (user_chars   as character,
          extension    as character)
         in hOEIDEService. 

function ShowMessageInIDE returns logical
         (msgText      as character,
          MsgType      as character,
          MsgTitle     as character, 
          MsgButtons   as character,
          ButtonValue  as logical) 
          in hOEIDEService. 
          
 
function ShowOkMessageInIDE returns logical
         (msgText      as character,
          MsgType      as character,
          MsgTitle     as character ) 
          in hOEIDEService.      
                 
function SetWindowSize return logical
         (phwin as handle )
          in hOEIDEService.   

function WidgetEvent return logical
         (phwindow   as handle,
          WidgetName as character,
          WidgetText as character,
          WidgetType as character,
          WidgetParent as character,
          WidgetAction as character ) in hOEIDEService. 
              
function AddCodeSection return logical
         (phwindow   as handle,
          AddSection as character) in hOEIDEService.  
          
function AddTrigger return logical
         (phwindow   as handle,
          WidgetName as character,
          WidgetType as character) in hOEIDEService.    
          
function RunDesign return logical
         (phwindow   as handle) in hOEIDEService.    
         
function CompileDesign return logical
         (phwindow   as handle) in hOEIDEService.  
         
function RenameWidget return logical
         (phwindow   as handle,
          WidgetOldName as character,
          WidgetNewName as character,
          WidgetText as character,
          WidgetType as character,
          WidgetParent as character,
          WidgetAction as character ) in hOEIDEService.   

function ShowCueCard return logical
         (CueCardTitle as character,
          CueCardMessage as character) in hOEIDEService.   

function OpenDBConnectionDialog return logical
         (pmessage as character) in hOEIDEService.          
                           
&ENDIF

&IF DEFINED(OEIDE-EXCLUDE-UTILITIES) = 0 &THEN
    
function OEIDE_CanLaunchDialog returns logical
         ( ):         
    define variable plOk as logical no-undo.
    if valid-handle(hOEIDEService) then 
        run CanLaunchDialog in hOEIDEService(output plOk).
    return plOk.
end function.

function OEIDE_CanShowMessage returns logical
         ( ):         
    define variable plOk as logical no-undo.
    if valid-handle(hOEIDEService) then 
        run CanShowMessage in hOEIDEService(output plOk).
    return plOk.
end function.


&ENDIF
                           
 
/* ***************************  Main Block  *************************** */
{&METHOD}
OEIDEIsRunning = if OS-GETENV("OEA_PORT":U) > "" then true else false.
if OEIDEIsRunning and not VALID-HANDLE(hOEIDEService) then
do:
    /* Check to see if OEIDEService is already running */
    hOEIDEService = session:first-procedure.
    do while VALID-HANDLE(hOEIDEService) 
         and hOEIDEService:FILE-NAME <> cProcName:
       hOEIDEService = hOEIDEService:NEXT-SIBLING.
    end.
    if not VALID-HANDLE(hOEIDEService) then
        run VALUE(cProcName) persistent set hOEIDEService.
end.
{&METHOD-END}

&ENDIF

/*************************************************************/
/* Copyright (c) 1984-2012 by Progress Software Corporation  */
/*                                                           */
/* All rights reserved.  No part of this program or document */
/* may be  reproduced in  any form  or by  any means without */
/* permission in writing from PROGRESS Software Corporation. */
/*************************************************************/  
/*------------------------------------------------------------------------
    File        : oeideservice.p
    Purpose     : Methods to interact with the OpenEdge IDE

    Syntax      : 

    Description :

    Author(s)   : egarcia
    Created     :
    Notes       : Some ide information is stored in ide context in the session.
                  Publishes oeide_context from main block to retrieve the 
                  runtime/_oeidecontext.p procedure handle started by 
                  runtime/_server.p. 
  ----------------------------------------------------------------------*/
/*          This .W file was created with the Progress AppBuilder.      */
/*----------------------------------------------------------------------*/
using Progress.Lang.*.

/* ***************************  Definitions  ************************** */
{adecomm/_adetool.i} /* ADEpersistent  */
/* Shared variables to store Preferences for session */
 
&SCOPED-DEFINE BUFFER_SIZE         1024
&SCOPED-DEFINE NO_EMBEDDED_WINDOWS NO

&SCOPED-DEFINE VIEW_ACTIVATE 1
&SCOPED-DEFINE VIEW_VISIBLE  2
&SCOPED-DEFINE VIEW_CREATE   3

/** must match definitions in com.openedge.pdt.oestudio.input.ICommandHandlerConstants 
    and have a corresponding input handler   */
define variable  GET_IDE_PREFERENCES        as integer init 1 no-undo.  
define variable  GOTO_PAGE                  as integer init 2 no-undo.
define variable  GET_PROJECT_PROPERTIES     as integer init 3 no-undo.
define variable  GET_ACTIVE_PROJECT_OF_FILE as integer init 4 no-undo.
define variable  GET_PROJECT_OF_FILE        as integer init 5 no-undo.
define variable  OPEN_TEXT_EDITOR           as integer init 6 no-undo.
define variable  SAVE_EDITOR                as integer init 7 no-undo.
define variable  CLOSE_EDITOR               as integer init 8 no-undo.
define variable  ACTIVATE_EDITOR            as integer init 9 no-undo.
define variable  ADD_WINDOW                 as integer init 10 no-undo.
define variable  FIND_AND_SELECT            as integer init 11 no-undo.
define variable  SET_EDITOR_MODIFIED        as integer init 12 no-undo.
define variable  SHOW_VIEW                  as integer init 13 no-undo.
define variable  HIDE_VIEW                  as integer init 14 no-undo.
define variable  DELETE_VIEW                as integer init 15 no-undo.
define variable  GET_VIEW_HWND              as integer init 16 no-undo.
define variable  RUN_UIB_COMMAND            as integer init 17 no-undo.
define variable  SET_VIEW_TITLE             as integer init 18 no-undo.
define variable  SET_EMBEDDED_WINDOW        as integer init 19 no-undo.
define variable  SET_TTY_TERMINAL_COLOR     as integer init 20 no-undo.
define variable  VIEW_SOURCE                as integer init 21 no-undo.
define variable  SHOW_HELP                  as integer init 22 no-undo.
define variable  RUN_CHILD_DIALOG           as integer init 23 no-undo.
define variable  CHECK_HELP                 as integer init 24 no-undo.
define variable  OPEN_DYNAMICS_EDITOR       as integer init 25 no-undo.
define variable  SHOW_MESSAGE_IN_IDE        as integer init 26 no-undo.
define variable  APPBUILDER_CONNECTION      as integer init 27 no-undo.
define variable  OPEN_DESIGN_EDITOR         as integer init 28 no-undo.
define variable  OPEN_PROPERTY_SHEET        as integer init 29 no-undo.
define variable  SET_WINDOW_SIZE            as integer init 30 no-undo. 
define variable  WIDGET_EVENT               as integer init 31 no-undo.
define variable  ADD_CODE_SECTION           as integer init 32 no-undo.
define variable  ADD_TRIGGER                as integer init 33 no-undo.
define variable  RUN_DESIGN                 as integer init 34 no-undo.
define variable  COMPILE_DESIGN             as integer init 35 no-undo.
define variable  RENAME_WIDGET_NAME         as integer init 36 no-undo.
define variable  SHOW_CUE_CARD              as integer init 37 no-undo.
define variable  OPEN_DB_CONNECTION         as integer init 38 no-undo.
define variable  KEY_PRESSED                as integer init 39 no-undo.
define variable  CHECK_SYNTAX               as integer init 40 no-undo.

/* see publish in main block */ 
define variable fContextHandle as handle no-undo.
define variable PARAMETER_DELIMITER as char no-undo init "|".

function getAppbuilderMode returns character       () in fContextHandle.
function getDesignFileName returns character       (piHwnd as int64) in fContextHandle.
function getDesignHwnd returns int64             (pcFile as char) in fContextHandle.  
function getLinkFileFileName returns char          (pcLinkFile as char) in fContextHandle.   
function getLinkFileName returns char              (piHwnd as int64) in fContextHandle.
function getLinkFileTimeStamp returns datetime     (pcLinkFile as char) in fContextHandle. 
function getLinkFileWindow returns handle          (pcLinkFile as char) in fContextHandle .
function getOpenDialogHwnd returns int64         () in fContextHandle.
function getProjectName returns character          () in fContextHandle.
function getProjectWorkDirectory returns character () in fContextHandle.    
function getSocketClient returns handle            () in fContextHandle.
function getWorkDirectory returns character        () in fContextHandle.
/* not implemented - exposes context to abl 
   must be specifically declared - not defined in oeideservice.i */
function getRequestContext returns character        () in fContextHandle.
function registerObject returns logical            (piHwnd as int64,pObject as Object) in fContextHandle.
function removeHwnd returns logical                (piHwnd as int64) in fContextHandle.
function setCurrentEventObject returns logical     (pobj as Object) in fContextHandle.              
function setLinkFileTimeStamp returns logical      (pcLinkFile as char,dt as datetime) in fContextHandle. 
function setNextEventObject returns logical        (pobj as Object) in fContextHandle.              
/** not yet
/* not implemented - exposes context to abl 
   must be specifically declared - not defined in oeideservice.i */
function setRequestContext returns logical        (pccontext as char) in fContextHandle.
**/

function setWindowHandle returns logical (piHwnd as int64,phhandle as handle) in fContextHandle.               
define variable CurrentDesignEditor as int64 no-undo.
/*
define temp-table ttLinkedFile no-undo
    field windowHandle         as handle
    field projectName          as character
    field fileName             as character
    field linkedFile           as character
    field syncTimeStamp        as datetime
    index linkedFile   is primary unique linkedFile
    index windowHandle is unique windowHandle
    index fileName     is unique fileName   
    .
  */      



/* ********************  Preprocessor Definitions  ******************** */

&Scoped-define PROCEDURE-TYPE Procedure
&Scoped-define DB-AWARE no



/* ************************  Function Prototypes ********************** */

&IF DEFINED(EXCLUDE-activateWindow) = 0 &THEN

function activateWindow returns logical 
    ( phWindow as handle) forward.


&ENDIF

&IF DEFINED(EXCLUDE-checkSyntaxInIde) = 0 &THEN

function checkSyntaxInIde returns logical 
    ( phWindow as handle) forward.


&ENDIF

&IF DEFINED(EXCLUDE-displayEmbeddedWindow) = 0 &THEN

function displayEmbeddedWindow returns logical
         (viewId      as character,
          secondaryId as character,
          hWindow     as handle)  forward.


&ENDIF

&IF DEFINED(EXCLUDE-getDesignFileNameParent) = 0 &THEN

function getDesignFileNameParent returns character
         (piHwnd as handle)  forward.


&ENDIF

&IF DEFINED(EXCLUDE-getDesignId) = 0 &THEN
        
 /** we currently use the handle as the id -  */      
function getDesignId returns int64 
       (phWidget as handle) forward.

&ENDIF

&IF DEFINED(EXCLUDE-getProjectDisplayName) = 0 &THEN
        
 /** we currently use the handle as the id -  */      
function getProjectDisplayName returns character 
       () forward.

&ENDIF

&IF DEFINED(EXCLUDE-hideView) = 0 &THEN

function hideView returns logical
         (viewId      as character,
          secondaryId as character)  forward.


&ENDIF



&IF DEFINED(EXCLUDE-runDialog) = 0 &THEN

function runDialog returns logical 
    (phWindow as handle,
     pcDialogCommand as char) forward.


&ENDIF

&IF DEFINED(EXCLUDE-runUIBCommand) = 0 &THEN

function runUIBCommand returns logical 
    ( phWindow as handle, 
     pcCommand as char) forward.


&ENDIF

&IF DEFINED(EXCLUDE-setEmbeddedWindow) = 0 &THEN

function setEmbeddedWindow returns logical
         (viewId      as character,
          secondaryId as character,
          hWindow     as handle)  forward.


&ENDIF

&IF DEFINED(EXCLUDE-setTTYTerminalColor) = 0 &THEN

function setTTYTerminalColor returns logical
         (pBG as int,
          pFG as int)  forward.


&ENDIF


&IF DEFINED(EXCLUDE-setViewTitle) = 0 &THEN

function setViewTitle returns logical
         (viewId      as character,
          secondaryId as character,
          viewTitle   as character)  forward.


&ENDIF

&IF DEFINED(EXCLUDE-checHelp) = 0 &THEN

function checkHelp returns logical
         (pcContextId as character )  forward.


&ENDIF


&IF DEFINED(EXCLUDE-showHelp) = 0 &THEN

function showHelp returns logical
         (pcContextId as character )  forward.


&ENDIF

&IF DEFINED(EXCLUDE-showView) = 0 &THEN

function showView returns logical
         (viewId      as character,
          secondaryId as character,
          mode        as integer)  forward.


&ENDIF

&IF DEFINED(EXCLUDE-openEditor) = 0 &THEN
function openEditor returns logical
         (cProjectName  as character,
          cFileName     as character,
          cLinkedFile   as character,
          hWindowHandle as handle) forward.

&ENDIF

&IF DEFINED(EXCLUDE-openDesignEditor) = 0 &THEN

function openDesignEditor returns logical 
         (cProjectName  as character,
          cFileName      as character)  forward.

&ENDIF

&IF DEFINED(EXCLUDE-openTextEditor) = 0 &THEN

function openTextEditor returns logical 
         (cProjectName  as character,
          cFileName      as character)  forward.

&ENDIF

&IF DEFINED(EXCLUDE-openDynamicsEditor) = 0 &THEN

function openDynamicsEditor returns logical 
         (cProjectName  as character,
          cFileName      as character)  forward.

&ENDIF

&IF DEFINED(EXCLUDE-openPropertySheet) = 0 &THEN
function openPropertySheet returns logical 
          (windowHandle  as handle) forward.  

&ENDIF

&IF DEFINED(EXCLUDE-saveEditor) = 0 &THEN

function saveEditor returns logical
         (cProjectName  as character,
          cFileName     as character,
          ask_file_name as logical)  forward.


&ENDIF

&IF DEFINED(EXCLUDE-closeEditor) = 0 &THEN

function closeEditor returns logical
         (cProjectName  as character,
          cFileName     as character,
          lSaveChanges  as logical)  forward.


&ENDIF

&IF DEFINED(EXCLUDE-findAndSelect) = 0 &THEN

function findAndSelect returns logical
         (projectName  as character,
          fileName     as character,
          cText        as character,
          activateEditor as logical)  forward.


&ENDIF

&IF DEFINED(EXCLUDE-createLinkedFile) = 0 &THEN

function createLinkedFile returns character
         (user_chars   as character,
          extension    as character)  forward.


&ENDIF


&IF DEFINED(EXCLUDE-gotoPage) = 0 &THEN

function gotoPage returns logical 
    ( phWindow as handle, 
      piPage as int) forward.


&ENDIF

&IF DEFINED(EXCLUDE-viewSource) = 0 &THEN

function keyPressed returns logical 
    ( phWindow as handle,
      pcKey    as character) forward.

&ENDIF

&IF DEFINED(EXCLUDE-viewSource) = 0 &THEN

function viewSource returns logical 
    ( phWindow as handle,
      wName AS CHARACTER,
      wType AS CHARACTER,
      wSection AS CHARACTER,
      wTrigger AS CHARACTER) forward.


&ENDIF

&IF DEFINED(EXCLUDE-hasDdialog) = 0 &THEN
 function HasDialog returns logical
         (phParent as handle) forward.
&ENDIF

&IF DEFINED(EXCLUDE-SetWindowSize) = 0 &THEN
function  SetWindowSize return logical
         (phwin as handle ) forward.          
&ENDIF

&IF DEFINED(EXCLUDE-ShowOkMessageInIDE) = 0 &THEN
function ShowOkMessageInIDE returns logical
         (msgText      as character,
          MsgType      as character,
          MsgTitle     as character) forward.   
&ENDIF

&IF DEFINED(EXCLUDE-ShowMessageInIDE) = 0 &THEN
function ShowMessageInIDE returns logical
          (msgText      as character,
          MsgType      as character,
          MsgTitle     as character, 
          MsgButtons   as character,
          ButtonValue  as logical) forward.
&ENDIF
          
&IF DEFINED(EXCLUDE-WidgetEvent) = 0 &THEN
function WidgetEvent returns logical
         (phwindow   as handle,
          WidgetName as character,
          WidgetText as character,
          WidgetType as character,
          WidgetParent as character,
          WidgetAction as character ) forward.
&ENDIF
&IF DEFINED(EXCLUDE-RenameWidget) = 0 &THEN
function RenameWidget return logical
         (phwindow   as handle,
          WidgetOldName as character,
          WidgetNewName as character,
          WidgetText as character,
          WidgetType as character,
          WidgetParent as character,
          WidgetAction as character ) forward.
 &ENDIF         
&IF DEFINED(EXCLUDE-AddCodeSection) = 0 &THEN
function AddCodeSection return logical
         (phwindow   as handle,
          AddSection as character)forward.          
&ENDIF     
     
&IF DEFINED(EXCLUDE-AddTrigger) = 0 &THEN
function AddTrigger return logical
         (phwindow   as handle,
          WidgetName as character,
          WidgetType as character) forward.
&endif      

&IF DEFINED(EXCLUDE-RunDesign) = 0 &THEN
function RunDesign return logical
         (phwindow   as handle) forward.
&endif             
&IF DEFINED(EXCLUDE-CompileDesign) = 0 &THEN         
function CompileDesign return logical
         (phwindow   as handle) forward.    
&endif   
&IF DEFINED(EXCLUDE-ShowCueCard) = 0 &THEN
function ShowCueCard return logical
         (CueCardTitle as character,
          CueCardMessage as character) forward.  
&endif   

&IF DEFINED(EXCLUDE-OpenDBConnectionDialog) = 0 &THEN
function OpenDBConnectionDialog return logical
         (pmessage as character)   forward.
&endif                      
/* *********************** Procedure Settings ************************ */



/* *************************  Create Window  ************************** */

/* DESIGN Window definition (used by the UIB) 
  CREATE WINDOW Procedure ASSIGN
         HEIGHT             = 15
         WIDTH              = 60.
/* END WINDOW DEFINITION */
                                                                        */

/* ************************* Included-Libraries *********************** */

 




/* ***************************  Main Block  *************************** */
publish "oeide_context" from this-procedure (output fContextHandle).
 
 



/* **********************  Internal Procedures  *********************** */
 
 
&IF DEFINED(EXCLUDE-getSendEditMaster) = 0 &THEN
        
procedure getIsIDEIntegrated:
    DEFINE OUTPUT PARAMETER plintegrated AS LOGICAL NO-UNDO. 
    /*------------------------------------------------------------------------------
          Purpose: Is ab integrated 
                   True is currently the only supported mode. 
                   We're keeping the ability to support multiple modes implemented
                   to support the old modes embedded and not embedded for defensive 
                   reasons. (note: implemention of the old modes or other modes in 
                   addition to the integrsted would require a lot of work)
                                                                                           
            Notes: TODO ABMode = integrated                                                                       
    ------------------------------------------------------------------------------*/
   plintegrated = true.


end procedure.
    

&ENDIF

 
&IF DEFINED(EXCLUDE-OnChoose) = 0 &THEN
        
procedure OnChoose:
    define input  parameter h as handle no-undo.
    /*------------------------------------------------------------------------------
            Purpose:                                                                      
            Notes:                                                                        
    ------------------------------------------------------------------------------*/
  /* message 
   h:name
   focus:name 
   
   view-as alert-box.
*/
end procedure.
    

&ENDIF

&IF DEFINED(EXCLUDE-positionDesignWindow) = 0 &THEN
        
procedure positionDesignWindow:
    define input parameter phWindow as handle no-undo.
    /*------------------------------------------------------------------------------
            Purpose: called from uibmain to position the design window ...                                                                        
            Notes:                                                                        
    ------------------------------------------------------------------------------*/
    /* the numbers are copied from uibmain hardcode  - there were no comments */
    
   /* left upper corner of design canvas */
    assign phWindow:x = 10  
           phWindow:y = 10 NO-ERROR.
             
    SetWindowSize(phWindow).
end procedure.
    

&ENDIF
 
 

&IF DEFINED(EXCLUDE-getLinkedFileName) = 0 &THEN

procedure getLinkedFileName :
/*------------------------------------------------------------------------------
  Purpose: Returns the file name of the linked file for a given window
  Parameters:
  Notes: 
------------------------------------------------------------------------------*/
define input parameter phWindow           as handle     no-undo.
define output parameter pcLinkedFile      as character  no-undo.
    
    define variable iId as int64 no-undo.
    iId = getDesignId(phWindow).
    pcLinkedFile = getLinkFileName(iId).
end procedure.


&ENDIF

&IF DEFINED(EXCLUDE-getSyncTimeStamp) = 0 &THEN

procedure getSyncTimeStamp :
/*------------------------------------------------------------------------------
  Purpose: Returns the timestamp of a linked file
  Parameters:
  Notes: 
------------------------------------------------------------------------------*/
define input parameter pcLinkedFile     as character  no-undo.
define output parameter timeStamp       as datetime   no-undo.
    timeStamp = getLinkFileTimeStamp(pcLinkedFile).
end procedure.


&ENDIF

&IF DEFINED(EXCLUDE-setSyncTimeStamp) = 0 &THEN

procedure setSyncTimeStamp :
/*------------------------------------------------------------------------------
  Purpose: Sets the timestamp of a linked file
  Parameters:
  Notes: 
------------------------------------------------------------------------------*/
define input parameter pcLinkedFile as character  no-undo.
define input parameter timeStamp    as datetime   no-undo.
    setLinkFileTimeStamp(pcLinkedFile,timeStamp).
end procedure.


&ENDIF

&IF DEFINED(EXCLUDE-addWindow) = 0 &THEN

procedure addWindow :
/*------------------------------------------------------------------------------
  Purpose: Adds a 4GL window to the specified view
  Parameters:
    Notes:  
------------------------------------------------------------------------------*/
define input parameter viewId      as character  no-undo.
define input parameter secondaryId as character  no-undo.
define input parameter hWindow     as handle     no-undo.

define variable wHwnd as int64       no-undo.
define variable lVisible as logical    no-undo.
define variable cResult as character   no-undo.

&IF "{&NO_EMBEDDED_WINDOWS}" EQ "YES" &THEN
    return.
&ENDIF
if (secondaryId begins "DesignView":U or secondaryId begins "PropertiesWindow":U) then 
    return.

if not valid-handle(hWindow) then return.

define variable iParentWindow as int64    no-undo.

run getViewHwnd (viewId, secondaryId, output iParentWindow).

if iParentWindow <> 0 then
    assign hWindow:IDE-WINDOW-TYPE = 1 /* virtual desktop */ 
           hWindow:IDE-PARENT-HWND = iParentWindow.
           

end procedure.


&ENDIF


&IF DEFINED(EXCLUDE-displayDesignWindow) = 0 &THEN

procedure displayDesignWindow :
    define input parameter pcFileName  as character  no-undo.
    define input parameter hWindow     as handle     no-undo.
    define variable iParentWindow as int64 no-undo.
    
    if pcFileName = ? then pcFileName = "NEW".
    
    iParentWindow = getDesignHwnd(pcFileName).
    if iParentWindow = ? then 
    do:
        /* check if linked file name was passed (synchfromid) */
        pcFileName = getLinkFileFileName(pcFileName).
        iParentWindow = getDesignHwnd(pcFileName).
    end.    
    if iParentWindow  <> ? and iParentWindow <> 0 then
    do:
         /* design canvas mode = not movable and only reizable right-bottom */ 
        assign hWindow:IDE-WINDOW-TYPE = 5  
               hWindow:IDE-PARENT-HWND = iParentWindow.
   
        setWindowHandle(iParentWindow,hwindow).
    end.
    return.
end procedure.

&ENDIF

&IF DEFINED(EXCLUDE-displayWindow) = 0 &THEN
 
procedure displayContainer :
/*------------------------------------------------------------------------------
  Purpose:  hook for adm2/containr.p 
  Parameters:
  Notes: Called from createObject before window is realized 
------------------------------------------------------------------------------*/
define input parameter prochandle     as handle  no-undo.
define input parameter objectname    as character  no-undo.
define input parameter hWindow        as handle     no-undo.

    define variable pdialog as adeuib.idialogservice  no-undo.
    define variable iHwnd as int64 no-undo.
    if not valid-handle(hWindow) then 
        return.
    case objectname:
        /* CustomLayout (_uibmain morph-layout  ) and CustomizationPriority 
           SmartWindows that emulates dialogs in standalone - uses Eclipse dialog */
        when "rycstlow" or when "rycusmodw" then
        do:
           ihwnd = getOpenDialogHwnd().
           pdialog = new adeuib._windowservice(hWindow,ihwnd,procHandle).
           registerObject(ihwnd,pdialog).
        end. 
    end.  
end procedure.

    
&ENDIF


&IF DEFINED(EXCLUDE-displayWindow) = 0 &THEN

procedure displayWindow :
/*------------------------------------------------------------------------------
  Purpose: Compound procedure to show and embed 
           the specified window into the view in virtual desktop mode 
  Parameters:
  Notes: 
------------------------------------------------------------------------------*/
define input parameter viewId      as character  no-undo.
define input parameter secondaryId as character  no-undo.
define input parameter hWindow     as handle     no-undo.

define variable xViewId as char init "com.openedge.pdt.oestudio.views.OEAppBuilderView".

define variable iParentWindow as int64    no-undo.

   if not valid-handle(hWindow) then return.
       
   if viewId = "appbuilderpalette" then
   do:
    /*    if CurrentDesignEditor > 0 then         */
    /*        iParentWindow = CurrentDesignEditor.*/
    /*    else                                    */
        viewId = xViewId.
    end.

    if viewId = xViewId and secondaryId begins "designview" then
    do:
      
        define variable hwnd as int64 no-undo.
        /*define variable result as integer no-undo.*/
    
        /* This will prevent the window from becoming visible even if the window 
           is explicitly made visible by setting VISIBLE = YES, HIDDEN = FALSE, 
           or any other attribute setting or statement that makes a window visible. */
        hWindow:IDE-WINDOW-MODE = 1. 
        /*  realize window (see above) */
        hWindow:hidden = false. 
/*                                                       */
/*            run GetParent(hWindow:hwnd, output result).*/
/*                                                       */
/*            run ShowWindow(result, 0, output result).  */
        
        /* Set positions somewhat central as some dialogs seems to be 
           positioned relative to uib main see below
           -- not tested with ide-window-mode = 1  */  
        hWindow:col = session:width / 2. 
        hWindow:row = 10.
                 
        return.
         
    end.
    
end procedure.


&ENDIF

&IF DEFINED(EXCLUDE-setEditorModified) = 0 &THEN

procedure setEditorModified :
/*------------------------------------------------------------------------------
  Purpose: Set the editor to modified 
  Parameters:
  Notes: 
  - Tell the OpenEdge IDE Editor that the file has been modified so the Save 
    button in the IDE will be enabled, and a check for changes would be 
    performed before the editor is closed.
------------------------------------------------------------------------------*/
    define input parameter phWindow     as handle     no-undo.
  
    define variable iDesignId as int64 no-undo. 
    iDesignId = getDesignId(phWindow). 
    run sendRequest in getSocketClient()
                     (SET_EDITOR_MODIFIED,
                      "IDE setEditorModified ":U 
                      + QUOTER(getProjectName()) + PARAMETER_DELIMITER
                      + QUOTER(iDesignId)).
        
end procedure.


&ENDIF

&IF DEFINED(EXCLUDE-getWindowOfFile) = 0 &THEN

procedure getWindowOfFile :
/*------------------------------------------------------------------------------
  Purpose: Returns the handle of the window associated with a linked file
  Parameters:
  Notes: 
------------------------------------------------------------------------------*/
define input parameter pcLinkedFile as character  no-undo.
define output parameter phWindow    as handle     no-undo.
    phWindow = getLinkFileWindow(pcLinkedFile).
end procedure.


&ENDIF
 
&IF DEFINED(EXCLUDE-getViewHwnd) = 0 &THEN

procedure getViewHwnd :
/*------------------------------------------------------------------------------
  Purpose: Returns the Windows hwnd value of the specified view
  Parameters:
  Notes: 
------------------------------------------------------------------------------*/
define input parameter viewId       as character  no-undo.
define input parameter secondaryId  as character  no-undo.
define output parameter iResult     as int64    no-undo.

define variable cResult as character  no-undo.
  
if  (viewId = "DIALOG") then
do:
   iResult = getDesignHwnd(secondaryId).
   
end.

else if (secondaryId = "NEWOBJECT" or secondaryId = "WIZARD") then
do:
    iResult = getDesignHwnd(secondaryId).
    
end.
else do:
    
   if (secondaryId begins "DesignView":U) then
       return.

   run sendWaitRequest in getSocketClient()(
                    GET_VIEW_HWND,
                    "IDE getViewHwnd ":U 
                    + viewId + PARAMETER_DELIMITER 
                    + QUOTER(secondaryId),
                    output cResult).
    iResult = int64(cResult) no-error.
    
end.

end procedure.


&ENDIF

&IF DEFINED(EXCLUDE-getActiveProjectOfFile) = 0 &THEN

procedure getActiveProjectOfFile :
/*------------------------------------------------------------------------------
  Purpose: Returns the project associated with a file for the AppBuilder session
  Parameters:
  Notes: Returns blank if the project cannot be used as a resource 
  in the current AppBuilder session.
------------------------------------------------------------------------------*/
define input parameter pcFullPathName as character  no-undo.
define output parameter pcProjectName as character  no-undo.
define variable phand as handle no-undo.
define variable cCurrentProjectName as character   no-undo.

    if pcFullPathName = "" or pcFullPathName = ? then
    do:
        pcProjectName = "".
        return.
    end.
        
    cCurrentProjectName = getProjectName().
    run sendWaitRequest in getSocketClient()(
            GET_ACTIVE_PROJECT_OF_FILE,
            "IDE getActiveProjectOfFile ":U
            + QUOTER(getProjectName()) + PARAMETER_DELIMITER    
            + QUOTER(pcFullPathName), 
            output pcProjectName).
/*                                                                              */
/*        run sendRequest("IDE getActiveProjectOfFile ":U                       */
/*                        + QUOTER(cCurrentProjectName) + " "                   */
/*                        + QUOTER(pcFullPathName), true, output pcProjectName).*/
    
    if pcProjectName = "FALSE":U then
        pcProjectName = "".
    
    if pcprojectName <> "" then
    do:
        run adeuib/_oeidepref.p PERSISTENT SET phand.
        run SetCurrentProjectProperties in phand(pcprojectName).
        if valid-handle(phand) then
        delete object phand no-error.
    end.

end procedure.


&ENDIF

&IF DEFINED(EXCLUDE-getProjectProperties) = 0 &THEN

procedure getPreferences :
/*------------------------------------------------------------------------------
  Purpose: Returns the project properties from the ide
  Parameters:
  Notes: 
------------------------------------------------------------------------------*/
    define output parameter pcProperties as character  no-undo.

    run sendWaitRequest in getSocketClient()
          (GET_IDE_PREFERENCES,
          "IDE getIDEPreferences ":U 
          +  quoter(GetProjectName()),
          output pcproperties).
           
end procedure.


&ENDIF

&IF DEFINED(EXCLUDE-RunChildDialog) = 0 &THEN

procedure runChildDialog :
/*------------------------------------------------------------------------------
  Purpose: Asks the IDE to start a dialog and call RunChildDialog from it 
  Parameters:
  Notes: 
------------------------------------------------------------------------------*/
    /* the object that knows who and what to call  */
    define input parameter Object as Object  no-undo.
    /* store handle for call back to the uib service */
    setCurrentEventObject(Object).
    run sendRequest in getSocketClient()
          (RUN_CHILD_DIALOG ,
          "IDE RunChildDialog ":U 
          +  quoter(GetProjectName())) .
          
end procedure.


&ENDIF

&IF DEFINED(EXCLUDE-setNextChildDialog) = 0 &THEN

procedure setNextChildDialog :
/*------------------------------------------------------------------------------
  Purpose: Sets the next dialog.
           Sets HasNextDialog to true.
           Caller must check and return signal to the IDE to call again from 
           current runchildDialog request. 
  Parameters:
  Notes: 
------------------------------------------------------------------------------*/
    /* the object that knows who and what to call  */
    define input parameter Object as Object  no-undo.
    /* store handle for call back to the uib service */
    setNextEventObject(Object).
end procedure.

&ENDIF

/*&IF DEFINED(EXCLUDE-runWizard) = 0 &THEN                                   */
/*                                                                                */
/*procedure runWizard :                                                           */
/*/*------------------------------------------------------------------------------*/
/*  Purpose: Asks the IDE to start a dialog and call RunChildDialog from it       */
/*  Parameters:                                                                   */
/*  Notes:                                                                        */
/*------------------------------------------------------------------------------*/*/
/*    /*  te  */                                                                  */
/*    define input parameter pcTemplateName as char  no-undo.                     */
/*    /* store handle for call back to the uib service */                         */
/*    run sendRequest in getSocketClient()                                        */
/*          (RUN_WIZARD ,                                                         */
/*          "IDE RunWizard ":U                                                    */
/*          +  quoter(pcTemplateName)) .                                          */
/*                                                                                */
/*end procedure.                                                                  */
/*                                                                                */
/*                                                                                */
/*&ENDIF                                                                          */




&IF DEFINED(EXCLUDE-getProjectProperties) = 0 &THEN

procedure getProjectProperties :
/*------------------------------------------------------------------------------
  Purpose: Returns the project properties from the ide
  Parameters:
  Notes: 
------------------------------------------------------------------------------*/
    define output parameter pcProperties as character  no-undo.

    run sendWaitRequest in getSocketClient()
          (GET_PROJECT_PROPERTIES,
          "IDE getProjectProperties ":U 
          +  quoter(GetProjectName()),
          output pcproperties).
           
 
end procedure.


&ENDIF


&IF DEFINED(EXCLUDE-getProjectOfFile) = 0 &THEN

procedure getProjectOfFile :
/*------------------------------------------------------------------------------
  Purpose: Returns the project associated with a file
  Parameters:
  Notes: 
------------------------------------------------------------------------------*/
define input parameter pcFullPathName as character  no-undo.
define output parameter pcProjectName as character  no-undo.
define variable cCurrentProjectName as character   no-undo.
if pcFullPathName = "" or pcFullPathName = ? then
do:
    pcProjectName = "".
    return.
end.
    
    
cCurrentProjectName = getProjectName().
run sendWaitRequest in getSocketClient()(
                    GET_PROJECT_OF_FILE, 
                    "IDE getProjectOfFile ":U 
                    + QUOTER(cCurrentProjectName) + PARAMETER_DELIMITER    
                    + QUOTER(pcFullPathName), 
                     output pcProjectName).

if pcProjectName = "FALSE":U then
    pcProjectName = "".

end procedure.


&ENDIF

&IF DEFINED(EXCLUDE-CreateDialogService) = 0 &THEN

procedure createDialogService :
/*------------------------------------------------------------------------------
  Purpose:  Creates a dialog service for the IDE 
  Parameters:
        INOUT frame handle 
        OUTPUT adeuib.idialogservice 
  Notes: 
------------------------------------------------------------------------------*/
    define input parameter pFrame  as handle  no-undo.
    define output parameter pdialog as adeuib.idialogservice  no-undo.
    define variable iHwnd as int64 no-undo.
    ihwnd = getOpenDialogHwnd().
    pdialog = new adeuib._dialogservice(pframe,ihwnd).
    registerObject(ihwnd,pdialog).
end procedure.


&ENDIF



&IF DEFINED(EXCLUDE-asyncRequest) = 0 &THEN

procedure asyncRequest :
/*------------------------------------------------------------------------------
  Purpose: Executes IDE commands ignoring its response
  Parameters:
        INPUT   pcCommand IDE command to be send to the OEIDE
  Notes: 
------------------------------------------------------------------------------*/
    define input parameter pcCommand as character   no-undo.

    define variable cResult as character   no-undo.

    run sendRequest(pcCommand, false, output cResult).
end procedure.


&ENDIF

&IF DEFINED(EXCLUDE-appbuilderConnection) = 0 &THEN

procedure appbuilderConnection :
/*    define input  parameter pReply as longchar no-undo.*/
    run sendRequest in getSocketClient()(
                        APPBUILDER_CONNECTION, 
                        "IDE appbuilderConnection ":U 
                        + quoter(getProjectName())).
    
end procedure.    

&ENDIF

&IF DEFINED(EXCLUDE-resizeToParent) = 0 &THEN

procedure resizeToParent :
    define input  parameter hWindow as handle no-undo.
    define variable wrect as memptr no-undo.
    define variable iparent as integer no-undo.
    define variable ihwnd as integer no-undo.
    define variable iXpos as integer no-undo.
    define variable iYpos as integer no-undo.
    define variable iWidth as integer no-undo.
    define variable iHeight as integer no-undo.
    
    run GetParent(hWindow:hwnd,output iparent).
    if iparent <> 0 then 
    do on error undo, leave:
        set-size(wrect) = 16. /* 4 INTEGERS at 4 bytes each*/
        run GetWindowRect(iparent, output wrect).        
        assign iXpos = GET-LONG(wrect, 1)
               iYpos = GET-LONG(wrect, 5).
               iWidth = GET-LONG(wrect, 9).
               iHeight = GET-LONG(wrect, 1).
        hWindow:height = iheight.
        hwindow:width = iWidth.
        
    end.
end procedure.
&ENDIF


&IF DEFINED(EXCLUDE-sendRequest) = 0 &THEN

procedure sendRequest :
/*------------------------------------------------------------------------------
  Purpose: Executes IDE commands 
  Parameters:
        INPUT   pcCommand IDE command to be send to the OEIDE
        INPUT   plWait    Wait for response from the OEIDE
        OUTPUT  pcResult  String returned from the OEIDE.
                It cannot be unknown.
                The string TRUE and FALSE may be returned from the OEIDE.
  Notes: DEPRECATED This is old and not in use 
             -  kept in case someone calls it (customer code)   
------------------------------------------------------------------------------*/
define input parameter pcCommand as character   no-undo.
define input parameter plWait    as logical     no-undo.
define output parameter pcResult as character   no-undo initial "FALSE":U.

define variable hSocket as handle      no-undo.
define variable mBuffer as memptr      no-undo.
define variable mReadBuffer as memptr  no-undo.
define variable lStatus as logical     no-undo.

   if pcCommand = ? then return.
   if not plWait then
       pcResult = "TRUE":U.
/*    MESSAGE "sendrequest:"*/
/*                          */
/*           pccommand      */
/*    VIEW-AS ALERT-BOX.    */
   create socket hSocket.
   
   lStatus = hSocket:connect("-H localhost -S ":U + OS-GETENV("OEA_PORT":U)) no-error.
   if not lStatus then return.
   
   pcCommand = pcCommand + "~n".
   SET-SIZE(mBuffer)      = 0.
   SET-SIZE(mBuffer)      = length(pcCommand) + 1.
   PUT-STRING(mBuffer, 1) = pcCommand.
   
   lStatus = hSocket:write(mBuffer, 1, length(pcCommand)).
   SET-SIZE(mBuffer) = 0.
   if not lStatus then return.       
 
   if plWait then
   do:
        SET-SIZE(mReadBuffer)      = {&BUFFER_SIZE}.
        if hSocket:connected() then
        do:
            
            lStatus = not hSocket:read(mReadBuffer, 1, {&BUFFER_SIZE} - 1, read-available) no-error.
            if hSocket:bytes-read > 0 or lStatus then
                pcResult = "".                
            
            do while hSocket:bytes-read > 0:                
                PUT-BYTE(mReadBuffer, hSocket:bytes-read + 1) = 0.
                pcResult = pcResult + GET-STRING(mReadBuffer, 1).
                if hSocket:get-bytes-available() <= 0 then
                    leave.
                lStatus = not hSocket:read(mReadBuffer, 1, {&BUFFER_SIZE} - 1, read-available) no-error.
            end.
           
        end.
        SET-SIZE(mReadBuffer) = 0.        
   end.
 
   hSocket:disconnect() no-error.
   delete object hSocket.
end procedure.


&ENDIF

&IF DEFINED(EXCLUDE-canLaunchDialog) = 0 &THEN

procedure canLaunchDialog: 
    define output parameter plOk as logical  no-undo.         
    plok = HasDialog(session) = false.      
end procedure.       

&ENDIF

&IF DEFINED(EXCLUDE-canShowMessage) = 0 &THEN
/* currently same as dialog, but is a separate api to allow change
   Messages are handled by ide so could always be true... */
procedure canShowMessage: 
    define output parameter plOk as logical  no-undo.         
    plok = HasDialog(session) = false.      
end procedure.       

&ENDIF


&IF DEFINED(EXCLUDE-createUntitledFile) = 0 &THEN

procedure createUntitledFile :
    /*------------------------------------------------------------------------------
      Purpose: Creates an untitled file using the input file name as the source.
      Parameters:
            INPUT-OUTPUT pcFileName Source for the content of the untitled file.                
      Notes: 
    ------------------------------------------------------------------------------*/
    define input-output parameter pcFileName as character   no-undo.
    
    define variable cBaseFileName     as character   no-undo.
    define variable cUntitledFileName as character   no-undo.
    define variable i                 as integer     no-undo.
    define variable cFileExt          as character   no-undo.
    
    /* Use the file extension of the specified file name unless it is .tmp. */
    i = r-index(pcFileName, ".").
    if i > 0 then
    do:
        cFileExt = substring(pcFileName, i).
        if cFileExt = ".tmp":U then
            cFileExt = "".
    end.    
    
    i = 0.
    cBaseFileName = os-getenv("ECLIPSE_ROOT") + "Untitled".
    file-info:file-name = cBaseFileName + STRING(i) + cFileExt.
    do while file-info:full-pathname <> ?:
        i = i + 1.
        file-info:file-name = cBaseFileName + STRING(i) + cFileExt.
    end.
    cUntitledFileName = file-info:file-name.
    file-info:file-name = pcFileName.
    if file-info:full-pathname <> ? then
        os-copy VALUE(file-info:full-pathname) VALUE(cUntitledFileName).
    else
    do:
        output TO VALUE(cUntitledFileName).
        output CLOSE.
    end.    
    
    pcFileName = replace(cUntitledFileName, "~\", "/").  

end procedure.


&ENDIF

&IF DEFINED(EXCLUDE-Win32APIs) = 0 &THEN

procedure Win32APIs :
end procedure.

procedure FindWindowA external "USER32.DLL":
  define input  parameter lpClassName    as LONG.
  define input  parameter lpWindowName   as character.
  define return parameter hWnd           as LONG.
end.

procedure FindWindowByClassName external "USER32.DLL" ordinal 228:
  define input  parameter lpClassName  as character.
  define input  parameter lpWindowName as LONG.
  define return parameter hWnd         as LONG.
end.

procedure GetParent external "USER32.DLL":
  define input  parameter hWnd           as LONG.
  define return parameter rhWnd          as LONG.
end.

procedure SetParent external "USER32.DLL":
  define input  parameter hWndChild      as LONG.
  define input  parameter hWndParent     as LONG.
  define return parameter rhWnd          as LONG.
end.

procedure SetWindowPos external "user32.dll":
  define input parameter hWnd            as LONG.
  define input parameter hWndInsertAfter as LONG.
  define input parameter x               as LONG.
  define input parameter y               as LONG.
  define input parameter cx              as LONG.
  define input parameter cy              as LONG.
  define input parameter wflags          as LONG.   
  define return parameter rc             as LONG.
end.

procedure GetWindowRect external "USER32.DLL":
  define input  parameter  hWnd          as LONG.
  define output parameter  lpRect        as memptr.
end.

procedure ShowWindow external "user32.dll":
    define input parameter hWnd as LONG.
    define input parameter nCmdShow as LONG.
    define return parameter result as LONG.
end.

/* the code is not used in 11.2 and thus removed @todo remove method */
procedure SetWindowPosition:
    define input parameter iParentWindow as int64    no-undo.
    define input parameter hNewWindow    as handle     no-undo.
    define input parameter hOldWindow    as handle     no-undo.
    
end procedure.    

/* the code is not used in 11.2 and thus removed @todo remove method */
procedure SetWindowPositionXY:
    define input parameter iParentWindow as int64    no-undo.
    define input parameter hNewWindow    as handle     no-undo.    
    define input parameter iXpos         as integer    no-undo.
    define input parameter iYpos         as integer    no-undo.

end procedure.    


&ENDIF

 /* ************************  Function Implementations ***************** */

&IF DEFINED(EXCLUDE-activateWindow) = 0 &THEN
        
function activateWindow returns logical 
    ( phWindow as handle ):
/*------------------------------------------------------------------------------
        Purpose: activate/set focus in editor                                                                 
        Notes:                                                                        
------------------------------------------------------------------------------*/
  define variable iId  as int64 no-undo.
   
  iId = getDesignId(phWindow).
  
  RUN sendRequest in getSocketClient()
                  (ACTIVATE_EDITOR,
                   "IDE activateEditor ":U
                   + QUOTER(getProjectName()) + PARAMETER_DELIMITER
                   + QUOTER(iId)).
  return true.
end function.
    

&ENDIF

&IF DEFINED(EXCLUDE-checkSyntaxInIde) = 0 &THEN
        
function checkSyntaxInIde returns logical 
    ( phWindow as handle ):
/*------------------------------------------------------------------------------
        Purpose: activate/set focus in editor                                                                 
        Notes:                                                                        
------------------------------------------------------------------------------*/
  define variable iId  as int64 no-undo.
   
  iId = getDesignId(phWindow).
  
  RUN sendRequest in getSocketClient()
                  (CHECK_SYNTAX,
                   "IDE checkSyntax ":U
                   + QUOTER(iId)).
  return true.
end function.
    

&ENDIF


&IF DEFINED(EXCLUDE-getDesignId) = 0 &THEN
        
 /** we currently use the handle as the id -  
  @TODO move to _oeidecontext - it now has window handle (but not indexed yet) */      
function getDesignId returns int64
       (phWidget as handle):
     
     if phWidget:type = "FRAME" then
         return phWidget:PARENT:IDE-PARENT-HWND.  
     else
         return phWidget:IDE-PARENT-HWND.
end function.
    

&ENDIF


&IF DEFINED(EXCLUDE-getDesignFileNameParent) = 0 &THEN
        
function getDesignFileNameParent returns character 
    (piHwnd as handle):
     define variable cFile as character no-undo.   
     if piHwnd:type = "FRAME" then
         cFile = getDesignFileName(piHwnd:PARENT:IDE-PARENT-HWND).  
     else
         cFile = getDesignFileName(piHwnd:IDE-PARENT-HWND).
     return cFile.
 end function.
    

&ENDIF

&IF DEFINED(EXCLUDE-getProjectDisplayName) = 0 &THEN
        
 /** we currently use the handle as the id -  */      
function getProjectDisplayName returns character 
       () :
     define variable cName as character no-undo.
     cName = getProjectName().
     if cName = ".sharedavm":U then 
         cName = "Shared AVM".
     return cName.      
 end function.          

&ENDIF

&IF DEFINED(EXCLUDE-displayEmbeddedWindow) = 0 &THEN

function displayEmbeddedWindow returns logical
         (viewId      as character,
          secondaryId as character,
          hWindow     as handle) :
/*------------------------------------------------------------------------------
  Purpose:  Compound function to show and set the title of a view and embed 
            the specified window into the view
    Notes:  
------------------------------------------------------------------------------*/
    if (secondaryId begins "DesignView":U or secondaryId begins "PropertiesWindow":U) then 
        return true.
    showView(viewId, secondaryId, {&VIEW_ACTIVATE}).
    setViewTitle(viewId, secondaryId, hWindow:title).
    setEmbeddedWindow(viewId, secondaryId, hWindow).
    return true.
end function.


&ENDIF

&IF DEFINED(EXCLUDE-hideView) = 0 &THEN

function hideView returns logical
         (viewId      as character,
          secondaryId as character) :
/*------------------------------------------------------------------------------
  Purpose:  Hides the specified view
    Notes:  
------------------------------------------------------------------------------*/
  define variable cResult as character   no-undo. 
  
  if (secondaryId begins "DesignView":U or secondaryId begins "PropertiesWindow":U) then 
      return true.  
  
  run sendRequest in getSocketClient() 
                  (HIDE_VIEW,
                  "IDE hideView ":U 
                  + viewId + PARAMETER_DELIMITER 
                  + QUOTER(secondaryId)).
  return true.

end function.


&ENDIF

&IF DEFINED(EXCLUDE-runDialog) = 0 &THEN
        
function runDialog returns logical 
    ( phWindow as handle, 
      pcDialogCommand as char) :  

   return runUIBCommand(phWindow,pcDialogCommand).
  
end function.
    

&ENDIF


&IF DEFINED(EXCLUDE-runUIBCommand) = 0 &THEN
        
function runUIBCommand returns logical 
    ( phWindow as handle,
      pcCommand as char  ):
 
  define variable iId as int64 no-undo.
  
  /* TODO use tLinkedfile? */
  iId = getDesignId(phWindow).
  run sendRequest in getSocketClient() (
                   RUN_UIB_COMMAND,  
                   "IDE runUIBCommand ":U 
                   + QUOTER(getProjectName()) + PARAMETER_DELIMITER
                   + QUOTER(iId) + PARAMETER_DELIMITER
                   + QUOTER(pcCommand)).
  
  return true.
end function.
    

&ENDIF

&IF DEFINED(EXCLUDE-setEmbeddedWindow) = 0 &THEN

function setEmbeddedWindow returns logical
         (viewId      as character,
          secondaryId as character,
          hWindow     as handle) :
/*------------------------------------------------------------------------------
  Purpose:  Sets the given 4GL window as an embedded window in the specified
            view
    Notes:  
------------------------------------------------------------------------------*/
    define variable lVisible as logical    no-undo.
    define variable wHwnd as int64       no-undo.
    define variable cResult as character   no-undo.  
  
&IF "{&NO_EMBEDDED_WINDOWS}" EQ "YES" &THEN  
    return true.
&ENDIF    
    if (secondaryId begins "DesignView":U ) then 
        return true.
    if hWindow:hwnd = ? then
    do:
        lVisible = hWindow:visible.
        hWindow:visible = true.
        hWindow:visible = lVisible.
    end.                                     
    run GetParent (hWindow:hwnd, output wHwnd).
    run sendRequest in getSocketClient()
                (SET_EMBEDDED_WINDOW,
                 "IDE setEmbeddedWindow ":U 
                 + viewId + PARAMETER_DELIMITER 
                 + QUOTER(secondaryId) + PARAMETER_DELIMITER
                 + STRING(wHwnd)).
  return true.

end function.


&ENDIF

&IF DEFINED(EXCLUDE-setTTYTerminalColor) = 0 &THEN

function setTTYTerminalColor returns logical
         (pBg as int,
          pFg as int):
              
    run sendRequest in getSocketClient() (
                  SET_TTY_TERMINAL_COLOR,
                  "IDE setTTYTerminalColor ":U 
                  + QUOTER(GetProjectName()) + PARAMETER_DELIMITER
                  + QUOTER(pBg) + PARAMETER_DELIMITER
                  + QUOTER(pFg)).
    return true. 
end function.


&ENDIF


&IF DEFINED(EXCLUDE-setViewTitle) = 0 &THEN

function setViewTitle returns logical
         (viewId      as character,
          secondaryId as character,
          viewTitle   as character) :
/*------------------------------------------------------------------------------
  Purpose: Sets the title of the specified view
    Notes:  
------------------------------------------------------------------------------*/
  define variable cResult as character   no-undo.
  
  if (secondaryId begins "DesignView":U) then
      return true.
                               
  run sendRequest in getSocketClient() (
                  SET_VIEW_TITLE,
                  "IDE setViewTitle ":U 
                  + viewId + PARAMETER_DELIMITER 
                  + QUOTER(secondaryId) + PARAMETER_DELIMITER
                  + QUOTER(viewTitle)).
  return true.

end function.


&ENDIF

&IF DEFINED(EXCLUDE-checkHelp) = 0 &THEN

function checkHelp returns logical
         (pcContextId as char) :
    define variable cExists as character no-undo.
    run sendWaitRequest in getSocketClient()
          (CHECK_HELP,
          "IDE CheckHelp ":U
          +  quoter(pcContextId),
            output cExists ).
    return logical(cExists).
end function.

&ENDIF



&IF DEFINED(EXCLUDE-showHelp) = 0 &THEN

function showHelp returns logical
         (pcContextId as char) :
    define variable cExists as character no-undo.
     run sendRequest in getSocketClient()
          (SHOW_HELP,
          "IDE OpenHelp ":U 
          +  quoter(pcContextId) ).
    return true.         
end function.

&ENDIF

&IF DEFINED(EXCLUDE-showView) = 0 &THEN

function showView returns logical
         (viewId      as character,
          secondaryId as character,
          mode        as integer) :
/*------------------------------------------------------------------------------
  Purpose:  Displays the specified view in the IDE
    Notes:  
------------------------------------------------------------------------------*/
  define variable cResult as character   no-undo.
  if (secondaryId begins "DesignView":U) then
      return true.
        
  if mode = ? or mode <= 0 or mode > 3 then /* mode values are 1, 2, 3 */
      mode = {&VIEW_ACTIVATE}.              /* Default value */
  run sendRequest in getSocketClient() (
                  SHOW_VIEW,
                  "IDE showView ":U 
                  + viewId + PARAMETER_DELIMITER 
                  + QUOTER(secondaryId) + PARAMETER_DELIMITER
                  + STRING(mode)).
  return true.

end function.


&ENDIF

&IF DEFINED(EXCLUDE-openEditor) = 0 &THEN

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION openEditor Procedure 
function openEditor returns logical
         (cProjectName  as character,
          cFileName     as character,
          cLinkedFile   as character,
          hWindowHandle as handle) :
/*------------------------------------------------------------------------------
  Purpose:  Open an OEIDE Editor instance.
    Notes:  For backwards compatibility
    - cLinkedFile - "untitled" is only supported value  
    - hWindowHandle  - is ignored 
------------------------------------------------------------------------------*/
define variable cResult as character   no-undo.


if cProjectName = ? then cProjectName = getProjectName().
if cLinkedFile = "UNTITLED":U then
do:
    run createUntitledFile(input-output cFileName).
end.    
    
return openTextEditor (cProjectName,cFileName).

end function.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME

&ENDIF


&IF DEFINED(EXCLUDE-openDesignEditor) = 0 &THEN

function openDesignEditor returns logical 
          (cProjectName  as character,
           cFileName     as character ) :
/*------------------------------------------------------------------------------
  Purpose: Open an OEIDE Design Editor instance for a dynamic Dynamics object.
    Notes: static Dynamics objects should use openEditor  
------------------------------------------------------------------------------*/
    if cProjectName = ? then cProjectName = getProjectName().
    run sendRequest in getSocketClient() (OPEN_DESIGN_EDITOR,
                                      "IDE openDesignEditor ":U 
                                      + QUOTER(cProjectName) + PARAMETER_DELIMITER
                                      + QUOTER(cfileName)).  
    return true.    
end function.

&ENDIF

&IF DEFINED(EXCLUDE-openDynamicsEditor) = 0 &THEN

function openDynamicsEditor returns logical 
          (cProjectName  as character,
           cFileName     as character ) :
/*------------------------------------------------------------------------------
  Purpose: Open an OEIDE Design Editor instance for a dynamic Dynamics object.
    Notes: static Dynamics objects should use openEditor  
------------------------------------------------------------------------------*/
    if cProjectName = ? then cProjectName = getProjectName().
    run sendRequest in getSocketClient() (OPEN_DYNAMICS_EDITOR,
                                      "IDE openDynamicsEditor ":U 
                                      + QUOTER(cProjectName) + PARAMETER_DELIMITER
                                      + QUOTER(cfileName)).  
    return true.    
end function.

&ENDIF

 &IF DEFINED(EXCLUDE-openTextEditor) = 0 &THEN

function openTextEditor returns logical 
          (cProjectName  as character,
           cFileName     as character ) :
/*------------------------------------------------------------------------------
  Purpose: Open an OEIDE Design Editor instance for a dynamic Dynamics object.
    Notes: static Dynamics objects should use openEditor  
------------------------------------------------------------------------------*/
    if cProjectName = ? then cProjectName = getProjectName().
    run sendRequest in getSocketClient() (OPEN_TEXT_EDITOR,
                                      "IDE openTextEditor ":U 
                                      + QUOTER(cProjectName) + PARAMETER_DELIMITER
                                      + QUOTER(cfileName)).  
    return true.    
end function.

&ENDIF
 

&IF DEFINED(EXCLUDE-openPropertySheet) = 0 &THEN
function openPropertySheet returns logical 
          (phWindow  as handle):
    
    define variable iId  as int64 no-undo.
   
    iId = getDesignId(phWindow).
    run sendRequest in getSocketClient() (
                      OPEN_PROPERTY_SHEET,
                      "IDE openPropertySheet ":U 
                    + QUOTER(getProjectName()) + PARAMETER_DELIMITER
                    + QUOTER(iId)).       

    return true.
end function.                
&ENDIF


&IF DEFINED(EXCLUDE-saveEditor) = 0 &THEN

function saveEditor returns logical
         (cProjectName  as character,
          cFileName     as character,
          ask_file_name as logical) :
/*------------------------------------------------------------------------------
  Purpose: Tells the OpenEdge IDE to perform a save operation on the 
           OpenEdge IDE Editor
    Notes: 
    - A Save or Save Ass dialog is used dependeding on the ask_file_name 
    parameter 
------------------------------------------------------------------------------*/
  define variable cResult as character   no-undo.

/*
  IF hWindowHandle <> ? THEN /* A .w file is being opened. */
  DO:
      FIND ttLinkedFile WHERE ttLinkedFile.windowHandle = hWindowHandle NO-ERROR.
      IF NOT AVAILABLE ttLinkedFile THEN
          CREATE ttLinkedFile.

      ASSIGN ttLinkedFile.windowHandle = hWindowHandle
             ttLinkedFile.projectName  = cProjectName
             ttLinkedFile.fileName     = cFileName
             ttLinkedFile.linkedFile   = cLinkedFile.
      FILE-INFO:FILE-NAME = cLinkedFile.         
      ASSIGN ttLinkedFile.syncTimeStamp = DATETIME(FILE-INFO:FILE-MOD-DATE, FILE-INFO:FILE-MOD-TIME).
  END.
*/
  
  run sendRequest in getSocketClient() 
                  (SAVE_EDITOR,
                   "IDE saveEditor ":U 
                  + QUOTER(cProjectName) + PARAMETER_DELIMITER
                  + QUOTER(cfileName) + PARAMETER_DELIMITER
                  + (if ask_file_name then "SAVEAS":U else "SAVE":U)
                  ).
  return true.

end function.


&ENDIF

&IF DEFINED(EXCLUDE-closeEditor) = 0 &THEN

function closeEditor returns logical
         (cProjectName  as character,
          cFileName     as character,
          lSaveChanges  as logical) :
/*------------------------------------------------------------------------------
  Purpose:  Closes OEIDE Editor instance for the specified file name
    Notes:  
------------------------------------------------------------------------------*/
  
  run sendRequest in getSocketClient()
                  (CLOSE_EDITOR,
                   "IDE closeEditor ":U 
                  + QUOTER(cProjectName) + PARAMETER_DELIMITER
                  + QUOTER(cFileName) + PARAMETER_DELIMITER
                  + (if lSaveChanges then "TRUE":U else "FALSE":U)
                  ).
  return true.

end function.


&ENDIF

&IF DEFINED(EXCLUDE-closeEditor) = 0 &THEN

function gotoPage returns logical
         (phWindow as handle,
          piPage as int) :
/*------------------------------------------------------------------------------
  Purpose:  go to page of window
    Notes:  
------------------------------------------------------------------------------*/
   define variable cFile   as character no-undo.
   define variable cResult as character no-undo.
  
   define variable iDesignId as int64 no-undo. 
   iDesignId = getDesignId(phWindow).  
  
   run sendRequest in getSocketClient() (
                   GOTO_PAGE,
                   "IDE GotoPage ":U 
                  + QUOTER(iDesignId) + PARAMETER_DELIMITER
                  + QUOTER(piPage)) .
  return true.

end function.


&ENDIF


&IF DEFINED(EXCLUDE-keyPressed) = 0 &THEN

function keyPressed returns logical 
    ( phWindow as handle,
      pcKey    as character):
/*------------------------------------------------------------------------------
  Purpose:  handle keystroke
    Notes:  
------------------------------------------------------------------------------*/
    define variable iDesignId as int64 no-undo. 
    iDesignId = getDesignId(phWindow).  
  
    run sendRequest in getSocketClient()
                    (KEY_PRESSED,
                      "IDE KeyPressed ":U 
                      + QUOTER(iDesignId) + PARAMETER_DELIMITER
                      + QUOTER(pcKey)).
  
  return true.

end function.

&ENDIF

&IF DEFINED(EXCLUDE-viewSource) = 0 &THEN

function viewSource returns logical
         (phWindow as handle,
          wName AS CHARACTER,
          wType AS CHARACTER,
          wSection AS CHARACTER,
          wTrigger AS CHARACTER ) :
/*------------------------------------------------------------------------------
  Purpose:  View source for the specified window
    Notes:  
------------------------------------------------------------------------------*/
    define variable iDesignId as int64 no-undo. 
    iDesignId = getDesignId(phWindow).  
  
    run sendRequest in getSocketClient()
                    (VIEW_SOURCE,
                      "IDE viewSource ":U 
                      + QUOTER(iDesignId) + PARAMETER_DELIMITER
                      + QUOTER(wName) + PARAMETER_DELIMITER
                      + QUOTER(wType) + PARAMETER_DELIMITER
                      + QUOTER(wSection) + PARAMETER_DELIMITER
                      + QUOTER(wTrigger)).
  
  return true.

end function.


&ENDIF


&IF DEFINED(EXCLUDE-findAndSelect) = 0 &THEN

function findAndSelect returns logical
         (projectName  as character,
          fileName     as character,
          cText        as character,
          activateEditor as logical) :
/*------------------------------------------------------------------------------
  Purpose:  Finds and select the specified text in the OEIDE Editor
    Notes:  
------------------------------------------------------------------------------*/
  define variable cResult as character   no-undo.
    /*
    FIND ttLinkedFile WHERE ttLinkedFile.fileName = fileName NO-ERROR.
    
    /* TODO - findAndSelect sometimes get fileName with slashes instead of backslashes */
    IF NOT AVAILABLE ttLinkedFile THEN
    DO: 
        fileName = REPLACE(fileName, "/", "~\").
        FIND ttLinkedFile WHERE ttLinkedFile.fileName = fileName NO-ERROR.
    END.    
    
    IF NOT AVAILABLE ttLinkedFile THEN RETURN FALSE.
    */
   
    run sendRequest in getSocketClient() (
                   FIND_AND_SELECT,
                   "IDE findAndSelect ":U 
                   + QUOTER(getProjectName()) + PARAMETER_DELIMITER
                   + QUOTER(fileName) + PARAMETER_DELIMITER
                   + QUOTER(cText) + PARAMETER_DELIMITER
                   + (if activateEditor then "TRUE" else "FALSE")
                   ).
    return true.

end function.


&ENDIF

&IF DEFINED(EXCLUDE-createLinkedFile) = 0 &THEN

function createLinkedFile returns character
         (user_chars   as character,
          extension    as character) :
/*------------------------------------------------------------------------------
  Purpose:  Creates an available temporary file in the linked_resources area.
    Notes:  The return parameter is a complete name that includes the path.
    
    This code is based on adecomm/_tmpfile.p.
------------------------------------------------------------------------------*/

define var name           as character no-undo.
define var name1           as character no-undo.

define var base           as integer.
define var check_name     as character.
define variable lastChar         as character no-undo.
/*
 * Loop until we find a name that hasn't been used. In theory, if the
 * temp directory gets filled, this could be an infinite loop. But, the
 * likelihood of that is low.
 */
check_name = "something":U.
 
do while check_name <> ?:
  /* Take the lowest 5 digits (change the format so that everything works out to have exactly 5
     characters. */
     
  assign
    base = ( time * 1000 + etime ) modulo 100000
    name1 = string(base,"99999":U)
    lastChar = substring(name1,length(name1)) 
     /* Add in the extension and directory into the name. */
    name = getProjectWorkDirectory() 
          + (if not (lastChar = "~\" or lastChar ="/") then "/" else "") 
          + "p":U + name1 + user_chars + extension.
          
  check_name = search(name).
  
end.
/* Creates the linked file */
output TO VALUE(name).
output CLOSE.

name = replace(name, "~\", "/").
name = replace(name, "//", "/").
       
return name.

end function.


&ENDIF

&IF DEFINED(EXCLUDE-ShowOkMessageInIDE) = 0 &THEN

function ShowOkMessageInIDE returns logical
         (msgText      as character,
          MsgType      as character,
          MsgTitle     as character) :
    return ShowMessageInIDE(msgText,MsgType,MsgTitle,"OK",true).     
end function.

&ENDIF

&IF DEFINED(EXCLUDE-ShowMessageInIDE) = 0 &THEN

function ShowMessageInIDE returns logical
         (msgText      as character,
          MsgType      as character,
          MsgTitle     as character, 
          MsgButtons   as character,
          ButtonValue  as logical):
   define variable cResult as character  no-undo.
   define variable ButtonFocus as character no-undo.
   define variable iReturn as integer no-undo.
   
   If msgtitle = ? or msgTitle = "?" then 
      msgTitle = upper(substring(MsgType,1,1)) 
               + lower(substring(MsgType,2,length(MsgType))).
   
   case msgType:
       when "Information" then msgType = "0".
       when "Warning"     then msgType = "1".
       when "Error"       then msgType = "2".
       when "Question"    then msgType = "3".
       otherwise msgType = "2".

   end.
   /* Possible button values are: YES-NO,YES-NO-CANCEL,OK,OK-CANCEL,RETRY-CANCEL. */
   case MsgButtons:
       when "OK" then 
           Assign ButtonFocus = "OK"
                  MsgButtons = "OK". /* get right case */
       when "OK-Cancel" then
       do:
            if ButtonValue then ButtonFocus = "OK".
            else ButtonFocus = "Cancel".
            MsgButtons = "OK-Cancel". /* get right case */
       end.
       when "YES-NO" then
       do:
            if ButtonValue then ButtonFocus = "Yes".
            else ButtonFocus = "No".
            MsgButtons = "Yes-No". /* get right case */
       end.
       when "YES-NO-CANCEL" then
       do:
            if ButtonValue then ButtonFocus = "Yes".
            else if not ButtonValue then ButtonFocus = "No".
            else ButtonFocus = "Cancel".
            MsgButtons = "Yes-No-Cancel". /* get right case */
       end.
       when "RETRY-CANCEL" then
       do:
            if ButtonValue then ButtonFocus = "Retry".
            else ButtonFocus = "Cancel".
            MsgButtons = "Retry-Cancel". /* get right case */
       end.
   end case.
   run sendWaitRequest in getSocketClient()               
                 (SHOW_MESSAGE_IN_IDE,
                  "IDE ShowMessageInIDE ":U
                  + QUOTER(msgText)      + PARAMETER_DELIMITER
                  + QUOTER(MsgType)    + PARAMETER_DELIMITER
                  + QUOTER(MsgTitle)   + PARAMETER_DELIMITER
                  + QUOTER(MsgButtons) + PARAMETER_DELIMITER
                  + QUOTER(ButtonFocus),
                  output cResult).
    
   iReturn =lookup(cResult,MsgButtons,"-").
    /* bad return - assume last button  (cancel if possible)*/
   if not (iReturn > 0) then
       iReturn = num-entries(MsgButtons).
   
   case iReturn:
        when 1 then return true. 
        when 2 then return false.
        when 3 then return ?. 
   end.     
                      
end function.

&ENDIF


&IF DEFINED(EXCLUDE-hasDdialog) = 0 &THEN
/** Utility. used by CanLaunchDialog to check if we can call ide. If a ide supported procedure is used by a dialog for example
    when being called from an unsupported wizard it cannot launch through IDE, since the IDE hosted
    dialog is a window from the ABL perpsective. oeideservice.i OEIDE_CanLaunch() is external api 
  -  oeideservice is included by adm2 code that does not have access to ade code so no other place to add this utility */ 
function HasDialog returns logical
         (phParent as handle):
    define variable hChild  as handle no-undo.
    hChild = phParent:first-child.
    do while valid-handle(hChild):
        if hChild:type = "window" and HasDialog(hChild) then
            return true.  
         /* Check for visible added due to issues with the hidden 
            clipboard frame, so the check returned true after 
            cut, copy, paste (hidden dialog should not cause the 
            problem this check attempts to avoid )   */
        else if hChild:type = "dialog-box" and hChild:visible then 
            return true.  
        hChild = hChild:next-sibling.
    end.     
    return false.                          
end function.       

&ENDIF

&IF DEFINED(EXCLUDE-SetWindowSize) = 0 &THEN             
function SetWindowSize return logical
         (phWindow as handle ):
    
    define variable iDesignId as int64 no-undo. 
    define variable wrect as memptr no-undo.
    define variable iXpos as integer no-undo.
    define variable iYpos as integer no-undo.
    define variable iWidth as integer no-undo.
    define variable iHeight as integer no-undo.
  
/* @todo get  true external size -  this returns big numbers */
/*      phWindow:visible = true. */
    
/*    SET-SIZE(wrect) = 16. /* 4 INTEGERS at 4 bytes each */*/
/*                                                          */
/*                                                          */
/*    run GetWindowRect(phWindow:hwnd, output wrect).       */
/*    assign iXpos = GET-LONG(wrect, 1)                     */
/*           iYpos = GET-LONG(wrect, 5).                    */
/*           iWidth = GET-LONG(wrect, 9).                   */
/*           iHeight = GET-LONG(wrect, 13).                 */
   
      
    ixpos = phWindow:x.
    iypos = phWindow:y.
    iwidth = phWindow:width-p  .
    iheight= phwindow:height-p  .
    iDesignId = getDesignId(phWindow). 
    if (iDesignId) > 0 then 
        run sendRequest in getSocketClient() (
                      SET_WINDOW_SIZE,
                      "IDE SetWindowSize ":U 
                    + QUOTER(iDesignId) + PARAMETER_DELIMITER
                    + QUOTER(iXpos) + PARAMETER_DELIMITER
                    + QUOTER(iYpos) + PARAMETER_DELIMITER  
                    + QUOTER(iWidth)  + PARAMETER_DELIMITER
                    + QUOTER(iHeight)).            
          
end function.                 
&ENDIF

&IF DEFINED(EXCLUDE-WidgetEvent) = 0 &THEN             
function WidgetEvent return logical
         (phwindow   as handle,
          WidgetName as character,
          WidgetText as character,
          WidgetType as character,
          WidgetParent as character,
          WidgetAction as character ):
      define variable iDesignId as int64 no-undo. 
     /* valid check - may be called when the window itself is deleted (save all)  
       if necessary we may use an id to manage this, but it was only encountered 
        during a save all that deleted the window due to save outside of project... 
      @TODO -  Maybe sanitize should be moved to getDesignId or use an id instead of handle 
         */
      if valid-handle(phWindow) then
      do:      
          iDesignId = getDesignId(phWindow).    
          if (iDesignId) > 0 then
          do: 
               /* ensure constant casing. _attr-ed saves with different case  */
               if WidgetType <> "SmartObject":U then 
                   WidgetType = caps(WidgetType).
               run sendRequest in getSocketClient() (
                          WIDGET_EVENT,
                          "IDE WidgetEvent ":U 
                        + QUOTER(iDesignId) + PARAMETER_DELIMITER
                        + QUOTER(WidgetName) + PARAMETER_DELIMITER
                        + QUOTER(WidgetText) + PARAMETER_DELIMITER
                        + QUOTER(WidgetType) + PARAMETER_DELIMITER
                        + QUOTER(WidgetParent) + PARAMETER_DELIMITER
                        + QUOTER(WidgetAction) ).     
          end.
      end.
end function.                               
&endif             

&IF DEFINED(EXCLUDE-AddCodeSection) = 0 &THEN
 function AddCodeSection return logical
         (phwindow   as handle,
          AddSection as character):
      define variable iDesignId as int64 no-undo. 
      iDesignId = getDesignId(phWindow).          
      if (iDesignId) > 0 then 
      run sendRequest in getSocketClient() (
                      ADD_CODE_SECTION,
                      "IDE AddCodeSection ":U 
                    + QUOTER(iDesignId) + PARAMETER_DELIMITER
                    + QUOTER(AddSection) ).   
 end function.              
&endif

&IF DEFINED(EXCLUDE-ReNameWidget) = 0 &THEN             
function RenameWidget return logical
         (phwindow   as handle,
          WidgetOldName as character,
          WidgetNewName as character,
          WidgetText as character,
          WidgetType as character,
          WidgetParent as character,
          WidgetAction as character ):
      define variable iDesignId as int64 no-undo. 
      iDesignId = getDesignId(phWindow).    
     
      if (iDesignId) > 0 then
      do:
           /* ensure constant casing. _attr-ed saves with different case  */
           if WidgetType <> "SmartObject":U then 
               WidgetType = caps(WidgetType).
           run sendRequest in getSocketClient() (
                      RENAME_WIDGET_NAME,
                      "IDE RenameWidgetName ":U
                    + QUOTER(iDesignId) + PARAMETER_DELIMITER
                    + QUOTER(WidgetOldName) + PARAMETER_DELIMITER
                    + QUOTER(WidgetNewName) + PARAMETER_DELIMITER
                    + QUOTER(WidgetText) + PARAMETER_DELIMITER
                    + QUOTER(WidgetType) + PARAMETER_DELIMITER
                    + QUOTER(WidgetParent) + PARAMETER_DELIMITER
                    + QUOTER(WidgetAction) ).
     end.              
end function.                               
&endif       

&IF DEFINED(EXCLUDE-AddTrigger ) = 0 &THEN
function AddTrigger return logical
         (phwindow   as handle,
          WidgetName as character,
          WidgetType as character):
    define variable iDesignId as int64 no-undo. 
    iDesignId = getDesignId(phWindow).          
    if (iDesignId) > 0 then 
    do:
        /* ensure constant casing. _attr-ed saves with different case  */
        if WidgetType <> "SmartObject":U then 
             WidgetType = caps(WidgetType).
        run sendRequest in getSocketClient() (
                          ADD_TRIGGER,
                          "IDE AddTrigger ":U 
                        + QUOTER(iDesignId) + PARAMETER_DELIMITER
                        + QUOTER(WidgetName)+ PARAMETER_DELIMITER
                        + QUOTER(WidgetType) ).       
    end.                      
end function.            
&endif       

&IF DEFINED(EXCLUDE-RunDesign) = 0 &THEN
function RunDesign return logical
         (phwindow   as handle):
    define variable iDesignId as int64 no-undo. 
    iDesignId = getDesignId(phWindow).          
    if (iDesignId) > 0 then 
    run sendRequest in getSocketClient() (
                      RUN_DESIGN,
                      "IDE RunDesign ":U 
                    + QUOTER(iDesignId) ).               
end function.             
&endif      
       
&IF DEFINED(EXCLUDE-CompileDesign) = 0 &THEN         
function CompileDesign return logical
         (phwindow   as handle):  
         define variable iDesignId as int64 no-undo. 
    iDesignId = getDesignId(phWindow).          
    if (iDesignId) > 0 then 
    run sendRequest in getSocketClient() (
                      COMPILE_DESIGN,
                      "IDE CompileDesign ":U 
                      + QUOTER(iDesignId) ).              
end function.               
&endif  

&IF DEFINED(EXCLUDE-ShowCueCard) = 0 &THEN
function ShowCueCard return logical
         (CueCardTitle as character,
          CueCardMessage as character):
              
     run sendRequest in getSocketClient() (
                      SHOW_CUE_CARD,
                      "IDE SHowCueCard ":U 
                      + QUOTER(CueCardTitle) + PARAMETER_DELIMITER
                      + QUOTER(CueCardMessage) ).           
end function.                
&endif  

&IF DEFINED(EXCLUDE-OpenDBConnectionDialog) = 0 &THEN
function OpenDBConnectionDialog return logical
         (pmessage as character):
    define variable pcOk as character no-undo.        
    if pmessage = ? then 
        pmessage = "".    
    run sendWaitRequest in getSocketClient()
          (OPEN_DB_CONNECTION,
          "IDE OpenDBConnectionDialog ":U 
          +  quoter(GetProjectName()) + PARAMETER_DELIMITER
          +  quoter(pmessage) ,
          output pcOk).  
    return logical(pcOk) .            
end function.                               
&endif             /*************************************************************/
/* Copyright (c) 1984-2005 by Progress Software Corporation  */
/*                                                           */
/* All rights reserved.  No part of this program or document */
/* may be  reproduced in  any form  or by  any means without */
/* permission in writing from PROGRESS Software Corporation. */
/*************************************************************/

/**************************************************************************
    Procedure:  pcmpcls.i
    
    Purpose:    Generic procedures for handling compilation of .cls files

    Syntax :    { adecomm/pcmpcls.i }

    Parameters:
    
    Description:
        Defines some generic procedures for handling the compilation of
        .cls files, for the Procedure Editor and Procedure Window.

        We need to provide the same .cls-handling functionality in both 
        Procedure Window and Procedure Editor. Rather than re-code it, 
        this functionality was pulled into this include file. Although 
        it has some UI, this should be portable to both GUI and TTY
        Procedure Editors.

        For more information, refer to adeedit/pcompile.i, adecomm/_pwrun.p,
        webutil\_cpyfile.p

    Notes  :
    Authors: 
    Date   : May 2005
**************************************************************************/


/* Preprocessor to determine the correct dir delimiter to use for the OS */
&IF "{&OPSYS}" = "UNIX" &THEN
  &SCOPED-DEFINE DIRDELIM /  
&ELSE
  &SCOPED-DEFINE DIRDELIM ~~~\
&ENDIF

PROCEDURE GetUniqueDir:
/*--------------------------------------------------------------------------
    Purpose:        Returns a unique subdirectory name below the given dir

    Run Syntax: RUN GetUniqueDir(INPUT dir,INPUT prefix,INPUT suffix,OUTPUT subdir).
    Parameters:
      dir - parent directory for unique subdir. If ?, use SESSION:TEMP-DIR.
      prefix - prefix for the subdir name. If ?, use "".
      suffix - suffix for the subdir name. If ?, use "".
      subdir - unique subdirectory within SESSION:TEMP-DIR
    Description:
    Notes: DOES NOT GUARANTEE subdir IS WRITABLE, JUST UNIQUE
    Adapted from adecomm/_tmpfile.p
---------------------------------------------------------------------------*/
    DEFINE INPUT  PARAMETER cDir AS CHARACTER   NO-UNDO.
    DEFINE INPUT  PARAMETER cPrefix AS CHARACTER   NO-UNDO.
    DEFINE INPUT  PARAMETER cSuffix AS CHARACTER   NO-UNDO.
    DEFINE OUTPUT PARAMETER cSubDir AS CHARACTER   NO-UNDO.

    DEFINE VARIABLE cCheckName AS CHARACTER   NO-UNDO.
    DEFINE VARIABLE iBase AS INTEGER     NO-UNDO.
    
    ASSIGN 
        cDir = (IF cDir = ? THEN SESSION:TEMP-DIR ELSE cDir)
        cPrefix = (IF cPrefix = ? THEN "" ELSE cPrefix)
        cSuffix = (IF cSuffix = ? THEN "" ELSE cSuffix)
        cCheckName = "something".
 
    DO WHILE cCheckName <> ?:
      /* Take the lowest 5 digits (change the format so that everything works out to have exactly 5
         characters. */
      ASSIGN
        iBase = ( TIME * 1000 + ETIME ) MODULO 100000
        cSubDir = STRING(iBase,"99999":U).
 
      /* Add in the extension and directory into the name. */
      cSubDir = SESSION:TEMP-DIR + cPrefix + cSubDir + cSuffix.
 
      cCheckName = SEARCH(cSubDir).
    END.
END PROCEDURE.

PROCEDURE GetClassCompileName:
/*--------------------------------------------------------------------------
    Purpose:        Creates the necessary dir structure beneath the 
                    current working directory, creates the .cls file, 
                    and returns the fully qualified pathname to this dir.

    Run Syntax: RUN GetClassCompileName(ClassTmpDir,SrcFileName,ClassType,OUTPUT CompileFilename).
    Parameters:      
      ClassTmpDir - temp directory name for storing this class's directories
      SrcFileName - name of the source file, so we can strip off the basename
      ClassType   - package name of class, including the basename
      CompilerFilename - fully qualified name of file to compile
    Description:
    Notes:
      Although the compiler will give us the ClassType, we don't want to 
      use that for saving the file, as the user might have saved it as 
      something else. In this case, we want to make sure the directories 
      match the ClassType, but the basename match the SrcFileName.
      If there are any errors creating the necessary directories, don't
      handle them here, just return with a ? filename, and let the caller 
      handle the SAVE error.
---------------------------------------------------------------------------*/
    DEFINE INPUT  PARAMETER ClassTmpDir AS CHARACTER   NO-UNDO.
    DEFINE INPUT  PARAMETER SrcFileName AS CHARACTER   NO-UNDO.
    DEFINE INPUT  PARAMETER ClassType AS CHARACTER   NO-UNDO.
    DEFINE OUTPUT PARAMETER CompileFilename AS CHARACTER INIT ? NO-UNDO.

    DEFINE VARIABLE cDummy AS CHARACTER   NO-UNDO.
    DEFINE VARIABLE cBaseName AS CHARACTER   NO-UNDO.
    DEFINE VARIABLE iNumDirs AS INTEGER     NO-UNDO.
    DEFINE VARIABLE iDir AS INTEGER     NO-UNDO.
    DEFINE VARIABLE cDir AS CHARACTER   NO-UNDO.

    /* if ClassTmpDir is not available */
    FILE-INFO:FILE-NAME = ClassTmpDir.
    IF (FILE-INFO:FILE-TYPE = ?) THEN
    DO:
        /* create it */
        OS-CREATE-DIR VALUE(ClassTmpDir).
        /* if error occurred creating dir, then return */
        IF (OS-ERROR <> 0) THEN
            RETURN.
    END.

    /* count the number of dirs (separated by ".":U) in ClassType.
     * Skip the last one, as that is the filename */
    iNumDirs = NUM-ENTRIES(ClassType,".":U) - 1.
    CompileFilename = ClassTmpDir.
    /* for each entry in the ClassType (except the last one) */
    DO iDir = 1 TO iNumDirs:
        /* get the directory name */
        cDir = ENTRY(iDir,ClassType,".":U).
        /* add the subdir to the CompileFilename */
        CompileFilename = CompileFilename + "{&DIRDELIM}":U + cDir.
        /* create a subdir in the ClassTmpDir */
        OS-CREATE-DIR VALUE(CompileFilename).
        /* if error creating dir, then return */
        IF (OS-ERROR <> 0) THEN
            RETURN.
    END.

    /* get the basename from the SrcFileName */
    IF (SrcFileName = ?) THEN
        /* if no SrcFileName provided, use the last entry in ClassType, and append ".cls" */
        cBaseName = ENTRY(iNumDirs + 1,ClassType,".":U) + ".cls".
    ELSE
        /* Get the basename from SrcFileName, including the ".cls" */
        RUN adecomm/_osprefx.p ( SrcFileName, OUTPUT cDummy, OUTPUT cBaseName).

    /* append the basename to CompileFilename */
    CompileFileName = CompileFileName + "{&DIRDELIM}":U + cBaseName.
    
END PROCEDURE.

PROCEDURE CreateClassStub:
/*--------------------------------------------------------------------------
    Purpose:        Creates a stub file to instantiate an OO4GL class

    Run Syntax: 
        RUN CreateClassStub(
               INPUT cStubFile,INPUT cClassType).
    Parameters:
        cStubFile - filename of the stub to create
        cClassType - package of the class
    Description:
    Notes: Any errors returned in RETURN-VALUE.
---------------------------------------------------------------------------*/
    DEFINE INPUT  PARAMETER cStubFile AS CHARACTER   NO-UNDO.
    DEFINE INPUT  PARAMETER cClassType AS CHARACTER   NO-UNDO.

    OUTPUT TO VALUE(cStubFile) NO-ECHO.
    PUT UNFORMATTED
        "DEFINE VARIABLE rTemp AS CLASS ":U cClassType " NO-UNDO." SKIP(1)
        "DO ON ERROR  UNDO, LEAVE":U SKIP
        "   ON ENDKEY UNDO, LEAVE":U SKIP
        "   ON STOP   UNDO, LEAVE":U SKIP
        "   ON QUIT   UNDO, LEAVE:":U SKIP(1)
        "    rTemp = NEW ":U cClassType " ( ) .":U SKIP(1)
        "END.":U SKIP
        "DELETE OBJECT rTemp NO-ERROR.":U SKIP.
    OUTPUT CLOSE.
    RETURN ?.
END PROCEDURE.

PROCEDURE AskToSaveClass:
/*--------------------------------------------------------------------------
    Purpose:        Asks the user if they wish to save the class file on save

    Run Syntax: 
        RUN AskToSaveClass(
               INPUT lUntitled,
               INPUT cClassType,
               INPUT lSaveBeforeRun,
               OUTPUT lOK).
    Parameters:
        lUntitled      - TRUE if buffer is untitled
        cClassType     - Expected package name of file, for untitled buffer
        lSaveBeforeRun - AutoSaveCls value
        lOK            - Whether user indicated save or not
    Description:    Displays a dialog, telling the user they must save
                    a .cls file in order to run it. The dialog also displays
                    a toggle to indicate whether the procedure editor should
                    just save without asking in future .In the case of an 
                    untitled edit buffer, we hide this toggle. This 
                    auto-save toggle is passed back in lSaveBeforeRun.
    Notes: 
---------------------------------------------------------------------------*/
    DEFINE INPUT        PARAMETER lUntitled AS LOGICAL     NO-UNDO.
    DEFINE INPUT        PARAMETER cClassType AS CHARACTER   NO-UNDO.
    DEFINE INPUT-OUTPUT PARAMETER lSaveBeforeRun AS LOGICAL     NO-UNDO.
    DEFINE OUTPUT       PARAMETER lOK AS LOGICAL INIT FALSE NO-UNDO.

    DEFINE VARIABLE lAutoSave AS LOGICAL INITIAL no 
         LABEL "Save .cls file automatically before run" 
         VIEW-AS TOGGLE-BOX SIZE 55 BY .81 NO-UNDO.
    DEFINE VARIABLE cSaveText1 AS CHARACTER FORMAT "x(60)" NO-UNDO.
    DEFINE BUTTON bYes AUTO-GO LABEL "Yes" SIZE 15 BY 1.14.
    DEFINE BUTTON bNo AUTO-END-KEY LABEL "No" SIZE 15 BY 1.14.
    DEFINE VARIABLE cClassFile AS CHARACTER   NO-UNDO.
    DEFINE VARIABLE cClassPath AS CHARACTER   NO-UNDO.
    DEFINE VARIABLE ipos AS INTEGER     NO-UNDO.

    DEFINE FRAME fClassSave
         lAutoSave AT ROW 4.33 COL 4
         bYes AT ROW 5.52 COL 18
         bNo AT ROW 5.52 COL 35
         cSaveText1 VIEW-AS TEXT 
              SIZE 65 BY .95 AT ROW 1.48 COL 4 NO-LABEL
         "Do you wish to save this file now?" VIEW-AS TEXT
              SIZE 60 BY .95 AT ROW 2.43 COL 4
         SPACE(2.19) SKIP(3.61)
        WITH VIEW-AS DIALOG-BOX KEEP-TAB-ORDER 
             SIDE-LABELS NO-UNDERLINE THREE-D  SCROLLABLE
             TITLE "Warning - .cls file not saved"
             DEFAULT-BUTTON bYes.

    ON GO OF FRAME fClassSave
    DO:
        lOK = TRUE.
        ASSIGN lAutoSave.
    END.

    lAutoSave = lSaveBeforeRun.

    IF lUntitled THEN
    DO:
        /* if we were passed a classtype */
        IF (cClassType <> ?) THEN
        DO:
            /* 20050920-014 Display this message as an alert-box, 
             * as we don't need the autosave checkbox if we don't
             * know the filename. */
            ipos = R-INDEX(cClassType,".":U).
            IF (ipos > 0) THEN
                ASSIGN 
                  cClassFile = SUBSTRING(cClassType,ipos + 1)
                  cClassPath = REPLACE(SUBSTRING(cClassType,1,ipos - 1),".":U,"{&DIRDELIM}":U).
            ELSE 
                 ASSIGN
                     cClassFile = cClassType
                     cClassPath = "".
            MESSAGE 
                "You must save this file as '":U + cClassFile + "'.cls":U + 
                (IF cClassPath <> "" THEN 
                     ", in a directory '":U + cClassPath + "'":U
                 ELSE 
                     "") SKIP
                "relative to PROPATH, in order to run.":U SKIP(1)
                "Do you wish to save this file now?"
                VIEW-AS ALERT-BOX QUESTION BUTTONS YES-NO UPDATE lOK.
            RETURN.
        END.  /* if cClassType <> ? */
        ELSE
        DO:
            /* we were not passed a classtype: this is an error, and should never happen!
             * To handle it gracefully, just tell the user this must be saved as .cls 
             */
            cSaveText1 = "You must save this file as a .cls file in order to run.".
        END.

        /* display on the form */
        lAutoSave:VISIBLE IN FRAME fClassSave = FALSE.
        DISPLAY cSaveText1 WITH FRAME fClassSave.
        ENABLE bYes bNo WITH FRAME fClassSave.
    END.  /* if lUntitled */
    ELSE
    DO:
        cSaveText1 = "You must save a .cls file in order to run.":U .
        DISPLAY lAutoSave cSaveText1 WITH FRAME fClassSave.
        ENABLE ALL WITH FRAME fClassSave.
    END.
    VIEW FRAME fClassSave.

    DO ON ERROR UNDO, LEAVE ON ENDKEY UNDO, LEAVE:
        /* wait for GO or Cancel of fClassSave */
        WAIT-FOR GO OF FRAME fClassSave OR 
            WINDOW-CLOSE OF FRAME fClassSave.
    END.

    HIDE FRAME fClassSave.
    lSaveBeforeRun = IF (NOT lUntitled AND lOK) THEN lAutoSave ELSE lSaveBeforeRun.

END PROCEDURE.

PROCEDURE FindClassInPropath:
/*--------------------------------------------------------------------------
    Purpose:        Determines whether a file matching the package name of
                    cClassType is on the PROPATH, and if so, whether this
                    is the same file as cFileName. If so, Ask the user if
                    they REALLY want to execute this file.
                    
    Run Syntax: 
        RUN FindClassInPropath(
               INPUT cClassType,INPUT cFileName,OUTPUT lOK).
    Parameters:
        cClassType - package of the class to locate
        cFileName  - filename of the .cls file which contains this package
        lOK        - the user really wants to run this file.
    Description:    
    Notes: 
          TO DO: Things to consider:
                 - if a user saves his .cls file, but has its .r file in
                   the same dir, then what should we do? We will use the .r
                   even though it may not contain the latest code. 
---------------------------------------------------------------------------*/
    DEFINE INPUT  PARAMETER cClassType AS CHARACTER   NO-UNDO.
    DEFINE INPUT  PARAMETER cFileName AS CHARACTER   NO-UNDO.
    DEFINE OUTPUT PARAMETER lOK AS LOGICAL INIT TRUE NO-UNDO.
    
    DEFINE VARIABLE cSrchPath AS CHARACTER   NO-UNDO.
    DEFINE VARIABLE cSrchFile AS CHARACTER   NO-UNDO.
    DEFINE VARIABLE cFilePath AS CHARACTER   NO-UNDO.
    DEFINE VARIABLE cRPath AS CHARACTER   NO-UNDO.
    DEFINE VARIABLE cMsg AS CHARACTER INIT ? NO-UNDO.

    /* replace "." in cClassType with dir delimiter, and add ".cls".
     * Also get the .r equivalent */
    ASSIGN 
        cSrchPath = REPLACE(cClassType,".":U,"{&DIRDELIM}":U ) + ".cls":U
        cRPath = REPLACE(cClassType,".":U,"{&DIRDELIM}":U ) + ".r":U.

    /* in the TTY Procedure editor, the filename may not have a fully 
     * qualified path. If not, locate this based on search */
    ASSIGN 
        FILE-INFO:FILE-NAME = cFileName
        cFilePath = FILE-INFO:FULL-PATHNAME.

    /* look for r-code path first */
    cRPath = SEARCH(cRPath).
    /* if r-code exists in the PROPATH, then we will never end up 
     * running our .cls file */
    IF (cRPath <> ?) THEN
    DO:
        ASSIGN
          FILE-INFO:FILE-NAME = cRPath
            cRPath = FILE-INFO:FULL-PATHNAME.
        cMsg = "The file ":U + cRPath + " was found in the PROPATH,~n":U + 
            "so this will run instead of ":U + cFilePath + ".":U.
    END.
    ELSE
    DO:
        /* no r-code found, look for source path */
        cSrchFile = SEARCH(cSrchPath).
        IF cSrchFile <> ? THEN
            ASSIGN 
                FILE-INFO:FILE-NAME = cSrchFile
                cSrchFile = FILE-INFO:FULL-PATHNAME.
        IF (cSrchFile = ? OR cSrchFile <> cFilePath) THEN
            cMsg  = 
            (IF cSrchFile = ? THEN
                "File ":U + cSrchPath + " could not be found relative to PROPATH.":U
             ELSE
                "The file ":U + cSrchFile + " was found first in the PROPATH, so this will run instead of ":U + cFilePath + ".":U).
    END.

    IF (cMsg <> ?) THEN
        MESSAGE cMsg SKIP
        "If you continue, you may get errors or unexpected behavior.":U SKIP(1)
        "Do you wish to continue?":U
        VIEW-AS ALERT-BOX WARNING BUTTONS YES-NO
        UPDATE lOK.
END PROCEDURE.

FUNCTION IsValidClassChange RETURN LOGICAL (
    INPUT cFileName AS CHAR,
    INPUT cCurrentClassType AS CHAR,
    INPUT cCompileClassType AS CHAR):
/*--------------------------------------------------------------------------
    Purpose:        Checks if the classtype from the last compile
                    matches the pathname of the file, and that it matches
                    the classtype previously recorded.
    Run Syntax: 
        IF IsValidClassChange(
               INPUT cFileName,
               INPUT cCurrentClassType,
               INPUT cCompileClassType) THEN...
    Parameters:
        FileName          - fully qualified pathname of the .cls file 
        cCurrentClassType - package of the class when we last recorded it
        cCompileClassType - package of the class from the last compile
    Description:    
    Notes: 
---------------------------------------------------------------------------*/
  DEFINE VARIABLE lRet AS LOGICAL INIT NO    NO-UNDO.
  DEFINE VARIABLE cClassPath AS CHARACTER   NO-UNDO.
  DEFINE VARIABLE cBaseName AS CHARACTER   NO-UNDO.
  DEFINE VARIABLE cFilePath AS CHARACTER   NO-UNDO.
  DEFINE VARIABLE ipos AS INTEGER     NO-UNDO.
  DEFINE VARIABLE ictr AS INTEGER     NO-UNDO.
  DEFINE VARIABLE iNumClassDir AS INTEGER     NO-UNDO.
  DEFINE VARIABLE iNumPathDir AS INTEGER     NO-UNDO.
  DEFINE VARIABLE cFileDir AS CHARACTER   NO-UNDO.
  DEFINE VARIABLE cClassDir AS CHARACTER   NO-UNDO.

  /* first, check whether the full pathname of the .cls file matches 
   * cCompileClassType. If these don't match, the user has put an 
   * invalid classtype into the file, and we should just tell them it is
   * an error. 
   * Of course, only do this if we have a filename
   */
  IF (cFilename <> ? AND cFilename <> "":U) THEN
  DO:
      /* make sure we get the fully qualified pathname */
      ASSIGN 
          FILE-INFO:FILE-NAME = cFileName
          cFileName = FILE-INFO:FULL-PATHNAME.
      /* get the base filename */
      RUN adecomm/_osprefx.p ( cFileName, OUTPUT cFilePath, OUTPUT cBaseName).
      ASSIGN 
          iNumClassDir = NUM-ENTRIES(cCompileClassType,".":U).

      /* compare to the last entry in cCompileClassType */
      IF (cBaseName <> 
          ENTRY(iNumClassDir,cCompileClassType,".":U) + ".cls":U) THEN
          /* basenames don't match, abort */
          RETURN FALSE.
      ELSE IF iNumClassDir > 1 THEN
      DO:
          /* the basenames matched, and there are dirs to check in cCompileClassType.
           * Move backwards through the dirs */
          iNumPathDir = NUM-ENTRIES(cFilePath,"{&DIRDELIM}":U) - 1.
          DO ipos = iNumClassDir - 1 TO 1 BY -1 :
              ASSIGN
                  cClassDir = ENTRY(ipos,cCompileClassType,".":U)
                  cFileDir = 
                      (IF iNumPathDir > 0 THEN
                      ENTRY(iNumPathDir,cFilePath,"{&DIRDELIM}":U)
                      ELSE "":U)
                  iNumPathDir = iNumPathDir - 1.
              IF (cClassDir <> cFileDir) THEN
                  /* we found a mismatch between cCompileClassType and cFileName */
                  RETURN FALSE.
          END.
      END.  /* if iNumClassDir > 1 */
  END.  /* if cFileName <> ? and cFileName <> "" */

  /* If we get to here, cCompileClassType matches cFileName, so we know the 
   * file contains a valid classtype (or else this is an untitled buffer).
   * Now, check to see if the last recorded classtype is a subset of the 
   * cCompileClassType, to know if the user just qualified the class with 
   * a package name. */
  IF cCompileClassType MATCHES ("*":U + cCurrentClassType) THEN
      RETURN TRUE.
   
  RETURN NO.

END.  /* CheckClassType */
/*************************************************************/
/* Copyright (c) 1984-2005,2008 by Progress Software Corporation  */
/*                                                           */
/* All rights reserved.  No part of this program or document */
/* may be  reproduced in  any form  or by  any means without */
/* permission in writing from PROGRESS Software Corporation. */
/*************************************************************/
/*------------------------------------------------------------------------

  File: adecomm/rptvar.i

  Description: Defines and initializes common variables used in audit reports.
               
  Author: Kenneth S. McIntosh

  Created: August 9,2005
  
  History:
     fernando  Dec  23, 2008  Support for Encryption reports
  
------------------------------------------------------------------------*/

&IF "{&WINDOW-SYSTEM}" = "TTY" &THEN
  &GLOBAL-DEFINE DATA-WIDTH 75
&ELSE 
  &GLOBAL-DEFINE DATA-WIDTH 84
&ENDIF

DEFINE VARIABLE txtReport    AS CHARACTER   NO-UNDO FORMAT "x(50)"
       EXTENT 15 
       INITIAL ["Track Audit Policy Changes",
                "Track Database Schema Changes",
                "Track Audit Data Administration (Dump/Load)",
                "Track Application Data Administration (Dump/Load)",
                "Track User Account Changes",
                "Track Security Permissions Changes",
                "Track SQL Permissions Changes",
                "Track Authentication System Changes",
                "Client Session Authentication Report",
                "Database Administration Report (Utilities)",
                "Database Access Report (Login/Logout/etc...)",
                "Custom Audit Data Filter",
                "Track Encryption Policy Changes",
                "Track Key Store Changes",
                "Database Encryption Administration (Utilities)"].

DEFINE VARIABLE rsDetail     AS LOGICAL     NO-UNDO
                                VIEW-AS RADIO-SET HORIZONTAL
                                RADIO-BUTTONS "Detail", TRUE, "Summary", FALSE
                                INITIAL TRUE.
DEFINE VARIABLE tbAppend     AS LOGICAL     NO-UNDO.
DEFINE VARIABLE fiFileName   AS CHARACTER   NO-UNDO FORMAT "x(50)".
DEFINE VARIABLE cbPrinter    AS CHARACTER   NO-UNDO VIEW-AS COMBO-BOX
                                                    INNER-LINES 5
                                                    SIZE 35 BY 1.
DEFINE VARIABLE cDefaultFile AS CHARACTER   NO-UNDO.

DEFINE VARIABLE fiPgLength   AS INTEGER     NO-UNDO.

CASE piReport:
  WHEN 1  THEN cDefaultFile = "aud_pol".
  WHEN 2  THEN cDefaultFile = "db_schema".
  WHEN 3  THEN cDefaultFile = "aud_data_admin".
  WHEN 4  THEN cDefaultFile = "app_data_admin".
  WHEN 5  THEN cDefaultFile = "user_maint".
  WHEN 6  THEN cDefaultFile = "sec_perm".
  WHEN 7  THEN cDefaultFile = "dba_sql".
  WHEN 8  THEN cDefaultFile = "auth_sys".
  WHEN 9  THEN cDefaultFile = "client_sess".
  WHEN 10 THEN cDefaultFile = "db_util".
  WHEN 11 THEN cDefaultFile = "db_access".
  WHEN 12 THEN cDefaultFile = "cust_audit".
  WHEN 13 THEN cDefaultFile = "enc_pol".
  WHEN 14 THEN cDefaultFile = "enc_keystore".
  WHEN 15 THEN cDefaultFile = "enc_admin".
END CASE.

/*===========================Functions=====================================*/
FUNCTION unquote RETURNS CHARACTER
    ( INPUT pcRawString AS CHARACTER,
      INPUT pcQuoteChar AS CHARACTER ):
  /* Removes extraneous quotes from command-line string */
  DEFINE VARIABLE iChar       AS INTEGER     NO-UNDO.

  DEFINE VARIABLE cTempString AS CHARACTER   NO-UNDO.

  DEFINE VARIABLE lNewQuote   AS LOGICAL     NO-UNDO.
  
  IF pcQuoteChar EQ ? OR pcQuoteChar EQ "" THEN
    pcQuoteChar = "~"".

  pcRawString = REPLACE(pcRawString,"~"~"~"~"","~"~"").
  CHAR-BLK:
  DO iChar = 1 TO LENGTH(pcRawString):
    IF iChar = 1 AND
       SUBSTRING(pcRawString,1,1) = pcQuoteChar THEN DO:
      lNewQuote = TRUE.
      NEXT CHAR-BLK.
    END.
    IF SUBSTRING(pcRawString,iChar,1)     EQ pcQuoteChar AND
       (SUBSTRING(pcRawString,iChar + 1,1) NE pcQuoteChar AND
        (iChar > 1 AND 
         SUBSTRING(pcRawString,iChar - 1,1) NE pcQuoteChar)) THEN DO:
      IF NOT lNewQuote THEN DO: 
        lNewQuote = TRUE.
        NEXT CHAR-BLK.
      END.
      ELSE DO:
        lNewQuote = FALSE.
        NEXT CHAR-BLK.
      END.
    END.
    ELSE
      cTempString = cTempString + SUBSTRING(pcRawString,iChar,1).
  END.

  RETURN cTempString.
END FUNCTION.

FUNCTION formatCommandLine RETURNS CHARACTER
    ( INPUT pcCommandLine AS CHARACTER ):

  DEFINE VARIABLE cRunOpt    AS CHARACTER   NO-UNDO.
  DEFINE VARIABLE cOptions   AS CHARACTER   NO-UNDO.

  DEFINE VARIABLE lNextEntry AS LOGICAL     NO-UNDO.

  DEFINE VARIABLE iOption    AS INTEGER     NO-UNDO.

  cRunOpt = unQuote(pcCommandLine,
                    "~"").
  cOptions = ?.
  IF INDEX(cRunOpt,"-P") > 0 THEN DO:
    DO iOption = 1 TO NUM-ENTRIES(cRunOpt," "):
      IF ENTRY(iOption,cRunOpt," ") EQ "-P" THEN DO:
        lNextEntry = TRUE.
        NEXT.
      END.
      ELSE IF lNextEntry THEN DO:
        cOptions = cOptions + " <password_omitted>". 
        lNextEntry = FALSE.
        NEXT.
      END.
          
      IF cOptions EQ ? THEN
        cOptions = ENTRY(iOption,cRunOpt," ").
      ELSE
        cOptions = cOptions + " " + ENTRY(iOption,cRunOpt," ").
    END.
    cRunOpt = cOptions.
  END.

  RETURN cRunOpt.
END FUNCTION.

FUNCTION padLine RETURNS CHARACTER
    ( INPUT pcLine   AS CHARACTER,
      INPUT piLength AS INTEGER ):
  DEFINE VARIABLE cLine    AS CHARACTER   NO-UNDO.
  DEFINE VARIABLE iRepeats AS INTEGER     NO-UNDO.

  iRepeats = TRUNC((piLength - LENGTH(pcLine,"CHARACTER")) / 2,0).
  cLine = FILL(" ",iRepeats) + pcLine. 
  
  RETURN cLine.

END FUNCTION.

FUNCTION truncateLine RETURNS CHARACTER
    ( INPUT-OUTPUT pcLine   AS CHARACTER,
      INPUT        piLength AS INTEGER ):

  DEFINE VARIABLE iNextWord AS INTEGER     NO-UNDO.
  DEFINE VARIABLE iCount    AS INTEGER     NO-UNDO.

  DEFINE VARIABLE cWord     AS CHARACTER   NO-UNDO.
  DEFINE VARIABLE cLine     AS CHARACTER   NO-UNDO.
  DEFINE VARIABLE cTempLine AS CHARACTER   NO-UNDO.

  cTempLine = pcLine.

  DO iCount = 1 TO NUM-ENTRIES(pcLine," "):
    cWord = ENTRY(iCount,pcLine," ").
    IF (LENGTH(cLine,"CHARACTER") + 
        LENGTH(cWord,"CHARACTER") + 1) >= piLength THEN
      LEAVE.
    cLine     = cLine + (IF cLine NE "" THEN " " ELSE "") + cWord.
    cTempLine = (IF iCount = NUM-ENTRIES(pcLine," ") THEN ""
                 ELSE SUBSTRING(cTempLine,INDEX(cTempLine," ") + 1)).
  END.
  
  pcLine = cTempLine.
  RETURN cLine.
END FUNCTION.
&Scoped-define WINDOW-NAME CURRENT-WINDOW
&Scoped-define FRAME-NAME Dialog-Frame
/******************************************************************
* Copyright (C) 2006 by Progress Software Corporation. All rights *
* reserved.  Prior versions of this work may contain portions     *
* contributed by participants of Possenet.                        *
*                                                                 *
******************************************************************/
/*------------------------------------------------------------------------

  File: adecomm/_viewasd.w

  Description: Dialog to set the view-as property for browse columns.

  Input Parameters:
      pcFields: Comma delimited list with the field names.
      pcDataTypes: comma delimited list with the field data-types.
      pcFieldFormats: comma delimited list with the field formats.
      pcBrowseType: "SmartDataBrowser" = A Dynamic or Static SmartDataBrowser.
                    "STATIC"  = A Static browser widget.
      
  Input-Output Parameters:
      pcColumnTypes: CHR(5) delimited list with the browse column types
      pcColumnDelimiters: CHR(5) delimited list with the browse column delimiters
      pcColumnItems: CHR(5) delimited list with the browse column ITEMS
      pcColumnItemPairs: CHR(5) delimited list with the browse column ITEM-PAIRS
      pcColumnInnerLines: CHR(5) delimited list with the browse column INNER-LINES
      pcColumnMaxChars: CHR(5) delimited list with the browse column MAX-CHARS
      pcColumnSort: CHR(5) delimited list with the browse column SORTs
      pcCoumnAutoCompletion: CHR(5) delimited list with the browse column AUTO-COMPLETIONs
      pcColumnUniqueMatch: CHR(5) delimited list with the browse column UNIQUE-MATCHes

  Output Parameters:
      pcCancel: FALSE if the OK button is pressed, otherwise TRUE.

  Author: Marcelo Ferrante

  Created: June 29 2006
------------------------------------------------------------------------*/
/*          This .W file was created with the Progress AppBuilder.       */
/*----------------------------------------------------------------------*/
{adecomm/commeng.i}   /* Help String Definitions                 */

/* ***************************  Definitions  ************************** */

/* Parameters Definitions ---                                           */
DEFINE INPUT        PARAMETER pcFields       AS CHARACTER   NO-UNDO.
DEFINE INPUT        PARAMETER pcDataTypes    AS CHARACTER   NO-UNDO.
DEFINE INPUT        PARAMETER pcFieldFormats AS CHARACTER   NO-UNDO.
DEFINE INPUT        PARAMETER pcBrowseType   AS CHARACTER   NO-UNDO.

DEFINE INPUT-OUTPUT PARAMETER pcColumnTypes          AS CHARACTER NO-UNDO.
DEFINE INPUT-OUTPUT PARAMETER pcColumnDelimiters     AS CHARACTER NO-UNDO.
DEFINE INPUT-OUTPUT PARAMETER pcColumnItems          AS CHARACTER NO-UNDO.
DEFINE INPUT-OUTPUT PARAMETER pcColumnItemPairs      AS CHARACTER NO-UNDO.
DEFINE INPUT-OUTPUT PARAMETER pcColumnInnerLines     AS CHARACTER NO-UNDO.
DEFINE INPUT-OUTPUT PARAMETER pcColumnMaxChars       AS CHARACTER NO-UNDO.
DEFINE INPUT-OUTPUT PARAMETER pcColumnSort           AS CHARACTER NO-UNDO.
DEFINE INPUT-OUTPUT PARAMETER pcColumnAutoCompletion AS CHARACTER NO-UNDO.
DEFINE INPUT-OUTPUT PARAMETER pcColumnUniqueMatch    AS CHARACTER NO-UNDO.

DEFINE       OUTPUT PARAMETER pcCancel AS LOGICAL     NO-UNDO.

/* Local Variable Definitions ---                                       */
DEFINE VARIABLE gcCurrentField   AS CHARACTER   NO-UNDO.
DEFINE VARIABLE gcDataType       AS CHARACTER   NO-UNDO.
define variable frameTitle       as character no-undo init "View-as attributes". 



/* ********************  Preprocessor Definitions  ******************** */

&Scoped-define PROCEDURE-TYPE Dialog-Box
&Scoped-define DB-AWARE no

/* Name of designated FRAME-NAME and/or first browse and/or first query */
&Scoped-define FRAME-NAME Dialog-Frame

/* Standard List Definitions                                            */
&Scoped-Define ENABLED-OBJECTS coFields RECT-5 coViewAs raItems edItems ~
coType fiDelimiter raDelimiter fiInnerLines fiMaxChars toSort ~
toAutoCompletion toUniqueMatch Btn_OK Btn_Cancel Btn_Help fiChr fiClose 
&Scoped-Define DISPLAYED-OBJECTS coFields coViewAs raItems edItems coType ~
fiDelimiter raDelimiter fiInnerLines fiMaxChars toSort toAutoCompletion ~
toUniqueMatch fiChr fiClose 

/* Custom List Definitions                                              */
/* isModified,comboObjects,List-3,List-4,List-5,List-6                  */
&Scoped-define isModified coViewAs edItems coType fiDelimiter fiInnerLines ~
fiMaxChars toSort toAutoCompletion toUniqueMatch 
&Scoped-define comboObjects raItems edItems coType fiDelimiter raDelimiter ~
fiInnerLines fiMaxChars toSort toAutoCompletion toUniqueMatch 



/* ************************  Function Prototypes ********************** */

FUNCTION buildPropertyList RETURNS CHARACTER
  (INPUT pcPropertyValue AS CHARACTER,
   INPUT pcFieldName     AS CHARACTER,
   INPUT pcFieldValue    AS CHARACTER)  FORWARD.


FUNCTION formatListItemPairs RETURNS CHARACTER
  (INPUT pcItems     AS CHARACTER,
   INPUT pcDelimiter AS CHARACTER)  FORWARD.


FUNCTION getDataType RETURNS CHARACTER
  (INPUT pcField AS CHARACTER)  FORWARD.


FUNCTION getDelimiter RETURNS CHARACTER
  ( /* parameter-definitions */ )  FORWARD.


FUNCTION getWidgetNames RETURNS CHARACTER
  ( /* parameter-definitions */ )  FORWARD.


FUNCTION returnListItemPairs RETURNS CHARACTER
  (INPUT pcItems     AS CHARACTER,
   INPUT pcDelimiter AS CHARACTER)  FORWARD.


FUNCTION setDelimiter RETURNS LOGICAL
  (INPUT pcDelimiter AS CHARACTER)  FORWARD.


FUNCTION setType RETURNS LOGICAL
  (INPUT pcDataType AS CHARACTER)  FORWARD.


FUNCTION validateValues RETURNS LOGICAL
  ( /* parameter-definitions */ )  FORWARD.



/* ***********************  Control Definitions  ********************** */

/* Define a dialog box                                                  */

/* Definitions of the field level widgets                               */
DEFINE BUTTON Btn_Cancel AUTO-END-KEY 
     LABEL "Cancel" 
     SIZE 15 BY 1.14
     BGCOLOR 8 .

DEFINE BUTTON Btn_Help 
     LABEL "&Help" 
     SIZE 15 BY 1.14
     BGCOLOR 8 .

DEFINE BUTTON Btn_OK AUTO-GO 
     LABEL "OK" 
     SIZE 15 BY 1.14
     BGCOLOR 8 .

DEFINE VARIABLE coFields AS CHARACTER FORMAT "X(90)":U  
     LABEL "Field" 
     CONTEXT-HELP-ID 0
     VIEW-AS COMBO-BOX INNER-LINES 5
     DROP-DOWN-LIST
     SIZE 33.4 BY 1 NO-UNDO.

DEFINE VARIABLE coType AS CHARACTER FORMAT "X(256)":U INITIAL "DROP-DOWN-LIST" 
     LABEL "Type" 
     CONTEXT-HELP-ID 0
     VIEW-AS COMBO-BOX INNER-LINES 5
     LIST-ITEMS "DROP-DOWN","DROP-DOWN-LIST" 
     DROP-DOWN-LIST
     SIZE 25 BY 1 NO-UNDO.

DEFINE VARIABLE coViewAs AS CHARACTER FORMAT "X(10)":U 
     LABEL "View-as" 
     CONTEXT-HELP-ID 0
     VIEW-AS COMBO-BOX INNER-LINES 5
     LIST-ITEMS "Combo-box","Toggle-box","Fill-in" 
     DROP-DOWN-LIST
     SIZE 17.8 BY 1 NO-UNDO.

DEFINE VARIABLE edItems AS CHARACTER 
     CONTEXT-HELP-ID 0
     VIEW-AS EDITOR SCROLLBAR-VERTICAL LARGE
     SIZE 60 BY 4 NO-UNDO.

DEFINE VARIABLE fiChr AS CHARACTER FORMAT "X(50)":U INITIAL "Delimiter" 
     CONTEXT-HELP-ID 0
      VIEW-AS TEXT 
     SIZE 9 BY .62 NO-UNDO.

DEFINE VARIABLE fiClose AS CHARACTER FORMAT "X(50)":U INITIAL ")" 
     CONTEXT-HELP-ID 0
      VIEW-AS TEXT 
     SIZE 2 BY .62 NO-UNDO.

DEFINE VARIABLE fiDelimiter AS CHARACTER FORMAT "X(50)":U 
     CONTEXT-HELP-ID 0
     VIEW-AS FILL-IN 
     SIZE 6 BY 1 NO-UNDO.

DEFINE VARIABLE fiInnerLines AS CHARACTER FORMAT "X(50)":U INITIAL "5" 
     LABEL "Inner Lines" 
     CONTEXT-HELP-ID 0
     VIEW-AS FILL-IN 
     SIZE 10.4 BY 1 NO-UNDO.

DEFINE VARIABLE fiMaxChars AS CHARACTER FORMAT "X(50)":U 
     LABEL "Maximum Characters" 
     CONTEXT-HELP-ID 0
     VIEW-AS FILL-IN 
     SIZE 15.2 BY 1 NO-UNDO.

DEFINE VARIABLE raDelimiter AS CHARACTER 
     VIEW-AS RADIO-SET HORIZONTAL
     RADIO-BUTTONS 
          "Printable", "printable",
"Non-printable", "non-printable"
     SIZE 31 BY .71 NO-UNDO.

DEFINE VARIABLE raItems AS CHARACTER 
     CONTEXT-HELP-ID 0
     VIEW-AS RADIO-SET HORIZONTAL
     RADIO-BUTTONS 
          "List-Items", "I",
"List-Item-Pairs", "P"
     SIZE 36 BY .86 NO-UNDO.

DEFINE RECTANGLE RECT-5
     EDGE-PIXELS 2 GRAPHIC-EDGE  NO-FILL   
     SIZE 60 BY .1.

DEFINE VARIABLE toAutoCompletion AS LOGICAL INITIAL no 
     LABEL "Auto-Completion" 
     CONTEXT-HELP-ID 0
     VIEW-AS TOGGLE-BOX
     SIZE 20 BY .81 NO-UNDO.

DEFINE VARIABLE toSort AS LOGICAL INITIAL no 
     LABEL "Sort" 
     CONTEXT-HELP-ID 0
     VIEW-AS TOGGLE-BOX
     SIZE 9 BY .81 NO-UNDO.

DEFINE VARIABLE toUniqueMatch AS LOGICAL INITIAL no 
     LABEL "Unique-Match" 
     CONTEXT-HELP-ID 0
     VIEW-AS TOGGLE-BOX
     SIZE 18 BY .81 NO-UNDO.


/* ************************  Frame Definitions  *********************** */

DEFINE FRAME Dialog-Frame
     coFields AT ROW 1.14 COL 7.6 COLON-ALIGNED WIDGET-ID 36
     coViewAs AT ROW 2.43 COL 10.8 COLON-ALIGNED WIDGET-ID 32
     raItems AT ROW 4.05 COL 3.8 NO-LABEL WIDGET-ID 12
     edItems AT ROW 5 COL 4 NO-LABEL WIDGET-ID 18
     coType AT ROW 9.29 COL 7.8 COLON-ALIGNED WIDGET-ID 4
     fiDelimiter AT ROW 10.52 COL 45 COLON-ALIGNED NO-LABEL WIDGET-ID 34
     raDelimiter AT ROW 10.67 COL 4 NO-LABEL WIDGET-ID 38
     fiInnerLines AT ROW 11.76 COL 13.6 COLON-ALIGNED WIDGET-ID 16
     fiMaxChars AT ROW 11.76 COL 46.8 COLON-ALIGNED WIDGET-ID 20
     toSort AT ROW 13.05 COL 4 WIDGET-ID 22
     toAutoCompletion AT ROW 13.05 COL 20.8 WIDGET-ID 24
     toUniqueMatch AT ROW 13.05 COL 47 WIDGET-ID 26
     Btn_OK AT ROW 14.33 COL 3.8
     Btn_Cancel AT ROW 14.33 COL 18.8
     Btn_Help AT ROW 14.33 COL 49.4
     fiChr AT ROW 10.71 COL 35 COLON-ALIGNED NO-LABEL WIDGET-ID 46
     fiClose AT ROW 10.71 COL 51 COLON-ALIGNED NO-LABEL WIDGET-ID 50
     RECT-5 AT ROW 3.71 COL 4 WIDGET-ID 30
     SPACE(2.19) SKIP(11.94)
    WITH 
    &if defined(IDE-IS-RUNNING) = 0 &then
        VIEW-AS DIALOG-BOX 
        TITLE frameTitle
    &else
        no-box    
    &endif
        KEEP-TAB-ORDER 
        SIDE-LABELS NO-UNDERLINE THREE-D  SCROLLABLE 
        FONT 1
        DEFAULT-BUTTON Btn_OK CANCEL-BUTTON Btn_Cancel WIDGET-ID 100.
 
/* ***********  Runtime Attributes and AppBuilder Settings  *********** */
{adeuib/ide/dialoginit.i "frame Dialog-Frame:handle"}

/* SETTINGS FOR DIALOG-BOX Dialog-Frame
   FRAME-NAME                                                           */
ASSIGN 
       FRAME Dialog-Frame:SCROLLABLE       = FALSE
       FRAME Dialog-Frame:HIDDEN           = TRUE.

/* SETTINGS FOR COMBO-BOX coType IN FRAME Dialog-Frame
   1 2                                                                  */
/* SETTINGS FOR COMBO-BOX coViewAs IN FRAME Dialog-Frame
   1                                                                    */
/* SETTINGS FOR EDITOR edItems IN FRAME Dialog-Frame
   1 2                                                                  */
ASSIGN 
       edItems:RETURN-INSERTED IN FRAME Dialog-Frame  = TRUE.

ASSIGN 
       fiClose:HIDDEN IN FRAME Dialog-Frame           = TRUE.

/* SETTINGS FOR FILL-IN fiDelimiter IN FRAME Dialog-Frame
   1 2                                                                  */
/* SETTINGS FOR FILL-IN fiInnerLines IN FRAME Dialog-Frame
   1 2                                                                  */
/* SETTINGS FOR FILL-IN fiMaxChars IN FRAME Dialog-Frame
   1 2                                                                  */
/* SETTINGS FOR RADIO-SET raDelimiter IN FRAME Dialog-Frame
   2                                                                    */
/* SETTINGS FOR RADIO-SET raItems IN FRAME Dialog-Frame
   2                                                                    */
/* SETTINGS FOR TOGGLE-BOX toAutoCompletion IN FRAME Dialog-Frame
   1 2                                                                  */
/* SETTINGS FOR TOGGLE-BOX toSort IN FRAME Dialog-Frame
   1 2                                                                  */
/* SETTINGS FOR TOGGLE-BOX toUniqueMatch IN FRAME Dialog-Frame
   1 2                                                                  */
/* _RUN-TIME-ATTRIBUTES-END */

 



/* ************************  Control Triggers  ************************ */

&Scoped-define SELF-NAME Dialog-Frame
ON WINDOW-CLOSE OF FRAME Dialog-Frame /* View-as attributes */
DO:
ASSIGN pcCancel = TRUE.
APPLY "END-ERROR":U TO SELF.
END.



&Scoped-define SELF-NAME Btn_Cancel
ON CHOOSE OF Btn_Cancel IN FRAME Dialog-Frame /* Cancel */
DO:
ASSIGN pcCancel = TRUE.
APPLY "WINDOW-CLOSE" TO FRAME {&FRAME-NAME}.
END.



&Scoped-define SELF-NAME Btn_Help
ON CHOOSE OF Btn_Help IN FRAME Dialog-Frame /* Help */
OR HELP OF FRAME {&FRAME-NAME}
DO: /* Call Help Function (or a simple message). */
   RUN adecomm/_adehelp.p ("COMM", "CONTEXT", {&Viewas_Attribute_Dialog_Box}, ?).
END.



&Scoped-define SELF-NAME Btn_OK
ON CHOOSE OF Btn_OK IN FRAME Dialog-Frame /* OK */
DO:
IF getWidgetNames() NE "" THEN
DO:

    IF NOT validateValues() THEN
        RETURN NO-APPLY.

    RUN saveValues.
END.

    ASSIGN pcCancel = FALSE.
END.



&Scoped-define SELF-NAME coFields
ON VALUE-CHANGED OF coFields IN FRAME Dialog-Frame /* Field */
DO:
SESSION:SET-WAIT-STATE("GENERAL":U).

IF getWidgetNames() NE "" THEN
DO:

   IF NOT validateValues() THEN
   DO:
      /*If wrong values were entered for the selected field we have to
        stay in the same field and let the user to fix the problem; then
        return no-apply so nothing is changed. Fix for bug: 20060921-037*/
      ASSIGN SELF:SCREEN-VALUE = gcCurrentField.
      RETURN NO-APPLY.
   END.

   RUN saveValues.

END.
   RUN newFieldSelected.
SESSION:SET-WAIT-STATE("":U).
END.



&Scoped-define SELF-NAME coType
ON VALUE-CHANGED OF coType IN FRAME Dialog-Frame /* Type */
DO:
IF SELF:SCREEN-VALUE = "DROP-DOWN-LIST":U THEN
    ASSIGN toAutoCompletion:SENSITIVE = FALSE
           toAutoCompletion:CHECKED   = FALSE
           fiMaxChars:SENSITIVE       = FALSE
           toUniqueMatch:SENSITIVE    = FALSE
           toUniqueMatch:CHECKED      = FALSE.

ELSE
    ASSIGN toAutoCompletion:SENSITIVE = TRUE
           fiMaxChars:SENSITIVE       = TRUE
           toUniqueMatch:SENSITIVE    = toAutoCompletion:CHECKED.
END.



&Scoped-define SELF-NAME coViewAs
ON VALUE-CHANGED OF coViewAs IN FRAME Dialog-Frame /* View-as */
DO:
IF SELF:SCREEN-VALUE = 'Combo-box':U THEN
DO:
    ENABLE {&comboObjects} WITH FRAME {&FRAME-NAME}.

    IF pcBrowseType = "STATIC":U THEN
        ASSIGN fiDelimiter:SCREEN-VALUE = ","
               raDelimiter:SCREEN-VALUE = "printable":U
               fiDelimiter:SENSITIVE = FALSE
               raDelimiter:SENSITIVE = FALSE
               fiClose:HIDDEN        = TRUE.

    IF fiDelimiter:SCREEN-VALUE = "" THEN ASSIGN fiDelimiter:SCREEN-VALUE = ",".
END.
ELSE DO:
   DISABLE {&comboObjects} WITH FRAME {&FRAME-NAME}.
   fiClose:HIDDEN        = TRUE.
END.

setType(gcDataType).

APPLY 'VALUE-CHANGED':U TO coType.

END.



&Scoped-define SELF-NAME raDelimiter
ON VALUE-CHANGED OF raDelimiter IN FRAME Dialog-Frame
DO:

IF SELF:SCREEN-VALUE = "printable":U THEN
ASSIGN fiChr:SCREEN-VALUE = "Delimiter:":U
       fiChr:WIDTH = 9
       fiChr:COL = 38
       fiClose:HIDDEN = TRUE
       fiDelimiter:SCREEN-VALUE = "":U.

ELSE
ASSIGN fiChr:SCREEN-VALUE = "CHR(":U
       fiChr:WIDTH = 6
       fiChr:COL = 41
       fiClose:HIDDEN = FALSE
       fiDelimiter:SCREEN-VALUE = "":U.

ASSIGN fiDelimiter:MODIFIED = TRUE.
END.



&Scoped-define SELF-NAME raItems
ON VALUE-CHANGED OF raItems IN FRAME Dialog-Frame
DO:
  DEFINE VARIABLE i          AS INTEGER     NO-UNDO.
  DEFINE VARIABLE tmpString  AS CHARACTER   NO-UNDO.
  DEFINE VARIABLE cDelimiter AS CHARACTER   NO-UNDO.
  DEFINE VARIABLE cItems     AS CHARACTER   NO-UNDO.
  DEFINE VARIABLE cFormat    AS CHARACTER   NO-UNDO.

  ASSIGN edItems:SCREEN-VALUE = RIGHT-TRIM(edItems:SCREEN-VALUE)
         cDelimiter = getDelimiter()
         cFormat    = ENTRY(LOOKUP(gcCurrentField, pcFields), pcFieldFormats) NO-ERROR.

  IF edItems:SCREEN-VALUE NE "" THEN
  DO:
    /* Try to convert current contents */
    IF SELF:SCREEN-VALUE = "I" /* LIST-ITEMS */ THEN
    DO:
      DO i = 1 TO NUM-ENTRIES(edItems:SCREEN-VALUE,CHR(10)):
        tmpString = (IF tmpString NE "" THEN tmpString + CHR(10) ELSE tmpString) + 
                     ENTRY(1,ENTRY(i,edItems:SCREEN-VALUE,CHR(10)),cDelimiter).
      END.

    END.
    ELSE DO: /* LIST-ITEM-PAIRS */
      DO i = 1 TO NUM-ENTRIES(edItems:SCREEN-VALUE,CHR(10)):
        ASSIGN tmpString = (IF tmpString NE "" THEN tmpString + CHR(10) ELSE tmpString) + 
                           ENTRY(i,edItems:SCREEN-VALUE,CHR(10)) + cDelimiter.
        CASE gcDataType: /* Figure out which value to display based on data type */
          WHEN "CHARACTER":U THEN tmpString = tmpString + ENTRY(i,edItems:SCREEN-VALUE,CHR(10)).
          WHEN "INTEGER":U   THEN tmpString = tmpString + STRING(i,     IF cFormat = ? OR cFormat = "" THEN "->,>>>,>>9" ELSE cFormat).
          WHEN "INT64":U     THEN tmpString = tmpString + STRING(i,     IF cFormat = ? OR cFormat = "" THEN "->,>>>,>>9" ELSE cFormat).
          WHEN "LOGICAL":U   THEN tmpString = tmpString + STRING(no,    IF cFormat = ? OR cFormat = "" THEN "yes/no" ELSE cFormat).
          WHEN "DECIMAL":U   THEN tmpString = tmpString + STRING(i,     IF cFormat = ? OR cFormat = "" THEN "->>,>>9.99" ELSE cFormat).
          WHEN "DATE":U      THEN tmpString = tmpString + STRING(TODAY, IF cFormat = ? OR cFormat = "" THEN "99/99/99" ELSE cFormat).
        END.
        ASSIGN tmpString = tmpString + (IF i <> NUM-ENTRIES(edItems:SCREEN-VALUE,CHR(10)) THEN cDelimiter ELSE "").
      END.
  END.

    ASSIGN edItems:SCREEN-VALUE = TRIM(tmpString).
  END.
END.



&Scoped-define SELF-NAME toAutoCompletion
ON VALUE-CHANGED OF toAutoCompletion IN FRAME Dialog-Frame /* Auto-Completion */
DO:
  ASSIGN toUniqueMatch:SENSITIVE = SELF:CHECKED
         toUniqueMatch:MODIFIED  = TRUE.
END.



&UNDEFINE SELF-NAME



/* ***************************  Main Block  *************************** */

/* Parent the dialog-box to the ACTIVE-WINDOW, if there is no parent.   */
IF VALID-HANDLE(ACTIVE-WINDOW) AND FRAME {&FRAME-NAME}:PARENT eq ?
THEN FRAME {&FRAME-NAME}:PARENT = ACTIVE-WINDOW.

/* Now enable the interface and wait for the exit condition.            */
/* (NOTE: handle ERROR and END-KEY so cleanup code will always fire.    */
MAIN-BLOCK:
DO ON ERROR   UNDO MAIN-BLOCK, LEAVE MAIN-BLOCK
   ON END-KEY UNDO MAIN-BLOCK, LEAVE MAIN-BLOCK:

RUN enable_UI.
RUN fillFieldCombo.
RUN newFieldSelected.
    &if defined(IDE-IS-RUNNING) = 0 &then
    WAIT-FOR GO OF FRAME {&FRAME-NAME}.
    &else
    &scoped-define CANCEL-EVENT U2
    {adeuib/ide/dialogstart.i btn_ok btn_cancel frametitle}
    dialogService:SizeToFit().
    WAIT-FOR GO OF FRAME {&FRAME-NAME} or "{&CANCEL-EVENT}" of this-procedure.
    if canceldialog then 
        undo, leave.
    &endif
END.

RUN disable_UI.



/* **********************  Internal Procedures  *********************** */

PROCEDURE disable_UI :
/*------------------------------------------------------------------------------
  Purpose:     DISABLE the User Interface
  Parameters:  <none>
  Notes:       Here we clean-up the user-interface by deleting
               dynamic widgets we have created and/or hide 
               frames.  This procedure is usually called when
               we are ready to "clean-up" after running.
------------------------------------------------------------------------------*/
  /* Hide all frames. */
  HIDE FRAME Dialog-Frame.
END PROCEDURE.


PROCEDURE enable_UI :
/*------------------------------------------------------------------------------
  Purpose:     ENABLE the User Interface
  Parameters:  <none>
  Notes:       Here we display/view/enable the widgets in the
               user-interface.  In addition, OPEN all queries
               associated with each FRAME and BROWSE.
               These statements here are based on the "Other 
               Settings" section of the widget Property Sheets.
------------------------------------------------------------------------------*/
  DISPLAY coFields coViewAs raItems edItems coType fiDelimiter raDelimiter 
          fiInnerLines fiMaxChars toSort toAutoCompletion toUniqueMatch fiChr 
          fiClose 
      WITH FRAME Dialog-Frame.
  ENABLE coFields RECT-5 coViewAs raItems edItems coType fiDelimiter 
         raDelimiter fiInnerLines fiMaxChars toSort toAutoCompletion 
         toUniqueMatch Btn_OK Btn_Cancel Btn_Help fiChr fiClose 
      WITH FRAME Dialog-Frame.
  VIEW FRAME Dialog-Frame.
  {&OPEN-BROWSERS-IN-QUERY-Dialog-Frame}
END PROCEDURE.


PROCEDURE fillFieldCombo :
/*------------------------------------------------------------------------------
  Purpose: Fills the 'Field' combo-box using the pcFields parameters. Only valid
           data types for COMBO-BOX and TOGGLE-BOX are loaded. They are:
           DECIMAL,CHARACTER,INTEGER,INT64,DATE,LOGICAL.

  Parameters:  <none>
  Notes:       
------------------------------------------------------------------------------*/
DEFINE VARIABLE iField AS INTEGER     NO-UNDO.
 
/*If there is one entry in pcFields is because the window was called*/
IF NUM-ENTRIES(pcFields) = 1 THEN
DO:
   coFields:ADD-LAST(pcFields) IN FRAME {&FRAME-NAME}.
   coFields:SENSITIVE = FALSE.
END.

ELSE
REPEAT iField = 1 TO NUM-ENTRIES(pcFields):
    IF NOT CAN-DO("DECIMAL,CHARACTER,INTEGER,INT64,DATE,LOGICAL":U, getDataType(ENTRY(iField, pcFields))) THEN
       NEXT.

       coFields:ADD-LAST(ENTRY(iField, pcFields)).
END.

coFields:SCREEN-VALUE = coFields:ENTRY(1).

END PROCEDURE.


PROCEDURE loadValues :
/*------------------------------------------------------------------------------
  Purpose: Load the values received as parameters in the widgets.
  Parameters:  <none>
  Notes: This procedure is called from newFieldSelected
------------------------------------------------------------------------------*/
DEFINE VARIABLE iFieldPosition AS INTEGER     NO-UNDO.
DEFINE VARIABLE cPropertyValue AS CHARACTER   NO-UNDO.
DEFINE VARIABLE cItems         AS CHARACTER   NO-UNDO.
DEFINE VARIABLE cDelimiter     AS CHARACTER   NO-UNDO.

DO WITH FRAME {&FRAME-NAME}:

ASSIGN iFieldPosition       = LOOKUP(gcCurrentField, pcFields)
       cDelimiter           = ENTRY(iFieldPosition, pcColumnDelimiters, CHR(5)) NO-ERROR. /*Gets the delimiter*/

ASSIGN edItems:SCREEN-VALUE = "":U.

IF cDelimiter = "?" OR cDelimiter = ? OR cDelimiter = "" THEN
    ASSIGN cDelimiter = ",". /*Default value for delimiter is comma*/

setDelimiter(cDelimiter).

ASSIGN cPropertyValue = ENTRY(iFieldPosition, pcColumnTypes, CHR(5)) NO-ERROR. /*Gets the ColumnType property*/

CASE cPropertyValue:
    WHEN "TB":U THEN ASSIGN coViewAs:SCREEN-VALUE = "Toggle-box":U.

    WHEN "DD":U OR WHEN "DDL":U THEN
    DO:
         ASSIGN coViewAs:SCREEN-VALUE = "Combo-box":U
                coType:SCREEN-VALUE   = IF cPropertyValue = "DD":U THEN "DROP-DOWN":U ELSE "DROP-DOWN-LIST":U.

         ASSIGN cItems = ENTRY(iFieldPosition, pcColumnItems, CHR(5)) NO-ERROR.
        
        /*Sets the list-items or list-item-pairs property*/
        IF cItems = ? OR cItems = "?" OR cItems = "" THEN /*no list-items means we have list-item-pairs*/
           ASSIGN raItems:SCREEN-VALUE = "P":U
                  edItems:SCREEN-VALUE = returnListItemPairs(ENTRY(iFieldPosition, pcColumnItemPairs, CHR(5)), cDelimiter) NO-ERROR.

        ELSE
           ASSIGN raItems:SCREEN-VALUE = "I":U
                  edItems:SCREEN-VALUE = REPLACE(cItems, cDelimiter, CHR(10)).
    END. /*WHEN "DD":U OR WHEN "DDL":U*/

    OTHERWISE ASSIGN coViewAs:SCREEN-VALUE = "Fill-in":U.
END CASE.

/*Gets the inner-lines*/
ASSIGN cPropertyValue = ENTRY(iFieldPosition, pcColumnInnerLines, CHR(5)) NO-ERROR.
ASSIGN fiInnerLines:SCREEN-VALUE = IF ERROR-STATUS:ERROR OR cPropertyValue EQ ? OR cPropertyValue EQ "" OR cPropertyValue EQ "?" THEN "5" ELSE cPropertyValue.

/*Gets the max-chars*/
ASSIGN cPropertyValue = ENTRY(iFieldPosition, pcColumnMaxChars, CHR(5)) NO-ERROR.
ASSIGN fiMaxChars:SCREEN-VALUE = IF ERROR-STATUS:ERROR OR cPropertyValue EQ ? OR cPropertyValue EQ "" OR cPropertyValue EQ "?" THEN "0" ELSE cPropertyValue.

/*Gest the Sort*/
ASSIGN cPropertyValue = ENTRY(iFieldPosition, pcColumnSort, CHR(5)) NO-ERROR.
ASSIGN toSort:CHECKED = IF NOT ERROR-STATUS:ERROR AND cPropertyValue = "Y" THEN YES ELSE FALSE.

/*Gets the Auto-completion*/
ASSIGN cPropertyValue = ENTRY(iFieldPosition, pcColumnAutoCompletion, CHR(5)) NO-ERROR.
ASSIGN toAutoCompletion:CHECKED = IF NOT ERROR-STATUS:ERROR AND cPropertyValue = "Y" THEN YES ELSE FALSE.

/*Gets the Unique-match*/
ASSIGN cPropertyValue = ENTRY(iFieldPosition, pcColumnUniqueMatch, CHR(5)) NO-ERROR.
ASSIGN toUniqueMatch:CHECKED = IF NOT ERROR-STATUS:ERROR AND cPropertyValue = "Y" THEN YES ELSE FALSE.

END. /*DO WITH FRAME {&FRAME-NAME}*/
END PROCEDURE.


PROCEDURE newFieldSelected :
/*------------------------------------------------------------------------------
  Purpose: Sets variables and widgets according to the new field selected.

  Parameters:  <none>
  Notes: This procedure is called when the dialog is opened, or when a new field
         is selected in the 'Field' combo-box.

------------------------------------------------------------------------------*/
ASSIGN gcDataType     = getDataType(coFields:SCREEN-VALUE IN FRAME {&FRAME-NAME})
       gcCurrentField = coFields:SCREEN-VALUE.

setType(gcDataType).

IF gcDataType = "LOGICAL":U THEN
  ASSIGN coViewAs:LIST-ITEMS = "Combo-box,Toggle-box,Fill-in":U.
ELSE
  ASSIGN coViewAs:LIST-ITEMS = "Combo-box,Fill-in":U.

RUN loadValues.

APPLY 'VALUE-CHANGED':U TO coViewAs.
APPLY 'VALUE-CHANGED':U TO coType.
APPLY 'VALUE-CHANGED':U TO toAutoCompletion.

END PROCEDURE.


PROCEDURE saveValues :
/*------------------------------------------------------------------------------
  Purpose: Stores the new values in the input-output parameter lists
  Parameters:  <none>
  Notes:       
------------------------------------------------------------------------------*/
DEFINE VARIABLE cModifiedFields AS CHARACTER   NO-UNDO.

DEFINE VARIABLE cDelimiter AS CHARACTER   NO-UNDO.
DEFINE VARIABLE cField     AS CHARACTER   NO-UNDO.
DEFINE VARIABLE iField     AS INTEGER     NO-UNDO.

ASSIGN cModifiedFields = getWidgetNames().

DO WITH FRAME {&FRAME-NAME}:

REPEAT iField = 1 TO NUM-ENTRIES(cModifiedFields):
    ASSIGN cField = ENTRY(iField, cModifiedFields).

        IF cField = "coViewAs":U OR cField = "coType":U THEN
            CASE coViewAs:SCREEN-VALUE:
                WHEN "Toggle-box":U THEN ASSIGN pcColumnTypes = buildPropertyList(pcColumnTypes, gcCurrentField, "TB":U).
                WHEN "Combo-box":U  THEN ASSIGN pcColumnTypes = buildPropertyList(pcColumnTypes, gcCurrentField, IF coType:SCREEN-VALUE = "DROP-DOWN":U THEN "DD":U ELSE "DDL":U).
                WHEN "Fill-in":U    THEN
                DO:
                     /*If the field is set back to fill-in, we assign null to every property value.*/
                     ASSIGN pcColumnTypes           = buildPropertyList(pcColumnTypes,          gcCurrentField, "?":U)
                            pcColumnItemPairs       = buildPropertyList(pcColumnItemPairs,      gcCurrentField, "?":U)
                            pcColumnItems           = buildPropertyList(pcColumnItems,          gcCurrentField, "?":U)
                            pcColumnDelimiters      = buildPropertyList(pcColumnDelimiters,     gcCurrentField, "?":U)
                            pcColumnInnerLines      = buildPropertyList(pcColumnInnerLines,     gcCurrentField, "?":U)
                            pcColumnMaxChars        = buildPropertyList(pcColumnMaxChars,       gcCurrentField, "?":U)
                            pcColumnSort            = buildPropertyList(pcColumnSort,           gcCurrentField, "?":U)
                            pcColumnAutoCompletion  = buildPropertyList(pcColumnAutoCompletion, gcCurrentField, "?":U)
                            pcColumnUniqueMatch     = buildPropertyList(pcColumnUniqueMatch,    gcCurrentField, "?":U).
                     RETURN.
                END. /*WHEN "Fill-in":U*/
            END CASE.

        IF coViewAs:SCREEN-VALUE NE "Combo-box":U THEN NEXT.

        CASE cField:
        WHEN "edItems":U THEN
        DO:
            ASSIGN edItems:SCREEN-VALUE = TRIM(edItems:SCREEN-VALUE, CHR(10)).

            IF raItems:SCREEN-VALUE = "I":U THEN
                /*If the new value is a list-items list we have to reset list-item-pairs to ?*/
                ASSIGN pcColumnItemPairs = buildPropertyList(pcColumnItemPairs, gcCurrentField, "?":U)
                       pcColumnItems     = buildPropertyList(pcColumnItems,     gcCurrentField, REPLACE(edItems:SCREEN-VALUE, CHR(10), getDelimiter())).
            ELSE
                /*If the new value is a list-item-pairs list we have to reset list-items to ?*/
                ASSIGN pcColumnItems     = buildPropertyList(pcColumnItems, gcCurrentField, "?")
                       pcColumnItemPairs = buildPropertyList(pcColumnItemPairs, gcCurrentField, formatListItemPairs(edItems:SCREEN-VALUE, getDelimiter())).

        END. /*WHEN "edItems"*/

        WHEN "fiDelimiter":U THEN
             ASSIGN cDelimiter  = getDelimiter()
                    pcColumnDelimiters = buildPropertyList(pcColumnDelimiters, gcCurrentField, IF cDelimiter = "," THEN "?" ELSE cDelimiter).

        WHEN "fiInnerLines":U THEN
             ASSIGN pcColumnInnerLines = buildPropertyList(pcColumnInnerLines, gcCurrentField, IF fiInnerLines:SCREEN-VALUE = "0" THEN "?" ELSE fiInnerLines:SCREEN-VALUE).

        WHEN "fiMaxChars":U THEN
             ASSIGN pcColumnMaxChars = buildPropertyList(pcColumnMaxChars, gcCurrentField, IF fiMaxChars:SCREEN-VALUE = "0" THEN "?" ELSE fiMaxChars:SCREEN-VALUE).

        /*FALSE is the default value for logical properties, therefore we pass "?" if the value is false in the following properties.*/
        WHEN "toSort":U THEN
             ASSIGN pcColumnSort  = buildPropertyList(pcColumnSort, gcCurrentField, IF toSort:CHECKED THEN "Y":U ELSE "?").

        WHEN "toAutoCompletion":U THEN
             ASSIGN pcColumnAutoCompletion  = buildPropertyList(pcColumnAutoCompletion, gcCurrentField, IF toAutoCompletion:CHECKED THEN "Y":U ELSE "?":U).

        WHEN "toUniqueMatch":U THEN
             ASSIGN pcColumnUniqueMatch = buildPropertyList(pcColumnUniqueMatch, gcCurrentField, IF toUniqueMatch:CHECKED AND toAutoCompletion:CHECKED THEN "Y":U ELSE "?").

    END CASE.

END. /*REPEAT*/

END. /*DO WITH FRAME {&FRAME-NAME}:*/

END PROCEDURE.


/* ************************  Function Implementations ***************** */

FUNCTION buildPropertyList RETURNS CHARACTER
  (INPUT pcPropertyValue AS CHARACTER,
   INPUT pcFieldName     AS CHARACTER,
   INPUT pcFieldValue    AS CHARACTER) :
/*------------------------------------------------------------------------------
  Purpose: Assigns the property value in the position related to the field.
    Notes:
------------------------------------------------------------------------------*/
DEFINE VARIABLE iFieldPosition         AS INTEGER     NO-UNDO.
DEFINE VARIABLE iPosition              AS INTEGER     NO-UNDO.
DEFINE VARIABLE iPropertyEntries       AS INTEGER     NO-UNDO.
DEFINE VARIABLE iFieldsEntries         AS INTEGER     NO-UNDO.

DEFINE VARIABLE lDefValues             AS LOGICAL     NO-UNDO INITIAL TRUE.

ASSIGN iFieldPosition   = LOOKUP(pcFieldName, pcFields)
       iFieldsEntries   = NUM-ENTRIES(pcFields)
       iPropertyEntries = NUM-ENTRIES(pcPropertyValue, CHR(5)).

REPEAT iPosition = 1 TO iFieldsEntries:
    /*The property could be blank, so we add the default value ("?") to each entry*/
    IF iPropertyEntries LT iFieldsEntries THEN ASSIGN pcPropertyValue = pcPropertyValue + "?" + CHR(5).

    /*If we are in the entry that is the same position than the field passed as parameter, we set
      the value passed in pcValue in the current position*/
    IF iPosition = iFieldPosition THEN
        ASSIGN ENTRY(iFieldPosition, pcPropertyValue, CHR(5)) = pcFieldValue.

    /*lDefValues is initialized as TRUE, if some value is not the default, lDefValues is
      set to FALSE*/
    IF lDefValues AND ENTRY(iPosition, pcPropertyValue, CHR(5)) NE "?" THEN
       ASSIGN lDefValues = FALSE.
END.

/*If lDefValues=TRUE is because all of the values in the property are the defaults, so we blank the property*/
ASSIGN pcPropertyValue = IF lDefValues = TRUE THEN "" ELSE TRIM(pcPropertyValue, CHR(5)).

RETURN pcPropertyValue.   /* Function return value. */

END FUNCTION.


FUNCTION formatListItemPairs RETURNS CHARACTER
  (INPUT pcItems     AS CHARACTER,
   INPUT pcDelimiter AS CHARACTER) :
/*------------------------------------------------------------------------------
  Purpose: Replaces the CHR(10) in the editor with the delimiter. Then that value
           is written in the file.
    Notes:  
------------------------------------------------------------------------------*/
DEFINE VARIABLE cListItemPairs AS CHARACTER   NO-UNDO.
DEFINE VARIABLE cItem          AS CHARACTER   NO-UNDO.
DEFINE VARIABLE iItem          AS INTEGER     NO-UNDO.

/*Each line (item) in the editor could finish with the delimiter or without it, so we
  add the delimiter if it is not pressent*/
REPEAT iItem = 1 TO NUM-ENTRIES(pcItems, CHR(10)):
       ASSIGN cItem          = ENTRY(iItem, pcItems, CHR(10))
              cListItemPairs = cListItemPairs + cItem +
              IF SUBSTRING(cItem, LENGTH(cItem), 1) = pcDelimiter THEN "" ELSE pcDelimiter.
END.

ASSIGN cListItemPairs = TRIM(cListItemPairs, pcDelimiter).

RETURN cListItemPairs.   /* Function return value. */

END FUNCTION.


FUNCTION getDataType RETURNS CHARACTER
  (INPUT pcField AS CHARACTER) :
/*------------------------------------------------------------------------------
  Purpose: Returns the data-type for the field passed as parameter
    Notes:  
------------------------------------------------------------------------------*/
DEFINE VARIABLE iFieldPosition AS INTEGER     NO-UNDO.

ASSIGN iFieldPosition = LOOKUP(pcField, pcFields).

RETURN IF iFieldPosition EQ 0 THEN "" ELSE ENTRY(iFieldPosition, pcDataTypes).   /* Function return value. */

END FUNCTION.


FUNCTION getDelimiter RETURNS CHARACTER
  ( /* parameter-definitions */ ) :
/*------------------------------------------------------------------------------
  Purpose: Returns the entered delimiter.
    Notes:  
------------------------------------------------------------------------------*/
DO WITH FRAME {&FRAME-NAME}:

    IF raDelimiter:SCREEN-VALUE = "non-printable":U THEN
       RETURN CHR(fiDelimiter:INPUT-VALUE).

    ELSE
       RETURN fiDelimiter:SCREEN-VALUE.
END.

RETURN ?.   /* Function return value. */

END FUNCTION.


FUNCTION getWidgetNames RETURNS CHARACTER
  ( /* parameter-definitions */ ) :
/*-------------------------------------------------------------------------------
  Purpose: Returns a comma delimited list with the widget names that contains
           information for the view-as property.
    Notes:  
-------------------------------------------------------------------------------*/
DEFINE VARIABLE cModifiedFields AS CHARACTER   NO-UNDO.

DEFINE VARIABLE hField          AS HANDLE      NO-UNDO.

ASSIGN hField = FRAME {&FRAME-NAME}:FIRST-CHILD
       hField = hField:FIRST-CHILD.

DO WHILE VALID-HANDLE(hField):

    IF LOOKUP(hField:NAME, "{&isModified}":U, " ") > 0 AND CAN-DO("COMBO-BOX,EDITOR,TOGGLE-BOX,FILL-IN":U, hField:TYPE) THEN
                    ASSIGN cModifiedFields = cModifiedFields + hField:NAME + ",".

    ASSIGN hField = hField:NEXT-SIBLING NO-ERROR.

END.

ASSIGN cModifiedFields = TRIM(cModifiedFields, ",").

RETURN IF cModifiedFields = ? THEN "" ELSE cModifiedFields.   /* Function return value. */

END FUNCTION.


FUNCTION returnListItemPairs RETURNS CHARACTER
  (INPUT pcItems     AS CHARACTER,
   INPUT pcDelimiter AS CHARACTER) :
/*------------------------------------------------------------------------------
  Purpose: Returns the list-item-pairs values formated to be displayed in the
           editor.
    Notes:
------------------------------------------------------------------------------*/
DEFINE VARIABLE cTempItems AS CHARACTER   NO-UNDO.
DEFINE VARIABLE i AS INTEGER     NO-UNDO.

REPEAT i = 1 TO NUM-ENTRIES(pcItems, pcDelimiter) BY 2:
    ASSIGN cTempItems = cTempItems + ENTRY(i, pcItems, pcDelimiter) + pcDelimiter +
                                     ENTRY(i + 1, pcItems, pcDelimiter) + pcDelimiter + CHR(10).
END.

ASSIGN cTempItems = TRIM(TRIM(cTempItems, CHR(10)), pcDelimiter).

RETURN cTempItems.   /* Function return value. */

END FUNCTION.


FUNCTION setDelimiter RETURNS LOGICAL
  (INPUT pcDelimiter AS CHARACTER) :
/*------------------------------------------------------------------------------
  Purpose: Sets the delimiter in the fiDelimiter and riDelimiter values
           according to its ASCII value.
    Notes:
------------------------------------------------------------------------------*/
DO WITH FRAME {&FRAME-NAME}:

    IF ASC(pcDelimiter) LE 31 OR ASC(pcDelimiter) GE 127 THEN
        ASSIGN raDelimiter:SCREEN-VALUE = "non-printable":U
               fiDelimiter:SCREEN-VALUE = STRING(ASC(pcDelimiter)).

    ELSE
        ASSIGN raDelimiter:SCREEN-VALUE = "printable":U
               fiDelimiter:SCREEN-VALUE = pcDelimiter
               fiClose:HIDDEN           = TRUE.

    IF raDelimiter:SCREEN-VALUE = "printable":U AND fiDelimiter:SCREEN-VALUE = "" THEN
        ASSIGN fiDelimiter:SCREEN-VALUE = ",".
END.

RETURN TRUE.   /* Function return value. */

END FUNCTION.


FUNCTION setType RETURNS LOGICAL
  (INPUT pcDataType AS CHARACTER) :
/*------------------------------------------------------------------------------
  Purpose:  
    Notes:  
------------------------------------------------------------------------------*/
IF pcDataType NE 'CHARACTER':U THEN
DO:
    ASSIGN coType:SCREEN-VALUE IN FRAME {&FRAME-NAME} = "DROP-DOWN-LIST":U
           coType:SENSITIVE    = FALSE.
END.

IF coViewAs:SCREEN-VALUE NE "COMBO-BOX":U THEN
   ASSIGN coType:MODIFIED = FALSE.

RETURN TRUE.   /* Function return value. */

END FUNCTION.


FUNCTION validateValues RETURNS LOGICAL
  ( /* parameter-definitions */ ) :
/*------------------------------------------------------------------------------
  Purpose:  
    Notes:  
------------------------------------------------------------------------------*/
IF coViewAs:SCREEN-VALUE IN FRAME {&FRAME-NAME} = "Combo-box":U THEN
DO:

    IF edItems:SCREEN-VALUE = "" OR edItems:SCREEN-VALUE = ? THEN
    DO:
        MESSAGE (IF raItems:SCREEN-VALUE = "P" THEN "LIST-ITEM-PAIRS":U ELSE "LIST-ITEMS":U) " must be entered for a COMBO-BOX widget" VIEW-AS ALERT-BOX ERROR BUTTONS OK.
        RETURN FALSE.
    END.

    RUN adecomm/_vtitems.p (INPUT edItems:SCREEN-VALUE,
                            INPUT IF raItems:SCREEN-VALUE = "P" THEN "LIST-ITEM-PAIRS":U ELSE "LIST-ITEMS":U,
                            INPUT gcDataType,
                            INPUT IF raDelimiter:SCREEN-VALUE = "printable":U THEN fiDelimiter:SCREEN-VALUE ELSE CHR(fiDelimiter:INPUT-VALUE)) NO-ERROR.

    IF ERROR-STATUS:ERROR THEN
    DO:
        MESSAGE "Invalid '" (IF raItems:SCREEN-VALUE = "P" THEN "LIST-ITEM-PAIRS":U ELSE "LIST-ITEMS":U) "' definition for '" gcDataType "' datatype for" SKIP
                "field '" gcCurrentField + "'" VIEW-AS ALERT-BOX ERROR BUTTONS OK.
        RETURN FALSE.
    END.

    IF (fiDelimiter:SCREEN-VALUE IN FRAME {&FRAME-NAME} = ? OR fiDelimiter:SCREEN-VALUE = "") THEN
    DO:
        MESSAGE 'You must enter a delimiter'
            VIEW-AS ALERT-BOX INFO BUTTONS OK.
        RETURN FALSE.
    END.

    IF ASC(fiDelimiter:SCREEN-VALUE) LE 5 THEN
    DO:
        MESSAGE 'Delimiter must be CHR(6) or greater'
            VIEW-AS ALERT-BOX INFO BUTTONS OK.
        RETURN FALSE.
    END.
END.

RETURN TRUE.   /* Function return value. */

END FUNCTION.


/******************************************************************
* Copyright (C) 2006 by Progress Software Corporation. All rights *
* reserved.  Prior versions of this work may contain portions     *
* contributed by participants of Possenet.                        *
*                                                                 *
******************************************************************/
/*----------------------------------------------------------------------------

File: _vtitems.p

Description:
    Checks if the list-items or list-items pairs are valid.

Input Parameters:
   pcItems: List-items or list-item-pairs to be validated.

   pcItemsType: 'LIST-ITEMS': The items received in pcItems is a delimited list
                              of list-items.

                'LIST-ITEM-PAIRS': The items received in pcItems is a delimited list
                                   of list-item-pairs.

   pcDataType: DataType of the items
   pcDelimiter: Delimiter datatype
                            
Output Parameters:
   <None>

Author: Marcelo Ferrante.

Date Created: Jun 13th, 2006
---------------------------------------------------------------------------- */
DEFINE INPUT  PARAMETER pcItems     AS CHARACTER   NO-UNDO.
DEFINE INPUT  PARAMETER pcItemsType AS CHARACTER   NO-UNDO.
DEFINE INPUT  PARAMETER pcDataType  AS CHARACTER   NO-UNDO.
DEFINE INPUT  PARAMETER pcDelimiter AS CHARACTER   NO-UNDO.

DEFINE VARIABLE cTempFile           AS CHARACTER   NO-UNDO.

DEFINE VARIABLE i      AS INTEGER     NO-UNDO.
DEFINE VARIABLE lError AS LOGICAL     NO-UNDO.

DEFINE STREAM TempStream.

{adecomm/adefext.i}

/* There's no restrictions for list-items or list-item-pairs if  data-type is character */  
IF pcDataType = "Character":U THEN RETURN.

  RUN adecomm/_tmpfile.p
      ({&STD_TYP_UIB_COMPILE}, {&STD_EXT_UIB}, OUTPUT cTempFile).
  
  OUTPUT STREAM tempStream TO VALUE(cTempFile).

  PUT STREAM tempStream UNFORMATTED
    "DEFINE VARIABLE aComboBox AS " + pcDataType SKIP.
  PUT STREAM tempStream UNFORMATTED
    "     VIEW-AS COMBO-BOX " + pcItemsType SKIP "     ".

  IF pcItemsType = "LIST-ITEMS":U THEN 
     PUT STREAM tempStream UNFORMATTED REPLACE(pcItems,CHR(10),",").

  ELSE DO i = 1 TO NUM-ENTRIES(pcItems,CHR(10)):
          PUT STREAM tempStream UNFORMATTED """"  + /* first item of pair (quoted) */
              ENTRY(1,ENTRY(i,pcItems,CHR(10)),pcDelimiter) + '",' +
              /* Quote the second item only if it's a CHAR field */
              (IF pcDataType = "Character":U THEN '"' + 
              ENTRY(2,ENTRY(i,pcItems,CHR(10)),pcDelimiter) + '"'
              ELSE ENTRY(2,ENTRY(i,pcItems,CHR(10)),pcDelimiter)) +
              (IF i < NUM-ENTRIES(pcItems,CHR(10)) THEN ",":U + CHR(10)
              ELSE "").
       END.  /* DO i = 1 to Num-Entries */

  PUT STREAM tempStream UNFORMATTED "." SKIP.
  OUTPUT STREAM tempStream CLOSE.
  COMPILE VALUE(cTempFile) NO-ERROR.
  IF COMPILER:ERROR THEN
     ASSIGN lError = TRUE.

  OS-DELETE VALUE(cTempFile) NO-ERROR.

  IF lError THEN RETURN ERROR.
  ELSE RETURN.
 

&ANALYZE-SUSPEND _VERSION-NUMBER AB_v10r12 GUI
&ANALYZE-RESUME
/* Connected Databases 
*/
&Scoped-define WINDOW-NAME C-Win
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _DEFINITIONS C-Win 
/***********************************************************************
* Copyright (C) 2007-2008 by Progress Software Corporation. All rights *
* reserved.  Prior versions of this work may contain portions          *
* contributed by participants of Possenet.                             *
*                                                                      *
***********************************************************************/
/*------------------------------------------------------------------------

  File: adecomm/_assign-wid.w

  Description: This is the 'Runtime Widget-id Assignment Tool' main window. 

  Input Parameters:
      <none>

  Output Parameters:
      <none>

  Author: Marcelo Ferrante
  
  Created: May 09, 2007

------------------------------------------------------------------------*/
/*          This .W file was created with the Progress AppBuilder.      */
/*----------------------------------------------------------------------*/

/* Create an unnamed pool to store all the widgets created 
     by this procedure. This is a good default which assures
     that this procedure's triggers and internal procedures 
     will execute in this procedure's storage, and that proper
     cleanup will occur on deletion of the procedure. */

CREATE WIDGET-POOL.

/* ***************************  Definitions  ************************** */
{protools/ptlshlp.i}  /* help definitions        */
{src/adm2/globals.i}
{src/adm2/ttaction.i}
{src/adm2/tttoolbar.i}
{src/adm2/treettdef.i}
{adecomm/dswid.i}

/* Parameters Definitions ---                                           */

/* Local Variable Definitions ---                                       */
DEFINE VARIABLE gcStatus    AS CHARACTER   NO-UNDO.
DEFINE VARIABLE ghDSLibrary AS HANDLE    NO-UNDO.

DEFINE TEMP-TABLE ttBrowser NO-UNDO
FIELD cKey            AS CHARACTER
FIELD cLabel          AS CHARACTER
FIELD cContainer      AS CHARACTER
FIELD cContainerPath  AS CHARACTER
FIELD cContainerName  AS CHARACTER
FIELD cExpanded       AS CHARACTER
FIELD lParentExpanded AS LOGICAL
FIELD WidgetID        AS INTEGER
FIELD iOrder          AS INTEGER
FIELD cStatus         AS CHARACTER /*U=Updated;D=Deleted;SD=Deleted by the sync process*/
FIELD cParent         AS CHARACTER
FIELD cTTName         AS CHARACTER
FIELD cTTFieldID      AS CHARACTER
INDEX ckey AS PRIMARY UNIQUE cContainer cKey cParent.

/*This temp-table is used in syncStaticObject to store the InstanceChildren record before
  the container is synchronized, and then detect the deletions.*/
DEFINE TEMP-TABLE beforeInstanceChildren NO-UNDO LIKE InstanceChildren.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME


&ANALYZE-SUSPEND _UIB-PREPROCESSOR-BLOCK 

/* ********************  Preprocessor Definitions  ******************** */

&Scoped-define PROCEDURE-TYPE Window
&Scoped-define DB-AWARE no

/* Name of designated FRAME-NAME and/or first browse and/or first query */
&Scoped-define FRAME-NAME DEFAULT-FRAME
&Scoped-define BROWSE-NAME brObjects

/* Internal Tables (found by Frame, Query & Browse Queries)             */
&Scoped-define INTERNAL-TABLES ttBrowser

/* Definitions for BROWSE brObjects                                     */
&Scoped-define FIELDS-IN-QUERY-brObjects ttBrowser.cExpanded ttBrowser.cLabel ttBrowser.WidgetID   
&Scoped-define ENABLED-FIELDS-IN-QUERY-brObjects ttBrowser.WidgetID   
&Scoped-define ENABLED-TABLES-IN-QUERY-brObjects ttBrowser
&Scoped-define FIRST-ENABLED-TABLE-IN-QUERY-brObjects ttBrowser
&Scoped-define SELF-NAME brObjects
&Scoped-define QUERY-STRING-brObjects FOR EACH ttBrowser NO-LOCK       WHERE ttBrowser.cContainer      = coContainer:SCREEN-VALUE AND             ttBrowser.lParentExpanded = TRUE AND             ttBrowser.cStatus NE "D":U             BY ttBrowser.iOrder INDEXED-REPOSITION
&Scoped-define OPEN-QUERY-brObjects OPEN QUERY {&SELF-NAME} FOR EACH ttBrowser NO-LOCK       WHERE ttBrowser.cContainer      = coContainer:SCREEN-VALUE AND             ttBrowser.lParentExpanded = TRUE AND             ttBrowser.cStatus NE "D":U             BY ttBrowser.iOrder INDEXED-REPOSITION.
&Scoped-define TABLES-IN-QUERY-brObjects ttBrowser
&Scoped-define FIRST-TABLE-IN-QUERY-brObjects ttBrowser


/* Definitions for FRAME DEFAULT-FRAME                                  */
&Scoped-define OPEN-BROWSERS-IN-QUERY-DEFAULT-FRAME ~
    ~{&OPEN-QUERY-brObjects}

/* Standard List Definitions                                            */
&Scoped-Define ENABLED-OBJECTS RECT-4 buAdd RECT-5 RECT-8 rcRight rcBrowser ~
rcToolbar fiXMLFileName coContainer brObjects buNew buOpen buTree buSync ~
buCancel buRemove buSave 
&Scoped-Define DISPLAYED-OBJECTS fiXMLFileName coContainer 

/* Custom List Definitions                                              */
/* List-1,List-2,List-3,List-4,List-5,List-6                            */

/* _UIB-PREPROCESSOR-BLOCK-END */
&ANALYZE-RESUME


/* ************************  Function Prototypes ********************** */

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION-FORWARD checkTransaction C-Win 
FUNCTION checkTransaction RETURNS LOGICAL
  ( /* parameter-definitions */ )  FORWARD.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION-FORWARD getFileExtension C-Win 
FUNCTION getFileExtension RETURNS CHARACTER
  (INPUT pcFileName AS CHARACTER)  FORWARD.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION-FORWARD isABRunning C-Win 
FUNCTION isABRunning RETURNS LOGICAL
  ( /* parameter-definitions */ )  FORWARD.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION-FORWARD setWidgetStatus C-Win 
FUNCTION setWidgetStatus RETURNS LOGICAL
  (INPUT pcStatus AS CHARACTER)  FORWARD.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME


/* ***********************  Control Definitions  ********************** */

/* Define the widget handle for the window                              */
DEFINE VAR C-Win AS WIDGET-HANDLE NO-UNDO.

/* Menu Definitions                                                     */
DEFINE SUB-MENU m_File 
       MENU-ITEM m_Exit         LABEL "Exit"          .

DEFINE SUB-MENU m_Options 
       MENU-ITEM m_AssignonAdd  LABEL "Assign Default Values on Add"
              TOGGLE-BOX
       MENU-ITEM m_Assign_Default_Values LABEL "Re-assign Default Values".

DEFINE SUB-MENU m_Help 
       MENU-ITEM m__About_Runtime_Widget-id_As LABEL " About Runtime Widget-id Assignment Tool".

DEFINE MENU MENU-BAR-C-Win MENUBAR
       SUB-MENU  m_File         LABEL "File"          
       SUB-MENU  m_Options      LABEL "Options"       
       SUB-MENU  m_Help         LABEL "Help"          .


/* Definitions of the field level widgets                               */
DEFINE BUTTON buAdd 
     IMAGE-UP FILE "adeicon/add.gif":U NO-FOCUS FLAT-BUTTON
     LABEL "Add Containers" 
     SIZE 5 BY 1.14 TOOLTIP "Add Containers to XML file".

DEFINE BUTTON buCancel 
     IMAGE-UP FILE "adeicon/cancel.gif":U NO-FOCUS FLAT-BUTTON
     LABEL "Cancel" 
     SIZE 5 BY 1.14 TOOLTIP "Cancel Updates".

DEFINE BUTTON buNew 
     IMAGE-UP FILE "adeicon/new.bmp":U NO-FOCUS FLAT-BUTTON
     LABEL "New" 
     SIZE 5 BY 1.14 TOOLTIP "New XML file".

DEFINE BUTTON buOpen 
     IMAGE-UP FILE "adeicon/open.bmp":U NO-FOCUS FLAT-BUTTON
     LABEL "Open" 
     SIZE 5 BY 1.14 TOOLTIP "Open XML file".

DEFINE BUTTON buRemove 
     IMAGE-UP FILE "adeicon/delete.gif":U NO-FOCUS FLAT-BUTTON
     LABEL "Remove Container" 
     SIZE 5 BY 1.14 TOOLTIP "Remove Container from XML file".

DEFINE BUTTON buSave 
     IMAGE-UP FILE "adeicon/save.gif":U NO-FOCUS FLAT-BUTTON
     LABEL "Save" 
     SIZE 5 BY 1.14 TOOLTIP "Save to XML file".

DEFINE BUTTON buSync 
     IMAGE-UP FILE "adeicon/synch.gif":U
     IMAGE-INSENSITIVE FILE "adeicon/synchd.gif":U NO-FOCUS FLAT-BUTTON
     LABEL "Synchronize" 
     SIZE 5 BY 1.14 TOOLTIP "Synchronize XML data with source object".

DEFINE BUTTON buTree 
     IMAGE-UP FILE "adeicon/collapseall.gif":U
     IMAGE-INSENSITIVE FILE "adeicon/collapsealld.gif":U NO-FOCUS FLAT-BUTTON
     LABEL "Collapse All" 
     SIZE 5 BY 1.14 TOOLTIP "Collapse All".

DEFINE VARIABLE coContainer AS CHARACTER FORMAT "X(256)":U INITIAL "0" 
     LABEL "Container" 
     VIEW-AS COMBO-BOX SORT INNER-LINES 5
     LIST-ITEM-PAIRS "Item 1","0"
     DROP-DOWN-LIST
     SIZE 56.6 BY 1 NO-UNDO.

DEFINE VARIABLE fiXMLFileName AS CHARACTER FORMAT "X(1024)":U 
     LABEL "XML File Name" 
     CONTEXT-HELP-ID 0
     VIEW-AS FILL-IN 
     SIZE 51.2 BY 1 NO-UNDO.

DEFINE RECTANGLE rcBrowser
     EDGE-PIXELS 2 GRAPHIC-EDGE  NO-FILL   
     SIZE 69.4 BY 17.62.

DEFINE RECTANGLE rcRight
     EDGE-PIXELS 2 GRAPHIC-EDGE  NO-FILL   
     SIZE .2 BY 1.33.

DEFINE RECTANGLE rcToolbar
     EDGE-PIXELS 2 GRAPHIC-EDGE  NO-FILL   
     SIZE 69.4 BY 1.33.

DEFINE RECTANGLE RECT-4
     EDGE-PIXELS 2 GRAPHIC-EDGE  NO-FILL   
     SIZE .2 BY 1.33.

DEFINE RECTANGLE RECT-5
     EDGE-PIXELS 2 GRAPHIC-EDGE  NO-FILL   
     SIZE .2 BY 1.33.

DEFINE RECTANGLE RECT-8
     EDGE-PIXELS 2 GRAPHIC-EDGE  NO-FILL   
     SIZE .2 BY 1.33.

/* Query definitions                                                    */
&ANALYZE-SUSPEND
DEFINE QUERY brObjects FOR 
      ttBrowser SCROLLING.
&ANALYZE-RESUME

/* Browse definitions                                                   */
DEFINE BROWSE brObjects
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _DISPLAY-FIELDS brObjects C-Win _FREEFORM
  QUERY brObjects NO-LOCK DISPLAY
      ttBrowser.cExpanded LABEL "" FORMAT "X(1)" WIDTH 2
      ttBrowser.cLabel FORMAT "X(128)" WIDTH 50
      ttBrowser.WidgetID

ENABLE ttBrowser.WidgetID
/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME
    WITH NO-BOX NO-LABELS NO-ASSIGN NO-ROW-MARKERS SEPARATORS SIZE 67 BY 14.76 FIT-LAST-COLUMN.


/* ************************  Frame Definitions  *********************** */

DEFINE FRAME DEFAULT-FRAME
     buAdd AT ROW 1.24 COL 12.6 WIDGET-ID 208
     fiXMLFileName AT ROW 2.71 COL 16 COLON-ALIGNED WIDGET-ID 230
     coContainer AT ROW 3.86 COL 2.4 WIDGET-ID 2
     brObjects AT ROW 5 COL 2.2 WIDGET-ID 200
     buNew AT ROW 1.24 COL 1.6 WIDGET-ID 60
     buOpen AT ROW 1.24 COL 6.6 WIDGET-ID 6
     buTree AT ROW 1.19 COL 39.6 WIDGET-ID 4
     buSync AT ROW 1.19 COL 33.6 WIDGET-ID 224
     buCancel AT ROW 1.24 COL 27.6 WIDGET-ID 12
     buRemove AT ROW 1.24 COL 17.6 WIDGET-ID 206
     buSave AT ROW 1.24 COL 22.6 WIDGET-ID 10
     RECT-4 AT ROW 1.1 COL 12 WIDGET-ID 216
     RECT-5 AT ROW 1.1 COL 33 WIDGET-ID 218
     RECT-8 AT ROW 1.1 COL 39 WIDGET-ID 226
     rcRight AT ROW 1.1 COL 45 WIDGET-ID 228
     rcBrowser AT ROW 2.43 COL 1 WIDGET-ID 232
     rcToolbar AT ROW 1.1 COL 1 WIDGET-ID 234
    WITH 1 DOWN NO-BOX KEEP-TAB-ORDER OVERLAY 
         SIDE-LABELS NO-UNDERLINE THREE-D 
         AT COL 1 ROW 1.14
         SIZE 70.2 BY 19.57 DROP-TARGET WIDGET-ID 100.


/* *********************** Procedure Settings ************************ */

&ANALYZE-SUSPEND _PROCEDURE-SETTINGS
/* Settings for THIS-PROCEDURE
   Type: Window
   Allow: Basic,Browse,DB-Fields,Window,Query
   Other Settings: COMPILE
 */
&ANALYZE-RESUME _END-PROCEDURE-SETTINGS

/* *************************  Create Window  ************************** */

&ANALYZE-SUSPEND _CREATE-WINDOW
IF SESSION:DISPLAY-TYPE = "GUI":U THEN
  CREATE WINDOW C-Win ASSIGN
         HIDDEN             = YES
         TITLE              = "Runtime WIDGET-ID Assignment Tool"
         HEIGHT             = 19.19
         WIDTH              = 69.6
         MAX-HEIGHT         = 45.67
         MAX-WIDTH          = 280
         VIRTUAL-HEIGHT     = 45.67
         VIRTUAL-WIDTH      = 280
         RESIZE             = yes
         SCROLL-BARS        = no
         STATUS-AREA        = no
         BGCOLOR            = ?
         FGCOLOR            = ?
         KEEP-FRAME-Z-ORDER = yes
         THREE-D            = yes
         MESSAGE-AREA       = no
         SENSITIVE          = yes.
ELSE {&WINDOW-NAME} = CURRENT-WINDOW.

ASSIGN {&WINDOW-NAME}:MENUBAR    = MENU MENU-BAR-C-Win:HANDLE.

&IF '{&WINDOW-SYSTEM}' NE 'TTY' &THEN
IF NOT C-Win:LOAD-ICON("adeicon/assignwid.ico":U) THEN
    MESSAGE "Unable to load icon: adeicon/assignwid.ico"
            VIEW-AS ALERT-BOX WARNING BUTTONS OK.
&ENDIF
/* END WINDOW DEFINITION                                                */
&ANALYZE-RESUME



/* ***********  Runtime Attributes and AppBuilder Settings  *********** */

&ANALYZE-SUSPEND _RUN-TIME-ATTRIBUTES
/* SETTINGS FOR WINDOW C-Win
  VISIBLE,,RUN-PERSISTENT                                               */
/* SETTINGS FOR FRAME DEFAULT-FRAME
   FRAME-NAME                                                           */
/* BROWSE-TAB brObjects coContainer DEFAULT-FRAME */
ASSIGN 
       brObjects:COLUMN-RESIZABLE IN FRAME DEFAULT-FRAME       = TRUE.

/* SETTINGS FOR COMBO-BOX coContainer IN FRAME DEFAULT-FRAME
   ALIGN-L                                                              */
ASSIGN 
       fiXMLFileName:READ-ONLY IN FRAME DEFAULT-FRAME        = TRUE.

IF SESSION:DISPLAY-TYPE = "GUI":U AND VALID-HANDLE(C-Win)
THEN C-Win:HIDDEN = no.

/* _RUN-TIME-ATTRIBUTES-END */
&ANALYZE-RESUME


/* Setting information for Queries and Browse Widgets fields            */

&ANALYZE-SUSPEND _QUERY-BLOCK BROWSE brObjects
/* Query rebuild information for BROWSE brObjects
     _START_FREEFORM
OPEN QUERY {&SELF-NAME} FOR EACH ttBrowser NO-LOCK
      WHERE ttBrowser.cContainer      = coContainer:SCREEN-VALUE AND
            ttBrowser.lParentExpanded = TRUE AND
            ttBrowser.cStatus NE "D":U
            BY ttBrowser.iOrder INDEXED-REPOSITION.
     _END_FREEFORM
     _Options          = "NO-LOCK INDEXED-REPOSITION"
     _Query            is OPENED
*/  /* BROWSE brObjects */
&ANALYZE-RESUME

 



/* ************************  Control Triggers  ************************ */

&Scoped-define SELF-NAME C-Win
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL C-Win C-Win
ON END-ERROR OF C-Win /* Runtime WIDGET-ID Assignment Tool */
OR ENDKEY OF {&WINDOW-NAME} ANYWHERE DO:
  /* This case occurs when the user presses the "Esc" key.
     In a persistently run window, just ignore this.  If we did not, the
     application would exit. */
  IF FOCUS:NAME = "WidgetID":U THEN
  DO:
        ASSIGN ttBrowser.WidgetID = INT(FOCUS:SCREEN-VALUE).
        APPLY "LEAVE":U TO FOCUS.
  END.

IF NOT checkTransaction() THEN
   RETURN NO-APPLY.

IF VALID-HANDLE(ghDSLibrary) THEN
    DELETE OBJECT ghDSLibrary NO-ERROR.
  IF THIS-PROCEDURE:PERSISTENT THEN RETURN NO-APPLY.
END.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME


&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL C-Win C-Win
ON WINDOW-CLOSE OF C-Win /* Runtime WIDGET-ID Assignment Tool */
DO:
  /* This event will close the window and terminate the procedure.  */

  IF VALID-HANDLE(FOCUS) AND FOCUS:NAME = "WidgetID":U THEN
  DO:
      ASSIGN ttBrowser.WidgetID = INT(FOCUS:SCREEN-VALUE).
      APPLY "LEAVE":U TO FOCUS.
  END.

  IF NOT checkTransaction() THEN
   RETURN NO-APPLY.

  IF VALID-HANDLE(ghDSLibrary) THEN
      DELETE OBJECT ghDSLibrary NO-ERROR.

  APPLY "CLOSE":U TO THIS-PROCEDURE.
  RETURN NO-APPLY.
END.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME


&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL C-Win C-Win
ON WINDOW-MAXIMIZED OF C-Win /* Runtime WIDGET-ID Assignment Tool */
DO:
  RUN windowResized.
END.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME


&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL C-Win C-Win
ON WINDOW-RESIZED OF C-Win /* Runtime WIDGET-ID Assignment Tool */
DO:
  RUN windowResized.
END.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME


&Scoped-define SELF-NAME DEFAULT-FRAME
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL DEFAULT-FRAME C-Win
ON DROP-FILE-NOTIFY OF FRAME DEFAULT-FRAME
DO:
DEFINE VARIABLE cFileType AS CHARACTER   NO-UNDO.
DEFINE VARIABLE cFileExt  AS CHARACTER   NO-UNDO.

/*If a transaction is opened, this option is disabled*/
IF gcStatus = "Started":U THEN
   RETURN NO-APPLY.

/*Checks that only one file was dropped*/
IF SELF:GET-DROPPED-FILE(2) NE "" THEN
DO:
    MESSAGE "Only one file at time could be dropped in this window"
        VIEW-AS ALERT-BOX INFO BUTTONS OK.
    RETURN NO-APPLY.
END.

ASSIGN FILE-INFO:FILE-NAME = SELF:GET-DROPPED-FILE(1)
       cFileType = FILE-INFO:FILE-TYPE.

/*If the dropped file is not a file, just return no-apply*/
IF INDEX(cFileType, "F") EQ 0 THEN RETURN NO-APPLY.

/*Gets the extension of the file*/
ASSIGN cFileExt = getFileExtension(FILE-INFO:FILE-NAME).

IF cFileExt = "xml":U THEN
RUN loadXML (INPUT FILE-INFO:FILE-NAME) NO-ERROR.
IF ERROR-STATUS:ERROR THEN RETURN NO-APPLY.

END.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME


&Scoped-define BROWSE-NAME brObjects
&Scoped-define SELF-NAME brObjects
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL brObjects C-Win
ON LEFT-MOUSE-DBLCLICK OF brObjects IN FRAME DEFAULT-FRAME
DO:
DEFINE VARIABLE cParentKey AS CHARACTER   NO-UNDO.
DEFINE VARIABLE cParentExpanded AS CHARACTER   NO-UNDO.

DEFINE VARIABLE rRow        AS ROWID       NO-UNDO.
DEFINE VARIABLE iCurrentRow AS INTEGER     NO-UNDO.

DEFINE BUFFER bBrowser FOR TEMP-TABLE ttBrowser.

IF brObjects:QUERY:NUM-RESULTS = 0 THEN
    RETURN NO-APPLY.

ASSIGN cParentKey      = ttBrowser.cKey
       cParentExpanded = ttBrowser.cExpanded
       rRow            = ROWID(ttBrowser)
       iCurrentRow     = brObjects:FOCUSED-ROW.

IF cParentExpanded = "" THEN RETURN NO-APPLY.

FOR EACH ttBrowser WHERE ttBrowser.cParent = cParentKey:

    IF ttBrowser.cExpanded NE "" THEN
    ASSIGN ttBrowser.cExpanded = IF ttBrowser.cExpanded = "-" THEN "+" ELSE ttBrowser.cExpanded 
           ttBrowser.lParentExpanded = FALSE.

    FOR EACH bBrowser WHERE bBrowser.cParent = ttBrowser.cKey:
           ASSIGN bBrowser.lParentExpanded = FALSE.
    END. /*FOR EACH bBrowser*/

    IF cParentExpanded = "+" OR cParentExpanded = ">" OR cParentExpanded = "<" THEN
        ASSIGN ttBrowser.lParentExpanded = TRUE.
    ELSE
        ASSIGN ttBrowser.lParentExpanded = FALSE.

END. /*FOR EACH ttBrowser*/

{&BROWSE-NAME}:SET-REPOSITIONED-ROW(iCurrentRow,"CONDITIONAL").
{&OPEN-QUERY-{&BROWSE-NAME}}      
REPOSITION {&BROWSE-NAME} TO ROWID rRow NO-ERROR.

IF cParentExpanded = "+" THEN
   ASSIGN ttBrowser.cExpanded = "-".
ELSE
   ASSIGN ttBrowser.cExpanded = "+".

RUN updateSyncStatus.
{&BROWSE-NAME}:REFRESH().

END.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME


&Scoped-define SELF-NAME buAdd
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL buAdd C-Win
ON CHOOSE OF buAdd IN FRAME DEFAULT-FRAME /* Add Containers */
DO:
DEFINE VARIABLE cCurrentContainers AS CHARACTER   NO-UNDO.

FOR EACH Container NO-LOCK:
    ASSIGN cCurrentContainers = cCurrentContainers + "," + TRIM(Container.contPath + "/" + Container.contName, "/").
END.

ASSIGN cCurrentContainers = TRIM(cCurrentContainers, ",").
RUN adecomm/_getwidobjs.w (INPUT cCurrentContainers,
                           INPUT fiXMLFileName:SCREEN-VALUE,
                           INPUT MENU-ITEM m_AssignonAdd:CHECKED IN MENU MENU-BAR-C-Win,
                           INPUT-OUTPUT DATASET dsWidgetID BY-REFERENCE).

RUN fillComboBox (TRUE).
APPLY "VALUE-CHANGED":U TO coContainer.
DATASET dsWidgetID:WRITE-XML("FILE", fiXMLFileName:SCREEN-VALUE IN FRAME {&FRAME-NAME}, TRUE).

IF NOT CAN-FIND(FIRST Container) THEN
setWidgetStatus("XMLEmpty":U).
ELSE
setWidgetStatus("Finished":U).
END.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME


&Scoped-define SELF-NAME buCancel
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL buCancel C-Win
ON CHOOSE OF buCancel IN FRAME DEFAULT-FRAME /* Cancel */
DO:
DEFINE VARIABLE lButton AS LOGICAL     NO-UNDO.

MESSAGE "Are you sure you want to undo the changes?" SKIP(1)
    VIEW-AS ALERT-BOX QUESTION BUTTONS YES-NO UPDATE lButton.

      IF lButton = YES THEN
        RUN undoTransaction.

      ELSE RETURN NO-APPLY.

END.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME


&Scoped-define SELF-NAME buNew
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL buNew C-Win
ON CHOOSE OF buNew IN FRAME DEFAULT-FRAME /* New */
DO:
DEFINE VARIABLE cFile AS CHARACTER   NO-UNDO.

IF NOT checkTransaction() THEN
   RETURN NO-APPLY.

  SYSTEM-DIALOG GET-FILE cFile
     FILTERS "Widget-id XML File (*.xml)" "*.xml"
     TITLE "New Widget-id XML File"
     DEFAULT-EXTENSION "xml"
     CREATE-TEST-FILE
     IN WINDOW c-win.

  /*User cancelled in the system-dialog get-file window.*/
  IF cFile = "":U THEN
    RETURN NO-APPLY.

ASSIGN fiXMLFileName:SCREEN-VALUE = cFile.
DATASET dsWidgetID:EMPTY-DATASET().
RUN fillComboBox (TRUE).
{&OPEN-QUERY-{&BROWSE-NAME}}
setWidgetStatus("XMLEmpty":U).
END.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME


&Scoped-define SELF-NAME buOpen
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL buOpen C-Win
ON CHOOSE OF buOpen IN FRAME DEFAULT-FRAME /* Open */
DO:
DEFINE VARIABLE cFile AS CHARACTER   NO-UNDO.
  
  SYSTEM-DIALOG GET-FILE cFile
     FILTERS "Widget-id XML File (*.xml)" "*.xml"
     TITLE "Open Widget-id XML File"
     IN WINDOW c-win.

  IF cFile = "":U THEN RETURN NO-APPLY.
RUN loadXML (INPUT cFile).
END.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME


&Scoped-define SELF-NAME buRemove
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL buRemove C-Win
ON CHOOSE OF buRemove IN FRAME DEFAULT-FRAME /* Remove Container */
DO:
  RUN deleteContainer.
END.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME


&Scoped-define SELF-NAME buSave
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL buSave C-Win
ON CHOOSE OF buSave IN FRAME DEFAULT-FRAME /* Save */
DO:
  RUN commitTransaction.
END.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME


&Scoped-define SELF-NAME buSync
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL buSync C-Win
ON CHOOSE OF buSync IN FRAME DEFAULT-FRAME /* Synchronize */
DO:
DEFINE VARIABLE hProcLibrary AS HANDLE      NO-UNDO.
DEFINE VARIABLE lChanged     AS LOGICAL     NO-UNDO.
RUN adecomm/_setcurs.p (INPUT "WAIT":U).
/*If the AppBuilder is running, check for objects in design mode*/

IF isABRunning() THEN
DO:
    RUN adeuib/_widfunc.p PERSISTENT SET hProcLibrary.

    IF DYNAMIC-FUNCTION('getAppBuilderStatus':U IN hProcLibrary) = "Runtime":U THEN
        RUN syncRuntimeObject (OUTPUT lChanged).

    ELSE DO:

    RUN getDesignObjectNames IN hProcLibrary (INPUT "", INPUT-OUTPUT TABLE ttObjectNames).

    FIND FIRST ttObjectNames WHERE ttObjectNames.cName = coContainer:SCREEN-VALUE NO-LOCK NO-ERROR.

    IF NOT AVAILABLE(ttObjectNames) THEN
    DO:
        MESSAGE "Container '" + coContainer:SCREEN-VALUE + "' must be opened in the AppBuilder, or executed before to use this feature."
            VIEW-AS ALERT-BOX INFO BUTTONS OK.
        DELETE OBJECT hProcLibrary.
        RETURN NO-APPLY.
    END.

    IF ttObjectNames.isStatic = TRUE THEN
    DO:
        FIND FIRST ttBrowser NO-LOCK.
        FILE-INFO:FILE-NAME = ttBrowser.cContainer.

        RUN syncStaticObject IN hProcLibrary (INPUT cContainerName,
                                              INPUT cContainerPath,
                                              INPUT FILE-INFO:FULL-PATHNAME,
                                              INPUT MENU-ITEM m_AssignonAdd:CHECKED IN MENU MENU-BAR-C-Win,
                                              OUTPUT lChanged,
                                              INPUT-OUTPUT DATASET dsWidgetID BY-REFERENCE).
    END. /*IF ttObjectName.isStatic = TRUE THEN*/
    ELSE RUN syncDynObject (OUTPUT lChanged).
    END.
END. /*IF isABRunning() THEN*/
ELSE RUN syncRuntimeObject (OUTPUT lChanged).

IF NOT lChanged THEN
DO:
    MESSAGE "No changes were found during the synchronization."
         VIEW-AS ALERT-BOX INFORMATION
         TITLE c-win:TITLE.
    RETURN NO-APPLY.
END.
RUN fillBrowseTempTable.
{&OPEN-QUERY-{&BROWSE-NAME}}
setWidgetStatus("Started":U).
DELETE OBJECT hProcLibrary.
RUN adecomm/_setcurs.p (INPUT "":U).
END.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME


&Scoped-define SELF-NAME buTree
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL buTree C-Win
ON CHOOSE OF buTree IN FRAME DEFAULT-FRAME /* Collapse All */
DO:
DEFINE VARIABLE rRow        AS ROWID       NO-UNDO.
DEFINE VARIABLE iCurrentRow AS INTEGER     NO-UNDO.

DEFINE BUFFER bBrowser FOR TEMP-TABLE ttBrowser.

ASSIGN rRow            = ROWID(ttBrowser)
       iCurrentRow     = brObjects:FOCUSED-ROW.

IF SELF:TOOLTIP = "Expand all":U THEN
DO:
    FOR EACH ttBrowser:
        ASSIGN ttBrowser.lParentExpanded = TRUE.

        IF ttBrowser.cExpanded NE "" THEN
           ASSIGN ttBrowser.cExpanded = "-".

        FOR EACH bBrowser WHERE bBrowser.cParent = ttBrowser.cKey:
            ASSIGN bBrowser.lParentExpanded = TRUE.
        END. /*FOR EACH bBrowser*/

    END.
    ASSIGN SELF:TOOLTIP = "Collapse All":U.
    SELF:LOAD-IMAGE("adeicon/collapseall.gif").
    RUN updateSyncStatus.
END.
ELSE DO:
    FOR EACH ttBrowser WHERE ttBrowser.lParentExpanded = TRUE:

        IF ttBrowser.cExpanded EQ "" AND ttBrowser.cParent NE "" THEN
            ASSIGN ttBrowser.lParentExpanded = FALSE.
        ELSE ASSIGN ttBrowser.cExpanded = IF ttBrowser.cExpanded NE "" THEN "+" ELSE "".

        FOR EACH bBrowser WHERE bBrowser.cParent = ttBrowser.cKey:
               ASSIGN bBrowser.lParentExpanded = FALSE.
        END. /*FOR EACH bBrowser*/
    END.

    ASSIGN SELF:TOOLTIP = "Expand All":U.
    SELF:LOAD-IMAGE("adeicon/expandall.gif").
END.

{&browse-name}:SET-REPOSITIONED-ROW(iCurrentRow,"CONDITIONAL").
{&OPEN-QUERY-{&BROWSE-NAME}}      
REPOSITION {&browse-name}  TO ROWID rRow NO-ERROR.

END.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME


&Scoped-define SELF-NAME coContainer
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL coContainer C-Win
ON VALUE-CHANGED OF coContainer IN FRAME DEFAULT-FRAME /* Container */
DO:
IF NOT checkTransaction() THEN
   RETURN NO-APPLY.
  
RUN fillBrowseTempTable.

{&OPEN-QUERY-{&BROWSE-NAME}}
END.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME


&Scoped-define SELF-NAME m_Assign_Default_Values
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL m_Assign_Default_Values C-Win
ON CHOOSE OF MENU-ITEM m_Assign_Default_Values /* Re-assign Default Values */
DO:
  DEFINE VARIABLE iWidgetID       AS INTEGER   NO-UNDO.
  DEFINE VARIABLE hProcGap        AS HANDLE    NO-UNDO.
  DEFINE VARIABLE isFirstInstance AS LOGICAL   NO-UNDO INITIAL TRUE.
  DEFINE VARIABLE isFirstAction   AS LOGICAL   NO-UNDO INITIAL TRUE.
  DEFINE VARIABLE isFirstPage     AS LOGICAL   NO-UNDO INITIAL TRUE.
  DEFINE VARIABLE isFirstTreeNode AS LOGICAL   NO-UNDO INITIAL TRUE.
  DEFINE VARIABLE cOldObjectType  AS CHARACTER NO-UNDO.

  DEFINE BUFFER bttBrowser FOR ttBrowser.

  RUN adecomm/_widgaps.p PERSISTENT SET hProcGap.

  FOR EACH bttBrowser WHERE bttBrowser.cContainer = coContainer:SCREEN-VALUE IN FRAME {&FRAME-NAME} AND
            bttBrowser.cttName NE ""
            BY bttBrowser.iOrder:

            CASE bttBrowser.cttName:
                WHEN "Action":U THEN
                DO:
                    IF isFirstAction THEN
                        ASSIGN iWidgetID = 0
                               isFirstAction = FALSE.
                    ASSIGN iWidgetID = iWidgetID + DYNAMIC-FUNCTION('getWidgetIDGap':U IN hProcGap, INPUT "SmartToolbarActions":U).
                END.
                WHEN "Pages":U THEN
                DO:
                    IF isFirstPage THEN
                        ASSIGN iWidgetID = 0
                               isFirstPage = FALSE.
                    ASSIGN iWidgetID = iWidgetID + DYNAMIC-FUNCTION('getWidgetIDGap':U IN hProcGap, INPUT "SmartFolderPage":U).
                END.
                WHEN "TreeNode":U THEN
                DO:
                    IF isFirstTreeNode THEN
                        ASSIGN iWidgetID = 0
                               isFirstTreeNode = FALSE.
                    ASSIGN iWidgetID = iWidgetID + DYNAMIC-FUNCTION('getWidgetIDGap':U IN hProcGap, INPUT "TreeNode":U).
                END.
                WHEN "Instance":U THEN
                DO:
                    IF isFirstInstance THEN
                        ASSIGN iWidgetID = 0
                               isFirstInstance = FALSE.

                    FIND FIRST Instance WHERE Instance.contPath = bttBrowser.cContainerPath AND
                                              Instance.contName = bttBrowser.cContainerName AND
                                              Instance.ID       = bttBrowser.cTTFieldID NO-LOCK NO-ERROR.
                         IF NOT AVAILABLE(instance)
                         THEN NEXT.
                    ASSIGN iWidgetID      = iWidgetID + DYNAMIC-FUNCTION('getWidgetIDGap':U IN hProcGap, INPUT IF cOldObjectType = "":U THEN "FRAME":U ELSE cOldObjectType)
                           cOldObjectType = Instance.ObjectType.
                END.
                WHEN "InstanceChildren":U THEN
                DO:
                    FIND FIRST InstanceChildren WHERE InstanceChildren.contPath = bttBrowser.cContainerPath AND
                                                      InstanceChildren.contName = bttBrowser.cContainerName AND
                                                      InstanceChildren.ID       = bttBrowser.cTTName        AND
                                                      InstanceChildren.parentInstanceID = bttBrowser.cParent NO-LOCK.
                    ASSIGN iWidgetID = iWidgetID + DYNAMIC-FUNCTION('getWidgetIDGap':U IN hProcGap, INPUT InstanceChildren.ObjectType).
                END.
            END.

            ASSIGN bttBrowser.cStatus  = "U":U
                   bttBrowser.WidgetID = iWidgetID.
  END.

  {&OPEN-QUERY-{&BROWSE-NAME}}

  IF gcStatus NE "Started":U THEN
    setWidgetStatus("Started":U).
  DELETE OBJECT hProcGap NO-ERROR.
END.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME


&Scoped-define SELF-NAME m_Exit
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL m_Exit C-Win
ON CHOOSE OF MENU-ITEM m_Exit /* Exit */
DO:
  APPLY "WINDOW-CLOSE":U TO c-win.
END.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME


&Scoped-define SELF-NAME m__About_Runtime_Widget-id_As
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL m__About_Runtime_Widget-id_As C-Win
ON CHOOSE OF MENU-ITEM m__About_Runtime_Widget-id_As /*  About Runtime Widget-id Assignment Tool */
DO:
      RUN adecomm/_adehelp.p ( "ptls", "CONTEXT":U, {&WidgetID_Runtime_Assignment_Utility},?).
END.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME


&UNDEFINE SELF-NAME

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _MAIN-BLOCK C-Win 


/* ***************************  Main Block  *************************** */

/* Set CURRENT-WINDOW: this will parent dialog-boxes and frames.        */
ASSIGN CURRENT-WINDOW                = {&WINDOW-NAME} 
       THIS-PROCEDURE:CURRENT-WINDOW = {&WINDOW-NAME}.

/* The CLOSE event can be used from inside or outside the procedure to  */
/* terminate it.                                                        */
ON CLOSE OF THIS-PROCEDURE 
   RUN disable_UI.

/* Best default for GUI applications is...                              */
PAUSE 0 BEFORE-HIDE.

/* Now enable the interface and wait for the exit condition.            */
/* (NOTE: handle ERROR and END-KEY so cleanup code will always fire.    */
MAIN-BLOCK:
DO ON ERROR   UNDO MAIN-BLOCK, LEAVE MAIN-BLOCK
   ON END-KEY UNDO MAIN-BLOCK, LEAVE MAIN-BLOCK:

   RUN enable_UI.
   RUN adecomm/_dswidfunc.p PERSISTENT SET ghDSLibrary.
   setWidgetStatus("ToolEmpty":U).
   coContainer:DELETE(1).
   MENU-ITEM m_AssignonAdd:CHECKED = TRUE.
IF NOT THIS-PROCEDURE:PERSISTENT THEN
    WAIT-FOR CLOSE OF THIS-PROCEDURE.
END.

ON 'LEAVE':U OF ttBrowser.WidgetID
DO:
    IF SELF:MODIFIED THEN
    DO:
        IF INT(SELF:SCREEN-VALUE) > 65535 THEN
        DO:
            MESSAGE 'Widget-id value cannot be greater than 65535'
                VIEW-AS ALERT-BOX INFO BUTTONS OK.
            RETURN NO-APPLY.
        END.

        FIND CURRENT ttBrowser EXCLUSIVE-LOCK.

        ASSIGN ttBrowser.cStatus = "U" 
               ttBrowser.WidgetID = INT(SELF:SCREEN-VALU).

        FIND CURRENT ttBrowser NO-LOCK.

        SELF:MODIFIED = FALSE.
    END. /*IF SELF:MODIFIED THEN*/
END. /*ON 'LEAVE':U OF ttBrowser.WidgetID*/

ON 'ENTRY':U OF ttBrowser.WidgetID
DO:
    IF ttBrowser.cLabel = "Pages":U OR
         ttBrowser.cLabel = "TreeView Nodes":U OR
       ttBrowser.cLabel = "Toolbar Buttons":U OR
       ttBrowser.cLabel = "Instances":U THEN
       RETURN NO-APPLY.
END. /*ON 'ENTRY':U OF ttBrowser.WidgetID*/

ON 'VALUE-CHANGED':U OF ttBrowser.WidgetID
DO:
   IF gcStatus NE "Started":U THEN
    setWidgetStatus("Started":U).
END. /*ON 'LEAVE':U OF ttBrowser.WidgetID*/

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME


/* **********************  Internal Procedures  *********************** */

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE commitTransaction C-Win 
PROCEDURE commitTransaction :
/*------------------------------------------------------------------------------
  Purpose:     
  Parameters:  <none>
  Notes:       
------------------------------------------------------------------------------*/
FOR EACH ttBrowser WHERE ttBrowser.cStatus = "D":U
                   BREAK BY ttBrowser.cContainer:
    IF FIRST-OF(ttBrowser.cContainer) THEN
    DO:
         RUN removeContainer (INPUT ttBrowser.cContainerPath, INPUT ttBrowser.cContainerName, YES).
    END. /*IF FIRST-OF(ttBrowser.cContainer THEN*/

            DELETE ttBrowser.
END.

IF NOT CAN-FIND (FIRST Container) THEN
DO:
   setWidgetStatus("XMLEmpty":U).
   DATASET dsWidgetID:WRITE-XML("FILE", fiXMLFileName:SCREEN-VALUE IN FRAME {&FRAME-NAME}, TRUE).
   RETURN.
END.

IF FOCUS:NAME = "WidgetID":U THEN
DO:
    ASSIGN ttBrowser.WidgetID = INT(FOCUS:SCREEN-VALUE) NO-ERROR.
    APPLY "LEAVE":U TO FOCUS.
END.

DATASET dsWidgetID:ACCEPT-CHANGES().

FOR EACH ttBrowser WHERE ttBrowser.cStatus = "U":U:

    CASE ttBrowser.cTTName:
        WHEN "Pages":U THEN
        DO:
            FIND FIRST Pages WHERE Pages.contName = ttBrowser.cContainerName AND
                                   Pages.contPath = ttBrowser.cContainerPath AND
                                   Pages.PageNumber = INT(ttBrowser.cTTFieldID)
                                   NO-ERROR.

            ASSIGN Pages.WidgetID = ttBrowser.WidgetID.
        END. /*WHEN "Pages":U THEN*/

        WHEN "Action":U THEN
        DO:
            FIND FIRST Action WHERE Action.contName = ttBrowser.cContainerName AND
                                    Action.contPath = ttBrowser.cContainerPath AND
                                    Action.actionID = ttBrowser.cTTFieldID
                                   NO-ERROR.

            ASSIGN Action.WidgetID = ttBrowser.WidgetID.
        END. /*WHEN "Action":U THEN*/

        WHEN "Instance":U THEN
        DO:
            FIND FIRST Instance WHERE Instance.contName = ttBrowser.cContainerName AND
                                      Instance.contPath = ttBrowser.cContainerPath AND
                                      Instance.ID       = ttBrowser.cTTFieldID
                                      NO-ERROR.

            ASSIGN Instance.WidgetID = ttBrowser.WidgetID.
        END. /*WHEN "Instance":U THEN*/

        WHEN "InstanceChildren":U THEN
        DO:
            FIND FIRST InstanceChildren WHERE InstanceChildren.contName         = ttBrowser.cContainerName AND
                                              InstanceChildren.contPath         = ttBrowser.cContainerPath AND
                                              InstanceChildren.ID               = ttBrowser.cTTFieldID     AND
                                              InstanceChildren.parentInstanceID = ttBrowser.cParent
                                              NO-ERROR.

            ASSIGN InstanceChildren.WidgetID = ttBrowser.WidgetID.
        END. /*WHEN "InstanceChildren":U THEN*/
        
        WHEN "TreeNode":U THEN
        DO:
            FIND FIRST TreeNode WHERE TreeNode.contName = ttBrowser.cContainerName AND
                                      TreeNode.contPath = ttBrowser.cContainerPath AND
                                      TreeNode.ID       = ttBrowser.cTTFieldID
                                      NO-ERROR.

            ASSIGN TreeNode.WidgetID = ttBrowser.WidgetID.
        END. /*WHEN "TreeNode":U THEN*/
    END CASE. /*CASE ttBrowser.cTTName:*/

    ASSIGN ttBrowser.cStatus = "":U.
END. /*FOR EACH ttBrowser WHERE ttBrowser.cStatus = "U":U:*/

DATASET dsWidgetID:WRITE-XML("FILE", fiXMLFileName:SCREEN-VALUE IN FRAME {&FRAME-NAME}, TRUE).

setWidgetStatus("Finished":U).

IF coContainer:SCREEN-VALUE NE "" THEN
    APPLY "VALUE-CHANGED":U TO coContainer.
RETURN.
END PROCEDURE.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE deleteContainer C-Win 
PROCEDURE deleteContainer :
/*------------------------------------------------------------------------------
  Purpose: This procedure performs a logical deletion of the container. The
           physical deletion of the container is performed in commitTransaction.
  Parameters:  <none>
  Notes:       
------------------------------------------------------------------------------*/
FOR EACH ttBrowser WHERE ttBrowser.cContainer = coContainer:SCREEN-VALUE IN FRAME {&FRAME-NAME}:
    ASSIGN ttBrowser.cStatus = "D":U.
END.
coContainer:DELETE(coContainer:SCREEN-VALUE).
coContainer:SCREEN-VALUE IN FRAME {&FRAME-NAME} = coContainer:ENTRY(1) NO-ERROR.

{&OPEN-QUERY-{&BROWSE-NAME}}
setWidgetStatus("Started":U).
END PROCEDURE.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE disable_UI C-Win  _DEFAULT-DISABLE
PROCEDURE disable_UI :
/*------------------------------------------------------------------------------
  Purpose:     DISABLE the User Interface
  Parameters:  <none>
  Notes:       Here we clean-up the user-interface by deleting
               dynamic widgets we have created and/or hide 
               frames.  This procedure is usually called when
               we are ready to "clean-up" after running.
------------------------------------------------------------------------------*/
  /* Delete the WINDOW we created */
  IF SESSION:DISPLAY-TYPE = "GUI":U AND VALID-HANDLE(C-Win)
  THEN DELETE WIDGET C-Win.
  IF THIS-PROCEDURE:PERSISTENT THEN DELETE PROCEDURE THIS-PROCEDURE.
END PROCEDURE.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE enable_UI C-Win  _DEFAULT-ENABLE
PROCEDURE enable_UI :
/*------------------------------------------------------------------------------
  Purpose:     ENABLE the User Interface
  Parameters:  <none>
  Notes:       Here we display/view/enable the widgets in the
               user-interface.  In addition, OPEN all queries
               associated with each FRAME and BROWSE.
               These statements here are based on the "Other 
               Settings" section of the widget Property Sheets.
------------------------------------------------------------------------------*/
  DISPLAY fiXMLFileName coContainer 
      WITH FRAME DEFAULT-FRAME IN WINDOW C-Win.
  ENABLE RECT-4 buAdd RECT-5 RECT-8 rcRight rcBrowser rcToolbar fiXMLFileName 
         coContainer brObjects buNew buOpen buTree buSync buCancel buRemove 
         buSave 
      WITH FRAME DEFAULT-FRAME IN WINDOW C-Win.
  {&OPEN-BROWSERS-IN-QUERY-DEFAULT-FRAME}
  VIEW C-Win.
END PROCEDURE.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE fillBrowseTempTable C-Win 
PROCEDURE fillBrowseTempTable :
/*------------------------------------------------------------------------------
  Purpose:     
  Parameters:  <none>
  Notes:       
------------------------------------------------------------------------------*/
DEFINE VARIABLE iOrder AS INTEGER     NO-UNDO.
DEFINE VARIABLE cContainerFile  AS CHARACTER  NO-UNDO.
DEFINE VARIABLE cContainerPath  AS CHARACTER  NO-UNDO.
DEFINE VARIABLE cContainerName  AS CHARACTER  NO-UNDO.

/*Clean the temp-table*/
EMPTY TEMP-TABLE ttBrowser.

ASSIGN cContainerFile = REPLACE(coContainer:SCREEN-VALUE IN FRAME {&FRAME-NAME}, "~\", "/").

IF INDEX(cContainerFile, "/") > 0 THEN
   ASSIGN cContainerPath = SUBSTRING(cContainerFile, 1, R-INDEX(cContainerFile, "/") - 1)
          cContainerName = SUBSTRING(cContainerFile, R-INDEX(cContainerFile, "/") + 1).
ELSE ASSIGN cContainerPath = ""
            cContainerName = cContainerFile.

FOR EACH Container NO-LOCK WHERE Container.contPath = cContainerPath AND
                                 Container.contName = cContainerName:

    IF CAN-FIND(FIRST Pages WHERE Pages.contPath = Container.contPath AND
                                  Pages.contName = Container.contName) THEN
    DO:
        CREATE ttBrowser.
        ASSIGN iOrder                    = iOrder + 1
               ttBrowser.cKey            = "Pages"
               ttBrowser.cLabel          = "Pages"
               ttBrowser.cContainer      = TRIM(Container.contPath + "/" + Container.contName, "/")
               ttBrowser.cContainerName  = Container.contName
               ttBrowser.cContainerPath  = Container.contPath
               ttBrowser.cExpanded       = "-"
               ttBrowser.lParentExpanded = TRUE
               ttBrowser.WidgetID        = 0
               ttBrowser.iOrder          = iOrder
               ttBrowser.cParent         = ""
               ttBrowser.cStatus         = ""
               ttBrowser.cTTName         = ""
               ttBrowser.cTTFieldID      = "".

        FOR EACH Pages NO-LOCK WHERE Pages.contPath = Container.contPath AND
                                     Pages.contName = Container.contName:
            CREATE ttBrowser.
            ASSIGN iOrder                    = iOrder + 1
                   ttBrowser.cKey            = "Page" + STRING(Pages.pageNumber)
                   ttBrowser.cLabel          = FILL(" ", 4) + STRING(Pages.pageNumber) + " (" + Pages.pageLabel + ")"
                   ttBrowser.cContainer      = TRIM(Container.contPath + "/" + Container.contName, "/")
                   ttBrowser.cContainerName  = Container.contName
                   ttBrowser.cContainerPath  = Container.contPath
                   ttBrowser.cExpanded       = ""
                   ttBrowser.lParentExpanded = TRUE
                   ttBrowser.WidgetID        = Pages.WidgetID
                   ttBrowser.iOrder          = iOrder
                   ttBrowser.cParent         = "Pages"
                   ttBrowser.cStatus         = ""
                   ttBrowser.cTTName         = "Pages"
                   ttBrowser.cTTFieldID      = STRING(Pages.pageNumber).
        END. /*FOR EACH Pages NO-LOCK WHERE Pages.parentID = Container.ID:*/

    END. /*IF CAN-FIND(FIRST Pages WHERE Pages.parentID = Container.ID) THEN*/

    IF CAN-FIND(FIRST Action WHERE Action.contPath = Container.contPath AND
                                   Action.contName = Container.contName) THEN
    DO:
        CREATE ttBrowser.
        ASSIGN iOrder                    = iOrder + 100000
               ttBrowser.cKey            = "Actions"
               ttBrowser.cLabel          = "Toolbar Buttons"
               ttBrowser.cContainer      = TRIM(Container.contPath + "/" + Container.contName, "/")
               ttBrowser.cContainerName  = Container.contName
               ttBrowser.cContainerPath  = Container.contPath
               ttBrowser.cExpanded       = "-"
               ttBrowser.lParentExpanded = TRUE
               ttBrowser.WidgetID        = 0
               ttBrowser.iOrder          = iOrder
               ttBrowser.cParent         = ""
               ttBrowser.cStatus         = ""
               ttBrowser.cTTName         = ""
               ttBrowser.cTTFieldID      = "".

        FOR EACH Action NO-LOCK WHERE Action.contPath = Container.contPath AND
                                      Action.contName = Container.contName:
            CREATE ttBrowser.
            ASSIGN iOrder                    = iOrder + 1
                   ttBrowser.cKey            = STRING(Action.actionID)
                   ttBrowser.cLabel          = FILL(" ", 4) + Action.actionID
                   ttBrowser.cContainer      = TRIM(Container.contPath + "/" + Container.contName, "/")
                   ttBrowser.cContainerName  = Container.contName
                   ttBrowser.cContainerPath  = Container.contPath
                   ttBrowser.cExpanded       = ""
                   ttBrowser.lParentExpanded = TRUE
                   ttBrowser.WidgetID        = Action.WidgetID
                   ttBrowser.iOrder          = iOrder
                   ttBrowser.cParent         = "Actions"
                   ttBrowser.cStatus         = ""
                   ttBrowser.cTTName         = "Action"
                   ttBrowser.cTTFieldID      = Action.actionID.
        END. /*FOR EACH Pages NO-LOCK WHERE Pages.parentID = Container.ID:*/
    END. /*IF CAN-FIND(FIRST Action WHERE Action.parentID = Container.ID) THEN*/

    IF CAN-FIND(FIRST Instance WHERE Instance.contPath = Container.contPath AND
                                     Instance.contName = Container.contName) THEN
    DO:
        CREATE ttBrowser.
        ASSIGN iOrder                    = 200000
               ttBrowser.cKey            = "Instances"
               ttBrowser.cLabel          = "Instances"
               ttBrowser.cContainer      = TRIM(Container.contPath + "/" + Container.contName, "/")
               ttBrowser.cContainerName  = Container.contName
               ttBrowser.cContainerPath  = Container.contPath
               ttBrowser.cExpanded       = "-"
               ttBrowser.lParentExpanded = TRUE
               ttBrowser.WidgetID        = 0
               ttBrowser.iOrder          = iOrder
               ttBrowser.cParent         = ""
               ttBrowser.cStatus         = ""
               ttBrowser.cTTName         = ""
               ttBrowser.cTTFieldID      = "".

        FOR EACH Instance  NO-LOCK WHERE Instance.contPath = Container.contPath AND
                                         Instance.contName = Container.contName:

            CREATE ttBrowser.
            ASSIGN iOrder                    = iOrder + 10000
                   ttBrowser.cKey            = Instance.ID
                   ttBrowser.cLabel          = FILL(" ", 4) + Instance.ID
                   ttBrowser.cContainer      = TRIM(Container.contPath + "/" + Container.contName, "/")
                   ttBrowser.cContainerName  = Container.contName
                   ttBrowser.cContainerPath  = Container.contPath
                   ttBrowser.cExpanded       = IF CAN-FIND(FIRST InstanceChildren WHERE InstanceChildren.parentInstanceID = Instance.ID         AND
                                                                                        InstanceChildren.contPath         = Instance.contPath   AND
                                                                                        InstanceChildren.contName         = Instance.contName)  THEN "-" ELSE ""
                   ttBrowser.lParentExpanded = TRUE
                   ttBrowser.WidgetID        = Instance.WidgetID
                   ttBrowser.iOrder          = iOrder
                   ttBrowser.cParent         = "Instances"
                   ttBrowser.cStatus         = ""
                   ttBrowser.cTTName         = "Instance"
                   ttBrowser.cTTFieldID      = Instance.ID.

            FOR EACH InstanceChildren NO-LOCK 
                         WHERE InstanceChildren.parentInstanceID = Instance.ID         AND
                               InstanceChildren.contPath         = Instance.contPath   AND
                               InstanceChildren.contName         = Instance.contName:

                CREATE ttBrowser.
                ASSIGN iOrder                    = iOrder + 1
                       ttBrowser.cKey            = InstanceChildren.ID
                       ttBrowser.cLabel          = FILL(" ", 8) + InstanceChildren.ID
                       ttBrowser.cContainer      = TRIM(Container.contPath + "/" + Container.contName, "/")
                       ttBrowser.cContainerName  = Container.contName
                       ttBrowser.cContainerPath  = Container.contPath
                       ttBrowser.cExpanded       = ""
                       ttBrowser.lParentExpanded = TRUE
                       ttBrowser.WidgetID        = InstanceChildren.WidgetID
                       ttBrowser.iOrder          = iOrder
                       ttBrowser.cParent         = Instance.ID
                       ttBrowser.cStatus         = ""
                       ttBrowser.cTTName         = "InstanceChildren"
                       ttBrowser.cTTFieldID      = InstanceChildren.ID.
            END. /*FOR EACH InstanceChildren NO-LOCK */
        END. /*FOR EACH Instance WHERE Instance.parentID = Container.id NO-LOCK:*/
    END. /*IF CAN-FIND(FIRST Instance WHERE Instance.contID = Container.ID) THEN*/


    IF CAN-FIND(FIRST TreeNode WHERE TreeNode.contPath = Container.contPath AND
                                     TreeNode.contName = Container.contName) THEN
    DO:
        CREATE ttBrowser.
        ASSIGN iOrder                    = 300000
               ttBrowser.cKey            = "TreeNodes":U
               ttBrowser.cLabel          = "TreeView Nodes":U
               ttBrowser.cContainer      = TRIM(Container.contPath + "/" + Container.contName, "/")
               ttBrowser.cContainerName  = Container.contName
               ttBrowser.cContainerPath  = Container.contPath
               ttBrowser.cExpanded       = "-":U
               ttBrowser.lParentExpanded = TRUE
               ttBrowser.WidgetID        = 0
               ttBrowser.iOrder          = iOrder
               ttBrowser.cParent         = "":U
               ttBrowser.cStatus         = "":U
               ttBrowser.cTTName         = "":U
               ttBrowser.cTTFieldID      = "":U.

        FOR EACH TreeNode  NO-LOCK WHERE TreeNode.contPath = Container.contPath AND
                                         TreeNode.contName = Container.contName:

            CREATE ttBrowser.
            ASSIGN iOrder                    = iOrder + 10000
                   ttBrowser.cKey            = TreeNode.ID
                   ttBrowser.cLabel          = FILL(" ", 4) + TreeNode.cLabel
                   ttBrowser.cContainer      = TRIM(Container.contPath + "/" + Container.contName, "/")
                   ttBrowser.cContainerName  = Container.contName
                   ttBrowser.cContainerPath  = Container.contPath
                   ttBrowser.cExpanded       = "":U
                   ttBrowser.lParentExpanded = TRUE
                   ttBrowser.WidgetID        = TreeNode.WidgetID
                   ttBrowser.iOrder          = iOrder
                   ttBrowser.cParent         = "TreeNodes":U
                   ttBrowser.cStatus         = "":U
                   ttBrowser.cTTName         = "TreeNode":U
                   ttBrowser.cTTFieldID      = TreeNode.ID.
        END.
    END.
END. /*FOR EACH Container NO-LOCK*/

RUN updateSyncStatus.
END PROCEDURE.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE fillComboBox C-Win 
PROCEDURE fillComboBox :
/*------------------------------------------------------------------------------
  Purpose:     
  Parameters:  <none>
  Notes:       
------------------------------------------------------------------------------*/
DEFINE INPUT  PARAMETER plFillBrowser AS LOGICAL     NO-UNDO.
/*If we blank the list-item-pairs, then the add-last method raises an error,
  that is why we create a dummy item*/
coContainer:LIST-ITEM-PAIRS IN FRAME {&FRAME-NAME} = "0,0".

FOR EACH Container NO-LOCK:
    coContainer:ADD-FIRST(Container.contPath + (IF Container.contPath NE "" THEN "/" ELSE "") + Container.contName + " (" + Container.ObjectType + ")", Container.contPath + (IF Container.contPath NE "" THEN "/" ELSE "") + Container.contName).
END.

IF plFillBrowser THEN
RUN fillBrowseTempTable.

coContainer:DELETE("0") IN FRAME {&FRAME-NAME} NO-ERROR.
coContainer:SCREEN-VALUE IN FRAME {&FRAME-NAME} = coContainer:ENTRY(1) NO-ERROR.

END PROCEDURE.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE loadXML C-Win 
PROCEDURE loadXML :
/*------------------------------------------------------------------------------
  Purpose:     
  Parameters:  <none>
  Notes:       
------------------------------------------------------------------------------*/
DEFINE INPUT  PARAMETER pcXMLFileName AS CHARACTER   NO-UNDO.

DEFINE VARIABLE lOk AS LOGICAL     NO-UNDO.

IF NOT checkTransaction() THEN
   RETURN ERROR.

ASSIGN lOk = DATASET dsWidgetID:READ-XML("FILE":U, pcXMLFileName, "EMPTY":U, ?, FALSE) NO-ERROR.

IF NOT lOk THEN
DO:
    MESSAGE "The XML file cannot be loaded."
        VIEW-AS ALERT-BOX INFO BUTTONS OK.
    RETURN ERROR.
END.

RUN fillComboBox (TRUE).
fiXMLFileName:SCREEN-VALUE IN FRAME {&FRAME-NAME} = pcXMLFileName.
setWidgetStatus("Finished").
APPLY "VALUE-CHANGED":U TO coContainer.
END PROCEDURE.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE removeContainer C-Win 
PROCEDURE removeContainer :
/*------------------------------------------------------------------------------
  Purpose:     
  Parameters:  <none>
  Notes:       
------------------------------------------------------------------------------*/
DEFINE INPUT PARAMETER pcPath            AS CHARACTER NO-UNDO.
DEFINE INPUT PARAMETER pcName            AS CHARACTER NO-UNDO.
DEFINE INPUT PARAMETER plDeleteContainer AS LOGICAL   NO-UNDO.

FIND FIRST Container WHERE Container.contPath = pcPath AND
                           Container.contName = pcName.
FOR EACH Instances OF Container:
    DELETE Instances.
END.
FOR EACH Instance OF Container:
    DELETE Instance.
END.
FOR EACH InstanceChildren OF Container:
    DELETE InstanceChildren.
END.
FOR EACH ParentPages OF Container:
    DELETE ParentPages.
END.
FOR EACH Pages OF Container:
    DELETE Pages.
END.
FOR EACH Actions OF Container:
    DELETE Actions.
END.
FOR EACH Action OF Container:
    DELETE Action.
END.

IF plDeleteContainer THEN
    DELETE Container.
END PROCEDURE.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE syncDynObject C-Win 
PROCEDURE syncDynObject :
/*------------------------------------------------------------------------------
  Purpose:     
  Parameters:  <none>
  Notes:       
------------------------------------------------------------------------------*/
DEFINE OUTPUT PARAMETER plChanged AS LOGICAL NO-UNDO.

DEFINE VARIABLE cPropertyNames  AS CHARACTER NO-UNDO.
DEFINE VARIABLE cPropertyValues AS CHARACTER NO-UNDO.
DEFINE VARIABLE dObjectID       AS DECIMAL   NO-UNDO.
DEFINE VARIABLE cObjectType     AS CHARACTER NO-UNDO.
DEFINE VARIABLE cRootNodeCode   AS CHARACTER NO-UNDO.
DEFINE VARIABLE cFile           AS CHARACTER NO-UNDO.
DEFINE VARIABLE cPath           AS CHARACTER NO-UNDO.
DEFINE VARIABLE cInstances      AS CHARACTER NO-UNDO.
DEFINE VARIABLE iItems          AS INTEGER   NO-UNDO.
DEFINE VARIABLE iItem           AS INTEGER   NO-UNDO.
DEFINE VARIABLE cItem           AS CHARACTER NO-UNDO.
DEFINE VARIABLE iLastPage       AS INTEGER   NO-UNDO.
DEFINE VARIABLE cActions        AS CHARACTER NO-UNDO.
DEFINE VARIABLE cNodes          AS CHARACTER NO-UNDO.

TEMP-TABLE Pages:TRACKING-CHANGES            = TRUE.
TEMP-TABLE Action:TRACKING-CHANGES           = TRUE.
TEMP-TABLE Instance:TRACKING-CHANGES         = TRUE.
TEMP-TABLE TreeNode:TRACKING-CHANGES         = TRUE.
TEMP-TABLE InstanceChildren:TRACKING-CHANGES = TRUE.

    /*Gets the class name and instanceID for the current container*/
    ASSIGN cPropertyNames = "ClassName,InstanceId,RootNodeCode":U.
    RUN getInstanceProperties IN gshRepositoryManager (
        INPUT        coContainer:SCREEN-VALUE IN FRAME {&FRAME-NAME},
        INPUT        "", 
        INPUT-OUTPUT cPropertyNames,
              OUTPUT cPropertyValues) NO-ERROR.

    ASSIGN dObjectId     = DECIMAL(ENTRY(LOOKUP("InstanceId":U, cPropertyNames), cPropertyValues, CHR(1)))
           cObjectType   = ENTRY(LOOKUP("ClassName":U, cPropertyNames), cPropertyValues, CHR(1))
           cRootNodeCode = IF CAN-DO(cPropertyNames, "RootNodeCode":U) THEN ENTRY(LOOKUP("RootNodeCode":U, cPropertyNames), cPropertyValues, CHR(1)) ELSE "".

    /*Get the object instance to later check for deletions*/
    RUN getContainedInstanceNames IN gshRepositoryManager (
        INPUT  coContainer:SCREEN-VALUE,
        OUTPUT cInstances) NO-ERROR.

    DYNAMIC-FUNCTION('createDynContainerDetails':U IN ghDSLibrary,
        INPUT  coContainer:SCREEN-VALUE,
        INPUT  dObjectId,
        INPUT  cRootNodeCode,
        INPUT  MENU-ITEM m_AssignonAdd:CHECKED IN MENU MENU-BAR-C-Win,
        INPUT  DATASET dsWidgetID BY-REFERENCE,
        OUTPUT iLastPage,
        OUTPUT plChanged,
        OUTPUT cNodes,
        INPUT-OUTPUT cActions).

    /*Check if instance were deleted*/
    FOR EACH Instance WHERE Instance.contPath = "":U AND
                            Instance.contName = coContainer:SCREEN-VALUE:
        IF NOT CAN-DO(cInstances, Instance.ID) THEN
        DO:
            DELETE Instance.
            ASSIGN plChanged = TRUE.
        END.
    END. /*FOR EACH Instance WHERE Instance.contPath = "":U*/

    /*Check for deleted actions*/
    FOR EACH Action WHERE Action.contPath = "" AND
                          Action.contName = coContainer:SCREEN-VALUE:

        IF NOT CAN-DO(cActions, Action.actionID) THEN
        DO:
            DELETE Action.
            ASSIGN plChanged = TRUE.
        END.
    END. /* Action WHERE Action.contPath = "" AND */

    /*Check if some Page was deleted from the container*/
    FOR EACH Pages WHERE Pages.contPath = "":U AND
                         Pages.contName = coContainer:SCREEN-VALUE AND
                         Pages.pageNumber GT iLastPage:
            DELETE Pages.
            ASSIGN plChanged = TRUE.
    END. /*FOR EACH Pages WHERE Pages.contPath = "":U AND*/

    FOR EACH TreeNode WHERE TreeNode.contPath = "":U AND
                            TreeNode.contName = coContainer:SCREEN-VALUE:
        IF NOT CAN-DO(cNodes, TreeNode.ID) THEN
        DO:
            DELETE TreeNode.
            ASSIGN plChanged = TRUE.
        END.
    END.

TEMP-TABLE Pages:TRACKING-CHANGES            = FALSE.
TEMP-TABLE Action:TRACKING-CHANGES           = FALSE.
TEMP-TABLE Instance:TRACKING-CHANGES         = FALSE.
TEMP-TABLE TreeNode:TRACKING-CHANGES         = FALSE.
TEMP-TABLE InstanceChildren:TRACKING-CHANGES = FALSE.

RETURN.
END PROCEDURE.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE syncRuntimeObject C-Win 
PROCEDURE syncRuntimeObject :
/*------------------------------------------------------------------------------
    Purpose: Gets runtime objects information and compare it with the XML file
             information.
    Parameters: <none>
    Notes: This procedure is called from the Synchronization button (buSync) if
           the AppBuilder is not running, or if the AppBuilder is running but
           the object is in run mode.
------------------------------------------------------------------------------*/
DEFINE OUTPUT PARAMETER plChanged AS LOGICAL    NO-UNDO.

DEFINE VARIABLE cObjectName     AS CHARACTER NO-UNDO.
DEFINE VARIABLE lStatic         AS LOGICAL   NO-UNDO.

RUN getRuntimeObjectNames IN ghDSLibrary (INPUT SESSION:FIRST-CHILD, INPUT "":U, INPUT-OUTPUT TABLE ttObjectNames).

FIND FIRST ttObjectNames WHERE ttObjectNames.cName = coContainer:SCREEN-VALUE IN FRAME {&FRAME-NAME} NO-LOCK NO-ERROR.

{get LogicalObjectName cObjectName ttObjectNames.hHandle} NO-ERROR.
ASSIGN lStatic = (cObjectName = "":U OR cObjectName = ?).

    IF NOT AVAILABLE(ttObjectNames) THEN
    DO:
        MESSAGE "Container '" + coContainer:SCREEN-VALUE + "' must be opened in the AppBuilder, or executed before to use this feature."
            VIEW-AS ALERT-BOX INFO BUTTONS OK.
        RETURN.
    END.

    IF lStatic THEN
        RUN syncStaticObject (OUTPUT plChanged).
    ELSE
        RUN syncDynObject (OUTPUT plChanged).

RETURN.
END PROCEDURE.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE syncStaticObject C-Win 
PROCEDURE syncStaticObject :
/*------------------------------------------------------------------------------
    Purpose:
    Parameters: <none>
    Notes:
------------------------------------------------------------------------------*/
DEFINE OUTPUT PARAMETER plChanged AS LOGICAL    NO-UNDO.

DEFINE VARIABLE tmpChanged      AS LOGICAL    NO-UNDO.
DEFINE VARIABLE cObjectName     AS CHARACTER NO-UNDO.
DEFINE VARIABLE lStatic         AS LOGICAL   NO-UNDO.
DEFINE VARIABLE cInstances      AS CHARACTER NO-UNDO.
DEFINE VARIABLE iInstances      AS INTEGER   NO-UNDO.
DEFINE VARIABLE iInstance       AS INTEGER   NO-UNDO.
DEFINE VARIABLE lIsVisual       AS LOGICAL   NO-UNDO.
DEFINE VARIABLE hInstance       AS HANDLE    NO-UNDO.
DEFINE VARIABLE cActions        AS CHARACTER NO-UNDO.
DEFINE VARIABLE iField          AS INTEGER    NO-UNDO.
DEFINE VARIABLE cField          AS CHARACTER  NO-UNDO.
DEFINE VARIABLE cFields         AS CHARACTER  NO-UNDO.
DEFINE VARIABLE cPath           AS CHARACTER NO-UNDO.
DEFINE VARIABLE cFile           AS CHARACTER NO-UNDO.
DEFINE VARIABLE lDuplicateNames AS LOGICAL   NO-UNDO.
DEFINE VARIABLE iLastPage       AS INTEGER   NO-UNDO.
DEFINE VARIABLE iTempPages      AS INTEGER    NO-UNDO.
DEFINE VARIABLE iLastWidgetID   AS INTEGER   NO-UNDO.
DEFINE VARIABLE cOldObjectType  AS CHARACTER NO-UNDO.
DEFINE VARIABLE cInstanceNames  AS CHARACTER NO-UNDO.
DEFINE VARIABLE cInstanceID     AS CHARACTER  NO-UNDO.

RUN getRuntimeObjectNames IN ghDSLibrary (INPUT SESSION:FIRST-CHILD, INPUT "":U, INPUT-OUTPUT TABLE ttObjectNames).

FIND FIRST ttObjectNames WHERE ttObjectNames.cName = coContainer:SCREEN-VALUE IN FRAME {&FRAME-NAME} NO-LOCK NO-ERROR.

{get LogicalObjectName cObjectName ttObjectNames.hHandle} NO-ERROR.
ASSIGN lStatic = (cObjectName = "":U OR cObjectName = ?).

TEMP-TABLE Pages:TRACKING-CHANGES            = TRUE.
TEMP-TABLE Action:TRACKING-CHANGES           = TRUE.
TEMP-TABLE Instance:TRACKING-CHANGES         = TRUE.
TEMP-TABLE TreeNode:TRACKING-CHANGES         = TRUE.
TEMP-TABLE InstanceChildren:TRACKING-CHANGES = TRUE.
        
{get ContainerTarget cInstances ttObjectNames.hHandle}.

    IF NOT AVAILABLE(ttObjectNames) THEN
    DO:
        MESSAGE "Container '" + coContainer:SCREEN-VALUE + "' must be opened in the AppBuilder, or executed before to use this feature."
            VIEW-AS ALERT-BOX INFO BUTTONS OK.
        RETURN.
    END.

    DYNAMIC-FUNCTION('splitFileName':U IN ghDSLibrary, INPUT coContainer:SCREEN-VALUE, OUTPUT cPath, OUTPUT cFile).

        ASSIGN iInstances = NUM-ENTRIES(cInstances).

        REPEAT iInstance = 1 TO iInstances:

            ASSIGN hInstance   = WIDGET-HANDLE(ENTRY(iInstance, cInstances))
                   lIsVisual   = DYNAMIC-FUNCTION('instanceOf' IN hInstance, INPUT "visual":U) NO-ERROR.

            IF NOT lIsVisual OR lIsVisual = ? THEN
                NEXT.

            /*Get all the instance names to later check if some instance was deleted.*/
            {get ObjectName cInstanceID hInstance}.
            ASSIGN cInstanceNames = cInstanceNames + cInstanceID + ",":U
                   iTempPages     = iLastPage.

            /*Get the Instance Children to later check for deletions.*/
            IF DYNAMIC-FUNCTION('instanceOf' IN hInstance, INPUT "Filter":U) THEN
            DO: 
                {get DisplayedFields cFields hInstance}.
                REPEAT iField = 1 TO NUM-ENTRIES(cFields):
                    ASSIGN cField = ENTRY(iField, cFields).

                    CREATE beforeInstanceChildren.
                    ASSIGN beforeInstanceChildren.ID               = cField
                           beforeInstanceChildren.contPath         = cPath
                           beforeInstanceChildren.contName         = cFile
                           beforeInstanceChildren.parentInstanceID = cInstanceID
                           beforeInstanceChildren.ObjectType       = "SmartFilterField":U.

                END.
            END.

            DYNAMIC-FUNCTION('createContainerDetails':U IN ghDSLibrary,
                INPUT cFile,
                INPUT cPath,
                INPUT hInstance,
                INPUT cInstanceID,
                INPUT TRUE,
                INPUT MENU-ITEM m_AssignonAdd:CHECKED IN MENU MENU-BAR-C-Win,
                INPUT DATASET dsWidgetID BY-REFERENCE,
                OUTPUT lDuplicateNames,
                OUTPUT iTempPages,
                OUTPUT tmpChanged,
                INPUT-OUTPUT cActions,
                INPUT-OUTPUT iLastWidgetID,
                INPUT-OUTPUT cOldObjectType).
                
                IF tmpChanged = TRUE AND plChanged = FALSE THEN
                    ASSIGN plChanged = TRUE.
                IF iTempPages > iLastPage THEN
                    ASSIGN iLastPage = iTempPages. 
        END. /*REPEAT iInstance = 1 TO iInstances:*/

        /*If we have actions, we have to create them*/
        IF cActions NE "" THEN
        DO:
            DYNAMIC-FUNCTION('createActions':U IN ghDSLibrary,
                INPUT cFile,
                INPUT cPath,
                INPUT cActions,
                INPUT DATASET dsWidgetID BY-REFERENCE).
        END. /*IF cActions NE "" THEN*/

        ASSIGN cInstanceNames = TRIM(cInstanceNames, ",").
        FOR EACH Instance WHERE Instance.contPath = cPath AND
                                Instance.contName = cFile:

            IF NOT CAN-DO(cInstanceNames, Instance.ID) THEN
            DO:
                DELETE Instance.
                ASSIGN plChanged = TRUE.
            END.
        END. /*FOR EACH Instance WHERE Instance.contPath = "":U*/

        /*Remove the deleted instance children.*/
        FOR EACH InstanceChildren WHERE InstanceChildren.contPath = cPath AND
                                        InstanceChildren.contName = cFile:
            IF NOT CAN-FIND(beforeInstanceChildren WHERE
                            beforeInstanceChildren.contPath         = InstanceChildren.contPath AND
                            beforeInstanceChildren.contName         = InstanceChildren.contName AND
                            beforeInstanceChildren.parentInstanceID = InstanceChildren.parentInstanceID AND
                            beforeInstanceChildren.ID               = InstanceChildren.ID) THEN
            DO:
                DELETE InstanceChildren.
                ASSIGN plChanged = TRUE.
            END.
        END. /* FOR EACH InstanceChildren WHERE InstanceChildren.contPath = cPath AND */

        /*Check for deleted actions*/
        FOR EACH Action WHERE Action.contPath = cPath AND
                              Action.contName = cFile:

            IF NOT CAN-DO(cActions, Action.actionID) THEN
            DO:
                DELETE Action.
                ASSIGN plChanged = TRUE.
            END.
        END. /* Action WHERE Action.contPath = "" AND */

        /*Check if some Page was deleted from the container*/
        FOR EACH Pages WHERE Pages.contPath = cPath AND
                             Pages.contName = cFile AND
                             Pages.pageNumber GT iLastPage:
                DELETE Pages.
                ASSIGN plChanged = TRUE.
        END. /*FOR EACH Pages WHERE Pages.contPath = "":U AND*/

TEMP-TABLE Pages:TRACKING-CHANGES            = FALSE.
TEMP-TABLE Action:TRACKING-CHANGES           = FALSE.
TEMP-TABLE Instance:TRACKING-CHANGES         = FALSE.
TEMP-TABLE TreeNode:TRACKING-CHANGES         = FALSE.
TEMP-TABLE InstanceChildren:TRACKING-CHANGES = FALSE.
EMPTY TEMP-TABLE beforeInstanceChildren.
RETURN.
END PROCEDURE.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE undoTransaction C-Win 
PROCEDURE undoTransaction :
/*------------------------------------------------------------------------------
  Purpose:     
  Parameters:  <none>
  Notes:       
------------------------------------------------------------------------------*/
DATASET dsWidgetID:REJECT-CHANGES().

FOR EACH ttBrowser WHERE ttBrowser.cStatus = "D":U
                         BREAK BY ttBrowser.cContainer:
    IF FIRST-OF(ttBrowser.cContainer) THEN
    DO:
        FIND FIRST Container WHERE Container.contPath = ttBrowser.cContainerPath AND
                                   Container.contName = ttBrowser.cContainerName
                                   NO-LOCK NO-ERROR.
           coContainer:ADD-FIRST(Container.contPath + (IF Container.contPath = "" THEN "" ELSE "/") + Container.contName + " (" + Container.ObjectType + ")", (Container.contPath + (IF Container.contPath = "" THEN "" ELSE "/") + Container.contName)) IN FRAME {&FRAME-NAME}.
           ASSIGN coContainer:SCREEN-VALUE = ttBrowser.cContainer.
    END.
END.

setWidgetStatus("Finished":U).
APPLY "VALUE-CHANGED":U TO coContainer.
END PROCEDURE.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE updateSyncStatus C-Win 
PROCEDURE updateSyncStatus :
/*--------------------------------------------------------------------------------
  Purpose: This procedure detects if objects were added or deleted from the
           container.
  Parameters:  <none>
  Notes: This works for Container Instances, Instance Children, TreeNodes, Pages
         and Toolbar Actions.
         If one of those items were added (ROW-STATE(<table>)) = 3, this is
         marked with ">". But if an item is removed (ROW-STATE(before_table) = 1),
         this is marked as "<", this is for information only, after the updates
         are saved, the deleted items are removed from the browser.
--------------------------------------------------------------------------------*/
DEFINE VARIABLE iLastBrowser AS INTEGER NO-UNDO.

/*Checks for new added objects*/
FOR EACH Instance WHERE ROW-STATE(Instance) = 3:
    FIND FIRST ttBrowser WHERE ttBrowser.cTTName = "Instance":U AND
                               ttBrowser.cTTFieldID = Instance.ID. 
    ASSIGN ttBrowser.cExpanded = ">".
END.

FOR EACH InstanceChildren WHERE ROW-STATE(InstanceChildren) = 3:
    FIND FIRST ttBrowser WHERE ttBrowser.cTTName = "InstanceChildren":U AND
                               ttBrowser.cTTFieldID = InstanceChildren.ID AND
                               ttBrowser.cParent = InstanceChildren.parentInstanceID. 
    ASSIGN ttBrowser.cExpanded = ">".
END.

FOR EACH Action WHERE ROW-STATE(Action) = 3:
    FIND FIRST ttBrowser WHERE ttBrowser.cTTName = "Action":U AND
                               ttBrowser.cTTFieldID = Action.actionID. 
    ASSIGN ttBrowser.cExpanded = ">".
END.

FOR EACH Pages WHERE ROW-STATE(Pages) = 3:
    FIND FIRST ttBrowser WHERE ttBrowser.cTTName = "Pages":U AND
                               ttBrowser.cTTFieldID = STRING(Pages.pageNumber). 
    ASSIGN ttBrowser.cExpanded = ">".
END.

FOR EACH TreeNode WHERE ROW-STATE(TreeNode) = 3:
    FIND FIRST ttBrowser WHERE ttBrowser.cTTName = "TreeNode":U AND
                               ttBrowser.cTTFieldID = TreeNode.ID. 
    ASSIGN ttBrowser.cExpanded = ">".
END.

/*Checks for deleted objects*/
/*DELETED ACTIONS*/
FOR EACH before_action WHERE ROW-STATE(before_Action) = 1:
    FIND FIRST ttBrowser WHERE ttBrowser.cTTName = "Action":U AND
                               ttBrowser.cTTFieldID = before_Action.actionID NO-ERROR.
    IF AVAILABLE(ttBrowser) THEN
    DO:
        ASSIGN ttBrowser.cExpanded = "<".
        NEXT.
    END.

    FIND LAST ttBrowser WHERE ttBrowser.cTTName = "Action" NO-LOCK NO-ERROR.
    IF AVAILABLE(ttBrowser) THEN
        ASSIGN iLastBrowser = IF iLastBrowser NE 0 THEN iLastBrowser + 1 ELSE ttBrowser.iOrder + 1.
    ELSE ASSIGN iLastBrowser = 100001.

    /*The procedure fillBrowseTempTable does not create the Actions parent node, if there are not Actions in the container.
      So this procedure has to create the Actions parent node, just to show the Actions that were deleted in the right place.*/
    IF NOT CAN-FIND(FIRST ttBrowser WHERE ttBrowser.cContainerPath = before_action.contPath AND
                                          ttBrowser.cContainerName = before_action.contName AND
                                          ttBrowser.cKey           = "Actions":U) THEN
    DO:
        CREATE ttBrowser.
        ASSIGN iOrder                    = iLastBrowser
               ttBrowser.cKey            = "Actions"
               ttBrowser.cLabel          = "Toolbar Buttons"
               ttBrowser.cContainer      = coContainer:SCREEN-VALUE IN FRAME {&FRAME-NAME}
               ttBrowser.cContainerName  = before_action.contName
               ttBrowser.cContainerPath  = before_action.contPath
               ttBrowser.cExpanded       = "-"
               ttBrowser.lParentExpanded = TRUE
               ttBrowser.WidgetID        = 0
               ttBrowser.iOrder          = iOrder
               ttBrowser.cParent         = ""
               ttBrowser.cStatus         = ""
               ttBrowser.cTTName         = ""
               ttBrowser.cTTFieldID      = "".
    END.

    CREATE ttBrowser.
    ASSIGN iOrder                    = iLastBrowser
           ttBrowser.cKey            = STRING(before_action.actionID)
           ttBrowser.cLabel          = FILL(" ", 4) + before_action.actionID
           ttBrowser.cContainer      = coContainer:SCREEN-VALUE IN FRAME {&FRAME-NAME}
           ttBrowser.cExpanded       = "<"
           ttBrowser.lParentExpanded = TRUE
           ttBrowser.WidgetID        = before_action.WidgetID
           ttBrowser.iOrder          = iOrder
           ttBrowser.cParent         = "Actions"
           ttBrowser.cStatus         = ""
           ttBrowser.cTTName         = "Action"
           ttBrowser.cTTFieldID      = before_action.actionID.
END. /* FOR EACH before_action WHERE ROW-STATE(before_Action) = 1: */

/*DELETED TREENODES*/
ASSIGN iLastBrowser = 0.
FOR EACH before_TreeNode WHERE ROW-STATE(before_TreeNode) = 1:
    FIND FIRST ttBrowser WHERE ttBrowser.cTTName = "TreeNode":U AND
                               ttBrowser.cTTFieldID = STRING(before_TreeNode.ID) NO-ERROR.
    IF AVAILABLE(ttBrowser) THEN
    DO:
        ASSIGN ttBrowser.cExpanded = "<".
        NEXT.
    END.

    FIND LAST ttBrowser WHERE ttBrowser.cTTName = "TreeNode" NO-LOCK NO-ERROR.
    IF AVAILABLE(ttBrowser) THEN
        ASSIGN iLastBrowser = IF iLastBrowser NE 0 THEN iLastBrowser + 1 ELSE ttBrowser.iOrder + 1.
    ELSE ASSIGN iLastBrowser = 300001.

    /*The procedure fillBrowseTempTable does not create the parentPages node, if there are not pages in the container.
      So this procedure has to create the parentPage node, just to show the pages that were deleted in the right place.*/
    IF NOT CAN-FIND(FIRST ttBrowser WHERE ttBrowser.cContainerPath = before_TreeNode.contPath AND
                                          ttBrowser.cContainerName = before_TreeNode.contName AND
                                          ttBrowser.cKey           = "TreeNodes":U) THEN
    DO:
        CREATE ttBrowser.
        ASSIGN iOrder                    = iLastBrowser
               ttBrowser.cKey            = "TreeNodes"
               ttBrowser.cLabel          = "TreeView Nodes":U
               ttBrowser.cContainer      = coContainer:SCREEN-VALUE IN FRAME {&FRAME-NAME}
               ttBrowser.cContainerName  = before_TreeNode.contName
               ttBrowser.cContainerPath  = before_TreeNode.contPath
               ttBrowser.cExpanded       = "-"
               ttBrowser.lParentExpanded = TRUE
               ttBrowser.WidgetID        = 0
               ttBrowser.iOrder          = iOrder
               ttBrowser.cParent         = ""
               ttBrowser.cStatus         = ""
               ttBrowser.cTTName         = ""
               ttBrowser.cTTFieldID      = "".
    END.

    CREATE ttBrowser.
    ASSIGN iOrder                    = iLastBrowser + 1
           ttBrowser.cKey            = before_TreeNode.ID
           ttBrowser.cLabel          = FILL(" ", 4) + before_TreeNode.cLabel
           ttBrowser.cContainer      = coContainer:SCREEN-VALUE IN FRAME {&FRAME-NAME}
           ttBrowser.cContainerName  = before_TreeNode.contName
           ttBrowser.cContainerPath  = before_TreeNode.contPath
           ttBrowser.cExpanded       = "<":U
           ttBrowser.lParentExpanded = TRUE
           ttBrowser.WidgetID        = before_TreeNode.WidgetID
           ttBrowser.iOrder          = iOrder
           ttBrowser.cParent         = "TreeNodes":U
           ttBrowser.cStatus         = "":U
           ttBrowser.cTTName         = "TreeNode":U
           ttBrowser.cTTFieldID      = before_TreeNode.ID.
END. /*FOR EACH before_pages WHERE ROW-STATE(before_Pages) = 1:*/

/*DELETED PAGES*/
ASSIGN iLastBrowser = 0.
FOR EACH before_Pages WHERE ROW-STATE(before_Pages) = 1:
    FIND FIRST ttBrowser WHERE ttBrowser.cTTName = "Pages":U AND
                               ttBrowser.cTTFieldID = STRING(before_Pages.pageNumber) NO-ERROR.
    IF AVAILABLE(ttBrowser) THEN
    DO:
        ASSIGN ttBrowser.cExpanded = "<".
        NEXT.
    END.

    FIND LAST ttBrowser WHERE ttBrowser.cTTName = "Pages" NO-LOCK NO-ERROR.
    IF AVAILABLE(ttBrowser) THEN
        ASSIGN iLastBrowser = IF iLastBrowser NE 0 THEN iLastBrowser + 1 ELSE ttBrowser.iOrder + 1.
    ELSE ASSIGN iLastBrowser = 1.

    /*The procedure fillBrowseTempTable does not create the parentPages node, if there are not pages in the container.
      So this procedure has to create the parentPage node, just to show the pages that were deleted in the right place.*/
    IF NOT CAN-FIND(FIRST ttBrowser WHERE ttBrowser.cContainerPath = before_Pages.contPath AND
                                          ttBrowser.cContainerName = before_Pages.contName AND
                                          ttBrowser.cKey           = "Pages":U) THEN
    DO:
        CREATE ttBrowser.
        ASSIGN iOrder                    = iLastBrowser
               ttBrowser.cKey            = "Pages"
               ttBrowser.cLabel          = "Pages"
               ttBrowser.cContainer      = coContainer:SCREEN-VALUE IN FRAME {&FRAME-NAME}
               ttBrowser.cContainerName  = before_Pages.contName
               ttBrowser.cContainerPath  = before_Pages.contPath
               ttBrowser.cExpanded       = "-"
               ttBrowser.lParentExpanded = TRUE
               ttBrowser.WidgetID        = 0
               ttBrowser.iOrder          = iOrder
               ttBrowser.cParent         = ""
               ttBrowser.cStatus         = ""
               ttBrowser.cTTName         = ""
               ttBrowser.cTTFieldID      = "".
    END.

    CREATE ttBrowser.
    ASSIGN iOrder                    = iLastBrowser + 1
           ttBrowser.cKey            = "Page" + STRING(before_Pages.pageNumber)
           ttBrowser.cLabel          = FILL(" ", 4) + STRING(before_Pages.pageNumber) /*+ " (" + before_Pages.pageLabel + ")"*/
           ttBrowser.cContainer      = coContainer:SCREEN-VALUE IN FRAME {&FRAME-NAME}
           ttBrowser.cContainerName  = before_Pages.contName
           ttBrowser.cContainerPath  = before_Pages.contPath
           ttBrowser.cExpanded       = "<"
           ttBrowser.lParentExpanded = TRUE
           ttBrowser.WidgetID        = before_Pages.WidgetID
           ttBrowser.iOrder          = iOrder
           ttBrowser.cParent         = "Pages"
           ttBrowser.cStatus         = ""
           ttBrowser.cTTName         = "Pages"
           ttBrowser.cTTFieldID      = STRING(before_Pages.pageNumber).
END. /*FOR EACH before_pages WHERE ROW-STATE(before_Pages) = 1:*/

/*DELETE INSTANCES*/
ASSIGN iLastBrowser = 0.
FOR EACH before_Instance WHERE ROW-STATE(before_Instance) = 1:
    FIND FIRST ttBrowser WHERE ttBrowser.cTTName = "Instance":U AND
                               ttBrowser.cTTFieldID = before_Instance.ID NO-ERROR.
    IF AVAILABLE(ttBrowser) THEN
    DO:
        ASSIGN ttBrowser.cExpanded = "<".
        NEXT.
    END.

    FIND LAST ttBrowser WHERE ttBrowser.cTTName = "Instance" NO-LOCK NO-ERROR.
    IF AVAILABLE(ttBrowser) THEN
        ASSIGN iLastBrowser = IF iLastBrowser NE 0 THEN iLastBrowser + 1 ELSE ttBrowser.iOrder + 1.
    ELSE ASSIGN iLastBrowser =  200001.

    /*The procedure fillBrowseTempTable does not create the Instance parent node, if there are not instances in the container.
      So this procedure has to create the Instance parent node, just to show the Instances that were deleted in the right place.*/
    IF NOT CAN-FIND(FIRST ttBrowser WHERE ttBrowser.cContainerPath = before_Instance.contPath AND
                                          ttBrowser.cContainerName = before_Instance.contName AND
                                          ttBrowser.cKey           = "Instances":U) THEN
    DO:
        CREATE ttBrowser.
        ASSIGN iOrder                    = iLastBrowser
               ttBrowser.cKey            = "Instances"
               ttBrowser.cLabel          = "Instances"
               ttBrowser.cContainer      = coContainer:SCREEN-VALUE IN FRAME {&FRAME-NAME}
               ttBrowser.cContainerName  = before_Instance.contName
               ttBrowser.cContainerPath  = before_Instance.contPath
               ttBrowser.cExpanded       = "-"
               ttBrowser.lParentExpanded = TRUE
               ttBrowser.WidgetID        = 0
               ttBrowser.iOrder          = iOrder
               ttBrowser.cParent         = ""
               ttBrowser.cStatus         = ""
               ttBrowser.cTTName         = ""
               ttBrowser.cTTFieldID      = "".
    END.

    CREATE ttBrowser.
    ASSIGN iOrder                    = iLastBrowser
           ttBrowser.cKey            = before_Instance.ID
           ttBrowser.cLabel          = FILL(" ", 4) + before_Instance.ID
           ttBrowser.cContainer      = coContainer:SCREEN-VALUE IN FRAME {&FRAME-NAME}
           ttBrowser.cExpanded       = "<"
           ttBrowser.lParentExpanded = TRUE
           ttBrowser.WidgetID        = before_Instance.WidgetID
           ttBrowser.iOrder          = iOrder
           ttBrowser.cParent         = "Instances"
           ttBrowser.cStatus         = ""
           ttBrowser.cTTName         = "Instance"
           ttBrowser.cTTFieldID      = before_Instance.ID.

    /*DELETED INSTANCE CHILDREN*/
    FOR EACH before_InstanceChildren WHERE before_InstanceChildren.contPath         = before_Instance.contPath AND
                                           before_InstanceChildren.contName         = before_Instance.contName AND
                                           before_InstanceChildren.parentInstanceID = before_Instance.ID
                                           NO-LOCK:
        FIND FIRST ttBrowser WHERE ttBrowser.cTTName = "InstanceChildren":U AND
                                   ttBrowser.cParent = before_InstanceChildren.parentInstanceID AND
                                   ttBrowser.cTTFieldID = before_InstanceChildren.ID NO-ERROR.
        IF AVAILABLE(ttBrowser) THEN
        DO:
            ASSIGN ttBrowser.cExpanded = "<".
            NEXT.
        END.

        ASSIGN iLastBrowser = iLastBrowser + 1.
        CREATE ttBrowser.
        ASSIGN iOrder                    = iLastBrowser
               ttBrowser.cKey            = before_InstanceChildren.ID
               ttBrowser.cLabel          = FILL(" ", 8) + before_InstanceChildren.ID
               ttBrowser.cContainer      = coContainer:SCREEN-VALUE IN FRAME {&FRAME-NAME}
               ttBrowser.cExpanded       = "<"
               ttBrowser.lParentExpanded = TRUE
               ttBrowser.WidgetID        = before_InstanceChildren.WidgetID
               ttBrowser.iOrder          = iOrder
               ttBrowser.cParent         = before_Instance.ID
               ttBrowser.cStatus         = ""
               ttBrowser.cTTName         = "InstanceChildren"
               ttBrowser.cTTFieldID      = before_InstanceChildren.ID.
    END. /* FOR EACH before_InstanceChildren  */
END. /* FOR EACH before_Instance WHERE ROW-STATE(before_Instance) = 1: */

ASSIGN iLastBrowser = 0.
FOR EACH before_InstanceChildren WHERE ROW-STATE(before_InstanceChildren) = 1:
    FIND FIRST ttBrowser WHERE ttBrowser.cTTName = "InstanceChildren":U AND
                               ttBrowser.cTTFieldID = before_InstanceChildren.ID AND
                               ttBrowser.cParent = before_InstanceChildren.parentInstanceID NO-ERROR.
    IF AVAILABLE(ttBrowser) THEN
    DO:
        ASSIGN ttBrowser.cExpanded = "<".
        NEXT.
    END.

    FIND LAST ttBrowser WHERE ttBrowser.cTTName = "InstanceChildren" AND 
                              ttBrowser.cParent = before_InstanceChildren.parentInstanceID
                              NO-LOCK NO-ERROR.
    IF AVAILABLE(ttBrowser) THEN
        ASSIGN iLastBrowser = IF iLastBrowser NE 0 THEN iLastBrowser + 1 ELSE ttBrowser.iOrder + 1.
    ELSE DO:
        FIND LAST ttBrowser WHERE ttBrowser.cTTFieldID = before_InstanceChildren.parentInstanceID
                              NO-LOCK NO-ERROR.
        IF AVAILABLE(ttBrowser) THEN
           ASSIGN iLastBrowser = IF iLastBrowser NE 0 THEN iLastBrowser + 1 ELSE ttBrowser.iOrder + 1.
         ASSIGN iLastBrowser =  200001.
    END.

    ASSIGN iLastBrowser = iLastBrowser + 1.
    CREATE ttBrowser.
    ASSIGN iOrder                    = iLastBrowser
           ttBrowser.cKey            = before_InstanceChildren.ID
           ttBrowser.cLabel          = FILL(" ", 8) + before_InstanceChildren.ID
           ttBrowser.cContainer      = coContainer:SCREEN-VALUE IN FRAME {&FRAME-NAME}
           ttBrowser.cExpanded       = "<"
           ttBrowser.lParentExpanded = TRUE
           ttBrowser.WidgetID        = before_InstanceChildren.WidgetID
           ttBrowser.iOrder          = iOrder
           ttBrowser.cParent         = before_InstanceChildren.parentInstanceID
           ttBrowser.cStatus         = ""
           ttBrowser.cTTName         = "InstanceChildren"
           ttBrowser.cTTFieldID      = before_InstanceChildren.ID.
END. /*FOR EACH before_InstanceChildren WHERE ROW-STATE(before_InstanceChildren) = 1:*/
END PROCEDURE.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE windowResized C-Win 
PROCEDURE windowResized :
/*------------------------------------------------------------------------------
  Purpose: Resizes the objects in the window.
  Parameters:  <none>
  Notes:       
------------------------------------------------------------------------------*/
DEFINE VARIABLE dWinWidth  AS DECIMAL    NO-UNDO.
DEFINE VARIABLE dWinHeight AS DECIMAL    NO-UNDO.

FRAME {&FRAME-NAME}:SCROLLABLE = TRUE  NO-ERROR.

IF c-win:WIDTH < rcRight:COL IN FRAME {&frame-name} THEN
ASSIGN dWinWidth   = rcRight:COL
       c-win:WIDTH = dWinWidth.
ELSE
ASSIGN dWinWidth  = c-win:WIDTH.

IF c-win:HEIGHT < brObjects:ROW + brObjects:ROW-HEIGHT-CHARS * 9 THEN
ASSIGN dWinHeight = brObjects:ROW + brObjects:ROW-HEIGHT-CHARS * 9
       c-win:HEIGHT = dWinHeight - 1.
ELSE  
ASSIGN dWinHeight = c-win:HEIGHT + 1.

 ASSIGN rcBrowser:WIDTH     = dWinWidth
        rcToolbar:WIDTH     = dWinWidth
        brObjects:WIDTH     = dWinWidth - 2.5
        fiXMLFileName:WIDTH = dWinWidth - fiXMLFileName:COL
        coContainer:WIDTH   = dWinWidth - coContainer:COL
        NO-ERROR.

 FRAME {&frame-name}:SCROLLABLE = FALSE NO-ERROR.
 FRAME {&frame-name}:WIDTH  = dWinWidth  NO-ERROR.
 FRAME {&frame-name}:HEIGHT = dWinHeight - 0.1 NO-ERROR.

 ASSIGN brObjects:HEIGHT = dWinHeight - brObjects:ROW - 0.3
        rcBrowser:HEIGHT = dWinHeight - rcBrowser:ROW - 0.1 NO-ERROR.

RETURN.
END PROCEDURE.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME

/* ************************  Function Implementations ***************** */

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION checkTransaction C-Win 
FUNCTION checkTransaction RETURNS LOGICAL
  ( /* parameter-definitions */ ) :
/*------------------------------------------------------------------------------
  Purpose:  
    Notes:  
------------------------------------------------------------------------------*/
DEFINE VARIABLE lButton AS LOGICAL     NO-UNDO.

IF gcStatus = "Started":U THEN
DO:
    MESSAGE "Current values have not been saved." SKIP(1)
            "Do you wish to save current values before you proceed?"
        VIEW-AS ALERT-BOX QUESTION BUTTONS YES-NO-CANCEL UPDATE lButton.

    IF lButton = ? THEN
        RETURN FALSE.

    IF lButton = NO THEN
        RUN undoTransaction.

    IF lButton= YES THEN
        RUN commitTransaction.
END.
  
RETURN TRUE.   /* Function return value. */

END FUNCTION.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION getFileExtension C-Win 
FUNCTION getFileExtension RETURNS CHARACTER
  (INPUT pcFileName AS CHARACTER) :
/*------------------------------------------------------------------------------
  Purpose:  
    Notes:  
------------------------------------------------------------------------------*/
DEFINE VARIABLE cFileExt AS CHARACTER   NO-UNDO.

ASSIGN cFileExt = REPLACE(pcFileName, "/", "~\")
       cFileExt = SUBSTRING(cFileExt, R-INDEX(cFileExt, ".") + 1, -1).

RETURN cFileExt.   /* Function return value. */

END FUNCTION.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION isABRunning C-Win 
FUNCTION isABRunning RETURNS LOGICAL
  ( /* parameter-definitions */ ) :
/*------------------------------------------------------------------------------
  Purpose:  
    Notes:  
------------------------------------------------------------------------------*/
  DEFINE VARIABLE iLevel          AS INTEGER NO-UNDO INITIAL 1. 
  
  REPEAT WHILE PROGRAM-NAME(iLevel) <> ?.
    IF PROGRAM-NAME(iLevel) = "adeuib/_uibmain.p" THEN RETURN TRUE.
    ASSIGN iLevel = iLevel + 1.
  END.

  RETURN FALSE.   /* Function return value. */
END FUNCTION.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION setWidgetStatus C-Win 
FUNCTION setWidgetStatus RETURNS LOGICAL
  (INPUT pcStatus AS CHARACTER) :
/*-------------------------------------------------------------------------------
  Purpose:  Sets the toolbar button and widget status.
  
    Notes: Possible values:
           'Started': A transaction is started.
           'Finished': A transaction is finished
           'ToolEmpty': There are not XML file loaded in the tool
           'XMLEmpty': The XML file beign edited is empty (no container is added)  
-------------------------------------------------------------------------------*/
DO WITH FRAME {&FRAME-NAME}:

CASE pcStatus:

    WHEN 'Started':U THEN
      ASSIGN buNew:SENSITIVE       = FALSE
             buOpen:SENSITIVE      = FALSE
             buAdd:SENSITIVE       = FALSE
             buRemove:SENSITIVE    = FALSE
             buSave:SENSITIVE      = TRUE
             buCancel:SENSITIVE    = TRUE 
             buSync:SENSITIVE      = FALSE
             buTree:SENSITIVE      = TRUE
             coContainer:SENSITIVE = FALSE
             MENU-ITEM m_Assign_Default_Values:SENSITIVE IN MENU menu-bar-c-win = FALSE.

    WHEN 'Finished':U THEN
      ASSIGN buNew:SENSITIVE       = TRUE
             buOpen:SENSITIVE      = TRUE
             buAdd:SENSITIVE       = TRUE
             buRemove:SENSITIVE    = TRUE
             buSave:SENSITIVE      = FALSE
             buCancel:SENSITIVE    = FALSE
             buSync:SENSITIVE      = TRUE
             buTree:SENSITIVE      = TRUE
             coContainer:SENSITIVE = TRUE
             MENU-ITEM m_Assign_Default_Values:SENSITIVE IN MENU menu-bar-c-win = TRUE.

    WHEN 'ToolEmpty':U THEN
      ASSIGN buNew:SENSITIVE       = TRUE
             buOpen:SENSITIVE      = TRUE
             buAdd:SENSITIVE       = FALSE
             buRemove:SENSITIVE    = FALSE
             buSave:SENSITIVE      = FALSE
             buCancel:SENSITIVE    = FALSE
             buSync:SENSITIVE      = FALSE
             buTree:SENSITIVE      = FALSE
             coContainer:SENSITIVE = FALSE
             MENU-ITEM m_Assign_Default_Values:SENSITIVE IN MENU menu-bar-c-win = FALSE.

    WHEN 'XMLEmpty':U THEN
      ASSIGN buNew:SENSITIVE       = TRUE
             buOpen:SENSITIVE      = TRUE
             buAdd:SENSITIVE       = TRUE
             buRemove:SENSITIVE    = FALSE
             buSave:SENSITIVE      = FALSE
             buCancel:SENSITIVE    = FALSE
             buSync:SENSITIVE      = FALSE
             buTree:SENSITIVE      = FALSE
             coContainer:SENSITIVE = FALSE
             MENU-ITEM m_Assign_Default_Values:SENSITIVE IN MENU menu-bar-c-win = FALSE.
END CASE.

ASSIGN gcStatus = pcStatus.

END.
RETURN TRUE.   /* Function return value. */

END FUNCTION.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME

/***********************************************************************
* Copyright (C) 2007 by Progress Software Corporation. All rights      *
* reserved.  Prior versions of this work may contain portions          *
* contributed by participants of Possenet.                             *
*                                                                      *
***********************************************************************/
/*------------------------------------------------------------------------
    File        : _dswidfunc.p
    Purpose     : Manipulate the widget-id dataset temp-tables 

    Author(s)   : Marcelo Ferrante
    Created     : Thu Jul 19 10:43:39 EDT 2007
    Notes       : This library is run persistent by _widfunc.p and
                  _getwidobjs.w.
  ----------------------------------------------------------------------*/

/* ***************************  Definitions  ************************** */


/* ********************  Preprocessor Definitions  ******************** */
{adecomm/dswid.i}
{src/adm2/globals.i}
{src/adm2/tttoolbar.i}
{src/adm2/ttaction.i}
{src/adm2/treettdef.i}

/* ************************  Function Prototypes ********************** */

FUNCTION getRelativeName RETURNS CHARACTER 
	(INPUT pcFullFileName AS CHARACTER) FORWARD.


FUNCTION splitFileName RETURNS LOGICAL 
	(INPUT  pcFileName AS CHARACTER,
     OUTPUT pcPath     AS CHARACTER,
     OUTPUT pcFIle     AS CHARACTER) FORWARD.


FUNCTION createDynContainerDetails RETURNS LOGICAL 
	(INPUT pcObjectName     AS CHARACTER,
     INPUT pdObjectID       AS DECIMAL,
     INPUT pcRootNodeCode   AS CHARACTER,
     INPUT plAssignGaps     AS LOGICAL,
     INPUT DATASET dsWidgetID,
     OUTPUT piLastPage      AS INTEGER,
     OUTPUT plChanged       AS LOGICAL,
     OUTPUT pcNodes         AS CHARACTER,
     INPUT-OUTPUT pcActions AS CHARACTER) FORWARD.


FUNCTION createActions RETURNS LOGICAL 
	(INPUT pcFile AS CHARACTER,
     INPUT pcPath AS CHARACTER,
     INPUT pcActions AS CHARACTER,
     INPUT DATASET dsWidgetID) FORWARD.


FUNCTION createContainerDetails RETURNS LOGICAL 
	(INPUT  pcFile          AS CHARACTER,
     INPUT  pcPath          AS CHARACTER,
     INPUT  phInstance      AS HANDLE,
     INPUT  pcInstance      AS CHARACTER,
     INPUT  plRuntime       AS LOGICAL,
     INPUT  plAssignGaps    AS LOGICAL,
     INPUT  DATASET dsWidgetID,
     OUTPUT plDuplicateName AS LOGICAL,
     OUTPUT piTotalPages    AS INTEGER,
     OUTPUT plChanged       AS LOGICAL,
     INPUT-OUTPUT pcActions       AS CHARACTER,
     INPUT-OUTPUT piLastWidgetID  AS INTEGER,
     INPUT-OUTPUT pcOldObjectType AS CHARACTER) FORWARD.


FUNCTION createContainer RETURNS LOGICAL 
	(INPUT pcFileName        AS CHARACTER,
     INPUT pcObjectType      AS CHARACTER,
     INPUT plCheckDuplicates AS LOGICAL,
     OUTPUT pcFile           AS CHARACTER,
     OUTPUT pcPath           AS CHARACTER,
     INPUT DATASET dsWidgetID) FORWARD.
/* ***************************  Main Block  *************************** */



/* ************************  Function Implementations ***************** */

FUNCTION getRelativeName RETURNS CHARACTER 
    (INPUT pcFullFileName AS CHARACTER):
/*------------------------------------------------------------------------------
    Purpose:
    Notes:
------------------------------------------------------------------------------*/
DEFINE VARIABLE cFileName       AS CHARACTER  NO-UNDO.
DEFINE VARIABLE cTempFileName   AS CHARACTER  NO-UNDO.
DEFINE VARIABLE iFileEntries    AS INTEGER    NO-UNDO.
DEFINE VARIABLE iFileEntry      AS INTEGER    NO-UNDO.

ASSIGN pcFullFileName = REPLACE(pcFullFileName, "~\", "/")
       iFileEntries   = NUM-ENTRIES(pcFullFileName, "/").

REPEAT iFileEntry = iFileEntries TO 1 BY -1:
    ASSIGN cTempFileName = ENTRY(iFileEntry, pcFullFileName, "/") + "~\" + cTempFileName
           cTempFileName = TRIM(cTempFileName, "~\").

    IF cTempFileName NE ? THEN ASSIGN cFileName = cFileName + cTempFileName.
    ASSIGN cFileName = LEFT-TRIM(TRIM(REPLACE(SEARCH(cTempFileName), "~\", "/"), "."), "/").

    IF cFileName NE ? THEN RETURN cFileName.
END.

RETURN "".
END FUNCTION.

FUNCTION splitFileName RETURNS LOGICAL 
    (INPUT  pcFileName AS CHARACTER,
     OUTPUT pcPath     AS CHARACTER,
     OUTPUT pcFIle     AS CHARACTER):
/*------------------------------------------------------------------------------
    Purpose:
    Notes:
------------------------------------------------------------------------------*/
DEFINE VARIABLE iFileSeparatorPos AS INTEGER    NO-UNDO.
ASSIGN iFileSeparatorPos = R-INDEX(pcFileName, "/").

IF iFileSeparatorPos = 0 THEN
    ASSIGN pcFile = pcFileName
           pcPath = "":U.
ELSE
    ASSIGN pcFile = SUBSTRING(pcFileName, iFileSeparatorPos + 1)
           pcPath = SUBSTRING(pcFileName, 1, iFileSeparatorPos - 1).

RETURN TRUE.
END FUNCTION.

FUNCTION createContainer RETURNS LOGICAL 
    (INPUT pcFileName        AS CHARACTER,
     INPUT pcObjectType      AS CHARACTER,
     INPUT plCheckDuplicates AS LOGICAL,
     OUTPUT pcFile           AS CHARACTER,
     OUTPUT pcPath           AS CHARACTER,
     INPUT DATASET dsWidgetID):
/*------------------------------------------------------------------------------
    Purpose: Creates the container record.
    Parameters:
      pcFileName: relative file name of the container.
      pcObjectType: SmartObject type of the container
      plCheckDuplicates: If true, checks if the container already exists and shows
                         a message to the user, to confirm that he/she wants to
                         override the old values.
      OUTPUT pcFile: File name of the container
      OUTPUT pcPath: Relative path of the container
      INPUT-OUTPUT TABLE Container: container temp-table.
    Notes:
------------------------------------------------------------------------------*/
DEFINE VARIABLE lOk               AS LOGICAL    NO-UNDO.

splitFileName(INPUT pcFileName, OUTPUT pcPath, OUTPUT pcFile).

FIND FIRST Container WHERE Container.contPath = pcPath AND Container.contName = pcFile NO-LOCK NO-ERROR.

IF AVAILABLE Container AND plCheckDuplicates THEN
DO:
    MESSAGE "Container '" pcPath + "/":U + pcFile "' already exists in the Widget-id file." SKIP(1)
            "Do you want to override it?"
            VIEW-AS ALERT-BOX QUESTION BUTTONS YES-NO UPDATE lOk.

    IF NOT lOk THEN RETURN FALSE.

    FOR EACH Instances OF Container:        DELETE Instances.        END.
    FOR EACH Instance OF Container:         DELETE Instance.         END.
    FOR EACH InstanceChildren OF Container: DELETE InstanceChildren. END.
    FOR EACH ParentPages OF Container:      DELETE ParentPages.      END.
    FOR EACH Pages OF Container:            DELETE Pages.            END.
    FOR EACH Actions OF Container:          DELETE Actions.          END.
    FOR EACH Action OF Container:           DELETE Action.           END.
    FOR EACH TreeNodes OF Container:        DELETE TreeNodes.        END.
    FOR EACH TreeNode OF Container:         DELETE TreeNode.         END.
END. /*IF AVAILABLE Container THEN*/

ELSE DO:
    CREATE Container.
    ASSIGN Container.contName   = pcFile
           Container.contPath   = pcPath
           Container.ObjectType = pcObjectType.
END.

RETURN TRUE.
END FUNCTION.

FUNCTION createContainerDetails RETURNS LOGICAL 
    (INPUT  pcFile          AS CHARACTER,
     INPUT  pcPath          AS CHARACTER,
     INPUT  phInstance      AS HANDLE,
     INPUT  pcInstance      AS CHARACTER,
     INPUT  plRuntime       AS LOGICAL,
     INPUT  plAssignGaps    AS LOGICAL,
     INPUT  DATASET dsWidgetID,
     OUTPUT plDuplicateName AS LOGICAL,
     OUTPUT piTotalPages    AS INTEGER,
     OUTPUT plChanged       AS LOGICAL,
     INPUT-OUTPUT pcActions       AS CHARACTER,
     INPUT-OUTPUT piLastWidgetID  AS INTEGER,
     INPUT-OUTPUT pcOldObjectType AS CHARACTER):
/*------------------------------------------------------------------------------
    Purpose: Create all the container details.
    Notes:
------------------------------------------------------------------------------*/
DEFINE VARIABLE cObjectType    AS CHARACTER NO-UNDO.
DEFINE VARIABLE cInstanceID    AS CHARACTER NO-UNDO.
DEFINE VARIABLE iInstance      AS INTEGER   NO-UNDO.
DEFINE VARIABLE iObjectGap     AS INTEGER   NO-UNDO.
DEFINE VARIABLE hProcGap       AS HANDLE    NO-UNDO.
DEFINE VARIABLE cTempActions   AS CHARACTER NO-UNDO.
DEFINE VARIABLE iActions       AS INTEGER   NO-UNDO.
DEFINE VARIABLE cPage          AS CHARACTER NO-UNDO.
DEFINE VARIABLE iPage          AS INTEGER   NO-UNDO.
DEFINE VARIABLE cPages         AS CHARACTER NO-UNDO.
DEFINE VARIABLE iField         AS INTEGER   NO-UNDO.
DEFINE VARIABLE cFields        AS CHARACTER NO-UNDO.
DEFINE VARIABLE cField         AS CHARACTER  NO-UNDO.

RUN adecomm/_widgaps.p PERSISTENT SET hProcGap.

IF NOT CAN-FIND(FIRST Instances WHERE Instances.contName = pcFile AND Instances.contPath = pcPath) THEN
DO:
    CREATE Instances.
    ASSIGN Instances.contName = pcFile
           Instances.contPath = pcPath
           plChanged          = TRUE.
END. /* IF NOT CAN-FIND(FIRST Instances WHERE Instances.contName = pcFile AND Instances.contPath = pcPath) THEN */

&SCOPED-DEFINE xp-assign

{get ObjectType cObjectType phInstance}.
&UNDEFINE xp-assign

IF pcInstance NE "" AND pcInstance NE ? THEN
    ASSIGN cInstanceID = pcInstance.
ELSE
{get ObjectName cInstanceID phInstance}.    

ASSIGN iObjectGap     = DYNAMIC-FUNCTION('getWidgetIDGap':U IN hProcGap, INPUT IF pcOldObjectType = "":U THEN "FRAME":U ELSE pcOldObjectType)
       piLastWidgetID = piLastWidgetID + iObjectGap.

        IF piLastWidgetID > 65535 AND plAssignGaps THEN
        DO:
            MESSAGE "The maximum value of 65535 for the widget-id attribute has been reached." SKIP
                    "Widget-id for the remaining objects won't be assigned." SKIP
                    "Review and assign the widget-ids manually." 
                 VIEW-AS ALERT-BOX WARNING
                 TITLE "Runtime Widget-id Assignment tool".
            ASSIGN plAssignGaps = FALSE.
        END.

/*If the object is in design mode, we have to check for duplicate names.*/
IF NOT plRuntime AND (pcInstance = "" OR pcInstance = ?) THEN
DO:
    FIND LAST Instance WHERE Instance.ID BEGINS cInstanceID AND
                             Instance.contPath = pcPath AND
                             Instance.contName = pcFile
                             USE-INDEX cWidgetID
                             NO-LOCK NO-ERROR.
    IF AVAILABLE(Instance) THEN
    DO:
        ASSIGN iInstance       = (IF INDEX(Instance.ID, "(") GT 0 THEN INT(SUBSTRING(Instance.ID, INDEX(Instance.ID, "(") + 1, INDEX(Instance.ID, ")") - INDEX(Instance.ID, "(") - 1)) ELSE 1) + 1
               cInstanceID     = cInstanceID + "(" + STRING(iInstance) + ")"
               plDuplicateName = TRUE.
    END. /* IF CAN-FIND(FIRST Instance WHERE Instance.ID = cInstanceID AND Instance.contPath = pcPath AND Instance.contName = pcFile) THEN */
END. /* IF NOT plRuntime THEN */

FIND FIRST Instance WHERE Instance.ID       = cInstanceID AND
                          Instance.contPath = pcPath AND
                          Instance.contName = pcFile
                          NO-LOCK NO-ERROR.

IF NOT AVAILABLE(Instance) THEN
DO:
    CREATE Instance.
    ASSIGN Instance.ID         = cInstanceID
           Instance.contPath   = pcPath
           Instance.contName   = pcFile
           Instance.ObjectType = cObjectType
           Instance.WidgetID   = IF plAssignGaps THEN piLastWidgetID ELSE 0
           plChanged           = TRUE NO-ERROR.
END.

/*If the instance is a toolbar, we build a variable with all the action names
  in all toolbars, avoiding duplicates.*/
IF DYNAMIC-FUNCTION('instanceOf' IN phInstance, INPUT "toolbar":U) THEN
DO:
    ASSIGN cTempActions = DYNAMIC-FUNCTION('actions':U IN phInstance, INPUT "toolbar":U).  
    REPEAT iActions = 1 TO NUM-ENTRIES(cTempActions):
        IF NOT CAN-DO(pcActions, ENTRY(iActions, cTempActions)) THEN
            ASSIGN pcActions = pcActions + ENTRY(iActions, cTempActions) + ",".
    END. /*REPEAT iActions = 1 TO NUM-ENTRIES(cTempActions):*/
END. /* IF DYNAMIC-FUNCTION('instanceOf' IN phInstance, INPUT "toolbar":U) THEN */

/*If the Instance is a Folder, we have to get the pages in the container.*/
IF DYNAMIC-FUNCTION('instanceOf' IN phInstance, INPUT "SmartFolder":U) THEN
DO:
    {get FolderLabels cPages phInstance}.

    ASSIGN piTotalPages = NUM-ENTRIES(cPages, "|":U)
           iObjectGap   = DYNAMIC-FUNCTION('getWidgetIDGap':U IN hProcGap, INPUT "SmartFolderPage":U).

    IF piTotalPages GT 0 AND NOT CAN-FIND(FIRST ParentPages WHERE ParentPages.contPath = pcPath AND ParentPages.contName = pcFile) THEN
    DO:
        CREATE ParentPages.
        ASSIGN ParentPages.contPath = pcPath
               ParentPages.contName = pcFile
               plChanged            = TRUE.
    END.

    REPEAT iPage = 1 TO piTotalPages:
        ASSIGN cPage = ENTRY(iPage, cPages, "|":U).

        FIND FIRST Pages WHERE Pages.contPath   = pcPath AND
                               Pages.contName   = pcFile AND
                               Pages.PageNumber = iPage NO-ERROR.
        IF NOT AVAILABLE(Pages) THEN
        DO:
            CREATE Pages.
            ASSIGN Pages.contPath   = pcPath
                   Pages.contName   = pcFile
                   Pages.PageNumber = iPage
                   Pages.WidgetID   = iObjectGap * iPage
                   plChanged        = TRUE.
        END. /*IF NOT AVAILABLE(Pages) THEN*/
        ASSIGN Pages.pageLabel  = cPage.
    END. /* REPEAT iPage = 1 TO NUM-ENTRIES(iPages): */
END. /*IF DYNAMIC-FUNCTION('instanceOf' IN b_S._handle, INPUT "folder":U) THEN*/ 

IF DYNAMIC-FUNCTION('instanceOf' IN phInstance, INPUT "Filter":U) THEN
DO: 
    {get DisplayedFields cFields phInstance}.
    ASSIGN iObjectGap = DYNAMIC-FUNCTION('getWidgetIDGap':U IN hProcGap, INPUT "FilterField":U).

    REPEAT iField = 1 TO NUM-ENTRIES(cFields):
        ASSIGN cField = ENTRY(iField, cFields).

        IF NOT CAN-FIND(InstanceChildren WHERE InstanceChildren.contPath         = pcPath      AND 
                                               InstanceChildren.contName         = pcFile      AND 
                                               InstanceChildren.parentInstanceID = Instance.ID AND
                                               InstanceChildren.ID               = cField) THEN 
        DO:
            CREATE InstanceChildren.
            ASSIGN InstanceChildren.ID               = cField
                   InstanceChildren.contPath         = pcPath
                   InstanceChildren.contName         = pcFile
                   InstanceChildren.parentInstanceID = Instance.ID
                   InstanceChildren.ObjectType       = "SmartFilterField":U
                   InstanceChildren.WidgetID         = IF iField = 1 THEN 8 ELSE iObjectGap * (iField - 1) + 8
                   plChanged                         = TRUE.
        END.
    END. /* REPEAT iField = 1 TO NUM-ENTRIES(cFields): */
END. /* IF DYNAMIC-FUNCTION('instanceOf' IN phInstance, INPUT "Filter":U) THEN*/

ASSIGN pcOldObjectType = cObjectType.

DELETE OBJECT hProcGap.

RETURN TRUE.
END FUNCTION.

FUNCTION createActions RETURNS LOGICAL 
    (INPUT pcFile AS CHARACTER,
     INPUT pcPath AS CHARACTER,
     INPUT pcActions AS CHARACTER,
     INPUT DATASET dsWidgetID):
/*------------------------------------------------------------------------------
    Purpose:
    Notes:
------------------------------------------------------------------------------*/
DEFINE VARIABLE iAction    AS INTEGER   NO-UNDO.
DEFINE VARIABLE cAction    AS CHARACTER NO-UNDO.
DEFINE VARIABLE iObjectGap AS INTEGER   NO-UNDO.
DEFINE VARIABLE iActions   AS INTEGER   NO-UNDO.
DEFINE VARIABLE hProcGap   AS HANDLE    NO-UNDO.

RUN adecomm/_widgaps.p   PERSISTENT SET hProcGap.

IF NOT CAN-FIND(FIRST Actions WHERE Actions.contPath = pcPath AND Actions.contName = pcFile) THEN
DO:
    CREATE Actions.
    ASSIGN Actions.contPath = pcPath
           Actions.contName = pcFile.
END.

ASSIGN pcActions   = TRIM(pcActions, ",":U)
       iActions   = NUM-ENTRIES(pcActions)
       iObjectGap = DYNAMIC-FUNCTION('getWidgetIDGap':U IN hProcGap, INPUT "SmartToolbarActions":U).

REPEAT iAction = 1 TO iActions:
    ASSIGN cAction = ENTRY(iAction, pcActions).

    IF NOT CAN-FIND(FIRST Action WHERE Action.contPath = pcPath AND
                                       Action.contName = pcFile AND
                                       Action.actionID = cAction) THEN
    DO:
        CREATE Action.
        ASSIGN Action.contPath    = pcPath
               Action.contName    = pcFile
               Action.actionID    = cAction
               Action.actionLabel = cAction
               Action.WidgetID    = iObjectGap * iAction.
    END.
END. /* REPEAT iAction = 1 TO iActions: */

DELETE OBJECT hProcGap.

RETURN TRUE. 
END FUNCTION.

FUNCTION createDynContainerDetails RETURNS LOGICAL 
    (INPUT pcObjectName     AS CHARACTER,
     INPUT pdObjectID       AS DECIMAL,
     INPUT pcRootNodeCode   AS CHARACTER,
     INPUT plAssignGaps     AS LOGICAL,
     INPUT DATASET dsWidgetID,
     OUTPUT piLastPage      AS INTEGER,
     OUTPUT plChanged       AS LOGICAL,
     OUTPUT pcNodes         AS CHARACTER,
     INPUT-OUTPUT pcActions AS CHARACTER):
/*------------------------------------------------------------------------------
    Purpose:
    Notes:
------------------------------------------------------------------------------*/
DEFINE VARIABLE hProcGap        AS HANDLE    NO-UNDO.
DEFINE VARIABLE cInstances      AS CHARACTER NO-UNDO.
DEFINE VARIABLE iInstances      AS INTEGER   NO-UNDO.
DEFINE VARIABLE cInstance       AS CHARACTER NO-UNDO.
DEFINE VARIABLE iInstance       AS INTEGER   NO-UNDO.
DEFINE VARIABLE cPropertyNames  AS CHARACTER NO-UNDO.
DEFINE VARIABLE cPropertyValues AS CHARACTER NO-UNDO.
DEFINE VARIABLE dInstanceID     AS DECIMAL   NO-UNDO.
DEFINE VARIABLE dOldObjectType  AS DECIMAL NO-UNDO.
DEFINE VARIABLE cLogicalName    AS CHARACTER NO-UNDO.
DEFINE VARIABLE cInstanceType   AS CHARACTER NO-UNDO.
DEFINE VARIABLE iObjectGap      AS INTEGER   NO-UNDO.
DEFINE VARIABLE iLastWidgetID   AS INTEGER   NO-UNDO.
DEFINE VARIABLE cFolderPages    AS CHARACTER NO-UNDO.
DEFINE VARIABLE iItems          AS INTEGER   NO-UNDO.
DEFINE VARIABLE iItem           AS INTEGER   NO-UNDO.
DEFINE VARIABLE cItem           AS CHARACTER NO-UNDO.
DEFINE VARIABLE cOldObjectType  AS CHARACTER NO-UNDO.
DEFINE VARIABLE cNodeKey        AS CHARACTER NO-UNDO.
DEFINE VARIABLE iActions        AS INTEGER   NO-UNDO.
DEFINE VARIABLE cUsedToolbars   AS CHARACTER NO-UNDO.
DEFINE VARIABLE lIsLocalWidget  AS LOGICAL   NO-UNDO.
DEFINE VARIABLE lIsOldLocalWidget  AS LOGICAL   NO-UNDO.
DEFINE VARIABLE lIsDynView      AS LOGICAL   NO-UNDO.

RUN adecomm/_widgaps.p PERSISTENT SET hProcGap.

    /*Gets the instance names contained in the current container*/
    RUN getContainedInstanceNames IN gshRepositoryManager (
        INPUT  pcObjectName,
        OUTPUT cInstances) NO-ERROR.

    ASSIGN cInstances = TRIM(cInstances, ",")
           iInstances  = NUM-ENTRIES(cInstances).

    /*Loop to navigate every instance.*/
    REPEAT iInstance = 1 TO iInstances:
        ASSIGN cInstance      = ENTRY(iInstance, cInstances)
               cPropertyNames = "InstanceId,ClassName,ActionGroups,FolderLabels,LogicalObjectName":U.

        IF cInstance = "":U THEN NEXT.

        /*Gets the required properties for the current instance*/
        RUN getInstanceProperties IN gshRepositoryManager (
            INPUT        pcObjectName,
            INPUT        cInstance, 
            INPUT-OUTPUT cPropertyNames,
                  OUTPUT cPropertyValues) NO-ERROR.

        ASSIGN dInstanceId       = DECIMAL(ENTRY(LOOKUP("InstanceId":U, cPropertyNames), cPropertyValues, CHR(1)))
               cInstanceType     = ENTRY(LOOKUP("ClassName":U, cPropertyNames), cPropertyValues, CHR(1))
               lIsLocalWidget    = DYNAMIC-FUNCTION('isA' IN gshRepositoryManager, INPUT dInstanceId, "ProgressWidget":U)
               lIsOldLocalWidget = DYNAMIC-FUNCTION('isA' IN gshRepositoryManager, INPUT dOldObjectType, "ProgressWidget":U)
               lIsDynView        = DYNAMIC-FUNCTION('isA' IN gshRepositoryManager, INPUT pdObjectID, "DynView":U).

        /*If the widget is a local widget (i.e.: button, fill-in, etc), then we have to treat it as a DataField.*/
        IF lIsOldLocalWidget THEN
            ASSIGN iObjectGap = DYNAMIC-FUNCTION('getWidgetIDGap':U IN hProcGap, INPUT "DataField":U).
        ELSE IF lIsDynView AND cOldObjectType = "":U THEN
            iObjectGap = DYNAMIC-FUNCTION('getWidgetIDGap':U IN hProcGap, INPUT "DataField":U).
        ELSE
            ASSIGN iObjectGap = DYNAMIC-FUNCTION('getWidgetIDGap':U IN hProcGap, INPUT IF cOldObjectType = "":U THEN "FRAME":U ELSE cOldObjectType).

        ASSIGN iLastWidgetID = iLastWidgetID + iObjectGap.

        IF CAN-DO(cPropertyNames, "LogicalObjectName":U) THEN
             ASSIGN cLogicalName  = ENTRY(LOOKUP("LogicalObjectName":U, cPropertyNames), cPropertyValues, CHR(1)).

        IF iLastWidgetID > 65535 AND plAssignGaps THEN
        DO:
            MESSAGE "The maximum value of 65535 for the widget-id attribute has been reached." SKIP
                    "Widget-id for the remaining objects won't be assigned." SKIP
                    "Review and assign the widget-ids manually." 
                 VIEW-AS ALERT-BOX WARNING
                 TITLE "Runtime Widget-id Assignment tool".
            ASSIGN plAssignGaps = FALSE.
        END.

        IF DYNAMIC-FUNCTION('isA' IN gshRepositoryManager, INPUT dInstanceId, "SBO":U) THEN NEXT.

        /*We only need Visual and DataField objects*/
        IF NOT DYNAMIC-FUNCTION('isA' IN gshRepositoryManager, INPUT dInstanceId, "Visual") AND 
           NOT DYNAMIC-FUNCTION('isA' IN gshRepositoryManager, INPUT dInstanceId, "DataField") AND 
           NOT lIsLocalWidget THEN NEXT.

        /*Creates the Instance parent node for the container, if this does not exist.*/
        IF NOT CAN-FIND(FIRST Instances WHERE Instances.contName = pcObjectName AND Instances.contPath = "") THEN
        DO:
            CREATE Instances.
            ASSIGN Instances.contName = pcObjectName
                   Instances.contPath = ""
                   plChanged          = TRUE.
        END.

        /*Create the instance record*/
        IF NOT CAN-FIND(FIRST Instance WHERE Instance.contPath = "" AND
                                             Instance.contName = pcObjectName AND
                                             Instance.ID = cInstance) THEN
        DO:
            CREATE Instance.
            ASSIGN Instance.ID         = cInstance
                   Instance.contPath   = ""
                   Instance.contName   = pcObjectName
                   Instance.ObjectType = cInstanceType
                   plChanged           = TRUE
                   Instance.WidgetID   = IF plAssignGaps THEN iLastWidgetID ELSE 0 NO-ERROR.
        END.

        /*If the instance is a folder, then get and create the folder pages*/
        IF DYNAMIC-FUNCTION('isA' IN gshRepositoryManager, INPUT dInstanceId, "SmartFolder") THEN
        DO:
            ASSIGN cFolderPages = ENTRY(LOOKUP("FolderLabels":U, cPropertyNames), cPropertyValues, CHR(1))
                   iItems       = NUM-ENTRIES(cFolderPages, "|")
                   piLastPage   = iItems
                   iObjectGap   = DYNAMIC-FUNCTION('getWidgetIDGap':U IN hProcGap, INPUT "SmartFolderPage":U).

            IF iItems GT 0 AND NOT CAN-FIND(FIRST ParentPages WHERE ParentPages.contPath = "" AND ParentPages.contName = pcObjectName) THEN
            DO:
                CREATE ParentPages.
                ASSIGN ParentPages.contPath = ""
                       ParentPages.contName = pcObjectName
                       plChanged            = TRUE.
            END.

            REPEAT iItem = 1 TO iItems:
                ASSIGN cItem = ENTRY(iItem, cFolderPages, "|").

                FIND FIRST Pages WHERE Pages.contPath   = ""           AND
                                       Pages.contName   = pcObjectName AND
                                       Pages.pageNumber = iItem NO-ERROR.
                IF NOT AVAILABLE(Pages) THEN
                DO:
                    CREATE Pages.
                    ASSIGN Pages.contPath   = ""
                           Pages.contName   = pcObjectName
                           Pages.PageNumber = iItem
                           Pages.WidgetID   = iObjectGap * iItem
                           plChanged        = TRUE.
                END.
                ASSIGN Pages.pageLabel  = cItem.
            END. /*REPEAT iItem = 1 TO iItems:*/
        END. /*IF cInstance = "SmartFolder":U THEN*/

        /*If the instance is a Toolbar, we build a variable with the toolbar names, to later get all the
          toolbar actions in one call to the API*/
        IF DYNAMIC-FUNCTION('isA' IN gshRepositoryManager, INPUT dInstanceId, "Toolbar") THEN
        DO:
            /*Avoid to get duplicate toolbar actions*/
            IF CAN-DO(cUsedToolbars, cLogicalName) THEN NEXT.

            /*Get and create all the toolbar actions that are involved in the current container*/
            ASSIGN iObjectGap = DYNAMIC-FUNCTION('getWidgetIDGap':U IN hProcGap, INPUT "SmartToolbarActions":U)
                   cUsedToolbars = cUsedToolbars + "," + cLogicalName
                   cUsedToolbars = TRIM(cUsedToolbars, ",").

            /*Create the action parent node, if this does not exist.*/
            IF NOT CAN-FIND(FIRST Actions WHERE Actions.contPath = "":U AND Actions.contName = pcObjectName) THEN
            DO:
                CREATE Actions.
                ASSIGN Actions.contPath = ""
                       Actions.contName = pcObjectName
                       plChanged        = TRUE.
            END.

            /*Gets all the actions that are in all the toolbars in the selected container.*/
            RUN getToolbarBandActions IN gshRepositoryManager (
                INPUT cLogicalName,
                INPUT "Actions":U,
                INPUT ENTRY(LOOKUP("ActionGroups":U, cPropertyNames), cPropertyValues, CHR(1)),
                OUTPUT TABLE ttToolbarBand,
                OUTPUT TABLE ttObjectBand,
                OUTPUT TABLE ttBand,
                OUTPUT TABLE ttBandAction,    
                OUTPUT TABLE ttAction,
                OUTPUT TABLE ttCategory) NO-ERROR.

            /*Creates the actions*/
            FOR EACH ttToolbarBand NO-LOCK WHERE ttToolbarBand.ToolbarName = cLogicalName, 
                EACH ttBand NO-LOCK WHERE ttBand.Band = ttToolbarBand.Band AND
                                          (ttBand.bandType = "Toolbar":U OR
                                           ttBand.bandType = "Menu&Toolbar":U),
                EACH ttBandAction NO-LOCK OF ttBand,
                EACH ttAction     NO-LOCK OF ttBandAction:

                IF NOT CAN-DO(pcActions, ttAction.Action) THEN
                    ASSIGN pcActions = pcActions + ttAction.Action + ",":U.

                IF CAN-FIND(FIRST Action WHERE Action.contPath = "" AND 
                                               Action.contName = pcObjectName AND
                                               Action.actionID = ttAction.Action)
                THEN NEXT.

                CREATE Action.
                ASSIGN iActions           = iActions + 1
                       Action.contPath    = ""
                       Action.contName    = pcObjectName
                       Action.actionID    = ttAction.Action
                       Action.actionLabel = ttAction.Action
                       Action.WidgetID    = iObjectGap * iActions
                       plChanged          = TRUE.
            END. /*FOR EACH ttToolbarBand NO-LOCK:*/
        END. /*IF DYNAMIC-FUNCTION('isA' IN gshRepositoryManager, INPUT dInstanceId, "Toolbar") THEN*/

        ASSIGN cOldObjectType = cInstanceType
               dOldObjectType = dInstanceID.
    END. /*REPEAT iInstance = 1 TO iInstances:*/

    /*If the object is a DynTree, we have to get the containers to be launched for each node.*/
    IF DYNAMIC-FUNCTION('isA' IN gshRepositoryManager, INPUT pdObjectId, "DynTree") THEN
    DO:
        ASSIGN iObjectGap = DYNAMIC-FUNCTION('getWidgetIDGap':U IN hProcGap, INPUT "TreeNode":U).
        FIND LAST TreeNode WHERE TreeNode.contPath = "":U AND
                                 TreeNode.contName = pcObjectName
                                 USE-INDEX cWidgetID NO-LOCK NO-ERROR.
        IF AVAILABLE(TreeNode) THEN
            ASSIGN iLastWidgetID = TreeNode.widgetID + iObjectGap.

        RUN ry/app/rytrenodep.p (INPUT pcRootNodeCode,
                                 INPUT ?,
                                 OUTPUT TABLE ttNode ).

        /*Creates the Instance parent node for the container, only if nodes were found, and it was not previously created.*/
        IF NOT CAN-FIND(FIRST TreeNodes WHERE TreeNodes.contName = pcObjectName AND TreeNodes.contPath = "") AND
               CAN-FIND(FIRST ttNode) THEN
        DO:
            CREATE TreeNodes.
            ASSIGN TreeNodes.contName = pcObjectName
                   TreeNodes.contPath = ""
                   plChanged          = TRUE.
        END.

        FOR EACH ttNode NO-LOCK WHERE ttNode.LOGICAL_object NE "":U:

            ASSIGN cNodeKey = ttNode.node_code + "_":U + ttNode.logical_object.
            IF NOT CAN-DO(pcNodes, cNodeKey) THEN
                ASSIGN pcNodes = pcNodes + cNodeKey + ",":U.

            IF NOT CAN-FIND(FIRST TreeNode WHERE TreeNode.contPath = "":U AND
                                                 TreeNode.contName = pcObjectName AND
                                                 TreeNode.ID       = cNodeKey) THEN
            DO:
                ASSIGN iLastWidgetID       = iLastWidgetID + iObjectGap.
                IF iLastWidgetID > 65535 AND plAssignGaps THEN
                DO:
                    MESSAGE "The maximum value of 65535 for the widget-id attribute has been reached." SKIP
                            "Widget-id for the remaining objects won't be assigned." SKIP
                            "Review and assign the widget-ids manually." 
                         VIEW-AS ALERT-BOX WARNING
                         TITLE "Runtime Widget-id Assignment tool".
                    ASSIGN plAssignGaps = FALSE.
                END.

                CREATE TreeNode.
                ASSIGN TreeNode.ID         = cNodeKey
                       TreeNode.cLabel     = ttNode.node_code + " (" + ttNode.logical_object + ")"
                       TreeNode.contPath   = "":U
                       TreeNode.contName   = pcObjectName
                       TreeNode.ObjectType = "TreeNode":U
                       TreeNode.WidgetID   = IF plAssignGaps THEN iLastWidgetID ELSE 0 
                       plChanged           = TRUE
                       NO-ERROR.
            END. /* IF NOT CAN-FIND(FIRST TreeNode */
        END. /*FOR EACH ttNode NO-LOCK:*/
    END. /*IF DYNAMIC-FUNCTION('isA' IN gshRepositoryManager, INPUT dObjectId, "DynTree") THEN*/

    ASSIGN iLastWidgetID  = 0
           iObjectGap     = 0
           cOldObjectType = "":U
           pcActions      = TRIM(pcActions, ",":U)
           pcNodes        = TRIM(pcNodes, ",":U).

IF VALID-HANDLE(hProcGap) THEN
   DELETE OBJECT hProcGap.
   
RETURN TRUE.

END FUNCTION.



/* **********************  Internal Procedures  *********************** */

PROCEDURE getRuntimeObjectNames:
/*------------------------------------------------------------------------------
    Purpose: Returns the SmartObject container names that are running
             in the session.
    Parameters: <none>
    Notes:
------------------------------------------------------------------------------*/
DEFINE INPUT  PARAMETER phParent        AS HANDLE     NO-UNDO.
DEFINE INPUT  PARAMETER pcExcludeObject AS CHARACTER  NO-UNDO.
DEFINE INPUT-OUTPUT PARAMETER TABLE FOR ttObjectNames.

DEFINE VARIABLE cValidContainers AS CHARACTER  NO-UNDO INITIAL
    "DynTree,DynObjc,DynMenc,DynFold,DynFrame,SmartWindow,SmartDialog,SmartFrame,SmartDataViewer":U.
DEFINE VARIABLE isContainer AS LOGICAL   NO-UNDO.
DEFINE VARIABLE iContainers AS INTEGER   NO-UNDO.
DEFINE VARIABLE iContainer  AS INTEGER   NO-UNDO.
DEFINE VARIABLE hChild      AS HANDLE    NO-UNDO.
DEFINE VARIABLE hProc       AS HANDLE    NO-UNDO.
DEFINE VARIABLE cObjectType AS CHARACTER NO-UNDO.
DEFINE VARIABLE cObjectName AS CHARACTER NO-UNDO.
DEFINE VARIABLE lStatic     AS LOGICAL   NO-UNDO.
DEFINE VARIABLE cTargets    AS CHARACTER NO-UNDO.
DEFINE VARIABLE hTarget     AS HANDLE    NO-UNDO.
DEFINE VARIABLE iTarget     AS INTEGER   NO-UNDO.
DEFINE VARIABLE hTVSource   AS HANDLE    NO-UNDO.
DEFINE VARIABLE cTVSource   AS CHARACTER NO-UNDO.

REPEAT WHILE VALID-HANDLE(phParent):
    IF phParent:TYPE EQ "PROCEDURE":U THEN
    ASSIGN hProc = phParent.
    ELSE
    ASSIGN hProc = phParent:INSTANTIATING-PROCEDURE.
    IF hProc NE ? THEN
    DO:
        {get ObjectType cObjectType hProc} NO-ERROR.
        IF NOT ERROR-STATUS:ERROR AND cObjectType NE ? AND cObjectType NE 'SUPER':U THEN
        DO:
           /*We have to validate that the container is one of the valid container classes.
             For example, DynBrow inherits from container, but this is not considered as container in
             the widget-id assignment tool. So we have to filter that.*/
           ASSIGN iContainers = NUM-ENTRIES(cValidContainers).
           REPEAT iContainer = 1 TO iContainers:
               ASSIGN isContainer = DYNAMIC-FUNCTION('instanceOf':U IN hProc, INPUT ENTRY(iContainer, cValidContainers)) NO-ERROR.
               IF isContainer = TRUE THEN LEAVE.
           END.
           IF NOT ERROR-STATUS:ERROR AND isContainer THEN
           DO:
               {get LogicalObjectName cObjectName hProc} NO-ERROR.
               ASSIGN lStatic = (cObjectName = "":U).

               IF cObjectName = "":U THEN
               ASSIGN cObjectName = hProc:FILE-NAME.

               ASSIGN cObjectName = REPLACE(cObjectName, "~\":U, "/":U).

               IF NOT CAN-FIND(FIRST ttObjectNames WHERE ttObjectNames.cName = cObjectName) THEN
               DO:
                   CREATE ttObjectNames.
                   ASSIGN ttObjectNames.cName    = cObjectName
                          ttObjectNames.isStatic = lStatic
                          ttObjectNames.lImport  = NOT CAN-DO(cObjectName, pcExcludeObject)
                          ttObjectNames.hHandle  = hProc.
               END.

               {get ContainerTarget cTargets hProc} NO-ERROR.
               IF cTargets NE "" AND NOT ERROR-STATUS:ERROR THEN
               DO:
                   REPEAT iTarget = 1 TO NUM-ENTRIES(cTargets):
                       ASSIGN hTarget = WIDGET-HANDLE(ENTRY(iTarget, cTargets)).

                       /*Due to the DynTree structure and the way it is created, if the running object is a folder in
                         a treeview, we get the folder name but not the treeview container name. So we have to check if the
                         the running object has a TVController-source link. If yes, is because we are running a DynTree,
                         so we have to get the name of the Container that handles the treeview.*/
                       ASSIGN cTVSource = DYNAMIC-FUNCTION('linkhandles' IN hProc, INPUT "TVController-source") NO-ERROR.
                       IF NOT ERROR-STATUS:ERROR AND cTVSource NE "":U THEN                       DO: 
                           ASSIGN hTVSource = WIDGET-HANDLE(cTVSource)
                                  hTVSource = DYNAMIC-FUNCTION('getContainerSource' IN hTVSource)
                                  cTVSource = DYNAMIC-FUNCTION('getTreeLogicalName' IN hTVSource).

                           IF cTVSource NE "":U AND cTVSource NE ? THEN                           DO:
                               IF NOT CAN-FIND(FIRST ttObjectNames WHERE ttObjectNames.cName = cTVSource) THEN
                               DO:
                                   CREATE ttObjectNames.
                                   ASSIGN ttObjectNames.cName    = cTVSource
                                          ttObjectNames.isStatic = FALSE /*Force the TreeView container to be dynamic*/
                                          ttObjectNames.lImport  = NOT CAN-DO(cTVSource, pcExcludeObject)
                                          ttObjectNames.hHandle  = hTVSource.
                               END.
                           END. /*IF cTVSource NE "":U AND cTVSource NE ? THEN*/
                       END. /* IF NOT ERROR-STATUS:ERROR AND cTVSource NE "":U THEN */
                       IF DYNAMIC-FUNCTION('instanceOf':U IN hTarget, INPUT 'Container':U) THEN
                           RUN getRuntimeObjectNames (INPUT hTarget, INPUT pcExcludeObject, INPUT-OUTPUT TABLE ttObjectNames).
                   END.
               END. /*IF cTargets NE "" THEN*/
           END. /*IF DYNAMIC-FUNCTION('instanceOf':U IN hProc, INPUT 'Container':U) THEN*/
        END. /*IF NOT ERROR-STATUS:ERROR AND cObjectType NE ? THEN*/
    END. /* IF hProc NE ? THEN */

    ASSIGN phParent = phParent:NEXT-SIBLING NO-ERROR.
    IF ERROR-STATUS:ERROR THEN LEAVE.
END. /*REPEAT WHILE VALID-HANDLE(phParent):*/

RETURN.
END PROCEDURE.&ANALYZE-SUSPEND _VERSION-NUMBER AB_v10r12 GUI
&ANALYZE-RESUME
/* Connected Databases 
*/
&Scoped-define WINDOW-NAME CURRENT-WINDOW
&Scoped-define FRAME-NAME Dialog-Frame
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _DEFINITIONS Dialog-Frame 
/***********************************************************************
* Copyright (C) 2007 by Progress Software Corporation. All rights      *
* reserved.  Prior versions of this work may contain portions          *
* contributed by participants of Possenet.                             *
*                                                                      *
***********************************************************************/
/*------------------------------------------------------------------------

  File: adecomm/_getwidobjs.w

  Description: Dialog used for the 'Runtime Widget-id assignment tool' to
               get the runtime or design objects, to then be imported in that
               tool.

  Input Parameters:
      <none>

  Output Parameters:
      <none>

  Author: Marcelo Ferrante

  Created: Jun 13, 2007.
------------------------------------------------------------------------*/
/*          This .W file was created with the Progress AppBuilder.       */
/*----------------------------------------------------------------------*/

/* ***************************  Definitions  ************************** */
{src/adm2/globals.i}
{src/adm2/tttoolbar.i}
{src/adm2/ttaction.i}
{src/adm2/treettdef.i}
{adecomm/dswid.i}

DEFINE TEMP-TABLE ttStoreAttribute      NO-UNDO
    FIELD tAttributeParent      AS CHARACTER
    FIELD tAttributeParentObj   AS DECIMAL
    FIELD tAttributeLabel       AS CHARACTER
    FIELD tConstantValue        AS LOGICAL      INITIAL NO
    FIELD tCharacterValue       AS CHARACTER
    FIELD tDecimalValue         AS DECIMAL
    FIELD tIntegerValue         AS INTEGER
    FIELD tDateValue            AS DATE
    FIELD tRawValue             AS RAW
    FIELD tLogicalValue         AS LOGICAL
    INDEX idxParent
        tAttributeParent
    INDEX idxObj
        tAttributeParentObj
    .

/* Parameters Definitions ---                                           */
DEFINE INPUT  PARAMETER pcExcludeObjects AS CHARACTER NO-UNDO.
DEFINE INPUT  PARAMETER pcXMLFileName    AS CHARACTER NO-UNDO.
DEFINE INPUT  PARAMETER plAssignGaps     AS LOGICAL   NO-UNDO.
DEFINE INPUT-OUTPUT PARAMETER DATASET FOR dsWidgetID.

/* Local Variable Definitions ---                                       */
DEFINE VARIABLE hProcLibrary  AS HANDLE    NO-UNDO.
DEFINE VARIABLE gcObjectsType AS CHARACTER NO-UNDO.
DEFINE VARIABLE ghDSLibrary   AS HANDLE     NO-UNDO.
/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME


&ANALYZE-SUSPEND _UIB-PREPROCESSOR-BLOCK 

/* ********************  Preprocessor Definitions  ******************** */

&Scoped-define PROCEDURE-TYPE Dialog-Box
&Scoped-define DB-AWARE no

/* Name of designated FRAME-NAME and/or first browse and/or first query */
&Scoped-define FRAME-NAME Dialog-Frame
&Scoped-define BROWSE-NAME brObjects

/* Internal Tables (found by Frame, Query & Browse Queries)             */
&Scoped-define INTERNAL-TABLES ttObjectNames

/* Definitions for BROWSE brObjects                                     */
&Scoped-define FIELDS-IN-QUERY-brObjects ttObjectNames.lImport VIEW-AS TOGGLE-BOX ttObjectNames.isStatic ttObjectNames.cName   
&Scoped-define ENABLED-FIELDS-IN-QUERY-brObjects ttObjectNames.lImport   
&Scoped-define ENABLED-TABLES-IN-QUERY-brObjects ttObjectNames
&Scoped-define FIRST-ENABLED-TABLE-IN-QUERY-brObjects ttObjectNames
&Scoped-define SELF-NAME brObjects
&Scoped-define QUERY-STRING-brObjects FOR EACH ttObjectNames NO-LOCK INDEXED-REPOSITION
&Scoped-define OPEN-QUERY-brObjects OPEN QUERY {&SELF-NAME} FOR EACH ttObjectNames NO-LOCK INDEXED-REPOSITION.
&Scoped-define TABLES-IN-QUERY-brObjects ttObjectNames
&Scoped-define FIRST-TABLE-IN-QUERY-brObjects ttObjectNames


/* Definitions for DIALOG-BOX Dialog-Frame                              */
&Scoped-define OPEN-BROWSERS-IN-QUERY-Dialog-Frame ~
    ~{&OPEN-QUERY-brObjects}

/* Standard List Definitions                                            */
&Scoped-Define ENABLED-OBJECTS RECT-10 buGetObjects rsType brObjects Btn_OK ~
Btn_Cancel Btn_Help 
&Scoped-Define DISPLAYED-OBJECTS rsType 

/* Custom List Definitions                                              */
/* List-1,List-2,List-3,List-4,List-5,List-6                            */

/* _UIB-PREPROCESSOR-BLOCK-END */
&ANALYZE-RESUME


/* ************************  Function Prototypes ********************** */
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION-FORWARD isABRunning Dialog-Frame 
FUNCTION isABRunning RETURNS LOGICAL
  ( /* parameter-definitions */ )  FORWARD.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME


/* ***********************  Control Definitions  ********************** */

/* Define a dialog box                                                  */

/* Definitions of the field level widgets                               */
DEFINE BUTTON Btn_Cancel AUTO-END-KEY 
     LABEL "Cancel" 
     SIZE 15 BY 1.14
     BGCOLOR 8 .

DEFINE BUTTON Btn_Help 
     LABEL "&Help" 
     SIZE 15 BY 1.14
     BGCOLOR 8 .

DEFINE BUTTON Btn_OK AUTO-GO 
     LABEL "OK" 
     SIZE 15 BY 1.14
     BGCOLOR 8 .

DEFINE BUTTON buGetObjects 
     LABEL "Get Objects" 
     SIZE 14.6 BY 1.14.

DEFINE VARIABLE rsType AS CHARACTER 
     VIEW-AS RADIO-SET HORIZONTAL
     RADIO-BUTTONS 
          "Runtime", "Runtime",
"Design", "Design"
     SIZE 24.2 BY .71 NO-UNDO.

DEFINE RECTANGLE RECT-10
     EDGE-PIXELS 2 GRAPHIC-EDGE  NO-FILL   
     SIZE 42 BY 1.43.

/* Query definitions                                                    */
&ANALYZE-SUSPEND
DEFINE QUERY brObjects FOR 
      ttObjectNames SCROLLING.
&ANALYZE-RESUME

/* Browse definitions                                                   */
DEFINE BROWSE brObjects
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _DISPLAY-FIELDS brObjects Dialog-Frame _FREEFORM
  QUERY brObjects NO-LOCK DISPLAY
      ttObjectNames.lImport COLUMN-LABEL "Add" FORMAT "yes/no":U VIEW-AS TOGGLE-BOX
      ttObjectNames.isStatic COLUMN-LABEL "Static" FORMAT "Yes/No":U
      ttObjectNames.cName COLUMN-LABEL "Name" FORMAT "X(128)":U
ENABLE ttObjectNames.lImport
/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME
    WITH NO-ROW-MARKERS SEPARATORS SIZE 54 BY 14.05 FIT-LAST-COLUMN.


/* ************************  Frame Definitions  *********************** */

DEFINE FRAME Dialog-Frame
     buGetObjects AT ROW 1.29 COL 33.8 WIDGET-ID 202
     rsType AT ROW 1.57 COL 8.2 NO-LABEL WIDGET-ID 206
     brObjects AT ROW 2.81 COL 1 WIDGET-ID 2
     Btn_OK AT ROW 17 COL 1
     Btn_Cancel AT ROW 17 COL 16
     Btn_Help AT ROW 17 COL 40
     RECT-10 AT ROW 1.14 COL 7.4 WIDGET-ID 210
     SPACE(5.60) SKIP(15.57)
    WITH VIEW-AS DIALOG-BOX KEEP-TAB-ORDER 
         SIDE-LABELS NO-UNDERLINE THREE-D  SCROLLABLE 
         TITLE "Get Objects"
         DEFAULT-BUTTON Btn_OK CANCEL-BUTTON Btn_Cancel WIDGET-ID 100.


/* *********************** Procedure Settings ************************ */

&ANALYZE-SUSPEND _PROCEDURE-SETTINGS
/* Settings for THIS-PROCEDURE
   Type: Dialog-Box
   Allow: Basic,Browse,DB-Fields,Query
   Other Settings: COMPILE
 */
&ANALYZE-RESUME _END-PROCEDURE-SETTINGS



/* ***********  Runtime Attributes and AppBuilder Settings  *********** */

&ANALYZE-SUSPEND _RUN-TIME-ATTRIBUTES
/* SETTINGS FOR DIALOG-BOX Dialog-Frame
   FRAME-NAME                                                           */
/* BROWSE-TAB brObjects rsType Dialog-Frame */
ASSIGN 
       FRAME Dialog-Frame:SCROLLABLE       = FALSE
       FRAME Dialog-Frame:HIDDEN           = TRUE.

/* _RUN-TIME-ATTRIBUTES-END */
&ANALYZE-RESUME


/* Setting information for Queries and Browse Widgets fields            */

&ANALYZE-SUSPEND _QUERY-BLOCK BROWSE brObjects
/* Query rebuild information for BROWSE brObjects
     _START_FREEFORM
OPEN QUERY {&SELF-NAME} FOR EACH ttObjectNames NO-LOCK INDEXED-REPOSITION.
     _END_FREEFORM
     _Options          = "NO-LOCK INDEXED-REPOSITION"
     _Query            is OPENED
*/  /* BROWSE brObjects */
&ANALYZE-RESUME

 



/* ************************  Control Triggers  ************************ */

&Scoped-define SELF-NAME Dialog-Frame
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL Dialog-Frame Dialog-Frame
ON GO OF FRAME Dialog-Frame /* Get Objects */
DO:
    IF VALID-HANDLE(hProcLibrary) THEN
    DELETE OBJECT hProcLibrary.

    IF VALID-HANDLE(ghDSLibrary) THEN
    DELETE OBJECT ghDSLibrary.
END.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME


&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL Dialog-Frame Dialog-Frame
ON WINDOW-CLOSE OF FRAME Dialog-Frame /* Get Objects */
DO:
IF VALID-HANDLE(hProcLibrary) THEN
DELETE OBJECT hProcLibrary.

IF VALID-HANDLE(ghDSLibrary) THEN
DELETE OBJECT ghDSLibrary.
  APPLY "END-ERROR":U TO SELF.
END.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME


&Scoped-define SELF-NAME Btn_Help
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL Btn_Help Dialog-Frame
ON CHOOSE OF Btn_Help IN FRAME Dialog-Frame /* Help */
OR HELP OF FRAME {&FRAME-NAME}
DO: /* Call Help Function (or a simple message). */
  MESSAGE "Help for File: {&FILE-NAME}" VIEW-AS ALERT-BOX INFORMATION.
END.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME


&Scoped-define SELF-NAME Btn_OK
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL Btn_OK Dialog-Frame
ON CHOOSE OF Btn_OK IN FRAME Dialog-Frame /* OK */
DO:
RUN adecomm/_setcurs.p (INPUT "WAIT":U).
IF gcObjectsType = "Design":U THEN
DO:
    RUN getStaticDesignObject IN hProcLibrary (INPUT plAssignGaps, INPUT TABLE ttObjectNames, INPUT-OUTPUT DATASET dsWidgetID BY-REFERENCE).

    FOR EACH ttObjectNames WHERE ttObjectNames.lImport = TRUE AND 
                                 ttObjectNames.isStatic = TRUE:
            DYNAMIC-FUNCTION('setWidgetIDFileName':U IN hProcLibrary, INPUT ttObjectNames.cName, INPUT pcXMLFileName).
    END.

    IF CAN-FIND(FIRST ttObjectNames WHERE ttObjectNames.lImport  = TRUE AND
                                          ttObjectNames.isStatic = FALSE) THEN
       RUN getDynamicDesignObject (INPUT "Design":U).

END. /*IF gcObjectsType = "Design":U THEN*/
ELSE DO:
    IF CAN-FIND(FIRST ttObjectNames WHERE ttObjectNames.lImport  = TRUE AND
                                          ttObjectNames.isStatic = FALSE) THEN
        RUN getDynamicDesignObject (INPUT "Runtime":U).

    FOR EACH ttObjectNames WHERE ttObjectNames.lImport  = TRUE AND
                                 ttObjectNames.isStatic = TRUE:
        RUN getRuntimeObjectDetails (INPUT ttObjectNames.hHandle, INPUT plAssignGaps).
    END.
END.
RUN adecomm/_setcurs.p (INPUT "":U).
END.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME


&Scoped-define SELF-NAME buGetObjects
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL buGetObjects Dialog-Frame
ON CHOOSE OF buGetObjects IN FRAME Dialog-Frame /* Get Objects */
DO:
RUN adecomm/_setcurs.p (INPUT "WAIT":U).
EMPTY TEMP-TABLE ttObjectNames.

IF rsType:SCREEN-VALUE = "Design":U THEN
    RUN getDesignObjectNames IN hProcLibrary (INPUT pcExcludeObjects, INPUT-OUTPUT TABLE ttObjectNames).
ELSE
    RUN getRuntimeObjectNames IN ghDSLibrary (INPUT SESSION:FIRST-CHILD, INPUT pcExcludeObjects, INPUT-OUTPUT TABLE ttObjectNames).

{&OPEN-QUERY-{&BROWSE-NAME}}

ASSIGN gcObjectsType = rsType:SCREEN-VALUE.
RUN adecomm/_setcurs.p (INPUT "":U).
END.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME


&Scoped-define BROWSE-NAME brObjects
&UNDEFINE SELF-NAME

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _MAIN-BLOCK Dialog-Frame 


/* Parent the dialog-box to the ACTIVE-WINDOW, if there is no parent.   */
IF VALID-HANDLE(ACTIVE-WINDOW) AND FRAME {&FRAME-NAME}:PARENT eq ?
THEN FRAME {&FRAME-NAME}:PARENT = ACTIVE-WINDOW.


/* Now enable the interface and wait for the exit condition.            */
/* (NOTE: handle ERROR and END-KEY so cleanup code will always fire.    */
MAIN-BLOCK:
DO ON ERROR   UNDO MAIN-BLOCK, LEAVE MAIN-BLOCK
   ON END-KEY UNDO MAIN-BLOCK, LEAVE MAIN-BLOCK:

   IF NOT isABRunning() THEN
    rsType:DISABLE("Design":U).

   ELSE
    RUN adeuib/_widfunc.p PERSISTENT SET hProcLibrary.

   RUN adecomm/_dswidfunc.p PERSISTENT SET ghDSLibrary.

   RUN enable_UI.
   WAIT-FOR GO OF FRAME {&FRAME-NAME}.
END.
RUN disable_UI.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME


/* **********************  Internal Procedures  *********************** */ 
&IF DEFINED(EXCLUDE-getRuntimeObjectDetails) = 0 &THEN
		
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE getRuntimeObjectDetails Procedure
PROCEDURE getRuntimeObjectDetails:
/*------------------------------------------------------------------------------
    Purpose:
    Parameters: <none>
    Notes:
------------------------------------------------------------------------------*/
DEFINE INPUT  PARAMETER phObject     AS HANDLE     NO-UNDO.
DEFINE INPUT  PARAMETER plAssignGaps AS LOGICAL    NO-UNDO.

DEFINE VARIABLE cFile           AS CHARACTER  NO-UNDO.
DEFINE VARIABLE cPath           AS CHARACTER  NO-UNDO.
DEFINE VARIABLE hInstance       AS HANDLE     NO-UNDO.
DEFINE VARIABLE cActions        AS CHARACTER  NO-UNDO.
DEFINE VARIABLE cOldObjectType  AS CHARACTER  NO-UNDO.
DEFINE VARIABLE cObjectType     AS CHARACTER  NO-UNDO.
DEFINE VARIABLE cInstances      AS CHARACTER  NO-UNDO.
DEFINE VARIABLE iInstances      AS INTEGER    NO-UNDO.
DEFINE VARIABLE iInstance       AS INTEGER    NO-UNDO.
DEFINE VARIABLE lIsVisual       AS LOGICAL    NO-UNDO.
DEFINE VARIABLE lDuplicateNames AS LOGICAL    NO-UNDO.
DEFINE VARIABLE iLastWidgetID   AS INTEGER    NO-UNDO.
DEFINE VARIABLE iLastPage       AS INTEGER    NO-UNDO.
DEFINE VARIABLE lChanged        AS LOGICAL    NO-UNDO.
DEFINE VARIABLE cObjectName     AS CHARACTER  NO-UNDO.

&SCOPED-DEFINE xp-assign
{get ObjectType cObjectType phObject}
{get LogicalObjectName cObjectName phObject}
{get ContainerTarget cInstances phObject}.
&UNDEFINE xp-assign

ASSIGN iInstances = NUM-ENTRIES(cInstances).

IF NOT DYNAMIC-FUNCTION('createContainer':U IN ghDSLibrary,
                   INPUT ttObjectNames.cName,
                   INPUT cObjectType,
                   INPUT TRUE,
                   OUTPUT cFile,
                   OUTPUT cPath,
                   INPUT DATASET dsWidgetID BY-REFERENCE)
THEN RETURN.

REPEAT iInstance = 1 TO iInstances:

    ASSIGN hInstance   = WIDGET-HANDLE(ENTRY(iInstance, cInstances))
           lIsVisual   = DYNAMIC-FUNCTION('instanceOf' IN hInstance, INPUT "visual":U) NO-ERROR.

    IF NOT lIsVisual OR lIsVisual = ? THEN
        NEXT.

    DYNAMIC-FUNCTION('createContainerDetails':U IN ghDSLibrary,
        INPUT cFile,
        INPUT cPath,
        INPUT hInstance,
        INPUT "":U,
        INPUT TRUE,
        INPUT plAssignGaps,
        INPUT DATASET dsWidgetID BY-REFERENCE,
        OUTPUT lDuplicateNames,
        OUTPUT iLastPage,
        OUTPUT lChanged,
        INPUT-OUTPUT cActions,
        INPUT-OUTPUT iLastWidgetID,
        INPUT-OUTPUT cOldObjectType).
        
        IF iLastWidgetID > 65535 THEN
            ASSIGN plAssignGaps = FALSE.
END. /*REPEAT iInstance = 1 TO iInstances:*/

/*If we have actions, we have to create them*/
IF cActions NE "" THEN
DO:
    DYNAMIC-FUNCTION('createActions':U IN ghDSLibrary,
        INPUT cFile,
        INPUT cPath,
        INPUT cActions,
        INPUT DATASET dsWidgetID BY-REFERENCE).

    ASSIGN cActions  = "". 
END. /*IF cActions NE "" THEN*/

RETURN.
END PROCEDURE.
	
/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME

&ENDIF 

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE disable_UI Dialog-Frame  _DEFAULT-DISABLE
PROCEDURE disable_UI :
/*------------------------------------------------------------------------------
  Purpose:     DISABLE the User Interface
  Parameters:  <none>
  Notes:       Here we clean-up the user-interface by deleting
               dynamic widgets we have created and/or hide 
               frames.  This procedure is usually called when
               we are ready to "clean-up" after running.
------------------------------------------------------------------------------*/
  /* Hide all frames. */
  HIDE FRAME Dialog-Frame.
END PROCEDURE.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE enable_UI Dialog-Frame  _DEFAULT-ENABLE
PROCEDURE enable_UI :
/*------------------------------------------------------------------------------
  Purpose:     ENABLE the User Interface
  Parameters:  <none>
  Notes:       Here we display/view/enable the widgets in the
               user-interface.  In addition, OPEN all queries
               associated with each FRAME and BROWSE.
               These statements here are based on the "Other 
               Settings" section of the widget Property Sheets.
------------------------------------------------------------------------------*/
  DISPLAY rsType 
      WITH FRAME Dialog-Frame.
  ENABLE RECT-10 buGetObjects rsType brObjects Btn_OK Btn_Cancel Btn_Help 
      WITH FRAME Dialog-Frame.
  VIEW FRAME Dialog-Frame.
  {&OPEN-BROWSERS-IN-QUERY-Dialog-Frame}
END PROCEDURE.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE getDynamicDesignObject Dialog-Frame 
PROCEDURE getDynamicDesignObject :
/*------------------------------------------------------------------------------
  Purpose:     
  Parameters:  <none>
  Notes:       
------------------------------------------------------------------------------*/
DEFINE INPUT  PARAMETER pcObjectState AS CHARACTER  NO-UNDO.

DEFINE VARIABLE cPropertyNames    AS CHARACTER NO-UNDO.
DEFINE VARIABLE cPropertyValues   AS CHARACTER NO-UNDO.
DEFINE VARIABLE dObjectId         AS DECIMAL   NO-UNDO.
DEFINE VARIABLE cObjectType       AS CHARACTER NO-UNDO.
DEFINE VARIABLE cRootNodeCode     AS CHARACTER NO-UNDO.
DEFINE VARIABLE cPath             AS CHARACTER NO-UNDO.
DEFINE VARIABLE cFile             AS CHARACTER NO-UNDO.
DEFINE VARIABLE cActions          AS CHARACTER NO-UNDO.
DEFINE VARIABLE iLastPage         AS INTEGER   NO-UNDO.
DEFINE VARIABLE lChanged          AS HANDLE    NO-UNDO.
DEFINE VARIABLE cNodes            AS CHARACTER NO-UNDO.
DEFINE VARIABLE cWidgetIDFileName AS CHARACTER  NO-UNDO.
DEFINE VARIABLE cRelName          AS CHARACTER  NO-UNDO.
DEFINE VARIABLE lOk               AS LOGICAL    NO-UNDO.
DEFINE VARIABLE dObjectObj        AS DECIMAL    NO-UNDO.
DEFINE VARIABLE hTmp              AS HANDLE     NO-UNDO.

/*Gets all the Dynamic containers in design mode.*/
FOR EACH ttObjectNames WHERE ttObjectNames.lImport  = TRUE AND
                             ttObjectNames.isStatic = FALSE NO-LOCK:

    /*Gets the class name and instanceID for the current container*/
    ASSIGN cPropertyNames = "ClassName,InstanceId,RootNodeCode,WidgetIDFileName":U.
    RUN getInstanceProperties IN gshRepositoryManager (
        INPUT        ttObjectNames.cName,
        INPUT        "", 
        INPUT-OUTPUT cPropertyNames,
              OUTPUT cPropertyValues) NO-ERROR.

    ASSIGN dObjectId     = DECIMAL(ENTRY(LOOKUP("InstanceId":U, cPropertyNames), cPropertyValues, CHR(1)))
           cObjectType   = ENTRY(LOOKUP("ClassName":U, cPropertyNames), cPropertyValues, CHR(1))
           cRootNodeCode = IF CAN-DO(cPropertyNames, "RootNodeCode":U) THEN ENTRY(LOOKUP("RootNodeCode":U, cPropertyNames), cPropertyValues, CHR(1)) ELSE ""
           cWidgetIDFileName = ENTRY(LOOKUP("WidgetIDFileName":U, cPropertyNames), cPropertyValues, CHR(1)).

    IF cWidgetIDFileName = "":U THEN
        ASSIGN cWidgetIDFileName = ttObjectNames.cName + ".xml".

    ASSIGN cRelName = DYNAMIC-FUNCTION('getRelativeName':U IN ghDSLibrary, INPUT pcXMLFileName).

    /*We tell the user if the widgetidFileName stored in the repository is different than the widget-id file name
      being edited in the tool.*/
    IF cWidgetIDFileName NE cRelName THEN    DO:
        /*If we are in design mode, the user is given to the option to update the widget-id file name in the
          repository.*/
        IF pcObjectState = "Design":U THEN
        DO:
            MESSAGE "The WidgetID File Name assigned for the container '" + ttObjectNames.cName + "' is different than the" SKIP
                    "WidgetID file name being edited in this tool." SKIP(1)
                    "Do you want to assign the new WidgetID file Name '" + cRelName + "' to the selected Container?"
               VIEW-AS ALERT-BOX QUESTION BUTTONS YES-NO
               TITLE FRAME dialog-frame:TITLE
               UPDATE lOk.

            /*If the user decides to update the widget-id file name, we do it using the 
              Repository Manager API.*/
            IF lOk THEN
            DO:
                CREATE ttStoreAttribute.
                ASSIGN dObjectObj                           = DYNAMIC-FUNCTION('getSmartObjectObj' IN gshRepositoryManager, INPUT ttObjectNames.cName, INPUT 0)
                       ttStoreAttribute.tAttributeParent    = 'Master':U
                       ttStoreAttribute.tAttributeParentObj = dObjectObj
                       ttStoreAttribute.tAttributeLabel     = "WidgetIDFileName":U
                       ttStoreAttribute.tCharacterValue     = cRelName
                       ttStoreAttribute.tConstantValue      = NO.
                RUN storeAttributeValues IN gshRepositoryManager (INPUT BUFFER ttStoreAttribute:HANDLE, INPUT TABLE-HANDLE hTmp).

                DYNAMIC-FUNCTION('refreshDPS' IN hProcLibrary, STRING(dObjectObj), STRING(dObjectObj), "WidgetIDFileName":U, cRelName).
            END. /*IF lOk THEN*/
        END. /* IF pcObjectState = "Design":U THEN*/
        /*If we are in runtime, we only warn the user, but he/she cannot modify the widget-id file name in the
          repository.*/
        ELSE MESSAGE "The WidgetID File Name assigned for the container '" + ttObjectNames.cName + "' is different than the" SKIP
                     "WidgetID file name being edited in this tool." SKIP(1)
                     VIEW-AS ALERT-BOX WARNING
                     TITLE FRAME dialog-frame:TITLE.
    END. /*IF cWidgetIDFileName NE cRelName THEN*/

    IF NOT DYNAMIC-FUNCTION('createContainer':U IN ghDSLibrary,
                 INPUT ttObjectNames.cName,
                 INPUT cObjectType,
                 INPUT TRUE,
                 OUTPUT cFile,
                 OUTPUT cPath,
                 INPUT DATASET dsWidgetID BY-REFERENCE)
    THEN NEXT.

    DYNAMIC-FUNCTION('createDynContainerDetails':U IN ghDSLibrary,
        INPUT ttObjectNames.cName,
        INPUT dObjectID,
        INPUT cRootNodeCode,
        INPUT plAssignGaps,
        INPUT DATASET dsWidgetID BY-REFERENCE,
        OUTPUT iLastPage,
        OUTPUT lChanged,
        OUTPUT cNodes,
        INPUT-OUTPUT cActions).

END. /*FOR EACH ttObjectNames*/

RETURN.
END PROCEDURE.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME

/* ************************  Function Implementations ***************** */

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION isABRunning Dialog-Frame 
FUNCTION isABRunning RETURNS LOGICAL
  ( /* parameter-definitions */ ) :
/*------------------------------------------------------------------------------
  Purpose:  
    Notes:  
------------------------------------------------------------------------------*/
  DEFINE VARIABLE iLevel AS INTEGER NO-UNDO INITIAL 1. 
  
  REPEAT WHILE PROGRAM-NAME(iLevel) <> ?.
    IF PROGRAM-NAME(iLevel) = "adeuib/_uibmain.p" THEN RETURN TRUE.
    ASSIGN iLevel = iLevel + 1.
  END.

  RETURN FALSE.   /* Function return value. */
END FUNCTION.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME


/*--------------------------------------------------------------------------------
    File        : _widgaps.p
    Purpose     : Returns the default widget-id gap for the specified object type.	

    Syntax      :

    Description : 

    Author(s)   : Marcelo Ferrante
    Created     : Thu May 24 17:53:33 EDT 2007
    Notes       : This file is used by the 'Runtime Widget-id assgnment tool'
                  to leave enough space between the SmartObject widget-ids, in
                  order to avoid duplicates.
                  These values are separated from the tool itself to allow
                  developers or QA engineers to customize these values.

                  In order to modify these values it is required to change the
                  value of piWidgetID for the required object type.
  -------------------------------------------------------------------------------*/

/* ***************************  Definitions  ************************** */

/* ********************  Preprocessor Definitions  ******************** */

/* ************************  Function Prototypes ********************** */

FUNCTION getWidgetIDGap RETURNS INTEGER 
	(INPUT pcObjectType AS CHARACTER) FORWARD.

/* ***************************  Main Block  *************************** */

/* ************************  Function Implementations ***************** */

FUNCTION getWidgetIDGap RETURNS INTEGER 
    (INPUT pcObjectType AS CHARACTER):
/*------------------------------------------------------------------------------
    Purpose:
    Notes:
------------------------------------------------------------------------------*/
CASE pcObjectType:
    WHEN "FRAME":U               THEN RETURN 200.
    WHEN "SmartDataBrowser":U    THEN RETURN 250.
    WHEN "DynBrow":U             THEN RETURN 250.
    WHEN "SmartViewer":U         THEN RETURN 1000.
    WHEN "SmartDataViewer":U     THEN RETURN 1000.
    WHEN "DynView":U             THEN RETURN 1000.
    WHEN "DataField":U           THEN RETURN 4.
    WHEN "SmartDataField":U      THEN RETURN 20.
    WHEN "DynCombo":U            THEN RETURN 10.
    WHEN "DynLookup":U           THEN RETURN 10.
    WHEN "SmartFilter":U         THEN RETURN 100.
    WHEN "FilterField":U         THEN RETURN 6.
    WHEN "SmartToolbar":U        THEN RETURN 200.
    WHEN "Toolbar":U             THEN RETURN 200.
    WHEN "SmartToolbarActions":U THEN RETURN 2.
    WHEN "SmartSelect":U         THEN RETURN 10.
    WHEN "SmartFolder":U         THEN RETURN 1000.
    WHEN "SmartFrame":U          THEN RETURN 2000.
    WHEN "SmartFolderPage":U     THEN RETURN 20.
    WHEN "SmartLOBField":U       THEN RETURN 10.
    WHEN "SmartPanel":U          THEN RETURN 50.
    WHEN "TreeNode":U            THEN RETURN 2000.
    OTHERWISE RETURN 500.
END. /* case */
END FUNCTION./***********************************************************************
* Copyright (C) 2007 by Progress Software Corporation. All rights      *
* reserved.  Prior versions of this work may contain portions          *
* contributed by participants of Possenet.                             *
*                                                                      *
***********************************************************************/
/*------------------------------------------------------------------------
    File        : dswid.i
    Purpose     : 

    Syntax      :

    Description : Temp-Tables and ProDataSet definitions for the
                  implementation of the WIDGET-ID support.

    Author(s)   : Marcelo Ferrante
    Created     : Tue May 08 16:31:22 EDT 2007
    Notes       : The ProDataSet definitions matchs the definition of the
                  XML file that stores the widget-id values.
                  WRITE-XML and READ-XML can then be used to synchronize
                  values between the XML file and ProDataSet.
 
  ----------------------------------------------------------------------*/

/* ***************************  Definitions  ************************** */


/* ********************  Preprocessor Definitions  ******************** */


/* ***************************  Main Block  *************************** */

DEFINE TEMP-TABLE Container NO-UNDO BEFORE-TABLE before_Container
FIELD contName   AS CHARACTER XML-NODE-NAME "Name":U XML-NODE-TYPE "ATTRIBUTE":U
FIELD contPath   AS CHARACTER XML-NODE-NAME "Path":U XML-NODE-TYPE "ATTRIBUTE":U
FIELD ObjectType AS CHARACTER XML-NODE-TYPE "ATTRIBUTE":U
INDEX containerID AS UNIQUE contPath contName.

DEFINE TEMP-TABLE Instances NO-UNDO
FIELD contName AS CHARACTER XML-NODE-TYPE "HIDDEN":U
FIELD contPath AS CHARACTER XML-NODE-TYPE "HIDDEN":U
INDEX parentid AS UNIQUE contPath contName.

DEFINE TEMP-TABLE Instance NO-UNDO BEFORE-TABLE before_Instance
FIELD ID         AS CHARACTER XML-NODE-TYPE "ATTRIBUTE":U
FIELD contPath   AS CHARACTER XML-NODE-TYPE "HIDDEN":U
FIELD contName   AS CHARACTER XML-NODE-TYPE "HIDDEN":U
FIELD ObjectType AS CHARACTER XML-NODE-TYPE "ATTRIBUTE":U
FIELD WidgetID   AS INTEGER   XML-NODE-TYPE "ATTRIBUTE":U
INDEX ckey       AS PRIMARY UNIQUE contPath contName ID
INDEX cWidgetID  contPath contName WidgetID.

DEFINE TEMP-TABLE InstanceChildren NO-UNDO BEFORE-TABLE before_InstanceChildren
FIELD ID               AS CHARACTER XML-NODE-TYPE "ATTRIBUTE":U
FIELD contPath         AS CHARACTER XML-NODE-TYPE "HIDDEN":U
FIELD contName         AS CHARACTER XML-NODE-TYPE "HIDDEN":U
FIELD parentInstanceID AS CHARACTER XML-NODE-TYPE "HIDDEN":U
FIELD ObjectType       AS CHARACTER XML-NODE-TYPE "ATTRIBUTE":U
FIELD WidgetID         AS INTEGER   XML-NODE-TYPE "ATTRIBUTE":U
INDEX ckey             AS PRIMARY UNIQUE contPath contName parentInstanceID ID.

DEFINE TEMP-TABLE ParentPages NO-UNDO XML-NODE-NAME "Pages":U
FIELD contName AS CHARACTER XML-NODE-TYPE "HIDDEN":U
FIELD contPath AS CHARACTER XML-NODE-TYPE "HIDDEN":U
INDEX parentid AS PRIMARY UNIQUE contPath contName.

DEFINE TEMP-TABLE Pages NO-UNDO XML-NODE-NAME "Page":U BEFORE-TABLE before_Pages
FIELD contPath   AS CHARACTER XML-NODE-TYPE "HIDDEN":U
FIELD contName   AS CHARACTER XML-NODE-TYPE "HIDDEN":U
FIELD pageNumber AS INTEGER   XML-NODE-TYPE "ATTRIBUTE":U XML-NODE-NAME "ID":U
FIELD pageLabel  AS CHARACTER XML-NODE-TYPE "ATTRIBUTE":U XML-NODE-NAME "Label":U
FIELD WidgetID   AS INTEGER   XML-NODE-TYPE "ATTRIBUTE":U
INDEX pageNumber AS PRIMARY UNIQUE contPath contName PageNumber.

DEFINE TEMP-TABLE Actions NO-UNDO XML-NODE-NAME "ToolbarButtons":U
FIELD contName AS CHARACTER XML-NODE-TYPE "HIDDEN":U
FIELD contPath AS CHARACTER XML-NODE-TYPE "HIDDEN":U
INDEX parentid AS PRIMARY UNIQUE contPath contName.

DEFINE TEMP-TABLE Action NO-UNDO XML-NODE-NAME "Button":U BEFORE-TABLE before_Action
FIELD contPath    AS CHARACTER XML-NODE-TYPE "HIDDEN":U
FIELD contName    AS CHARACTER XML-NODE-TYPE "HIDDEN":U
FIELD actionID    AS CHARACTER XML-NODE-TYPE "ATTRIBUTE":U XML-NODE-NAME "ID":U
FIELD actionLabel AS CHARACTER XML-NODE-TYPE "ATTRIBUTE":U XML-NODE-NAME "Label":U
FIELD WidgetID    AS INTEGER   XML-NODE-TYPE "ATTRIBUTE":U
INDEX actionID AS PRIMARY UNIQUE contPath contName actionID.

DEFINE TEMP-TABLE TreeNodes NO-UNDO XML-NODE-NAME "TreeViewNodes":U
FIELD contName AS CHARACTER XML-NODE-TYPE "HIDDEN":U
FIELD contPath AS CHARACTER XML-NODE-TYPE "HIDDEN":U
INDEX parentid AS UNIQUE contPath contName.

DEFINE TEMP-TABLE TreeNode NO-UNDO BEFORE-TABLE before_TreeNode
FIELD ID         AS CHARACTER XML-NODE-TYPE "ATTRIBUTE":U
FIELD cLabel     AS CHARACTER XML-NODE-TYPE "ATTRIBUTE":U XML-NODE-NAME "Label":U
FIELD contPath   AS CHARACTER XML-NODE-TYPE "HIDDEN":U
FIELD contName   AS CHARACTER XML-NODE-TYPE "HIDDEN":U
FIELD ObjectType AS CHARACTER XML-NODE-TYPE "ATTRIBUTE":U
FIELD WidgetID   AS INTEGER   XML-NODE-TYPE "ATTRIBUTE":U
INDEX ckey       AS PRIMARY UNIQUE contPath contName ID
INDEX cWidgetID  contPath contName widgetID.

DEFINE DATASET dsWidgetID     FOR Container, parentPages, Pages, Actions, Action,
                                  Instances, Instance, instanceChildren,
                                  TreeNodes, TreeNode
    DATA-RELATION contAction  FOR Container, parentPages    
        RELATION-FIELDS(contPath,contPath,contName,contName) NESTED
    DATA-RELATION contPage    FOR parentPages, Pages
        RELATION-FIELDS(contPath,contPath,contName,contName) NESTED
    DATA-RELATION contAction  FOR Container, Actions    
        RELATION-FIELDS(contPath,contPath,contName,contName) NESTED
    DATA-RELATION Action      FOR Actions, Action    
        RELATION-FIELDS(contPath,contPath,contName,contName) NESTED
    DATA-RELATION contInst    FOR Container, Instances
        RELATION-FIELDS(contPath,contPath,contName,contName) NESTED
    DATA-RELATION contInst    FOR Instances, Instance
        RELATION-FIELDS(contPath,contPath,contName,contName) NESTED
    DATA-RELATION relInstance FOR Instance, instanceChildren
        RELATION-FIELDS(ID,parentInstanceID,contPath,contPath,contName,contName) NESTED
    DATA-RELATION contTrees   FOR Container, TreeNodes
        RELATION-FIELDS(contPath,contPath,contName,contName) NESTED
    DATA-RELATION contTree    FOR TreeNodes, TreeNode
        RELATION-FIELDS(contPath,contPath,contName,contName) NESTED
        .

DEFINE TEMP-TABLE ttObjectNames NO-UNDO
FIELD lImport  AS LOGICAL INITIAL TRUE
FIELD cName    AS CHARACTER
FIELD isStatic AS LOGICAL
FIELD hHandle  AS HANDLE
INDEX lImport limport
INDEX cname cname./*********************************************************************
* Copyright (C) 2009 by Progress Software Corporation. All rights    *
* reserved.                                                          *
*                                                                    *
*********************************************************************/

/*----------------------------------------------------------------------------

File: _altbufdat.p

Description:
   Display _Field information for the quick field report.  It will go to 
   the currently set output device (e.g., a file, the printer).
 
Input Parameters:
   p_DbId  - Id of the _Db record for this database. Not used.

Author: Fernando de Souza

Date Created: 04/07/09

----------------------------------------------------------------------------*/

{prodict/sec/sec-pol.i}
{ prodict/misc/misc-funcs.i }

DEFINE INPUT PARAMETER p_DbId AS RECID NO-UNDO.


DEFINE SHARED STREAM rpt.

DEF VAR myObjAttrs     AS prodict.pro._obj-attrib-util NO-UNDO.
DEF VAR cObj           AS CHARACTER                    NO-UNDO.
DEF VAR cTable         AS CHARACTER                    NO-UNDO.
DEF VAR line           AS CHAR                         NO-UNDO.
DEF VAR areaName       AS CHAR                         NO-UNDO.
DEF VAR lStopped       AS LOGICAL                      NO-UNDO.

/* for quick report */
FORM
   cObj                         FORMAT "x(43)"  COLUMN-LABEL "Object!Name" 
   areaName                     FORMAT "x(20)"  COLUMN-LABEL "Area!Name" 
   WITH FRAME quick-report USE-TEXT STREAM-IO DOWN.

/* For general long text strings.  line is formatted as appropriate. */
FORM
   line FORMAT "x(77)" NO-LABEL
   WITH FRAME rptline NO-ATTR-SPACE DOWN NO-BOX USE-TEXT STREAM-IO.

/* Main block */
IF NOT CONNECTED("DICTDB") THEN DO:
    MESSAGE "DICTDB database is required but it is not connected."
        VIEW-AS ALERT-BOX ERROR BUTTONS OK.
    RETURN "".
END.

IF NOT dbAdmin(USERID("DICTDB")) THEN DO:
  MESSAGE "You must be a Security Administrator to run this report."
      VIEW-AS ALERT-BOX ERROR BUTTONS OK.
  RETURN "".
END.

IF DBTYPE("DICTDB") NE "PROGRESS" THEN DO:
    MESSAGE "Cannot use this option with this database type."
        VIEW-AS ALERT-BOX ERROR BUTTONS OK.
    RETURN "".
END.

/* get buffer-pool information now */
DO TRANSACTION ON ERROR UNDO, LEAVE
               ON STOP  UNDO, LEAVE:

   lStopped = YES.

   /* this will acquire a schema lock for us on the DICTDB database */
   myObjAttrs = NEW prodict.pro._obj-attrib-util().

   /* if this is the detailed report, we want to get the area number for the
      objects too.
   */
   myObjAttrs:FillAreaNum = YES.

   /* populate the dataset with the objects assignable to the 
     alternate buffer pool */
   myObjAttrs:getTableList(OUTPUT DATASET dsObjAttrs BY-REFERENCE).

   FOR EACH ttObjAttrs.
       /* just want the ones that are assigned to the alternate buffer pool
          at the object or area level.
       */
       IF ttObjAttrs.obj-buf-pool = "Primary" AND 
          ttObjAttrs.area-buf-pool = "Primary" THEN DO:
           DELETE ttObjAttrs.
           NEXT.
       END.
   END.

   /* check if there is anything to be reported */
   IF NOT CAN-FIND (FIRST ttObjAttrs) THEN DO:
      PUT STREAM rpt UNFORMATTED "All objects are assigned to the primary buffer pool."
              SKIP.
   END.

   lStopped = NO.

   CATCH ae AS PROGRESS.Lang.AppError:
       MESSAGE ae:GetMessage(1) 
               VIEW-AS ALERT-BOX ERROR BUTTONS OK.
       DELETE OBJECT ae.
   END CATCH.
   FINALLY:
      IF VALID-OBJECT(myObjAttrs) THEN
         DELETE OBJECT myObjAttrs NO-ERROR.
   END FINALLY. 
END.

/* if we got a stop condition (such as a canceled lock), stop it now */
IF lStopped THEN
    STOP.

/* message was logged above */
IF NOT CAN-FIND (FIRST ttObjAttrs) THEN
   RETURN.

RUN doQuickReport.

PROCEDURE doQuickReport:
    DEF VAR hArea            AS HANDLE  NO-UNDO.
    DEF VAR iLast            AS INT     NO-UNDO.
    DEF VAR cTmp             AS CHAR    NO-UNDO.
    DEF VAR foundNotAssigned AS LOGICAL NO-UNDO.
    DEF VAR skipLine         AS LOGICAL NO-UNDO.

    ASSIGN cTmp = LDBNAME("DICTDB") + "._Area".
    CREATE BUFFER hArea FOR TABLE cTmp NO-ERROR.

    IF CAN-FIND (FIRST ttObjAttrs WHERE ttObjAttrs.obj-buf-pool NE "Primary") THEN DO:
        DISPLAY STREAM rpt 
            "List of object-level assignable objects that are assigned to the"
            @ line
            WITH FRAME rptline.
        DOWN STREAM rpt 1 WITH FRAME rptline.
        DISPLAY STREAM rpt 
            "alternate buffer pool at the object level"
            @ line
            WITH FRAME rptline.
        DOWN STREAM rpt 1 WITH FRAME rptline.
        skipLine = YES.
    END.

    /* first the objects assigned at the object level */
    FOR EACH ttObjAttrs WHERE ttObjAttrs.obj-buf-pool NE "Primary":
        
        IF ttObjAttrs.obj-type NE "TABLE" THEN DO:
            /* for table.object, strip out the table part */
           IF cTable NE ENTRY(1, ttObjAttrs.obj-name, ".") THEN DO:
               ASSIGN cTable = ENTRY(1, ttObjAttrs.obj-name, ".")
                      foundNotAssigned = YES.
               /* the table itself is not assigned, so
                  we will log the table name so the object appears
                  indented underneath it.
               */
               DISPLAY STREAM rpt 
                   ENTRY(1, ttObjAttrs.obj-name,".") + " (*)" @ cObj
                   WITH FRAME quick-report.
               DOWN STREAM rpt WITH FRAME quick-report.
           END.
           /* this will appear indented under the table name */
           ASSIGN cObj = " - " + ENTRY(2, ttObjAttrs.obj-name, ".") 
                          + " (" + ttObjAttrs.obj-type + ")".
        END.
        ELSE
            ASSIGN  cTable = ttObjAttrs.obj-name
                    cObj = cTable.

        /* try to get the area name. If the area number is the same as
           the previous one, we already got it
        */
        IF iLast NE ttObjAttrs.obj-area THEN DO:
            iLast = ttObjAttrs.obj-area.
            IF ttObjAttrs.obj-area NE ? THEN
               hArea:FIND-FIRST("where _Area-number = " + STRING(ttObjAttrs.obj-area), NO-LOCK) NO-ERROR.
            IF hArea:AVAILABLE THEN DO:
                areaName = hArea::_Area-name.
                hArea:BUFFER-RELEASE().
            END.
            ELSE
                areaName = "".
        END.

        DISPLAY STREAM rpt
            cObj
            areaName
            WITH FRAME quick-report.
        DOWN STREAM rpt WITH FRAME quick-report.

        /* done with this */
        IF ttObjAttrs.area-buf-pool = "Primary" THEN
           DELETE ttObjAttrs.
    END.

    IF foundNotAssigned THEN DO:
        IF skipLine THEN 
            DOWN STREAM rpt 1 WITH FRAME rptline.

        DISPLAY STREAM rpt 
            "(*) Table not assigned to the alternate buffer pool at the object level"
            @ line
            WITH FRAME rptline.
        DOWN STREAM rpt 1 WITH FRAME rptline.
    END.

    /* now check if there are objects assigned at the area level */
    IF CAN-FIND(FIRST ttObjAttrs) THEN DO:
        IF skipLine THEN 
            DOWN STREAM rpt 1 WITH FRAME rptline.

        DISPLAY STREAM rpt 
            "List of object-level assignable objects that are assigned to the"
            @ line
            WITH FRAME rptline.
        DOWN STREAM rpt 1 WITH FRAME rptline.
        DISPLAY STREAM rpt 
            "alternate buffer pool at the area level"
            @ line
            WITH FRAME rptline.
        DOWN STREAM rpt 1 WITH FRAME rptline.

        cTable = "".

        FOR EACH ttObjAttrs:

            IF ttObjAttrs.obj-type NE "TABLE" THEN DO:
                /* for table.object, strip out the table part */
               IF cTable NE ENTRY(1, ttObjAttrs.obj-name, ".") THEN DO:
                   ASSIGN cTable = ENTRY(1, ttObjAttrs.obj-name, ".").
                   /* the table itself is not assigned, so
                      we will log the table name so the object appears
                      indented underneath it.
                   */
                   DISPLAY STREAM rpt 
                       ENTRY(1, ttObjAttrs.obj-name,".") + " (*)" @ cObj
                       WITH FRAME quick-report.
                   DOWN STREAM rpt WITH FRAME quick-report.
               END.
               /* this will appear indented under the table name */
               ASSIGN cObj = " - " + ENTRY(2, ttObjAttrs.obj-name, ".") 
                              + " (" + ttObjAttrs.obj-type + ")".
            END.
            ELSE
                ASSIGN  cTable = ttObjAttrs.obj-name
                        cObj = cTable.

            /* try to get the area name. If the area number is the same as
               the previous one, we already got it
            */
            IF iLast NE ttObjAttrs.obj-area THEN DO:
                iLast = ttObjAttrs.obj-area.
                IF ttObjAttrs.obj-area NE ? THEN
                   hArea:FIND-FIRST("where _Area-number = " + STRING(ttObjAttrs.obj-area), NO-LOCK) NO-ERROR.
                IF hArea:AVAILABLE THEN DO:
                    areaName = hArea::_Area-name.
                    hArea:BUFFER-RELEASE().
                END.
                ELSE
                    areaName = "".
            END.

            DISPLAY STREAM rpt
                cObj
                areaName
                WITH FRAME quick-report.
            DOWN STREAM rpt WITH FRAME quick-report.
        END.

    END.

    IF VALID-HANDLE(hArea) THEN
        DELETE OBJECT hArea.

END PROCEDURE.


/*********************************************************************
* Copyright (C) 2009 by Progress Software Corporation. All rights    *
* reserved.                                                          *
*                                                                    *
*********************************************************************/

/*----------------------------------------------------------------------------

File: _altbufrpt.p

Description:
   Alternate buffer pool report for both the GUI and character dictionaries.
 
Input Parameters:
   /*p_LName  - Logical name of the database*/
   p_DbId    - Id of the _Db record corresponding to the current database

Author: Fernando de Souza

Date Created: 04/07/09

----------------------------------------------------------------------------*/
&GLOBAL-DEFINE WIN95-BTN YES
{adecomm/commeng.i}  /* Help contexts */

DEFINE INPUT PARAMETER p_DbId 	 AS RECID NO-UNDO.

DEFINE VAR header_str AS CHAR 	 NO-UNDO.


header_str =  " Alternate Buffer Pool information".

RUN adecomm/_report.p 
   (INPUT p_DbId,
    INPUT header_str,
    INPUT "Quick Alternate Buffer Pool Report",
    INPUT "",
    INPUT "",
    INPUT "adecomm/_altbufdat.p",
    INPUT "",
    INPUT {&Quick_Alternate_Buffer_Pool_Report}).


RETURN RETURN-VALUE.
/*********************************************************************
* Copyright (C) 2008-2009 by Progress Software Corporation. All rights *
* reserved.                                                          *
*                                                                    *
*********************************************************************/

/*----------------------------------------------------------------------------

File: _encpdat.p

Description:
   Display encryption policy info for the quick and detailed encryption policy
   report.  It will go to the currently set output device (e.g., a file,
   the printer).
 
Input Parameters:
    p_RepId =  Numeric Identifier of the report being called.
               1 = quick report
               2 = detailed report
   p_Tbl   - The name of the table to report on - or ALL for all tables.

Author: Fernando de Souza

Date Created: 10/28/08
    
    Modified: 

----------------------------------------------------------------------------*/
{ prodict/sec/sec-pol.i }
{ prodict/misc/misc-funcs.i }

DEFINE INPUT PARAMETER p_RepId   AS INT NO-UNDO.
DEFINE INPUT PARAMETER p_Tbl     AS CHAR  NO-UNDO.

DEFINE SHARED STREAM rpt.

DEF VAR myEPolicyCache AS prodict.sec._sec-pol-util NO-UNDO.
DEF VAR isQuick        AS LOGICAL                   NO-UNDO.
DEF VAR cObj           AS CHARACTER                 NO-UNDO.
DEF VAR cTable         AS CHARACTER                 NO-UNDO.
DEF VAR line           AS CHAR                      NO-UNDO.
DEF VAR areaName       AS CHAR                      NO-UNDO.
DEF VAR lStopped       AS LOGICAL                   NO-UNDO.

DEFINE VAR separators AS CHAR EXTENT 3 NO-UNDO INITIAL 
[
  "=========================================================================",
  "============================= Table: ",
  "-------------------------------------------------------------------------"
].

&GLOBAL-DEFINE SEP_NEXTTBL    1
&GLOBAL-DEFINE SEP_TBLNAME    2
&GLOBAL-DEFINE SEP_OTHER      3
&GLOBAL-DEFINE SEP_TBLEND    " " + STRING(separators[{&SEP_NEXTTBL}],  SUBSTITUTE("x(&1)", 35 - LENGTH(cTable,"RAW":u)))

/* for quick report */
FORM
   cObj                         FORMAT "x(43)"  COLUMN-LABEL "Object!Name" 
   ttObjEncPolicyVersions.pol-cipher   FORMAT "x(20)"  COLUMN-LABEL "Cipher Name!(Current Policy)" 
   ttObjEncPolicyVersions.pol-version  FORMAT ">>>9"   COLUMN-LABEL "Policy!Version"
   WITH FRAME quick-report USE-TEXT STREAM-IO DOWN.

/* For general long text strings.  line is formatted as appropriate. */
FORM
   line FORMAT "x(77)" NO-LABEL
   WITH FRAME rptline NO-ATTR-SPACE DOWN NO-BOX USE-TEXT STREAM-IO.

/* for detailed report */
FORM 
    ttObjAttrs.obj-name  AT 2 FORMAT "x(65)" LABEL "Object Name "
    ttObjAttrs.obj-type  AT 2 FORMAT "x(32)" LABEL "Object Type " 
    areaName               AT 2 FORMAT "x(42)" LABEL "Storage Area"
    WITH FRAME obj-info SIDE-LABELS NO-ATTR-SPACE DOWN NO-BOX 
                        USE-TEXT STREAM-IO.

/* for detailed report */
FORM
    ttObjEncPolicyVersions.pol-version AT 8 FORMAT ">>>9"   COLUMN-LABEL "Policy Version"
    ttObjEncPolicyVersions.pol-cipher  FORMAT "x(20)"   COLUMN-LABEL "Cipher Name" 
    ttObjEncPolicyVersions.pol-state   FORMAT "x(20)"   COLUMN-LABEL "Policy State" 
    WITH FRAME pol-info NO-ATTR-SPACE DOWN NO-BOX USE-TEXT STREAM-IO.



/* Main block */
IF NOT CONNECTED("DICTDB") THEN DO:
    MESSAGE "DICTDB database is required but it is not connected."
        VIEW-AS ALERT-BOX ERROR BUTTONS OK.
    RETURN "".
END.

IF NOT dbAdmin(USERID("DICTDB")) THEN DO:
  MESSAGE "You must be a Security Administrator to use this option."
      VIEW-AS ALERT-BOX ERROR BUTTONS OK.
  RETURN "".
END.

IF DBTYPE("DICTDB") NE "PROGRESS" THEN DO:
    MESSAGE "Cannot use this option with this database type."
        VIEW-AS ALERT-BOX ERROR BUTTONS OK.
    RETURN "".
END.

ASSIGN isQuick = p_RepId EQ 1.

/* get policy information now */
DO TRANSACTION ON ERROR UNDO, LEAVE
               ON STOP  UNDO, LEAVE:

   lStopped = YES.

   /* this will acquire a schema lock for us on the DICTDB database */
   myEPolicyCache = NEW prodict.sec._sec-pol-util().

   /* if this is the detailed report, we want to get the are number for the
      objects too.
   */
   IF NOT isQuick THEN
      myEPolicyCache:FillAreaNum = YES.

   /* populate the dataset with the encryptable object names and current 
      policy info*/
   IF isQuick OR p_Tbl = "ALL" THEN
       myEPolicyCache:getTableList(INPUT YES, /* get current policy info */
                                   OUTPUT DATASET dsObjAttrs BY-REFERENCE).
   ELSE
       myEPolicyCache:getObjectList(p_Tbl, 
                                    YES,/* get current policy info */
                                    OUTPUT DATASET dsObjAttrs BY-REFERENCE).

   FOR EACH ttObjAttrs.
       /* for the quick report, only want the policies that are current and
          with encryption enabled.
       */
       IF isQuick AND ttObjAttrs.obj-cipher = "" THEN DO:
           DELETE ttObjAttrs.
           NEXT.
       END.

       /* get the policy info */
       myEPolicyCache:getPolicyVersions(INPUT ttObjAttrs.obj-num, 
                                        INPUT ttObjAttrs.obj-type, 
                                        OUTPUT DATASET dsObjAttrs BY-REFERENCE).

       /* do not want to report on tables with no policies at all */
       IF (isQuick OR p_Tbl = "ALL") AND NOT CAN-FIND (FIRST ttObjEncPolicyVersions OF ttObjAttrs) THEN
          DELETE ttObjAttrs.
   END.

   /* check if there is anything to be reported */
   IF NOT CAN-FIND (FIRST ttObjAttrs) THEN DO:
      IF isQuick OR p_Tbl = "ALL"  THEN
          PUT STREAM rpt UNFORMATTED "There are no objects with encryption currently enabled."
                  SKIP.
      ELSE
          PUT STREAM rpt UNFORMATTED "Table " p_Tbl " (and its objects) is not encryptable or does not" SKIP
                  "contain any encryption policy info." SKIP.
   END.

   lStopped = NO.

   CATCH ae AS PROGRESS.Lang.AppError:
       MESSAGE ae:GetMessage(1) 
               VIEW-AS ALERT-BOX ERROR BUTTONS OK.
       DELETE OBJECT ae.
   END CATCH.
   FINALLY:
      IF VALID-OBJECT(myEPolicyCache) THEN
         DELETE OBJECT myEPolicyCache NO-ERROR.
   END FINALLY. 
END.

/* if we got a stop condition (such as a canceled lock), stop it now */
IF lStopped THEN
    STOP.

/* message was logged above */
IF NOT CAN-FIND (FIRST ttObjAttrs) THEN
   RETURN.

IF isQuick THEN DO:
    RUN doQuickReport.
END.
ELSE DO: /* detailed report */
    RUN doDetailedReport.
END.


PROCEDURE doQuickReport:

    DISPLAY STREAM rpt 
        "Reporting only objects with encryption enabled at the object level."
        @ line
        WITH FRAME rptline.
    DOWN STREAM rpt 1 WITH FRAME rptline.

    FOR EACH ttObjAttrs:
        FIND FIRST ttObjEncPolicyVersions OF ttObjAttrs.
        IF ttObjAttrs.obj-type NE "TABLE" THEN DO:
            /* for table.object, strip out the table part */
           IF cTable NE ENTRY(1, ttObjAttrs.obj-name, ".") THEN DO:
               ASSIGN cTable = ENTRY(1, ttObjAttrs.obj-name, ".").
               /* the table itself did not have any policies, so
                  we will log the table name so the object appears
                  indented underneath it.
               */
               DISPLAY STREAM rpt 
                   ENTRY(1, ttObjAttrs.obj-name,".") @ cObj
                   WITH FRAME quick-report.
               DOWN STREAM rpt WITH FRAME quick-report.
           END.
           /* this will appear indented under the table name */
           ASSIGN cObj = " - " + ENTRY(2, ttObjAttrs.obj-name, ".") 
                          + " (" + ttObjAttrs.obj-type + ")".
        END.
        ELSE
            ASSIGN  cTable = ttObjAttrs.obj-name
                    cObj = cTable.

        DISPLAY STREAM rpt
            cObj
            ttObjEncPolicyVersions.pol-version
            ttObjEncPolicyVersions.pol-cipher
            WITH FRAME quick-report.
         DOWN STREAM rpt WITH FRAME quick-report.
    END.

END PROCEDURE.


PROCEDURE doDetailedReport.
    DEF VAR hArea         AS HANDLE  NO-UNDO.
    DEF VAR cTmp          AS CHAR    NO-UNDO.
    DEF VAR iLast         AS INT     NO-UNDO.
    DEF VAR lFirstOfTable AS LOGICAL NO-UNDO.

    ASSIGN cTmp = LDBNAME("DICTDB") + "._Area".
    CREATE BUFFER hArea FOR TABLE cTmp NO-ERROR.

    IF p_Tbl = "ALL" THEN DO:
        DISPLAY STREAM rpt 
            "Reporting only objects with encryption policies at the object level."
            @ line
            WITH FRAME rptline.
    END.
    ELSE DO:
        DISPLAY STREAM rpt 
            "Reporting encryptable objects (at the object level)."
            @ line
            WITH FRAME rptline.
    END.
    DOWN STREAM rpt 1 WITH FRAME rptline.

    FOR EACH ttObjAttrs:
        /* first table or switching to a different table */
        IF cTable NE ENTRY(1, ttObjAttrs.obj-name, ".") THEN DO:
           lFirstOfTable = YES.
           cTable = ENTRY(1, ttObjAttrs.obj-name, ".").

           DOWN STREAM rpt 2 WITH FRAME rptline.
           DISPLAY STREAM rpt separators[{&SEP_NEXTTBL}] @ line
                  WITH FRAME rptline.
           DOWN STREAM rpt 1 WITH FRAME rptline.

           DISPLAY STREAM rpt separators[{&SEP_TBLNAME}] +
                              ENTRY(1, ttObjAttrs.obj-name, ".") +
                              {&SEP_TBLEND}
                   @ line WITH FRAME rptline.
           DOWN STREAM rpt 1 WITH FRAME rptline.
        END.
        ELSE
            lFirstOfTable = NO.

        IF NOT lFirstOfTable THEN DO:
            DOWN STREAM rpt 1 WITH FRAME rptline.
            DISPLAY STREAM rpt SEPARATORS[{&SEP_OTHER}] @ line
                 WITH FRAME rptline.
            DOWN STREAM rpt WITH FRAME rptline.
        END.

        /* get the object name */
        IF ttObjAttrs.obj-type NE "TABLE" THEN DO:
           ASSIGN cObj = ENTRY(2, ttObjAttrs.obj-name, ".") +
                         " (Table: " + cTable + ")".
        END.
        ELSE
            ASSIGN  cTable = ttObjAttrs.obj-name
                    cObj = cTable.

        /* try to get the area name. If the area number is the same as
           the previous one, we already got it
        */
        IF iLast NE ttObjAttrs.obj-area THEN DO:
            iLast = ttObjAttrs.obj-area.
            IF ttObjAttrs.obj-area NE ? THEN
               hArea:FIND-FIRST("where _Area-number = " + STRING(ttObjAttrs.obj-area), NO-LOCK) NO-ERROR.
            IF hArea:AVAILABLE THEN DO:
                areaName = hArea::_Area-name.
                hArea:BUFFER-RELEASE().
            END.
            ELSE
                areaName = "".
        END.

        DOWN STREAM rpt 1 WITH FRAME rptline.
        DISPLAY STREAM rpt
            cObj @ ttObjAttrs.obj-name 
            ttObjAttrs.obj-type 
            areaName
            WITH FRAME obj-info.

        DOWN STREAM rpt 1 WITH FRAME rptline.

        /* if the table was never encrypted or there are no current policies,
           just log message.
        */
        IF NOT CAN-FIND (FIRST ttObjEncPolicyVersions OF ttObjAttrs) THEN DO:
            DISPLAY STREAM rpt  "        No policy information available for object."
                                @ line WITH FRAME rptline.

            DOWN STREAM rpt WITH FRAME rptline.
            DOWN STREAM rpt WITH FRAME rptline.
        END.

        FOR EACH ttObjEncPolicyVersions OF ttObjAttrs.
            DISPLAY STREAM rpt ttObjEncPolicyVersions.pol-version
                               ttObjEncPolicyVersions.pol-cipher
                               ttObjEncPolicyVersions.pol-state
                    WITH FRAME pol-info.
            DOWN STREAM rpt WITH FRAME pol-info.
        END.
        DOWN STREAM rpt WITH FRAME rptline.
    END.
    DOWN STREAM rpt WITH FRAME rptline.

    IF VALID-HANDLE(hArea) THEN
        DELETE OBJECT hArea.

END PROCEDURE.
/*********************************************************************
* Copyright (C) 2008-2009 by Progress Software Corporation. All rights    *
* reserved.                                                          *
*                                                                    *
*********************************************************************/

/*----------------------------------------------------------------------------

File: _encrpt.p

Description:
   Encryption Policy report for both the GUI and character dictionary.
 
Input Parameters:
   p_RepId   - Id of the report
   p_LName  - Logical name of the database
   p_Tbl    - The table name or "ALL".  
   p_TblAsk - If yes, ask the user if he wants the table name specified or ALL.

Author: Fernando de Souza

Date Created: 10/27/08


----------------------------------------------------------------------------*/
&GLOBAL-DEFINE WIN95-BTN YES
{adecomm/commeng.i}  /* Help contexts */
{adecomm/adestds.i}  /* Standard layout defines, colors etc. */
{adecomm/adeintl.i}  /* International support */

{ prodict/misc/misc-funcs.i }
{ prodict/sec/sec-pol.i }

DEFINE INPUT PARAMETER p_RepId 	 AS INT      NO-UNDO.
DEFINE INPUT PARAMETER p_LName 	 AS CHAR     NO-UNDO.
DEFINE INPUT PARAMETER p_Tbl 	 AS CHAR     NO-UNDO.
DEFINE INPUT PARAMETER p_TblAsk  AS LOGICAL  NO-UNDO.

DEFINE NEW SHARED STREAM rpt.  /* used by prtrpt.i */

DEFINE VAR ans         AS LOGICAL      	     	       NO-UNDO.
DEFINE VAR header_str  AS CHAR 	       	     	       NO-UNDO.
DEFINE VAR app         AS LOGICAL   INITIAL FALSE      NO-UNDO.
DEFINE VAR dev         AS CHAR 	       	     	       NO-UNDO
   VIEW-AS RADIO-SET
   RADIO-BUTTONS "Terminal","TERMINAL","Printer","PRINTER","File","F"
   INITIAL "TERMINAL".
DEFINE VAR fil         AS CHAR                         NO-UNDO.
DEFINE VAR siz         AS INTEGER   INITIAL 0          NO-UNDO.

DEFINE VAR which_tbl   AS CHARACTER  INITIAL "t"       NO-UNDO
      LABEL "&Report on"
      VIEW-AS RADIO-SET  
      RADIO-BUTTONS "Selected Table", "t",
      	       	    "ALL Tables",     "a".

DEFINE BUTTON btn_Ok 	 LABEL "OK"       {&STDPH_OKBTN} AUTO-GO.
DEFINE BUTTON btn_Cancel LABEL "Cancel"   {&STDPH_OKBTN} AUTO-ENDKEY.
DEFINE BUTTON btn_Files  LABEL "&Files..." 
   &IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN SIZE 15 by 1.125 &ENDIF .
   
&IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN
   Define button    btn_Help  label "&Help" {&STDPH_OKBTN}.
   Define rectangle rect_Btns {&STDPH_OKBOX}. /* standard button rectangle */
   &global-define   HLP_BTN  &HELP = "btn_Help"
&ELSE
   &global-define   HLP_BTN  
&ENDIF

DEFINE VAR stat AS LOGICAL NO-UNDO.
Define variable  Dlg_ShortH     as integer   NO-UNDO. /* Short Height of Dialog */

DEF VAR myEPolicyCache AS prodict.sec._sec-pol-util NO-UNDO.
DEF VAR lStopped       AS LOGICAL                   NO-UNDO.

/*-------------------------------Forms------------------------------------*/
FORM
   SKIP({&TFM_WID})
   
   dev LABEL "&Send Output to"           COLON 17  
   SKIP ({&VM_WID})

   fil NO-LABEL FORMAT "x({&PATH_WIDG})"           AT    19
       VIEW-AS FILL-IN NATIVE SIZE 30 BY 1   	   {&STDPH_FILL} SPACE(.3)
   btn_Files
   SKIP({&VM_WID})

   app LABEL "&Append to Existing File?" AT    19
       VIEW-AS TOGGLE-BOX 
   SKIP({&VM_WIDG})
   
   siz LABEL "&Page Length" FORMAT ">>9" COLON 17   {&STDPH_FILL}
   "(# Lines, 0 for Continuous)":t35                   	  
   SKIP({&VM_WIDG})

   which_tbl  COLON 17 

   {adecomm/okform.i
      &BOX    = rect_btns
      &STATUS = no
      &OK     = btn_OK
      &CANCEL = btn_Cancel
      {&HLP_BTN}
   }

   WITH FRAME options 
      SIDE-LABELS 
      DEFAULT-BUTTON btn_Ok CANCEL-BUTTON btn_Cancel
      VIEW-AS DIALOG-BOX TITLE "Report Options".


/*-----------------------------Triggers------------------------------------*/

/*----- OK or GO -----*/
ON GO OF FRAME OPTIONS  
DO:
   DEFINE VARIABLE flags AS CHARACTER.
  
   IF p_TblAsk THEN
      which_tbl = which_tbl:SCREEN-VALUE.

   ASSIGN 
      dev
      fil
      app
      siz.

   fil = TRIM(fil).
   IF p_TblAsk AND which_tbl = "a" THEN
      p_Tbl = "ALL".
   
   /* Do it.  If user displays to terminal he will have the option to print
      later.  If going to printer - that's all folks.
   */   
   header_str = "Database: " + p_LName.
   IF dev = "TERMINAL" THEN
   DO:
      RUN adecomm/_report.p 
    	 (INPUT p_RepId, 
    	  INPUT header_str,
          INPUT "Detailed Encryption Policy Report",
    	  INPUT "",
    	  INPUT "",
    	  INPUT "adecomm/_encpdat.p",
    	  INPUT p_Tbl,
          INPUT {&Detailed_Encryption_Policy_Report_Dialog_Box}).
   END.
   ELSE DO:

      IF dev = "F" then DO:
        ASSIGN dev = fil.  
        IF NOT app THEN DO:
          FILE-INFO:FILE-NAME = fil.
          IF FILE-INFO:FULL-PATHNAME NE ? THEN DO:
            DEF VAR choice AS LOGICAL INITIAL NO.
            MESSAGE fil "already exists. Overwrite?" VIEW-AS ALERT-BOX QUESTION 
              BUTTONS YES-NO UPDATE choice.
            IF NOT choice THEN DO:
              APPLY "ENTRY" TO fil.
              RETURN NO-APPLY.
            END.
          END.
        END.
      END.
      {adecomm/prtrpt.i
	    &Header = header_str
        &Flags  = flags
	    &dev    = dev
	    &app    = app
	    &siz    = siz
	    &Func   = "adecomm/_encpdat.p 
      	       	      (INPUT p_RepId, INPUT p_Tbl)"}
   END.
END.

/*----- VALUE-CHANGED of DEVICE RADIO SET -----*/
ON VALUE-CHANGED OF dev IN FRAME options
DO:
   /* Default to continuous output for terminal, 60 for printer */
   dev = SELF:SCREEN-VALUE.
   IF dev = "F" /* file */ THEN DO:
      ASSIGN
	 siz:SCREEN-VALUE IN FRAME options = "0"
	 &IF "{&WINDOW-SYSTEM}" = "TTY" &THEN 
	    fil:VISIBLE IN FRAME options = yes
	    btn_Files:VISIBLE IN FRAME options = yes
	    app:VISIBLE IN FRAME options = yes
	 &ELSE
	    fil:SENSITIVE IN FRAME options = yes
	    btn_Files:SENSITIVE IN FRAME options = yes
	    app:SENSITIVE IN FRAME options = yes
	 &ENDIF
      	 .
      APPLY "ENTRY" TO fil IN FRAME options.
   END.
   ELSE DO:
      &IF "{&WINDOW-SYSTEM}" = "TTY" &THEN 
	 ASSIGN
	    fil:VISIBLE IN FRAME options = no
	    btn_Files:VISIBLE IN FRAME options = no
	    app:VISIBLE IN FRAME options = no.
      &ELSE
	 ASSIGN
	    fil:SENSITIVE IN FRAME options = no
	    fil:SCREEN-VALUE IN FRAME options = ""
	    btn_Files:SENSITIVE IN FRAME options = no
	    app:SENSITIVE IN FRAME options = no.
      &ENDIF
      IF dev = "TERMINAL" THEN
	 siz:SCREEN-VALUE IN FRAME options = "0".
      ELSE IF dev = "PRINTER" THEN  
	 siz:SCREEN-VALUE IN FRAME options = "60".
   END.
END.

/*----- HIT of FILE BUTTON -----*/
on choose of btn_Files in frame options
do:
   Define var name       as char    NO-UNDO.
   Define var picked_one as logical NO-UNDO.
   Define var d_title    as char    NO-UNDO init "Report File".

   name = TRIM(fil:screen-value in frame options).
   &IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN
      system-dialog GET-FILE 
		    name 
		    filters            "*" "*"
		    default-extension  ""
		    title 	       d_title 
		    /*must-exist*/
		    update             picked_one.
   &ELSE
      run adecomm/_filecom.p
	  ( INPUT "" /* p_Filter */, 
	    INPUT "" /* p_Dir */ , 
	    INPUT "" /* p_Drive */ ,
	    INPUT no /* File Open */ ,
	    INPUT d_title ,
            INPUT "" /* Dialog Options */ ,
	    INPUT-OUTPUT name,
   	    OUTPUT picked_one ). 
   &ENDIF

   if picked_one then
      fil:screen-value in frame options = name.
end.

ON HELP OF FRAME options
  &IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN
    OR CHOOSE OF btn_Help IN FRAME options
  &ENDIF
  RUN "adecomm/_adehelp.p" ("comm", "CONTEXT", {&Report_Options}, ?).

/*-------------------------------Mainline code-----------------------------*/
/* Check for privileges */

IF NOT dbAdmin(USERID("DICTDB")) THEN DO:
  MESSAGE "You must be a Security Administrator to use this option."
      VIEW-AS ALERT-BOX ERROR BUTTONS OK.
  RETURN "".
END.

/* we will try to instantiate the sec-pol-util object now so that if
   there are any errors, we will get them now and get out.
*/
DO TRANSACTION ON ERROR UNDO, LEAVE
               ON STOP  UNDO, LEAVE:

   lStopped = YES.

   /* this will acquire a schema lock for us on the DICTDB database */
   myEPolicyCache = NEW prodict.sec._sec-pol-util().

   lStopped = NO.

   CATCH ae AS PROGRESS.Lang.AppError:
       MESSAGE ae:GetMessage(1) 
               VIEW-AS ALERT-BOX ERROR BUTTONS OK.
       DELETE OBJECT ae.

       /* set this to zero so we get out below */
       p_RepId = 0.
   END CATCH.
   FINALLY:
      IF VALID-OBJECT(myEPolicyCache) THEN
         DELETE OBJECT myEPolicyCache NO-ERROR.
   END FINALLY. 
END.

/* if we got a stop condition (such as a canceled lock), stop it now */
IF lStopped THEN
    RETURN.

IF p_RepId = 2 THEN DO:
    ASSIGN
      which_tbl:HIDDEN IN FRAME options = (IF p_TblAsk THEN no else yes).
    
    IF which_tbl:HIDDEN THEN DO:
        /* Set the dialog size values and shorten the dialog height. */
        /*  Add a small margin {&VM_OKBOX} in pixels to short and full height to
           ensure dialog is large enough for the widgets, particularly on Windows XP. */
        assign Dlg_ShortH = FRAME options:HEIGHT-PIXELS -
                            (FRAME options:HEIGHT-PIXELS
                             - btn_Ok:Y IN FRAME options)
               Dlg_ShortH = Dlg_ShortH + {&VM_OKBOX}
               . /* END ASSIGN */

       btn_Ok:Y = which_tbl:Y.
       btn_Cancel:Y = which_tbl:Y.
       &IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN
       btn_Help:Y = which_tbl:Y.
       &ENDIF
       
       ASSIGN FRAME options:HEIGHT-PIXELS = Dlg_ShortH NO-ERROR.
    END.
    /* "File" related fields start insensitive or hidden by default */
    ASSIGN
      &IF "{&WINDOW-SYSTEM}" = "TTY" &THEN 
        fil:hidden IN FRAME options = yes
        btn_Files:hidden IN FRAME options = yes
        app:hidden IN FRAME options = yes
        fil:sensitive IN FRAME options = yes
        btn_Files:sensitive IN FRAME options = yes
        app:sensitive IN FRAME options = yes
      &ELSE
        fil:sensitive IN FRAME options = no
        btn_Files:sensitive IN FRAME options = no
        app:sensitive IN FRAME options = no
      &ENDIF
      .
    
    /* Run time layout for button area. */
    {adecomm/okrun.i  
      &FRAME  = "frame options" 
      &BOX    = "rect_Btns"
      &OK     = "btn_OK" 
      &Cancel = "btn_Cancel"
      {&HLP_BTN} }
    
    DISPLAY
      dev
      siz
      which_tbl   WHEN p_TblAsk
      WITH FRAME options.
    
    ENABLE
      dev siz which_tbl WHEN p_TblAsk
      btn_Ok btn_Cancel
      &IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN
        btn_Help
      &ENDIF
      WITH FRAME options.
    
    /* Reset tab-order for things that will be enabled later. */
    ASSIGN
      stat = fil:MOVE-AFTER-TAB-ITEM(dev:HANDLE IN FRAME options)
      stat = btn_Files:MOVE-AFTER-TAB-ITEM(fil:HANDLE IN FRAME options)
      stat = app:MOVE-AFTER-TAB-ITEM(btn_Files:HANDLE IN FRAME options).
    
    /* If user choose print and there's a problem with the printer, 
       Progress may generate a STOP condition - so trap that so
       we don't get kicked out of the whole application.  */
    DO ON ERROR UNDO, LEAVE ON ENDKEY UNDO, LEAVE ON STOP UNDO, LEAVE:
      WAIT-FOR CHOOSE of btn_OK in FRAME options OR GO of FRAME options FOCUS dev.
    END.
    
    HIDE FRAME options.
END.
ELSE IF p_RepId = 1 THEN DO:
      header_str = "Database: " + p_LName.

      RUN adecomm/_report.p 
      (INPUT p_RepId, /*p_DbId,*/ 
       INPUT header_str,
       INPUT "Quick Encryption Policy Report",
       INPUT "'Current' policies",
       INPUT "",
       INPUT "adecomm/_encpdat.p",
       INPUT "ALL",
       INPUT {&Quick_Encryption_Policy_Report_Dialog_Box}).

END.

RETURN.


/* _secprpt.p -  end of file */
/* Copyright © 2006-2011 OE Hive and contributors. 
   All project and contributed content is copyright by its respective owners. 
   All rights reserved.
*/
/*------------------------------------------------------------------------
    File        : _getshortpathname.p
    Purpose     : Return win32 short path name

    Syntax      :

    Description : 

    Author(s)   : From www.oehive.org. jurjen 
    Created     : Fri Jul 15 16:11:22 EDT 2011
    Notes       : 
  ----------------------------------------------------------------------*/
routine-level on error undo, throw.

/* ***************************  Definitions  ************************** */

define input  parameter pLongName  as character no-undo. 
define output parameter pShortName as character no-undo.
 
procedure GetShortPathNameA external "kernel32.dll" :
  define input  parameter  lpszLongPath  as character.
  define output parameter  lpszShortPath as character.
  define input  parameter  cchBuffer     as LONG.
  define return parameter  ReturnValue   as LONG.
end procedure.
 
define variable iReturnValue as integer no-undo.
define variable iShortsize as integer init 256 no-undo. 
 
pShortName = fill("-", 256).
 
run GetShortPathNameA (plongname,
                       output pShortName,
                       length(pShortName),
                       output iReturnValue).
 
if iReturnValue > iShortsize then 
    undo, throw new Progress.Lang.AppError("Buffer too short to handle " + string(iReturnValue),?).
else 
if iReturnValue = 0 then 
    undo, throw new Progress.Lang.AppError("File  " + pLongName + " was not found.",?).
else 
/*   shortname = ENTRY(1, shortname, CHR(0)).*/
    pShortname = substring(pShortname, 1, iReturnvalue).
   
   
/*------------------------------------------------------------------------
    File        : ide_chscolr.p
    Purpose     : 

    Syntax      :

    Description : 

    Author(s)   : hdaniels
    Created     : Tue Jan 24 13:32:32 EST 2012
    Notes       :
  ----------------------------------------------------------------------*/

/* ***************************  Definitions  ************************** */

routine-level on error undo, throw.

/* ********************  Preprocessor Definitions  ******************** */


/* ***************************  Main Block  *************************** */
/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/
/* s-alert2.p - alert box routine */

/*
Input text comes in 'pi_text' parameter, and may be any length.
This program splits it up into 45-character chunks, breaking at
spaces.  Embedded '^' marks get translated into line-feeds (like
in column-labels).

pi_type the the type of alert box to use.
  pi_type = "e*" -> error
  pi_type = "i*" -> information
  pi_type = "m*" -> message
  pi_type = "q*" -> question
  pi_type = "w*" -> warning

pi_butn is the type of button(s) to use.
pio_ans is the initial value and also the result.
  pi_butn = "YES-NO"        -> pio_ans = TRUE/FALSE
  pi_butn = "YES-NO-CANCEL" -> pio_ans = TRUE/FALSE/?
  pi_butn = "OK"            -> pio_ans = TRUE
  pi_butn = "OK-CANCEL"     -> pio_ans = TRUE/?
  pi_butn = "RETRY-CANCEL"  -> pio_ans = TRUE/?

End-error handling:
  If there is a "CANCEL" button, then the result will be as if the user
  pressed the "CANCEL" button.  If there is NO "CANCEL" button but
  there is a "NO" button, then the result will be as if the user
  pressed the "NO" button.  If there is only the "OK" button, then the
  result will be as if the user selected the "OK" button.
  
 
*/

DEFINE INPUT-OUTPUT PARAMETER pio_ans AS LOGICAL   NO-UNDO. /* value */
DEFINE INPUT        PARAMETER pi_type AS CHARACTER NO-UNDO. /* alert type */
DEFINE INPUT        PARAMETER pi_butn AS CHARACTER NO-UNDO. /* buttons */
DEFINE INPUT        PARAMETER pi_text AS CHARACTER NO-UNDO. /* text */

DEFINE VARIABLE v_text AS CHARACTER NO-UNDO. /* word-wrapped text */

/*****************************************************************/
/************ New parser written by Alex *************************/
&SCOPED-DEFINE dh-limit 16
&SCOPED-DEFINE dw-limit 45

DEF VAR cChunk AS CHAR EXTENT {&dh-limit} NO-UNDO.
DEF VAR I      AS INT                     NO-UNDO.  
DEF VAR K      AS INT                     NO-UNDO.  
DEF VAR lOK    AS LOG                     NO-UNDO.  
DEF VAR lOver  AS LOG INIT NO             NO-UNDO.  
DEF VAR cTemp  AS CHAR                    NO-UNDO.  

/*****************************************************************/
/* this proc shifts text chunks up to make space for a new chunk */
PROCEDURE shift:
DEF INPUT PARAM iStart AS INT NO-UNDO.
DEF VAR J              AS INT NO-UNDO.

IF iStart > {&dh-limit} - 1 OR iStart < 2 THEN RETURN.
IF cChunk[{&dh-limit}] <> "" THEN lOver = YES.

REPEAT J = {&dh-limit} TO iStart + 1 BY -1: ASSIGN cChunk[J] = cChunk[J - 1]. END.

cChunk[iStart] = "".
END PROCEDURE.
/*****************************************************************/

Zakorjuchka:
REPEAT I = 1 TO {&dh-limit}:
IF INDEX(pi_text,"^":u) > 0 THEN 
  ASSIGN cChunk[I] = SUBSTRING(pi_text, 1, INDEX(pi_text,"^":u) - 1)
         pi_text   = SUBSTRING(pi_text, INDEX(pi_text,"^":u) + 1).
ELSE
  DO:
  ASSIGN cChunk[I] = pi_text. LEAVE Zakorjuchka.
  END.
END.

ASSIGN lOK = NO.
DO WHILE NOT lOK:
ASSIGN lOK = YES.
 REPEAT I = {&dh-limit} TO 1 BY -1: 
 IF LENGTH(cChunk[I]) < {&dw-limit} + 1 THEN NEXT.                       
 RUN shift(INPUT I + 1).                                       
 ASSIGN K = R-INDEX(cChunk[I], " ", {&dw-limit} + 1) lOK = NO.                   

 IF K = 0 THEN                                             
   ASSIGN cTemp         = SUBSTRING(cChunk[I], {&dw-limit} + 1)
          cChunk[I]     = SUBSTRING(cChunk[I], 1, {&dw-limit})      
          cChunk[I + 1] = cTemp.        
 ELSE                                                      
   ASSIGN cTemp         = SUBSTRING(cChunk[I], K + 1)
          cChunk[I]     = SUBSTRING(cChunk[I], 1, K - 1)   
          cChunk[I + 1] = cTemp.     
 END. /* repeat */
END. /* do while */

DO I = 1 TO {&dh-limit}: ASSIGN v_text = v_text + cChunk[I] + CHR(10). END.
ASSIGN v_text = TRIM(v_text, CHR(10)) + CHR(10) + IF lOver THEN "..." ELSE "".
/*****************************************************************/
/********************** End new parser ***************************/

/*****************************************************************/
/******************* Screen messaging part ***********************/
CASE SUBSTRING(pi_type,1,1,"CHARACTER":u) + "/":u + pi_butn:
  WHEN "e/YES-NO":u THEN
  do:
    &if DEFINED(IDE-IS-SUPPORTED) <> 0  &THEN       
    if OEIDE_CanShowMessage() then
       pio_ans = ShowMessageInIDE(v_text,"Error",?,"YES-NO",pio_ans).
    else
    &endif  
    MESSAGE v_text
      VIEW-AS ALERT-BOX error BUTTONS YES-NO
      UPDATE pio_ans.
  end.    
  WHEN "e/YES-NO-CANCEL":u THEN
  do: 
     &if DEFINED(IDE-IS-SUPPORTED) <> 0  &THEN   
    if OEIDE_CanShowMessage() then
       pio_ans = ShowMessageInIDE(v_text,"Error",?,"YES-NO-CANCEL",pio_ans).
    else   
    &endif
    MESSAGE v_text
      VIEW-AS ALERT-BOX error BUTTONS YES-NO-CANCEL
      UPDATE pio_ans.
  end.    
  WHEN "e/OK":u THEN
  do:
     &if DEFINED(IDE-IS-SUPPORTED) <> 0  &THEN   
    if OEIDE_CanShowMessage() then
       pio_ans = ShowMessageInIDE(v_text,"Error",?,"OK",yes).
    else  
    &endif
    MESSAGE v_text
      VIEW-AS ALERT-BOX error BUTTONS OK
      UPDATE pio_ans.
  end.    
  WHEN "e/OK-CANCEL":u THEN
  do:
    &if DEFINED(IDE-IS-SUPPORTED) <> 0  &THEN  
    if OEIDE_CanShowMessage() then
       pio_ans = ShowMessageInIDE(v_text,"Error",?,"OK-CANCEL",pio_ans).
    else  
    &endif
    MESSAGE v_text
      VIEW-AS ALERT-BOX error BUTTONS OK-CANCEL
      UPDATE pio_ans.
  end.    
  WHEN "e/RETRY-CANCEL":u THEN
  do:
    &if DEFINED(IDE-IS-SUPPORTED) <> 0  &THEN  
    if OEIDE_CanShowMessage() then
       pio_ans = ShowMessageInIDE(v_text,"Error",?,"RETRY-CANCEL",pio_ans).
    else  
    &endif
    MESSAGE v_text
      VIEW-AS ALERT-BOX error BUTTONS RETRY-CANCEL
      UPDATE pio_ans.
  end.    
  WHEN "i/YES-NO":u THEN
  do:
    &if DEFINED(IDE-IS-SUPPORTED) <> 0  &THEN   
    if OEIDE_CanShowMessage() then
       pio_ans = ShowMessageInIDE(v_text,"Information",?,"YES-NO",pio_ans).
    else  
    &endif
    MESSAGE v_text
      VIEW-AS ALERT-BOX information BUTTONS YES-NO
      UPDATE pio_ans.
  end.    
  WHEN "i/YES-NO-CANCEL":u THEN
  do:
    &if DEFINED(IDE-IS-SUPPORTED) <> 0  &THEN   
    if OEIDE_CanShowMessage() then
       pio_ans = ShowMessageInIDE(v_text,"Information",?,"YES-NO-CANCEL",pio_ans).
    else  
    &endif
    MESSAGE v_text
      VIEW-AS ALERT-BOX information BUTTONS YES-NO-CANCEL
      UPDATE pio_ans.
  end.    
  WHEN "i/OK":u THEN
  do:
    &if DEFINED(IDE-IS-SUPPORTED) <> 0  &THEN   
    if OEIDE_CanShowMessage() then
       pio_ans = ShowMessageInIDE(v_text,"Information",?,"OK",pio_ans).
    else  
    &endif
    MESSAGE v_text
      VIEW-AS ALERT-BOX information BUTTONS OK
      UPDATE pio_ans.
  end.    
  WHEN "i/OK-CANCEL":u THEN
  do:
    &if DEFINED(IDE-IS-SUPPORTED) <> 0  &THEN   
    if OEIDE_CanShowMessage() then
       pio_ans = ShowMessageInIDE(v_text,"Information",?,"OK-CANCEL",pio_ans).
    else  
    &endif
    MESSAGE v_text
      VIEW-AS ALERT-BOX information BUTTONS OK-CANCEL
      UPDATE pio_ans.
  end.    
  WHEN "i/RETRY-CANCEL":u THEN
  do:
    &if DEFINED(IDE-IS-SUPPORTED) <> 0  &THEN   
    if OEIDE_CanShowMessage() then
       pio_ans = ShowMessageInIDE(v_text,"Information",?,"RETRY-CANCEL",pio_ans).
    else  
    &endif
    MESSAGE v_text
      VIEW-AS ALERT-BOX information BUTTONS RETRY-CANCEL
      UPDATE pio_ans.
  end.    
  WHEN "m/YES-NO":u THEN
  do:
    &if DEFINED(IDE-IS-SUPPORTED) <> 0  &THEN   
    if OEIDE_CanShowMessage() then
       pio_ans = ShowMessageInIDE(v_text,"Message",?,"YES-NO",pio_ans).
    else  
    &endif
    MESSAGE v_text
      VIEW-AS ALERT-BOX message BUTTONS YES-NO
      UPDATE pio_ans.
  end.    
  WHEN "m/YES-NO-CANCEL":u THEN
  do:
    &if DEFINED(IDE-IS-SUPPORTED) <> 0  &THEN   
    if OEIDE_CanShowMessage() then
       pio_ans = ShowMessageInIDE(v_text,"Message",?,"YES-NO-CANCEL",pio_ans).
    else  
    &endif
    MESSAGE v_text
      VIEW-AS ALERT-BOX message BUTTONS YES-NO-CANCEL
      UPDATE pio_ans.
  end.    
  WHEN "m/OK":u THEN
  do:
    &if DEFINED(IDE-IS-SUPPORTED) <> 0  &THEN   
    if OEIDE_CanShowMessage() then
       pio_ans = ShowMessageInIDE(v_text,"Message",?,"OK",pio_ans).
    else  
    &endif
    MESSAGE v_text
      VIEW-AS ALERT-BOX message BUTTONS OK
      UPDATE pio_ans.
  end.    
  WHEN "m/OK-CANCEL":u THEN
  do:
    &if DEFINED(IDE-IS-SUPPORTED) <> 0  &THEN   
    if OEIDE_CanShowMessage() then
       pio_ans = ShowMessageInIDE(v_text,"Message",?,"OK-CANCEL",pio_ans).
    else  
    &endif
    MESSAGE v_text
      VIEW-AS ALERT-BOX message BUTTONS OK-CANCEL
     UPDATE pio_ans.
  end.   
  WHEN "m/RETRY-CANCEL":u THEN
  do:
    &if DEFINED(IDE-IS-SUPPORTED) <> 0  &THEN   
    if OEIDE_CanShowMessage() then
       pio_ans = ShowMessageInIDE(v_text,"Message",?,"RETRY-CANCEL",pio_ans).
    else  
    &endif
    MESSAGE v_text
      VIEW-AS ALERT-BOX message BUTTONS RETRY-CANCEL
      UPDATE pio_ans.
  end.    
  WHEN "q/YES-NO":u THEN
  do:
    &if DEFINED(IDE-IS-SUPPORTED) <> 0  &THEN   
    if OEIDE_CanShowMessage() then
       pio_ans = ShowMessageInIDE(v_text,"Question",?,"YES-NO",pio_ans).
    else  
    &endif
    MESSAGE v_text
      VIEW-AS ALERT-BOX question BUTTONS YES-NO
      UPDATE pio_ans.
  end.    
  WHEN "q/YES-NO-CANCEL":u THEN
  do:
    &if DEFINED(IDE-IS-SUPPORTED) <> 0  &THEN   
    if OEIDE_CanShowMessage() then
       pio_ans = ShowMessageInIDE(v_text,"Question",?,"YES-NO-CANCEL",pio_ans).
    else  
    &endif
    MESSAGE v_text
      VIEW-AS ALERT-BOX question BUTTONS YES-NO-CANCEL
      UPDATE pio_ans.
  end.   
  WHEN "q/OK":u THEN
  do:
    &if DEFINED(IDE-IS-SUPPORTED) <> 0  &THEN   
    if OEIDE_CanShowMessage() then
       pio_ans = ShowMessageInIDE(v_text,"Question",?,"OK",pio_ans).
    else  
    &endif
    MESSAGE v_text
      VIEW-AS ALERT-BOX question BUTTONS OK
      UPDATE pio_ans.
  end.    
  WHEN "q/OK-CANCEL":u THEN
  do:
    &if DEFINED(IDE-IS-SUPPORTED) <> 0  &THEN   
    if OEIDE_CanShowMessage() then
       pio_ans = ShowMessageInIDE(v_text,"Question",?,"OK-CANCEL",pio_ans).
    else  
    &endif
    MESSAGE v_text
      VIEW-AS ALERT-BOX question BUTTONS OK-CANCEL
      UPDATE pio_ans.
  end.    
  WHEN "q/RETRY-CANCEL":u THEN
  do:
    &if DEFINED(IDE-IS-SUPPORTED) <> 0  &THEN   
    if OEIDE_CanShowMessage() then
       pio_ans = ShowMessageInIDE(v_text,"Question",?,"RETRY-CANCEL",pio_ans).
    else  
    &endif
    MESSAGE v_text
      VIEW-AS ALERT-BOX question BUTTONS RETRY-CANCEL
      UPDATE pio_ans.
  end.    
  WHEN "w/YES-NO":u THEN
  do:
    &if DEFINED(IDE-IS-SUPPORTED) <> 0  &THEN   
    if OEIDE_CanShowMessage() then
       pio_ans = ShowMessageInIDE(v_text,"Warning",?,"YES-NO",pio_ans).
    else  
    &endif
    MESSAGE v_text
      VIEW-AS ALERT-BOX warning BUTTONS YES-NO
      UPDATE pio_ans.
  end.    
  WHEN "w/YES-NO-CANCEL":u THEN
  do:
    &if DEFINED(IDE-IS-SUPPORTED) <> 0  &THEN   
    if OEIDE_CanShowMessage() then
       pio_ans = ShowMessageInIDE(v_text,"Warning",?,"YES-NO-CANCEL",pio_ans).
    else  
    &endif
    MESSAGE v_text
      VIEW-AS ALERT-BOX warning BUTTONS YES-NO-CANCEL
      UPDATE pio_ans.
  end.    
  WHEN "w/OK":u THEN
  do:
    &if DEFINED(IDE-IS-SUPPORTED) <> 0  &THEN   
    if OEIDE_CanShowMessage() then
       pio_ans = ShowMessageInIDE(v_text,"Warning",?,"OK",pio_ans).
    else  
    &endif
    MESSAGE v_text
      VIEW-AS ALERT-BOX warning BUTTONS OK
      UPDATE pio_ans.
  end.    
  WHEN "w/OK-CANCEL":u THEN
  do:
    &if DEFINED(IDE-IS-SUPPORTED) <> 0  &THEN   
    if OEIDE_CanShowMessage() then
       pio_ans = ShowMessageInIDE(v_text,"Warning",?,"OK-CANCEL",pio_ans).
    else  
    &endif
    MESSAGE v_text
      VIEW-AS ALERT-BOX warning BUTTONS OK-CANCEL
      UPDATE pio_ans.
  end.    
  WHEN "w/RETRY-CANCEL":u THEN
  do:
    &if DEFINED(IDE-IS-SUPPORTED) <> 0  &THEN   
    if OEIDE_CanShowMessage() then
       pio_ans = ShowMessageInIDE(v_text,"Warning",?,"RETRY-CANCEL",pio_ans).
    else  
    &endif
    MESSAGE v_text
      VIEW-AS ALERT-BOX warning BUTTONS RETRY-CANCEL
      UPDATE pio_ans.
  end.    
END CASE.

/* proper end-error handling of return value. */
IF NOT pio_ans AND NUM-ENTRIES(pi_butn,"-":u) = 2 THEN
  pio_ans = (IF pi_butn MATCHES "*-CANCEL":u THEN ? ELSE pi_butn <> "YES-NO":u).

RETURN.

/* s-alert.p - end of file */
/*************************************************************/
/* Copyright (c) 2013 by Progress Software Corporation.      */
/*                                                           */
/* All rights reserved.  No part of this program or document */
/* may be  reproduced in  any form  or by  any means without */
/* permission in writing from Progress Software Corporation. */
/*************************************************************/
/*------------------------------------------------------------------------
    Purpose     : resolve relative path of full path file
                  prompts if relative name shadowed by other file in propath
    Syntax      :
     
    Description : 

    Author(s)   : 
    Created     : Apr 2013
    Notes       : No check for valid-file. 
                  will return passed file if invalid
                  will return relative filename if path matches propath even if file does not exist
    Parameter      input-output filename
                   in - full pathed file 
                   out - relative path if in propath (and confirmed if shadowed) 
                          
                       - "" if cancel shadowed selection 
                       - fullpath in all other cases (no check for valid file)
  ----------------------------------------------------------------------*/

/* ***************************  Definitions  ************************** */

routine-level on error undo, throw.

define input-output  parameter pcfile as character no-undo.

define variable DOS-SLASH   as character no-undo initial "~\":U.
define variable UNIX-SLASH  as character no-undo initial "/":U.
define variable cSearch     as character no-undo.
define variable lok         as logical no-undo.
define variable cMsg        as character no-undo.
define variable i           as integer no-undo.
define variable cPickedFile as character no-undo. 
define variable cUseSlash   as character no-undo.
define variable cNotUseSlash as character no-undo.
define variable MSG_TITLE    as character initial "Confirm use of relative path" no-undo.
{adecomm/oeideservice.i}

/* ********************  Preprocessor Definitions  ******************** */


/* ***************************  Main Block  *************************** */
if opsys = "UNIX":U then
do:
    assign 
        cUseSlash = DOS-SLASH
        cNotUseSlash  = UNIx-SLASH.
end.
else do:
    assign 
        cUseSlash = UNIx-SLASH
        cNotUseSlash  = DOS-SLASH.
end.        
pcfile = replace(pcfile,cUseSlash,cNotUseSlash).
do i = 1 to num-entries(propath):
    file-info:file-name = trim(entry(i,propath)).
    if pcFile begins file-info:full-pathname and file-info:full-pathname ne ? then 
    do:
        cPickedfile = pcFile.
        /* If it's there, chop off the leading part */
        pcFile = substring(pcFile, length(right-trim(file-info:full-pathname,cUseSlash)) + 2, -1,"CHARACTER":U).
        cSearch = search(pcFile).
        if cSearch <> ? and not cSearch begins file-info:full-pathname then
        do:
            lok = true.
            cMsg =    "The relative path " + pcFile + " of the selected file "
                        + cPickedfile + " resolves to a different file " + cSearch + " in propath." + "~n~n"
                        + "Confirm use of relative path." + "~n~n"  + "Select:" + "~n"
                        + "   Yes to use relative path."  + "~n"  
                        + "   No to use full path (not recommended)."  + "~n" 
                        + "   Cancel to select a different file.".
            if OEIDE_CanShowMessage() then 
                lok = ShowMessageInIDE(cMsg,"Question":U,MSG_TITLE,"yes-no-cancel":U,lok).
            else 
                message cMsg       
                    view-as alert-box question buttons yes-no-cancel title MSG_TITLE update lok .
            if not lok then 
                pcfile = cPickedfile.
            else if lok = ? then
                pcfile = "". 
        end.
    end.
end.            /*********************************************************************
* Copyright (C) 2013 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/*----------------------------------------------------------------------------

File: _dbconnide.p

Description:
   Calls PDS connection dialog box, doing the 
   connection if the user presses OK.  This call takes only three parameters.

Input/Output Parameters:
   
   | On input:  a value is supplied if known, otherwise, the value is ?
   | On output: if connect succeeded, all values are set.  If connect failed
      	        or if the user cancelled, Pname and LName are set to ?.

   p_PName  - the physical name of the database
   p_LName  - the logical name of the database
   p_Type   - The database type (e.g., PROGRESS, ORACLE)
   
 
Author:  hdaniels

Date Created: 08/26/2013

----------------------------------------------------------------------------*/
{adecomm/oeideservice.i}

Define INPUT-OUTPUT parameter p_PName  as char NO-UNDO.
Define INPUT-OUTPUT parameter p_LName  as char NO-UNDO.
Define INPUT-OUTPUT parameter p_Type   as char NO-UNDO.

define var lok           as logical no-undo.
define variable inum as integer no-undo.
/*----------------------------Mainline code----------------------------------*/

inum = NUM-DBS.
p_LName = ?. 
p_PName = ?.
 /* ? = no prompt do you want to connect*/
lOK =  OpenDBConnectionDialog(?). 
if lok = true then 
do:
    if NUM-DBS > 0 then
    do:
        /* The database whose name was entered in the name fill-in, may in
           fact not be one of the ones that connected successfully.
           To be sure we get this right, get the info from Progress for
           the num+1 connected database - it should be the first of the ones
           that were just connected.
          */
        assign
             p_LName = LDBNAME(inum + 1)
             p_PName = PDBNAME(inum + 1)
             p_Type = DBTYPE(inum + 1).
             
    end.  
     
end.      
   
RETURN.



Y//+S!+³?3Ä»»kÞ³‰¹kÄÚÁAèq‰?ÍAWWéW9>qåyÔ¡WÔWyA5Úgï¥Ú¤ï&Q…®®¾ìâ/~û¸ý”£Ûôè¡F,EW§ë§›eV¥Ç]‘nJ\«ÊÜ`SnV¼8KQ‹¥WÒVñ1Y)Ãà_I¼ •o“rŽe–e.\Ÿ"ze®¾À]…¿3à»’tíÚ]gÈ0š#Ž¿7Y#oª¢%œá8_ýëÍé¸+“S¼ýL[V×àôÏib<¿b —û¿ßèÒ°¤b£+¤Ò»r‘¬ºð%82üC—¸0©T¹0Ý¿QB)LQlL°°…(ÈÈUUö1ÈÀ–ÛPÜ­ZƒÎƒ1””CN:”ÎòuŠ†Cc|™I IììmŒ¾l‚À°mmáŒí…”¼Àmg†é¼Òkõæ
hgdd6½øN<6Bes
nyN©°s÷n£ìW¡„ú€M×ÒÕ’IŸë¥XÇJ:‹—\à`¨à³ÆË[—Á™¯jïŽ‹3%êðââô¯ˆæu–Ÿôê¸ßäÕU…2Y|ÿ\È$ƒ–y\ñ–hqÛÀá"úüË‚¤‹Ä
²Ã‘Ê€áËÃ™™!3Xqã†“ï
rr!X¿Àj<‹’œï©t—-=Vƒ³ÒÆq%ý‚´häpý¥{œã<·ëà=¬(ño;¿²­˜6×ìºWþìßHóÙÊÛúõj1³ÙÓh`=B/‚=JR2	0pg04u¡r=!¡¥".Å§v!xEPGQQ+µ›qñ,3åíèê?ë•ŒŸ­¹œœÝáá4÷ØâÒƒb+óbÒomnHÓ Lï*ÐÐ@mŒ½ÓE½EÐ%@mÌõÌfllÉvÌ?É(çGG?"æÅÅ?õ?õj2jÈ/©ùw?å‘S|#á	·€‘ VMìav$t Áoh@¢X´r6ýñ‚ð¤Va<è7T!œA5N §¥²ÖiÙm²	h°y›•\`üÓæ‚»\Îyµ½¦EJ|]SÕnÏ®'Ÿë¦ýæñ€²‰æH¼¡âïõ1ô*XE/\«s]˜—ÖYãÓZ´U–7;Nd–|†(Ú+•{‡(Ý`Ö“FøT€øõ[Z¡òõkàX*õ®ùÐ°ß ¹îaÖÖþâ±mœ­ w¸ÿ;;ÁÓšÿŠöøëPS*ð/“P~7æxS÷PwS]ë0a$SÍç…À°Y?
B@ÀÀíœg&¬ï

í£
Ú£Úgñ:òñò:KÜÛAÉ“žMÉ“ÖÉG#G8%úóú%óú‹"‡q‹‚‹‡ÁÖõ@&õÎ—4£::ôØ«£'ôØÿô2;¡ô)ÿÿ¿Ô»)»s}[u·Q~úCáÒ…ÕBYÔÕýjÚðkz¢ç	kðÎÎçD:¡¡¡µ¡ÚÚOT×OT·Ê
_êêe8ç8 êþó<êeèê,¼$l<æ²OØÞÞmê¸m:íËíQœ’Qd’dœ’ç†Qdþ‰í¾Éí¶í†!¸Ö¨ø¸"†¨†!S"øÞ9"S9U^³‰9Ü«3t^Ÿ««~fÆÍOFsL½^s±'±x1Æ½Ì^„±‹ÿ1ÿm!j!mP•mYè¬è•‘e€Y†l‘€ép†e®ÊÊ®ÊpË®ÊëÎ@GÛ±{5··'{·£•£R¨›F_ýRýÂ=ðèñoo­­œ-¼•Á¥ —¼Ä¥à—ò`ò*òCÄU	“	^Eí³“Ó^	˜íÊ)e¡e¿23’êÈ×»%“€Eá™^Êß™H|G^B”
ŠNYYò÷)í¹(ýŠ¸*ë":˜Í­X×ZÌš=`¾¸4¯ÎOa(Ã(È9[zXJPk“m	;ëŸRA³j/‘çœ+2¶/o7upšTX;Z &¸ÚÅM¸¤ýÖ÷Ù´„žƒ¾žÖcG„Å}g°'©Ã¡¥Ä6w6á½Ù­¦=ó=c°hâœl&¡ç·òù#.;¬ŒïÌQlæNÞ©îÂ9²F,Bpø7$¹ç{wS7ì††ñŠsÆdñÆ¥×ñÒÐÞOÉ©À¯—”I¸Rƒy¥solƒ_çR	ã:ü1ÂE³étÐ®³/	‹u}-A­sÓÎ½à˜îÉîÚœº;òºwkk;d·à€³WK4ÓÁœ9[«;…yF`Õ‡þE«âhÏñ˜ÀÅåËRkÑ:z‡;;ïô‰aÑs^^Y+^óóYóÛ#SD8+€#DlèùSýùà]Ð}O)F˜¨ïyŸIY¸aM¹à"õ-<á¸Øô7ö5c|6gX¿+'X+.’@ªIòI“Âppû\ÕAà\Aïòo¬ü4û7$¬7À¬ÌÔáÔnnIÌnnÌnßöâetöûŠZ`û`ŠÞÕûµZ\Û—Ú"w’üY//+S!+³?3Ä»»kÞ³‰¹kÄÚÁAèq‰?ÍAWWéW9>qåyÔ¡WÔWyA5Úgï¥Ú¤ï&Q…®®¾ìâ/~û¸ý”£Ûôè¡F,EW§ë§›eV¥Ç]‘nJ\«ÊÜ`SnV¼8KQ‹¥WÒVñ1Y)Ãà_I¼ •o“rŽe–e.\Ÿ"ze®¾À]…¿3à»’tíÚ]gÈ0š#Ž¿7Y#oª¢%œá8_ýëÍé¸+“S¼ýL[V×àôÏib<¿b —û¿ßèÒ°¤b£+¤Ò»r‘¬ºð%82üC—¸0©T¹0Ý¿QB)LQlL°°…(ÈÈUUö1ÈÀ–ÛPÜ­ZƒÎƒ1””CN:”ÎòuŠ†Cc|™I IììmŒ¾l‚À°mmáŒí…”¼Àmg†é¼Òkõæ
hgdd6½øN<6Bes
nyN©°s÷n£ìW¡„ú€M×ÒÕ’IŸë¥XÇJ:‹—\à`¨à³ÆË[—Á™¯jïŽ‹3%êðââô¯ˆæu–Ÿôê¸ßäÕU…2Y|ÿ\È$ƒ–y\ñ–hqÛÀá"úüË‚¤‹Ä
²Ã‘Ê€áËÃ™™!3Xqã†“ï
rr!X¿Àj<‹’œï©t—-=Vƒ³ÒÆq%ý‚´häpý¥{œã<·ëà=¬(ño;¿²­˜6×ìºWþìßHóÙÊÛúõj1³ÙÓh`=B/‚=JR2	0pg04u¡r=!¡¥".Å§v!xEPGQQ+µ›qñ,3åíèê?ë•ŒŸ­¹œœÝáá4÷ØâÒƒb+óbÒomnHÓ Lï*ÐÐ@mŒ½ÓE½EÐ%@mÌõÌfllÉvÌ?É(çGG?"æÅÅ?õ?õj2jÈ/©ùw?å‘S|#á	·€‘ VMìav$t Áoh@¢X´r6ýñ‚ð¤Va<è7T!œA5N §¥²ÖiÙm²	h°y›•\`üÓæ‚»\Îyµ½¦EJ|]SÕnÏ®'Ÿë¦ýæñ€²‰æH¼¡âïõ1ô*XE/\«s]˜—ÖYãÓZ´U–7;Nd–|†(Ú+•{‡(Ý`Ö“FøT€øõ[Z¡òõkàX*õ®ùÐ°ß ¹îaÖÖþâ±mœ­ w¸ÿ;;ÁÓšÿŠöøëPS*ð/“P~7æxS÷PwS]ë0a$SÍç…À°Y?
B@ÀÀíœg&¬ï

í£
Ú£Úgñ:òñò:KÜÛAÉ“žMÉ“ÖÉG#G8%úóú%óú‹"‡q‹‚‹‡ÁÖõ@&õÎ—4£::ôØ«£'ôØÿô2;¡ô)ÿÿ¿Ô»)»s}[u·Q~úCáÒ…ÕBYÔÕýjÚðkz¢ç	kðÎÎçD:¡¡¡µ¡ÚÚOT×OT·Ê
_êêe8ç8 êþó<êeèê,¼$l<æ²OØÞÞmê¸m:íËíQœ’Qd’dœ’ç†Qdþ‰í¾Éí¶í†!¸Ö¨ø¸"†¨†!S"øÞ9"S9U^³‰9Ü«3t^Ÿ««~fÆÍOFsL½^s±'±x1Æ½Ì^„±‹ÿ1ÿm!j!mP•mYè¬è•‘e€Y†l‘€ép†e®ÊÊ®ÊpË®ÊëÉÅ/¥ÏWó‡q²9*ŠlŽŒç28ì>3:Ù8	\Vp[ETS7¾nXÄ4”ÕÓ•fÒ÷ðü<®‚üÂ®(ÑŒËš´4O/pJŠY//+S!+³?3Ä»»kÞ³‰¹kÄÚÁAèq‰?ÍAWWéW9>qåyÔ¡WÔWyA5Úgï¥Ú¤ï&Q…®®¾ìâ/~û¸ý”£Ûôè¡F,EW§ë§›eV¥Ç]‘nJ\«ÊÜ`SnV¼8KQ‹¥WÒVñ1Y)Ãà_I¼ •o“rŽe–e.\Ÿ"ze®¾À]…¿3à»’tíÚ]gÈ0š#Ž¿7Y#oª¢%œá8_ýëÍé¸+“S¼ýL[V×àôÏib<¿b —û¿ßèÒ°¤b£+¤Ò»r‘¬ºð%82üC—¸0©T¹0Ý¿QB)LQlL°°…(ÈÈUUö1ÈÀ–ÛPÜ­ZƒÎƒ1””CN:”ÎòuŠ†Cc|™I IììmŒ¾l‚À°mmáŒí…”¼Àmg†é¼Òkõæ
hgdd6½øN<6Bes
nyN©°s÷n£ìW¡„ú€M×ÒÕ’IŸë¥XÇJ:‹—\à`¨à³ÆË[—Á™¯jïŽ‹3%êðââô¯ˆæu–Ÿôê¸ßäÕU…2Y|ÿ\È$ƒ–y\ñ–hqÛÀá"úüË‚¤‹Ä
²Ã‘Ê€áËÃ™™!3Xqã†“ï
rr!X¿Àj<‹’œï©t—-=Vƒ³ÒÆq%ý‚´häpý¥{œã<·ëà=¬(ño;¿²­˜6×ìºWþìßHóÙÊÛúõj1³ÙÓh`=B/‚=JR2	0pg04u¡r=!¡¥".Å§v!xEPGQQ+µ›qñ,3åíèê?ë•ŒŸ­¹œœÝáá4÷ØâÒƒb+óbÒomnHÓ Lï*ÐÐ@mŒ½ÓE½EÐ%@mÌõÌfllÉvÌ?É(çGG?"æÅÅ?õ?õj2jÈ/©ùw?å‘S|#á	·€‘ VMìav$t Áoh@¢X´r6ýñ‚ð¤Va<è7T!œA5N §¥²ÖiÙm²	h°y›•\`üÓæ‚»\Îyµ½¦EJ|]SÕnÏ®'Ÿë¦ýæñ€²‰æH¼¡âïõ1ô*XE/\«s]˜—ÖYãÓZ´U–7;Nd–|†(Ú+•{‡(Ý`Ö“FøT€øõ[Z¡òõkàX*õ®ùÐ°ß ¹îaÖÖþâ±mœ­ w¸ÿ;;ÁÓšÿŠöøëPS*ð/“P~7æxS÷PwS]ë0a$SÍç…À°Y?
B@ÀÀíœg&¬ï

í£
Ú£Úgñ:òñò:KÜÛAÉ“žMÉ“ÖÉG#G8%úóú%óú‹"‡q‹‚‹‡ÁÖõ@&õÎ—4£::ôØ«£'ôØÿô2;¡ô)ÿÿ¿Ô»)»s}[u·Q~úCáÒ…ÕBYÔÕýjÚðkz¢ç	kðÎÎçD:¡¡¡µ¡ÚÚOT×OT·Ê
_êêe8ç8 êþó<êeèê,¼$l<æ²OØÞÞmê¸m:íËíQœ’Qd’dœ’ç†Qdþ‰í¾Éí¶í†!¸Ö¨ø¸"†¨†!S"øÞ9"S9U^³‰9Ü«3t^Ÿ««~fÆÍOFsL½^s±'±x1Æ½Ì^„±‹ÿ1ÿm!j!mP•mYè¬è•‘e€Y†l‘€ép†e®ÊÊ®ÊpË®ÊëÎ@GÛ±{5··'{·£•£R¨›F_ýRýÂ=ðèñoo­­œ-¼•Á¥ —¼Ä¥à—ò`ò*òCÄU	“	^Eí³“Ó^	˜íÊ)e¡e¿23’êÈ×”,€tŒÄœé–³³ÊM´ëg44Q)¨±{@¹)%XýbVá¹ÿD@«õýìÄfèÉ§Oój›¸æ«ÒOoUŒð}bÅÐmMmþärbQIVZ  
gÅLõ~Ÿ?ËÑü†¡6ÓÇËòf}Ü‚6Ú×ÿú½Ã»	¶QP×.îVŒ³¦ªøFÓ}²—·/ÂÙ"Zjdo‹@Æ$MVp³Ñl– Â„7Ž°$-ü
G¡x™
&Ë~èy
=
í6y=y‘®T í›8/1ÿý¯¸»÷ÏB)³©²	Êzºìî/j
î«#Ò×’{lÏ=üàco^p4¼iT|éG•ÄèLÏ@”nº–L¡ ß:Qç¡˜ª˜yt´y(C(Êÿª<þCÉjjjT§ÐZj²&+|Dg÷™˜<=Ö¨í)<¸Ö¶­â–«=8{ÂÌÅpm7üJä°¡Rú³{9ê°Ù°••Ž4„\¡øU4qJ\\äZ‰Jq¦RQH„Ž„¦QÎHHŽ¼?Î<rZr?¼µ¼×rÉ:<>í0T¬ýíããŽè‰CÏ•äù¤‹TLäó"YÐG‚JÊ¤ýÛòû„ª%­G@«é&BéÃ*&B\#’h\ÑÃppó/‡È\ÑÑÎ/—ú¹ú‡}‡QÍ}—Í®}ý®®>ÃŒ¢°°>ýÁ•Œý­Ã|l‘€õlŠa-úÊ/82DÝb-'ÀÀHU=åH´ U^È›ùÐCÿü$Ienw›$ºñÅU÷ìüäT¶¸É¢íýßkDc‘Ìÿ„uU02õòô!y44Å-•_Ç	cäGd½è«J!ç½L´«u&q]q&;ÖÜôÿ^»D_c~MŒz^Ñ•mW6¹íhFm	tF“¼$õÖ ubTõ$gß–O}<°	>ÓÁ~Úm{ss>¢>‹Þ˜vûvû»q0ý"WV²"Wž]E<ÍÄ±ìÐi]o ŒÞ°Þ	ëEoŒMç¥¥MOMŒyúx+c¿EtÇ¹·3BR2´’ÝÏl±~¡ñhë»êê¸)Ÿ¹{-óÒÑm{Þ¸®dÈÅås¼°{‚›TÎDå	¥©<0Eôáúk#á#CmØXÌCœC(Jì˜I×r”¨k„9<¿žd/-9c&ý]'âÈ…yc··sÆf7KÏ7fÏ—Æ7;ç)›÷Ên¡£ ùÉo¡Œ½`wÌÛÌÛ2:w:Û—³õå˜³³°Öfm>¹WäFâÉÒW]ÚGÇ`fóôU³¤h.ºGGYG2¥2G¥GGGÎ—sŽÿžWWEÂW:ÐÜ´Ö…Ñ8‰#ŽM”F’§g„™0÷ø!Ýk‡Ÿ<Cgbg£­nFõÌ<J<Ì“dínÁ,.o…{R}kpÕ-fËÁJ‚€¨^ñJnlYÏÀ×kG‚K…Ì)m%B`ùû™QºŒµ–·ú3³AlPômëgjM\JL£Ë!P”Þ"..ÚÅƒdkk¹¹†ƒk%ý††0ŒIlh‡<h<Â´--8<Zýœ´êv¾vÖÍ¢)••¢)l¦Í€€³)G[#YrO‹ò³*‹¬¡b¿‘žÏÄ¡52,|ÈCQyB¬h)Á‡–Ö	1DŠ=tt¯9œÒÖ{*	bsæ!(O-¤£s¦q{È–ŠfÖê,ÜŽßàçt÷Æ‚fŠzãxÉ¹ÞåX\š†IY0Ii!pf3.‡Û(b7h7hµµìs|5éL-äq@5¨Äô?Ç¢R½žŸ4íp™Êh»÷™ÿ~ã>0ª‰´chùl‚k¢ã4¾èÀÌÍ¦o9Ä³@b—|¼þ¥ÓÐÖ^"'
XEBœÖgõ”%=Ç{|µ<µP™@êŠXEó@¼Ÿ–0¼vBiì÷{ŒÌ/ˆv/2óŽÂqÏ{É'ãÓ]Tùï…†ƒ;áïƒÀŽÛƒ.Í•³±t.B£¹ìè2K¦‹›Fä®þâlXí»ÆSqD--½P—P-Ÿù9ËPýR¤èÙI3Œm{!ãªi|9/žm!ý:&útDn¡û¤H°ŸËÛšJÈ²SÓÍò#nõæ*”²‚
:­u¯^ÃdGõÏý‘ÑÛ³§ý†â¹¾pÔ=·à3—ƒ½wvË¦¬s”¢Ñ4‘]¯ï¹³ßµÿnïdßæ¹ÌÿuœÜaª–¹!½í¢8<ñÚ›Ðu”íÏÔ§šA¾ý =ii \sMÛéé«oÅûÀªúë'¢!²NB:¡ÍjŸùÜŒ[a#ÃÏ"Z|Z	¢kGÆ@ÌÙÇ¢cÐ7pWÀÆqP™7dQÔT%Ê0í°©ç07fáäÍÍÂelj¹Oå“Ü³¥ÀxVÊ&ÞšÇJ°^,Ndy+˜þÄËhBd!Ž©¹ºÛÿÕ|¡çt06h’»°þ*1¡‚·W‹Ÿó°”ÜyKðèS-,ÀÉø¬ãö^C7óMÔž—ll ”és;fFX=__	Ñ‘6eÜÒß[›8î?¡§°VÁYH)ÄÛBOÄJuuÛÛŠ:‹Ë:Š‰ÅÊMËM¿ÅV‰åº¦Å¦Å^¢ÓÍÓ¨ò´»Ò#ò´§èX±¢ÖÒ"¢¢ÖŠ³uŠ;;"íPÇ…€ä ªÑÄ*ªÞªÄÞ‘ø}~!¶½®OW‚r}•Ÿˆ¤ÄÞÁ“‘êždÉ•ýzÜßÍOÅ¨¯c6ÚCenƒŽ‘Ìà=wÑæ¤¥¬/øZù!#‚ƒô´O€O•‘)¿DöAyðOææ››H×—\Åë™êÓ¢™'˜óõŸ…}5Ò±17®¹8µÛ'@nÝ9õ8ê›x^">[Mö—Œã¸˜>©e²Š (Hé-^·§--[^ ´&;k¸»-÷ÇÒ6ÜÏà’˜WÆÛÐÑ_)í§_àÐQKÃ$¤Ê¥c!9P:›ôï¨+ñÇ—Ûz.$€$ÚCCºClÌCÜÌ¸9T€@×ã÷=×‡¦´”<®®
­Ù©Îú­Ò½³Ú7™-5(™ÉFç{æhtpÚô9‘=±â)N¾€â@¾i¯m”¯cÇ%@%I”R''%˜S~È)WÞcÐg•á>¿å•ŒUåÐ}ñO)O¿À~CCë÷¤Â1çf†ÊIü	«“.©Ü©dùù:A–¢{ÎùÜO”ùÎ”Îú”Ýbúg§ôÊ§öæ':š0'3''q„·`¤“b½»÷•œÔê²Ýàe{6‚…î¾Åt©EÝÛ/!¸ÙÏÙc‡¼Mg«ò‹'·H±–×.Csss(sœFFCœý¦îb`×FžVScFSÊÁÌlq¾Hh‰'ljlYZb¦âLP£›/5ûÛ5ØÌÆ""„%ÌÒÆ¸òò–´d•€Oç’q«©¼ù`˜8F©A—W
ùDEmi•|+€5‹ˆ»Å‹t5çÛ1=ý±	4ãºsbÂ¯¬¸Ç×bÝÜÊì¶	LÈ­.¦<X_¥xÜü4u4ù¤¿ìááæäBîÅ–»–5§5µ§pµpÞppû]e"´®A]N]vN',,6Øv½,Á,,´ûœRP1PP R™ú5_Î8S3ÃÏ‚ÀZìŽ°ÝrBÙŒW!à#»¡gg¬¾-oDIµH# ÅyCXýHE¼Â Ø9É6ÅÓÐ‹‘€º½Y†H¤RôIì°{
¯•Ó¸ØêÍÖõbJ¿Å‘ý",¹QÅ?-K€+ˆæýS©©ý©Gåß’l—*MBâŒ{šÀ’ñÝTðß­Ûù«­*¼àÚ=‡r2Æ!E9PtpÍ0šìïg¼eQlOcuOIb^’1[V'¯²AV¼8·±G±²Õßl{ÇÉ³	Ú™­&‰DŸö-€k¿e·så;Ù4DÌ§ŸÎÛ $yšK.JŒZŠ])]üTëñõø9œÁu£Æu+‚o™mÓ"<ýãlŸZô%£
f>Žì¡x©lÀ5"ï7ƒ{·‹çlËî	¶÷F¹íµsÕp¼åd¡qåKS@¬º½çêHP^×&ƒ`)mØV‰‹Ô‰Òº×öýËX„¶zi1x@›yÝ|ñâ™({Y*OàñTªÀˆ“*Øê+Q’…Kê¨ýQffÁE‰÷Wõ,£3¥Ž²NÂ²¿½lŸÔÞÕúF\@«XvÒ.%ä—²AÞ0„š•pºÀÿùùš4dÝÀ¬€ïC)i”kï„·‚ã³¦ÔWéFù)ÛÛajBÀóŠc(ƒdô{Î·í¡ƒ¿/³ºÊ!y ÿ™ÖÕ®bÁ‘ÐÑóo[Œº!u‡Ÿ–ÆÅŸì÷÷Ò¼h{’|­=ÖÖ_C\PÚVèŠˆˆ„x£‰þqKŠ^Ä]ü?t¦±}±*Â…R*H7Ôkù*øg	ñ1…)“Güüè)h‹Âb…4{Õr1š„.Ni¯R”ÐÃüE^ÕT¯æð ™dðÂ.VìîMf›èu¶³Å»ìz–kƒ+¹Žt)aªŽ}@^Cí¼Æ¥‚ŽªaÝÕ$÷Šµ”§²µ¼-Ç!¡OvÓnOÜÊo}<<2¶¡Ð}kRtNß¢$Mºi7Ôpx7?Öÿ3ýäýÐ	i9–©\I,…”KÃ¦ç‹##»’‹tÊÊ’+^ëÀ’cT’55	cßrú ú5——5í­%**ÕNs%{÷%ÈÈp7Èß7M&Óô”&É&”7XùzSzÇŽ D¥ ·3ýÁ5Ñ¢@é1Pÿ|ÃnW•fÕ“ËDXãŠEXi¹Áœïˆ¥[Xý&¢ïÎäùÖñ<ý¢ 281ëáíæœ+Ýýô"ÌlT+¬Í;è|@H•ëÅêx•;ƒòÖõ¤yUWP¨Êàˆ'çÂÂÍÉ“ˆòÕËÐ%
©ò<ŸãÔìßþ$î< ,Z—Ã›&P‹|ÏŸ°~ôW‹‰N¸‰UÓÅ£š÷a§dîsŠ•3*šd6ØÙ9‘ÚDŽn #u&'Y½Då÷Èî=U‘‰ÞŒê®‹‘à6Äˆ9ÔK¾\èÇñ¶š~µnËµB^«W$¯OO¯jij]"iG½J?´CË|S+MQ€O]´	"«PŽ_<6uxq÷•wèáv	à*è®*†CNÃÇ®/2Çu‰Ãü!9ü/Çu9ÃCuMt‡0wôGU?mo=X7ÚA_î»0¼lö9öö0«ìÚººRºYXGH)»	dR±èž2TÉãØÅI–ÞcñoÀÅUåUUUUoÅoÌ¨oÜ8oÜhÜ÷ººæÜ(•±õþžS¨ïº4éI(.aá-kb±*ä„6÷:ñ¿l#}üïâžJ‰´}É8&ƒF«3=*[unær™8S¸
ûdûgKeY“ñ	'F:X*–éK”»*(•îHü?$XÂI”m†UÚfÍäO²&Ä…òåt~¸±Ûói»{²þÜ|¥l‘àWWW(EYYkí¡»l»¡å÷¤ÑvŽLêëZXÏG–[–µ§32	’Ÿ&N©ÃF~P)§ÙÞRq~[\‹DiíO6'ÀøsM3¨ò´3säsqäå>ðOð>«Q±àkþ,!gè¼¢Å‚=´ä!­+~ÃŸ8ì-Œ¨ÍÏ)Ô…ØWcÎyÑ?õyYÐ;S§‡zŸÂ5á›½€Ì×’Eáž*ÊÖ¿È¬ÖÈ=}å}*ò¨@}S*@÷L@“**Ù@Œ†’¶ß¨€f€†‘¹ß444¹€-RÜ{4::h›¾›q¾ß:›¾›õ8¬ÆÜöæú]ÀÐ[.07†ËÄø¾%=+ôÞWánƒ åtîg'K_ß——K¾®“pëŸ£}”›;Ð@·šÌÀ9½šè««=‹ˆ€ï}‡}c¦-CYZ¿Žñ{P$XN}.à¬Ö¹zž	žòE9œ©I[ÅI6u4>Fè‹¨6°žTâ¢vl%Œã=¶ô üQw‘'´~Šš<÷©Î€ïnªH*.§HÆ]À½xNwïs,/“sÔ@…¡©÷«}YŒP``¢}p¢dÊmx¾½µmÒcÜšç¯ò#.q‰‚¡e­¥ÙUYçh˜ë×õr8¸M‘c`B‘]?*AöR¶›4ŠÁ9­¹ymGG}Ó½°½•óËceo
AøéT[1mGMD¤XœQGPÚD0J^U/#2ò/¨*zÿY(Ü×$jB	Y½$xtôë{13·UQUâÜ6´¨H,>µîP$\6P =»°¬?€ñ1œ/¿¬ÉöPÌ¤ñâ‚¦ÐÍ%uôÓ $n_zzã\&H¨Ú}Õµ¤â lU­BJDØ£ÜŸ{¨­l­UZ¢yG¶ªx!¤}ÝliÆöV7š(žŠŠYgÈg¥°røìtôBÂÓ©ÁgßüÝÃiõ‡àH×¥›«ˆ±W+×ŠÚÚ©«ŒÓ7,ª¡NåLéwúºtffwÂ°Y‹j,ºæãÐ
à—Ð^ø#€[tv×E¿÷²OÐK™YÊ™4—+¦oòAÆÑ+NS®ÚD²èš““Œeb]¼sEh¢s9Oõìå4Ä6˜€ä•d ³W}2.+®‹ÍCaÛdr.9%m’Ú¼i,¶ZþãWÄ|>7,¸+DzK8ƒDâ¸œÛQÊUz9@…"ª€J‹#î*ðýøaÆÚ+=ìym@®4ÆTÃQÇ[‘Di¶b¹œÑßáï©-7Š:Ä–æ[nRŽC#EtÙ_íoPQú9·O55HHOØXoØXLÎ¸5ð1/•úåßåß¢ÒU¨ÒÒ¨ÖåÓ¨«LLÖð©Ü~ÜšÓÜÓ†O@©FOFÜW,F‘5S”,@X@»XúmÉã«5ãªlÆ…û€Æf€……€!ËÌ¦|*³:Y¦ÂhNÖJŸy‰«!6FGš„ïŸrž½ghHHF2
”#Ÿg	ðƒAÎ(ºÅNK[ÄéÃ[›·×·ÊR\9¨‚Od\‰Ÿ£ë<&ÌeÂ‡ÎÇÌm,ÜÛÂveÎ*AhÿÞw×8"1úm:l¡††‘œ¶t'Ž1¹GP1€øyŒØé½«×”ÊC™í5ŸItQÝ{q9\¼\90&¨ƒã7}cæW…ŽGŒ±
`E‘Ÿ;BÅYåãYó¥Ú­íóR(3{ü“GnœÌœz¬åœµIÌÙ‰ð¥ñµ’úoÇ‚„¸F~sýuQWÈfº[¼HófBÕâ?S»‰ÂgÙ'ö¤tŸF€tWü©e20 –’¥0@xr¥–»òò$;;´pªwha´^ÅÇç¢üìTþPâªg}¤ë,re+8pýk^	EQºì{òž©8­'SÌ&“a*uƒBýR¯‰)jÉéâ¦¨i»}˜Æ§ˆLÃi’5—Y¢|’0Œ„§Ô€ŽæÐ¸©Kr±LíÂo•‰•„.ŸÒè®žž†R_Ñä—^U_RÂ<mý#ý-fmfÂXýñ#L3‡L‡Ñp~ÑLÑcEc

ÃÃÞj­­P-jj°­»²ÝwÓ_Ú¼ÈŠËÆêæóêˆ`û.í~oiJ‡O6€épzp¥ùvó`EåAj™I:/–F0´Kí3ÇåŒôç±ÈmJmÕ±*º‘Äšñþ:zZ¾N¡
oòšèìž§ÈÊÄª…6*’N+_<§`oÞó¢ðw<¨w­ßŽá‘Ý`ùè8áÒÈ–ùé–Kä¤°­¼¸ï°Á¡h´OÉhz+Õ9õA	Gn¿ÅR+Åîó¡ô¼Ž)vÈÄ4œ”¸5#ð¿¨’©vÏ#Õ‹	‹âîîå†}e¶ŒÁc«ÙSVou;I,'ZQ#+%z^? ›ú‡+Ž9UK@-U‰‰[ÕQ76X/=hGmq"•Õ2ÕÜW#=‹šqªÒ¶9)mþ¶|jGlúµ¤t·	ùv1ëœVP N†Ü#,&¦Q”§Î¯¤]oÇZ•ó	'=\UþÔ@£Ëµ'ù'Ï—Ÿ©à´üšzzšjÐ¸)æ<üh§Ë F®(ä#ÒtneS}ÕTÙQz^y££SMAÇú‡•fê/„Ahhú‹ÙúÙÂhŸùÎ/Â¥	ÂÑÅµõS»ø#S	V¦úòFnLa6™„Ðä1“¢‡®¬«öruSo…CX¦­|œ˜ÎâEz¼bõkÀlžÂÙàKÌÉ­Ôgn«þ¶r;›3°Éä¿4~Ñ¾²aÈ:d¯~³ñ›QÜõÔUÑ7
wÉ’.ü/=$±‡²´Õ¸ ‘’ŠT ¾h­^ÅÛ_ÿ]üëqá„æOOæ§ægH„pŸŸ+F‡&+	|Isjv&&	º²Ÿºf	ºÅ²FfsD²èDøž‡ø§„b”Õ§”ø2³€+t+™ó·MXgt˜ª.˜’èE¡¡§§üx&õ§kñ—:ž¸êúøêÕùRn17›‚Éº{	+uåYeˆÚ'Ü$‹_ª&~*Œ,¹9FÅÞcU‡|‚ÕdR¢†44Šaþz& zC–øY9}KõO^<z]6NYmôh(£<6Xn )qhåÅØÊ¸?ÒÅgÉ‹ÞZxˆŠöŒ°¡e˜¾ýRTç”*ZqÂÒ%Â‹Û:`‘%8!)@`õ„8zÜ{•TŸÇAÜÉÝ‹B°ÝßÎÆÎ³£Û$Î¢‹øÛ|dNÉÔp¹³Už´8ùP"‰’gÚ¤ÏRÁÇˆSEÕÆÿO¬E/0G8è£`ý,U†Uœ/¬2.òüòò˜áø©šñnÒ_¾”{æÕˆ td”ˆ£’ù½§1ÌL;8ôKðæ?8T»„0›332¢¢¥2¥½ê½,ÚòY`ªG?o½qšz…aøÊ²Öýüï¨Œ±`¸òã0ÆÒHÚêž>0tro“z±¯¤b•iÀ¹a9ÞœÝÝ, ôÝÖ“¦¦ö›¦¦OþBÐGÅ¾@	 Øÿ¶ºkÖ…ˆTÿ`-0ÆJwM€J–uñÃä4z³M‰‹“ÈÇÊÀr$Hä[î[K»»8ž’žî;¯E¯;$~¯;L<QxÑøüìøn=ì<¼>y J ß FJyJyŠ

ÂÂ½‹¦½µœ¯µA„û$05Žèö×v†±¾Ø7zHÊÌë,ý	+NBI»hÏ&u5•Kð_è¬J“Æ®îµ±Ÿ@×ÆÚ§I¼x“'g³üçNöfÃŸ¢
•)ô6"ÐÕºPQPQL¥3ìü¸xôíúˆ½÷|Ø¡¤XYN[[ýõUÌyuœ–äaüAlg|³ç¯º‹C­ìçÇÂ|­ZŒ©åÇ6¯£úEä•†r×È?ÝÔÔzÃÿÓÖ›×ø°yšµ%T±%ô”*ôûýèÙ>CÝû'1ŸÒÁ#+”ûèÂZJ„0£ÒÏÔµ*)ßŸ–ƒR®Ö«ÊÏUHGšñÙ‡F"3 XŸÄïé:äùdÓ²äsÙ²cÐ¨ <Î)ýš.‰¿W>w¨”Ú¯U©¸¥:Et;¡lž<EmÝ¹ass7¤ã tî˜â¦{DFdEQvYZäna2VY“ÆÒ+o×ª Dsþ¼e ›/#ùz
¬tûµ#W"ÂG×ì§‘yY‡Y1W)øœðaw‡ýšOâÀƒU%
´,na3)/n#âØKÿÂå9ê(ióù]¸ù<¼ˆ¦¥m1ì¡Æ…è²n-ºGÒ-·†öŠ ÍÄ€Ž(ÄÿÙ¹píêâÇ©ívêÃY™XJpiN*†#6M¥{H8B_ÞZ¢%$µS¸fîX˜¸£¸²w-w­}~±Ö	TgnÆô‹rÏq¦ç=r»É	DQƒÏ‰ˆÓøa¨–8¬ÿ¬ÂÕV¬°úi|"ÎÆ:æ?R¼z¶F(_ÓQ›­¢â’ÎYž:JÐä¶ÄMMsffåç'…T7f7á;ŒrrfÎ‡AùäïfDÎÄÎrœœ¾žrõzÌîÏîÌeÌeá8ee8žïÕù	 ë~ï~Ê	#Ê+íxµQ«‚?TÕ×¾©ÀP­ÿhÿŠAáWfî+ñù ÊÆ¥Å¿/nh'œ`FJß{»-ž+‚3)22ó*hÄí¯Ü-8)7Lt
G…äd
¹rYÕâÓÀYpf¤±/¶ÿØØ¤C‹—ÜŸqœQV†áÍùÝ$ø³™•Ô¬T{ÏW¨  BBèW±±¹¹v¹O&ËÒªO&ªªç„çöC„a$\CC\C§²æÕðâððâÓd–éð||BdÄÂÜ(5("ii¿{BÄs°÷y€ÀÃ|Ñø¿|¹ÅÊ!Aü'üU@Þ`AceW~hÐÈ}ÈÈc©¼¾Ÿ®µ}}Áa}gîüð¥îoÏ_FG1oYŽo+&orVÜêoiW -pÇuÆKG¦¯ÜqR]åÉ%êýx>>=xÒ¬Wx)µð…)—«(:9LVöEwèësÁ[½{’Sq!uÁ„ Y­^vÍQîÑm—èŒ*kWÂúábE¼¸Áçáh·Ó„«¦|­Èžvçb­eJ§¬òjz¦:µ>ÃÍ[¿[¦¡»©û,n˜™Î¯HðÐÅ=²ôŠ“ÅÂ„@Z„%ï,îîñ,5T€kÓ =ðÂ¼¸ )ßÎÐøuÈ9\S…D;¦×«õHz&Ë(ÓÏiíÜfR\ ó™™4`=Ï¤|?áË$z¤dYÛ=8Ô{Ùn=ìº1åy0ëº+€ú¸²øÿúQü“¦	¬ª_¹‘ò1vmÒ9ýmUíš‚$B³Ö1ßòÌÝ6=sFü™[­Ç­D­="»Áù»À1 5Ÿ1[¥œ~Lšl'Ésš6Û ŠïÍ‘¨ºG9ÊÜ{ MÓ4¡HG´—¬â‡­—â¯Ått~~±±[2ÅƒÉ¿Š=©=ü9.³OÓd#|Gk|~b1™~-Wþ$ÿê¾ÄôÁ®þŸSn <Š±Í‘%ãY8®~ï»Ø³!q‰èWDî«!“œo¤®Õí^edËíKÚã&ó~º#~
"ÚsrqxÖÏ¡µ†ƒœ$¸àYÜD±:ÔCúŒÈ|‚é€œ²µ4h3üÐLXùb¡·¨Ÿ°ËÂ&<ÓS¾9â[L`ÃgsSïPÌYìj×9Ü'DbjuÖëV“‘}J°æ¼Õ ºèv@‘óCæûGèæ!ì¢¶âkP:ØAXdôQ‡@ùòÁD9©(ŠæìÿJ¯Ìß÷øþ›ä¹®Ã5æK‹Ö3­Z¦ÑP®FðÔôˆóZZˆèZ¹m–µ¥è„[¹[€ßÌ¹n—ŸBÎÎPP¶PÌî!ÒÇîÒÇÌÇùùôù!}kù&o,1o1øë0Ï.N1èu#uu¶›ejAÊiŽAe{àCëSÙÄÝÀ×
!'y±8Ia^V°¶rƒ@ºê©ýsY[Ï[[—ì£ùŸL­ü‰«šâD
©P­n›‰Ø†R 
y/+XKZÎ2åUåžÌlªZ]óªôôü ‚Ÿ2ó·99j!é9fäÌSÓÖÖZ†²ÜzÊ"¬*ÑÑÇµ²V|(T†sÈpúif(¿6+‡4ËÜBÿÇZ0€.c€«%·Ñk¦ž£ttæhF%,plQÈ©zz…·qÕÆÑŒAÈÙÞ‚øRÖƒ!!Q;œ!yp„QQö~V'ŒCt`~-t
í\º?ÒR<u^Õ›¼ÕÕÕ¨Ã¨¼V**'²ôôŒ5;÷ëŒÚŒ;ŒÚ`6©®©Ð¨ÐY`ÐMVMÐÐs–‰– SGÊßußOßz¶†r´AøÖ‹ß—f†m3Ž6Ÿ±7CåÈHŠ'œÌKýçF¢Í´ì ÑN³ÑXµ$¥¦Ußž¿ÅHÿ‘ß§ òiM‰O0Ã£C²{5@[‹iã5°ªÄ^1ý’ÓÈŽü¢¨ÃÏÅ­ÑªCEÄ^xx°Ôä_¸òï;ö—¥3øÛHTËÀ­Åì*j:8»PkûXRC P.{Å”ë4wŸò+p¶C¹K„?TL÷Vëá&PE2õPåi¡LÒõY«È¥b}kl„V=Î£¹a1o¡<`wh{“Àñ-Õ–ßg’€çÏ*4ÂàâêX©×é$^Â}Ô»Â6Âì*X”x‡½í’æ+›Ò¯álÿþþê2gÛ)ˆ¶E-Cs÷;.`fn¤gfùš¢yÇÈËá|È¨“PïÐ59³{P´À2ˆUpÍ¦¡Þö#5ŒX»éVìpÑFöúh_—Ksëks²ûë.ï.s.HX–‚HÎ–¦¦M‚xÀPÎÎ-cÎ/±™%™/ü%Ê:¿¿F%ä¦ô½‹½ãä¦svãûŠ
+ssÈ
‰öà‡ö¥_C–‚÷‹¢Çøy2\6]ò;ÛM„G•L¸Öj¸›•òQ2¨º®Ì¼aÓã “õïÃŒåãEçÃ«í¼¹,RÊê¨îUž*cçg¦¾ÔÍ*¤Å·ËÐòµI¦gP@ûBÿGª¿ÜŽJPíËì}=
àü³ú{mP€÷îæ§+ü—×†ðâŒàk“³4B•+Íâio‰’ÞøKËNHô;+A@‹7UVÑ`‡vIIüccü"Icðõ(4ëc³ë²z"™Õ_™´™´²;ZÕï—‚‚!á}¨}%Þ}>><òÞÒÞ
ÕÞ¢ÒäÕÒ6Ñ®®00á6®QQ00“©ƒjjÝ\Ý–è&~ÑÁåèîÇdÖ˜È’z÷™Ëâ+ËÏäpaŽ:HNØ´vyRþ']tžû?Ì)`£w?w™ÌµÏ…¢Õ#p'{!ífKŽÃò[^© ·•pwlCë3Ç;wC-]¼&Ãóuiû¥ààZ~ei™®m*—×/µ©p	C*6EC9€K¬ee¬O€ÑÜ`§ço€Æw6¯×¹Aa“+C££C4&êSVfÓ½:Mµ×¡ù ÊêêjŒžëêÚžk8tëÜHKy1=â›zj'Ñ-¼fûDyÔEJ­,{ U5*[ŒåêšÔ#>ë@ÞÁC6yŒvy*#3H©Î®Ý#“èÀÝ@’/’¸RÓ|ŸÏïÀ*‡É‹"e!OÔ+lZ•u)l*yyðË¤›%a;ÿžÃK¿Ël8³A?A3µAØ(=?3ÞAA­öÞÙxYoáü,&Uhì¦ â-/Âì•[*ÂSr[«hFer7Ãs¯YU¤dQÚ±‚ÞðXÔœû‚¼tëåCö“ƒ)‰C“çéu}àwâãâcüXd‡ógaÄ¥‹ë¬£¦s‚àôðµcø©›®¬Á˜*îK(ÒÏ¤†óØ9]¦ÓÆóe&–2. z`Þ@HšËÁÂ¦¨‹EbýÑ‚%ß§¬
uê/_“PR¨’	T6EuÙ«U.~d§#€R¶mZEZ€!–uJ–ÞíÞL–´ƒ·LÀÛƒÛ[™\À||¿t3+\©¸Þ
ó0¸á*ªáÞSPÀé*ãPé*Ü–¤»[Ñ¡,‚Ø‚ï—™L\R.N•À^®ð†7´ç”.’y™™nžÄ´¼7¿MKLkq³å(¬Õ%danµƒç'ìŸÅU1³×ºQqšÝ/ÖB€}˜ž«“@òÄCò†½åªìrß‘sÂZÍ~^`ûû¦Ò’â¹$È¥Ëš¶“xÅÛ°û×Ûûöƒ•û«@ö\7¯«\ØÐùù«Q1s¯ùùâô{d!!Ý{ÂÂO‡7hµY{Y¼$OvvvÚŠÚvê^êê#ÔYaVÊÿR^Q[–u´TxÑ- UÑf%SX7¨*ò A½CIo]Ï§?­Ý®rëWv17#TŸ~æà>ô5
mpe}ÀN¡–§3]ÞHb†È+òÍ¢`4ƒüÁ”kX	£ØAApDt¶Ì|Rï+Ø•¤Sr³”I}àŽEà3å‚ôáÖ÷Q[Afd¤÷TEä»#V!ÜCÛû\dqW“~/ÎTÿadecomm/1lstdn.iÓ8*ÿ[ŸöÖ[Ÿö<ÿadecomm/1lstup.iÐ¸·ÿ[ŸöÖ[Ÿö<ÿadecomm/2lstdef.ir½ÿ,[ŸöÖ[Ÿö<ÿadecomm/2lstdn.iÔiéÿA[ŸöÖ[Ÿö<ÿadecomm/2lstup.iP*ÿD[ŸöÖ[Ÿö<ÿadecomm/_a-schem.p/Æ(nÿ{[ŸöÖ[Ÿö<ÿadecomm/_about.pÕ3éÿ)e[ŸöÖ[Ÿö<þÿadecomm/_adeevnt.pÈ’]Nÿ78[ŸöÖ[Ÿö<ÿadecomm/_adehelp.p?”†ÿ;5[ŸöÖ[Ÿö<ÿadecomm/_adeload.p9’Ï»ÿÍ[ŸöÖ[Ÿö<ÿadecomm/_adeobj.p‘¸êˆÿù[ŸöÖ[Ÿö<ÿadecomm/_adetool.i(D÷ÿè[ŸöÖ[Ÿö<ÿadecomm/_asread.pxzüiÿP[ŸöÖ[Ÿö<ÿadecomm/_bldfld.wqÕ¹ÿ%[ŸöÖ[Ÿö<þÿadecomm/_bstfnam.póÞÿŒ[ŸöÖ[Ÿö<ÿadecomm/_chkfmt.p'Ø%jÿÂ[ŸöÖ[Ÿö<ÿadecomm/_chkpp.iÍ¦@,ÿ	9[ŸöÖ[Ÿö<ÿadecomm/_chosobj.w¦ÑIeÿÝG[ŸöÖ[Ÿö=ÿadecomm/_chossdo.p©´&¬ÿþ[ŸöÖ[Ÿö=ÿadecomm/_chscolr.p¨1Aªÿª[ŸöÖ[Ÿö=ÿadecomm/_chsfont.p'Uë·ÿJû[ŸöÖ[Ÿö=þÿadecomm/_collaps.p±6²ÿ+$[ŸöÖ[Ÿö=ÿadecomm/_convert.p!EaÖÿ<[ŸöÖ[Ÿö=ÿadecomm/_datatyp.p˜jÿ7[ŸöÖ[Ÿö=ÿadecomm/_dbcnnct.p(qqIÿù[ŸöÖ[Ÿö=ÿadecomm/_dbconn.p®‚Bÿª[ŸöÖ[Ÿö=ÿadecomm/_dbconnc.pB ìÿ[¢[ŸöÖ[Ÿö=ÿadecomm/_dbconng.w	°éŽÿs[ŸöÖ[Ÿö=þÿadecomm/_dbconnx.p>cyÿ±[ŸöÖ[Ÿö=ÿadecomm/_dbcreat.pg²ÿ:[ŸöÖ[Ÿö=ÿadecomm/_dblist.pžwÇ¹ÿ•[ŸöÖ[Ÿö=ÿadecomm/_delitem.pbÓNÿì[ŸöÖ[Ÿö=ÿadecomm/_dictdb.pmoÚ:ÿÕ[ŸöÖ[Ÿö=ÿadecomm/_disconn.pËµâÿ][ŸöÖ[Ÿö=ÿadecomm/_dlgmnua.pZólÿH'[ŸöÖ[Ÿö=þÿadecomm/_dlgrecm.p-;“ÿ[[ŸöÖ[Ÿö=ÿadecomm/_dtbldat.pÈRîÿtÙ[ŸöÖ[Ÿö=ÿadecomm/_dtblrpt.pQ•ÇÇÿ/ß[ŸöÖ[Ÿö=ÿadecomm/_dynbuf.p]ö÷¦ÿ[ŸöÖ[Ÿö=ÿadecomm/_errmsgs.p&³«ÿŸ[ŸöÖ[Ÿö=ÿadecomm/_filecom.pya&JÿAÈ[ŸöÖ[Ÿö=ÿadecomm/_filter6.pÆhÿÇ[ŸöÖ[Ÿö=þÿadecomm/_filter7.pƒ)mÙÿ¼[ŸöÖ[Ÿö=ÿadecomm/_finddb.pà„s•ÿ^[ŸöÖ[Ÿö=ÿadecomm/_findtbl.p bwóÿr[ŸöÖ[Ÿö=ÿadecomm/_fldlist.puC~eÿ>[ŸöÖ[Ÿö=ÿadecomm/_fldsas.pZ‹£ÿC[ŸöÖ[Ÿö=ÿadecomm/_fldsel.p(œ¢æÿN‚[ŸöÖ[Ÿö=ÿadecomm/_fldseld.p¿ñhÿ)‘[ŸöÖ[Ÿö=þÿadecomm/_fndfile.p3¼ùÿÆê[ŸöÖ[Ÿö=ÿadecomm/_getconp.pˆ;áãÿ"3[ŸöÖ[Ÿö=ÿadecomm/_getdbid.p£]ÿ7[ŸöÖ[Ÿö=ÿadecomm/_getdbs.p5kMÿV[ŸöÖ[Ÿö=ÿadecomm/_getdlst.p\£ÿ#°[ŸöÖ[Ÿö=ÿadecomm/_getfdbs.phï7Sÿ²[ŸöÖ[Ÿö=ÿadecomm/_getfile.p~?Dÿ)a[ŸöÖ[Ÿö=þÿadecomm/_getflen.p†Amfÿ»[ŸöÖ[Ÿö=ÿadecomm/_getflst.pÌ|!ÿè[ŸöÖ[Ÿö=ÿadecomm/_getimag.pö²“	ÿ[ŸöÖ[Ÿö=ÿadecomm/_getobject.pÄC¡ ÿ	Ù[ŸöÖ[Ÿö=ÿadecomm/_getpdbs.p
%ªùÿÅ[ŸöÖ[Ÿö=ÿadecomm/_getprof.pcl²¾ÿè[ŸöÖ[Ÿö=ÿadecomm/_getwver.p‰$À¦ÿ›[ŸöÖ[Ÿö=þÿadecomm/_gttbldb.p©MÈAÿc[ŸöÖ[Ÿö=ÿadecomm/_gttblid.pñ6Î¤ÿ	ê[ŸöÖ[Ÿö=ÿadecomm/_holddb.pUØŽÿý[ŸöÖ[Ÿö>ÿadecomm/_isfld.io|Ü‹ÿ¢[ŸöÖ[Ÿö>ÿadecomm/_istbl.iî³á-ÿ[ŸöÖ[Ÿö>ÿadecomm/_j-test.ptªå2ÿ*[ŸöÖ[Ÿö>ÿadecomm/_kvlist.p}™õ\ÿì[ŸöÖ[Ÿö>þÿadecomm/_kwhelp.pÏK	Hÿ½[ŸöÖ[Ÿö>ÿadecomm/_locard.pÖ	ÿ•[ŸöÖ[Ÿö>ÿadecomm/_locdwb.pýò	!šÿY[ŸöÖ[Ÿö>ÿadecomm/_lstnav.p	'óÿ–[ŸöÖ[Ÿö>ÿadecomm/_mfldlst.p3	3‰ÿ#×[ŸöÖ[Ÿö>ÿadecomm/_mfldmap.p—é	W`ÿsŠ[ŸöÖ[Ÿö>ÿadecomm/_mfldsel.p‡c	Êêÿ[[ŸöÖ[Ÿö>þÿadecomm/_mnkvals.p‰™
%õÿ#Ä[ŸöÖ[Ÿö>ÿadecomm/_modpath.wâ¶
I¹ÿJ[ŸöÖ[Ÿö>ÿadecomm/_mtemp.i²Õ
“¼ÿÇ[ŸöÖ[Ÿö>ÿadecomm/_opnfile.wã£
•ƒÿ2[ŸöÖ[Ÿö>ÿadecomm/_oscpath.p;²
¤µÿ	[ŸöÖ[Ÿö>ÿadecomm/_oserr.p“ã
­Âÿ[ŸöÖ[Ÿö>ÿadecomm/_osfext.p8ö
³ÅÿÏ[ŸöÖ[Ÿö>þÿadecomm/_osfmush.pð6
¼”ÿ:[ŸöÖ[Ÿö>ÿadecomm/_osfrw.p“å
ÃÎÿ[ŸöÖ[Ÿö>ÿadecomm/_osprefx.pj÷
ÐÑÿb[ŸöÖ[Ÿö>ÿadecomm/_osprint.péÉ
Ø3ÿˆ[ŸöÖ[Ÿö>ÿadecomm/_osprodl.p
õ»ÿ.[ŸöÖ[Ÿö>ÿadecomm/_ossfnam.pŸ3
úéÿY[ŸöÖ[Ÿö>ÿadecomm/_palette.wmeBÿ“[ŸöÖ[Ÿö>þÿadecomm/_prfxfld.pÔÔ¢\ÿ[ŸöÖ[Ÿö>ÿadecomm/_proserr.pé@¯oÿ
|[ŸöÖ[Ÿö>ÿadecomm/_pwaddfile.ph8¹ëÿ
<[ŸöÖ[Ÿö>ÿadecomm/_pwattr.iõoÄ'ÿ#Ñ[ŸöÖ[Ÿö>ÿadecomm/_uniqfil.p²0çøÿ	ü[ŸöÖ[Ÿö>ÿadecomm/_pwchfnt.p’ñôÿ[ŸöÖ[Ÿö>ÿadecomm/_pwclose.pª5þ„ÿ
t[ŸöÖ[Ÿö>þÿadecomm/_pwclosf.pj7øÿ
³[ŸöÖ[Ÿö>ÿadecomm/_pwcmpfl.pñX«ÿ3[ŸöÖ[Ÿö>ÿadecomm/_pwcomp.pŸ~2Þÿ
M[ŸöÖ[Ÿö>ÿadecomm/_pwcreat.pÌü=+ÿ‚[ŸöÖ[Ÿö>ÿadecomm/_pwdelpw.p#W­ÿ[ŸöÖ[Ÿö>ÿadecomm/_pwedit.pï^½ÿð[ŸöÖ[Ÿö>ÿadecomm/_pwemdrp.p«Am­ÿ[ŸöÖ[Ÿö>þÿadecomm/_pwexit.p_¸{­ÿÔ[ŸöÖ[Ÿö>ÿadecomm/_pwfchg.p³c”ÿ	#[ŸöÖ[Ÿö>ÿadecomm/_pwfile.p=
¤ÿ	Û[ŸöÖ[Ÿö>ÿadecomm/_pwfmod.p_§ÿx[ŸöÖ[Ÿö>ÿadecomm/_pwgeteh.p·—­÷ÿ¾[ŸöÖ[Ÿö>ÿadecomm/_pwgetfh.pŒÃ´µÿ¼[ŸöÖ[Ÿö>ÿadecomm/_pwgetun.p†Eºqÿ
a[ŸöÖ[Ÿö>þÿadecomm/_pwgetwh.pëÙÄÒÿ¾[ŸöÖ[Ÿö>ÿadecomm/_pwglob.iý]Íÿ[ŸöÖ[Ÿö>ÿadecomm/_pwhelp.pæAÑ«ÿW[ŸöÖ[Ÿö>ÿadecomm/_pwin.pªÙÞÿ	e[ŸöÖ[Ÿö>ÿadecomm/_pwmain.pò²çgÿ8ø[ŸöÖ[Ÿö>ÿadecomm/_pwmbar.p¿þ _ÿ5²[ŸöÖ[Ÿö>ÿadecomm/_pwnew.p'rVÿZ[ŸöÖ[Ÿö>þÿadecomm/_pwnewpw.p°9dkÿ+[ŸöÖ[Ÿö>ÿadecomm/_pwopen.p¦èl–ÿ'[ŸöÖ[Ÿö>ÿadecomm/_pwprint.poø„½ÿÀ[ŸöÖ[Ÿö>ÿadecomm/_pwrdfl.pB5’}ÿy[ŸöÖ[Ÿö>ÿadecomm/_pwresz.pï§öÿ
?[ŸöÖ[Ÿö>ÿadecomm/_pwrun.pÿ°²5ÿ|0[ŸöÖ[Ÿö>ÿadecomm/_pwsavas.p—|.eÿ([ŸöÖ[Ÿö>þÿadecomm/_pwsave.p4fJÿP[ŸöÖ[Ÿö>ÿadecomm/_pwsavef.p$ÝRÝÿC[ŸöÖ[Ÿö>ÿadecomm/_pwsrch.px>•ßÿ¦[ŸöÖ[Ÿö>ÿadecomm/_pwwinst.pS±…ÿ
¬[ŸöÖ[Ÿö>ÿadecomm/_qaredat.pôL¼1ÿ~[ŸöÖ[Ÿö>ÿadecomm/_qarerpt.pûìÓ¯ÿˆ[ŸöÖ[Ÿö>ÿadecomm/_qflddat.pÏšÙ7ÿN[ŸöÖ[Ÿö>þÿadecomm/_qfldrpt.p•¼ê…ÿô[ŸöÖ[Ÿö>ÿadecomm/_qidxdat.pÒzøyÿ¾[ŸöÖ[Ÿö?ÿadecomm/_qidxrpt.pX7ÿ[ŸöÖ[Ÿö?ÿadecomm/_qinit.pD :ÿ_f[ŸöÖ[Ÿö?ÿadecomm/_qisjoin.p3H ÿ®[ŸöÖ[Ÿö?ÿadecomm/_qseqdat.päñ…NÿÉ[ŸöÖ[Ÿö?ÿadecomm/_qseqrpt.pšÖ–ÿ	ý[ŸöÖ[Ÿö?þÿadecomm/_qtbldat.pÔ¨ ÿ[ŸöÖ[Ÿö?ÿadecomm/_qtblrpt.pýê²&ÿ„[ŸöÖ[Ÿö?ÿadecomm/_qusrdat.pÀ9½ªÿÑ[ŸöÖ[Ÿö?ÿadecomm/_qusrrpt.p[»Ä{ÿ	[ŸöÖ[Ÿö?ÿadecomm/_qviwdat.px4Í•ÿD[ŸöÖ[Ÿö?ÿadecomm/_qviwrpt.p¯éÙÿ
J[ŸöÖ[Ÿö?ÿadecomm/_readpossever.pòçô#ÿ?[ŸöÖ[Ÿö?þÿadecomm/_reg2ini.p	bÿ#æ[ŸöÖ[Ÿö?ÿadecomm/_relfile.p«-Hÿ ð[ŸöÖ[Ÿö?ÿadecomm/_relname.pDšN8ÿr[ŸöÖ[Ÿö?ÿadecomm/_report.pF6^ªÿN}[ŸöÖ[Ÿö?ÿadecomm/_rsearch.p˜­'ÿ	t[ŸöÖ[Ÿö?ÿadecomm/_ruler.pF÷¶›ÿ!x[ŸöÖ[Ÿö?ÿadecomm/_runard.p”“Øÿp[ŸöÖ[Ÿö?þÿadecomm/_runcode.p¸QÞƒÿ€n[ŸöÖ[Ÿö?ÿadecomm/_rundwb.pa¡^ñÿz[ŸöÖ[Ÿö?ÿadecomm/_s-alert.pÃúekÿÅ[ŸöÖ[Ÿö?ÿadecomm/_s-schem.p…ll0ÿ!([ŸöÖ[Ÿö?ÿadecomm/_scroll.pýÒXÿ[ŸöÖ[Ÿö?ÿadecomm/_selindx.p!j”fÿÓ[ŸöÖ[Ÿö?ÿadecomm/_setalia.pLÀ¤9ÿM[ŸöÖ[Ÿö?þÿadecomm/_setcurs.pÚu©†ÿ	1[ŸöÖ[Ÿö?ÿadecomm/_so-cue.w-¥²·ÿL[ŸöÖ[Ÿö?ÿadecomm/_so-cued.p2þÊÿ	[ŸöÖ[Ÿö?ÿadecomm/_so-cuew.p†Ú
ÓÿN[ŸöÖ[Ÿö?ÿadecomm/_solink.w†l!ÿù[ŸöÖ[Ÿö?ÿadecomm/_somatch.w X,ÿR[ŸöÖ[Ÿö?ÿadecomm/_sortstr.p«Û~5ÿF[ŸöÖ[Ÿö?þÿadecomm/_srchhlp.pûÜƒ{ÿ
[ŸöÖ[Ÿö?ÿadecomm/_statdsp.pF×Š…ÿ	[ŸöÖ[Ÿö?ÿadecomm/_status.pÞŠ“ˆÿ†[ŸöÖ[Ÿö?ÿadecomm/_tblbrws.p¾ß¯ÿl[ŸöÖ[Ÿö?ÿadecomm/_tbllist.pNË·zÿY[ŸöÖ[Ÿö?ÿadecomm/_tblsel.pBÏÓÿ0[ŸöÖ[Ÿö?ÿadecomm/_tfbrws.pŸIcÿÐ[ŸöÖ[Ÿö?þÿadecomm/_tmpfile.p7?	3ÿ”[ŸöÖ[Ÿö?ÿadecomm/_toollic.páDÇÿw[ŸöÖ[Ÿö?ÿadecomm/_topmost.pHÔ+>ÿ¦[ŸöÖ[Ÿö?ÿadecomm/_treldat.pÈf8äÿÃ[ŸöÖ[Ÿö?ÿadecomm/_trelrpt.pÍR§ÿh[ŸöÖ[Ÿö?ÿadecomm/_trigdat.pØu_ÿ¿[ŸöÖ[Ÿö?ÿadecomm/_trigrpt.pÞLqÎÿî[ŸöÖ[Ÿö?þÿadecomm/_ttblbrs.p¡‚¼ÿ,[ŸöÖ[Ÿö?ÿadecomm/_ttfbrws.pFÅŠèÿ[ŸöÖ[Ÿö?ÿadecomm/_ttysr.p	“xÿ-?[ŸöÖ[Ÿö?ÿadecomm/_valname.pÁqÀ·ÿ+[ŸöÖ[Ÿö?ÿadecomm/_valpnam.pÑæËâÿ&[ŸöÖ[Ÿö?ÿadecomm/_viewas.p6$Øÿ@“[ŸöÖ[Ÿö?ÿadecomm/_wfrun.pì*›ÿK[ŸöÖ[Ÿö?þÿadecomm/_wincolr.pmî æÿÄ[ŸöÖ[Ÿö?ÿadecomm/_winmenu.wBÈ,ªÿ¤[ŸöÖ[Ÿö?ÿadecomm/_winmore.w4ºNÿ 6[ŸöÖ[Ÿö@ÿadecomm/_winsys.p÷PÚ„ÿÅ[ŸöÖ[Ÿö@ÿadecomm/_y-build.pŠëñIÿÜ[ŸöÖ[Ÿö@ÿadecomm/_y-date.p©ÚÍWÿˆ[ŸöÖ[Ÿö@ÿadecomm/_y-logic.p–ÿÑßÿY[ŸöÖ[Ÿö@þÿadecomm/_y-num.pòá8ÿp[ŸöÖ[Ÿö@ÿadecomm/_y-qbw.p(úä¨ÿB[ŸöÖ[Ÿö@ÿadecomm/_y-schem.pFÜõêÿò[ŸöÖ[Ÿö@ÿadecomm/_y-strng.pƒAÜÿ‚[ŸöÖ[Ÿö@ÿadecomm/adefext.i—­
^ÿó[ŸöÖ[Ÿö@ÿadecomm/adeintl.i;yQÿ·[ŸöÖ[Ÿö@ÿadecomm/adestds.iGÿ4Ë[ŸöÖ[Ÿö@þÿadecomm/adewrap.iÏeHÓÿ
Ï[ŸöÖ[Ÿö@ÿadecomm/appserv.i37S¢ÿR[ŸöÖ[Ÿö@ÿadecomm/appsrvtt.iÃÔWôÿ…[ŸöÖ[Ÿö@ÿadecomm/as-utils.wÉ`yÿX[ŸöÖ[Ÿö@ÿadecomm/browqury.iíµ¹ÿ>[ŸöÖ[Ÿö@ÿadecomm/cbcdrop.izT÷ÿ[[ŸöÖ[Ÿö@ÿadecomm/cbcdropx.i‡iÿŸ[ŸöÖ[Ÿö@þÿadecomm/cbcomm.i´†ÿ ¿[ŸöÖ[Ÿö@ÿadecomm/cbdown.iR8Çÿt[ŸöÖ[Ÿö@ÿadecomm/cbdrop.iüT;ÿm[ŸöÖ[Ÿö@ÿadecomm/cbdropx.iÂf_¨ÿ|[ŸöÖ[Ÿö@ÿadecomm/cbtdrop.iEøk$ÿ[ŸöÖ[Ÿö@ÿadecomm/cbtdropx.iÃ¸|>ÿã[ŸöÖ[Ÿö@ÿadecomm/cbvar.ihkŠ!ÿ[ŸöÖ[Ÿö@þÿadecomm/commeng.i¾/Ž&ÿ"ƒ[ŸöÖ[Ÿö@ÿadecomm/convcp.p‹°©ÿ[ŸöÖ[Ÿö@ÿadecomm/dedit.ii¿¼¶ÿË[ŸöÖ[Ÿö@ÿadecomm/deltable.i€ýÍÿj[ŸöÖ[Ÿö@ÿadecomm/dfldlist.iV½Ôëÿ}[ŸöÖ[Ÿö@ÿadecomm/dirsrch.i^Ûhÿß[ŸöÖ[Ÿö@ÿadecomm/ds_type.i9çGÿÓ[ŸöÖ[Ÿö@þÿadecomm/dsearch.iaóÿ¯[ŸöÖ[Ÿö@ÿadecomm/ebrowse.defÞIÉÿ [ŸöÖ[Ÿö@ÿadecomm/ebrowse.iDCéÿ[ŸöÖ[Ÿö@ÿadecomm/fileinfo.i`Ÿ#†ÿï[ŸöÖ[Ÿö@ÿadecomm/fldlist.iËñ0uÿþ[ŸöÖ[Ÿö@ÿadecomm/get-user.p+~=sÿ
‹[ŸöÖ[Ÿö@ÿadecomm/getdbs.iŽGþÿ¢[ŸöÖ[Ÿö@þÿadecomm/icondir.i½PO ÿ¿[ŸöÖ[Ÿö@ÿadecomm/lstdef1.iõ*V_ÿ^[ŸöÖ[Ÿö@ÿadecomm/lstdn.iyWZ½ÿ1[ŸöÖ[Ÿö@ÿadecomm/lstup.iZº`îÿƒ[ŸöÖ[Ÿö@ÿadecomm/okbar.iE.hqÿD[ŸöÖ[Ÿö@ÿadecomm/okform.iÏëvµÿÇ[ŸöÖ[Ÿö@ÿadecomm/okrun.i7ê|ÿ[ŸöÖ[Ÿö@þÿadecomm/osnul.i¸«Žûÿ”[ŸöÖ[Ÿö@ÿadecomm/pedit.i°@’ÿ¢[ŸöÖ[Ÿö@ÿadecomm/prtrpt.iG˜4ÿ	—[ŸöÖ[Ÿö@ÿadecomm/pruntool.i>2>4ÿœ[ŸöÖ[Ÿö@ÿadecomm/psearch.i>QÐÿl[ŸöÖ[Ÿö@ÿadecomm/qurywidg.iy(¾mÿT[ŸöÖ[Ÿö@ÿadecomm/rtnval.itaÆÁÿü[ŸöÖ[Ÿö@þÿadecomm/tblbrws.iŒ¼Ï½ÿA¡[ŸöÖ[Ÿö@ÿadecomm/toolmenu.i„$^ÿ[ŸöÖ[Ÿö@ÿadecomm/toolrun.i-A-mÿDõ[ŸöÖ[Ÿö@ÿadecomm/toolsupp.iIyrbÿ[[ŸöÖ[Ÿö@ÿadecomm/trigdlg.iü—…½ÿW[ŸöÖ[Ÿö@ÿadecomm/trigtrig.i²L™ÿX[ŸöÖ[Ÿö@ÿadecomm/tt-brws.i" lÿ9[ŸöÖ[Ÿö@þÿadecomm/ttblbrws.i¢š¤¥ÿ.â[ŸöÖ[Ÿö@ÿadecomm/uibpref.iììÓ‡ÿ¶[ŸöÖ[Ÿö@ÿadecomm/utilhlp.igÙ=ÿY[ŸöÖ[Ÿö@ÿadecomm/xmlschema.pìÞ–ÿÚ±[ŸöÖ[Ÿö@ÿadecomm/xmlwidg.i`¹Gÿ=[ŸöÖ[Ÿö@ÿadecomm/y-const.ipÓË„ÿT[ŸöÖ[Ÿö@ÿadecomm/_y-datetime-tz.pd ÿP[ŸöÖ[ŸöAþÿadecomm/_y-datetime.p\Ç#ðÿ[ŸöÖ[ŸöAÿadecomm/_auddat.p$(ÿã8[ŸöÖ[ŸöAÿadecomm/_auddfilt.pOCÿWk[ŸöÖ[ŸöAÿadecomm/_auddtl.pEŒb®ÿVo[ŸöÖ[ŸöAÿadecomm/_audrpt.p4Ç¹ÿ;[ŸöÖ[ŸöAÿadecomm/_cust-flt.pUÈô;ÿI[ŸöÖ[ŸöAÿadecomm/_dimextent.p.ñ =Lÿþ[ŸöÖ[ŸöAþÿadecomm/_getfiledialog.wG QJÿu[ŸöÖ[ŸöAÿadecomm/_praudrpt.p‹ k¿ÿˆ¯[ŸöÖ[ŸöAÿadecomm/aud-evts.išj ônÿü[ŸöÖ[ŸöAÿadecomm/aud-tts.iâî újÿ<¤[ŸöÖ[ŸöAÿadecomm/dcmpcls.i<S!7ÿ	D[ŸöÖ[ŸöAÿadecomm/oeideservice.iÒ­!@Rÿ"[ŸöÖ[ŸöAÿadecomm/oeideservice.pÍÈ!bÓÿ3 [ŸöÖ[ŸöAþÿadecomm/pcmpcls.i.$"•óÿM+[ŸöÖ[ŸöAÿadecomm/rptvar.iúz"ãÿá[ŸöÖ[ŸöAÿadecomm/_viewasd.wò"üÿÿœ’[ŸöÖ[ŸöAÿadecomm/_vtitems.poÿ#™‘ÿ[ŸöÖ[ŸöAÿadecomm/_assign-wid.wÉš#¥”ÿiï[ŸöÖ[ŸöAÿadecomm/_dswidfunc.pô%ƒÿ’F[ŸöÖ[ŸöAÿadecomm/_getwidobjs.wÀÑ%¡Éÿ[E[ŸöÖ[ŸöAþÿadecomm/_widgaps.p£%ýÿ
ð[ŸöÖ[ŸöAÿadecomm/dswid.i=ƒ&þÿ³[ŸöÖ[ŸöAÿadecomm/_altbufdat.p¼Ê&!±ÿ%—[ŸöÖ[ŸöAÿadecomm/_altbufrpt.poý&GHÿ[ŸöÖ[ŸöAÿadecomm/_encpdat.plÕ&LXÿ.†[ŸöÖ[ŸöAÿadecomm/_encprpt.p¸»&zÞÿ.D[ŸöÖ[ŸöAÿadecomm/_getshortpathname.ph&©"ÿø[ŸöÖ[ŸöAþÿadecomm/ide_chscolr.pq|&°ÿX[ŸöÖ[ŸöAÿadecomm/_s-alert2.pl,&²rÿ1‰[ŸöÖ[ŸöAÿadecomm/_resolvepath.p€ˆ&ãûÿ™[ŸöÖ[ŸöAÿadecomm/_dbconnide.pl|&ó”ÿá[ŸöÖ[ŸöAÿadecomm/_pweditor.i·&üuÿC[ŸöÖ[ŸöBÿadecomm/editsrc.iFp'¸ÿN[ŸöÖ[ŸöBÿadecomm/peditor.ið$'	ÿ/ì[ŸöÖ[ŸöBþÿÈ:d'þ