×undefinedBLë&ANALYZE-SUSPEND _VERSION-NUMBER UIB_v9r12 GUI
&ANALYZE-RESUME
&Scoped-define WINDOW-NAME CURRENT-WINDOW
&Scoped-define FRAME-NAME ASInfo
{adecomm/appserv.i}
DEFINE VARIABLE h_aaaa                     AS HANDLE          NO-UNDO.
DEFINE VARIABLE h_asbroker1                AS HANDLE          NO-UNDO.
DEFINE VARIABLE h_sports2000partition      AS HANDLE          NO-UNDO.
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _DEFINITIONS ASInfo 
/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/
/*------------------------------------------------------------------------

  File: _ASInfo.w

  Description: AppServer Information PRO*Tool

  Input Parameters:
      <none>

  Output Parameters:
      <none>

  Author: Gerry Seidl

  Created: 11/19/98
  
------------------------------------------------------------------------*/
/*          This .W file was created with the Progress AppBulder.       */
/*----------------------------------------------------------------------*/
{adecomm/appsrvtt.i "NEW GLOBAL"} /* Partition info temp table defn */
{adecomm/appserv.i}
{protools/ptlshlp.i} /* Pro*Tools help contexts */
{adecomm/_adetool.i}

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

/* Parameters Definitions ---                                           */

/* Local Variable Definitions ---                                       */

DEFINE VARIABLE h AS HANDLE NO-UNDO. /* server handle */

DEFINE TEMP-TABLE OtherAS
    FIELD ASName AS CHARACTER
    FIELD hAS    AS HANDLE
    INDEX iAS IS PRIMARY AsName.

/* _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 ASInfo

/* Standard List Definitions                                            */
&Scoped-Define ENABLED-OBJECTS AppService Btn_GetInfo connid connctxt ~
ASppath conndbs connpps Btn_Close Btn_Help RECT-1 RECT-2 RECT-3 RECT-4 
&Scoped-Define DISPLAYED-OBJECTS AppService connid opmode connreq connbnd ~
connctxt ASppath conndbs connpps 

/* 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 Btn_Close AUTO-GO 
     LABEL "&Close" 
     SIZE 15 BY 1.14
     BGCOLOR 8 .

DEFINE BUTTON Btn_GetInfo 
     LABEL "&Get Info" 
     SIZE 15 BY 1
     BGCOLOR 8 .

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

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

DEFINE VARIABLE connctxt AS CHARACTER 
     VIEW-AS EDITOR NO-WORD-WRAP SCROLLBAR-HORIZONTAL SCROLLBAR-VERTICAL
     SIZE 75 BY 3 NO-UNDO.

DEFINE VARIABLE connbnd AS LOGICAL FORMAT "yes/no":U INITIAL NO 
     LABEL "Connection Bound" 
     VIEW-AS FILL-IN 
     SIZE 7 BY 1 NO-UNDO.

DEFINE VARIABLE connid AS CHARACTER FORMAT "X(256)":U 
     LABEL "Connection Id" 
     VIEW-AS FILL-IN 
     SIZE 51 BY 1 NO-UNDO.

DEFINE VARIABLE connreq AS LOGICAL FORMAT "yes/no":U INITIAL NO 
     LABEL "Connection Bound Req." 
     VIEW-AS FILL-IN 
     SIZE 7 BY 1 NO-UNDO.

DEFINE VARIABLE opmode AS CHARACTER FORMAT "X(256)":U 
     LABEL "Operating Mode" 
     VIEW-AS FILL-IN 
     SIZE 51 BY 1 NO-UNDO.

DEFINE RECTANGLE RECT-1
     EDGE-PIXELS 2 GRAPHIC-EDGE  NO-FILL 
     SIZE 79 BY 8.1.

DEFINE RECTANGLE RECT-2
     EDGE-PIXELS 2 GRAPHIC-EDGE  NO-FILL 
     SIZE 79 BY 5.71.

DEFINE RECTANGLE RECT-3
     EDGE-PIXELS 2 GRAPHIC-EDGE  NO-FILL 
     SIZE 39 BY 5.71.

DEFINE RECTANGLE RECT-4
     EDGE-PIXELS 2 GRAPHIC-EDGE  NO-FILL 
     SIZE 39 BY 5.71.

DEFINE VARIABLE ASppath AS CHARACTER 
     VIEW-AS SELECTION-LIST SINGLE NO-DRAG 
     SCROLLBAR-HORIZONTAL SCROLLBAR-VERTICAL 
     SIZE 75 BY 5 NO-UNDO.

DEFINE VARIABLE conndbs AS CHARACTER 
     VIEW-AS SELECTION-LIST SINGLE NO-DRAG 
     SCROLLBAR-HORIZONTAL SCROLLBAR-VERTICAL 
     SIZE 35 BY 5 NO-UNDO.

DEFINE VARIABLE connpps AS CHARACTER 
     VIEW-AS SELECTION-LIST SINGLE 
     SCROLLBAR-HORIZONTAL SCROLLBAR-VERTICAL 
     SIZE 35 BY 5 NO-UNDO.


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

DEFINE FRAME ASInfo
     AppService AT ROW 1.48 COL 10 COLON-ALIGNED
     Btn_GetInfo AT ROW 1.48 COL 67
     connid AT ROW 3.62 COL 27 COLON-ALIGNED
     opmode AT ROW 4.81 COL 27 COLON-ALIGNED
     connreq AT ROW 6 COL 27 COLON-ALIGNED
     connbnd AT ROW 6 COL 71 COLON-ALIGNED
     connctxt AT ROW 7.91 COL 5 NO-LABEL
     ASppath AT ROW 12.19 COL 5 NO-LABEL
     conndbs AT ROW 18.38 COL 5 NO-LABEL
     connpps AT ROW 18.38 COL 45 NO-LABEL
     Btn_Close AT ROW 1.48 COL 83
     Btn_Help AT ROW 2.91 COL 83
     RECT-1 AT ROW 3.14 COL 3
     RECT-2 AT ROW 11.71 COL 3
     RECT-3 AT ROW 17.91 COL 43
     RECT-4 AT ROW 17.91 COL 3
     "Connection Context" VIEW-AS TEXT
          SIZE 22 BY .62 AT ROW 7.19 COL 5
     "Server-side session attributes" VIEW-AS TEXT
          SIZE 28 BY .62 AT ROW 2.91 COL 5
     "Running persistent procedures" VIEW-AS TEXT
          SIZE 29 BY .62 AT ROW 17.67 COL 45
     "Propath" VIEW-AS TEXT
          SIZE 9 BY .62 AT ROW 11.48 COL 5
     "Connected Databases" VIEW-AS TEXT
          SIZE 22 BY .62 AT ROW 17.67 COL 5
     SPACE(71.79) SKIP(5.41)
    WITH VIEW-AS DIALOG-BOX KEEP-TAB-ORDER 
         SIDE-LABELS NO-UNDERLINE THREE-D  SCROLLABLE 
         TITLE "AppServer Session Information"
         DEFAULT-BUTTON Btn_Close.


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

&ANALYZE-SUSPEND _PROCEDURE-SETTINGS
/* Settings for THIS-PROCEDURE
   Type: DIALOG-BOX
   Allow: Basic,Browse,DB-Fields,Query
   Other Settings: COMPILE APPSERVER
 */
&ANALYZE-RESUME _END-PROCEDURE-SETTINGS



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

&ANALYZE-SUSPEND _RUN-TIME-ATTRIBUTES
/* SETTINGS FOR DIALOG-BOX ASInfo
   Custom                                                               */
ASSIGN 
       FRAME ASInfo:SCROLLABLE       = FALSE
       FRAME ASInfo:HIDDEN           = TRUE.

/* SETTINGS FOR FILL-IN connbnd IN FRAME ASInfo
   NO-ENABLE                                                            */
ASSIGN 
       connctxt:READ-ONLY IN FRAME ASInfo        = TRUE.

ASSIGN 
       connid:READ-ONLY IN FRAME ASInfo        = TRUE.

/* SETTINGS FOR FILL-IN connreq IN FRAME ASInfo
   NO-ENABLE                                                            */
/* SETTINGS FOR FILL-IN opmode IN FRAME ASInfo
   NO-ENABLE                                                            */
/* _RUN-TIME-ATTRIBUTES-END */
&ANALYZE-RESUME

 



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

&Scoped-define SELF-NAME ASInfo
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL ASInfo ASInfo
ON WINDOW-CLOSE OF FRAME ASInfo /* AppServer Session Information */
DO:
  APPLY "END-ERROR":U TO SELF.
END.

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


&Scoped-define SELF-NAME AppService
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL AppService ASInfo
ON VALUE-CHANGED OF AppService IN FRAME ASInfo /* Partition */
DO:
  IF AppService NE AppService:SCREEN-VALUE THEN DO:
    /* Clear out the contents of the dialog */
    CLEAR FRAME {&FRAME-NAME} NO-PAUSE.
    ASSIGN 
      asppath:LIST-ITEMS = ? 
      conndbs:LIST-ITEMS = ?
      connpps:LIST-ITEMS = ?
    .
  END.
END.

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


&Scoped-define SELF-NAME Btn_GetInfo
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL Btn_GetInfo ASInfo
ON CHOOSE OF Btn_GetInfo IN FRAME ASInfo /* Get Info */
DO:
  DEFINE VARIABLE ppath   AS CHARACTER NO-UNDO. /* receives Propath */
  DEFINE VARIABLE dbs     AS CHARACTER NO-UNDO. /* receives List of Databases */
  DEFINE VARIABLE pprocs  AS CHARACTER NO-UNDO. /* receives List of Running Persistent Procedures */
  DEFINE VARIABLE addme   AS LOGICAL   NO-UNDO INITIAL TRUE. /* answer to question below */
  DEFINE VARIABLE hAsynch AS HANDLE    NO-UNDO. /* handle to asynch run */
  DEFINE VARIABLE scid    AS CHARACTER NO-UNDO. /* receives SESSION:SERVER-CONNECTION-ID */
  DEFINE VARIABLE som     AS CHARACTER NO-UNDO. /* receives SESSION:SERVER-OPERATING-MODE */
  DEFINE VARIABLE scbr    AS LOGICAL   NO-UNDO. /* receives SESSION:SERVER-CONNECTION-BOUND-REQUEST */
  DEFINE VARIABLE scb     AS LOGICAL   NO-UNDO. /* receives SESSION:SERVER-CONNECTION-BOUND */
  DEFINE VARIABLE scc     AS CHARACTER NO-UNDO. /* receives SESSION:SERVER-CONNECTION-CONTEXT */
  DEFINE VARIABLE useconn AS LOGICAL   NO-UNDO. /* indicates whether or not we used an existing connection from AppServ-TT */ 
  
  ASSIGN AppService.
  FIND FIRST AppSrv-TT WHERE Partition = AppService NO-LOCK NO-ERROR.
  IF AVAILABLE(AppSrv-TT) THEN 
  DO:
    IF NOT AppSrv-TT.Configuration THEN DO: /* Local */
      MESSAGE "The AppService" AppSrv-TT.App-Service "is defined as being local." SKIP
              "This session's information will be displayed." 
              VIEW-AS ALERT-BOX INFORMATION TITLE "AppServer Session Information".
      ASSIGN h = SESSION:HANDLE. 
    END.
    ELSE DO: /* Remote */          
      ASSIGN useconn = FALSE. 
      /* Connect to the AppServer */
      RUN appServerConnect(
        INPUT AppSrv-TT.Partition, 
        INPUT AppSrv-TT.Security, 
        INPUT AppSrv-TT.Info,
        OUTPUT h) NO-ERROR.
      /* if both of these conditions are true then cancel must have been pressed */
      IF h = ? AND RETURN-VALUE = 'ERROR':U 
          THEN RETURN NO-APPLY.
      IF h = SESSION:HANDLE THEN DO:
        MESSAGE "Could not access connection to AppService" AppSrv-TT.App-Service 
                VIEW-AS ALERT-BOX INFORMATION TITLE "AppServer Session Information".
        RETURN NO-APPLY. 
      END.
    END.      
  END.
  ELSE DO:  
    ASSIGN useconn = FALSE.
    /* Look for connections in alternative list */
    FIND FIRST OtherAS WHERE AppService = OtherAS.ASName NO-ERROR.
    IF AVAILABLE OtherAS THEN 
      ASSIGN h = OtherAS.hAS.
    ELSE DO:
      MESSAGE "A server by the name of" AppService:SCREEN-VALUE "was not found."
        VIEW-AS ALERT-BOX ERROR TITLE "AppServer Session Information".
      RETURN NO-APPLY.
    END.
  END.
  /* Are there any asynchronous requests oustanding on this AppServer? */
  IF h:ASYNC-REQUEST-COUNT > 0 THEN DO:
      MESSAGE "There are currently " TRIM(STRING(h:ASYNC-REQUEST-COUNT,">>>9")) 
          " asynchronous requests queued for this AppServer." SKIP 
          "Do you want to continue?" 
          VIEW-AS ALERT-BOX QUESTION BUTTONS OK-CANCEL UPDATE addme.
  END.
  /* 
   * Gather up information from companion program running asynchronously
   * on SERVER h 
   */
  IF addme THEN DO:
      RUN adecomm/_asread.p ON SERVER h 
        ASYNCHRONOUS SET hAsynch
        EVENT-PROCEDURE "ASInfo":U
       (OUTPUT scid,     /* SESSION:SERVER-CONNECTION-ID */
        OUTPUT som,      /* SESSION:SERVER-OPERATING-MODE */
        OUTPUT scbr,     /* SESSION:SERVER-CONNECTION-BOUND-REQUEST */
        OUTPUT scb,      /* SESSION:SERVER-CONNECTION-BOUND */
        OUTPUT scc,      /* SESSION:SERVER-CONNECTION-CONTEXT */
        OUTPUT ppath,    /* PROPATH */
        OUTPUT dbs,      /* List of Databases */
        OUTPUT pprocs).  /* List of Running Persistent Procedures */
  
      WAIT-FOR PROCEDURE-COMPLETE OF hAsynch.
  END.
  
  IF AVAILABLE(AppSrv-TT) AND NOT useconn THEN
    /* Disconnect and destroy handle to the AppServer */
    RUN appServerDisconnect(
      INPUT AppSrv-TT.Partition).
END.


PROCEDURE ASInfo:
    /* 
     * Event procedure for the asnych call we made to _asread 
     * If receives, assigns and displays the data received.   
     */
    DEFINE INPUT PARAMETER scid    AS CHARACTER NO-UNDO. /* receives SESSION:SERVER-CONNECTION-ID */
    DEFINE INPUT PARAMETER som     AS CHARACTER NO-UNDO. /* receives SESSION:SERVER-OPERATING-MODE */
    DEFINE INPUT PARAMETER scbr    AS LOGICAL   NO-UNDO. /* receives SESSION:SERVER-CONNECTION-BOUND-REQUEST */
    DEFINE INPUT PARAMETER scb     AS LOGICAL   NO-UNDO. /* receives SESSION:SERVER-CONNECTION-BOUND */
    DEFINE INPUT PARAMETER scc     AS CHARACTER NO-UNDO. /* receives SESSION:SERVER-CONNECTION-CONTEXT */
    DEFINE INPUT PARAMETER ppath   AS CHARACTER NO-UNDO. /* PROPATH */
    DEFINE INPUT PARAMETER dbs     AS CHARACTER NO-UNDO. /* List of Databases */
    DEFINE INPUT PARAMETER pprocs  AS CHARACTER NO-UNDO. /* Load selection lists */
    
    DO WITH FRAME {&FRAME-NAME}:
       ASSIGN 
          connid   = scid
          opmode   = som 
          connreq  = scbr 
          connbnd  = scb 
          connctxt = scc
          asppath:LIST-ITEMS = ppath 
          conndbs:LIST-ITEMS = dbs
          connpps:LIST-ITEMS = pprocs
        .
        DISPLAY connid opmode connreq connbnd connctxt ASppath conndbs connpps WITH
          FRAME {&FRAME-NAME}.  
    END.
END.

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


&Scoped-define SELF-NAME Btn_Help
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL Btn_Help ASInfo
ON CHOOSE OF Btn_Help IN FRAME ASInfo /* Help */
OR HELP OF FRAME {&FRAME-NAME}
DO: /* Call Help Function (or a simple message). */
  RUN adecomm/_adehelp.p ("ptls":U,"CONTEXT":U, {&AppServer_Session_Information}, ? ).
END.

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


&UNDEFINE SELF-NAME

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


/* ***************************  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 PopulateAppService.
  IF RETURN-VALUE = "NONE":U THEN DO:
    MESSAGE "There are no AppServers currently defined." SKIP
            "You can define them with the Service Parameter Maintenance tool."
            VIEW-AS ALERT-BOX ERROR
            TITLE "AppServer Session Information".
    RETURN.
  END.
  RUN enable_UI.
  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 ASInfo  _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 ASInfo.
END PROCEDURE.

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

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE enable_UI ASInfo  _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 AppService connid opmode connreq connbnd connctxt ASppath conndbs 
          connpps 
      WITH FRAME ASInfo.
  ENABLE AppService Btn_GetInfo connid connctxt ASppath conndbs connpps 
         Btn_Close Btn_Help RECT-1 RECT-2 RECT-3 RECT-4 
      WITH FRAME ASInfo.
  VIEW FRAME ASInfo.
  {&OPEN-BROWSERS-IN-QUERY-ASInfo}
END PROCEDURE.

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

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE PopulateAppService ASInfo 
PROCEDURE PopulateAppService :
/*------------------------------------------------------------------------------
  Purpose:     Populates the AppService combo-box with defined AppServers.
  Parameters:  <none>
  Notes:       Returns "NONE" if no AppServers are defined.
------------------------------------------------------------------------------*/
DEFINE VARIABLE hServ     AS HANDLE NO-UNDO.
DEFINE VARIABLE hServName AS CHARACTER NO-UNDO.

DO WITH FRAME {&FRAME-NAME}:  
  /* Load up definitions from the Appserver PRO*Tool */
  AppService:DELIMITER = CHR(3).
  AppService:LIST-ITEMS = DYNAMIC-FUNCTION('definedPartitions':U IN appSrvUtils) .
  AppService:DELIMITER = ',':U.
      
  /* Also load up any AppServer connections which were created outside of the tool */
  ASSIGN hServ = SESSION:FIRST-SERVER.
  DO WHILE VALID-HANDLE(hServ):
    /* check if it's already active in the other list */
    FIND FIRST AppSrv-TT WHERE hServ = AppSrv-TT.AS-Handle NO-ERROR.
    IF NOT AVAILABLE AppSrv-TT THEN DO: /* If not, add it */
      IF hServ:NAME <> ? AND hServ:NAME <> "" THEN 
      DO: /* If we find one, we'll display the name off the handle and add it to our list */
        IF NUM-ENTRIES(hServ:NAME,":":U) >= 2 THEN DO:
          /*
           * If the handle is not in AppSrv-TT, it has an ugly name delimited by "::". 
           * Let's create a friendly one 
           */
          ASSIGN hServName = ENTRY(3,hServ:NAME,":":U) + " on " + ENTRY(1,hServ:NAME,":":U).
        END.
        ELSE
          ASSIGN hServName = hServ:NAME. /* Not sure what it is, so let's leave it alone */
        AppService:ADD-LAST(hServName).
        CREATE OtherAS.
        ASSIGN ASName = hServName
               hAS    = hServ.
      END.  
    END.
    hServ = hServ:NEXT-SIBLING.
  END.
  
  IF AppService:LIST-ITEMS <> ? THEN 
    AppService:SCREEN-VALUE = AppService:ENTRY(1).
  ELSE
    RETURN "NONE":U.
END.
END PROCEDURE.

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

&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 Window-1
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _DEFINITIONS Window-1 
/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/
/*------------------------------------------------------------------------

  File:                 break.w

  Description:          Persistent procedure to set/modify breakpoints

  Input Parameters:
      <none>

  Output Parameters:
      <none>

  Author:               J. Rothermal
  Created:              3/24/95
  Updated:              J. Palazzo 10/95
------------------------------------------------------------------------*/
/*          This .W file was created with the Progress UIB.             */
/*----------------------------------------------------------------------*/

/* Create an unnamed pool to Add 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  ************************** */

/* Parameters Definitions ---                                           */

DEFINE INPUT PARAMETER pType AS CHAR NO-UNDO.


/* Local Variable Definitions -----------                     */

{protools/psvar.i} 
{protools/ptlshlp.i}

DEFINE VAR h_app           AS HANDLE NO-UNDO.
DEFINE VAR fOK             AS LOG    NO-UNDO.
DEFINE VAR pvalue          AS CHAR   NO-UNDO.
DEFINE VAR cnt             AS INT    NO-UNDO.

{adecomm/_adetool.i}   /* Signify as an ADE Persistent object. */

/* _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 frm-break

/* Standard List Definitions                                            */
&Scoped-Define ENABLED-OBJECTS btn-close slct-objects slct-methods btn-help ~
bf-defined 
&Scoped-Define DISPLAYED-OBJECTS slct-objects slct-methods bf-defined ~
def-label 

/* 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 Window-1 AS WIDGET-HANDLE NO-UNDO.

/* Definitions of the field level widgets                               */
DEFINE BUTTON btn-Add 
     LABEL "&Add" 
     SIZE 12 BY 1
     BGCOLOR 8 .

DEFINE BUTTON btn-close 
     LABEL "Close" 
     SIZE 12 BY 1.

DEFINE BUTTON btn-help 
     LABEL "&Help" 
     SIZE 12 BY 1.

DEFINE BUTTON btn-rmv 
     LABEL "&Remove" 
     SIZE 12 BY 1.

DEFINE VARIABLE def-label AS CHARACTER FORMAT "x(15)":U 
      VIEW-AS TEXT 
     SIZE 25 BY .81 NO-UNDO.

DEFINE VARIABLE bf-defined AS CHARACTER 
     VIEW-AS SELECTION-LIST MULTIPLE 
     SCROLLBAR-HORIZONTAL SCROLLBAR-VERTICAL 
     SIZE 51 BY 5.24 NO-UNDO.

DEFINE VARIABLE slct-methods AS CHARACTER 
     VIEW-AS SELECTION-LIST MULTIPLE 
     SCROLLBAR-HORIZONTAL SCROLLBAR-VERTICAL 
     SIZE 24.8 BY 6.67 NO-UNDO.

DEFINE VARIABLE slct-objects AS CHARACTER 
     VIEW-AS SELECTION-LIST MULTIPLE 
     SCROLLBAR-HORIZONTAL SCROLLBAR-VERTICAL 
     SIZE 24.8 BY 6.67 NO-UNDO.


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

DEFINE FRAME frm-break
     btn-close AT ROW 1.48 COL 54
     slct-objects AT ROW 2.33 COL 2 NO-LABEL
     slct-methods AT ROW 2.33 COL 28 NO-LABEL
     btn-Add AT ROW 2.67 COL 54
     btn-help AT ROW 3.95 COL 54
     bf-defined AT ROW 10.1 COL 2 NO-LABEL
     btn-rmv AT ROW 10.1 COL 54
     def-label AT ROW 9.33 COL 2 NO-LABEL
     "SmartObjects" VIEW-AS TEXT
          SIZE 25 BY .76 AT ROW 1.48 COL 2
     "Methods/States" VIEW-AS TEXT
          SIZE 25 BY .76 AT ROW 1.48 COL 28
    WITH 1 DOWN NO-BOX KEEP-TAB-ORDER OVERLAY 
         SIDE-LABELS NO-UNDERLINE THREE-D 
         AT COL 1 ROW 1
         SIZE 66.57 BY 14.81
         FONT 4.


/* *********************** 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 Window-1 ASSIGN
         HIDDEN             = YES
         TITLE              = "Breakpoints"
         HEIGHT             = 14.81
         WIDTH              = 66.6
         MAX-HEIGHT         = 17.48
         MAX-WIDTH          = 91.2
         VIRTUAL-HEIGHT     = 17.48
         VIRTUAL-WIDTH      = 91.2
         RESIZE             = no
         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.
/* END WINDOW DEFINITION                                                */
&ANALYZE-RESUME



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

&ANALYZE-SUSPEND _RUN-TIME-ATTRIBUTES
/* SETTINGS FOR WINDOW Window-1
  VISIBLE,,RUN-PERSISTENT                                               */
/* SETTINGS FOR FRAME frm-break
                                                                        */
/* SETTINGS FOR BUTTON btn-Add IN FRAME frm-break
   NO-ENABLE                                                            */
/* SETTINGS FOR BUTTON btn-rmv IN FRAME frm-break
   NO-ENABLE                                                            */
/* SETTINGS FOR FILL-IN def-label IN FRAME frm-break
   NO-ENABLE ALIGN-L                                                    */
IF SESSION:DISPLAY-TYPE = "GUI":U AND VALID-HANDLE(Window-1)
THEN Window-1:HIDDEN = no.

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

 



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

&Scoped-define SELF-NAME Window-1
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL Window-1 Window-1
ON END-ERROR OF Window-1 /* Breakpoints */
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 Window-1 Window-1
ON WINDOW-CLOSE OF Window-1 /* Breakpoints */
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 bf-defined
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL bf-defined Window-1
ON VALUE-CHANGED OF bf-defined IN FRAME frm-break
DO:                                                        
  DEF VAR lFileName AS CHAR NO-UNDO.

  RUN Chk_Run_Win.
  IF RETURN-VALUE = "CLOSE":U THEN RETURN.
                                            
  ASSIGN     
  lFileName = SUBSTRING(bf-defined:SCREEN-VALUE,1,
                        INDEX(bf-defined:SCREEN-VALUE," ") - 1).
                        
  FIND FIRST pp WHERE pp.cFileName = lFileName NO-ERROR.
  IF NOT AVAILABLE pp THEN RETURN.
  
  ASSIGN                                                               
    slct-objects:SCREEN-VALUE = "" 
    slct-objects:SCREEN-VALUE = lFileName 
    slct-methods:LIST-ITEMS   = pp.pHandle:INTERNAL-ENTRIES
    slct-methods:SCREEN-VALUE = "".
  IF pp.cMethod <> "NONE" THEN    
  DO:
    Run LoadMethods.
    
    IF pType = "Breaks" THEN
    DO:
      FIND FIRST pgm-bf WHERE pgm-bf.cFileName = lFileName
                    AND pgm-bf.cType = yes NO-ERROR.
      IF AVAILABLE pgm-bf THEN
        slct-methods:SCREEN-VALUE = pgm-bf.cMethod.   
      ELSE
        slct-methods:SCREEN-VALUE = "".
    END.
    ELSE
    DO:
      FIND FIRST pgm-bf WHERE pgm-bf.cFileName = lFileName
                      AND pgm-bf.cType = no NO-ERROR.
      IF AVAILABLE pgm-bf THEN
        slct-methods:SCREEN-VALUE = pgm-bf.cMethod.
      ELSE
        slct-methods:SCREEN-VALUE = "".
    END.
    
    ASSIGN btn-rmv:SENSITIVE = YES.
  END.
 
  RUN adecomm/_scroll.p (INPUT slct-objects:HANDLE,
                         INPUT slct-objects:SCREEN-VALUE).
  RUN adecomm/_scroll.p (INPUT slct-methods:HANDLE,
                         INPUT slct-methods:SCREEN-VALUE).

END.

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


&Scoped-define SELF-NAME btn-Add
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL btn-Add Window-1
ON CHOOSE OF btn-Add IN FRAME frm-break /* Add */
DO:
  RUN Chk_Run_Win.
  IF RETURN-VALUE = "CLOSE":U THEN RETURN.
  
  RUN Add-bf.
END.

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


&Scoped-define SELF-NAME btn-close
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL btn-close Window-1
ON CHOOSE OF btn-close IN FRAME frm-break /* Close */
DO:
    APPLY "WINDOW-CLOSE" TO {&WINDOW-NAME}.
END.

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


&Scoped-define SELF-NAME btn-help
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL btn-help Window-1
ON CHOOSE OF btn-help IN FRAME frm-break /* Help */
OR HELP OF FRAME frm-break DO:

  IF pType = "Breaks" THEN
    RUN adecomm/_adehelp.p 
        ( INPUT "ptls", INPUT "CONTEXT" , INPUT {&PRO_Spy_Breakpoints}  , INPUT "" ).
  ELSE
    RUN adecomm/_adehelp.p 
        ( INPUT "ptls", INPUT "CONTEXT" , INPUT {&PRO_Spy_Filters}  , INPUT "" ).
  
END.

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


&Scoped-define SELF-NAME btn-rmv
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL btn-rmv Window-1
ON CHOOSE OF btn-rmv IN FRAME frm-break /* Remove */
DO:
   
   DEFINE VAR tList   AS CHAR  NO-UNDO.
   DEFINE VAR temp    AS CHAR  NO-UNDO.
   DEFINE VAR tpgm    AS CHAR  NO-UNDO.
   DEFINE VAR tmethod AS CHAR  NO-UNDO.
   DEFINE VAR bflist  AS CHAR  NO-UNDO.
   
   RUN Chk_Run_Win.
   IF RETURN-VALUE = "CLOSE":U THEN RETURN.
      
   IF bf-defined:SCREEN-VALUE = "" OR
      bf-defined:SCREEN-VALUE = ? THEN DO:
       MESSAGE "No entry in the Defined list has been selected."
          VIEW-AS ALERT-BOX INFORMATION BUTTONS OK IN WINDOW WINDOW-1.
       RETURN.
   END.                                  
                                
   ASSIGN
     tList = bf-defined:SCREEN-VALUE
     slct-objects:SCREEN-VALUE = ?
     slct-objects:SCREEN-VALUE = ""
     slct-objects:SCREEN-VALUE = ?
     slct-methods:SCREEN-VALUE = "".

                                           
   DO cnt = 1 TO NUM-ENTRIES(tList):    
          
       ASSIGN
       temp = ENTRY(cnt,tList)
       tpgm = SUBSTR(temp,1,INDEX(temp," ") - 1)
       tmethod = TRIM(REPLACE(temp,tpgm," ")).             

       IF cnt < NUM-ENTRIES(tList) THEN
         tmethod = tmethod + ",".
                    
       IF pType = "Breaks" THEN    
         FIND pgm-bf WHERE pgm-bf.cFileName = tpgm
                       AND pgm-bf.cType = yes
                       NO-ERROR.
       ELSE
         FIND pgm-bf WHERE pgm-bf.cFileName = tpgm
                       AND pgm-bf.cType = no
                       NO-ERROR.         
                                                                
       ASSIGN
           pgm-bf.cMethod = REPLACE(pgm-bf.cMethod,tmethod,"")
           pgm-bf.cMethod = REPLACE(pgm-bf.cMethod,",,", ",").
       
       pgm-bf.cMethod = TRIM(pgm-bf.cMethod, ",").
                                                 
       IF pgm-bf.cMethod = "" THEN DELETE pgm-bf.
                         
       FIND def-bf WHERE def-bf.cFileName = tpgm
                  AND def-bf.cMethod   = tmethod
                  NO-ERROR.
       IF AVAILABLE def-bf THEN DELETE def-bf.

       IF AVAILABLE pgm-bf AND pgm-bf.cMethod <> "" THEN
         ASSIGN  
             bflist = pgm-bf.cMethod.
       ELSE
         ASSIGN 
             bflist = "".
       
   END.                      
   
   
   fOK   = bf-defined:DELETE(tList).   
   DISPLAY bf-defined WITH FRAME {&FRAME-NAME}.

   slct-objects:SCREEN-VALUE = ?.
   slct-objects:SCREEN-VALUE = pp.cFileName.
   
   slct-methods:SCREEN-VALUE = ?.
   slct-methods:SCREEN-VALUE = bflist.   
   
   IF bf-defined:LIST-ITEMS = ? THEN
   DO:
     FOR EACH def-bf:
       DELETE def-bf NO-ERROR.
     END.
    
     FOR EACH adm-methods-bf:
       DELETE adm-methods-bf NO-ERROR.
     END.     
   END.

END.

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


&Scoped-define SELF-NAME slct-methods
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL slct-methods Window-1
ON MOUSE-SELECT-DBLCLICK OF slct-methods IN FRAME frm-break
DO:

  RUN Add-bf.
   
END.

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


&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL slct-methods Window-1
ON VALUE-CHANGED OF slct-methods IN FRAME frm-break
DO:
   RUN Chk_Run_Win.
   IF RETURN-VALUE = "CLOSE":U THEN RETURN.
END.

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


&Scoped-define SELF-NAME slct-objects
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL slct-objects Window-1
ON VALUE-CHANGED OF slct-objects IN FRAME frm-break
DO:
  RUN Chk_Run_Win.
  IF RETURN-VALUE = "CLOSE":U THEN RETURN.
      
  IF NUM-ENTRIES(slct-objects:SCREEN-VALUE) > 1 THEN DO:
      slct-methods:LIST-ITEMS = "".
      bf-defined:LIST-ITEMS = "".
      RETURN.
  END.

  IF slct-objects:SCREEN-VALUE = "" THEN
    bf-defined:LIST-ITEMS = "".
  
  FIND FIRST pp WHERE pp.cFileName = slct-objects:SCREEN-VALUE 
      NO-ERROR.
  
  RUN LoadMethods.

  FOR EACH def-bf:
    DELETE def-bf.    
  END.

  IF pType = "Breaks" THEN
    FIND FIRST pgm-bf WHERE pgm-bf.cFileName = slct-objects:SCREEN-VALUE
                  AND pgm-bf.cType     = yes
                  AND pgm-bf.cMethod  <> "" NO-ERROR.
  ELSE
    FIND FIRST pgm-bf WHERE pgm-bf.cFileName = slct-objects:SCREEN-VALUE
                  AND pgm-bf.cType     = no 
                  AND pgm-bf.cMethod  <> "" NO-ERROR.
  
  IF AVAILABLE pgm-bf THEN 
  DO:
     ASSIGN
     slct-methods:SCREEN-VALUE = pgm-bf.cMethod.      

     IF pType = "Breaks" THEN
     DO:     
       FOR EACH pgm-bf WHERE pgm-bf.cFileName = slct-objects:SCREEN-VALUE
                             AND pgm-bf.cType = yes
                             AND pgm-bf.cMethod <> "" :
       
         bf-defined:LIST-ITEMS = "".
       
         DO cnt = 1 TO NUM-ENTRIES(pgm-bf.cMethod):
           CREATE def-bf.
           ASSIGN def-bf.cFileName = pgm-bf.cFileName
              def-bf.cMethod   = ENTRY(cnt,pgm-bf.cMethod)
              fOK = bf-defined:ADD-LAST(pgm-bf.cFileName + " " + ENTRY(cnt,pgm-bf.cMethod)).
         END.
       
       END. /* for each pgm-bf */    
     END.
     ELSE
     DO:
       FOR EACH pgm-bf WHERE pgm-bf.cFileName = slct-objects:SCREEN-VALUE
                             AND pgm-bf.cType = no
                             AND pgm-bf.cMethod <> "" :
       
         bf-defined:LIST-ITEMS = "".
       
         DO cnt = 1 TO NUM-ENTRIES(pgm-bf.cMethod):
           CREATE def-bf.
           ASSIGN def-bf.cFileName = pgm-bf.cFileName
              def-bf.cMethod   = ENTRY(cnt,pgm-bf.cMethod)
              fOK = bf-defined:ADD-LAST(pgm-bf.cFileName + " " + ENTRY(cnt,pgm-bf.cMethod)).
         END.
       
       END. /* for each pgm-bf */  
     END.       
  END.
  ELSE
      bf-defined:LIST-ITEMS = "".
  
  RUN adecomm/_scroll.p (INPUT slct-methods:HANDLE,
                         INPUT slct-methods:SCREEN-VALUE).
   
END.

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


&UNDEFINE SELF-NAME

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _MAIN-BLOCK Window-1 


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

ASSIGN THIS-PROCEDURE:CURRENT-WINDOW = {&WINDOW-NAME}
       {&WINDOW-NAME}:TITLE = "PRO*Spy - Setting " + pType
       def-label            = "Defined " + pType.
       
/* Parent to the main ProSpy window. */
ASSIGN {&WINDOW-NAME}:PARENT = ps_window.

/* Ensure that the window cannot be resized by the WINDOW-MAXIMIZED event. */
ASSIGN {&WINDOW-NAME}:MAX-WIDTH  = {&WINDOW-NAME}:WIDTH
       {&WINDOW-NAME}:MAX-HEIGHT = {&WINDOW-NAME}:HEIGHT .

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

&IF "{&WINDOW-SYSTEM}" BEGINS "MS-WIN" &THEN
fOK = {&WINDOW-NAME}:LOAD-ICON("adeicon/prospy.ico").
&ELSE
fOK = {&WINDOW-NAME}:LOAD-ICON("adeicon/prospy.xpm").
&ENDIF

/* 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 Init_Window.
   RUN Move_To_Top (INPUT "_ENTRY":U).
       
   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-bf Window-1 
PROCEDURE Add-bf :
/*------------------------------------------------------------------------------
  Purpose:     
  Parameters:  <none>
  Notes:       
------------------------------------------------------------------------------*/

  DEF VAR tItem                   AS INT  NO-UNDO.
  DEF VAR cnt1                    AS INT  NO-UNDO.
  DEF VAR cnt2                    AS INT  NO-UNDO.
  
  DEF VAR svalue                  AS CHAR NO-UNDO.
  DEF VAR pvalue                  AS CHAR NO-UNDO.  
      
  DEF VAR l-choice                AS LOG  NO-UNDO.
  DEF VAR fOK                     AS LOG  NO-UNDO.
  
  DEF VAR bfMethods               AS CHAR NO-UNDO.

                
  svalue = slct-objects:SCREEN-VALUE IN FRAME {&FRAME-NAME}.
  pvalue = slct-methods:SCREEN-VALUE IN FRAME {&FRAME-NAME}.

  if pvalue = "" OR pvalue = ? THEN
  DO:
    MESSAGE "No Methods/States have been selected."
            VIEW-AS ALERT-BOX INFORMATION BUTTONS OK IN WINDOW WINDOW-1.
    RETURN.
  END.

   
  RUN Chk-for-bf.
  pvalue = slct-methods:SCREEN-VALUE IN FRAME {&FRAME-NAME}.
  IF pvalue = ""  OR pvalue = ? THEN RETURN.

  FIND FIRST pp WHERE pp.cFileName = svalue
    NO-ERROR.  

  IF pType = "Breaks" THEN
  DO:
    FIND FIRST pgm-bf WHERE pgm-bf.cFileName = pp.cFileName
                        AND pgm-bf.cType     = yes
                        AND pgm-bf.cMethod   = pvalue NO-ERROR.
  
    IF AVAILABLE pgm-bf THEN 
    DO:
      MESSAGE pgm-bf.cFileName + ":  " pgm-bf.cMethod SKIP
              "You have already defined this break."
              VIEW-AS ALERT-BOX INFORMATION BUTTONS OK IN WINDOW WINDOW-1.
      RETURN.         
    END.
  END.
  ELSE
    IF pType = "Filters" THEN
    DO:
      FIND FIRST pgm-bf WHERE pgm-bf.cFileName = pp.cFileName
                          AND pgm-bf.cType     = no
                          AND pgm-bf.cMethod   = pvalue NO-ERROR.

      IF AVAILABLE pgm-bf THEN 
      DO:
        MESSAGE pgm-bf.cFileName + ":  " pgm-bf.cMethod SKIP
                "You have already defined this filter."
                VIEW-AS ALERT-BOX INFORMATION BUTTONS OK IN WINDOW WINDOW-1.
        RETURN.
      END.
    END.
                              
  IF pType = "Breaks" THEN     
    FIND pgm-bf WHERE pgm-bf.cFileName = pp.cFileName 
                  AND pgm-bf.cType     = yes NO-ERROR.   
  ELSE
    FIND pgm-bf WHERE pgm-bf.cFileName = pp.cFileName 
                  AND pgm-bf.cType     = no NO-ERROR.   

  IF AVAILABLE pgm-bf THEN
    ASSIGN                                  
      bfMethods = pgm-bf.cMethod.
  ELSE
    ASSIGN
      bfMethods = "".

  IF NUM-ENTRIES(slct-methods:SCREEN-VALUE IN FRAME {&FRAME-NAME}) = 1 AND
     NOT CAN-DO(pp.cMethod,slct-methods:SCREEN-VALUE IN FRAME {&FRAME-NAME}) THEN
    bfMethods = 
                 (IF bfMethods = "" OR bfMethods = "NONE" THEN 
                  slct-methods:SCREEN-VALUE IN FRAME {&FRAME-NAME}
  ELSE bfMethods + "," + slct-methods:SCREEN-VALUE IN FRAME {&FRAME-NAME}).
    ELSE 
      DO cnt = 1 TO NUM-ENTRIES(slct-methods:SCREEN-VALUE IN FRAME {&FRAME-NAME}):
        IF NOT CAN-DO(ENTRY(cnt, slct-methods:SCREEN-VALUE),bfMethods) THEN
        bfMethods = 
                     IF bfMethods = "" OR bfMethods = "NONE" THEN 
                       ENTRY(cnt, slct-methods:SCREEN-VALUE IN FRAME {&FRAME-NAME})
                     ELSE bfMethods + "," + ENTRY(cnt, slct-methods:SCREEN-VALUE IN FRAME {&FRAME-NAME}).
      END.
              
  IF bfMethods = "" OR bfMethods = ? THEN bfMethods = "NONE". 

  IF pType = "Breaks" THEN    
    IF NOT AVAILABLE pgm-bf THEN 
    DO:
      CREATE pgm-bf.
      ASSIGN pgm-bf.cFileName = pp.cFileName
             pgm-bf.cType     = yes
             pgm-bf.cMethod   = bfMethods.
    END.   
    ELSE                    
      ASSIGN                                  
             pgm-bf.cMethod = bfMethods.
      ELSE
        IF NOT AVAILABLE pgm-bf THEN 
        DO:
          CREATE pgm-bf.
          ASSIGN pgm-bf.cFileName = pp.cFileName
                 pgm-bf.cType     = no
                 pgm-bf.cMethod   = bfMethods.
        END.   
        ELSE                    
          ASSIGN                                  
                 pgm-bf.cMethod = bfMethods.     

  FOR EACH def-bf:
    DELETE def-bf.
  END.
     
  DO cnt = 1 TO NUM-ENTRIES(pgm-bf.cMethod):
    FIND def-bf WHERE def-bf.cFileName = pgm-bf.cFileName 
                  AND def-bf.cMethod   = ENTRY(cnt,pgm-bf.cMethod) NO-ERROR. 
                   
    IF NOT AVAILABLE def-bf THEN 
    DO:
      CREATE def-bf.
      ASSIGN def-bf.cFileName = pgm-bf.cFileName
             def-bf.cMethod   = ENTRY(cnt,pgm-bf.cMethod).
    END.
  END.    

              
  bf-defined:LIST-ITEMS = "".
   
  FOR EACH def-bf:
     fOK = bf-defined:ADD-LAST(def-bf.cFileName + " " + def-bf.cMethod).
  END.

  btn-rmv:SENSITIVE IN FRAME {&FRAME-NAME} = yes.


END PROCEDURE.

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

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE Chk-for-bf Window-1 
PROCEDURE Chk-for-bf :
/*------------------------------------------------------------------------------
  Purpose:     
  Parameters:  <none>
  Notes:       
------------------------------------------------------------------------------*/ 

  DEF VAR cnt1                    AS INT  NO-UNDO.
  DEF VAR cnt2                    AS INT  NO-UNDO.
  
  DEF VAR svalue                  AS CHAR NO-UNDO.
  DEF VAR pvalue                  AS CHAR NO-UNDO.  
  DEF VAR stored-method-state     AS CHAR NO-UNDO.
  DEF VAR new-method-state        AS CHAR NO-UNDO.
  DEF VAR method-state            AS CHAR NO-UNDO.
  DEF VAR rmv-method-state        AS CHAR NO-UNDO.
  DEF VAR old-method-state        AS CHAR NO-UNDO.
  DEF VAR common-method-state     AS CHAR NO-UNDO.
  DEF VAR rmv-break-list          AS CHAR NO-UNDO.
  DEF VAR rmv-filter-list         AS CHAR NO-UNDO.
  DEF VAR rmv-break-selection     AS CHAR NO-UNDO.
  DEF VAR rmv-filter-selection    AS CHAR NO-UNDO.
      
  DEF VAR l-choice                AS LOG  NO-UNDO.

  DEF VAR position                AS INT  NO-UNDO.  
  DEF VAR startposition           AS INT  NO-UNDO.
  
  ASSIGN
    rmv-break-list       = ""
    rmv-filter-list      = ""
    rmv-break-selection  = ""
    rmv-filter-selection = "".
    
                
  svalue = slct-objects:SCREEN-VALUE IN FRAME {&FRAME-NAME}.
  pvalue = slct-methods:SCREEN-VALUE IN FRAME {&FRAME-NAME}.
  
  
  FIND FIRST pp WHERE pp.cFileName = svalue NO-ERROR.

  /* Generate a list of methods/states that are common between */
  /* what have already been created and what are attempted to  */
  /* be created now.                                           */ 
   
  IF AVAILABLE pp THEN
  DO:
    IF pType = "Filters" THEN 
      FIND FIRST pgm-bf WHERE pgm-bf.cFileName = pp.cFileName
                          AND pgm-bf.cType     = yes NO-ERROR.
    ELSE IF pType = "Breaks" THEN
      FIND FIRST pgm-bf WHERE pgm-bf.cFileName = pp.cFileName
                          AND pgm-bf.cType     = no NO-ERROR.
                          
    IF AVAILABLE pgm-bf THEN
    DO:
      DO cnt1 = 1 TO NUM-ENTRIES(pgm-bf.cMethod):
        stored-method-state = ENTRY(cnt1, pgm-bf.cMethod).
          
        DO cnt2 = 1 TO NUM-ENTRIES(pvalue):
          new-method-state = ENTRY(cnt2, pvalue).
            
          IF new-method-state = stored-method-state THEN
            IF common-method-state = "" THEN
              common-method-state = new-method-state.
            ELSE IF common-method-state <> "" THEN
              common-method-state = common-method-state + "," + new-method-state.
        END.  
        
      END. 
      
    END.
    ELSE IF NOT AVAILABLE pgm-bf THEN 
      RETURN.
      
  END.
  ELSE IF NOT AVAILABLE pp THEN
    RETURN.


  /* Based on the list of common methods/states that is being attempted to  */
  /* create -- go through and inform the user                               */
    
  DO cnt1 = 1 TO NUM-ENTRIES(common-method-state):
    method-state = ENTRY(cnt1, common-method-state).

    IF pType = "Filters" THEN
    DO:    
      MESSAGE "A Break has already been set on:  " method-state + "." SKIP(1)
              " Would you like to remove the Break?" 
              VIEW-AS ALERT-BOX QUESTION BUTTONS YES-NO
              UPDATE l-choice IN WINDOW WINDOW-1.
            
      IF l-choice EQ TRUE THEN
      DO:
        IF rmv-break-list = "" THEN
          rmv-break-list = method-state.
        ELSE IF rmv-break-list <> "" THEN
          rmv-break-list = rmv-break-list + "," + method-state.
      END.      
      ELSE IF l-choice EQ FALSE THEN
      DO:
        IF rmv-filter-selection = "" THEN
          rmv-filter-selection = method-state.
        ELSE IF rmv-filter-selection <> "" THEN
          rmv-filter-selection = rmv-filter-selection + "," + method-state.
      END.
      
    END.
    
    ELSE IF pType = "Breaks" THEN
    DO:
      MESSAGE "A Filter has already been set on:  " method-state + "." SKIP(1)
              "Would you like to remove the Filter?"
              VIEW-AS ALERT-BOX QUESTION BUTTONS YES-NO
              UPDATE l-choice IN WINDOW WINDOW-1.
              
      IF l-choice EQ TRUE THEN
      DO: 
        IF rmv-filter-list = "" THEN
          rmv-filter-list = method-state.
        ELSE IF rmv-filter-list <> "" THEN
          rmv-filter-list = rmv-filter-list + "," + method-state.
      END.      
      ELSE IF l-choice EQ FALSE THEN
      DO:
        IF rmv-break-selection = "" THEN
          rmv-break-selection = method-state.
        ELSE IF rmv-break-selection <> "" THEN
          rmv-break-selection = rmv-break-selection + "," + method-state.
      END.
      
    END.
  END.

  
  /* Update temp-tables now that remove break/filter lists have been updated. */
  
  FIND FIRST pp WHERE pp.cFileName = svalue NO-ERROR.
  
  IF AVAILABLE pp THEN
  DO:
  
    IF pType = "Filters" THEN
    DO:         
      IF rmv-break-list <> "" THEN
      DO:
        FIND FIRST pgm-bf WHERE pgm-bf.cFileName = pp.cFileName 
                            AND pgm-bf.cType     = yes NO-ERROR.
        
        IF AVAILABLE pgm-bf THEN
        DO:        
          DO cnt1 = 1 TO NUM-ENTRIES(rmv-break-list):
            rmv-method-state = ENTRY(cnt1, rmv-break-list).
            
            position = LOOKUP(rmv-method-state, pgm-bf.cMethod).
            
            IF position <> 0 THEN
            DO:
              old-method-state = ENTRY(position, pgm-bf.cMethod).
                
              IF old-method-state = rmv-method-state THEN
              DO:
                IF position = 1 AND NUM-ENTRIES(pgm-bf.cMethod) > 1 THEN
                DO:
                  startposition = INDEX(pgm-bf.cMethod, ",", 1).
                  pgm-bf.cMethod = SUBSTRING(pgm-bf.cMethod, startposition + 1).
                END.
                ELSE
                  IF position = NUM-ENTRIES(pgm-bf.cMethod) AND NUM-ENTRIES(pgm-bf.cMethod) > 1 THEN
                  DO:
                    startposition = R-INDEX(pgm-bf.cMethod, ",", LENGTH(pgm-bf.cMethod)).  
                    pgm-bf.cMethod = SUBSTRING(pgm-bf.cMethod, 1, startposition - 1).
                  END.
                  ELSE
                    ENTRY(position, pgm-bf.cMethod) = "".
                      
                pgm-bf.cMethod = REPLACE(pgm-bf.cMethod, ",,", ",").

              END.
            END.
          END.
        END.  
        
        
        DO cnt1 = 1 TO NUM-ENTRIES(rmv-break-list):
          rmv-method-state = ENTRY(cnt1, rmv-break-list).
          
          FIND FIRST def-bf WHERE def-bf.cFileName = pp.cFileName
                              AND def-bf.cMethod   = rmv-method-state NO-ERROR.
                              
          IF AVAILABLE def-bf THEN DELETE def-bf.
        END.
        
        IF pgm-bf.cMethod = "" THEN DELETE pgm-bf.
        
      END.
    END.    
    ELSE IF pType = "Breaks" THEN
    DO:     
      IF rmv-filter-list <> "" THEN
      DO:
        FIND FIRST pgm-bf WHERE pgm-bf.cFileName = pp.cFileName 
                            AND pgm-bf.cType     = no NO-ERROR.
        
        IF AVAILABLE pgm-bf THEN
        DO:
          DO cnt1 = 1 TO NUM-ENTRIES(rmv-filter-list):
            rmv-method-state = ENTRY(cnt1, rmv-filter-list).

            position = LOOKUP(rmv-method-state, pgm-bf.cMethod).
            
            IF position <> 0 THEN
            DO:
              old-method-state = ENTRY(position, pgm-bf.cMethod).
                
              IF old-method-state = rmv-method-state THEN
              DO:
                IF position = 1 AND NUM-ENTRIES(pgm-bf.cMethod) > 1 THEN
                DO:
                  startposition = INDEX(pgm-bf.cMethod, ",", 1).
                  pgm-bf.cMethod = SUBSTRING(pgm-bf.cMethod, startposition + 1).
                END.
                ELSE
                  IF position = NUM-ENTRIES(pgm-bf.cMethod) AND NUM-ENTRIES(pgm-bf.cMethod) > 1 THEN
                  DO:
                    startposition = R-INDEX(pgm-bf.cMethod, ",", LENGTH(pgm-bf.cMethod)).  
                    pgm-bf.cMethod = SUBSTRING(pgm-bf.cMethod, 1, startposition - 1).
                  END.
                  ELSE
                    ENTRY(position, pgm-bf.cMethod) = "".
                      
                pgm-bf.cMethod = REPLACE(pgm-bf.cMethod, ",,", ",").
              END.                   
            END.
          END.
        END.
        
        DO cnt1 = 1 TO NUM-ENTRIES(rmv-filter-list):
          rmv-method-state = ENTRY(cnt1, rmv-filter-list).
          
          FIND FIRST def-bf WHERE def-bf.cFileName = pp.cFileName
                              AND def-bf.cMethod   = rmv-method-state NO-ERROR.
                              
          IF AVAILABLE def-bf THEN DELETE def-bf.
        END.
        
        IF pgm-bf.cMethod = "" THEN DELETE pgm-bf.
        
      END.
    END.
  END.    
  
    
  /* Update screen-value of slct-methods selection-list box based on remove break/filter */
  /* selection lists                                                                     */

  IF pType = "Filters" AND rmv-filter-selection <> "" THEN
  DO:
    ASSIGN
      slct-methods:SCREEN-VALUE = ?                       
      slct-methods:SCREEN-VALUE = rmv-break-list.       
  END.          
  ELSE IF pType = "Breaks" AND rmv-break-selection <> "" THEN
  DO:                
    ASSIGN 
      slct-methods:SCREEN-VALUE = ?
      slct-methods:SCREEN-VALUE = rmv-filter-list.    
  END.

END PROCEDURE.

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

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE Chk_Run_Win Window-1 
PROCEDURE Chk_Run_Win :
/*------------------------------------------------------------------------------
  Purpose:     
  Parameters:  <none>
  Notes:       
------------------------------------------------------------------------------*/


IF NOT VALID-HANDLE(app_handle) THEN
DO ON STOP UNDO, RETRY:

  IF NOT RETRY THEN
  MESSAGE "Run window has been shut down."  SKIP(1)
          "Closing " + pType + " Window."          
          VIEW-AS ALERT-BOX INFORMATION BUTTONS OK IN WINDOW WINDOW-1.
    
  RUN Reset_Lists.
  APPLY "WINDOW-CLOSE" TO {&WINDOW-NAME}.
  RETURN "CLOSE":U.
  
END.                           

END PROCEDURE.

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

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE disable_UI Window-1  _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(Window-1)
  THEN DELETE WIDGET Window-1.
  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 Window-1  _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 slct-objects slct-methods bf-defined def-label 
      WITH FRAME frm-break IN WINDOW Window-1.
  ENABLE btn-close slct-objects slct-methods btn-help bf-defined 
      WITH FRAME frm-break IN WINDOW Window-1.
  {&OPEN-BROWSERS-IN-QUERY-frm-break}
  VIEW Window-1.
END PROCEDURE.

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

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE Init_Window Window-1 
PROCEDURE Init_Window :
/*------------------------------------------------------------------------------
  Purpose:     
  Parameters:  <none>
  Notes:       
------------------------------------------------------------------------------*/

DO WITH FRAME {&FRAME-NAME}:  

  /* Case 1: Setup for a new running application. */
  IF VALID-HANDLE(app_handle) AND (h_app <> app_handle) THEN
  DO:
    RUN Reset_Lists.
    ASSIGN h_app = app_handle.
  END.
  /* Case 2: Same running app, just bring the window forward. */
  ELSE
  IF VALID-HANDLE(app_handle) AND (h_app = app_handle) THEN
  DO:
    RUN Move_To_Top (INPUT "_ENTRY":U).
    RETURN.
  END.
  /* Case 3: No app running, clear window and bring forward. */
  ELSE
  DO:
    RUN Reset_Lists.
    RUN enable_UI.
    RUN Move_To_Top (INPUT "_ENTRY":U).
    RETURN.
  END.
  
  IF pType = "Breaks" THEN
    FOR EACH pgm-bf WHERE pgm-bf.cType = yes:
       DO cnt = 1 TO NUM-ENTRIES(pgm-bf.cMethod):
         CREATE def-bf.
         ASSIGN def-bf.cFileName = pgm-bf.cFileName
                def-bf.cMethod   = ENTRY(cnt,pgm-bf.cMethod)
                fOK = bf-defined:ADD-LAST(pgm-bf.cFileName + " " + 
                                          ENTRY(cnt,pgm-bf.cMethod)).
       END.
    END. /* for each pgm-bf */    
  ELSE
    FOR EACH pgm-bf WHERE pgm-bf.cType = no:
       DO cnt = 1 TO NUM-ENTRIES(pgm-bf.cMethod):
         CREATE def-bf.
         ASSIGN def-bf.cFileName = pgm-bf.cFileName
                def-bf.cMethod   = ENTRY(cnt,pgm-bf.cMethod)
                fOK = bf-defined:ADD-LAST(pgm-bf.cFileName + " " + 
                                          ENTRY(cnt,pgm-bf.cMethod)).
       END.
    END. /* for each pgm-bf */ 
  
  RUN LoadLists.
     
  RUN enable_UI.
  ASSIGN btn-rmv:SENSITIVE = (bf-defined:NUM-ITEMS <> 0).
  ASSIGN btn-Add:SENSITIVE = (slct-objects:NUM-ITEMS <> 0).
  
END. /* DO WITH FRAME */

END PROCEDURE.

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

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE LoadLists Window-1 
PROCEDURE LoadLists :
/*------------------------------------------------------------------------------
  Purpose:     
  Parameters:  <none>
  Notes:       
------------------------------------------------------------------------------*/

  DEFINE VAR thandle AS HANDLE     NO-UNDO.
  
  thandle = app_handle.
  
  DO WHILE VALID-HANDLE(thandle): 
   
    IF INDEX(thandle:FILE-NAME,"adecomm") = 0 AND
       INDEX(thandle:FILE-NAME,"protools") = 0 AND
       INDEX(thandle:FILE-NAME,"adeshar") = 0 THEN DO:
        CREATE pp.
        ASSIGN pp.pHANDLE   = thandle
               pp.cFileName = thandle:FILE-NAME
               fOK          = slct-objects:ADD-LAST(pp.cFileName) 
                              IN FRAME frm-break.
    END.
    ASSIGN thandle      = thandle:NEXT-SIBLING.         
  END.
  
  
END PROCEDURE.

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

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE LoadMethods Window-1 
PROCEDURE LoadMethods :
/*------------------------------------------------------------------------------
  Purpose:     
  Parameters:  <none>
  Notes:       
------------------------------------------------------------------------------*/
    
  DEFINE VAR icount AS INTEGER.
  DEFINE VAR numofmethods AS INTEGER.  
  DEFINE VAR lstatus AS LOGICAL.   
  DEFINE VAR pcmethods AS CHARACTER.

  FIND FIRST pp WHERE pp.cFileName = slct-objects:SCREEN-VALUE IN FRAME frm-break NO-ERROR.
    
  ASSIGN 
     numofmethods = NUM-ENTRIES(pp.phandle:INTERNAL-ENTRIES)
     pcmethods = pp.phandle:INTERNAL-ENTRIES.

  slct-methods:LIST-ITEMS IN FRAME frm-break = "".
    
  DO icount=1 TO numofmethods:
    CREATE adm-methods-bf.
    adm-methods-bf.slctmethod = ENTRY(icount, pcmethods).
  END.
  
  FOR EACH adm-methods-bf:
    lstatus = slct-methods:ADD-LAST(adm-methods-bf.slctmethod) IN FRAME frm-break.
  END.

  FOR EACH adm-methods-bf:
    DELETE adm-methods-bf NO-ERROR.
  END.
  
END PROCEDURE.

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

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE Move_To_Top Window-1 
PROCEDURE Move_To_Top :
/*------------------------------------------------------------------------------
  Purpose:     
  Parameters:  <none>
  Notes:       
------------------------------------------------------------------------------*/
  DEFINE INPUT PARAMETER p_Flags AS CHARACTER NO-UNDO.
  
  ASSIGN fOK = {&window-name}:MOVE-TO-TOP().
  ASSIGN {&window-name}:WINDOW-STATE = WINDOW-NORMAL.
  
  IF CAN-DO(p_Flags, "_ENTRY":U) THEN
    APPLY "ENTRY":U TO btn-help IN FRAME {&FRAME-NAME}.

END PROCEDURE.

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

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE Reset_Lists Window-1 
PROCEDURE Reset_Lists :
/*------------------------------------------------------------------------------
  Purpose:     
  Parameters:  <none>
  Notes:       
------------------------------------------------------------------------------*/

  DO WITH FRAME {&FRAME-NAME}:  
    FOR EACH pgm-bf:
      DELETE pgm-bf NO-ERROR.
    END.
    
    FOR EACH pp:
      DELETE pp NO-ERROR.
    END.
      
    FOR EACH def-bf:
      DELETE def-bf NO-ERROR.
    END.
      
    FOR EACH adm-methods-bf:
      DELETE adm-methods-bf NO-ERROR.
    END.

    ASSIGN slct-objects:LIST-ITEMS = ""
           slct-methods:LIST-ITEMS = ""
           bf-defined:LIST-ITEMS   = ""
           btn-rmv:SENSITIVE = NO
           btn-add:SENSITIVE = NO.
           
    DISPLAY {&DISPLAYED-OBJECTS} WITH FRAME {&FRAME-NAME} NO-ERROR.

    ASSIGN h_app = ?.
           
  END.

END PROCEDURE.

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

&ANALYZE-SUSPEND _VERSION-NUMBER UIB_v8r12 GUI
&ANALYZE-RESUME
&Scoped-define WINDOW-NAME w_Color
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _DEFINITIONS w_Color 
/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/
/*-----------------------------------------------------------------------------

  File: _colorch.w

  Description: change colors 0 to 15

  Input Parameters:
      <none>

  Output Parameters:
      <none>

  Author: Gerry Seidl

  Created: 04/16/93 - 10:22 am
  Updated: 2/9/94 - Updated syntax to current version (7.2A)
  Updated: 9/12/94- Updated to Run Persistent

------------------------------------------------------------------------*/
/*          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  ************************** */
{ protools/ptlshlp.i } /* help definitions */
{ adecomm/_adetool.i }
{ protools/_runonce.i}

/* Parameters Definitions ---                                                */

/* Local Variable Definitions ---                                            */

/* _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 FRAME-A

/* Standard List Definitions                                            */
&Scoped-Define ENABLED-OBJECTS RECT-4 Cancel-But OK-But Color-0 Color-1 ~
Color-2 Color-3 Color-4 Color-5 Color-6 Color-7 Revert-But Color-8 Color-9 ~
Color-10 Color-11 Color-12 Color-13 Color-14 Color-15 b_Help 

/* 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_Color AS WIDGET-HANDLE NO-UNDO.

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

DEFINE BUTTON Cancel-But AUTO-END-KEY 
     LABEL "&Close":L 
     SIZE 15 BY 1.14.

DEFINE BUTTON OK-But 
     LABEL "&Save":L 
     SIZE 15 BY 1.14.

DEFINE BUTTON Revert-But 
     LABEL "&Revert":L 
     SIZE 15 BY 1.14.

DEFINE RECTANGLE Color-0
     EDGE-PIXELS 1 GRAPHIC-EDGE  
     SIZE 7 BY 1.14
     BGCOLOR 0 .

DEFINE RECTANGLE Color-1
     EDGE-PIXELS 1 GRAPHIC-EDGE  
     SIZE 7.2 BY 1.14
     BGCOLOR 1 .

DEFINE RECTANGLE Color-10
     EDGE-PIXELS 1 GRAPHIC-EDGE  
     SIZE 7.2 BY 1.14
     BGCOLOR 10 .

DEFINE RECTANGLE Color-11
     EDGE-PIXELS 1 GRAPHIC-EDGE  
     SIZE 7.2 BY 1.14
     BGCOLOR 11 .

DEFINE RECTANGLE Color-12
     EDGE-PIXELS 1 GRAPHIC-EDGE  
     SIZE 7.2 BY 1.14
     BGCOLOR 12 .

DEFINE RECTANGLE Color-13
     EDGE-PIXELS 1 GRAPHIC-EDGE  
     SIZE 7.2 BY 1.14
     BGCOLOR 13 .

DEFINE RECTANGLE Color-14
     EDGE-PIXELS 1 GRAPHIC-EDGE  
     SIZE 7.2 BY 1.14
     BGCOLOR 14 .

DEFINE RECTANGLE Color-15
     EDGE-PIXELS 1 GRAPHIC-EDGE  
     SIZE 7.2 BY 1.14
     BGCOLOR 15 .

DEFINE RECTANGLE Color-2
     EDGE-PIXELS 1 GRAPHIC-EDGE  
     SIZE 7.2 BY 1.14
     BGCOLOR 2 .

DEFINE RECTANGLE Color-3
     EDGE-PIXELS 1 GRAPHIC-EDGE  
     SIZE 7.2 BY 1.14
     BGCOLOR 3 .

DEFINE RECTANGLE Color-4
     EDGE-PIXELS 1 GRAPHIC-EDGE  
     SIZE 7.2 BY 1.14
     BGCOLOR 4 .

DEFINE RECTANGLE Color-5
     EDGE-PIXELS 1 GRAPHIC-EDGE  
     SIZE 7.2 BY 1.14
     BGCOLOR 5 .

DEFINE RECTANGLE Color-6
     EDGE-PIXELS 1 GRAPHIC-EDGE  
     SIZE 7.2 BY 1.14
     BGCOLOR 6 .

DEFINE RECTANGLE Color-7
     EDGE-PIXELS 1 GRAPHIC-EDGE  
     SIZE 7.2 BY 1.14
     BGCOLOR 7 .

DEFINE RECTANGLE Color-8
     EDGE-PIXELS 1 GRAPHIC-EDGE  
     SIZE 7.2 BY 1.14
     BGCOLOR 8 .

DEFINE RECTANGLE Color-9
     EDGE-PIXELS 1 GRAPHIC-EDGE  
     SIZE 7.2 BY 1.14
     BGCOLOR 9 .

DEFINE RECTANGLE RECT-4
     EDGE-PIXELS 2 GRAPHIC-EDGE  NO-FILL 
     SIZE 75 BY 5.62.


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

DEFINE FRAME FRAME-A
     Cancel-But AT ROW 1.29 COL 79
     OK-But AT ROW 2.76 COL 79
     Revert-But AT ROW 4.29 COL 79
     b_Help AT ROW 5.76 COL 79
     " Colors" VIEW-AS TEXT
          SIZE 8 BY .62 AT ROW 1 COL 4
     RECT-4 AT ROW 1.29 COL 3
     "Color 0" VIEW-AS TEXT
          SIZE 8 BY .62 AT ROW 1.81 COL 5
     "Color 1" VIEW-AS TEXT
          SIZE 6.6 BY .62 AT ROW 1.81 COL 14
     "Color 2" VIEW-AS TEXT
          SIZE 7 BY .62 AT ROW 1.81 COL 23
     "Color 3" VIEW-AS TEXT
          SIZE 8 BY .62 AT ROW 1.81 COL 32
     "Color 4" VIEW-AS TEXT
          SIZE 8 BY .62 AT ROW 1.81 COL 41
     "Color 5" VIEW-AS TEXT
          SIZE 8 BY .62 AT ROW 1.81 COL 50
     "Color 6" VIEW-AS TEXT
          SIZE 8 BY .62 AT ROW 1.81 COL 59
     "Color 7" VIEW-AS TEXT
          SIZE 8 BY .62 AT ROW 1.81 COL 68
     Color-0 AT ROW 2.81 COL 5
     Color-1 AT ROW 2.81 COL 14
     Color-2 AT ROW 2.81 COL 23
     Color-3 AT ROW 2.81 COL 32
     Color-4 AT ROW 2.81 COL 41
     Color-5 AT ROW 2.81 COL 50
     Color-6 AT ROW 2.81 COL 59
     Color-7 AT ROW 2.81 COL 68
     "Color 8" VIEW-AS TEXT
          SIZE 8 BY .62 AT ROW 4.24 COL 5
     "Color 9" VIEW-AS TEXT
          SIZE 8 BY .62 AT ROW 4.24 COL 14
     "Color 10" VIEW-AS TEXT
          SIZE 9 BY .62 AT ROW 4.24 COL 23
     "Color 11" VIEW-AS TEXT
          SIZE 7.6 BY .62 AT ROW 4.24 COL 32
     "Color 12" VIEW-AS TEXT
          SIZE 9 BY .62 AT ROW 4.24 COL 41
     "Color 13" VIEW-AS TEXT
          SIZE 9 BY .62 AT ROW 4.24 COL 50
     "Color 14" VIEW-AS TEXT
          SIZE 8 BY .62 AT ROW 4.24 COL 59
     "Color 15" VIEW-AS TEXT
          SIZE 9 BY .62 AT ROW 4.24 COL 68
     Color-8 AT ROW 5.24 COL 5
     Color-9 AT ROW 5.24 COL 14
     Color-10 AT ROW 5.24 COL 23
     Color-11 AT ROW 5.24 COL 32
     Color-12 AT ROW 5.24 COL 41
     Color-13 AT ROW 5.24 COL 50
     Color-14 AT ROW 5.24 COL 59
     Color-15 AT ROW 5.24 COL 68
    WITH 1 DOWN NO-BOX OVERLAY 
         SIDE-LABELS NO-UNDERLINE THREE-D 
         AT COL 1 ROW 1
         SIZE 95.14 BY 6.5.


/* *********************** 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 w_Color ASSIGN
         HIDDEN             = YES
         TITLE              = "Color Changer"
         HEIGHT             = 6.62
         WIDTH              = 95.6
         MAX-HEIGHT         = 6.62
         MAX-WIDTH          = 95.6
         VIRTUAL-HEIGHT     = 6.62
         VIRTUAL-WIDTH      = 95.6
         MAX-BUTTON         = no
         RESIZE             = no
         SCROLL-BARS        = no
         STATUS-AREA        = no
         BGCOLOR            = ?
         FGCOLOR            = ?
         THREE-D            = yes
         MESSAGE-AREA       = no
         SENSITIVE          = yes.
ELSE {&WINDOW-NAME} = CURRENT-WINDOW.

IF NOT w_Color:LOAD-ICON("adeicon/clrchnge":U) THEN
    MESSAGE "Unable to load icon: adeicon/clrchnge"
            VIEW-AS ALERT-BOX WARNING BUTTONS OK.
/* END WINDOW DEFINITION                                                */
&ANALYZE-RESUME



/* ***************  Runtime Attributes and UIB Settings  ************** */

&ANALYZE-SUSPEND _RUN-TIME-ATTRIBUTES
/* SETTINGS FOR WINDOW w_Color
  VISIBLE,,RUN-PERSISTENT                                               */
/* SETTINGS FOR FRAME FRAME-A
                                                                        */
IF SESSION:DISPLAY-TYPE = "GUI":U AND VALID-HANDLE(w_Color)
THEN w_Color:HIDDEN = no.

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

 



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

&Scoped-define SELF-NAME b_Help
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL b_Help w_Color
ON CHOOSE OF b_Help IN FRAME FRAME-A /* Help */
DO:
  RUN adecomm/_adehelp.p ( "ptls", "CONTEXT", {&Color_Changer}, ? ).  
END.

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


&Scoped-define SELF-NAME Cancel-But
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL Cancel-But w_Color
ON CHOOSE OF Cancel-But IN FRAME FRAME-A /* Close */
DO:  /* for BUTTON "Cancel"  */
  apply "window-close" to {&window-name}.
END.

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


&Scoped-define SELF-NAME Color-0
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL Color-0 w_Color
ON MOUSE-SELECT-CLICK OF Color-0 IN FRAME FRAME-A
, color-1, color-2, color-3, color-4, color-5, color-6, color-7, color-8
, color-9, color-10, color-11, color-12, color-13, color-14, color-15
DO:  /* for RECTANGLE */
  run setcolor(self:bgcolor).
END.

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


&Scoped-define SELF-NAME OK-But
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL OK-But w_Color
ON CHOOSE OF OK-But IN FRAME FRAME-A /* Save */
DO:  /* for BUTTON "Save"  */
  PUT-KEY-VALUE color all NO-ERROR.
  IF ERROR-STATUS:ERROR THEN RUN adeshar/_puterr.p ("Colors", CURRENT-WINDOW).
END.

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


&Scoped-define SELF-NAME Revert-But
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL Revert-But w_Color
ON CHOOSE OF Revert-But IN FRAME FRAME-A /* Revert */
DO:  /* for BUTTON "Revert"  */
  def var ok as log.
  def var cno as int.
  def var cinfo as char.
  repeat cno = 0 to 15:
      get-key-value section "colors" key "color" + string(cno) value cinfo.
      ok = color-table:set-red-value(cno, int(entry(1,cinfo))).
      ok = color-table:set-green-value(cno, int(entry(2,cinfo))).
      ok = color-table:set-blue-value(cno, int(entry(3,cinfo))).
  end.
END.

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


&UNDEFINE SELF-NAME

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


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

/* 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:
  RUN enable_UI.
  RUN SetDynamic.
  STATUS INPUT "Click on the color you wish you change".
  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 disable_UI w_Color _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_Color)
  THEN DELETE WIDGET w_Color.
  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_Color _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 RECT-4 Cancel-But OK-But Color-0 Color-1 Color-2 Color-3 Color-4 
         Color-5 Color-6 Color-7 Revert-But Color-8 Color-9 Color-10 Color-11 
         Color-12 Color-13 Color-14 Color-15 b_Help 
      WITH FRAME FRAME-A IN WINDOW w_Color.
  {&OPEN-BROWSERS-IN-QUERY-FRAME-A}
  VIEW w_Color.
END PROCEDURE.

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

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE setcolor w_Color 
PROCEDURE setcolor :
/* -----------------------------------------------------------
  Purpose:     
  Run Syntax:  RUN setcolor (cno).
  Parameters:  <none>
  Notes:       
-------------------------------------------------------------*/
  DEFINE INPUT PARAMETER cno AS INTEGER NO-UNDO.
  SYSTEM-DIALOG COLOR cno.
END PROCEDURE.

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

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE setdynamic w_Color 
PROCEDURE setdynamic :
/* -----------------------------------------------------------
  Purpose:     
  Run Syntax:  RUN <procedure> (INPUT, OUTPUT).
  Parameters:  <none>
  Notes:       
-------------------------------------------------------------*/
  DEFINE VARIABLE cno AS INTEGER NO-UNDO.
  DEFINE VARIABLE ok  AS LOGICAL NO-UNDO.
  REPEAT cno = 0 TO 15:
     ok = COLOR-TABLE:SET-DYNAMIC(cno, yes).
  END.
END PROCEDURE.

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

&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        : protools\convt89.p
    Purpose     : To convert Version 8 SmartObjects to Version 9 SmartObjects

    Syntax      : RUN protools\convt89.p (INPUT input-file,
                                          INPUT output-file,
                                          OUTPUT num-changes).

    Description : This procedure attempts to Convert V8 SmartObject syntax
                  to V9 SmartObject syntax.  Unfortunately this task cannot
                  be fully automated.  Therefore we do the best we can and
                  attempt to flag as many problem spots as possible.  We
                  flag them in two ways:
                     1) A logfile is generated
                     2) &MESSAGE statements are positioned in the code
                        near the problem area.

    Author(s)   : Ross Hunte & John Sadd
    Created     : March 12, 1998
    Notes       :
    
    Modified    : 08/02/99  by tsm  Stop call to removePrefixes for controls
                                    this will prevent "broker-" from being removed
                                    from a trigger of a control that contains "broker-" 
               
  ------------------------------------------------------------------------*/
/*          This .W file was created with the Progress UIB.             */
/*----------------------------------------------------------------------*/

{adecomm/adefext.i}

/* ***************************  Definitions  ************************** */
DEFINE INPUT PARAMETER i-flnm     AS CHARACTER NO-UNDO.
DEFINE INPUT PARAMETER o-flnm     AS CHARACTER NO-UNDO.
DEFINE OUTPUT PARAMETER changes   AS INTEGER   NO-UNDO.

DEFINE SHARED TEMP-TABLE name-switch
  FIELD forget   AS LOGICAL
  FIELD seq      AS INTEGER
  FIELD old-name AS CHARACTER
  FIELD new-name AS CHARACTER
  INDEX forget-seq IS PRIMARY UNIQUE forget seq.

DEFINE SHARED TEMP-TABLE method
  FIELD v8method AS CHARACTER
  FIELD v9method AS CHARACTER
  FIELD mType    AS CHARACTER
  FIELD params   AS CHARACTER
  INDEX v8method IS PRIMARY UNIQUE v8method.
  
DEFINE SHARED TEMP-TABLE prprty
  FIELD v8prop   AS CHARACTER
  FIELD v9prop   AS CHARACTER
  INDEX v8prop IS PRIMARY UNIQUE v8prop.

DEFINE TEMP-TABLE substitute  NO-UNDO
  FIELD seq        AS INTEGER
  FIELD fld        AS CHARACTER
  FIELD qualifiers AS CHARACTER
  INDEX seq IS PRIMARY UNIQUE seq
  INDEX q-f qualifiers fld.

DEFINE VARIABLE browseTrigs    AS LOGICAL   NO-UNDO.  /* In browse trigger section */
DEFINE VARIABLE cIncLib        AS CHARACTER NO-UNDO.  /* Include libraries code    */
DEFINE VARIABLE cLine          AS CHARACTER NO-UNDO.  /* One line of code.         */
DEFINE VARIABLE cSubLine       AS CHARACTER NO-UNDO.
DEFINE VARIABLE cAction        AS CHARACTER NO-UNDO.  /* Action to perform         */
DEFINE VARIABLE cState         AS CHARACTER NO-UNDO.  /* Current parsing state.    */
DEFINE VARIABLE com-bgns       AS INTEGER   NO-UNDO.  /* The begining of a comment */
DEFINE VARIABLE com-ends       AS INTEGER   NO-UNDO.  /* The ending of a comment   */
DEFINE VARIABLE cProcName      AS CHARACTER NO-UNDO.
DEFINE VARIABLE cName          AS CHARACTER NO-UNDO.
DEFINE VARIABLE cAttrName      AS CHARACTER NO-UNDO.
DEFINE VARIABLE cValue         AS CHARACTER NO-UNDO.
DEFINE VARIABLE cCustomPrefix  AS CHARACTER NO-UNDO.  /* User-defined              */
DEFINE VARIABLE lReturn        AS LOGICAL   NO-UNDO.  /* Convert RETURN-VALUE      */
DEFINE VARIABLE cQuoteMark     AS CHARACTER NO-UNDO.
DEFINE VARIABLE cInHdl         AS CHARACTER NO-UNDO.
DEFINE VARIABLE iIndex         AS INTEGER   NO-UNDO.
DEFINE VARIABLE iIndex2        AS INTEGER   NO-UNDO.
DEFINE VARIABLE iName          AS INTEGER   NO-UNDO.
DEFINE VARIABLE inProcSettings AS LOGICAL   NO-UNDO.
DEFINE VARIABLE stmnt-end      AS INTEGER   NO-UNDO.  /* The end of a statement   */
DEFINE VARIABLE browseName     AS CHARACTER NO-UNDO.  /* The name of the browser  */
DEFINE VARIABLE templateType   AS CHARACTER NO-UNDO.  /* Type of template         */
DEFINE VARIABLE nTokens        AS INTEGER   NO-UNDO.  /* Number of tokens         */
DEFINE VARIABLE nTokens2       AS INTEGER   NO-UNDO.
DEFINE VARIABLE i              AS INTEGER   NO-UNDO.  /* A loop counter           */
DEFINE VARIABLE asnList        AS CHARACTER NO-UNDO.  /* List variable assignmnts */
DEFINE VARIABLE blockType      AS CHARACTER NO-UNDO.  /* Typu eof UIB block       */
DEFINE VARIABLE fldList        AS CHARACTER NO-UNDO.  /* List of fields in query  */
DEFINE VARIABLE fListByTbl     AS CHARACTER NO-UNDO.  /* Like fldList but by tbl  */
DEFINE VARIABLE fldRebuild     AS CHARACTER NO-UNDO.  /* Field rebuild info       */
DEFINE VARIABLE tblList        AS CHARACTER NO-UNDO.  /* List of tables in query  */
DEFINE VARIABLE includeFile    AS CHARACTER NO-UNDO.  /* Name of SDO include file */
DEFINE VARIABLE save-line      AS CHARACTER NO-UNDO.  /* Saveline for later outpt */
DEFINE VARIABLE tmpLine        AS CHARACTER NO-UNDO.  /* Temporary Line           */
DEFINE VARIABLE tmpParam       AS CHARACTER NO-UNDO.  /* A parameter info entry   */
DEFINE VARIABLE numbers        AS CHARACTER NO-UNDO  INITIAL
     "SPC,SPC,FIRST,SECOND,THIRD,FOURTH,FIFTH,SIXTH,SEVENTH,EIGHTH,NINTH,TENTH":U.
DEFINE VARIABLE window-name    AS CHARACTER NO-UNDO.  /* Window name for headers  */
DEFINE VARIABLE xTableList     AS CHARACTER NO-UNDO.  /* List of external tables  */
DEFINE VARIABLE tkns           AS CHARACTER EXTENT 5 NO-UNDO.  /*cLine Tokens     */
DEFINE VARIABLE lCont          AS LOGICAL   NO-UNDO.
DEFINE VARIABLE iInd           AS INTEGER   NO-UNDO.
 
DEFINE VARIABLE cStateVals    AS CHARACTER NO-UNDO INIT      /* state messages */
   "record-available,no-record-available,no-external-record-available,~
update-begin,update,update-complete,delete-complete,~
first-record,last-record,only-record,not-first-or-last".
DEFINE VARIABLE cStateProps   AS CHARACTER NO-UNDO INIT /* matching new properties */
   "Record,Record,Record,~
Update,Update,Update,Update,~
Position,Position,Position,Position".

/* _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-convertLinkFunctions) = 0 &THEN

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION-FORWARD convertLinkFunctions Procedure 
FUNCTION convertLinkFunctions RETURNS LOGICAL FORWARD.

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

&ENDIF

&IF DEFINED(EXCLUDE-determineAction) = 0 &THEN

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION-FORWARD determineAction Procedure 
FUNCTION determineAction RETURNS CHARACTER
  ( /* parameter-definitions */ )  FORWARD.

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

&ENDIF

&IF DEFINED(EXCLUDE-fetchToken) = 0 &THEN

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION-FORWARD fetchToken Procedure 
FUNCTION fetchToken RETURNS CHARACTER
  (pcString AS CHARACTER, piToken AS INTEGER)  FORWARD.

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

&ENDIF

&IF DEFINED(EXCLUDE-ProcessV8Run) = 0 &THEN

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION-FORWARD ProcessV8Run Procedure 
FUNCTION ProcessV8Run RETURNS LOGICAL FORWARD.

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

&ENDIF

&IF DEFINED(EXCLUDE-removePrefixes) = 0 &THEN

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION-FORWARD removePrefixes Procedure 
FUNCTION removePrefixes RETURNS CHARACTER
  (pcLine AS CHARACTER)  FORWARD.

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

&ENDIF

&IF DEFINED(EXCLUDE-replaceOne) = 0 &THEN

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION-FORWARD replaceOne Procedure 
FUNCTION replaceOne RETURNS CHARACTER
  ( /* parameter-definitions */
     pcLine AS CHARACTER,  
     pqualifiers AS CHARACTER)  FORWARD.

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

&ENDIF

&IF DEFINED(EXCLUDE-replaceQualifiers) = 0 &THEN

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION-FORWARD replaceQualifiers Procedure 
FUNCTION replaceQualifiers RETURNS CHARACTER
  ( /* parameter-definitions */
     pcLine AS CHARACTER,  
     pqualifiers AS CHARACTER)  FORWARD.

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

&ENDIF

&IF DEFINED(EXCLUDE-userProcName) = 0 &THEN

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION-FORWARD userProcName Procedure 
FUNCTION userProcName RETURNS LOGICAL
  ( /* parameter-definitions */
     cInLine AS CHARACTER,
     iInd AS INTEGER, 
     cv8Method 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             = 15
         WIDTH              = 60.
/* END WINDOW DEFINITION */
                                                                        */
&ANALYZE-RESUME

 


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


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


ASSIGN changes = 0
       cIncLib = "".

RUN prelim-scan.   /* Prelinary scan to pick up method library section */

INPUT  FROM VALUE(i-flnm).
OUTPUT TO   VALUE(o-flnm).

readLine:
REPEAT:
  IMPORT UNFORMATTED cLine.

  /* Check for empty lines. */
  IF LENGTH(cLine) = 0 THEN DO:
    PUT UNFORMATTED CHR(10).
    NEXT readLine.
  END.
  
  /* Define the actions to perform on this line. */

  /* Look for a procedure header. Remove adm- or local- prefix
     from preprocessor lines and from the procedure name itself. 
     First check for the EXCLUDE preprocessor line.
     Also check for the ANALYZE-SUSPEND line. */
  cAction = determineAction().

  CASE cAction:

    WHEN "Prefixes" THEN DO:
      IF fetchToken(cLine,4) NE "adm-create-objects" AND
         fetchToken(cLine,3) NE "_CONTROL" THEN removePrefixes(cLine).
      ASSIGN cProcName = TRIM(fetchToken(cLine,4), "~"")
             blockType = fetchToken(cLine,3).
      /* See if we can get the window name here */
      IF cProcName = "_DEFINITIONS" AND blockType = "_CUSTOM" THEN
        window-name = fetchToken(cLine, 5).
      /* See if we need to supress this section */
      ELSE IF CAN-FIND(FIRST name-switch WHERE name-switch.forget AND
                             name-switch.old-name = cProcName AND
                             name-switch.new-name = "Procedure") THEN DO:
        RUN remove-block.  /* Removes all code through the next &ANALYZE-RESUME */
        NEXT readline.
      END.  /* If this procedure is to be removed */
      ELSE IF cProcName = browseName AND blockType = "_CONTROL" THEN DO:
        /* We are in the trigger section of a Smart Browse.  First create an
           OFF-END trigger, then fix up the ROW-ENTRY, ROW-LEAVE and
           VALUE-CHANGED triggers. */
        tmpLine = cLine.
        IMPORT UNFORMATTED cLine.
        IF LOOKUP(fetchToken(cLine, 2),"ROW-ENTRY,ROW-LEAVE,VALUE-CHANGED") > 0 THEN DO:
          IF NOT browseTrigs THEN DO:  /* Just entered the section */
            ASSIGN browseTrigs = TRUE
                   tkns[2]     = ENTRY(2, cLine, " ":U)
                   tkns[4]     = ENTRY(4, cLine, " ":U)
                   changes     = changes + 1.
            PUT UNFORMATTED tmpLine SKIP
                REPLACE(cLine,tkns[2],"CTRL-END":U) SKIP
                'DO:':U SKIP
                '  APPLY "END":U TO BROWSE ' + tkns[4] + '.' SKIP
                'END.' SKIP (1)
                '/* _UIB-CODE-BLOCK-END */' SKIP
                '~&ANALYZE-RESUME':U SKIP (2).
            PUT UNFORMATTED tmpLine SKIP
                REPLACE(cLine,tkns[2],"CTRL-HOME":U) SKIP
                'DO:':U SKIP
                '  APPLY "HOME":U TO BROWSE ' + tkns[4] + '.' SKIP
                'END.' SKIP (1)
                '/* _UIB-CODE-BLOCK-END */' SKIP
                '~&ANALYZE-RESUME':U SKIP (2).
            PUT UNFORMATTED tmpLine SKIP
                REPLACE(cLine,tkns[2],"END":U) SKIP
                'DO:':U SKIP
                '  ~{src/adm2/brsend.i}':U SKIP
                'END.':U SKIP (1)
                '/* _UIB-CODE-BLOCK-END */' SKIP
                '~&ANALYZE-RESUME':U SKIP (2).
            PUT UNFORMATTED tmpLine SKIP
                REPLACE(cLine,tkns[2],"HOME":U) SKIP
                'DO:':U SKIP 
                '  ~{src/adm2/brshome.i}':U SKIP
                'END.':U SKIP (1)
                '/* _UIB-CODE-BLOCK-END */' SKIP
                '~&ANALYZE-RESUME':U SKIP (2).
            PUT UNFORMATTED tmpLine SKIP
                REPLACE(cLine,tkns[2],"OFF-END":U) SKIP
                "DO:":U SKIP
                "  ~{src/adm2/brsoffnd.i}":U SKIP
                "END.":U SKIP (1)
                "/* _UIB-CODE-BLOCK-END */" SKIP
                "~&ANALYZE-RESUME":U SKIP (2).
            PUT UNFORMATTED tmpLine SKIP
                REPLACE(cLine,tkns[2],"OFF-HOME":U) SKIP
                "DO:":U SKIP
                "  ~{src/adm2/brsoffhm.i}":U SKIP
                "END.":U SKIP (1)
                "/* _UIB-CODE-BLOCK-END */" SKIP
                "~&ANALYZE-RESUME":U SKIP (2).
            PUT UNFORMATTED tmpLine SKIP
                REPLACE(cLine,tkns[2],"SCROLL-NOTIFY":U) SKIP
                "DO:":U SKIP
                "  ~{src/adm2/brsscrol.i}":U SKIP
                "END.":U SKIP (1)
                "/* _UIB-CODE-BLOCK-END */" SKIP
                "~&ANALYZE-RESUME":U SKIP (2).
         END. /* IF NOT browseTrigs */
        END. /* IF a ROW-ENTRY, ROW-LEAVE or VALUE-CHANGED trigger */
        PUT UNFORMATTED tmpLine SKIP.
      END.  /* If this is a trigger for the browse control */
      ELSE IF cProcName = "_MAIN-BLOCK":U AND blockType = "_CONTROL":U 
        THEN browseTrigs = FALSE.
      ELSE IF cProcName = "exit" AND blockType = "_PROCEDURE" THEN DO:
        RUN remove-block.
        RUN gen-exitObject.
        NEXT readline.
      END. /* If a local-exit procedure */
      ELSE IF blockType = "_PROCEDURE":U AND
           CAN-FIND(FIRST method WHERE method.v8method = cProcName) THEN DO:
        /* This is an override of an adm-method */
        FIND FIRST method WHERE method.v8method = cProcName.
        cLine = REPLACE(cLine, method.v8method, method.v9method).
        IF method.mType BEGINS "F" THEN cLine = REPLACE(cLine, "_PROCEDURE", "_FUNCTION").
        PUT UNFORMATTED cLine SKIP.
        PUT UNFORMATTED (IF method.mType = "P" THEN
          "PROCEDURE " + method.v9method + " :" ELSE
          "FUNCTION " + method.v9method + " RETURNS " +
              (IF method.mType = "FL" THEN "LOGICAL" ELSE "CHARACTER") +
              " ( ) :") SKIP.
        IF method.params NE " " THEN DO:
          DO i = 1 TO NUM-ENTRIES(method.params):
            tmpParam = ENTRY(i, method.params).
            PUT UNFORMATTED "  DEFINE " +
                (IF ENTRY(3, tmpParam, "|":U) = "I" THEN "INPUT"
                 ELSE IF ENTRY(3, tmpParam, "|":U) = "O" THEN "OUTPUT"
                 ELSE "INPUT-OUTPUT") + " PARAMETER " + ENTRY(1, tmpParam, "|":U) +
                 " AS " + ENTRY(2, tmpParam, "|":U) + " NO-UNDO." SKIP.
          END.  /* Do for each parameter */
        END. /* If there are parameters to define */
        /* Read in what should be the method definition line */
        IMPORT UNFORMATTED cLine. /* Swallow it */
        IMPORT UNFORMATTED cLine.
        changes = changes + 1.
      END.  /* When on a method header */
    END.  /* When Prefixes */

    WHEN "Scoped-Def" THEN DO:
      cName = fetchToken(cLine, 2).
      /* See if this is on the list to get rid of */
      IF cName BEGINS "FIELD-PAIRS" THEN DO:
        changes = changes + 1.
        DO WHILE (R-INDEX(cLine,"~~") = LENGTH(cLine)):
          IMPORT UNFORMATTED cLine.
        END.
        NEXT readline.
      END.
      ELSE IF CAN-FIND(FIRST name-switch WHERE name-switch.forget AND
                                          name-switch.old-name = cName)
        THEN NEXT readline.
      ELSE IF cName = "ADM-SUPPORTED-LINKS" THEN DO:
        PUT UNFORMATTED "&Scoped-define DB-AWARE " +
                        IF templateType eq "QUERY.W" THEN "yes" ELSE "no" SKIP.
        ASSIGN cLine = REPLACE(cLine,"Record-Source",
                 IF templateType eq "BROWSER.W" THEN "Update-Source"
                                                 ELSE "Data-Source")
               cLine = REPLACE(cLine,"Record-Target", "Data-Target").
        IF templateType eq "QUERY.W" THEN
          ASSIGN cLine = TRIM(cLine) + ",Update-Target,Commit-Target,Commit-Source" + 
                         CHR(10) + CHR(10) + CHR(10) +
                         "/* Db-Required definitions. */" + CHR(10) +
                         "~&IF DEFINED(DB-REQUIRED) = 0 ~&THEN" + CHR(10) +
                         "    ~&GLOBAL-DEFINE DB-REQUIRED TRUE" + CHR(10) +
                         "~&ENDIF" + CHR(10) +
                         "~&GLOBAL-DEFINE DB-REQUIRED-START   ~&IF ~{~&DB-REQUIRED} " +
                         "~&THEN" + CHR(10) +
                         "~&GLOBAL-DEFINE DB-REQUIRED-END     ~&ENDIF" + CHR(10).

        IF templateType eq "VIEWER.W" THEN
          ASSIGN cLine = TRIM(REPLACE(cLine,"Data-Source,","")) +
                            ",Group-Assign-Source,Group-Assign-Target,Update-Source".
      END.  /* If ADM-SUPPORTED-LINKS */
      ELSE IF cName BEGINS "TABLES-IN-QUERY-" OR cName BEGINS "ENABLED-TABLES-IN-QUERY-" THEN DO:
        nTokens = NUM-ENTRIES(cLine, " ").
        IF templateType = "BROWSER.W" THEN DO:
          cLine = fetchToken(cLine, 1) + " ":U + fetchToken(cLine, 2) + " rowObject".
        END.  /* if browser */
        ELSE DO:
          IF templateType = "QUERY.W" THEN RUN gen-preprocs.
       
          IF nTokens > 3 THEN DO:  /* If there is more than 1 table */
            /* Note: v8 only outputted FIRST table, v9 Needs to output upto ten.  */
            /* If there is only one table, it will be taken care of in the normal */
            /* readline loop.  If there are more, things need to be handled       */
            /* differently.                                                       */
          
            /* Write out cLine */
            PUT UNFORMATTED cLine SKIP.
            /* Read in what shoule be the first table line */
            IMPORT UNFORMATTED tmpLine.
            PUT UNFORMATTED tmpLine SKIP.
            cName = fetchToken(tmpLine, 2).
            /* Write out SECOND thorugh n table lines */
            DO i = 4 TO nTokens:
              IF i > 12 THEN NEXT readline.
              tmpLine = "&Scoped-define " + REPLACE(cName,"FIRST", ENTRY(i,numbers)) +
                           " " + fetchToken(cLine, i).
              PUT UNFORMATTED tmpLine SKIP.
           END. /* DO i = 3 TO nTokens */
           NEXT readline.
          END. /* If there is more than 1 table */
        END.  /* else do - not browser */
      END. /* If cName BEGINS "TABLES-IN-QUERY-" */
      ELSE IF templateType = "BROWSER.W" AND cName = "BROWSE-NAME"
        THEN browseName = fetchToken(cLine, 3).  /* we need this later */
      ELSE IF cName EQ "DISPLAYED-FIELDS" AND templateType = "VIEWER.W" THEN
        RUN collect-sdo-info.
      ELSE IF cName BEGINS "FIELDS-IN-QUERY" AND templateType = "BROWSER.W" THEN
        RUN collect-sdo-info.
      ELSE IF cName BEGINS "INTERNAL-TABLES" AND templateType = "BROWSER.W" THEN
        cLine = "~&Scoped-define INTERNAL-TABLES rowObject".
      ELSE IF INDEX(cLine,"External") > 0 AND INDEX(cLine,"Table") > 0 THEN DO:
        /* Here we always remove the line, but if it is the list of external
           table, save the list if we are working with a query.  We need the
           list to suppress "OF" clauses.                                    */
        IF templateType = "QUERY.W" OR templateType = "BROWSER.W" AND
          cName = "EXTERNAL-TABLES" THEN DO:
          nTokens = NUM-ENTRIES(cLine, " ").
          DO i = 3 TO nTokens:
            xTableList = xTableList + "," + fetchToken(cLine,i).
          END.  /* Do i = 3 TO nTokens */
          xTableList = LEFT-TRIM(xTableList, ",":U).
        END.  /* If processing a Query and have the External-Tables definition */
        NEXT readline.  /* Remove all Scoped-defines dealing with external tables */
      END. /* If working on something about external tables */
      ELSE IF cName BEGINS "OPEN-QUERY-" AND templateType = "QUERY.W" THEN DO:
        nTokens = NUM-ENTRIES(xTableList).
        IF nTokens > 0 THEN DO:
          DO i = 1 TO nTokens:
            cLine = replace(cLine, "OF " + ENTRY(i, xTableList), "").
          END.  /* For each external table */
        END.  /* If there are any external tables */
        IF templateType = "QUERY.W" THEN DO:  /* Save cLine for later */
          /* In a SDO the OPEN-QUERY comes after DATA-FIELD-DEFS (and
             DB-REQUIRED-START)  */
          save-line = cLine.
          IMPORT UNFORMATTED cLine. /* Read the sortby phrase */
          save-line = save-line + CHR(10) + cLine.
          IF cLine BEGINS "&Scoped-define TABLES-IN-QUERY-" THEN DO:
            nTokens = NUM-ENTRIES(cLine, " ").
            RUN gen-preprocs.
          END.
          NEXT readline.
        END.  /* If working on a SmartQuery */
      END.  /* If we have the OPEN-QUERY definition in a QUERY  */
      ELSE IF cName BEGINS "OPEN-QUERY-" AND templateType = "BROWSER.W" THEN DO:
        nTokens = NUM-ENTRIES(cLine, " ":U).
        DO i = 1 TO 5:
          tmpLine = tmpLine + fetchToken(cLine, i) + " ":U.
        END.  /* do i = 1 to 5 */
        cLine = tmpLine + "FOR EACH rowObject.":U.
        lCont = TRUE.
        DO WHILE lCont:
          IMPORT UNFORMATTED tmpLine.
          IF LEFT-TRIM(tmpLine) MATCHES '*SORTBY-PHRASE*':U THEN lCont = FALSE. 
        END.
      END.  /* If we have the OPEN-QUERY definition in a BROWSER */
      ELSE IF cName = "ADM-CONTAINER" THEN DO:
        /* Write out cLine */
        PUT UNFORMATTED cLine SKIP (1).
        cLine = "~&Scoped-Define ADM-SUPPORTED-LINKS Data-Target,Data-Source,Page-Target".
      END.  /* If we are processing a WINDOW or DIALOG-BOX */
    END.  /* When Scoped-define */

    WHEN "Procedure" THEN DO:
      cName = removePrefixes(cLine).
      /* Note: removePrefixes returns the prefix removed.
         If this is a local or possibly custom-prefix version of a 
         procedure, we need to hang onto the base procedure name so
         that if we encounter it within the body of the procedure we can 
         replace it with SUPER. */
      IF (cName = "local-") OR (cCustomPrefix NE "" AND cName = cCustomPrefix)
        THEN cProcName = fetchToken(cLine, 2).

      /* See if we should delete the entire procedure */
      IF CAN-FIND(first name-switch WHERE name-switch.forget AND
                                          name-switch.old-name = cName AND
                                          name-switch.new-name = "Procedure") THEN DO:
        /* Remove to past the next "&ANALYZE-RESUME" */
        changes = changes + 1.
        REPEAT WHILE cLine NE "&ANALYZE-RESUME":
          IMPORT UNFORMATTED cLine.
        END.
        /* Have found the &analyze-resume - NOW start again */
        NEXT readline.
      END.
    END. /* When "Procedure */

    WHEN "Dispatch" OR WHEN "Notify" OR WHEN "Get-Attribute" OR
    WHEN "Set-Attribute" OR WHEN "New-State" THEN DO:
      /* This is to screen out cases where users have procedures that start
         with notify or dispatch, as in RUN notify-me-now. */
      ASSIGN i = IF cAction = "Notify" THEN INDEX(cLine, "notify") + 6
                 ELSE IF cAction = "Dispatch" THEN INDEX(cLine, "dispatch") + 8
                 ELSE -1.
      IF i > 0 THEN DO:
        ASSIGN tkns[1]  = SUBSTRING(cLine,i,1).
        IF tkns[1] NE " " AND tkns[1] NE "(" THEN
          ASSIGN cAction = "RUN"
                 lReturn = no. /* A normal run */
      END.
      IF cAction NE "RUN" THEN DO:  
        lReturn = processV8Run().
        IF NOT lReturn THEN NEXT readline.
      END.
    END.

    WHEN "Init-Object" THEN DO:
      lReturn = no.    /* Turn off RETURN-VALUE conversion with each new RUN stmt. */
      RUN convertInitObject.
    END.  /* WHEN Init-Object */

    WHEN "Get-Link-Handle" OR WHEN "Set-Link-Attribute" OR WHEN "Request-Attribute"
    THEN DO:
      convertLinkFunctions().
    END.

    WHEN "Run" THEN DO:
      lReturn = no.       /* Turn off RETURN-VALUE conversion with each new RUN stmt. */
      /* If it is a method, replace the name */
      FOR EACH method:
        iInd = INDEX(cLine,method.v8method).
        IF iInd > 0 AND NOT userProcName(cLine,iInd,method.v8method) THEN DO:
          IF method.mType = "FL" THEN
            ASSIGN cLine = REPLACE(cLine, "RUN ":U, "":U)
                   cLine = REPLACE(cLine, method.v8Method, method.v9method + "()":U).
          ELSE
            ASSIGN cLine = REPLACE(cLine,method.v8method, method.v9method).
          changes = changes + 1.
        END.
      END.
    END.

    WHEN "EndProc" THEN DO:
      ASSIGN cProcName      = ""                            /* reset at procedure end */
             lReturn        = no
             inProcSettings = no.
    END. /* WHEN "EndProc" */

    WHEN "Other" THEN DO:     /* In all other lines, convert RETURN-VALUE to attr name. */
      /* If we haven't yet established the templateType try here */
      cName = fetchToken(cLine,1).
      IF templateType = "" AND cName = "Description" THEN DO:
        cName = fetchToken(cLine, 4).
        IF LOOKUP(cName,"BROWSER.W,cntnrdlg.w,cntnrfrm.w,cntnrwin.w,QUERY.W,SMART.W,VIEWER.W")
           > 0 THEN templateType = cName.
      END.
      ELSE IF cName = "&ANALYZE-SUSPEND" AND fetchToken(cLine,2) = "_PROCEDURE-SETTINGS"
        THEN inProcSettings = TRUE.
      ELSE IF inProcSettings AND cName = "Allow" AND templateType = "QUERY.W"
        THEN ASSIGN cLine   = "   Allow: Query"
                    changes = changes + 1.
      ELSE IF inProcSettings AND cName = "Allow" AND templateType BEGINS "cntnr"
        THEN ASSIGN cLine = cLine + CHR(10) +
                            "   Container Links: Data-Target,Data-Source,Page-Target".
      ELSE IF inProcSettings AND cName = "Frames" AND templateType = "QUERY.W"
        THEN ASSIGN cLine   = "   Frames: 0"
                    changes = changes + 1.
      ELSE IF inProcSettings AND cName = "Add" AND
              LOOKUP(templateType,"QUERY.W,BROWSER.W") > 0 AND
              fetchToken(cLine,2) = "Fields"
        THEN ASSIGN cLine   = "   Add Fields to: Neither"
                    changes = changes + 1.
      ELSE IF inProcSettings AND cName = "OTHER" AND templateType = "QUERY.W"
        THEN ASSIGN cLine   = cLine + " DB-AWARE"
                    changes = changes + 1.
      ELSE IF browseTrigs AND LEFT-TRIM(cLine) BEGINS "~{src":U
        THEN ASSIGN cLine   = REPLACE(cLine, "adm/template", "adm2")
                    changes = changes + 1.
      ELSE IF cName = "_Design-Parent" AND templateType = "QUERY.W" THEN DO:
        PUT UNFORMATTED fldRebuild SKIP.
        changes = changes + 1.
      END.
      ELSE IF templateType NE "" AND
              fetchToken(cLine,3) = "Runtime":U AND
              fetchToken(cLine,4) = "Attributes":U AND
              fetchToken(cLine,7) = "Settings":U THEN RUN gen-include-lib.
      ELSE IF templateType = "QUERY.W" AND cName = "/*" THEN DO:
        ASSIGN tkns[2] = fetchToken(cLine,2)
               tkns[3] = fetchToken(cLine,3)
               tkns[4] = fetchToken(cLine,4).
        IF tkns[2] = "Custom":U AND
           tkns[3] = "List":U AND
           tkns[4] = "Definitions":U THEN DO:
          /* Insert a DB-REQUIRED-END */
          PUT UNFORMATTED "~{~&DB-REQUIRED-END}" SKIP (1).
        END.
        ELSE IF tkns[2] = "Query":U AND
                tkns[3] = "definitions":U THEN DO:
          /* Insert a DB-REQUIRED-START */
          PUT UNFORMATTED "~{~&DB-REQUIRED-START}" SKIP (1).          
        END.
        ELSE IF tkns[2] BEGINS "~*" AND
                tkns[3] = "Frame":U AND
                tkns[4] = "Definitions":U THEN DO:
          /* Insert a DB-REQUIRED-END */
          PUT UNFORMATTED "~{~&DB-REQUIRED-END}" SKIP (1).          
        END.
        ELSE cLine = REPLACE(REPLACE(cLine, "List-1", "ADM-CREATE-FIELDS"),
                             "List-6           ", "List-6").
      END.  /* If query.w and a comment */
      ELSE IF lReturn AND INDEX(cLine,'RETURN-VALUE') > 0 AND
           INDEX(cLine,'ADM-ERROR') = 0 THEN
        ASSIGN cLine   = REPLACE(cLine, 'RETURN-VALUE', cAttrName)
               changes = changes + 1.
      ELSE IF INDEX(cLine,"External") > 0 AND INDEX(cLine,"Table") > 0 THEN
        NEXT readline.
      ELSE IF cProcName NE "" AND cName = "END":U AND
           fetchToken(cLine, 2) = "PROCEDURE.":U THEN DO:
        FIND method WHERE method.v8method = cProcName NO-ERROR.
        IF AVAILABLE method AND method.mTYPE BEGINS "F" THEN
          cLine = "END.":U.
      END.
      
    END. /* WHEN "Other" */
    
  END CASE.
            
  /* Before writing the line, make the easy one-for-one substitutions */
  NAME-SWITCH-SCAN:
  FOR EACH name-switch:
    IF INDEX(cLine,old-name) > 0 THEN DO:
      IF NOT name-switch.forget THEN DO:
        IF old-name = "SET-SIZE" AND INDEX(cLine,old-name) < INDEX(cLine,"=":U) 
          THEN NEXT NAME-SWITCH-SCAN.
        ASSIGN changes = changes + 1
               cLine   = REPLACE(cLine, old-name, new-name).
        IF old-name = "Current-Page":U THEN
          cLine = REPLACE(cLine, "ADM-CurrentPage", "CurrentPage").
      END.
      ELSE DO: /* remove the whole line */
        IF old-name = "key-value" THEN DO:
          /* if its key-value, be carefull */
          IF INDEX(cLine, " key-value":U) > 0 THEN 
            cLine = "/* " + cLine + " */".
        END.
        ELSE cLine = "/* " + cLine + " */".
      END.  /* Else remove the line */
    END.  /* If the string exists */
  END. /* For each simple change */
        
  PUT UNFORMATTED cLine SKIP.
END.                            /* END of REPEAT: IMPORT loop */

INPUT CLOSE.
OUTPUT CLOSE.

/* If this is a SmartViewer or SmartDataBrowser - create the sdo type include file 
   and reopen the .w file making the proper changes                     */
IF LOOKUP(templateType, "VIEWER.W,BROWSER.W") > 0 THEN 
  RUN second-pass(o-flnm).

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


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

&IF DEFINED(EXCLUDE-appendLine) = 0 &THEN

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE appendLine Procedure 
PROCEDURE appendLine :
/*------------------------------------------------------------------------------
  Purpose:     This procedure appends the next line in the input file to the
               current line (cLine).
  Parameters:  <none>
  Notes:       
------------------------------------------------------------------------------*/
  DEFINE VARIABLE next-line AS CHARACTER                             NO-UNDO.
  
  IMPORT UNFORMATTED next-line.
  cLine = cLine + " " + TRIM(next-Line).
END PROCEDURE.  /* Procedure appendLine */

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

&ENDIF

&IF DEFINED(EXCLUDE-collect-sdo-info) = 0 &THEN

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE collect-sdo-info Procedure 
PROCEDURE collect-sdo-info :
/*------------------------------------------------------------------------------
  Purpose:     In processing a SmartViewer, it is necessary to build an include
               file for the RowObject temptable defininition.  Also all table
               references need to be switched to "RowObject". This procedure
               processes the DISPLAYED-FIELDS preprocess to make a first guess
               at what the RowObject include file should look like.  A second
               pass through the SmartViewer is where we make the necessary 
               corrections to the source code.
               
  Parameters:  <none>
  Notes:       
------------------------------------------------------------------------------*/
DEFINE VARIABLE field-list AS CHARACTER                                 NO-UNDO.
DEFINE VARIABLE fld        AS CHARACTER                                 NO-UNDO.
DEFINE VARIABLE i          AS INTEGER                                   NO-UNDO.
DEFINE VARIABLE n          AS INTEGER                                   NO-UNDO.
DEFINE VARIABLE n-entries  AS INTEGER                                   NO-UNDO.

/* Build comma delimited list of displayed fields */
PROCESS-FIELDS:
REPEAT:
  n = NUM-ENTRIES(TRIM(cLine)," ").
  DO i = 1 TO n:
    fld = ENTRY(i,cLine," ").
    IF fld NE "&Scoped-Define" AND fld NE "DISPLAYED-FIELDS" AND
       fld NE "~~" THEN
      field-list = field-list + "," + ENTRY(i,cLine," ").
    IF i = n THEN DO:
      IF fld EQ "~~" THEN DO:
        PUT UNFORMATTED cLine SKIP.
        IMPORT UNFORMATTED cLine.
        NEXT PROCESS-FIELDS.
      END.  /* If line ends with tilda */
      ELSE LEAVE PROCESS-FIELDS. 
    END.  /* If at the end of the line and there is a continuation */
  END.  /* Do i = 1 to n */
END.  /* Do while field-list ends in a comma */

ASSIGN field-list = TRIM(field-list,"~,")
       n-entries  = NUM-ENTRIES(field-list).
DO i = 1 TO n-entries:  /* For each displayed field */
  ASSIGN fld = ENTRY(i, field-list)
         /* Is this field qualified with db or table ? */
          n  = NUM-ENTRIES(fld,".").
  IF n > 1 THEN DO:
    CREATE substitute.
    ASSIGN substitute.seq        = i
           substitute.fld        = ENTRY(n,fld,".")
           substitute.qualifiers = SUBSTR(fld,1,R-INDEX(fld,".") - 1).
  END. /* Field is qualified with something */
END.

END PROCEDURE.

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

&ENDIF

&IF DEFINED(EXCLUDE-convertInitObject) = 0 &THEN

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE convertInitObject Procedure 
PROCEDURE convertInitObject :
/*------------------------------------------------------------------------------
  Purpose:     To convert Init-Object to ConstructObject.  The main focus is
               to get the attribute list in the 4th line correct.
  Parameters:  <none>
  Notes:       
------------------------------------------------------------------------------*/
  DEFINE VARIABLE endOfString AS INTEGER                              NO-UNDO.

  PUT UNFORMATTED "       RUN constructObject (" SKIP.
  IMPORT UNFORMATTED cLine.
  IF INDEX(cLine,"adm/objects") > 0 THEN DO:
    ASSIGN cLine = REPLACE(cLine, "adm/objects":U, "adm2":U)
           cLine = REPLACE(cLine, "p-navico", "pnavico")
           cLine = REPLACE(cLine, "p-navlbl", "pnavlbl")
           cLine = REPLACE(cLine, "p-updsav", "pupdsav").
  END.
  PUT UNFORMATTED cLine SKIP.
  IMPORT UNFORMATTED cLine.
  PUT UNFORMATTED cLine SKIP.
  IMPORT UNFORMATTED cLine.
  cName = fetchToken(cLine,1).
  IF INDEX(cLine,"FOLDER-LABELS") = 0 THEN DO:
    SCAN-INSTANCE-ATTRIBUTES:
    REPEAT WHILE cName ne "OUTPUT":
      ASSIGN cLine = REPLACE(cLine," = ":U, CHR(4))
             cLine = REPLACE(cLine,",":U, CHR(3))
             cLine = REPLACE(cLine,"Layout","ObjectLayout")
             cLine = REPLACE(cLine,"Edge-Pixels","EdgePixels")
             cLine = REPLACE(cLine,"SmartPanelType","PanelType")
             cLine = REPLACE(cLine,"Right-to-Left","RightToLeft")
             tmpLine = IF cName ne "INPUT" THEN tmpLine + TRIM(cLine)
                       ELSE cLine.

      IMPORT UNFORMATTED cLine.
      cName = fetchToken(cLine,1).
    END. /* Repeat */
    ASSIGN tmpLine = tmpLine + ","
           tmpLine = REPLACE(tmpLine,CHR(3) + ",", ",").
  END.  /* If not converting a folder */
  ELSE DO:  /* Here we do convert a folder */
    REPEAT WHILE cName ne "OUTPUT":
      ASSIGN cLine = REPLACE(cLine," = ":U, CHR(4))
             cLine = REPLACE(cLine,",":U, CHR(3))
             cLine = REPLACE(cLine,"FOLDER-LABELS","FolderLabels")
             cLine = REPLACE(cLine,"FOLDER-TAB-TYPE","FolderTabType")
             tmpLine = IF cName ne "INPUT" THEN tmpLine + TRIM(cLine)
                       ELSE cLine.

      IMPORT UNFORMATTED cLine.
      cName = fetchToken(cLine,1).
    END. /* Repeat */
    ASSIGN endOfString = R-INDEX(tmpLine,"':U") - 1
           tmpLine = SUBSTRING(tmpLine,1,endOfString) + CHR(3) +
                             "HideOnInit" + CHR(4) + "no" + CHR(3) +
                             "DisableOnInit" + CHR(4) + "no" + CHR(3) +
                             "ObjectLayout" + "':U ,"                                  
           tmpLine = REPLACE(tmpLine,CHR(3) + ",", ",").
  END.
  PUT UNFORMATTED tmpLine SKIP.

END PROCEDURE.

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

&ENDIF

&IF DEFINED(EXCLUDE-gen-exitObject) = 0 &THEN

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE gen-exitObject Procedure 
PROCEDURE gen-exitObject :
/*------------------------------------------------------------------------------
  Purpose:     To generate the exitObject function
  Parameters:  <none>
  Notes:       
------------------------------------------------------------------------------*/
  PUT UNFORMATTED
    '&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE exitObject ' + window-name +
    CHR(10) + 'PROCEDURE exitObject :' + CHR(10) +
    '/*------------------------------------------------------------------------------'
    + CHR(10) +
    '  Purpose:  Window-specific override of this procedure which destroys' + CHR(10) +
    '            its contents and itself.' + CHR(10) + '    Notes:' + CHR(10) +
    '------------------------------------------------------------------------------*/'
    + CHR(10) + CHR(10) +
    '  APPLY "CLOSE":U TO THIS-PROCEDURE.' + CHR(10) +
    '  RETURN.' + CHR(10) + CHR(10) +
    'END PROCEDURE.' + CHR(10) + CHR(10) + '/* _UIB-CODE-BLOCK-END */' + CHR(10) +
    '&ANALYZE-RESUME' + CHR(10).
END PROCEDURE.

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

&ENDIF

&IF DEFINED(EXCLUDE-gen-include-lib) = 0 &THEN

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE gen-include-lib Procedure 
PROCEDURE gen-include-lib :
/*------------------------------------------------------------------------------
  Purpose:     Generate the Included libraries section 
  Parameters:  <none>
  Notes:       
------------------------------------------------------------------------------*/
  IF cIncLib NE "" THEN
    tmpLine = cIncLib + CHR(10) + CHR(10) + CHR(10) + CHR(10).
  ELSE
  tmpLine = "&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _INCLUDED-LIB " +
            window-name + CHR(10) +
            "/* ************************* Included-Libraries *********************** */" +
            CHR(10) + CHR(10) +
            (IF templateType = "BROWSER.W"       THEN "~{src/adm2/browser.i}"
             ELSE IF templateType = "VIEWER.W"   THEN "~{src/adm2/viewer.i}"
             ELSE IF templateType = "cntnrdlg.w" THEN "~{src/adm2/containr.i}"
             ELSE IF templateType = "cntnrfrm.w" THEN "~{src/adm2/containr.i}"
             ELSE IF templateType = "cntnrwin.w" THEN "~{src/adm2/containr.i}"
             ELSE IF templateType = "QUERY.W"    THEN "~{src/adm2/data.i}"
             ELSE "~{src/adm2/smart.i}") + CHR(10) + CHR(10) +
            "/* _UIB-CODE-BLOCK-END */" + CHR(10) +
            "&ANALYZE-RESUME" + CHR(10) + CHR(10) + CHR(10) + CHR(10).
  PUT UNFORMATTED tmpline SKIP.
END PROCEDURE.

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

&ENDIF

&IF DEFINED(EXCLUDE-gen-preprocs) = 0 &THEN

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE gen-preprocs Procedure 
PROCEDURE gen-preprocs :
/*------------------------------------------------------------------------------
  Purpose:     
  Parameters:  <none>
  Notes:       
------------------------------------------------------------------------------*/
  /* Manufacture the field related preprocessors - first get a complete
     list of fields - less duplicates                                   */
  DO i = 3 TO nTokens:
    tblList = tblList + "," + fetchToken(cLine, i).
  END.
  ASSIGN tblList     = TRIM(tblList,"~,")
         includeFile = ENTRY(NUM-ENTRIES(i-flnm,"~\"), i-flnm, "~\")
         includeFile = SUBSTR(includeFile,1, LENGTH(includeFile) - 1) + "i".

  IF NUM-DBS < 1 THEN
    RUN output-error(
        "Cannot determine field list unless the database is connected.").
  ELSE RUN protools/makeflds.w (INPUT includeFile, INPUT tblList,
                                OUTPUT fldList, OUTPUT fListByTbl,
                                OUTPUT asnList, OUTPUT fldRebuild).
  IF fListByTbl NE "" THEN fListByTbl = fListByTbl + CHR(10).

  PUT UNFORMATTED
      "&Scoped-Define ENABLED-FIELDS " + fldList SKIP
      fListByTbl SKIP (1)
      "&Scoped-Define DATA-FIELDS " + fldList SKIP
      "&Scoped-Define MANDATORY-FIELDS" SKIP
      "&Scoped-Define APPLICATION-SERVICE" SKIP
      "&Scoped-Define ASSIGN-LIST " + asnList SKIP
      "&Scoped-Define DATA-FIELD-DEFS " + '"' + includeFile + '"' SKIP (1)
      "~{&DB-REQUIRED-START}" SKIP
      save-line SKIP.

END PROCEDURE.

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

&ENDIF

&IF DEFINED(EXCLUDE-output-error) = 0 &THEN

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE output-error Procedure 
PROCEDURE output-error :
/*------------------------------------------------------------------------------
  Purpose:    Writes an error message to the log file and also puts a &MESSAGE
              statement into the output file.
  Parameters:  err-msg  - error message to be outputted
  Notes:       
------------------------------------------------------------------------------*/
  DEFINE INPUT PARAMETER err-msg AS CHARACTER                NO-UNDO.
    PUT UNFORMATTED cLine SKIP
        "~&MESSAGE Convert Utility: " + err-msg SKIP.
END PROCEDURE.

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

&ENDIF

&IF DEFINED(EXCLUDE-prelim-scan) = 0 &THEN

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE prelim-scan Procedure 
PROCEDURE prelim-scan :
/*------------------------------------------------------------------------------
  Purpose:     A preliminary scan of the input file to collect some information.
               The current version only collects the include file section.
  Parameters:  <none>
  Notes:       
------------------------------------------------------------------------------*/
  DEFINE VARIABLE inIncLibBlock AS LOGICAL        INITIAL NO            NO-UNDO.

  INPUT FROM VALUE(i-flnm).

  LineScanner:
  REPEAT:
    IMPORT UNFORMATTED cLine.
  
    IF cLine BEGINS "&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _INCLUDED-LIB" THEN
      inIncLibBlock = TRUE.  /* We are in the block */

    IF inIncLibBlock THEN DO:
      ASSIGN cLine = REPLACE(cLine, "src/adm/method/query.i":U, "src/adm2/data.i":U)
             cLine = REPLACE(cLine, "src/adm/method":U, "src/adm2":U)
             cIncLib = IF cIncLib NE "" THEN cIncLib + CHR(10) + cLine
                                        ELSE cLine.
      IF cLine BEGINS "&ANALYZE-RESUME" THEN LEAVE LineScanner.
    END.  /* If inIncLibBlock */
  END.  /* End of LineScanner Repeat */

  INPUT CLOSE.
  
END PROCEDURE.

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

&ENDIF

&IF DEFINED(EXCLUDE-remove-block) = 0 &THEN

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE remove-block Procedure 
PROCEDURE remove-block :
/*------------------------------------------------------------------------------
  Purpose: Remove an entire block of code upto the next &ANALYZE-RESUME    
  Parameters:  <none>
  Notes:       
------------------------------------------------------------------------------*/
  changes = changes + 1.
  REPEAT WHILE cLine NE "&ANALYZE-RESUME":
    IMPORT UNFORMATTED cLine.
  END.
 
END PROCEDURE.

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

&ENDIF

&IF DEFINED(EXCLUDE-second-pass) = 0 &THEN

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE second-pass Procedure 
PROCEDURE second-pass :
/*------------------------------------------------------------------------------
  Purpose:     This is called when processing a SmartViewer.  It is necessary
               to first build a SmartData type temp-table include file, then
               reopen the new file and make proper substitions and changes.
  Parameters:  dotwFile - the name of the new .w file
  Notes:       
------------------------------------------------------------------------------*/
  DEFINE INPUT PARAMETER dotwFile AS CHARACTER                        NO-UNDO.
  
  DEFINE VARIABLE incl-fl       AS CHARACTER                          NO-UNDO.
  DEFINE VARIABLE last-seq      AS INTEGER                            NO-UNDO.
  DEFINE VARIABLE n-parts       AS INTEGER                            NO-UNDO.
  DEFINE VARIABLE proc-settings AS LOGICAL                            NO-UNDO.
  DEFINE VARIABLE tokn1         AS CHARACTER                          NO-UNDO.
  DEFINE VARIABLE tokn2         AS CHARACTER                          NO-UNDO.
  DEFINE VARIABLE tmpflnm       AS CHARACTER                          NO-UNDO.

  /* ------------------------------------------------------------------------ */
  /*     First create the include file                                        */
  /* ------------------------------------------------------------------------ */
  ASSIGN incl-fl = ENTRY(1,dotwFile, ".")
         n-parts = NUM-ENTRIES(incl-fl, "~/")
         tokn1   = ENTRY(n-parts, incl-fl, "~/")
         tokn1   = "d" + SUBSTR(tokn1,2)
         tokn1   = (IF LENGTH(tokn1) < 8 THEN tokn1 ELSE SUBSTR(tokn1,1,7))
                    + "x.i".
  ENTRY(n-parts, incl-fl, "~/") = tokn1.

  FIND LAST substitute NO-ERROR.
  IF AVAILABLE substitute THEN last-seq = SUBSTITUTE.seq.

  OUTPUT TO VALUE(incl-fl).
  FOR EACH substitute:
    PUT UNFORMATTED "  FIELD " + substitute.fld + " LIKE " +
                    substitute.qualifiers + "." + substitute.fld +
                    IF substitute.seq NE last-seq THEN " ~~" ELSE " " SKIP.
  END.
  OUTPUT CLOSE.
  
  
  /* ------------------------------------------------------------------------ */
  /*     Now review the output file                                           */
  /* ------------------------------------------------------------------------ */
  
  /* Rename the file to a temporary file */
  RUN adecomm/_tmpfile.p ({&STD_TYP_UIB_DUP}, {&STD_EXT_UIB}, OUTPUT tmpflnm).
  OS-COPY VALUE(dotwfile) VALUE(tmpflnm).
  
  /* Open the input and output files and start processing */
  INPUT  FROM VALUE(tmpflnm).
  OUTPUT TO   VALUE(dotwfile).

  readLine:
  REPEAT:
    IMPORT UNFORMATTED cLine.

    /* Check for empty lines. */
    IF LENGTH(cLine) = 0 THEN DO:
      PUT UNFORMATTED CHR(10).
      NEXT readLine.
    END.

    IF templateType = "BROWSER.W" AND LEFT-TRIM(cLine) BEGINS "_Where" THEN DO:
      lCont = TRUE.
      DO WHILE lCont:
          IMPORT UNFORMATTED cLine.
          IF LEFT-TRIM(cLine) BEGINS "_":U AND NOT(LEFT-TRIM(cLine) BEGINS "_Where":U) THEN lCont = FALSE.
      END.  /* do while lCont */
    END.  /* If cLine is _WHERE */
 
    IF templateType NE "BROWSER.W" AND cLine BEGINS "&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _DEFINITIONS" THEN DO:
      /* Insert the include inclusion */
      PUT UNFORMATTED CHR(10) +
      "/* Temp-Table and Buffer definitions                                    */"
      SKIP
      "~&MESSAGE Convert Utility: " +
        "You should substitute a proper SmartData include file below." SKIP
      "DEFINE TEMP-TABLE RowObject" + CHR(10) +
      "       ~{" + '"' + incl-fl + '"' + "}." + CHR(10)
              SKIP.
    END. /* If cLine is _CUSTOM _DEFINITIONS */

    ELSE IF cLine BEGINS "/* Name of first Frame and/or Browse" THEN DO:
      PUT UNFORMATTED 
       "/* Include file with RowObject temp-table definition */" SKIP
       "~&MESSAGE Convert Utility: " +
        "You should substitute a proper SmartData include file below." SKIP
       "&Scoped-define DATA-FIELD-DEFS " + incl-fl SKIP (1).
    END.

    ELSE IF cLine BEGINS "&ANALYZE-SUSPEND _PROCEDURE-SETTINGS" THEN
      proc-settings = TRUE.

    ELSE IF cLine BEGINS "&ANALYZE-RESUME _END-PROCEDURE-SETTINGS" THEN
      proc-settings = FALSE.

    ELSE IF proc-settings THEN DO:
      ASSIGN tokn1 = fetchToken(cLine,1)
             tokn2 = fetchToken(cLine,2).
      IF tokn1 = "~/~*" AND tokn2 = "Settings" THEN
        PUT UNFORMATTED 
          '~&MESSAGE Convert Utility: ' +
          'You should substitute a proper SmartData procedure name and ' +
          'include file below.' SKIP.
        
      ELSE IF tokn1 = "Allow" AND
              tokn2 = "~:" THEN
        PUT UNFORMATTED '   Data Source: ~<_CONVERTED_~>' SKIP.
      ELSE IF templateType NE "BROWSER.W" AND tokn1 = "Other" AND tokn2 = "Settings" THEN DO:
        PUT UNFORMATTED
          '   Add Fields to: Neither' SKIP 
          cLine SKIP
          '   Temp-Tables and Buffers:' SKIP
          '      TABLE: RowObject D "?" ?' SKIP
          '      ADDITIONAL-FIELDS:' SKIP
          '          ~{' + incl-fl + '}' SKIP
          '      END-FIELDS.' SKIP
          '   END-TABLES.' SKIP.
        IMPORT UNFORMATTED cLine.
        proc-settings = FALSE.
      END. /* Other settings: */
    END.  /* If end of proc-settings comment */

    ELSE IF templateType NE "BROWSER.W" AND 
            cLine BEGINS "&Scoped-define ENABLED-TABLES" THEN
      cLine = "&Scoped-define ENABLED-TABLES RowObject".

    ELSE IF templateType NE "BROWSER.W" AND 
            cLine BEGINS "&Scoped-define FIRST-ENABLED-TABLE" THEN
      cLine = "&Scoped-define FIRST-ENABLED-TABLE RowObject".

    ELSE IF templateType = "BROWSER.W" AND cLine BEGINS "DEFINE QUERY" THEN DO:
      PUT UNFORMATTED 
        'DEFINE TEMP-TABLE RowObject' SKIP
        '    ~{~{&DATA-FIELD-DEFS~}~}' SKIP
        '    ~{src/adm2/robjflds.i~}.' SKIP(1).

      PUT UNFORMATTED cLine SKIP.
      lCont = TRUE.
      DO WHILE lCont:
        IMPORT UNFORMATTED tmpLine.
        IF LEFT-TRIM(tmpLine) BEGINS '&ANALYZE-RESUME':U THEN lCont = FALSE. 
      END.
      PUT UNFORMATTED '     rowObject SCROLLING.':U SKIP.
      cLine = '~&ANALYZE-RESUME':U.
    END.  /* define query */

    ELSE IF templateType = "BROWSER.W" AND LEFT-TRIM(cLine) BEGINS "QUERY" THEN DO:
      PUT UNFORMATTED cLine SKIP.
      lCont = TRUE.
      DO WHILE lCont:
        IMPORT UNFORMATTED tmpLine.
        IF tmpLine BEGINS "/* _UIB-CODE-BLOCK-END":U THEN lCont = FALSE.
        ELSE IF LEFT-TRIM(tmpLine) BEGINS "ENABLE":U THEN PUT UNFORMATTED "  ENABLE":U SKIP. 
        ELSE DO:
            tmpLine = ENTRY(1, LEFT-TRIM(tmpLine), " ":U).
            PUT UNFORMATTED "      " + ENTRY(NUM-ENTRIES(tmpLine, ".":U), tmpLine, ".":U) SKIP.
        END.  /* else do - field name */
      END.  /* do while lCont */
      cLine = "/* _UIB-CODE-BLOCK-END */":U.
    END.

    ELSE IF templateType = "BROWSER.W" AND LEFT-TRIM(cLine) BEGINS "_TblList" THEN
      ASSIGN cLine = '     _TblList          = "rowObject"'.
   
    ELSE IF templateType = "BROWSER.W" AND LEFT-TRIM(cLine) BEGINS "_Options" THEN
      ASSIGN cLine = '     _Options          = "NO-LOCK INDEXED-REPOSITION"'.

    ELSE IF templateType = "BROWSER.W" AND LEFT-TRIM(cLine) BEGINS "_TblOptList" THEN
      NEXT readLine.

    ELSE IF templateType = "BROWSER.W" AND LEFT-TRIM(cLine) BEGINS "_FldNameList["  THEN DO:
      ASSIGN nTokens = NUM-ENTRIES(LEFT-TRIM(cLine), " ":U).
             nTokens2 = NUM-ENTRIES(ENTRY(nTokens, LEFT-TRIM(cLine), " ":U), ".":U).
      
     ASSIGN cLine = '     ' + ENTRY(1, LEFT-TRIM(cLine), " ":U) + '   ' + 
        ENTRY(nTokens - 1, LEFT-TRIM(cLine), " ":U) + ' _<SDO>.rowobject.' +
        ENTRY(nTokens2, ENTRY(nTokens, LEFT-TRIM(cLine), " ":U), ".":U).
    END.

    ELSE DO: /* Go throught field substitutions */
      FOR EACH substitute BREAK BY qualifiers:
        IF FIRST-OF(qualifiers) THEN DO:
         cline = replaceQualifiers(cline,qualifiers).
        END.
      END.  /* For each substitute */
    END.  /* Else do the substitutions */
    
    PUT UNFORMATTED cLine SKIP.

  END.  /* Readline Repeat */
  
  INPUT CLOSE.
  OUTPUT CLOSE.

  OS-DELETE VALUE(tmpflnm).
  
END PROCEDURE.

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

&ENDIF

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

&IF DEFINED(EXCLUDE-convertLinkFunctions) = 0 &THEN

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION convertLinkFunctions Procedure 
FUNCTION convertLinkFunctions RETURNS LOGICAL:
 
/*------------------------------------------------------------------------------
  Purpose:     To convert a V8 style RUN Get-Link-Handle, RUN set-link-attribute
               or RUN Request-Attribute statement to a V9 style linkHandles(cLink),
               assignLinkProperties or linkProperties function
  Parameters:  <none>
  Notes:       Returns True if reasonably successful, False if confused 
------------------------------------------------------------------------------*/


DEFINE VARIABLE cArg1     AS CHARACTER                             NO-UNDO.
DEFINE VARIABLE cArg2     AS CHARACTER                             NO-UNDO.
DEFINE VARIABLE cArg3     AS CHARACTER                             NO-UNDO.
DEFINE VARIABLE cArg4     AS CHARACTER                             NO-UNDO.
DEFINE VARIABLE i         AS INTEGER                               NO-UNDO.
DEFINE VARIABLE n-e       AS INTEGER                               NO-UNDO.
DEFINE VARIABLE parms     AS CHARACTER                             NO-UNDO.

  /* Before attempting to parse this statment, lets strip out any comments and make
     sure continuation lines are tacked on */

  /* Find the end of the statement - there must be a ")" near then end of
     the statement (after OUTPUT parameter in the case of get-link-handle)
      - but make sure its not in a comment */
  IF cAction = "Get-Link-Handle" THEN DO:
    ASSIGN stmnt-end = INDEX(cLine, "OUTPUT").
    DO WHILE stmnt-end = 0:
      RUN appendLine.
      ASSIGN stmnt-end = INDEX(cLine, "OUTPUT").
    END.
  END.  /* IF Get-Link-Handle */
  ELSE stmnt-end = 1.

  /* Found OUTPUT keyword (in Get-Link-Handle case) , look for ")" after it */  
  ASSIGN stmnt-end = INDEX(cLine, ")", stmnt-end).
  DO WHILE stmnt-end = 0:
    RUN appendLine.
    ASSIGN stmnt-end = INDEX(cLine, ")").
  END.

  /* We now have a candidate for the end of the statement - make sure that it is not
     in a comment */
  ASSIGN com-bgns  = INDEX(cLine, "~/~*")                 /* Begining of a comment */
         com-ends  = INDEX(cLine, "~*~/", com-bgns + 2 ). /* End of comment        */

  DO WHILE com-bgns > 0 AND         /* There is a comment                          */
           stmnt-end > com-bgns AND /* The ) is after the start of the comment     */
          (stmnt-end < com-ends OR  /* The ) is before the end of the comment or   */
           com-ends = 0):           /* The comment is continued onto the next line */
    IF com-ends = 0 THEN DO:   /* Find the end of the comment */
      DO WHILE com-ends = 0:
        RUN appendLine.
        com-ends = INDEX(cLine, "~*~/", com-bgns + 2 ). /* End of comment        */
      END.
    END.  /* Find the end of the comment */

    /* Now we know that the ")" is in the comment, remove the comment and
       cycle back to find the next statement end candidate                       */
    ASSIGN cLine     = SUBSTRING(cLine,1,com-bgns - 1) + " " +
                        SUBSTRING(cLine,com-ends + 2)
           com-bgns  = INDEX(cLine, "~/~*")
           com-ends  = INDEX(cLine, "~*~/", com-bgns + 2)
           stmnt-end = INDEX(cLine,")").
    IF cLine = "" THEN RETURN TRUE.
    DO WHILE stmnt-end = 0:
      RUN appendLine.
      ASSIGN stmnt-end = INDEX(cLine, ")").
    END.  /* Looking for the end of the statement ")" */
  END.  /* DO while the end ")" is in a comment */

  /* This much code is common to all "RUN" get-link-handle statements: 
     Skip, for the moment, everything before RUN. This assign expects a line to 
     look like:
Token 1       2                    2          3      4         5     
    RUN get-link-handle or set-link-attribute IN adm-broker-hdl ( <cArg1>, cArg2, OUTPUT cArg3 ).
                                                                                        */
  ASSIGN lReturn  = no /* Turn off RETURN-VALUE conversion with each new RUN stmt.      */
         cSubLine = SUBSTR(cLine, INDEX(cLine, "RUN "))  /* cSubLine is everything
                                                            from the RUN keyword on     */
         parms    = ENTRY(2, cLine, "(":U)               /* the parameter list          */
         carg1    = TRIM(ENTRY(1, parms))                /* cArg1 is handle of proc     */
         n-e      = NUM-ENTRIES(cArg1, " ":U)            /* Maybe has "INPUT"           */
         cArg1   = IF n-e > 1 THEN                       /* This strips the INPUT keywd */
                      ENTRY(n-e, cArg1, " ")
                    ELSE cArg1
 
         cArg2    = TRIM(ENTRY(2, parms))                /* Link type                   */
         n-e      = NUM-ENTRIES(cArg2, " ":U)            /* Maybe has "INPUT"           */
         cArg2    = IF n-e > 1 THEN                      /* Strip out INPUT keyword     */
                      ENTRY(n-e, cArg2, " ")
                    ELSE cArg2
 
         cArg3 = TRIM(ENTRY(1,ENTRY(3, parms), ")"))     /* Link Handle                 */
         n-e      = NUM-ENTRIES(cArg3, " ":U)            /* Has "OUTPUT"                */
         cArg3 = ENTRY(n-e, cArg3, " ")                  /* Strip out OUTPUT keyword    */
         cArg1   = IF cArg1 = "THIS-PROCEDURE" THEN ""
                    ELSE cArg1
         changes  = changes + 1.
 
  CASE cAction:
    WHEN "Get-Link-Handle" THEN DO:
        cLine = SUBSTR(cLine,1,INDEX(cLine, "RUN") - 1) +   /* Keep indentation as RUN */
                 cArg3 + " = " +
                 (IF cArg1 EQ "" THEN "linkHandles(" + cArg2 + ")."
                  ELSE "DYNAMIC-FUNCTION('linkHandles' IN " + cArg1 + ", " + cArg2 + ")."
                  ).
    END.  /* Get-Link-Handle case */

    WHEN "Set-Link-Attribute" THEN DO:
        cLine = SUBSTR(cLine,1,INDEX(cLine, "RUN") - 1) +   /* Keep indentation as RUN */
                 (IF cArg1 EQ "" THEN "assignLinkProperty(" + cArg2 + ", " + 
                                       TRIM(ENTRY(1, cArg3, "=":U)) + ", " +
                                       TRIM(ENTRY(2, cArg3, "=":U)) + ")."
                  ELSE "DYNAMIC-FUNCTION('assignlinkProperty':U IN " + cArg1 + ", " + cArg2 +
                                       TRIM(ENTRY(1, cArg3, "=":U)) + ", " +
                                       TRIM(ENTRY(2, cArg3, "=":U)) + ")."
                  ).
    END.  /* Set-Link-Attribute */

    WHEN "Request-Attribute" THEN DO:
      /* Look for RETURN-VALUE */
      REPEAT WHILE INDEX(cLine, "RETURN-VALUE") = 0:
        IMPORT UNFORMATTED cLine.
      END.  /* While looking for Mr. Return Value */
      cLine = ENTRY(1, cLine, "=":U) + "= ":U +
              (IF cArg1 = "" THEN "linkProperty("
               ELSE "DYNAMIC-FUNCTION('linkProperty':U IN " + cArg1 + ", ":U) +
               cArg2 + ", " + cArg3 + ").".
    END.  /* Request-Attribute Case */

    WHEN "Modify-List-Attribute" THEN DO:
      ASSIGN cLine = SUBSTR(cLine,1,INDEX(cLine, "RUN") - 1) +  /* Keep indentation as RUN */
                        "modifyListProperty(" + parms.          /* Params don't change     */
    END.  /* Modify-List-Attribute Case */
  END CASE. /* Case on cAction */
 
  RETURN FALSE.   /* Function return value. */

END FUNCTION.

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

&ENDIF

&IF DEFINED(EXCLUDE-determineAction) = 0 &THEN

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION determineAction Procedure 
FUNCTION determineAction RETURNS CHARACTER
  ( /* parameter-definitions */ ) :
/*------------------------------------------------------------------------------
  Purpose:  A new line has read this determines the action to perform. The
            possible choices are:
                Prefixes            Scoped-Def          Procedure
                Dispatch            Notify              Init-Object
                Get-Attribute       Set-Attribute       Get-Link-Handle
                Set-Link-Attribute  Request-Attribute   Modify-List-Attribute
                New-State           Run                 EndProc
                Other
                
    Notes:  
------------------------------------------------------------------------------*/

  cAction = IF SUBSTR(cLine,1,20) = "&IF DEFINED(EXCLUDE-" 
              OR SUBSTR(cLine,1,32) = "&ANALYZE-SUSPEND _UIB-CODE-BLOCK" 
                THEN "Prefixes"
            ELSE IF SUBSTR(cLine,1,10) = "&SCOPED-DE"
                THEN "Scoped-Def"
            /* Next check for the procedure header itself. */
            ELSE IF SUBSTR(cLine,1,10) = "PROCEDURE " 
                THEN "Procedure"
            /* Next check for all the RUN statements we have to convert. */
            ELSE IF INDEX(cLine, "RUN dispatch") NE 0 
                THEN "Dispatch"
            ELSE IF INDEX(cLine, "RUN notify") NE 0 
                THEN "Notify"
            ELSE IF INDEX(cLine, "RUN init-object") NE 0
                THEN "Init-Object"
            ELSE IF INDEX(cLine, "RUN get-attribute") NE 0 
                THEN "Get-Attribute"
            ELSE IF INDEX(cLine, "RUN set-attribute-list") NE 0 
                THEN "Set-Attribute"
            ELSE "Other".

  /* Need to break this up due to 4096 byte limit */
  IF cAction = "Other" THEN
    ASSIGN cAction =
            IF INDEX(cLine, "RUN get-link-handle") NE 0 
                THEN "Get-Link-Handle"
            ELSE IF INDEX(cLine, "RUN set-link-attribute") NE 0 
                THEN "Set-Link-Attribute"
            ELSE IF INDEX(cLine, "RUN request-attribute") NE 0 
                THEN "Request-Attribute"
            ELSE IF INDEX(cLine, "RUN modify-list-attribute") NE 0 
                THEN "Modify-List-Attribute"
            ELSE IF INDEX(cLine, "RUN new-state") NE 0
                THEN "New-State"
            ELSE IF INDEX(cLine, "RUN ") NE 0 
                THEN "Run"           /* Any other RUN statement. */
            ELSE IF cLine BEGINS "&ANALYZE-RESUME" 
                THEN "EndProc"
            ELSE "Other".       /* For any code that looks at all other lines. */

  RETURN cAction.   /* Function return value. */

END FUNCTION.

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

&ENDIF

&IF DEFINED(EXCLUDE-fetchToken) = 0 &THEN

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION fetchToken Procedure 
FUNCTION fetchToken RETURNS CHARACTER
  (pcString AS CHARACTER, piToken AS INTEGER) :
/*------------------------------------------------------------------------------
  Purpose: Given a string (pcString) fetchToken returns the nth (piToken)
           space delimited token 
    Notes:  
------------------------------------------------------------------------------*/

  DEFINE VARIABLE iToken   AS INTEGER   NO-UNDO.
  DEFINE VARIABLE iPos     AS INTEGER   NO-UNDO INIT 1.
  DEFINE VARIABLE iLen     AS INTEGER   NO-UNDO.
  DEFINE VARIABLE iStart   AS INTEGER   NO-UNDO.
  DEFINE VARIABLE cChar    AS CHARACTE  NO-UNDO.
  DEFINE VARIABLE cQuote   AS CHARACTER NO-UNDO.
  DEFINE VARIABLE cSpecial AS CHARACTER NO-UNDO INIT ":()=".  /* Special tokens. */

  ASSIGN pcString = pcString + " "
                    /* Pad with a space to avoid counting problems at end. */
         iLen     = LENGTH(pcString,"CHARACTER").
                    /* Make sure we don't walk off the end of the string.  */

  DO iToken = 1 TO piToken:
    /* Skip white space */
    cChar = SUBSTR(pcString, iPos, 1).
    DO WHILE iPos < iLen AND (cChar = " " OR cChar = CHR(10)):
      ASSIGN iPos  = iPos + 1
             cChar = SUBSTR(pcString, iPos, 1).
    END.  /* DO WHILE iPos < iLen and character is " " or CHR(10) */

    /* We are currently at the start of a token */
    ASSIGN iStart = iPos.    /* Mark the beginning of each token. */
 
    /* cChar is non blank - Look for quotes */
    IF  cChar = "'" OR cChar = '"' THEN DO:
      /* Treat the quoted string (incl. the quotes) as one token. */
      iPos = iPos + 1.        /* Move past the leading quote. */
      DO WHILE iPos < iLen AND SUBSTR(pcString, iPos, 1) NE cChar:
        iPos = iPos + 1.      /* Find the matching end quote */
      END.
      iPos = iPos + 1.        /* and position beyond it. */
    END.  /* If single or double quote */
    ELSE DO:  /* This token isn't in quotes */
      IF INDEX(cSpecial,cChar) NE 0 THEN  /* Special tokens */
        iPos = iPos + 1.
      ELSE DO WHILE iPos < iLen AND INDEX(" " + cSpecial, cChar) = 0:
        ASSIGN iPos = iPos + 1
               cChar = SUBSTR(pcString, iPos, 1).    /* Walk through the token. */
      END.
    END.  /* Else do: */
  END.  /* iToken = 1 to piToken */
  RETURN SUBSTR(pcString, iStart, iPos - iStart).
END FUNCTION.  /* fetchToken */

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

&ENDIF

&IF DEFINED(EXCLUDE-ProcessV8Run) = 0 &THEN

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION ProcessV8Run Procedure 
FUNCTION ProcessV8Run RETURNS LOGICAL:
/*------------------------------------------------------------------------------
  Purpose:     To process a V8 style RUN statement of any of the following v8
               procesdures: Dispatch, Notify, Get-Attribute, Set-Attribute OR
               New-State
  Parameters:  <none>
  Notes:       Returns True if reasonably successful, False if confused 
------------------------------------------------------------------------------*/

DEFINE VARIABLE attrEntry AS CHARACTER                             NO-UNDO.
DEFINE VARIABLE attr-i    AS CHARACTER                             NO-UNDO.
DEFINE VARIABLE built-in  AS LOGICAL                               NO-UNDO.
DEFINE VARIABLE frst-chr  AS CHARACTER                             NO-UNDO.
DEFINE VARIABLE i         AS INTEGER                               NO-UNDO.
DEFINE VARIABLE nspcs     AS INTEGER                               NO-UNDO.
DEFINE VARIABLE ntokens   AS INTEGER                               NO-UNDO.
DEFINE VARIABLE save-line AS CHARACTER                             NO-UNDO.

  /* Before attempting to parse this statment, lets strip out any comments and make
     sure continuation lines are tacked on */

  /* Find the end of the statement - since this is a Dispatch, Notify, Get-Attribute,
     Set-Attribute or New-State RUN statement, there must be a ")" near then end of
     the statement - but make sure its not in a comment */
  ASSIGN stmnt-end = INDEX(cLine, ")").
  DO WHILE stmnt-end = 0:
    RUN appendLine.
    ASSIGN stmnt-end = INDEX(cLine, ")").
  END.

  /* We now have a candidate for the end of the statement - make sure that it is not
     in a comment */
  ASSIGN com-bgns  = INDEX(cLine, "~/~*")                 /* Begining of a comment */
         com-ends  = INDEX(cLine, "~*~/", com-bgns + 2 ). /* End of comment        */

  DO WHILE com-bgns > 0 AND         /* There is a comment                          */
           stmnt-end > com-bgns AND /* The ) is after the start of the comment     */
          (stmnt-end < com-ends OR  /* The ) is before the end of the comment or   */
           com-ends = 0):           /* The comment is continued onto the next line */
    IF com-ends = 0 THEN DO:   /* Find the end of the comment */
      DO WHILE com-ends = 0:
        RUN appendLine.
        com-ends = INDEX(cLine, "~*~/", com-bgns + 2 ). /* End of comment        */
      END.
    END.  /* Find the end of the comment */

    /* Now we know that the ")" is in the comment, remove the comment and
       cycle back to find the next statement end candidate                       */
    ASSIGN cLine     = SUBSTRING(cLine,1,com-bgns - 1) + " " +
                        SUBSTRING(cLine,com-ends + 2)
           com-bgns  = INDEX(cLine, "~/~*")
           com-ends  = INDEX(cLine, "~*~/", com-bgns + 2)
           stmnt-end = INDEX(cLine,")").
    IF cLine = "" THEN RETURN TRUE.
    DO WHILE stmnt-end = 0:
      RUN appendLine.
      ASSIGN stmnt-end = INDEX(cLine, ")").
    END.  /* Looking for the end of the statement ")" */
  END.  /* DO while the end ")" is in a comment */

  /* This much code is common to all the special "RUN" statements: 
     Skip, for the moment, everything before RUN. This assign expects a line to 
     look like:
Token 1     2   or 2   or 2          or 2          or 2        3    4     5    6      7   8
    RUN dispatch|notify|get-attribute|set-attribute!new-state [IN cInHdl] ( [INPUT] cName ).
or    1     2      2      2             2             2                   3    4     5[4] 6[5]
                                                                                        */

  ASSIGN lReturn  = no /* Turn off RETURN-VALUE conversion with each new RUN stmt.  */
         cSubLine = SUBSTR(cLine, INDEX(cLine, "RUN ")) /* cSubLine is everything
                                                           from the RUN keyword on  */
         cInHdl   = IF fetchToken(cSubLine, 3) = "IN"   /* cInHdl is handle of proc */
                      THEN fetchToken(cSubLine, 4)      /* that the internal proc   */
                      ELSE ""                           /* will be run "IN"         */
         iIndex   = IF cInHdl = "" THEN 4 ELSE 6        /* Look for 'cName' token.  */
         cName    = IF fetchToken(cSubLine, iIndex) = 'INPUT' /* cName is the proc  */
                      THEN fetchToken(cSubLine, iIndex + 1)
                      ELSE fetchToken(cSubLine, iIndex)
         changes  = changes + 1.

  /* Is this attribute a built-in property? */
  FIND prprty WHERE prprty.v8prop = SUBSTR(cName, 2, LENGTH(cName) - 2) NO-ERROR.
  ASSIGN built-in = AVAILABLE prprty.

  CASE cAction:
    WHEN "Dispatch" THEN DO:
      /* Look for "RUN dispatch [IN hdl] ('proc')" and change to 
         "RUN proc [IN hdl]"  or "RUN SUPER" if we're in a local 'proc'. */
      cName = SUBSTR(cName, 2, LENGTH(cName) - 2).   /* Eliminate quote marks. */
      IF cName = "CREATE-OBJECTS" THEN cName = "createObjects".
  
      /* If the name of the procedure we're dispatching is the same as the
         name of the procedure we're *in*, then use the SUPER keyword. */
      IF cName = cProcName THEN DO:
        IF cInHdl = "" OR cInHdl = "This-Procedure":U THEN
          cName = "SUPER".
        ELSE DO:
          FIND FIRST method WHERE method.v8method = cName NO-ERROR.
          IF AVAILABLE method then cName = method.v9method.
        END.
        FIND FIRST method WHERE method.v8method = cProcName NO-ERROR.
        IF AVAILABLE method AND method.params NE "" THEN DO:
          DO i = 1 TO NUM-ENTRIES(method.params):
            tmpParam = ENTRY(i, method.params).
            cName = cName + (IF i = 1 THEN " (":U  ELSE ", ":U) +
                      (IF ENTRY(3,tmpParam,"|":U) = "I":U THEN "INPUT ":U
                       ELSE IF ENTRY(3,tmpParam,"|":U) = "O":U THEN "OUTPUT ":U
                       ELSE "INPUT-OUTPUT ":U) + ENTRY(1,tmpParam,"|":U).
          END.  /* DO i = 1 to num-entries */
          cName = cName + ")".
        END.  /* If this is an adm-method */
      END.  /* If this is a call to itself */
      FIND FIRST method WHERE method.v8method = cName NO-ERROR.
      IF AVAILABLE method THEN cName = method.v9method.
      IF AVAILABLE method AND method.mTYPE = "FL" THEN cName = cName + "()".
  
      cLine = SUBSTR(cLine,1,INDEX(cLine, "RUN") + 3) +       /* Up through "RUN " */
                cName + (IF cInHdl NE "" THEN " IN " + cInHdl ELSE " ") +
                SUBSTR(cSubLine,INDEX(cSubLine,")") + 1).       /* Statement End */
      IF AVAILABLE method AND method.mType = "FL" THEN
        cLine = REPLACE(cLine, "RUN ":U, "":U).
    END.  /* WHEN cAction = "Dispatch" */
    WHEN "Notify" THEN DO:
      /* Look for "RUN notify [IN hdl] ('proc')" and change to 
         "PUBLISH 'proc' [FROM hdl]". ("cName" is the notify proc name here,
         including the enclosing quote marks and :U, because the PUBLISH
         syntax requires the event name to be a string literal or expression.)
         If there is a link name specified in the Notify, then for now we simply
         eliminate it by searching for a comma and ignoring everything after that.
         In principle this means that the object at the other end of the link must
         SUBSCRIBE to that event. This is probably OK for, say, GROUP-ASSIGN-TARGETs,
         which can subscribe to all the same events as a TABLEIO-TARGET, but gets
         more interesting for, say, "apply-entry, TABLEIO-SOURCE" or
         "view, CONTAINER-SOURCE". */
      IF INDEX(cName, ",") NE 0 THEN    /* Keep initial quote mark and match at end. */
        cName = SUBSTR(cName, 1, INDEX(cName, ",") - 1) + SUBSTR(cName, 1, 1).
      FIND FIRST method WHERE method.v8method = TRIM(TRIM(cName,"'":U),'"':U) NO-ERROR.
      IF AVAILABLE method THEN cName = IF cName BEGINS "'":U OR cName BEGINS '"':U
                                       THEN "'":U + method.v9method + "'":U ELSE
                                       method.v9method.
      IF AVAILABLE method AND method.mTYPE = "FL" THEN cName = cName + "()".
  
      cLine = SUBSTR(cLine,1,INDEX(cLine, "RUN") - 1) +       /* Any initial space */
              "PUBLISH " + cName + ":U" + 
              (IF cInHdl NE "" THEN " FROM " + cInHdl ELSE " ") +
              SUBSTR(cSubLine,INDEX(cSubLine,")") + 1).       /* Statement End */
    END.  /* WHEN cAction = "Notify" */
    WHEN "Get-Attribute" THEN DO:
      ASSIGN lReturn   = yes   /* Flag to convert RETURN-VALUEs. */
      /* Look for RUN get-attribute. If found, remove that line, unless there's
         a comment or something else at the end, and replace all occurrences
         of RETURN-VALUE up to the procedure end or next RUN with get<attrname>. 
         Note that users may wish to change the code to avoid multiple invocations
         of the get function, so we may wish to flag multiple RETURN-VALUEs. */
             cInHdl    = IF cInHdl = "THIS-PROCEDURE" THEN "" ELSE cInHdl
             cAttrName = (IF cInHdl NE "" THEN
                          "DYNAMIC-FUNCTION('" ELSE "") +
                         "get" + /* If built-in then v9prop else user defined */
                         (IF built-in THEN prprty.v9prop +
                            (IF cInHdl NE "" THEN "':U IN " + cInHdl + ")" ELSE "()")
                          ELSE "UserProperty('" + SUBSTR(cName, 2, LENGTH(cName) - 2) + 
                            (IF cInHdl NE "" THEN "':U IN " + cInHdl + ")" ELSE "':U)"))
      /* Look for a comment at the end of the line; if found, write it out.
         All following RETURN-VALUEs up to the end of procedure or next RUN statement
         will be replaced with the getAttr function (see "Other" below). */
             iIndex    = INDEX(cLine, "/*")
             cLine     = IF iIndex NE 0 THEN SUBSTR(cLine, iIndex) ELSE " ".
    END.  /* WHEN xAction = "Get-Attribute" */
    WHEN "Set-Attribute" THEN DO:
      /* Look for RUN set-attribute-list and convert each attribute to new style:
         Example:
            RUN set-attribute-list ( 'attr1 = value1, attr2 = value2, ... attr3 = value3':U).
         Becomes:
            {set attr1 value1}
            {set attr2 value2}
                 . . .
            {set attrn valuen}        */
  
     ASSIGN cName     = REPLACE(cName, "=":U, " = ":U)
            cName     = REPLACE(cName, "  ", " ")
            nTokens   = NUM-ENTRIES(cName," ")
            save-line = cLine
            nspcs     = INDEX(cLine, "RUN") - 1
            cLine     = "".
      DO i = 2 TO nTokens - 1:  /* Look for "="'s */
        ASSIGN attrEntry = ENTRY(i, cName, " ").
        IF attrEntry = "=" THEN DO:
          /* At this point we are in the midst of a "Attr = Value" triplet */
          ASSIGN attr-i   = TRIM(ENTRY(i - 1, cName, " "), "~',~"")
                 cValue   = TRIM(ENTRY(i + 1, cName, " "), "~,")
                 frst-chr = SUBSTRING(cValue,1,1)
                 cValue   = IF frst-chr = '"' THEN RIGHT-TRIM(cValue,"~'")
                            ELSE IF frst-chr = "'" THEN RIGHT-TRIM(cValue, '~"')
                            ELSE RIGHT-TRIM(cValue, '~',~"')
                 frst-chr = SUBSTRING(cValue,1,1)
                 cValue   = IF INDEX("0123456789-+.,",frst-chr) = 0
                               THEN "'" + cValue + "'" ELSE cValue.
                 
          IF NOT CAN-FIND(FIRST name-switch WHERE name-switch.forget AND
                                            attr-i = name-switch.old-name) THEN DO:
            /* If this is not on the forget list then write it out */
            /* Check to see if this is a built-in property */
            FIND prprty WHERE prprty.v8prop = attr-i NO-ERROR.

            IF AVAILABLE prprty THEN
              cLine = cLine + (IF cLine ne "" THEN CHR(10) ELSE "") + FILL(" ", nspcs) +
                      "~{set " + prprty.v9prop + " " + cvalue + "}.".
            ELSE  /* Not a buit-in property */
              cLine = cLine + (IF cLine ne "" THEN CHR(10) ELSE "") + FILL(" ", nspcs) +
                      "DYNAMIC-FUNCTION ('setUserProperty':U" +
                               (IF cInHdl NE "" THEN " IN " + cInHdl ELSE "") + ", '" +
                               attr-i + "':U, " + cvalue + ").".

          END.  /* If not on the forget list */
        END.  /* If attrEntry = "+" */
      END.  /* Do i = 2 TO nTokens - 1 */
    END. /* WHEN cAction = "Set-Attribute */
    WHEN "New-State" THEN DO:
      /* Each state message is really a value for a group property in the new world.
         Look up the message, find the corresponding property name (add "State" to it),
         and turn it into a setPropState function. */
      ASSIGN iIndex = LOOKUP(SUBSTR(cName, 2, LENGTH(cName) - 2),
                          cStateVals).                              /* w/o quotes */
      IF iIndex > 0 THEN
        ASSIGN cLine = SUBSTR(cLine,1,INDEX(cLine, "RUN") - 1) +    /* Any initial space */
                       (IF cInHdl NE "" THEN cInHdl + ":" ELSE "") +
                       "set" + ENTRY(iIndex,cStateProps) + "State(" +
                       cName + ":U)" +  
                       SUBSTR(cSubLine,INDEX(cSubLine,")") + 1).    /* Statement End */
      /* Special handling for setUpdateState('update-begin') */
      IF cLine MATCHES "*setUpdateState*" THEN
        cLine = REPLACE(REPLACE(cLine,"setUpdateState":U, "RUN updateState":U),
                        "update-begin":U, "UPDATE":U).
    END.  /* WHEN cAction = "New-State" */
  END CASE.  /* End the case on cAction */

  RETURN TRUE.   /* Reasonably succesfull */

END FUNCTION.  /* ProcessV8Run */

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

&ENDIF

&IF DEFINED(EXCLUDE-removePrefixes) = 0 &THEN

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION removePrefixes Procedure 
FUNCTION removePrefixes RETURNS CHARACTER
  (pcLine AS CHARACTER) :
/*------------------------------------------------------------------------------
  Purpose: Remove adm-, local-, broker-, or custom- prefix from the line and
           return the kind of prefix removed. 
    Notes:  
------------------------------------------------------------------------------*/
 
  DEFINE VARIABLE cPrefix AS CHARACTER NO-UNDO INIT "".

  cPrefix = IF INDEX(pcLine,"adm-") NE 0          THEN "adm-"
            ELSE IF INDEX(pcLine,"local-") NE 0   THEN "local-"
            ELSE IF INDEX(pcLine,"broker-") NE 0  THEN "broker-"
            ELSE IF cCustomPrefix NE "" AND INDEX(pcLine,cCustomPrefix) NE 0
                                                  THEN cCustomPrefix
            ELSE "".

  /* Don't change adm-create-object */
  IF cPrefix = "adm-" AND INDEX(pcLine,"adm-create-objects") NE 0 THEN
    cPrefix = "".

  IF cPrefix NE "" THEN           /* Don't touch non-"dispatch" procedure names. */
    ASSIGN cLine   = REPLACE(cLine, cPrefix, "")
           changes = changes + 1.
  RETURN cPrefix.
END FUNCTION.  /* removePrefixes */

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

&ENDIF

&IF DEFINED(EXCLUDE-replaceOne) = 0 &THEN

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION replaceOne Procedure 
FUNCTION replaceOne RETURNS CHARACTER
  ( /* parameter-definitions */
     pcLine AS CHARACTER,  
     pqualifiers AS CHARACTER) :
/*------------------------------------------------------------------------------
  Purpose:  This routine replaces each occurence of a qualifier with RowObject. 
        We have to look at each occurence
        separately to make sure it is not a substring. For example, we don't want
        to replace Order with RowObject in the Order-Line case.
    Notes:  
------------------------------------------------------------------------------*/
DEFINE VARIABLE cx          AS CHARACTER.
DEFINE VARIABLE cStr1       AS CHARACTER.
DEFINE VARIABLE cStr2       AS CHARACTER.
DEFINE VARIABLE tempLine    AS CHARACTER INIT ?.
DEFINE VARIABLE ix          AS INTEGER.
DEFINE VARIABLE iqLen       AS INTEGER.  


ASSIGN iqLen = LENGTH(pqualifiers).    


ix = INDEX(pcline,pqualifiers).
DO WHILE ix > 0:

/* look at the character following the tablename to see if is really
    just a substring of another tablename like Order is a substring of Order-Line 
 */
    cx = SUBSTR(pcline,ix + iqLen,1).
    /* if it is a valid match, then do the substitution */
    IF cx = " " OR cx = "" OR cx = "." THEN DO:
        cStr1 = SUBSTR(pcline, 1, ix + iqLen - 1).
        cStr2 = SUBSTR(pcline,ix + iqLen).

        cStr1 = REPLACE(cStr1, pqualifiers, " RowObject").
        pcLine = cStr1 + cStr2.    
        /* if we haven't run into any bad matches then look again from beginning */
        /* otherwise we have to advance temporarily past the bad match so we 
         * don't keep finding it
         */
        IF templine = ? THEN
            ix = INDEX(pcline,pqualifiers).
        ELSE DO:    
            templine = SUBSTR(pcline,ix + iqLen).
            IF INDEX(templine,pqualifiers) > 0 THEN
                ix = ix + iqlen + INDEX(templine, pqualifiers) - 1.
            ELSE LEAVE.
        END.
    END. /* if cx = " " */
    ELSE DO:    /* this was the bad match so advance past it */ 
        templine = SUBSTR(pcline,ix + iqLen).
        IF INDEX(templine, pqualifiers) > 0 THEN
            ix = ix + iqlen + INDEX(templine, pqualifiers) - 1.
         ELSE LEAVE.
    END.
        
END. /* end Do while */
RETURN pcLine.
END FUNCTION.

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

&ENDIF

&IF DEFINED(EXCLUDE-replaceQualifiers) = 0 &THEN

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION replaceQualifiers Procedure 
FUNCTION replaceQualifiers RETURNS CHARACTER
  ( /* parameter-definitions */
     pcLine AS CHARACTER,  
     pqualifiers AS CHARACTER) :
/*------------------------------------------------------------------------------
  Purpose:  Replaces qualifier (with and without appropriate prefixes) with
            'RowObject'. The replacement is done for all appropriate occurences
            in the pcLine.
    Notes:  
------------------------------------------------------------------------------*/
DEFINE VARIABLE iqLen   AS INTEGER.
DEFINE VARIABLE cx      AS CHARACTER.

iqLen = LENGTH(pqualifiers) + 1.
pcLine = replaceOne(pcLine, " " + pqualifiers).
pcLine = replaceOne(pcLine, "(" + pqualifiers).

/* last case is when it is at beginning of line and not preceded by space
    or left parenthesis 
 */
IF pcLine BEGINS pqualifiers THEN DO:
    cx = SUBSTR(pcline,iqLen,1).
    /* if it is a valid match, then do the substitution */
    IF cx = " " OR cx = "" OR cx = "." 
        THEN pcLine = "RowObject" + SUBSTRING(pcLine, iqLen).
END. /* if pcline Begins */
  
RETURN pcLine.   /* Function return value. */
   
END FUNCTION.

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

&ENDIF

&IF DEFINED(EXCLUDE-userProcName) = 0 &THEN

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION userProcName Procedure 
FUNCTION userProcName RETURNS LOGICAL
  ( /* parameter-definitions */
     cInLine AS CHARACTER,
     iInd AS INTEGER, 
     cv8Method AS CHARACTER ) :
/*------------------------------------------------------------------------------
  Purpose:  Determine if the procedure name is exactly the method name
  and not just a prefix for a user-defined procedure name.
    Notes:  
------------------------------------------------------------------------------*/
  
  DEFINE VARIABLE cNext AS CHARACTER NO-UNDO.

 
  /* look at the character immediately following the method name.
     Determine if cinLine is exactly that method or if the methodname is just
     a prefix.
   */
   cNext = substring(cInLine,iInd + length(cv8Method)).
   IF cNext = " " OR cNext = "(" OR cNext = "." THEN RETURN FALSE.
       ELSE RETURN TRUE.
END FUNCTION.

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

&ENDIF

&ANALYZE-SUSPEND _VERSION-NUMBER UIB_v7r10 GUI
&ANALYZE-RESUME
&Scoped-define WINDOW-NAME    d_custom
&Scoped-define FRAME-NAME     d_custom
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _DEFINITIONS d_custom 
/*********************************************************************
* 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: _custmi2.w

  Description: Add/Update PRO*Tools applets 

  Input Parameters:
      <none>

  Output Parameters:
      <none>

  Author: Gerry Seidl

  Created: 10/06/94 - 10:42 am
  
  Last Modified on 01/27/94 by GFS - Added order support.
                   10/26/94 BY GFS
                   05/27/99 by tsm - Changed filters parameter in call to 
                                    _fndfile.p because it now needs list-item 
                                    pairs rather than list-items to support new 
                                    image formats
------------------------------------------------------------------------*/
/*          This .W file was created with the Progress UIB.             */
/*----------------------------------------------------------------------*/
{ protools/_protool.i } /* shared temp-table definitions */
{ protools/ptlshlp.i }  /* help contents definitions */

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

/* Parameters Definitions ---                                           */
DEFINE INPUT PARAMETER mode         AS CHAR    NO-UNDO. /*"Add" or "Update" */
DEFINE OUTPUT PARAMETER modrcode    AS LOGICAL NO-UNDO. /* add/upd return code */

/* Shared Variable Definitions ---                                       */
DEFINE SHARED VARIABLE iname     AS CHAR  NO-UNDO. /* FULL IMAGE NAME    */
DEFINE SHARED VARIABLE pname     AS CHAR  NO-UNDO. /* FULL PROC NAME     */
DEFINE SHARED VARIABLE dlist-i   AS CHAR  NO-UNDO. /* dirs for images    */
DEFINE SHARED VARIABLE dlist-p   AS CHAR  NO-UNDO. /* dirs for procs     */
DEFINE SHARED VARIABLE ifilename AS CHAR  NO-UNDO.
DEFINE SHARED VARIABLE pfilename AS CHAR  NO-UNDO.
DEFINE SHARED VARIABLE modrecid  AS RECID NO-UNDO.

/* Local Variable Definitions ---                                        */
DEFINE VARIABLE rcode            AS LOG   NO-UNDO. /* generic RETURN CODE */
DEFINE VARIABLE hcontext         AS INT   NO-UNDO. /* help context no.   */

/* Tells okbar.i to size buttons to win-95. */
&GLOBAL-DEFINE WIN95-BTN YES

DEFINE NEW SHARED BUFFER tfunct FOR pt-function.
DEFINE NEW SHARED BUFFER temp   FOR pt-function.

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



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

/* Name of first Frame and/or Browse (alphabetically)                   */
&Scoped-define FRAME-NAME  d_custom

/* Custom List Definitions                                              */
&Scoped-define LIST-1 
&Scoped-define LIST-2 
&Scoped-define LIST-3 

/* Definitions for DIALOG-BOX d_custom                                  */
&Scoped-define FIELDS-IN-QUERY-d_custom 
&Scoped-define ENABLED-FIELDS-IN-QUERY-d_custom 
&Scoped-define OPEN-QUERY-d_custom OPEN QUERY d_custom FOR EACH pt-function SHARE-LOCK.
&Scoped-define FIRST-TABLE-IN-QUERY-d_custom pt-function
&Scoped-define TABLES-IN-QUERY-d_custom pt-function 

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

/* Define a dialog box                                                  */

/* Definitions of the field level widgets                               */
DEFINE BUTTON b_Files 
     LABEL "&Files...":L 
     SIZE 14 BY 1.14.

DEFINE BUTTON b_Image 
     LABEL "":L 
     SIZE-PIXELS 38 BY 38.

DEFINE VARIABLE b_Image_Label AS CHARACTER FORMAT "X(256)":U INITIAL "&Image:" 
      VIEW-AS TEXT 
     SIZE 7 BY 1 NO-UNDO.

DEFINE VARIABLE fFile AS CHARACTER FORMAT "x(65)" 
     LABEL "&Program" 
     VIEW-AS FILL-IN 
     SIZE 29 BY 1.08.

DEFINE VARIABLE fName AS CHARACTER FORMAT "x(30)" 
     LABEL "&Label" 
     VIEW-AS FILL-IN 
     SIZE 44 BY 1.08.

DEFINE RECTANGLE r_Attributes
     EDGE-PIXELS 2 GRAPHIC-EDGE  NO-FILL 
     SIZE 55 BY 6.27
     BGCOLOR 8 .

DEFINE VARIABLE t_pdisplay AS LOGICAL INITIAL no 
     LABEL "&Display on palette":L 
     VIEW-AS TOGGLE-BOX
     SIZE 23 BY .85 NO-UNDO.

DEFINE VARIABLE t_perrun AS LOGICAL INITIAL no 
     LABEL "&Run Persistent":L 
     VIEW-AS TOGGLE-BOX
     SIZE 19 BY .85 NO-UNDO.


/* Query definitions                                                    */
DEFINE QUERY d_custom FOR pt-function SCROLLING.

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

DEFINE FRAME d_custom
     fName AT ROW 2.27 COL 10 COLON-ALIGNED
     fFile AT ROW 3.77 COL 10 COLON-ALIGNED
     b_Files AT ROW 3.77 COL 42
     b_Image AT ROW 5.5 COL 12
     t_perrun AT ROW 5.5 COL 22
     b_Image_Label AT ROW 5.77 COL 3 COLON-ALIGNED NO-LABEL
     t_pdisplay AT ROW 6.5 COL 22
     " Attributes" VIEW-AS TEXT
          SIZE 11 BY .65 AT ROW 1.27 COL 3
     r_Attributes AT ROW 1.5 COL 2
     SPACE(0.64) SKIP(0.26)
    WITH VIEW-AS DIALOG-BOX KEEP-TAB-ORDER 
         SIDE-LABELS NO-UNDERLINE THREE-D SCROLLABLE 
         TITLE "Add PRO*Tools Applet":L.

 


/* ***************  Runtime Attributes and UIB Settings  ************** */

&ANALYZE-SUSPEND _RUN-TIME-ATTRIBUTES
/* SETTINGS FOR DIALOG-BOX d_custom
  VISIBLE,L                                                             */
ASSIGN 
       FRAME d_custom:SCROLLABLE       = FALSE.

/* SETTINGS FOR FILL-IN b_Image_Label IN FRAME d_custom
   NO-ENABLE                                                            */
/* _RUN-TIME-ATTRIBUTES-END */
&ANALYZE-RESUME



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

&ANALYZE-SUSPEND _QUERY-BLOCK DIALOG-BOX d_custom
/* Query rebuild information for DIALOG-BOX d_custom
     _TblList          = "pt-function"
     _Options          = "SHARE-LOCK"
     _OrdList          = ""
     _Query            is OPENED
*/  /* DIALOG-BOX d_custom */
&ANALYZE-RESUME

 



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

&Scoped-define SELF-NAME d_custom
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL d_custom d_custom
ON ENDKEY OF FRAME d_custom /* Add PRO*Tools Applet */
OR END-ERROR OF FRAME {&FRAME-NAME}
DO:
  ASSIGN modrcode = no.
END.

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


&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL d_custom d_custom
ON GO OF FRAME d_custom /* Add PRO*Tools Applet */
DO:              
  
  /* Check for valid input */
  IF fName:SCREEN-VALUE = "" THEN DO:
    MESSAGE "Enter a name for this applet." VIEW-AS ALERT-BOX ERROR.
    APPLY "ENTRY" TO fName.
    RETURN NO-APPLY.
  END.
  IF fFile:SCREEN-VALUE = "" THEN DO:
    MESSAGE "Enter a program for this applet." VIEW-AS ALERT-BOX ERROR.
    APPLY "ENTRY" TO fFile.
    RETURN NO-APPLY.
  END.
  /* Disallow duplicate names */
  FIND temp WHERE temp.pcFname = fname:SCREEN-VALUE NO-ERROR.
  IF (AVAILABLE temp AND mode = "Add") OR
     (AVAILABLE temp AND mode = "Update" AND temp.pcfname <> tfunct.pcfname) THEN 
  DO:
    MESSAGE "An applet with this label already exists." VIEW-AS ALERT-BOX ERROR.
    APPLY "ENTRY" TO fName.
    RETURN NO-APPLY.
  END.
  /* Check for valid procedure name */
  FILE-INFO:FILE-NAME = fFile:SCREEN-VALUE.
  IF FILE-INFO:PATHNAME EQ ? THEN 
  CHK:
  DO: /* can't find what the user entered, if .p or .w, try to find a .r */
    IF LOOKUP(SUBSTRING(fFile:SCREEN-VALUE,LENGTH(fFile:SCREEN-VALUE) - 1,2,"CHARACTER":U), ".w,.p") > 0 THEN DO:
      FILE-INFO:FILE-NAME = SUBSTRING(fFile:SCREEN-VALUE,1,LENGTH(fFile:SCREEN-VALUE) - 1,"CHARACTER":U) + "r".
      IF FILE-INFO:PATHNAME NE ? THEN LEAVE CHK.
    END.
    MESSAGE fFile:SCREEN-VALUE "was not found!" skip 
      "Please check your PROGRESS Propath or enter a fully-qualified name for the procedure."
      VIEW-AS ALERT-BOX ERROR BUTTONS OK.
    APPLY "ENTRY" TO fFile.
    RETURN NO-APPLY.
  END.
  
  /* If 'ADD', add to temp-table */
  IF mode = "Add" THEN DO:
      FIND LAST temp USE-INDEX order.
      CREATE tfunct.
      ASSIGN tfunct.order = temp.order + 10. 
  END.   
  ASSIGN tfunct.pcFname   = fName:SCREEN-VALUE
         tfunct.pcFile    = fFile:SCREEN-VALUE
         tfunct.pcImage   = iFileName
         tfunct.perrun    = t_perrun:CHECKED
         tfunct.pdisplay  = t_pdisplay:CHECKED.


  ASSIGN  modrecid    = RECID(tfunct)
          modrcode    = yes.      
  RELEASE tfunct.
END.

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


&Scoped-define SELF-NAME b_Files
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL b_Files d_custom
ON CHOOSE OF b_Files IN FRAME d_custom /* Files... */
DO:
    IF dlist-p = "" THEN dlist-p = ".".
    ASSIGN pFilename = fName:SCREEN-VALUE.
    RUN adecomm/_fndfile.p (INPUT "Procedure to Run",
                          INPUT "TEXT", 
                          INPUT "Procedures & Windows (*.p,*.w)|*.p,*.w|All Files|*.*",
                          INPUT-OUTPUT dlist-p,
                          INPUT-OUTPUT pFileName,
                          OUTPUT pname,
                          OUTPUT rcode).  
    IF rcode THEN
      fFile:SCREEN-VALUE = pname.
END.

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


&Scoped-define SELF-NAME b_Image
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL b_Image d_custom
ON CHOOSE OF b_Image IN FRAME d_custom
DO:
  DEFINE VARIABLE image-formats AS CHARACTER NO-UNDO.
  
  image-formats = "All Picture Files|*.bmp,*.gif,*.ico,*.jpg,*.png,*.tif" +
    "|Bitmap (*.bmp)|*.bmp" +
    "|GIF (*.gif)|*.gif" +
    "|Icon (*.ico)|*.ico" + 
    "|JPEG (*.jpg)|*.jpg" + 
    "|PNG (*.png)|*.png" + 
    "|TIFF (*.tif)|*.tif" +
    "|All Files|*.*":U.

  IF dlist-i = "" THEN dlist-i = ".".
  RUN adecomm/_fndfile.p (INPUT "Image",
                          INPUT "IMAGE", 
                          &IF "{&WINDOW-SYSTEM}" BEGINS "MS-WIN" &THEN
                            INPUT image-formats,
                          &ELSE 
                            INPUT "*.xpm,*.xbm|*.*",
                          &ENDIF
                          INPUT-OUTPUT dlist-i,
                          INPUT-OUTPUT iFileName,
                          OUTPUT iname,
                          OUTPUT rcode).  
  IF rcode THEN
      rcode = self:Load-Image(iname).
END.

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


&UNDEFINE SELF-NAME

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


/* ***************************  Main Block  *************************** */
{ adecomm/commeng.i }

/* Which help file to use? */
IF mode = "Add" THEN hcontext = {&Add_Applet_DB}.
ELSE hcontext = {&Update_Applet_DB}.

{ adecomm/okbar.i &TOOL = "ptls"
                 &CONTEXT = hcontext }

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

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

/* Now enable the interface and wait for the exit condition.            */
/* (NOTE: handle ERROR and END-KEY so cleanup code will always fire.    */
IF mode = "Update" THEN DO:
    ASSIGN FRAME {&FRAME-NAME}:TITLE = "Update PRO*Tools Applet".
    FIND tfunct WHERE RECID(tfunct) = modrecid NO-ERROR.
    IF NOT AVAILABLE tfunct THEN DO:
        MESSAGE "Record not available".
        RETURN.
    END.
    RUN Display_Fields.
END.
ELSE ASSIGN iname = ""
            pname = ""
            ifilename = ""
            pfilename = ""
            t_pdisplay = yes
            t_perrun = yes.
            
IF NOT SESSION:WINDOW-SYSTEM BEGINS "MS-WIN" THEN
    ASSIGN b_Image_Label = "Image:".

MAIN-BLOCK:
DO ON ERROR   UNDO MAIN-BLOCK, LEAVE MAIN-BLOCK
   ON END-KEY UNDO MAIN-BLOCK, LEAVE MAIN-BLOCK:
  RUN enable_UI.
  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 d_custom _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 d_custom.
END PROCEDURE.

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


&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE Display_Fields d_custom 
PROCEDURE Display_Fields :
/* -----------------------------------------------------------
  Purpose:     displays fields on the frame
  Parameters:  <none>
  Notes:       
-------------------------------------------------------------*/
      ASSIGN t_Perrun   = tfunct.perrun
             iFileName  = tfunct.pcImage
             t_pdisplay = tfunct.pdisplay
             fName      = tfunct.pcFname
             fFile      = tfunct.pcFile.
      DISPLAY fName 
              fFile 
              t_Perrun
              t_pdisplay
              WITH FRAME {&FRAME-NAME}.
      rcode = b_Image:LOAD-IMAGE(pcImage).
      ASSIGN iFileName = pcImage
             pFileName = pcFname.
END PROCEDURE.

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


&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE enable_UI d_custom _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.
   -------------------------------------------------------------------- */

  {&OPEN-QUERY-d_custom}
  GET FIRST d_custom.
  DISPLAY fName fFile t_perrun b_Image_Label t_pdisplay 
      WITH FRAME d_custom.
  ENABLE r_Attributes fName fFile b_Files b_Image t_perrun t_pdisplay 
      WITH FRAME d_custom.
  {&OPEN-BROWSERS-IN-QUERY-d_custom}
END PROCEDURE.

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


&UNDEFINE FRAME-NAME 
&UNDEFINE WINDOW-NAME
&ANALYZE-SUSPEND _VERSION-NUMBER UIB_v7r11 GUI
&ANALYZE-RESUME
&Scoped-define WINDOW-NAME    d_pt-func
&Scoped-define FRAME-NAME     d_pt-func
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _DEFINITIONS d_pt-func 
/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/
/*------------------------------------------------------------------------

  File: protools/_custmiz.w

  Description: PRO*Tools Customization dialog

  Input Parameters:
      <none>

  Output Parameters:
      <none>

  Author: Gerry Seidl

  Created: 09/01/94 - 12:56 pm
  
  Last Modified on 10/26/94 by GFS

------------------------------------------------------------------------*/
/*          This .W file was created with the Progress UIB.             */
/*----------------------------------------------------------------------*/
/* ***************************  Definitions  ************************** */
{ protools/_protool.i } /* shared temp-table def */
{ protools/ptlshlp.i }  /* Help file definitions */
{ adecomm/_adetool.i }

/* Parameters Definitions ---                                           */
DEFINE INPUT PARAMETER hPalette AS HANDLE.   /* PROC HANDLE of Palette */
DEFINE INPUT-OUTPUT PARAMETER ptdat AS CHAR. /* data file loaded from */

/* Local Variable Definitions ---                                       */
DEFINE NEW SHARED VARIABLE iname     AS CHAR NO-UNDO. /* FULL IMAGE NAME */
DEFINE NEW SHARED VARIABLE pname     AS CHAR NO-UNDO. /* FULL PROC NAME */
DEFINE NEW SHARED VARIABLE rcode     AS LOG  NO-UNDO. /* RETURN CODE */
DEFINE NEW SHARED VARIABLE dlist-i   AS CHAR NO-UNDO. /* dirs for images */
DEFINE NEW SHARED VARIABLE dlist-p   AS CHAR NO-UNDO. /* dirs for procs */
DEFINE NEW SHARED VARIABLE ifilename AS CHAR NO-UNDO.
DEFINE NEW SHARED VARIABLE pfilename AS CHAR NO-UNDO.
DEFINE NEW SHARED VARIABLE modrecid  AS RECID NO-UNDO.

DEFINE VARIABLE modrcode AS LOGICAL NO-UNDO. /* upd/add return code */
DEFINE VARIABLE h        AS HANDLE  NO-UNDO.
DEFINE VARIABLE l        AS LOGICAL NO-UNDO.
DEFINE VARIABLE changed  AS LOGICAL NO-UNDO INITIAL no.

/* Tells okbar.i to size buttons to win-95. */
&GLOBAL-DEFINE WIN95-BTN YES

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



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

/* Name of first Frame and/or Browse (alphabetically)                   */
&Scoped-define FRAME-NAME  d_pt-func
&Scoped-define BROWSE-NAME brFunc

/* Custom List Definitions                                              */
&Scoped-define LIST-1 
&Scoped-define LIST-2 
&Scoped-define LIST-3 

/* Definitions for BROWSE brFunc                                        */
&Scoped-define FIELDS-IN-QUERY-brFunc pt-function.pdisplay ~
pt-function.pcFname 
&Scoped-define OPEN-QUERY-brFunc OPEN QUERY brFunc FOR EACH pt-function SHARE-LOCK ~
    BY pt-function.order.

/* Definitions for DIALOG-BOX d_pt-func                                 */
&Scoped-define FIELDS-IN-QUERY-d_pt-func 
&Scoped-define ENABLED-FIELDS-IN-QUERY-d_pt-func 
&Scoped-define OPEN-BROWSERS-IN-QUERY-d_pt-func ~
    ~{&OPEN-QUERY-brFunc}

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

/* Define a dialog box                                                  */

/* Definitions of the field level widgets                               */
DEFINE BUTTON b_Add 
     LABEL "&Add...":L 
     SIZE 10.2 BY 1.

DEFINE BUTTON b_down 
     IMAGE-UP FILE "adeicon/next"
     LABEL "~\/" 
     SIZE 10.2 BY 1.5.

DEFINE BUTTON b_Files2 
     LABEL "&Files...":L 
     SIZE 10 BY 1.

DEFINE BUTTON b_Remove 
     LABEL "&Remove":L 
     SIZE 10.2 BY 1.

DEFINE BUTTON b_up 
     IMAGE-UP FILE "adeicon/prev"
     LABEL "/~\" 
     SIZE 10.2 BY 1.5.

DEFINE BUTTON b_Update 
     LABEL "&Update...":L 
     SIZE 10.2 BY 1.

DEFINE VARIABLE b_Image_Label AS CHARACTER FORMAT "X(256)":U INITIAL "Image:" 
      VIEW-AS TEXT 
     SIZE 7 BY 1 NO-UNDO.

DEFINE VARIABLE dfilename AS CHARACTER FORMAT "X(256)":U 
     LABEL "&Startup file" 
     VIEW-AS FILL-IN 
     SIZE 52 BY 1 NO-UNDO.

DEFINE IMAGE f_Image
     SIZE-PIXELS 32 BY 32
     BGCOLOR 8 .

DEFINE RECTANGLE r_Attributes
     EDGE-PIXELS 2 GRAPHIC-EDGE  NO-FILL 
     SIZE 43 BY 7.77
     BGCOLOR 8 .

DEFINE RECTANGLE r_Functions
     EDGE-PIXELS 2 GRAPHIC-EDGE  NO-FILL 
     SIZE 44 BY 7.77
     BGCOLOR 8 .

DEFINE RECTANGLE r_Options
     EDGE-PIXELS 2 GRAPHIC-EDGE  NO-FILL 
     SIZE 88 BY 3.77
     BGCOLOR 8 .

DEFINE VARIABLE t_pdisplay AS LOGICAL INITIAL no 
     LABEL "Display On Palette":L 
     VIEW-AS TOGGLE-BOX
     SIZE 23 BY .85 NO-UNDO.

DEFINE VARIABLE t_perrun AS LOGICAL INITIAL no 
     LABEL "Run Persistent":L 
     VIEW-AS TOGGLE-BOX
     SIZE 19 BY .85 NO-UNDO.

DEFINE VARIABLE t_Save_Loc AS LOGICAL INITIAL no 
     LABEL "Save &Current Palette Position and Orientation":L 
     VIEW-AS TOGGLE-BOX
     SIZE 49 BY .85 NO-UNDO.


/* Query definitions                                                    */
DEFINE QUERY brFunc FOR pt-function SCROLLING.

/* Browse definitions                                                   */
DEFINE BROWSE brFunc QUERY brFunc SHARE-LOCK NO-WAIT DISPLAY 
      pt-function.pdisplay FORMAT "  / *"
      pt-function.pcFname
    WITH NO-LABELS SIZE 30 BY 6.77.


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

DEFINE FRAME d_pt-func
     brFunc AT ROW 2.3 COL 3
     b_Add AT ROW 2.3 COL 34
     pt-function.pcFname AT ROW 2.5 COL 54 COLON-ALIGNED
          LABEL "Label"
          VIEW-AS FILL-IN 
          SIZE 33 BY 1.08
          BGCOLOR 15 FGCOLOR 0 
     b_Remove AT ROW 3.5 COL 34
     pt-function.pcFile AT ROW 4 COL 54 COLON-ALIGNED
          LABEL "Program" FORMAT "x(65)"
          VIEW-AS FILL-IN 
          SIZE 33 BY 1.08
          BGCOLOR 15 FGCOLOR 0 
     b_Update AT ROW 4.7 COL 34
     t_perrun AT ROW 6 COL 66
     b_Image_Label AT ROW 6.5 COL 47 COLON-ALIGNED NO-LABEL
     t_pdisplay AT ROW 7 COL 66
     b_up AT ROW 6 COL 34 NO-LABEL
     b_down AT ROW 7.6 COL 34 NO-LABEL
     t_Save_Loc AT ROW 10.5 COL 25
     dfilename AT ROW 11.77 COL 19 COLON-ALIGNED 
     b_Files2 AT ROW 11.77 COL 74
     "(Applets will be saved to this file)" VIEW-AS TEXT
          SIZE 40 BY .65 AT ROW 12.9 COL 21
     " Applets " VIEW-AS TEXT
          SIZE 9 BY .65 AT ROW 1.5 COL 3
     " Attributes" VIEW-AS TEXT
          SIZE 11 BY .65 AT ROW 1.5 COL 47
     r_Attributes AT ROW 1.81 COL 2
     r_Functions AT ROW 1.81 COL 46
     f_Image AT ROW 6.27 COL 56
     " Startup Options" VIEW-AS TEXT
          SIZE 16 BY .65 AT ROW 9.77 COL 3
     r_Options AT ROW 10 COL 2
     SPACE(0.93) SKIP(0.38)
    WITH VIEW-AS DIALOG-BOX KEEP-TAB-ORDER 
         SIDE-LABELS NO-UNDERLINE THREE-D SCROLLABLE 
         TITLE "PRO*Tools Customization":L.

 


/* ***************  Runtime Attributes and UIB Settings  ************** */

&ANALYZE-SUSPEND _RUN-TIME-ATTRIBUTES
ASSIGN 
       FRAME d_pt-func:SCROLLABLE       = FALSE.

/* SETTINGS FOR FILL-IN b_Image_Label IN FRAME d_pt-func
   NO-ENABLE                                                            */
/* SETTINGS FOR FILL-IN pt-function.pcFile IN FRAME d_pt-func
   NO-ENABLE EXP-LABEL EXP-FORMAT EXP-HELP                              */
/* SETTINGS FOR FILL-IN pt-function.pcFname IN FRAME d_pt-func
   NO-ENABLE EXP-LABEL                                                  */
/* SETTINGS FOR TOGGLE-BOX t_pdisplay IN FRAME d_pt-func
   NO-ENABLE                                                            */
/* SETTINGS FOR TOGGLE-BOX t_perrun IN FRAME d_pt-func
   NO-ENABLE                                                            */
/* _RUN-TIME-ATTRIBUTES-END */
&ANALYZE-RESUME


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

&ANALYZE-SUSPEND _QUERY-BLOCK BROWSE brFunc
/* Query rebuild information for BROWSE brFunc
     _TblList          = "pt-function"
     _Options          = "SHARE-LOCK"
     _OrdList          = "pt-function.order|yes"
     _FldNameList[1]   = pt-function.pdisplay
     _FldFormatList[1] = "  / *"
     _FldNameList[2]   = pt-function.pcFname
     _Query            is OPENED
*/  /* BROWSE brFunc */
&ANALYZE-RESUME

 



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

&Scoped-define SELF-NAME d_pt-func
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL d_pt-func d_pt-func
ON GO OF FRAME d_pt-func /* PRO*Tools Customization */
DO:
  DEFINE VARIABLE choice        AS LOGICAL NO-UNDO INITIAL yes. /* Misc LOG */
  DEFINE VARIABLE px            AS INTEGER NO-UNDO. /* x Loc of Palette */
  DEFINE VARIABLE py            AS INTEGER NO-UNDO. /* y Loc of Palette */
  DEFINE VARIABLE items-per-row AS INTEGER NO-UNDO.
  DEFINE VARIABLE lbl-or-btn    AS CHAR    NO-UNDO. /* lbl or btn */
  DEFINE VARIABLE o             AS INTEGER NO-UNDO INITIAL 10. /* used to renumber */
  DEFINE VARIABLE v             AS CHAR    NO-UNDO.

  IF changed OR dfilename:SCREEN-VALUE NE ptdat THEN DO:
    ASSIGN dfilename = dfilename:SCREEN-VALUE.
    FILE-INFO:FILE-NAME = dfilename.
    IF INDEX(FILE-INFO:FILE-TYPE, "W") = 0 THEN DO:
        MESSAGE "You do not have permission to write to this file."
          VIEW-AS ALERT-BOX WARNING BUTTONS OK.
        APPLY "ENTRY" TO dfilename IN FRAME {&FRAME-NAME}.
        RETURN NO-APPLY.
    END.
    IF FILE-INFO:FULL-PATHNAME <> ? THEN DO:
      ASSIGN choice = NO.
      MESSAGE "Do you want to overwrite" skip
              dfilename "?"
              VIEW-AS ALERT-BOX QUESTION BUTTONS YES-NO
              UPDATE choice.
      IF choice THEN dfilename = FILE-INFO:FULL-PATHNAME.
    END.
  
    IF choice THEN DO:
      IF dfilename <> ? AND dfilename <> "" THEN 
      DO ON ERROR UNDO, RETRY:  
        IF RETRY THEN DO:
          MESSAGE "An error has occured writing to " dfilename skip
                  "The file cannot be saved until the problem is corrected."
            VIEW-AS ALERT-BOX ERROR.
          RETURN NO-APPLY.
        END.
        /* Save applets */
          OUTPUT TO value(dfilename).
              REPEAT PRESELECT EACH pt-function BY pt-function.order:
                  FIND NEXT pt-function.
                  ASSIGN pt-function.order = o       /* renumber */
                         o                 = o + 10.
                  EXPORT pt-function.
              END.
          OUTPUT CLOSE.
          ASSIGN ptdat = dfilename.
      END.
      ELSE DO:
          MESSAGE "You must specify a Startup File!" VIEW-AS
              ALERT-BOX ERROR BUTTONS OK.
          APPLY "ENTRY" TO dfilename IN FRAME {&FRAME-NAME}.
          RETURN NO-APPLY.
      END.
    END.
  END. /* IF changed */
  
  /* SAVE Startup File Options */
/*
  PUT-KEY-VALUE SECTION "ProTools" 
                KEY     "ExecuteOnAdeStartup" 
                VALUE   STRING(t_Startup:CHECKED, "yes/no") NO-ERROR.
                
  PUT-KEY-VALUE SECTION "ProTools" 
                KEY     "AddFunctionsToAdeMenuBar" 
                VALUE   STRING(t_Add_To_Menu:CHECKED, "yes/no") NO-ERROR.  
*/                
  PUT-KEY-VALUE SECTION "ProTools" 
                KEY     "FunctionDefs" 
                VALUE   ptdat NO-ERROR.                            
  IF ERROR-STATUS:ERROR THEN RUN INI_Error (INPUT "FunctionDefs").
  ELSE DO:
    GET-KEY-VALUE SECTION "ProTools" 
                  KEY     "FunctionDefs" 
                  VALUE   v .                            
    IF v NE ptdat THEN RUN INI_Error (INPUT "FunctionDefs").
  END.
     
  IF t_Save_Loc:CHECKED THEN DO:
        RUN Get-Location IN hPalette (OUTPUT px, OUTPUT py). 
        PUT-KEY-VALUE SECTION "ProTools" 
                    KEY     "PaletteLoc" 
                    VALUE   STRING(px) + "," + STRING(py) NO-ERROR. 
        IF ERROR-STATUS:ERROR THEN RUN INI_Error (INPUT "PaletteLoc").
        ELSE DO:
          GET-KEY-VALUE SECTION "ProTools" 
                      KEY     "PaletteLoc" 
                      VALUE   v .                            
          IF v NE STRING(px) + "," + STRING(py) THEN RUN INI_Error (INPUT "FunctionDefs").
        END.

        RUN Get-Items-Per-Row IN hPalette (OUTPUT items-per-row).
        PUT-KEY-VALUE SECTION "ProTools" 
                    KEY     "ItemsPerRow" 
                    VALUE   STRING(items-per-row) NO-ERROR.
        IF ERROR-STATUS:ERROR THEN RUN INI_Error (INPUT "ItemsPerRow").
        ELSE DO:
          GET-KEY-VALUE SECTION "ProTools" 
                      KEY     "ItemsPerRow" 
                      VALUE   v .                            
          IF v NE STRING(items-per-row) THEN RUN INI_Error (INPUT "FunctionDefs").
        END.     
  END.                   
END.

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


&Scoped-define BROWSE-NAME brFunc
&Scoped-define SELF-NAME brFunc
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL brFunc d_pt-func
ON VALUE-CHANGED OF brFunc IN FRAME d_pt-func
DO:
  RUN Display_Fields.
END.

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


&Scoped-define SELF-NAME b_Add
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL b_Add d_pt-func
ON CHOOSE OF b_Add IN FRAME d_pt-func /* Add */
DO:
    RUN protools/_custmi2.w (INPUT "Add",
                             OUTPUT modrcode).
    IF modrcode THEN DO: /* new one added */
        ASSIGN changed = yes.
        {&OPEN-QUERY-brFunc}
        l = h:SET-REPOSITIONED-ROW (MAX(1,h:FOCUSED-ROW), "CONDITIONAL").
        REPOSITION brFunc TO RECID(modrecid).
        FIND pt-function WHERE RECID(pt-function) = modrecid.
        RUN Display_Fields.
        IF pt-function.pdisplay THEN
            RUN Add-Function IN hPalette (INPUT pt-function.pcFile,
                                          INPUT pt-function.pcImage, 
                                          INPUT pt-function.pcFname,
                                          INPUT pt-function.perrun,
                                          INPUT pt-function.order).
    END.
END.

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


&Scoped-define SELF-NAME b_down
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL b_down d_pt-func
ON CHOOSE OF b_down IN FRAME d_pt-func /* \/ */
DO:
  DEFINE BUFFER   tbuf FOR pt-function.
  DEFINE VARIABLE trecid AS RECID   NO-UNDO.
  DEFINE VARIABLE oswap  AS INTEGER NO-UNDO.
  
  ASSIGN trecid = RECID(pt-function).
  ASSIGN changed = yes.
  GET NEXT brFunc.
  IF AVAILABLE(pt-function) THEN DO:
      FIND tbuf WHERE RECID(tbuf) = trecid.
      ASSIGN oswap             = tbuf.order
             tbuf.order        = pt-function.order
             pt-function.order = oswap.
      RUN Swap_Order IN hPalette (INPUT pt-function.pcFname,
                                  INPUT tbuf.pcFname).
      {&OPEN-QUERY-brFunc}
      l = h:SET-REPOSITIONED-ROW (MAX(1,h:FOCUSED-ROW), "CONDITIONAL").
      REPOSITION brFunc TO RECID(trecid).
  END.
  ELSE DO:
      MESSAGE "This is already the last applet in the order"
          VIEW-AS ALERT-BOX INFORMATION BUTTONS OK.  
      GET LAST brFunc.
  END.
END.

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


&Scoped-define SELF-NAME b_Files2
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL b_Files2 d_pt-func
ON CHOOSE OF b_Files2 IN FRAME d_pt-func /* Files... */
DO:
    SYSTEM-DIALOG GET-FILE ptdat
    FILTERS "PRO*Tools defs (*.dat)" "*.dat",
            "All files (*.*)" "*.*"
    DEFAULT-EXTENSION ".dat"
    USE-FILENAME
    CREATE-TEST-FILE
    SAVE-AS
    UPDATE rcode.
    IF rcode AND ptdat NE dfilename:SCREEN-VALUE THEN
      ASSIGN changed                = yes
             dfilename:SCREEN-VALUE = ptdat.
END.

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


&Scoped-define SELF-NAME b_Remove
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL b_Remove d_pt-func
ON CHOOSE OF b_Remove IN FRAME d_pt-func /* Remove */
DO:
  DEF VAR choice AS LOG.
  DEF VAR fname  AS CHAR.
  DEF VAR onpal  AS LOG INITIAL yes.
  DEFINE BUFFER tfunc FOR pt-function.
  
  IF AVAILABLE (pt-function) THEN DO:
      MESSAGE "Are you sure you want to remove" skip
              "applet: " + pcFname + "?"
              VIEW-AS ALERT-BOX QUESTION BUTTONS YES-NO
              UPDATE choice.
      IF CHOICE THEN DO:
          ASSIGN fname   = pcFname
                 onpal   = pt-function.pdisplay
                 changed = yes.
          FIND tfunc WHERE RECID(tfunc) = RECID(pt-FUNCTION).
          FIND PREV tfunc USE-INDEX order NO-ERROR.
          IF AVAILABLE pt-FUNCTION THEN 
          l = h:SET-REPOSITIONED-ROW (MAX(1,h:FOCUSED-ROW), "CONDITIONAL").
          DELETE pt-FUNCTION.
          {&OPEN-QUERY-brFunc}
          IF RECID(tfunc) NE ? THEN REPOSITION brFunc TO RECID(RECID(tfunc)).
          ELSE rcode = brFunc:SELECT-ROW(1).
          RUN Display_Fields.
          IF onpal THEN 
            RUN Delete-Function IN hPalette (INPUT Fname).
      END.
  END.
  ELSE MESSAGE "Please select a applet to remove" 
          VIEW-AS ALERT-BOX ERROR BUTTONS OK.
END.

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


&Scoped-define SELF-NAME b_up
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL b_up d_pt-func
ON CHOOSE OF b_up IN FRAME d_pt-func /* /\ */
DO:
  DEFINE BUFFER   tbuf FOR pt-function.
  DEFINE VARIABLE trecid AS RECID   NO-UNDO.
  DEFINE VARIABLE oswap  AS INTEGER NO-UNDO.
  
  ASSIGN trecid  = RECID(pt-function)
         changed = yes.
  GET PREV brFunc.
  IF AVAILABLE(pt-function) THEN DO:
      FIND tbuf WHERE RECID(tbuf) = trecid.
      ASSIGN oswap             = tbuf.order
             tbuf.order        = pt-function.order
             pt-function.order = oswap.
      RUN Swap_Order IN hPalette (INPUT pt-function.pcFname,
                                  INPUT tbuf.pcFname).
      {&OPEN-QUERY-brFunc}
      l = h:SET-REPOSITIONED-ROW (MAX(1,h:FOCUSED-ROW), "CONDITIONAL").
      REPOSITION brFunc TO RECID(trecid).
  END.
  ELSE DO:
      MESSAGE "This is already the first applet in the order"
          VIEW-AS ALERT-BOX INFORMATION BUTTONS OK.
      GET FIRST brFunc.
  END.
END.

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


&Scoped-define SELF-NAME b_Update
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL b_Update d_pt-func
ON CHOOSE OF b_Update IN FRAME d_pt-func /* Update */
DO:
  DEFINE VARIABLE wasdisp AS LOG NO-UNDO. /* was it displayed before upd? */
  DEFINE VARIABLE oldname AS CHARACTER NO-UNDO. /* original name of function */
  
  IF AVAILABLE (pt-function) THEN DO:
    ASSIGN modrecid = RECID(pt-function)
           wasdisp  = pt-function.pdisplay
           oldname  = pt-function.pcFname.
    RUN protools/_custmi2.w (INPUT "Update",
                             OUTPUT modrcode).
    IF modrcode = NO THEN RETURN.
    ASSIGN changed = yes.
    {&OPEN-QUERY-brFunc}
    l = h:SET-REPOSITIONED-ROW (MAX(1,h:FOCUSED-ROW), "CONDITIONAL").
    REPOSITION brFunc TO RECID(modrecid).
    RUN Display_Fields.
  END.                         
  ELSE DO:
      MESSAGE "There is no applet to update." VIEW-AS ALERT-BOX
          ERROR BUTTONS ok.
      RETURN NO-APPLY.
  END. 
  IF wasdisp AND NOT pt-function.pdisplay THEN
      RUN Delete-Function IN hPalette (INPUT pt-function.pcFname).  
  ELSE IF NOT wasdisp AND pt-function.pdisplay THEN
      RUN Add-Function IN hPalette (INPUT pt-function.pcFile,
                                    INPUT pt-function.pcImage, 
                                    INPUT pt-function.pcFname,
                                    INPUT pt-function.perrun,
                                    INPUT pt-function.order). 
  ELSE IF pt-function.pdisplay THEN 
       RUN Update-Function IN hPalette (INPUT pt-function.pcFile,
                                        INPUT pt-function.pcImage, 
                                        INPUT pt-function.pcFname,
                                        INPUT pt-function.perrun,
                                        INPUT oldname). 

  /* Show "*" in the browse (if this isn't displayed) */
/*  DISPLAY t_pdisplay:CHECKED @ pt-function.pdisplay WITH BROWSE {&BROWSE-NAME}.                                      
*/
END.

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


&UNDEFINE SELF-NAME

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _MAIN-BLOCK d_pt-func 


/* ***************************  Main Block  *************************** */
{ adecomm/commeng.i }
{ adecomm/okbar.i &TOOL = "ptls"
                 &CONTEXT = {&Protools_Customize_Dlg_Box} }

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

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

RUN Read-INI.
&IF "{&WINDOW-SYSTEM}" EQ "OSF/Motif" &THEN
    ASSIGN b_Image_Label = "Image:".
&ENDIF
/* 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.
  ASSIGN dfilename:SCREEN-VALUE = ptdat
         rcode                  = brFunc:SELECT-ROW(1)
         h                      = brFunc:HANDLE.
  APPLY "VALUE-CHANGED" TO brFunc.
  WAIT-FOR GO OF FRAME {&FRAME-NAME}.
END.
RUN disable_UI.
IF LAST-EVENT:FUNCTION = "GO" AND changed THEN RUN Redraw IN hPalette.

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


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

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE disable_UI d_pt-func _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 d_pt-func.
END PROCEDURE.

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


&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE Display_Fields d_pt-func 
PROCEDURE Display_Fields :
/* -----------------------------------------------------------
  Purpose:     display attributes of applet
  Parameters:  <none>
  Notes:       
-------------------------------------------------------------*/
      ASSIGN t_Perrun   = pt-function.perrun
             iFileName  = pt-function.pcImage
             pFileName  = pt-function.pcFname
             t_pdisplay = pt-function.pdisplay.
      DISPLAY pt-function.pcFname 
              pt-function.pcFile 
              t_Perrun
              t_pdisplay
              WITH FRAME {&FRAME-NAME}.
      rcode = f_Image:LOAD-IMAGE(?). /* clear */
      rcode = f_Image:LOAD-IMAGE(iFileName,0,0,f_Image:WIDTH-P,f_Image:HEIGHT-P).
END PROCEDURE.

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


&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE enable_UI d_pt-func _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 t_perrun b_Image_Label t_pdisplay t_Save_Loc dfilename 
      WITH FRAME d_pt-func.
  IF AVAILABLE pt-function THEN 
    DISPLAY pt-function.pcFname pt-function.pcFile 
      WITH FRAME d_pt-func.
  ENABLE r_Attributes r_Functions brFunc b_Add b_Remove b_Update f_Image b_up 
         b_down r_Options t_Save_Loc dfilename b_Files2 
      WITH FRAME d_pt-func.
  {&OPEN-BROWSERS-IN-QUERY-d_pt-func}
END PROCEDURE.

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


&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE INI_Error d_pt-func 
PROCEDURE INI_Error :
/* -----------------------------------------------------------
  Purpose:     Error writing to startup file
  Parameters:  <none>
  Notes:       
-------------------------------------------------------------*/
  DEFINE INPUT PARAMETER msg AS CHAR NO-UNDO.
  
  MESSAGE "ERROR writing parameter: " msg "to startup file!" skip
          "You may not have permission to write to this file." skip
          "If you attempting personal changes, you should run" skip
          "from your own copy of protools.dat and startup file."
          VIEW-AS ALERT-BOX ERROR BUTTONS OK.
          
END PROCEDURE.

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


&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE Read-INI d_pt-func 
PROCEDURE Read-INI :
/* -----------------------------------------------------------
  Purpose:     Read startup options
  Parameters:  <none>
  Notes:       
-------------------------------------------------------------*/
  DEFINE VARIABLE get-log AS CHAR NO-UNDO.
/*  
  GET-KEY-VALUE SECTION "ProTools" 
                KEY "ExecuteOnAdeStartup" 
                VALUE get-log.
  IF get-log = "yes" THEN t_Startup = yes.
  ELSE t_Startup = no.
                
  GET-KEY-VALUE SECTION "ProTools" 
                KEY "AddFunctionsToAdeMenuBar" 
                VALUE get-log.  
  IF get-log = "yes" THEN t_Add_To_Menu = yes.
  ELSE t_Add_To_Menu = no.
*/  
  GET-KEY-VALUE SECTION "ProTools" 
                KEY "PaletteLoc" 
                VALUE get-log.  
  IF get-log <> "" THEN t_Save_Loc = yes.
  ELSE t_Save_Loc = no.

END PROCEDURE.

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


&UNDEFINE BROWSE-NAME
&UNDEFINE FRAME-NAME
&UNDEFINE WINDOW-NAME
/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/
/* PROGRAM NAME: _db_gw.p
 * AUTHOR      : Gerry Seidl
 * DATE        : 12/09/94
 * DESCRIPTION : Looks for additional _db records that indicate whether or not this
 *               database is a schema-holder. If so, it returns comma-delimited lists
 *               of the foreign db names (db-name) and their db types (db-type).
 */
DEFINE OUTPUT PARAMETER anygw   AS LOG INITIAL no NO-UNDO.
DEFINE OUTPUT PARAMETER db-name AS CHAR           NO-UNDO.
DEFINE OUTPUT PARAMETER db-type AS CHAR           NO-UNDO.

FOR EACH tinydict._db WHERE tinydict._db._db-name <> ?          AND 
                            tinydict._db._db-type <> "PROGRESS" AND
                            tinydict._db._db-local = no         AND
                            tinydict._db._db-slave = YES NO-LOCK:
   ASSIGN anygw = yes
          db-name = db-name + "," + tinydict._db._db-name
          db-type = db-type + "," + tinydict._db._db-type.
END.
/* Remove leading comma */
IF LENGTH(db-name,"CHARACTER") > 0 THEN db-name = SUBSTRING(db-name,2,-1,"CHARACTER").
IF LENGTH(db-type,"CHARACTER") > 0 THEN db-type = SUBSTRING(db-type,2,-1,"CHARACTER").

RETURN.
 
                   
&ANALYZE-SUSPEND _VERSION-NUMBER UIB_v9r12 GUI
&ANALYZE-RESUME
&Scoped-define WINDOW-NAME C-Win
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _DEFINITIONS C-Win 
/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/
/*------------------------------------------------------------------------

  File: protools/_dblist.w

  Description: DB Connections PRO*Tools window

  Input Parameters:
      <none>

  Output Parameters:
      <none>

  Author: Tammy Marshall

  Created: 04/09/99

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

{ adecomm/_adetool.i }
{ protools/_runonce.i }
{ protools/_schdef.i }  /* TableDetails, FieldDetails, IndexDetails temp table definitions */

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

/* Parameters Definitions ---                                           */

/* Local Variable Definitions ---                                       */
DEFINE VARIABLE run_dblist  AS CHARACTER  NO-UNDO.
DEFINE VARIABLE db_lname    AS CHARACTER  NO-UNDO.
DEFINE VARIABLE cSelcDB     AS CHARACTER  NO-UNDO.  /* currently selected db */
DEFINE VARIABLE iHeightChng AS INTEGER    NO-UNDO.  /* new height of frame and window to display DB connection info */
DEFINE VARIABLE hSchema     AS HANDLE     NO-UNDO.  /* Schema window handle */
DEFINE VARIABLE cTableList  AS CHARACTER  NO-UNDO.  /* comma separated list of table names */  
DEFINE VARIABLE cDBName     AS CHARACTER  NO-UNDO.  /* database name */
DEFINE VARIABLE cDBType     AS CHARACTER  NO-UNDO.  /* type of db - PROGRESS or foreign */
DEFINE VARIABLE hChildWin   AS HANDLE     NO-UNDO.  /* handle of Schema window */
DEFINE VARIABLE lExists     AS LOGICAL    NO-UNDO.  
DEFINE VARIABLE gwflag      AS LOGICAL    NO-UNDO.
DEFINE VARIABLE db-type     AS CHARACTER  NO-UNDO.
DEFINE VARIABLE db-name     AS CHARACTER  NO-UNDO.

/* Shared variable needed when connecting to an Oracle database */
DEFINE NEW SHARED VARIABLE drec_db AS RECID INITIAL ? NO-UNDO.

DEFINE TEMP-TABLE run-list
  FIELD rdb-name  AS CHARACTER /* database name */
  FIELD sh-name  AS CHARACTER /* schema holder name */
  FIELD prg-name AS CHARACTER /* program which uses it */
  INDEX db-name  IS PRIMARY rdb-name.

/* _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 DEFAULT-FRAME

/* Standard List Definitions                                            */
&Scoped-Define ENABLED-OBJECTS bClose db-list bHelp bConnect dbRect 

/* 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 availFld C-Win 
FUNCTION availFld RETURNS LOGICAL
 ( INPUT pcTblName AS CHARACTER, INPUT pcFldName AS CHARACTER)  FORWARD.

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

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION-FORWARD availIdx C-Win 
FUNCTION availIdx RETURNS LOGICAL
 ( INPUT pcTblName AS CHARACTER, INPUT pcIdxName AS CHARACTER)  FORWARD.

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

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION-FORWARD availTbl C-Win 
FUNCTION availTbl RETURNS LOGICAL
  ( INPUT pcTblName AS CHARACTER)  FORWARD.

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

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION-FORWARD dbconn C-Win 
FUNCTION dbconn RETURNS LOGICAL
  (  )  FORWARD.

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

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION-FORWARD getdbName C-Win 
FUNCTION getdbName RETURNS CHARACTER
  ( /* parameter-definitions */ )  FORWARD.

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

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION-FORWARD getdbType C-Win 
FUNCTION getdbType RETURNS CHARACTER
  ( /* parameter-definitions */ )  FORWARD.

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

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION-FORWARD getFld C-Win 
FUNCTION getFld RETURNS CHARACTER
  ( INPUT pcTable AS CHARACTER)  FORWARD.

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

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION-FORWARD getIndx C-Win 
FUNCTION getIndx RETURNS CHARACTER
  ( INPUT cTable AS CHARACTER )  FORWARD.

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

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION-FORWARD getTbl C-Win 
FUNCTION getTbl RETURNS CHARACTER
  ( /* parameter-definitions */ )  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.

/* Definitions of the field level widgets                               */
DEFINE BUTTON bClose 
     LABEL "C&lose" 
     SIZE 20 BY 1.14.

DEFINE BUTTON bConnect 
     LABEL "&Connect" 
     SIZE 20 BY 1.14.

DEFINE BUTTON bHelp 
     LABEL "&Help" 
     SIZE 20 BY 1.14.

DEFINE BUTTON b_DBDetails 
     LABEL "&DB Details >>" 
     SIZE 20 BY 1.14.

DEFINE BUTTON b_disconnect 
     LABEL "D&isconnect" 
     SIZE 20 BY 1.14.

DEFINE BUTTON b_Schema 
     LABEL "&Schema Details" 
     SIZE 20 BY 1.14.

DEFINE VARIABLE eInfo AS CHARACTER 
     VIEW-AS EDITOR NO-WORD-WRAP SCROLLBAR-HORIZONTAL SCROLLBAR-VERTICAL
     SIZE 76 BY 5.24
     FONT 0 NO-UNDO.

DEFINE VARIABLE eLbl AS CHARACTER FORMAT "X(256)":U INITIAL "Connection Information" 
     LABEL "" 
      VIEW-AS TEXT 
     SIZE 23 BY .76 NO-UNDO.

DEFINE RECTANGLE connrect
     EDGE-PIXELS 2 GRAPHIC-EDGE  NO-FILL 
     SIZE 78 BY 6.

DEFINE RECTANGLE dbRect
     EDGE-PIXELS 2 GRAPHIC-EDGE  NO-FILL 
     SIZE 57 BY 8.81.

DEFINE VARIABLE db-list AS CHARACTER 
     VIEW-AS SELECTION-LIST SINGLE 
     SCROLLBAR-HORIZONTAL SCROLLBAR-VERTICAL 
     SIZE 55 BY 8
     FONT 0 NO-UNDO.


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

DEFINE FRAME DEFAULT-FRAME
     bClose AT ROW 1.52 COL 60
     db-list AT ROW 2 COL 3 NO-LABEL
     bHelp AT ROW 2.86 COL 60
     bConnect AT ROW 4.91 COL 60
     b_disconnect AT ROW 6.24 COL 60
     b_Schema AT ROW 7.86 COL 60
     b_DBDetails AT ROW 9.19 COL 60
     eInfo AT ROW 11.33 COL 3 NO-LABEL
     eLbl AT ROW 10.43 COL 2 COLON-ALIGNED
     connrect AT ROW 10.81 COL 2
     dbRect AT ROW 1.52 COL 2
     "Databases" VIEW-AS TEXT
          SIZE 11.2 BY .62 AT ROW 1.19 COL 3.8
    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
   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              = "Database Connections"
         HEIGHT             = 16
         WIDTH              = 80
         MAX-HEIGHT         = 16
         MAX-WIDTH          = 80
         VIRTUAL-HEIGHT     = 16
         VIRTUAL-WIDTH      = 80
         MAX-BUTTON         = no
         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.
/* 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
                                                                        */
/* SETTINGS FOR BUTTON b_DBDetails IN FRAME DEFAULT-FRAME
   NO-ENABLE                                                            */
/* SETTINGS FOR BUTTON b_disconnect IN FRAME DEFAULT-FRAME
   NO-ENABLE                                                            */
/* SETTINGS FOR BUTTON b_Schema IN FRAME DEFAULT-FRAME
   NO-ENABLE                                                            */
/* SETTINGS FOR RECTANGLE connrect IN FRAME DEFAULT-FRAME
   NO-ENABLE                                                            */
ASSIGN 
       connrect:HIDDEN IN FRAME DEFAULT-FRAME           = TRUE.

/* SETTINGS FOR SELECTION-LIST db-list IN FRAME DEFAULT-FRAME
   NO-DISPLAY                                                           */
/* SETTINGS FOR EDITOR eInfo IN FRAME DEFAULT-FRAME
   NO-DISPLAY NO-ENABLE                                                 */
ASSIGN 
       eInfo:HIDDEN IN FRAME DEFAULT-FRAME           = TRUE
       eInfo:READ-ONLY IN FRAME DEFAULT-FRAME        = TRUE.

/* SETTINGS FOR FILL-IN eLbl IN FRAME DEFAULT-FRAME
   NO-DISPLAY NO-ENABLE                                                 */
ASSIGN 
       eLbl:HIDDEN 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

 



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

&Scoped-define SELF-NAME C-Win
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL C-Win C-Win
ON END-ERROR OF C-Win /* Database Connections */
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 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 /* Database Connections */
DO:
  /* This event will close the window and terminate the procedure.  */
  APPLY "CLOSE":U TO THIS-PROCEDURE.
  RETURN NO-APPLY.
END.

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


&Scoped-define SELF-NAME bClose
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL bClose C-Win
ON CHOOSE OF bClose IN FRAME DEFAULT-FRAME /* Close */
DO:
  /* Applying window-close to this window will close this window and will cause
     a parent-window-close event to fire in any child windows */
  APPLY "WINDOW-CLOSE":U TO C-Win.  
END.

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


&Scoped-define SELF-NAME bConnect
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL bConnect C-Win
ON CHOOSE OF bConnect IN FRAME DEFAULT-FRAME /* Connect */
DO:
  Define var lline         as char    NO-UNDO. /* sel-list line */
  
  /* Database Parameters */
  DEFINE VARIABLE PysName       AS CHARACTER    NO-UNDO. /* Physical DB Name */
  DEFINE VARIABLE LogName       AS CHARACTER    NO-UNDO. /* Logical DB Name  */
  DEFINE VARIABLE theType       AS CHARACTER    NO-UNDO. /* DB Name Type - eg. "PROGRESS" */
  DEFINE VARIABLE Db_Multi_User AS LOGICAL      NO-UNDO.

  /* Addl. Parameters */
  DEFINE VARIABLE network       AS CHARACTER    NO-UNDO.
  DEFINE VARIABLE host          AS CHARACTER    NO-UNDO.
  DEFINE VARIABLE service       AS CHARACTER    NO-UNDO.
  DEFINE VARIABLE uid           AS CHARACTER    NO-UNDO.
  DEFINE VARIABLE pwd           AS CHARACTER    NO-UNDO.
  DEFINE VARIABLE trigloc       AS CHARACTER    NO-UNDO.
  DEFINE VARIABLE pfile         AS CHARACTER    NO-UNDO.
  DEFINE VARIABLE uparms        AS CHARACTER    NO-UNDO.
  DEFINE VARIABLE pargs         AS CHARACTER    NO-UNDO.
   
  DEFINE VARIABLE args          AS CHARACTER EXTENT 4 NO-UNDO.
  DEFINE VARIABLE logname2      AS CHARACTER          NO-UNDO.
  DEFINE VARIABLE constring     AS CHARACTER          NO-UNDO.
  
  DEFINE VARIABLE x             AS INTEGER            NO-UNDO.
  DEFINE VARIABLE iPos          AS INTEGER            NO-UNDO.
  
  if substring(db-list:SCREEN-VALUE ,28, -1, "CHARACTER") = "(not connected)" THEN 
  DO: /* connect dataserver */ 
      ASSIGN     
      logname = trim(substring(db-list:SCREEN-VALUE, 1, 15, "CHARACTER"))
      theType = trim(substring(db-list:SCREEN-VALUE,17,11, "CHARACTER"))
      theType = substring(theType,1,length(theType, "CHARACTER") - 1, "CHARACTER").

      run prodict/misc/_getconp.p
              (INPUT        logname,
               INPUT-OUTPUT PysName,
               INPUT-OUTPUT logname2,
               INPUT-OUTPUT theType,
               OUTPUT       trigloc,
               OUTPUT       pfile,
               OUTPUT       Db_Multi_User,
               OUTPUT       network,
               OUTPUT       host,
               OUTPUT       service,
               OUTPUT       uid,
               OUTPUT       pwd,
               OUTPUT       args[2],
               OUTPUT       args[3],
               OUTPUT       args[4]
               ).  
      ASSIGN pargs = trim(args[2] + " " + args[3] + " " + args[4]).
  END.  
  ELSE
  /* Set defaults for the db connect dialog. */
  ASSIGN DB_Multi_User = no
         theType       = "PROGRESS":U.

  run adecomm/_dbconnx.p ( YES,
                          INPUT-OUTPUT PysName,
                          INPUT-OUTPUT LogName,
                          INPUT-OUTPUT theType,       
                          INPUT-OUTPUT Db_Multi_User,
                          INPUT-OUTPUT network,
                          INPUT-OUTPUT host,
                          INPUT-OUTPUT service,
                          INPUT-OUTPUT uid,
                          INPUT-OUTPUT pwd,
                          INPUT-OUTPUT trigloc,
                          INPUT-OUTPUT pfile,
                          INPUT-OUTPUT pargs,
                          OUTPUT       constring ).

  /* Was a database connected */    
  /*message constring length(constring) view-as alert-box. */            
  IF theType = "PROGRESS":U THEN DO:
    
    x = 1.
    DO x = 1 TO NUM-DBS:
      ASSIGN lline                = LDBNAME(x).
             substring(lline, 16, -1, "CHARACTER") = "[" + dbtype(LDBNAME(x)) + "]".
      iPos = LOOKUP(lline,db-list:LIST-ITEMS,db-list:DELIMITER).
      IF DBTYPE(LDBNAME(X)) = "PROGRESS":U AND (iPos = 0 OR iPos = ?) THEN DO:
        db-list:ADD-LAST(lline).
        CREATE ALIAS tinydict FOR DATABASE VALUE(LDBNAME(x)). /* needed for next procedure */
        RUN protools/_db_gw.p (OUTPUT gwflag, OUTPUT db-name, OUTPUT db-type). /* Is schema-holder? If so, of what? */
        DELETE ALIAS tinydict.
        IF gwflag THEN DO x = 1 to NUM-ENTRIES(db-name): /* go after foreign databases */
          ASSIGN lline = "  " + entry(x,db-name)
                 substring(lline,16,-1,"CHARACTER") = "[" + entry(x,db-type) + "]".
          IF NOT CONNECTED(entry(x,db-name)) THEN
                 substring(lline,28,-1,"CHARACTER") = "(not connected)".
          IF db-list:ADD-LAST(lline) THEN.
        END.  /* if gwflag */      
      END.  /* if dbtype = "PROGRESS" and iPos = 0 or ? */
    END.  /* do x = 1 to num-dbs */
  END.  /* if theType = "PROGRESS" */

  IF CONNECTED(logname) THEN DO: /* hey! we connected something */
    IF theType <> "PROGRESS" THEN DO:
        IF NOT db-list:SCREEN-VALUE BEGINS logname THEN DO:
          search-blk:
          DO x = 1 TO db-list:NUM-ITEMS:
            IF TRIM(db-list:ENTRY(x)) BEGINS logname THEN DO:
              ASSIGN lline = db-list:ENTRY(x)
                     db-list:SCREEN-VALUE = lline.
              LEAVE search-blk.
            END.  /* Found the correct line */
          END.  /* search-blk */
        END.  /* If selected line isn't the correct line */
        lline = substring(db-list:SCREEN-VALUE,1,27,"CHARACTER").
        IF db-list:REPLACE(lline, db-list:SCREEN-VALUE) THEN.
        ASSIGN db-list:SCREEN-VALUE   = lline
               b_dbdetails:SENSITIVE    = yes
               b_schema:SENSITIVE     = yes
               b_disconnect:SENSITIVE = yes.
    END.
    IF PysName ne ? AND eInfo:VISIBLE THEN RUN fill-editor.
    IF db-list:NUM-ITEMS <> 0 and db-list:SCREEN-VALUE = ? THEN DO:
        db-list:SCREEN-VALUE = db-list:ENTRY(1).
        APPLY "VALUE-CHANGED" TO db-list.
        IF b_dbdetails:SENSITIVE = no THEN b_dbdetails:SENSITIVE = yes.
        IF b_Schema:SENSITIVE = no THEN b_Schema:SENSITIVE = yes.
    END.
  END.
END.

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


&Scoped-define SELF-NAME bHelp
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL bHelp C-Win
ON CHOOSE OF bHelp IN FRAME DEFAULT-FRAME /* Help */
DO:
  RUN adecomm/_adehelp.p
    (INPUT "ptls":U, 
     INPUT "CONTEXT":U, 
     INPUT 17, 
     INPUT  ?).
END.

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


&Scoped-define SELF-NAME b_DBDetails
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL b_DBDetails C-Win
ON CHOOSE OF b_DBDetails IN FRAME DEFAULT-FRAME /* DB Details >> */
DO:
  /* Need to see if the database is still connected - it may have been 
     disconnected through the data dictionary */
  IF NOT dbconn() THEN DO:
    MESSAGE "You are no longer connected to" CAPS(getdbName()) + " database"
      VIEW-AS ALERT-BOX INFORMATION.
    db-list:DELETE(db-list).  /* remove db from list b/c no longer connected to it */
    IF db-list:NUM-ITEMS > 0 THEN
      ASSIGN db-list:SCREEN-VALUE = db-list:ENTRY(1). 
    IF db-list:SCREEN-VALUE = ? OR db-list:NUM-ITEMS = 0 THEN
      ASSIGN  b_DBDetails:SENSITIVE = no
              b_Schema:SENSITIVE  = no
              b_Disconnect:SENSITIVE = no.
  END.  /* selected database no longer connected */
  
  ELSE DO:  /* selected database is still connected */
    
    /* The expanded Information is HIDDEN if the dialog is alreadey collapsed */
    IF eInfo:HIDDEN THEN
    DO: /* Expand window */
   
      /* Calculate what the window and frame height needs to be changed to 
         when the window initially displays with the DB Connection Info hidden */
      ASSIGN iHeightChng = connrect:ROW + connrect:HEIGHT - 1.0 +
        FRAME {&FRAME-NAME}:BORDER-TOP + 
        FRAME {&FRAME-NAME}:BORDER-BOTTOM +
        0.4.            
           
      ASSIGN {&WINDOW-NAME}:HEIGHT = iHeightChng
             {&WINDOW-NAME}:VIRTUAL-HEIGHT = iHeightChng
             FRAME {&FRAME-NAME}:HEIGHT = iHeightChng   
             FRAME {&FRAME-NAME}:VIRTUAL-HEIGHT = iHeightChng   
             eInfo:HIDDEN = no
             eLbl:HIDDEN  = no
             connrect:HIDDEN = no
             eInfo:SENSITIVE = yes.
                        
      RUN Fill-Editor.
      ASSIGN self:label = "Hide &DB Details <<".
    END.  /* expand window */ 
    ELSE /* collapse window */
    DO:
      ASSIGN iHeightChng = dbrect:ROW + dbrect:HEIGHT - 1.0 +
        FRAME {&FRAME-NAME}:BORDER-TOP + 
        FRAME {&FRAME-NAME}:BORDER-BOTTOM +
        0.4. 

      ASSIGN eInfo:HIDDEN = yes
             connrect:HIDDEN = yes
             eLbl:HIDDEN  = yes 
             FRAME {&FRAME-NAME}:HEIGHT = iHeightChng
             FRAME {&FRAME-NAME}:VIRTUAL-HEIGHT = iHeightChng
             {&WINDOW-NAME}:HEIGHT = iHeightChng
             {&WINDOW-NAME}:VIRTUAL-HEIGHT = iHeightChng
             self:LABEL = "&DB Details >>".
    END.  /* else do - collapse window */
  END.  /* else do - database still connected */
END.  /* choose */

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


&Scoped-define SELF-NAME b_disconnect
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL b_disconnect C-Win
ON CHOOSE OF b_disconnect IN FRAME DEFAULT-FRAME /* Disconnect */
DO:
  DEFINE VARIABLE dbtodisc AS CHARACTER NO-UNDO.
  DEFINE VARIABLE i        AS INTEGER   NO-UNDO.
  DEFINE VARIABLE errmsg   AS CHARACTER NO-UNDO.
  DEFINE VARIABLE prgstr   AS CHARACTER NO-UNDO.
  DEFINE VARIABLE fdstr    AS CHARACTER NO-UNDO.
  
  /* Generate list of database which code is currently running against */
  FOR EACH run-list:
    DELETE run-list.
  END.  /* for each run-list */
  RUN Running_DBList.

  ASSIGN db-list
         dbtodisc = trim(substring(db-list,1,15,"CHARACTER":U)).
  IF CAN-FIND (FIRST run-list WHERE rdb-name EQ dbtodisc) THEN DO:
    FOR EACH run-list WHERE rdb-name EQ dbtodisc:
      prgstr = prgstr + "  " + prg-name + CHR(10).
    END.
    MESSAGE CAPS(dbtodisc) "is in use by the following running procedure" + 
            (IF NUM-ENTRIES(RIGHT-TRIM(prgstr),CHR(10)) > 1 THEN "s:" ELSE ":") skip(1)
            RIGHT-TRIM(prgstr) skip(1)
            CAPS(dbtodisc) "cannot be disconnected until all procedures that" {&SKP}
            "access it are terminated."
            VIEW-AS ALERT-BOX INFORMATION.
    RETURN NO-APPLY.
  END.  
  ELSE IF CAN-FIND (FIRST run-list WHERE sh-name EQ dbtodisc) THEN DO:
    /* Trying to disconnect the schema of a database which has running code! */
    FOR EACH run-list WHERE sh-name EQ dbtodisc BREAK BY rdb-name:
      IF FIRST-OF(rdb-name) THEN 
        prgstr = CHR(10) + "Foreign Database: " + rdb-name + CHR(10) + "Running Procedure(s): " + prg-name.
      ELSE prgstr = prgstr + ", " + prg-name.
    END.
    MESSAGE CAPS(dbtodisc) "is a schema-holder database for at least one foreign" skip
            "database which is currently in use by a running procedure:" skip(1)
            TRIM(prgstr) skip(1)
            CAPS(dbtodisc) "cannot be disconnected until all procedures that" skip
            "access its foreign databases are terminated."
            VIEW-AS ALERT-BOX INFORMATION.
    RETURN NO-APPLY.
  END.    
  IF db-list NE "" THEN DISCONNECT VALUE(dbtodisc) NO-ERROR.  
  IF ERROR-STATUS:ERROR THEN DO: /* Oh no! */
    IF ERROR-STATUS:NUM-MESSAGES > 0 THEN DO:
      DO i = 1 TO ERROR-STATUS:NUM-MESSAGES:
        errmsg = errmsg + ERROR-STATUS:GET-MESSAGE(i) + 
                 (IF i NE ERROR-STATUS:NUM-MESSAGES THEN chr(10) ELSE ""). 
      END.
      MESSAGE errmsg VIEW-AS ALERT-BOX ERROR BUTTONS OK.
    END.
    ELSE MESSAGE "An error occurred during disconnect." 
           VIEW-AS ALERT-BOX ERROR.
    RETURN.
  END. 
  /* Is the database still connected? If so, 'disconnect-pending' */
  IF CONNECTED(dbtodisc) THEN
    MESSAGE "Database: " + dbtodisc + " cannot be disconnected at this time." skip(1)
            "It may be in use by a running procedure or SmartObject." skip(1)
            "It will be disconnected automatically when the last" skip
            "dependant object terminates."
            VIEW-AS ALERT-BOX WARNING.
  ELSE DO:
    RUN initialize-dblist. /* Rebuild list of connected dbs */
    
    /* If Schema window is running then close it */
    IF VALID-HANDLE(hSchema) THEN DO:
      hChildWin = hSchema:CURRENT-WINDOW.
      APPLY "WINDOW-CLOSE":U TO hChildWin.
    END.  /* if Schema window running */
    
    DO i = 1 TO db-list:NUM-ITEMS:
      IF TRIM(SUBSTRING(db-list:ENTRY(i),1,15,"CHARACTER":U)) = dbtodisc THEN
      
      IF SUBSTRING(db-list:ENTRY(i), 28, -1, "CHARACTER") = "(not connected)" THEN.
      ELSE 
        MESSAGE "Database: " + dbtodisc + " cannot be disconnected at this time." skip(1)
                "It may be in use by a running procedure or SmartObject." skip(1)
                "It will be disconnected automatically when the last" skip
                "dependant object terminates."
                VIEW-AS ALERT-BOX WARNING.
    END.
  END.
END.

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


&Scoped-define SELF-NAME b_Schema
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL b_Schema C-Win
ON CHOOSE OF b_Schema IN FRAME DEFAULT-FRAME /* Schema Details */
DO:
  /* Need to see if the selected db is still connected - it may have been 
     disconnected through the data dictionary */
  IF NOT dbconn() THEN DO:
    MESSAGE "You are no longer connected to" CAPS(getDBName()) + " database"
      VIEW-AS ALERT-BOX INFORMATION.
    db-list:DELETE(db-list).  /* remove db from list b/c no longer connected to it */
    RUN initialize-dblist.
    IF db-list:NUM-ITEMS > 0 THEN 
      ASSIGN db-list:SCREEN-VALUE = db-list:ENTRY(1). 
    IF db-list:SCREEN-VALUE = ? OR db-list:NUM-ITEMS = 0 THEN 
      ASSIGN  b_DBDetails:SENSITIVE = no
              b_Schema:SENSITIVE  = no
              b_Disconnect:SENSITIVE = no.
              
    /* If schema window is running, close it and any child windows */          
    IF VALID-HANDLE(hSchema) THEN DO:
      hChildWin = hSchema:CURRENT-WINDOW.
      APPLY "WINDOW-CLOSE":U TO hChildWin.
    END.  /* if Schema window running */
  END.  /* selected database no longer connected */
  
  ELSE DO:  /* db still connected */
    /* If Schema window is running, don't run it again, move it to the top */
    IF VALID-HANDLE(hSchema) THEN DO:
      hChildWin = hSchema:CURRENT-WINDOW.
      hChildWin:MOVE-TO-TOP().
      APPLY "ENTRY":U TO hChildWin.
    END.  /* if Schema detail window is already running */
    
    /* If Schema window is not already running, run it */
    ELSE DO:
      cDBName = getdbName().
      cDBType = getdbType().
    
      IF db-list:SCREEN-VALUE NE ? THEN 
      DO:
          /* We need to determine if this is a Schema holder, if so, we don't 
             run the Schema detail window */
          CREATE ALIAS tinydict FOR DATABASE VALUE(SDBNAME(cDBName)). /* needed for next procedure */
          RUN protools/_db_gw.p (OUTPUT gwflag, OUTPUT db-name, OUTPUT db-type). /* Is schema-holder? If so, of what? */
          DELETE ALIAS tinydict.
          IF gwflag AND cDBType = "PROGRESS" THEN MESSAGE 
            "There are no Schema details to display for Schema holders."
            VIEW-AS ALERT-BOX INFORMATION.
          ELSE DO:  /* this is not a schema holder */
            RUN protools/_schlist.w PERSISTENT SET hSchema (INPUT THIS-PROCEDURE).
            RUN RefreshSchema IN hSchema (INPUT cDBName, INPUT cDBType, INPUT getTbl()).
          END.  /* else do - not schema holder */
      END.  /* if db-list screen value ne ? */
      ELSE MESSAGE "You must select a database." VIEW-AS ALERT-BOX ERROR BUTTONS OK.
    END.  /* else do - Schema window not already running */
  END.  /* else do - db is still connected */
END.  /* choose */

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


&Scoped-define SELF-NAME db-list
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL db-list C-Win
ON VALUE-CHANGED OF db-list IN FRAME DEFAULT-FRAME
DO:
  /* If the foreign db is not connected, disconnected, schema detail and db details
     buttons should not be available */
  IF SUBSTRING(db-list:SCREEN-VALUE, 28, -1,"CHARACTER") = "(not connected)" THEN DO:
  
    IF eInfo:VISIBLE IN FRAME {&FRAME-NAME} = yes THEN DO:
      ASSIGN eInfo:HIDDEN IN FRAME {&FRAME-NAME}    = yes
         connrect:HIDDEN IN FRAME {&FRAME-NAME} = yes
         eLbl:HIDDEN  IN FRAME {&FRAME-NAME}    = yes
         &IF "{&WINDOW-SYSTEM}" EQ "OSF/Motif" &THEN
           b_DBDetails:LABEL = "DB Details >>".
         &ELSE
           b_DBDetails:LABEL = "&DB Details >>".
         &ENDIF  
  
      /* Calculate what the window and frame height needs to be changed to 
         when the window initially displays with the DB Connection Info hidden */
      ASSIGN iHeightChng = dbrect:ROW + dbrect:HEIGHT - 1.0 +
        FRAME {&FRAME-NAME}:BORDER-TOP + 
        FRAME {&FRAME-NAME}:BORDER-BOTTOM +
        0.4.

        ASSIGN FRAME {&FRAME-NAME}:HEIGHT = iHeightChng
             FRAME {&FRAME-NAME}:VIRTUAL-HEIGHT = iHeightChng
             {&WINDOW-NAME}:HEIGHT = iHeightChng
             {&WINDOW-NAME}:VIRTUAL-HEIGHT = iHeightChng.  

    END.  /* if Db Details visible */
    
    ASSIGN 
      b_disconnect:SENSITIVE = no
      b_Schema:SENSITIVE = no
      b_DBDetails:SENSITIVE = no.

    IF VALID-HANDLE(hSchema) THEN DO:
      hChildWin = hSchema:CURRENT-WINDOW.
      APPLY "WINDOW-CLOSE":U TO hChildWin.
    END.  /* if Schema window running */
    RETURN.
  END.  /* if foreign db not connected */
  ELSE b_disconnect:SENSITIVE = yes.

  /* Need to see if the selected db is still connected - it may have been 
     disconnected through the data dictionary */
  IF NOT dbconn() THEN DO:
    MESSAGE "You are not longer connected to" CAPS(cSelcDB) + " database" 
      VIEW-AS ALERT-BOX INFORMATION.
    db-list:DELETE(db-list).  /* remove db from list b/c no longer connected to it */
    RUN initialize-dblist.
    IF db-list:NUM-ITEMS > 0 THEN 
      ASSIGN db-list:SCREEN-VALUE = db-list:ENTRY(1). 
    IF VALID-HANDLE(hSchema) THEN DO:
      hChildWin = hSchema:CURRENT-WINDOW.
      APPLY "WINDOW-CLOSE":U TO hChildWin.
    END.  /* if Schema window running */
  END.  /* if database no longer connected */

  ELSE DO:  /* selected db still connected */
    IF eInfo:VISIBLE THEN RUN fill-editor. /* Show more info about the database */
    ASSIGN 
      b_Schema:SENSITIVE = yes
      b_DBDetails:SENSITIVE = yes.

    /* If Schema window is open, need to get a list of tables for the
       database that user has selected */
    IF VALID-HANDLE(hSchema) THEN DO:
      cDBName = TRIM(substring(db-list:SCREEN-VALUE,1,15,"CHARACTER")).
      cDBType = TRIM(substring(db-list:SCREEN-VALUE,17,11,"CHARACTER")).
      cDBType = substring(cDBType,1,length(cDBType,"CHARACTER") - 1,"CHARACTER").

      IF db-list:SCREEN-VALUE NE ? THEN 
      DO:
        /* We need to determine if this is a Schema holder, if so, we close
           the Schema detail window */
        CREATE ALIAS tinydict FOR DATABASE VALUE(SDBNAME(cDBName)). /* needed for next procedure */
        RUN protools/_db_gw.p (OUTPUT gwflag, OUTPUT db-name, OUTPUT db-type). /* Is schema-holder? If so, of what? */
        DELETE ALIAS tinydict.
        IF gwflag AND cDBType = "PROGRESS" THEN DO:
          MESSAGE "There are no Schema details to display for Schema holders."
            VIEW-AS ALERT-BOX INFORMATION.
          hChildWin = hSchema:CURRENT-WINDOW.
          APPLY "WINDOW-CLOSE":U TO hChildWin.
        END.  /* if schema holder */
        ELSE DO:
          CREATE ALIAS tinydict FOR DATABASE VALUE(SDBNAME(cDBName)).
          RUN protools/_tbllist.p (INPUT cDBType, INPUT cDBName, OUTPUT cTableList).
          DELETE ALIAS tinydict.
          RUN RefreshSchema IN hSchema (INPUT cDBName, INPUT cDBType, INPUT cTableList).
        END.  /* else do - not schema holder */
      END.  /* if db-list screen value NE ? */
    END.  /* if schema detail running */
  END.  /* else do - db still connected */
END.  /* value-changed */

/* _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.

/* Initialize lists */
RUN initialize-dblist.

/* 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.
  APPLY "ENTRY":U TO C-Win.
  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 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.
------------------------------------------------------------------------------*/
  ENABLE bClose db-list bHelp bConnect dbRect 
      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 Fill-Editor C-Win 
PROCEDURE Fill-Editor :
/* -----------------------------------------------------------
  Purpose:     Fill editor with db info.
  Parameters:  <none>
  Notes:       
-------------------------------------------------------------*/
  ASSIGN 
    db_lname = trim(substring(db-list:SCREEN-VALUE IN FRAME {&FRAME-NAME}, 1, 15,"CHARACTER"))
    cDBType = trim(substring(db-list:SCREEN-VALUE,17,11,"CHARACTER"))
    cDBType = substring(cDBType,1,length(cDBType,"CHARACTER") - 1, "CHARACTER").

  IF db_lname = "" OR db_lname = ? THEN
  ASSIGN einfo = "Database  n/a" + chr(10) +
                 "  Physical Name: n/a" + chr(10) +
                 "  Database Type: n/a" + chr(10) +
                 "  Schema Name  : n/a" + chr(10) +
                 "  Restrictions : n/a". 
  ELSE 
  ASSIGN eInfo = "Database " + db_lname + chr(10) +
                 "  Physical Name: " + (IF PDBNAME(db_lname) = ? THEN "n/a" ELSE PDBNAME(db_lname)) + chr(10)
         eInfo = eInfo + "  Database Type: " + (IF DBTYPE(db_lname) = ?  THEN cDBType ELSE DBTYPE(db_lname))  + chr(10)
         eInfo = eInfo + "  Schema Holder: " + (IF SDBNAME(db_lname) = ? THEN "n/a" ELSE SDBNAME(db_lname)) + chr(10)
         eInfo = eInfo + "  Restrictions : " + (IF DBRESTRICTIONS(db_lname) = "" THEN "None" 
                                       ELSE DBRESTRICTIONS(db_lname)) + CHR(10)
         eInfo = eInfo + (IF DBTYPE(db_lname) NE "PROGRESS" THEN "" ELSE "    DB Version : " + (IF DBVERSION(db_lname) = ? THEN "" ELSE DBVERSION(db_lname)) + CHR(10))
         eInfo = eInfo + "Connect Params : " + (IF DBPARAM(db_lname) = ? THEN "" ELSE DBPARAM(db_lname)) + CHR(10) 
         eInfo = eInfo + "     Code Page : " + (IF DBCODEPAGE(db_lname) = ? THEN "" ELSE DBCODEPAGE(db_lname)) + CHR(10)
         eInfo = eInfo + "     Collation : " + (IF DBCOLLATION(db_lname) = ? THEN "" ELSE DBCOLLATION(db_lname))
  .
  DISPLAY eLbl eInfo with frame {&FRAME-NAME}.
END PROCEDURE.

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

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE getFieldDetails C-Win 
PROCEDURE getFieldDetails :
/*------------------------------------------------------------------------------
  Purpose: This procedure accepts a temp-table with a record for the
           currently selected field.  It calls _getfld which poplulates
           the temp-table with the field details to display in the Field
           Detail window.     
  Parameters:  <none>
  Notes:       
------------------------------------------------------------------------------*/
DEFINE INPUT-OUTPUT PARAMETER TABLE FOR FieldDetails.

  cDBName = getdbName().
  cDBType = getdbType().
    
  IF db-list:SCREEN-VALUE IN FRAME {&FRAME-NAME} NE ? THEN 
  DO:
      CREATE ALIAS tinydict FOR DATABASE VALUE(SDBNAME(cDBName)).
      RUN protools/_getfld.p (INPUT cDBType, INPUT cDBName, INPUT-OUTPUT TABLE FieldDetails).
      DELETE ALIAS tinydict.
  END.

END PROCEDURE.

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

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE getIndexDetails C-Win 
PROCEDURE getIndexDetails :
/*------------------------------------------------------------------------------
  Purpose: This procedure accepts a temp-table with a record for the
           currently selected field.  It calls _getidx which poplulates
           the temp-table with the index details to display in the Index
           Detail window.         
  Parameters:  <none>
  Notes:       
------------------------------------------------------------------------------*/
DEFINE INPUT-OUTPUT PARAMETER TABLE FOR IndexDetails.
DEFINE OUTPUT PARAMETER TABLE FOR IndxFldDetails.

  cDBName = getdbName().
  cDBType = getdbType().
    
  IF db-list:SCREEN-VALUE IN FRAME {&FRAME-NAME} NE ? THEN 
  DO:
      CREATE ALIAS tinydict FOR DATABASE VALUE(SDBNAME(cDBName)).
      RUN protools/_getidx.p (INPUT cDBType, INPUT cDBName, INPUT-OUTPUT TABLE IndexDetails, OUTPUT TABLE IndxFldDetails).
      DELETE ALIAS tinydict.
  END.

END PROCEDURE.

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

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE getTableDetails C-Win 
PROCEDURE getTableDetails :
/*------------------------------------------------------------------------------
  Purpose: This procedure accepts a temp-table with a record for the
           currently selected table.  It calls _gettbl which poplulates
           the temp-table with the table details to display in the Table
           Detail window.    
  Parameters:  <none>
  Notes:       
------------------------------------------------------------------------------*/
DEFINE INPUT-OUTPUT PARAMETER TABLE FOR TableDetails.

  cDBName = getdbName().
  cDBType = getdbType().
    
  IF db-list:SCREEN-VALUE IN FRAME {&FRAME-NAME} NE ? THEN 
  DO:
      CREATE ALIAS tinydict FOR DATABASE VALUE(SDBNAME(cDBName)).
      RUN protools/_gettbl.p (INPUT cDBType, INPUT cDBName, INPUT-OUTPUT TABLE TableDetails).
      DELETE ALIAS tinydict.
  END.
  
END PROCEDURE.

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

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE initialize-dblist C-Win 
PROCEDURE initialize-dblist :
/* -----------------------------------------------------------
  Purpose:     Create a list of Connected databases.  Assign
               the first one as the "current" selection and
               show the info about it.  
  Parameters:  <none>
  Notes:       
-------------------------------------------------------------*/
  DEFINE VARIABLE x       AS INTEGER                NO-UNDO.
  DEFINE VARIABLE i       AS INTEGER                NO-UNDO.
  DEFINE VARIABLE lline   AS CHAR    FORMAT "X(40)" NO-UNDO.
  
  ASSIGN eInfo:HIDDEN IN FRAME {&FRAME-NAME}    = yes
         connrect:HIDDEN IN FRAME {&FRAME-NAME} = yes
         eLbl:HIDDEN  IN FRAME {&FRAME-NAME}    = yes
         &IF "{&WINDOW-SYSTEM}" EQ "OSF/Motif" &THEN
           b_DBDetails:LABEL = "DB Details >>".
         &ELSE
           b_DBDetails:LABEL = "&DB Details >>".
         &ENDIF  
  
  /* Calculate what the window and frame height needs to be changed to 
     when the window initially displays with the DB Connection Info hidden */
  ASSIGN iHeightChng = dbrect:ROW + dbrect:HEIGHT - 1.0 +
    FRAME {&FRAME-NAME}:BORDER-TOP + 
    FRAME {&FRAME-NAME}:BORDER-BOTTOM +
    0.4.

  ASSIGN FRAME {&FRAME-NAME}:HEIGHT = iHeightChng
         FRAME {&FRAME-NAME}:VIRTUAL-HEIGHT = iHeightChng
         {&WINDOW-NAME}:HEIGHT = iHeightChng
         {&WINDOW-NAME}:VIRTUAL-HEIGHT = iHeightChng.  
         
  DO WITH FRAME {&FRAME-NAME}:
    ASSIGN db-list:SCREEN-VALUE = ""
           db-list:LIST-ITEMS   = "".
    DO i = 1 to NUM-DBS: /* loop through connected databases */
      IF DBTYPE(ldbname(i)) <> "PROGRESS" THEN next. /* skip non-progress databases */
      ASSIGN lline                = ldbname(i)
             substring(lline, 16, -1, "CHARACTER") = "[" + DBTYPE(ldbname(i)) + "]".
      IF db-list:ADD-LAST(lline) THEN.
      CREATE ALIAS tinydict FOR DATABASE VALUE(ldbname(i)).
      RUN protools/_db_gw.p (OUTPUT gwflag, OUTPUT db-name, OUTPUT db-type). /* Is schema-holder? If so, of what? */
      DELETE ALIAS tinydict.
      IF gwflag THEN DO x = 1 to NUM-ENTRIES(db-name): /* go after foreign databases */
          ASSIGN lline = "  " + entry(x,db-name).
                 SUBSTRING(lline, 16, -1, "CHARACTER") = "[" + entry(x,db-type) + "]".
          IF NOT CONNECTED(entry(x,db-name)) THEN
                 SUBSTRING(lline, 28, -1, "CHARACTER") = "(not connected)".
          IF db-list:ADD-LAST(lline) THEN.
      END.
    END.
    IF NUM-DBS > 0 THEN db-list:SCREEN-VALUE = db-list:ENTRY(1).
  END.
  IF eInfo:VISIBLE THEN RUN fill-editor.  
  IF db-list:SCREEN-VALUE = ? OR db-list:NUM-ITEMS = 0 THEN
      ASSIGN  b_DBDetails:SENSITIVE = no
              b_Schema:SENSITIVE  = no
              b_Disconnect:SENSITIVE = no.
  ELSE ASSIGN b_DBDetails:SENSITIVE = yes
              b_Schema:SENSITIVE  = yes
              b_Disconnect:SENSITIVE = yes.
END PROCEDURE.

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

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE Running_DBList C-Win 
PROCEDURE Running_DBList :
/* -----------------------------------------------------------
  Purpose:     Build used db list.
  Parameters:  <none>
  Notes:       
-------------------------------------------------------------*/
  DEFINE VARIABLE h       AS HANDLE.
  DEFINE VARIABLE i       AS INTEGER   NO-UNDO.
  DEFINE VARIABLE dbentry AS CHARACTER NO-UNDO.

  /* Run through the list of procedures and build a list
   * of databases which they rely on
   */
  ASSIGN h = SESSION:FIRST-PROCEDURE.
  DO WHILE VALID-HANDLE(h):
    DO i = 1 TO NUM-ENTRIES(h:DB-REFERENCES):
      ASSIGN dbentry = ENTRY(i, h:DB-REFERENCES).
      IF LOOKUP(dbentry, run_dblist) = 0 THEN
        FIND run-list WHERE rdb-name = dbentry AND
                              prg-name = h:FILE-NAME NO-ERROR.
        IF NOT AVAILABLE run-list THEN DO:
          CREATE run-list.
          ASSIGN 
            run-list.rdb-name  = dbentry
            run-list.sh-name  = (IF SDBNAME(dbentry) NE dbentry THEN SDBNAME(dbentry) ELSE ?)
            run-list.prg-name = h:FILE-NAME.
        END.
    END.    
    h = h:NEXT-SIBLING.
  END.

END PROCEDURE.

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

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

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION availFld C-Win 
FUNCTION availFld RETURNS LOGICAL
 ( INPUT pcTblName AS CHARACTER, INPUT pcFldName AS CHARACTER) :
/*------------------------------------------------------------------------------
  Purpose: This function determines if a field still exists in the database, it
           may have been removed through the data dictionary  
    Notes:  
------------------------------------------------------------------------------*/
  cDBName = getdbName().
  cDBType = getdbType().
    
  IF db-list:SCREEN-VALUE IN FRAME {&FRAME-NAME} NE ? THEN 
  DO:
    CREATE ALIAS tinydict FOR DATABASE VALUE(SDBNAME(cDBName)).
    RUN protools/_fldavbl.p (INPUT cDBType, INPUT cDBName, INPUT pcTblName, 
      INPUT pcFldName, OUTPUT lExists).
    DELETE ALIAS tinydict.
  END.  /* if dblist screen-value NE ? */
  RETURN lExists.   /* Function return value. */

END FUNCTION.

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

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION availIdx C-Win 
FUNCTION availIdx RETURNS LOGICAL
 ( INPUT pcTblName AS CHARACTER, INPUT pcIdxName AS CHARACTER) :
/*------------------------------------------------------------------------------
  Purpose: This function determines if an Index still exists in the database, it
           may have been removed through the data dictionary  
    Notes:  
------------------------------------------------------------------------------*/
  cDBName = getdbName().
  cDBType = getdbType().
    
  IF db-list:SCREEN-VALUE IN FRAME {&FRAME-NAME} NE ? THEN 
  DO:
    CREATE ALIAS tinydict FOR DATABASE VALUE(SDBNAME(cDBName)).
    RUN protools/_idxavbl.p (INPUT cDBType, INPUT cDBName, INPUT pcTblName, 
      INPUT pcIdxName, OUTPUT lExists).
    DELETE ALIAS tinydict.
  END.  /* if dblist screen-value NE ? */
  RETURN lExists.   /* Function return value. */

END FUNCTION.

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

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION availTbl C-Win 
FUNCTION availTbl RETURNS LOGICAL
  ( INPUT pcTblName AS CHARACTER) :
/*------------------------------------------------------------------------------
  Purpose: This function determines if a Table still exists in the database, it 
           may have been removed through the data dictionary
    Notes:  
------------------------------------------------------------------------------*/
  cDBName = getdbName().
  cDBType = getdbType().
    
  IF db-list:SCREEN-VALUE IN FRAME {&FRAME-NAME} NE ? THEN 
  DO:
    CREATE ALIAS tinydict FOR DATABASE VALUE(SDBNAME(cDBName)).
    RUN protools/_tblavbl.p (INPUT cDBType, INPUT cDBName, INPUT pcTblName, OUTPUT lExists).
    DELETE ALIAS tinydict.
  END.  /* if dblist screen-value NE ? */
  RETURN lExists.   /* Function return value. */

END FUNCTION.

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

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION dbconn C-Win 
FUNCTION dbconn RETURNS LOGICAL
  (  ) :
/*------------------------------------------------------------------------------
  Purpose: This function determines whether the selected database is still
           still connected.  It may have been disconnected by the user (though
           the dictionary, for example).  
    Notes:  
------------------------------------------------------------------------------*/
  DO WITH FRAME {&FRAME-NAME}:
    ASSIGN db-list
      cSelcDB = trim(substring(db-list,1,15,"CHARACTER":U)).
  END.  /* do with frame */
  IF NOT CONNECTED(cSelcDB) THEN RETURN FALSE.
  ELSE RETURN TRUE.   /* Function return value. */

END FUNCTION.

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

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION getdbName C-Win 
FUNCTION getdbName RETURNS CHARACTER
  ( /* parameter-definitions */ ) :
/*------------------------------------------------------------------------------
  Purpose: Returns name of currently selected database 
    Notes:  
------------------------------------------------------------------------------*/

  RETURN TRIM(substring(db-list:SCREEN-VALUE IN FRAME {&FRAME-NAME},1,15,"CHARACTER")). /* Function return value. */

END FUNCTION.

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

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION getdbType C-Win 
FUNCTION getdbType RETURNS CHARACTER
  ( /* parameter-definitions */ ) :
/*------------------------------------------------------------------------------
  Purpose: Returns the type for the currently selected database 
    Notes:  
------------------------------------------------------------------------------*/
DEFINE VARIABLE cType AS CHARACTER NO-UNDO.
  
  cType = TRIM(substring(db-list:SCREEN-VALUE IN FRAME {&FRAME-NAME},17,11,"CHARACTER")).
  cType = substring(cType,1,length(cType,"CHARACTER") - 1,"CHARACTER").

  RETURN cType.   /* Function return value. */

END FUNCTION.

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

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION getFld C-Win 
FUNCTION getFld RETURNS CHARACTER
  ( INPUT pcTable AS CHARACTER) :
/*------------------------------------------------------------------------------
  Purpose: This function is called from the Schema window with a table name, it 
           creates an alias for the currently selected database and runs a procedure 
           to get a comma separated list of field names.  It passes the list of
           field names back to the Schema window.   
    Notes:  
------------------------------------------------------------------------------*/
  cDBName = getdbName().
  cDBType = getdbType().
    
  IF db-list:SCREEN-VALUE IN FRAME {&FRAME-NAME} NE ? THEN 
  DO:
      CREATE ALIAS tinydict FOR DATABASE VALUE(SDBNAME(cDBName)).
      RUN protools/_fldlist.p (INPUT cDBType, INPUT cDBName, INPUT pcTable, OUTPUT cTableList).
      DELETE ALIAS tinydict.
  END.  /* if db-list screen-value ne ? */
  RETURN cTableList.   /* Function return value. */

END FUNCTION.

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

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION getIndx C-Win 
FUNCTION getIndx RETURNS CHARACTER
  ( INPUT cTable AS CHARACTER ) :
/*------------------------------------------------------------------------------
  Purpose: This function is called from the Schema window with a table name, it 
           creates an alias for the currently selected database and runs a procedure 
           to get a comma separated list of index names.  It passes the list of
           index names back to the Schema window. 
    Notes:  
------------------------------------------------------------------------------*/
  cDBName = getdbName().
  cDBType = getdbType().
    
  IF db-list:SCREEN-VALUE IN FRAME {&FRAME-NAME} NE ? THEN 
  DO:
      CREATE ALIAS tinydict FOR DATABASE VALUE(SDBNAME(cDBName)).
      RUN protools/_idxlist.p (INPUT cDBType, INPUT cDBName, INPUT cTable, OUTPUT cTableList).
      DELETE ALIAS tinydict.
  END.  /* if db-list screen-value ne ? */
  RETURN cTableList.   /* Function return value. */

END FUNCTION.

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

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION getTbl C-Win 
FUNCTION getTbl RETURNS CHARACTER
  ( /* parameter-definitions */ ) :
/*------------------------------------------------------------------------------
  Purpose: This function creates an alias for the currently selected database and 
           runs a procedure to get a comma separated list of table names.
    Notes:  
------------------------------------------------------------------------------*/
  cDBName = getdbName().
  cDBType = getdbType().
    
  IF db-list:SCREEN-VALUE IN FRAME {&FRAME-NAME} NE ? THEN 
  DO:
    CREATE ALIAS tinydict FOR DATABASE VALUE(SDBNAME(cDBName)).
    RUN protools/_tbllist.p (INPUT cDBType, INPUT cDBName, OUTPUT cTableList).
    DELETE ALIAS tinydict.
  END.  /* if dblist screen-value NE ? */
  RETURN cTableList.   /* Function return value. */
 
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.                           *
*                                                                    *
*********************************************************************/
/* _edfont.p --  Calls the SYSTEM FONT EDITOR for font 2,  */
/*               which is the default editor font for all  */
/*               ADE tools. [Note: changes may be saved in */
/*               your PROGRESS.INI file]                   */
/*               Used by _uibspcl window.                  */
/* Wm.T.Wood - July 1993                                   */

SYSTEM-DIALOG FONT 2 FIXED-ONLY.
/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/
/*PROGRAM NAME: _fldavbl.p
 * AUTHOR      : Tammy Marshall
 * DATE        : 04/01/99
 * DESCRIPTION : Accepts a table name and field name and returns a logical 
 *               indicating whether the field still exists in the table in the DB.
 * */
 
DEFINE INPUT PARAMETER pcDBType AS CHARACTER NO-UNDO.
DEFINE INPUT PARAMETER pcDBName AS CHARACTER NO-UNDO.
DEFINE INPUT PARAMETER pcTblName AS CHARACTER NO-UNDO.
DEFINE INPUT PARAMETER pcFldName AS CHARACTER NO-UNDO.
DEFINE OUTPUT PARAMETER plExists AS LOGICAL NO-UNDO.

DEFINE VARIABLE rDB AS RECID NO-UNDO.

IF pcDBType = "PROGRESS" THEN
    FIND tinydict._db WHERE tinydict._db._db-name = ? AND 
        tinydict._db._db-type = "PROGRESS" NO-LOCK NO-ERROR. /*local */
ELSE
    FIND tinydict._db WHERE tinydict._db._db-name = pcDBName AND 
        tinydict._db._db-type = pcDBType NO-LOCK NO-ERROR. /* foreign */
rDB = RECID(tinydict._db).

FIND tinydict._File WHERE RECID(tinydict._db) = rDB AND
  tinydict._File._File-Name = pcTblName NO-LOCK NO-ERROR.
IF AVAILABLE _File THEN DO:
  FIND tinydict._Field WHERE _Field._File-Recid = RECID(_File) AND
    _Field._Field-Name = pcFldName NO-LOCK NO-ERROR.
  IF AVAILABLE _Field THEN plExists = TRUE.
  ELSE plExists = FALSE.
END.  /* if avail _file */
ELSE plExists = FALSE.  

&ANALYZE-SUSPEND _VERSION-NUMBER UIB_v9r12 GUI
&ANALYZE-RESUME
&Scoped-define WINDOW-NAME C-Win
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _DEFINITIONS C-Win 
/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/
/*------------------------------------------------------------------------

  File: protools/_flddetl.w

  Description: Field Detail Window of the DB Connections PRO*Tool

  Input Parameters:
      hParentWin - Handle of the Schema Detail Window

  Output Parameters:
      <none>

  Author: Tammy Marshall

  Created: 04/09/99

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

{protools/_schdef.i}  /* FieldDetails temp table definition */

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

/* Parameters Definitions ---                                           */
DEFINE INPUT PARAMETER hParentWin AS HANDLE NO-UNDO.

/* Local Variable Definitions ---                                       */

/* _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 DEFAULT-FRAME

/* Standard List Definitions                                            */
&Scoped-Define ENABLED-OBJECTS cname cdatatype cformat iorder clabel ~
idecimals ccollabel iextent casgntrig cinitial chelp cvalexp cvalmsg ~
cviewas cdesc bClose bHelp 
&Scoped-Define DISPLAYED-OBJECTS cname cdatatype cformat iorder clabel ~
idecimals ccollabel iextent casgntrig cinitial chelp cvalexp cvalmsg ~
cviewas cdesc lmandatory lcasesen 

/* 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 C-Win AS WIDGET-HANDLE NO-UNDO.

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

DEFINE BUTTON bHelp 
     LABEL "&Help" 
     SIZE 15 BY 1.14.

DEFINE VARIABLE cdesc AS CHARACTER 
     VIEW-AS EDITOR SCROLLBAR-VERTICAL
     SIZE 45 BY 3.33
     BGCOLOR 15 FGCOLOR 0  NO-UNDO.

DEFINE VARIABLE cviewas AS CHARACTER 
     VIEW-AS EDITOR SCROLLBAR-VERTICAL
     SIZE 45 BY 3.33
     BGCOLOR 15 FGCOLOR 0  NO-UNDO.

DEFINE VARIABLE casgntrig AS CHARACTER FORMAT "X(256)":U 
     LABEL "Assign Trig" 
     VIEW-AS FILL-IN 
     SIZE 30 BY 1
     BGCOLOR 15 FGCOLOR 0  NO-UNDO.

DEFINE VARIABLE ccollabel AS CHARACTER FORMAT "X(30)":U 
     LABEL "Col. Label" 
     VIEW-AS FILL-IN 
     SIZE 26 BY 1
     BGCOLOR 15 FGCOLOR 0  NO-UNDO.

DEFINE VARIABLE cdatatype AS CHARACTER FORMAT "X(15)":U 
     LABEL "Data Type" 
     VIEW-AS FILL-IN 
     SIZE 25 BY 1
     BGCOLOR 15 FGCOLOR 0  NO-UNDO.

DEFINE VARIABLE cformat AS CHARACTER FORMAT "X(45)":U 
     LABEL "Format" 
     VIEW-AS FILL-IN 
     SIZE 45 BY 1
     BGCOLOR 15 FGCOLOR 0  NO-UNDO.

DEFINE VARIABLE chelp AS CHARACTER FORMAT "X(256)":U 
     LABEL "Help" 
     VIEW-AS FILL-IN 
     SIZE 82 BY 1
     BGCOLOR 15 FGCOLOR 0  NO-UNDO.

DEFINE VARIABLE cinitial AS CHARACTER FORMAT "X(30)":U INITIAL "0" 
     LABEL "Initial" 
     VIEW-AS FILL-IN 
     SIZE 25 BY 1
     BGCOLOR 15 FGCOLOR 0  NO-UNDO.

DEFINE VARIABLE clabel AS CHARACTER FORMAT "X(30)":U 
     LABEL "Label" 
     VIEW-AS FILL-IN 
     SIZE 45 BY 1
     BGCOLOR 15 FGCOLOR 0  NO-UNDO.

DEFINE VARIABLE cname AS CHARACTER FORMAT "X(30)":U 
     LABEL "Field Name" 
     VIEW-AS FILL-IN 
     SIZE 45 BY 1
     BGCOLOR 15 FGCOLOR 0  NO-UNDO.

DEFINE VARIABLE cvalexp AS CHARACTER FORMAT "X(256)":U 
     LABEL "Valexp" 
     VIEW-AS FILL-IN 
     SIZE 82 BY 1
     BGCOLOR 15 FGCOLOR 0  NO-UNDO.

DEFINE VARIABLE cvalmsg AS CHARACTER FORMAT "X(256)":U 
     LABEL "Valmsg" 
     VIEW-AS FILL-IN 
     SIZE 82 BY 1
     BGCOLOR 15 FGCOLOR 0  NO-UNDO.

DEFINE VARIABLE idecimals AS INTEGER FORMAT ">>>9":U INITIAL 0 
     LABEL "Decimals" 
     VIEW-AS FILL-IN 
     SIZE 9 BY 1
     BGCOLOR 15 FGCOLOR 0  NO-UNDO.

DEFINE VARIABLE iextent AS INTEGER FORMAT ">>>9":U INITIAL 0 
     LABEL "Extent" 
     VIEW-AS FILL-IN 
     SIZE 9 BY 1
     BGCOLOR 15 FGCOLOR 0  NO-UNDO.

DEFINE VARIABLE iorder AS INTEGER FORMAT ">>>9":U INITIAL 0 
     LABEL "Order #" 
     VIEW-AS FILL-IN 
     SIZE 9 BY 1
     BGCOLOR 15 FGCOLOR 0  NO-UNDO.

DEFINE VARIABLE lcasesen AS LOGICAL INITIAL no 
     LABEL "Case Sensitive":L 
     VIEW-AS TOGGLE-BOX
     SIZE 18 BY .86 NO-UNDO.

DEFINE VARIABLE lmandatory AS LOGICAL INITIAL no 
     LABEL "Mandatory":L 
     VIEW-AS TOGGLE-BOX
     SIZE 14 BY .86 NO-UNDO.


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

DEFINE FRAME DEFAULT-FRAME
     cname AT ROW 1.38 COL 13 COLON-ALIGNED
     cdatatype AT ROW 1.48 COL 70 COLON-ALIGNED
     cformat AT ROW 2.67 COL 13 COLON-ALIGNED
     iorder AT ROW 2.76 COL 70 COLON-ALIGNED
     clabel AT ROW 4 COL 13 COLON-ALIGNED
     idecimals AT ROW 4.1 COL 70 COLON-ALIGNED
     ccollabel AT ROW 5.29 COL 13 COLON-ALIGNED
     iextent AT ROW 5.38 COL 70 COLON-ALIGNED
     casgntrig AT ROW 6.57 COL 13 COLON-ALIGNED
     cinitial AT ROW 6.67 COL 70 COLON-ALIGNED
     chelp AT ROW 7.86 COL 13 COLON-ALIGNED
     cvalexp AT ROW 9.19 COL 13 COLON-ALIGNED
     cvalmsg AT ROW 10.48 COL 13 COLON-ALIGNED
     cviewas AT ROW 12.91 COL 52 NO-LABEL
     cdesc AT ROW 12.95 COL 5.8 NO-LABEL
     lmandatory AT ROW 16.76 COL 14
     lcasesen AT ROW 16.76 COL 53
     bClose AT ROW 18.43 COL 18.6
     bHelp AT ROW 18.43 COL 66.4
     "Description:" VIEW-AS TEXT
          SIZE 12 BY .67 AT ROW 12 COL 6.6
     "View-As phrase:" VIEW-AS TEXT
          SIZE 15 BY .67 AT ROW 12 COL 52.6
    WITH 1 DOWN NO-BOX KEEP-TAB-ORDER OVERLAY 
         SIDE-LABELS NO-UNDERLINE THREE-D 
         AT COL 1 ROW 1
         SIZE 98 BY 19.


/* *********************** 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              = "Field Details"
         HEIGHT             = 19.05
         WIDTH              = 98.8
         MAX-HEIGHT         = 19.91
         MAX-WIDTH          = 118.2
         VIRTUAL-HEIGHT     = 19.91
         VIRTUAL-WIDTH      = 118.2
         MAX-BUTTON         = no
         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.
/* 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
                                                                        */
ASSIGN 
       casgntrig:READ-ONLY IN FRAME DEFAULT-FRAME        = TRUE.

ASSIGN 
       ccollabel:READ-ONLY IN FRAME DEFAULT-FRAME        = TRUE.

ASSIGN 
       cdatatype:READ-ONLY IN FRAME DEFAULT-FRAME        = TRUE.

ASSIGN 
       cdesc:READ-ONLY IN FRAME DEFAULT-FRAME        = TRUE.

ASSIGN 
       cformat:READ-ONLY IN FRAME DEFAULT-FRAME        = TRUE.

ASSIGN 
       chelp:READ-ONLY IN FRAME DEFAULT-FRAME        = TRUE.

ASSIGN 
       cinitial:READ-ONLY IN FRAME DEFAULT-FRAME        = TRUE.

ASSIGN 
       clabel:READ-ONLY IN FRAME DEFAULT-FRAME        = TRUE.

ASSIGN 
       cname:READ-ONLY IN FRAME DEFAULT-FRAME        = TRUE.

ASSIGN 
       cvalexp:READ-ONLY IN FRAME DEFAULT-FRAME        = TRUE.

ASSIGN 
       cvalmsg:READ-ONLY IN FRAME DEFAULT-FRAME        = TRUE.

ASSIGN 
       cviewas:READ-ONLY IN FRAME DEFAULT-FRAME        = TRUE.

ASSIGN 
       idecimals:READ-ONLY IN FRAME DEFAULT-FRAME        = TRUE.

ASSIGN 
       iextent:READ-ONLY IN FRAME DEFAULT-FRAME        = TRUE.

ASSIGN 
       iorder:READ-ONLY IN FRAME DEFAULT-FRAME        = TRUE.

/* SETTINGS FOR TOGGLE-BOX lcasesen IN FRAME DEFAULT-FRAME
   NO-ENABLE                                                            */
/* SETTINGS FOR TOGGLE-BOX lmandatory IN FRAME DEFAULT-FRAME
   NO-ENABLE                                                            */
IF SESSION:DISPLAY-TYPE = "GUI":U AND VALID-HANDLE(C-Win)
THEN C-Win:HIDDEN = no.

/* _RUN-TIME-ATTRIBUTES-END */
&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 /* Field Details */
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 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 PARENT-WINDOW-CLOSE OF C-Win /* Field Details */
DO:
  APPLY "WINDOW-CLOSE":U TO C-Win.
END.

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


&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL C-Win C-Win
ON WINDOW-CLOSE OF C-Win /* Field Details */
DO:
  /* This event will close the window and terminate the procedure.  */
  APPLY "ENTRY":U TO hParentWin.
  APPLY "CLOSE":U TO THIS-PROCEDURE.
  RETURN NO-APPLY.
END.

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


&Scoped-define SELF-NAME bClose
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL bClose C-Win
ON CHOOSE OF bClose IN FRAME DEFAULT-FRAME /* Close */
DO:
  APPLY "WINDOW-CLOSE":U TO C-Win.
END.

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


&Scoped-define SELF-NAME bHelp
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL bHelp C-Win
ON CHOOSE OF bHelp IN FRAME DEFAULT-FRAME /* Help */
DO:
  RUN adecomm/_adehelp.p
    (INPUT "ptls":U, 
     INPUT "CONTEXT":U, 
     INPUT 30, 
     INPUT  ?).
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}.
       
ASSIGN CURRENT-WINDOW:PARENT = hParentWin. /* parent the previous window to this window */

/* 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.
  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 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 cname cdatatype cformat iorder clabel idecimals ccollabel iextent 
          casgntrig cinitial chelp cvalexp cvalmsg cviewas cdesc lmandatory 
          lcasesen 
      WITH FRAME DEFAULT-FRAME IN WINDOW C-Win.
  ENABLE cname cdatatype cformat iorder clabel idecimals ccollabel iextent 
         casgntrig cinitial chelp cvalexp cvalmsg cviewas cdesc bClose bHelp 
      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 refreshField C-Win 
PROCEDURE refreshField :
/*------------------------------------------------------------------------------
  Purpose:     
  Parameters:  <none>
  Notes:       
------------------------------------------------------------------------------*/
DEFINE INPUT PARAMETER TABLE FOR FieldDetails.

  FIND FIRST FieldDetails NO-LOCK NO-ERROR.
  IF AVAILABLE FieldDetails THEN DO WITH FRAME {&FRAME-NAME}:
    ASSIGN 
      casgntrig:SCREEN-VALUE = FieldDetails.asgntrig
      ccollabel:SCREEN-VALUE = FieldDetails.collabel
      cdatatype:SCREEN-VALUE = FieldDetails.datatype
      cdesc:SCREEN-VALUE = FieldDetails.tdesc
      cformat:SCREEN-VALUE = FieldDetails.tformat
      chelp:SCREEN-VALUE = FieldDetails.thelp
      cviewas:SCREEN-VALUE = FieldDetails.viewas
      cinitial:SCREEN-VALUE = FieldDetails.initval
      clabel:SCREEN-VALUE = FieldDetails.tlabel
      cname:SCREEN-VALUE = FieldDetails.fldname
      cvalexp:SCREEN-VALUE = FieldDetails.valexp
      cvalmsg:SCREEN-VALUE = FieldDetails.valmsg
      idecimals:SCREEN-VALUE = STRING(FieldDetails.tdec)
      iextent:SCREEN-VALUE = STRING(FieldDetails.textent)
      iorder:SCREEN-VALUE = STRING(FieldDetails.torder)
      lmandatory = FieldDetails.tmandatory
      lcasesen = FieldDetails.casesensitive.
      
    ASSIGN {&WINDOW-NAME}:TITLE = FieldDetails.tblname + "." + 
      FieldDetails.fldname + " Field Details".
    DISPLAY lmandatory lcasesen WITH FRAME {&FRAME-NAME}.
  END.  /* do with frame */
  
  APPLY "ENTRY":U TO C-Win.
  APPLY "ENTRY":U TO bClose.
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.                           *
*                                                                    *
*********************************************************************/
/*PROGRAM NAME: _fldlist.p
 * AUTHOR      : Tammy Marshall
 * DATE        : 04/01/99
 * DESCRIPTION : Returns a list of field names to populate the selection list
 *               of fields in the DB Connections PRO*Tool Schema window.
 * */
 
DEFINE INPUT PARAMETER pcDBType AS CHARACTER NO-UNDO.
DEFINE INPUT PARAMETER pcDBName AS CHARACTER NO-UNDO.
DEFINE INPUT PARAMETER pTableName AS CHARACTER NO-UNDO.
DEFINE OUTPUT PARAMETER cFieldList AS CHARACTER NO-UNDO.

DEFINE VARIABLE rDB AS RECID NO-UNDO.  /* recid of _db */

IF pcDBType = "PROGRESS" THEN
    FIND tinydict._db WHERE tinydict._db._db-name = ? AND 
        tinydict._db._db-type = "PROGRESS" NO-LOCK NO-ERROR. /*local */
ELSE
    FIND tinydict._db WHERE tinydict._db._db-name = pcDBName AND 
        tinydict._db._db-type = pcDBType NO-LOCK NO-ERROR. /* foreign */
rDB = RECID(tinydict._db).

FIND tinydict._File WHERE tinydict._File._Db-Recid = rDB AND
  tinydict._File._File-Name = pTableName NO-LOCK NO-ERROR.
IF AVAILABLE tinydict._File THEN 
  FOR EACH tinydict._Field OF tinydict._File NO-LOCK:
    IF cFieldList <> "" THEN cFieldList = cFieldList + ",".
    ASSIGN cFieldList = cFieldList + _Field._Field-Name.
  END.  /* for each _field */
 

/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/
/*PROGRAM NAME: _getfld.p
 * AUTHOR      : Tammy Marshall
 * DATE        : 04/01/99
 * DESCRIPTION : Assigns field information to the FieldDetails temp-table
 *               record for the currently selected field (in the DB 
 *               Connections PRO*Tool Schema window).  The FieldDetails 
 *               temp-table is then used to display the field info in the 
 *               Field Details window called from the Schema window.
 * */
 
{protools/_schdef.i} /* FieldDetails temp table definition */
 
DEFINE INPUT PARAMETER pcDBType AS CHARACTER NO-UNDO.
DEFINE INPUT PARAMETER pcDBName AS CHARACTER NO-UNDO.
DEFINE INPUT-OUTPUT PARAMETER TABLE FOR FieldDetails.

DEFINE VARIABLE rDB AS RECID NO-UNDO.

IF pcDBType = "PROGRESS" THEN
    FIND tinydict._db WHERE tinydict._db._db-name = ? AND 
        tinydict._db._db-type = "PROGRESS" NO-LOCK NO-ERROR. /*local */
ELSE
    FIND tinydict._db WHERE tinydict._db._db-name = pcDBName AND 
        tinydict._db._db-type = pcDBType NO-LOCK NO-ERROR. /* foreign */
rDB = RECID(tinydict._db).

FIND FIRST FieldDetails.
FIND tinydict._File WHERE RECID(tinydict._db) = rDB AND
  tinydict._File._File-Name = FieldDetails.tblname NO-LOCK NO-ERROR.
IF AVAILABLE tinydict._File THEN 
  FIND tinydict._Field WHERE tinydict._Field._File-recid = RECID(tinydict._File) AND
    tinydict._Field._Field-name = FieldDetails.fldname NO-LOCK NO-ERROR.
  IF AVAILABLE tinydict._Field THEN DO:
    ASSIGN 
      FieldDetails.tdesc = _Field._Desc
      FieldDetails.datatype = _Field._Data-type
      FieldDetails.initval = _Field._Initial
      FieldDetails.tlabel = _Field._Label
      FieldDetails.tmandatory = _Field._Mandatory
      FieldDetails.tformat = _Field._Format
      FieldDetails.tdec = _Field._Decimals
      FieldDetails.torder = _Field._Order
      FieldDetails.textent = _Field._Extent
      FieldDetails.valexp = _Field._Valexp
      FieldDetails.valmsg = _Field._Valmsg
      FieldDetails.thelp = _Field._Help
      FieldDetails.collabel = _Field._Col-label
      FieldDetails.casesensitive = _Field._Fld-case
      FieldDetails.viewas = _Field._View-as.
      
    /* Schema trigger */  
    FIND tinydict._Field-Trig WHERE _Field-Trig._File-Recid = RECID(_File) AND
      _Field-Trig._Field-Recid = RECID(_Field) AND 
      _Field-Trig._Event = "ASSIGN" NO-LOCK NO-ERROR.
    IF AVAILABLE tinydict._Field-Trig THEN
      ASSIGN FieldDetails.asgntrig = _Field-Trig._Proc-Name.
  END.  /* if avail _field */

  
      
      
/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/
/*PROGRAM NAME: _getidx.p
 * AUTHOR      : Tammy Marshall
 * DATE        : 04/01/99
 * DESCRIPTION : Assigns index information to the IndexDetails and IndxFldDetails
 *               temp-table records for the currently selected index (in the DB 
 *               Connections PRO*Tool Schema window).  The IndexDetails and
 *               IndxFldDetails temp-tables are then used to display the index
 *               and index field info in the Index Details window called from the 
 *               Schema window.
 * */
 
{protools/_schdef.i} /* IndexDetails temp table definition */
 
DEFINE INPUT PARAMETER pcDBType AS CHARACTER NO-UNDO.
DEFINE INPUT PARAMETER pcDBName AS CHARACTER NO-UNDO.
DEFINE INPUT-OUTPUT PARAMETER TABLE FOR IndexDetails.
DEFINE OUTPUT PARAMETER TABLE FOR IndxFldDetails.

DEFINE VARIABLE rDB AS RECID NO-UNDO.

IF pcDBType = "PROGRESS" THEN
    FIND tinydict._db WHERE tinydict._db._db-name = ? AND 
        tinydict._db._db-type = "PROGRESS" NO-LOCK NO-ERROR. /*local */
ELSE
    FIND tinydict._db WHERE tinydict._db._db-name = pcDBName AND 
        tinydict._db._db-type = pcDBType NO-LOCK NO-ERROR. /* foreign */
rDB = RECID(tinydict._db).

FIND FIRST IndexDetails.
FIND tinydict._File WHERE RECID(tinydict._db) = rDB AND
  tinydict._File._File-Name = IndexDetails.tblname NO-LOCK NO-ERROR.
IF AVAILABLE tinydict._File THEN 
  FIND tinydict._Index WHERE tinydict._Index._File-recid = RECID(tinydict._File) AND
    tinydict._Index._Index-name = IndexDetails.idxname NO-LOCK NO-ERROR.
  IF AVAILABLE tinydict._Index THEN DO:
    ASSIGN 
      IndexDetails.tdesc = _Index._Desc
      IndexDetails.lactive = _Index._Active
      IndexDetails.lunique = _Index._Unique.
    IF _Index._Wordidx = 1 THEN IndexDetails.lwordindex = TRUE.
    ELSE IndexDetails.lwordindex = FALSE.

    IF tinydict._File._Prime-Index = RECID(_Index) THEN IndexDetails.lprimary = yes.
    
    FIND LAST _Index-Field OF _Index NO-LOCK NO-ERROR.
    IF AVAILABLE _Index-Field THEN IndexDetails.labbrev = _Index-Field._Abbreviate.
    
    FOR EACH tinydict._Index-Field WHERE 
      _Index-Field._Index-recid = RECID(_Index) NO-LOCK:
      
      CREATE IndxFldDetails.
      ASSIGN
        IndxFldDetails.tblname = IndexDetails.tblname
        IndxFldDetails.idxname = _Index._Index-name
        IndxFldDetails.idxseq = _Index-Field._Index-seq
        IndxFldDetails.lasc = _Index-Field._Ascending.
        
      FIND tinydict._Field WHERE RECID(_Field) = _Index-Field._Field-recid NO-LOCK NO-ERROR.
      IF AVAIL _Field THEN ASSIGN
        IndxFldDetails.fldname = _Field._Field-name
        IndxFldDetails.fldtype = _Field._Data-Type.
        
    END.  /* for each index field */
  END.  /* if avail _index */

  
      
      
/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/
/*PROGRAM NAME: _gettbl.p
 * AUTHOR      : Tammy Marshall
 * DATE        : 04/01/99
 * DESCRIPTION : Assigns table information to the TableDetails temp-table
 *               record for the currently selected table (in the DB 
 *               Connections PRO*Tool Schema window).  The TableDetails 
 *               temp-table is then used to display the field info in the 
 *               Table Details window called from the Schema window.
 * */
 
{protools/_schdef.i} /* TableDetails temp table definition */
 
DEFINE INPUT        PARAMETER pcDBType AS CHARACTER NO-UNDO.
DEFINE INPUT        PARAMETER pcDBName AS CHARACTER NO-UNDO.
DEFINE INPUT-OUTPUT PARAMETER TABLE FOR TableDetails.

DEFINE VARIABLE rDB AS RECID NO-UNDO.

IF pcDBType = "PROGRESS":U THEN
  FIND tinydict._db WHERE tinydict._db._db-name = ? AND 
       tinydict._db._db-type = "PROGRESS" NO-LOCK NO-ERROR. /*local */
ELSE
  FIND tinydict._db WHERE tinydict._db._db-name = pcDBName AND 
       tinydict._db._db-type = pcDBType NO-LOCK NO-ERROR. /* foreign */
rDB = RECID(tinydict._db).

FIND FIRST TableDetails.
FIND tinydict._File WHERE RECID(tinydict._db) = rDB AND
  tinydict._File._File-Name = TableDetails.name NO-LOCK NO-ERROR.
IF AVAILABLE tinydict._File THEN DO:
  ASSIGN 
    TableDetails.tdesc    = _File._Desc
    TableDetails.tlabel   = _File._File-Label
    TableDetails.valexp   = _File._Valexp
    TableDetails.valmsg   = _File._Valmsg
    TableDetails.multitenant = _File._File-Attributes[1]
    TableDetails.keepdefaultarea = _File._File-Attributes[2]
    TableDetails.replproc = _File._Fil-misc2[6].
  
  /* Schema triggers */
  FOR EACH tinydict._File-Trig WHERE _File-Trig._File-Recid = RECID(_File) NO-LOCK:
    CASE _File-Trig._Event:
      WHEN "CREATE":U THEN 
        ASSIGN TableDetails.crtrig     = _File-Trig._Proc-Name.
      WHEN "DELETE":U THEN 
        ASSIGN TableDetails.deltrig    = _File-Trig._Proc-Name.
      WHEN "FIND":U THEN 
        ASSIGN TableDetails.fndtrig    = _File-Trig._Proc-Name.
      WHEN "WRITE":U THEN 
        ASSIGN TableDetails.wrtrig     = _File-Trig._Proc-Name.
      WHEN "REPLICATION-CREATE":U THEN 
        ASSIGN TableDetails.repcrtrig  = _File-Trig._Proc-Name.
      WHEN "REPLICATION-DELETE":U THEN 
        ASSIGN TableDetails.repdeltrig = _File-Trig._Proc-Name.
      WHEN "REPLICATION-WRITE":U THEN 
        ASSIGN TableDetails.repwrtrig  = _File-Trig._Proc-Name.
    END CASE.  
  END.  /* for each trigger */
  
  /* Storage Area */
  IF tinydict._File._For-type <> ? THEN
    ASSIGN TableDetails.storarea = "n/a".
  ELSE IF INTEGER(DBVERSION(pcDBName)) >= 9 THEN
    RUN protools/_storarea.p (RECID(tinydict._File), OUTPUT TableDetails.storarea).
 
END.  /* if avail _file */

/* _gettbl.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.                           *
*                                                                    *
*********************************************************************/
/*PROGRAM NAME: _idxavbl.p
 * AUTHOR      : Tammy Marshall
 * DATE        : 04/01/99
 * DESCRIPTION : Accepts a table name and an index name and returns a logical 
 *               indicating whether the index still exists in the table in the DB.
 * */
 
DEFINE INPUT PARAMETER pcDBType AS CHARACTER NO-UNDO.
DEFINE INPUT PARAMETER pcDBName AS CHARACTER NO-UNDO.
DEFINE INPUT PARAMETER pcTblName AS CHARACTER NO-UNDO.
DEFINE INPUT PARAMETER pcIdxName AS CHARACTER NO-UNDO.
DEFINE OUTPUT PARAMETER plExists AS LOGICAL NO-UNDO.

DEFINE VARIABLE rDB AS RECID NO-UNDO.

IF pcDBType = "PROGRESS" THEN
    FIND tinydict._db WHERE tinydict._db._db-name = ? AND 
        tinydict._db._db-type = "PROGRESS" NO-LOCK NO-ERROR. /*local */
ELSE
    FIND tinydict._db WHERE tinydict._db._db-name = pcDBName AND 
        tinydict._db._db-type = pcDBType NO-LOCK NO-ERROR. /* foreign */
rDB = RECID(tinydict._db).

FIND tinydict._File WHERE RECID(tinydict._db) = rDB AND
  tinydict._File._File-Name = pcTblName NO-LOCK NO-ERROR.
IF AVAILABLE _File THEN DO:
  FIND tinydict._Index WHERE _Index._File-Recid = RECID(_File) AND
    _Index._Index-Name = pcIdxName NO-LOCK NO-ERROR.
  IF AVAILABLE _Index THEN plExists = TRUE.
  ELSE plExists = FALSE.
END.  /* if avail _file */
ELSE plExists = FALSE.  

&ANALYZE-SUSPEND _VERSION-NUMBER UIB_v9r12 GUI
&ANALYZE-RESUME
&Scoped-define WINDOW-NAME C-Win
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _DEFINITIONS C-Win 
/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/
/*------------------------------------------------------------------------

  File: protools/_idxdetl.w

  Description: Index Detail Window of DB Connections PRO*Tool

  Input Parameters:
      hParentWin - handle of Schema Detail Window

  Output Parameters:
      <none>

  Author: Tammy Marshall

  Created: 04/09/99

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

{protools/_schdef.i}  /* IndexDetails temp table definition */

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

/* Parameters Definitions ---                                           */
DEFINE INPUT PARAMETER hParentWin AS HANDLE NO-UNDO.

/* Local Variable Definitions ---                                       */

/* _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 DEFAULT-FRAME

/* Standard List Definitions                                            */
&Scoped-Define ENABLED-OBJECTS cname cdesc bclose bHelp 
&Scoped-Define DISPLAYED-OBJECTS cname lactive lprimary cdesc lunique ~
lwordindex labbrev 

/* 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 C-Win AS WIDGET-HANDLE NO-UNDO.

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

DEFINE BUTTON bHelp 
     LABEL "&Help" 
     SIZE 15 BY 1.14.

DEFINE VARIABLE cdesc AS CHARACTER 
     VIEW-AS EDITOR SCROLLBAR-VERTICAL
     SIZE 35 BY 3.52
     BGCOLOR 15 FGCOLOR 0  NO-UNDO.

DEFINE VARIABLE cname AS CHARACTER FORMAT "X(256)":U 
     LABEL "Index Name" 
     VIEW-AS FILL-IN 
     SIZE 27 BY 1
     BGCOLOR 15 FGCOLOR 0  NO-UNDO.

DEFINE VARIABLE labbrev AS LOGICAL INITIAL no 
     LABEL "Abbreviated" 
     VIEW-AS TOGGLE-BOX
     SIZE 17 BY .81 NO-UNDO.

DEFINE VARIABLE lactive AS LOGICAL INITIAL no 
     LABEL "Active" 
     VIEW-AS TOGGLE-BOX
     SIZE 13.4 BY .81 NO-UNDO.

DEFINE VARIABLE lprimary AS LOGICAL INITIAL no 
     LABEL "Primary" 
     VIEW-AS TOGGLE-BOX
     SIZE 13.4 BY .81 NO-UNDO.

DEFINE VARIABLE lunique AS LOGICAL INITIAL no 
     LABEL "Unique" 
     VIEW-AS TOGGLE-BOX
     SIZE 13.4 BY .81 NO-UNDO.

DEFINE VARIABLE lwordindex AS LOGICAL INITIAL no 
     LABEL "Word Index" 
     VIEW-AS TOGGLE-BOX
     SIZE 17 BY .81 NO-UNDO.


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

DEFINE FRAME DEFAULT-FRAME
     cname AT ROW 1.38 COL 15.2 COLON-ALIGNED
     lactive AT ROW 1.43 COL 54
     lprimary AT ROW 2.71 COL 54
     cdesc AT ROW 3.91 COL 7.8 NO-LABEL
     lunique AT ROW 4.05 COL 54
     lwordindex AT ROW 5.33 COL 54
     labbrev AT ROW 6.67 COL 54
     bclose AT ROW 14.76 COL 14
     bHelp AT ROW 14.76 COL 47.6
     "Description" VIEW-AS TEXT
          SIZE 14 BY .62 AT ROW 2.95 COL 7.8
    WITH 1 DOWN NO-BOX KEEP-TAB-ORDER OVERLAY 
         SIDE-LABELS NO-UNDERLINE THREE-D 
         AT COL 1 ROW 1
         SIZE 85 BY 15.24.


/* *********************** 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              = "Index Details"
         HEIGHT             = 15.33
         WIDTH              = 74.4
         MAX-HEIGHT         = 15.33
         MAX-WIDTH          = 90
         VIRTUAL-HEIGHT     = 15.33
         VIRTUAL-WIDTH      = 90
         MAX-BUTTON         = no
         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.
/* 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
                                                                        */
ASSIGN 
       cdesc:READ-ONLY IN FRAME DEFAULT-FRAME        = TRUE.

ASSIGN 
       cname:READ-ONLY IN FRAME DEFAULT-FRAME        = TRUE.

/* SETTINGS FOR TOGGLE-BOX labbrev IN FRAME DEFAULT-FRAME
   NO-ENABLE                                                            */
/* SETTINGS FOR TOGGLE-BOX lactive IN FRAME DEFAULT-FRAME
   NO-ENABLE                                                            */
/* SETTINGS FOR TOGGLE-BOX lprimary IN FRAME DEFAULT-FRAME
   NO-ENABLE                                                            */
/* SETTINGS FOR TOGGLE-BOX lunique IN FRAME DEFAULT-FRAME
   NO-ENABLE                                                            */
/* SETTINGS FOR TOGGLE-BOX lwordindex IN FRAME DEFAULT-FRAME
   NO-ENABLE                                                            */
IF SESSION:DISPLAY-TYPE = "GUI":U AND VALID-HANDLE(C-Win)
THEN C-Win:HIDDEN = no.

/* _RUN-TIME-ATTRIBUTES-END */
&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 /* Index Details */
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 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 PARENT-WINDOW-CLOSE OF C-Win /* Index Details */
DO:
  APPLY "WINDOW-CLOSE":U TO C-Win.
END.

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


&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL C-Win C-Win
ON WINDOW-CLOSE OF C-Win /* Index Details */
DO:
  /* This event will close the window and terminate the procedure.  */
  APPLY "ENTRY":U TO hParentWin.
  APPLY "CLOSE":U TO THIS-PROCEDURE.
  RETURN NO-APPLY.
END.

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


&Scoped-define SELF-NAME bclose
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL bclose C-Win
ON CHOOSE OF bclose IN FRAME DEFAULT-FRAME /* Close */
DO:
  APPLY "WINDOW-CLOSE":U TO C-Win.
END.

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


&Scoped-define SELF-NAME bHelp
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL bHelp C-Win
ON CHOOSE OF bHelp IN FRAME DEFAULT-FRAME /* Help */
DO:
  RUN adecomm/_adehelp.p
    (INPUT "ptls":U, 
     INPUT "CONTEXT":U, 
     INPUT 13, 
     INPUT  ?).
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}.

ASSIGN CURRENT-WINDOW:PARENT = hParentWin. /* parent the previous window to this window */

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

DEFINE QUERY qIndxFlds FOR IndxFldDetails.

DEFINE BROWSE brwsIndxFlds QUERY qIndxFlds NO-LOCK
  DISPLAY 
    idxseq LABEL "Index-Seq" 
    fldname LABEL "Field Name" FORMAT "x(20)"
    fldtype LABEL "Field Type" FORMAT "x(15)"
    lasc LABEL "Ascending" WITH EXPANDABLE SIZE 63 BY 5.50.
    
ASSIGN 
  BROWSE brwsIndxFlds:ROW = 8.50
  BROWSE brwsIndxFlds:COLUMN = 5.00.
  
/* 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.
  DISPLAY brwsIndxFlds WITH FRAME DEFAULT-FRAME IN WINDOW C-Win.
  ENABLE brwsIndxFlds WITH FRAME DEFAULT-FRAME IN WINDOW C-Win.
  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 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 cname lactive lprimary cdesc lunique lwordindex labbrev 
      WITH FRAME DEFAULT-FRAME IN WINDOW C-Win.
  ENABLE cname cdesc bclose bHelp 
      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 refreshIndex C-Win 
PROCEDURE refreshIndex :
/*------------------------------------------------------------------------------
  Purpose:     
  Parameters:  <none>
  Notes:       
------------------------------------------------------------------------------*/
DEFINE INPUT PARAMETER TABLE FOR IndexDetails.
DEFINE INPUT PARAMETER TABLE FOR IndxFldDetails.

  FIND FIRST IndexDetails NO-LOCK NO-ERROR.
  IF AVAILABLE IndexDetails THEN DO WITH FRAME {&FRAME-NAME}:
    ASSIGN 
      cname:SCREEN-VALUE = IndexDetails.idxname
      cdesc:SCREEN-VALUE = IndexDetails.tdesc
      lactive = IndexDetails.lactive
      lprimary = IndexDetails.lprimary
      lunique = IndexDetails.lunique
      lwordindex = IndexDetails.lwordindex
      labbrev = IndexDetails.labbrev.
    
    ASSIGN {&WINDOW-NAME}:TITLE = IndexDetails.idxname + " Index Details".
    DISPLAY lactive lprimary lunique lwordindex labbrev WITH FRAME {&FRAME-NAME}.
  END.  /* do with frame */
 
  OPEN QUERY qIndxFlds FOR EACH IndxFldDetails NO-LOCK.
    
  APPLY "ENTRY":U TO C-Win.
  APPLY "ENTRY":U TO bClose.
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.                           *
*                                                                    *
*********************************************************************/
/*PROGRAM NAME: _idxlist.p
 * AUTHOR      : Tammy Marshall
 * DATE        : 04/01/99
 * DESCRIPTION : Returns a list of index names to populate the selection list
 *               of indices in the DB Connections PRO*Tool Schema window.
 * */
 
DEFINE INPUT PARAMETER pcDBType AS CHARACTER NO-UNDO.
DEFINE INPUT PARAMETER pcDBName AS CHARACTER NO-UNDO.
DEFINE INPUT PARAMETER pcTableName AS CHARACTER NO-UNDO.
DEFINE OUTPUT PARAMETER cIndxList AS CHARACTER NO-UNDO.

DEFINE VARIABLE rDB AS RECID NO-UNDO.  /* recid of _db */

IF pcDBType = "PROGRESS" THEN
    FIND tinydict._db WHERE tinydict._db._db-name = ? AND 
        tinydict._db._db-type = "PROGRESS" NO-LOCK NO-ERROR. /*local */
ELSE
    FIND tinydict._db WHERE tinydict._db._db-name = pcDBName AND 
        tinydict._db._db-type = pcDBType NO-LOCK NO-ERROR. /* foreign */
rDB = RECID(tinydict._db).

FIND tinydict._File WHERE tinydict._File._Db-Recid = rDB AND
  tinydict._File._File-Name = pcTableName NO-LOCK NO-ERROR.
IF AVAILABLE tinydict._File THEN 
  FOR EACH tinydict._Index OF tinydict._File NO-LOCK:
    IF cIndxList <> "" THEN cIndxList = cIndxList + ",".
    ASSIGN cIndxList = cIndxList + _Index._Index-Name.
  END.  /* for each _field */
 
&ANALYZE-SUSPEND _VERSION-NUMBER UIB_v8r11 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 dlg-msgcnt
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _DEFINITIONS dlg-msgcnt 
/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/
/*------------------------------------------------------------------------

  File: 

  Description: 

  Input Parameters:
      <none>

  Output Parameters:
      <none>

  Author: 

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

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

/* Parameters Definitions ---                                           */

{protools/ptlshlp.i}

/* 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 dlg-msgcnt

/* Standard List Definitions                                            */
&Scoped-Define ENABLED-OBJECTS msgcnt Btn_OK Btn_Help 
&Scoped-Define DISPLAYED-OBJECTS msgcnt 

/* 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 Btn_Help 
     LABEL "&Help" 
     SIZE 10 BY 1
     BGCOLOR 8 .

DEFINE BUTTON Btn_OK AUTO-GO 
     LABEL "OK" 
     SIZE 10 BY 1
     BGCOLOR 8 .

DEFINE {&NEW} SHARED VARIABLE msgcnt AS INTEGER FORMAT "z9":U INITIAL ? 
     LABEL "Number of Messages" 
     VIEW-AS FILL-IN 
     SIZE 4 BY 1 NO-UNDO.


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

DEFINE FRAME dlg-msgcnt
     msgcnt AT ROW 1.54 COL 21 COLON-ALIGNED
     Btn_OK AT ROW 3.15 COL 7
     Btn_Help AT ROW 3.15 COL 17.86
     SPACE(6.42) SKIP(0.38)
    WITH VIEW-AS DIALOG-BOX KEEP-TAB-ORDER 
         SIDE-LABELS NO-UNDERLINE THREE-D  SCROLLABLE 
         FONT 4
         TITLE "Number of Messages"
         DEFAULT-BUTTON Btn_OK.

 

/* *********************** 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
/* SETTINGS FOR DIALOG-BOX dlg-msgcnt
   Default                                                              */
ASSIGN 
       FRAME dlg-msgcnt:SCROLLABLE       = FALSE.

/* SETTINGS FOR FILL-IN msgcnt IN FRAME dlg-msgcnt
   SHARED                                                               */
/* _RUN-TIME-ATTRIBUTES-END */
&ANALYZE-RESUME

 




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

&Scoped-define SELF-NAME dlg-msgcnt
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL dlg-msgcnt dlg-msgcnt
ON WINDOW-CLOSE OF FRAME dlg-msgcnt /* Number of Messages */
DO:
 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 dlg-msgcnt
ON CHOOSE OF Btn_Help IN FRAME dlg-msgcnt /* Help */
OR HELP OF FRAME {&FRAME-NAME}
DO: /* Call Help Function (or a simple message). */
  
    RUN adecomm/_adehelp.p 
        ( INPUT "ptls", INPUT "CONTEXT" , INPUT {&Pro_Spy_Number}, INPUT "" ).

END.

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


&Scoped-define SELF-NAME Btn_OK
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL Btn_OK dlg-msgcnt
ON CHOOSE OF Btn_OK IN FRAME dlg-msgcnt /* OK */
DO:
     ASSIGN msgcnt.
     IF msgcnt = 0 THEN
     DO:
       MESSAGE "Invalid message counter value."
               VIEW-AS ALERT-BOX INFORMATION BUTTONS OK
               TITLE "Information".
       RETURN NO-APPLY.
     END.
     ASSIGN msgcnt.
END.

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


&UNDEFINE SELF-NAME

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _MAIN-BLOCK dlg-msgcnt 


/* ***************************  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.
  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 dlg-msgcnt _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 dlg-msgcnt.
END PROCEDURE.

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


&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE enable_UI dlg-msgcnt _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 msgcnt 
      WITH FRAME dlg-msgcnt.
  ENABLE msgcnt Btn_OK Btn_Help 
      WITH FRAME dlg-msgcnt.
  {&OPEN-BROWSERS-IN-QUERY-dlg-msgcnt}
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: _osprmt.p

  Description: Start an OS prompt.

  Input Parameters:
      <none>

  Output Parameters:
      <none>

  Author: Gerry Seidl

  Modified on 
     08/22/96 by gfs - changed to work on Windows NT
     01/16/96 by gfs - ported to WIN32
 *---------------------------------------------------------------------------*/
IF SESSION:WINDOW-SYSTEM BEGINS "MS-WIN" THEN DO:
  DEFINE VARIABLE windir        AS MEMPTR.
  DEFINE VARIABLE windowsdir    AS CHARACTER NO-UNDO.
  DEFINE VARIABLE outsize       AS INTEGER   NO-UNDO.
  
  /* Get Windows directory */
  SET-SIZE(windir) = 80.
  IF OPSYS = "WIN32" THEN RUN GetWindowsDirectoryA(windir, 80, OUTPUT outsize).
  ELSE RUN GetWindowsDirectory(windir, 80, OUTPUT outsize).
  ASSIGN windowsdir = get-string(windir,1).      

  /* Find out what's available on the system to get a DOS Prompt */
  ASSIGN FILE-INFO:FILE-NAME = OS-GETENV("COMSPEC"). /* Environment variable */
  IF FILE-INFO:FULL-PATHNAME = ? THEN DO:
    ASSIGN FILE-INFO:FILE-NAME = windowsdir + "/DOSPRMPT.PIF". /* Windows 3.1 */
    IF FILE-INFO:FULL-PATHNAME = ? THEN DO:
      ASSIGN FILE-INFO:FILE-NAME = windowsdir + "/COMMAND.COM". /* Windows 95 */
      IF FILE-INFO:FULL-PATHNAME = ? THEN DO:
        ASSIGN FILE-INFO:FILE-NAME = windowsdir + "/SYSTEM32/CMD.EXE". /* Windows NT */
        IF FILE-INFO:FULL-PATHNAME = ? THEN DO:
          MESSAGE "Cannot create DOS prompt." VIEW-AS ALERT-BOX ERROR.         
          RETURN.
        END.
      END.
    END.
  END.
  IF OPSYS = "WIN32" THEN
    RUN WinExec (INPUT FILE-INFO:FULL-PATHNAME, INPUT 1). 
  ELSE
    RUN WinExec16 (INPUT FILE-INFO:FULL-PATHNAME, INPUT 1). 
END.
ELSE IF SESSION:WINDOW-SYSTEM = "OSF/MOTIF" THEN
    OS-COMMAND SILENT "xterm &".

/* 32bit version */
PROCEDURE WinExec EXTERNAL "KERNEL32.DLL": 
    DEFINE INPUT PARAMETER prog_name AS CHARACTER. 
    DEFINE INPUT PARAMETER prog_style AS SHORT. 
END.

/* 16bit version */
PROCEDURE WinExec16 EXTERNAL "krnl386.exe" ORDINAL 166: 
    DEFINE INPUT PARAMETER prog_name AS CHARACTER. 
    DEFINE INPUT PARAMETER prog_style AS SHORT. 
END.

/* 32bit version */
PROCEDURE GetWindowsDirectoryA EXTERNAL "KERNEL32.DLL":
  DEFINE INPUT PARAMETER dirname AS MEMPTR.
  DEFINE INPUT PARAMETER bufsize AS LONG.
  DEFINE RETURN PARAMETER len    AS LONG. 
END.

/* 16bit version */
PROCEDURE GetWindowsDirectory EXTERNAL "KERNEL.EXE":
  DEFINE INPUT PARAMETER dirname AS MEMPTR.
  DEFINE INPUT PARAMETER bufsize AS SHORT.
  DEFINE RETURN PARAMETER len    AS SHORT. 
END.










&ANALYZE-SUSPEND _VERSION-NUMBER UIB_v8r12 GUI
&ANALYZE-RESUME
/* Connected Databases 
*/
&Scoped-define WINDOW-NAME C-Win
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _DEFINITIONS C-Win 
/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/
/*------------------------------------------------------------------------

  File: _ppmgr.w

  Description: Creates a TEMP-TABLE of all the persistent-procedures
               (SESSION:FIRST-PROCEDURE) in this PROGRESS Session and 
               lets the user:
                   a) APPLY "CLOSE"
                   b) DELETE PROCEDURE
                   c) View Internal Entries  

  Input Parameters:
      <none>

  Output Parameters:
      <none>

  Author: William T. Wood

  Created: July 6, 1994
   
  Modified by: Gerry Seidl - UI redone and logic fixed up
                           - handle DISPATCH.
                           - changed from dialog-box to window,
                             added menubar, view filter and adapted
                             freeform query.
                           - Added display of DB-REFs and Params of IPs 
        GFS 06/19/98 - Correctly handle Functions and v9 smartobjects.
        GFS 08/06/98 - Fix UIB-MODE, SmartInfo for V9 and allow a user to
                       execute a function with no parameters.
        GFS 02/04/99 - Added Super procedures
        JEP 10/20/99 - Check for ADEPersistent first, then SmartObject
                       design mode.
------------------------------------------------------------------------*/
/*          This .W file was created with the Progress UIB.             */
/*----------------------------------------------------------------------*/
CREATE WIDGET-POOL.

{ protools/ptlshlp.i } /* help definitions */
{ adecomm/_adetool.i }
{ protools/_runonce.i }
/* ***************************  Definitions  ************************** */

/* Local Definitions ---                                           */
DEFINE TEMP-TABLE pp
    FIELD pHandle    AS WIDGET-HANDLE
    FIELD cFileName  AS CHARACTER     FORMAT "X(256)":U LABEL "Title"
    FIELD ptype      AS INTEGER
    INDEX cFileName  IS PRIMARY cFileName  
    .

&IF "{&WINDOW-SYSTEM}" EQ "OSF/MOTIF" &THEN
  DEFINE TEMP-TABLE sort-ie /* used to sort internal entries on Motif */
    FIELD ie AS CHAR
    INDEX ie IS PRIMARY ie.
&ENDIF
    
DEFINE VAR h             AS WIDGET-HANDLE NO-UNDO.
DEFINE VAR ldummy        AS LOGICAL NO-UNDO.
DEFINE VAR isSmartObject AS LOGICAL NO-UNDO.

/* Shared Definitions ---                                               */

/* _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 DEFAULT-FRAME
&Scoped-define BROWSE-NAME browser_pp

/* Internal Tables (found by Frame, Query & Browse Queries)             */
&Scoped-define INTERNAL-TABLES pp

/* Definitions for BROWSE browser_pp                                    */
&Scoped-define FIELDS-IN-QUERY-browser_pp pp.cFileName WITH NO-LABELS   
&Scoped-define ENABLED-FIELDS-IN-QUERY-browser_pp   
&Scoped-define SELF-NAME browser_pp
&Scoped-define QUERY-STRING-browser_pp FOR EACH pp
&Scoped-define OPEN-QUERY-browser_pp OPEN QUERY browser_pp FOR EACH pp.
&Scoped-define TABLES-IN-QUERY-browser_pp pp
&Scoped-define FIRST-TABLE-IN-QUERY-browser_pp pp


/* Definitions for FRAME DEFAULT-FRAME                                  */

/* Standard List Definitions                                            */
&Scoped-Define ENABLED-OBJECTS browser_pp Btn_Close Btn_Delete int-entries ~
Btn_Run_In paramlist dbrefs superProcs RECT-1 RECT-2 r_intent r_objects 
&Scoped-Define DISPLAYED-OBJECTS int-entries paramlist dbrefs uid ~
superProcs lbl_po lbl_ie 

/* 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 C-Win AS WIDGET-HANDLE NO-UNDO.

/* Menu Definitions                                                     */
DEFINE SUB-MENU m_File 
       MENU-ITEM m_Exit         LABEL "E&xit"         .

DEFINE SUB-MENU m_View 
       MENU-ITEM m_Refresh      LABEL "&Refresh List of Procedure Objects"
       RULE
       MENU-ITEM m_Hide_UIB     LABEL "Hide &UIB-Mode Objects"
              TOGGLE-BOX
       MENU-ITEM m_Hide_ADE     LABEL "Hide ADE &Procedures"
              TOGGLE-BOX.

DEFINE SUB-MENU m_Help 
       MENU-ITEM m_OpenEdge_Master_Help LABEL "OpenEdge &Master Help"
       MENU-ITEM m_Help_Topics  LABEL "PRO*Tools &Help Topics"
       MENU-ITEM m_Contents     LABEL "&Procedure Object Viewer Help" ACCELERATOR "F1"
       RULE
       MENU-ITEM m_About        LABEL "&About Procedure Object Viewer".

DEFINE MENU MENU-BAR-C-Win MENUBAR
       SUB-MENU  m_File         LABEL "&File"         
       SUB-MENU  m_View         LABEL "&View"         
       SUB-MENU  m_Help         LABEL "&Help"         .


/* Definitions of the field level widgets                               */
DEFINE BUTTON Btn_Close 
     LABEL "&Apply  ~"Close~"":L 
     SIZE 16 BY 1.

DEFINE BUTTON Btn_Delete 
     LABEL "&Delete":L 
     SIZE 9 BY 1.

DEFINE BUTTON Btn_Run_In 
     LABEL "&RUN Entry":L 
     SIZE 13 BY 1.

DEFINE BUTTON b_smartinfo 
     LABEL "Smart&Info...":L 
     SIZE 12 BY 1.

DEFINE VARIABLE lbl_ie AS CHARACTER FORMAT "X(256)":U INITIAL " Internal Entries" 
      VIEW-AS TEXT 
     SIZE 12 BY .62 NO-UNDO.

DEFINE VARIABLE lbl_po AS CHARACTER FORMAT "X(256)":U INITIAL " Procedure Objects" 
      VIEW-AS TEXT 
     SIZE 16 BY .62 NO-UNDO.

DEFINE VARIABLE uid AS CHARACTER FORMAT "X(256)":U 
     VIEW-AS FILL-IN 
     SIZE 29 BY .81 NO-UNDO.

DEFINE RECTANGLE RECT-1
     EDGE-PIXELS 2 GRAPHIC-EDGE  NO-FILL 
     SIZE 40 BY 5.95.

DEFINE RECTANGLE RECT-2
     EDGE-PIXELS 2 GRAPHIC-EDGE  NO-FILL 
     SIZE 40 BY 7.14.

DEFINE RECTANGLE r_intent
     EDGE-PIXELS 2 GRAPHIC-EDGE  NO-FILL 
     SIZE 40 BY 14.48.

DEFINE RECTANGLE r_objects
     EDGE-PIXELS 2 GRAPHIC-EDGE  NO-FILL 
     SIZE 39 BY 14.48.

DEFINE VARIABLE dbrefs AS CHARACTER 
     VIEW-AS SELECTION-LIST SINGLE SCROLLBAR-VERTICAL 
     SIZE 38 BY 5.24 NO-UNDO.

DEFINE VARIABLE int-entries AS CHARACTER 
     VIEW-AS SELECTION-LIST SINGLE SORT 
     SCROLLBAR-HORIZONTAL SCROLLBAR-VERTICAL 
     SIZE 38 BY 6.67 NO-UNDO.

DEFINE VARIABLE paramlist AS CHARACTER 
     VIEW-AS SELECTION-LIST SINGLE 
     SCROLLBAR-HORIZONTAL SCROLLBAR-VERTICAL 
     SIZE 38 BY 4.52 NO-UNDO.

DEFINE VARIABLE superProcs AS CHARACTER 
     VIEW-AS SELECTION-LIST SINGLE 
     SCROLLBAR-HORIZONTAL SCROLLBAR-VERTICAL 
     SIZE 38 BY 6.43 NO-UNDO.

/* Query definitions                                                    */
&ANALYZE-SUSPEND
DEFINE QUERY browser_pp FOR 
      pp SCROLLING.
&ANALYZE-RESUME

/* Browse definitions                                                   */
DEFINE BROWSE browser_pp
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _DISPLAY-FIELDS browser_pp C-Win _FREEFORM
  QUERY browser_pp NO-LOCK DISPLAY
      pp.cFileName WITH NO-LABELS
/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME
    WITH NO-ROW-MARKERS NO-COLUMN-SCROLLING SIZE 37 BY 12.14
         FONT 4 ROW-HEIGHT-CHARS .62.


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

DEFINE FRAME DEFAULT-FRAME
     browser_pp AT ROW 1.71 COL 3
     Btn_Close AT ROW 14.33 COL 3
     Btn_Delete AT ROW 14.33 COL 19
     b_smartinfo AT ROW 14.33 COL 28
     int-entries AT ROW 1.71 COL 43 NO-LABEL
     Btn_Run_In AT ROW 8.86 COL 55
     paramlist AT ROW 10.76 COL 43 NO-LABEL
     dbrefs AT ROW 1.71 COL 84 NO-LABEL
     uid AT ROW 14.81 COL 92 COLON-ALIGNED NO-LABEL
     superProcs AT ROW 7.91 COL 84 NO-LABEL
     lbl_po AT ROW 1 COL 1 COLON-ALIGNED NO-LABEL
     lbl_ie AT ROW 1 COL 41 COLON-ALIGNED NO-LABEL
     RECT-1 AT ROW 1.24 COL 83
     RECT-2 AT ROW 7.43 COL 83
     r_intent AT ROW 1.24 COL 42
     r_objects AT ROW 1.24 COL 2
     "Super Procedures" VIEW-AS TEXT
          SIZE 18 BY .57 AT ROW 7.19 COL 84
     "Unique-ID:" VIEW-AS TEXT
          SIZE 10 BY .81 AT ROW 14.81 COL 83
     "Databases Referenced" VIEW-AS TEXT
          SIZE 23 BY .57 AT ROW 1 COL 84
     "Parameters" VIEW-AS TEXT
          SIZE 11 BY .57 AT ROW 10.05 COL 43
    WITH 1 DOWN NO-BOX KEEP-TAB-ORDER OVERLAY 
         SIDE-LABELS NO-UNDERLINE THREE-D 
         AT COL 1 ROW 1
         SIZE 123.8 BY 15.1
         FONT 4.


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

&ANALYZE-SUSPEND _PROCEDURE-SETTINGS
/* Settings for THIS-PROCEDURE
   Type: Window
   Compile into: 
   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              = "Procedure Object Viewer"
         HEIGHT             = 15.05
         WIDTH              = 123.8
         MAX-HEIGHT         = 20.91
         MAX-WIDTH          = 146.2
         VIRTUAL-HEIGHT     = 20.91
         VIRTUAL-WIDTH      = 146.2
         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.

ASSIGN {&WINDOW-NAME}:MENUBAR    = MENU MENU-BAR-C-Win:HANDLE.

&IF '{&WINDOW-SYSTEM}' NE 'TTY' &THEN
IF NOT C-Win:LOAD-ICON("adeicon\procedur":U) THEN
    MESSAGE "Unable to load icon: adeicon\procedur"
            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
   Custom                                                               */
/* BROWSE-TAB browser_pp 1 DEFAULT-FRAME */
/* SETTINGS FOR BUTTON b_smartinfo IN FRAME DEFAULT-FRAME
   NO-ENABLE                                                            */
/* SETTINGS FOR FILL-IN lbl_ie IN FRAME DEFAULT-FRAME
   NO-ENABLE                                                            */
/* SETTINGS FOR FILL-IN lbl_po IN FRAME DEFAULT-FRAME
   NO-ENABLE                                                            */
/* SETTINGS FOR FILL-IN uid IN FRAME DEFAULT-FRAME
   NO-ENABLE                                                            */
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 browser_pp
/* Query rebuild information for BROWSE browser_pp
     _START_FREEFORM
OPEN QUERY browser_pp FOR EACH pp.
     _END_FREEFORM
     _Options          = "NO-LOCK"
     _Query            is NOT OPENED
*/  /* BROWSE browser_pp */
&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 /* Procedure Object Viewer */
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 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 /* Procedure Object Viewer */
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 BROWSE-NAME browser_pp
&Scoped-define SELF-NAME browser_pp
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL browser_pp C-Win
ON ITERATION-CHANGED OF browser_pp IN FRAME DEFAULT-FRAME
DO:  
   IF AVAILABLE(pp) THEN DO:
     IF NOT VALID-HANDLE(pp.pHandle) THEN DO:
       MESSAGE pp.cFileName "is no longer active." SKIP
               "Refreshing the list."
         VIEW-AS ALERT-BOX INFORMATION.
       RUN Build_PP_List.
     END.
     RUN Set_Internal_Entries.
     IF VALID-HANDLE(pp.pHandle) THEN
     ASSIGN dbrefs:LIST-ITEMS    = pp.pHandle:DB-REFERENCES
            uid:SCREEN-VALUE     = STRING(pp.pHandle:UNIQUE-ID).
     ELSE RETURN NO-APPLY.
                              
     RUN List-Params.
     /* Is this a SmartObject? */
     /* V8-style */
     isSmartObject = CAN-DO (pp.pHandle:INTERNAL-ENTRIES, "Dispatch":U) AND
                     CAN-DO (pp.pHandle:INTERNAL-ENTRIES, "get-attribute":U).
     /* v9-style */
     IF CAN-DO (pp.pHandle:INTERNAL-ENTRIES, "getObjectVersion":U) THEN DO:
         isSmartObject = 
          DYNAMIC-FUNCTION("getObjectVersion":U IN pp.pHandle) BEGINS "ADM":U
            NO-ERROR.
         IF isSmartObject = ? THEN isSmartObject = FALSE.
     END.
     RUN List-SuperProcedures.
   END.
   ELSE isSmartObject = no.
   b_SmartInfo:SENSITIVE = isSmartObject.
   
   /* Disable buttons that act on the current pp */
   IF AVAILABLE (pp) ne btn_Close:SENSITIVE
   THEN ASSIGN btn_Close:SENSITIVE = AVAILABLE(pp)
               btn_Delete:SENSITIVE = AVAILABLE (pp)
               btn_Run_In:SENSITIVE = int-entries:SCREEN-VALUE NE "" AND
                                      int-entries:SCREEN-VALUE NE ?
               .
   
   IF int-entries:NUM-ITEMS > 0 THEN DO:
       ASSIGN int-entries:SCREEN-VALUE = int-entries:ENTRY(1).
       APPLY "VALUE-CHANGED" TO int-entries.
   END.  
END.

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


&Scoped-define SELF-NAME Btn_Close
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL Btn_Close C-Win
ON CHOOSE OF Btn_Close IN FRAME DEFAULT-FRAME /* Apply  "Close" */
DO:
  /* Apply "CLOSE" to the procedure.  This might not do any good. */
  APPLY "CLOSE":U TO pp.pHandle.
  
  IF VALID-HANDLE(pp.pHandle)
  THEN MESSAGE "Applying CLOSE to" pp.cFileName "did not close the procedure."
               SKIP
               "The 'Delete Procedure' button should work."
               VIEW-AS ALERT-BOX INFORMATION.
  ELSE RUN check_procedures.
  
END.

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


&Scoped-define SELF-NAME Btn_Delete
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL Btn_Delete C-Win
ON CHOOSE OF Btn_Delete IN FRAME DEFAULT-FRAME /* Delete */
DO:
  /* DELETE this procedure.  This should work, but it did not. */
  DELETE PROCEDURE pp.pHandle.
  
  IF VALID-HANDLE(pp.pHandle)
  THEN MESSAGE "Deleting the procedure" pp.cFileName "did not work."
               SKIP
               "The procedure is still in memory.  Perhaps there is an"
               "active WAIT-FOR in the procedure."
               VIEW-AS ALERT-BOX WARNING.
  ELSE RUN check_procedures.
  
END.

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


&Scoped-define SELF-NAME Btn_Run_In
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL Btn_Run_In C-Win
ON CHOOSE OF Btn_Run_In IN FRAME DEFAULT-FRAME /* RUN Entry */
DO:  
  DEFINE VARIABLE adm-method AS CHARACTER NO-UNDO.
  /* Run the current entry in the current persistent procedure.  This may
     cause an error (but that is ok). */
  RUN-IN-BLOCK:
  DO ON ERROR UNDO RUN-IN-BLOCK, LEAVE RUN-IN-BLOCK:
    IF REPLACE(SELF:LABEL,"&","") EQ "Run entry" THEN DO:
      IF ENTRY(1,pp.pHandle:GET-SIGNATURE(int-entries:SCREEN-VALUE)) = "FUNCTION":U THEN DO:
        DEFINE VARIABLE abtitle AS CHARACTER NO-UNDO.
        ASSIGN abtitle = "Return value of function " + int-entries:SCREEN-VALUE.
        CASE ENTRY(2,pp.pHandle:GET-SIGNATURE(int-entries:SCREEN-VALUE)):
          WHEN "CHARACTER" THEN DO:
            DEFINE VARIABLE rc AS CHARACTER NO-UNDO.
            ASSIGN rc = DYNAMIC-FUNCTION(int-entries:SCREEN-VALUE IN pp.pHandle).
            MESSAGE rc VIEW-AS ALERT-BOX TITLE abtitle.
          END.
          WHEN "INTEGER" THEN DO:
            DEFINE VARIABLE ri AS INTEGER NO-UNDO.
            ASSIGN ri = DYNAMIC-FUNCTION(int-entries:SCREEN-VALUE IN pp.pHandle).
            MESSAGE ri VIEW-AS ALERT-BOX TITLE abtitle.
          END.
          WHEN "DECIMAL" THEN DO:
            DEFINE VARIABLE rd AS DECIMAL NO-UNDO.
            ASSIGN rd = DYNAMIC-FUNCTION(int-entries:SCREEN-VALUE IN pp.pHandle).
            MESSAGE rd VIEW-AS ALERT-BOX TITLE abtitle.
          END.
          WHEN "LOGICAL" THEN DO:
            DEFINE VARIABLE rl AS LOGICAL NO-UNDO.
            ASSIGN rl = DYNAMIC-FUNCTION(int-entries:SCREEN-VALUE IN pp.pHandle).
            MESSAGE rl VIEW-AS ALERT-BOX TITLE abtitle.
          END.
          WHEN "WIDGET-HANDLE" THEN DO:
            DEFINE VARIABLE rh AS WIDGET-HANDLE NO-UNDO.
            ASSIGN rh = DYNAMIC-FUNCTION(int-entries:SCREEN-VALUE IN pp.pHandle).
            MESSAGE STRING(rh) VIEW-AS ALERT-BOX TITLE abtitle.
          END.
        END CASE.
        DYNAMIC-FUNCTION(int-entries:SCREEN-VALUE IN pp.pHandle).
      END.
      ELSE
        RUN VALUE(int-entries:SCREEN-VALUE) IN pp.pHandle.
    END.
    ELSE IF REPLACE(SELF:LABEL,"&","") EQ "Dispatch" THEN DO:
      IF int-entries:SCREEN-VALUE BEGINS "adm-" THEN
        ASSIGN adm-method = REPLACE(int-entries:SCREEN-VALUE,"adm-","").
      ELSE IF int-entries:SCREEN-VALUE BEGINS "local-" THEN
        ASSIGN adm-method = REPLACE(int-entries:SCREEN-VALUE,"local-","").
      RUN Dispatch IN pp.pHandle (adm-method).
    END.
  END.
  RUN Check_Procedures.
END.

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


&Scoped-define SELF-NAME b_smartinfo
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL b_smartinfo C-Win
ON CHOOSE OF b_smartinfo IN FRAME DEFAULT-FRAME /* SmartInfo... */
DO:  
  IF CAN-DO (pp.pHandle:INTERNAL-ENTRIES, "getObjectVersion":U) THEN DO: /* v9 */
    IF DYNAMIC-FUNCTION("getObjectVersion":U IN pp.pHandle) BEGINS "ADM":U THEN
      RUN adm2/support/_so-info.w (INPUT pp.pHandle, INPUT "SmartInfo").
  END.
  ELSE
    RUN adm/support/_so-info.w (INPUT pp.pHandle, INPUT "SmartInfo").
END.

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


&Scoped-define SELF-NAME int-entries
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL int-entries C-Win
ON VALUE-CHANGED OF int-entries IN FRAME DEFAULT-FRAME
DO:
  DEFINE VARIABLE params AS CHARACTER NO-UNDO INITIAL "".
  
  /* Set the RUN..IN button to be sensitive only if there is a valid item
     selected in the list. */
  IF SELF:SCREEN-VALUE NE "" THEN DO:
    ASSIGN params = ENTRY(3,pp.pHandle:GET-SIGNATURE(SELF:SCREEN-VALUE)) NO-ERROR.
    IF (params NE "" AND KEYWORD(ENTRY(1,params," ")) NE ?) /*OR 
      ENTRY(1,pp.pHandle:GET-SIGNATURE(SELF:SCREEN-VALUE)) = "FUNCTION":U */ THEN 
        btn_Run_In:SENSITIVE = NO.
    ELSE btn_Run_In:SENSITIVE = YES.
    RUN List-Params.
  END.
  ELSE btn_Run_In:SENSITIVE = NO.
  IF (SELF:SCREEN-VALUE BEGINS "adm-"    OR 
      SELF:SCREEN-VALUE BEGINS "local-") AND
     SELF:LOOKUP("Dispatch")      NE ?   AND
     SELF:LOOKUP("Get-Attribute") NE ?   THEN
    Btn_Run_In:LABEL = "Di&spatch".
  ELSE Btn_Run_In:LABEL = "&Run entry".
END.

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


&Scoped-define SELF-NAME m_About
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL m_About C-Win
ON CHOOSE OF MENU-ITEM m_About /* About Procedure Object Viewer */
DO:
    RUN adecomm/_about.p (INPUT "Procedure Object Viewer", INPUT "adeicon/procedur").  
END.

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


&Scoped-define SELF-NAME m_Contents
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL m_Contents C-Win
ON CHOOSE OF MENU-ITEM m_Contents /* Procedure Object Viewer Help */
DO:
  RUN adecomm/_adehelp.p ( "ptls", "CONTEXT", {&Procedure_Object_Viewer}, ? ).    
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 "CLOSE" TO THIS-PROCEDURE.
END.

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


&Scoped-define SELF-NAME m_Help_Topics
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL m_Help_Topics C-Win
ON CHOOSE OF MENU-ITEM m_Help_Topics /* Help Topics */
DO:
  RUN adecomm/_adehelp.p ( "ptls", "TOPICS", {&Procedure_Object_Viewer}, ? ).
END.

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


&Scoped-define SELF-NAME m_Hide_ADE
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL m_Hide_ADE C-Win
ON VALUE-CHANGED OF MENU-ITEM m_Hide_ADE /* Hide ADE Procedures */
DO:
  RUN Open_Query.  
END.

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


&Scoped-define SELF-NAME m_Hide_UIB
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL m_Hide_UIB C-Win
ON VALUE-CHANGED OF MENU-ITEM m_Hide_UIB /* Hide UIB-Mode Objects */
DO:
  RUN Open_Query.
END.

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


&Scoped-define SELF-NAME m_OpenEdge_Master_Help
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL m_OpenEdge_Master_Help C-Win
ON CHOOSE OF MENU-ITEM m_OpenEdge_Master_Help /* OpenEdge Master Help */
DO:
  RUN adecomm/_adehelp ( INPUT "mast",
                         INPUT "TOPICS",
                         INPUT ?,
                         INPUT ? ).
END.

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


&Scoped-define SELF-NAME m_Refresh
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL m_Refresh C-Win
ON CHOOSE OF MENU-ITEM m_Refresh /* Refresh List of Procedure Objects */
DO:
  RUN Build_PP_List.
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.

/* Make adjustments if running on Win95 font */
IF SESSION:PIXELS-PER-COLUMN = 5 THEN
  ASSIGN lbl_po:WIDTH = lbl_po:WIDTH + 5
         lbl_ie:WIDTH = lbl_ie:WIDTH + 4.
         
/* 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.
  ASSIGN MENU-ITEM m_Hide_ADE:CHECKED IN MENU MENU-BAR-C-Win = YES
         MENU-ITEM m_Hide_UIB:CHECKED IN MENU MENU-BAR-C-Win = YES.
  RUN Build_PP_List.
  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 Build_PP_List C-Win 
PROCEDURE Build_PP_List :
/*------------------------------------------------------------------------------
  Purpose:     Builds the Persistent Procedure List
  Parameters:  <none>
  Notes:       
------------------------------------------------------------------------------*/
  DEFINE VARIABLE setDesignMode AS LOGICAL NO-UNDO.
  
  DO WITH FRAME {&FRAME-NAME}:
    FOR EACH pp. DELETE pp. END. /* Whack old list */
    /* Find the handles, filenames, etc of all persistent procedures.       */
    h = SESSION:FIRST-PROCEDURE.
    DO WHILE VALID-HANDLE(h):
      CREATE pp.
      ASSIGN pp.pHANDLE = h
             pp.cFileName = h:FILE-NAME
             h = h:NEXT-SIBLING
             setDesignMode = FALSE
             .
             
      /* Add " (design)" to name to indicate the version of a SmartObject in
       * UIB "design" mode. This differentiates it from another instance which
       * may be part of a running container
       */
      IF CAN-DO(pp.pHANDLE:INTERNAL-ENTRIES,"ADEPersistent":U) THEN 
        pp.ptype = 1. /* ADE proc */
      ELSE IF CAN-DO(pp.pHANDLE:INTERNAL-ENTRIES,"get-attribute":U) /* V8-style */ THEN DO:
        RUN get-attribute IN pp.pHANDLE ("UIB-MODE":U).
        ASSIGN setDesignMode = RETURN-VALUE NE ?.
      END.
      ELSE IF CAN-DO(pp.pHandle:INTERNAL-ENTRIES,"getUIBMode":U) 
      AND INDEX(pp.cFileName,"smart.p":U) = 0 /* v9-style */ THEN 
        setDesignMode = DYNAMIC-FUNCTION("getUIBMode":U IN pp.pHANDLE) = "Design":U 
        NO-ERROR.
      
      IF setDesignMode THEN
          ASSIGN pp.cFileName = pp.cFileName + " (design)":U
                 pp.ptype     = 2.       
    END.
    
    /* Show the query */
    RUN Open_Query.
  END.
END PROCEDURE.

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

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE check_procedures C-Win 
PROCEDURE check_procedures :
/* -----------------------------------------------------------
  Purpose: Go through all the procedures we have a record of
           and see if any are deleted.  If they are, then 
           reopen the query.    
  Parameters:  <none>
  Notes:       
-------------------------------------------------------------*/
  DEFINE VARIABLE lReOpen            AS LOGICAL    NO-UNDO.
  DEFINE VARIABLE NextRowId          AS ROWID      NO-UNDO.
  DEFINE VARIABLE iReposTo           AS INTEGER    NO-UNDO.
  
  IF AVAILABLE(pp) THEN NextRowId = ROWID(pp).

  /* Have any procedures been deleted? */
  lReOpen = NO.
  FOR EACH pp WHERE
    (IF MENU-ITEM m_Hide_ADE:CHECKED IN MENU MENU-BAR-C-Win THEN 
       pp.ptype NE 1 
     ELSE TRUE) AND
     (IF MENU-ITEM m_Hide_UIB:CHECKED IN MENU MENU-BAR-C-Win THEN
       pp.ptype NE 2
       ELSE TRUE):
    IF NextRowId = ? THEN NextRowId = ROWID(pp).
    IF NOT VALID-HANDLE(pp.pHandle) THEN DO:
      ASSIGN lReOpen = YES
             NextRowId = ?
             iReposTo   = browser_pp:FOCUSED-ROW IN FRAME {&FRAME-NAME}.
      DELETE pp.
    END.
  END.

  IF NextRowId = ? THEN DO:
    FIND LAST pp WHERE
    (IF MENU-ITEM m_Hide_ADE:CHECKED IN MENU MENU-BAR-C-Win THEN 
       pp.ptype NE 1 
     ELSE TRUE) AND
     (IF MENU-ITEM m_Hide_UIB:CHECKED IN MENU MENU-BAR-C-Win THEN
       pp.ptype NE 2
       ELSE TRUE) NO-ERROR.
    IF AVAILABLE pp THEN nextRowId = ROWID(pp).
  END.
  
  /* Reset the query & and empty the selection list, if necessary. */
  IF lReOpen THEN DO:
    RUN Open_Query.
    RUN Set_Selections(NextRowId, iReposTo).
  END.
  ELSE DO:
    FIND pp WHERE ROWID(pp) = NextRowId NO-ERROR.
    IF AVAILABLE (pp) THEN RUN Repos(NextRowId, browser_pp:FOCUSED-ROW).
  END.
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 int-entries paramlist dbrefs uid superProcs lbl_po lbl_ie 
      WITH FRAME DEFAULT-FRAME IN WINDOW C-Win.
  ENABLE browser_pp Btn_Close Btn_Delete int-entries Btn_Run_In paramlist 
         dbrefs superProcs RECT-1 RECT-2 r_intent r_objects 
      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 List-Params C-Win 
PROCEDURE List-Params :
/*------------------------------------------------------------------------------
  Purpose:     List Parameters of currently selected IP or Function
  Parameters:  <none>
  Notes:       
------------------------------------------------------------------------------*/
   DEFINE VARIABLE plist AS CHARACTER NO-UNDO.
   DEFINE VARIABLE i     AS INTEGER   NO-UNDO.
   
   DO WITH FRAME {&FRAME-NAME}:
     ASSIGN paramlist:LIST-ITEMS = ""
            plist                = pp.pHandle:GET-SIGNATURE(int-entries:SCREEN-VALUE).
     /* If it's a Function, insert a line indicating the data type of the return value */
     IF ENTRY(1,plist) = "FUNCTION":U THEN DO:
       IF paramlist:ADD-LAST("FUNCTION returns ":U + CAPS(ENTRY(2,plist))) THEN.
     END.
     
     IF NUM-ENTRIES(plist) > 2 THEN
     DO i = 3 TO NUM-ENTRIES(plist):
         IF paramlist:ADD-LAST(ENTRY(i,plist)) THEN.
     END.
   END.
END PROCEDURE.

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

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE List-SuperProcedures C-Win 
PROCEDURE List-SuperProcedures :
/*------------------------------------------------------------------------------
  Purpose:     List of the selected procedure's super procedures
  Parameters:  <none>
  Notes:       
------------------------------------------------------------------------------*/
  DEFINE VARIABLE i AS INTEGER NO-UNDO.
  DEFINE BUFFER xpp FOR pp.
  
  DO WITH FRAME {&FRAME-NAME}:
    ASSIGN superProcs:LIST-ITEMS = "".
    DO i = 1 TO NUM-ENTRIES(pp.pHandle:SUPER-PROCEDURES):
      FIND xpp WHERE xpp.pHandle = WIDGET-HANDLE(ENTRY(i,pp.pHandle:SUPER-PROCEDURES)) NO-ERROR.
      IF AVAILABLE xpp THEN
        superProcs:ADD-LAST(xpp.cFileName).
      ELSE
        superProcs:ADD-LAST("Handle: " + ENTRY(i,pp.pHandle:SUPER-PROCEDURES)).
    END.
  END.
END PROCEDURE.

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

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE Open_Query C-Win 
PROCEDURE Open_Query :
/*------------------------------------------------------------------------------
  Purpose:     Re/Opens the Query.
  Parameters:  <none>
  Notes:       
------------------------------------------------------------------------------*/
DO WITH FRAME {&FRAME-NAME}:
  OPEN QUERY browser_pp FOR EACH pp WHERE
      (IF MENU-ITEM m_Hide_ADE:CHECKED IN MENU MENU-BAR-C-Win THEN 
         pp.ptype NE 1 
       ELSE TRUE) AND
       (IF MENU-ITEM m_Hide_UIB:CHECKED IN MENU MENU-BAR-C-Win THEN
         pp.ptype NE 2
         ELSE TRUE).
  ASSIGN browser_pp:SENSITIVE = YES.
  RUN Set_Selections(?,1).
  APPLY "ITERATION-CHANGED":U TO browser_pp.
END.

END PROCEDURE.

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

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE Repos C-Win 
PROCEDURE Repos :
/*------------------------------------------------------------------------------
  Purpose:     Reposition browser.
  Parameters:  <none>
  Notes:       
------------------------------------------------------------------------------*/
  DEFINE INPUT PARAMETER oldrowid  AS ROWID      NO-UNDO.
  DEFINE INPUT PARAMETER iFocusRow AS INTEGER    NO-UNDO.
  
  DEFINE VARIABLE h AS HANDLE  NO-UNDO.
  DEFINE VARIABLE l AS LOGICAL NO-UNDO.

  DO WITH FRAME {&FRAME-NAME}: 
    ASSIGN h = browser_pp:HANDLE
           l = h:SET-REPOSITIONED-ROW (MAX(1,iFocusRow), "CONDITIONAL").
  
    REPOSITION browser_pp TO ROWID(oldrowid).
  END.
END PROCEDURE.

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

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE Set_Internal_Entries C-Win 
PROCEDURE Set_Internal_Entries :
/*------------------------------------------------------------------------------
  Purpose:     Sets the contents of the int-entries selection list.
  Parameters:  <none>
  Notes:       
------------------------------------------------------------------------------*/

  DO WITH FRAME {&FRAME-NAME}:
     ASSIGN int-entries:HIDDEN = yes.
     &IF "{&WINDOW-SYSTEM}" EQ "OSF/Motif" &THEN
       /* This code is here to sort the internal-entries in alphabetical order
        * since the 'SORT' option on a selection-list in Motif does not work
        */
       DEFINE VARIABLE i        AS INTEGER    NO-UNDO.
       DEFINE VARIABLE sorted   AS CHARACTER  NO-UNDO INITIAL "".
     
       
       FOR EACH sort-ie: DELETE sort-ie. END.
       IF NUM-ENTRIES(pp.pHandle:INTERNAL-ENTRIES) > 0 THEN DO:
         DO i = 1 TO NUM-ENTRIES(pp.pHandle:INTERNAL-ENTRIES):
           CREATE sort-ie.
           ASSIGN ie = ENTRY(i,pp.pHandle:INTERNAL-ENTRIES).
         END.
         FOR EACH sort-ie BY ie:
           ASSIGN sorted = sorted + (IF sorted NE "" THEN "," ELSE "") + sort-ie.ie.
         END.
       END.
       ASSIGN int-entries:LIST-ITEMS = sorted.
     &ELSE
       int-entries:LIST-ITEMS = pp.pHandle:INTERNAL-ENTRIES.
     &ENDIF
     ASSIGN int-entries:HIDDEN = no.
  END.
END PROCEDURE.

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

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE Set_Selections C-Win 
PROCEDURE Set_Selections :
/* -----------------------------------------------------------
  Purpose:     Position selections on the browser and sel-list.
  Parameters:  NewRowid  - Rowid ro reposition to.  If ? then first row
               iFocusRow - Row to take focus
  Notes:       
-------------------------------------------------------------*/

DEFINE INPUT  PARAMETER NewRowid  AS ROWID      NO-UNDO.
DEFINE INPUT  PARAMETER iFocusRow AS INTEGER    NO-UNDO.

    FIND pp WHERE ROWID(pp) = NewRowid AND
      (IF MENU-ITEM m_Hide_ADE:CHECKED IN MENU MENU-BAR-C-Win THEN 
         pp.ptype NE 1 
       ELSE TRUE) AND
       (IF MENU-ITEM m_Hide_UIB:CHECKED IN MENU MENU-BAR-C-Win THEN
         pp.ptype NE 2
         ELSE TRUE) NO-ERROR.
    IF NOT AVAILABLE pp THEN
      FIND FIRST pp WHERE
        (IF MENU-ITEM m_Hide_ADE:CHECKED IN MENU MENU-BAR-C-Win THEN 
           pp.ptype NE 1 
         ELSE TRUE) AND
         (IF MENU-ITEM m_Hide_UIB:CHECKED IN MENU MENU-BAR-C-Win THEN
           pp.ptype NE 2
           ELSE TRUE) NO-ERROR.
    IF AVAILABLE pp THEN DO:
        IF browser_pp:SELECT-ROW(1) IN FRAME {&FRAME-NAME} THEN.
        IF ROWID(pp) = NewRowid THEN RUN repos(NewRowid, iFocusRow).
    END.
    ELSE
        ASSIGN Btn_Delete:SENSITIVE = no
               Btn_Close:SENSITIVE  = no
               Btn_Run_In:SENSITIVE = no
               int-entries:LIST-ITEMS IN FRAME {&FRAME-NAME} = "":U
               dbrefs:LIST-ITEMS      IN FRAME {&FRAME-NAME} = "":U
               paramlist:LIST-ITEMS   IN FRAME {&FRAME-NAME} = "":U
               superProcs:LIST-ITEMS  IN FRAME {&FRAME-NAME} = "":U
               uid:SCREEN-VALUE       IN FRAME {&FRAME-NAME} = "":U.
  
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:  _ppuscl.p

    Purpose:    Checks to see if the UIB is running and if it is
                it launches adeuib/_ppuscal.w.

    Parameters: None

    Description:
    Notes  :
    Authors: Ross Hunter
    Date   : Feb. 10, 1997
**************************************************************************/

DEFINE VARIABLE level          AS INTEGER NO-UNDO INITIAL 1. 
DEFINE VARIABLE uib_is_running AS LOGICAL NO-UNDO INITIAL NO.

REPEAT WHILE PROGRAM-NAME(level) <> ?.
  IF PROGRAM-NAME(level) = "adeuib/_uibmain.p" THEN uib_is_running = TRUE.
  ASSIGN level = level + 1.
END.
IF NOT uib_is_running THEN DO:
  MESSAGE
    "The AppBuilder is not running." SKIP "You must start the AppBuilder before running the Screen Scaling Utility."
    VIEW-AS ALERT-BOX ERROR.
  RETURN.
END.
ELSE
  RUN adeuib/_ppuscal.w PERSISTENT.

RETURN.
&ANALYZE-SUSPEND _VERSION-NUMBER UIB_v7r11 GUI
&ANALYZE-RESUME
&Scoped-define WINDOW-NAME w_cfg
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _DEFINITIONS w_cfg 
/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/
/*------------------------------------------------------------------------

  File: _PROCFG.W

  Description: Display PROGRESS.CFG information

  Input Parameters:
      <none>

  Output Parameters:
      <none>

  Author: Gerry Seidl

  Created: 01/08/95 -  3:51 pm

------------------------------------------------------------------------*/
/*          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/_adetool.i }
{ protools/ptlshlp.i } /* help definitions */
{ protools/_runonce.i }

DEFINE TEMP-TABLE cfg
    FIELD product         AS CHARACTER FORMAT "X(28)" COLUMN-LABEL "Product!Name"
    FIELD install_date    AS CHARACTER FORMAT "X(30)" LABEL "Install Date"
    FIELD user_limit      AS INTEGER   FORMAT ">,>>9" LABEL "User Limit"
    FIELD expiration_date AS CHARACTER FORMAT "X(30)" LABEL "Expire Date"
    FIELD serial_number   AS CHARACTER FORMAT "X(11)" COLUMN-LABEL "Serial!Number"
    FIELD control_numbers AS CHARACTER FORMAT "X(25)" LABEL "Control Numbers"
    FIELD version_number  AS CHARACTER FORMAT "X(8)"  LABEL "Version Number"
    FIELD machine_class   AS CHARACTER FORMAT "X(4)"  LABEL "Machine Class"
    FIELD port_number     AS INTEGER   FORMAT ">>9"   LABEL "Port Number".
    
/* Parameters Definitions ---                                           */

/* Local Variable Definitions ---                                       */   
DEFINE VARIABLE rc AS INTEGER NO-UNDO. /* return code */

&IF LOOKUP(OPSYS, "MSDOS,WIN32") = 0 &THEN
    &SCOPED-DEFINE SLASH /
&ELSE 
    &SCOPED-DEFINE SLASH ~~~\
&ENDIF

/* _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 f_cfg
&Scoped-define BROWSE-NAME b_cfg

/* Internal Tables (found by Frame, Query & Browse Queries)             */
&Scoped-define INTERNAL-TABLES cfg

/* Definitions for BROWSE b_cfg                                         */
&Scoped-define FIELDS-IN-QUERY-b_cfg cfg.product cfg.serial_number 
&Scoped-define ENABLED-FIELDS-IN-QUERY-b_cfg 
&Scoped-define OPEN-QUERY-b_cfg OPEN QUERY b_cfg FOR EACH cfg NO-LOCK ~
    BY cfg.product.
&Scoped-define FIRST-TABLE-IN-QUERY-b_cfg cfg
&Scoped-define TABLES-IN-QUERY-b_cfg cfg

/* Definitions for FRAME f_cfg                                          */
&Scoped-define OPEN-BROWSERS-IN-QUERY-f_cfg ~
    ~{&OPEN-QUERY-b_cfg}

/* Standard List Definitions                                            */
&Scoped-Define ENABLED-OBJECTS b_cfg b_Close b_Help r_cfg 
&Scoped-Define DISPLAYED-FIELDS cfg.control_numbers cfg.expiration_date ~
cfg.install_date cfg.machine_class cfg.port_number cfg.user_limit ~
cfg.version_number 
&Scoped-Define DISPLAYED-OBJECTS company 

/* 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_cfg AS WIDGET-HANDLE NO-UNDO.
DEFINE BUTTON b_Close 
     LABEL "&Close" 
     SIZE 15 BY 1.125.

DEFINE BUTTON b_Help 
     LABEL "&Help" 
     SIZE 15 BY 1.125.

DEFINE VARIABLE company AS CHARACTER FORMAT "X(256)":U 
     LABEL "Company Name" 
     VIEW-AS FILL-IN 
     SIZE 53 BY 1 NO-UNDO.

DEFINE RECTANGLE r_cfg
     EDGE-PIXELS 2 GRAPHIC-EDGE  NO-FILL 
     SIZE 41 BY 8.

DEFINE RECTANGLE r_splash
     EDGE-PIXELS 3 GRAPHIC-EDGE  NO-FILL 
     SIZE 40.89 BY 4.47.


&ANALYZE-SUSPEND
/* Query definitions                                                    */
DEFINE QUERY b_cfg FOR 
      cfg SCROLLING.
&ANALYZE-RESUME

/* Browse definitions                                                   */
DEFINE BROWSE b_cfg
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _DISPLAY-FIELDS b_cfg w_cfg _STRUCTURED
  QUERY b_cfg NO-LOCK DISPLAY
      cfg.product
      cfg.serial_number
/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME
    WITH SIZE 44.5 BY 8.

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

DEFINE FRAME f_cfg
     company AT ROW 1.28 COL 16 COLON-ALIGNED
     b_cfg AT ROW 3 COL 2
     cfg.install_date AT ROW 3.5 COL 63 COLON-ALIGNED
          VIEW-AS FILL-IN 
          SIZE 22 BY 1
          FONT 4
     cfg.user_limit AT ROW 4.5 COL 63 COLON-ALIGNED
          VIEW-AS FILL-IN 
          SIZE 6.89 BY 1
          FONT 4
     cfg.expiration_date AT ROW 5.5 COL 63 COLON-ALIGNED
          VIEW-AS FILL-IN 
          SIZE 22 BY 1
          FONT 4
     cfg.control_numbers AT ROW 6.47 COL 63 COLON-ALIGNED
          VIEW-AS FILL-IN 
          SIZE 22 BY 1
          FONT 4
     cfg.version_number AT ROW 7.5 COL 63 COLON-ALIGNED
          VIEW-AS FILL-IN 
          SIZE 12.11 BY 1
          FONT 4
     cfg.machine_class AT ROW 8.5 COL 63 COLON-ALIGNED
          VIEW-AS FILL-IN 
          SIZE 8.11 BY 1
          FONT 4
     cfg.port_number AT ROW 9.5 COL 63 COLON-ALIGNED
          VIEW-AS FILL-IN 
          SIZE 4.56 BY 1
          FONT 4
     b_Close AT ROW 11.22 COL 31
     b_Help AT ROW 11.22 COL 51
     " Product Configuration Information" VIEW-AS TEXT
          SIZE 33 BY .88 AT ROW 2.5 COL 48
     r_cfg AT ROW 3 COL 47
    WITH 1 DOWN NO-BOX KEEP-TAB-ORDER OVERLAY 
         SIDE-LABELS NO-UNDERLINE THREE-D 
         AT COL 1 ROW 1
         SIZE 87 BY 12
         DEFAULT-BUTTON b_Close.

DEFINE FRAME f_splash
     r_splash AT ROW 1.13 COL 1
     "PROGRESS Configuration File Browser" VIEW-AS TEXT
          SIZE 37 BY .84 AT ROW 1.66 COL 3
     "Version 1.0" VIEW-AS TEXT
          SIZE 12 BY .66 AT ROW 2.66 COL 16
     "Attempting to read PROGRESS.CFG file..." VIEW-AS TEXT
          SIZE 38 BY .88 AT ROW 4.16 COL 3
    WITH 1 DOWN NO-BOX KEEP-TAB-ORDER OVERLAY 
         THREE-D 
         AT COL 26.22 ROW 4.13
         SIZE 41.57 BY 4.92.

 

/* *********************** 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 w_cfg ASSIGN
         HIDDEN             = YES
         TITLE              = "PROGRESS Configuration File"
         HEIGHT             = 12
         WIDTH              = 88
         MAX-HEIGHT         = 12
         MAX-WIDTH          = 88
         VIRTUAL-HEIGHT     = 12
         VIRTUAL-WIDTH      = 88
         RESIZE             = no
         SCROLL-BARS        = no
         STATUS-AREA        = no
         BGCOLOR            = ?
         FGCOLOR            = ?
         THREE-D            = yes
         MESSAGE-AREA       = no
         MAX-BUTTON         = no
         SENSITIVE          = yes.
ELSE {&WINDOW-NAME} = CURRENT-WINDOW.

IF NOT w_cfg:LOAD-ICON("adeicon/cnfginfo") THEN
    MESSAGE "Unable to load icon: adeicon/cnrginfo"
            VIEW-AS ALERT-BOX WARNING BUTTONS OK.
&ANALYZE-RESUME


/* ***************  Runtime Attributes and UIB Settings  ************** */

&ANALYZE-SUSPEND _RUN-TIME-ATTRIBUTES
/* SETTINGS FOR WINDOW w_cfg
  VISIBLE,,RUN-PERSISTENT                                               */
/* SETTINGS FOR FILL-IN company IN FRAME f_cfg
   NO-ENABLE                                                            */
/* SETTINGS FOR FILL-IN cfg.control_numbers IN FRAME f_cfg
   NO-ENABLE                                                            */
/* SETTINGS FOR FILL-IN cfg.expiration_date IN FRAME f_cfg
   NO-ENABLE                                                            */
/* SETTINGS FOR FILL-IN cfg.install_date IN FRAME f_cfg
   NO-ENABLE                                                            */
/* SETTINGS FOR FILL-IN cfg.machine_class IN FRAME f_cfg
   NO-ENABLE                                                            */
/* SETTINGS FOR FILL-IN cfg.port_number IN FRAME f_cfg
   NO-ENABLE                                                            */
/* SETTINGS FOR FILL-IN cfg.user_limit IN FRAME f_cfg
   NO-ENABLE                                                            */
/* SETTINGS FOR FILL-IN cfg.version_number IN FRAME f_cfg
   NO-ENABLE                                                            */
/* SETTINGS FOR FRAME f_splash
   NOT-VISIBLE UNDERLINE                                                */
IF SESSION:DISPLAY-TYPE = "GUI":U AND VALID-HANDLE(w_cfg)
THEN w_cfg:HIDDEN = no.

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


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

&ANALYZE-SUSPEND _QUERY-BLOCK BROWSE b_cfg
/* Query rebuild information for BROWSE b_cfg
     _TblList          = "sports.cfg"
     _Options          = "NO-LOCK"
     _OrdList          = "sports.cfg.product|yes"
     _FldNameList[1]   = sports.cfg.product
     _FldNameList[2]   = sports.cfg.serial_number
     _Query            is OPENED
*/  /* BROWSE b_cfg */
&ANALYZE-RESUME

&ANALYZE-SUSPEND _QUERY-BLOCK FRAME f_splash
/* Query rebuild information for FRAME f_splash
     _Options          = "NO-LOCK"
     _Query            is NOT OPENED
*/  /* FRAME f_splash */
&ANALYZE-RESUME

 




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

&Scoped-define BROWSE-NAME b_cfg
&Scoped-define SELF-NAME b_cfg
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL b_cfg w_cfg
ON VALUE-CHANGED OF b_cfg IN FRAME f_cfg
DO:
  RUN Display_Details.
END.

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


&Scoped-define SELF-NAME b_Close
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL b_Close w_cfg
ON CHOOSE OF b_Close IN FRAME f_cfg /* Close */
DO:
  APPLY "CLOSE" TO THIS-PROCEDURE.
END.

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


&Scoped-define SELF-NAME b_Help
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL b_Help w_cfg
ON CHOOSE OF b_Help IN FRAME f_cfg /* Help */
DO:
  RUN adecomm/_adehelp.p ( "ptls", "CONTEXT", {&Configuration_File}, ? ).    
END.

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


&UNDEFINE SELF-NAME

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


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

/* Set CURRENT-WINDOW: this will parent dialog-boxes and frames.        */
ASSIGN CURRENT-WINDOW                = {&WINDOW-NAME} 
       THIS-PROCEDURE:CURRENT-WINDOW = {&WINDOW-NAME}.

/* Adjust for Win95 font */
IF SESSION:PIXELS-PER-COLUMN = 5 THEN
  ASSIGN {&WINDOW-NAME}:WIDTH      = 94
         FRAME {&FRAME-NAME}:WIDTH = 93
         r_cfg:WIDTH               = 47
         cfg.install_date:WIDTH    = 24
         cfg.control_numbers:WIDTH = 28
         FRAME f_splash:WIDTH      = 42
         r_splash:WIDTH            = 42
  .
         
/* The CLOSE event can be used from inside or outside the procedure to  */
/* terminate it.                                                        */
ON CLOSE OF THIS-PROCEDURE 
   RUN disable_UI.

VIEW FRAME f_splash.
RUN Get_CFG(OUTPUT rc).
IF rc > 0 THEN DO:
    IF THIS-PROCEDURE:PERSISTENT THEN DELETE PROCEDURE THIS-PROCEDURE.
    RETURN. /* error */
END.
ASSIGN FRAME f_splash:HIDDEN = yes.
HIDE FRAME f_splash.

STATUS DEFAULT "Select product or click Close to exit.".  
STATUS INPUT  "Select product or click Close to exit.". 
/* 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:
  RUN enable_UI.
  IF CAN-FIND (FIRST cfg) THEN DO:
    IF b_cfg:SELECT-ROW(1) THEN.
    APPLY "VALUE-CHANGED" TO b_cfg IN FRAME {&FRAME-NAME}.
  END.
  APPLY "ENTRY" TO b_cfg.
  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 disable_UI w_cfg _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 THEN DELETE WIDGET w_cfg.
  IF THIS-PROCEDURE:PERSISTENT THEN DELETE PROCEDURE THIS-PROCEDURE.
END PROCEDURE.

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


&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE Display_Details w_cfg 
PROCEDURE Display_Details :
/* -----------------------------------------------------------
  Purpose:     
  Parameters:  <none>
  Notes:       
-------------------------------------------------------------*/
    DISPLAY cfg.control_numbers cfg.expiration_date cfg.install_date 
        cfg.machine_class cfg.port_number cfg.user_limit cfg.version_number  
        WITH FRAME {&FRAME-NAME}.
END PROCEDURE.

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


&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE enable_UI w_cfg _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 company 
      WITH FRAME f_cfg IN WINDOW w_cfg.
  IF AVAILABLE cfg THEN 
    DISPLAY cfg.install_date cfg.user_limit cfg.expiration_date 
          cfg.control_numbers cfg.version_number cfg.machine_class 
          cfg.port_number 
      WITH FRAME f_cfg IN WINDOW w_cfg.
  ENABLE b_cfg r_cfg b_Close b_Help 
      WITH FRAME f_cfg IN WINDOW w_cfg.
  {&OPEN-BROWSERS-IN-QUERY-f_cfg}
  ENABLE r_splash 
      WITH FRAME f_splash IN WINDOW w_cfg.
  {&OPEN-BROWSERS-IN-QUERY-f_splash}
  VIEW w_cfg.
END PROCEDURE.

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


&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE Get_CFG w_cfg 
PROCEDURE Get_CFG :
/* -----------------------------------------------------------
  Purpose:     
  Parameters:  <none>
  Notes:       
-------------------------------------------------------------*/
    DEFINE OUTPUT PARAMETER rc AS INTEGER   NO-UNDO INITIAL 0.
    DEFINE VARIABLE i          AS INTEGER   NO-UNDO.
    DEFINE VARIABLE batchfile  AS CHARACTER NO-UNDO.
    DEFINE VARIABLE outputfile AS CHARACTER NO-UNDO.
    DEFINE VARIABLE dlcvalue   AS CHARACTER NO-UNDO.
    DEFINE VARIABLE showcfgloc AS CHARACTER NO-UNDO.
    DEFINE VARIABLE cfgline    AS CHARACTER NO-UNDO FORMAT "X(255)".
    DEFINE VARIABLE cmd        AS CHARACTER NO-UNDO.
    DEFINE VARIABLE cfgfile    AS CHARACTER NO-UNDO.
    DEFINE VARIABLE unixshell  AS CHARACTER NO-UNDO.
    
    RUN adecomm/_setcurs.p ("WAIT").

    /* Delete previous temp-table records. */
    FOR EACH cfg:
        DELETE cfg.
    END.
      
    /* Determine DLC path. */
    GET-KEY-VALUE SECTION "Startup" KEY "DLC" VALUE dlcvalue.
    IF dlcvalue = ? OR dlcvalue = "" THEN
        ASSIGN dlcvalue   = OS-GETENV("DLC").           
    ASSIGN batchfile  = SESSION:TEMP-DIRECTORY + "cfg.bat".
    ASSIGN outputfile = SESSION:TEMP-DIRECTORY + "cfg.out".
    IF OPSYS = "UNIX" THEN unixshell = OS-GETENV("SHELL").
    OS-DELETE VALUE(batchfile).
    OS-DELETE VALUE(outputfile). 

    /* Determine PROCFG path and filename. */
    GET-KEY-VALUE SECTION "Startup" KEY "PROCFG" VALUE cfgfile.
    IF cfgfile = ? OR cfgfile = "" THEN
    DO:
      ASSIGN cfgfile = OS-GETENV("PROCFG").
      IF cfgfile = ? THEN
        ASSIGN cfgfile = dlcvalue + "{&SLASH}" + "progress.cfg".
    END.

    /* Determine showcfg executable name. */
    ASSIGN showcfgloc = SEARCH("showcfg").
    IF SESSION:WINDOW-SYSTEM BEGINS "MS-WIN" THEN
        ASSIGN showcfgloc = SEARCH("showcfgd.exe").
    ELSE ASSIGN showcfgloc = SEARCH("showcfg").
    IF showcfgloc = ? THEN 
        ASSIGN showcfgloc = dlcvalue + "{&SLASH}" + "bin" + "{&SLASH}" +
                            (IF LOOKUP(OPSYS , "MSDOS,WIN32":U) > 0
                                THEN "showcfgd"
                                ELSE "showcfg").

    /* Create cfg.bat which we'll run to capture the output of showcfg exe
       in cfg.out. We will then read cfg.out and display it to the user in
       a friendly interface. */
    OUTPUT TO VALUE(batchfile). /* cfg.bat */
    IF cfgfile NE ? OR cfgfile NE "" THEN 
        PUT UNFORMATTED "set PROCFG=" + '"' + cfgfile + '"' SKIP.
    PUT UNFORMATTED '"' + showcfgloc + '"' + " " + '"' + cfgfile + '"' + " > " + '"' + outputfile + '"' SKIP.
    OUTPUT CLOSE.
    
    /* Execute the batch file and read the cfg.out file. */
    ASSIGN cmd = (IF OPSYS = "unix" THEN unixshell + " " ELSE "") + '"' + batchfile + '"'.
    OS-COMMAND SILENT VALUE(cmd).
    
    IF SEARCH(outputfile) <> ? THEN DO:
        INPUT FROM VALUE(outputfile) NO-ECHO.
        DO i = 1 to 4:
            IMPORT UNFORMATTED cfgline.
            ASSIGN cfgline = TRIM(cfgline).
            IF SUBSTRING(cfgline,1,19) = "Configuration file:" THEN
                ASSIGN {&WINDOW-NAME}:TITLE = "PROGRESS Configuration File - "
                        + TRIM(SUBSTRING(cfgline,21)).
            ELSE IF SUBSTRING(cfgline,1,13) = "Company Name:" THEN
                ASSIGN company = TRIM(SUBSTRING(cfgline,15)).
            ELSE IF SUBSTRING(cfgline,1,6) = "Error:" THEN
            DO: /* Bad thing happened */
                MESSAGE cfgline skip 
                        "Try setting the PROCFG environment variable in your O/S environment."
                        VIEW-AS ALERT-BOX ERROR BUTTONS OK.
                RUN adecomm/_setcurs.p ("").
                ASSIGN rc = 1.
                RETURN.
            END.
        END.
        REPEAT:
            IMPORT UNFORMATTED cfgline.
            ASSIGN cfgline = TRIM(cfgline).
            CASE substring(cfgline,1,2):
                WHEN 'Pr' THEN DO:
                    CREATE cfg.
                    ASSIGN cfg.product = TRIM(SUBSTRING(cfgline,15)).
                END.
                WHEN 'In' THEN
                    ASSIGN cfg.install_date = TRIM(SUBSTRING(cfgline,20)).
                WHEN 'Us' THEN
                    ASSIGN cfg.user_limit = INTEGER(SUBSTRING(cfgline,13)).
                WHEN 'Ex' THEN
                    ASSIGN cfg.expiration_date = TRIM(SUBSTRING(cfgline,18)).
                WHEN 'Se' THEN
                    ASSIGN cfg.serial_number = TRIM(SUBSTRING(cfgline,16)).
                WHEN 'Co' THEN
                    ASSIGN cfg.control_numbers = TRIM(SUBSTRING(cfgline,18)).
                WHEN 'Ve' THEN
                    ASSIGN cfg.version_number = TRIM(SUBSTRING(cfgline,17)).
                WHEN 'Ma' THEN
                    ASSIGN cfg.machine_class = TRIM(SUBSTRING(cfgline,16)).
                WHEN 'Po' THEN
                    ASSIGN cfg.port_number = INTEGER(TRIM(SUBSTRING(cfgline,14))).
            END CASE.
        END.
        INPUT CLOSE.
        RUN adecomm/_setcurs.p ("").
    END. 
    ELSE DO:
        MESSAGE "Program was not able to extract configuration information."
            VIEW-AS ALERT-BOX ERROR BUTTONS OK.
        RUN adecomm/_setcurs.p ("").
        ASSIGN rc = 1.
        RETURN.
    END.    
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: _proobjv.p

  Description: Start the Progress COM Object Viewer executable.

  Input Parameters:
      <none>

  Output Parameters:
      <none>

  Author: Gerry Seidl

  Modified: 
     
 *---------------------------------------------------------------------------*/
IF SESSION:WINDOW-SYSTEM BEGINS "MS-WIN" THEN DO:
  FILE-INFO:FILE-NAME = "bin\proobjvw.exe".
  IF FILE-INFO:FULL-PATHNAME NE ? THEN DO:
    RUN WinExec (INPUT FILE-INFO:FULL-PATHNAME, INPUT 1). 
  END.
  ELSE MESSAGE "proobjvw.exe was not found."
         VIEW-AS ALERT-BOX ERROR.
END.
ELSE
  MESSAGE "This program runs only under Microsoft Windows."
    VIEW-AS ALERT-BOX ERROR.
    
PROCEDURE WinExec EXTERNAL "KERNEL32.DLL": 
    DEFINE INPUT PARAMETER prog_name AS CHARACTER. 
    DEFINE INPUT PARAMETER prog_style AS SHORT. 
END.









&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,2008 by Progress Software Corporation. All rights *
* reserved. Prior versions of this work may contain portions           *
* contributed by participants of Possenet.                             *
*                                                                      *
***********************************************************************/
/*------------------------------------------------------------------------

  File: _propath.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 by Gerry Seidl
              GFS on 11/06/98 - Made deleting directory items smarter
------------------------------------------------------------------------*/
/*          This .W file was created with the Progress UIB.             */
/*----------------------------------------------------------------------*/
{ protools/ptlshlp.i } /* help definitions */
{ adecomm/_adetool.i }

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

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

/* Standard List Definitions                                            */
&Scoped-Define ENABLED-OBJECTS path-list Btn_OK Btn_Cancel b_add b_modify ~
b_delete b_search b_move_up b_move_down BUTTON-3 

/* 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 FixSlashes f 
FUNCTION FixSlashes RETURNS CHARACTER
  ( INPUT pname AS CHARACTER)  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":L 
     SIZE 15 BY 1.14.

DEFINE BUTTON Btn_OK AUTO-GO 
     LABEL "OK":L 
     SIZE 15 BY 1.14.

DEFINE BUTTON BUTTON-3 
     LABEL "&Help" 
     SIZE 15 BY 1.14.

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_modify 
     LABEL "&Modify":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 BUTTON b_search 
     LABEL "&Search..." 
     SIZE 15 BY 1.14.

DEFINE VARIABLE path-list AS CHARACTER 
     VIEW-AS SELECTION-LIST MULTIPLE 
     SCROLLBAR-HORIZONTAL SCROLLBAR-VERTICAL 
     SIZE 64 BY 15 NO-UNDO.


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

DEFINE FRAME f
     path-list AT ROW 1.48 COL 2.2 NO-LABEL
     Btn_OK AT ROW 1.62 COL 68
     Btn_Cancel AT ROW 2.91 COL 68
     b_add AT ROW 5.24 COL 68
     b_modify AT ROW 6.57 COL 68
     b_delete AT ROW 7.86 COL 68
     b_search AT ROW 9.1 COL 68
     b_move_up AT ROW 11.24 COL 68
     b_move_down AT ROW 12.48 COL 68
     BUTTON-3 AT ROW 15.29 COL 68
     SPACE(1.59) SKIP(0.32)
    WITH VIEW-AS DIALOG-BOX KEEP-TAB-ORDER 
         SIDE-LABELS THREE-D  SCROLLABLE 
         TITLE "Propath Editor":L
         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 f
   UNDERLINE                                                            */
ASSIGN 
       FRAME f:SCROLLABLE       = FALSE.

/* SETTINGS FOR BUTTON Btn_Cancel IN FRAME f
   NO-DISPLAY                                                           */
/* SETTINGS FOR BUTTON Btn_OK IN FRAME f
   NO-DISPLAY                                                           */
/* SETTINGS FOR BUTTON b_add IN FRAME f
   NO-DISPLAY                                                           */
/* SETTINGS FOR BUTTON b_delete IN FRAME f
   NO-DISPLAY                                                           */
/* SETTINGS FOR BUTTON b_modify 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                                                           */
ASSIGN 
       path-list:DELIMITER IN FRAME f      = CHR(4) .

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

 



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

&Scoped-define SELF-NAME BUTTON-3
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL BUTTON-3 f
ON CHOOSE OF BUTTON-3 IN FRAME f /* Help */
DO:
  RUN adecomm/_adehelp.p ( "ptls", "CONTEXT", {&PROPATH_Editor}, ? ).  
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:
  DEFINE VAR l_ok           AS LOGICAL   NO-UNDO.
  DEFINE VAR Invalid_IsOK   AS LOGICAL   NO-UNDO INIT NO.
  DEFINE VAR file_ext       AS CHARACTER NO-UNDO.
  
  DEFINE FRAME f_add
         "Directory:" VIEW-AS TEXT AT ROW 1.5 COL 2
         new_dir    AS CHAR FORMAT "X(132)" VIEW-AS FILL-IN SIZE 50 BY 1.08
                    AT 2
         btn_OK     AT ROW 1.5 COL 54
         SKIP (0.1)
         btn_cancel AT 54 SPACE (1)
         SKIP (0.5)
         WITH SIDE-LABELS NO-LABELS THREE-D
              DEFAULT-BUTTON btn_OK 
              VIEW-AS DIALOG-BOX KEEP-TAB-ORDER 
                      TITLE "Add Directory from Propath".
  
  /* Parent the dialog-box to same window as the "parent" dialog.   */
  FRAME f_add:PARENT = FRAME {&FRAME-NAME}:PARENT.
  ON WINDOW-CLOSE OF FRAME f_add APPLY "END-ERROR" TO SELF.

l_ok = NO.
  MAIN_LOOP:
  DO WHILE NOT l_ok
     ON STOP UNDO, LEAVE  ON ENDKEY UNDO, LEAVE:
    RUN adecomm/_setcurs.p (INPUT "":U).
    ENABLE new_dir btn_OK btn_cancel WITH FRAME f_add.
    WAIT-FOR GO OF FRAME f_add.
    RUN adecomm/_setcurs.p (INPUT "WAIT":U).
    ASSIGN new_dir:SCREEN-VALUE = TRIM(new_dir:SCREEN-VALUE)
           new_dir:SCREEN-VALUE = "." WHEN new_dir:SCREEN-VALUE = ""
           .

    /* Is the choice a valid directory? i.e. It is blank (shorthand for 
       the current directory)  OR it is a real directory. */
    ASSIGN FILE-INFO:FILENAME = new_dir:SCREEN-VALUE
           Invalid_IsOK       = NO.
    IF ( FILE-INFO:FULL-PATHNAME = ? ) THEN
    DO:
        RUN adecomm/_osfext.p (INPUT new_dir:SCREEN-VALUE, OUTPUT file_ext).
        MESSAGE new_dir:SCREEN-VALUE SKIP
                IF file_ext <> ".pl" THEN
                    "Cannot find this directory."
                ELSE
                    "Cannot find this r-code library."
                SKIP(1)
                "Do you want to continue?"
                VIEW-AS ALERT-BOX WARNING BUTTONS YES-NO 
                        UPDATE Invalid_IsOK .
        IF ( Invalid_IsOK = NO ) THEN NEXT MAIN_LOOP.
    END.
    /* If its not a directory, it must be an r-code lib. Otherwise, invalid. */
    IF ( NOT FILE-INFO:FILE-TYPE BEGINS "D" ) THEN
    DO:
        RUN adecomm/_osfext.p (INPUT new_dir:SCREEN-VALUE, OUTPUT file_ext).
        IF file_ext <> ".pl":U THEN
        DO ON STOP UNDO, RETRY:
          IF NOT RETRY THEN
          MESSAGE new_dir:SCREEN-VALUE SKIP
                  "This is not a valid directory or r-code library."
                  VIEW-AS ALERT-BOX WARNING.
          NEXT MAIN_LOOP.
        END.
    END.
    ASSIGN l_ok = YES.
    ASSIGN l_ok = path-list:ADD-FIRST ("  0. " + (IF FILE-INFO:FILENAME = "." THEN "[current directory]" ELSE FILE-INFO:FILENAME)).
    IF l_ok THEN
    DO:
        RUN number_path.
        path-list:SCREEN-VALUE = path-list:ENTRY(1).
    END.
  END.
  RUN adecomm/_setcurs.p (INPUT "":U).
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.
  DEFINE VAR adedir AS CHAR    NO-UNDO.
  DEFINE VAR bindir AS CHAR    NO-UNDO.
  DEFINE VAR dlcdir AS CHAR    NO-UNDO.
  DEFINE VAR rawdir AS CHAR    NO-UNDO.
  DEFINE VAR ppitem AS CHAR    NO-UNDO.
  
  /* Read DLC from Registry or INI */
  GET-KEY-VALUE SECTION "Startup":U KEY "DLC":U VALUE dlcdir.

  /* 
   * If DLC is not in the Registry or INI file (not likely, 
   * then get it from the environment 
   */
  IF dlcdir = ? OR dlcdir = "" THEN
    ASSIGN dlcdir = OS-GETENV("DLC":U).

  ASSIGN dlcdir = FixSlashes(dlcdir)
         adedir = dlcdir + "~\gui":U
         bindir = dlcdir + "~\bin":U
         choice = path-list:SCREEN-VALUE.         
  
  /* 
   * Loop through chosen entries and validate each one and
   * allow the user to delete any entry which is not dlcdir,
   * bindir or in adedir
   */
  DO i = 1 TO NUM-ENTRIES(choice):
    ASSIGN ppitem = ENTRY(i,choice)
           rawdir = FixSlashes(TRIM(SUBSTRING(ppitem,INDEX(ppitem,".":U) + 1,-1,"CHARACTER":U))).
    /* Validate the item */
    IF rawdir = dlcdir OR rawdir = bindir OR INDEX(rawdir,adedir) > 0 THEN
      MESSAGE "Progress does not allow you to remove " + rawdir + " from the Propath"
          VIEW-AS ALERT-BOX ERROR BUTTONS OK.
    ELSE /* Ok to delete */
      l_ok = path-list:DELETE(ppitem).
  END.
  
  /* Renumber the path */
  RUN number_path.
  
  /* Set currently selected item to the first one in the list */
  path-list:SCREEN-VALUE = path-list:ENTRY(1).
END.

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


&Scoped-define SELF-NAME b_modify
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL b_modify f
ON CHOOSE OF b_modify IN FRAME f /* Modify */
DO:
  DEFINE VAR l_ok           AS LOGICAL   NO-UNDO.
  DEFINE VAR Invalid_IsOK   AS LOGICAL   NO-UNDO INIT NO.
  DEFINE VAR file_ext       AS CHARACTER NO-UNDO.
  DEFINE VARIABLE curr_dir  AS CHARACTER NO-UNDO.
  DEFINE VARIABLE pos       AS INTEGER   NO-UNDO.
  DEFINE VARIABLE cpos      AS CHARACTER NO-UNDO.

  DEFINE FRAME f_modify
         "Directory:" VIEW-AS TEXT AT ROW 1.5 COL 2
         new_dir    AS CHAR FORMAT "X(132)" VIEW-AS FILL-IN SIZE 50 BY 1.08
                    AT 2
         btn_OK     AT ROW 1.5 COL 54
         SKIP (0.1)
         btn_cancel AT 54 SPACE (1)
         SKIP (0.5)
         WITH SIDE-LABELS NO-LABELS THREE-D
              DEFAULT-BUTTON btn_OK 
              VIEW-AS DIALOG-BOX KEEP-TAB-ORDER 
                      TITLE "Modify Directory".
  
  /* Parent the dialog-box to same window as the "parent" dialog.   */
  FRAME f_modify:PARENT = FRAME {&FRAME-NAME}:PARENT.
  ON WINDOW-CLOSE OF FRAME f_modify APPLY "END-ERROR" TO SELF.

  ASSIGN NEW_dir:SCREEN-VALUE = trim(substring(path-list:SCREEN-VALUE,INDEX(path-list:SCREEN-VALUE,".") + 2))
         curr_dir = path-list:SCREEN-VALUE.

  l_ok = NO.
  MAIN_LOOP:
  DO WHILE NOT l_ok
     ON STOP UNDO, LEAVE  ON ENDKEY UNDO, LEAVE:
    RUN adecomm/_setcurs.p (INPUT "":U).
    ENABLE new_dir btn_OK btn_cancel WITH FRAME f_modify.
    WAIT-FOR GO OF FRAME f_modify.
    RUN adecomm/_setcurs.p (INPUT "WAIT":U).
    ASSIGN new_dir:SCREEN-VALUE = TRIM(new_dir:SCREEN-VALUE)
           new_dir:SCREEN-VALUE = "." WHEN new_dir:SCREEN-VALUE = ""
           .

    /* Is the choice a valid directory? i.e. It is blank (shorthand for 
       the current directory)  OR it is a real directory. */
    ASSIGN FILE-INFO:FILENAME = new_dir:SCREEN-VALUE
           Invalid_IsOK       = NO.
    IF ( FILE-INFO:FULL-PATHNAME = ? ) THEN
    DO:
        RUN adecomm/_osfext.p (INPUT new_dir:SCREEN-VALUE, OUTPUT file_ext).
        MESSAGE new_dir:SCREEN-VALUE SKIP
                IF file_ext <> ".pl" THEN
                    "Cannot find this directory."
                ELSE
                    "Cannot find this r-code library."
                SKIP(1)
                "Do you want to continue?"
                VIEW-AS ALERT-BOX WARNING BUTTONS YES-NO 
                        UPDATE Invalid_IsOK .
        IF ( Invalid_IsOK = NO ) THEN NEXT MAIN_LOOP.
    END.
    /* If its not a directory, it must be an r-code lib. Otherwise, invalid. */
    IF ( NOT FILE-INFO:FILE-TYPE BEGINS "D" ) THEN
    DO:
        RUN adecomm/_osfext.p (INPUT new_dir:SCREEN-VALUE, OUTPUT file_ext).
        IF file_ext <> ".pl":U THEN
        DO ON STOP UNDO, RETRY:
          IF NOT RETRY THEN
          MESSAGE new_dir:SCREEN-VALUE SKIP
                  "This is not a valid directory or r-code library."
                  VIEW-AS ALERT-BOX WARNING.
          NEXT MAIN_LOOP.
        END.
    END.
    ASSIGN l_ok = YES.
    ASSIGN pos       = INT(TRIM(SUBSTRING(curr_dir,1,(INDEX(curr_dir,".":U,1) - 1)))) 
           cpos      = IF pos < 100 THEN STRING(pos," 99":U) ELSE STRING(pos,"999":U) 
           new_dir   = cpos + ". " + new_dir:SCREEN-VALUE.
    path-list:REPLACE(new_dir,pos).
    IF l_ok THEN
    DO:
        RUN number_path.
        path-list:SCREEN-VALUE = path-list:ENTRY(pos). /*Return to same position*/
    END.
  END.
  RUN adecomm/_setcurs.p (INPUT "":U).
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, CHR(4)) TO 1 BY -1:
    ASSIGN choice-item = ENTRY (i,choice,CHR(4)) 
           ipos        = INTEGER (SUBSTRING(choice-item,1,3)).
    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,CHR(4)) eq 0
      THEN ASSIGN
             new-choice = choice-item
             new-swap   = swap-item
             SUBSTRING(new-swap,1,3)   = SUBSTRING(choice-item,1,3)
             SUBSTRING(new-choice,1,3) = SUBSTRING(swap-item,1,3)
             l_ok = path-list:REPLACE( new-swap, choice-item)
             l_ok = path-list:REPLACE( new-choice, swap-item)
             ENTRY(i,choice,CHR(4)) = 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, CHR(4)):
    ASSIGN choice-item = ENTRY (i,choice, CHR(4)) 
           ipos        = INTEGER (SUBSTRING(choice-item,1,3)).
    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,CHR(4)) eq 0
      THEN ASSIGN
             new-choice = choice-item
             new-swap   = swap-item
             SUBSTRING(new-swap,1,3)   = SUBSTRING(choice-item,1,3)
             SUBSTRING(new-choice,1,3) = SUBSTRING(swap-item,1,3)
             l_ok = path-list:REPLACE( new-swap, choice-item)
             l_ok = path-list:REPLACE( new-choice, swap-item)
             ENTRY(i,choice,CHR(4)) = 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_search
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL b_search f
ON CHOOSE OF b_search IN FRAME f /* Search... */
DO:
  RUN protools/_search.w.
END.

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


&Scoped-define SELF-NAME path-list
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL path-list f
ON MOUSE-SELECT-DBLCLICK OF path-list IN FRAME f
DO:
  APPLY "choose" TO b_modify.
END.

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


&UNDEFINE SELF-NAME

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


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

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

/* Populate the selection list */
RUN get_path.

/* 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.
  WAIT-FOR GO OF FRAME {&FRAME-NAME}.
  /* Reset PROPATH based on any changes */
  RUN set_propath.
END.
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 Btn_OK Btn_Cancel b_add b_modify b_delete b_search b_move_up 
         b_move_down BUTTON-3 
      WITH 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 
               PROPATH.  Note that we put line numbers on each line 
               (and we support up to 999 items in the propath).
  Parameters:  <none>
 -------------------------------------------------------------*/
  DEFINE VAR plist AS CHAR    NO-UNDO.
  DEFINE VAR i     AS INTEGER NO-UNDO.
  DEFINE VAR cnt   AS INTEGER NO-UNDO.
  
  cnt = NUM-ENTRIES(PROPATH).
  IF cnt > 999 THEN DO:
    MESSAGE "Only 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 (this will allow us to have unique entries). */
  DO i = 1 TO cnt:
    IF entry(i,PROPATH) = "." THEN 
         plist = (IF i eq 1 THEN "" ELSE plist + CHR(4)) + STRING(i,">>9") + ". " + "[current directory]".
    ELSE plist = (IF i eq 1 THEN "" ELSE plist + CHR(4)) + STRING(i,">>9") + ". " + ENTRY(i,PROPATH).
  END.
  path-list:LIST-ITEMS IN FRAME {&FRAME-NAME} = plist.
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 + CHR(4)) + 
              STRING(i,">>9") + SUBSTRING(path-list:ENTRY(i),4).
    END.
    path-list:LIST-ITEMS = plist.
  END.
END PROCEDURE.

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

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE set_propath f 
PROCEDURE set_propath :
/* -----------------------------------------------------------
  Purpose:     Copy the contents of the path-list to PROPATH. 
               Note that we need to remove the line numbers from
               each line (in format ">>9. ") by taking the substring
               of each line.
  Parameters:  <none>
 -------------------------------------------------------------*/
  DEFINE VAR path   AS CHAR    CASE-SENSITIVE  NO-UNDO.
  DEFINE VAR i      AS INTEGER                 NO-UNDO.
  DEFINE VAR choice AS LOGICAL                 NO-UNDO.
  DEFINE VAR dlcdir AS CHAR                    NO-UNDO.
  DEFINE VAR oldpp  AS CHAR    FORMAT "X(4096)" NO-UNDO. /* save to INI file */
  
  DO WITH FRAME {&FRAME-NAME}:
    /* Remove a number from each line.  */
    DO i = 1 TO path-list:NUM-ITEMS:
      path = (IF i eq 1 THEN "" ELSE path + ",":U) + SUBSTRING(path-list:ENTRY(i),6).
    END.
  END.
  ASSIGN i = LOOKUP("[current directory]",path).
  IF i > 0 THEN
      ENTRY(i,path) = ".".
  /* Store PROPATH if it has changed */
  IF PROPATH NE path THEN DO:
      ASSIGN PROPATH = path.
      MESSAGE "Propath was changed only for this session. " skip
          "Do you want to save it to your startup file?"  skip
          "(the previous value will be saved to OLD-PROPATH)"
          VIEW-AS ALERT-BOX QUESTION BUTTONS yes-no UPDATE choice.
      IF choice THEN DO:
          /* Since %DLC%\GUI, %DLC% & %DLC%\BIN are automatically added, we will not write
           * them out */
          ASSIGN dlcdir = OS-GETENV("DLC") + (IF LOOKUP(OPSYS, "MSDOS,WIN32") > 0 THEN "~\gui" ELSE "/gui").
          i = LOOKUP(dlcdir + (IF LOOKUP(OPSYS, "MSDOS,WIN32") > 0 THEN "~\gui" ELSE "/gui"),PATH).
          IF i > 0 THEN ENTRY(i,PATH) = "".
          i = LOOKUP(dlcdir + (IF LOOKUP(OPSYS, "MSDOS,WIN32") > 0 THEN "~\bin" ELSE "/bin"),PATH).
          IF i > 0 THEN ENTRY(i,PATH) = "".
          i = LOOKUP(dlcdir,PATH).
          IF i > 0 THEN ENTRY(i,PATH) = "".
          PATH = REPLACE(PATH,",,",","). /* remove null entries */
          IF LENGTH(PATH) > 4096 THEN DO:
              MESSAGE "Propath exceeds 4096 bytes. It cannot be saved to your startup file"
                  VIEW-AS ALERT-BOX WARNING BUTTONS OK.
              RETURN.
          END.      
          GET-KEY-VALUE SECTION "Startup" KEY "PROPATH" VALUE oldpp.
          IF LENGTH(oldpp) > 0 THEN /* save off old ProPath value */
              PUT-KEY-VALUE SECTION "Startup" KEY "OLD-PROPATH" VALUE oldpp NO-ERROR.
          /* write out new propath */
          PUT-KEY-VALUE SECTION "Startup" KEY "PROPATH" VALUE path NO-ERROR.
          IF ERROR-STATUS:ERROR THEN RUN adeshar/_puterr.p ("Propath Editor", CURRENT-WINDOW).
      END.
  END.
END PROCEDURE.

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

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

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION FixSlashes f 
FUNCTION FixSlashes RETURNS CHARACTER
  ( INPUT pname AS CHARACTER) :
/*------------------------------------------------------------------------------
  Purpose: Gets slashes all tilting the same way so that paths can be compared
    Notes:  
------------------------------------------------------------------------------*/
  RETURN 
    IF LOOKUP(OPSYS, "MSDOS,WIN32":U) > 0 THEN 
      REPLACE(pname,"/":U,"~\":U) 
    ELSE 
      REPLACE(pname,"~\":U,"/":U). 
END FUNCTION.

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

&ANALYZE-SUSPEND _VERSION-NUMBER UIB_v8r12 GUI
&ANALYZE-RESUME
&Scoped-define WINDOW-NAME WINDOW-1
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _DEFINITIONS WINDOW-1 
/***********************************************************************
* 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:             _prospy.w

  Description:      Pro*Spy utility in Pro*Tools
                    Displays messaging between objects

  Input Parameters:
      <none>

  Output Parameters:
      <none>

  Author:           J. Rothermal

  Created:          3/20/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  ************************** */

/* Parameters Definitions ---                                           */

/* Global and Shared Variable Definitions ---                           */
{protools/psvar.i &new = new}
{protools/_runonce.i}
{protools/ptlshlp.i} /* PRO*Tools Help include file */
{src/adm2/support/admhlp.i}  /* ADM Help include file */

DEFINE NEW GLOBAL SHARED VARIABLE wfRunning      AS CHARACTER NO-UNDO.
DEFINE NEW GLOBAL SHARED VARIABLE h_ade_tool     AS HANDLE    NO-UNDO.
DEFINE NEW GLOBAL SHARED VARIABLE adm-broker-hdl AS HANDLE    NO-UNDO.

/* Local Variable Definitions ---                                       */
DEFINE VAR pFile             AS CHAR             NO-UNDO.

DEFINE VAR sNumFld           AS INT              NO-UNDO.
DEFINE VAR c-msg             AS INT              NO-UNDO.

DEFINE VAR logbuffer         AS HANDLE           NO-UNDO.
DEFINE VAR sFrame            AS HANDLE           NO-UNDO.
DEFINE VAR h_break           AS HANDLE           NO-UNDO.
DEFINE VAR h_filter          AS HANDLE           NO-UNDO.
DEFINE VAR hdl               AS HANDLE           NO-UNDO.
DEFINE VAR prospy_runwin     AS HANDLE           NO-UNDO.

DEFINE VAR Saved_File        AS LOG              NO-UNDO.
DEFINE VAR saved_log         AS LOG   INIT ?     NO-UNDO.
DEFINE VAR fOK               AS LOG              NO-UNDO.
DEFINE VAR Smart_Frame       AS LOG              NO-UNDO.

{adecomm/_adetool.i}   /* Signify PRO*Spy as an ADE Persistent Tool. */

/* _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 FRM-MAIN

/* Standard List Definitions                                            */
&Scoped-Define ENABLED-OBJECTS EDITOR-1 RECT-3 btn-break btn-filter ~
btn-mark Btn-help RECT-12 l-step tgl-methods tgl-states 
&Scoped-Define DISPLAYED-OBJECTS EDITOR-1 l-step tgl-methods tgl-states 

/* 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 WINDOW-1 AS WIDGET-HANDLE NO-UNDO.

/* Menu Definitions                                                     */
DEFINE SUB-MENU mnu_File 
       MENU-ITEM m_Run          LABEL "&Run..."       
       RULE
       MENU-ITEM m_Save_As      LABEL "S&ave As..."   
       RULE
       MENU-ITEM m_Exit         LABEL "E&xit"         .

DEFINE SUB-MENU mnu_Options 
       MENU-ITEM m_Break        LABEL "&Break..."     
       MENU-ITEM m_Filter       LABEL "Fil&ter..."    
       MENU-ITEM m_Mark         LABEL "&Mark"         
       MENU-ITEM m_Clear        LABEL "&Clear"        
              DISABLED
       RULE
       MENU-ITEM m_Log          LABEL "&Log"          
              TOGGLE-BOX
       RULE
       MENU-ITEM m_msgcnt       LABEL "Set Message &Counter...".

DEFINE SUB-MENU mnu_Help 
       MENU-ITEM m_Contents     LABEL "&Help Topics"  
       MENU-ITEM m_Search       LABEL "&PRO*Spy Help"  ACCELERATOR "F1"
       RULE
       MENU-ITEM m_ADM          LABEL "&ADM Help..."  
       RULE
       MENU-ITEM m_About        LABEL "About &PRO*Spy".

DEFINE MENU mnu-bar MENUBAR
       SUB-MENU  mnu_File       LABEL "&File"         
       SUB-MENU  mnu_Options    LABEL "&Options"      
       SUB-MENU  mnu_Help       LABEL "&Help"         .


/* Definitions of the field level widgets                               */
DEFINE BUTTON btn-break 
     LABEL "&Break...":L 
     SIZE 10 BY 1.

DEFINE BUTTON btn-clear 
     LABEL "&Clear":L 
     SIZE 10 BY 1.

DEFINE BUTTON btn-filter 
     LABEL "Fil&ter...":L 
     SIZE 10 BY 1.

DEFINE BUTTON Btn-help 
     LABEL "&Help":L 
     SIZE 10 BY 1.

DEFINE BUTTON btn-mark 
     LABEL "Mar&k":L 
     SIZE 10 BY 1.

DEFINE VARIABLE EDITOR-1 AS CHARACTER 
     VIEW-AS EDITOR NO-WORD-WRAP SCROLLBAR-HORIZONTAL SCROLLBAR-VERTICAL LARGE
     SIZE 53.4 BY 9.38
     BGCOLOR 15 FONT 2 NO-UNDO.

DEFINE RECTANGLE RECT-12
     EDGE-PIXELS 3 GRAPHIC-EDGE  NO-FILL 
     SIZE 54 BY 1.67.

DEFINE RECTANGLE RECT-3
     EDGE-PIXELS 3 GRAPHIC-EDGE  NO-FILL 
     SIZE 54 BY 2.

DEFINE VARIABLE l-step AS LOGICAL INITIAL no 
     LABEL "Ste&p Messages" 
     VIEW-AS TOGGLE-BOX
     SIZE 20 BY .76 NO-UNDO.

DEFINE VARIABLE tgl-methods AS LOGICAL INITIAL no 
     LABEL "&Methods" 
     VIEW-AS TOGGLE-BOX
     SIZE 11 BY .76 NO-UNDO.

DEFINE VARIABLE tgl-states AS LOGICAL INITIAL no 
     LABEL "&States" 
     VIEW-AS TOGGLE-BOX
     SIZE 10 BY .76 NO-UNDO.


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

DEFINE FRAME FRM-MAIN
     EDITOR-1 AT ROW 1.81 COL 2.6 NO-LABEL
     btn-break AT ROW 12.19 COL 4
     btn-filter AT ROW 12.19 COL 14
     btn-clear AT ROW 12.19 COL 24
     btn-mark AT ROW 12.19 COL 34
     Btn-help AT ROW 12.19 COL 44
     l-step AT ROW 14.33 COL 4
     tgl-methods AT ROW 14.33 COL 34
     tgl-states AT ROW 14.33 COL 45.4
     "SmartObjects" VIEW-AS TEXT
          SIZE 17 BY .67 AT ROW 1 COL 3
     "Methods/States" VIEW-AS TEXT
          SIZE 23 BY .67 AT ROW 1 COL 28
     RECT-3 AT ROW 11.62 COL 2
     RECT-12 AT ROW 13.86 COL 2
     "Display:" VIEW-AS TEXT
          SIZE 8 BY .76 AT ROW 14.33 COL 25
    WITH 1 DOWN NO-BOX KEEP-TAB-ORDER OVERLAY 
         NO-LABELS SIDE-LABELS NO-UNDERLINE THREE-D 
         AT COL 1 ROW 1 SCROLLABLE 
         FONT 4.


/* *********************** 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 WINDOW-1 ASSIGN
         HIDDEN             = YES
         TITLE              = "PRO*Spy"
         COLUMN             = 38.8
         ROW                = 7.57
         HEIGHT             = 15.71
         WIDTH              = 55.8
         MAX-HEIGHT         = 24.14
         MAX-WIDTH          = 107.8
         VIRTUAL-HEIGHT     = 24.14
         VIRTUAL-WIDTH      = 107.8
         MAX-BUTTON         = no
         RESIZE             = no
         SCROLL-BARS        = no
         STATUS-AREA        = no
         BGCOLOR            = ?
         FGCOLOR            = ?
         THREE-D            = yes
         MESSAGE-AREA       = no
         SENSITIVE          = yes.
ELSE {&WINDOW-NAME} = CURRENT-WINDOW.

ASSIGN {&WINDOW-NAME}:MENUBAR    = MENU mnu-bar:HANDLE.
/* END WINDOW DEFINITION                                                */
&ANALYZE-RESUME



/* ***************  Runtime Attributes and UIB Settings  ************** */

&ANALYZE-SUSPEND _RUN-TIME-ATTRIBUTES
/* SETTINGS FOR WINDOW WINDOW-1
  VISIBLE,,RUN-PERSISTENT                                               */
/* SETTINGS FOR FRAME FRM-MAIN
   Size-to-Fit                                                          */
ASSIGN 
       FRAME FRM-MAIN:SCROLLABLE       = FALSE
       FRAME FRM-MAIN:SENSITIVE        = FALSE.

ASSIGN 
       btn-break:PRIVATE-DATA IN FRAME FRM-MAIN     = 
                "Break".

/* SETTINGS FOR BUTTON btn-clear IN FRAME FRM-MAIN
   NO-ENABLE                                                            */
ASSIGN 
       btn-filter:PRIVATE-DATA IN FRAME FRM-MAIN     = 
                "Filter".

ASSIGN 
       Btn-help:MANUAL-HIGHLIGHT IN FRAME FRM-MAIN = TRUE.

ASSIGN 
       EDITOR-1:RETURN-INSERTED IN FRAME FRM-MAIN  = TRUE
       EDITOR-1:READ-ONLY IN FRAME FRM-MAIN        = TRUE.

IF SESSION:DISPLAY-TYPE = "GUI":U AND VALID-HANDLE(WINDOW-1)
THEN WINDOW-1:HIDDEN = yes.

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

 



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

&Scoped-define SELF-NAME Btn-help
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL Btn-help WINDOW-1
ON CHOOSE OF Btn-help IN FRAME FRM-MAIN /* Help */
DO:
    RUN adecomm/_adehelp.p 
        ( INPUT "ptls", INPUT "CONTEXT" , INPUT {&Pro_Spy_Window}, INPUT "" ).
END.

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


&Scoped-define SELF-NAME l-step
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL l-step WINDOW-1
ON VALUE-CHANGED OF l-step IN FRAME FRM-MAIN /* Step Messages */
DO:
  
  IF l-step:CHECKED THEN c-msg = 0.
    
END.


&Scoped-define SELF-NAME m_About
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL m_About WINDOW-1
ON CHOOSE OF MENU-ITEM m_About /* About Pro*Spy */
DO:

    RUN adecomm/_about.p ( "PRO*Spy" , "adeicon/prospy" ).
  
END.

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


&Scoped-define SELF-NAME mnu_File
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL mnu_File WINDOW-1
ON MENU-DROP OF MENU mnu_File /* File */
DO:
  IF NOT VALID-HANDLE(app_handle) THEN
  DO:
    FOR EACH pgm-bf:
      DELETE pgm-bf NO-ERROR.
    END.
    
    FOR EACH pp:
      DELETE pp NO-ERROR.
    END.
    
    FOR EACH def-bf:
      DELETE def-bf NO-ERROR.
    END.
    
    FOR EACH adm-methods-bf:
      DELETE adm-methods-bf NO-ERROR.
    END.    
    
    MENU-ITEM m_Run:SENSITIVE IN MENU mnu_File = yes.
    
    RUN adecomm/_statdsp.p
    (INPUT sFrame,
     INPUT 1,
     INPUT "").
  END.     
END.

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


&Scoped-define SELF-NAME m_ADM
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL m_ADM WINDOW-1
ON CHOOSE OF MENU-ITEM m_ADM /* ADM Help... */
DO:
  
    RUN adecomm/_adehelp.p 
        ( INPUT "uib", INPUT "CONTEXT" , INPUT {&ADM_Basics}, INPUT "" ).

END.

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


&Scoped-define SELF-NAME m_Break
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL m_Break WINDOW-1
ON CHOOSE OF MENU-ITEM m_Break /* Break... */
, btn-break DO:

  IF VALID-HANDLE(h_break) THEN
     RUN Init_Window IN h_break.
  ELSE
     RUN protools/_break.w PERSISTENT SET h_break (INPUT "Breaks").

END.

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


&Scoped-define SELF-NAME m_Clear
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL m_Clear WINDOW-1
ON CHOOSE OF MENU-ITEM m_Clear /* Clear */
, btn-clear DO:
 
  ASSIGN
    editor-1:SCREEN-VALUE IN FRAME FRM-MAIN = ""
    btn-Clear:SENSITIVE = NO
    MENU-ITEM m_Clear:SENSITIVE IN MENU mnu_Options = NO.
    
  IF VALID-HANDLE(logbuffer) THEN
    logbuffer:SCREEN-VALUE = "".
            
END.

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


&Scoped-define SELF-NAME m_Contents
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL m_Contents WINDOW-1
ON CHOOSE OF MENU-ITEM m_Contents /* Help Topics */
DO:
  RUN adecomm/_adehelp.p 
      ( INPUT "ptls", INPUT "TOPICS" , INPUT ?, INPUT "" ).
END.

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


&Scoped-define SELF-NAME m_Exit
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL m_Exit WINDOW-1
ON CHOOSE OF MENU-ITEM m_Exit /* Exit */
DO:
  APPLY "CLOSE":U TO THIS-PROCEDURE.
  RETURN NO-APPLY.
END.

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


&Scoped-define SELF-NAME m_Filter
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL m_Filter WINDOW-1
ON CHOOSE OF MENU-ITEM m_Filter /* Filter... */
, btn-Filter DO:
  IF VALID-HANDLE(h_filter) THEN
     RUN Init_Window IN h_filter.
  ELSE
     RUN protools/_break.w PERSISTENT SET h_filter (INPUT "Filters").
END.

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


&Scoped-define SELF-NAME m_Log
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL m_Log WINDOW-1
ON VALUE-CHANGED OF MENU-ITEM m_Log /* Log */
DO:
  
  IF MENU-ITEM m_log:CHECKED IN MENU mnu_Options THEN DO:
     CREATE EDITOR logbuffer
     ASSIGN LARGE  = YES
            FRAME  = FRAME frm-main:HANDLE
            HIDDEN = YES.
     saved_log = NO.
  END. 

  RUN adecomm/_statdsp.p                                       
      (INPUT sFrame, 
       INPUT 2, 
       INPUT 'Logging ' + 
             STRING(MENU-ITEM m_log:CHECKED IN MENU mnu_Options,"ON/OFF")).
    
END.

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


&Scoped-define SELF-NAME m_Mark
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL m_Mark WINDOW-1
ON CHOOSE OF MENU-ITEM m_Mark /* Mark */
, btn-mark DO:

DEFINE VAR l-dummy    AS LOG NO-UNDO.

ASSIGN
l-dummy = editor-1:INSERT-STRING(CHR(KEYCODE("RETURN")) + FILL(" ",10) +
          "**********************************************************" + 
          CHR(KEYCODE("RETURN")) + CHR(KEYCODE("RETURN")))
         IN FRAME {&frame-name}.

IF MENU-ITEM m_log:CHECKED IN MENU mnu_Options THEN 
  l-dummy = logbuffer:INSERT-STRING(CHR(KEYCODE("RETURN")) + FILL(" ",10) +
            "**********************************************************" + 
            CHR(KEYCODE("RETURN")) + CHR(KEYCODE("RETURN"))).

END.

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


&Scoped-define SELF-NAME m_msgcnt
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL m_msgcnt WINDOW-1
ON CHOOSE OF MENU-ITEM m_msgcnt /* Set Message Counter... */
DO:
  RUN protools/_msgcnt.w.
END.

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


&Scoped-define SELF-NAME m_Run
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL m_Run WINDOW-1
ON CHOOSE OF MENU-ITEM m_Run /* Run... */
DO:

   RUN RunFile.
 
END.

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


&Scoped-define SELF-NAME m_Save_As
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL m_Save_As WINDOW-1
ON CHOOSE OF MENU-ITEM m_Save_As /* Save As... */
DO:
  IF VALID-HANDLE(logbuffer) THEN DO:
      saved_log = YES.
      RUN SaveAsFile (logbuffer:HANDLE).
  END.
  ELSE
      RUN SaveAsFile (editor-1:HANDLE IN FRAME frm-main).
END.

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


&Scoped-define SELF-NAME m_Search
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL m_Search WINDOW-1
ON CHOOSE OF MENU-ITEM m_Search /* PRO*Spy Help */
DO:   
    RUN adecomm/_adehelp.p 
        ( INPUT "ptls", INPUT "CONTEXT" , INPUT {&Pro_Spy_Window}, INPUT "" ).
END.

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


&UNDEFINE SELF-NAME

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _MAIN-BLOCK WINDOW-1 


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

IF "{&WINDOW-SYSTEM}" = "OSF/MOTIF" THEN
  RUN motif-window.


/* Set CURRENT-WINDOW: this will parent dialog-boxes and frames.        */
ASSIGN CURRENT-WINDOW                  = {&WINDOW-NAME} 
       THIS-PROCEDURE:CURRENT-WINDOW   = {&WINDOW-NAME}.

/* Shared var used to parent the Breaks and Filters windows. */
ASSIGN ps_window = {&WINDOW-NAME}.

/* Ensure that the window cannot be resized by the WINDOW-MAXIMIZED event. */
ASSIGN {&WINDOW-NAME}:MAX-WIDTH  = {&WINDOW-NAME}:WIDTH
       {&WINDOW-NAME}:MAX-HEIGHT = {&WINDOW-NAME}:HEIGHT .

/* The CLOSE event can be used from inside or outside the procedure to  */
/* terminate it.                                                        */
ON CLOSE OF THIS-PROCEDURE DO:
    RUN Destroy.
    IF RETURN-VALUE = "NO-APPLY":U THEN
        RETURN NO-APPLY.
END.

/* 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:
  IF MENU-ITEM m_Exit:SENSITIVE IN MENU mnu_File = TRUE THEN
    APPLY "CLOSE":U TO THIS-PROCEDURE.
  RETURN NO-APPLY.
END.

/*
/* Best default for GUI applications is...                              */
PAUSE 0 BEFORE-HIDE.
*/

/* Prevent this procedure from being called twice (by checking FILE-NAME) */
IF THIS-PROCEDURE:PERSISTENT THEN DO:
  /* See if a copy already exists. */
  hdl = SESSION:FIRST-PROCEDURE.
  DO WHILE VALID-HANDLE(hdl):   
    IF hdl ne THIS-PROCEDURE AND hdl:FILE-NAME eq THIS-PROCEDURE:FILE-NAME THEN
    DO ON STOP UNDO, RETRY:
      IF NOT RETRY THEN
        MESSAGE "PRO*Spy is already running."
              VIEW-AS ALERT-BOX WARNING BUTTONS OK IN WINDOW {&WINDOW-NAME}.
      DELETE PROCEDURE THIS-PROCEDURE.
      RETURN.
    END.
    hdl = hdl:NEXT-SIBLING.
  END.
END. 

ASSIGN fOK = {&WINDOW-NAME}:LOAD-ICON("adeicon/prospy").

/* Now enable the interface and wait for the exit condition.            */
MAIN-BLOCK:
DO ON STOP UNDO MAIN-BLOCK, RETRY MAIN-BLOCK:
  IF NOT RETRY THEN
  DO:   
    RUN enable_UI.         
    RUN RunFile.           
  
    IF NOT THIS-PROCEDURE:PERSISTENT THEN 
        WAIT-FOR CLOSE OF THIS-PROCEDURE.
  END.
  ELSE APPLY "CLOSE":U TO THIS-PROCEDURE.
END.

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


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

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE Close_RunWin WINDOW-1 
PROCEDURE Close_RunWin :
/*--------------------------------------------------------------------------
    Purpose:        Called by PRO*Spy Run Window when user chooses
                    to close window. Only applies to running SmartFrames.

    Run Syntax:     RUN Close_RunWin.
    
    Parameters:
        
    Description:    Uses RETURN-VALUE "NO-APPLY" to cancel the Exit.

    Notes:
  ---------------------------------------------------------------------------*/
 
  IF VALID-HANDLE(app_handle) THEN
  DO ON STOP UNDO, LEAVE:
    RUN dispatch IN app_handle ("destroy":u).
    IF VALID-HANDLE(app_handle) THEN
        APPLY "CLOSE" TO app_handle.
    IF VALID-HANDLE(app_handle) THEN
      DELETE PROCEDURE app_handle NO-ERROR.
  END.
  
  /* If we needed to create a run window, delete it now. */
  IF VALID-HANDLE(prospy_runwin) THEN DELETE WIDGET prospy_runwin.

  FOR EACH pgm-bf:
    DELETE pgm-bf NO-ERROR.
  END.
    
  FOR EACH pp:
    DELETE pp NO-ERROR.
  END.
    
  FOR EACH def-bf:
    DELETE def-bf NO-ERROR.
  END.
    
  FOR EACH adm-methods-bf:
    DELETE adm-methods-bf NO-ERROR.
  END.

END PROCEDURE.

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

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE Destroy WINDOW-1 
PROCEDURE Destroy :
/*--------------------------------------------------------------------------
    Purpose:        Low-level routine to exit PRO*Spy.

    Run Syntax:     RUN Destroy.
    
    Parameters:
        
    Description:    Uses RETURN-VALUE "NO-APPLY" to cancel the Exit.

    Notes:
  ---------------------------------------------------------------------------*/
 
   DEF VAR save-now AS LOGICAL NO-UNDO.

   RUN Close_RunWin.

   IF MENU-ITEM m_log:CHECKED IN MENU mnu_Options AND
      NOT Saved_File THEN
   DO ON STOP UNDO, RETURN:
      MESSAGE "Messages have been logged but not saved." SKIP
              "Would you like to save them now?" 
              VIEW-AS ALERT-BOX QUESTION BUTTONS YES-NO
              UPDATE save-now.
      IF save-now THEN RUN SaveAsFile (logbuffer:HANDLE).
   END.

   /* If they are open, remove the Break and Filter windows. */
   IF VALID-HANDLE(h_break) THEN
     RUN disable_UI IN h_break.
   IF VALID-HANDLE(h_filter) THEN
     RUN disable_UI IN h_filter.
     
   RUN disable_UI.            

END PROCEDURE.

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

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE disable_UI WINDOW-1 _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(WINDOW-1)
  THEN DELETE WIDGET WINDOW-1.
  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 WINDOW-1 
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.
   -------------------------------------------------------------------- */
  ASSIGN
  tgl-methods = YES
  tgl-states  = YES.
  
  RUN adecomm/_status.p 
      ({&window-name},
       "30,12",
       False,
       4,
       OUTPUT sFrame,
       OUTPUT sNumFld).

  ASSIGN
  sframe:Y      = {&window-name}:HEIGHT-P - sframe:HEIGHT-P
  sframe:HIDDEN = NO.

  DISPLAY EDITOR-1 tgl-states tgl-methods
      WITH FRAME frm-main IN WINDOW WINDOW-1.
      
  ENABLE EDITOR-1 btn-filter btn-break btn-mark 
        btn-help l-step tgl-methods tgl-states 
        WITH FRAME frm-main IN WINDOW {&window-name}.
  {&OPEN-BROWSERS-IN-QUERY-frm-main}

  VIEW WINDOW-1.
END PROCEDURE.

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

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE FileSave WINDOW-1 
PROCEDURE FileSave :
/*--------------------------------------------------------------------------
    Purpose:        Low-level routine to save buffer contents to os file.
                    Updates Window Title if file name has changed.

    Run Syntax:     RUN FileSave ( INPUT p_Buffer , 
                                   INPUT p_File_Selected ,
                                   OUTPUT p_Saved_File ) .

    Parameters:
        
    Description:

    Notes:
  ---------------------------------------------------------------------------*/
 
  DEFINE INPUT PARAMETER p_Buffer        AS WIDGET-HANDLE NO-UNDO.
  DEFINE INPUT PARAMETER p_File_Selected AS CHARACTER NO-UNDO.
  DEFINE OUTPUT PARAMETER p_Saved_File   AS LOGICAL NO-UNDO.
  
  DEFINE VAR Old_BufName AS CHAR NO-UNDO .
  DEFINE VAR Save_OK     AS LOGICAL NO-UNDO.
   
    ASSIGN p_Saved_File = p_Buffer:SAVE-FILE( p_File_Selected ) NO-ERROR .

    IF ( NOT p_Saved_File )
    THEN DO:
        MESSAGE p_Buffer:PRIVATE-DATA 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.
    END.
    
    IF ( NOT p_Saved_File )
    THEN DO:
        ASSIGN
            p_Buffer:PRIVATE-DATA = Old_BufName
            p_Saved_File      = FALSE
            Saved_File        = FALSE
        .
        RETURN.
    END.
                    
    ASSIGN
    Saved_File   = TRUE  /* Global status var. */
    p_Saved_File = TRUE.
   
END PROCEDURE.

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

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE motif-window WINDOW-1 
PROCEDURE motif-window :
/*------------------------------------------------------------------------------
  Purpose:     
  Parameters:  <none>
  Notes:       
------------------------------------------------------------------------------*/

  ASSIGN
      {&window-name}:width = 62
      {&window-name}:max-width = 62
      {&window-name}:virtual-width = 62
      
      FRAME {&frame-name}:width = 62
      
      editor-1:width = 59
      
      rect-12:width = 60
      rect-3:width = 60
      
      btn-break:column = 3
      btn-break:width = 11.50
      
      btn-filter:column = 14.50
      btn-filter:width = 11.50
      
      btn-clear:column = 26
      btn-clear:width = 11.50
      
      btn-mark:column = 37.50
      btn-mark:width = 11.50
      
      btn-help:column = 49.5
      btn-help:width = 11.50
            
      l-step:width = 17
      l-step:height = .80
      
      tgl-methods:column = 32
      tgl-methods:width = 11

      tgl-states:column = 44
      tgl-states:width = 11.
      
END PROCEDURE.

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

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE receive-message WINDOW-1 
PROCEDURE receive-message :
/* -----------------------------------------------------------
  Purpose:     
  Parameters:  2 parameters passed 
               pc-procedure: handle to the procedure calling this
                             routine.
               pc-type     : message type
               pc-input    : comma-separated list with the
                             method being executed and any parameters              
 Notes:       
-------------------------------------------------------------*/

DEFINE INPUT PARAMETER pc-procedure AS HANDLE NO-UNDO.
DEFINE INPUT PARAMETER pc-type      AS CHAR   NO-UNDO.
DEFINE INPUT PARAMETER pc-input     AS CHAR   NO-UNDO.

        
DEFINE VAR pc-param      AS CHAR   NO-UNDO.
DEFINE VAR pc-method     AS CHAR   NO-UNDO.
DEFINE VAR prefix        AS CHAR   NO-UNDO.
DEFINE VAR msg-text      AS CHAR   NO-UNDO.
DEFINE VAR p-name        AS CHAR   NO-UNDO.

DEFINE VAR l-dummy       AS LOG    NO-UNDO.
DEFINE VAR found-break   AS LOG    NO-UNDO.
DEFINE VAR found-filter  AS LOG    NO-UNDO.
DEFINE VAR filtering     AS LOG    NO-UNDO.   
DEFINE VAR breaking      AS LOG    NO-UNDO.   

DEFINE VAR l-cursor_pos  AS LOG.
DEFINE VAR l-choice      AS LOG.

DEFINE BUFFER spgm-bf    FOR pgm-bf.

DEFINE VAR attr-settings AS CHAR   NO-UNDO.


ASSIGN FRAME FRM-MAIN tgl-methods tgl-states.
ASSIGN                                 
    pc-method    = ENTRY(1,pc-type)       
    pc-param     = pc-type
    pc-param     = REPLACE(pc-param,pc-method + ",","")
    found-break  = NO
    found-filter = NO
    filtering    = CAN-FIND(FIRST pgm-bf WHERE pgm-bf.cType = NO)
    breaking     = CAN-FIND(FIRST pgm-bf WHERE pgm-bf.cType = YES).

IF tgl-methods AND not tgl-states AND
   INDEX(pc-param,"new-state") <> 0 THEN RETURN.
                
IF NOT tgl-methods AND tgl-states AND  
   INDEX(pc-param,"new-state") = 0 THEN RETURN.


/* If filter record found then found-filter = TRUE ELSE FALSE */
IF filtering THEN
DO:
  FIND pgm-bf WHERE pgm-bf.cFileName = pc-procedure:FILE-NAME 
                AND pgm-bf.cType     = NO NO-ERROR.
  IF AVAILABLE pgm-bf THEN 
  DO:
    IF pgm-bf.cMethod = "NONE" THEN found-filter = no.
    ELSE
    DO:
      IF pc-input MATCHES ("notify*") AND pgm-bf.cMethod EQ "notify" 
        AND pc-procedure:FILE-NAME EQ pgm-bf.cFileName THEN
        found-filter = yes.
      ELSE
        found-filter = CAN-DO(pgm-bf.cMethod,pc-input).
    END.
  END.                                        
END.


/* If break record found then found-break = TRUE ELSE FALSE */
IF breaking THEN
DO:
  FIND pgm-bf WHERE pgm-bf.cFileName = pc-procedure:FILE-NAME 
                AND pgm-bf.cType     = YES NO-ERROR.   
  IF AVAILABLE pgm-bf THEN 
  DO:
    IF pgm-bf.cMethod = "NONE" THEN found-break = no.
    ELSE
      DO:
        IF pc-input MATCHES ("notify*") AND pgm-bf.cMethod EQ "notify" 
           AND pc-procedure:FILE-NAME EQ pgm-bf.cFileName THEN
          found-break = yes.
        ELSE
          found-break = CAN-DO(pgm-bf.cMethod,pc-input).
      END.
  END.
END.

/* If filtering and filter record matched current message received then */
/* return to calling procedure else continue and print message out */
IF filtering AND found-filter THEN RETURN.

IF NOT tgl-methods AND NOT tgl-states THEN RETURN.


ASSIGN
   l-cursor_pos = editor-1:MOVE-TO-EOF()
   c-msg        = c-msg + 1                                     
   prefix       = IF found-break THEN "*" ELSE " "
   p-name       = pc-procedure:FILE-NAME
   p-name       = IF INDEX(p-name,"/") > 0 THEN SUBSTR(p-name,R-INDEX(p-name,"/") + 1)
                  ELSE p-name
   p-name       = IF INDEX(p-name,"~\") > 0 THEN SUBSTR(p-name,R-INDEX(p-name,"~\") + 1)
                  ELSE p-name
   msg-text     = ((prefix + lc(p-name)) + " ":U10) + CHR(9) +
                  lc(pc-input) + FILL(" ",12 - LENGTH(pc-input))
   msg-text     = msg-text + CHR(10)     
   l-dummy      = editor-1:INSERT-STRING(msg-text) IN FRAME {&frame-name}
                                
   btn-Clear:SENSITIVE = YES
   MENU-ITEM m_Clear:SENSITIVE IN MENU mnu_Options = YES.


IF MENU-ITEM m_log:CHECKED IN MENU mnu_Options THEN 
  l-dummy = logbuffer:INSERT-STRING(msg-text). 

IF found-break THEN 
DO:
  ASSIGN                                  
    c-msg   = msgcnt.

  IF l-step:CHECKED EQ FALSE THEN
  DO:   
    MESSAGE "Stopped at:  "  pc-input SKIP(1)
            "                in:  "  p-name SKIP(1)
            " Stepping is not on, would you like to turn it on?"
            VIEW-AS ALERT-BOX QUESTION BUTTONS YES-NO
            TITLE "Question" UPDATE l-choice.
       
     IF l-choice EQ TRUE THEN 
     DO:
       ASSIGN l-step = yes.
       DISPLAY l-step WITH FRAME frm-main.
     END.
  END.
  ELSE IF l-step:CHECKED EQ TRUE THEN
  DO:
    MESSAGE "Stopped at:  " pc-input SKIP(1)
            "               in:  " p-name  SKIP(1)
            " Stepping is on, would you like to turn it off?"
            VIEW-AS ALERT-BOX QUESTION BUTTONS YES-NO
            TITLE "Question" UPDATE l-choice.
       
    IF l-choice EQ TRUE THEN
    DO:
      ASSIGN l-step = no.
      DISPLAY l-step WITH FRAME frm-main.
    END.
  END.      
END.

IF l-step:CHECKED THEN  
DO:
  l-dummy = {&window-name}:MOVE-TO-TOP().
  
  IF c-msg = msgcnt THEN 
  DO:
    MESSAGE "Stepping ..." SKIP(1)
            "Would you like to turn stepping off?"
            VIEW-AS ALERT-BOX QUESTION BUTTONS YES-NO
            TITLE "Question" UPDATE l-choice.
     
    IF l-choice EQ TRUE THEN
    DO:
      ASSIGN l-step = no.
      DISPLAY l-step WITH FRAME frm-main.
    END.

    c-msg = 0.
  END. /* msgcnt limit hit */
END.   /* l-step:CHECKED */ 

/* If broker.p adm-destroy, clear the Break and Filter windows. */
IF TRIM(pc-input) = "adm-destroy":U AND p-name = "broker.p":U THEN
DO:
  /* Clear the Break and Filter windows. */
  IF VALID-HANDLE(h_break) THEN
    RUN Reset_Lists IN h_break.
  IF VALID-HANDLE(h_filter) THEN
    RUN Reset_Lists IN h_filter.
    
  /* Enable the Run option. */
  ASSIGN MENU-ITEM m_Run:SENSITIVE IN MENU mnu_File = YES.
END.

END PROCEDURE.

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

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE RunFile WINDOW-1 
PROCEDURE RunFile :
/*--------------------------------------------------------------------------
    Purpose:        Executes the RUN command, which allows user to select
                    and run an existing file.

    Run Syntax:     RUN RunnFile.

    Parameters:

    Description:

        1. Prompts user for name of file to open.

    Notes:
  ---------------------------------------------------------------------------*/

  DEFINE VARIABLE OF_OK         AS LOGICAL   NO-UNDO.
  DEFINE VARIABLE Valid_BufName AS LOGICAL   NO-UNDO.   
  DEFINE VARIABLE WF_Run        AS LOGICAL   NO-UNDO.
  
  DEFINE VARIABLE File_Selected AS CHARACTER NO-UNDO.
  
  DEFINE VARIABLE tBuffer       AS HANDLE    NO-UNDO.       
 

  CREATE EDITOR tBuffer
  ASSIGN large  = yes
         WIDTH  = 25
         HEIGHT = 10
         ROW    = 2
         COL    = 1
         HIDDEN = YES
         FRAME  = FRAME frm-main:HANDLE
         .

  File_Selected = ?.
  OPEN_BLOCK:
  DO WHILE TRUE:
    
    RUN adecomm/_getfile.p (INPUT WINDOW-1 , INPUT "PRO*Spy" , 
                            "OPEN":U , "Run" , "OPEN":U , 
                            INPUT-OUTPUT File_Selected ,
                            OUTPUT OF_OK ).
    IF NOT OF_OK THEN DO:
        DELETE WIDGET tBuffer.  
        RETURN. /* User pressed Cancel. */
    END.

    OF_OK = tBuffer:READ-FILE(File_Selected).
    IF OF_OK THEN DO:
       /* If the file does not have the ADM-CONTAINER preprocessor,
          then tell user its not a SmartContainer and don't let them
          run the procedure. */
       OF_OK = tBuffer:SEARCH("&Scoped-define ADM-CONTAINER":U,
                              FIND-NEXT-OCCURRENCE).
       IF NOT OF_OK THEN
       DO ON STOP UNDO, RETRY:
           IF NOT RETRY THEN
                MESSAGE File_Selected SKIP
                       "Cannot run this procedure." SKIP(1)
                       "PRO*Spy can only run SmartContainers."
                  VIEW-AS ALERT-BOX INFORMATION BUTTONS OK.
           NEXT OPEN_BLOCK.
       END. 
    END.
    /* We'll need to know if its a SmartFrame for controlling the window
       a SmartFrame runs in.
    */
    ASSIGN Smart_Frame = tBuffer:SEARCH("Type: SmartFrame":U, FIND-NEXT-OCCURRENCE).
                                  
    /* Scan back up the file to see if the UIB-generated Connected Databases
       line is present. If it is and there are no db's connected, warn
       the user and make them connect to a database. */
    OF_OK = tBuffer:SEARCH("/" + "* Connected Databases":U, FIND-PREV-OCCURRENCE).
    
    IF OF_OK = TRUE AND NUM-DBS = 0 THEN
    DO ON STOP UNDO, RETRY:
       IF NOT RETRY THEN
            RUN adecomm/_dbcnnct.p
                (INPUT "You must have at least one connected database to " +
                       "access database information.",
                 OUTPUT OF_OK).
         IF NOT OF_OK OR RETRY THEN NEXT OPEN_BLOCK.
    END.

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

    /* Register PRO*Spy running a procedure. */
    RUN adecomm/_wfrun.p (INPUT "PRO*Spy.", OUTPUT WF_Run).
    /* If another tool is already running a procedure, can't proceed */
    IF WF_Run THEN
    DO:
      RUN adecomm/_setcurs.p (INPUT "").
      RETURN.
    END.
    
    RUN adecomm/_runcode.p
           ( INPUT File_Selected,
             INPUT "_PERSISTENT, _KEEP-WIDGETS",
             INPUT ?,
             OUTPUT app_handle ).
    ASSIGN wfrunning = "".
    
    RUN set-watchdog IN adm-broker-hdl (INPUT THIS-PROCEDURE) NO-ERROR.
    
    IF NOT ERROR-STATUS:ERROR THEN 
    DO:
        /* Ensure SmartFrame code does not parent to PRO*Spy's window
           by pointing current-window to PRO*Spy Run Window. */
        IF Smart_Frame THEN
        DO:
          /* We create the run window new each time so it always has
             the default Progress window characteristics. */
          IF VALID-HANDLE(prospy_runwin) THEN DELETE WIDGET prospy_runwin.
          CREATE WINDOW prospy_runwin
              ASSIGN PARENT = WINDOW-1
                     TITLE  = "PRO*Spy - Run"
              TRIGGERS:
                ON WINDOW-CLOSE PERSISTENT
                    RUN Close_RunWin IN THIS-PROCEDURE.
              END TRIGGERS.
          ASSIGN CURRENT-WINDOW = prospy_runwin.
        END.
        
        RUN dispatch IN app_handle ("initialize").

        /* If the Break or Filter windows are open, initialize them. */
        IF VALID-HANDLE(h_break) THEN
            RUN Init_Window IN h_break.
        IF VALID-HANDLE(h_filter) THEN
            RUN Init_Window IN h_filter.

        LEAVE OPEN_BLOCK. 
    END. /* IF NOT ERROR-STATUS */

  END. /* DO OPEN_BLOCK */
                                   
  /* We don't need the edit widget anymore. */
  IF VALID-HANDLE(tBuffer) THEN DELETE WIDGET tBuffer.  

  RUN adecomm/_setcurs.p (INPUT "").

  ASSIGN
    pFile             = File_Selected
    MENU-ITEM m_Run:SENSITIVE IN MENU mnu_File = no.
  
  RUN adecomm/_statdsp.p 
      (INPUT sFrame, 
       INPUT 1, 
       INPUT pFile).

  RUN adecomm/_statdsp.p 
      (INPUT sFrame, 
       INPUT 2, 
       INPUT 'Logging ' + 
             STRING(MENU-ITEM m_log:CHECKED IN MENU mnu_Options,"ON/OFF")).
 
END PROCEDURE.

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

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE SaveAsFile WINDOW-1 
PROCEDURE SaveAsFile :
/*--------------------------------------------------------------------------
    Purpose:        Executes the SAVE AS command, saving contents of logging
                    buffer to a user selected file name.

    Run Syntax:     RUN SaveAsFile ( INPUT p_Buffer ) .

    Parameters:

    Description:

        1. Prompts user for name of file to save current edit buffer
           contents to.
        2. Calls SaveFile procedure to execute actual save.

        Users execute the SAVE AS command to:
            1.  Save an Untitled file.
            2.  Save an existing file to a different file name.

    Notes:
  ---------------------------------------------------------------------------*/
  DEFINE INPUT PARAMETER p_Buffer AS WIDGET-HANDLE NO-UNDO .

  DEFINE VARIABLE File_Selected AS CHAR NO-UNDO.
  DEFINE VARIABLE SA_OK AS LOGICAL NO-UNDO.
  DEFINE VARIABLE Old_Filename AS CHAR NO-UNDO.
  DEFINE VARIABLE Valid_BufName AS LOGICAL NO-UNDO .
  
  SAVE_AS_BLOCK:
  DO WHILE TRUE:

    RUN adecomm/_getfile.p
        ( INPUT {&WINDOW-NAME},
          INPUT "PROSPY",
          INPUT "Save As" ,
          INPUT "Save As",
          INPUT "SAVE",
          INPUT-OUTPUT File_Selected ,
          OUTPUT SA_OK ) .

    IF NOT SA_OK THEN RETURN. /* User pressed Cancel. */  
    
    RUN FileSave ( INPUT p_Buffer , INPUT File_Selected  ,
                   OUTPUT Saved_File ).
    IF ( Saved_File = TRUE ) THEN LEAVE SAVE_AS_BLOCK.

  END. /* DO */

END PROCEDURE.

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

&ANALYZE-SUSPEND _VERSION-NUMBER AB_v9r12 GUI
&ANALYZE-RESUME
&Scoped-define WINDOW-NAME C-Win
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _DEFINITIONS C-Win 
/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/
/*------------------------------------------------------------------------

  File: _protgen.w

  Description: PRO*Tools Prototype Include File Generator
               This procedure runs a Super procedure persistently, reads
               its INTERNAL-ENTRIES and generates an include file 
               containing prototypes of all of the procedures and functions
               contained within it. The generated include file will typically
               be used by Proxygen users so that Proxygen will be able to
               determine all of the procedures and functions available in
               a procedure (including all of its super procedures).

  Input Parameters:
      <none>

  Output Parameters:
      <none>

  Author: Gerry Seidl

  Created: March 6, 1998

  Modified by GFS on 04/03/98 - Correctly handle Function with MAP TO option
              GFS on 11/04/98 - Correctly handle "Table" parameters
              JEP on 08/01/00 - Correctly handle "Table-Handle" parameters
                                and "Buffer" parameters for Functions.
------------------------------------------------------------------------*/
/*          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  ************************** */
{ protools/ptlshlp.i } /* help definitions */
{ adecomm/_adetool.i }
{ protools/_runonce.i }

/* Parameters Definitions ---                                           */

/* Local Variable Definitions ---                                       */
DEFINE VARIABLE hStatusLine AS WIDGET-HANDLE NO-UNDO.
DEFINE VARIABLE iDummy      AS INTEGER       NO-UNDO.
DEFINE VARIABLE oldname     AS CHARACTER     NO-UNDO.

/* Stream Definitions */
DEFINE STREAM out.

/* _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 DEFAULT-FRAME

/* Standard List Definitions                                            */
&Scoped-Define ENABLED-OBJECTS rect_Include rect_Super Super_Proc Btn_File ~
Include_File Btn_Close Btn_Generate Btn_Help 
&Scoped-Define DISPLAYED-OBJECTS Super_Proc Include_File 

/* 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 CreateParam C-Win 
FUNCTION CreateParam RETURNS CHARACTER
  ( sparm AS CHARACTER /* signature of param */,
    ptype AS CHARACTER /* parameter type "Procedure" or "Function") */)  FORWARD.

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

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION-FORWARD MakeProtoName C-Win 
FUNCTION MakeProtoName RETURNS 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.

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

DEFINE BUTTON Btn_File 
     LABEL "&File..." 
     SIZE 10 BY 1.

DEFINE BUTTON Btn_Generate DEFAULT 
     LABEL "&Generate" 
     SIZE 15 BY 1.14.

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

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

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

DEFINE RECTANGLE rect_Include
     EDGE-PIXELS 2 GRAPHIC-EDGE  NO-FILL 
     SIZE 48 BY 2.14.

DEFINE RECTANGLE rect_Super
     EDGE-PIXELS 2 GRAPHIC-EDGE  NO-FILL 
     SIZE 48 BY 2.14.


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

DEFINE FRAME DEFAULT-FRAME
     Super_Proc AT ROW 1.95 COL 2 COLON-ALIGNED HELP
          "Enter the name of the super procedure" NO-LABEL
     Btn_File AT ROW 1.95 COL 39 HELP
          "Choose a Super Procedure"
     Include_File AT ROW 4.57 COL 2 COLON-ALIGNED HELP
          "Enter the name of the include file to generate" NO-LABEL
     Btn_Close AT ROW 1.24 COL 52 HELP
          "Close this window"
     Btn_Generate AT ROW 2.67 COL 52 HELP
          "Generate the prototype include file"
     Btn_Help AT ROW 4.1 COL 52 HELP
          "Get help on this window"
     rect_Include AT ROW 3.86 COL 2
     rect_Super AT ROW 1.24 COL 2
     " &Super Procedure" VIEW-AS TEXT
          SIZE 18 BY .62 AT ROW 1 COL 4
     " &Include file to generate" VIEW-AS TEXT
          SIZE 26 BY .62 AT ROW 3.62 COL 4
    WITH 1 DOWN NO-BOX KEEP-TAB-ORDER OVERLAY 
         SIDE-LABELS NO-UNDERLINE THREE-D 
         AT COL 1 ROW 1
         SIZE 67.2 BY 5.38
         DEFAULT-BUTTON Btn_Generate.


/* *********************** 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              = "Prototype Generator"
         HEIGHT             = 5.29
         WIDTH              = 66.8
         MAX-HEIGHT         = 16
         MAX-WIDTH          = 105.8
         VIRTUAL-HEIGHT     = 16
         VIRTUAL-WIDTH      = 105.8
         MAX-BUTTON         = no
         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.

&IF '{&WINDOW-SYSTEM}' NE 'TTY' &THEN
IF NOT C-Win:LOAD-ICON("adeicon\protogen":U) THEN
    MESSAGE "Unable to load icon: adeicon\protogen"
            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
   Custom                                                               */
IF SESSION:DISPLAY-TYPE = "GUI":U AND VALID-HANDLE(C-Win)
THEN C-Win:HIDDEN = no.

/* _RUN-TIME-ATTRIBUTES-END */
&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 /* Prototype Generator */
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 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 /* Prototype Generator */
DO:
  /* This event will close the window and terminate the procedure.  */
  APPLY "CLOSE":U TO THIS-PROCEDURE.
  RETURN NO-APPLY.
END.

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


&Scoped-define SELF-NAME Btn_Close
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL Btn_Close C-Win
ON CHOOSE OF Btn_Close IN FRAME DEFAULT-FRAME /* Close */
DO:
  APPLY "CLOSE":U TO THIS-PROCEDURE.
END.

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


&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL Btn_Close C-Win
ON ENTRY OF Btn_Close IN FRAME DEFAULT-FRAME /* Close */
DO:
  RUN adecomm/_statdsp.p(hStatusLine, 1, SELF:HELP).         
END.

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


&Scoped-define SELF-NAME Btn_File
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL Btn_File C-Win
ON CHOOSE OF Btn_File IN FRAME DEFAULT-FRAME /* File... */
DO:
  DEFINE VARIABLE l_ok AS LOGICAL.
  
  SYSTEM-DIALOG GET-FILE Super_Proc
    TITLE "Choose Super Procedure"
    FILTERS "All Source(*.p~;*.w)" "*.p~;*.w",
            "Procedures(*.p)" "*.p",
            "AppBuilder files(*.w)" "*.w",
            "All Files(*.*)" "*.*"
    MUST-EXIST
    UPDATE l_ok IN WINDOW {&WINDOW-NAME}.
  
  IF l_ok THEN DO: /* "Open" was chosen */
    /* If the file is in the PROPATH, make it a relative pathname */
    FILE-INFO:FILE-NAME = Super_Proc. 
    IF FILE-INFO:PATHNAME NE ? THEN 
      Super_Proc:SCREEN-VALUE = FILE-INFO:PATHNAME.
    
    DISPLAY Super_Proc WITH FRAME {&FRAME-NAME}.
    ASSIGN Include_File:SCREEN-VALUE = MakeProtoName().
    APPLY "ENTRY" TO Include_File.
  END.
END.

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


&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL Btn_File C-Win
ON ENTRY OF Btn_File IN FRAME DEFAULT-FRAME /* File... */
DO:
  RUN adecomm/_statdsp.p(hStatusLine, 1, SELF:HELP).         
END.

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


&Scoped-define SELF-NAME Btn_Generate
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL Btn_Generate C-Win
ON CHOOSE OF Btn_Generate IN FRAME DEFAULT-FRAME /* Generate */
OR GO OF FRAME {&FRAME-NAME}
DO:
  DEFINE VARIABLE OKtoOverwrite AS LOGICAL NO-UNDO.
  
  /* Complain if there was no procedure entered */
  IF Super_Proc:SCREEN-VALUE = "" THEN DO:
    MESSAGE "You must enter the name of a super procedure." 
      VIEW-AS ALERT-BOX ERROR.
    APPLY "ENTRY":U TO Super_Proc.
    RETURN NO-APPLY.
  END.
  ELSE IF Include_File:SCREEN-VALUE = "" THEN DO:
    MESSAGE "You must enter a name for the include file to generate."
      VIEW-AS ALERT-BOX ERROR.
    Include_File:SCREEN-VALUE = MakeProtoName().
    APPLY "ENTRY":U TO Include_File.
    RETURN NO-APPLY.
  END.

  /* Check to see if include file already exists */
  ASSIGN FILE-INFO:FILE-NAME = Include_File:SCREEN-VALUE.
  IF FILE-INFO:FULL-PATHNAME NE ? THEN DO:
    RUN adecomm/_s-alert.p (INPUT-OUTPUT OKtoOverwrite, "Q":U, "Yes-No":U, 
      "The file, " + Include_File:SCREEN-VALUE + ", already exists. " + 
      "Do you want to overwrite it?").
    IF NOT OKtoOverwrite THEN DO:
      APPLY "ENTRY":U TO Include_File.
      RETURN NO-APPLY.
    END.
  END.
  
  RUN Generate_Prototypes. /* generate include file */
END.

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


&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL Btn_Generate C-Win
ON ENTRY OF Btn_Generate IN FRAME DEFAULT-FRAME /* Generate */
DO:
  RUN adecomm/_statdsp.p(hStatusLine, 1, SELF:HELP).         
END.

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


&Scoped-define SELF-NAME Btn_Help
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL Btn_Help C-Win
ON CHOOSE OF Btn_Help IN FRAME DEFAULT-FRAME /* Help */
DO:
  RUN adecomm/_adehelp.p("ptls":U, "CONTEXT":U, {&Protogen}, ?).
END.

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


&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL Btn_Help C-Win
ON ENTRY OF Btn_Help IN FRAME DEFAULT-FRAME /* Help */
DO:
  RUN adecomm/_statdsp.p(hStatusLine, 1, SELF:HELP).         
END.

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


&Scoped-define SELF-NAME Include_File
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL Include_File C-Win
ON ENTRY OF Include_File IN FRAME DEFAULT-FRAME
DO:
  RUN adecomm/_statdsp.p(hStatusLine, 1, SELF:HELP).         
END.

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


&Scoped-define SELF-NAME Super_Proc
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL Super_Proc C-Win
ON ENTRY OF Super_Proc IN FRAME DEFAULT-FRAME
DO:
  ASSIGN oldname = SELF:SCREEN-VALUE. /* Store off old name to compare later */
  RUN adecomm/_statdsp.p(hStatusLine, 1, SELF:HELP).         
END.

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


&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL Super_Proc C-Win
ON LEAVE OF Super_Proc IN FRAME DEFAULT-FRAME
DO:
  /* If there is no include file name, generate a default one */
  IF (SELF:SCREEN-VALUE NE "" AND Include_File:SCREEN-VALUE = "") OR
      SELF:SCREEN-VALUE NE oldname THEN DO:
    Include_File:SCREEN-VALUE = MakeProtoName().
    APPLY "ENTRY":U TO Include_File.
    RETURN NO-APPLY.
  END.
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}.

ON ALT-S ANYWHERE
  APPLY "ENTRY":U TO Super_Proc IN FRAME {&FRAME-NAME}.
  
ON ALT-I ANYWHERE
  APPLY "ENTRY":U TO Include_File IN FRAME {&FRAME-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 CreateStatusArea.
  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 CreateStatusArea C-Win 
PROCEDURE CreateStatusArea :
/*------------------------------------------------------------------------------
  Purpose:     Creates a status line in the window
  Parameters:  <none>
  Notes:       
------------------------------------------------------------------------------*/
  /* Create generic ADE status bar in the window */
  RUN adecomm/_status.p ( INPUT {&WINDOW-NAME}:HANDLE, 
                       INPUT "50":U, 
                       INPUT FALSE, 
                       INPUT (IF SESSION:PIXELS-PER-COLUMN = 5 THEN 4 ELSE ?), 
                       OUTPUT hStatusLine,
                       OUTPUT iDummy).
                      
  /* resize the window, and position the status bar */                    
  ASSIGN {&WINDOW-NAME}:HEIGHT-P = {&WINDOW-NAME}:HEIGHT-P + hStatusLine:HEIGHT-P
         hStatusLine:Y           = {&WINDOW-NAME}:HEIGHT-P - hStatusLine:HEIGHT-P
         hStatusLine:VISIBLE     = TRUE.

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 Super_Proc Include_File 
      WITH FRAME DEFAULT-FRAME IN WINDOW C-Win.
  ENABLE rect_Include rect_Super Super_Proc Btn_File Include_File Btn_Close 
         Btn_Generate Btn_Help 
      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 Generate_Prototypes C-Win 
PROCEDURE Generate_Prototypes :
/*------------------------------------------------------------------------------
  Purpose:     Reads the internal entries of the super procedure and writes the
               prototypes to the specified include file.
  Parameters:  <none>
  Notes:       
------------------------------------------------------------------------------*/
  DEFINE VARIABLE hSuper  AS HANDLE    NO-UNDO. /* handle to super procedure */
  DEFINE VARIABLE Entries AS CHARACTER NO-UNDO. /* to store internal entries */
  DEFINE VARIABLE i       AS INTEGER   NO-UNDO. /* loop counter */
  DEFINE VARIABLE c       AS INTEGER   NO-UNDO. /* loop counter */
  DEFINE VARIABLE sig     AS CHARACTER NO-UNDO. /* signature of proc or fcn */
  DEFINE VARIABLE name    AS CHARACTER NO-UNDO. /* name of proc or fcn */
  DEFINE VARIABLE sparm   AS CHARACTER NO-UNDO. /* Param with "AS" added */
  DEFINE VARIABLE aproc   AS LOGICAL   NO-UNDO. /* are we writing a procedure? */
  
  /* Store screen values */
  DO WITH FRAME {&FRAME-NAME}:
    ASSIGN Super_Proc Include_File.
  END.
  
  /* Run the Super procedure */
  DO ON STOP UNDO, LEAVE:
      RUN adecomm/_runcode.p(INPUT super_proc, 
        INPUT "_PERSISTENT":U, INPUT ?, OUTPUT hSuper).     
  END.
  
  /* Check for valid procedure handle */
  IF NOT VALID-HANDLE(hSuper) THEN DO:
    MESSAGE Super_Proc "did not run sucessfully." VIEW-AS ALERT-BOX ERROR.
    APPLY "ENTRY":U TO Super_Proc.
    RETURN "ERROR":U.
  END.
  
  /* Get it's internal entries */
  ASSIGN Entries = hSuper:INTERNAL-ENTRIES.
  
  /* Check for any procedures and/or functions */
  IF Entries = ? OR Entries = "" THEN DO:
    MESSAGE "There are no internal procedures or functions" SKIP
            "defined in procedure " Super_Proc VIEW-AS ALERT-BOX ERROR.
    DELETE PROCEDURE hSuper.
    APPLY "ENTRY":U TO Super_Proc.
    RETURN "ERROR":U.
  END.
             
  RUN adecomm/_statdsp.p(hStatusLine,1, "Creating prototypes...").
  
  /* Open a stream to the include file */
  OUTPUT STREAM out TO VALUE(Include_File).
  
  /* Write Include file header */
  PUT STREAM out UNFORMATTED "/*":U SKIP
                 " * Prototype include file: " + Include_File SKIP
                 " * Created from procedure: " + Super_Proc + 
                 " at " + STRING(TIME,"HH:MM") + " on " STRING(TODAY) SKIP
                 " * by the PROGRESS PRO*Tools Prototype Include File Generator" SKIP
                 " */":U SKIP(1).
                 
  /* Process the procedures and functions */
  DO i = 1 to NUM-ENTRIES(hSuper:INTERNAL-ENTRIES):
    ASSIGN name = ENTRY(i,Entries)
           sig  = hSuper:GET-SIGNATURE(name).

    /* Write block type and its name */
    CASE ENTRY(1,sig):
      WHEN "DLL-ENTRY":U THEN PUT STREAM out UNFORMATTED "PROCEDURE ":U + name. /* DLL */
      WHEN "EXTERN":U THEN PUT STREAM out UNFORMATTED "FUNCTION ":U + name. /* MAPS TO */
      OTHERWISE PUT STREAM out UNFORMATTED ENTRY(1,sig) + " ":U + name.
    END CASE.
    
    /* If it's a function, write out RETURNS line with data-type */
    IF ENTRY(2,sig) NE "" THEN DO:
      PUT STREAM out UNFORMATTED " RETURNS ":U CAPS(ENTRY(2,sig)). 
      ASSIGN aproc = FALSE.
    END.
    ELSE DO:
      /* It's a procedure (or DLL-ENTRY) */      
      PUT STREAM out UNFORMATTED " IN SUPER:":U SKIP.
      ASSIGN aproc = TRUE. 
    END.
    
    /* Process the parameters */
    IF NUM-ENTRIES(sig) > 2 AND ENTRY(3,sig) NE "" THEN 
    DO:
      DO c = 3 TO NUM-ENTRIES(sig):
        IF aproc THEN PUT STREAM out UNFORMATTED "  ":U CreateParam(ENTRY(c,sig),"Procedure":U) SKIP.
        ELSE DO: /* Function */
          IF c = 3 THEN PUT STREAM out UNFORMATTED SKIP "  (":U.
          ELSE PUT STREAM out UNFORMATTED ",":U SKIP "   ":U.
          PUT STREAM out UNFORMATTED CreateParam(ENTRY(c,sig),"Function":U).
        END.
      END.
      IF NOT aproc THEN PUT STREAM out ")":U.
    END.
    IF aproc THEN PUT STREAM out UNFORMATTED "END PROCEDURE.":U SKIP(1).
    ELSE PUT STREAM out " IN SUPER.":U SKIP(1).
  END. /* DO i = 1 to NUM-ENTRIES(hSuper:INTERNAL-ENTRIES): */
  
  /* Close output file */
  OUTPUT STREAM out CLOSE.
  
  /* Shut down super procedure */
  DELETE PROCEDURE hSuper.
  
  RUN adecomm/_statdsp.p(hStatusLine,1, "Done").
  
  APPLY "ENTRY":U TO Super_Proc.
  
END PROCEDURE.

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

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

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION CreateParam C-Win 
FUNCTION CreateParam RETURNS CHARACTER
  ( sparm AS CHARACTER /* signature of param */,
    ptype AS CHARACTER /* parameter type "Procedure" or "Function") */) :
/*------------------------------------------------------------------------------
  Purpose: Constructs correct parameter line for prototype based on the 
           signature returned by get-signature. 
    Notes:  
------------------------------------------------------------------------------*/
  DEFINE VARIABLE vparam AS CHARACTER NO-UNDO.

  IF ENTRY(1,sparm," ":U) = "BUFFER":U THEN
  DO:
    IF ptype = "PROCEDURE":U THEN
    DO:
       ASSIGN vparam = SUBSTITUTE("DEFINE PARAMETER BUFFER &1 FOR &2":U,
                                   ENTRY(2,sparm," ":U), ENTRY(3,sparm," ":U) ).
    END.
    ELSE IF ptype = "FUNCTION":U THEN
    DO:
       ASSIGN vparam = SUBSTITUTE("BUFFER &1 FOR &2":U,
                                   ENTRY(2,sparm," ":U), ENTRY(3,sparm," ":U) ).
    END.
  END.
  ELSE DO:
    IF ptype = "PROCEDURE":U THEN
    DO:
       ASSIGN vparam = SUBSTITUTE("DEFINE &1 PARAMETER &2":U,
                                   ENTRY(1,sparm," ":U),
                                   ENTRY(2,sparm," ":U)).
    END.
    ELSE IF ptype = "FUNCTION":U THEN
    DO:
       ASSIGN vparam = SUBSTITUTE("&1 &2":U, ENTRY(1,sparm," ":U), ENTRY(2,sparm," ":U)).
    END.
    
    /* Determine Table and Table-Handle parameter formats. */
    IF ENTRY(2,sparm," ":U) BEGINS "TABLE":U THEN
    DO:
       IF ENTRY(2,sparm," ":U) = "TABLE":U THEN
           vparam = SUBSTITUTE(vparam + " &1 &2":U, "FOR":U, ENTRY(3,sparm," ":U)).
       ELSE IF ENTRY(2,sparm," ":U) = "TABLE-HANDLE":U THEN
           vparam = SUBSTITUTE(vparam + " &1 &2":U,
                               (IF NUM-ENTRIES(sparm, " ":U) = 4 THEN ENTRY(4,sparm," ":U) ELSE "":U),
                                ENTRY(3,sparm," ":U)).
    END.
    /* Determine Data-Type/Variable parameters format. */
    ELSE IF NOT ENTRY(2,sparm," ":U) BEGINS "TABLE":U THEN
    DO:
       ASSIGN vparam = SUBSTITUTE(vparam + " &1 &2":U, "AS":U, ENTRY(3,sparm," ":U)).
    END.
  END.
  
  /* If this is a procedure, add the trailing period. */
  IF ptype = "PROCEDURE":U THEN
      ASSIGN vparam = (vparam + ".":U).
  
  RETURN vparam.

END FUNCTION.

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

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION MakeProtoName C-Win 
FUNCTION MakeProtoName RETURNS CHARACTER:
/*------------------------------------------------------------------------------
  Purpose: Generate a prototype include file name from super proc name 
    Notes:  
------------------------------------------------------------------------------*/
  DEFINE VARIABLE path    AS CHARACTER NO-UNDO. /* the path */
  DEFINE VARIABLE fname   AS CHARACTER NO-UNDO. /* file name */
  DEFINE VARIABLE ext     AS CHARACTER NO-UNDO. /* file extention */ 
  DEFINE VARIABLE newname AS CHARACTER NO-UNDO. /* new filename */

  RUN adecomm/_osprefx.p (Super_Proc:SCREEN-VALUE IN FRAME {&FRAME-NAME}, OUTPUT path, output fname).
  RUN adecomm/_osfext.p (fname, output ext).
  
  IF ext NE "" THEN
    ASSIGN newname = REPLACE(fname,ext,"":U).
  ELSE newname = fname.
  
  /* Use up to the first 4 characters of the original name to start with */
  IF LENGTH(newname,"CHARACTER":U) > 4 THEN 
    ASSIGN newname = SUBSTRING(newname,1,4,"CHARACTER":U).
  
  /* Assemble new name */
  ASSIGN ext     = ".i":U.
         newname = path + newname + "prto":U + ext.

  RETURN newname.   /* Function return value. */

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

  File: _protool.i

  Description: Defines PROTools temp-table

  Input Parameters:
      &NEW

  Output Parameters:
      <none>

  Author: Gerry Seidl
  
  Created: 09/07/94 - 03:32 pm
------------------------------------------------------------------------*/
DEFINE {1} SHARED TEMP-TABLE pt-function NO-UNDO
    FIELD pcFname   AS CHARACTER FORMAT "X(30)"
    FIELD pcFile    AS CHAR      FORMAT "X(65)"
    FIELD pcImage   AS CHARACTER FORMAT "X(65)"
    FIELD perrun    AS LOGICAL
    FIELD pdisplay  AS LOGICAL   
    FIELD order     AS INTEGER   FORMAT ">>>9"
    FIELD onmenu    AS LOGICAL
    INDEX pcFname   IS PRIMARY pcFname ASCENDING
    INDEX order                order   ASCENDING.
    
/*********************************************************************
* 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: _protool.p

  Description: This persistent procedure sets up the Feature Definitions
               for the Pro*Tools application.
               
               It runs adecomm/_palette.p to create the palette and define
               its features.
               
               Features for the palette are stored in the file pointed to
               by FunctionDefs in the PROGRESS startup file (INI/.Xdefaults).
               
  Input Parameters:
       <none>

  Output Parameters:
      <none>

  Author: Gerry Seidl

  Created: Sept 8, 1994 
  
  Modified by: TAJ on 01/22/02 Don't show webclient applet if executable not installed.
               JEP on 08/19/01 ICF support. Changed AB License call.
               GFS on 04/08/98 Changed default .dat file for Webspeed
               GFS on 01/27/95 Added applet order
------------------------------------------------------------------------*/
{ protools/_protool.i NEW } /* shared temp-table */    
{ protools/ptlshlp.i }      /* help definitions  */
{ adecomm/_adetool.i }

DEFINE VARIABLE hPalette       AS HANDLE  NO-UNDO.
DEFINE VARIABLE hdl            AS WIDGET  NO-UNDO.
DEFINE VARIABLE pitems         AS CHAR    NO-UNDO. /* palette items */
DEFINE VARIABLE ptdat          AS CHAR    NO-UNDO. /* loc of dat file */
DEFINE VARIABLE s_pxpy         AS CHAR    NO-UNDO. /* x,y Loc from INI */
DEFINE VARIABLE px             AS INTEGER NO-UNDO. /* x co-ordinate */
DEFINE VARIABLE py             AS INTEGER NO-UNDO. /* y co=ordinate */
DEFINE VARIABLE citems-per-row AS CHAR    NO-UNDO. /* i-p-r from INI */
DEFINE VARIABLE items-per-row  AS INTEGER NO-UNDO.
DEFINE VARIABLE lbl-or-btn     AS CHAR    NO-UNDO. /* setting in INI */
DEFINE VARIABLE ptlabels       AS LOGICAL NO-UNDO. /* labels ? */
DEFINE VARIABLE ABLic          AS INTEGER NO-UNDO. /* AB license        */
DEFINE VARIABLE ABTools        AS CHAR    NO-UNDO. /* AB Tools  jep-icf */

/* Prevent this procedure from being called twice (by checking FILE-NAME) */
IF THIS-PROCEDURE:PERSISTENT THEN DO:
  /* See if a copy already exists. */
  hdl = SESSION:FIRST-PROCEDURE.
  DO WHILE VALID-HANDLE(hdl): 
    IF hdl:FILE-NAME eq "adecomm/_palette.w"
    THEN DO:
      hPalette = hdl:CURRENT-WINDOW.
      IF hPalette:WINDOW-STATE = 2 THEN hPalette:WINDOW-STATE = 3.
      IF hPalette:MOVE-TO-TOP() THEN.
      DELETE PROCEDURE THIS-PROCEDURE.
      RETURN.
    END.
    hdl = hdl:NEXT-SIBLING.
  END.
END. 

/* Check license. If Webspeed-only, change .dat file below */
RUN adeshar/_ablic.p (INPUT NO /* Show Msgs */, OUTPUT ABLic, OUTPUT ABTools). /* jep-icf */

GET-KEY-VALUE SECTION "ProTools" KEY "FunctionDefs" VALUE ptdat.
IF SEARCH(ptdat) = ? OR ptdat = "" THEN DO:
    IF ABLic NE 2 THEN
      ASSIGN ptdat = SEARCH("protools/protools.dat").
    ELSE 
      ASSIGN ptdat = SEARCH("protools/wprotool.dat"). /* Webspeed */
    IF ptdat = ? THEN DO:
        MESSAGE "PROTOOLS.DAT was not found!" VIEW-AS ALERT-BOX ERROR.
        RUN Destroy.
        RETURN.
    END. 
END.

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

INPUT FROM VALUE(ptdat).
REPEAT TRANSACTION ON ERROR UNDO, LEAVE:
    CREATE pt-function.
    IMPORT pt-function.
END.
INPUT CLOSE.

/* IZ 1901: Don't show the WebClient Assembler 
 * applet if its executable is not installed. 
 */
IF SEARCH("prowcappmgr.exe") = ? THEN
DO:
    FIND pt-function WHERE pt-function.pcFile
                           = "protools/_prowcapped.p":u NO-ERROR.
    IF AVAIL pt-function THEN pt-function.pdisplay = no.

    /* GIH 13-Apr-2004: Don't show WebClient Deployment Packager */
    FIND pt-function WHERE pt-function.pcFile
                           = "protools/_prowcappdp.p":u NO-ERROR.
    IF AVAIL pt-function THEN pt-function.pdisplay = no.
END.

/* The Screen Capture ProTool is only available in the 32-bit Windows client */
IF PROCESS-ARCHITECTURE NE 32 THEN
DO:
    FIND pt-function WHERE pt-function.pcFile = "protools/_scrcap.w":u NO-ERROR.
    IF AVAIL pt-function THEN pt-function.pdisplay = NO.
END.

IF NOT CAN-DO(ABTools, "Enable-ICF":u) THEN
for each pt-function WHERE 
         pt-function.pcFile = "ry/uib/_v89dcnv.w":U or
         pt-function.pcFile = "adeuib/_convertadm2dynamics.w":u:
    pt-function.pdisplay = NO.
END.

FOR EACH pt-function WHERE pt-function.pdisplay = yes BY pt-function.order:
    ASSIGN pitems = pitems + CHR(10).
    IF pt-function.perrun THEN
        ASSIGN pitems = pitems + "PERSISTENT,".
    ELSE ASSIGN pitems = pitems + "RUN,".
    ASSIGN pitems = pitems + pcFile + "," + pcImage + "," + pcFname + ", ," + 
                        "no," + STRING(pt-function.order).
END.       
ASSIGN pitems = substring(pitems,2).

FOR EACH pt-function WHERE pcFname = "":
    DELETE pt-function.
END.

/* Create the palette, and then set up the palette.  If there is an error
   in any of the setup, then delete the palette and this procedure */
RUN adecomm/_palette.w PERSISTENT SET hPalette.
SETUP-BLOCK:
DO ON ERROR UNDO SETUP-BLOCK, RETRY SETUP-BLOCK:
  /* If there is a RETRY, then there was an error setting up the palette.
     In this case, just delete the palette and THIS-PROCEDURE. */
  IF RETRY THEN DO:
     RUN destroy IN hPalette NO-ERROR.
     RUN destroy IN THIS-PROCEDURE.
     RUN adecomm/_setcurs.p ("":U).
     RETURN.
  END.
  ELSE DO:
    /* Setup the Palette */
   
    RUN Add-Menu-Item   IN hPalette 
      (INPUT "&Customize...", INPUT "ALT-ENTER", INPUT "Customize", INPUT "HANDLE", INPUT THIS-PROCEDURE).
    RUN Add-Menu-Item   IN hPalette 
      (INPUT "&About PRO*Tools", INPUT "", INPUT "About", INPUT "HANDLE", INPUT THIS-PROCEDURE).
    RUN set-items       IN hPalette (INPUT pitems).

    GET-KEY-VALUE SECTION "ProTools" KEY "Visualization" VALUE lbl-or-btn.
    IF lbl-or-btn = "labels" 
    THEN ptlabels = yes.
    ELSE ptlabels = no.

    RUN set-button-size IN hPalette (INPUT 24).
    RUN set-label-font  IN hPalette (INPUT 4).
    RUN set-menu        IN hPalette (INPUT no).
    RUN set-parent      IN hPalette (INPUT this-procedure).
    RUN set-title       IN hPalette (INPUT "PRO*Tools").
    &IF "{&WINDOW-SYSTEM}" EQ "OSF/Motif" &THEN
      RUN set-window-icon IN hPalette (INPUT "adeicon/protools.xpm").
    &ELSE
      RUN set-window-icon IN hPalette (INPUT "adeicon/protools.ico").
    &ENDIF
    RUN add-f1-help     IN hPalette (INPUT "pthelp", INPUT this-procedure).

    GET-KEY-VALUE SECTION "ProTools" KEY "PaletteLoc" VALUE s_pxpy.
    ASSIGN px = INT(ENTRY(1,s_pxpy))
       py = INT(ENTRY(2,s_pxpy)).
    GET-KEY-VALUE SECTION "ProTools" KEY "ItemsPerRow" VALUE citems-per-row.
    ASSIGN items-per-row = INT(citems-per-row).
    IF items-per-row = 0 THEN items-per-row = 5.
    RUN Realize         IN hPalette (INPUT px, INPUT py, INPUT items-per-row).
  END. /* IF not RETRY... */
END. /* SETUP-BLOCK */
                                
/* Close this procedure */
ON CLOSE OF THIS-PROCEDURE DO:
    RUN destroy.
END.                                    

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

IF NOT THIS-PROCEDURE:PERSISTENT THEN
    WAIT-FOR CLOSE OF THIS-PROCEDURE.
    
PROCEDURE destroy:
   /* Free up the Persistent Procedure */
   IF THIS-PROCEDURE:PERSISTENT THEN DELETE PROCEDURE THIS-PROCEDURE.
   IF VALID-HANDLE(hPalette) THEN DELETE PROCEDURE hPalette.
   RUN adecomm/_setcurs.p ("":U).
END.

PROCEDURE Customize:
    RUN protools/_custmiz.w (INPUT hPalette, INPUT-OUTPUT ptdat).
END.

PROCEDURE About:
    RUN adecomm/_about.p (INPUT "PRO*Tools", INPUT "adeicon/protools").
END.

PROCEDURE pthelp:
    RUN adecomm/_adehelp.p ( "ptls", "TOPICS", {&Main_Contents}, ? ).
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: _prowcapped.p

  Description: Start the Progress Web Client Application Editor executable.

  Input Parameters:
      <none>

  Output Parameters:
      <none>

  Author: Gerry Seidl

  Created: 05/23/2000

  Modified: 03/13/01 gfs Updated the name of the exe called.
     
 *---------------------------------------------------------------------------*/
IF SESSION:WINDOW-SYSTEM BEGINS "MS-WIN" THEN DO:
  FILE-INFO:FILE-NAME = "bin\prowcappmgr.exe":U.
  IF FILE-INFO:FULL-PATHNAME NE ? THEN DO:
    RUN WinExec (INPUT FILE-INFO:FULL-PATHNAME, INPUT 1). 
  END.
  ELSE MESSAGE "prowcappmgr.exe was not found."
         VIEW-AS ALERT-BOX ERROR.
END.
ELSE
  MESSAGE "This program runs only under Microsoft Windows."
    VIEW-AS ALERT-BOX ERROR.
    
PROCEDURE WinExec EXTERNAL "KERNEL32.DLL": 
    DEFINE INPUT PARAMETER prog_name AS CHARACTER. 
    DEFINE INPUT PARAMETER prog_style 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.                           *
*                                                                    *
*********************************************************************/
/**************************************************************************
    Procedure:  _pwedit.p

    Purpose:    ProTools front-end call to Procedure Window main procedure.

    Syntax :    RUN protools/_pwedit.p.

    Parameters:
    Description:
    Notes  :
                Parent ID passed is Null (""). This "parents" Procedure
                Windows created by ProTools to the ADE Desktop. When
                the ADE Desktop is told to exit, it notifies each
                of its Procedure Windows (Parent ID = Null), giving each
                a chance to let the user save work-in-progress.
    Authors: John Palazzo
    Date   : March, 1994
**************************************************************************/

RUN adecomm/_pwmain.p ("",   /* Parent ID [eg. UIB]. */
                       "",   /* FileList */
                       "").  /* p_Edit_command (Currently Unused) */
&ANALYZE-SUSPEND _VERSION-NUMBER UIB_v8r12 GUI
&ANALYZE-RESUME
&Scoped-define WINDOW-NAME run_win
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _DEFINITIONS run_win 
/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/
/*------------------------------------------------------------------------

  File: _runfile.w

  Description: Run a procedure

  Input Parameters:
      <none>

  Output Parameters:
      <none>

  Author: Bill Wood

  Created: 11/16/94 -  4:25 pm

  Modified by Gerry Seidl on 11/16/94 - Make it a persistent window/proc.

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

/* By creating a widget-pool, the ui objects of _runfile.w will not be
   deleted when Protools window is deleted.

   We do run the chance of deleting the ui objects of other persistently
   run procedures that do not create their own widget-pool. Not creating
   their own widget-pool is bad programming practice for persistent
   procedures. Every persistent ADE procedure would have to create all
   ui objects in their own named persistent widget-pool. We won't be doing
   that any time soon.  - jep and pal 8/29/96
*/

CREATE WIDGET-POOL.

/* ***************************  Definitions  ************************** */
{ protools/ptlshlp.i } /* help definitions */
{ adecomm/_adetool.i }  
{protools/_runonce.i}

/* Parameters Definitions ---                                           */

/* Local Variable Definitions ---                                       */
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_tool     AS HANDLE    NO-UNDO.
DEFINE VARIABLE wfrun      AS LOGICAL   NO-UNDO.
DEFINE VARIABLE run_flags  AS CHARACTER NO-UNDO.
DEFINE VARIABLE app_handle AS HANDLE   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_Run

/* Standard List Definitions                                            */
&Scoped-Define ENABLED-OBJECTS btn_close run-pgm btn_browse l_persistent ~
btn_Run btn_Help 
&Scoped-Define DISPLAYED-OBJECTS run-pgm l_persistent 

/* 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 run_win AS WIDGET-HANDLE NO-UNDO.

/* Definitions of the field level widgets                               */
DEFINE BUTTON btn_browse 
     LABEL "&File...":L 
     SIZE 15 BY 1.14.

DEFINE BUTTON btn_close 
     LABEL "&Close":L 
     SIZE 15 BY 1.14.

DEFINE BUTTON btn_Help 
     LABEL "&Help" 
     SIZE 15 BY 1.14.

DEFINE BUTTON btn_Run AUTO-GO 
     LABEL "&Run":L 
     SIZE 15 BY 1.14.

DEFINE VARIABLE run-pgm AS CHARACTER FORMAT "X(256)" 
     VIEW-AS FILL-IN 
     SIZE 38 BY 1.

DEFINE VARIABLE l_persistent AS LOGICAL INITIAL no 
     LABEL "Run &Persistent":L 
     VIEW-AS TOGGLE-BOX
     SIZE 22 BY .86.


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

DEFINE FRAME f_Run
     btn_close AT ROW 1.29 COL 43
     run-pgm AT ROW 2.52 COL 3 HELP
          "Enter the name of the program you wish to run" NO-LABEL
     btn_browse AT ROW 2.52 COL 43
     l_persistent AT ROW 3.76 COL 3
     btn_Run AT ROW 3.76 COL 26
     btn_Help AT ROW 3.76 COL 43
     "&Name of Procedure to Run:" VIEW-AS TEXT
          SIZE 28 BY .62 AT ROW 1.62 COL 3
    WITH 1 DOWN NO-BOX KEEP-TAB-ORDER OVERLAY 
         SIDE-LABELS NO-UNDERLINE THREE-D 
         AT COL 1 ROW 1
         SIZE 58.4 BY 4.24
         DEFAULT-BUTTON btn_Run.


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

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

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

&ANALYZE-SUSPEND _CREATE-WINDOW
IF SESSION:DISPLAY-TYPE = "GUI":U THEN
  CREATE WINDOW run_win ASSIGN
         HIDDEN             = YES
         TITLE              = "Run Procedure"
         HEIGHT             = 4.29
         WIDTH              = 58.4
         MAX-HEIGHT         = 4.29
         MAX-WIDTH          = 58.4
         VIRTUAL-HEIGHT     = 4.29
         VIRTUAL-WIDTH      = 58.4
         MAX-BUTTON         = no
         RESIZE             = no
         SCROLL-BARS        = no
         STATUS-AREA        = no
         BGCOLOR            = 8
         FGCOLOR            = ?
         THREE-D            = yes
         MESSAGE-AREA       = no
         SENSITIVE          = yes.
ELSE {&WINDOW-NAME} = CURRENT-WINDOW.

&IF '{&WINDOW-SYSTEM}' NE 'TTY' &THEN
IF NOT run_win:LOAD-ICON("adeicon/run":U) THEN
    MESSAGE "Unable to load icon: adeicon/run"
            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 run_win
  VISIBLE,,RUN-PERSISTENT                                               */
/* SETTINGS FOR FRAME f_Run
                                                                        */
ASSIGN 
       l_persistent:PRIVATE-DATA IN FRAME f_Run     = 
                "l_persistent".

/* SETTINGS FOR FILL-IN run-pgm IN FRAME f_Run
   ALIGN-L                                                              */
ASSIGN 
       run-pgm:PRIVATE-DATA IN FRAME f_Run     = 
                "run-pgm".

IF SESSION:DISPLAY-TYPE = "GUI":U AND VALID-HANDLE(run_win)
THEN run_win:HIDDEN = no.

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


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

&ANALYZE-SUSPEND _QUERY-BLOCK FRAME f_Run
/* Query rebuild information for FRAME f_Run
     _Query            is NOT OPENED
*/  /* FRAME f_Run */
&ANALYZE-RESUME

 



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

&Scoped-define SELF-NAME run_win
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL run_win run_win
ON WINDOW-CLOSE OF run_win /* Run Procedure */
DO:
  /* Stop the Procedure */
  APPLY "CLOSE":U TO THIS-PROCEDURE.
  RETURN NO-APPLY.
END.

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


&Scoped-define SELF-NAME f_Run
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL f_Run run_win
ON GO OF FRAME f_Run
DO:
  
  /* Is there a non-blank name? */
  IF TRIM(run-pgm:SCREEN-VALUE) NE "":U THEN DO:
    run-pgm = SEARCH (run-pgm:SCREEN-VALUE) NO-ERROR.
    /* If .p or .w specified, check for a .r and run that instead */
    IF run-pgm EQ ? AND 
       CAN-DO(".w,.p",SUBSTRING(run-pgm:SCREEN-VALUE,LENGTH(run-pgm:SCREEN-VALUE) - 1,2,"CHARACTER":U)) THEN
      run-pgm = SEARCH(SUBSTRING(run-pgm:SCREEN-VALUE,1,LENGTH(run-pgm:SCREEN-VALUE) - 2,"CHARACTER":U) + ".r").
    IF run-pgm EQ ? THEN DO:
       MESSAGE "Cannot find file:" run-pgm:SCREEN-VALUE
            VIEW-AS ALERT-BOX ERROR BUTTONS OK IN WINDOW {&WINDOW-NAME}.
       RETURN NO-APPLY.
    END.
    RUN adecomm/_wfrun.p (INPUT "PRO*Tools.", OUTPUT wfrun). /* register PRO*Tools is running a procedure */
    IF wfrun THEN RETURN NO-APPLY. /* Another tool is already running a procedure, can't proceed */
    
    /* Run a procedure (with the appropriate wrapper for a run). */
    RUN-BLOCK:
    DO ON STOP UNDO, RETRY RUN-BLOCK:
      ASSIGN h_tool = h_ade_tool.
      IF l_persistent:CHECKED AND NOT RETRY THEN
      DO:
        /* If this is run persistent,  KEEP any WIDGETS created by the 
           persistent procedure. */
        ASSIGN run_flags = "_PERSISTENT,_PAUSE,_KEEP-WIDGETS":U.
        RUN adecomm/_runcode.p
            (INPUT run-pgm , INPUT run_flags , INPUT ? /* Stop_Widget */, OUTPUT app_handle ).
      END.
      ELSE DO:
        IF NOT RETRY THEN
        DO:
          ASSIGN run_flags = "_PAUSE":U.
          RUN disable_widgets IN THIS-PROCEDURE.
          RUN disable_widgets IN h_tool NO-ERROR.
          RUN adecomm/_runcode.p
            (INPUT run-pgm , INPUT run_flags , INPUT ? /* Stop_Widget */, OUTPUT app_handle ).
          IF NOT VALID-HANDLE(h_tool) THEN
             UNDO run-block.
        END.
        RUN enable_widgets IN h_tool NO-ERROR.
        RUN enable_widgets IN THIS-PROCEDURE.
      END.
    END.  /* DO ON STOP */
    ASSIGN wfRunning = "".
  END. /* IF run-pgm is not blank */  
  ELSE DO:
    MESSAGE "Enter a procedure to run."
        VIEW-AS ALERT-BOX ERROR BUTTONS OK IN WINDOW {&WINDOW-NAME}.
  END.
  IF VALID-HANDLE({&WINDOW-NAME}) THEN 
  DO:
     {&WINDOW-NAME}:MOVE-TO-TOP() .
     APPLY "ENTRY" TO run-pgm.
  END.

  RETURN NO-APPLY.
END.

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


&Scoped-define SELF-NAME btn_browse
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL btn_browse run_win
ON CHOOSE OF btn_browse IN FRAME f_Run /* File... */
DO:
  DEFINE VAR l_ok AS LOGICAL NO-UNDO.
  DEFINE VAR filename AS CHAR NO-UNDO.
  DEFINE VAR Filter_NameString AS CHAR EXTENT 5                NO-UNDO.
  DEFINE VAR Filter_FileSpec   LIKE Filter_NameString          NO-UNDO.

  /* Initialize the file filters, for special cases. */
  ASSIGN Filter_NameString[ 1 ] = IF OPSYS = "UNIX":U
                                    THEN "All Source(*.[pw])"
                                    ELSE "All Source(*.p~;*.w)"
         Filter_FileSpec[ 1 ]   = IF OPSYS = "UNIX":U
                                    THEN "*.[pw]"
                                    ELSE "*.p~;*.w"
         Filter_NameString[ 2 ] = "Procedures(*.p)"
         Filter_FileSpec[ 2 ]   = "*.p"
         Filter_NameString[ 3 ] = "Windows(*.w)"
         Filter_FileSpec[ 3 ]   = "*.w"
         Filter_NameString[ 4 ] = "Compiled r-code(*.r)"
         Filter_FileSpec[ 4 ]   = "*.r" 
         Filter_NameString[ 5 ] = IF OPSYS = "UNIX":U
                                    THEN "All Files(*)"
                                    ELSE "All Files(*.*)"
         Filter_FileSpec[ 5 ]   = IF OPSYS = "UNIX":U
                                    THEN "*"
                                    ELSE "*.*".

  /* Ask for a file name. NOTE: File-names to run must exist */                          
  filename = run-pgm:SCREEN-VALUE.
  SYSTEM-DIALOG GET-FILE filename
      TITLE    "Run"
      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 ]             
      MUST-EXIST
      UPDATE   l_ok IN WINDOW {&WINDOW-NAME}.  
  IF l_ok THEN run-pgm:SCREEN-VALUE = filename.
END.

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


&Scoped-define SELF-NAME btn_close
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL btn_close run_win
ON CHOOSE OF btn_close IN FRAME f_Run /* Close */
DO:
  APPLY "CLOSE":U TO THIS-PROCEDURE.
END.

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


&Scoped-define SELF-NAME btn_Help
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL btn_Help run_win
ON CHOOSE OF btn_Help IN FRAME f_Run /* Help */
DO:
  RUN adecomm/_adehelp.p ( "ptls", "CONTEXT", {&Run_Procedure}, ? ).    
END.

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


&UNDEFINE SELF-NAME

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


/* ***************************  Main Block  *************************** */
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.
ON ALT-N OF FRAME f_run ANYWHERE DO:
    APPLY "ENTRY" TO run-pgm IN FRAME {&FRAME-NAME}.
END.

/* 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.
  APPLY "ENTRY" TO run-pgm.
  
  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 disable_UI run_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(run_win)
  THEN DELETE WIDGET run_win.
  IF THIS-PROCEDURE:PERSISTENT THEN DELETE PROCEDURE THIS-PROCEDURE.
END PROCEDURE.

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

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE Disable_Widgets run_win 
PROCEDURE Disable_Widgets :
/*------------------------------------------------------------------------------
  Purpose:     Disables the widgets in this window before a run
  Parameters:  <none>
  Notes:       
------------------------------------------------------------------------------*/
DO WITH FRAME {&FRAME-NAME}:
  ASSIGN btn_browse:SENSITIVE    = no
         btn_close:SENSITIVE     = no
         btn_Run:SENSITIVE       = no
         btn_Help:SENSITIVE      = no
         run-pgm:SENSITIVE       = no
         l_persistent:SENSITIVE  = no.
END.

END PROCEDURE.

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

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE enable_UI run_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 run-pgm l_persistent 
      WITH FRAME f_Run IN WINDOW run_win.
  ENABLE btn_close run-pgm btn_browse l_persistent btn_Run btn_Help 
      WITH FRAME f_Run IN WINDOW run_win.
  {&OPEN-BROWSERS-IN-QUERY-f_Run}
  VIEW run_win.
END PROCEDURE.

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

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE Enable_Widgets run_win 
PROCEDURE Enable_Widgets :
/*------------------------------------------------------------------------------
  Purpose:     Enables widgets in the window after a run
  Parameters:  <none>
  Notes:       
------------------------------------------------------------------------------*/
DO WITH FRAME {&FRAME-NAME}:
  ASSIGN btn_browse:SENSITIVE    = yes
         btn_close:SENSITIVE     = yes
         btn_Run:SENSITIVE       = yes
         btn_Help:SENSITIVE      = yes
         run-pgm:SENSITIVE       = yes
         l_persistent:SENSITIVE  = yes.
END.

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:  _runonce.i
                                       
    Purpose:    Checks to see if this procedure is already running
                and if so kills the second copy.

    Syntax :    {protools/_runonce.i}

    Parameters: None
        
    Description:
    Notes  :
    Authors: Gerry Seidl
    Date   : 4/27/95
**************************************************************************/
DEFINE VARIABLE pt-applet-hdl AS HANDLE.
DEFINE VARIABLE pt-applet-win AS WIDGET-HANDLE.

/* Prevent this procedure from being called twice (by checking FILE-NAME) */
IF THIS-PROCEDURE:PERSISTENT THEN DO:
  /* See if a copy already exists. */
  pt-applet-hdl = SESSION:FIRST-PROCEDURE.
  DO WHILE VALID-HANDLE(pt-applet-hdl):
    IF pt-applet-hdl:FILE-NAME eq THIS-PROCEDURE:FILE-NAME AND
       pt-applet-hdl NE THIS-PROCEDURE:HANDLE
    THEN DO:
      pt-applet-win = pt-applet-hdl:CURRENT-WINDOW.
      IF pt-applet-win:WINDOW-STATE = 2 THEN pt-applet-win:WINDOW-STATE = 3.
      IF pt-applet-win:MOVE-TO-TOP() THEN.
      DELETE PROCEDURE THIS-PROCEDURE.
      RETURN.
    END.
    pt-applet-hdl = pt-applet-hdl:NEXT-SIBLING.
  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.                           *
*                                                                    *
*********************************************************************/
/*PROGRAM NAME: _schdef.i
 * AUTHOR      : Tammy Marshall
 * DATE        : 04/01/99
 * DESCRIPTION : Defines the TableDetails, FieldDetails, and IndexDetails 
 *               temporary tables used to get the Table, Field and Index
 *               details to display in the Details windows of the DB
 *               Connections PRO*Tool.
 * */

DEFINE TEMP-TABLE TableDetails
  FIELD name AS CHARACTER
  FIELD storarea AS CHARACTER
  FIELD multitenant AS LOGICAL
  FIELD keepdefaultarea AS LOGICAL
  FIELD tlabel AS CHARACTER
  FIELD tdesc AS CHARACTER
  FIELD replproc AS CHARACTER
  FIELD valexp AS CHARACTER
  FIELD valmsg AS CHARACTER
  FIELD crtrig AS CHARACTER
  FIELD deltrig AS CHARACTER
  FIELD fndtrig AS CHARACTER
  FIELD wrtrig AS CHARACTER
  FIELD repcrtrig AS CHARACTER
  FIELD repdeltrig AS CHARACTER
  FIELD repwrtrig AS CHARACTER.
  
DEFINE TEMP-TABLE FieldDetails
  FIELD tblname AS CHARACTER
  FIELD fldname AS CHARACTER
  FIELD datatype AS CHARACTER
  FIELD tformat AS CHARACTER
  FIELD torder AS INTEGER
  FIELD tlabel AS CHARACTER
  FIELD tdec AS INTEGER
  FIELD collabel AS CHARACTER
  FIELD textent AS INTEGER
  FIELD asgntrig AS CHARACTER
  FIELD initval AS CHARACTER
  FIELD thelp AS CHARACTER
  FIELD valexp AS CHARACTER
  FIELD valmsg AS CHARACTER
  FIELD tdesc AS CHARACTER
  FIELD viewas AS CHARACTER
  FIELD tmandatory AS LOGICAL
  FIELD casesensitive AS LOGICAL.
  
DEFINE TEMP-TABLE IndexDetails
  FIELD tblname AS CHARACTER
  FIELD idxname AS CHARACTER
  FIELD tdesc AS CHARACTER
  FIELD lactive AS LOGICAL
  FIELD lprimary AS LOGICAL
  FIELD lunique AS LOGICAL
  FIELD lwordindex AS LOGICAL
  FIELD labbrev AS LOGICAL.
  
DEFINE TEMP-TABLE IndxFldDetails
  FIELD tblname AS CHARACTER
  FIELD idxname AS CHARACTER
  FIELD idxseq AS INTEGER
  FIELD fldname AS CHARACTER
  FIELD fldtype AS CHARACTER
  FIELD lasc AS LOGICAL.
  
  
  
&ANALYZE-SUSPEND _VERSION-NUMBER UIB_v9r12 GUI
&ANALYZE-RESUME
&Scoped-define WINDOW-NAME C-Win
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _DEFINITIONS C-Win 
/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/
/*------------------------------------------------------------------------

  File: protools/_schlist.w

  Description: This is the Schema Detail window of the DB Connections PRO*Tool.
               It displays the tables, fields and indices of the selected database.
               
  Input Parameters:
      hParentProc - procedure handle for DB Connections procedure (_dblist)

  Output Parameters:
      <none>

  Author: Tammy Marshall

  Created: 04/09/99

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

{protools/_schdef.i}  /* TableDetails, FieldDetails, IndexDetails temp table definition */

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

/* Parameters Definitions ---                                           */
DEFINE INPUT PARAMETER hParentProc AS HANDLE NO-UNDO.  /* handle of DB connection procedure */

/* Local Variable Definitions ---                                       */
DEFINE VARIABLE hParentWin AS HANDLE NO-UNDO.  /* handle of DB connection window */
DEFINE VARIABLE rDB AS RECID NO-UNDO.  /* recid of selected _db */
DEFINE VARIABLE hTblDetail AS HANDLE NO-UNDO.  /* handle Table Detail procedure */
DEFINE VARIABLE hFldDetail AS HANDLE NO-UNDO.  /* handle Field Detail procedure */
DEFINE VARIABLE hIdxDetail AS HANDLE NO-UNDO.  /* handle Index Detail procedure */
DEFINE VARIABLE hTblWin AS HANDLE NO-UNDO.  /* handle Table Detail window */
DEFINE VARIABLE hFldWin AS HANDLE NO-UNDO.  /* handle Field Detail window */
DEFINE VARIABLE hIdxWin AS HANDLE NO-UNDO.  /* handle Index Detail window */

/* _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 DEFAULT-FRAME

/* Standard List Definitions                                            */
&Scoped-Define ENABLED-OBJECTS RECT-1 RECT-2 RECT-3 selTables selFields ~
selIndices bTables bFields bIndex bClose bHelp 
&Scoped-Define DISPLAYED-OBJECTS selTables selFields selIndices 

/* 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 C-Win AS WIDGET-HANDLE NO-UNDO.

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

DEFINE BUTTON bFields 
     LABEL "&Field Details" 
     SIZE 15 BY 1.14.

DEFINE BUTTON bHelp 
     LABEL "&Help" 
     SIZE 15 BY 1.14.

DEFINE BUTTON bIndex 
     LABEL "&Index Details" 
     SIZE 15 BY 1.14.

DEFINE BUTTON bTables 
     LABEL "&Table Details" 
     SIZE 15 BY 1.14.

DEFINE RECTANGLE RECT-1
     EDGE-PIXELS 2 GRAPHIC-EDGE  NO-FILL 
     SIZE 28.2 BY 10.

DEFINE RECTANGLE RECT-2
     EDGE-PIXELS 2 GRAPHIC-EDGE  NO-FILL 
     SIZE 28.2 BY 10.

DEFINE RECTANGLE RECT-3
     EDGE-PIXELS 2 GRAPHIC-EDGE  NO-FILL 
     SIZE 28.2 BY 10.

DEFINE VARIABLE selFields AS CHARACTER 
     VIEW-AS SELECTION-LIST SINGLE SCROLLBAR-VERTICAL 
     SIZE 25 BY 6.19 NO-UNDO.

DEFINE VARIABLE selIndices AS CHARACTER 
     VIEW-AS SELECTION-LIST SINGLE SCROLLBAR-VERTICAL 
     SIZE 25 BY 6.19 NO-UNDO.

DEFINE VARIABLE selTables AS CHARACTER 
     VIEW-AS SELECTION-LIST SINGLE SCROLLBAR-VERTICAL 
     SIZE 25 BY 6.19 NO-UNDO.


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

DEFINE FRAME DEFAULT-FRAME
     selTables AT ROW 2.19 COL 4 NO-LABEL
     selFields AT ROW 2.19 COL 33.2 NO-LABEL
     selIndices AT ROW 2.19 COL 62.2 NO-LABEL
     bTables AT ROW 9.48 COL 9.2
     bFields AT ROW 9.48 COL 37.8
     bIndex AT ROW 9.48 COL 67.2
     bClose AT ROW 12.67 COL 20.4
     bHelp AT ROW 12.67 COL 55.6
     "Tables" VIEW-AS TEXT
          SIZE 8 BY .62 AT ROW 1.14 COL 5.2
     "Indices" VIEW-AS TEXT
          SIZE 8 BY .62 AT ROW 1.14 COL 63.2
     "Fields" VIEW-AS TEXT
          SIZE 7.2 BY .62 AT ROW 1.14 COL 34.2
     RECT-1 AT ROW 1.48 COL 2.6
     RECT-2 AT ROW 1.48 COL 31.6
     RECT-3 AT ROW 1.48 COL 60.6
    WITH 1 DOWN NO-BOX KEEP-TAB-ORDER OVERLAY 
         SIDE-LABELS NO-UNDERLINE THREE-D 
         AT COL 1 ROW 1
         SIZE 91 BY 15.05.


/* *********************** 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              = "Schema"
         HEIGHT             = 13.86
         WIDTH              = 89.8
         MAX-HEIGHT         = 16
         MAX-WIDTH          = 98.2
         VIRTUAL-HEIGHT     = 16
         VIRTUAL-WIDTH      = 98.2
         MAX-BUTTON         = no
         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.
/* 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
                                                                        */
IF SESSION:DISPLAY-TYPE = "GUI":U AND VALID-HANDLE(C-Win)
THEN C-Win:HIDDEN = no.

/* _RUN-TIME-ATTRIBUTES-END */
&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 /* Schema */
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 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 PARENT-WINDOW-CLOSE OF C-Win /* Schema */
DO:
  /* When the db connections window is close, parent-window-close event fires for
     this window and we want to apply window-close here to close this window and
     any child windows */
  APPLY "WINDOW-CLOSE":U TO C-Win.
END.

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


&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL C-Win C-Win
ON WINDOW-CLOSE OF C-Win /* Schema */
DO:
  /* This event will close the window and terminate the procedure.  */
  APPLY "ENTRY":U TO hParentWin.
  APPLY "CLOSE":U TO THIS-PROCEDURE.
  RETURN NO-APPLY.
END.

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


&Scoped-define SELF-NAME bClose
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL bClose C-Win
ON CHOOSE OF bClose IN FRAME DEFAULT-FRAME /* Close */
DO:
  /* Applying window-close to this window will close this window and will cause
     a parent-window-close event to fire in any child windows */
  APPLY "WINDOW-CLOSE":U TO C-Win.
END.

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


&Scoped-define SELF-NAME bFields
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL bFields C-Win
ON CHOOSE OF bFields IN FRAME DEFAULT-FRAME /* Field Details */
DO:
  /* Need to see if the database is still connected - it may have been
     disconnected through the data dictionary */
  IF NOT DYNAMIC-FUNCTION("dbconn" IN hParentProc) THEN DO:
    MESSAGE "You are no longer connected to" 
      CAPS(DYNAMIC-FUNCTION("getDbName" IN hParentProc)) + " database"
      VIEW-AS ALERT-BOX INFORMATION.
    RUN initialize-dblist IN hParentProc.  /* refresh list of connected dbs */
    APPLY "WINDOW-CLOSE":U TO C-Win.  /* close this window and any child windows */
  END.  /* if selected db no longer connected */

  ELSE DO:  /* if selected db is still connected */
    /* If the Field detail window is running, don't run it again, bring it to the
       top of all other windows */
    IF VALID-HANDLE(hFldDetail) THEN DO:
      hFldWin = hFldDetail:CURRENT-WINDOW.
      hFldWin:MOVE-TO-TOP().
      APPLY "ENTRY":U TO hFldWin.
    END.  /* if Field detail window is already running */
  
    /* Field detail window is not already running, so run it */
    ELSE DO:
      RUN protools/_flddetl.w PERSISTENT SET hFldDetail (INPUT C-Win:HANDLE).
      /* We need to create a temp-table record for this field's details to be
         displayed in the detail window.  The temp-table record is populated 
         in a separate program that uses an alias to
         access the db metaschema */
      CREATE FieldDetails.
      ASSIGN 
        FieldDetails.tblname = selTables:SCREEN-VALUE
        FieldDetails.fldname = selFields:SCREEN-VALUE.
      RUN getFieldDetails IN hParentProc (INPUT-OUTPUT TABLE FieldDetails). 
      RUN refreshField IN hFldDetail (INPUT TABLE FieldDetails).
      FIND FIRST FieldDetails.
      DELETE FieldDetails.
    END.  /* else do - field detail win not running */
  END.  /* else do - selected db still connected */
END.  /* choose */

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


&Scoped-define SELF-NAME bHelp
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL bHelp C-Win
ON CHOOSE OF bHelp IN FRAME DEFAULT-FRAME /* Help */
DO:
  RUN adecomm/_adehelp.p
    (INPUT "ptls":U, 
     INPUT "CONTEXT":U, 
     INPUT 10, 
     INPUT  ?).
END.

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


&Scoped-define SELF-NAME bIndex
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL bIndex C-Win
ON CHOOSE OF bIndex IN FRAME DEFAULT-FRAME /* Index Details */
DO:
  /* Need to see if the database is still connected - it may have been
     disconnected through the data dictionary */
  IF NOT DYNAMIC-FUNCTION("dbconn" IN hParentProc) THEN DO:
    MESSAGE "You are no longer connected to" 
      CAPS(DYNAMIC-FUNCTION("getDbName" IN hParentProc)) + " database"
      VIEW-AS ALERT-BOX INFORMATION.
    RUN initialize-dblist IN hParentProc.  /* refresh list of connected dbs */
    APPLY "WINDOW-CLOSE":U TO C-Win.  /* close this window and any child windows */
  END.  /* if selected db no longer connected */

  ELSE DO:  /* if selected db is still connected */
    /* If the Index detail window is running, don't run it again, bring it to the
       top of all other windows */
    IF VALID-HANDLE(hIdxDetail) THEN DO:
      hIdxWin = hIdxDetail:CURRENT-WINDOW.
      hIdxWin:MOVE-TO-TOP().
      APPLY "ENTRY":U TO hIdxWin.
    END.  /* if Index detail window is already running */
  
    /* Index detail window is not already running, so run it */
    ELSE DO:  
      RUN protools/_idxdetl.w PERSISTENT SET hIdxDetail (INPUT C-Win:HANDLE).
         /* We need to create a temp-table record for this index's details to be
         displayed in the detail window.  The temp-table record is populated 
         in a separate program that uses an alias to
         access the db metaschema */
      CREATE IndexDetails. 
      ASSIGN 
        IndexDetails.tblname = selTables:SCREEN-VALUE
        IndexDetails.idxname = selIndices:SCREEN-VALUE.
      RUN getIndexDetails IN hParentProc (INPUT-OUTPUT TABLE IndexDetails, OUTPUT TABLE IndxFldDetails).
      RUN refreshIndex IN hIdxDetail (INPUT TABLE IndexDetails, INPUT TABLE IndxFldDetails).
      FIND FIRST IndexDetails.
      DELETE IndexDetails.
    END.  /* else do - index detail win not running */
  END.  /* else do - selected db still connected */
END.  /* choose */

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


&Scoped-define SELF-NAME bTables
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL bTables C-Win
ON CHOOSE OF bTables IN FRAME DEFAULT-FRAME /* Table Details */
DO:
  /* Need to see if the database is still connected - it may have been
     disconnected through the data dictionary */
  IF NOT DYNAMIC-FUNCTION("dbconn" IN hParentProc) THEN DO:
    MESSAGE "You are no longer connected to" 
      CAPS(DYNAMIC-FUNCTION("getDbName" IN hParentProc)) + " database"
      VIEW-AS ALERT-BOX INFORMATION.
    RUN initialize-dblist IN hParentProc.  /* refresh list of connected dbs */
    APPLY "WINDOW-CLOSE":U TO C-Win.  /* close this window and any child windows */
  END.  /* if selected db no longer connected */
  
  ELSE DO:  /* selected db still connected */
    /* If the Table detail window is running, don't run it again, bring it to the
       top of all other windows */
    IF VALID-HANDLE(hTblDetail) THEN DO:
      hTblWin = hTblDetail:CURRENT-WINDOW.
      hTblWin:MOVE-TO-TOP().
      APPLY "ENTRY":U TO hTblWin.
    END.  /* if Table detail window is already running */
  
    /* Table detail window is not running, so run it */ 
    ELSE DO:
      RUN protools/_tbldetl.w PERSISTENT SET hTblDetail (INPUT C-Win:HANDLE).
      /* We need to create a temp-table record for this table's details to be
         displayed in the detail window.  The temp-table record is populated 
         in a separate program that uses an alias to
         access the db metaschema */
      CREATE TableDetails.
      ASSIGN TableDetails.name = selTables:SCREEN-VALUE.
      RUN getTableDetails IN hParentProc (INPUT-OUTPUT TABLE TableDetails).
      RUN refreshTable IN hTblDetail (INPUT TABLE TableDetails).
      FIND FIRST TableDetails.
      DELETE TableDetails.
    END.  /* else do - table detail not running */
  END.  /* else do - selected db still connected */
END.  /* choose */

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


&Scoped-define SELF-NAME selFields
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL selFields C-Win
ON VALUE-CHANGED OF selFields IN FRAME DEFAULT-FRAME
DO:
  /* Need to see if the database is still connected - it may have been
     disconnected through the data dictionary */
  IF NOT DYNAMIC-FUNCTION("dbconn" IN hParentProc) THEN DO:
    MESSAGE "You are no longer connected to" 
      CAPS(DYNAMIC-FUNCTION("getDbName" IN hParentProc)) + " database"
      VIEW-AS ALERT-BOX INFORMATION.
    RUN initialize-dblist IN hParentProc.  /* refresh list of connected dbs */
    APPLY "WINDOW-CLOSE":U TO C-Win.  /* close this window and any child windows */
  END.  /* if selected db no longer connected */
  
  ELSE DO:  /* selected db still connected */
    /* Need to see if the field still exists in the database - it may have
       been removed with the data dictionary */
    IF NOT DYNAMIC-FUNCTION("availFld" IN hParentProc, 
      INPUT selTables:SCREEN-VALUE, INPUT selFields:SCREEN-VALUE) THEN DO:
      MESSAGE selFields:SCREEN-VALUE "field no longer exists in the database"
        VIEW-AS ALERT-BOX INFORMATION.
      ASSIGN selFields:LIST-ITEMS = 
        DYNAMIC-FUNCTION("getFld" IN hParentProc, INPUT selTables:SCREEN-VALUE).
      selFields:SCREEN-VALUE = ENTRY(1, selFields:LIST-ITEMS).
    END.  /* if table no longer avail */

    /* If Field Detail window is running, get field details for the
       newly selected table and refresh those details in the detail window */
    IF VALID-HANDLE(hFldDetail) THEN DO:
         /* We need to create a temp-table record for this field's details to be
         displayed in the detail window.  The temp-table record is populated 
         in a separate program that uses an alias to
         access the db metaschema */
      CREATE FieldDetails.
      ASSIGN 
        FieldDetails.tblname = selTables:SCREEN-VALUE
        FieldDetails.fldname = selFields:SCREEN-VALUE.
      RUN getFieldDetails IN hParentProc (INPUT-OUTPUT TABLE FieldDetails).
      RUN RefreshField IN hFldDetail (INPUT TABLE FieldDetails).
      FIND FIRST FieldDetails.
      DELETE FieldDetails.
    END.  /* if child window is running */
  END.  /* else do - selected db still connected */
END.  /* value-changed */

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


&Scoped-define SELF-NAME selIndices
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL selIndices C-Win
ON VALUE-CHANGED OF selIndices IN FRAME DEFAULT-FRAME
DO:
  /* Need to see if the database is still connected - it may have been
     disconnected through the data dictionary */
  IF NOT DYNAMIC-FUNCTION("dbconn" IN hParentProc) THEN DO:
    MESSAGE "You are no longer connected to" 
      CAPS(DYNAMIC-FUNCTION("getDbName" IN hParentProc)) + " database"
      VIEW-AS ALERT-BOX INFORMATION.
    RUN initialize-dblist IN hParentProc.  /* refresh list of connected dbs */
    APPLY "WINDOW-CLOSE":U TO C-Win.  /* close this window and any child windows */
  END.  /* if selected db no longer connected */

  ELSE DO:  /* selected db still connected */
    /* Need to see if the field still exists in the database - it may have
       been removed with the data dictionary */
    IF NOT DYNAMIC-FUNCTION("availIdx" IN hParentProc, 
      INPUT selTables:SCREEN-VALUE, INPUT selIndices:SCREEN-VALUE) THEN DO:
      MESSAGE selIndices:SCREEN-VALUE "index no longer exists in the database"
        VIEW-AS ALERT-BOX INFORMATION.
      ASSIGN selIndices:LIST-ITEMS = 
        DYNAMIC-FUNCTION("getIndx" IN hParentProc, INPUT selTables:SCREEN-VALUE).
      selIndices:SCREEN-VALUE = ENTRY(1, selIndices:LIST-ITEMS).
    END.  /* if table no longer avail */
 
    /* If Index Detail window is running, get index details for the
       newly selected table and refresh those details in the detail window */
    IF VALID-HANDLE(hIdxDetail) THEN DO:
         /* We need to create a temp-table record for this index's details to be
         displayed in the detail window.  The temp-table record is populated 
         in a separate program that uses an alias to
         access the db metaschema */
      CREATE IndexDetails.
      ASSIGN 
        IndexDetails.tblname = selTables:SCREEN-VALUE
        IndexDetails.idxname = selIndices:SCREEN-VALUE.
      RUN getIndexDetails IN hParentProc (INPUT-OUTPUT TABLE IndexDetails, OUTPUT TABLE IndxFldDetails).
      RUN RefreshIndex IN hIdxDetail (INPUT TABLE IndexDetails, INPUT TABLE IndxFldDetails).
      FIND FIRST IndexDetails.
      DELETE IndexDetails.
    END.  /* if child window is running */
  END.  /* else do - selected db still connected */
END.  /* value-changed */

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


&Scoped-define SELF-NAME selTables
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL selTables C-Win
ON VALUE-CHANGED OF selTables IN FRAME DEFAULT-FRAME
DO:
  /* Need to see if the database is still connected - it may have been
     disconnected through the data dictionary */
  IF NOT DYNAMIC-FUNCTION("dbconn" IN hParentProc) THEN DO:
    MESSAGE "You are no longer connected to" 
      CAPS(DYNAMIC-FUNCTION("getDbName" IN hParentProc)) + " database"
      VIEW-AS ALERT-BOX INFORMATION.
    RUN initialize-dblist IN hParentProc.  /* refresh list of connected dbs */
    APPLY "WINDOW-CLOSE":U TO C-Win.  /* close this window and any child windows */
  END.  /* if selected db no longer connected */
  
  ELSE DO:  /* selected db still connected */
    /* Need to see if the table still exists in the database - it may have
       been removed with the data dictionary */
    IF NOT DYNAMIC-FUNCTION("availTbl" IN hParentProc, INPUT selTables:SCREEN-VALUE) THEN DO:
      MESSAGE selTables:SCREEN-VALUE "table no longer exists in the database"
        VIEW-AS ALERT-BOX INFORMATION.
      ASSIGN selTables:LIST-ITEMS = 
        DYNAMIC-FUNCTION("getTbl" IN hParentProc).  /* refresh list of tables */
      selTables:SCREEN-VALUE = ENTRY(1, selTables:LIST-ITEMS).
    END.  /* if table no longer avail */
    
    /* Refresh Field and Index lists when Table is changed */
    ASSIGN 
      selFields:LIST-ITEMS = 
        DYNAMIC-FUNCTION("getFld" IN hParentProc, INPUT selTables:SCREEN-VALUE)
      selFields:SCREEN-VALUE = ENTRY(1, selFields:LIST-ITEMS)
      selIndices:LIST-ITEMS =
        DYNAMIC-FUNCTION("getIndx" IN hParentProc, INPUT selTables:SCREEN-VALUE)
      selIndices:SCREEN-VALUE = ENTRY(1, selIndices:LIST-ITEMS).
    APPLY "VALUE-CHANGED":U TO selFields.
    APPLY "VALUE-CHANGED":U TO selIndices.
  
    /* If Table Detail window is running, get table details for the
       newly selected table an refresh those details in the detail window */
    IF VALID-HANDLE(hTblDetail) THEN DO:
      /* We need to create a temp-table record for this table's details to be
         displayed in the detail window.  The temp-table record is populated 
         in a separate program that uses an alias to
         access the db metaschema */
      CREATE TableDetails.  
      ASSIGN TableDetails.name = selTables:SCREEN-VALUE.
      RUN getTableDetails IN hParentProc (INPUT-OUTPUT TABLE TableDetails).
      RUN RefreshTable IN hTblDetail (INPUT TABLE TableDetails).
      FIND FIRST TableDetails.
      DELETE TableDetails. 
    END.  /* if child window is running */
  END.  /* else do - selected db still connected */
END.  /* value changed */

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


&UNDEFINE SELF-NAME

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _MAIN-BLOCK C-Win 


/* ***************************  Main Block  *************************** */
hParentWin = hParentProc:CURRENT-WINDOW.  /* get the handle of the previous window */

/* Set CURRENT-WINDOW: this will parent dialog-boxes and frames.        */
ASSIGN CURRENT-WINDOW                = {&WINDOW-NAME} 
       THIS-PROCEDURE:CURRENT-WINDOW = {&WINDOW-NAME}.

ASSIGN CURRENT-WINDOW:PARENT = hParentWin. /* parent the previous window to this window */

/* 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.
  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 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 selTables selFields selIndices 
      WITH FRAME DEFAULT-FRAME IN WINDOW C-Win.
  ENABLE RECT-1 RECT-2 RECT-3 selTables selFields selIndices bTables bFields 
         bIndex bClose bHelp 
      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 RefreshSchema C-Win 
PROCEDURE RefreshSchema :
/*------------------------------------------------------------------------------
  Purpose: This procedure accepts the currently selected database name and type 
           and a comma separated list of tables for that database.  It changes
           the window title and the list of tables displayed.  
  Parameters: pcDBName - currently selected database
              pcDBType - database type for the currently selected database
              pcTableList - list of tables for the currently selected db
  Notes:       
------------------------------------------------------------------------------*/
DEFINE INPUT PARAMETER pcDBName AS CHARACTER NO-UNDO.
DEFINE INPUT PARAMETER pcDBType AS CHARACTER NO-UNDO.
DEFINE INPUT PARAMETER pcTableList AS CHARACTER NO-UNDO.

  ASSIGN 
    {&WINDOW-NAME}:TITLE = "Schema - " + pcDBName + " [" + pcDBType + "]"
    selTables:LIST-ITEMS IN FRAME {&FRAME-NAME} = pcTableList
    selTables:SCREEN-VALUE = ENTRY(1, pcTableList)
    selFields:LIST-ITEMS = 
      DYNAMIC-FUNCTION("getFld" IN hParentProc, INPUT selTables:SCREEN-VALUE)
    selFields:SCREEN-VALUE = ENTRY(1, selFields:LIST-ITEMS)
    selIndices:LIST-ITEMS =
      DYNAMIC-FUNCTION("getIndx" IN hParentProc, INPUT selTables:SCREEN-VALUE)
    selIndices:SCREEN-VALUE = ENTRY(1, selIndices:LIST-ITEMS).

  APPLY "ENTRY":U TO C-Win.
  APPLY "VALUE-CHANGED":U TO selTables.
  APPLY "VALUE-CHANGED":U TO selFields.
  APPLY "VALUE-CHANGED":U TO selIndices.
  APPLY "ENTRY":U TO bClose.
END PROCEDURE.

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

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE SetTable C-Win 
PROCEDURE SetTable :
/*------------------------------------------------------------------------------
  Purpose:     Can be used to reposition the Table and Field selection list 
               values
               
  Parameters:  pcTable   Name of Table
               pcField  Name of FIeld
  Notes:       
------------------------------------------------------------------------------*/
DEFINE INPUT  PARAMETER pcTable AS CHARACTER  NO-UNDO.
DEFINE INPUT  PARAMETER pcField AS CHARACTER  NO-UNDO.

IF pcTable > "" AND LOOKUP(pcTable,selTables:LIST-ITEMS IN FRAME {&FRAME-NAME}) > 0 THEN
DO:
  ASSIGN selTables:SCREEN-VALUE  = pcTable NO-ERROR.
  APPLY "VALUE-CHANGED":U TO selTables.
END.

IF pcField > "" AND LOOKUP(pcTable,selTables:LIST-ITEMS IN FRAME {&FRAME-NAME}) > 0 THEN
DO:
  ASSIGN selFields:SCREEN-VALUE  = pcField NO-ERROR.
  APPLY "VALUE-CHANGED":U TO selFields.
END.

END PROCEDURE.

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

&ANALYZE-SUSPEND _VERSION-NUMBER UIB_v7r11 GUI
&ANALYZE-RESUME
&Scoped-define WINDOW-NAME CURRENT-WINDOW
&Scoped-define FRAME-NAME d_print
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _DEFINITIONS d_print 
/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/
/*------------------------------------------------------------------------

  File: _SCRPRTD.W

  Description: Print options for SCRCAP.W

  Input Parameters:
      <none>

  Output Parameters:
      x   (int) 
      y   (int)
      opt (int)
      image_to_print (int) 1 = original, 2 = modified.

  Author: Gerry Seidl

  Created: 01/20/95 - 11:26 pm

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

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

/* Parameters Definitions ---                                           */

/* Local Variable Definitions ---                                       */
DEFINE INPUT  PARAMETER image_changed AS LOGICAL NO-UNDO.

DEFINE OUTPUT PARAMETER x   AS INTEGER NO-UNDO.
DEFINE OUTPUT PARAMETER y   AS INTEGER NO-UNDO.
DEFINE OUTPUT PARAMETER opt AS INTEGER NO-UNDO.
DEFINE OUTPUT PARAMETER image_to_print AS INTEGER NO-UNDO.

DEFINE VARIABLE l AS LOGICAL NO-UNDO.

/* _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 d_print

/* Standard List Definitions                                            */
&Scoped-Define ENABLED-OBJECTS b_cancel b_ok RECT-1 rs_print_opt ~
rs_which_image r_print_opt 
&Scoped-Define DISPLAYED-OBJECTS rs_print_opt rs_which_image xscale yscale 

/* 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 BUTTON b_cancel AUTO-END-KEY 
     LABEL "Cancel":L 
     SIZE 10 BY 1.

DEFINE BUTTON b_ok AUTO-GO 
     LABEL "OK":L 
     SIZE 10 BY 1.

DEFINE VARIABLE xscale AS INTEGER FORMAT ">>>9":U INITIAL 0 
     VIEW-AS FILL-IN 
     SIZE 7.5 BY 1 NO-UNDO.

DEFINE VARIABLE yscale AS INTEGER FORMAT ">>>9":U INITIAL 0 
     VIEW-AS FILL-IN 
     SIZE 7.5 BY 1 NO-UNDO.

DEFINE VARIABLE rs_print_opt AS INTEGER 
     VIEW-AS RADIO-SET VERTICAL
     RADIO-BUTTONS 
          "Best Fit", 1,
"Stretch To Page", 2,
"Scale", 3
     SIZE 20 BY 2.5 NO-UNDO.

DEFINE VARIABLE rs_which_image AS INTEGER 
     VIEW-AS RADIO-SET VERTICAL
     RADIO-BUTTONS 
          "Original Image", 1,
"Modified Image", 2
     SIZE 18 BY 3.85 NO-UNDO.

DEFINE RECTANGLE RECT-1
     EDGE-PIXELS 2 GRAPHIC-EDGE  NO-FILL 
     SIZE 20 BY 4.88.

DEFINE RECTANGLE r_print_opt
     EDGE-PIXELS 2 GRAPHIC-EDGE  NO-FILL 
     SIZE 25 BY 4.88.


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

DEFINE FRAME d_print
     b_ok AT ROW 1.54 COL 50
     rs_which_image AT ROW 2 COL 3 NO-LABEL
     rs_print_opt AT ROW 2.23 COL 25 NO-LABEL
     b_cancel AT ROW 2.88 COL 50
     xscale AT ROW 5 COL 28 COLON-ALIGNED NO-LABEL
     yscale AT ROW 5 COL 38 COLON-ALIGNED NO-LABEL
     " Image To Print" VIEW-AS TEXT
          SIZE 15 BY .62 AT ROW 1.27 COL 3
     " Print Options" VIEW-AS TEXT
          SIZE 14 BY .65 AT ROW 1.27 COL 24
     RECT-1 AT ROW 1.5 COL 2
     r_print_opt AT ROW 1.5 COL 23
     "X" VIEW-AS TEXT
          SIZE 2 BY .65 AT ROW 5.23 COL 28
     "Y" VIEW-AS TEXT
          SIZE 2 BY .65 AT ROW 5.23 COL 38
     SPACE(21.28) SKIP(0.84)
    WITH VIEW-AS DIALOG-BOX KEEP-TAB-ORDER NO-HELP 
         SIDE-LABELS NO-UNDERLINE THREE-D  SCROLLABLE 
         TITLE "Print":L
         DEFAULT-BUTTON b_ok.

 

/* *********************** 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 d_print:SCROLLABLE       = FALSE.

/* SETTINGS FOR FILL-IN xscale IN FRAME d_print
   NO-ENABLE                                                            */
/* SETTINGS FOR FILL-IN yscale IN FRAME d_print
   NO-ENABLE                                                            */
/* _RUN-TIME-ATTRIBUTES-END */
&ANALYZE-RESUME

 




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

&Scoped-define SELF-NAME d_print
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL d_print d_print
ON END-ERROR OF FRAME d_print /* Print */
OR ENDKEY OF FRAME D_print DO:
  ASSIGN opt = -1.
END.

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


&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL d_print d_print
ON GO OF FRAME d_print /* Print */
DO:
  ASSIGN xscale = INT(xscale:SCREEN-VALUE)
         yscale = INT(yscale:SCREEN-VALUE)
         rs_print_opt = INT(rs_print_opt:SCREEN-VALUE)
         image_to_print = INT(rs_which_image:SCREEN-VALUE)
         x = xscale
         y = yscale
         opt = rs_print_opt.
END.

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


&Scoped-define SELF-NAME rs_print_opt
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL rs_print_opt d_print
ON VALUE-CHANGED OF rs_print_opt IN FRAME d_print
DO:
  IF INT(rs_print_opt:SCREEN-VALUE) = 3 THEN DO:
      ASSIGN xscale:SENSITIVE = yes
             yscale:SENSITIVE = yes
             xscale:SCREEN-VALUE = "2400"
             yscale:SCREEN-VALUE = "1800".
      APPLY "ENTRY" TO xscale.
  END.
  ELSE
      ASSIGN xscale:SENSITIVE = no
             yscale:SENSITIVE = no.
END.

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


&Scoped-define SELF-NAME rs_which_image
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL rs_which_image d_print
ON VALUE-CHANGED OF rs_which_image IN FRAME d_print
DO:
  DEFINE VARIABLE l AS LOGICAL NO-UNDO.
  
  IF SELF:SCREEN-VALUE = "2" THEN
    ASSIGN l = rs_print_opt:DISABLE("Best Fit")
           l = rs_print_opt:DISABLE("Stretch To Page")
           rs_print_opt:SCREEN-VALUE = "3".
  ELSE
    ASSIGN l = rs_print_opt:ENABLE("Best Fit")
           l = rs_print_opt:ENABLE("Stretch To Page") 
           rs_print_opt:SCREEN-VALUE = "1".
  APPLY "VALUE-CHANGED" TO rs_print_opt.
END.

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


&UNDEFINE SELF-NAME

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


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

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

/* 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.
  IF NOT image_changed THEN 
    l = rs_which_image:DISABLE("Modified Image").
  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 d_print _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 d_print.
END PROCEDURE.

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


&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE enable_UI d_print _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 rs_which_image rs_print_opt xscale yscale 
      WITH FRAME d_print.
  ENABLE RECT-1 r_print_opt b_ok rs_which_image rs_print_opt b_cancel 
      WITH FRAME d_print.
  {&OPEN-BROWSERS-IN-QUERY-d_print}
END PROCEDURE.

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


&Scoped-define WINDOW-NAME CURRENT-WINDOW
&Scoped-define FRAME-NAME Dialog-Frame
/***********************************************************************
* 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.                             *
*                                                                      *
***********************************************************************/
/*------------------------------------------------------------------------

  File: _search.w

  Description: Finds all copies of a file in the PROGRESS PROPATH 

  Input Parameters:
      <none>

  Output Parameters:
      <none>

  Author: David Lee

  Created: 5/12/95
  
  Modified by GFS on 11/06/98 - Added ability to list the reference to a 
                                .PL if the file searched for was in one.
           by tsm on 07/02/99 - Added ability to handle date formats other
                                than "mdy"
------------------------------------------------------------------------*/
/*          This .W file was created with the Progress UIB.             */
/*----------------------------------------------------------------------*/

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

/* Parameters Definitions ---                                           */

/* Local Variable Definitions ---                                       */

define variable foundCount as integer no-undo.
         
DEFINE variable ipTitle AS CHARACTER NO-UNDO INITIAL "Propath File Search". 
    
   &if DEFINED(IDE-IS-RUNNING) <> 0 &then
define variable gFiles as character no-undo.
/* somewhat random - probably more to add */
define variable xNoOpen as character init "r,pl,dll,exe,class" no-undo.
define variable gSelectedFile as character no-undo.
   &endif    
   
&IF "{&WINDOW-SYSTEM}" BEGINS "MS-WIN" &THEN
{adecomm/fileinfo.i}

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.

&ENDIF




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

/* Name of first Frame and/or Browse and/or first Query                 */
&Scoped-define FRAME-NAME Dialog-Frame



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

/* Define a dialog box                                                  */

/* Definitions of the field level widgets                               */
DEFINE BUTTON Btn_Close AUTO-GO 
     LABEL "&Close" 
     SIZE 12 BY 1.1
     BGCOLOR 8 .

DEFINE BUTTON doIt 
     LABEL "&Search" 
     SIZE 12 BY 1.1
     BGCOLOR 8 .

DEFINE BUTTON Btn_OpenFile AUTO-GO 
     LABEL "&Open File" 
     SIZE 12 BY 1.1
     BGCOLOR 8 .

DEFINE VARIABLE whichFile AS CHARACTER FORMAT "X(256)":U 
     VIEW-AS FILL-IN 
     SIZE 51 BY 1.1 NO-UNDO.

DEFINE VARIABLE foundFile AS CHARACTER 
     VIEW-AS SELECTION-LIST SINGLE 
     SCROLLBAR-HORIZONTAL SCROLLBAR-VERTICAL 
     SIZE 64 BY 4.1 NO-UNDO.


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



DEFINE FRAME Dialog-Frame

    "Search for File:" VIEW-AS TEXT
          SIZE 18 BY .67 AT ROW 1.29 COL 2   
          SPACE(47.19)
     whichFile AT ROW 2 COL 2 NO-LABEL
     doIt AT ROW 1.95 COL 54
  &if DEFINED(IDE-IS-RUNNING) = 0 &then   
     foundFile AT ROW 5.05 COL 2 NO-LABEL
     Btn_Close AT ROW 3.43 COL 54
     "Can be Found In:" VIEW-AS TEXT
          SIZE 18 BY .67 AT ROW 4.24 COL 2
   
      SKIP(4.46)
  &ELSE
     "Can be Found In:" VIEW-AS TEXT
          SIZE 18 BY .67 AT ROW 3.43 COL 2 
       foundFile AT ROW 4.24 COL 2 NO-LABEL
       Btn_Openfile AT ROW 8.56 COL 41
       Btn_Close AT ROW 8.56 COL 54
       SKIP(0.38)
       
  &ENDIF     
 
     WITH  
         SIDE-LABELS NO-UNDERLINE THREE-D  SCROLLABLE 
 
 &if DEFINED(IDE-IS-RUNNING) = 0 &then
         TITLE ipTitle 
         VIEW-AS DIALOG-BOX    
 &else
         no-box
 &endif        
         KEEP-TAB-ORDER DEFAULT-BUTTON Btn_Close.

{adeuib/ide/dialoginit.i "FRAME Dialog-Frame:handle"}

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





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

/* SETTINGS FOR DIALOG-BOX Dialog-Frame
   Custom                                                               */
    &if DEFINED(IDE-IS-RUNNING) = 0 &then
    ASSIGN 
       FRAME Dialog-Frame:SCROLLABLE       = FALSE
       FRAME Dialog-Frame:HIDDEN           = TRUE.
    &endif
/* SETTINGS FOR FILL-IN whichFile IN FRAME Dialog-Frame
   ALIGN-L                                                              */
/* _RUN-TIME-ATTRIBUTES-END */
/* funcs not forward declared for now */

function GetFileExtension returns char(pcfile as char):
     define variable i as integer no-undo.
     i = r-index(pcfile,".").
     if i > 0 then
         return substring(pcfile,i + 1).
     else
         return "".    
end .

 &if DEFINED(IDE-IS-RUNNING) <> 0 &then

function CanOpenFile returns logical(pcfile as char):
     define variable cExt as char no-undo.
     cExt = GetFileExtension(pcFile).
     return cExt > "" AND lookup(cExt,xNoOpen) = 0.      
end .

function GetSelectedFile returns char():
     define variable i as integer no-undo.
     if gFiles > "" then
     do with frame {&frame-name}:
         i = foundFile:lookup(foundFile:screen-value).
         if i > 0 and num-entries(gFiles) >= i then
             return entry(i,gFiles).
     end.
     return "".
end .


&endif

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

ON GO OF FRAME Dialog-Frame /* Propath File Search */
DO:
  run adecomm/_setcurs.p("WAIT"). 
END.

ON WINDOW-CLOSE OF FRAME Dialog-Frame /* Propath File Search */
DO:
  run adecomm/_setcurs.p(""). 
 APPLY "END-ERROR":U TO SELF.
END.

ON CHOOSE OF Btn_Close IN FRAME Dialog-Frame /* Close */
DO:
 Apply "CLOSE" to FRAME {&FRAME-NAME}. 
END.

ON CHOOSE OF doIt IN FRAME Dialog-Frame /* Search */
DO:
    
    
    
    define variable s   as logical   no-undo.
    define variable str as character no-undo.
    define variable rel as logical   no-undo.
    
    &if DEFINED(IDE-IS-RUNNING) <> 0 &then
    
    gfiles = "":U.
    
    &endif    
    
    ASSIGN whichfile.
    foundFile:LIST-ITEMS = "".
    foundCount = 1.
        
    if length(whichFile) > 1 then do:
        run adecomm/_setcurs.p("WAIT").
       
        /* 
         * Full path name, don't use propath
         */        
        if index(":", whichFile) > 0 then run addFile(search(whichFile)).
        else do:
            define variable i         as integer   no-undo.
            define variable rCodeName as character no-undo.
            define variable ext       as character no-undo.
 

            do i = 1 to num-entries(propath):

                /*
                 * Don't want a slash if starting from
                 * a local directory
                 */
                 
                if entry(i, propath) = "" then
                    assign
                        str = whichFile
                        rel = yes.
                else
                    assign
                        str = entry(i, propath) + "~/" + whichFile
                        rel = no
                    .
                
                /*
                 * Replace all the slashes
                 */
                
                &IF "{&WINDOW-SYSTEM}" BEGINS "MS-WIN" &THEN
                
                   str = replace(str, "~/", "~\").   
                    
                &ELSE
                     str = replace(str, "~\", "~/").               
                &ENDIF 
                 /*
                 * Look for r-code if a.p or .w or .cls
                 */
            
                ext = GetFileExtension(str).
                IF ext = "p" OR ext = "w" OR ext = "cls" THEN DO:                
                  run makeRCodeName(str, output rCodeName).
                  if rCodeName <> ? then run addFile(rCodeName).
                END.
                                                                           
                file-info:file-name = str.
                
                /*
                 * If we're working with a relative file then
                 * the check is different
                 */

                if rel then do:
                
                    if search(str) = str then
                           run addFile(str).                
                end.
                else do: 
                    if     file-info:pathname <> ? 
                       and file-info:pathname = str then
                           run addFile(str).    
                end.
            end.
        end.
        /* Also, see if it's in a .pl file */
        IF LIBRARY(SEARCH(whichFile)) NE ? THEN RUN addFile(LIBRARY(SEARCH(whichFile))).
        
        /* Report if nothing were found. */
        IF foundFile:NUM-ITEMS eq 0 THEN foundFile:LIST-ITEMS = "[No files found]".
        run adecomm/_setcurs.p ("").
    end.
    else
        foundFile:SCREEN-VALUE = "".    
END.

ON LEAVE OF whichFile IN FRAME Dialog-Frame
DO:
    if whichFile = whichFile:SCREEN-VALUE then return.
    
    whichFIle = whichFile:SCREEN-VALUE.  
END.



ON RETURN OF whichFile IN FRAME Dialog-Frame
DO:
    if whichFile = whichFile:SCREEN-VALUE then return.
    
    whichFile = whichFile:SCREEN-VALUE.
    apply "CHOOSE" to doIt.  
END.

&if DEFINED(IDE-IS-RUNNING) <> 0 &then
 
ON CHOOSE OF Btn_OpenFile IN FRAME Dialog-Frame  
DO:
    run handleFileSelection.     
END.


ON DEFAULT-ACTION OF foundFile IN FRAME Dialog-Frame /* foundFile */
DO:
    run handleFileSelection.
END.

ON VALUE-CHANGED OF foundFile IN FRAME Dialog-Frame /* foundFile */
DO:
    Btn_OpenFile:sensitive in frame Dialog-Frame = CanOpenFile(GetSelectedFile()) .
END.
&ENDIF

/* ***************************  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.
  
  /*
   * Load the file information
   */
  &IF "{&WINDOW-SYSTEM}" BEGINS "MS-WIN" &THEN
      run LoadFileInfo.
  &ENDIF.
 
 &scoped-define CANCEL-EVENT U2
      &if DEFINED(IDE-IS-RUNNING) <> 0 &then
 ipTitle = ipTitle +  " - " + getProjectDisplayName().
      &endif
 {adeuib/ide/dialogstart.i  Btn_Close Btn_Close iptitle}
      &if DEFINED(IDE-IS-RUNNING) <> 0 &then
  dialogService:SizeToFit().
      &endif
  run adecomm/_setcurs.p("").
  WAIT-FOR GO OF FRAME {&FRAME-NAME}.
  
  run adecomm/_setcurs.p("").
END.
RUN disable_UI.

&IF "{&WINDOW-SYSTEM}" BEGINS "MS-WIN" &THEN
  RUN UnloadDLL.
&ENDIF.

&if DEFINED(IDE-IS-RUNNING) <> 0 &then
   return gSelectedFile.
&endif
 


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

PROCEDURE addFile :
/*------------------------------------------------------------------------------
  Purpose:     
  Parameters:  <none>
  Notes:       
------------------------------------------------------------------------------*/
define input parameter fName as character no-undo.

define variable cDate   as character no-undo.
define variable i       as integer   no-undo initial 1.
define variable str     as character no-undo.
define variable s       as logical   no-undo.
define variable dateStr as character no-undo initial "".
define variable modDate as date      no-undo.
define variable modTime as character no-undo.
define variable preStr  as character no-undo.
define variable cExt    as character no-undo.

if fName = ? then return.
if length(fName) < 0 then return.

preStr = string(foundCount) + ". " + fName.

&if DEFINED(IDE-IS-RUNNING) <> 0 &then
   gFiles = gFiles
          + (if foundCount = 1 then "" else ",")
          + fname.  
&endif

do with frame {&FRAME-NAME}:
    &IF "{&WINDOW-SYSTEM}" BEGINS "MS-WIN" &THEN
         run file_info (fName, output file-year,
                               output file-mon,
                               output file-day,
                               output file-hour,
                               output file-min,
                               output file-sec,
                               output file-size,
                               output error).
        
        /* We need to build the date string based on the users date format */
        do while i <= 3:        
          case substring(session:date-format, i, 1):
            when "m":U then cDate = cDate + string(file-mon,"99").
            when "d":U then cDate = cDate + string(file-day,"99").
            when "y":U then cDate = cDate + substring(string(file-year),3,2,"fixed").
          end case.
          i = i + 1.
        end.  /* do while i <= 3 */

        IF error = 0 THEN
        assign
            cDate = substring(cDate, 1, 2) 
                  + "/" + substring(cDate, 3, 2) 
                  + "/" + substring(cDate, 5, 2)
            modDate = date(cDate)         
            modTime = string(file-hour,"99")
                    + ":"
                    + string(file-min,"99")
                    + ":"
                    + string(file-sec,"99")

            dateStr = string(modDate) + " " + modTime.
        
        /*
         * Try to get the dates/teims to lineup. But never
         * allow a filename to be clipped!
         */
         
        if length(preStr) < 55 then preStr = string(preStr, "X(55)").
    &ENDIF
    assign
        str = preStr + " " + dateStr
        s = foundFile:ADD-LAST(str)
        foundCount = foundCount + 1
    .
end.

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 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 whichFile foundFile 
      WITH FRAME Dialog-Frame.
  ENABLE whichFile doIt foundFile Btn_Close 
      WITH FRAME Dialog-Frame.
  VIEW FRAME Dialog-Frame.
  {&OPEN-BROWSERS-IN-QUERY-Dialog-Frame}
END PROCEDURE.

&if DEFINED(IDE-IS-RUNNING) <> 0 &then
procedure handleFileSelection:
/*------------------------------------------------------------------------------
 Purpose:
 Notes:
------------------------------------------------------------------------------*/
    define variable cFile as character no-undo.
    cFile = GetSelectedFile().
    if CanOpenFile(cFile) then 
    do:
        gSelectedFile = cFile.
        apply "go" to FRAME {&FRAME-NAME}.
    end.   
end procedure.
&endif

PROCEDURE makeRCodeName :
/*------------------------------------------------------------------------------
  Purpose:     
  Parameters:  <none>
  Notes:       
------------------------------------------------------------------------------*/
define input  parameter fName as character no-undo.
define output parameter rName as character no-undo initial ?.

define variable str as character no-undo.

if num-entries(fName, ".") > 1 then

     str = substr(fName, 1, r-index(fName, ".") - 1) + ".r".
else
     str = fName + ".r". 

file-info:file-name = str.

if     file-info:pathname <> ? 
   and file-info:pathname = str then rName = str.
END PROCEDURE.


&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) 2005 by Progress Software Corporation. All rights    *
* reserved.  Prior versions of this work may contain portions        *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/
/*------------------------------------------------------------------------

  File: _session.w

  Description: List connected databases (and let the user add/remove some).

    Input Parameters:
      <none>

  Output Parameters:
      <none>

  Author: Gerry Seidl

  Created: 08/09/93 -  7:37 am
  
  Modified on 11/06/96 gfs - Added adjustment to dialog for win95 font
              08/01/97 gfs - Updated attribute list
              01/23/98 gfs - Updated attribute list for v9
              12/07/98 gfs - Additional attr update for v9
              05/25/99 tsm - Added NUMERIC-DECIMAL-POINT and 
                             NUMERIC-SEPARATOR for v9.1
              06/11/99 tsm - Added CONTEXT-HELP-FILE for v9.1
              09/24/99 gfs - Added some other missing attrs.           
------------------------------------------------------------------------*/
/*          This .W file was created with the Progress UIB.             */
/*----------------------------------------------------------------------*/
{ adecomm/commeng.i}   /* Help contexts */
{ adecomm/adestds.i}   /* Standard layout defines, colors etc. */
{ protools/ptlshlp.i } /* help definitions */
{ adecomm/_adetool.i }

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

/* Parameters Definitions ---                                           */

/* Local Variable Definitions ---                                       */
DEFINE NEW SHARED STREAM rpt.

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

/* Standard List Definitions                                            */
&Scoped-Define ENABLED-OBJECTS attr-list Btn_Close b_Print b_Help 

/* 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 Btn_Close AUTO-GO 
     LABEL "&Close":L 
     SIZE 15 BY 1.12.

DEFINE BUTTON b_Help 
     LABEL "&Help" 
     SIZE 15 BY 1.12.

DEFINE BUTTON b_Print 
     LABEL "&Print" 
     SIZE 15 BY 1.12.

DEFINE VARIABLE attr-list AS CHARACTER 
     VIEW-AS SELECTION-LIST SINGLE SORT 
     SCROLLBAR-HORIZONTAL SCROLLBAR-VERTICAL 
     SIZE 54 BY 13.82
     FONT 2 NO-UNDO.


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

DEFINE FRAME f
     attr-list AT ROW 1.59 COL 3 NO-LABEL
     Btn_Close AT ROW 15.77 COL 4
     b_Print AT ROW 15.77 COL 21.5
     b_Help AT ROW 15.77 COL 39.5
     SPACE(4.20) SKIP(0.30)
    WITH VIEW-AS DIALOG-BOX KEEP-TAB-ORDER 
         SIDE-LABELS THREE-D  SCROLLABLE 
         TITLE "Session Attributes":L
         DEFAULT-BUTTON Btn_Close.


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

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



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

&ANALYZE-SUSPEND _RUN-TIME-ATTRIBUTES
/* SETTINGS FOR DIALOG-BOX f
   UNDERLINE                                                            */
ASSIGN 
       FRAME f:SCROLLABLE       = FALSE.

/* SETTINGS FOR SELECTION-LIST attr-list IN FRAME f
   NO-DISPLAY                                                           */
/* SETTINGS FOR BUTTON Btn_Close IN FRAME f
   NO-DISPLAY                                                           */
/* _RUN-TIME-ATTRIBUTES-END */
&ANALYZE-RESUME

 



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

&Scoped-define SELF-NAME b_Help
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL b_Help f
ON CHOOSE OF b_Help IN FRAME f /* Help */
DO:
  RUN adecomm/_adehelp.p ( "ptls", "CONTEXT", {&Session_Attributes}, ? ).  
END.

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


&Scoped-define SELF-NAME b_Print
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL b_Print f
ON CHOOSE OF b_Print IN FRAME f /* Print */
DO:
  RUN Print_Attrs.
END.

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


&UNDEFINE SELF-NAME

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


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

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

/* Set Delimiter for the selection list. We cannot use ',' since
 * several numeric parameters are decimals and would mess up the
 * entries when using European format
 */
ASSIGN attr-list:DELIMITER = ";".

/* Get session Attributes. */
RUN get_attributes.

/* This adjustment is for when we are running with MS Sans Serif 8
 * as the default font
 */
IF SESSION:PIXELS-PER-COLUMN = 5 THEN
  ASSIGN FRAME {&FRAME-NAME}:WIDTH = FRAME {&FRAME-NAME}:WIDTH + 13
         attr-list:WIDTH           = attr-list:WIDTH + 14
         b_help:COLUMN             = b_help:COLUMN + 6
         b_print:COLUMN            = b_print:COLUMN + 6
         btn_close:COLUMN          = btn_Close:COLUMN + 6.
  
/* 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.
  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 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 attr-list Btn_Close b_Print b_Help 
      WITH FRAME f.
  {&OPEN-BROWSERS-IN-QUERY-f}
END PROCEDURE.

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

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE get_attributes f 
PROCEDURE get_attributes :
/* -----------------------------------------------------------
  Purpose:    Populate a list with the session attributes
              in the form "Attribute = value"     
  Parameters:  <none>
  Notes:       
-------------------------------------------------------------*/
  DEFINE VARIABLE fproc  AS HANDLE NO-UNDO.
  DEFINE VARIABLE lproc  AS HANDLE NO-UNDO.
  DEFINE VARIABLE fchild AS HANDLE NO-UNDO.
  DEFINE VARIABLE lchild AS HANDLE NO-UNDO.
  
  ASSIGN fproc  = SESSION:FIRST-PROCEDURE
         lproc  = SESSION:LAST-PROCEDURE
         fchild = SESSION:FIRST-CHILD
         lchild = SESSION:LAST-CHILD.
           
  attr-list:LIST-ITEMS IN FRAME {&FRAME-NAME} =
    "APPL-ALERT-BOXES       = " + STRING(SESSION:APPL-ALERT-BOXES) + 
   ";BATCH-MODE             = " + STRING(SESSION:BATCH-MODE) + 
   ";CHARSET                = " + SESSION:CHARSET + 
   ";CONTEXT-HELP-FILE      = " + (IF SESSION:CONTEXT-HELP-FILE NE ? THEN SESSION:CONTEXT-HELP-FILE ELSE "?") +
   ";CPCASE                 = " + (IF SESSION:CPCASE NE ? THEN SESSION:CPCASE ELSE "?") + 
   ";CPCOLL                 = " + (IF SESSION:CPCOLL NE ? THEN SESSION:CPCOLL ELSE "?") +
   ";CPINTERNAL             = " + (IF SESSION:CPINTERNAL NE ? THEN SESSION:CPINTERNAL ELSE "?") + 
   ";CPLOG                  = " + (IF SESSION:CPLOG NE ? THEN SESSION:CPLOG ELSE "?") +
   ";CPPRINT                = " + (IF SESSION:CPPRINT NE ? THEN SESSION:CPPRINT ELSE "?") +
   ";CPRCODEIN              = " + (IF SESSION:CPRCODEIN NE ? THEN SESSION:CPRCODEIN ELSE "?") +
   ";CPRCODEOUT             = " + (IF SESSION:CPRCODEOUT NE ? THEN SESSION:CPRCODEOUT ELSE "?") + 
   ";CPSTREAM               = " + (IF SESSION:CPSTREAM NE ? THEN SESSION:CPSTREAM ELSE "?") +
   ";CPTERM                 = " + (IF SESSION:CPTERM NE ? THEN SESSION:CPTERM ELSE "?") +   
   ";DATA-ENTRY-RETURN      = " + STRING(SESSION:DATA-ENTRY-RETURN) + 
   ";DATE-FORMAT            = " + STRING(SESSION:DATE-FORMAT) + 
   ";DEBUG-ALERT            = " + (IF SESSION:DEBUG-ALERT THEN "TRUE" ELSE "FALSE") + 
   ";DISPLAY-TYPE           = " + SESSION:DISPLAY-TYPE  + 
   ";FIRST-ASYNC-REQUEST    = " + (IF SESSION:FIRST-ASYNC-REQUEST NE ? THEN STRING(SESSION:FIRST-ASYNC-REQUEST) ELSE "?") +
   ";FIRST-CHILD            = " + STRING(SESSION:FIRST-CHILD) + (IF CAN-QUERY(fchild,"TYPE") THEN " [" + fchild:TYPE + "]" ELSE "") +
   ";FIRST-PROCEDURE        = " + (IF VALID-HANDLE(fproc) THEN fproc:FILE-NAME ELSE "<none>") +
   ";FIRST-SERVER           = " + (IF SESSION:FIRST-SERVER NE ? THEN STRING(SESSION:FIRST-SERVER) ELSE "?") +
   ";FIRST-SOCKET           = " + (IF SESSION:FIRST-SOCKET NE ? THEN STRING(SESSION:FIRST-SOCKET) ELSE "?") +
   ";FRAME-SPACING          = " + STRING(SESSION:FRAME-SPACING) + 
   ";GET-PRINTERS()         = " + (IF SESSION:GET-PRINTERS() NE ? THEN STRING(SESSION:GET-PRINTERS()) ELSE "<none>") + 
   ";HEIGHT-CHARS           = " + STRING(SESSION:HEIGHT-CHARS) + 
   ";HEIGHT-PIXELS          = " + STRING(SESSION:HEIGHT-PIXELS) + 
   ";IMMEDIATE-DISPLAY      = " + STRING(SESSION:IMMEDIATE-DISPLAY) + 
   ";LAST-ASYNC-REQUEST     = " + (IF SESSION:LAST-ASYNC-REQUEST NE ? THEN STRING(SESSION:LAST-ASYNC-REQUEST) ELSE "?") +
   ";LAST-CHILD             = " + STRING(SESSION:LAST-CHILD) + (IF CAN-QUERY(lchild,"TYPE") THEN " [" + lchild:TYPE + "]" ELSE "") +
   ";LAST-PROCEDURE         = " + (IF VALID-HANDLE(lproc) THEN lproc:FILE-NAME ELSE "<none>") +
   ";LAST-SERVER            = " + (IF SESSION:LAST-SERVER NE ? THEN STRING(SESSION:LAST-SERVER) ELSE "?") +
   ";LAST-SOCKET            = " + (IF SESSION:LAST-SOCKET NE ? THEN STRING(SESSION:LAST-SOCKET) ELSE "?") +
   ";MULTITASKING-INTERVAL  = " + STRING(SESSION:MULTITASKING-INTERVAL) +
   ";NUMERIC-DECIMAL-POINT  = " + SESSION:NUMERIC-DECIMAL-POINT +
   ";NUMERIC-FORMAT         = " + SESSION:NUMERIC-FORMAT +
   ";NUMERIC-SEPARATOR      = " + SESSION:NUMERIC-SEPARATOR +
   ";OLE-INVOKE-LOCALE      = " + (IF SESSION:OLE-INVOKE-LOCALE NE ? THEN STRING(SESSION:OLE-INVOKE-LOCALE) ELSE "?") +
   ";OLE-NAMES-LOCALE       = " + (IF SESSION:OLE-NAMES-LOCALE NE ? THEN STRING(SESSION:OLE-NAMES-LOCALE) ELSE "?") +
   ";PARAMETER              = " + SESSION:PARAMETER +
   ";PIXELS-PER-COLUMN      = " + STRING(SESSION:PIXELS-PER-COLUMN) + 
   ";PIXELS-PER-ROW         = " + STRING(SESSION:PIXELS-PER-ROW)
   NO-ERROR.

attr-list:LIST-ITEMS IN FRAME {&FRAME-NAME} = attr-list:LIST-ITEMS IN FRAME {&FRAME-NAME} +
   ";PRINTER-CONTROL-HANDLE = " + STRING(SESSION:PRINTER-CONTROL-HANDLE) +
   ";PRINTER-HDC            = " + (IF SESSION:PRINTER-HDC = ? THEN "?" ELSE STRING(SESSION:PRINTER-HDC)) +
   ";PRINTER-NAME           = " + (IF SESSION:PRINTER-NAME NE ? THEN SESSION:PRINTER-NAME ELSE "?") +
   ";PRINTER-PORT           = " + (IF SESSION:PRINTER-PORT NE ? THEN SESSION:PRINTER-PORT ELSE "?") + 
   ";REMOTE                 = " + (IF SESSION:REMOTE THEN "TRUE" ELSE "FALSE") +
   ";STREAM                 = " + SESSION:STREAM + 
   ";SUPER-PROCEDURES       = " + (IF SESSION:SUPER-PROCEDURES = "" THEN "<none>" ELSE SESSION:SUPER-PROCEDURES) +
   ";SUPPRESS-WARNINGS      = " + STRING(SESSION:SUPPRESS-WARNINGS) + 
   ";SYSTEM-ALERT-BOXES     = " + STRING(SESSION:SYSTEM-ALERT-BOXES) + 
   ";TEMP-DIRECTORY         = " + SESSION:TEMP-DIRECTORY + 
   ";THREE-D                = " + STRING(SESSION:THREE-D) +
   ";TIME-SOURCE            = " + SESSION:TIME-SOURCE + 
   ";TOOLTIPS               = " + (IF SESSION:TOOLTIPS THEN "TRUE" ELSE "FALSE") +
   ";TYPE                   = " + SESSION:TYPE +
   ";V6DISPLAY              = " + STRING(SESSION:V6DISPLAY) + 
   ";WAIT-STATE             = " + (IF SESSION:GET-WAIT-STATE() = "" THEN "<none>" ELSE SESSION:GET-WAIT-STATE()) +
   ";WIDTH-CHARS            = " + STRING(SESSION:WIDTH-CHARS) + 
   ";WIDTH-PIXELS           = " + STRING(SESSION:WIDTH-PIXELS) + 
   ";WINDOW-SYSTEM          = " + SESSION:WINDOW-SYSTEM +
   ";WORK-AREA-HEIGHT-PIXELS= " + STRING(SESSION:WORK-AREA-HEIGHT-PIXELS) +
   ";WORK-AREA-WIDTH-PIXELS = " + STRING(SESSION:WORK-AREA-WIDTH-PIXELS) +
   ";WORK-AREA-X            = " + STRING(SESSION:WORK-AREA-X) +
   ";WORK-AREA-Y            = " + STRING(SESSION:WORK-AREA-Y) +
   ";YEAR-OFFSET            = " + STRING(SESSION:YEAR-OFFSET)
   NO-ERROR.
END PROCEDURE.

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

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE Print_Attrs f 
PROCEDURE Print_Attrs :
/*------------------------------------------------------------------------------
  Purpose:     Print attributes 
  Parameters:  <none>
  Notes:       
------------------------------------------------------------------------------*/

  /* Print Dialog routine. Largely stolen from adecomm/_report.p */
  
  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 VARIABLE stat    AS LOGICAL     NO-UNDO.
  
  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...".
  DEFINE BUTTON btn_Help   LABEL "&Help"  {&STDPH_OKBTN}.
  
  DEFINE RECTANGLE rect_Btns {&STDPH_OKBOX}. /* standard button rectangle */
  
  &GLOBAL-DEFINE   HLP_BTN  &HELP = "btn_Help"
  
  FORM
     SKIP({&TFM_WID})
  
     dev LABEL "&Send Output to"           COLON 17
     SKIP ({&VM_WID})
  
     fil NO-LABEL FORMAT "x(60)"           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".
     
  ON HELP of FRAME prt_options OR choose of btn_Help in frame prt_options
    RUN adecomm/_adehelp.p ("comm":u,"CONTEXT":u,{&Print_Options},?).
  
  ON WINDOW-CLOSE OF FRAME prt_options
    apply "END-ERROR" to frame prt_options.
  
  ON GO OF FRAME prt_OPTIONS DO:
    DEFINE VARIABLE h_datetime AS CHARACTER                NO-UNDO.
    DEFINE VARIABLE i          AS INTEGER                  NO-UNDO.  
    DEFINE VARIABLE attrs      AS CHARACTER FORMAT "X(70)" 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 fil = "" OR fil = ? OR INDEX(FILE-INFO:FILE-TYPE,"D") > 0 THEN DO:
           MESSAGE "Please enter a valid filename." VIEW-AS ALERT-BOX ERROR.
           APPLY "ENTRY" TO fil.
           RETURN NO-APPLY.
         END.
         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.
    /* Header with Page specification */
    FORM HEADER
        h_datetime FORMAT "x(17)" SPACE(7) "Session Attributes"
        "Page" AT 70 PAGE-NUMBER (rpt) FORMAT "ZZ9" 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) "Session Attributes" SKIP
        WITH FRAME page_head_cont
        PAGE-TOP NO-LABELS NO-BOX NO-ATTR-SPACE NO-UNDERLINE USE-TEXT STREAM-IO.
    
    FORM attrs NO-LABEL WITH FRAME detail DOWN CENTERED 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).
  
      ASSIGN 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.
      
      /* The actual report ... */
      DO i = 1 to NUM-ENTRIES(attr-list:LIST-ITEMS IN FRAME {&FRAME-NAME},";"):
        DISPLAY STREAM rpt ENTRY(i,attr-list:LIST-ITEMS IN FRAME {&FRAME-NAME},";") @ attrs WITH FRAME detail.   
        DOWN STREAM rpt WITH FRAME detail.
      END. 
  
      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. */
    ASSIGN dev = SELF:SCREEN-VALUE.
    IF dev = "F" /* file */ THEN DO:
      ASSIGN
        siz:SCREEN-VALUE IN FRAME prt_options    = "0"
        fil:SENSITIVE IN FRAME prt_options       = yes
        btn_Files:SENSITIVE IN FRAME prt_options = yes
        app:SENSITIVE IN FRAME prt_options       = yes
        .
      APPLY "ENTRY" TO fil IN FRAME prt_options.
    END.
    ELSE 
      ASSIGN
        siz:SCREEN-VALUE    IN FRAME prt_options = "60"
        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"
        .
  END.
    
  /*----- HIT of FILE BUTTON -----*/
  ON CHOOSE OF btn_Files IN FRAME prt_options
  DO:
    DEFINE VARIABLE name       AS CHARACTER  NO-UNDO.
    DEFINE VARIABLE picked_one AS LOGICAL    NO-UNDO.
    DEFINE VARIABLE d_title    AS CHARACTER  NO-UNDO INITIAL "Report File".
   
    ASSIGN name = TRIM(fil:screen-value in FRAME prt_options).
    SYSTEM-DIALOG GET-FILE 
      name 
      filters            "*" "*"
      default-extension  ""
      title              d_title 
      update             picked_one.
   
    IF picked_one THEN
         fil:SCREEN-VALUE IN FRAME prt_options = name.
  END.
  
  /*=======Mainline for Print processing=========*/
  
  {adecomm/okrun.i  
     &FRAME = "frame prt_options" 
     &BOX   = "rect_Btns"
     &OK    = "btn_OK" 
     &CANCEL = "btn_Cancel"   /* to center for TTY mode */
     {&HLP_BTN}
  }
  
  /* 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    = ""
    fil:SENSITIVE IN FRAME prt_options       = no
    btn_Files:SENSITIVE IN FRAME prt_options = no
    app:SENSITIVE IN FRAME prt_options       = no
    .
  
  ASSIGN
    dev = "Printer"
    siz = 60.
  DISPLAY dev siz WITH FRAME prt_options.
  
  ENABLE
     dev
     siz
     btn_Ok 
     btn_Cancel
     btn_Help
     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 = app:MOVE-AFTER-TAB-ITEM(btn_Files:HANDLE IN FRAME prt_options)
    stat = btn_Files:MOVE-AFTER-TAB-ITEM(fil: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 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:  _smoupg.p

    Purpose:    Checks to see if the UIB is running and if it is
                it launches adeuib/_smoupg.w.

    Parameters: None

    Description:
    Notes  :
    Authors: Gerry Seidl
    Date   : 9/12/96
**************************************************************************/

DEFINE VARIABLE level          AS INTEGER NO-UNDO INITIAL 1. 
DEFINE VARIABLE uib_is_running AS LOGICAL NO-UNDO INITIAL NO.

REPEAT WHILE PROGRAM-NAME(level) <> ?.
  IF PROGRAM-NAME(level) = "adeuib/_uibmain.p" THEN uib_is_running = TRUE.
  ASSIGN level = level + 1.
END.
IF NOT uib_is_running THEN DO:
  MESSAGE "The UIB is not running. You must start the UIB before running the SmartObject Upgrade Utility." VIEW-AS ALERT-BOX ERROR.
  RETURN.
END.
ELSE
  RUN adeuib/_smoupg.w PERSISTENT.

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: _storarea.p 

  Description: 

  Note: Called by protools/_gettbl.p.  This file relies on tinydict alias 
        having been predefined.
  
  Input Parameters:
      pRecid    - RECID of tinydict

  Output Parameters:
      pStorArea - value of metaschema _Area._Area-name for this database.

  Author:  D.M.ADams
  Created: 09/24/99
  History: 08/16/00 D. McMann Added _Db-recid for _StorageObject find 20000815029
------------------------------------------------------------------------*/
DEFINE INPUT  PARAMETER pRecid    AS RECID     NO-UNDO.
DEFINE OUTPUT PARAMETER pStorArea AS CHARACTER NO-UNDO.

FIND tinydict._File WHERE RECID(tinydict._File) = pRecid NO-ERROR.
IF AVAILABLE tinydict._File THEN DO:
  
  IF tinydict._File._File-number <> ? THEN DO:
    FIND tinydict._StorageObject NO-LOCK
      WHERE tinydict._StorageObject._Db-recid = tinydict._File._Db-recid AND
            tinydict._StorageObject._Object-type   = 1 AND
            tinydict._StorageObject._Object-number = tinydict._File._File-number and
            tinydict._StorageObject._Partitionid = 0 NO-ERROR.
    IF AVAILABLE tinydict._StorageObject THEN                      
      FIND tinydict._Area NO-LOCK 
        WHERE tinydict._Area._Area-number = tinydict._StorageObject._Area-number 
        NO-ERROR.
    ELSE
      FIND tinydict._Area NO-LOCK 
        WHERE tinydict._Area._Area-number = 6 NO-ERROR.
  END.    /* if filenumer <> ? */
  ELSE
    FIND tinydict._Area NO-LOCK 
      WHERE tinydict._Area._Area-number = tinydict._File._ianum NO-ERROR.
      
  IF AVAILABLE _Area THEN
    ASSIGN pStorArea = tinydict._Area._Area-name. 
END.
  
/* _storarea.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.                           *
*                                                                    *
*********************************************************************/
/*PROGRAM NAME: _tblavbl.p
 * AUTHOR      : Tammy Marshall
 * DATE        : 04/01/99
 * DESCRIPTION : Accepts a table name and returns a logical indicating whether
 *               the table still exists in the DB.
 * */
 
DEFINE INPUT PARAMETER pcDBType AS CHARACTER NO-UNDO.
DEFINE INPUT PARAMETER pcDBName AS CHARACTER NO-UNDO.
DEFINE INPUT PARAMETER pcName AS CHARACTER NO-UNDO.
DEFINE OUTPUT PARAMETER plExists AS LOGICAL NO-UNDO.

DEFINE VARIABLE rDB AS RECID NO-UNDO.

IF pcDBType = "PROGRESS" THEN
    FIND tinydict._db WHERE tinydict._db._db-name = ? AND 
        tinydict._db._db-type = "PROGRESS" NO-LOCK NO-ERROR. /*local */
ELSE
    FIND tinydict._db WHERE tinydict._db._db-name = pcDBName AND 
        tinydict._db._db-type = pcDBType NO-LOCK NO-ERROR. /* foreign */
rDB = RECID(tinydict._db).

FIND tinydict._File WHERE RECID(tinydict._db) = rDB AND
  tinydict._File._File-Name = pcName NO-LOCK NO-ERROR.
IF AVAILABLE _File THEN plExists = TRUE.
ELSE plExists = FALSE.  

&ANALYZE-SUSPEND _VERSION-NUMBER UIB_v9r12 GUI
&ANALYZE-RESUME
&Scoped-define WINDOW-NAME C-Win
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _DEFINITIONS C-Win 
/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/
/*------------------------------------------------------------------------

  File: protools/_tbldetl.w

  Description: This is the Table Details Window of the DB Connections PRO*Tool

  Input Parameters:
      hParentWin - handle of the Schema Detail Window

  Output Parameters:
      <none>

  Author: Tammy Marshall

  Created: 04/09/99

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

{protools/_schdef.i}  /* Table-Details temp table definition */

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

/* Parameters Definitions ---                                           */
DEFINE INPUT PARAMETER hParentWin AS HANDLE NO-UNDO.

/* Local Variable Definitions ---                                       */

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

/* Standard List Definitions                                            */
&Scoped-Define ENABLED-OBJECTS RECT-5 cname cdesc clabel lMultitenant ~
lKeepDefault cstorarea creplproc cvalexp cvalmsg crtrig repcrtrig deltrig ~
repdeltrig fndtrig repwrtrig wrtrig bClose bHelp 
&Scoped-Define DISPLAYED-OBJECTS cname cdesc clabel lMultitenant ~
lKeepDefault cstorarea creplproc cvalexp cvalmsg crtrig repcrtrig deltrig ~
repdeltrig fndtrig repwrtrig wrtrig 

/* 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 C-Win AS WIDGET-HANDLE NO-UNDO.

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

DEFINE BUTTON bHelp 
     LABEL "&Help" 
     SIZE 15 BY 1.14.

DEFINE VARIABLE cdesc AS CHARACTER 
     VIEW-AS EDITOR SCROLLBAR-VERTICAL
     SIZE 38.6 BY 4.95
     BGCOLOR 15 FGCOLOR 0  NO-UNDO.

DEFINE VARIABLE clabel AS CHARACTER FORMAT "X(256)":U 
     LABEL "Label" 
     VIEW-AS FILL-IN 
     SIZE 34 BY 1
     BGCOLOR 15 FGCOLOR 0  NO-UNDO.

DEFINE VARIABLE cname AS CHARACTER FORMAT "X(256)":U INITIAL "abcdefghijklmnopqrstuvwxyz" 
     LABEL "Table Name" 
     VIEW-AS FILL-IN 
     SIZE 34 BY 1
     BGCOLOR 15 FGCOLOR 0  NO-UNDO.

DEFINE VARIABLE creplproc AS CHARACTER FORMAT "X(256)":U 
     LABEL "Replication" 
     VIEW-AS FILL-IN 
     SIZE 34 BY 1
     BGCOLOR 15 FGCOLOR 0  NO-UNDO.

DEFINE VARIABLE crtrig AS CHARACTER FORMAT "X(256)":U 
     LABEL "Create" 
     VIEW-AS FILL-IN 
     SIZE 30 BY 1
     BGCOLOR 15 FGCOLOR 0  NO-UNDO.

DEFINE VARIABLE cstorarea AS CHARACTER FORMAT "X(256)":U 
     LABEL "Storage Area" 
     VIEW-AS FILL-IN 
     SIZE 34 BY 1
     BGCOLOR 15 FGCOLOR 0  NO-UNDO.

DEFINE VARIABLE cvalexp AS CHARACTER FORMAT "X(256)":U 
     LABEL "ValExp" 
     VIEW-AS FILL-IN 
     SIZE 76 BY 1
     BGCOLOR 15 FGCOLOR 0  NO-UNDO.

DEFINE VARIABLE cvalmsg AS CHARACTER FORMAT "X(256)":U 
     LABEL "ValMsg" 
     VIEW-AS FILL-IN 
     SIZE 76 BY 1
     BGCOLOR 15 FGCOLOR 0  NO-UNDO.

DEFINE VARIABLE deltrig AS CHARACTER FORMAT "X(256)":U 
     LABEL "Delete" 
     VIEW-AS FILL-IN 
     SIZE 30 BY 1
     BGCOLOR 15 FGCOLOR 0  NO-UNDO.

DEFINE VARIABLE fndtrig AS CHARACTER FORMAT "X(256)":U 
     LABEL "Find" 
     VIEW-AS FILL-IN 
     SIZE 30 BY 1
     BGCOLOR 15 FGCOLOR 0  NO-UNDO.

DEFINE VARIABLE lKeepDefault AS LOGICAL FORMAT "yes/no":U INITIAL NO 
     LABEL "Keep Default Area" 
     VIEW-AS FILL-IN 
     SIZE 6.8 BY 1
     BGCOLOR 15  NO-UNDO.

DEFINE VARIABLE lMultitenant AS LOGICAL FORMAT "yes/no":U INITIAL NO 
     LABEL "Multi-tenant" 
     VIEW-AS FILL-IN 
     SIZE 6.8 BY 1
     BGCOLOR 15  NO-UNDO.

DEFINE VARIABLE repcrtrig AS CHARACTER FORMAT "X(256)":U 
     LABEL "Replication-Create" 
     VIEW-AS FILL-IN 
     SIZE 30 BY 1
     BGCOLOR 15 FGCOLOR 0  NO-UNDO.

DEFINE VARIABLE repdeltrig AS CHARACTER FORMAT "X(256)":U 
     LABEL "Replication-Delete" 
     VIEW-AS FILL-IN 
     SIZE 30 BY 1
     BGCOLOR 15 FGCOLOR 0  NO-UNDO.

DEFINE VARIABLE repwrtrig AS CHARACTER FORMAT "X(256)":U 
     LABEL "Replication-Write" 
     VIEW-AS FILL-IN 
     SIZE 30 BY 1
     BGCOLOR 15 FGCOLOR 0  NO-UNDO.

DEFINE VARIABLE wrtrig AS CHARACTER FORMAT "X(256)":U 
     LABEL "Write" 
     VIEW-AS FILL-IN 
     SIZE 30 BY 1
     BGCOLOR 15 FGCOLOR 0  NO-UNDO.

DEFINE RECTANGLE RECT-5
     EDGE-PIXELS 2 GRAPHIC-EDGE  NO-FILL   
     SIZE 92 BY 5.57.


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

DEFINE FRAME DEFAULT-FRAME
     cname AT ROW 1.38 COL 17 COLON-ALIGNED
     cdesc AT ROW 2.67 COL 56.4 NO-LABEL
     clabel AT ROW 2.71 COL 17 COLON-ALIGNED
     lMultitenant AT ROW 4 COL 17 COLON-ALIGNED WIDGET-ID 2
     lKeepDefault AT ROW 4 COL 44 COLON-ALIGNED WIDGET-ID 4
     cstorarea AT ROW 5.33 COL 17 COLON-ALIGNED
     creplproc AT ROW 6.62 COL 17 COLON-ALIGNED
     cvalexp AT ROW 7.91 COL 17 COLON-ALIGNED
     cvalmsg AT ROW 9.24 COL 17 COLON-ALIGNED
     crtrig AT ROW 11.14 COL 10.8 COLON-ALIGNED
     repcrtrig AT ROW 11.14 COL 60.6 COLON-ALIGNED
     deltrig AT ROW 12.43 COL 10.8 COLON-ALIGNED
     repdeltrig AT ROW 12.43 COL 60.6 COLON-ALIGNED
     fndtrig AT ROW 13.76 COL 10.8 COLON-ALIGNED
     repwrtrig AT ROW 13.76 COL 60.6 COLON-ALIGNED
     wrtrig AT ROW 15.05 COL 10.8 COLON-ALIGNED
     bClose AT ROW 17.05 COL 20.4
     bHelp AT ROW 17.05 COL 60.8
     "Description:" VIEW-AS TEXT
          SIZE 13 BY .62 AT ROW 1.76 COL 56.4
     "Triggers" VIEW-AS TEXT
          SIZE 8.2 BY .62 AT ROW 10.48 COL 5.4
     RECT-5 AT ROW 10.81 COL 3
    WITH 1 DOWN NO-BOX KEEP-TAB-ORDER OVERLAY 
         SIDE-LABELS NO-UNDERLINE THREE-D 
         AT COL 1 ROW 1 SCROLLABLE .


/* *********************** 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              = "Table Details"
         HEIGHT             = 18.81
         WIDTH              = 96
         MAX-HEIGHT         = 20.48
         MAX-WIDTH          = 101
         VIRTUAL-HEIGHT     = 20.48
         VIRTUAL-WIDTH      = 101
         MAX-BUTTON         = no
         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.
/* 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 Size-to-Fit                                               */
ASSIGN 
       FRAME DEFAULT-FRAME:SCROLLABLE       = FALSE.

ASSIGN 
       cdesc:READ-ONLY IN FRAME DEFAULT-FRAME        = TRUE.

ASSIGN 
       clabel:READ-ONLY IN FRAME DEFAULT-FRAME        = TRUE.

ASSIGN 
       cname:READ-ONLY IN FRAME DEFAULT-FRAME        = TRUE.

ASSIGN 
       creplproc:READ-ONLY IN FRAME DEFAULT-FRAME        = TRUE.

ASSIGN 
       crtrig:READ-ONLY IN FRAME DEFAULT-FRAME        = TRUE.

ASSIGN 
       cstorarea:READ-ONLY IN FRAME DEFAULT-FRAME        = TRUE.

ASSIGN 
       cvalexp:READ-ONLY IN FRAME DEFAULT-FRAME        = TRUE.

ASSIGN 
       cvalmsg:READ-ONLY IN FRAME DEFAULT-FRAME        = TRUE.

ASSIGN 
       deltrig:READ-ONLY IN FRAME DEFAULT-FRAME        = TRUE.

ASSIGN 
       fndtrig:READ-ONLY IN FRAME DEFAULT-FRAME        = TRUE.

ASSIGN 
       lKeepDefault:READ-ONLY IN FRAME DEFAULT-FRAME        = TRUE.

ASSIGN 
       lMultitenant:READ-ONLY IN FRAME DEFAULT-FRAME        = TRUE.

ASSIGN 
       repcrtrig:READ-ONLY IN FRAME DEFAULT-FRAME        = TRUE.

ASSIGN 
       repdeltrig:READ-ONLY IN FRAME DEFAULT-FRAME        = TRUE.

ASSIGN 
       repwrtrig:READ-ONLY IN FRAME DEFAULT-FRAME        = TRUE.

ASSIGN 
       wrtrig: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

 



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

&Scoped-define SELF-NAME C-Win
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL C-Win C-Win
ON END-ERROR OF C-Win /* Table Details */
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 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 PARENT-WINDOW-CLOSE OF C-Win /* Table Details */
DO:
  APPLY "WINDOW-CLOSE":U TO C-Win.
END.

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


&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL C-Win C-Win
ON WINDOW-CLOSE OF C-Win /* Table Details */
DO:
  /* This event will close the window and terminate the procedure.  */
  APPLY "ENTRY":U TO hParentWin.
  APPLY "CLOSE":U TO THIS-PROCEDURE.
  RETURN NO-APPLY.
END.

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


&Scoped-define SELF-NAME bClose
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL bClose C-Win
ON CHOOSE OF bClose IN FRAME DEFAULT-FRAME /* Close */
DO:
  APPLY "WINDOW-CLOSE":U TO C-Win.
END.

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


&Scoped-define SELF-NAME bHelp
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL bHelp C-Win
ON CHOOSE OF bHelp IN FRAME DEFAULT-FRAME /* Help */
DO:
  RUN adecomm/_adehelp.p
    (INPUT "ptls":U, 
     INPUT "CONTEXT":U, 
     INPUT 11, 
     INPUT  ?).
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}.
       
ASSIGN CURRENT-WINDOW:PARENT = hParentWin. /* parent the previous window to this window */

/* 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.
  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 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 cname cdesc clabel lMultitenant lKeepDefault cstorarea creplproc 
          cvalexp cvalmsg crtrig repcrtrig deltrig repdeltrig fndtrig repwrtrig 
          wrtrig 
      WITH FRAME DEFAULT-FRAME IN WINDOW C-Win.
  ENABLE RECT-5 cname cdesc clabel lMultitenant lKeepDefault cstorarea 
         creplproc cvalexp cvalmsg crtrig repcrtrig deltrig repdeltrig fndtrig 
         repwrtrig wrtrig bClose bHelp 
      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 refreshTable C-Win 
PROCEDURE refreshTable :
/*------------------------------------------------------------------------------
  Purpose:     
  Parameters:  <none>
  Notes:       
------------------------------------------------------------------------------*/
DEFINE INPUT PARAMETER TABLE FOR TableDetails.
 
  FIND FIRST TableDetails NO-LOCK NO-ERROR.
  IF AVAILABLE TableDetails THEN DO WITH FRAME {&FRAME-NAME}:
    IF TableDetails.multitenant then
        cstorarea:label = "Default Area".
    else    
        cstorarea:label = "Storage Area".
        
    ASSIGN 
      cname:SCREEN-VALUE = TableDetails.name
      cdesc:SCREEN-VALUE = TableDetails.tdesc
      clabel:SCREEN-VALUE = TableDetails.tlabel
      crtrig:SCREEN-VALUE = TableDetails.crtrig
      deltrig:SCREEN-VALUE = TableDetails.deltrig
      fndtrig:SCREEN-VALUE = TableDetails.fndtrig
      wrtrig:SCREEN-VALUE = TableDetails.wrtrig
      repcrtrig:SCREEN-VALUE = TableDetails.repcrtrig
      repdeltrig:SCREEN-VALUE = TableDetails.repdeltrig
      repwrtrig:SCREEN-VALUE = TableDetails.repwrtrig
      cvalexp:SCREEN-VALUE = TableDetails.valexp
      cvalmsg:SCREEN-VALUE = TableDetails.valmsg
      creplproc:SCREEN-VALUE = TableDetails.replproc   
      cstorarea:SCREEN-VALUE = TableDetails.storarea
      lMultitenant:SCREEN-VALUE = string(TableDetails.multitenant)
      lKeepDefault:SCREEN-VALUE = string(TableDetails.keepdefaultarea).       
    ASSIGN {&WINDOW-NAME}:TITLE = TableDetails.name + " Table Details".
  END.  /* do with frame */
  
  APPLY "ENTRY":U TO C-Win.
  APPLY "ENTRY":U TO bClose.
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.                           *
*                                                                    *
*********************************************************************/
/*PROGRAM NAME: _tbllist.p
 * AUTHOR      : Tammy Marshall
 * DATE        : 04/01/99
 * DESCRIPTION : Returns a list of table names to populate the selection list
 *               of tables in the DB Connections PRO*Tool Schema window.
 * */
 
DEFINE INPUT PARAMETER pcDBType AS CHARACTER NO-UNDO.
DEFINE INPUT PARAMETER pcDBName AS CHARACTER NO-UNDO.
DEFINE OUTPUT PARAMETER pcTableList AS CHARACTER NO-UNDO.

DEFINE VARIABLE rDB AS RECID NO-UNDO.

IF pcDBType = "PROGRESS":U THEN
    FIND tinydict._db WHERE tinydict._db._db-name = ? AND 
        tinydict._db._db-type = "PROGRESS":U NO-LOCK NO-ERROR. /*local */
ELSE
    FIND tinydict._db WHERE tinydict._db._db-name = pcDBName AND 
        tinydict._db._db-type = pcDBType NO-LOCK NO-ERROR. /* foreign */
rDB = RECID(tinydict._db).

IF INT(DBVERSION(pcDBName)) < 9 THEN DO:
  FOR EACH tinydict._File WHERE RECID(tinydict._db) = rDB AND
    NOT tinydict._File._Hidden NO-LOCK BY tinydict._File._File-Name:
      
      IF pcTableList <> "" THEN pcTableList = pcTableList + ",":U.
      ASSIGN pcTableList = pcTableList + _File._File-Name.
  END.  /* for each _File */
END.  /* db version less than 9 */
ELSE DO:
  /* Need to check the File-Number for V9 or greater db's, anything less 
     than 0 is metaschema table and anything greater than 32K is SQL92 
     system catalog tables */
  FOR EACH tinydict._File NO-LOCK 
    WHERE RECID(tinydict._db) = rDB AND
          NOT tinydict._File._Hidden AND
          (tinydict._File._File-Number > 0 AND 
           tinydict._File._File-Number < 32768) 
    USE-INDEX _File-Name:
    
    IF pcTableList <> "" THEN 
      pcTableList = pcTableList + ",":U.
    ASSIGN pcTableList = pcTableList + tinydict._File._File-Name.
  END.  /* for each _File */
END.  /* else do - db version is 9 or greater */

/* _tbllist.p - end of file */
&ANALYZE-SUSPEND _VERSION-NUMBER AB_v9r12 GUI
&ANALYZE-RESUME
/* Connected Databases 
          files            PROGRESS
*/
&Scoped-define WINDOW-NAME V89conv

/* Temp-Table and Buffer definitions                                    */
DEFINE TEMP-TABLE Procedure NO-UNDO /* LIKE files.Procedure.            */
    FIELD Name AS CHARACTER FORMAT "X(255)"
    FIELD Stts AS CHARACTER FORMAT "X(9)" LABEL "Status" INITIAL "Not Conv"
    FIELD Extension AS CHARACTER
  INDEX Name IS PRIMARY UNIQUE Name
  INDEX Extension Extension Name.


&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _DEFINITIONS V89conv 
/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/
/*------------------------------------------------------------------------

  File:        protools/v89conv.w

  Description: Main procedure for the V8 to V9 SmartObject conversion
               utility/

  Input Parameters:
      <none>

  Output Parameters:
      <none>

  Author:     D. Ross Hunter

  Created:    March 1, 1998

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

{protools/ptlshlp.i}  /* help definitions        */
{adecomm/_adetool.i}  /* Register as an ADE tool */
{protools/_runonce.i} /* allow one instance      */

/* Parameters Definitions ---                                           */

/* Local Variable Definitions ---                                       */
{adecomm/dirsrch.i}
{adecomm/cbvar.i}
DEFINE VARIABLE forget-sw   AS LOGICAL                 NO-UNDO.
DEFINE VARIABLE list-mem    AS MEMPTR                  NO-UNDO.
DEFINE VARIABLE list-size   AS INTEGER   INITIAL 20000 NO-UNDO.
DEFINE VARIABLE missed-file AS INTEGER                 NO-UNDO.
DEFINE VARIABLE name-seq    AS INTEGER                 NO-UNDO.
DEFINE VARIABLE DirError    AS INTEGER                 NO-UNDO.
DEFINE VARIABLE FileSize    AS INTEGER                 NO-UNDO.
DEFINE VARIABLE CurFilter   AS CHARACTER               NO-UNDO.
DEFINE VARIABLE error       AS INTEGER                 NO-UNDO.
DEFINE VARIABLE ThisMessage AS CHARACTER               NO-UNDO.

DEFINE VARIABLE abort-conv  AS LOGICAL                 NO-UNDO.
DEFINE VARIABLE sort-mode   AS INTEGER   INITIAL 2     NO-UNDO.

DEFINE NEW SHARED TEMP-TABLE name-switch
  FIELD forget   AS LOGICAL
  FIELD seq      AS INTEGER
  FIELD old-name AS CHARACTER
  FIELD new-name AS CHARACTER
  INDEX forget-seq IS PRIMARY UNIQUE forget seq.

DEFINE NEW SHARED TEMP-TABLE method
  FIELD v8method AS CHARACTER
  FIELD v9method AS CHARACTER
  FIELD mType    AS CHARACTER
  FIELD params   AS CHARACTER
  INDEX v8method IS PRIMARY UNIQUE v8method.

DEFINE NEW SHARED TEMP-TABLE prprty
  FIELD v8prop   AS CHARACTER
  FIELD v9prop   AS CHARACTER
  INDEX v8prop IS PRIMARY UNIQUE v8prop.

DEFINE STREAM log-file.

/* _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 DEFAULT-FRAME
&Scoped-define BROWSE-NAME BROWSE-1

/* Internal Tables (found by Frame, Query & Browse Queries)             */
&Scoped-define INTERNAL-TABLES Procedure

/* Definitions for BROWSE BROWSE-1                                      */
&Scoped-define FIELDS-IN-QUERY-BROWSE-1 Procedure.Stts Procedure.Name 
&Scoped-define ENABLED-FIELDS-IN-QUERY-BROWSE-1 
&Scoped-define OPEN-QUERY-BROWSE-1 OPEN QUERY BROWSE-1 FOR EACH Procedure NO-LOCK.
&Scoped-define TABLES-IN-QUERY-BROWSE-1 Procedure
&Scoped-define FIRST-TABLE-IN-QUERY-BROWSE-1 Procedure


/* Definitions for FRAME DEFAULT-FRAME                                  */
&Scoped-define OPEN-BROWSERS-IN-QUERY-DEFAULT-FRAME ~
    ~{&OPEN-QUERY-BROWSE-1}

/* Standard List Definitions                                            */
&Scoped-Define ENABLED-OBJECTS RECT-1 RECT-2 RECT-4 RECT-5 Directory ~
btn_browse tog_subdir file-filter filter-btn tog_compile Btn-rebuild ~
BROWSE-1 Btn_Sort Btn_Add Btn_Remove Btn_Convert Btn_Abort Btn_Exit ~
Btn_Help 
&Scoped-Define DISPLAYED-OBJECTS Directory tog_subdir file-filter ~
tog_compile 

/* 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 V89conv AS WIDGET-HANDLE NO-UNDO.

/* Definitions of the field level widgets                               */
DEFINE BUTTON Btn-rebuild 
     LABEL "Build File &List" 
     SIZE 24 BY 1.14.

DEFINE BUTTON Btn_Abort AUTO-GO 
     LABEL "&Abort Conversions" 
     SIZE 25 BY 1.14
     BGCOLOR 8 .

DEFINE BUTTON Btn_Add AUTO-GO 
     LABEL "Add a &File..." 
     SIZE 15 BY 1.14
     BGCOLOR 8 .

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

DEFINE BUTTON Btn_Convert AUTO-GO 
     LABEL "Start &Conversions" 
     SIZE 25 BY 1.14
     BGCOLOR 8 .

DEFINE BUTTON Btn_Exit AUTO-GO DEFAULT 
     LABEL "&Exit" 
     SIZE 15 BY 1.14
     BGCOLOR 8 .

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

DEFINE BUTTON Btn_Remove AUTO-GO 
     LABEL "&Remove" 
     SIZE 15 BY 1.14
     BGCOLOR 8 .

DEFINE BUTTON Btn_Sort AUTO-GO 
     LABEL "&Sort ..." 
     SIZE 15 BY 1.14
     BGCOLOR 8 .

DEFINE BUTTON filter-btn 
     IMAGE-UP FILE "adeicon\cbbtn":U
     LABEL "F" 
     SIZE 4 BY 1.

DEFINE VARIABLE Directory AS CHARACTER FORMAT "X(256)":U INITIAL "." 
     VIEW-AS FILL-IN 
     SIZE 44 BY 1.19 NO-UNDO.

DEFINE VARIABLE file-filter AS CHARACTER FORMAT "X(256)":U 
     LABEL "Fi&lter" 
     VIEW-AS FILL-IN 
     SIZE 15 BY 1 NO-UNDO.

DEFINE RECTANGLE RECT-1
     EDGE-PIXELS 2 GRAPHIC-EDGE  NO-FILL 
     SIZE .2 BY 5.

DEFINE RECTANGLE RECT-2
     EDGE-PIXELS 2 GRAPHIC-EDGE  NO-FILL 
     SIZE 63 BY 4.76.

DEFINE RECTANGLE RECT-4
     EDGE-PIXELS 2 GRAPHIC-EDGE  NO-FILL 
     SIZE 82 BY 12.81.

DEFINE RECTANGLE RECT-5
     EDGE-PIXELS 2 GRAPHIC-EDGE  NO-FILL 
     SIZE 82 BY .1.

DEFINE VARIABLE filter-list AS CHARACTER 
     VIEW-AS SELECTION-LIST SINGLE SCROLLBAR-VERTICAL 
     LIST-ITEMS "*.w,*.p,*.i","*.w","*.p","*.i","*.*" 
     SIZE 19 BY 3.57 NO-UNDO.

DEFINE VARIABLE tog_compile AS LOGICAL INITIAL yes 
     LABEL "Co&mpile after Conversion" 
     VIEW-AS TOGGLE-BOX
     SIZE 29 BY .81 NO-UNDO.

DEFINE VARIABLE tog_subdir AS LOGICAL INITIAL yes 
     LABEL "&Include Subdirectories" 
     VIEW-AS TOGGLE-BOX
     SIZE 26 BY .81 NO-UNDO.

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

DEFINE VARIABLE srch-lbl AS CHARACTER FORMAT "X(256)":U INITIAL "Searching:" 
      VIEW-AS TEXT 
     SIZE 19 BY .62 NO-UNDO.

DEFINE RECTANGLE RECT-6
     EDGE-PIXELS 2 GRAPHIC-EDGE  NO-FILL 
     SIZE 53.4 BY 5.57.

/* Query definitions                                                    */
&ANALYZE-SUSPEND
DEFINE QUERY BROWSE-1 FOR 
      Procedure SCROLLING.
&ANALYZE-RESUME

/* Browse definitions                                                   */
DEFINE BROWSE BROWSE-1
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _DISPLAY-FIELDS BROWSE-1 V89conv _STRUCTURED
  QUERY BROWSE-1 DISPLAY
      Procedure.Stts FORMAT "X(12)"
      Procedure.Name FORMAT "X(44)"
/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME
    WITH NO-ROW-MARKERS SEPARATORS MULTIPLE SIZE 62 BY 9 EXPANDABLE.


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

DEFINE FRAME DEFAULT-FRAME
     Directory AT ROW 2.19 COL 4 COLON-ALIGNED NO-LABEL
     btn_browse AT ROW 2.19 COL 50
     tog_subdir AT ROW 3.86 COL 6
     file-filter AT ROW 3.86 COL 44 COLON-ALIGNED
     filter-btn AT ROW 3.86 COL 62
     tog_compile AT ROW 5.05 COL 6
     Btn-rebuild AT ROW 5.05 COL 41
     BROWSE-1 AT ROW 8.38 COL 6
     Btn_Sort AT ROW 10.05 COL 69.6
     Btn_Add AT ROW 11.48 COL 69.6
     Btn_Remove AT ROW 12.91 COL 69.6
     Btn_Convert AT ROW 18.14 COL 18
     Btn_Abort AT ROW 18.14 COL 47
     Btn_Exit AT ROW 1.71 COL 72
     Btn_Help AT ROW 3.14 COL 72
     filter-list AT ROW 4.81 COL 46 NO-LABEL
     RECT-1 AT ROW 1.48 COL 69
     RECT-2 AT ROW 1.71 COL 4
     RECT-4 AT ROW 7.19 COL 4
     RECT-5 AT ROW 6.71 COL 4
     "  Directory:" VIEW-AS TEXT
          SIZE 12 BY .62 AT ROW 1.24 COL 5
     "Files to Convert:" VIEW-AS TEXT
          SIZE 15 BY .62 AT ROW 7.67 COL 6
    WITH 1 DOWN NO-BOX KEEP-TAB-ORDER OVERLAY 
         SIDE-LABELS NO-UNDERLINE THREE-D 
         AT COL 1 ROW 1
         SIZE 87 BY 19.38
         DEFAULT-BUTTON Btn_Exit.

DEFINE FRAME FRAME-A
     srch-lbl AT ROW 2.91 COL 7 COLON-ALIGNED NO-LABEL
     srch-dir AT ROW 3.86 COL 7 COLON-ALIGNED NO-LABEL
     RECT-6 AT ROW 1.14 COL 1.6
    WITH 1 DOWN KEEP-TAB-ORDER OVERLAY 
         SIDE-LABELS NO-UNDERLINE THREE-D 
         AT COL 8 ROW 10
         SIZE 55 BY 6
         BGCOLOR 4 FGCOLOR 15 .


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

&ANALYZE-SUSPEND _PROCEDURE-SETTINGS
/* Settings for THIS-PROCEDURE
   Type: Window
   Allow: Basic,Browse,DB-Fields,Window,Query
   Other Settings: COMPILE
   Temp-Tables and Buffers:
      TABLE: ? T "?" NO-UNDO files Procedure
   END-TABLES.
 */
&ANALYZE-RESUME _END-PROCEDURE-SETTINGS

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

&ANALYZE-SUSPEND _CREATE-WINDOW
IF SESSION:DISPLAY-TYPE = "GUI":U THEN
  CREATE WINDOW V89conv ASSIGN
         HIDDEN             = YES
         TITLE              = "ADM1 to ADM2 SmartObject Conversion Utility"
         HEIGHT             = 19.38
         WIDTH              = 87
         MAX-HEIGHT         = 19.38
         MAX-WIDTH          = 87
         VIRTUAL-HEIGHT     = 19.38
         VIRTUAL-WIDTH      = 87
         RESIZE             = yes
         SCROLL-BARS        = no
         STATUS-AREA        = no
         BGCOLOR            = ?
         FGCOLOR            = ?
         KEEP-FRAME-Z-ORDER = yes
         THREE-D            = yes
         MESSAGE-AREA       = no
         MAX-BUTTON         = NO
         SENSITIVE          = yes.
ELSE {&WINDOW-NAME} = CURRENT-WINDOW.

&IF '{&WINDOW-SYSTEM}' NE 'TTY' &THEN
IF NOT V89conv:LOAD-ICON("adeicon\smoupgrd":U) THEN
    MESSAGE "Unable to load icon: adeicon\smoupgrd"
            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 V89conv
  VISIBLE,,RUN-PERSISTENT                                               */
/* REPARENT FRAME */
ASSIGN FRAME FRAME-A:FRAME = FRAME DEFAULT-FRAME:HANDLE.

/* SETTINGS FOR FRAME DEFAULT-FRAME
   Custom                                                               */

DEFINE VARIABLE XXTABVALXX AS LOGICAL NO-UNDO.

ASSIGN XXTABVALXX = FRAME FRAME-A:MOVE-BEFORE-TAB-ITEM (Directory:HANDLE IN FRAME DEFAULT-FRAME)
/* END-ASSIGN-TABS */.

/* BROWSE-TAB BROWSE-1 Btn-rebuild DEFAULT-FRAME */
/* SETTINGS FOR SELECTION-LIST filter-list IN FRAME DEFAULT-FRAME
   NO-DISPLAY NO-ENABLE                                                 */
ASSIGN 
       filter-list:HIDDEN IN FRAME DEFAULT-FRAME           = TRUE.

/* SETTINGS FOR FRAME FRAME-A
   NOT-VISIBLE                                                          */
ASSIGN 
       FRAME FRAME-A:HIDDEN           = TRUE.

IF SESSION:DISPLAY-TYPE = "GUI":U AND VALID-HANDLE(V89conv)
THEN V89conv:HIDDEN = no.

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


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

&ANALYZE-SUSPEND _QUERY-BLOCK BROWSE BROWSE-1
/* Query rebuild information for BROWSE BROWSE-1
     _TblList          = "Temp-Tables.Procedure"
     _FldNameList[1]   > Temp-Tables.Procedure.Stts
"Procedure.Stts" ? "X(12)" "character" ? ? ? ? ? ? no ? no no ?
     _FldNameList[2]   > Temp-Tables.Procedure.Name
"Procedure.Name" ? "X(44)" "character" ? ? ? ? ? ? no ? no no ?
     _Query            is OPENED
*/  /* BROWSE BROWSE-1 */
&ANALYZE-RESUME

 



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

&Scoped-define SELF-NAME V89conv
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL V89conv V89conv
ON END-ERROR OF V89conv /* Version 8 to Version 9 SmartObject Conversion Utility */
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 THIS-PROCEDURE:PERSISTENT THEN RETURN NO-APPLY.
END.

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


&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL V89conv V89conv
ON WINDOW-CLOSE OF V89conv /* Version 8 to Version 9 SmartObject Conversion Utility */
DO:
  /* This event will close the window and terminate the procedure.  */
  APPLY "CLOSE":U TO THIS-PROCEDURE.
  RETURN NO-APPLY.
END.

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


&Scoped-define SELF-NAME Btn-rebuild
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL Btn-rebuild V89conv
ON CHOOSE OF Btn-rebuild IN FRAME DEFAULT-FRAME /* Build File List */
DO:
  DEFINE VARIABLE ErrorStatus AS LOGICAL                         NO-UNDO.
  DEFINE VARIABLE i           AS INTEGER                         NO-UNDO.
  DEFINE VARIABLE tmpflnm     AS CHARACTER                       NO-UNDO.

  DO WITH FRAME {&FRAME-NAME}:
    RUN adecomm/_setcurs.p ("WAIT":U).

    /* Clear out the old stuff */
    FOR EACH Procedure:
      DELETE Procedure.
    END.
    
    ASSIGN Directory
           FILE-INFO:filename = RIGHT-TRIM(Directory,"~\,~/")
           Directory          = FILE-INFO:FULL-PATHNAME
           tog_subdir         = tog_subdir:CHECKED
           CurFilter          = file-filter:SCREEN-VALUE.

    RUN process_subdirectories(Directory, Directory, CurFilter).

    HIDE FRAME FRAME-A.
    SELF:LABEL = "Rebuild File &List":U.
    RUN open-browse.
    RUN adecomm/_setcurs.p ("":U).

    IF NUM-RESULTS("{&BROWSE-NAME}") = 0 THEN DO:
      ThisMessage =  "No files were found that matched your criteria. " +
                     "Try changing the file type filters.".
      RUN adecomm/_s-alert.p (INPUT-OUTPUT ErrorStatus, "w":U,"ok":U, ThisMessage).
      RETURN "False":U.
    END.  /* IF no files were found */
    
  END. /* DO WITH FRAME {&FRAME-NAME} */
END.

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


&Scoped-define SELF-NAME Btn_Abort
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL Btn_Abort V89conv
ON CHOOSE OF Btn_Abort IN FRAME DEFAULT-FRAME /* Abort Conversions */
DO:
  abort-conv = TRUE.
END.

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


&Scoped-define SELF-NAME Btn_Add
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL Btn_Add V89conv
ON CHOOSE OF Btn_Add IN FRAME DEFAULT-FRAME /* Add a File... */
DO:
  DEFINE VARIABLE Filter_NameString AS CHARACTER EXTENT 5      NO-UNDO.
  DEFINE VARIABLE Filter_FileSpec   AS CHARACTER EXTENT 5      NO-UNDO.
  DEFINE VARIABLE File_Ext          AS CHARACTER               NO-UNDO.
  DEFINE VARIABLE FileName          AS CHARACTER               NO-UNDO.
  DEFINE VARIABLE NewRecid          AS RECID                   NO-UNDO.
  DEFINE VARIABLE NumEntries        AS INTEGER                 NO-UNDO.
  DEFINE VARIABLE p_ok              AS LOGICAL                 NO-UNDO.

  ASSIGN Directory
         FILE-INFO:filename = RIGHT-TRIM(Directory,"~\,~/")
         Directory          = FILE-INFO:FULL-PATHNAME
         Filter_NameString[ 1 ] = "All Source(*.w~;*.p~;*.i)"
         Filter_FileSpec[ 1 ]   = "*.w~;*.p~;*.i"
         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 ] = "All Files(*.*)"
         Filter_FileSpec[ 5 ]   = "*.*".
         
  SYSTEM-DIALOG GET-FILE filename
     TITLE    "Add File Dialog" 
     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 ]             
     MUST-EXIST
     UPDATE   p_ok IN WINDOW CURRENT-WINDOW.
  IF p_ok <> TRUE THEN RETURN.

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

  IF FileName BEGINS Directory THEN
    FileName = SUBSTRING(FileName, LENGTH(Directory, "CHARACTER":U) + 2).   
  ASSIGN FILE-INFO:FILE-NAME = FileName.
  IF FILE-INFO:FILE-TYPE = "FRW":U THEN DO:
    /* Don't allow .r's even if user asks for them */
    IF (NOT FileName MATCHES "*~~.r":U) THEN DO:
      CREATE Procedure.
      ASSIGN Procedure.name      = FileName
             NumEntries          = NUM-ENTRIES(FileName,".":U)
             Procedure.extension = IF NumEntries < 2 THEN ""
                                   ELSE ENTRY(NumEntries, FileName, ".":U)
             NewRecid            = RECID(Procedure).
      {&BROWSE-NAME}:SET-REPOSITIONED-ROW(5,"CONDITIONAL").
      RUN open-browse.
      REPOSITION {&BROWSE-NAME} TO RECID NewRecid.
    END.  /* IF not a .r */
  END.  /* IF a file */
  RUN adecomm/_setcurs.p ("":U).
END.

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


&Scoped-define SELF-NAME btn_browse
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL btn_browse V89conv
ON CHOOSE OF btn_browse IN FRAME DEFAULT-FRAME /* Browse... */
DO:
  DO WITH FRAME {&FRAME-NAME}.
    ASSIGN directory.
    RUN adeshar/_seldir.w (INPUT-OUTPUT directory).
    DISPLAY directory.
  END.
END.

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


&Scoped-define SELF-NAME Btn_Convert
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL Btn_Convert V89conv
ON CHOOSE OF Btn_Convert IN FRAME DEFAULT-FRAME /* Start Conversions */
DO:
  DEFINE VARIABLE Changes-made AS INTEGER                        NO-UNDO.
  DEFINE VARIABLE ConvRecid    AS RECID                          NO-UNDO.
  DEFINE VARIABLE dir-dirs     AS INTEGER                        NO-UNDO.
  DEFINE VARIABLE err-num      AS INTEGER                        NO-UNDO.
  DEFINE VARIABLE i            AS INTEGER                        NO-UNDO.
  DEFINE VARIABLE new-path     AS CHARACTER                      NO-UNDO.
  DEFINE VARIABLE old-path     AS CHARACTER                      NO-UNDO.
  DEFINE VARIABLE rel-name     AS CHARACTER                      NO-UNDO.
  DEFINE VARIABLE tmpDir       AS CHARACTER                      NO-UNDO.
  DEFINE VARIABLE tmpFile      AS CHARACTER                      NO-UNDO.
  DEFINE VARIABLE tmpflnm      AS CHARACTER                      NO-UNDO.
  DEFINE VARIABLE tmpfl-dirs   AS INTEGER                        NO-UNDO.
  DEFINE VARIABLE tst-line     AS CHARACTER                      NO-UNDO.

  DISABLE ALL EXCEPT Btn_abort filter-list WITH FRAME {&FRAME-NAME}.
  
  OUTPUT STREAM log-file TO "V89Conv.log".
  PUT STREAM log-file UNFORMATTED SKIP (2)
      "Converting V8 SmartObjects to V9" FILL(" ",20) TODAY " " +
      STRING(TIME,"HH:MM:SS") SKIP (1).

  DO WITH FRAME {&FRAME-NAME}:
    ASSIGN Directory
           FILE-INFO:filename = RIGHT-TRIM(Directory,"~\,~/")
           Directory          = FILE-INFO:FULL-PATHNAME
           tog_compile.

    RUN open-browse.
    GET FIRST {&BROWSE-NAME}.
    IF NOT AVAILABLE Procedure THEN DO:
      MESSAGE "The file list is empty." SKIP
              "No conversions have been done." VIEW-AS ALERT-BOX INFORMATION.
      ENABLE ALL WITH FRAME {&FRAME-NAME}.
      PUT STREAM log-file UNFORMATTED
        "The file list is empty." SKIP
         "No conversions have been done.".
      OUTPUT STREAM log-file CLOSE.
      RETURN.
    END.
    {&BROWSE-NAME}:SET-REPOSITIONED-ROW(2,"CONDITIONAL").
    {&BROWSE-NAME}:SELECT-ROW(1).
    OS-CREATE-DIR VALUE(Directory + "~\V8-ADM").
    
    /* old-path is the last directory created */
    ASSIGN old-path   = Directory + "~\V8-ADM"
           abort-conv = FALSE.

    CONVERSION-LOOP:
    REPEAT WHILE AVAILABLE Procedure:
  
      ASSIGN Procedure.Stts = "..."
             ConvRecid      = RECID(Procedure).

      DISPLAY Procedure.Stts Procedure.Name WITH BROWSE {&BROWSE-NAME}.
      PROCESS EVENTS.
      
      IF abort-conv THEN DO:
        MESSAGE "Conversion is aborting." SKIP
                "Check V89Conv.log for status."  VIEW-AS ALERT-BOX INFORMATION.
        ENABLE ALL WITH FRAME {&FRAME-NAME}.
        PUT STREAM log-file UNFORMATTED
           "Conversion is aborting." SKIP.
        OUTPUT STREAM log-file CLOSE.
        RETURN.
      END.
      
      /* See if the procedure is some where below the directory:
            For example: the directory might be C:\work\area but 
                         the procedure might be C:\test\myfile.w
         This can easily happen if the user pressed the "Add a File" button. */
      IF SUBSTRING(Procedure.Name,2,1) = ":" THEN DO:
        /* Here the user has choosen a file not in the directory specified. */
        ASSIGN i       = R-INDEX(Procedure.Name,"~\")
               tmpDir  = SUBSTRING(Procedure.Name,1 , i - 1, "CHARACTER":U)
               tmpFile = SUBSTRING(Procedure.Name,i + 1).
        /* Create V8-ADM subdirectory */
        OS-CREATE-DIR VALUE(tmpDir + "~\V8-ADM").
      END.
      ELSE ASSIGN tmpDir  = directory
                  tmpFile = Procedure.Name.

      /* Look for a null (or trivially small) file */
      FILE-INFO:FILE-NAME = SEARCH(tmpDir + "~\" + tmpFile).
      IF FILE-INFO:FILE-SIZE < 10 THEN DO:
        PUT STREAM log-file UNFORMATTED SKIP(1)
           "Procedure " + procedure.name + " is an invalid SmartObject." + CHR(10) +
           "No processing will occur." + CHR(10).
        Procedure.Stts = "Not Conv".      
      END.
      
      ELSE DO: /* Have a procedure to convert - First check to see if it is a V8 .w */
        INPUT FROM VALUE(SEARCH(tmpDir + "~\" + tmpFile)) NO-ECHO.
        IMPORT UNFORMATTED tst-line.
        INPUT CLOSE.
        IF INDEX(tst-line,"AB_v9") > 0 THEN DO:
          PUT STREAM log-file UNFORMATTED SKIP(1)
             "Procedure " + procedure.name + " is already converted." + CHR(10) +
             "No processing will occur." + CHR(10).
          Procedure.Stts = "V9".
        END.
      END.  /* Else look for a V9 file */
      
      IF Procedure.Stts NE "..." THEN DO:
        DISPLAY Procedure.stts WITH BROWSE {&BROWSE-NAME}.
        PROCESS EVENTS.
        GET NEXT {&BROWSE-NAME}.
        IF NOT AVAILABLE Procedure THEN LEAVE CONVERSION-LOOP.
        {&BROWSE-NAME}:SELECT-NEXT-ROW().
        NEXT CONVERSION-LOOP.
      END.  /* If the procedure is already V9 */
 
      /* Have a procedure to convert - Copy it to sub-tree */
      tmpflnm = tmpDir + "~\V8-ADM~\" +
                IF INDEX(tmpFile,":~\") = 2 THEN
                        ENTRY(1,tmpFile,":") + SUBSTRING(tmpFile,3)
                ELSE tmpFile.
                
      IF INDEX(tmpFile,"~\") > 0 THEN DO:  /* Need to create a Directory */
        ASSIGN tmpfl-dirs = NUM-ENTRIES(tmpflnm,"~\") - 1
                            /* (-1) because we don't count the filename */
               dir-dirs   = NUM-ENTRIES(tmpDir,"~\") + 1
                            /* (+1) because we do count V8-ADM */
               new-path   = SUBSTRING(tmpflnm,1,R-INDEX(tmpflnm,"~\") - 1,"CHARACTER").
        IF old-path NE new-path THEN DO:  /* Not the same as the last one created */
          new-path = tmpDir + "~\V8-ADM".  /* Initialize at V8-ADM and work out */
          DO i = dir-dirs + 1 TO tmpfl-dirs:
            new-path = new-path + "~\" + ENTRY(i,tmpflnm,"~\").
            IF NOT old-path BEGINS new-path THEN DO:
               OS-CREATE-DIR VALUE(new-path).
               old-path = new-path.
            END. /* If the last path doesn't already contain the new path */
          END. /* DO i = num dirs in tmpDir + V8-ADM to tmpfl-dirs */
        END. /* If not yet created */
      END. /* If the procedure.name has a back-slash in it */

      PUT STREAM log-file UNFORMATTED SKIP (1)
           "Copying " + Procedure.Name + " to " tmpflnm + "."
           FORMAT "X(75)" SKIP.

      RUN adecomm/_relname.p (tmpDir + "~\" + tmpFile, "MUST-EXIST",
                              OUTPUT rel-name).
       
      OS-COPY VALUE(SEARCH(rel-name)) VALUE(tmpflnm).
      /* Convert here */
      PUT STREAM log-file UNFORMATTED
           "Converting " + Procedure.Name + "."
           FORMAT "X(75)" SKIP.
      RUN protools/_convt89.p (INPUT tmpflnm,
                               INPUT rel-name,
                               OUTPUT changes-made).
      PUT STREAM log-file UNFORMATTED
                 "    " + STRING(changes-made) + 
                 (IF changes-made eq 1 THEN " change made." ELSE " changes made.")
           FORMAT "X(75)" SKIP.

      Procedure.Stts = IF changes-made = 0 THEN "No-change" ELSE
                       STRING(changes-made) +
                       (IF changes-made eq 1 THEN " Change" ELSE " Changes").
                       
      IF changes-made > 0 AND tog_compile:CHECKED THEN DO:
        PUT STREAM log-file UNFORMATTED
             "Compiling " + Procedure.Name + "."
             FORMAT "X(75)" SKIP.
        COMPILE VALUE(Procedure.Name) SAVE NO-ERROR.
        IF COMPILER:ERROR THEN DO:
          Procedure.Stts = "Comp. Err.".
          PUT STREAM log-file UNFORMATTED
             "    " + Procedure.Name + " did not compile." FORMAT "X(75)" SKIP.
          DO err-num = 1 TO ERROR-STATUS:NUM-MESSAGES:
            IF err-num > 10 THEN LEAVE.
            PUT STREAM log-file
               "    " + ERROR-STATUS:GET-MESSAGE(err-num) FORMAT "X(77)" SKIP.
          END.
        END.  /* If a compiler error occurred */
        ELSE PUT STREAM log-file UNFORMATTED
                 "    0 Compiler errors." FORMAT "X(75)" SKIP.
      END.
      
      DISPLAY Procedure.Stts Procedure.Name WITH BROWSE {&BROWSE-NAME}.

      GET NEXT {&BROWSE-NAME}.
      IF NOT AVAILABLE Procedure THEN LEAVE CONVERSION-LOOP.
      {&BROWSE-NAME}:SELECT-NEXT-ROW().
    END.  /* Repeat while available Procedure */

  END.  /* Do With Frame */
  BELL.
  ENABLE ALL EXCEPT filter-list WITH FRAME {&FRAME-NAME}.
  OUTPUT STREAM log-file CLOSE.
END.

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


&Scoped-define SELF-NAME Btn_Exit
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL Btn_Exit V89conv
ON CHOOSE OF Btn_Exit IN FRAME DEFAULT-FRAME /* Exit */
DO:
  APPLY "WINDOW-CLOSE" TO {&WINDOW-NAME}.
END.

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


&Scoped-define SELF-NAME Btn_Help
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL Btn_Help V89conv
ON CHOOSE OF Btn_Help IN FRAME DEFAULT-FRAME /* Help */
OR HELP OF FRAME {&FRAME-NAME}
DO: /* Call Help Function (or a simple message). */
  RUN adecomm/_adehelp.p ( "ptls", "CONTEXT":U, {&SmartObject_Upgrade_Utility_v9},?).
END.

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


&Scoped-define SELF-NAME Btn_Remove
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL Btn_Remove V89conv
ON CHOOSE OF Btn_Remove IN FRAME DEFAULT-FRAME /* Remove */
DO:
  DEFINE VARIABLE i       AS INTEGER     NO-UNDO.
  DEFINE VARIABLE num-sel AS INTEGER     NO-UNDO.
  
  IF {&BROWSE-NAME}:NUM-SELECTED-ROWS < 1 THEN DO:
    MESSAGE "No procedures are selected." SKIP
            " Nothing has been deleted." VIEW-AS ALERT-BOX WARNING.
    RETURN NO-APPLY.
  END.
  ELSE DO:
    num-sel = {&BROWSE-NAME}:NUM-SELECTED-ROWS.
    DO i = num-sel to 1 BY -1:
      {&BROWSE-NAME}:FETCH-SELECTED-ROW(i).
      DELETE PROCEDURE.
    END.
    {&BROWSE-NAME}:DELETE-SELECTED-ROWS().
  END.  /* Else something was selected */
END.

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


&Scoped-define SELF-NAME Btn_Sort
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL Btn_Sort V89conv
ON CHOOSE OF Btn_Sort IN FRAME DEFAULT-FRAME /* Sort ... */
DO:
  DEFINE VARIABLE cur-sort AS INTEGER              NO-UNDO.
  cur-sort = sort-mode.
  RUN protools/sort-dia.w (INPUT-OUTPUT sort-mode).
  IF sort-mode NE cur-sort THEN RUN open-browse.
END.

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


&Scoped-define SELF-NAME Directory
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL Directory V89conv
ON RETURN OF Directory IN FRAME DEFAULT-FRAME
DO:
  APPLY "TAB".
  RETURN NO-APPLY.
END.

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


&Scoped-define BROWSE-NAME BROWSE-1
&UNDEFINE SELF-NAME

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


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

/* Set CURRENT-WINDOW: this will parent dialog-boxes and frames.        */
ASSIGN CURRENT-WINDOW                = {&WINDOW-NAME} 
       THIS-PROCEDURE:CURRENT-WINDOW = {&WINDOW-NAME}.

/* Set the combo box */
{adecomm/cbdropx.i &Frame  = "FRAME {&FRAME-NAME}"
                   &CBFill = "file-filter"
                   &CBList = "filter-list"
                   &CBBtn  = "filter-btn"
                   &CBInit = '"~*~.w"'}

/* 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:
  /* Load up the name-switch temp-table */
  INPUT FROM VALUE(SEARCH("protools/v89names.dat")).
  GEN-NAME-SWITCH-TABLE:
  REPEAT:
    name-seq = name-seq + 1.
    CREATE name-switch.
    ASSIGN name-switch.forget = forget-sw
           name-switch.seq    = name-seq.
    IMPORT name-switch.old-name name-switch.new-name.
    IF name-switch.old-name = "++" OR name-switch.old-name = " " THEN DO:
      IF name-switch.new-name = "Old" THEN forget-sw = FALSE.
      ELSE IF name-switch.new-name = "Remove" THEN forget-sw = TRUE.
      IF name-switch.new-name = "Method" THEN
        UNDO GEN-NAME-SWITCH-TABLE, LEAVE GEN-NAME-SWITCH-TABLE.
      DELETE name-switch.
    END.  /* IF old-name = "++" */
  END.  /* GEN-NAME-SWITCH-TABLE: REPEAT */

  GEN-METHOD-TABLE:
  REPEAT:
    CREATE method.
    IMPORT method.v8method method.v9method method.mType method.params.
    IF method.v8method = " " OR method.v8method = "++" THEN
      UNDO GEN-METHOD-TABLE, LEAVE GEN-METHOD-TABLE.
  END.  /* GEN-METHOD-TABLE */

  GEN-PRPRTY-TABLE:
  REPEAT:
    CREATE prprty.
    IMPORT prprty.v8prop prprty.v9prop.
    IF prprty.v8prop = " " OR prprty.v8prop = "++" THEN
      UNDO GEN-PRPRTY-TABLE, LEAVE GEN-PRPRTY-TABLE.
  END.  /* GEN-PRPRTY-TABLE */

  INPUT CLOSE.

  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 disable_UI V89conv  _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(V89conv)
  THEN DELETE WIDGET V89conv.
  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 V89conv  _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 Directory tog_subdir file-filter tog_compile 
      WITH FRAME DEFAULT-FRAME IN WINDOW V89conv.
  ENABLE RECT-1 RECT-2 RECT-4 RECT-5 Directory btn_browse tog_subdir 
         file-filter filter-btn tog_compile Btn-rebuild BROWSE-1 Btn_Sort 
         Btn_Add Btn_Remove Btn_Convert Btn_Abort Btn_Exit Btn_Help 
      WITH FRAME DEFAULT-FRAME IN WINDOW V89conv.
  {&OPEN-BROWSERS-IN-QUERY-DEFAULT-FRAME}
  DISPLAY srch-lbl srch-dir 
      WITH FRAME FRAME-A IN WINDOW V89conv.
  ENABLE RECT-6 srch-lbl srch-dir 
      WITH FRAME FRAME-A IN WINDOW V89conv.
  {&OPEN-BROWSERS-IN-QUERY-FRAME-A}
  VIEW V89conv.
END PROCEDURE.

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

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE open-browse V89conv 
PROCEDURE open-browse :
/*------------------------------------------------------------------------------
  Purpose:     
  Parameters:  <none>
  Notes:       
------------------------------------------------------------------------------*/
  CASE sort-mode:
    WHEN 1 THEN
      OPEN QUERY BROWSE-1 FOR EACH Procedure
                                BY Procedure.Stts
                                BY Procedure.Name.
    WHEN 2 THEN
      OPEN QUERY BROWSE-1 FOR EACH Procedure.
    WHEN 3 THEN
      OPEN QUERY BROWSE-1 FOR EACH Procedure
                                BY Procedure.Extension.
  END CASE.
END PROCEDURE.

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

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE process_subdirectories V89conv 
PROCEDURE process_subdirectories :
/*------------------------------------------------------------------------------
  Purpose:     
  Parameters:  <none>
  Notes:       
------------------------------------------------------------------------------*/
  DEFINE INPUT PARAMETER Org-Dir   AS CHARACTER                        NO-UNDO.
  DEFINE INPUT PARAMETER Directory AS CHARACTER                        NO-UNDO.
  DEFINE INPUT PARAMETER CurFilter AS CHARACTER                        NO-UNDO.
  
  DEFINE VARIABLE ErrorStatus      AS LOGICAL                          NO-UNDO.
  DEFINE VARIABLE i                AS INTEGER                          NO-UNDO.
  DEFINE VARIABLE newlist          AS CHARACTER                        NO-UNDO.
  DEFINE VARIABLE NumEntries       AS INTEGER                          NO-UNDO.
  DEFINE VARIABLE tmpflnm          AS CHARACTER                        NO-UNDO.

  ASSIGN SET-SIZE(list-mem) = list-size
         FILE-INFO:filename = Directory
         Directory          = FILE-INFO:FULL-PATHNAME.
  
  /* Don't process the "save" directory tree */
  IF INDEX(Directory,"V8-ADM") > 0 AND INDEX(Directory,Org-DIR) > 0
    THEN RETURN.

  /* First process any subdirectories IF tog_subdir is TRUE */
  IF tog_subdir THEN DO:
    RUN file_search(
        Directory,
        "*.*",
        INPUT-OUTPUT list-mem,
        list-size,
        OUTPUT missed-file,
        OUTPUT DirError).

      IF DirError <> 0 THEN DO:
        RUN adecomm/_setcurs.p ("":U).
        ASSIGN SET-SIZE(list-mem) = 0
               ThisMessage        = "Error in directory search. ".
        RUN adecomm/_s-alert.p (INPUT-OUTPUT ErrorStatus, "w":U, "ok":U, ThisMessage).
        RETURN "False":U.
      END.

      IF missed-file > 0 THEN DO:
        ThisMessage = "Too many files in your directory. " +
                      "The file list may not be inclusive.".
        RUN adecomm/_s-alert.p (INPUT-OUTPUT ErrorStatus, "w":U, "ok":U, ThisMessage).
      END.

      ASSIGN NewList            = GET-STRING(list-mem,1)
             SET-SIZE(list-mem) = 0.

      DO i = 1 TO NUM-ENTRIES(NewList):
        tmpflnm = ENTRY(i,NewList).
        IF tmpflnm NE "." AND tmpflnm NE ".." THEN DO:
          ASSIGN tmpflnm             = Directory + "~\":U + tmpflnm
                 FILE-INFO:FILE-NAME = tmpflnm.
          IF FILE-INFO:FILE-TYPE = "DRW" THEN
            RUN process_subdirectories(Org-Dir, tmpflnm, CurFilter).
        END.  /* If not current directory and not upper directory */
      END. /* DO i = 1 to NUM-ENTRIES of NewList */
    END. /* If the user wants recusion */

    VIEW FRAME FRAME-A.
    RECT-6:MOVE-TO-BOTTOM().
    ASSIGN srch-lbl:SCREEN-VALUE IN FRAME FRAME-A = "Searching:"
           srch-dir:SCREEN-VALUE IN FRAME FRAME-A = Directory.

    /* Now process files in this directory - recall file_search with proper filter */
    ASSIGN SET-SIZE(list-mem) = list-size.
    RUN file_search(
        Directory,
        CurFilter,
        INPUT-OUTPUT list-mem,
        list-size,
        OUTPUT missed-file,
        OUTPUT DirError).
    
    IF DirError <> 0 THEN DO:
      RUN adecomm/_setcurs.p ("":U).
      ASSIGN SET-SIZE(list-mem) = 0
             ThisMessage        = "Error in directory search. ".
      RUN adecomm/_s-alert.p (INPUT-OUTPUT ErrorStatus, "w":U, "ok":U, ThisMessage).
      RETURN "False":U.
    END.

    ASSIGN newlist            = GET-STRING(list-mem,1)
           SET-SIZE(list-mem) = 0.

    DO i = 1 TO NUM-ENTRIES(NewList):
      /* Don't allow directories 
       * Note that FILE-INFO can return ? for FILE-TYPE or FULL-PATHNAME
       * when there is no permission to access the file etc.
       * The ideal would have been to have file-type = F, but it screened
       * out valid files.                                                    */
      ASSIGN tmpflnm             = Directory + "~\":U + ENTRY(i,NewList)
             FILE-INFO:FILE-NAME = tmpflnm.
      IF FILE-INFO:FILE-TYPE = "FRW":U THEN DO:
        /* Don't allow .r's even if user asks for them */
        IF (NOT tmpflnm MATCHES "*~~.r":U) THEN DO:
          CREATE Procedure.
          ASSIGN Procedure.name      = SUBSTRING(tmpflnm,LENGTH(Org-Dir,"CHARACTER") + 2)
                 NumEntries          = NUM-ENTRIES(tmpflnm,".":U)
                 Procedure.extension = IF NumEntries < 2 THEN ""
                                       ELSE ENTRY(NumEntries, tmpflnm, ".":U).
        END.  /* IF not a .r */
      END.  /* IF a file */
    END. /* DO i = 1 to NUM-ENTRIES of list-char */

END PROCEDURE.

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

ÐÏà¡±á>þÿ	þÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿýÿÿÿþÿÿÿþÿÿÿþÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿRoot Entryÿÿÿÿÿÿÿÿ€©:é£®½€CtrlFrameÿÿÿÿÿÿÿÿà"9é£®½€©:é£®½FrameÿÿÿÿÿÿÿÿControl0ÿÿÿÿÿÿÿÿÿÿÿÿþÿÿÿþÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ	
G&{93330F00-7CA6-101B-874B-0020AF109266}
CSComboBox$4E93D971-7540-11b1-89a1-00C04FD4A836‰W,Ý
CSComboBox€€Rã‘ÎãªK¸QDBMS Sans Serifÿ€€	
CSComboBoxÿÿ
CSComboBoxÿÿÿÿ/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/
/*-----------------------------------------------------------------------------

  File: _wabout.w

  Description: call to Shell About

  Input Parameters:
      <none>

  Output Parameters:
      <none>

  Author: Gerry Seidl

  Modified on 01/15/96 by gfs - ported to WIN32
 *---------------------------------------------------------------------------*/
IF OPSYS EQ "WIN32" THEN
  RUN ShellAboutA (INPUT 0, 
                  INPUT "Windows Information#", 
                  INPUT "",
                  INPUT 0).

ELSE
  RUN ShellAbout (INPUT 0, 
                  INPUT "PRO*Tools", 
                  INPUT "",
                  INPUT 0).
        
/* WIN API entry points */
/* 32bit version */        
PROCEDURE ShellAboutA EXTERNAL "shell32.dll":
    DEFINE INPUT PARAMETER hWnd    AS LONG.
    DEFINE INPUT PARAMETER AppName AS CHAR.
    DEFINE INPUT PARAMETER AppInfo AS CHAR.  
    DEFINE INPUT PARAMETER hIcon   AS LONG.
END.
/* 16bit version */
PROCEDURE ShellAbout EXTERNAL "shell.exe":
    DEFINE INPUT PARAMETER hWnd    AS SHORT.
    DEFINE INPUT PARAMETER AppName AS CHAR.
    DEFINE INPUT PARAMETER AppInfo AS CHAR.  
    DEFINE INPUT PARAMETER hIcon   AS SHORT.
END.

&ANALYZE-SUSPEND _VERSION-NUMBER UIB_v8r12 GUI
&ANALYZE-RESUME
&Scoped-define WINDOW-NAME hWin
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _DEFINITIONS hWin 
/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/
/*----------------------------------------------------------------------

  File: _walker.w

  Description: 
      Walks all the widgets on the screen.

  Input Parameters:
      <none>
       
  Output Parameters:
      <none>

  Author: Wm. T. Wood, Gerry Seidl

  Created: Sept. 1994
  
  Modified:
    01/04/2001 (Tim Townsend) Changed to preserve physical row position
                              when repositioning.
  
------------------------------------------------------------------------*/
/*          This .W file was created with the Progress UIB.             */
/*----------------------------------------------------------------------*/

CREATE WIDGET-POOL.

/* ***************************  Definitions  ************************** */
{ protools/ptlshlp.i  } /* help definitions   */
{ adecomm/_adetool.i  } /* define as ADE tool */
{ protools/_runonce.i } /* allow one instance */

/* Parameters Definitions ---                                           */

/* Local Variable Definitions ---                                       */
DEFINE VAR show_levels AS INTEGER NO-UNDO. 
DEFINE VAR save_recid  AS RECID   NO-UNDO.
DEFINE VAR mode        AS CHAR    NO-UNDO INITIAL "NO-ADE".

/* Temp-Table/Browser Definitions ---                                   */
DEFINE TEMP-TABLE tt
  FIELD handle       AS HANDLE
  FIELD name         AS CHAR
  FIELD level        AS INTEGER  
  FIELD parent-recid AS RECID
  FIELD expanded     AS LOGICAL
  FIELD visible      AS LOGICAL      
  .
DEFINE BUFFER x_tt FOR tt.

DEFINE QUERY wlist FOR tt SCROLLING.

DEFINE BROWSE   wlist
       QUERY    wlist
       DISPLAY  FILL("     ",tt.level - 1) + 
                (IF NOT CAN-FIND (FIRST x_tt WHERE x_tt.parent-recid eq RECID(tt))
                 THEN "  "
                 ELSE (IF tt.expanded THEN "- " ELSE "+ " )) + 
                tt.name FORMAT "X(1024)"
       WITH SIZE 50 BY 14
            FONT 4
            &IF "{&WINDOW-SYSTEM}" NE "OSF/Motif" &THEN
                SEPARATORS
            &ENDIF
            NO-LABELS EXPANDABLE.      

&Scoped-define OPEN-QUERY-wlist OPEN QUERY wlist FOR EACH tt WHERE tt.level <= show_levels AND tt.visible.

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

/* Standard List Definitions                                            */
&Scoped-Define ENABLED-OBJECTS btn_expand btn_collapse btn_level-1 ~
btn_level-2 btn_level-3 btn_level-4 btn_level-5 btn_level-all levels 
&Scoped-Define DISPLAYED-OBJECTS levels 

/* 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_Exit         LABEL "E&xit"         .

DEFINE SUB-MENU m_View 
       MENU-ITEM m_User_Defined_Objects LABEL "&User Application Objects"
              TOGGLE-BOX
       MENU-ITEM m_All_Objects  LABEL "&All Objects"  
              TOGGLE-BOX
       RULE
       MENU-ITEM m_Refresh      LABEL "&Refresh"      .

DEFINE SUB-MENU m_Help 
       MENU-ITEM m_Master       LABEL "OpenEdge &Master Help"
       MENU-ITEM m_Contents     LABEL "PRO*Tools &Help Topics"
       MENU-ITEM m_Tool_Help    LABEL "&Control Hierarchy Help" ACCELERATOR "F1"
       RULE
       MENU-ITEM m_About        LABEL "&About Control Hierarchy".

DEFINE MENU MENU-BAR-hWin MENUBAR
       SUB-MENU  m_File         LABEL "&File"         
       SUB-MENU  m_View         LABEL "&View"         
       SUB-MENU  m_Help         LABEL "&Help"         .


/* Definitions of the field level widgets                               */
DEFINE BUTTON btn_collapse 
     LABEL "-":L 
     SIZE 4 BY 1.

DEFINE BUTTON btn_expand 
     LABEL "+":L 
     SIZE 4 BY 1.

DEFINE BUTTON btn_level-1 
     LABEL "1":L 
     SIZE 4 BY 1.

DEFINE BUTTON btn_level-2 
     LABEL "2":L 
     SIZE 4 BY 1.

DEFINE BUTTON btn_level-3 
     LABEL "3":L 
     SIZE 4 BY 1.

DEFINE BUTTON btn_level-4 
     LABEL "4":L 
     SIZE 4 BY 1.

DEFINE BUTTON btn_level-5 
     LABEL "5":L 
     SIZE 4 BY 1.

DEFINE BUTTON btn_level-all 
     LABEL "...":L 
     SIZE 4 BY 1.

DEFINE VARIABLE levels AS CHARACTER FORMAT "X(21)":U 
      VIEW-AS TEXT 
     SIZE 17 BY .95.


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

DEFINE FRAME f
     btn_expand AT ROW 1 COL 1
     btn_collapse AT ROW 1 COL 5
     btn_level-1 AT ROW 1 COL 27
     btn_level-2 AT ROW 1 COL 31
     btn_level-3 AT ROW 1 COL 35
     btn_level-4 AT ROW 1 COL 39
     btn_level-5 AT ROW 1 COL 43
     btn_level-all AT ROW 1 COL 47
     levels AT ROW 1.05 COL 8 COLON-ALIGNED NO-LABEL
    WITH 1 DOWN NO-BOX KEEP-TAB-ORDER OVERLAY 
         SIDE-LABELS NO-UNDERLINE THREE-D 
         AT COL 1 ROW 1
         SIZE 77.2 BY 19.43.


/* *********************** 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              = "Control Hierarchy"
         HEIGHT             = 19.43
         WIDTH              = 77.2
         MAX-HEIGHT         = 44.43
         MAX-WIDTH          = 256
         VIRTUAL-HEIGHT     = 44.43
         VIRTUAL-WIDTH      = 256
         RESIZE             = yes
         SCROLL-BARS        = no
         STATUS-AREA        = no
         BGCOLOR            = ?
         FGCOLOR            = ?
         THREE-D            = yes
         MESSAGE-AREA       = no
         SENSITIVE          = yes.
ELSE {&WINDOW-NAME} = CURRENT-WINDOW.

ASSIGN {&WINDOW-NAME}:MENUBAR    = MENU MENU-BAR-hWin:HANDLE.

&IF '{&WINDOW-SYSTEM}' NE 'TTY' &THEN
IF NOT hWin:LOAD-ICON("adeicon/cntrlhry":U) THEN
    MESSAGE "Unable to load icon: adeicon/cntrlhry"
            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 hWin
  VISIBLE,,RUN-PERSISTENT                                               */
/* SETTINGS FOR FRAME f
                                                                        */
IF SESSION:DISPLAY-TYPE = "GUI":U AND VALID-HANDLE(hWin)
THEN hWin:HIDDEN = no.

/* _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 /* Control Hierarchy */
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 ENTRY OF hWin /* Control Hierarchy */
DO:
  /* Reassign Current-window so dialog-boxes come up correctly */
  CURRENT-WINDOW = THIS-PROCEDURE:CURRENT-WINDOW.
END.

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


&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL hWin hWin
ON WINDOW-CLOSE OF hWin /* Control Hierarchy */
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-MAXIMIZED OF hWin /* Control Hierarchy */
DO:
  /* Make sure that the window's new size does not cover the taskbar */
  ASSIGN SELF:x = SESSION:WORK-AREA-X
         SELF:y = SESSION:WORK-AREA-Y
         SELF:HEIGHT-PIXELS = SESSION:WORK-AREA-HEIGHT-PIXELS
         SELF:WIDTH-PIXELS  = SESSION:WORK-AREA-WIDTH-PIXELS.
END.

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


&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL hWin hWin
ON WINDOW-RESIZED OF hWin /* Control Hierarchy */
DO:
  DEFINE VARIABLE hCol AS HANDLE NO-UNDO.
  
  /* Resize the frame and browse widget to the window */
  ASSIGN hCol                  = BROWSE wlist:FIRST-COLUMN
         FRAME f:HIDDEN        = TRUE
         FRAME f:WIDTH-P       = SELF:WIDTH-P
         FRAME f:HEIGHT-P      = SELF:HEIGHT-P
         BROWSE wlist:WIDTH-P  = FRAME f:WIDTH-P - 
           (FRAME F:BORDER-LEFT-P + FRAME F:BORDER-RIGHT-P)
         BROWSE wlist:HEIGHT-P = FRAME f:HEIGHT-P - 
           (FRAME F:BORDER-TOP-P + FRAME F:BORDER-BOTTOM-P) - btn_expand:HEIGHT-P
         hCol:WIDTH            = BROWSE wlist:WIDTH
         FRAME f:SCROLLABLE    = FALSE
         FRAME f:HIDDEN        = FALSE NO-ERROR.
END.

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


&Scoped-define SELF-NAME btn_collapse
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL btn_collapse hWin
ON CHOOSE OF btn_collapse IN FRAME f /* - */
DO:
  DEFINE BUFFER child_tt FOR tt.
  IF AVAILABLE tt AND tt.expanded THEN DO:
    /* Don't collapse something that has no children */
    IF CAN-FIND (FIRST child_tt WHERE child_tt.parent-recid eq RECID(tt))
    THEN DO:
      RUN adecomm/_setcurs.p ("WAIT").
      /* Store the current recid */
      save_recid = RECID(tt).
      RUN set_expansion (RECID(tt), NO).
      RUN reopen_query(yes).
      RUN adecomm/_setcurs.p ("").
    END.
  END.
END.

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


&Scoped-define SELF-NAME btn_expand
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL btn_expand hWin
ON CHOOSE OF btn_expand IN FRAME f /* + */
DO:
  IF AVAILABLE tt AND tt.expanded eq NO THEN DO:
    RUN adecomm/_setcurs.p ("WAIT").
    /* Store the current recid */
    save_recid = RECID(tt).
    RUN set_expansion (RECID(tt), YES).
    RUN reopen_query(yes).
    RUN adecomm/_setcurs.p ("").
  END.
END.

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


&Scoped-define SELF-NAME btn_level-1
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL btn_level-1 hWin
ON CHOOSE OF btn_level-1 IN FRAME f /* 1 */
DO:
  /* Store the current recid, change the display level, and reopen the query. */
  ASSIGN save_recid = IF AVAILABLE tt THEN RECID(tt) ELSE ? 
         show_levels = integer(self:LABEL)
         levels:SCREEN-VALUE = "Level 1"   /* Show user what levels are shown */
         .
  RUN reopen_query(yes).
END.

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


&Scoped-define SELF-NAME btn_level-2
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL btn_level-2 hWin
ON CHOOSE OF btn_level-2 IN FRAME f /* 2 */
DO:
  /* Store the current recid, change the display level, and reopen the query. */
  ASSIGN save_recid = IF AVAILABLE tt THEN RECID(tt) ELSE ? 
         show_levels = integer(self:LABEL)    
         /* Show user what levels are shown */     
         levels:SCREEN-VALUE = "Levels 1 - " + SELF:LABEL
         .
  RUN reopen_query(yes).
END.

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


&Scoped-define SELF-NAME btn_level-3
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL btn_level-3 hWin
ON CHOOSE OF btn_level-3 IN FRAME f /* 3 */
DO:
  /* Store the current recid, change the display level, and reopen the query. */
  ASSIGN save_recid = IF AVAILABLE tt THEN RECID(tt) ELSE ? 
         show_levels = integer(self:LABEL)   
         /* Show user what levels are shown */     
         levels:SCREEN-VALUE = "Levels 1 - " + SELF:LABEL
         .
  RUN reopen_query(yes).
END.

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


&Scoped-define SELF-NAME btn_level-4
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL btn_level-4 hWin
ON CHOOSE OF btn_level-4 IN FRAME f /* 4 */
DO:
  /* Store the current recid, change the display level, and reopen the query. */
  ASSIGN save_recid = IF AVAILABLE tt THEN RECID(tt) ELSE ? 
         show_levels = integer(self:LABEL)   
         /* Show user what levels are shown */     
         levels:SCREEN-VALUE = "Levels 1 - " + SELF:LABEL
         .
  RUN reopen_query(yes).
END.

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


&Scoped-define SELF-NAME btn_level-5
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL btn_level-5 hWin
ON CHOOSE OF btn_level-5 IN FRAME f /* 5 */
DO:
  /* Store the current recid, change the display level, and reopen the query. */
  ASSIGN save_recid = IF AVAILABLE tt THEN RECID(tt) ELSE ? 
         show_levels = integer(self:LABEL)   
         /* Show user what levels are shown */     
         levels:SCREEN-VALUE = "Levels 1 - " + SELF:LABEL
         .
  RUN reopen_query(yes).
END.

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


&Scoped-define SELF-NAME btn_level-all
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL btn_level-all hWin
ON CHOOSE OF btn_level-all IN FRAME f /* ... */
DO:
  /* Store the current recid, change the display level, and reopen the query. */
  ASSIGN save_recid = IF AVAILABLE tt THEN RECID(tt) ELSE ? 
         show_levels = 1000000   
         /* Show user what levels are shown */     
         levels:SCREEN-VALUE = "All Levels"
         .
  RUN reopen_query(yes).
END.

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


&Scoped-define SELF-NAME m_About
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL m_About hWin
ON CHOOSE OF MENU-ITEM m_About /* About Control Hierarchy */
DO:
    RUN adecomm/_about.p (INPUT "Control Hierarchy", INPUT "adeicon/cntrlhry").
END.

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


&Scoped-define SELF-NAME m_All_Objects
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL m_All_Objects hWin
ON VALUE-CHANGED OF MENU-ITEM m_All_Objects /* All Objects */
DO:
  IF SELF:CHECKED = YES THEN DO:
    ASSIGN MENU-ITEM m_User_Defined_objects:CHECKED IN MENU MENU-BAR-hWin = NO
           mode = "ALL".
    RUN Refresh.
  END.
  ELSE RETURN NO-APPLY.
END.

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


&Scoped-define SELF-NAME m_Contents
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL m_Contents hWin
ON CHOOSE OF MENU-ITEM m_Contents /* Help Topics */
DO:
  RUN adecomm/_adehelp.p ( "ptls", "TOPICS", {&Control_Hierarchy}, ? ).
END.

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


&Scoped-define SELF-NAME m_Exit
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL m_Exit hWin
ON CHOOSE OF MENU-ITEM m_Exit /* Exit */
DO:
   APPLY "CLOSE":U TO THIS-PROCEDURE.  
END.

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


&Scoped-define SELF-NAME m_Master
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL m_Master hWin
ON CHOOSE OF MENU-ITEM m_Master /* OpenEdge Master Help */
DO:
  RUN adecomm/_adehelp.p ( "mast", "TOPICS", ?, ? ).
END.

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


&Scoped-define SELF-NAME m_Refresh
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL m_Refresh hWin
ON CHOOSE OF MENU-ITEM m_Refresh /* Refresh */
DO:
  RUN Refresh.
END.

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


&Scoped-define SELF-NAME m_Tool_Help
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL m_Tool_Help hWin
ON CHOOSE OF MENU-ITEM m_Tool_Help /* Control Hierarchy Help */
DO:
  RUN adecomm/_adehelp.p ( "ptls", "CONTEXT", {&Control_Hierarchy}, ? ).
END.

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


&Scoped-define SELF-NAME m_User_Defined_Objects
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL m_User_Defined_Objects hWin
ON VALUE-CHANGED OF MENU-ITEM m_User_Defined_Objects /* User Application Objects */
DO:
  IF SELF:CHECKED = YES THEN DO:
    ASSIGN MENU-ITEM m_All_Objects:CHECKED IN MENU MENU-BAR-hWin = NO
           mode = "NO-ADE".
    RUN Refresh.
  END.
  ELSE RETURN NO-APPLY.  
END.

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


&UNDEFINE SELF-NAME

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


/* ***************************  Main Block  *************************** */
  
/* Add the browse to the frame */
DEFINE FRAME {&FRAME-NAME} wlist AT ROW 2 COL 1. 
  
/* Add a call to request the Default-Action when an item is dbl-clicked */ 
ON DEFAULT-ACTION OF wlist IN FRAME {&FRAME-NAME} DO:
  DEFINE BUFFER child_tt FOR tt.
  RUN adecomm/_setcurs.p ("WAIT").
  IF AVAILABLE tt THEN DO:
    /* Don't expand/collapse something that has no children */
    IF CAN-FIND (FIRST child_tt WHERE child_tt.parent-recid eq RECID(tt))
    THEN DO:
      /* Store the current recid */
      save_recid = RECID(tt).
      RUN set_expansion (RECID(tt), NOT tt.expanded).
      RUN reopen_query(yes).
    END.
  END. 
  RUN adecomm/_setcurs.p("").
END.
ASSIGN MENU-ITEM m_User_Defined_objects:CHECKED IN MENU MENU-BAR-hWin = YES
       MENU-ITEM m_All_Objects:CHECKED IN MENU MENU-BAR-hWin          = NO.
       
/* Send messages to alert boxes because there is no message area.       */
THIS-PROCEDURE:CURRENT-WINDOW = {&WINDOW-NAME}.

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:
  APPLY "window-resized" TO {&WINDOW-NAME}.
  RUN enable_UI.
  /* Create the list of widgets. */
  RUN create_list (SESSION, 1, ?).
  /* Show user what levels are shown */     
  ASSIGN show_levels = 1000000   
         levels:SCREEN-VALUE = "All Levels".
  .
  {&OPEN-QUERY-wlist} 
  ENABLE wlist WITH FRAME {&FRAME-NAME}.
  IF NOT THIS-PROCEDURE:PERSISTENT THEN
    WAIT-FOR CLOSE OF THIS-PROCEDURE.
END.

PROCEDURE LockWindowUpdate EXTERNAL "USER32.DLL":u:
    DEFINE INPUT  PARAMETER intWindowHwnd AS LONG NO-UNDO.
END PROCEDURE.

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


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

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE create_list hWin 
PROCEDURE create_list :
/* -----------------------------------------------------------
  Purpose: create the temp-table containing all the items in
           that parent to a widget.
  Parameters:  phParent - Pointer to the aggregate
               pLevel   - the level    
               prParent - Parent Recid
  Notes:       
-------------------------------------------------------------*/
  DEF INPUT PARAMETER phParent AS WIDGET  NO-UNDO.
  DEF INPUT PARAMETER pLevel   AS INTEGER NO-UNDO.
  DEF INPUT PARAMETER prParent AS RECID   NO-UNDO.
  
  DEF VAR elist AS CHARACTER     NO-UNDO INITIAL "User Interface Builder,PROGRESS,PRO*Tools,Data Dictionary,Procedure Editor,Data Administration,Librarian,Results,Translation Manager,Application Compiler,Control Hierarchy,Run Procedure,Color Changer,PRO*Spy".
  DEF VAR h     AS WIDGET-HANDLE NO-UNDO.
  
  /* Make a record in the temp-table */
  h = phParent:FIRST-CHILD.
  DO WHILE VALID-HANDLE(h):
     IF h:TYPE = "WINDOW" AND mode = "NO-ADE" THEN
       IF CAN-DO(elist,TRIM(h:TITLE))        OR 
         h:TITLE = ?                         OR
         h:TITLE BEGINS "Procedure -"        OR
         h:TITLE BEGINS "Procedure Editor -" OR
         h:TITLE BEGINS "User Interface Builder -" THEN DO:
           ASSIGN h = h:NEXT-SIBLING. /* skip it */
           NEXT.
       END.
    /* Create a record for this thing */
    CREATE tt.
    ASSIGN tt.level = pLevel
           tt.parent-recid = prParent
           tt.expanded = YES
           tt.visible = YES
           tt.handle = h.
           tt.name =  LC(h:TYPE) + ": "
           .
    /* Make the name more descriptive. */
    CASE h:TYPE:
      WHEN "WINDOW":U OR WHEN "DIALOG-BOX":U THEN 
        tt.name = tt.name + (IF h:TITLE EQ ? THEN STRING(h) ELSE h:TITLE).
      WHEN "FRAME":U THEN DO:
        tt.name = tt.name + IF h:TITLE eq ? THEN STRING(h) ELSE h:TITLE.
        END.
      WHEN "FIELD-GROUP":U THEN
        tt.name = tt.name + STRING(h).
      OTHERWISE DO:
        IF CAN-QUERY(h, "LABEL":U) AND h:LABEL ne ? AND h:LABEL ne "":U THEN 
          tt.name = tt.name + h:LABEL.
        ELSE IF CAN-QUERY(h, "NAME-":U) AND h:NAME ne ? THEN
          tt.name = tt.name + h:NAME.
        ELSE IF CAN-QUERY(h, "SCREEN-VALUE":U) AND h:SCREEN-VALUE ne ? THEN
          tt.name = tt.name + "'":U + h:SCREEN-VALUE + "'":U.
        ELSE tt.name = tt.name + "@ X=" + STRING(h:X) + ", Y=" + STRING(h:Y).
      END.
    END CASE.
    /* Call recursively, if necessary */
    IF CAN-QUERY(h,"FIRST-CHILD") THEN RUN create_list (h, pLevel + 1, RECID(tt)).
    
    /* Get the next sibling. */
    h = h:NEXT-SIBLING.
  END.     
END PROCEDURE.

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

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE disable_UI hWin  _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(hWin)
  THEN DELETE WIDGET hWin.
  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 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.
------------------------------------------------------------------------------*/
  DISPLAY levels 
      WITH FRAME f IN WINDOW hWin.
  ENABLE btn_expand btn_collapse btn_level-1 btn_level-2 btn_level-3 
         btn_level-4 btn_level-5 btn_level-all levels 
      WITH FRAME f IN WINDOW hWin.
  {&OPEN-BROWSERS-IN-QUERY-f}
  VIEW hWin.
END PROCEDURE.

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

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE Refresh hWin 
PROCEDURE Refresh :
/*------------------------------------------------------------------------------
  Purpose:     
  Parameters:  <none>
  Notes:       
------------------------------------------------------------------------------*/
  DEF VAR xname LIKE tt.name.
  
  RUN adecomm/_setcurs.p ("WAIT").
  /* save off old name */
  IF save_recid <> ? THEN DO:
      FIND x_tt WHERE RECID(x_tt) = save_recid NO-ERROR. 
      IF AVAILABLE x_tt THEN xname = x_tt.name.
      ELSE save_recid = ?.
  END.   
  /* clear original widget list */
  FOR EACH tt: DELETE tt. END.
  
  /* Create the list of widgets. */
  RUN create_list (SESSION, 1, ?).
  
  IF xname <> "" AND save_recid <> ? THEN DO:
      /* try to maintain previous position */
      FIND FIRST tt WHERE tt.name = xname NO-ERROR.
      IF NOT AVAILABLE tt THEN DO:
          FIND FIRST tt NO-ERROR.
          IF AVAILABLE tt THEN save_recid = RECID(tt).
      END.
      ELSE save_recid = RECID(tt).
  END.  
  RUN reopen_query(no).
  RUN adecomm/_setcurs.p ("").
END PROCEDURE.

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

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE reopen_query hWin 
PROCEDURE reopen_query :
/* -----------------------------------------------------------
  Purpose:  Remember where we are in the query, reopen the query
            and reposition to that point.   
  Parameters:  <none>
  Notes:       
-------------------------------------------------------------*/
def input        param pPreserve            as log         no-undo.

def var iPos                 as int                        no-undo.

  /* store current position */
  iPos = BROWSE wlist:FOCUSED-ROW.
  /* lock window */
  IF {&WINDOW-NAME}:HWND NE ? THEN
     run LockWindowUpdate({&WINDOW-NAME}:hwnd).
  /* Reopen query */
  {&OPEN-QUERY-wlist}
  /* Repositon query */
  IF save_recid NE ? THEN DO:
      FIND FIRST x_tt WHERE RECID(x_tt) = save_recid NO-ERROR.
      IF AVAILABLE x_tt THEN DO:
          DO WHILE x_tt.level > show_levels: /* if wrong level, find parent that is*/
              save_recid = x_tt.parent-recid.
              FIND x_tt WHERE RECID(x_tt) = save_recid.
          END.
          if pPreserve then
            wlist:SET-REPOSITIONED-ROW(iPos,"ALWAYS":u) in frame {&FRAME-NAME}.
          else
            wlist:SET-REPOSITIONED-ROW(wlist:DOWN,"CONDITIONAL":u) in frame {&FRAME-NAME}.
          REPOSITION wlist TO RECID save_recid.
      END. 
  END.   
  /* unlock window */
  run LockWindowUpdate(0).
END PROCEDURE.

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

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE set_expansion hWin 
PROCEDURE set_expansion :
/* -----------------------------------------------------------
  Purpose: If a list record is selected, then mark it as 
           expanded (or collapsed).  Mark its descendends as
           visible (or not).
           it and all its descendants.  
  Parameters:  pRecid  - Recid to expand
               pExpand - TRUE if we want to expand, FALSE for collapse
  Notes:       
-------------------------------------------------------------*/
  DEFINE INPUT PARAMETER pRecid  AS RECID   NO-UNDO.
  DEFINE INPUT PARAMETER pExpand AS LOGICAL NO-UNDO.
  
  DEFINE BUFFER child_tt FOR tt.
  
  FIND tt WHERE RECID(tt) eq pRECID NO-ERROR.
  IF AVAILABLE tt THEN DO:
    tt.expanded = pExpand.
    FOR EACH child_tt WHERE child_tt.parent-recid eq pRecid:
      RUN set_visible (RECID(child_tt), pExpand).
    END.
  END.
END PROCEDURE.

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

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE set_visible hWin 
PROCEDURE set_visible :
/* -----------------------------------------------------------
  Purpose: Mark the current record as visible (or not), if it
           is set the wrong way.
           visible (or not).
           it and all its descendants.  
  Parameters: pRecid   - Recid to expand
              pVisible - TRUE if we want to expand, FALSE for collapse
  Notes:       
-------------------------------------------------------------*/
  DEFINE INPUT PARAMETER pRecid   AS RECID   NO-UNDO.
  DEFINE INPUT PARAMETER pVisible AS LOGICAL NO-UNDO.
  
  DEFINE BUFFER child_tt FOR tt.
  
  FIND tt WHERE RECID(tt) eq pRECID NO-ERROR.
  IF AVAILABLE tt THEN DO:
    tt.visible = pVisible.
    FOR EACH child_tt WHERE child_tt.parent-recid eq pRecid:
      IF NOT pVisible OR (tt.expanded AND pVisible)
      THEN RUN set_visible (RECID(child_tt), pVisible).
    END.
  END.   
END PROCEDURE.

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

&ANALYZE-SUSPEND _VERSION-NUMBER UIB_v8r12 GUI
&ANALYZE-RESUME
&Scoped-define WINDOW-NAME CURRENT-WINDOW
&Scoped-define FRAME-NAME f_windows
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _DEFINITIONS f_windows 
/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/
/*------------------------------------------------------------------------

  File: _winmgr.w

  Description: Creates a TEMP-TABLE of all the windows (SESSION:Childen)
               in this PROGRESS Session and lets the user:
                   a) hide them
                   b) minimize them
                   c) maximize them  

  Input Parameters:
      <none>

  Output Parameters:
      <none>

  Author: William T. Wood

  Created: 11/10/93 - 10:17 am
  
  Modified by Gerry Seidl - UI redesigned, parent/child support
  
------------------------------------------------------------------------*/
/*          This .W file was created with the Progress UIB.             */
/*----------------------------------------------------------------------*/
{ protools/ptlshlp.i } /* help definitions */
{ adecomm/_adetool.i }

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

/* Local Definitions ---                                           */
DEFINE TEMP-TABLE w
    FIELD wHandle AS WIDGET-HANDLE
    FIELD wParent AS WIDGET-HANDLE
    FIELD level   AS INT
    FIELD cTitle  AS CHAR FORMAT "X(45)":U LABEL "Title"
    FIELD cStatus AS CHAR FORMAT "X(12)":U Label "Status"
    FIELD lHidden AS LOGICAL FORMAT "Hidden    /" LABEL "Hidden"
    FIELD srtfld  AS INT
    INDEX srtfld IS PRIMARY srtfld
    .
    
DEFINE VAR h      AS WIDGET-HANDLE NO-UNDO.
DEFINE VAR ldummy AS LOGICAL       NO-UNDO.
DEFINE VAR wseq   AS INTEGER       NO-UNDO INITIAL 0.

/* _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_windows

/* Standard List Definitions                                            */
&Scoped-Define ENABLED-OBJECTS Btn_Done b_Help 

/* 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 Btn_Done AUTO-GO 
     LABEL "&Close":L 
     SIZE 15 BY 1.14.

DEFINE BUTTON b_Help 
     LABEL "&Help" 
     SIZE 15 BY 1.14.

DEFINE BUTTON b_hide 
     LABEL "&Show":L 
     SIZE 15 BY 1.14.

DEFINE BUTTON b_pop 
     LABEL "&Pop to Top":L 
     SIZE 15 BY 1.14.


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

DEFINE FRAME f_windows
     Btn_Done AT ROW 1.48 COL 76.6
     b_hide AT ROW 3.38 COL 76.6
     b_pop AT ROW 4.71 COL 76.6
     b_Help AT ROW 6.1 COL 76.6
     SPACE(1.06) SKIP(4.35)
    WITH VIEW-AS DIALOG-BOX KEEP-TAB-ORDER 
         SIDE-LABELS THREE-D  SCROLLABLE 
         TITLE "PROGRESS Window Viewer":L
         DEFAULT-BUTTON Btn_Done.

 

/* *********************** 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_windows
   UNDERLINE Default                                                    */
ASSIGN 
       FRAME f_windows:SCROLLABLE       = FALSE.

/* SETTINGS FOR BUTTON Btn_Done IN FRAME f_windows
   NO-DISPLAY                                                           */
/* SETTINGS FOR BUTTON b_hide IN FRAME f_windows
   NO-DISPLAY NO-ENABLE                                                 */
/* SETTINGS FOR BUTTON b_pop IN FRAME f_windows
   NO-DISPLAY NO-ENABLE                                                 */
/* _RUN-TIME-ATTRIBUTES-END */
&ANALYZE-RESUME

 




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

&Scoped-define SELF-NAME b_Help
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL b_Help f_windows
ON CHOOSE OF b_Help IN FRAME f_windows /* Help */
DO:
  RUN adecomm/_adehelp.p ( "ptls", "CONTEXT", {&Window_Viewer}, ? ).
END.

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


&Scoped-define SELF-NAME b_hide
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL b_hide f_windows
ON CHOOSE OF b_hide IN FRAME f_windows /* Show */
DO:
  DEFINE VARIABLE choice AS LOGICAL INITIAL NO NO-UNDO.
  
  IF AVAILABLE w THEN DO:
    IF whandle:TITLE = "PROGRESS" AND REPLACE(SELF:LABEL,"&","") = "Hide" THEN DO:
      MESSAGE "The window named 'PROGRESS' is typically the PROGRESS Desktop." skip
              "Hiding this window may prevent you from using another tool" skip
              "or from exiting from PROGRESS." skip(1)
              "Do you really want to hide it?"
      VIEW-AS ALERT-BOX QUESTION BUTTONS YES-NO UPDATE choice. 
      IF NOT choice THEN RETURN NO-APPLY.
    END.
    RUN hide_current.
  END.
END.

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


&Scoped-define SELF-NAME b_pop
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL b_pop f_windows
ON CHOOSE OF b_pop IN FRAME f_windows /* Pop to Top */
DO:
  /* Pop the selected window (move it to top). */
  IF AVAILABLE w THEN DO:
    ASSIGN w.wHandle:VISIBLE = YES
           ldummy = w.wHandle:MOVE-TO-TOP().
    RUN redisplay_w.
  END.
END.

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


&UNDEFINE SELF-NAME

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


/* ************************* Browser Definitons *********************** */

/* Definitions of the queries                                           */
DEFINE QUERY browser_w FOR w SCROLLING.

/* Definitions of the browser frames                                    */
DEFINE BROWSE browser_w QUERY BROWSER_w DISPLAY 
      w.cTitle 
      w.cStatus
      w.lHidden
     WITH NO-UNDERLINE SIZE 74 BY 9.5.

/* Add the browser to the frame */    
DEFINE FRAME {&FRAME-NAME} browser_w AT ROW 1.5 COL 2.

/* Hide or show the current selection */
ON MOUSE-SELECT-DBLCLICK OF browser_w DO:
  IF AVAILABLE w THEN APPLY "CHOOSE" TO b_Hide.
END.

ON ITERATION-CHANGED OF browser_w DO:
   b_hide:LABEL = IF w.lHidden THEN "&Show" ELSE "&Hide".
   /* Enable buttons that depend on a valid window */
   IF AVAILABLE(w) ne b_hide:SENSITIVE
   THEN ASSIGN b_hide:SENSITIVE = AVAILABLE(w)
               b_pop:SENSITIVE  = b_hide:SENSITIVE
               .
END.

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

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

/* 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.
  /* Find the handles, titles, etc of all windows in the session. */
  RUN wins (SESSION, 1).
  /* Populate and show the browser on session windows. */
  OPEN QUERY browser_w FOR EACH w.
  ASSIGN browser_w:SENSITIVE = YES.
  IF browser_w:SELECT-ROW(1) THEN.
  APPLY "ITERATION-CHANGED" TO browser_w.
  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 f_windows _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_windows.
END PROCEDURE.

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


&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE enable_UI f_windows _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 Btn_Done b_Help 
      WITH FRAME f_windows.
  {&OPEN-BROWSERS-IN-QUERY-f_windows}
END PROCEDURE.

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


&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE hide_current f_windows 
PROCEDURE hide_current :
/* -----------------------------------------------------------
  Purpose:     
  Parameters:  <none>
  Notes:       
-------------------------------------------------------------*/
  IF w.wHandle eq FRAME {&FRAME-NAME}:PARENT AND w.wHandle:VISIBLE
  THEN MESSAGE "Sorry.  This window is the parent of this dialog-box." SKIP
               "It cannot be hidden."
               VIEW-AS ALERT-BOX WARNING BUTTONS OK.  
  ELSE DO:
    ASSIGN w.wHandle:HIDDEN = NOT w.wHandle:HIDDEN.
    RUN redisplay_w.         
  END.
END PROCEDURE.

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


&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE redisplay_w f_windows 
PROCEDURE redisplay_w :
/* -----------------------------------------------------------
  Purpose:     Redisplay the current visiblility of the current
               window (this is the only thing that can change
               in the browser).
  Parameters:  <none>
  Notes:       
-------------------------------------------------------------*/
  DEFINE BUFFER ww FOR w.
  DEFINE VARIABLE oldrecid AS RECID   NO-UNDO.
  DEFINE VARIABLE h        AS HANDLE  NO-UNDO.
  DEFINE VARIABLE l        AS LOGICAL NO-UNDO.
  
  oldrecid = RECID(w).
  ASSIGN w.lHidden = w.wHANDLE:HIDDEN
         b_hide:LABEL IN FRAME {&FRAME-NAME} = 
                     IF w.wHandle:HIDDEN THEN "&Show" ELSE "&Hide".
  IF CAN-FIND (FIRST ww WHERE ww.wParent = w.wHANDLE AND ww.level > w.level) THEN 
  DO:
    FOR EACH ww WHERE ww.wParent = w.wHANDLE AND ww.level > 1:
      ww.wHandle:HIDDEN = w.wHandle:HIDDEN.
      IF w.lHidden THEN ww.lHidden = w.wHANDLE:HIDDEN.
      ELSE ww.lHidden = ww.wHandle:HIDDEN.
    END.    
    ASSIGN h = browser_w:HANDLE
           l = h:SET-REPOSITIONED-ROW (MAX(1,h:FOCUSED-ROW), "CONDITIONAL").
    OPEN QUERY browser_w FOR EACH w.
    REPOSITION browser_w TO RECID(oldrecid).
    /*IF browser_w:SELECT-ROW(1) THEN.*/
  END.    
  ELSE DISPLAY w.lHidden  WITH BROWSE browser_w.
END PROCEDURE.

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


&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE wins f_windows 
PROCEDURE wins :
DEFINE INPUT PARAMETER w  AS HANDLE  NO-UNDO.
  DEFINE INPUT PARAMETER l  AS INTEGER NO-UNDO.
  DEFINE VARIABLE        h1 AS HANDLE  NO-UNDO.
  
  ASSIGN h1 = w:FIRST-CHILD.
  DO WHILE VALID-HANDLE(h1):
    IF h1:TYPE = "WINDOW" THEN DO:
      CREATE w.
      ASSIGN w.wHANDLE = h1
             w.wParent = (IF h1:PARENT EQ ? THEN h1 ELSE h1:PARENT)
             w.cTitle  = FILL("- ",l - 1) + " " + (IF h1:TITLE NE ? AND h1:TITLE NE "" THEN h1:TITLE ELSE "<no title>")
             w.cStatus = ENTRY(h1:WINDOW-STATE,"Maximized,Minimized,Normal":U)
             w.lHidden = IF w.wPARENT:HIDDEN THEN YES ELSE h1:HIDDEN
             w.level   = l
             wseq      = wseq + 1
             w.srtfld  = wseq.
    END.
    IF CAN-QUERY(h1,"FIRST-CHILD") THEN RUN wins (INPUT h1, l + 1).
    ASSIGN h1 = h1:NEXT-SIBLING.
  end.
END PROCEDURE.

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


&ANALYZE-SUSPEND _VERSION-NUMBER AB_v9r12 GUI
&ANALYZE-RESUME
/* Connected Databases 
          appsrvtt         PROGRESS
*/
&Scoped-define WINDOW-NAME CURRENT-WINDOW
&Scoped-define FRAME-NAME AddServ
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _DEFINITIONS AddServ 
/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/
/*------------------------------------------------------------------------

  File: protools/addpart.w

  Description: Add new partition to partition table

  Input Parameters:
      <none>

  Output Parameters:
      <none>

  Author: 

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

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

/* Parameters Definitions ---                                           */

/* Local Variable Definitions ---                                       */
DEFINE SHARED VARIABLE askCommit  AS LOGICAL                      NO-UNDO.
{adecomm/appsrvtt.i}
{protools/ptlshlp.i} /* Pro*Tools help contexts */

DEFINE BUFFER x_as FOR AppSrv-TT.

/* _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 AddServ

/* Internal Tables (found by Frame, Query & Browse Queries)             */
&Scoped-define INTERNAL-TABLES AppSrv-TT

/* Definitions for DIALOG-BOX AddServ                                   */
&Scoped-define FIELDS-IN-QUERY-AddServ AppSrv-TT.Partition ~
AppSrv-TT.App-Service AppSrv-TT.Host AppSrv-TT.Service AppSrv-TT.Security ~
AppSrv-TT.Info 
&Scoped-define ENABLED-FIELDS-IN-QUERY-AddServ AppSrv-TT.Partition ~
AppSrv-TT.App-Service AppSrv-TT.Host AppSrv-TT.Service AppSrv-TT.Security ~
AppSrv-TT.Info 
&Scoped-define ENABLED-TABLES-IN-QUERY-AddServ AppSrv-TT
&Scoped-define FIRST-ENABLED-TABLE-IN-QUERY-AddServ AppSrv-TT
&Scoped-define OPEN-QUERY-AddServ OPEN QUERY AddServ FOR EACH AppSrv-TT SHARE-LOCK.
&Scoped-define TABLES-IN-QUERY-AddServ AppSrv-TT
&Scoped-define FIRST-TABLE-IN-QUERY-AddServ AppSrv-TT


/* Standard List Definitions                                            */
&Scoped-Define ENABLED-FIELDS AppSrv-TT.Partition AppSrv-TT.App-Service ~
AppSrv-TT.Host AppSrv-TT.Service AppSrv-TT.Security AppSrv-TT.Info 
&Scoped-define ENABLED-TABLES AppSrv-TT
&Scoped-define FIRST-ENABLED-TABLE AppSrv-TT
&Scoped-define DISPLAYED-TABLES AppSrv-TT
&Scoped-define FIRST-DISPLAYED-TABLE AppSrv-TT
&Scoped-Define ENABLED-OBJECTS RS-Config Btn_OK Btn_Cancel Btn_Help 
&Scoped-Define DISPLAYED-FIELDS AppSrv-TT.Partition AppSrv-TT.App-Service ~
AppSrv-TT.Host AppSrv-TT.Service AppSrv-TT.Security AppSrv-TT.Info 
&Scoped-Define DISPLAYED-OBJECTS RS-Config Info-lbl 

/* 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 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 Info-lbl AS CHARACTER FORMAT "X(256)":U INITIAL "AppServer Information String:" 
      VIEW-AS TEXT 
     SIZE 30 BY .62 NO-UNDO.

DEFINE VARIABLE RS-Config AS LOGICAL 
     VIEW-AS RADIO-SET HORIZONTAL
     RADIO-BUTTONS 
          "Remote", yes,
"Local", no
     SIZE 27 BY 1.19 TOOLTIP "Select the current configuration" NO-UNDO.

/* Query definitions                                                    */
&ANALYZE-SUSPEND
DEFINE QUERY AddServ FOR 
      AppSrv-TT SCROLLING.
&ANALYZE-RESUME

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

DEFINE FRAME AddServ
     AppSrv-TT.Partition AT ROW 1.57 COL 16 COLON-ALIGNED
          LABEL "Partition Name"
          VIEW-AS FILL-IN 
          SIZE 27 BY 1 TOOLTIP "Enter the new partition name"
     AppSrv-TT.App-Service AT ROW 2.57 COL 16 COLON-ALIGNED
          LABEL "Service Name"
          VIEW-AS FILL-IN 
          SIZE 27 BY 1 TOOLTIP "Enter the Application Service Name"
     AppSrv-TT.Host AT ROW 3.57 COL 16 COLON-ALIGNED
          LABEL "Host (-H)"
          VIEW-AS FILL-IN 
          SIZE 27 BY 1 TOOLTIP "Host (-H) of the Name Server for this partition"
     AppSrv-TT.Service AT ROW 4.57 COL 16 COLON-ALIGNED
          LABEL "Service (-S)"
          VIEW-AS FILL-IN 
          SIZE 27 BY 1 TOOLTIP "Service (-S) of the Name Server for this partition"
     RS-Config AT ROW 5.52 COL 18 NO-LABEL
     AppSrv-TT.Security AT ROW 7 COL 9
          LABEL "Prompt for userid and password"
          VIEW-AS TOGGLE-BOX
          SIZE 40 BY .81
     AppSrv-TT.Info AT ROW 9.14 COL 3 NO-LABEL
          VIEW-AS EDITOR SCROLLBAR-VERTICAL
          SIZE 43 BY 3.57 TOOLTIP "AppServer Connection Information string"
     Btn_OK AT ROW 1.48 COL 47
     Btn_Cancel AT ROW 2.71 COL 47
     Btn_Help AT ROW 4.48 COL 47
     Info-lbl AT ROW 8.38 COL 3 NO-LABEL
     "Configuration:" VIEW-AS TEXT
          SIZE 13 BY 1 AT ROW 5.52 COL 4.6
     SPACE(45.59) SKIP(6.47)
    WITH VIEW-AS DIALOG-BOX KEEP-TAB-ORDER 
         SIDE-LABELS NO-UNDERLINE THREE-D  SCROLLABLE 
         TITLE "Add Partition"
         DEFAULT-BUTTON Btn_OK CANCEL-BUTTON Btn_Cancel.


/* *********************** 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 AddServ
   Custom                                                               */
ASSIGN 
       FRAME AddServ:SCROLLABLE       = FALSE
       FRAME AddServ:HIDDEN           = TRUE.

/* SETTINGS FOR FILL-IN AppSrv-TT.App-Service IN FRAME AddServ
   EXP-LABEL                                                            */
/* SETTINGS FOR FILL-IN AppSrv-TT.Host IN FRAME AddServ
   EXP-LABEL                                                            */
/* SETTINGS FOR FILL-IN Info-lbl IN FRAME AddServ
   NO-ENABLE ALIGN-L                                                    */
ASSIGN 
       Info-lbl:READ-ONLY IN FRAME AddServ        = TRUE.

/* SETTINGS FOR FILL-IN AppSrv-TT.Partition IN FRAME AddServ
   EXP-LABEL                                                            */
/* SETTINGS FOR TOGGLE-BOX AppSrv-TT.Security IN FRAME AddServ
   EXP-LABEL                                                            */
/* SETTINGS FOR FILL-IN AppSrv-TT.Service IN FRAME AddServ
   EXP-LABEL                                                            */
/* _RUN-TIME-ATTRIBUTES-END */
&ANALYZE-RESUME


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

&ANALYZE-SUSPEND _QUERY-BLOCK DIALOG-BOX AddServ
/* Query rebuild information for DIALOG-BOX AddServ
     _TblList          = "appsrvtt.AppSrv-TT"
     _Options          = "SHARE-LOCK"
     _Query            is OPENED
*/  /* DIALOG-BOX AddServ */
&ANALYZE-RESUME

 



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

&Scoped-define SELF-NAME AddServ
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL AddServ AddServ
ON WINDOW-CLOSE OF FRAME AddServ /* Add Partition */
DO:
  APPLY "END-ERROR":U TO SELF.
END.

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


&Scoped-define SELF-NAME AppSrv-TT.App-Service
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL AppSrv-TT.App-Service AddServ
ON LEAVE OF AppSrv-TT.App-Service IN FRAME AddServ /* Service Name */
, Partition, Host, Service
DO:
  DEFINE VARIABLE i          AS INTEGER         NO-UNDO.
  DEFINE VARIABLE n          AS INTEGER         NO-UNDO.
  DEFINE VARIABLE okay       AS LOGICAL         NO-UNDO.
  DEFINE VARIABLE tmp-string AS CHARACTER       NO-UNDO.
  
  ASSIGN tmp-string = SELF:SCREEN-VALUE
         n          = LENGTH(tmp-string,"RAW":U).
  okay = TRUE.
  DO i = 1 TO n WHILE okay:
    okay = INDEX("0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ-_",
                 SUBSTRING(tmp-string,i,1,"CHARACTER":U)) > 0.
  END.
  IF NOT okay THEN DO:
    MESSAGE 'There is at least one illegal character in the ' +
            SELF:LABEL + (IF NUM-ENTRIES(SELF:LABEL, " ":U) > 1 THEN
            '.' ELSE ' field.') SKIP
            'The only acceptable characters are "A-Z,a-z,0-9,- and _".' SKIP (1)
            'Please re-enter the name.' VIEW-AS ALERT-BOX ERROR.
    RETURN NO-APPLY.
  END.

  IF SELF:LABEL = "Partition Name" THEN DO:
    /* Prepopulate the Service Name */
    IF AppSrv-TT.App-Service:SCREEN-VALUE = "" THEN
         AppSrv-TT.App-Service:SCREEN-VALUE = SELF:SCREEN-VALUE.
  END.  /* If leaving the Partition field */
  
  IF SELF:LABEL = "Service Name" THEN DO:
    FIND FIRST x_as WHERE x_as.App-Service = SELF:SCREEN-VALUE AND
                          x_as.Partition NE AppSrv-TT.Partition:SCREEN-VALUE
                    NO-ERROR.
    IF AVAILABLE x_as THEN DO:
      ASSIGN AppSrv-TT.HOST = x_as.HOST
             AppSrv-TT.Service = x_as.Service
             AppSrv-TT.Configuration = x_as.Configuration
             AppSrv-TT.Security = x_as.Security
             AppSrv-TT.Info = x_as.Info.
      DISPLAY AppSrv-TT.Host AppSrv-TT.Service AppSrv-TT.Security
              AppSrv-TT.Info 
        WITH FRAME AddServ.
    END.  /* IF available x_as */
  END.  /* If leaving the AppService field */
END.

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


&Scoped-define SELF-NAME Btn_Cancel
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL Btn_Cancel AddServ
ON CHOOSE OF Btn_Cancel IN FRAME AddServ /* Cancel */
DO:
  DELETE AppSrv-TT.
END.

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


&Scoped-define SELF-NAME Btn_Help
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL Btn_Help AddServ
ON CHOOSE OF Btn_Help IN FRAME AddServ /* Help */
OR HELP OF FRAME {&FRAME-NAME}
DO: /* Call Help Function (or a simple message). */
  RUN adecomm/_adehelp.p ("ptls":U, "CONTEXT":U, {&Add_Partition_DB}, ?).
END.

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


&Scoped-define SELF-NAME Btn_OK
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL Btn_OK AddServ
ON CHOOSE OF Btn_OK IN FRAME AddServ /* OK */
DO:    
  IF AppSrv-TT.Partition:SCREEN-VALUE = "" THEN DO:
    MESSAGE "You must enter a partition name." VIEW-AS ALERT-BOX INFORMATION.
    APPLY "ENTRY" TO AppSrv-TT.Partition IN FRAME {&FRAME-NAME}.
    RETURN NO-APPLY.
  END.
  ELSE IF AppSrv-TT.App-Service:SCREEN-VALUE = "" THEN DO:
    MESSAGE "You must enter an application service name." VIEW-AS ALERT-BOX INFORMATION.
    APPLY "ENTRY" TO AppSrv-TT.App-Service IN FRAME {&FRAME-NAME}.
    RETURN NO-APPLY.
  END.
  
  ASSIGN {&ENABLED-FIELDS-IN-QUERY-{&FRAME-NAME}}
         RS-Config
         AppSrv-TT.Configuration = RS-Config
         askCommit = yes.
  
END.

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


&UNDEFINE SELF-NAME

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


/* ***************************  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:
  CREATE AppSrv-TT.
  RUN enable_UI.
  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 AddServ  _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 AddServ.
END PROCEDURE.

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

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE enable_UI AddServ  _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.
------------------------------------------------------------------------------*/

  {&OPEN-QUERY-AddServ}
  GET FIRST AddServ.
  DISPLAY RS-Config Info-lbl 
      WITH FRAME AddServ.
  IF AVAILABLE AppSrv-TT THEN 
    DISPLAY AppSrv-TT.Partition AppSrv-TT.App-Service AppSrv-TT.Host 
          AppSrv-TT.Service AppSrv-TT.Security AppSrv-TT.Info 
      WITH FRAME AddServ.
  ENABLE AppSrv-TT.Partition AppSrv-TT.App-Service AppSrv-TT.Host 
         AppSrv-TT.Service RS-Config AppSrv-TT.Security AppSrv-TT.Info Btn_OK 
         Btn_Cancel Btn_Help 
      WITH FRAME AddServ.
  VIEW FRAME AddServ.
  {&OPEN-BROWSERS-IN-QUERY-AddServ}
END PROCEDURE.

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

&ANALYZE-SUSPEND _VERSION-NUMBER AB_v9r12 GUI
&ANALYZE-RESUME
/* Connected Databases 
          appsrvtt         PROGRESS
*/
&Scoped-define WINDOW-NAME CURRENT-WINDOW
&Scoped-define FRAME-NAME AS-Frame
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _DEFINITIONS AS-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: protools/as-partn.w

  Description: AppServer Partition Deployment PRO*Tool

  Input Parameters:
      <none>

  Output Parameters:
      <none>

  Author: 

  Created: 1998
------------------------------------------------------------------------*/
/*          This .W file was created with the Progress AppBulder.       */
/*----------------------------------------------------------------------*/

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

/* Parameters Definitions ---                                           */

/* Local Variable Definitions ---                                       */
DEFINE NEW SHARED VARIABLE askCommit  AS LOGICAL                  NO-UNDO.
DEFINE VARIABLE old-rowid AS ROWID                                NO-UNDO.
DEFINE VARIABLE orig-name AS CHARACTER CASE-SENSITIVE             NO-UNDO.

{adecomm/appsrvtt.i "NEW GLOBAL"}
{adecomm/appserv.i}
{protools/ptlshlp.i} /* Pro*Tools help contexts */
{adecomm/_adetool.i}

DEFINE BUFFER x_as  FOR AppSrv-TT.
DEFINE BUFFER x_as2 FOR AppSrv-TT.

/* _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 AS-Frame
&Scoped-define BROWSE-NAME BROWSE-1

/* Internal Tables (found by Frame, Query & Browse Queries)             */
&Scoped-define INTERNAL-TABLES AppSrv-TT

/* Definitions for BROWSE BROWSE-1                                      */
&Scoped-define FIELDS-IN-QUERY-BROWSE-1 AppSrv-TT.Partition 
&Scoped-define ENABLED-FIELDS-IN-QUERY-BROWSE-1 AppSrv-TT.Partition 
&Scoped-define ENABLED-TABLES-IN-QUERY-BROWSE-1 AppSrv-TT
&Scoped-define FIRST-ENABLED-TABLE-IN-QUERY-BROWSE-1 AppSrv-TT
&Scoped-define OPEN-QUERY-BROWSE-1 OPEN QUERY BROWSE-1 FOR EACH AppSrv-TT NO-LOCK.
&Scoped-define TABLES-IN-QUERY-BROWSE-1 AppSrv-TT
&Scoped-define FIRST-TABLE-IN-QUERY-BROWSE-1 AppSrv-TT


/* Definitions for DIALOG-BOX AS-Frame                                  */
&Scoped-define OPEN-BROWSERS-IN-QUERY-AS-Frame ~
    ~{&OPEN-QUERY-BROWSE-1}

/* Standard List Definitions                                            */
&Scoped-Define ENABLED-FIELDS AppSrv-TT.App-Service AppSrv-TT.Host ~
AppSrv-TT.Service AppSrv-TT.Security AppSrv-TT.Info 
&Scoped-define ENABLED-TABLES AppSrv-TT
&Scoped-define FIRST-ENABLED-TABLE AppSrv-TT
&Scoped-define DISPLAYED-TABLES AppSrv-TT
&Scoped-define FIRST-DISPLAYED-TABLE AppSrv-TT
&Scoped-Define ENABLED-OBJECTS RECT-1 BROWSE-1 Btn_OK Btn_Cancel btn-Add ~
btn-Remove Btn_Help RS-Config 
&Scoped-Define DISPLAYED-FIELDS AppSrv-TT.App-Service AppSrv-TT.Host ~
AppSrv-TT.Service AppSrv-TT.Security AppSrv-TT.Info 
&Scoped-Define DISPLAYED-OBJECTS RS-Config Info-lbl 

/* 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 btn-Add 
     LABEL "&Add..." 
     SIZE 15 BY 1.14.

DEFINE BUTTON btn-Remove 
     LABEL "&Remove" 
     SIZE 15 BY 1.14.

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 Info-lbl AS CHARACTER FORMAT "X(256)":U INITIAL "AppServer Information String:" 
      VIEW-AS TEXT 
     SIZE 30 BY .62 NO-UNDO.

DEFINE VARIABLE RS-Config AS LOGICAL 
     VIEW-AS RADIO-SET HORIZONTAL
     RADIO-BUTTONS 
          "Remote", yes,
"Local", no
     SIZE 23 BY 1.19 TOOLTIP "Select the current configuration" NO-UNDO.

DEFINE RECTANGLE RECT-1
     EDGE-PIXELS 2 GRAPHIC-EDGE  NO-FILL 
     SIZE 51 BY 10.76.

/* Query definitions                                                    */
&ANALYZE-SUSPEND
DEFINE QUERY BROWSE-1 FOR 
      AppSrv-TT SCROLLING.
&ANALYZE-RESUME

/* Browse definitions                                                   */
DEFINE BROWSE BROWSE-1
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _DISPLAY-FIELDS BROWSE-1 AS-Frame _STRUCTURED
  QUERY BROWSE-1 DISPLAY
      AppSrv-TT.Partition
  ENABLE
      AppSrv-TT.Partition
/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME
    WITH NO-ROW-MARKERS SEPARATORS SIZE 47 BY 4.29 EXPANDABLE TOOLTIP "Edit the partition name".


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

DEFINE FRAME AS-Frame
     BROWSE-1 AT ROW 1.48 COL 5
     Btn_OK AT ROW 1.48 COL 59
     Btn_Cancel AT ROW 2.71 COL 59
     btn-Add AT ROW 4.33 COL 59
     btn-Remove AT ROW 5.57 COL 59
     AppSrv-TT.App-Service AT ROW 7 COL 19 COLON-ALIGNED
          LABEL "Service Name"
          VIEW-AS FILL-IN 
          SIZE 27 BY 1 TOOLTIP "Enter the Application service name"
     Btn_Help AT ROW 7.29 COL 59
     AppSrv-TT.Host AT ROW 8 COL 19 COLON-ALIGNED
          LABEL "Host (-H)"
          VIEW-AS FILL-IN 
          SIZE 17 BY 1 TOOLTIP "Host (-H) of the Name Server for this partition"
     AppSrv-TT.Service AT ROW 9 COL 19 COLON-ALIGNED
          LABEL "Service (-S)"
          VIEW-AS FILL-IN 
          SIZE 17 BY 1 TOOLTIP "Service (-S) of Name Server for this partition"
     RS-Config AT ROW 10 COL 21 NO-LABEL
     AppSrv-TT.Security AT ROW 11.24 COL 7.4
          LABEL "Prompt for userid and password"
          VIEW-AS TOGGLE-BOX
          SIZE 39 BY .81
     AppSrv-TT.Info AT ROW 13.14 COL 5 NO-LABEL
          VIEW-AS EDITOR SCROLLBAR-VERTICAL
          SIZE 46 BY 3.57 TOOLTIP "AppServer Connection Information string"
     Info-lbl AT ROW 12.43 COL 5 NO-LABEL
     "Configuration:" VIEW-AS TEXT
          SIZE 13 BY 1 AT ROW 10.05 COL 7.4
     RECT-1 AT ROW 6.52 COL 3
     SPACE(20.00) SKIP(0.47)
    WITH VIEW-AS DIALOG-BOX KEEP-TAB-ORDER 
         SIDE-LABELS NO-UNDERLINE THREE-D  SCROLLABLE 
         TITLE "AppServer Partition Deployment"
         DEFAULT-BUTTON Btn_OK CANCEL-BUTTON Btn_Cancel.


/* *********************** 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 AS-Frame
                                                                        */
/* BROWSE-TAB BROWSE-1 RECT-1 AS-Frame */
ASSIGN 
       FRAME AS-Frame:SCROLLABLE       = FALSE
       FRAME AS-Frame:HIDDEN           = TRUE.

/* SETTINGS FOR FILL-IN AppSrv-TT.App-Service IN FRAME AS-Frame
   EXP-LABEL                                                            */
/* SETTINGS FOR FILL-IN AppSrv-TT.Host IN FRAME AS-Frame
   EXP-LABEL                                                            */
/* SETTINGS FOR FILL-IN Info-lbl IN FRAME AS-Frame
   NO-ENABLE ALIGN-L                                                    */
ASSIGN 
       Info-lbl:READ-ONLY IN FRAME AS-Frame        = TRUE.

/* SETTINGS FOR TOGGLE-BOX AppSrv-TT.Security IN FRAME AS-Frame
   EXP-LABEL                                                            */
/* SETTINGS FOR FILL-IN AppSrv-TT.Service IN FRAME AS-Frame
   EXP-LABEL                                                            */
/* _RUN-TIME-ATTRIBUTES-END */
&ANALYZE-RESUME


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

&ANALYZE-SUSPEND _QUERY-BLOCK BROWSE BROWSE-1
/* Query rebuild information for BROWSE BROWSE-1
     _TblList          = "appsrvtt.AppSrv-TT"
     _FldNameList[1]   > appsrvtt.AppSrv-TT.Partition
"AppSrv-TT.Partition" ? ? "character" ? ? ? ? ? ? yes ? no no ?
     _Query            is OPENED
*/  /* BROWSE BROWSE-1 */
&ANALYZE-RESUME

 



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

&Scoped-define SELF-NAME AS-Frame
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL AS-Frame AS-Frame
ON WINDOW-CLOSE OF FRAME AS-Frame /* AppServer Partition Deployment */
DO:
  APPLY "END-ERROR":U TO SELF.
END.

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


&Scoped-define SELF-NAME AppSrv-TT.App-Service
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL AppSrv-TT.App-Service AS-Frame
ON LEAVE OF AppSrv-TT.App-Service IN FRAME AS-Frame /* Service Name */
, Host, Service, RS-Config
DO:
  DEFINE VARIABLE i          AS INTEGER         NO-UNDO.
  DEFINE VARIABLE n          AS INTEGER         NO-UNDO.
  DEFINE VARIABLE okay       AS LOGICAL         NO-UNDO.
  DEFINE VARIABLE tmp-string AS CHARACTER       NO-UNDO.
  
  ASSIGN tmp-string = SELF:SCREEN-VALUE
         n          = LENGTH(tmp-string,"RAW":U).
  okay = TRUE.
  DO i = 1 TO n WHILE okay:
    okay = INDEX("0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ-_",
                 SUBSTRING(tmp-string,i,1,"CHARACTER":U)) > 0.
  END.
  IF NOT okay THEN DO:
    MESSAGE 'There is at least one illegal character in the ' +
            SELF:LABEL + (IF NUM-ENTRIES(SELF:LABEL, " ":U) > 1 THEN
            '.' ELSE ' field.') SKIP
            'The only acceptable characters are "A-Z,a-z,0-9,- and _".' SKIP (1)
            'Please re-enter the name.' VIEW-AS ALERT-BOX ERROR.
    RETURN NO-APPLY.
  END.

  IF SELF:LABEL = "Service Name" THEN DO:
    FIND x_as WHERE ROWID(x_as) = old-rowid NO-ERROR.
    IF AVAILABLE x_as THEN 
      ASSIGN x_as.App-Service = SELF:SCREEN-VALUE
             askCommit        = yes.
    
    /* Now set other fields like current AppService rows if any */
    FIND FIRST x_as WHERE x_as.App-Service = SELF:SCREEN-VALUE AND
                          x_as.Partition NE AppSrv-TT.Partition
                    NO-ERROR.
    IF AVAILABLE x_as THEN DO:
      ASSIGN AppSrv-TT.HOST = x_as.HOST
             AppSrv-TT.Service = x_as.Service
             AppSrv-TT.Configuration = x_as.Configuration
             AppSrv-TT.Security = x_as.Security
             AppSrv-TT.Info = x_as.Info.
      DISPLAY AppSrv-TT.Host AppSrv-TT.Service AppSrv-TT.Security
              AppSrv-TT.Info 
        WITH FRAME AS-FRAME.
    END.  /* IF available x_as */
  END.  /* If leaving AppService Field */
END.

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


&Scoped-define BROWSE-NAME BROWSE-1
&Scoped-define SELF-NAME BROWSE-1
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL BROWSE-1 AS-Frame
ON ENTRY OF BROWSE-1 IN FRAME AS-Frame
DO:
   orig-name = AppSrv-TT.Partition:SCREEN-VALUE IN BROWSE BROWSE-1.
END.

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


&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL BROWSE-1 AS-Frame
ON ROW-LEAVE OF BROWSE-1 IN FRAME AS-Frame
DO:
   IF orig-name NE AppSrv-TT.Partition:SCREEN-VALUE IN BROWSE BROWSE-1
     THEN askCommit = yes.
END.

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


&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL BROWSE-1 AS-Frame
ON VALUE-CHANGED OF BROWSE-1 IN FRAME AS-Frame
DO:
  RUN update-old-record.
  RUN display-record.
  IF AVAILABLE AppSrv-TT THEN old-rowid = ROWID(AppSrv-TT).
  APPLY "ENTRY" TO SELF.
END.

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


&Scoped-define SELF-NAME btn-Add
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL btn-Add AS-Frame
ON CHOOSE OF btn-Add IN FRAME AS-Frame /* Add... */
DO:
  RUN update-old-record.
  run protools/addpart.w.
  {&OPEN-QUERY-BROWSE-1}
  RUN display-record.
  IF AVAILABLE AppSrv-TT THEN DO:
    old-rowid = ROWID(AppSrv-TT).
    btn-REMOVE:SENSITIVE IN FRAME {&FRAME-NAME} = (AVAILABLE AppSrv-TT).
  END.
END.

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


&Scoped-define SELF-NAME btn-Remove
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL btn-Remove AS-Frame
ON CHOOSE OF btn-Remove IN FRAME AS-Frame /* Remove */
DO:
  DELETE AppSrv-TT.
  {&OPEN-QUERY-BROWSE-1}
  RUN display-record.
  IF AVAILABLE AppSrv-TT THEN old-rowid = ROWID(AppSrv-TT).
  ASSIGN SELF:SENSITIVE = (AVAILABLE AppSrv-TT)
         askCommit      = yes.
END.

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


&Scoped-define SELF-NAME Btn_Help
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL Btn_Help AS-Frame
ON CHOOSE OF Btn_Help IN FRAME AS-Frame /* Help */
OR HELP OF FRAME {&FRAME-NAME}
DO: /* Call Help Function (or a simple message). */
  RUN adecomm/_adehelp.p ("ptls":U,"CONTEXT":U, {&AppServer_Partition}, ?).
END.

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


&Scoped-define SELF-NAME Btn_OK
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL Btn_OK AS-Frame
ON CHOOSE OF Btn_OK IN FRAME AS-Frame /* OK */
DO:
  DEFINE VARIABLE ans AS LOGICAL                              NO-UNDO.

  RUN update-old-record.

  IF askCommit THEN DO:  /* Something has changed */  
    MESSAGE "The partition setup has been changed only for this session." SKIP
            "Do you want to save these partition setups permanently" SKIP
            "for future sessions?"
            VIEW-AS ALERT-BOX QUESTION BUTTONS YES-NO SET ans.
    IF ans THEN DO:
      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.
      END.  /* For Each */
      OUTPUT CLOSE.
    END.  /* If ans */
  END.  /* If askCommit */
END.  /* On choose */

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


&UNDEFINE SELF-NAME

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _MAIN-BLOCK AS-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.


/* 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 display-record.
  IF AVAILABLE AppSrv-TT THEN old-rowid = ROWID(AppSrv-TT).
  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 AS-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 AS-Frame.
END PROCEDURE.

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

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE display-record AS-Frame 
PROCEDURE display-record :
/*------------------------------------------------------------------------------
  Purpose:     
  Parameters:  <none>
  Notes:       
------------------------------------------------------------------------------*/
  IF AVAILABLE AppSrv-TT THEN DO:
    RS-Config = AppSrv-TT.Configuration.
    DISPLAY AppSrv-TT.App-Service AppSrv-TT.Host AppSrv-TT.Service
            RS-Config AppSrv-TT.Security AppSrv-TT.Info 
      WITH FRAME AS-Frame.
    ENABLE BROWSE-1 AppSrv-TT.App-Service 
           AppSrv-TT.Host AppSrv-TT.Service RS-Config
           AppSrv-TT.Security AppSrv-TT.Info 
           Btn_OK Btn_Cancel btn-Add btn-Remove Btn_Help
      WITH FRAME AS-Frame.
  END.  /* If we have an AppSrv-TT record */
  ELSE DO WITH FRAME {&FRAME-NAME}:
    ASSIGN AppSrv-TT.App-Service:SCREEN-VALUE   = ""
           AppSrv-TT.App-Service:SENSITIVE      = FALSE
           btn-Remove:SENSITIVE                 = FALSE 
           AppSrv-TT.Host:SCREEN-VALUE          = ""
           AppSrv-TT.Host:SENSITIVE             = FALSE
           AppSrv-TT.Service:SCREEN-VALUE       = "" 
           AppSrv-TT.Service:SENSITIVE          = FALSE 
           RS-Config:SCREEN-VALUE               = STRING(FALSE)
           RS-Config:SENSITIVE                  = FALSE
           AppSrv-TT.Security:CHECKED           = FALSE
           AppSrv-TT.Security:SENSITIVE         = FALSE
           AppSrv-TT.Info:SCREEN-VALUE          = "" 
           AppSrv-TT.Info:SENSITIVE             = FALSE. 
  END.  /* There are no AppSrv-TT records */
END PROCEDURE.

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

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE enable_UI AS-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 RS-Config Info-lbl 
      WITH FRAME AS-Frame.
  IF AVAILABLE AppSrv-TT THEN 
    DISPLAY AppSrv-TT.App-Service AppSrv-TT.Host AppSrv-TT.Service 
          AppSrv-TT.Security AppSrv-TT.Info 
      WITH FRAME AS-Frame.
  ENABLE RECT-1 BROWSE-1 Btn_OK Btn_Cancel btn-Add btn-Remove 
         AppSrv-TT.App-Service Btn_Help AppSrv-TT.Host AppSrv-TT.Service 
         RS-Config AppSrv-TT.Security AppSrv-TT.Info 
      WITH FRAME AS-Frame.
  VIEW FRAME AS-Frame.
  {&OPEN-BROWSERS-IN-QUERY-AS-Frame}
END PROCEDURE.

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

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE update-old-record AS-Frame 
PROCEDURE update-old-record :
/*------------------------------------------------------------------------------
  Purpose:     
  Parameters:  <none>
  Notes:       
------------------------------------------------------------------------------*/
  FIND x_as WHERE ROWID(x_AS) = old-rowid NO-ERROR.
  
  IF AVAILABLE x_as THEN DO WITH FRAME AS-FRAME:
    /* To ensure a clean run next time, disconnect the AppServer. */
    RUN appServerDisconnect(x_as.Partition).
    
    IF x_as.App-Service   NE AppSrv-TT.App-Service:SCREEN-VALUE  OR
       x_as.Host          NE AppSrv-TT.Host:SCREEN-VALUE         OR
       x_as.Service       NE AppSrv-TT.Service:SCREEN-VALUE      OR
       x_as.Configuration NE (RS-Config:SCREEN-VALUE = "yes":U)  OR
       x_as.Security      NE AppSrv-TT.Security:CHECKED          OR
       x_as.Info          NE AppSrv-TT.Info:SCREEN-VALUE
      THEN askCommit = yes.


    ASSIGN x_as.App-Service   = AppSrv-TT.App-Service:SCREEN-VALUE
           x_as.Host          = AppSrv-TT.Host:SCREEN-VALUE 
           x_as.Service       = AppSrv-TT.Service:SCREEN-VALUE
           x_as.Configuration = (RS-Config:SCREEN-VALUE = "yes":U)
           x_as.Security      = AppSrv-TT.Security:CHECKED
           x_as.Info          = AppSrv-TT.Info:SCREEN-VALUE.

    /* Now update other rows sharing the same App-Service */
    FOR EACH x_as2 WHERE x_as2.App-Service = x_as.App-Service AND
                         x_as2.Partition  NE x_as.Partition:
    ASSIGN x_as2.Host          = x_as.Host 
           x_as2.Service       = x_as.Service
           x_as2.Configuration = x_as.Configuration
           x_as2.Security      = x_as.Security
           x_as2.Info          = x_as.Info.
    END.  /* For each x_as2 */
  END.

END PROCEDURE.

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


  FIELD App-Service LIKE ttAppSrv-TT.App-Service~
  FIELD Configuration LIKE ttAppSrv-TT.Configuration~
  FIELD Host LIKE ttAppSrv-TT.Host~
  FIELD Info LIKE ttAppSrv-TT.Info~
  FIELD Partition LIKE ttAppSrv-TT.Partition~
  FIELD PartitionType LIKE ttAppSrv-TT.PartitionType~
  FIELD Security LIKE ttAppSrv-TT.Security~
  FIELD Service LIKE ttAppSrv-TT.Service~
  FIELD ServerURL LIKE ttAppSrv-TT.ServerURL~
  FIELD PtnTblRecid LIKE ttAppSrv-TT.PtnTblRecid~
  FIELD Parameters LIKE ttAppSrv-TT.Parameters
&ANALYZE-SUSPEND _VERSION-NUMBER AB_v10r12 GUI ADM2
&ANALYZE-RESUME
/* Connected Databases 
          temp-db          PROGRESS
*/
&Scoped-define WINDOW-NAME CURRENT-WINDOW
{adecomm/appserv.i}
DEFINE VARIABLE h_Astra                    AS HANDLE          NO-UNDO.

/* Temp-Table and Buffer definitions                                    */
DEFINE TEMP-TABLE ttAppSrv-TT NO-UNDO LIKE ttAppSrv-TT.


&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _DEFINITIONS dTables 
/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/
/*------------------------------------------------------------------------

  File:             protools/dappsrv.w 

  Description:      Service Partition Management SDO. 
                    This SDO reads and writes data to the AppServ-TT table 
                    defined by appsrvtt.i.

  Input Parameters:
      <none>

  Output Parameters:
      <none>

  Notes            For this SDO to work properly, the container that it
                   is added to needs to make a call to setUserProperty
                   after the object has been created during the 
                   createObject of the container.

                   The property 'PartitionType' needs to be set to 
                   whatever partition type this SDO is going to serve.
 
                   This object supports three extra links:
                   1) tableChanged - The SDO is the source
                   2) cancelAll - The SDO is the target
                   3) writeBatch - The SDO is the target

  Created:         May 9, 2000 - Bruce Gruenbaum
------------------------------------------------------------------------*/
/*          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  ************************** */

/* Parameters Definitions ---                                           */

/* Local Variable Definitions ---                                       */

DEFINE VARIABLE cPtnType AS CHARACTER  NO-UNDO.

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


&ANALYZE-SUSPEND _UIB-PREPROCESSOR-BLOCK 

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

&Scoped-define PROCEDURE-TYPE SmartDataObject
&Scoped-define DB-AWARE yes

&Scoped-define ADM-SUPPORTED-LINKS Data-Source,Data-Target,Navigation-Target,Update-Target,Commit-Target,Filter-Target


/* Db-Required definitions. */
&IF DEFINED(DB-REQUIRED) = 0 &THEN
    &GLOBAL-DEFINE DB-REQUIRED TRUE
&ENDIF
&GLOBAL-DEFINE DB-REQUIRED-START   &IF {&DB-REQUIRED} &THEN
&GLOBAL-DEFINE DB-REQUIRED-END     &ENDIF


&Scoped-define QUERY-NAME Query-Main

/* Internal Tables (found by Frame, Query & Browse Queries)             */
&Scoped-define INTERNAL-TABLES ttAppSrv-TT

/* Definitions for QUERY Query-Main                                     */
&Scoped-Define ENABLED-FIELDS  App-Service Configuration Host Info Partition PartitionType Security~
 Service ServerURL PtnTblRecid Parameters
&Scoped-define ENABLED-FIELDS-IN-ttAppSrv-TT App-Service Configuration Host ~
Info Partition PartitionType Security Service ServerURL PtnTblRecid ~
Parameters 
&Scoped-Define DATA-FIELDS  App-Service Configuration Host Info Partition PartitionType Security~
 Service ServerURL PtnTblRecid Parameters
&Scoped-define DATA-FIELDS-IN-ttAppSrv-TT App-Service Configuration Host ~
Info Partition PartitionType Security Service ServerURL PtnTblRecid ~
Parameters 
&Scoped-Define MANDATORY-FIELDS 
&Scoped-Define APPLICATION-SERVICE 
&Scoped-Define ASSIGN-LIST 
&Scoped-Define DATA-FIELD-DEFS "protools/dappsrv.i"
&Scoped-define QUERY-STRING-Query-Main FOR EACH ttAppSrv-TT NO-LOCK INDEXED-REPOSITION
{&DB-REQUIRED-START}
&Scoped-define OPEN-QUERY-Query-Main OPEN QUERY Query-Main FOR EACH ttAppSrv-TT NO-LOCK INDEXED-REPOSITION.
{&DB-REQUIRED-END}
&Scoped-define TABLES-IN-QUERY-Query-Main ttAppSrv-TT
&Scoped-define FIRST-TABLE-IN-QUERY-Query-Main ttAppSrv-TT


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

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


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

{&DB-REQUIRED-START}

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION-FORWARD deleteRow dTables  _DB-REQUIRED
FUNCTION deleteRow RETURNS LOGICAL
  ( INPUT pcRowIdent AS CHARACTER)  FORWARD.

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

{&DB-REQUIRED-END}

{&DB-REQUIRED-START}

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION-FORWARD submitRow dTables  _DB-REQUIRED
FUNCTION submitRow RETURNS LOGICAL
  ( INPUT pcRowIdent AS CHARACTER,
    INPUT pcValueList AS CHARACTER)  FORWARD.

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

{&DB-REQUIRED-END}


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

{&DB-REQUIRED-START}

/* Query definitions                                                    */
&ANALYZE-SUSPEND
DEFINE QUERY Query-Main FOR 
      ttAppSrv-TT SCROLLING.
&ANALYZE-RESUME
{&DB-REQUIRED-END}


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


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

&ANALYZE-SUSPEND _PROCEDURE-SETTINGS
/* Settings for THIS-PROCEDURE
   Type: SmartDataObject
   Allow: Query
   Frames: 0
   Add Fields to: Neither
   Other Settings: PERSISTENT-ONLY COMPILE APPSERVER DB-AWARE
   Temp-Tables and Buffers:
      TABLE: ttAppSrv-TT T "?" NO-UNDO temp-db ttAppSrv-TT
   END-TABLES.
 */

/* This procedure should always be RUN PERSISTENT.  Report the error,  */
/* then cleanup and return.                                            */
IF NOT THIS-PROCEDURE:PERSISTENT THEN DO:
  MESSAGE "{&FILE-NAME} should only be RUN PERSISTENT.":U
          VIEW-AS ALERT-BOX ERROR BUTTONS OK.
  RETURN.
END.

&ANALYZE-RESUME _END-PROCEDURE-SETTINGS

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

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

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _INCLUDED-LIB dTables 
/* ************************* Included-Libraries *********************** */

{adecomm/appsrvtt.i}
{src/adm2/data.i}
{adecomm/_adetool.i}

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




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

&ANALYZE-SUSPEND _RUN-TIME-ATTRIBUTES
/* SETTINGS FOR WINDOW dTables
  VISIBLE,,RUN-PERSISTENT                                               */
/* _RUN-TIME-ATTRIBUTES-END */
&ANALYZE-RESUME


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

&ANALYZE-SUSPEND _QUERY-BLOCK QUERY Query-Main
/* Query rebuild information for SmartDataObject Query-Main
     _TblList          = "Temp-Tables.ttAppSrv-TT"
     _Options          = "NO-LOCK INDEXED-REPOSITION"
     _FldNameList[1]   > Temp-Tables.ttAppSrv-TT.App-Service
"App-Service" "App-Service" ? ? "character" ? ? ? ? ? ? yes ? no 255 no
     _FldNameList[2]   > Temp-Tables.ttAppSrv-TT.Configuration
"Configuration" "Configuration" ? ? "logical" ? ? ? ? ? ? yes ? no 12.4 no
     _FldNameList[3]   > Temp-Tables.ttAppSrv-TT.Host
"Host" "Host" ? ? "character" ? ? ? ? ? ? yes ? no 15 no
     _FldNameList[4]   > Temp-Tables.ttAppSrv-TT.Info
"Info" "Info" ? ? "character" ? ? ? ? ? ? yes ? no 255 no
     _FldNameList[5]   > Temp-Tables.ttAppSrv-TT.Partition
"Partition" "Partition" ? ? "character" ? ? ? ? ? ? yes ? no 25 no
     _FldNameList[6]   > Temp-Tables.ttAppSrv-TT.PartitionType
"PartitionType" "PartitionType" ? ? "character" ? ? ? ? ? ? yes ? no 13 no
     _FldNameList[7]   > Temp-Tables.ttAppSrv-TT.Security
"Security" "Security" ? ? "logical" ? ? ? ? ? ? yes ? no 29.6 no
     _FldNameList[8]   > Temp-Tables.ttAppSrv-TT.Service
"Service" "Service" ? ? "character" ? ? ? ? ? ? yes ? no 15 no
     _FldNameList[9]   > Temp-Tables.ttAppSrv-TT.ServerURL
"ServerURL" "ServerURL" ? ? "character" ? ? ? ? ? ? yes ? no 255 no
     _FldNameList[10]   > Temp-Tables.ttAppSrv-TT.PtnTblRecid
"PtnTblRecid" "PtnTblRecid" ? ? "recid" ? ? ? ? ? ? yes ? no 19.8 no
     _FldNameList[11]   > Temp-Tables.ttAppSrv-TT.Parameters
"Parameters" "Parameters" ? ? "character" ? ? ? ? ? ? yes ? no 255 no
     _Design-Parent    is WINDOW dTables @ ( 1.14 , 2.6 )
*/  /* QUERY Query-Main */
&ANALYZE-RESUME

 


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


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

  &IF DEFINED(UIB_IS_RUNNING) <> 0 &THEN          
    RUN initializeObject.
  &ENDIF

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


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

{&DB-REQUIRED-START}

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE assignDBRow dTables  _DB-REQUIRED
PROCEDURE assignDBRow :
/*------------------------------------------------------------------------------
  Purpose:     Super Override
  Parameters:  
  Notes:       
------------------------------------------------------------------------------*/

  DEFINE INPUT PARAMETER phRowObjUpd AS HANDLE NO-UNDO.
  DEFINE VARIABLE iRow AS INTEGER    NO-UNDO.
  DEFINE VARIABLE hRowMod AS HANDLE     NO-UNDO.
  DEFINE VARIABLE lDifferent AS LOGICAL    NO-UNDO.

  /* Code placed here will execute PRIOR to standard behavior. */

  RUN SUPER( INPUT phRowObjUpd).

  IF NOT AVAILABLE(ttAppSrv-TT) THEN
    RETURN.

  iRow = INTEGER(getUserProperty("CurrRecid":U)).
  IF iRow <> ? THEN
  DO:
    FIND FIRST AppSrv-TT WHERE RECID(AppSrv-TT) = iRow NO-ERROR.
    BUFFER-COMPARE ttAppSrv-TT TO AppSrv-TT
       SAVE RESULT IN lDifferent.
    lDifferent = NOT lDifferent.
  END.
  ELSE
  DO:
    hRowMod = phRowObjUpd:BUFFER-FIELD('RowMod':U).
    IF hRowMod:BUFFER-VALUE = "A":U OR 
       hRowMod:BUFFER-VALUE = "C":U THEN
    DO:
      CREATE AppSrv-TT.
      ASSIGN 
        ttAppSrv-TT.PtnTblRecid = RECID(AppSrv-TT)
        lDifferent = YES.
    END.
  END.
  IF lDifferent THEN
  DO:
    BUFFER-COPY ttAppSrv-TT TO AppSrv-TT
      ASSIGN AppSrv-TT.PartitionType = cPtnType. 
    PUBLISH 'tableChanged':U. 
  END.

END PROCEDURE.

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

{&DB-REQUIRED-END}

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE disable_UI dTables  _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. */
  IF THIS-PROCEDURE:PERSISTENT THEN DELETE PROCEDURE THIS-PROCEDURE.
END PROCEDURE.

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

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE initializeObject dTables 
PROCEDURE initializeObject :
/*------------------------------------------------------------------------------
  Purpose:     Super Override - Used to populate the temp-table.
  Parameters:  
  Notes:       
------------------------------------------------------------------------------*/
  /* Get the partition type that was set during createObject by the container */ 
  cPtnType = getUserProperty("PartitionType":U).

  /* Get the AppSrv-TT records that are required from the AppServ-TT global
     table */
  FOR EACH AppSrv-TT WHERE AppSrv-TT.PartitionType = cPtnType NO-LOCK:
    CREATE ttAppSrv-TT.
    BUFFER-COPY AppSrv-TT TO ttAppSrv-TT
      ASSIGN ttAppSrv-TT.PtnTblRecid = RECID(AppSrv-TT).
  END.

  RUN SUPER.

END PROCEDURE.

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

{&DB-REQUIRED-START}

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE preTransactionValidate dTables  _DB-REQUIRED
PROCEDURE preTransactionValidate :
/*------------------------------------------------------------------------------
  Purpose:     
  Parameters:  <none>
  Notes:       
------------------------------------------------------------------------------*/
  /* Make sure that the partition name is not blank or unknown */
  IF RowObjUpd.Partition = "" OR
     RowObjUpd.Partition = ? THEN
    RETURN "The partition name may not be blank or unknown.".

  /* Make sure that we do not have a duplicate partition name */
  FIND AppSrv-TT 
    WHERE AppSrv-TT.Partition = RowObjUpd.Partition 
    NO-ERROR.
  IF AVAILABLE(AppSrv-TT) AND
     (RECID(AppSrv-TT) <> RowObjUpd.PtnTblRecid OR
      RowObjUpd.PtnTblRecid = ?) THEN
    RETURN "A partition already exists with the name '" + RowObjUpd.Partition
           + "'. Partition names must be unique.".

  /* Set the CurrRecid property which we use later to alter the record on the
     AppSrv-TT table */
  IF AVAILABLE(RowObjUpd) AND
     RowObjUpd.PtnTblRecid <> ? THEN
  DO:
    setUserProperty(INPUT "CurrRecid":U, INPUT STRING(INTEGER(RowObjUpd.PtnTblRecid))).
  END.
  ELSE
  DO:
    setUserProperty(INPUT "CurrRecid":U, INPUT "?":U).
  END.


END PROCEDURE.

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

{&DB-REQUIRED-END}

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE writeBatch dTables 
PROCEDURE writeBatch :
/*------------------------------------------------------------------------------
  Purpose:     Writes the contents of the local temp-table back to AppServ-TT
               and notifies that the contents have changed.
  Parameters:  <none>
  Notes:       
------------------------------------------------------------------------------*/
/*  DEFINE VARIABLE lChanged   AS LOGICAL    NO-UNDO.
  DEFINE VARIABLE lAns       AS LOGICAL    NO-UNDO.
  DEFINE VARIABLE hContainer AS HANDLE     NO-UNDO.

  /* Go through all the local records */
  FOR EACH ttAppSrv-TT:
    lAns = NO.
    FIND AppSrv-TT NO-LOCK  /* Find the matching global record */
      WHERE AppSrv-TT.Partition = ttAppSrv-TT.Partition
      NO-ERROR.
    IF NOT AVAILABLE(AppSrv-TT) THEN /* If a global record does not exist, create it */
    DO:
      CREATE AppSrv-TT.
      lAns = YES.  /* Set the lAns flag to note that AppServ-TT must be updated */
    END.
    ELSE
    DO:
      BUFFER-COMPARE ttAppSrv-TT /* Compare for changes */
        USING 
            App-Service
            Configuration
            Host 
            Info 
            Partition 
            PartitionType
            Security 
            Service 
            ServerURL
            Parameters
        TO AppSrv-TT
        /* Buffer-compare returns NO if the records do not match */
        SAVE RESULT IN lAns.
      lAns = NOT lAns. /* If there have been changes set lAns to yes */
    END.
    /* If we have noted that we need to update AppServ-TT, copy the record here */
    IF lAns THEN
    DO:
      BUFFER-COPY ttAppSrv-TT TO AppSrv-TT
        ASSIGN AppSrv-TT.PartitionType = cPtnType. /* If a new record is created, we need to set the partition type. */
      lChanged = YES. /* This flag indicates *ANY* change to AppServ-TT */
    END.
  END.
  
  /* If the user has deleted a partition we need to get rid of it in AppServ-TT
     here. */
  FOR EACH AppSrv-TT 
    WHERE AppSrv-TT.PartitionType = cPtnType:
    IF NOT CAN-FIND(ttAppSrv-TT WHERE ttAppSrv-TT.Partition = AppSrv-TT.Partition) THEN
    DO:
      DELETE AppSrv-TT.
      lChanged = YES.
    END.
  END.
  
  /* If any changes have been made to AppServ-TT, notify all subscribers */
  IF lChanged THEN
    PUBLISH 'tableChanged':U. */

END PROCEDURE.

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

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

{&DB-REQUIRED-START}

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION deleteRow dTables  _DB-REQUIRED
FUNCTION deleteRow RETURNS LOGICAL
  ( INPUT pcRowIdent AS CHARACTER) :
/*------------------------------------------------------------------------------
  Purpose:     Super Override
  Notes:       
------------------------------------------------------------------------------*/
  DEFINE VARIABLE iRow AS INTEGER    NO-UNDO.

  /* Code placed here will execute PRIOR to standard behavior. */

  SUPER( INPUT pcRowIdent ).

  iRow = INTEGER(getUserProperty("CurrRecid":U)).
  IF iRow <> ? THEN
  DO TRANSACTION:
    FIND FIRST AppSrv-TT WHERE RECID(AppSrv-TT) = iRow NO-ERROR.
    IF AVAILABLE(AppSrv-TT) THEN
    DO:
      DELETE AppSrv-TT.
      PUBLISH 'tableChanged':U. 
    END.
  END.

  RETURN TRUE.

END FUNCTION.

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

{&DB-REQUIRED-END}

{&DB-REQUIRED-START}

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION submitRow dTables  _DB-REQUIRED
FUNCTION submitRow RETURNS LOGICAL
  ( INPUT pcRowIdent AS CHARACTER,
    INPUT pcValueList AS CHARACTER) :
/*------------------------------------------------------------------------------
  Purpose:     Super Override
  Notes:       
------------------------------------------------------------------------------*/

  /* If the rows have all been deleted, we don't want submitRow to run
     when the window is closed. */
  IF NOT AVAILABLE(RowObject) THEN 
    RETURN FALSE.
  
  RETURN SUPER( INPUT pcRowIdent, INPUT pcValueList ).

END FUNCTION.

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

{&DB-REQUIRED-END}

/* protools/dappsrv_cl.w - non-db proxy for protools/dappsrv.w */

&GLOBAL-DEFINE DB-REQUIRED FALSE

{"protools/dappsrv.w"}
&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        : protools/makeflds.w
    Purpose     : To generate a space delimited list of fields from 
                  a comma delimited list of tables

    Syntax      : RUN protools/makeflds.w (INPUT incFile, INPUT tblList,
                           OUTPUT fldList, OUTPUT asnList, OUTPUT fldRebuild)

    Description : This procedure does 4 things:
                  1) Generates a space delimited list of unique field
                     names (fldList) from a comma delimited list of
                     tables (tblList)
                  2) Generates a space delimited list of assignments of
                     fields that occur in more than 1 table
                  3) Generates a SmartData object style include file
                     (named incFile) that has field definitions in it.
                  4) Generates the structured comment (fldRebuild) needed
                     to reconstruct the SmartData Object's field information
                     when read back into the UIB.

    Author(s)   : Ross Hunter
    Created     : March 18, 1998
    Notes       : This is only called when at least one database is connected
    
    Modified    : 04/13/99  tsm  Added support for various Intl Numeric
                                 formats (in addition to American and 
                                 European) by using set-numeric-format
                                 method to set format back to user's setting
        
  ------------------------------------------------------------------------*/
/*          This .W file was created with the Progress UIB.             */
/*----------------------------------------------------------------------*/

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

DEFINE INPUT  PARAMETER incFile    AS CHARACTER                   NO-UNDO.
DEFINE INPUT  PARAMETER tblList    AS CHARACTER                   NO-UNDO.
DEFINE OUTPUT PARAMETER fldList    AS CHARACTER                   NO-UNDO.
DEFINE OUTPUT PARAMETER fListByTbl AS CHARACTER                   NO-UNDO.
DEFINE OUTPUT PARAMETER asnList    AS CHARACTER                   NO-UNDO.
DEFINE OUTPUT PARAMETER fldRbld    AS CHARACTER                   NO-UNDO.

DEFINE VARIABLE cl_file       AS CHARACTER                        NO-UNDO.
DEFINE VARIABLE ext           AS INTEGER                          NO-UNDO.
DEFINE VARIABLE fldCnt        AS INTEGER                          NO-UNDO.
DEFINE VARIABLE flddef        AS CHARACTER                        NO-UNDO.
DEFINE VARIABLE i             AS INTEGER                          NO-UNDO.
DEFINE VARIABLE listPos       AS INTEGER                          NO-UNDO.
DEFINE VARIABLE tblName       AS CHARACTER                        NO-UNDO.
DEFINE VARIABLE SaveSeparator AS CHARACTER                        NO-UNDO.
DEFINE VARIABLE SaveDecimal   AS CHARACTER                        NO-UNDO.

DEFINE STREAM incfl.

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

ASSIGN SaveSeparator          = SESSION:NUMERIC-SEPARATOR
       SaveDecimal            = SESSION:NUMERIC-DECIMAL-POINT
       SESSION:NUMERIC-FORMAT = "AMERICAN".
DO i = 1 TO NUM-ENTRIES(tblList):      /* Loop through the tables       */
  tblName = ENTRY(i,tblList).
  IF NUM-ENTRIES(tblName, ".") = 2 THEN
    ASSIGN tblName = ENTRY(2, tblName, ".").  /* Strip off the dbname if there */
  FIND _FILE WHERE _FILE._FILE-NAME = tblName NO-ERROR.
  IF AVAILABLE _FILE THEN DO:
    ASSIGN fListByTbl = (IF fListByTBL NE "" THEN fListByTbl + CHR(10) ELSE "") +
                        "~&Scoped-define ENABLED-FIELDS-IN-" + _FILE._FILE-NAME + " ".
    FOR EACH _FIELD OF _FILE:
      IF _FIELD._EXTENT EQ 0 THEN DO:
        listPos = LOOKUP(_FIELD._FIELD-NAME, fldList, " ").
        IF listPos eq 0 THEN
          ASSIGN fldCnt  = fldCnt + 1
                 fldList = fldList + _FIELD._FIELD-NAME + " "
                 fListByTbl = fListByTbl + _FIELD._FIELD-NAME + " "
                 flddef  = flddef + (IF fldCnt > 1 THEN CHR(10) ELSE "") +
                           "  FIELD " + _FIELD._FIELD-NAME + " LIKE " +
                           tblName + "." + _FIELD._FIELD-NAME + " VALIDATE ~~"
                 fldRbld = fldRbld + (IF fldCnt > 1 THEN CHR(10) ELSE "") +
                           "     _FldNameList[" + STRING(fldCnt) + "]   > " +
                           LDBNAME("DICTDB") + "." + tblName + "." + 
                           _FIELD._FIELD-NAME + CHR(10) +
                           '"' + _FIELD._FIELD-NAME + '" ' +
                           '"' + _FIELD._FIELD-NAME + '" ? ? "' +
                           _FIELD._DATA-TYPE + '" ? ? ? ? ? ? yes ? no ' +
                           (IF _FIELD._DATA-TYPE = "DATE" THEN
                               STRING(FONT-TABLE:GET-TEXT-WIDTH-CHARS(_FIELD._FORMAT))
                            ELSE IF _FIELD._DATA-TYPE BEGINS "C" THEN
                               STRING(LENGTH(STRING("A",_FIELD._FORMAT), "RAW":U))
                            ELSE IF _FIELD._DATA-TYPE BEGINS "L" THEN
                               STRING(MAXIMUM(FONT-TABLE:GET-TEXT-WIDTH-CHARS(STRING(YES,_FIELD._FORMAT)),
                                        FONT-TABLE:GET-TEXT-WIDTH-CHARS(STRING(NO, _FIELD._FORMAT))))
                            ELSE STRING(FONT-TABLE:GET-TEXT-WIDTH-CHARS(_FIELD._FORMAT))) +
                            " yes no no no no no no".
        ELSE
          ASSIGN asnList = asnList + "rowObject." + _FIELD._FIELD-NAME + " = " +
                           ENTRY(4, ENTRY(listPos, flddef, CHR(10)), " ") + " ".
      END.  /* If a scalar field */
      ELSE DO:  /* An array field */
        listPos = LOOKUP(_FIELD._FIELD-NAME + "1", fldList, " ").
        IF listPos eq 0 THEN DO:
          DO ext = 1 TO _FIELD._EXTENT:
            ASSIGN fldCnt  = fldCnt + 1
                   fldList = fldList + _FIELD._FIELD-NAME + STRING(ext) + " "
                   fListByTbl = fListByTbl + _FIELD._FIELD-NAME + STRING(ext) + " "
                   flddef  = flddef + (IF fldCnt > 1 THEN CHR(10) ELSE "") +
                             "  FIELD " + _FIELD._FIELD-NAME + STRING(ext) + " LIKE " +
                             tblName + "." + _FIELD._FIELD-NAME + "[" + STRING(ext) +
                                           "] VALIDATE ~~"
                   fldRbld = fldRbld + (IF fldCnt > 1 THEN CHR(10) ELSE "") +
                             "     _FldNameList[" + STRING(fldCnt) + "]   > " +
                             LDBNAME("DICTDB") + "." + tblName + "." + 
                             _FIELD._FIELD-NAME + "[" + STRING(ext) + "]" + CHR(10) +
                             '"' + _FIELD._FIELD-NAME + "[" + STRING(ext) + ']" ' +
                             '"' + _FIELD._FIELD-NAME + STRING(ext) + '" ? ? "' +
                             _FIELD._DATA-TYPE + '" ? ? ? ? ? ? yes ? no ' +
                             (IF _FIELD._DATA-TYPE = "DATE" THEN
                                 STRING(FONT-TABLE:GET-TEXT-WIDTH-CHARS(_FIELD._FORMAT))
                              ELSE IF _FIELD._DATA-TYPE BEGINS "C" THEN
                                 STRING(LENGTH(STRING("A",_FIELD._FORMAT), "RAW":U))
                             ELSE IF _FIELD._DATA-TYPE BEGINS "L" THEN
                                 STRING(MAXIMUM(FONT-TABLE:GET-TEXT-WIDTH-CHARS(STRING(YES,_FIELD._FORMAT)),
                                          FONT-TABLE:GET-TEXT-WIDTH-CHARS(STRING(NO, _FIELD._FORMAT))))
                              ELSE STRING(FONT-TABLE:GET-TEXT-WIDTH-CHARS(_FIELD._FORMAT))) +
                              " yes no no no no no no".
         END. /* ext = 1 to extent */
        END. /* If it isn't all ready in the list */                 
        ELSE
          ASSIGN asnList = asnList + "rowObject." + _FIELD._FIELD-NAME + " = " +
                           ENTRY(4, ENTRY(listPos, flddef, CHR(10)), " ") + " ".
        
      END.  /* Else an array field */
    END. /* FOR EACH _FIELD */
  END. /* If we found the _FILE record of the table */
END.  /* For all tables in the list */

/* Trim of the final space */
ASSIGN fldList                = TRIM(fldList)
       fListByTbl             = TRIM(fListByTbl)
       asnList                = TRIM(asnList)
       flddef                 = TRIM(flddef,"~~").
       
SESSION:SET-NUMERIC-FORMAT(SaveSeparator,SaveDecimal).

/* Write out the associated include file */
OUTPUT STREAM incfl TO VALUE(incFile).
PUT STREAM incfl UNFORMATTED flddef SKIP.
OUTPUT STREAM incfl CLOSE.

/* Write out the associated proxy file */
cl_file = ENTRY(1, incFile,".":U) + "_cl.w".
OUTPUT STREAM incfl TO VALUE(cl_file).
PUT STREAM incfl UNFORMATTED "/* " + cl_file + " - non-db proxy for " +
                 ENTRY(1, cl_file, "_":U) + ".w */" SKIP (1)
                 "~&GLOBAL-DEFINE DB-REQUIRED FALSE" SKIP (1)
                 "~{" + ENTRY(1, cl_file, "_":U) + ".w~}" SKIP.
OUTPUT STREAM incfl CLOSE.

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


"Color Changer" "protools/_colorch.w" "adeicon/clrchnge" yes yes 10 no
"Config info" "protools/_procfg.w" "adeicon/cnfginfo.bmp" yes yes 20 no
"Control Hierarchy" "protools/_walker.w" "adeicon/cntrlhry" yes yes 30 no
"DB List" "protools/_dblist.w" "adeicon/dblist" yes yes 40 no
"OS Prompt" "protools/_osprmt.p" "adeicon/osprompt" no yes 50 no
"Set Font 2" "protools/_edfont.p" "adeicon/setfont" no yes 60 no
"Editor" "protools/_pwedit.p" "adeicon/editor" no yes 70 no
"Procedures" "protools/_ppmgr.w" "adeicon/procedur" yes yes 80 no
"Propath" "protools/_propath.w" "adeicon/propath" no yes 90 no
"Run" "protools/_runfile.w" "adeicon/run" yes yes 100 no
"Session" "protools/_session.w" "adeicon/session" no yes 110 no
"Window Viewer" "protools/_winmgr.w" "adeicon/windview" no yes 120 no
"Windows Info" "protools/_wabout.p" "adeicon/wininfo" no yes 130 no
"Screen Capture" "protools/_scrcap.w" "adeicon/scrcap" yes yes 140 no
"SmartObject Upgrade Utility" "protools/_v89conv.w" "adeicon/smoupgrd" yes yes 150 no
"Screen Scaling Utility" "protools/_ppuscl.p" "adeicon/fntupgrd" no yes 160 no
"ADM to Dynamics" "adeuib/_convertadm2dynamics.w" "adeicon/admtodyn.gif" yes yes 170 no
"Progress COM Object Viewer" "protools/_proobjv.p" "adeicon/proobjvw" no yes 180 no
"Service Parameter Maintenance" "protools/waspartn.w" "adeicon/appsrvr" yes yes 190 no
"ProtoGen" "protools/_protgen.w" "adeicon/protogen" yes yes 200 no
"AppServer Information" "protools/_asinfo.w" "adeicon/asinfo" no yes 210 no
"Pro*Spy Plus" "protools/_psplus.w" "adeicon/prospy9.bmp" yes yes 220 no
"WebClient Application Assembler" "protools/_prowcapped.p" "adeicon/prowcapped" no yes 230 no
"WebClient Deployment Packager" "protools/_prowcappdp.p" "adeicon/prowcappdp" no yes 240 no
"XML Schema Mapping" "adexml/_xmlview.w" "adexml/images/xmlmap" yes yes 250 no
"Widget Attr Help" "protools/widattrs.w" "adeicon/w-widattrs-sm" yes yes 260 no
"Static Widget ID Assignment" "protools/_widgetidassign.p" "adeicon/widgidassign" no yes 270 no
"Runtime Widget ID Assignment" "protools/_runtimewidgetid.p" "adeicon/assignwid.gif" no yes 280 no&ANALYZE-SUSPEND _VERSION-NUMBER UIB_v9r12 GUI
&ANALYZE-RESUME
&Scoped-define WINDOW-NAME C-Win
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _DEFINITIONS C-Win 
/*------------------------------------------------------------------------

  File: _psfiltwin.w

  Description: Filter dialog used with Pro*Spy Plus

  Parameters:
  INPUT-OUTPUT pcFilter AS CHARACTER -- Filter criteria; This is the actual 
                                        query string that is passed to the query 
  INPUT-OUTPUT pcLabels AS CHARACTER -- This is the query for display purposes,
                                        with the fields' labels rather than the
                                        field names
  Author: Kenneth S. McIntosh

  History: Submitted December 16, 2002

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

/* Parameters Definitions ---                                           */

DEFINE INPUT-OUTPUT PARAMETER pcFilter  AS CHARACTER  NO-UNDO.
DEFINE INPUT-OUTPUT PARAMETER pcLabels  AS CHARACTER  NO-UNDO.
DEFINE OUTPUT       PARAMETER plApplied AS LOGICAL    NO-UNDO.

/* Local Variable Definitions ---                                       */

DEFINE VARIABLE cValue       AS CHARACTER  NO-UNDO.
DEFINE VARIABLE cChoice      AS CHARACTER  NO-UNDO.
DEFINE VARIABLE gcResults    AS CHARACTER  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 DEFAULT-FRAME

/* Standard List Definitions                                            */
&Scoped-Define ENABLED-OBJECTS slOptions btnEqual btnNE btnGT btnLT btnGTEQ ~
btnLTEQ btnBegins btnMatches btnContains btnAnd btnOr btnUndo btnClear ~
edResults BtnHelp BtnClose BtnApply RECT-1 
&Scoped-Define DISPLAYED-OBJECTS slOptions lblOptions edResults 

/* Custom List Definitions                                              */
/* OPERATOR-BTNS,TERMS-BTNS,List-3,List-4,List-5,List-6                 */
&Scoped-define OPERATOR-BTNS btnEqual btnNE btnGT btnLT btnGTEQ btnLTEQ ~
btnBegins btnMatches btnContains 
&Scoped-define TERMS-BTNS btnAnd btnOr 

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



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

/* Define the widget handle for the window                              */
DEFINE VAR C-Win AS WIDGET-HANDLE NO-UNDO.

/* Definitions of the field level widgets                               */
DEFINE BUTTON btnAnd 
     LABEL "A&ND" 
     SIZE 15 BY 1.14.

DEFINE BUTTON BtnApply DEFAULT 
     LABEL "&Apply" 
     SIZE 15 BY 1.14
     BGCOLOR 8 .

DEFINE BUTTON btnBegins 
     LABEL "BEGINS" 
     SIZE 12 BY 1.43 TOOLTIP "BEGINS".

DEFINE BUTTON btnClear 
     LABEL "C&lear All" 
     SIZE 15 BY 1.14.

DEFINE BUTTON BtnClose DEFAULT 
     LABEL "&Cancel" 
     SIZE 15 BY 1.14
     BGCOLOR 8 .

DEFINE BUTTON btnContains 
     LABEL "CONTAINS" 
     SIZE 12 BY 1.43 TOOLTIP "CONTAINS".

DEFINE BUTTON btnEqual 
     LABEL "=" 
     SIZE 6 BY 1.43 TOOLTIP "Equal To".

DEFINE BUTTON btnGT 
     LABEL ">" 
     SIZE 6 BY 1.43 TOOLTIP "Greater Than".

DEFINE BUTTON btnGTEQ 
     LABEL ">=" 
     SIZE 6 BY 1.43 TOOLTIP "Greater Than or Equal To".

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

DEFINE BUTTON btnLT 
     LABEL "<" 
     SIZE 6 BY 1.43 TOOLTIP "Less Than".

DEFINE BUTTON btnLTEQ 
     LABEL "<=" 
     SIZE 6 BY 1.43 TOOLTIP "Less Than or Equal To".

DEFINE BUTTON btnMatches 
     LABEL "MATCHES" 
     SIZE 12 BY 1.43 TOOLTIP "MATCHES".

DEFINE BUTTON btnNE 
     LABEL "<>" 
     SIZE 6 BY 1.43 TOOLTIP "Not Equal To".

DEFINE BUTTON btnOr 
     LABEL "&OR" 
     SIZE 15 BY 1.14.

DEFINE BUTTON btnUndo 
     LABEL "&UNDO" 
     SIZE 15 BY 1.14.

DEFINE VARIABLE edResults AS CHARACTER 
     VIEW-AS EDITOR NO-WORD-WRAP SCROLLBAR-HORIZONTAL SCROLLBAR-VERTICAL
     SIZE 86 BY 4.76
     FONT 0 NO-UNDO.

DEFINE VARIABLE lblOptions AS CHARACTER FORMAT "X(256)":U INITIAL "Options:" 
     VIEW-AS FILL-IN 
     SIZE 15 BY .71 NO-UNDO.

DEFINE RECTANGLE RECT-1
     EDGE-PIXELS 2000  NO-FILL 
     SIZE 28 BY 5.24.

DEFINE VARIABLE slOptions AS CHARACTER 
     VIEW-AS SELECTION-LIST SINGLE SCROLLBAR-VERTICAL 
     LIST-ITEM-PAIRS "Target Procedure","tTarget",
                     "Statement Source","tSrcProc",
                     "Procedure Name/Event","tProcName",
                     "Source File","tSource",
                     "Event Type","tType",
                     "Parameters","tParms" 
     SIZE 36.6 BY 5.76
     FONT 0 NO-UNDO.


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

DEFINE FRAME DEFAULT-FRAME
     slOptions AT ROW 2.19 COL 2.4 NO-LABEL
     lblOptions AT ROW 1.24 COL 2 NO-LABEL NO-TAB-STOP 
     btnEqual AT ROW 2.91 COL 41.8
     btnNE AT ROW 2.91 COL 47.8
     btnGT AT ROW 2.91 COL 53.8
     btnLT AT ROW 2.91 COL 59.8
     btnGTEQ AT ROW 4.33 COL 41.8
     btnLTEQ AT ROW 4.33 COL 47.8
     btnBegins AT ROW 4.33 COL 53.8
     btnMatches AT ROW 5.76 COL 41.8
     btnContains AT ROW 5.76 COL 53.8
     btnAnd AT ROW 2.43 COL 72
     btnOr AT ROW 3.62 COL 72
     btnUndo AT ROW 5.29 COL 72
     btnClear AT ROW 6.48 COL 72
     edResults AT ROW 8.38 COL 2 NO-LABEL
     BtnHelp AT ROW 14.1 COL 2
     BtnClose AT ROW 14.1 COL 57
     BtnApply AT ROW 14.1 COL 73
     RECT-1 AT ROW 2.43 COL 40
    WITH 1 DOWN NO-BOX KEEP-TAB-ORDER OVERLAY 
         SIDE-LABELS NO-UNDERLINE THREE-D 
         AT COL 1 ROW 1
         SIZE 88.8 BY 14.33.


/* *********************** 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              = "Pro*Spy Plus Filter"
         HEIGHT             = 14.33
         WIDTH              = 88.8
         MAX-HEIGHT         = 16
         MAX-WIDTH          = 118.4
         VIRTUAL-HEIGHT     = 16
         VIRTUAL-WIDTH      = 118.4
         SHOW-IN-TASKBAR    = no
         MIN-BUTTON         = no
         MAX-BUTTON         = no
         ALWAYS-ON-TOP      = yes
         RESIZE             = no
         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.

&IF '{&WINDOW-SYSTEM}' NE 'TTY' &THEN
IF NOT C-Win:LOAD-SMALL-ICON("adeicon/prospy9.ico":U) THEN
    MESSAGE "Unable to load small icon: adeicon/prospy9.ico"
            VIEW-AS ALERT-BOX WARNING BUTTONS OK.
&ENDIF
/* END WINDOW DEFINITION                                                */
&ANALYZE-RESUME

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _INCLUDED-LIB C-Win 
/* ************************* Included-Libraries *********************** */

{adecomm/_adetool.i}

/* _UIB-CODE-BLOCK-END */
&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
   Custom                                                               */
/* SETTINGS FOR BUTTON btnAnd IN FRAME DEFAULT-FRAME
   2                                                                    */
/* SETTINGS FOR BUTTON btnBegins IN FRAME DEFAULT-FRAME
   1                                                                    */
/* SETTINGS FOR BUTTON btnContains IN FRAME DEFAULT-FRAME
   1                                                                    */
/* SETTINGS FOR BUTTON btnEqual IN FRAME DEFAULT-FRAME
   1                                                                    */
/* SETTINGS FOR BUTTON btnGT IN FRAME DEFAULT-FRAME
   1                                                                    */
/* SETTINGS FOR BUTTON btnGTEQ IN FRAME DEFAULT-FRAME
   1                                                                    */
/* SETTINGS FOR BUTTON btnLT IN FRAME DEFAULT-FRAME
   1                                                                    */
/* SETTINGS FOR BUTTON btnLTEQ IN FRAME DEFAULT-FRAME
   1                                                                    */
/* SETTINGS FOR BUTTON btnMatches IN FRAME DEFAULT-FRAME
   1                                                                    */
/* SETTINGS FOR BUTTON btnNE IN FRAME DEFAULT-FRAME
   1                                                                    */
/* SETTINGS FOR BUTTON btnOr IN FRAME DEFAULT-FRAME
   2                                                                    */
ASSIGN 
       edResults:READ-ONLY IN FRAME DEFAULT-FRAME        = TRUE.

/* SETTINGS FOR FILL-IN lblOptions IN FRAME DEFAULT-FRAME
   NO-ENABLE ALIGN-L                                                    */
IF SESSION:DISPLAY-TYPE = "GUI":U AND VALID-HANDLE(C-Win)
THEN C-Win:HIDDEN = no.

/* _RUN-TIME-ATTRIBUTES-END */
&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 /* Pro*Spy Plus Filter */
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 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 /* Pro*Spy Plus Filter */
DO:
  /* This event will close the window and terminate the procedure.  */
  APPLY "CLOSE":U TO THIS-PROCEDURE.
  RETURN NO-APPLY.
END.

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


&Scoped-define SELF-NAME btnAnd
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL btnAnd C-Win
ON CHOOSE OF btnAnd IN FRAME DEFAULT-FRAME /* AND */
DO:
  ASSIGN gcResults              = edResults:SCREEN-VALUE 
         btnUndo:SENSITIVE      = TRUE
         edResults:SCREEN-VALUE = edResults:SCREEN-VALUE + ' ' + 
                                  REPLACE(SELF:LABEL,'&','')
         slOptions:SENSITIVE    = TRUE.
  DISABLE {&TERMS-BTNS} btnApply WITH FRAME {&FRAME-NAME}.
  APPLY 'ENTRY' TO slOptions.
END.

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


&Scoped-define SELF-NAME BtnApply
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL BtnApply C-Win
ON CHOOSE OF BtnApply IN FRAME DEFAULT-FRAME /* Apply */
DO:
  ASSIGN gcResults = edResults:SCREEN-VALUE 
         gcResults = REPLACE(gcResults,'Target Procedure','tTarget')
         gcResults = REPLACE(gcResults,'Statement Source','tSrcProc')
         gcResults = REPLACE(gcResults,'Procedure Name/Event','tProcName')
         gcResults = REPLACE(gcResults,'Source File','tSource')
         gcResults = REPLACE(gcResults,'Event Type','tType')
         gcResults = REPLACE(gcResults,'Parameters','tParms')
         pcFilter  = gcResults
         pcLabels  = edResults:SCREEN-VALUE
         plApplied = TRUE.

  APPLY "CLOSE":U TO THIS-PROCEDURE.
END.

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


&Scoped-define SELF-NAME btnClear
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL btnClear C-Win
ON CHOOSE OF btnClear IN FRAME DEFAULT-FRAME /* Clear All */
DO:
  ASSIGN gcResults              = ''
         edResults:SCREEN-VALUE = ''
         slOptions:SENSITIVE    = TRUE
         btnAnd:SENSITIVE       = FALSE
         btnOr:SENSITIVE        = FALSE
         btnApply:SENSITIVE     = TRUE.
END.

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


&Scoped-define SELF-NAME BtnClose
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL BtnClose C-Win
ON CHOOSE OF BtnClose IN FRAME DEFAULT-FRAME /* Cancel */
DO:
  &IF "{&PROCEDURE-TYPE}" EQ "SmartPanel" &THEN
    &IF "{&ADM-VERSION}" EQ "ADM1.1" &THEN
      RUN dispatch IN THIS-PROCEDURE ('exit').
    &ELSE
      RUN exitObject.
    &ENDIF
  &ELSE
      APPLY "CLOSE":U TO THIS-PROCEDURE.
  &ENDIF
END.

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


&Scoped-define SELF-NAME BtnHelp
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL BtnHelp C-Win
ON CHOOSE OF BtnHelp IN FRAME DEFAULT-FRAME /* Help */
OR HELP OF FRAME {&FRAME-NAME}
DO: 
  DEFINE VARIABLE iVersion AS INTEGER    NO-UNDO.

  iVersion = INTEGER(ENTRY(1,PROVERSION,".":U)) NO-ERROR.

  IF iVersion > 9 THEN
    RUN adecomm/_adehelp.p ( INPUT "ptls",
                             INPUT "CONTEXT",
                             INPUT 81,
                             INPUT ? ).
  ELSE
    MESSAGE "No application help available at this time."
        VIEW-AS ALERT-BOX INFO BUTTONS OK.
END.

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


&Scoped-define SELF-NAME btnOr
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL btnOr C-Win
ON CHOOSE OF btnOr IN FRAME DEFAULT-FRAME /* OR */
DO:
  ASSIGN gcResults              = edResults:SCREEN-VALUE 
         btnUndo:SENSITIVE      = TRUE
         edResults:SCREEN-VALUE = edResults:SCREEN-VALUE + ' ' + 
                                  REPLACE(SELF:LABEL,'&','')
         slOptions:SENSITIVE    = TRUE.
  DISABLE {&TERMS-BTNS} btnApply WITH FRAME {&FRAME-NAME}.
  APPLY 'ENTRY' TO slOptions.
END.

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


&Scoped-define SELF-NAME btnUndo
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL btnUndo C-Win
ON CHOOSE OF btnUndo IN FRAME DEFAULT-FRAME /* UNDO */
DO:
  edResults:SCREEN-VALUE = gcResults.
  IF gcResults = '' OR gcResults = ? THEN
    slOptions:SENSITIVE = TRUE.
  ELSE ENABLE {&TERMS-BTNS} btnApply WITH FRAME {&FRAME-NAME}.

  RUN setOperators ( INPUT 'DISABLE' ).
  SELF:SENSITIVE = FALSE.

  IF edResults:SCREEN-VALUE EQ '' OR edResults:SCREEN-VALUE EQ ? THEN
    DISABLE {&TERMS-BTNS} WITH FRAME {&FRAME-NAME}.
END.

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


&Scoped-define SELF-NAME slOptions
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL slOptions C-Win
ON DEFAULT-ACTION OF slOptions IN FRAME DEFAULT-FRAME
DO:
  btnUndo:SENSITIVE = TRUE.
  btnApply:SENSITIVE = FALSE.
  edResults:SCREEN-VALUE = edResults:SCREEN-VALUE + 
                           (IF edResults:SCREEN-VALUE NE '' THEN ' '
                            ELSE '') + cChoice.
  slOptions:SENSITIVE = FALSE.

  RUN setOperators ( INPUT 'ENABLE' ).
  APPLY 'ENTRY' TO btnEqual.
END.

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


&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL slOptions C-Win
ON VALUE-CHANGED OF slOptions IN FRAME DEFAULT-FRAME
DO:
  cChoice = ENTRY(LOOKUP(slOptions:SCREEN-VALUE,
                         slOptions:LIST-ITEM-PAIRS) - 1,
                  slOptions:LIST-ITEM-PAIRS).

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 loadOptions.

  /* Setup generic trigger for operator buttons to reduce code size. */
  ON 'CHOOSE':U OF btnBegins, 
                   btnContains, 
                   btnEqual, 
                   btnGT, 
                   btnGTEQ, 
                   btnLT, 
                   btnLTEQ, 
                   btnMatches, 
                   btnNE            
            IN FRAME {&FRAME-NAME} DO:

    RUN protools/_psvaldlg.w ( INPUT cChoice,
                               INPUT SELF:LABEL,
                               OUTPUT cValue ).
    IF cValue NE ? THEN DO:
      edResults:SCREEN-VALUE = edResults:SCREEN-VALUE + ' ' + 
                               SELF:LABEL + ' ~'' + cValue + '~''.
      RUN setOperators ( INPUT 'DISABLE' ).
      ENABLE {&TERMS-BTNS} btnApply WITH FRAME {&FRAME-NAME}.
      APPLY 'ENTRY' TO btnApply IN FRAME {&FRAME-NAME}.
    END.
  END.

  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 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 slOptions lblOptions edResults 
      WITH FRAME DEFAULT-FRAME IN WINDOW C-Win.
  ENABLE slOptions btnEqual btnNE btnGT btnLT btnGTEQ btnLTEQ btnBegins 
         btnMatches btnContains btnAnd btnOr btnUndo btnClear edResults BtnHelp 
         BtnClose BtnApply RECT-1 
      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 loadOptions C-Win 
PROCEDURE loadOptions :
/*------------------------------------------------------------------------------
  Purpose:     Loads up the options in the Options Selection List and initializes
               it's state
  Parameters:  <none>
  Notes:       
------------------------------------------------------------------------------*/
  DO WITH FRAME {&FRAME-NAME}:
    APPLY 'VALUE-CHANGED' TO slOptions.
    RUN setOperators ( INPUT 'DISABLE' ).

    IF pcFilter EQ '' OR pcFilter EQ ? THEN
      DISABLE {&TERMS-BTNS}.

    ELSE DO:
      ENABLE {&TERMS-BTNS}.
      ASSIGN edResults:SCREEN-VALUE = pcLabels
             slOptions:SENSITIVE    = FALSE.
    END.
    btnUndo:SENSITIVE = FALSE.
  END.
END PROCEDURE.

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

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE setOperators C-Win 
PROCEDURE setOperators :
/*------------------------------------------------------------------------------
  Purpose:     Resets the state of the operator buttons according to pcState
  Parameters:  INPUT pcState AS CHARACTER
  Notes:       
------------------------------------------------------------------------------*/
  DEFINE INPUT  PARAMETER pcState AS CHARACTER  NO-UNDO.

  IF pcState EQ 'ENABLE' THEN DO:
    ENABLE {&OPERATOR-BTNS} WITH FRAME {&FRAME-NAME}.
    IF cChoice NE 'Parameters' THEN
      btnContains:SENSITIVE IN FRAME {&FRAME-NAME} = FALSE.
  END.
  ELSE
    DISABLE  {&OPERATOR-BTNS} WITH FRAME {&FRAME-NAME}.
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.                           *
*                                                                    *
*********************************************************************/
DEFINE {&new} SHARED VAR c-pgm-filter      AS CHAR                   NO-UNDO.
DEFINE {&new} SHARED VAR c-filter          AS CHAR                   NO-UNDO.
DEFINE {&new} SHARED VAR c-pgm-break       AS CHAR                   NO-UNDO.
DEFINE {&new} SHARED VAR c-break           AS CHAR                   NO-UNDO.
DEFINE {&new} SHARED VAR c-break-on        AS CHAR                   NO-UNDO.
DEFINE {&new} SHARED VAR cx-event-list     AS CHAR EXTENT 4          NO-UNDO.

DEFINE {&new} SHARED VAR app_handle        AS HANDLE                 NO-UNDO.
DEFINE {&new} SHARED VAR ps_window         AS HANDLE                 NO-UNDO.

DEFINE {&new} SHARED VAR msgcnt            AS INT FORMAT "z9" INIT 1 NO-UNDO.

DEFINE {&new} SHARED TEMP-TABLE pgm-bf
    FIELD cFileName AS CHAR FORMAT "X(35)":U LABEL "Title"
    FIELD cType     AS LOG  FORMAT "Break/Filter"
    FIELD cMethod   AS CHAR FORMAT "X(35)":U LABEL "Break/Filter"
    INDEX cNameType IS PRIMARY cFileName cType 
    INDEX cType     cType
    .               

DEFINE {&new} SHARED TEMP-TABLE pp
    FIELD pHandle    AS WIDGET-HANDLE
    FIELD cFileName  AS CHAR FORMAT "X(35)":U LABEL "Title" 
    FIELD cMethod    AS CHAR FORMAT "X(35)":U LABEL "Methods"
    INDEX cFileName  IS PRIMARY cFileName  
    INDEX cMethod    cMethod
    .

DEFINE {&new} SHARED TEMP-TABLE def-bf
    FIELD cFileName  AS CHAR FORMAT "X(35)":U LABEL "Title" 
    FIELD cMethod    AS CHAR FORMAT "X(35)":U LABEL "Methods"
    INDEX cFileName  IS PRIMARY cFileName cMethod
    .

DEFINE {&new} SHARED TEMP-TABLE adm-methods-bf
    FIELD  slctmethod AS CHAR FORMAT "X(30)":U LABEL "Methods"
    INDEX  slctmethod IS PRIMARY slctmethod
    .
&ANALYZE-SUSPEND _VERSION-NUMBER UIB_v9r12 GUI
&ANALYZE-RESUME
&Scoped-define WINDOW-NAME C-Win
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _DEFINITIONS C-Win 
/*------------------------------------------------------------------------

  File: _psplus.w

  Description: Tool for post-mortem analysis of application calls.  
               The intent of this tool is to assist in debugging as
               well as education of the call structure of an application.

  Input Parameters:
      <none>

  Output Parameters:
      <none>

  History: Submitted December 16, 2002
          
------------------------------------------------------------------------*/
/*          This .W file was created with the Progress AB.              */
/*----------------------------------------------------------------------*/

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

&GLOBAL-DEFINE M IN FRAME f-Main
&GLOBAL-DEFINE MB IN MENU MENU-BAR-wWin
&GLOBAL-DEFINE MI MENU-ITEM
&GLOBAL-DEFINE PS STREAM pspystream

&IF "{&OPSYS}" = "WIN32" &THEN
  &GLOBAL-DEFINE A A
  &GLOBAL-DEFINE SHELL "SHELL32"
  &GLOBAL-DEFINE HWND LONG
  &GLOBAL-DEFINE INT LONG
&ELSE
  &GLOBAL-DEFINE A
  &GLOBAL-DEFINE SHELL "SHELL.DLL"
  &GLOBAL-DEFINE HWND SHORT
  &GLOBAL-DEFINE INT SHORT
&ENDIF
  
/* Parameters Definitions ---                                           */

/* Local Definitions ---                                       */

DEFINE STREAM pspystream.

DEFINE TEMP-TABLE tSpyInfo RCODE-INFORMATION
        FIELD tType     AS CHARACTER FORMAT "x(10)" LABEL 'Type'
        FIELD tSource   AS CHAR      FORMAT "x(28)" LABEL 'Source File'
        FIELD tSrcProc  AS CHAR      FORMAT "x(28)" LABEL 'Statement Source'
        FIELD tProcName AS CHAR      FORMAT "x(28)" LABEL 'Proc/Event'
        FIELD tTarget   AS CHAR      FORMAT "x(28)" LABEL 'Target Procedure'
        FIELD tLevel    AS INTEGER
        FIELD tParms    AS CHAR      FORMAT "x(10000)" LABEL 'Parameters'
        FIELD tSpyId    AS INTEGER
        FIELD tParentID AS CHARACTER
        FIELD tDescript AS CHARACTER FORMAT "x(500)"
        FIELD tBatch    AS INTEGER
        INDEX tLvlParIdx tSpyId tProcName tSrcProc tLevel tBatch tSource tType
        INDEX tWrdIdx IS WORD-INDEX tParms.

DEFINE QUERY qSpyInfo FOR tSpyInfo SCROLLING.
DEFINE BUFFER bSpyInfo FOR tSpyInfo.

DEFINE VARIABLE glHideADE      AS LOGICAL    NO-UNDO.
DEFINE VARIABLE glHideUIB      AS LOGICAL    NO-UNDO INIT TRUE.
DEFINE VARIABLE glModified     AS LOGICAL    NO-UNDO.
DEFINE VARIABLE glResults      AS LOGICAL    NO-UNDO INIT FALSE.

DEFINE VARIABLE iXPos          AS INTEGER    NO-UNDO.
DEFINE VARIABLE iYPos          AS INTEGER    NO-UNDO.
DEFINE VARIABLE iMinXPos       AS INTEGER    NO-UNDO.
DEFINE VARIABLE giCount        AS INTEGER    NO-UNDO.
DEFINE VARIABLE giWinHeight    AS INTEGER    NO-UNDO.
DEFINE VARIABLE giWinWidth     AS INTEGER    NO-UNDO.
DEFINE VARIABLE giLastBatch    AS INTEGER    NO-UNDO.
DEFINE VARIABLE giCurrentBatch AS INTEGER    NO-UNDO.
DEFINE VARIABLE giMinWidth     AS INTEGER    NO-UNDO INIT 679.
DEFINE VARIABLE giMinHeight    AS INTEGER    NO-UNDO INIT 439.

DEFINE VARIABLE gcFilter       AS CHARACTER  NO-UNDO.
DEFINE VARIABLE gcLabels       AS CHARACTER  NO-UNDO.
DEFINE VARIABLE cState         AS CHARACTER  NO-UNDO.
DEFINE VARIABLE gcOpenLog      AS CHARACTER  NO-UNDO.
DEFINE VARIABLE gcFruList      AS CHARACTER  NO-UNDO.
DEFINE VARIABLE gcBaseTitle    AS CHARACTER  NO-UNDO INIT 'Pro*Spy Plus'.

DEFINE VARIABLE gchTreeView    AS COM-HANDLE NO-UNDO.
DEFINE VARIABLE gchNodes       AS COM-HANDLE NO-UNDO.

DEFINE VARIABLE rowSelected    AS ROWID      NO-UNDO.

DEFINE VARIABLE ghSelectedFont AS HANDLE     NO-UNDO.
DEFINE VARIABLE ghMenu         AS HANDLE     NO-UNDO EXTENT 6.
DEFINE VARIABLE ghExit         AS HANDLE     NO-UNDO.
DEFINE VARIABLE ghRule         AS HANDLE     NO-UNDO.
DEFINE VARIABLE ghWindow       AS HANDLE     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-Main
&Scoped-define BROWSE-NAME filterBrowse

/* Definitions for FRAME f-Main                                         */

/* Standard List Definitions                                            */
&Scoped-Define ENABLED-OBJECTS detailRect btnResults RECT-19 statusRect ~
btnStart btnStop btnMark btnFilter edParms filterBrowse fiStatement ~
fiProcEvent fiStLoc fiTarget fiSourceFile txtParms fiStatus 
&Scoped-Define DISPLAYED-OBJECTS edParms fiStatement fiProcEvent fiStLoc ~
fiTarget fiSourceFile txtParms fiStatus 

/* 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 addNode C-Win 
FUNCTION addNode RETURNS LOGICAL
  ( )  FORWARD.

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

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION-FORWARD changeFont C-Win 
FUNCTION changeFont RETURNS LOGICAL
  ( INPUT phMenu AS HANDLE,
    INPUT piFont AS INTEGER )  FORWARD.

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

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION-FORWARD doesExist C-Win 
FUNCTION doesExist RETURNS LOGICAL
  ( INPUT pcFileName AS CHARACTER )  FORWARD.

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

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION-FORWARD getDescription C-Win 
FUNCTION getDescription RETURNS CHARACTER
  ( INPUT pcType     AS CHARACTER,
    INPUT pcProcName AS CHARACTER,
    INPUT pcTarget   AS CHARACTER,
    INPUT pcSource   AS CHARACTER )  FORWARD.

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

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION-FORWARD getNewId C-Win 
FUNCTION getNewId RETURNS INTEGER
  ( )  FORWARD.

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

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION-FORWARD parseInput C-Win 
FUNCTION parseInput RETURNS LOGICAL
  ( INPUT pcInput 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_Open_Log     LABEL "Open Log"       ACCELERATOR "F3"
       RULE
       MENU-ITEM m_Save_Log     LABEL "Save Log"       ACCELERATOR "F6"
       MENU-ITEM m_Save_Log_As  LABEL "Save Log &As"   ACCELERATOR "SHIFT-F6"
       RULE
       MENU-ITEM m_Close_Log    LABEL "Close Log"      ACCELERATOR "F8"
       RULE.

DEFINE SUB-MENU m_Tools 
       MENU-ITEM m_Start        LABEL "Start Tracing"
       MENU-ITEM m_Stop         LABEL "Stop Tracing"
       RULE
       MENU-ITEM m_Filter       LABEL "Filter"        
       RULE
       MENU-ITEM m_Mark         LABEL "Insert Mark"   .

DEFINE SUB-MENU m_Tree_Font 
       MENU-ITEM m_Largest      LABEL "Largest"       
              TOGGLE-BOX
       MENU-ITEM m_Large        LABEL "Large"         
              TOGGLE-BOX
       MENU-ITEM m_Medium       LABEL "Medium"        
              TOGGLE-BOX
       MENU-ITEM m_Smaller      LABEL "Smaller"       
              TOGGLE-BOX
       MENU-ITEM m_Smallest     LABEL "Smallest"      
              TOGGLE-BOX.

DEFINE SUB-MENU m_View 
       MENU-ITEM m_Refresh_List LABEL "Refresh List"   ACCELERATOR "F5"
       RULE
       MENU-ITEM m_Hide_ADE     LABEL "Hide ADE Procedures"
              TOGGLE-BOX
       MENU-ITEM m_Hide_UIB     LABEL "Hide UIB Mode Objects"
              TOGGLE-BOX
       RULE
       SUB-MENU  m_Tree_Font    LABEL "Tree Font"     .

DEFINE SUB-MENU m_Help 
       MENU-ITEM m_OpenEdge_Master_Help LABEL "OpenEdge &Master Help"
       MENU-ITEM m_Help_Topics  LABEL "PRO*Tools &Help Topics"
       MENU-ITEM m_Prospy_Help  LABEL "&Pro*Spy Plus Help" ACCELERATOR "F1"
       RULE
       MENU-ITEM m_About_PROSpy LABEL "&About Pro*Spy Plus".

DEFINE MENU MENU-BAR-wWin MENUBAR
       SUB-MENU  m_File         LABEL "File"          
       SUB-MENU  m_Tools        LABEL "Tools"         
       SUB-MENU  m_View         LABEL "View"          
       SUB-MENU  m_Help         LABEL "Help"          .


/* Definitions of handles for OCX Containers                            */
DEFINE VARIABLE CtrlFrame AS WIDGET-HANDLE NO-UNDO.
DEFINE VARIABLE chCtrlFrame AS COMPONENT-HANDLE NO-UNDO.

/* Definitions of the field level widgets                               */
DEFINE BUTTON btnFilter 
     IMAGE-UP FILE "adeicon/filter.bmp":U
     LABEL "btnfilter" 
     SIZE 6 BY 1.19 TOOLTIP "Filter".

DEFINE BUTTON btnMark 
     IMAGE-UP FILE "adeicon/psmark.bmp":U
     LABEL "Btn 1" 
     SIZE 6 BY 1.19 TOOLTIP "Insert Mark".

DEFINE BUTTON btnResults  NO-FOCUS
     LABEL "Hide Filter Results <<" 
     SIZE 26.4 BY .95.

DEFINE BUTTON btnStart 
     IMAGE-UP FILE "adeicon/psstart.bmp":U
     LABEL "btnstart" 
     SIZE 6 BY 1.19 TOOLTIP "Start Tracing".

DEFINE BUTTON btnStop 
     IMAGE-UP FILE "adeicon/psend.bmp":U
     LABEL "btnstop" 
     SIZE 6 BY 1.19 TOOLTIP "Stop Tracing".

DEFINE VARIABLE edParms AS CHARACTER 
     VIEW-AS EDITOR SCROLLBAR-VERTICAL
     SIZE 65 BY 3.86
     FONT 3 NO-UNDO.

DEFINE VARIABLE fiProcEvent AS CHARACTER FORMAT "X(256)":U 
     LABEL "Proc Name/Event" 
      VIEW-AS TEXT 
     SIZE 48.2 BY .67
     FONT 3 NO-UNDO.

DEFINE VARIABLE fiSourceFile AS CHARACTER FORMAT "X(256)":U 
     LABEL "Source File" 
      VIEW-AS TEXT 
     SIZE 48.2 BY .67
     FONT 3 NO-UNDO.

DEFINE VARIABLE fiStatement AS CHARACTER FORMAT "X(256)":U 
     LABEL "Type" 
      VIEW-AS TEXT 
     SIZE 48.2 BY .67
     FONT 3 NO-UNDO.

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

DEFINE VARIABLE fiStLoc AS CHARACTER FORMAT "X(256)":U 
     LABEL "Statement Source" 
      VIEW-AS TEXT 
     SIZE 48.2 BY .67
     FONT 3 NO-UNDO.

DEFINE VARIABLE fiTarget AS CHARACTER FORMAT "X(256)":U 
     LABEL "Target Procedure" 
      VIEW-AS TEXT 
     SIZE 48.2 BY .67
     FONT 3 NO-UNDO.

DEFINE VARIABLE txtParms AS CHARACTER FORMAT "X(256)":U INITIAL "Parameters:" 
      VIEW-AS TEXT 
     SIZE 12 BY .62 NO-UNDO.

DEFINE RECTANGLE detailRect
     EDGE-PIXELS 2000  
     SIZE 70 BY 11.91
     BGCOLOR 15 FGCOLOR 15 .

DEFINE RECTANGLE RECT-19
     EDGE-PIXELS 2 GRAPHIC-EDGE  NO-FILL 
     SIZE 25 BY 1.38.

DEFINE RECTANGLE statusRect
     EDGE-PIXELS 2000  NO-FILL 
     SIZE 134 BY .86.


/* Browse definitions                                                   */
DEFINE BROWSE filterBrowse
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _DISPLAY-FIELDS filterBrowse C-Win _STRUCTURED
  
/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME
    WITH NO-ROW-MARKERS SEPARATORS SIZE 134 BY 5 FIT-LAST-COLUMN.


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

DEFINE FRAME f-Main
     btnResults AT ROW 14.57 COL 109
     btnStart AT ROW 1.1 COL 2.4
     btnStop AT ROW 1.1 COL 8.4
     btnMark AT ROW 1.1 COL 14.4
     btnFilter AT ROW 1.1 COL 20.4
     edParms AT ROW 9.71 COL 69 NO-LABEL
     filterBrowse AT ROW 15.86 COL 2
     fiStatement AT ROW 3.33 COL 83.8 COLON-ALIGNED
     fiProcEvent AT ROW 4.52 COL 83.8 COLON-ALIGNED
     fiStLoc AT ROW 5.71 COL 83.8 COLON-ALIGNED
     fiTarget AT ROW 6.91 COL 83.8 COLON-ALIGNED
     fiSourceFile AT ROW 8.1 COL 83.8 COLON-ALIGNED
     txtParms AT ROW 9.05 COL 67 COLON-ALIGNED NO-LABEL
     fiStatus AT ROW 21.1 COL 1 COLON-ALIGNED NO-LABEL
     detailRect AT ROW 2.43 COL 66
     RECT-19 AT ROW 1 COL 2
     statusRect AT ROW 21 COL 2
    WITH 1 DOWN NO-BOX KEEP-TAB-ORDER OVERLAY 
         SIDE-LABELS NO-UNDERLINE THREE-D 
         AT COL 1 ROW 1
         SIZE 135.8 BY 20.86.


/* *********************** 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              = "Pro*Spy Plus"
         HEIGHT             = 20.91
         WIDTH              = 135.8
         MAX-HEIGHT         = 54
         MAX-WIDTH          = 320
         VIRTUAL-HEIGHT     = 54
         VIRTUAL-WIDTH      = 320
         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-wWin:HANDLE.

&IF '{&WINDOW-SYSTEM}' NE 'TTY' &THEN
IF NOT C-Win:LOAD-ICON("adeicon/prospy9.ico":U) THEN
    MESSAGE "Unable to load icon: adeicon/prospy9.ico"
            VIEW-AS ALERT-BOX WARNING BUTTONS OK.
&ENDIF
/* END WINDOW DEFINITION                                                */
&ANALYZE-RESUME

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _INCLUDED-LIB C-Win 
/* ************************* Included-Libraries *********************** */

{adecomm/_adetool.i}

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




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

&ANALYZE-SUSPEND _RUN-TIME-ATTRIBUTES
/* SETTINGS FOR WINDOW C-Win
  VISIBLE,,RUN-PERSISTENT                                               */
/* SETTINGS FOR FRAME f-Main
                                                                        */
/* BROWSE-TAB filterBrowse edParms f-Main */
ASSIGN 
       edParms:READ-ONLY IN FRAME f-Main        = TRUE.

ASSIGN 
       filterBrowse:COLUMN-RESIZABLE IN FRAME f-Main       = TRUE.

ASSIGN 
       fiProcEvent:READ-ONLY IN FRAME f-Main        = TRUE.

ASSIGN 
       fiSourceFile:READ-ONLY IN FRAME f-Main        = TRUE.

ASSIGN 
       fiStatement:READ-ONLY IN FRAME f-Main        = TRUE.

ASSIGN 
       fiStLoc:READ-ONLY IN FRAME f-Main        = TRUE.

ASSIGN 
       fiTarget:READ-ONLY IN FRAME f-Main        = TRUE.

IF SESSION:DISPLAY-TYPE = "GUI":U AND VALID-HANDLE(C-Win)
THEN C-Win:HIDDEN = no.

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

 


/* **********************  Create OCX Containers  ********************** */

&ANALYZE-SUSPEND _CREATE-DYNAMIC

&IF "{&OPSYS}" = "WIN32":U AND "{&WINDOW-SYSTEM}" NE "TTY":U &THEN

CREATE CONTROL-FRAME CtrlFrame ASSIGN
       FRAME           = FRAME f-Main:HANDLE
       ROW             = 2.43
       COLUMN          = 2
       HEIGHT          = 11.91
       WIDTH           = 63
       HIDDEN          = no
       SENSITIVE       = yes.
/* CtrlFrame OCXINFO:CREATE-CONTROL from: {C74190B6-8589-11D1-B16A-00C0F0283628} type: TreeView */
      CtrlFrame:MOVE-AFTER(btnFilter:HANDLE IN FRAME f-Main).

&ENDIF

&ANALYZE-RESUME /* End of _CREATE-DYNAMIC */


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

&Scoped-define SELF-NAME C-Win
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL C-Win C-Win
ON END-ERROR OF C-Win /* Pro*Spy Plus */
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 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 /* Pro*Spy Plus */
DO:
  SESSION:EXECUTION-LOG = FALSE.
  RUN closeApp.
  IF RETURN-VALUE EQ 'CANCEL' THEN
    RETURN NO-APPLY.

  APPLY "CLOSE":U TO THIS-PROCEDURE.
  IF NOT THIS-PROCEDURE:PERSISTENT THEN
    QUIT.

  RETURN NO-APPLY.
END.

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


&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL C-Win C-Win
ON WINDOW-RESIZED OF C-Win /* Pro*Spy Plus */
DO:
  RUN resizeWindow ( INPUT SELF:WIDTH-PIXELS,
                     INPUT SELF:HEIGHT-PIXELS ).
END.

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


&Scoped-define SELF-NAME btnFilter
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL btnFilter C-Win
ON CHOOSE OF btnFilter IN FRAME f-Main /* btnfilter */
DO:
  DEFINE VARIABLE lApplied AS LOGICAL    NO-UNDO.

  RUN protools/_psfiltwin.w ( INPUT-OUTPUT gcFilter,
                              INPUT-OUTPUT gcLabels,
                              OUTPUT lApplied ).

  IF lApplied THEN DO:
    RUN filterResults ( INPUT gcFilter ).
    /* If the filter was blank or failed for some reason, hide the results browse
       and clear the filter */
    IF CAN-DO('Closed,Error',RETURN-VALUE) THEN DO:
      IF btnResults:LABEL BEGINS 'Hide' THEN
        APPLY 'CHOOSE' TO btnResults.
      btnResults:SENSITIVE = FALSE.
    END.
    ELSE DO:
      btnResults:SENSITIVE = TRUE.
      IF btnResults:LABEL BEGINS 'Show' THEN
        APPLY 'CHOOSE' TO btnResults.
    END.
  END.

END.

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


&Scoped-define SELF-NAME btnMark
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL btnMark C-Win
ON CHOOSE OF btnMark IN FRAME f-Main /* Btn 1 */
DO:
  RUN insertMark ( INPUT FALSE ).
END.

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


&Scoped-define SELF-NAME btnResults
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL btnResults C-Win
ON CHOOSE OF btnResults IN FRAME f-Main /* Hide Filter Results << */
DO:
  cState = SELF:LABEL.
  RUN resultsState ( INPUT-OUTPUT cState ).
  SELF:LABEL = cState.
  glResults = (IF cState BEGINS 'Show' THEN FALSE ELSE TRUE).
END.

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


&Scoped-define SELF-NAME btnStart
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL btnStart C-Win
ON CHOOSE OF btnStart IN FRAME f-Main /* btnstart */
DO:
  IF glModified THEN
    RUN logAction ( INPUT gcOpenLog,
                    INPUT 'restartTrace' ).
  RUN toolbarState ( INPUT 'Trace' ).

  SESSION:EXECUTION-LOG = TRUE.
  
END.

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


&Scoped-define SELF-NAME btnStop
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL btnStop C-Win
ON CHOOSE OF btnStop IN FRAME f-Main /* btnstop */
DO:
  /* Stop logging. */
  SESSION:EXECUTION-LOG = FALSE.

  RUN logAction ( INPUT 'proexec.log',
                  INPUT 'openNew' ).

END.

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


&Scoped-define SELF-NAME CtrlFrame
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL CtrlFrame C-Win OCX.Collapse
PROCEDURE CtrlFrame.TreeView.Collapse .
/*------------------------------------------------------------------------------
  Purpose:     
  Parameters:  Required for OCX.
    Node
  Notes:       
------------------------------------------------------------------------------*/

DEFINE INPUT PARAMETER p-Node AS COM-HANDLE NO-UNDO.

/* This fills in as a sort of VALUE-CHANGED trigger.  If the selected
   row is different from the last selected row, we display the details
   of the new row. */
IF rowSelected EQ TO-ROWID(p-Node:KEY) THEN RETURN.

rowSelected = TO-ROWID(p-Node:KEY).
p-Node:ensureVisible().
RUN displayRow ( INPUT rowSelected ).

END PROCEDURE.

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


&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL CtrlFrame C-Win OCX.NodeClick
PROCEDURE CtrlFrame.TreeView.NodeClick .
/*------------------------------------------------------------------------------
  Purpose:     
  Parameters:  Required for OCX.
    Node
  Notes:       
------------------------------------------------------------------------------*/

DEFINE INPUT PARAMETER p-Node AS COM-HANDLE NO-UNDO.

/* This fills in as a sort of VALUE-CHANGED trigger.  If the selected
   row is different from the last selected row, we display the details
   of the new row. */
IF rowSelected EQ TO-ROWID(p-Node:KEY) THEN RETURN.

rowSelected = TO-ROWID(p-Node:KEY).
p-Node:ensureVisible().
RUN displayRow ( INPUT rowSelected ).

END PROCEDURE.

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


&Scoped-define BROWSE-NAME filterBrowse
&Scoped-define SELF-NAME filterBrowse
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL filterBrowse C-Win
ON DEFAULT-ACTION OF filterBrowse IN FRAME f-Main
DO:
  /* This event might have been applied programatically, and in error.
     This check helps to avoid any unwanted errors/behaviour. */
  IF NOT AVAILABLE tSpyInfo THEN
    LEAVE.

  /* Reposition the TreeView to the currently selected row. */
  RUN repositionTreeView ( INPUT STRING(ROWID(tSpyInfo)) ).

END.

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


&Scoped-define SELF-NAME m_About_PROSpy
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL m_About_PROSpy C-Win
ON CHOOSE OF MENU-ITEM m_About_PROSpy /* About Pro*Spy Plus */
DO:
  RUN adecomm/_about.p ( INPUT 'Pro*Spy Plus',
                         INPUT 'adeicon/prospy9.ico' ).
END.

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


&Scoped-define SELF-NAME m_Close_Log
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL m_Close_Log C-Win
ON CHOOSE OF MENU-ITEM m_Close_Log /* Close Log */
DO:
  RUN logAction ( INPUT gcOpenLog,
                  INPUT 'CLOSE' ).
END.

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


&Scoped-define SELF-NAME m_File
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL m_File C-Win
ON MENU-DROP OF MENU m_File /* File */
DO:
  RUN createFruList.
  {&MI} m_Save_Log:SENSITIVE {&MB} = glModified.
END.

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


&Scoped-define SELF-NAME m_Filter
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL m_Filter C-Win
ON CHOOSE OF MENU-ITEM m_Filter /* Filter */
DO:
  APPLY 'CHOOSE' TO btnFilter {&M}.
END.

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


&Scoped-define SELF-NAME m_Help_Topics
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL m_Help_Topics C-Win
ON CHOOSE OF MENU-ITEM m_Help_Topics /* Help Topics */
DO:
  RUN adecomm/_adehelp.p ( INPUT "ptls",
                           INPUT "TOPICS",
                           INPUT ?,
                           INPUT ? ).
END.

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


&Scoped-define SELF-NAME m_Hide_ADE
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL m_Hide_ADE C-Win
ON VALUE-CHANGED OF MENU-ITEM m_Hide_ADE /* Hide ADE Procedures */
DO:
  glHideADE = SELF:CHECKED.
END.

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


&Scoped-define SELF-NAME m_Hide_UIB
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL m_Hide_UIB C-Win
ON VALUE-CHANGED OF MENU-ITEM m_Hide_UIB /* Hide UIB Mode Objects */
DO:
  glHideUIB = SELF:CHECKED.
END.

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


&Scoped-define SELF-NAME m_Large
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL m_Large C-Win
ON VALUE-CHANGED OF MENU-ITEM m_Large /* Large */
DO:
  changeFont(SELF,11).
END.

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


&Scoped-define SELF-NAME m_Largest
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL m_Largest C-Win
ON VALUE-CHANGED OF MENU-ITEM m_Largest /* Largest */
DO:
  changeFont(SELF,12).
END.

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


&Scoped-define SELF-NAME m_Mark
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL m_Mark C-Win
ON CHOOSE OF MENU-ITEM m_Mark /* Insert Mark */
DO:
  APPLY 'CHOOSE' TO btnMark {&M}.
END.

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


&Scoped-define SELF-NAME m_Medium
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL m_Medium C-Win
ON VALUE-CHANGED OF MENU-ITEM m_Medium /* Medium */
DO:
  changeFont(SELF,10).
END.

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


&Scoped-define SELF-NAME m_OpenEdge_Master_Help
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL m_OpenEdge_Master_Help C-Win
ON CHOOSE OF MENU-ITEM m_OpenEdge_Master_Help /* OpenEdge Master Help */
DO:
  RUN adecomm/_adehelp.p ( INPUT "mast",
                           INPUT "TOPICS",
                           INPUT ?,
                           INPUT ? ).
END.

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


&Scoped-define SELF-NAME m_Open_Log
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL m_Open_Log C-Win
ON CHOOSE OF MENU-ITEM m_Open_Log /* Open Log */
DO:
  RUN logAction ( INPUT '',
                  INPUT 'OPEN' ).
END.

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


&Scoped-define SELF-NAME m_Prospy_Help
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL m_Prospy_Help C-Win
ON CHOOSE OF MENU-ITEM m_Prospy_Help /* Pro*Spy Plus Help */
DO:
  RUN prospyHelp.
END.

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


&Scoped-define SELF-NAME m_Refresh_List
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL m_Refresh_List C-Win
ON CHOOSE OF MENU-ITEM m_Refresh_List /* Refresh List */
DO:
  DEFINE VARIABLE cLog AS CHARACTER  NO-UNDO.

  cLog = gcOpenLog.

  RUN clearLog.

  IF cLog NE '' AND
     cLog NE ? THEN
    RUN logAction ( INPUT cLog,
                    INPUT 'OPEN' ).

  APPLY 'CHOOSE' TO btnStop {&M}.
  IF gcFilter NE '' THEN DO:
    RUN filterResults ( INPUT gcFilter ).
    IF btnResults:LABEL BEGINS 'Show' THEN
      APPLY 'CHOOSE' TO btnResults {&M}.
  END.
END.

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


&Scoped-define SELF-NAME m_Save_Log
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL m_Save_Log C-Win
ON CHOOSE OF MENU-ITEM m_Save_Log /* Save Log */
DO:
  RUN logAction ( INPUT gcOpenLog,
                  INPUT 'SAVE' ).
END.

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


&Scoped-define SELF-NAME m_Save_Log_As
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL m_Save_Log_As C-Win
ON CHOOSE OF MENU-ITEM m_Save_Log_As /* Save Log As */
DO:
  RUN logAction ( INPUT '',
                  INPUT 'SAVEAS' ).
END.

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


&Scoped-define SELF-NAME m_Smaller
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL m_Smaller C-Win
ON VALUE-CHANGED OF MENU-ITEM m_Smaller /* Smaller */
DO:
  changeFont(SELF,9).
END.

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


&Scoped-define SELF-NAME m_Smallest
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL m_Smallest C-Win
ON VALUE-CHANGED OF MENU-ITEM m_Smallest /* Smallest */
DO:
  changeFont(SELF,8).
END.

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


&Scoped-define SELF-NAME m_Start
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL m_Start C-Win
ON CHOOSE OF MENU-ITEM m_Start /* Start Tracing */
DO:
  APPLY 'CHOOSE' TO btnStart {&M}.
END.

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


&Scoped-define SELF-NAME m_Stop
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL m_Stop C-Win
ON CHOOSE OF MENU-ITEM m_Stop /* Stop Tracing */
DO:
  APPLY 'CHOOSE' TO btnStop {&M}.
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}
       ghWindow                      = {&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:
  IF PROCESS-ARCHITECTURE = 32 THEN
  DO:
    RUN enable_UI.
    ASSIGN giWinWidth                     = ghWindow:WIDTH-PIXELS
           giWinHeight                    = ghWindow:HEIGHT-PIXELS
           ghWindow:VIRTUAL-WIDTH-PIXELS  = SESSION:WIDTH-PIXELS
           ghWindow:VIRTUAL-HEIGHT-PIXELS = SESSION:HEIGHT-PIXELS NO-ERROR.
    RUN initObjects.
    IF NOT THIS-PROCEDURE:PERSISTENT THEN
      WAIT-FOR CLOSE OF THIS-PROCEDURE.
  END.
  ELSE
  DO:
      MESSAGE "Pro*Spy Plus only runs in the 32-bit Windows GUI client."
          VIEW-AS ALERT-BOX.
      STOP.
  END.
END.

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


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

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE appendParams C-Win 
PROCEDURE appendParams :
/*------------------------------------------------------------------------------
  Purpose:     This routine is responsible for appending parameter data for an 
               existing record in the tSpyInfo temp-table.
  Parameters:  INPUT prowRowIdent AS ROWID
               INPUT pcData AS CHARACTER
  Notes:       
------------------------------------------------------------------------------*/
  DEFINE INPUT  PARAMETER prowRowIdent AS ROWID      NO-UNDO.
  DEFINE INPUT  PARAMETER pcData       AS CHARACTER  NO-UNDO.

  DEFINE BUFFER bSpyInfo FOR tSpyInfo.

  FIND bSpyInfo WHERE ROWID(bSpyInfo) EQ prowRowIdent NO-ERROR.
  IF AVAILABLE bSpyInfo THEN
    bSpyInfo.tParms = bSpyInfo.tParms + pcData.

END PROCEDURE.

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

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE clearLog C-Win 
PROCEDURE clearLog :
/*------------------------------------------------------------------------------
  Purpose:     Clears the interface of all information and empties the temp-table.
  Parameters:  <none>
  Notes:       
------------------------------------------------------------------------------*/
  gchNodes:CLEAR().

  CLOSE QUERY qSpyInfo.
  EMPTY TEMP-TABLE tSpyInfo.
  
  CLEAR FRAME FRAME-E.
  CLEAR FRAME f-Main.
  CLEAR FRAME FRAME-C.

  edParms:SCREEN-VALUE {&E} = ''.
  glModified = FALSE.
  gcOpenLog  = ''.
  ghWindow:TITLE = gcBaseTitle.
  giLastBatch = 0.

END PROCEDURE.

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

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE closeApp C-Win 
PROCEDURE closeApp :
/*------------------------------------------------------------------------------
  Purpose:     Saves current settings to the registry/ini.
  Parameters:  <none>
  Notes:       
------------------------------------------------------------------------------*/
  DEFINE VARIABLE cFruList AS CHARACTER  NO-UNDO.

  DEFINE VARIABLE iMenu    AS INTEGER    NO-UNDO.

  APPLY 'CHOOSE' TO {&MI} m_close_log {&MB}.

  /* Compile a list of the existing Fru's */
  DO iMenu = 1 TO 6:
    IF VALID-HANDLE(ghMenu[iMenu]) THEN
      cFruList = cFruList + (IF cFruList NE '' THEN ',' ELSE '') + ghMenu[iMenu]:LABEL.
  END.
  
  /* If there is a saved log open, prepend the list with its name, if it's not
     already there */
  IF gcOpenLog NE 'proexec.log' AND gcOpenLog NE '' THEN
    IF ENTRY(1,cFruList) NE gcOpenLog THEN
      cFruList = gcOpenLog + (IF cFruList NE '' THEN ',' ELSE '') + cFruList. 
  
  /* Because of string size considerations, ensure there are no more than 6 entries 
     in the list */
  IF NUM-ENTRIES(cFruList) > 6 THEN
    cFruList = SUBSTRING(cFruList,1,R-INDEX(cFruList,',') - 1).

  IF cFruList NE '' THEN
    PUT-KEY-VALUE SECTION 'ProSpy' KEY 'FruList' VALUE cFruList NO-ERROR.

  PUT-KEY-VALUE SECTION 'ProSpy' KEY 'TreeFont' VALUE ghSelectedFont:LABEL NO-ERROR.
  PUT-KEY-VALUE SECTION 'ProSpy' KEY 'HideADE' VALUE 
      (IF {&MI} m_Hide_ADE:CHECKED {&MB} THEN 'TRUE' ELSE 'FALSE') NO-ERROR.
  PUT-KEY-VALUE SECTION 'ProSpy' KEY 'HideUIB' VALUE 
      (IF {&MI} m_Hide_UIB:CHECKED {&MB} THEN 'TRUE' ELSE 'FALSE') NO-ERROR.
  
  
END PROCEDURE.

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

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE closeLog C-Win 
PROCEDURE closeLog :
/*------------------------------------------------------------------------------
  Purpose:     
  Parameters:  <none>
  Notes:       
------------------------------------------------------------------------------*/
  DEFINE VARIABLE lSave AS LOGICAL    NO-UNDO.

  IF glModified THEN
      MESSAGE 'Closing a Pro*Spy Plus log file will discard changes to the currently displayed data.' SKIP
              'Do you wish to save the current information to a file prior to proceeding?'
          VIEW-AS ALERT-BOX INFO BUTTONS YES-NO-CANCEL UPDATE lSave.
  
  IF lSave EQ ? THEN
    RETURN 'CANCEL'.

  IF lSave THEN
    RUN saveLog ( INPUT gcOpenLog ).

  RUN clearLog.
  RUN toolbarState ( 'endTrace' ).

  ghWindow:TITLE = gcBaseTitle.
END PROCEDURE.

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

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE columnResized C-Win 
PROCEDURE columnResized :
/*------------------------------------------------------------------------------
  Purpose:     Modifies the column width in the registry for a specific column
  Parameters:  <none>
  Notes:       Usually called as an END-RESIZE persistent trigger for the 
               browse column
------------------------------------------------------------------------------*/
  DEFINE INPUT  PARAMETER phColumn AS HANDLE     NO-UNDO.

  DEFINE VARIABLE cColumns AS CHARACTER  NO-UNDO.

  GET-KEY-VALUE SECTION 'ProSpy' KEY 'ColumnWidths' VALUE cColumns.

  IF cColumns EQ ? THEN cColumns = ''.

  IF LOOKUP(phColumn:NAME,cColumns,CHR(2)) > 0 THEN
    ENTRY(LOOKUP(phColumn:NAME,cColumns,CHR(2)) + 1,cColumns,CHR(2)) = 
      STRING(phColumn:WIDTH-CHARS).
  ELSE cColumns = cColumns + (IF cColumns NE '' THEN CHR(2) ELSE '') +
                  phColumn:NAME + CHR(2) + STRING(phColumn:WIDTH-CHARS).
  
  PUT-KEY-VALUE SECTION 'ProSpy' KEY 'ColumnWidths' VALUE cColumns.
END PROCEDURE.

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

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE control_load C-Win  _CONTROL-LOAD
PROCEDURE control_load :
/*------------------------------------------------------------------------------
  Purpose:     Load the OCXs    
  Parameters:  <none>
  Notes:       Here we load, initialize and make visible the 
               OCXs in the interface.                        
------------------------------------------------------------------------------*/

&IF "{&OPSYS}" = "WIN32":U AND "{&WINDOW-SYSTEM}" NE "TTY":U &THEN
DEFINE VARIABLE UIB_S    AS LOGICAL    NO-UNDO.
DEFINE VARIABLE OCXFile  AS CHARACTER  NO-UNDO.

OCXFile = SEARCH( "_psplus.wrx":U ).
IF OCXFile = ? THEN
  OCXFile = SEARCH(SUBSTRING(THIS-PROCEDURE:FILE-NAME, 1,
                     R-INDEX(THIS-PROCEDURE:FILE-NAME, ".":U), "CHARACTER":U) + "wrx":U).

IF OCXFile <> ? THEN
DO:
  ASSIGN
    chCtrlFrame = CtrlFrame:COM-HANDLE
    UIB_S = chCtrlFrame:LoadControls( OCXFile, "CtrlFrame":U)
  .
  CtrlFrame:NAME = "CtrlFrame":U .
  RUN initialize-controls IN THIS-PROCEDURE NO-ERROR.
END.
ELSE MESSAGE "_psplus.wrx":U SKIP(1)
             "The binary control file could not be found. The controls cannot be loaded."
             VIEW-AS ALERT-BOX TITLE "Controls Not Loaded".

&ENDIF

END PROCEDURE.

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

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE createFruList C-Win 
PROCEDURE createFruList :
/*------------------------------------------------------------------------------
  Purpose:     
  Parameters:  <none>
  Notes:       
------------------------------------------------------------------------------*/
  DEFINE VARIABLE cFruList  AS CHARACTER  NO-UNDO.
  DEFINE VARIABLE cTempList AS CHARACTER  NO-UNDO.
  
  DEFINE VARIABLE iMenu     AS INTEGER    NO-UNDO.
  DEFINE VARIABLE iFiles    AS INTEGER    NO-UNDO.
  DEFINE VARIABLE iEntry    AS INTEGER    NO-UNDO.
  
  /* FRU (Files Recently Used) section */
  GET-KEY-VALUE SECTION 'ProSpy' KEY 'FruList' VALUE cFruList.

  iFiles = (IF NUM-ENTRIES(cFruList) EQ ? THEN 0 ELSE NUM-ENTRIES(cFruList)).

  DO iMenu = 1 TO 6:
    IF VALID-HANDLE(ghMenu[iMenu]) THEN
      DELETE WIDGET ghMenu[iMenu].
  END.
  IF VALID-HANDLE(ghExit) THEN
    DELETE WIDGET ghExit.

  IF VALID-HANDLE(ghRule) THEN
    DELETE WIDGET ghRule.

  MENU-LOOP:
  DO iMenu = 1 TO MIN(6,NUM-ENTRIES(cFruList)):

    IF NOT doesExist(ENTRY(iMenu,cFruList)) THEN
      cFruList = REPLACE(cFruList,ENTRY(iMenu,cFruList),'DELETED').
    
    IF ENTRY(iMenu,cFruList) EQ 'DELETED' THEN
      NEXT MENU-LOOP.
    ELSE iEntry = iEntry + 1.

    cTempList = cTempList + (IF cTempList NE '' THEN ',' ELSE '') + ENTRY(iMenu,cFruList).

    CREATE MENU-ITEM ghMenu[iEntry]
        ASSIGN PARENT = SUB-MENU m_File:HANDLE {&MB}
               LABEL  = ENTRY(iMenu,cFruList)
        TRIGGERS:
          ON 'CHOOSE' PERSISTENT RUN logAction 
              IN THIS-PROCEDURE ( INPUT ENTRY(iMenu,cFruList),
                                  INPUT 'OPEN' ).
        END TRIGGERS.
  END.

  iFiles = (IF NUM-ENTRIES(cTempList) EQ ? THEN 0 ELSE NUM-ENTRIES(cTempList)).

  /* If there were some Fru's added, add a RULE between them and the next menu-item(s) */
  IF iFiles NE 0 THEN
    CREATE MENU-ITEM ghRule
        ASSIGN SUBTYPE = 'RULE'
               PARENT  = SUB-MENU m_File:HANDLE {&MB}.

  /* Create the exit menu-item */
  CREATE MENU-ITEM ghExit
      ASSIGN LABEL  = 'E&xit'
             PARENT = SUB-MENU m_File:HANDLE {&MB}
      TRIGGERS:
        ON 'CHOOSE' PERSISTENT RUN exitChosen IN THIS-PROCEDURE.
      END TRIGGERS.

  PUT-KEY-VALUE SECTION 'ProSpy' KEY 'FruList' VALUE cTempList NO-ERROR.
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 displayRow C-Win 
PROCEDURE displayRow :
/*------------------------------------------------------------------------------
  Purpose:     Displays the row indicated by pRowSelected
  Parameters:  INPUT pRowSelected AS ROWID
  Notes:       
------------------------------------------------------------------------------*/
  DEFINE INPUT  PARAMETER pRowSelected AS ROWID      NO-UNDO.

  DO WITH FRAME F-Main:
    FIND tSpyInfo WHERE ROWID(tSpyInfo) EQ prowSelected NO-LOCK NO-ERROR.
    IF AVAILABLE tSpyInfo THEN
      ASSIGN edParms:SCREEN-VALUE       = tSpyInfo.tParms
             fiProcEvent:SCREEN-VALUE   = tSpyInfo.tProcName
             fiProcEvent:TOOLTIP        = (IF LENGTH(tSpyInfo.tProcName) >= fiProcEvent:WIDTH-CHARS THEN
                                             tSpyInfo.tProcName ELSE '')
             fiSourceFile:SCREEN-VALUE  = tSpyInfo.tSource
             fiSourceFile:TOOLTIP       = (IF LENGTH(tSpyInfo.tSource) >= fiSourceFile:WIDTH-CHARS THEN
                                             tSpyInfo.tSource ELSE '')
             fiStatement:SCREEN-VALUE   = tSpyInfo.tType
             fiStatement:TOOLTIP        = (IF LENGTH(tSpyInfo.tType) >= fiStatement:WIDTH-CHARS THEN
                                             tSpyInfo.tType ELSE '')
             fiStLoc:SCREEN-VALUE       = tSpyInfo.tSrcProc 
             fiStLoc:TOOLTIP            = (IF LENGTH(tSpyInfo.tSrcProc) >= fiStLoc:WIDTH-CHARS THEN
                                             tSpyInfo.tSrcProc ELSE '')
             fiTarget:SCREEN-VALUE      = tSpyInfo.tTarget
             fiTarget:TOOLTIP           = (IF LENGTH(tSpyInfo.tTarget) >= fiTarget:WIDTH-CHARS THEN
                                             tSpyInfo.tTarget ELSE '')
             fiStatus:SCREEN-VALUE      = tSpyInfo.tDescrip
             fiStatus:TOOLTIP           = (IF LENGTH(tSpyInfo.tDescrip) >= fiStatus:WIDTH-CHARS THEN
                                             tSpyInfo.tDescrip ELSE '') NO-ERROR.
    ELSE
      ASSIGN edParms:SCREEN-VALUE       = ''
             fiProcEvent:SCREEN-VALUE   = ''
             fiProcEvent:TOOLTIP        = ''
             fiSourceFile:SCREEN-VALUE  = ''
             fiSourceFile:TOOLTIP       = ''
             fiStatement:SCREEN-VALUE   = ''
             fiStatement:TOOLTIP        = ''
             fiStLoc:SCREEN-VALUE       = ''
             fiStLoc:TOOLTIP            = ''
             fiTarget:SCREEN-VALUE      = ''
             fiTarget:TOOLTIP           = ''
             fiStatus:SCREEN-VALUE      = ''
             fiStatus:TOOLTIP           = '' NO-ERROR.
  END.

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.
------------------------------------------------------------------------------*/
  RUN control_load.
  DISPLAY edParms fiStatement fiProcEvent fiStLoc fiTarget fiSourceFile txtParms 
          fiStatus 
      WITH FRAME f-Main IN WINDOW C-Win.
  ENABLE btnResults btnStart btnStop btnMark btnFilter edParms fiStatement 
         fiProcEvent fiStLoc fiTarget fiSourceFile txtParms fiStatus detailRect 
         RECT-19 statusRect 
      WITH FRAME f-Main IN WINDOW C-Win.
  {&OPEN-BROWSERS-IN-QUERY-f-Main}
  VIEW C-Win.
END PROCEDURE.

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

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE exitChosen C-Win 
PROCEDURE exitChosen :
/*------------------------------------------------------------------------------
  Purpose:     
  Parameters:  <none>
  Notes:       
------------------------------------------------------------------------------*/
  APPLY 'WINDOW-CLOSE' TO ghWindow.
END PROCEDURE.

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

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE filterResults C-Win 
PROCEDURE filterResults :
/*------------------------------------------------------------------------------
  Purpose:     Reopens/opens the query for the filter browser based on the 
               where clause specified by pcWhere.
  Parameters:  INPUT pcWhere AS CHARACTER
  Notes:       
------------------------------------------------------------------------------*/
  DEFINE INPUT  PARAMETER pcWhere AS CHARACTER  NO-UNDO.

  DEFINE VARIABLE hQuery  AS HANDLE     NO-UNDO.

  hQuery = QUERY qSpyInfo:HANDLE.
  hQuery:QUERY-CLOSE().
  IF pcWhere EQ '' OR pcWhere EQ ? THEN
    RETURN 'Closed'.
  
  hQuery:QUERY-PREPARE('FOR EACH tSpyInfo NO-LOCK WHERE ' + pcWhere) NO-ERROR.
  hQuery:QUERY-OPEN() NO-ERROR.

  BROWSE {&BROWSE-NAME}:MAX-DATA-GUESS = giCount.
  APPLY 'VALUE-CHANGED' TO BROWSE {&BROWSE-NAME}.
  
  IF NOT ERROR-STATUS:ERROR AND hQuery:IS-OPEN THEN
    RETURN 'success'.
  ELSE RETURN 'Error'.

END PROCEDURE.

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

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE importLog C-Win 
PROCEDURE importLog :
/*------------------------------------------------------------------------------
  Purpose:     Import the contents of a log file specified by pcLogFile.
  Parameters:  INPUT pcLogFile AS CHARACTER
  Notes:       
------------------------------------------------------------------------------*/
  DEFINE INPUT  PARAMETER pcLogFile AS CHARACTER  NO-UNDO.

  DEFINE VARIABLE cInput      AS CHARACTER  NO-UNDO.
  DEFINE VARIABLE cFirstRowid AS CHARACTER  NO-UNDO.
  DEFINE VARIABLE cReturn     AS CHARACTER  NO-UNDO.
  DEFINE VARIABLE cStatus     AS CHARACTER  NO-UNDO.

  DEFINE VARIABLE lDelete     AS LOGICAL    NO-UNDO.
  DEFINE VARIABLE lGoodLog    AS LOGICAL    NO-UNDO.
  DEFINE VARIABLE lGoodData   AS LOGICAL    NO-UNDO.
                           
  DEFINE VARIABLE iCount      AS INTEGER    NO-UNDO.
  DEFINE VARIABLE iLogSize    AS INTEGER    NO-UNDO.
  DEFINE VARIABLE iBytesRead  AS INTEGER    NO-UNDO.
  DEFINE VARIABLE iPercent    AS INTEGER    NO-UNDO.

  DEFINE VARIABLE rowLastRead AS ROWID      NO-UNDO.

  FILE-INFO:FILE-NAME = pcLogFile.
  iLogSize = FILE-INFO:FILE-SIZE.

  fiStatus:SCREEN-VALUE IN FRAME {&FRAME-NAME} = ''.
  fiStatus:FONT = 6.

  SESSION:SET-WAIT-STATE('GENERAL').
  gchTreeView:VISIBLE = FALSE.
  statusRect:VISIBLE  = FALSE.

  IF NOT glModified THEN
    giCurrentBatch = 0.

  INPUT FROM VALUE(pcLogFile).
  REP-BLK:
  REPEAT:
    iCount = iCount + 1.
    IMPORT UNFORMATTED cInput.
    iBytesRead = iBytesRead + LENGTH(cInput).
    lGoodData = ((cInput BEGINS 'RUN' OR
                  cInput BEGINS 'FUNC' OR
                  cInput BEGINS 'PUBL' OR
                  cInput BEGINS 'SUBS' OR 
                  cInput BEGINS 'UNSUBS' OR
                  cInput BEGINS 'EXEC' OR
                  cInput BEGINS 'MARK' OR
                  cInput BEGINS 'TRIGGER' OR
                  cInput BEGINS 'NEW' OR
                  cInput BEGINS 'SUPER' OR
                  cInput BEGINS 'INVOKE' OR
                  cinput BEGINS 'DELETE' OR
                  cinput BEGINS 'PERSTRIG') AND 
                 NUM-ENTRIES(cInput,'|') GE 7 ).

    iPercent = ABS((iBytesRead / iLogSize) * 100).
    cStatus  = FILL(CHR(1),INT(TRUNC(iPercent / 10,0))) + FILL(' ',10 - INT(TRUNC(iPercent / 10,0))) + ' ' + STRING(iPercent) + '%'.
    fiStatus:SCREEN-VALUE = cStatus.

    IF NOT lGoodData THEN DO:
       
      /* If we've already verified that the log is good then we assume that there
         was a newline character in the parameter data and we append it to the last
         record that was read. */
      IF lGoodLog THEN DO:
        RUN appendParams ( INPUT rowLastRead,
                           INPUT CHR(10) + cInput ).
        NEXT REP-BLK.
      END. /* Good Log */
      ELSE DO:
        RUN clearLog.
        MESSAGE 'Invalid Input Log!' SKIP 
                'Please ensure that you have a minimum of Progress Version 9.1D05 installed!'
            VIEW-AS ALERT-BOX ERROR BUTTONS OK.
        gcOpenLog = ''.
        cReturn   = 'ERROR'.
        LEAVE REP-BLK.
      END. /* Not a good log */
    END. /* Not good data */
             
    IF TRIM(ENTRY(4,cInput,'|')) EQ '***********************************' THEN
      RUN insertMark ( INPUT TRUE ).
    ELSE DO:
      parseInput(cInput).
      IF AVAILABLE tSpyInfo THEN DO:
        IF iCount = 1 THEN DO: 
          ASSIGN cFirstRowid = STRING(ROWID(tSpyInfo))
                 lGoodLog    = TRUE.
        END.
        rowLastRead = ROWID(tSpyInfo).
        addNode().
      END.
      ELSE iCount = iCount - 1.
    END.
  END. /* REPEAT: */
  INPUT CLOSE.
  gchTreeView:VISIBLE = TRUE.
  statusRect:VISIBLE  = TRUE.
  SESSION:SET-WAIT-STATE('').
  
  fiStatus:FONT = ?.
  fiStatus:SCREEN-VALUE = ''.

  RUN repositionTreeView ( cFirstRowid ).

  IF NOT CAN-FIND(FIRST tSpyInfo) THEN
    cReturn = 'ERROR'.

  RETURN cReturn.
END PROCEDURE.

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

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE initializeMenu C-Win 
PROCEDURE initializeMenu :
/*------------------------------------------------------------------------------
  Purpose:     Creates menu-items and initializes the state of existing
               menu-items with information that was saved from previous
               sessions
  Parameters:  <none>
  Notes:       
------------------------------------------------------------------------------*/
  DEFINE VARIABLE cHideUIB  AS CHARACTER  NO-UNDO.
  DEFINE VARIABLE cHideADE  AS CHARACTER  NO-UNDO.
  DEFINE VARIABLE cTreeFont AS CHARACTER  NO-UNDO.

  RUN createFruList.

  /* Treeview font section */
  GET-KEY-VALUE SECTION 'ProSpy' KEY 'TreeFont' VALUE cTreeFont. 
  CASE cTreeFont:
    WHEN '' OR WHEN ? OR WHEN 'Medium' THEN DO:
      {&MI} m_Medium:CHECKED {&MB} = TRUE.
      APPLY 'VALUE-CHANGED' TO {&MI} m_Medium {&MB}.
    END.
    WHEN 'Largest' THEN DO:
      {&MI} m_Largest:CHECKED {&MB} = TRUE.
      APPLY 'VALUE-CHANGED' TO {&MI} m_Largest {&MB}.
    END.
    WHEN 'Large' THEN DO:
      {&MI} m_Large:CHECKED {&MB} = TRUE.
      APPLY 'VALUE-CHANGED' TO {&MI} m_Large {&MB}.
    END.
    WHEN 'Smaller' THEN DO:
      {&MI} m_Smaller:CHECKED {&MB} = TRUE.
      APPLY 'VALUE-CHANGED' TO {&MI} m_Smaller {&MB}.
    END.
    WHEN 'Smallest' THEN DO:
      {&MI} m_Smallest:CHECKED {&MB} = TRUE.
      APPLY 'VALUE-CHANGED' TO {&MI} m_Smallest {&MB}.
    END.
  END CASE.
  
  /* Show/Hide Procedures section */
  GET-KEY-VALUE SECTION 'ProSpy' KEY 'HideADE' VALUE cHideADE.
  GET-KEY-VALUE SECTION 'ProSpy' KEY 'HideUIB' VALUE cHideUIB.

  /* Default is FALSE */
  IF cHideADE EQ ? OR cHideADE EQ 'FALSE' OR cHideADE EQ '' THEN
    {&MI} m_Hide_ADE:CHECKED {&MB} = FALSE.
  ELSE
    {&MI} m_Hide_ADE:CHECKED {&MB} = TRUE.

  APPLY 'VALUE-CHANGED' TO {&MI} m_Hide_ADE {&MB}.

  /* Default is TRUE */
  IF cHideUIB EQ ? OR cHideUIB EQ 'TRUE' OR cHideUIB EQ '' THEN
    {&MI} m_Hide_UIB:CHECKED {&MB} = TRUE.
  ELSE
    {&MI} m_Hide_UIB:CHECKED {&MB} = FALSE.
  
  APPLY 'VALUE-CHANGED' TO {&MI} m_Hide_UIB {&MB}.

END PROCEDURE.

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

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE initObjects C-Win 
PROCEDURE initObjects :
/*------------------------------------------------------------------------------
  Purpose:     initObjects
  Parameters:  <none>
  Notes:       
------------------------------------------------------------------------------*/
  /* Standard initialization defaults */
  DO WITH FRAME FRAME-E:
    statusRect:MOVE-TO-BOTTOM() {&M}.
    detailRect:MOVE-TO-BOTTOM().

    ASSIGN gchTreeView               = chCtrlFrame:TreeView
           gchNodes                  = gchTreeView:Nodes  
           gchTreeView:FullRowSelect = TRUE
           gchTreeView:HideSelection = FALSE
           gchTreeView:Indentation   = 1
           gchTreeView:LabelEdit     = 1
           gchTreeView:SingleSel     = FALSE
           gchTreeView:LineStyle     = 1 NO-ERROR.

    RUN setupBrowse( INPUT BROWSE {&BROWSE-NAME}:HANDLE, 
                     INPUT QUERY qSpyInfo:HANDLE,        
                     INPUT 'tSpyInfo.tType,' + 
                           'tSpyInfo.tSource,' +
                           'tSpyInfo.tSrcProc,' +
                           'tSpyInfo.tProcName,' +
                           'tSpyInfo.tTarget,' +
                           'tSpyInfo.tParms' ).       

    APPLY 'CHOOSE' TO btnResults {&M}.
  END.
  RUN toolbarState ( 'endTrace' ).

  /* Initialize defaults from information saved in registry/ini */
  RUN initializeMenu.

END PROCEDURE.

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

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE insertMark C-Win 
PROCEDURE insertMark :
/*------------------------------------------------------------------------------
  Purpose:     Responsible for inserting a mark in the treeview.
  Parameters:  INPUT plOpening AS LOGICAL
  Notes:       
------------------------------------------------------------------------------*/
  DEFINE INPUT  PARAMETER plOpening AS LOGICAL    NO-UNDO.

  DEFINE VARIABLE cMark AS CHARACTER  NO-UNDO.

  DO TRANSACTION:
    CREATE tSpyInfo.
    tSpyInfo.tSpyId    = DYNAMIC-FUNCTION('getNewId':U).
    tSpyInfo.tType     = 'MARK'.
    tSpyInfo.tBatch    = giLastBatch.
    tSpyInfo.tProcName = '***********************************'.
    tSpyInfo.tParentId = ?.
    tSpyInfo.tDescrip  = '***********************************'.
    cMark              = STRING(ROWID(tSpyInfo)).
  END.

  addNode().
  IF NOT plOpening THEN DO:
    RUN repositionTreeView ( INPUT cMark ).
    glModified = TRUE.
  END.
END PROCEDURE.

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

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE logAction C-Win 
PROCEDURE logAction :
/*------------------------------------------------------------------------------
  Purpose:     Used for handling log file operations...  
               If there is none specified, we ask the user to specify one.
  Parameters:  INPUT pcLogFile AS CHARACTER  -- Logfile name
  Notes:       
------------------------------------------------------------------------------*/
  DEFINE INPUT  PARAMETER pcLogFile AS CHARACTER  NO-UNDO.
  DEFINE INPUT  PARAMETER pcAction  AS CHARACTER  NO-UNDO.

  DEFINE VARIABLE lSave   AS LOGICAL.

  DEFINE VARIABLE cReturn AS CHARACTER.

  IF glModified AND
     CAN-DO('OPEN,CLOSE,restartTrace',pcAction) THEN DO:
    MOD-BLK:
    REPEAT:
      cReturn = ''.
      MESSAGE 'This action will discard changes to the currently displayed data.' SKIP
              'Do you wish to save the current information to a file prior to proceeding?'
            VIEW-AS ALERT-BOX INFO BUTTONS YES-NO-CANCEL UPDATE lSave.
  
      IF lSave EQ ? THEN
        RETURN 'CANCEL'.

      IF lSave THEN DO:
        RUN saveLog ( INPUT gcOpenLog ).
        cReturn = RETURN-VALUE.
      END.

      IF cReturn <> 'Cancelled' THEN
        LEAVE MOD-BLK.
    
    END. /* Repeat */
  END. /* Modified */

  CASE pcAction:
    WHEN 'openNew' THEN DO:
      RUN openLog ( INPUT-OUTPUT pcLogFile ).
      IF gcFilter NE '' AND gcFilter NE ? THEN DO:
        RUN filterResults ( INPUT gcFilter ).
        IF NOT CAN-DO('Closed,Error',RETURN-VALUE) THEN
          btnResults:SENSITIVE {&M} = TRUE.
      END.
    END.
    WHEN 'OPEN' THEN DO:
      RUN clearLog.
      RUN openLog ( INPUT-OUTPUT pcLogFile ).
      cReturn = RETURN-VALUE.

      IF cReturn NE 'ERROR' THEN DO:
        ghWindow:TITLE             = gcBaseTitle + ' -- ' + gcOpenLog.
        RUN updateFruList ( INPUT pcLogFile ).
      END.
      ELSE ghWindow:TITLE             = gcBaseTitle.
    END.
    WHEN 'CLOSE' OR WHEN 'CLEAR' THEN DO:
      RUN clearLog.
      RUN toolbarState ( 'endTrace' ).

      ghWindow:TITLE = gcBaseTitle.
      IF btnResults:LABEL {&M} BEGINS 'Hide' THEN
        APPLY 'CHOOSE' TO btnResults.
    END.
    WHEN 'SAVE' OR WHEN 'SAVEAS' THEN DO:
      RUN saveLog ( INPUT pcLogFile ).
      IF RETURN-VALUE NE 'Cancelled' THEN
        glModified = FALSE.

      ghWindow:TITLE = gcBaseTitle + ' -- ' + gcOpenLog.
    END.
    WHEN 'restartTrace' THEN
      IF NOT lSave THEN RUN clearLog.
  END CASE.
               
END PROCEDURE.

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

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE moveResults C-Win 
PROCEDURE moveResults :
/*------------------------------------------------------------------------------
  Purpose:     Responsible for moving the results browser and the status bar
  Parameters:  INPUT piHeight AS INTEGER
  Notes:       The upper left corner of the browse will always be 127 pixels
               from the bottom of the window.
               
               The upper left corner of the rectangle will always be 19 pixels
               from the bottom of the window.
               
               The upper left corner of the fill-in will always be 17 pixels
               from the bottom of the window.
------------------------------------------------------------------------------*/
  DEFINE INPUT  PARAMETER piHeight AS INTEGER    NO-UNDO.

  ASSIGN BROWSE {&BROWSE-NAME}:Y = (IF piHeight < giMinHeight THEN 
                                      giMinHeight ELSE piHeight) - 127
         statusRect:Y {&M}       = piHeight - 19
         fiStatus:Y {&M}         = piHeight - 17 NO-ERROR.
END PROCEDURE.

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

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE moveResultsButton C-Win 
PROCEDURE moveResultsButton :
/*------------------------------------------------------------------------------
  Purpose:     Responsible for moving the filter button along with a window
               resize action
  Parameters:  INPUT piWidth AS INTEGER
               INPUT piHeight AS INTEGER
  Notes:       When the filter browse is visible, the button is always 154 pixels 
               from the bottom of the window.
               
               When the filter browse is not visible, the button is always 45
               pixels from the bottom of the window.
               
               The button is always 139 pixels from the right handle side of the 
               window.
------------------------------------------------------------------------------*/
  DEFINE INPUT  PARAMETER piWidth  AS INTEGER    NO-UNDO.
  DEFINE INPUT  PARAMETER piHeight AS INTEGER    NO-UNDO.

  ASSIGN btnResults:X {&M} = piWidth - 139
         btnResults:Y {&M} = piHeight - (IF glResults THEN 154 ELSE 45) NO-ERROR.

END PROCEDURE.

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

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE openLog C-Win 
PROCEDURE openLog :
/*------------------------------------------------------------------------------
  Purpose:     Responsible for opening log files as specified by pcLogFile. 
  Parameters:  INPUT-OUTPUT pcLogFile AS CHARACTER
  Notes:       
------------------------------------------------------------------------------*/
  DEFINE INPUT-OUTPUT PARAMETER pcLogFile AS CHARACTER  NO-UNDO.

  DEFINE VARIABLE lOpen     AS LOGICAL    NO-UNDO.

  DEFINE VARIABLE cReturn   AS CHARACTER  NO-UNDO.

  DEFINE VARIABLE iFileSize AS INTEGER    NO-UNDO.

  IF pcLogFile EQ '' OR pcLogFile EQ ? THEN DO:
    SYSTEM-DIALOG GET-FILE pcLogFile
          FILTERS 'Log Files  (*.log)'    '*.log',
                  'Text Files (*.txt)'    '*.txt',
                  'Data Files (*.dat)'    '*.dat',
                  'All Files  (*.*)'      '*.*'
          INITIAL-FILTER 1
          TITLE 'Open Pro*Spy Plus Log File ...'
          UPDATE lOpen.

    IF NOT lOpen OR pcLogFile EQ '' OR pcLogFile EQ ? THEN
      RETURN.
  END.

  /* Check the file size to make sure that something was logged.
     This may be unnecessary in most cases, but it helps performance
     "just in case". */
  FILE-INFO:FILE-NAME = (IF pcLogFile EQ 'proexec.log' THEN 
                           SESSION:TEMP-DIR 
                         ELSE '') + pcLogFile.
  iFileSize = FILE-INFO:FILE-SIZE.
  IF iFileSize > 0 THEN DO:
    RUN importLog ( INPUT FILE-INFO:FULL-PATHNAME ).
    cReturn = RETURN-VALUE.
  END.
  ELSE DO:
    IF FILE-INFO:FILE-NAME EQ ? THEN DO:
      MESSAGE 'The file you specified ' pcLogFile ' was not found!'
          VIEW-AS ALERT-BOX ERROR BUTTONS OK.
      cReturn = 'ERROR'.
    END.
  END.
  IF CAN-FIND(FIRST tSpyInfo) THEN
    RUN toolbarState ( INPUT 'endTrace,data' ).
  ELSE RUN toolbarState ( INPUT 'endTrace' ).

  /* If we're reading from the proexec.log file, then glModified is always
     true unless the log file size is equal to zero. */
  IF pcLogFile EQ 'proexec.log' THEN
    glModified = (iFileSize > 0 AND cReturn NE 'ERROR').
  ELSE ASSIGN gcOpenLog = (IF cReturn NE 'ERROR' THEN pcLogFile ELSE '')
              glModified = FALSE.

  RETURN cReturn.
END PROCEDURE.

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

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE prospyHelp C-Win 
PROCEDURE prospyHelp :
/*------------------------------------------------------------------------------
  Purpose:     Brings up Pro*Spy Plus help utility
  Parameters:  <none>
  Notes:       
------------------------------------------------------------------------------*/
  DEFINE VARIABLE iVersion AS INTEGER    NO-UNDO.

  iVersion = INTEGER(ENTRY(1,PROVERSION,".":U)) NO-ERROR.
  IF iVersion > 9 THEN
    RUN adecomm/_adehelp.p ( INPUT "ptls",
                             INPUT "CONTEXT",
                             INPUT 110,
                             INPUT ? ).
  ELSE
    MESSAGE "No application help available at this time."
        VIEW-AS ALERT-BOX INFO BUTTONS OK.
END PROCEDURE.

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

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE repositionTreeview C-Win 
PROCEDURE repositionTreeview :
/*------------------------------------------------------------------------------
  Purpose:     Repositions to a specific row in the treeview
  Parameters:  INPUT pcMode AS CHARACTER
  Notes:       The input parameter 'pcMode' is most likely to be a rowid to
               a specific record in the tSpyInfo temp-table.  If it's not EQ to
               'FIRST' or 'LAST' then we attempt to find it in the tt, if it doesn't
               exist we reposition the treeview.
               
               If the record is not found we don't move.
------------------------------------------------------------------------------*/
  DEFINE INPUT  PARAMETER pcMode AS CHARACTER  NO-UNDO.

  DEFINE VARIABLE chNode AS COM-HANDLE NO-UNDO.

  CASE pcMode:
    WHEN 'FIRST' THEN
      FIND FIRST tSpyInfo NO-LOCK NO-ERROR.
    WHEN 'LAST' THEN
      FIND LAST tSpyInfo NO-LOCK NO-ERROR.
    OTHERWISE
      FIND tSpyInfo WHERE ROWID(tSpyInfo) EQ TO-ROWID(pcMode) NO-LOCK NO-ERROR.
  END CASE.
  IF AVAILABLE tSpyInfo THEN DO:
    chNode = gchNodes:ITEM(STRING(ROWID(tSpyInfo))) NO-ERROR.
    IF VALID-HANDLE(chNode) THEN
      chNode:SELECTED = TRUE NO-ERROR.
    RUN displayRow ( INPUT ROWID(tSpyInfo) ).
  END.
  chNode:ensureVisible() NO-ERROR.
  gchTreeView:REFRESH() NO-ERROR.

END PROCEDURE.

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

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE resizeResults C-Win 
PROCEDURE resizeResults :
/*------------------------------------------------------------------------------
  Purpose:     Changes the size of the results browser and status bar 
               proportionally to the size of the window.
  Parameters:  INPUT piWidth AS INTEGER - Width of the current window
  Notes:       The window is always; 9 pixels wider than the browser
                                     9 pixels wider than the rectange
                                     19 pixels wider than the fill-in
------------------------------------------------------------------------------*/
  DEFINE INPUT  PARAMETER piWidth AS INTEGER    NO-UNDO.

  ASSIGN BROWSE filterBrowse:WIDTH-PIXELS = piWidth - 9
         fiStatus:WIDTH-PIXELS {&M}       = piWidth - 19
         statusRect:WIDTH-PIXELS {&M}     = piWidth - 9 NO-ERROR.
END PROCEDURE.

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

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE resizeTreeview C-Win 
PROCEDURE resizeTreeview :
/*------------------------------------------------------------------------------
  Purpose:     Responsible for resizing the TreeView OCX's Control Frame
  Parameters:  INPUT piWidth AS INTEGER
               INPUT piHeight AS INTEGER
  Notes:       If the filter browser is visible, the Treeview height is always 
               159 pixels less than the window height.
            
               If the filter browser is NOT visible, the Treeview height is 
               always 50 pixels less than the window height.
               
               Treeview width is always 359 pixels less than the window width.
------------------------------------------------------------------------------*/
  DEFINE INPUT  PARAMETER piWidth    AS INTEGER    NO-UNDO.
  DEFINE INPUT  PARAMETER piHeight AS INTEGER    NO-UNDO.

  ASSIGN CtrlFrame:WIDTH-PIXELS  = piWidth - 364
         CtrlFrame:HEIGHT-PIXELS = piHeight - (IF glResults THEN 189 ELSE 80) NO-ERROR.
END PROCEDURE.

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

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE resizeViewer C-Win 
PROCEDURE resizeViewer :
/*------------------------------------------------------------------------------
  Purpose:     Responsible for resizing and moving the detail viewer when the 
               window is resized
  Parameters:  INPUT piWidth AS INTEGER 
               INPUT piHeight AS INTEGER
  Notes:       
------------------------------------------------------------------------------*/
  DEFINE INPUT  PARAMETER piWidth  AS INTEGER    NO-UNDO.
  DEFINE INPUT  PARAMETER piHeight AS INTEGER    NO-UNDO.

  DEFINE VARIABLE iLblPosition AS INTEGER    NO-UNDO.
  DEFINE VARIABLE iPosition    AS INTEGER    NO-UNDO.

  DEFINE VARIABLE hLabel       AS HANDLE     NO-UNDO.

  ASSIGN detailRect:X             {&M} = piWidth - 354
         detailRect:HEIGHT-PIXELS {&M} = piHeight - (IF glResults THEN 189 ELSE 80)
         iPosition                     = piWidth - 260
         hLabel                        = fiStatement:SIDE-LABEL-HANDLE {&M}
         iLblPosition                  = iPosition - fiStatement:X
         hLabel:X                      = hLabel:X + iLblPosition
         fiStatement:X            {&M} = iPosition
         hLabel                        = fiProcEvent:SIDE-LABEL-HANDLE {&M}
         iLblPosition                  = iPosition - fiProcEvent:X
         hLabel:X                      = hLabel:X + iLblPosition
         fiProcEvent:X            {&M} = iPosition
         hLabel                        = fiStLoc:SIDE-LABEL-HANDLE {&M}
         iLblPosition                  = iPosition - fiStLoc:X
         hLabel:X                      = hLabel:X + iLblPosition
         fiStLoc:X                {&M} = iPosition
         hLabel                        = fiTarget:SIDE-LABEL-HANDLE {&M}
         iLblPosition                  = iPosition - fiTarget:X
         hLabel:X                      = hLabel:X + iLblPosition
         fiTarget:X               {&M} = iPosition
         hLabel                        = fiSourceFile:SIDE-LABEL-HANDLE {&M}
         iLblPosition                  = iPosition - fiSourceFile:X
         hLabel:X                      = hLabel:X + iLblPosition
         fiSourceFile:X           {&M} = iPosition
         txtParms:X               {&M} = piWidth - 349
         edParms:X                {&M} = piWidth - 339
         edParms:HEIGHT-PIXELS    {&M} = piHeight - (IF glResults THEN 358 ELSE 249) NO-ERROR.
END PROCEDURE.

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

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE resizeWindow C-Win 
PROCEDURE resizeWindow :
/*------------------------------------------------------------------------------
  Purpose:     Responsible for overall resizing and replacement of the Pro*Spy
               Plus window and all of it's components
  Parameters:  INPUT piWidth AS INTEGER
               INPUT piHeight AS INTEGER
  Notes:       We use the input parameters for the window dimensions in order to 
               allow routines other than the window-resized trigger to call this.
  
------------------------------------------------------------------------------*/
  DEFINE INPUT  PARAMETER piWidth  AS INTEGER    NO-UNDO.
  DEFINE INPUT  PARAMETER piHeight AS INTEGER    NO-UNDO.

  IF piWidth < giMinWidth THEN
    ghWindow:WIDTH-PIXELS = giMinWidth.

  IF piHeight < (IF glResults THEN giMinHeight ELSE giMinHeight - 109) THEN
    ghWindow:HEIGHT-PIXELS = (IF glResults THEN giMinHeight ELSE giMinHeight - 109).

  
  ASSIGN giWinWidth                         = ghWindow:WIDTH-PIXELS
         giWinHeight                        = ghWindow:HEIGHT-PIXELS
         FRAME F-Main:WIDTH-PIXELS          = giWinWidth
         FRAME F-Main:VIRTUAL-WIDTH-PIXELS  = giWinWidth
         FRAME F-Main:HEIGHT-PIXELS         = giWinHeight
         FRAME F-Main:VIRTUAL-HEIGHT-PIXELS = giWinHeight.
  
  RUN resizeResults ( INPUT giWinWidth ).

  RUN moveResults ( INPUT giWinHeight ).

  RUN moveResultsButton ( INPUT giWinWidth,
                          INPUT giWinHeight ).

  RUN resizeTreeview ( INPUT giWinWidth,
                       INPUT giWinHeight ).

  RUN resizeViewer ( INPUT giWinWidth,
                     INPUT giWinHeight ).
END PROCEDURE.

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

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE resultsState C-Win 
PROCEDURE resultsState :
/*------------------------------------------------------------------------------
  Purpose:     This handles resizing the window to show/hide the filter
               results browser.
  Parameters:  INPUT-OUTPUT pcState
  Notes:       
------------------------------------------------------------------------------*/
  DEFINE INPUT-OUTPUT  PARAMETER pcState  AS CHARACTER  NO-UNDO.

  DEFINE VARIABLE lShow AS LOGICAL    NO-UNDO.

  lShow = (pcState BEGINS 'Show').
  IF NOT lShow THEN HIDE BROWSE {&BROWSE-NAME}.
  pcState = (IF lShow THEN 'Hide' ELSE 'Show') + ' Filter Results <<'.

  /* If the window is not maximized, we can resize the window, otherwise we resize 
     the frame and its objects to accomodate the window size */
  IF ghWindow:WINDOW-STATE NE 1 THEN DO:
    giWinHeight = giWinHeight + (IF lShow THEN 109 ELSE -109).

    ASSIGN ghWindow:HEIGHT-PIXELS             = giWinHeight
           giWinHeight                        = giWinHeight
           FRAME f-Main:HEIGHT-PIXELS         = giWinHeight
           FRAME f-Main:VIRTUAL-HEIGHT-PIXELS = giWinHeight
           fiStatus:Y                         = giWinHeight - 17
           statusRect:Y                       = giWinHeight - 19.

    IF lShow THEN VIEW BROWSE {&BROWSE-NAME}.

    RUN moveResults ( INPUT giWinHeight ).
  END.
  ELSE DO:
    glResults = lShow.
    RUN resizeWindow ( INPUT giWinWidth,
                       INPUT giWinHeight ).

    IF lShow THEN VIEW BROWSE {&BROWSE-NAME}.
  END.
END PROCEDURE.

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

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE saveLog C-Win 
PROCEDURE saveLog :
/*------------------------------------------------------------------------------
  Purpose:     Saves changes to a log file as specified by pcLogFile.
  Parameters:  INPUT pcLogFile AS CHARACTER
  Notes:       If pcLogFile is blank, unknown or 'proexec.log' the user is
               prompted with the system 'Save As' dialog.
------------------------------------------------------------------------------*/
  DEFINE INPUT  PARAMETER pcLogFile AS CHARACTER  NO-UNDO.

  DEFINE VARIABLE  lSaved AS LOGICAL    NO-UNDO.

  IF pcLogFile EQ ? THEN
    pcLogFile = ''.

  IF pcLogFile EQ '' OR
     pcLogFile EQ 'proexec.log' THEN DO:
    SYSTEM-DIALOG GET-FILE pcLogFile
        FILTERS 'Log Files  (*.log)'    '*.log',
                'Text Files (*.txt)'    '*.txt',
                'Data Files (*.dat)'    '*.dat',
                'All Files  (*.*)'      '*.*'
        INITIAL-FILTER 1
        ASK-OVERWRITE
        DEFAULT-EXTENSION '.log'
        INITIAL-DIR SESSION:TEMP-DIRECTORY
        SAVE-AS
        TITLE 'Save Pro*Spy Plus Log File ...'
        UPDATE lSaved.

    IF NOT lSaved OR pcLogFile EQ '' THEN
      RETURN 'Cancelled'.
  END.

  OUTPUT TO VALUE(pcLogFile).
  FOR EACH tSpyInfo NO-LOCK:
    PUT UNFORMATTED tSpyInfo.tType          ',' 
                    STRING(tSpyInfo.tBatch) ' | ' 
                    tSpyInfo.tSource        ' | ' 
                    tSpyInfo.tSrcProc       ' | ' 
                    tSpyInfo.tProcName      ' | '
                    tSpyInfo.tTarget        ' | '
                    tSpyInfo.tLevel         ' | '
                    tSpyInfo.tParms CHR(10).
  END.
  OUTPUT CLOSE.
  gcOpenLog = pcLogFile.
  glModified = FALSE.
  RUN updateFruList ( gcOpenLog ).

  RETURN ''.
  
END PROCEDURE.

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

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE setupBrowse C-Win 
PROCEDURE setupBrowse :
/*------------------------------------------------------------------------------
  Purpose:     
  Parameters:  <none>
  Notes:       
------------------------------------------------------------------------------*/
  DEFINE INPUT  PARAMETER phBrowse  AS HANDLE     NO-UNDO.
  DEFINE INPUT  PARAMETER phQuery   AS HANDLE     NO-UNDO.
  DEFINE INPUT  PARAMETER pcColumns AS CHARACTER  NO-UNDO.
  
  DEFINE VARIABLE iColumn   AS INTEGER    NO-UNDO.
  DEFINE VARIABLE iColPos   AS INTEGER    NO-UNDO.

  DEFINE VARIABLE hBuffer   AS HANDLE     NO-UNDO.
  DEFINE VARIABLE hColumn   AS HANDLE     NO-UNDO.

  DEFINE VARIABLE cColWdths AS CHARACTER  NO-UNDO.

  GET-KEY-VALUE SECTION 'ProSpy' KEY 'ColumnWidths' VALUE cColWdths.

  ASSIGN hBuffer             = phQuery:GET-BUFFER-HANDLE(1)
         phBrowse:QUERY      = ?
         phBrowse:QUERY      = phQuery
         phBrowse:EXPANDABLE = FALSE NO-ERROR.

  DO iColumn = 1 TO (IF pcColumns EQ '*' THEN hBuffer:NUM-FIELDS 
                     ELSE NUM-ENTRIES(pcColumns)):
    IF pcColumns EQ '*' THEN
      hColumn = phBrowse:ADD-LIKE-COLUMN(hBuffer:BUFFER-FIELD(iColumn)).
    ELSE
      hColumn = phBrowse:ADD-LIKE-COLUMN(ENTRY(iColumn,pcColumns)).

    iColPos = LOOKUP(hColumn:NAME,cColWdths,CHR(2)).
    IF iColPos > 0 THEN
      hColumn:WIDTH-CHARS = DECIMAL(ENTRY(iColPos + 1,cColWdths,CHR(2))) NO-ERROR.

    ON 'END-RESIZE' OF hColumn PERSISTENT RUN columnResized 
                                            IN THIS-PROCEDURE (hColumn).
  END.

  ASSIGN phBrowse:SENSITIVE = TRUE
         phBrowse:READ-ONLY = FALSE NO-ERROR.
  
END PROCEDURE.

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

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE toolbarState C-Win 
PROCEDURE toolbarState :
/*------------------------------------------------------------------------------
  Purpose:     Responsible for handling the state of the toolbar and menu.
  Parameters:  INPUT pcAction AS CHARACTER
  Notes:       
------------------------------------------------------------------------------*/
  DEFINE INPUT  PARAMETER pcAction AS CHARACTER  NO-UNDO.

  DEFINE VARIABLE cMode AS CHARACTER  NO-UNDO.

  DEFINE VARIABLE iMenu AS INTEGER    NO-UNDO.

  cMode = (IF NUM-ENTRIES(pcAction) > 1 THEN ENTRY(2,pcAction) ELSE '').
  pcAction = ENTRY(1,pcAction).

  CASE pcAction:
    WHEN 'Trace' THEN DO:
      /* We're tracing so disable almost every action from the user. */
      ASSIGN btnStart:SENSITIVE             {&M}  = FALSE
             {&MI} m_Start:SENSITIVE        {&MB} = FALSE
             btnStop:SENSITIVE              {&M}  = TRUE
             {&MI} m_Stop:SENSITIVE         {&MB} = TRUE
             {&MI} m_Open_Log:SENSITIVE     {&MB} = FALSE
             {&MI} m_Close_Log:SENSITIVE    {&MB} = FALSE
             btnFilter:SENSITIVE            {&M}  = FALSE
             {&MI} m_Filter:SENSITIVE       {&MB} = FALSE
             btnResults:SENSITIVE           {&M}  = FALSE
             btnMark:SENSITIVE              {&M}  = FALSE
             {&MI} m_Mark:SENSITIVE         {&MB} = FALSE
             {&MI} m_Refresh_List:SENSITIVE {&MB} = FALSE
             {&MI} m_Save_Log:SENSITIVE     {&MB} = FALSE
             {&MI} m_Save_Log_As:SENSITIVE  {&MB} = FALSE
             CtrlFrame:SENSITIVE                  = FALSE
             {&MI} m_Hide_ADE:SENSITIVE     {&MB} = FALSE
             {&MI} m_Hide_UIB:SENSITIVE     {&MB} = FALSE
             SUB-MENU m_Tree_Font:SENSITIVE {&MB} = FALSE
             {&MI} m_help_topics:SENSITIVE  {&MB} = FALSE
             {&MI} m_PROSpy_Help:SENSITIVE  {&MB} = FALSE
             {&MI} m_About_PROSpy:SENSITIVE {&MB} = FALSE
             fiStatus:SCREEN-VALUE          {&M}  = 'Tracing ...'
             BROWSE {&BROWSE-NAME}:SENSITIVE      = FALSE.
      /* Don't allow the user to access anything from the 
         Files Recently Used (FRU) list. */
      DO iMenu = 1 TO 6:
        IF VALID-HANDLE(ghMenu[iMenu]) THEN
          ghMenu[iMenu]:SENSITIVE = FALSE.
      END.
    END.
    WHEN 'endTrace' THEN DO:
      /* Enable appropriate items depending on whether there is anything
         in the log */
      IF cMode EQ 'data' THEN
        ASSIGN {&MI} m_Close_Log:SENSITIVE    {&MB} = TRUE
               {&MI} m_Save_Log:SENSITIVE     {&MB} = TRUE
               {&MI} m_Save_Log_As:SENSITIVE  {&MB} = TRUE
               btnFilter:SENSITIVE            {&M}  = TRUE
               {&MI} m_Filter:SENSITIVE       {&MB} = TRUE
               BROWSE {&BROWSE-NAME}:SENSITIVE      = TRUE.
      ELSE
        ASSIGN {&MI} m_Close_Log:SENSITIVE    {&MB} = FALSE
               {&MI} m_Save_Log:SENSITIVE     {&MB} = FALSE
               {&MI} m_Save_Log_As:SENSITIVE  {&MB} = FALSE
               btnFilter:SENSITIVE            {&M}  = FALSE
               {&MI} m_Filter:SENSITIVE       {&MB} = FALSE
               btnResults:SENSITIVE           {&M}  = FALSE
               BROWSE {&BROWSE-NAME}:SENSITIVE      = FALSE.

      ASSIGN btnStart:SENSITIVE             {&M}  = TRUE
             {&MI} m_Start:SENSITIVE        {&MB} = TRUE
             btnStop:SENSITIVE              {&M}  = FALSE
             {&MI} m_Stop:SENSITIVE         {&MB} = FALSE
             {&MI} m_Open_Log:SENSITIVE     {&MB} = TRUE
             btnMark:SENSITIVE              {&M}  = TRUE
             {&MI} m_Mark:SENSITIVE         {&MB} = TRUE
             {&MI} m_Refresh_List:SENSITIVE {&MB} = TRUE
             CtrlFrame:SENSITIVE                  = TRUE
             {&MI} m_Hide_ADE:SENSITIVE     {&MB} = TRUE
             {&MI} m_Hide_UIB:SENSITIVE     {&MB} = TRUE
             SUB-MENU m_Tree_Font:SENSITIVE {&MB} = TRUE
             {&MI} m_help_topics:SENSITIVE  {&MB} = TRUE
             {&MI} m_PROSpy_Help:SENSITIVE  {&MB} = TRUE
             {&MI} m_About_PROSpy:SENSITIVE {&MB} = TRUE
             fiStatus:SCREEN-VALUE          {&M}  = (IF fiStatus:SCREEN-VALUE BEGINS 'Tracing' OR
                                                        fiStatus:SCREEN-VALUE BEGINS 'Processing'
                                                     THEN '' ELSE fiStatus:SCREEN-VALUE).
      /* Re-Enable all the FRUs */
      DO iMenu = 1 TO 6:
        IF VALID-HANDLE(ghMenu[iMenu]) THEN
          ghMenu[iMenu]:SENSITIVE = TRUE.
      END.
    END.
  END CASE.
END PROCEDURE.

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

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE updateFruList C-Win 
PROCEDURE updateFruList :
/*------------------------------------------------------------------------------
  Purpose:     Adds the input file to the Files Recently Used list (FruList)
  Parameters:  INPUT pcFileName AS CHARACTER
  Notes:       
------------------------------------------------------------------------------*/
  DEFINE INPUT  PARAMETER pcFileName AS CHARACTER  NO-UNDO.

  DEFINE VARIABLE cFruList  AS CHARACTER  NO-UNDO.
  DEFINE VARIABLE cTempList AS CHARACTER  NO-UNDO.

  DEFINE VARIABLE iEntry    AS INTEGER    NO-UNDO.

  GET-KEY-VALUE SECTION 'ProSpy' KEY 'FruList' VALUE cFruList.

  IF pcFileName EQ ? OR pcFileName EQ '' OR pcFileName EQ 'proexec.log' THEN
    RETURN 'Invalid FileName'.

  cTempList = pcFileName.

  MENU-LOOP:
  DO iEntry = 1 TO MIN(6,NUM-ENTRIES(cFruList)):
    IF NUM-ENTRIES(cTempList) = 6 THEN
      LEAVE MENU-LOOP.

    IF ENTRY(iEntry,cFruList) EQ pcFileName OR 
       ENTRY(iEntry,cFruList) EQ '' OR
       ENTRY(iEntry,cFruList) EQ ? THEN
      NEXT MENU-LOOP.

    cTempList = cTempList + (IF cTempList NE '' THEN ',' ELSE '') + ENTRY(iEntry,cFruList).
  END.
  
  PUT-KEY-VALUE SECTION 'ProSpy' KEY 'FruList' VALUE cTempList NO-ERROR.
END PROCEDURE.

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

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

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION addNode C-Win 
FUNCTION addNode RETURNS LOGICAL
  ( ) :
/*------------------------------------------------------------------------------
  Purpose:  
    Notes:  
------------------------------------------------------------------------------*/
  DEFINE VARIABLE chParent   AS COM-HANDLE NO-UNDO.
  
  DEFINE VARIABLE cKey       AS CHARACTER  NO-UNDO.
  DEFINE VARIABLE cParentKey AS CHARACTER  NO-UNDO.

  IF NOT AVAILABLE tSpyInfo THEN
    RETURN FALSE.
  
  IF tSpyInfo.tParentID NE ? THEN
    cParentKey = STRING(tSpyInfo.tParentID).
  ELSE cParentKey = ?.

  chParent = gchTreeView:Nodes:ITEM(cParentKey) NO-ERROR.

  cKey = STRING(ROWID(tSpyInfo)).
  
  gchNodes:ADD(chParent,
               4,
               cKey,
               tSpyInfo.tDescript) NO-ERROR.

  chParent = gchTreeView:Nodes:ITEM(cKey) NO-ERROR.
  chParent = ? NO-ERROR.

  RELEASE tSpyInfo.

  RETURN TRUE.

END FUNCTION.

/* [ Com-Handle-Var = ] <com-handle>: Add (            */
/*       <anytype>-Relative BY-VARIANT-POINTER,        */
/*       <anytype>-Relationship BY-VARIANT-POINTER,    */
/*       <anytype>-Key BY-VARIANT-POINTER,             */
/*       <anytype>-Text BY-VARIANT-POINTER,            */
/*       <anytype>-Image BY-VARIANT-POINTER,           */
/*       <anytype>-SelectedImage BY-VARIANT-POINTER ). */

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

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION changeFont C-Win 
FUNCTION changeFont RETURNS LOGICAL
  ( INPUT phMenu AS HANDLE,
    INPUT piFont AS INTEGER ) :
/*------------------------------------------------------------------------------
  Purpose:  
    Notes:  
------------------------------------------------------------------------------*/
  IF phMenu:CHECKED THEN DO:
    IF VALID-HANDLE(ghSelectedFont) THEN
      ghSelectedFont:CHECKED = FALSE.
    ghSelectedFont = phMenu.
    gchTreeView:FONT:SIZE = piFont.

    RETURN TRUE.
  END.
  RETURN FALSE.
END FUNCTION.

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

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION doesExist C-Win 
FUNCTION doesExist RETURNS LOGICAL
  ( INPUT pcFileName AS CHARACTER ) :
/*------------------------------------------------------------------------------
  Purpose:  Verifies whether a file exists in the operating system. This
            only works with windows.
    Notes:  
------------------------------------------------------------------------------*/
  DEFINE VARIABLE lExists  AS LOGICAL    NO-UNDO.

  DEFINE VARIABLE cTemp    AS CHARACTER  NO-UNDO.
  DEFINE VARIABLE cOutFile AS CHARACTER  NO-UNDO.
  DEFINE VARIABLE cInput   AS CHARACTER  NO-UNDO.
  DEFINE VARIABLE cFile    AS CHARACTER  NO-UNDO.

  ASSIGN pcFileName = REPLACE(pcFileName,'/','\')
         cTemp      = RIGHT-TRIM(SESSION:TEMP-DIRECTORY,'\') + '\'
         cOutFile   = cTemp + 'psfound.dat'
         cFile      = ENTRY(NUM-ENTRIES(pcFileName,'\'),pcFileName,'\').

  OUTPUT {&PS} TO VALUE(cTemp + 'psfindit.bat').
  PUT {&PS} UNFORMATTED ENTRY(1,cTemp,':') ':' CHR(10).
  PUT {&PS} UNFORMATTED 'CD ~"' ENTRY(2,cTemp,':') '~"' CHR(10).
  PUT {&PS} UNFORMATTED 'DIR /B ~"' pcFileName '~" > ~"' cOutFile '~"' CHR(10).
  OUTPUT {&PS} CLOSE.

  OS-COMMAND SILENT VALUE('~"' + cTemp + '\psfindit.bat~"').
  INPUT {&PS} FROM VALUE(cOutFile).
  REP-BLK:
  REPEAT:
    IMPORT {&PS} UNFORMATTED cInput.
    IF cInput EQ cFile OR
       cInput EQ pcFileName THEN DO:
      lExists = TRUE.
      LEAVE REP-BLK.
    END.
    IF cInput EQ 'File Not Found' THEN DO:
      lExists = FALSE.
      LEAVE REP-BLK.
    END.
  END.
  INPUT {&PS} CLOSE.
  
  /* Clean up temp files */
  OS-COMMAND SILENT VALUE('DEL /F /Q ~"' + cTemp + 'psfindit.bat~"') NO-ERROR.
  OS-COMMAND SILENT VALUE('DEL /F /Q ~"' + cOutFile + '~"') NO-ERROR.
  
  RETURN lExists.

END FUNCTION.

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

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION getDescription C-Win 
FUNCTION getDescription RETURNS CHARACTER
  ( INPUT pcType     AS CHARACTER,
    INPUT pcProcName AS CHARACTER,
    INPUT pcTarget   AS CHARACTER,
    INPUT pcSource   AS CHARACTER ) :
/*------------------------------------------------------------------------------
  Purpose:  
    Notes:  
------------------------------------------------------------------------------*/
  DEFINE VARIABLE cDescription AS CHARACTER  NO-UNDO.

  cDescription = pcType + ' ' + 
                 pcProcName + ' IN ' + 
                 pcTarget + 
                 '  (' + pcSource + ')'.

  RETURN cDescription.

END FUNCTION.

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

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION getNewId C-Win 
FUNCTION getNewId RETURNS INTEGER
  ( ) :
/*------------------------------------------------------------------------------
  Purpose:  
    Notes:  
------------------------------------------------------------------------------*/
  giCount = giCount + 1.

  RETURN giCount.

END FUNCTION.

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

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION parseInput C-Win 
FUNCTION parseInput RETURNS LOGICAL
  ( INPUT pcInput AS CHARACTER ) :
/*------------------------------------------------------------------------------
   Purpose:  Main engine of prospy plus... used to parse the input from a log
             file into the correct data items.
Parameters:  INPUT pcInput AS CHARACTER
     Notes:  
------------------------------------------------------------------------------*/
  DEFINE VARIABLE cType     AS CHARACTER  NO-UNDO.
  DEFINE VARIABLE cSource   AS CHARACTER  NO-UNDO.
  DEFINE VARIABLE cSrcProc  AS CHARACTER  NO-UNDO.
  DEFINE VARIABLE cProcName AS CHARACTER  NO-UNDO.
  DEFINE VARIABLE cTarget   AS CHARACTER  NO-UNDO.
  DEFINE VARIABLE cParms    AS CHARACTER  NO-UNDO.
  DEFINE VARIABLE cLevel    AS CHARACTER  NO-UNDO.

  /* If this is prospy itself, don't record it */
  IF INDEX(pcInput,'_psplus') > 0 OR 
     INDEX(pcInput,THIS-PROCEDURE:FILE-NAME) > 0 THEN
    RETURN FALSE.
  
  ASSIGN cProcName = TRIM(ENTRY(4,pcInput,'|'))
         cTarget   = TRIM(ENTRY(5,pcInput,'|'))
         cTarget   = (IF NUM-ENTRIES(cProcName,'.') < 2 THEN cTarget ELSE cProcName).

  /* Omit appbuilder calls unless the user has de-selected that option */
  IF glHideUIB AND
     (cTarget BEGINS 'adeuib' OR
      cProcName BEGINS 'adeuib') THEN
    RETURN FALSE.

  /* Omit ade calls if the user has selected that option */
  IF glHideADE AND
     (cTarget BEGINS 'ade' OR
      cProcName BEGINS 'ade') THEN
    RETURN FALSE.

  /* Whittle down the value of pcInput one entry at a time from left to right
     until we get to the parameters section. */
  ASSIGN cType     = UPPER(TRIM(ENTRY(1,pcInput,'|')))
         cSource   = TRIM(ENTRY(2,pcInput,'|'))
         cSrcProc  = TRIM(ENTRY(3,pcInput,'|'))
         cLevel    = TRIM(ENTRY(6,pcInput,'|'))
         ENTRY(6,pcInput,'|') = CHR(3)
         ENTRY(1,pcInput,CHR(3)) = ''
         cParms    = SUBSTRING(pcInput,3).
  
  IF giCurrentBatch EQ 0 THEN
    giCurrentBatch = (IF NUM-ENTRIES(cType) > 1 THEN INT(ENTRY(2,cType)) ELSE giLastBatch + 1).
  
  ASSIGN cType       = ENTRY(1,cType)
         giLastBatch = giCurrentBatch.

  IF cType EQ 'PERSTRIG' THEN
     ASSIGN cType = 'PERSISTENT TRIGGER'.

  IF cSrcProc EQ 'USER-INTERFACE-TRIGGER' AND TRIM(cProcName,"~"") EQ '' THEN
      ASSIGN cProcName = cParms
             cParms    = ''
             cType     = 'TRIGGER'.


  DO TRANSACTION:
    CREATE tSpyInfo.
    /* Assign index values separately */
    tSpyInfo.tSpyId   = getNewId().
    tSpyInfo.tSrcProc = cSrcProc.
    tSpyInfo.tLevel   = INTEGER(cLevel).
    tSpyInfo.tSource  = cSource.
    tSpyInfo.tTarget  = cTarget.
    tSpyInfo.tBatch   = giCurrentBatch.

    ASSIGN tSpyInfo.tType     = cType
           tSpyInfo.tProcName = cProcName
           tSpyInfo.tParms    = cParms
           tSpyInfo.tDescript = (IF cProcName EQ 'SUPER' THEN 
                                   cSrcProc + ' (' + cProcName + ')'
                                 ELSE cProcName) + 
                                      (IF cType EQ 'PUBLISH' THEN ' FROM ' 
                                       ELSE ' IN ') + tSpyInfo.tTarget.

    FIND LAST bSpyInfo WHERE /* Criteria group 1 -- covers SUPER */
                            (((bSpyInfo.tProcName EQ tSpyInfo.tSrcProc) OR
                              (tSpyInfo.tProcName EQ 'SUPER' AND
                               bSpyInfo.tProcName EQ tSpyInfo.tSrcProc) OR
                              (bSpyInfo.tProcName EQ 'SUPER' AND
                               bSpyInfo.tSrcProc = tSpyInfo.tSrcProc)) OR
                            /* Criteria group 2 -- covers MAIN-BLOCK */
                            (tSpyInfo.tSrcProc EQ 'Main Block' AND
                             bSpyInfo.tProcName EQ tSpyInfo.tSource) OR
                            /* Criteria group 3 -- covers triggers */
                            (tSpyInfo.tSrcProc EQ 'USER-INTERFACE-TRIGGER' AND
                             bSpyInfo.tType EQ 'TRIGGER')) AND
                            (bSpyInfo.tBatch = tSpyInfo.tBatch AND
                             bSpyInfo.tLevel = tSpyInfo.tLevel - 1) OR
                            (tSpyInfo.tType NE 'TRIGGER' AND 
                             bSpyInfo.tType EQ 'PUBLISH' AND
                             bSpyInfo.tLevel EQ tSpyInfo.tLevel - 1) OR
                            /* if not covered by anything above, just link it to 
                               the level above this one*/
                            ( bSpyInfo.tLevel EQ tSpyInfo.tLevel - 1)
                            USE-INDEX tLvlParIdx NO-LOCK NO-ERROR.

    IF AVAILABLE bSpyInfo THEN
      tSpyInfo.tParentID = STRING(ROWID(bSpyInfo)).
    ELSE tSpyInfo.tParentID = ?.
  END. /* Transaction Scope End */
  
  RETURN TRUE.

END FUNCTION.

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

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

/*
   This file contains
   Help Context Identifiers for PROGRESS PRO*Tools HELP
   embedded in PROGRESS pre-processor statements.

   The form used in this file is:

	   <Name of the Help Topic>
	   &Global-Define <context-string> <context-number>

   Please contact Documentation to make changes to this file. 
   Thanks. 
*/

/* PRO*Tools Help Contents screen */
&Global-define Main_Contents 0

/*How To help topic (called from Help menu) */
&GLOBAL-DEFINE How_To 40

/* PRO*Tools Palette */
&Global-define Protools_Palette 42

/* PRO*Tools Customization dialog box */
&Global-define Protools_Customize_Dlg_Box 12

/* Add Applet dialog box */
&Global-define Add_Applet_DB 31

/* Update Applet dialog box */
&Global-define Update_Applet_DB 32

/* Find Procedure to Run dialog box */
&Global-define Find_Procedure_DB 33

/* Database Connections Fields dialog box */
&Global-define DC_Fields_DB 30

/* PRO*Spy Contents */
&Global-define PRO_Spy_Contents 3

/* PRO*Spy Setting Breakpoints dialog box */
&Global-define PRO_Spy_Breakpoints 57

/* PRO*Spy Setting Filters dialog box */
&Global-define PRO_Spy_Filters 6

/* PRO*Spy Number of Messages dialog box */
&Global-define PRO_Spy_Number 7

/* PRO*Tools -- Color Changer */
&GLOBAL-DEFINE Color_Changer 14

/* PRO*Tools -- Configuration File */
&GLOBAL-DEFINE Configuration_File 15

/* PRO*Tools -- Control Hierarchy */
&GLOBAL-DEFINE Control_Hierarchy 16

/* PRO*Tools -- Database Connections */
&GLOBAL-DEFINE Database_Connections 17

/* PRO*Tools -- Procedure Object Viewer */
&GLOBAL-DEFINE Procedure_Object_Viewer 18

/* PRO*Tools -- PROPATH Editor */
&GLOBAL-DEFINE PROPATH_Editor 19

/* PRO*Tools -- Run Procedure */
&GLOBAL-DEFINE Run_Procedure 20

/* PRO*Tools -- Session Attributes */
&GLOBAL-DEFINE Session_Attributes 21

/* PRO*Tools -- Window Viewer */
&GLOBAL-DEFINE Window_Viewer 22

/* PRO*Tools --OS-Prompt*/
&GLOBAL-DEFINE OS_Prompt 36

/* PRO*Tools --OS-Prompt*/
&GLOBAL-DEFINE Font_Changer 37

/* PRO*Tools -- Screen Capture*/
&GLOBAL-DEFINE Screen_Capture 38

/* PRO*Tools -- Window Information*/
&GLOBAL-DEFINE Window_Information 39

/* PRO*Spy window */
&Global-define PRO_Spy_Window 4

/* New for version 8.1 ------------------------------------------------------ */

/* Smartobject Upgrade Utility */
&Global-define SmartObject_Upgrade_Utility 76

/* New for version 8.2A ----------------------------------------------------- */

/* Screen Scaling Utility */
&Global-define Screen_Scaling_Utility 99

/* New for version 9.0A ----------------------------------------------------- */

/* AppServer Partition Utility */
&GLOBAL-DEFINE AppServer_Partition 104

/* Prototype Generator */
&GLOBAL-DEFINE Protogen 105

/* Add Partition dialog of AppServer Partition Utility */
&GLOBAL-DEFINE Add_Partition_DB 106

/* SmartObject Upgrade Utility V9 */
&GLOBAL-DEFINE SmartObject_Upgrade_Utility_v9 5

/* AppServer Session Information PRO*Tool */
&GLOBAL-DEFINE AppServer_Session_Information 9

/* New for version 9.1B ----------------------------------------------------- */

/* Index value will change for 9.1B FCS */
&GLOBAL-DEFINE XML_Schema_Mapping_Tool 74

/* New for Dynamics 2.0 ----------------------------------------------------- */

/* Convert old Smart Objects to Dynamic Objects Utility */ 
&GLOBAL-DEFINE Static_to_Dynamic_Conversion_Utility 72 

/* New for 10.1A */
&GLOBAL-DEFINE WidgetID_Assignment_Utility 200
&GLOBAL-DEFINE Object_Attribute_Reference 201

/* New for 10.1C */
&GLOBAL-DEFINE WidgetID_Runtime_Assignment_Utility 127
ÐÏà¡±á>þÿ	þÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿýÿÿÿþÿÿÿþÿÿÿþÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿRoot Entryÿÿÿÿÿÿÿÿ0$RJÖçÂ@CtrlFrameÿÿÿÿÿÿÿÿðáBJÖçÂðOJÖçÂFrameÿÿÿÿÿÿÿÿControl0ÿÿÿÿÿÿÿÿÿÿÿÿãþÿÿÿþÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ	‚;ú&{C74190B6-8589-11D1-B16A-00C0F0283628}TreeView$9368265E-85FE-11d1-8BE3-0000F8754DA1Z!C4Ž ×±<Áj"è1[ºïÍ«]º€hõ\Þì½põTreeViewÿÿÿÿ&ANALYZE-SUSPEND _VERSION-NUMBER UIB_v8r12 GUI
&ANALYZE-RESUME
&Scoped-define WINDOW-NAME CURRENT-WINDOW
&Scoped-define FRAME-NAME Sort-dialog
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _DEFINITIONS Sort-dialog 
/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/
/*------------------------------------------------------------------------

  File: 

  Description: 

  Input Parameters:
      <none>

  Output Parameters:
      <none>

  Author: 

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

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

/* Parameters Definitions ---                                           */
&IF DEFINED(UIB_is_Running) eq 0 &THEN
  DEFINE INPUT-OUTPUT PARAMETER sort-mode AS INTEGER              NO-UNDO.
&ELSE
  DEFINE VARIABLE               sort-mode AS INTEGER INITIAL 2    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 Sort-dialog

/* Standard List Definitions                                            */
&Scoped-Define ENABLED-OBJECTS RECT-6 Btn_OK RADIO-SET-1 Btn_Cancel ~
Btn_Help 
&Scoped-Define DISPLAYED-OBJECTS RADIO-SET-1 

/* 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 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 RADIO-SET-1 AS INTEGER INITIAL 2 
     VIEW-AS RADIO-SET VERTICAL
     RADIO-BUTTONS 
          "Status", 1,
"Name", 2,
"Extension", 3
     SIZE 23 BY 3.33 NO-UNDO.

DEFINE RECTANGLE RECT-6
     EDGE-PIXELS 2 GRAPHIC-EDGE  NO-FILL 
     SIZE 29 BY 4.52.


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

DEFINE FRAME Sort-dialog
     Btn_OK AT ROW 1.52 COL 33
     RADIO-SET-1 AT ROW 1.95 COL 5 NO-LABEL
     Btn_Cancel AT ROW 2.76 COL 33
     Btn_Help AT ROW 4.76 COL 33
     "  Sort by:" VIEW-AS TEXT
          SIZE 10 BY .95 AT ROW 1 COL 4
     RECT-6 AT ROW 1.48 COL 2
     SPACE(20.79) SKIP(0.51)
    WITH VIEW-AS DIALOG-BOX KEEP-TAB-ORDER 
         SIDE-LABELS NO-UNDERLINE THREE-D  SCROLLABLE 
         TITLE "Sort Options"
         DEFAULT-BUTTON Btn_OK CANCEL-BUTTON Btn_Cancel.


/* *********************** 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 UIB Settings  ************** */

&ANALYZE-SUSPEND _RUN-TIME-ATTRIBUTES
/* SETTINGS FOR DIALOG-BOX Sort-dialog
                                                                        */
ASSIGN 
       FRAME Sort-dialog:SCROLLABLE       = FALSE
       FRAME Sort-dialog:HIDDEN           = TRUE.

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

 




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

&Scoped-define SELF-NAME Sort-dialog
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL Sort-dialog Sort-dialog
ON WINDOW-CLOSE OF FRAME Sort-dialog /* Sort Options */
DO:
  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 Sort-dialog
ON CHOOSE OF Btn_Help IN FRAME Sort-dialog /* 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 Sort-dialog
ON CHOOSE OF Btn_OK IN FRAME Sort-dialog /* OK */
DO:
  ASSIGN RADIO-SET-1
         sort-mode = RADIO-SET-1.
END.

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


&UNDEFINE SELF-NAME

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _MAIN-BLOCK Sort-dialog 


/* ***************************  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:
  radio-set-1 = sort-mode.
  RUN enable_UI.
  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 Sort-dialog _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 Sort-dialog.
END PROCEDURE.

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


&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE enable_UI Sort-dialog _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 RADIO-SET-1 
      WITH FRAME Sort-dialog.
  ENABLE RECT-6 Btn_OK RADIO-SET-1 Btn_Cancel Btn_Help 
      WITH FRAME Sort-dialog.
  VIEW FRAME Sort-dialog.
  {&OPEN-BROWSERS-IN-QUERY-Sort-dialog}
END PROCEDURE.

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


&ANALYZE-SUSPEND _VERSION-NUMBER UIB_v9r12 GUI
&ANALYZE-RESUME
&Scoped-define WINDOW-NAME CURRENT-WINDOW
&Scoped-define FRAME-NAME Dialog-Frame
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _DEFINITIONS Dialog-Frame 
/*------------------------------------------------------------------------

  File: _psvaldlg.w

  Description: Input value dialog for a field.  Called by Pro*Spy Plus 
               Filter Window

  Parameters:
  INPUT pcField     AS CHARACTER -- The label of the field
  INPUT pcOperator  AS CHARACTER -- The operator the user selected in the 
                                    filter window
  OUTPUT pcOperator AS CHARACTER -- Value entered by user
  
  Author: Kenneth S. McIntosh

  History: Submitted December 16th, 2002
------------------------------------------------------------------------*/
/*          This .W file was created with the Progress AppBuilder.       */
/*----------------------------------------------------------------------*/

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

/* Parameters Definitions ---                                           */

/* Local Variable Definitions ---                                       */

DEFINE INPUT  PARAMETER pcField    AS CHARACTER  NO-UNDO.
DEFINE INPUT  PARAMETER pcOperator AS CHARACTER  NO-UNDO.
DEFINE OUTPUT PARAMETER pcValue    AS CHARACTER  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 first Frame and/or Browse and/or first Query                 */
&Scoped-define FRAME-NAME Dialog-Frame

/* Standard List Definitions                                            */
&Scoped-Define ENABLED-OBJECTS fiValue Btn_Cancel Btn_OK 
&Scoped-Define DISPLAYED-OBJECTS fiValue lblValue 

/* 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 Btn_Cancel AUTO-END-KEY 
     LABEL "Cancel" 
     SIZE 15 BY 1.14
     BGCOLOR 8 .

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

DEFINE VARIABLE fiValue AS CHARACTER FORMAT "X(256)":U 
     VIEW-AS FILL-IN 
     SIZE 58 BY 1
     FONT 0 NO-UNDO.

DEFINE VARIABLE lblValue AS CHARACTER FORMAT "X(256)":U 
      VIEW-AS TEXT 
     SIZE 42 BY .67
     FONT 0 NO-UNDO.


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

DEFINE FRAME Dialog-Frame
     fiValue AT ROW 2.91 COL 3 COLON-ALIGNED NO-LABEL
     Btn_Cancel AT ROW 5.05 COL 34
     Btn_OK AT ROW 5.05 COL 50
     lblValue AT ROW 1.48 COL 9 COLON-ALIGNED NO-LABEL
     SPACE(12.99) SKIP(4.08)
    WITH VIEW-AS DIALOG-BOX KEEP-TAB-ORDER 
         SIDE-LABELS NO-UNDERLINE THREE-D  SCROLLABLE 
         TITLE "Enter value for "
         DEFAULT-BUTTON Btn_OK CANCEL-BUTTON Btn_Cancel.


/* *********************** 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
                                                                        */
ASSIGN 
       FRAME Dialog-Frame:SCROLLABLE       = FALSE
       FRAME Dialog-Frame:HIDDEN           = TRUE.

/* SETTINGS FOR FILL-IN lblValue IN FRAME Dialog-Frame
   NO-ENABLE                                                            */
/* _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 /* Enter value for  */
DO:
  APPLY "END-ERROR":U TO SELF.
END.

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


&Scoped-define SELF-NAME Btn_Cancel
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL Btn_Cancel Dialog-Frame
ON CHOOSE OF Btn_Cancel IN FRAME Dialog-Frame /* Cancel */
DO:
  pcValue = ?.
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:
  pcValue = fiValue:SCREEN-VALUE.
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.


/* 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.
  ASSIGN lblValue:SCREEN-VALUE IN FRAME {&FRAME-NAME} = pcField + ' ' + pcOperator
         FRAME {&FRAME-NAME}:TITLE                    = FRAME {&FRAME-NAME}:TITLE + pcField.
  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 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 fiValue lblValue 
      WITH FRAME Dialog-Frame.
  ENABLE fiValue Btn_Cancel Btn_OK 
      WITH FRAME Dialog-Frame.
  VIEW FRAME Dialog-Frame.
  {&OPEN-BROWSERS-IN-QUERY-Dialog-Frame}
END PROCEDURE.

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

++ Old Name                        ++ New Name
"UIB_v8r12 GUI"                    "AB_v9r12 GUI ADM2"
"RUN initialize "                  "RUN initializeObject "
"init-pages"                       "initPages"
"init-object"                      "constructObject"
"set-position"                     "repositionObject"
"exit"                             "exitObject"
"set-size"                         "resizeObject"
"add-link"                         "addLink"
"adjust-tab-order"                 "adjustTabOrder"
"select-page"                      "selectPage"
"SmartBrowser"                     "SmartDataBrowser"
"SmartQuery"                       "SmartDataObject"
"SmartViewer"                      "SmartDataViewer"
"'Record':U"                       "'Data':U"
"{src/adm/template/windowmn.i}"    "{src/adm2/windowmn.i}"
"{src/adm/template/dialogmn.i}"    "{src/adm2/dialogmn.i}"
" IN THIS-PROCEDURE"               ""
" IN adm-broker-hdl"               ""
++ Remove List
"Keys-Accepted"                    Attribute
"Keys-Supplied"                    Attribute
"SortBy-Options"                   Attribute
"key-value"                        Attribute
"OPEN-QUERY-CASES"                 Procedure
"ROW-AVAILABLE"                    Procedure
"SEND-KEY"                         Procedure
"SEND-RECORDS"                     Procedure
"STATE-CHANGED"                    Procedure
"Foreign Keys"                     Procedure
"Find-Using-Key"                   Procedure
"Advanced Query Options"           Procedure
"_INCLUDED-LIB"                    Procedure
++ Method List
add-record                         addRecord        P " "
apply-entry                        applyEntry       P " "
apply-layout                       applyLayout      P " "
cancel-record                      cancelRecord     P " "
change-page                        changePage       P " "
copy-record                        copyRecord       P " "
delete-record                      deleteRecord     P " "
destroy                            destroyObject    P " "
disable                            disableObject    P " "
disable-fields                     disableFields    P "pcFieldType|CHAR|I"
display-fields                     displayFields    P "pcColValues|CHAR|I"
enable                             enableObject     P " "
enable-fields                      enableFields     P " "
get-first                          fetchFirst       P " "
get-last                           fetchLast        P " "
get-next                           fetchNext        P " "
get-prev                           fetchPrev        P " "
hide                               hideObject       P " "
initialize                         initializeObject P " "
open-query                         openQuery        FL " "
reset-record                       resetRecord      P " "
row-changed                        rowChanged       P " "
update-record                      updateRecord     P " "
view                               viewObject       P " "
++ Built-in Attribute List
Version                            ObjectVersion
Type                               ObjectType
Container-Type                     ContainerType
Query-Object                       QueryObject
ADM-Object-Handle                  ContainerHandle
ADM-attribute-list                 InstanceProperties
Supported-Links                    SupportedLinks
ADM-Parent                         ObjectParent
Hidden                             ObjectHidden
Initialized                        ObjectInitialized
UIB-Mode                           UIBMode
ADM-Translation-Attributes         TranslatableProperties
Current-Page                       CurrentPage
Layout                             ObjectLayout
Hide-On-Init                       HideOnInit
Disable-On-Init                    DisableOnInit
Fields-Enabled                     FieldsEnabled
ADM-new-record                     NewRecord
Right-To-Left                      RightToLeft
Enabled-Tables                     EnabledTables







 

&ANALYZE-SUSPEND _VERSION-NUMBER AB_v10r12 GUI ADM2
&ANALYZE-RESUME
/* Connected Databases 
*/
&Scoped-define WINDOW-NAME CURRENT-WINDOW

/* Temp-Table and Buffer definitions                                    */
DEFINE TEMP-TABLE RowObject
       {"protools/dappsrv.i"}.


&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _DEFINITIONS vTableWin 
/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/
/*------------------------------------------------------------------------

  File:               protools/vappsrv.w

  Description:        AppServer Partition Viewer. 
                      This Viewer provides editing facilities for the
                      AppServer partition type data in appserv-tt.

  Input Parameters:
      <none>

  Output Parameters:
      <none>

  Created:            May 9, 2000 - Bruce Gruenbaum

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

/* Parameters Definitions ---                                           */

/* Local Variable Definitions ---                                       */

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


&ANALYZE-SUSPEND _UIB-PREPROCESSOR-BLOCK 

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

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

&Scoped-define ADM-CONTAINER FRAME

&Scoped-define ADM-SUPPORTED-LINKS Data-Target,Update-Source,TableIO-Target,GroupAssign-Source,GroupAssign-Target

/* Include file with RowObject temp-table definition */
&Scoped-define DATA-FIELD-DEFS "protools/dappsrv.i"

/* Name of first Frame and/or Browse and/or first Query                 */
&Scoped-define FRAME-NAME F-Main

/* Standard List Definitions                                            */
&Scoped-Define ENABLED-FIELDS RowObject.Partition RowObject.Host ~
RowObject.Parameters RowObject.Service RowObject.App-Service ~
RowObject.ServerURL RowObject.Configuration RowObject.Security ~
RowObject.Info 
&Scoped-define ENABLED-TABLES RowObject
&Scoped-define FIRST-ENABLED-TABLE RowObject
&Scoped-Define ENABLED-OBJECTS RECT-2 
&Scoped-Define DISPLAYED-FIELDS RowObject.Partition RowObject.Host ~
RowObject.Parameters RowObject.Service RowObject.App-Service ~
RowObject.ServerURL RowObject.Configuration RowObject.Security ~
RowObject.Info 
&Scoped-define DISPLAYED-TABLES RowObject
&Scoped-define FIRST-DISPLAYED-TABLE RowObject
&Scoped-Define DISPLAYED-OBJECTS toSSL toSessionReuse toHostVerify 

/* Custom List Definitions                                              */
/* ADM-ASSIGN-FIELDS,List-2,List-3,List-4,List-5,List-6                 */

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



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


/* Definitions of the field level widgets                               */
DEFINE RECTANGLE RECT-2
     EDGE-PIXELS 2 GRAPHIC-EDGE  NO-FILL 
     SIZE 68 BY 15.1.

DEFINE VARIABLE toHostVerify AS LOGICAL INITIAL no 
     LABEL "Host verification disabled" 
     VIEW-AS TOGGLE-BOX
     SIZE 30 BY .81 TOOLTIP "Host verification disabled (-nohostverify)" NO-UNDO.

DEFINE VARIABLE toSessionReuse AS LOGICAL INITIAL no 
     LABEL "Session reuse disabled" 
     VIEW-AS TOGGLE-BOX
     SIZE 30 BY .81 TOOLTIP "Session reuse disabled (-nosessionreuse)" NO-UNDO.

DEFINE VARIABLE toSSL AS LOGICAL INITIAL no 
     LABEL "SSL enabled" 
     VIEW-AS TOGGLE-BOX
     SIZE 30 BY .81 TOOLTIP "SSL enabled (-ssl)" NO-UNDO.


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

DEFINE FRAME F-Main
     RowObject.Partition AT ROW 1.24 COL 20 COLON-ALIGNED
          VIEW-AS FILL-IN 
          SIZE 27 BY 1
     RowObject.Host AT ROW 2.43 COL 20 COLON-ALIGNED
          LABEL "Host (-H)"
          VIEW-AS FILL-IN 
          SIZE 17 BY 1
     RowObject.Parameters AT ROW 2.91 COL 41 NO-LABEL
          VIEW-AS FILL-IN 
          SIZE 27 BY 1
     RowObject.Service AT ROW 3.62 COL 20 COLON-ALIGNED
          LABEL "Service (-S)"
          VIEW-AS FILL-IN 
          SIZE 17 BY 1
     toSSL AT ROW 4.71 COL 22.2
     toSessionReuse AT ROW 5.48 COL 22.2
     toHostVerify AT ROW 6.24 COL 22.2
     RowObject.App-Service AT ROW 7.05 COL 2.6
          VIEW-AS FILL-IN 
          SIZE 27 BY 1
     RowObject.ServerURL AT ROW 8.24 COL 5.8
          LABEL "AppServer URL"
          VIEW-AS FILL-IN 
          SIZE 45 BY 1
     RowObject.Configuration AT ROW 9.43 COL 22 NO-LABEL
          VIEW-AS RADIO-SET HORIZONTAL EXPAND 
          RADIO-BUTTONS 
                    "Remote", yes,
"Local", no
          SIZE 31 BY .95
     RowObject.Security AT ROW 10.38 COL 22
          LABEL "Prompt for userid and password"
          VIEW-AS TOGGLE-BOX
          SIZE 34.6 BY .81
     RowObject.Info AT ROW 12.29 COL 3 NO-LABEL
          VIEW-AS EDITOR NO-WORD-WRAP MAX-CHARS 255 SCROLLBAR-HORIZONTAL SCROLLBAR-VERTICAL
          SIZE 64 BY 3.57
     "AppServer Information String:" VIEW-AS TEXT
          SIZE 29 BY .62 AT ROW 11.33 COL 3
     "Configuration:" VIEW-AS TEXT
          SIZE 13 BY .95 AT ROW 9.43 COL 8
     RECT-2 AT ROW 1 COL 1
    WITH 1 DOWN NO-BOX KEEP-TAB-ORDER OVERLAY USE-DICT-EXPS 
         SIDE-LABELS NO-UNDERLINE THREE-D NO-AUTO-VALIDATE 
         AT COL 1 ROW 1 SCROLLABLE .


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

&ANALYZE-SUSPEND _PROCEDURE-SETTINGS
/* Settings for THIS-PROCEDURE
   Type: SmartDataViewer
   Data Source: "protools/dappsrv.w"
   Allow: Basic,DB-Fields,Smart
   Container Links: Data-Target,Update-Source,TableIO-Target,GroupAssign-Source,GroupAssign-Target
   Frames: 1
   Add Fields to: Neither
   Other Settings: PERSISTENT-ONLY COMPILE
   Temp-Tables and Buffers:
      TABLE: RowObject D "?" ?  
      ADDITIONAL-FIELDS:
          {protools/dappsrv.i}
      END-FIELDS.
   END-TABLES.
 */

/* This procedure should always be RUN PERSISTENT.  Report the error,  */
/* then cleanup and return.                                            */
IF NOT THIS-PROCEDURE:PERSISTENT THEN DO:
  MESSAGE "{&FILE-NAME} should only be RUN PERSISTENT.":U
          VIEW-AS ALERT-BOX ERROR BUTTONS OK.
  RETURN.
END.

&ANALYZE-RESUME _END-PROCEDURE-SETTINGS

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

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

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _INCLUDED-LIB vTableWin 
/* ************************* Included-Libraries *********************** */

{src/adm2/viewer.i}
{adecomm/_adetool.i}

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




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

&ANALYZE-SUSPEND _RUN-TIME-ATTRIBUTES
/* SETTINGS FOR WINDOW vTableWin
  VISIBLE,,RUN-PERSISTENT                                               */
/* SETTINGS FOR FRAME F-Main
   NOT-VISIBLE Size-to-Fit                                              */
ASSIGN 
       FRAME F-Main:SCROLLABLE       = FALSE
       FRAME F-Main:HIDDEN           = TRUE.

/* SETTINGS FOR FILL-IN RowObject.App-Service IN FRAME F-Main
   ALIGN-L                                                              */
/* SETTINGS FOR RADIO-SET RowObject.Configuration IN FRAME F-Main
   EXP-LABEL                                                            */
/* SETTINGS FOR FILL-IN RowObject.Host IN FRAME F-Main
   EXP-LABEL                                                            */
/* SETTINGS FOR EDITOR RowObject.Info IN FRAME F-Main
   EXP-LABEL                                                            */
/* SETTINGS FOR FILL-IN RowObject.Parameters IN FRAME F-Main
   ALIGN-L                                                              */
ASSIGN 
       RowObject.Parameters:HIDDEN IN FRAME F-Main           = TRUE.

/* SETTINGS FOR TOGGLE-BOX RowObject.Security IN FRAME F-Main
   EXP-LABEL                                                            */
/* SETTINGS FOR FILL-IN RowObject.ServerURL IN FRAME F-Main
   ALIGN-L EXP-LABEL                                                    */
/* SETTINGS FOR FILL-IN RowObject.Service IN FRAME F-Main
   EXP-LABEL                                                            */
/* SETTINGS FOR TOGGLE-BOX toHostVerify IN FRAME F-Main
   NO-ENABLE                                                            */
/* SETTINGS FOR TOGGLE-BOX toSessionReuse IN FRAME F-Main
   NO-ENABLE                                                            */
/* SETTINGS FOR TOGGLE-BOX toSSL IN FRAME F-Main
   NO-ENABLE                                                            */
/* _RUN-TIME-ATTRIBUTES-END */
&ANALYZE-RESUME


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

&ANALYZE-SUSPEND _QUERY-BLOCK FRAME F-Main
/* Query rebuild information for FRAME F-Main
     _Options          = "NO-LOCK"
     _Query            is NOT OPENED
*/  /* FRAME F-Main */
&ANALYZE-RESUME

 



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

&Scoped-define SELF-NAME toHostVerify
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL toHostVerify vTableWin
ON VALUE-CHANGED OF toHostVerify IN FRAME F-Main /* Host verification disabled */
DO:
  {set DataModified TRUE}.
  RUN setParameters.  
END.

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


&Scoped-define SELF-NAME toSessionReuse
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL toSessionReuse vTableWin
ON VALUE-CHANGED OF toSessionReuse IN FRAME F-Main /* Session reuse disabled */
DO:
  {set DataModified TRUE}.
  RUN setParameters.  
END.

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


&Scoped-define SELF-NAME toSSL
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL toSSL vTableWin
ON VALUE-CHANGED OF toSSL IN FRAME F-Main /* SSL enabled */
DO:
  {set DataModified TRUE}.
  RUN setParameters.
END.

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


&UNDEFINE SELF-NAME

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


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

  &IF DEFINED(UIB_IS_RUNNING) <> 0 &THEN          
    RUN initializeObject.
  &ENDIF         
  
  /************************ INTERNAL PROCEDURES ********************/

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


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

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE disableFields vTableWin 
PROCEDURE disableFields :
/*------------------------------------------------------------------------------
  Purpose:     Super Override
  Parameters:  
  Notes:       
------------------------------------------------------------------------------*/

  DEFINE INPUT PARAMETER pcFieldType AS CHARACTER NO-UNDO.

  RUN SUPER( INPUT pcFieldType).
  DO WITH FRAME {&FRAME-NAME}:
     ASSIGN toSSL:SENSITIVE          = FALSE
            toSessionReuse:SENSITIVE = FALSE
            toHostVerify:SENSITIVE   = FALSE.
  END.

END PROCEDURE.

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

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE disable_UI vTableWin  _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-Main.
  IF THIS-PROCEDURE:PERSISTENT THEN DELETE PROCEDURE THIS-PROCEDURE.
END PROCEDURE.

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

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE displayFields vTableWin 
PROCEDURE displayFields :
/*------------------------------------------------------------------------------
  Purpose:     Super Override
  Parameters:  
  Notes:       
------------------------------------------------------------------------------*/

  DEFINE INPUT PARAMETER pcColValues AS CHARACTER NO-UNDO.

  RUN SUPER( INPUT pcColValues).
  DO WITH FRAME {&FRAME-NAME}:
     toSSL:CHECKED          = INDEX(RowObject.Parameters:SCREEN-VALUE, "-ssl") > 0.
     toSessionReuse:CHECKED = INDEX(RowObject.Parameters:SCREEN-VALUE, "-nosessionreuse") > 0.
     toHostVerify:CHECKED   = INDEX(RowObject.Parameters:SCREEN-VALUE, "-nohostverify") > 0.
  END.

END PROCEDURE.

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

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE enableFields vTableWin 
PROCEDURE enableFields :
/*------------------------------------------------------------------------------
  Purpose:     Super Override
  Parameters:  
  Notes:       
------------------------------------------------------------------------------*/
  DEFINE VARIABLE hDataSource    AS HANDLE    NO-UNDO.
  DEFINE VARIABLE cQueryPosition AS CHARACTER NO-UNDO.

  RUN SUPER.

  {get DataSource hDataSource}.
  IF NOT VALID-HANDLE(hDataSource) THEN
     RETURN.

  IF DYNAMIC-FUNCTION('getQueryPosition':U IN hDataSource) <> "NoRecordAvailable":U 
     OR DYNAMIC-FUNCTION('getNewRecord':U) = "Add":U THEN
  DO WITH FRAME {&FRAME-NAME}:
     ASSIGN toSSL:SENSITIVE          = TRUE
            toSessionReuse:SENSITIVE = TRUE
            toHostVerify:SENSITIVE   = TRUE.
  END.

END PROCEDURE.

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

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE setParameters vTableWin 
PROCEDURE setParameters PRIVATE :
/*------------------------------------------------------------------------------
  Purpose:     
  Parameters:  <none>
  Notes:       
------------------------------------------------------------------------------*/
  
  DO WITH FRAME {&FRAME-NAME}:
     RowObject.Parameters:SCREEN-VALUE =
        (IF toSSL:CHECKED          THEN " -ssl":U            ELSE "":U) +
        (IF toSessionReuse:CHECKED THEN " -nosessionreuse":U ELSE "":U) +
        (IF toHostVerify:CHECKED   THEN " -nohostverify":U   ELSE "":U).
  END.

END PROCEDURE.

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

&ANALYZE-SUSPEND _VERSION-NUMBER AB_v10r12 GUI ADM2
&ANALYZE-RESUME
/* Connected Databases 
*/
&Scoped-define WINDOW-NAME CURRENT-WINDOW

/* Temp-Table and Buffer definitions                                    */
DEFINE TEMP-TABLE RowObject
       {"protools/dappsrv.i"}.


&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _DEFINITIONS vTableWin 
/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/
/*------------------------------------------------------------------------

  File:               protools/vjmssrv.w

  Description:        JMS Partition Viewer. 
                      This Viewer provides editing facilities for the
                      JMS partition type data in appserv-tt.

  Input Parameters:
      <none>

  Output Parameters:
      <none>

  Created:            May 9, 2000 - Bruce Gruenbaum

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

/* Parameters Definitions ---                                           */

/* Local Variable Definitions ---                                       */

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


&ANALYZE-SUSPEND _UIB-PREPROCESSOR-BLOCK 

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

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

&Scoped-define ADM-CONTAINER FRAME

&Scoped-define ADM-SUPPORTED-LINKS Data-Target,Update-Source,TableIO-Target,GroupAssign-Source,GroupAssign-Target

/* Include file with RowObject temp-table definition */
&Scoped-define DATA-FIELD-DEFS "protools/dappsrv.i"

/* Name of first Frame and/or Browse and/or first Query                 */
&Scoped-define FRAME-NAME F-Main

/* Standard List Definitions                                            */
&Scoped-Define ENABLED-FIELDS RowObject.Partition RowObject.Host ~
RowObject.Parameters RowObject.Service RowObject.App-Service ~
RowObject.ServerURL RowObject.Info 
&Scoped-define ENABLED-TABLES RowObject
&Scoped-define FIRST-ENABLED-TABLE RowObject
&Scoped-Define ENABLED-OBJECTS RECT-3 
&Scoped-Define DISPLAYED-FIELDS RowObject.Partition RowObject.Host ~
RowObject.Parameters RowObject.Service RowObject.App-Service ~
RowObject.ServerURL RowObject.Info 
&Scoped-define DISPLAYED-TABLES RowObject
&Scoped-define FIRST-DISPLAYED-TABLE RowObject
&Scoped-Define DISPLAYED-OBJECTS toSSL toSessionReuse toHostVerify 

/* Custom List Definitions                                              */
/* ADM-ASSIGN-FIELDS,List-2,List-3,List-4,List-5,List-6                 */

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



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


/* Definitions of the field level widgets                               */
DEFINE RECTANGLE RECT-3
     EDGE-PIXELS 2 GRAPHIC-EDGE  NO-FILL 
     SIZE 73 BY 9.76.

DEFINE VARIABLE toHostVerify AS LOGICAL INITIAL no 
     LABEL "Host verification disabled" 
     VIEW-AS TOGGLE-BOX
     SIZE 30 BY .81 TOOLTIP "Host verification disabled (-nohostverify)" NO-UNDO.

DEFINE VARIABLE toSessionReuse AS LOGICAL INITIAL no 
     LABEL "Session reuse disabled" 
     VIEW-AS TOGGLE-BOX
     SIZE 30 BY .81 TOOLTIP "Session reuse disabled (-nosessionreuse)" NO-UNDO.

DEFINE VARIABLE toSSL AS LOGICAL INITIAL no 
     LABEL "SSL enabled" 
     VIEW-AS TOGGLE-BOX
     SIZE 30 BY .81 TOOLTIP "SSL enabled (-ssl)" NO-UNDO.


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

DEFINE FRAME F-Main
     RowObject.Partition AT ROW 1.24 COL 21 COLON-ALIGNED
          VIEW-AS FILL-IN 
          SIZE 27 BY 1
     RowObject.Host AT ROW 2.43 COL 21 COLON-ALIGNED
          LABEL "Host (-H)"
          VIEW-AS FILL-IN 
          SIZE 17 BY 1
     RowObject.Parameters AT ROW 2.91 COL 44.6 NO-LABEL
          VIEW-AS FILL-IN 
          SIZE 27 BY 1
     RowObject.Service AT ROW 3.62 COL 21 COLON-ALIGNED
          LABEL "Service (-S)"
          VIEW-AS FILL-IN 
          SIZE 17 BY 1
     toSSL AT ROW 4.71 COL 23
     toSessionReuse AT ROW 5.48 COL 23
     toHostVerify AT ROW 6.24 COL 23
     RowObject.App-Service AT ROW 7.1 COL 3.6
          VIEW-AS FILL-IN 
          SIZE 38 BY 1
     RowObject.ServerURL AT ROW 8.29 COL 6.8
          LABEL "AppServer URL"
          VIEW-AS FILL-IN 
          SIZE 50 BY 1
     RowObject.Info AT ROW 9.48 COL 21 COLON-ALIGNED
          LABEL "Broker URL"
          VIEW-AS FILL-IN 
          SIZE 50 BY 1
     RECT-3 AT ROW 1 COL 1
    WITH 1 DOWN NO-BOX KEEP-TAB-ORDER OVERLAY USE-DICT-EXPS 
         SIDE-LABELS NO-UNDERLINE THREE-D NO-AUTO-VALIDATE 
         AT COL 1 ROW 1 SCROLLABLE .


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

&ANALYZE-SUSPEND _PROCEDURE-SETTINGS
/* Settings for THIS-PROCEDURE
   Type: SmartDataViewer
   Data Source: "protools/dappsrv.w"
   Allow: Basic,DB-Fields,Smart
   Container Links: Data-Target,Update-Source,TableIO-Target,GroupAssign-Source,GroupAssign-Target
   Frames: 1
   Add Fields to: Neither
   Other Settings: PERSISTENT-ONLY COMPILE
   Temp-Tables and Buffers:
      TABLE: RowObject D "?" ?  
      ADDITIONAL-FIELDS:
          {protools/dappsrv.i}
      END-FIELDS.
   END-TABLES.
 */

/* This procedure should always be RUN PERSISTENT.  Report the error,  */
/* then cleanup and return.                                            */
IF NOT THIS-PROCEDURE:PERSISTENT THEN DO:
  MESSAGE "{&FILE-NAME} should only be RUN PERSISTENT.":U
          VIEW-AS ALERT-BOX ERROR BUTTONS OK.
  RETURN.
END.

&ANALYZE-RESUME _END-PROCEDURE-SETTINGS

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

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

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _INCLUDED-LIB vTableWin 
/* ************************* Included-Libraries *********************** */

{src/adm2/viewer.i}

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




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

&ANALYZE-SUSPEND _RUN-TIME-ATTRIBUTES
/* SETTINGS FOR WINDOW vTableWin
  VISIBLE,,RUN-PERSISTENT                                               */
/* SETTINGS FOR FRAME F-Main
   NOT-VISIBLE Size-to-Fit                                              */
ASSIGN 
       FRAME F-Main:SCROLLABLE       = FALSE
       FRAME F-Main:HIDDEN           = TRUE.

/* SETTINGS FOR FILL-IN RowObject.App-Service IN FRAME F-Main
   ALIGN-L                                                              */
/* SETTINGS FOR FILL-IN RowObject.Host IN FRAME F-Main
   EXP-LABEL                                                            */
/* SETTINGS FOR FILL-IN RowObject.Info IN FRAME F-Main
   EXP-LABEL                                                            */
/* SETTINGS FOR FILL-IN RowObject.Parameters IN FRAME F-Main
   ALIGN-L                                                              */
ASSIGN 
       RowObject.Parameters:HIDDEN IN FRAME F-Main           = TRUE.

/* SETTINGS FOR FILL-IN RowObject.ServerURL IN FRAME F-Main
   ALIGN-L EXP-LABEL                                                    */
/* SETTINGS FOR FILL-IN RowObject.Service IN FRAME F-Main
   EXP-LABEL                                                            */
/* SETTINGS FOR TOGGLE-BOX toHostVerify IN FRAME F-Main
   NO-ENABLE                                                            */
/* SETTINGS FOR TOGGLE-BOX toSessionReuse IN FRAME F-Main
   NO-ENABLE                                                            */
/* SETTINGS FOR TOGGLE-BOX toSSL IN FRAME F-Main
   NO-ENABLE                                                            */
/* _RUN-TIME-ATTRIBUTES-END */
&ANALYZE-RESUME


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

&ANALYZE-SUSPEND _QUERY-BLOCK FRAME F-Main
/* Query rebuild information for FRAME F-Main
     _Options          = "NO-LOCK"
     _Query            is NOT OPENED
*/  /* FRAME F-Main */
&ANALYZE-RESUME

 



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

&Scoped-define SELF-NAME toHostVerify
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL toHostVerify vTableWin
ON VALUE-CHANGED OF toHostVerify IN FRAME F-Main /* Host verification disabled */
DO:
  {set DataModified TRUE}.
  RUN setParameters.
END.

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


&Scoped-define SELF-NAME toSessionReuse
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL toSessionReuse vTableWin
ON VALUE-CHANGED OF toSessionReuse IN FRAME F-Main /* Session reuse disabled */
DO:
  {set DataModified TRUE}.
  RUN setParameters.  
END.

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


&Scoped-define SELF-NAME toSSL
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL toSSL vTableWin
ON VALUE-CHANGED OF toSSL IN FRAME F-Main /* SSL enabled */
DO:
  {set DataModified TRUE}.
  RUN setParameters.
END.

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


&UNDEFINE SELF-NAME

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


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

  &IF DEFINED(UIB_IS_RUNNING) <> 0 &THEN          
    RUN initializeObject.
  &ENDIF         
  
  /************************ INTERNAL PROCEDURES ********************/

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


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

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE disableFields vTableWin 
PROCEDURE disableFields :
/*------------------------------------------------------------------------------
  Purpose:     Super Override
  Parameters:  
  Notes:       
------------------------------------------------------------------------------*/

  DEFINE INPUT PARAMETER pcFieldType AS CHARACTER NO-UNDO.

  RUN SUPER( INPUT pcFieldType).
  DO WITH FRAME {&FRAME-NAME}:
     ASSIGN toSSL:SENSITIVE          = FALSE
            toSessionReuse:SENSITIVE = FALSE
            toHostVerify:SENSITIVE   = FALSE.
  END.

END PROCEDURE.

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

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE disable_UI vTableWin  _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-Main.
  IF THIS-PROCEDURE:PERSISTENT THEN DELETE PROCEDURE THIS-PROCEDURE.
END PROCEDURE.

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

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE displayFields vTableWin 
PROCEDURE displayFields :
/*------------------------------------------------------------------------------
  Purpose:     Super Override
  Parameters:  
  Notes:       
------------------------------------------------------------------------------*/

  DEFINE INPUT PARAMETER pcColValues AS CHARACTER NO-UNDO.

  RUN SUPER( INPUT pcColValues).
  DO WITH FRAME {&FRAME-NAME}:
     toSSL:CHECKED          = INDEX(RowObject.Parameters:SCREEN-VALUE, "-ssl") > 0.
     toSessionReuse:CHECKED = INDEX(RowObject.Parameters:SCREEN-VALUE, "-nosessionreuse") > 0.
     toHostVerify:CHECKED   = INDEX(RowObject.Parameters:SCREEN-VALUE, "-nohostverify") > 0.
  END.

END PROCEDURE.

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

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE enableFields vTableWin 
PROCEDURE enableFields :
/*------------------------------------------------------------------------------
  Purpose:     Super Override
  Parameters:  
  Notes:       
------------------------------------------------------------------------------*/
  DEFINE VARIABLE hDataSource    AS HANDLE    NO-UNDO.
  DEFINE VARIABLE cQueryPosition AS CHARACTER NO-UNDO.

  RUN SUPER.

  {get DataSource hDataSource}.
  IF NOT VALID-HANDLE(hDataSource) THEN
     RETURN.

  IF DYNAMIC-FUNCTION('getQueryPosition':U IN hDataSource) <> "NoRecordAvailable":U 
     OR DYNAMIC-FUNCTION('getNewRecord':U) = "Add":U THEN
  DO WITH FRAME {&FRAME-NAME}:
     ASSIGN toSSL:SENSITIVE          = TRUE
            toSessionReuse:SENSITIVE = TRUE
            toHostVerify:SENSITIVE   = TRUE.
  END.
END PROCEDURE.

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

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE setParameters vTableWin 
PROCEDURE setParameters PRIVATE :
/*------------------------------------------------------------------------------
  Purpose:     
  Parameters:  <none>
  Notes:       
------------------------------------------------------------------------------*/
  
  DO WITH FRAME {&FRAME-NAME}:
     RowObject.Parameters:SCREEN-VALUE =
        (IF toSSL:CHECKED          THEN " -ssl":U            ELSE "":U) +
        (IF toSessionReuse:CHECKED THEN " -nosessionreuse":U ELSE "":U) +
        (IF toHostVerify:CHECKED   THEN " -nohostverify":U   ELSE "":U).
  END.

END PROCEDURE.

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

&ANALYZE-SUSPEND _VERSION-NUMBER AB_v10r12 GUI ADM2
&ANALYZE-RESUME
&Scoped-define WINDOW-NAME wWin
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _DEFINITIONS wWin 
/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/
/*------------------------------------------------------------------------

  File:               protools/waspartn.w

  Description:        Service Partition Maintenance Tool.
                      This is a container window for the objects required
                      to maintain the partitions in appserv-TT.

  Input Parameters:
      <none>

  Output Parameters:
      <none>

  Notes:

  Created:            May 9, 2000 - Bruce Gruenbaum
          
------------------------------------------------------------------------*/
/*          This .W file was created with the Progress AB.              */
/*----------------------------------------------------------------------*/

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

/* Parameters Definitions ---                                           */

/* Local Variable Definitions ---                                       */

DEFINE VARIABLE lTblChanged AS LOGICAL INITIAL NO NO-UNDO.

DEFINE VARIABLE lSave AS LOGICAL INITIAL YES    NO-UNDO.

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


&ANALYZE-SUSPEND _UIB-PREPROCESSOR-BLOCK 

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

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

&Scoped-define ADM-CONTAINER WINDOW

&Scoped-define ADM-SUPPORTED-LINKS Data-Target,Data-Source,Page-Target,Update-Source,Update-Target,Filter-target,Filter-Source

/* Name of first Frame and/or Browse and/or first Query                 */
&Scoped-define FRAME-NAME fMain

/* Standard List Definitions                                            */
&Scoped-Define ENABLED-OBJECTS RECT-5 btn_Close btn_Help 

/* 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 wWin AS WIDGET-HANDLE NO-UNDO.

/* Definitions of handles for SmartObjects                              */
DEFINE VARIABLE h_asbrowser AS HANDLE NO-UNDO.
DEFINE VARIABLE h_dappsrv AS HANDLE NO-UNDO.
DEFINE VARIABLE h_djmssrv AS HANDLE NO-UNDO.
DEFINE VARIABLE h_dyntoolbar AS HANDLE NO-UNDO.
DEFINE VARIABLE h_folder AS HANDLE NO-UNDO.
DEFINE VARIABLE h_jmsbrowser AS HANDLE NO-UNDO.
DEFINE VARIABLE h_vappsrv AS HANDLE NO-UNDO.
DEFINE VARIABLE h_vjmssrv AS HANDLE NO-UNDO.

/* Definitions of the field level widgets                               */
DEFINE BUTTON btn_Close DEFAULT 
     LABEL "&Close" 
     SIZE 15 BY 1.14.

DEFINE BUTTON btn_Help 
     LABEL "&Help" 
     SIZE 15 BY 1.14.

DEFINE RECTANGLE RECT-5
     EDGE-PIXELS 2 GRAPHIC-EDGE  NO-FILL 
     SIZE 81 BY 1.67.


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

DEFINE FRAME fMain
     btn_Close AT ROW 25.05 COL 2
     btn_Help AT ROW 25.05 COL 66
     RECT-5 AT ROW 24.81 COL 1
    WITH 1 DOWN NO-BOX KEEP-TAB-ORDER OVERLAY 
         SIDE-LABELS NO-UNDERLINE THREE-D 
         AT COL 1 ROW 1
         SIZE 81 BY 25.67
         DEFAULT-BUTTON btn_Close.


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

&ANALYZE-SUSPEND _PROCEDURE-SETTINGS
/* Settings for THIS-PROCEDURE
   Type: SmartWindow
   Allow: Basic,Browse,DB-Fields,Query,Smart,Window
   Container Links: Data-Target,Data-Source,Page-Target,Update-Source,Update-Target,Filter-target,Filter-Source
   Design Page: 1
   Other Settings: COMPILE
 */
&ANALYZE-RESUME _END-PROCEDURE-SETTINGS

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

&ANALYZE-SUSPEND _CREATE-WINDOW
IF SESSION:DISPLAY-TYPE = "GUI":U THEN
  CREATE WINDOW wWin ASSIGN
         HIDDEN             = YES
         TITLE              = "Service Parameter Maintenance"
         HEIGHT             = 25.67
         WIDTH              = 81
         MAX-HEIGHT         = 28.81
         MAX-WIDTH          = 146.2
         VIRTUAL-HEIGHT     = 28.81
         VIRTUAL-WIDTH      = 146.2
         RESIZE             = no
         SCROLL-BARS        = no
         STATUS-AREA        = no
         BGCOLOR            = ?
         FGCOLOR            = ?
         THREE-D            = yes
         MESSAGE-AREA       = no
         SENSITIVE          = yes.
ELSE {&WINDOW-NAME} = CURRENT-WINDOW.
/* END WINDOW DEFINITION                                                */
&ANALYZE-RESUME

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _INCLUDED-LIB wWin 
/* ************************* Included-Libraries *********************** */

{adecomm/appserv.i}
{src/adm2/containr.i}
{protools/ptlshlp.i}
{adecomm/_adetool.i}

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




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

&ANALYZE-SUSPEND _RUN-TIME-ATTRIBUTES
/* SETTINGS FOR WINDOW wWin
  VISIBLE,,RUN-PERSISTENT                                               */
/* SETTINGS FOR FRAME fMain
                                                                        */
IF SESSION:DISPLAY-TYPE = "GUI":U AND VALID-HANDLE(wWin)
THEN wWin:HIDDEN = yes.

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

 



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

&Scoped-define SELF-NAME wWin
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL wWin wWin
ON END-ERROR OF wWin /* Service Parameter Maintenance */
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 THIS-PROCEDURE:PERSISTENT THEN RETURN NO-APPLY.
END.

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


&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL wWin wWin
ON WINDOW-CLOSE OF wWin /* Service Parameter Maintenance */
DO:
  /* This ADM code must be left here in order for the SmartWindow
     and its descendents to terminate properly on exit. */
  APPLY "CLOSE":U TO THIS-PROCEDURE.
  RETURN NO-APPLY.
END.

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


&Scoped-define SELF-NAME btn_Close
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL btn_Close wWin
ON CHOOSE OF btn_Close IN FRAME fMain /* Close */
DO:
  lSave = YES.
  APPLY "CLOSE":U TO THIS-PROCEDURE.
END.

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


&Scoped-define SELF-NAME btn_Help
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL btn_Help wWin
ON CHOOSE OF btn_Help IN FRAME fMain /* Help */
DO:
  /* Call the help function. */
  RUN adecomm/_adehelp.p ("ptls":U,"CONTEXT":U, {&AppServer_Partition}, ?).
END.

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


&UNDEFINE SELF-NAME

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


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

/* Include custom  Main Block code for SmartWindows. */
{src/adm2/windowmn.i}

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


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

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE adm-create-objects wWin  _ADM-CREATE-OBJECTS
PROCEDURE adm-create-objects :
/*------------------------------------------------------------------------------
  Purpose:     Create handles for all SmartObjects used in this procedure.
               After SmartObjects are initialized, then SmartLinks are added.
  Parameters:  <none>
------------------------------------------------------------------------------*/
  DEFINE VARIABLE currentPage  AS INTEGER NO-UNDO.

  ASSIGN currentPage = getCurrentPage().

  CASE currentPage: 

    WHEN 0 THEN DO:
       RUN constructObject (
             INPUT  'adm2/dyntoolbar.w':U ,
             INPUT  FRAME fMain:HANDLE ,
             INPUT  'EdgePixels2DeactivateTargetOnHidenoDisabledActionsFlatButtonsyesMenuyesShowBorderyesToolbaryesActionGroupsTableio,NavigationTableIOTypeSaveSupportedLinksNavigation-Source,TableIo-SourceToolbarBandsToolbarAutoSizenoToolbarDrawDirectionhorizontalLogicalObjectNameAutoResizeDisabledActionsHiddenActionsUpdateHiddenToolbarBandsHiddenMenuBandsMenuMergeOrder0RemoveMenuOnHidenoCreateSubMenuOnConflictyesNavigationTargetNameHideOnInitnoDisableOnInitnoObjectLayout':U ,
             OUTPUT h_dyntoolbar ).
       RUN repositionObject IN h_dyntoolbar ( 1.00 , 1.00 ) NO-ERROR.
       RUN resizeObject IN h_dyntoolbar ( 1.33 , 81.00 ) NO-ERROR.

       RUN constructObject (
             INPUT  'adm2/folder.w':U ,
             INPUT  FRAME fMain:HANDLE ,
             INPUT  'FolderLabels':U + 'AppServers|JMS Servers' + 'FolderTabWidth0FolderFont-1HideOnInitnoDisableOnInitnoObjectLayout':U ,
             OUTPUT h_folder ).
       RUN repositionObject IN h_folder ( 2.67 , 1.00 ) NO-ERROR.
       RUN resizeObject IN h_folder ( 21.91 , 81.00 ) NO-ERROR.

       /* Links to SmartFolder h_folder. */
       RUN addLink ( h_folder , 'Page':U , THIS-PROCEDURE ).

       /* Adjust the tab order of the smart objects. */
       RUN adjustTabOrder ( h_dyntoolbar ,
             btn_Close:HANDLE IN FRAME fMain , 'BEFORE':U ).
       RUN adjustTabOrder ( h_folder ,
             h_dyntoolbar , 'AFTER':U ).
    END. /* Page 0 */
    WHEN 1 THEN DO:
       RUN constructObject (
             INPUT  'protools/dappsrv.wDB-AWARE':U ,
             INPUT  FRAME fMain:HANDLE ,
             INPUT  'AppServiceASUsePromptASInfoForeignFieldsRowsToBatch200CheckCurrentChangedyesRebuildOnReposnoServerOperatingModeNONEDestroyStatelessnoDisconnectAppServernoObjectNamedappsrvUpdateFromSourcenoToggleDataTargetsyesOpenOnInityesPromptOnDeleteyesPromptColumns(NONE)':U ,
             OUTPUT h_dappsrv ).
       RUN repositionObject IN h_dappsrv ( 4.10 , 4.00 ) NO-ERROR.
       /* Size in AB:  ( 1.86 , 10.80 ) */

       RUN constructObject (
             INPUT  'adm2/dynbrowser.w':U ,
             INPUT  FRAME fMain:HANDLE ,
             INPUT  'DisplayedFieldsPartitionEnabledFieldsScrollRemotenoNumDown0CalcWidthnoMaxWidth80FetchOnReposToEndyesSearchFieldDataSourceNamesUpdateTargetNamesLogicalObjectNameHideOnInitnoDisableOnInitnoObjectLayout':U ,
             OUTPUT h_asbrowser ).
       RUN repositionObject IN h_asbrowser ( 4.10 , 7.00 ) NO-ERROR.
       RUN resizeObject IN h_asbrowser ( 5.00 , 68.00 ) NO-ERROR.

       RUN constructObject (
             INPUT  'protools/vappsrv.w':U ,
             INPUT  FRAME fMain:HANDLE ,
             INPUT  'EnabledObjFldsToDisableModifyFields(All)DataSourceNamesUpdateTargetNamesLogicalObjectNameLogicalObjectNamePhysicalObjectNameDynamicObjectnoRunAttributeHideOnInitnoDisableOnInitnoObjectLayout':U ,
             OUTPUT h_vappsrv ).
       RUN repositionObject IN h_vappsrv ( 9.29 , 7.00 ) NO-ERROR.
       /* Size in AB:  ( 15.10 , 68.00 ) */

       /* Links to SmartDataObject h_dappsrv. */
       RUN addLink ( h_dyntoolbar , 'Navigation':U , h_dappsrv ).
       RUN addLink ( h_dappsrv , 'tableChanged':U , THIS-PROCEDURE ).

       /* Links to SmartDataBrowser h_asbrowser. */
       RUN addLink ( h_dappsrv , 'Data':U , h_asbrowser ).

       /* Links to SmartDataViewer h_vappsrv. */
       RUN addLink ( h_dappsrv , 'Data':U , h_vappsrv ).
       RUN addLink ( h_vappsrv , 'Update':U , h_dappsrv ).
       RUN addLink ( h_dyntoolbar , 'TableIo':U , h_vappsrv ).

       /* Adjust the tab order of the smart objects. */
       RUN adjustTabOrder ( h_dyntoolbar ,
             btn_Close:HANDLE IN FRAME fMain , 'BEFORE':U ).
       RUN adjustTabOrder ( h_folder ,
             h_dyntoolbar , 'AFTER':U ).
       RUN adjustTabOrder ( h_asbrowser ,
             h_folder , 'AFTER':U ).
       RUN adjustTabOrder ( h_vappsrv ,
             h_asbrowser , 'AFTER':U ).
    END. /* Page 1 */
    WHEN 2 THEN DO:
       RUN constructObject (
             INPUT  'protools/dappsrv.wDB-AWARE':U ,
             INPUT  FRAME fMain:HANDLE ,
             INPUT  'AppServiceASUsePromptASInfoForeignFieldsRowsToBatch200CheckCurrentChangedyesRebuildOnReposnoServerOperatingModeNONEDestroyStatelessnoDisconnectAppServernoObjectNamedappsrvUpdateFromSourcenoToggleDataTargetsyesOpenOnInityesPromptOnDeleteyesPromptColumns(NONE)':U ,
             OUTPUT h_djmssrv ).
       RUN repositionObject IN h_djmssrv ( 4.57 , 8.00 ) NO-ERROR.
       /* Size in AB:  ( 1.86 , 10.80 ) */

       RUN constructObject (
             INPUT  'adm2/dynbrowser.w':U ,
             INPUT  FRAME fMain:HANDLE ,
             INPUT  'DisplayedFieldsPartitionEnabledFieldsScrollRemotenoNumDown0CalcWidthnoMaxWidth80FetchOnReposToEndyesSearchFieldDataSourceNamesUpdateTargetNamesLogicalObjectNameHideOnInitnoDisableOnInitnoObjectLayout':U ,
             OUTPUT h_jmsbrowser ).
       RUN repositionObject IN h_jmsbrowser ( 4.57 , 5.00 ) NO-ERROR.
       RUN resizeObject IN h_jmsbrowser ( 6.67 , 72.00 ) NO-ERROR.

       RUN constructObject (
             INPUT  'protools/vjmssrv.w':U ,
             INPUT  FRAME fMain:HANDLE ,
             INPUT  'EnabledObjFldsToDisableModifyFields(All)DataSourceNamesUpdateTargetNamesLogicalObjectNameLogicalObjectNamePhysicalObjectNameDynamicObjectnoRunAttributeHideOnInitnoDisableOnInitnoObjectLayout':U ,
             OUTPUT h_vjmssrv ).
       RUN repositionObject IN h_vjmssrv ( 11.71 , 5.00 ) NO-ERROR.
       /* Size in AB:  ( 7.62 , 73.00 ) */

       /* Links to SmartDataObject h_djmssrv. */
       RUN addLink ( h_dyntoolbar , 'Navigation':U , h_djmssrv ).
       RUN addLink ( h_djmssrv , 'tableChanged':U , THIS-PROCEDURE ).

       /* Links to SmartDataBrowser h_jmsbrowser. */
       RUN addLink ( h_djmssrv , 'Data':U , h_jmsbrowser ).

       /* Links to SmartDataViewer h_vjmssrv. */
       RUN addLink ( h_djmssrv , 'Data':U , h_vjmssrv ).
       RUN addLink ( h_vjmssrv , 'Update':U , h_djmssrv ).
       RUN addLink ( h_dyntoolbar , 'TableIO':U , h_vjmssrv ).

       /* Adjust the tab order of the smart objects. */
       RUN adjustTabOrder ( h_dyntoolbar ,
             btn_Close:HANDLE IN FRAME fMain , 'BEFORE':U ).
       RUN adjustTabOrder ( h_folder ,
             h_dyntoolbar , 'AFTER':U ).
       RUN adjustTabOrder ( h_jmsbrowser ,
             h_folder , 'AFTER':U ).
       RUN adjustTabOrder ( h_vjmssrv ,
             h_jmsbrowser , 'AFTER':U ).
    END. /* Page 2 */

  END CASE.
  /* Select a Startup page. */
  IF currentPage eq 0
  THEN RUN selectPage IN THIS-PROCEDURE ( 1 ).

END PROCEDURE.

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

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE createObjects wWin 
PROCEDURE createObjects :
/*------------------------------------------------------------------------------
  Purpose:     Super Override - Sets up the SDOs for their partition type
  Parameters:  
  Notes:       
------------------------------------------------------------------------------*/

  RUN SUPER.
  
  /* For each of the SDOs, if they have been instantiated, set the PartitionType
     property so that the appropriate records are read for appserv-tt */
  IF VALID-HANDLE(h_dappsrv) THEN
    DYNAMIC-FUNCTION('setUserProperty':U IN h_dappsrv,
                     INPUT "PartitionType":U,
                     INPUT "A":U).  /* AppServer SDO - "A" */


  IF VALID-HANDLE(h_djmssrv) THEN
    DYNAMIC-FUNCTION('setUserProperty':U IN h_djmssrv,
                     INPUT "PartitionType":U,
                     INPUT "J":U). /* JMS SDO - "J" */


END PROCEDURE.

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

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE destroyObject wWin 
PROCEDURE destroyObject :
/*------------------------------------------------------------------------------
  Purpose:     Super Override
  Parameters:  
  Notes:       
------------------------------------------------------------------------------*/

  RUN SUPER.

  /* Save the changes to the temp tables away */
  IF lSave THEN
    RUN saveAppSrvTT.

END PROCEDURE.

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

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE disable_UI wWin  _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(wWin)
  THEN DELETE WIDGET wWin.
  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 wWin  _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 RECT-5 btn_Close btn_Help 
      WITH FRAME fMain IN WINDOW wWin.
  {&OPEN-BROWSERS-IN-QUERY-fMain}
  VIEW wWin.
END PROCEDURE.

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

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE exitObject wWin 
PROCEDURE exitObject :
/*------------------------------------------------------------------------------
  Purpose:     Super Override
  Parameters:  
  Notes:       
------------------------------------------------------------------------------*/

  APPLY "CLOSE":U TO THIS-PROCEDURE.

END PROCEDURE.

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

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE saveAppSrvtt wWin 
PROCEDURE saveAppSrvtt :
/*------------------------------------------------------------------------------
  Purpose:     Allows the user to save the changes from the appsrv-tt temp-table
               to the appsrvtt.d file.

  Parameters:  <none>
  Notes:       
------------------------------------------------------------------------------*/

  DEFINE VARIABLE lAns AS LOGICAL    NO-UNDO.

  /* If the lTblChanged variable has been set, the contents have been written
     to appsrvtt.d */
  IF lTblChanged THEN /* The contents of appsrv-tt have changed. */
    MESSAGE "The partition setup has been changed only for this session." SKIP
            "Do you want to save these partition setups permanently" SKIP
            "for future sessions?"
            VIEW-AS ALERT-BOX QUESTION BUTTONS YES-NO SET lAns.
  IF lAns THEN 
    RUN savePartitionInfo IN appSrvUtils.

END PROCEDURE.

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

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE tableChanged wWin 
PROCEDURE tableChanged :
/*------------------------------------------------------------------------------
  Purpose:     Sets the tableChanged flag. 
  Parameters:  <none>
  Notes:       
------------------------------------------------------------------------------*/
  lTblChanged = YES.
END PROCEDURE.

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

&ANALYZE-SUSPEND _VERSION-NUMBER UIB_v8r12 GUI
/* Procedure Description
"Object Attribute Reference"
*/
&ANALYZE-RESUME
&Scoped-define WINDOW-NAME C-Win
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _DEFINITIONS C-Win 
/*------------------------------------------------------------------------

  File: widattrs.w

  Description: Object Attribute Reference
               Intended to be run persistently from Pro*Tools, but
               can be run directly


  Input Parameters:
      <none>

  Output Parameters:
      <none>

  Author: Tim Townsend

  Created: 6/1/99

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

/* Parameters Definitions ---                                           */

/* Local Variable Definitions ---                                       */

{protools/ptlshlp.i}  /* help definitions        */

def var dLastWindowHeight as decimal no-undo.
def var dLastWindowWidth  as decimal no-undo.
def var hList as widget-handle extent 3 no-undo.
def var hProc as handle no-undo.
def var hWin as handle no-undo.

def temp-table ttJunk
  field Junk1 as int.
def query qJunk for ttJunk.
def browse bJunk query qJunk
  display ttJunk.Junk1
  enable ttJunk.Junk1
  with 4 down.
def frame fJunk bJunk.

def stream sOut.

/* _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 fMain

/* Standard List Definitions                                            */
&Scoped-Define ENABLED-OBJECTS cWidget vbWidHelp slRO slEvents slRW ~
vRWLabel vROLabel vEventLabel 
&Scoped-Define DISPLAYED-OBJECTS cWidget slRO slEvents slRW vRWLabel ~
vROLabel vEventLabel 

/* 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 C-Win AS WIDGET-HANDLE NO-UNDO.

/* Definitions of the field level widgets                               */
DEFINE BUTTON vbWidHelp 
     LABEL "Help" 
     SIZE 15 BY 1.

DEFINE VARIABLE cWidget AS CHARACTER FORMAT "X(40)":U 
     LABEL "Object" 
     VIEW-AS COMBO-BOX SORT INNER-LINES 18
     LIST-ITEMS "Frame","Fill-in","Toggle-box","Combo-box","Radio-set","Slider","Editor","Text","Literal","Selection-list","Button","Image","Rectangle","Control-frame","Window","Field-group","Browse","Browse Column","Error-status","Compiler","File-info","Rcode-info","Session","Color-table","Procedure","Clipboard","Debugger","Last-event","Menu","Sub-menu","Menu-item (normal)","Menu-item (toggle)","Dialog-box","Server","Font-table","Dataset ","Data-source","Soap-fault ","Soap-fault-detail","Soap-header","Sax-reader","Soap-header-entryref","Call" 
     DROP-DOWN-LIST
     SIZE 24 BY 1 NO-UNDO.

DEFINE VARIABLE vEventLabel AS CHARACTER FORMAT "X(256)":U INITIAL "Events" 
      VIEW-AS TEXT 
     SIZE 32 BY .62 NO-UNDO.

DEFINE VARIABLE vROLabel AS CHARACTER FORMAT "X(256)":U INITIAL "Read-only and Methods" 
      VIEW-AS TEXT 
     SIZE 32 BY .62 NO-UNDO.

DEFINE VARIABLE vRWLabel AS CHARACTER FORMAT "X(256)":U INITIAL "Read/Write" 
      VIEW-AS TEXT 
     SIZE 32 BY .62 NO-UNDO.

DEFINE VARIABLE slEvents AS CHARACTER 
     VIEW-AS SELECTION-LIST SINGLE SORT SCROLLBAR-VERTICAL 
     SIZE 34 BY 16.19 NO-UNDO.

DEFINE VARIABLE slRO AS CHARACTER 
     VIEW-AS SELECTION-LIST SINGLE SORT SCROLLBAR-VERTICAL 
     SIZE 34 BY 16.19 NO-UNDO.

DEFINE VARIABLE slRW AS CHARACTER 
     VIEW-AS SELECTION-LIST SINGLE SORT SCROLLBAR-VERTICAL 
     SIZE 34 BY 16.19 NO-UNDO.


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

DEFINE FRAME fMain
     cWidget AT ROW 1.48 COL 18 COLON-ALIGNED
     vbWidHelp AT ROW 1.48 COL 45
     slRO AT ROW 3.81 COL 38 NO-LABEL
     slEvents AT ROW 3.81 COL 74 NO-LABEL
     slRW AT ROW 3.86 COL 2 NO-LABEL
     vRWLabel AT ROW 3.14 COL 2 NO-LABEL
     vROLabel AT ROW 3.14 COL 38 NO-LABEL
     vEventLabel AT ROW 3.14 COL 74 NO-LABEL
     "(or double-click in any list)" VIEW-AS TEXT
          SIZE 33 BY .62 AT ROW 1.71 COL 61
    WITH 1 DOWN NO-BOX KEEP-TAB-ORDER OVERLAY 
         SIDE-LABELS NO-UNDERLINE THREE-D 
         AT COL 1 ROW 1
         SIZE 108 BY 19.57.


/* *********************** 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 C-Win ASSIGN
         HIDDEN             = YES
         TITLE              = "Object Attribute Reference"
         HEIGHT             = 19.57
         WIDTH              = 108
         MAX-HEIGHT         = 19.57
         MAX-WIDTH          = 108
         VIRTUAL-HEIGHT     = 19.57
         VIRTUAL-WIDTH      = 108
         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.
/* 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 fMain
   FRAME-NAME                                                           */
/* SETTINGS FOR FILL-IN vEventLabel IN FRAME fMain
   ALIGN-L                                                              */
/* SETTINGS FOR FILL-IN vROLabel IN FRAME fMain
   ALIGN-L                                                              */
/* SETTINGS FOR FILL-IN vRWLabel IN FRAME fMain
   ALIGN-L                                                              */
IF SESSION:DISPLAY-TYPE = "GUI":U AND VALID-HANDLE(C-Win)
THEN C-Win:HIDDEN = yes.

/* _RUN-TIME-ATTRIBUTES-END */
&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 /* Object Attribute Reference */
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 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 HELP OF C-Win /* Object Attribute Reference */
DO:
  RUN adecomm/_adehelp.p ( "ptls", "CONTEXT":U, {&Object_Attribute_Reference},?).  
END.

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


&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL C-Win C-Win
ON WINDOW-CLOSE OF C-Win /* Object Attribute Reference */
DO:
  /* This event will close the window and terminate the procedure.  */
  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-RESIZED OF C-Win /* Object Attribute Reference */
DO:
  def var lSuppressWarnings as logical no-undo.
  
  assign lSuppressWarnings         = session:suppress-warnings
         session:suppress-warnings = true

         /* vertical size */
         frame {&FRAME-NAME}:height-chars = 
         frame {&FRAME-NAME}:height-chars +
           (self:height-chars - dLastWindowHeight)
         dLastWindowHeight = self:height-chars
         slRW:height-chars = frame {&FRAME-NAME}:height-chars -
                             slRW:row + 0.5
         slRO:height-chars = frame {&FRAME-NAME}:height-chars -
                             slRO:row + 0.5
         slEvents:height-chars = frame {&FRAME-NAME}:height-chars -
                             slEvents:row + 0.5
                             
         /* horizontal size */
         frame {&FRAME-NAME}:width-chars = 
         frame {&FRAME-NAME}:width-chars +
           (self:width-chars - dLastWindowWidth)
         dLastWindowWidth     = self:width-chars
         slRW:width-chars     = (frame {&FRAME-NAME}:width-chars - 6) / 3
         slRO:column          = slRW:column + slRW:width-chars + 2
         slRO:width-chars     = slRW:width-chars
         slEvents:column      = slRO:column + slRO:width-chars + 2
         slEvents:width-chars = slRW:width-chars

         /* labels */
         vRWLabel:column         = slRW:column
         vROLabel:column         = slRO:column
         vEventLabel:column      = slEvents:column
         vRWLabel:width-chars    = slRW:width-chars
         vROLabel:width-chars    = slRO:width-chars
         vEventLabel:width-chars = slEvents:width-chars

         /* finish */
         frame {&FRAME-NAME}:scrollable = false
         self:scroll-bars               = false
         session:suppress-warnings      = lSuppressWarnings.
         
END.

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


&Scoped-define SELF-NAME fMain
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL fMain C-Win
ON MOUSE-MENU-DBLCLICK OF FRAME fMain
DO:
  run DumpAllData.
END.

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


&Scoped-define SELF-NAME cWidget
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL cWidget C-Win
ON VALUE-CHANGED OF cWidget IN FRAME fMain /* Object */
DO:
  run ShowLists(self:screen-value).
END.

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


&Scoped-define SELF-NAME slEvents
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL slEvents C-Win
ON DEFAULT-ACTION OF slEvents IN FRAME fMain
DO:
  RUN adecomm/_adehelp.p
      (INPUT "lgrf":U, 
       INPUT "PARTIAL-KEY":U, 
       INPUT ?, 
       INPUT self:screen-value).
 
END.

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


&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL slEvents C-Win
ON MOUSE-MENU-DBLCLICK OF slEvents IN FRAME fMain
DO:
  if self:screen-value > "" then
    message replace(list-widgets(self:screen-value),",","~r~n")
      view-as alert-box info button ok 
              title substitute("List of Widgets For &1 Event",self:screen-value).
END.

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


&Scoped-define SELF-NAME slRO
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL slRO C-Win
ON DEFAULT-ACTION OF slRO IN FRAME fMain
DO:
  RUN adecomm/_adehelp.p
      (INPUT "lgrf":U, 
       INPUT "PARTIAL-KEY":U, 
       INPUT ?, 
       INPUT self:screen-value).
END.

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


&Scoped-define SELF-NAME slRW
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL slRW C-Win
ON DEFAULT-ACTION OF slRW IN FRAME fMain
DO:
  RUN adecomm/_adehelp.p
      (INPUT "lgrf":U, 
       INPUT "PARTIAL-KEY":U, 
       INPUT ?, 
       INPUT self:screen-value + " attribute").
END.

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


&Scoped-define SELF-NAME vbWidHelp
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL vbWidHelp C-Win
ON CHOOSE OF vbWidHelp IN FRAME fMain /* Help */
DO:
  DEFINE VARIABLE cSearchKey AS CHARACTER  NO-UNDO.
  DEFINE VARIABLE cWid       AS CHARACTER  NO-UNDO.

  ASSIGN
    cWid = trim(entry(1,cWidget:screen-value," "))
    cSearchKey = cWid + " " +
                (if can-do("clipboard,color-table,compiler,debugger,error-status,file-info,last-event,rcode-info,session,profiler",cWid)
                 then "system handle" else
                (if can-do("buffer,buffer-field,socket,transaction,x-document,x-noderef",cWid)
                 then "object handle" else
                (if can-do("procedure,server,web-context,temp-table,query,async-request",cWid)
                 then ""
                 else "widget"))).

  RUN adecomm/_adehelp.p
    (INPUT "lgrf":U, 
     INPUT "PARTIAL-KEY":U, 
     INPUT ?, 
     INPUT cSearchKey).
  
END.

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


&Scoped-define SELF-NAME vEventLabel
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL vEventLabel C-Win
ON MOUSE-SELECT-DBLCLICK OF vEventLabel IN FRAME fMain
DO:
  assign clipboard:value = replace(lc(slEvents:list-items),",","~r~n").  
END.

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


&Scoped-define SELF-NAME vROLabel
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL vROLabel C-Win
ON MOUSE-SELECT-DBLCLICK OF vROLabel IN FRAME fMain
DO:
  assign clipboard:value = replace(lc(slRO:list-items),",","~r~n").  
END.

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


&Scoped-define SELF-NAME vRWLabel
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL vRWLabel C-Win
ON MOUSE-SELECT-DBLCLICK OF vRWLabel IN FRAME fMain
DO:
  assign clipboard:value = replace(lc(slRW:list-items),",","~r~n").
END.

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


&UNDEFINE SELF-NAME

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _MAIN-BLOCK C-Win 


/* ***************************  Main Block  *************************** */
/* see if already running */
if this-procedure:persistent then do:
  hProc = session:first-procedure.
  do while valid-handle(hProc):
    if hProc:file-name = this-procedure:file-name and
       valid-handle(hProc:current-window) then do:
      hWin = hProc:current-window.
      if hWin:window-state = window-minimized then
        hWin:window-state = window-normal.
      hWin:move-to-top().
      apply "entry" to hWin.
      delete procedure this-procedure.
      return.
    end.
    hProc = hProc:next-sibling.
  end.
end.

/* Set CURRENT-WINDOW: this will parent dialog-boxes and frames.        */
ASSIGN CURRENT-WINDOW                = {&WINDOW-NAME} 
       THIS-PROCEDURE:CURRENT-WINDOW = {&WINDOW-NAME}
       {&WINDOW-NAME}:max-width-chars = ?
       {&WINDOW-NAME}:min-width-chars = 95
       {&WINDOW-NAME}:max-height-chars = ?
       {&WINDOW-NAME}:min-height-chars = 8
       {&WINDOW-NAME}:title = {&WINDOW-NAME}:title + " - " + proversion
       dLastWindowHeight = {&WINDOW-NAME}:height-chars
       dLastWindowWidth  = {&WINDOW-NAME}:width-chars
       hList[1] = slRW:handle
       hList[2] = slRO:handle
       hList[3] = slEvents:handle.
  cWidget:add-last("Buffer"       + cWidget:delimiter +
                   "Buffer-field" + cWidget:delimiter +
                   "Profiler"     + cWidget:delimiter +
                   "Query"        + cWidget:delimiter +
                   "Web-context").
  
  cWidget:add-last("Async-request"   + cWidget:delimiter +
                   "Server-Socket"   + cWidget:delimiter +
                   "Socket"          + cWidget:delimiter +
                   "Temp-table"      + cWidget:delimiter +
                   "Transaction"     + cWidget:delimiter +
                   "X-Document"      + cWidget:delimiter +
                   "X-Noderef").

/* The CLOSE event can be used from inside or outside the procedure to  */
/* terminate it.                                                        */
on close of this-procedure
do:
   put-key-value
     section "WidAttr"
     key     "ObjRef-Object"
     value   cWidget:screen-value in frame {&FRAME-NAME}.
   run disable_UI.
end.

/* Best default for GUI applications is...                              */
PAUSE 0 BEFORE-HIDE.

do with frame {&FRAME-NAME}:
  get-key-value
     section "WidAttr"
     key     "ObjRef-Object"
     value   cWidget.

  assign cWidget:inner-lines = min(30,max(1,cWidget:num-items))
         cWidget = cWidget:entry(1)
           when cWidget = ? or cWidget:lookup(cWidget) = 0.
  slRO:load-mouse-pointer("glove") no-error.
  slRW:load-mouse-pointer("glove") no-error.
  slEvents:load-mouse-pointer("glove") no-error.
end.

/* 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.
  apply "value-changed" to cWidget in frame {&FRAME-NAME}.
  apply "entry" to {&WINDOW-NAME}.
  IF NOT THIS-PROCEDURE:PERSISTENT THEN
    WAIT-FOR CLOSE OF THIS-PROCEDURE focus cWidget in frame {&FRAME-NAME}.
END.

if program-name(2) = ? then quit.

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


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

&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 DumpAllData C-Win 
PROCEDURE DumpAllData :
/*------------------------------------------------------------------------------
  Purpose:     This procedure dumps all attributes and events for all
               widget types to a file.  This file can then be parsed and
               compared with the file generated for a different Progress
               version to obtain  a list of all attributes and events added
               in between those versions.
  Parameters:  <none>
  Notes:       
------------------------------------------------------------------------------*/
def var iWidNo as int no-undo.
def var iListNo as int no-undo.
def var iItemNo as int no-undo.

do with frame {&FRAME-NAME}:
  session:set-wait-state("general").
  
  output stream sOut to value("attrs" + replace(proversion,".","") + ".txt").
  
  do iWidNo = 1 to cWidget:num-items:
    run ShowLists(cWidget:entry(iWidno)).

    do iListNo = 1 to 3:
      do iItemNo = 1 to hList[iListNo]:num-items:
        put stream sOut unformatted
          cWidget:entry(iWidNo) "~t"
          substr(hList[iListNo]:name,3) "~t"
          hList[iListNo]:entry(iItemNo) skip.
      end.  /* 1..? */
    end.  /* 1..3 */
  end.  /* 1..? */

  output stream sOut close.  
  apply "value-changed" to cWidget.
  
  session:set-wait-state("").
end.  /* do with frame */

return.
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 cWidget slRO slEvents slRW vRWLabel vROLabel vEventLabel 
      WITH FRAME fMain IN WINDOW C-Win.
  ENABLE cWidget vbWidHelp slRO slEvents slRW vRWLabel vROLabel vEventLabel 
      WITH FRAME fMain IN WINDOW C-Win.
  {&OPEN-BROWSERS-IN-QUERY-fMain}
  VIEW C-Win.
END PROCEDURE.

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

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE JunkProc C-Win 
PROCEDURE JunkProc :
/*------------------------------------------------------------------------------
  Purpose:     Empty procedure for getting async-request handle
  Notes:
------------------------------------------------------------------------------*/
END PROCEDURE.

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

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE ShowLists C-Win 
PROCEDURE ShowLists :
/*------------------------------------------------------------------------------
  Purpose:     
  Parameters:  cWidType
  Notes:       
------------------------------------------------------------------------------*/
def input parameter cWidType as char.

def var hWid as handle no-undo.
def var i as int no-undo.
def var lDelIt as logical init no no-undo.

do with frame {&FRAME-NAME}:
  case cWidType:
    when "literal" then
      assign hWid = cWidget:side-label-handle.
    when "field-group" then
      assign hWid = frame {&FRAME-NAME}:current-iteration.
    when "clipboard" then
      assign hWid = clipboard:handle.
    when "color-table" then
      assign hWid = color-table:handle.
    when "compiler" then
      assign hWid = compiler:handle.
    when "debugger" then
      assign hWid = debugger:handle.
    when "error-status" then
      assign hWid = error-status:handle.
    when "file-info" then
      assign hWid = file-info:handle.
    when "font-table" then
      assign hWid = font-table:handle.
    when "last-event" then
      assign hWid = last-event:handle.
    when "rcode-info" then
      assign hWid = rcode-info:handle.
    when "session" then
      assign hWid = session:handle.
    when "procedure" then
      assign hWid = this-procedure.
    when "browse" then
      assign hWid = bJunk:handle in frame fJunk.
    when "browse column" then
      assign hWid = bJunk:handle in frame fJunk
             hWid = hWid:first-column.
    when "server" then
    do:
      create server hWid.
      assign lDelIt = true.
    end.
    when "menu-item (normal)" then
    do:
      create menu-item hWid.
      assign lDelIt = true.
    end.
    when "menu-item (toggle)" then
    do:
      create menu-item hWid
        assign toggle-box = true.
      assign lDelIt = true.
    end.
    when "buffer" or when "buffer-field" then do:
        hWid = buffer ttJunk:handle.
        if cWidType = "buffer-field" then
          hWid = hWid:buffer-field(1).
    end.
    when "profiler" then do:
        hWid = profiler:handle.
    end.
    when "web-context" then do:
        hWid = web-context:handle.
    end.
    when "transaction" then do:
        hWid = this-procedure:transaction.
    end.
    when "async-request" then do:
        run JunkProc on session asynchronous set hWid.
        lDelIt = true.
    end.
    
    otherwise
    do:
      create value(cWidType) hWid.
      assign lDelIt = true.
    end.
  end case.

  assign slRW:list-items     = list-set-attrs(hWid)
         slRO:list-items     = list-query-attrs(hWid) 
         slEvents:list-items = list-events(hWid).

  /* remove all R/W attrs from R/O list */
  slRO:delete(slRW:list-items) no-error.

  if lDelIt then
    delete object hWid no-error.

end.  /* do with frame */

return.
END PROCEDURE.

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

"Config info" "protools/_procfg.w" "adeicon/cnfginfo.bmp" yes yes 10 no
"DB List" "protools/_dblist.w" "adeicon/dblist" yes yes 20 no
"OS Prompt" "protools/_osprmt.p" "adeicon/osprompt" no yes 30 no
"Set Font 2" "protools/_edfont.p" "adeicon/setfont" no yes 40 no
"Editor" "protools/_pwedit.p" "adeicon/editor" no yes 50 no
"Procedures" "protools/_ppmgr.w" "adeicon/procedur" yes yes 60 no
"Propath" "protools/_propath.w" "adeicon/propath" no yes 70 no
"Run" "protools/_runfile.w" "adeicon/run" yes yes 80 no
"Session" "protools/_session.w" "adeicon/session" no yes 90 no
"Window Viewer" "protools/_winmgr.w" "adeicon/windview" no yes 100 no
"Windows Info" "protools/_wabout.p" "adeicon/wininfo" no yes 110 no
"Progress COM Object Viewer" "protools/_proobjv.p" "adeicon/proobjvw" no yes 120 no
"Service Parameter Maintenance" "protools/waspartn.w" "adeicon/appsrvr" yes yes 130 no
"AppServer Information" "protools/_asinfo.w" "adeicon/asinfo" no yes 140 no
"XML Schema Mapping" "adexml/_xmlview.w" "adexml/images/xmlmap" yes yes 150 no
/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/
/* PROGRAM NAME: _getTblFldIdx.p
 * AUTHOR      : Don Bulua
 * DATE        : 04/12/04
 * DESCRIPTION : Retrieves meta schema information for the specified table and
                 stores all info in temp tables: TableDetails, FieldDetails
                 IndexDetails and IndxFldDetails.
                 
 * Parameters  : pcDBType   Type of Database   'PROGRESS'  for Progress databases
 *               pcDBName   Name of Database for foreign databases only
                 pcTable    Name of Table
 *      Notes  : Assumes the alias for tinydict was set to the database name           
 * */
 
{protools/_schdef.i} /* TableDetails temp table definition */
 
DEFINE INPUT        PARAMETER pcDBType AS CHARACTER NO-UNDO.
DEFINE INPUT        PARAMETER pcDBName AS CHARACTER NO-UNDO.
DEFINE INPUT        PARAMETER pcTable  AS CHARACTER NO-UNDO.
DEFINE OUTPUT PARAMETER TABLE FOR TableDetails.
DEFINE OUTPUT PARAMETER TABLE FOR FieldDetails.
DEFINE OUTPUT PARAMETER TABLE FOR IndexDetails.
DEFINE OUTPUT PARAMETER TABLE FOR IndxFldDetails.

DEFINE VARIABLE rDB AS RECID NO-UNDO.

EMPTY TEMP-TABLE TableDetails.
EMPTY TEMP-TABLE FieldDetails.
EMPTY TEMP-TABLE IndexDetails.
EMPTY TEMP-TABLE IndxFldDetails.


IF pcDBType = "PROGRESS":U THEN
  FIND tinydict._db WHERE tinydict._db._db-name = ? AND 
       tinydict._db._db-type = "PROGRESS" NO-LOCK NO-ERROR. /*local */
ELSE
  FIND tinydict._db WHERE tinydict._db._db-name = pcDBName AND 
       tinydict._db._db-type = pcDBType NO-LOCK NO-ERROR. /* foreign */
rDB = RECID(tinydict._db).

FIND tinydict._File WHERE RECID(tinydict._db) = rDB 
                      AND tinydict._File._File-Name = pcTable NO-LOCK NO-ERROR.
IF AVAILABLE tinydict._File THEN 
DO:
  CREATE TableDetails.
  ASSIGN 
    TableDetails.name     = pcTable
    TableDetails.tdesc    = tinydict._File._Desc
    TableDetails.tlabel   = tinydict._File._File-Label
    TableDetails.valexp   = tinydict._File._Valexp
    TableDetails.valmsg   = tinydict._File._Valmsg
    TableDetails.replproc = tinydict._File._Fil-misc2[6].
  
  /* Schema triggers */
  FOR EACH tinydict._File-Trig WHERE tinydict._File-Trig._File-Recid = RECID(_File) NO-LOCK:
    CASE _File-Trig._Event:
      WHEN "CREATE":U THEN 
        ASSIGN TableDetails.crtrig     = tinydict._File-Trig._Proc-Name.
      WHEN "DELETE":U THEN 
        ASSIGN TableDetails.deltrig    = tinydict._File-Trig._Proc-Name.
      WHEN "FIND":U THEN 
        ASSIGN TableDetails.fndtrig    = tinydict._File-Trig._Proc-Name.
      WHEN "WRITE":U THEN 
        ASSIGN TableDetails.wrtrig     = tinydict._File-Trig._Proc-Name.
      WHEN "REPLICATION-CREATE":U THEN 
        ASSIGN TableDetails.repcrtrig  = tinydict._File-Trig._Proc-Name.
      WHEN "REPLICATION-DELETE":U THEN 
        ASSIGN TableDetails.repdeltrig = tinydict._File-Trig._Proc-Name.
      WHEN "REPLICATION-WRITE":U THEN 
        ASSIGN TableDetails.repwrtrig  = tinydict._File-Trig._Proc-Name.
    END CASE.  
  END.  /* for each trigger */
  
  /* Storage Area */
  IF tinydict._File._For-type <> ? THEN
    ASSIGN TableDetails.storarea = "n/a".
  ELSE IF INTEGER(DBVERSION(pcDBName)) >=  9  THEN
    RUN protools/_storarea.p (RECID(tinydict._File), OUTPUT TableDetails.storarea).
    
  /* Retrieve all fields for the specified table */
  FOR EACH tinydict._Field WHERE tinydict._Field._File-recid = RECID(tinydict._File) NO-LOCK:
     CREATE FieldDetails.
     ASSIGN
       FieldDetails.tblname       = pcTable
	   FieldDetails.fldname 	  = tinydict._Field._Field-name
	   FieldDetails.tdesc 	  	  = tinydict._Field._Desc
	   FieldDetails.datatype 	  = tinydict._Field._Data-type
	   FieldDetails.initval  	  = tinydict._Field._Initial
	   FieldDetails.tlabel 		  = tinydict._Field._Label
	   FieldDetails.tmandatory    = tinydict._Field._Mandatory
	   FieldDetails.tformat 	  = tinydict._Field._Format
	   FieldDetails.tdec 		  = tinydict._Field._Decimals
	   FieldDetails.torder 		  = tinydict._Field._Order
	   FieldDetails.textent 	  = tinydict._Field._Extent
	   FieldDetails.valexp 		  = tinydict._Field._Valexp
	   FieldDetails.valmsg 		  = tinydict._Field._Valmsg
	   FieldDetails.thelp 		  = tinydict._Field._Help
	   FieldDetails.collabel 	  = tinydict._Field._Col-label
	   FieldDetails.casesensitive = tinydict._Field._Fld-case
	   FieldDetails.viewas 		  = tinydict._Field._View-as.

   	/* Schema trigger */  
     FIND tinydict._Field-Trig 
          WHERE _Field-Trig._File-Recid  = RECID(_File) 
            AND _Field-Trig._Field-Recid = RECID(_Field) 
            AND _Field-Trig._Event       = "ASSIGN" NO-LOCK NO-ERROR.
     IF AVAILABLE tinydict._Field-Trig THEN
      	ASSIGN FieldDetails.asgntrig = tinydict._Field-Trig._Proc-Name.  
  END. /* End For each _field */
  
  /* Find Indexes */
  FOR EACH tinydict._Index WHERE tinydict._Index._File-recid = RECID(tinydict._File) NO-LOCK:
     CREATE IndexDetails.
  	 ASSIGN 
  	    IndexDetails.tblname    = pcTable
  	    IndexDetails.idxname    = tinydict._Index._Index-name
  	    IndexDetails.tdesc      = tinydict._Index._Desc
  	    IndexDetails.lactive    = tinydict._Index._Active
  	    IndexDetails.lunique    = tinydict._Index._Unique
  	    IndexDetails.lwordindex = IF tinydict._Index._Wordidx = 1 THEN TRUE ELSE FALSE.
  	      
  	 IF tinydict._File._Prime-Index = RECID(tinydict._Index) THEN IndexDetails.lprimary = yes.
  	    
  	 FIND LAST tinydict._Index-Field OF tinydict._Index NO-LOCK NO-ERROR.
  	 IF AVAILABLE tinydict._Index-Field THEN IndexDetails.labbrev = tinydict._Index-Field._Abbreviate.
  	    
  	 FOR EACH tinydict._Index-Field WHERE tinydict._Index-Field._Index-recid = RECID(tinydict._Index) NO-LOCK:
  	    CREATE IndxFldDetails.
  	    ASSIGN
  	       IndxFldDetails.tblname = IndexDetails.tblname
  	       IndxFldDetails.idxname = tinydict._Index._Index-name
  	       IndxFldDetails.idxseq  = tinydict._Index-Field._Index-seq
  	       IndxFldDetails.lasc    = tinydict._Index-Field._Ascending.
  	        
  	    FIND tinydict._Field WHERE RECID(tinydict._Field) = tinydict._Index-Field._Field-recid NO-LOCK NO-ERROR.
  	    IF AVAIL tinydict._Field THEN 
           ASSIGN IndxFldDetails.fldname = tinydict._Field._Field-name
  	              IndxFldDetails.fldtype = tinydict._Field._Data-Type.
     END. /* For each _index-field */		        
  END.  /* for each index field */
					
END.  /* if avail _file */

/* _gettbl.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: _prowcappdp.p

  Description: Start the Progress WebClient Deployment Packager executable.

  Input Parameters:
      <none>

  Output Parameters:
      <none>

  Author: Garry Hall

  Created: 13 April, 2004
           Copied from protools/_prowcapped.p

  Modified: 
     
 *---------------------------------------------------------------------------*/
IF SESSION:WINDOW-SYSTEM BEGINS "MS-WIN" THEN DO:
  FILE-INFO:FILE-NAME = "bin\prowcappmgr.exe":U.
  IF FILE-INFO:FULL-PATHNAME NE ? THEN DO:
    RUN WinExec (INPUT FILE-INFO:FULL-PATHNAME + " -deploy", INPUT 1). 
  END.
  ELSE MESSAGE "prowcappmgr.exe was not found."
         VIEW-AS ALERT-BOX ERROR.
END.
ELSE
  MESSAGE "This program runs only under Microsoft Windows."
    VIEW-AS ALERT-BOX ERROR.
    
PROCEDURE WinExec EXTERNAL "KERNEL32.DLL": 
    DEFINE INPUT PARAMETER prog_name AS CHARACTER. 
    DEFINE INPUT PARAMETER prog_style AS LONG. 
END.









/*************************************************************/
/* 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:  _widgetidassign.p

    Purpose:    Checks to see if the AppBuilder is running and if it is
                it launches adeuib/_widgetidassign.w.

    Parameters: None

    Notes  :
**************************************************************************/

DEFINE VARIABLE level          AS INTEGER NO-UNDO INITIAL 1. 
DEFINE VARIABLE ab_is_running  AS LOGICAL NO-UNDO INITIAL NO.

REPEAT WHILE PROGRAM-NAME(level) <> ?.
  IF PROGRAM-NAME(level) = "adeuib/_uibmain.p" THEN ab_is_running = TRUE.
  ASSIGN level = level + 1.
END.
IF NOT ab_is_running THEN DO:
  MESSAGE "The AppBuilder is not running. You must start the AppBuilder before running the Widget ID Assignment Utility." VIEW-AS ALERT-BOX ERROR.
  RETURN.
END.
ELSE
  RUN adeuib/_widgetidassign.w PERSISTENT.

RETURN.
/*************************************************************/
/* Copyright (c) 2007 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:  _runtimewidgetid.p

    Purpose:    Checks to see if the AppBuilder is running and if it is
                it launches adecomm/_assign-wid.w (Runtime Widget-ID
                Assignment Tool).

    Parameters: None

    Notes  :
**************************************************************************/

DEFINE VARIABLE level          AS INTEGER NO-UNDO INITIAL 1. 
DEFINE VARIABLE ab_is_running  AS LOGICAL NO-UNDO INITIAL NO.

REPEAT WHILE PROGRAM-NAME(level) <> ?.
  IF PROGRAM-NAME(level) = "adeuib/_uibmain.p" THEN ab_is_running = TRUE.
  ASSIGN level = level + 1.
END.
IF NOT ab_is_running THEN DO:
  MESSAGE "The AppBuilder is not running. You must start the AppBuilder before running the Runtime Widget ID Assignment Tool." VIEW-AS ALERT-BOX ERROR.
  RETURN.
END.
ELSE
  RUN adecomm/_assign-wid.w PERSISTENT.

RETURN.
/*************************************************************/
/* Copyright (c) 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. */
/*************************************************************/

/*
 * Program: protools/_proasmdep.p
 * 
 * Wrapper for protools/_proasmdep2.p, so we can call it from command line.
 * For use by the WebClient Application Assembler (WCAA), 
 * to determine any dependencies in Infragistics controls
 * that need to be included in a deployed WebClient application.
 * 
 * Intended usage:
 *   prowin32 -p protools/_proasmdep.p -b -param <infile> -icfparam <outfile>
 * where
 *  infile - file containing the paths of assemblies for which to find any dependencies.
 *          The file *MUST* contain one assembly path per line.
 *  outfile - the file in which to write the list of dependencies.
 *          This file will contain the assembly-qualified name of the each dependent assembly, one per line.
 *
 * No error messages are returned, as this is intended to be a batch program.
 * Diagnostic logging is written to the client log file, _proasmdep.log, in the same directory as cinfile.
 */
 
 
DEFINE VARIABLE cinfile AS CHARACTER   NO-UNDO.
DEFINE VARIABLE coutfile AS CHARACTER   NO-UNDO.
DEFINE VARIABLE clogfile AS CHARACTER   NO-UNDO.
DEFINE VARIABLE ipos AS INTEGER     NO-UNDO.

ASSIGN 
     cinfile = SESSION:PARAMETER
     coutfile = SESSION:ICFPARAMETER.
 .
  

/* create ourselves a client log file, so that we can write diagnostics to it. 
 * Put it in the same dir as cinfile, called "_proasmdep.log" 
 */
ipos = R-INDEX(cinfile,"\").
IF (ipos > 0) THEN
    ASSIGN
        clogfile = SUBSTRING(cinfile,1,ipos) + "_proasmdep.log".

/* does our log already exist? */
FILE-INFO:FILE-NAME = clogfile.
IF (FILE-INFO:FILE-TYPE = ? OR INDEX(FILE-INFO:FILE-TYPE,"W") > 0) THEN
DO:
    /* we have  a log file name we can write to */
    ASSIGN 
        LOG-MANAGER:LOGFILE-NAME = clogfile
        LOG-MANAGER:LOG-ENTRY-TYPES = "4GLTRACE:2".
END.

RUN protools/_proasmdep2.r(cinfile,coutfile).

/*************************************************************/
/* Copyright (c) 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. */
/*************************************************************/

/*
 * Program: protools/_proasmdep2.p
 * 
 * Lists assembly dependencies for a given list of assemblies.
 * For use by the WebClient Application Assembler (WCAA), 
 * to determine any dependencies in Infragistics controls
 * that need to be included in a deployed WebClient application.
 * 
 * Intended usage:
 *   RUN protools/_proasmdep2.r(infile,outfile).
 * where
 *  infile - file containing the paths of assemblies for which to find any dependencies.
 *          The file *MUST* contain one assembly path per line.
 *  outfile - the file in which to write the list of dependencies.
 *          This file will contain the assembly-qualified name of the each dependent assembly, one per line.
 * 
 * No error messages are returned, as this is intended to be a batch program. 
 * Diagnostic logging is written to the client log file, LOG-MANAGER:LOGFILE-NAME.
 * If there is an invalid path in <infile>, then this file will be skipped, and the rest of the paths loaded.
 * Dependencies are listed only once in the output file.
 */

&IF "{&OPSYS}" = "WIN32":U AND "{&WINDOW-SYSTEM}" NE "TTY":U &THEN

USING System.Reflection.*.
USING System.Collections.*.

DEFINE INPUT  PARAMETER cinfile AS CHARACTER   NO-UNDO.
DEFINE INPUT  PARAMETER coutfile AS CHARACTER   NO-UNDO.

/* Contains the list of assembly paths for which to find dependencies */
DEF TEMP-TABLE ttasmpath NO-UNDO
    FIELD casmpath AS CHARACTER FORMAT "x(60)"
    FIELD oasm AS Progress.Lang.Object 
    .

/* Contains the assembly names of dependencies */
DEF TEMP-TABLE ttasmref NO-UNDO
    FIELD casmname AS CHARACTER FORMAT "x(60)"
    INDEX ixasmname casmname.

LOG-MANAGER:WRITE-MESSAGE("Input file " + cinfile).
LOG-MANAGER:WRITE-MESSAGE("Output file " + coutfile).

IF (cinfile = "" OR coutfile = "") THEN
DO:
    LOG-MANAGER:WRITE-MESSAGE("Input or output filename is empty. Aborting.").
    RETURN.
END.
/* verify the infile exists, and is a file */
FILE-INFO:FILE-NAME = cinfile.
IF FILE-INFO:FILE-TYPE = ? OR  index(FILE-INFO:FILE-TYPE,"F") = 0 THEN
DO:
    LOG-MANAGER:WRITE-MESSAGE("Input file does not exist or is not a file. Aborting.").
    RETURN.
END.

LOG-MANAGER:WRITE-MESSAGE("Before LoadFromFile").

/* Load the list of assemblies from the file */
RUN LoadFromFile(cinfile).

LOG-MANAGER:WRITE-MESSAGE("Before LoadList").

/* Load the assemblies into .NET */
RUN LoadList.

LOG-MANAGER:WRITE-MESSAGE("Before WriteToFile").

/* Write the dependencies of the loaded assemblies to the output file */
RUN WriteToFile(coutfile).

LOG-MANAGER:WRITE-MESSAGE("Completed.").
QUIT.

/*
 * Procedure LoadList
 * 
 * Loads the list of assemblies into .NET, by using System.Reflection.
 * If there is an invalid path, skip it, rather than terminate the load.
 * Also loads the names of the dependencies into ttasmref.
 */
PROCEDURE LoadList:

    DEFINE VARIABLE oAssembly AS System.Reflection.Assembly NO-UNDO.
    FOR EACH ttasmpath:
        LOG-MANAGER:WRITE-MESSAGE("About to load " + ttasmpath.casmpath).
        oAssembly = System.Reflection.Assembly:LoadFrom(ttasmpath.casmpath) NO-ERROR.
        /* skip an invalid path that fails to load */
        IF ERROR-STATUS:ERROR THEN 
        do:
            DEFINE VARIABLE i AS INTEGER     NO-UNDO.
            LOG-MANAGER:WRITE-MESSAGE("Failed to load " + ttasmpath.casmpath).
              DO i = 1 TO ERROR-STATUS:NUM-MESSAGES:
                  LOG-MANAGER:WRITE-MESSAGE(" " + 
                                            STRING(ERROR-STATUS:GET-NUMBER(i)) + " " + 
                                            ERROR-STATUS:GET-MESSAGE(i)).
              END.
            NEXT.
        END.
        LOG-MANAGER:WRITE-MESSAGE("Loaded " + ttasmpath.casmpath).
        ttasmpath.oasm = oAssembly.
        RUN GetAssemblyRefs(oAssembly).
    END.
END.

/* 
 * Procedure GetAssemblyRefs
 * 
 * Loads the assembly names of dependencies into ttasmref.
 * Needs to be a separate procedure so that oRef can be indeterminant.
 */
PROCEDURE GetAssemblyRefs:
    DEF INPUT PARAMETER oAssembly AS Assembly NO-UNDO.

    DEFINE VARIABLE oRef AS System.Reflection.AssemblyName EXTENT NO-UNDO.
    DEFINE VARIABLE irefmax AS INTEGER     NO-UNDO.
    DEFINE VARIABLE iref AS INTEGER     NO-UNDO.
    DEFINE VARIABLE casmname AS CHARACTER   NO-UNDO.

    oRef = oAssembly:GetReferencedAssemblies().
    irefmax = EXTENT(oRef).
    LOG-MANAGER:WRITE-MESSAGE("Number of dependencies: " + STRING(irefmax)).
    DO iref = 1 TO irefmax:
        casmname = oRef[iref]:FullName.
        LOG-MANAGER:WRITE-MESSAGE("  " + casmname).
        FIND FIRST ttasmref NO-LOCK WHERE
            ttasmref.casmname = casmname NO-ERROR.
        IF NOT AVAILABLE ttasmref THEN
        DO:
            CREATE ttasmref.
            ASSIGN
                ttasmref.casmname = casmname.
        END.
    END.

END.

/*
 * Procedure LoadFromFile
 *
 * Loads the assembly paths from the given file into ttasmname.
 */
PROCEDURE LoadFromFile:
    DEFINE INPUT  PARAMETER cinfile AS CHARACTER   NO-UNDO.
    
    DEFINE VARIABLE casmpath AS CHARACTER   NO-UNDO.
    DEFINE VARIABLE cline AS CHARACTER   NO-UNDO.

    INPUT FROM VALUE(cinfile).
    REPEAT:
        IMPORT UNFORMATTED cline.
        LOG-MANAGER:WRITE-MESSAGE("Read :" + cline).
        CREATE ttasmpath.
        ASSIGN ttasmpath.casmpath = cline.
    END.
    INPUT CLOSE.
END.

/*
 * Writes the list of dependencies in ttasmref into the output file, one per line.
 */
PROCEDURE WriteToFile:
    DEFINE INPUT PARAMETER coutfile AS CHARACTER NO-UNDO.

    DEF VARIABLE oAssembly AS Assembly NO-UNDO.

    OUTPUT TO VALUE(coutfile).

    LOG-MANAGER:WRITE-MESSAGE("List of dependencies:").
    FOR EACH ttasmref:
        LOG-MANAGER:WRITE-MESSAGE(" " + ttasmref.casmname).
        PUT UNFORMATTED ttasmref.casmname SKIP.
    END.
    OUTPUT CLOSE.
END.

&ELSE
/* TTY processing */
DEFINE INPUT  PARAMETER cinfile AS CHARACTER   NO-UNDO.
DEFINE INPUT  PARAMETER coutfile AS CHARACTER   NO-UNDO.

LOG-MANAGER:WRITE-MESSAGE("This program can be run only from prowin32.exe").

&ENDIF


ÿprotools/_asinfo.w*ÿJ[ŸöÚ[Ÿögÿprotools/_break.w ŸJ/ÿŸN[ŸöÚ[Ÿögÿprotools/_colorch.w¥é}ÿ:ë[ŸöÚ[Ÿögÿprotools/_convt89.p»$hÿN|[ŸöÚ[Ÿögÿprotools/_custmi2.wúŠräÿ9Ë[ŸöÚ[Ÿögÿprotools/_custmiz.w!O¬¯ÿe‰[ŸöÚ[Ÿögÿprotools/_db_gw.pµÚ8ÿ3[ŸöÚ[Ÿögþÿprotools/_dblist.w+4kÿÈß[ŸöÚ[Ÿögÿprotools/_edfont.pZ6áJÿ@[ŸöÚ[Ÿögÿprotools/_fldavbl.p–äŠÿª[ŸöÚ[Ÿögÿprotools/_flddetl.wOë4ÿ@[ŸöÚ[Ÿögÿprotools/_fldlist.p±ã+Gÿj[ŸöÚ[Ÿögÿprotools/_getfld.p1±ÿ_[ŸöÚ[Ÿögÿprotools/_getidx.päÊ=ÿ[[ŸöÚ[Ÿögþÿprotools/_gettbl.pS-Ikÿk[ŸöÚ[Ÿögÿprotools/_idxavbl.p&ðUÖÿ­[ŸöÚ[Ÿögÿprotools/_idxdetl.w£Á\ƒÿ3œ[ŸöÚ[Ÿögÿprotools/_idxlist.pœÿf[ŸöÚ[Ÿögÿprotools/_msgcnt.wwg–…ÿÂ[ŸöÚ[Ÿögÿprotools/_osprmt.pG³GÿÙ[ŸöÚ[Ÿögÿprotools/_ppmgr.wIâ¿ ÿÖ[ŸöÚ[Ÿögþÿprotools/_ppuscl.p‡SLöÿC[ŸöÚ[Ÿögÿprotools/_procfg.w7QR9ÿT[ŸöÚ[Ÿögÿprotools/_proobjv.pA¦Rÿ0[ŸöÚ[Ÿögÿprotools/_propath.wb«‚ÿeO[ŸöÚ[Ÿögÿprotools/_prospy.w£Ñÿ–¨[ŸöÚ[Ÿögÿprotools/_protgen.w+T§yÿdÝ[ŸöÚ[Ÿögÿprotools/_protool.iÓVÿ´[ŸöÚ[Ÿögþÿprotools/_protool.p%
ÿ‡[ŸöÚ[Ÿögÿprotools/_prowcapped.pw0‘ÿŽ[ŸöÚ[Ÿögÿprotools/_pwedit.p+¦6ÿ6[ŸöÚ[Ÿögÿprotools/_runfile.wp;Uÿ@:[ŸöÚ[Ÿögÿprotools/_runonce.i]…{ÿq[ŸöÚ[Ÿögÿprotools/_schdef.i?H‚ÿö[ŸöÚ[Ÿögÿprotools/_schlist.w³…Šöÿn[ŸöÚ[Ÿögþÿprotools/_scrprtd.w<Eùÿ%¤[ŸöÚ[Ÿögÿprotools/_search.w\:¶ÿ@ò[ŸöÚ[Ÿöhÿprotools/_session.w0Ù_¨ÿWŠ[ŸöÚ[Ÿöhÿprotools/_smoupg.p‡·2ÿ#[ŸöÚ[Ÿöhÿprotools/_storarea.p‚#¼Uÿy[ŸöÚ[Ÿöhÿprotools/_tblavbl.põáÄÎÿ…[ŸöÚ[Ÿöhÿprotools/_tbldetl.w,ÊSÿ@Ž[ŸöÚ[Ÿöhþÿprotools/_tbllist.p$c	
áÿÓ[ŸöÚ[Ÿöhÿprotools/_v89conv.wûÕ	´ÿšj[ŸöÚ[Ÿöhÿprotools/_v89conv.wrx(±	®ÿ
[ŸöÚ[Ÿöhÿprotools/_wabout.pßˆ	¸ÿK[ŸöÚ[Ÿöhÿprotools/_walker.w¨#	¾iÿkÔ[ŸöÚ[Ÿöhÿprotools/_winmgr.w¸-
*=ÿ27[ŸöÚ[Ÿöhÿprotools/addpart.wV¬
\tÿ9[ŸöÚ[Ÿöhþÿprotools/as-partn.wbÊ
•€ÿR[ŸöÚ[Ÿöhÿprotools/bappsrv.w@0
ç™ÿ[ŸöÚ[Ÿöhÿprotools/dappsrv.i1O
ç™ÿù[ŸöÚ[Ÿöhÿprotools/dappsrv.w¡³
é’ÿFÉ[ŸöÚ[Ÿöhÿprotools/dappsrv_cl.wx0[ÿ|[ŸöÚ[Ÿöhÿprotools/makeflds.w:È0×ÿ)g[ŸöÚ[Ÿöhÿprotools/protools.datzÍZ>ÿ:[ŸöÚ[Ÿöhþÿprotools/_psfiltwin.w#ÊbxÿR½[ŸöÚ[Ÿöhÿprotools/psvar.iµ5ÿ0[ŸöÚ[Ÿöhÿprotools/_psplus.wÎn½eÿ[a[ŸöÚ[Ÿöhÿprotools/ptlshlp.ix¹Æÿ€[ŸöÚ[Ÿöhÿprotools/_psplus.wrx'(Fÿ
[ŸöÚ[Ÿöhÿprotools/sort-dia.w<2Fÿ‡[ŸöÚ[Ÿöhÿprotools/_psvaldlg.w±^OÍÿõ[ŸöÚ[Ÿöhþÿprotools/v89names.dat­†lÂÿ­[ŸöÚ[Ÿöhÿprotools/vappsrv.wÖö|oÿ:ö[ŸöÚ[Ÿöhÿprotools/vjmssrv.w9·eÿ72[ŸöÚ[Ÿöhÿprotools/waspartn.w€bî—ÿO†[ŸöÚ[Ÿöhÿprotools/widattrs.w	ó>ÿ\c[ŸöÚ[Ÿöhÿprotools/wprotool.dat7š€ÿ[ŸöÚ[Ÿöhÿprotools/_getTblFldIdx.p’žŒÿª[ŸöÚ[Ÿöhþÿprotools/_prowcappdp.pÃŒ¹6ÿ›[ŸöÚ[Ÿöhÿprotools/_widgetidassign.p`:¾Ñÿ&[ŸöÚ[Ÿöhÿprotools/_runtimewidgetid.pøÃ÷ÿZ[ŸöÚ[Ÿöhÿprotools/_proasmdep.pXzÉQÿï[ŸöÚ[Ÿöhÿprotools/_proasmdep2.p[Ò@ÿO[ŸöÚ[ŸöhÿÈ:d'þ