#!/bin/sh
#
# This is a shell archive.  To extract its contents,
# execute this file with /bin/sh to create the file(s):
#
# README		    coxxq01c.per	coxxq01g.per	    coxxx03.4gl
# coxxq01.4gl	    coxxq01d.per	coxxq01h.per	    coxxx12.4gl
# coxxq01a.per	    coxxq01e.per	coxxq01i.per	    make_sample
# coxxq01b.per	    coxxq01f.per	coxxq01j.per	    sample.4gl
#
# This shell archive created: Mon Jul 25 09:51:52 EDT 1994
#
echo "Extracting file README"
sed -e 's/^X//' <<\SHAR_EOF > README
XHi Informix Programmer!
X
XTo execute this demo of query_window you need to run the shell "make_sample".
Xit will compile the 4GL modules and forms, and run the sample program
X(sample.4gl).
X
XPlease let me know what you think, and any problems you encounter.
X
XRegards,
XKerry Sainsbury
Xkerry@kcbbs.gen.nz
SHAR_EOF
if [ `wc -c < README` -ne      300 ]
then
    echo "Lengths do not match -- Bad Copy of README"
fi
echo "Extracting file coxxq01.4gl"
sed -e 's/^X//' <<\SHAR_EOF > coxxq01.4gl
X###############################################################################
X#                             CONDITIONS OF USE                               #
X#                                                                             #
X#                  Copyright Quanta Software Ltd 1994                         #
X#                            500 Queen Street                                 #
X#                            Auckland, New Zealand                            #
X#                            Ph. +64-9 377-4473                               #
X#                                                                             #
X# This software is offered as-is, no warranty etc etc. If you decide to use   #
X# this software I would appreciate it if you:                                 #
X#                                                                             #
X# 1. Told me who you are and where you work, either email to                  #
X#    kerry@kcbbs.gen.nz or (if bounced) to 30 Frangipani Ave, Manurewa,       #
X#    Auckland, New Zealand. I just want to know if this is being used!        #
X#    You could even phone me c/- +64-9 2666-011                               #
X#                                                                             #
X# 2. You leave all comments, from this "CONDITIONS OF USE" down to the        #
X#    "#END COMMENTS" marker, intact.                                          #
X#                                                                             #
X# 3. You don't try to sell it to anybody (but sure - use it in your           #
X#    applications!)                                                           #
X#                                                                             #
X# 4. Offer me a well-paid senior programmer type role. ;-)                    #
X#                                                                             #
X###############################################################################
X
X{******************************************************************************
X*    Filename     :   coxxq01.4gl                                             *
X*    System       :   Eunice 4GL - Common Module                              *
X*    Purpose      :   Quick and dirty QBE selection window                    *
X*    Returns      :   key value                                               *
X*    Author       :   Kerry Sainsbury                                         *
X*    Date Written :   12 August 1993                                          *
X*    Last Change  :                                                           *
X*                                                                             *
X* 21/10/93 Kerry S  - Major changes to the front end                          *
X*                   - Cleaning up Temp String Storage bug.                    *
X* 22/10/93 Kerry S  - Cope with cancelling from QBE window if keycnt > 1      *
X* 28/10/93 Kerry S  - Fields in "Query" QBE window now right-justified        *
X* 29/10/93 Kerry S  - AS flag was not working                                 *
X*                   - Null flag meant "Line" prompt did not display           *
X* 12/11/93 Kerry S  - Large headings causing routine to fall over             *
X* 12/11/93 Kerry S  - Stick "Nothing to list" message in a window             *
X* 16/11/93 Kerry S  - If > 5 keys would not open correct form                 *
X* 01/12/93 Kerry S  - Problems with numeric columns, and their headings       *
X* 07/12/93 Kerry S  - Catch user's attempts to use wildcards in numeric fields*
X* 07/12/93 Kerry S  - Cope with any error with QDsystem_error                 *
X* 13/12/93 Kerry S  - Cope with headings of up to 80 characters (but only     *
X*                     display first 30 characters)                            *
X* 26/04/94 Kerry S  - Found the -4518 (Temp String Space) bug. Informix bug!  *
X*                                                                             *
X*******************************************************************************}
X
X#!query_window(select_statement, headings, keycnt, flags)
X#!        - select_statement : display columns need {[k]size} parameter
X#!              eg: SELECT pmprodno{k15}, pmdesc{40}, smohdqty{8.2} etc
X#!                  would specify that pmprodno is 15 characters wide,
X#!                  pmdesc is 40 characters wide, and smohdqty is a numeric
X#!                  field 8 characters wide with 2 figures after the
X#!                  decimal points.
X#!                 - A "k" after the "{" indicates the field can be queryed
X#!                   under the "Query" menu option
X#!        - headings : headings for the SELECTed columns (eg:Code, Description)
X#!        - keycnt   : this number of columns which are keys
X#!                        (the first <keycnt> columns are returned to
X#!                         the calling function)
X#!        - flags. User selection options, delimited by colons.
X#!          "AS" - Automatically select if only one option to choose.
X#!          "NS" - No line selection available.
X#!          "FQ" - Force QBE before bringing up selection window
X#!          "NQ" - No "Query" option on ring menu
X#!
X#END COMMENTS
X#-------------
X 
XDATABASE eunice
XDEFINE   m_lpp           SMALLINT,  # Number of lines per page
X         m_bell          CHAR(1), # For ASCII(7)
X         ma_desclen      ARRAY[10] OF DECIMAL(3,1), # Length of display field
X         ma_number       ARRAY[10] OF SMALLINT,     # Is field a number ?
X         ma_key          ARRAY[10] OF SMALLINT,     # Is field a key for QBE?
X         ma_head         ARRAY[10] OF CHAR(30),     # Heading text
X         ma_desc         ARRAY[10] OF CHAR(80),     # Data from current row
X         ma_column       ARRAY[10] OF CHAR(20),     # Columns name
X         m_select        CHAR(400),                 # Hold SQL SELECT string 
X         m_change_text   CHAR(400),
X         m_eighty_spaces CHAR(80),
X         m_using         CHAR(20)   # For formatting numerics
X
XFUNCTION query_any(l_table, l_keycolumn, l_desccolumn, # Easy frontend
X                   l_keyname, l_heading,l_where, l_old)
XDEFINE   l_table        LIKE systables.tabname,
X         l_keycolumn    LIKE syscolumns.colname,
X         l_desccolumn   LIKE syscolumns.colname,
X         l_keyname      LIKE syscolumns.colname,
X         l_heading      LIKE syscolumns.colname,
X         l_where        CHAR(100),
X         l_old          CHAR(80),
X         l_flags        CHAR(20),
X         l_key          CHAR(80),
X         l_keylen       SMALLINT,
X         l_desclen      SMALLINT,
X         l_text         CHAR(200),
X         l_head         CHAR(80),
X         l_nrows        SMALLINT
X
X   WHENEVER ANY ERROR CALL QDsystem_error
X   IF l_where IS NULL THEN
X      LET l_where = "1=1"
X   END IF
X   LET l_keylen  = QDgetcollen(l_table, l_keycolumn) # Get size of columns
X   LET l_desclen = QDgetcollen(l_table, l_desccolumn)
X
X   LET l_text =  # Build a SELECT string
X "SELECT ",l_keycolumn CLIPPED,"{k",l_keylen,"}, ", # in a format suitable
X          l_desccolumn CLIPPED,"{",l_desclen,"}", # for query_window()
X  " FROM ",l_table CLIPPED,
X " WHERE ",l_where CLIPPED,
X" ORDER BY ",l_keycolumn CLIPPED
X
X   LET l_head = l_keyname CLIPPED,",",l_heading CLIPPED
X
X# Force QBE box if more than 50 rows in the table...
X
X   SELECT nrows
X     INTO l_nrows
X     FROM systables
X    WHERE tabname = l_table
X
X   IF l_nrows > 50 THEN              # If more than 50 rows in table
X      LET l_flags = "FQ"
X   ELSE
X      LET l_flags = ""
X   END IF
X
X   LET l_key = query_window(l_text, l_head, 1, l_flags) # Do it!
X
X   IF l_key IS NULL THEN
X      LET l_key = l_old
X   END IF
X   RETURN l_key
XEND FUNCTION
X
X
XFUNCTION query_window(l_select, l_heading, l_keycnt, l_flags)
XDEFINE   l_select        CHAR(400),
X         l_heading       CHAR(100),
X         l_keycnt        SMALLINT,
X         l_flags         CHAR(20),
X
X         l_desccolumn    CHAR(20),
X
X         l_text          CHAR(400),
X         l_fixwhere      CHAR(400),
X         l_desc          CHAR(80),
X         l_desclen       SMALLINT,
X         l_wcol          SMALLINT,
X         l_depth         SMALLINT,         
X         l_width         SMALLINT,
X         l_page          SMALLINT
X
X# Setup global variables...
X
X   WHENEVER ANY ERROR CALL QDsystem_error
X   LET m_select = l_select
X   LET m_lpp = 9       # There are 9 lines per page...
X   LET m_bell = ASCII(7)
X   LET m_using = "--------------------"
X   LET m_eighty_spaces =  # Do not replace with "80 SPACES"
X"                                                                                "
X
X    IF l_flags IS NULL THEN
X       LET l_flags = "|"
X    END IF
X
X# Extract options from l_desccolumn, and work out how wide the
X# description field will be...
X
X   LET l_desclen = QDget_desc_sizes()
X   LET l_select = m_select      # Store our cleaned up SQL string for later
X   LET l_heading = QDformat_heading(l_heading)
X
X# Force QBE box ?
X
X   IF l_flags MATCHES "*FQ*"          # If Force-Query flag turned on...
X   THEN
X      LET l_text = QDqbewindow()
X      IF check_del("Query cancelled") THEN
X         CASE
X         WHEN l_keycnt = 0
X            RETURN 
X         WHEN l_keycnt = 1
X            RETURN ""
X         WHEN l_keycnt = 2
X            RETURN "",""
X         WHEN l_keycnt = 3
X            RETURN "","",""
X         WHEN l_keycnt = 4
X            RETURN "","","",""
X         WHEN l_keycnt = 5
X            RETURN "","","","",""
X         WHEN l_keycnt = 6
X            RETURN "","","","","",""
X         WHEN l_keycnt = 7
X            RETURN "","","","","","",""
X         WHEN l_keycnt = 8
X            RETURN "","","","","","","",""
X         WHEN l_keycnt = 9
X            RETURN "","","","","","","","",""
X         WHEN l_keycnt = 10
X            RETURN "","","","","","","","","",""
X         END CASE
X      END IF
X   ELSE 
X      LET l_text = "1=1"
X   END IF
X
X   LET l_fixwhere = " WHERE ",l_text CLIPPED," AND "
X   LET m_change_text = l_select
X   CALL QDchange_text("WHERE", l_fixwhere)
X   LET m_select = m_change_text
X
X   IF m_change_text = l_select THEN      # Check for WHERE clause
X      LET m_select = 
X      "SYSTEM ERROR!<",
X      "SELECT string passed to query_window() did not contain a WHERE clause. ",
X      "Advise your support company of this error!"
X      CALL message_prompt(m_select, "")
X      CASE
X      WHEN l_keycnt = 0
X         RETURN 
X      WHEN l_keycnt = 1
X         RETURN ""
X      WHEN l_keycnt = 2
X         RETURN "",""
X      WHEN l_keycnt = 3
X         RETURN "","",""
X      WHEN l_keycnt = 4
X         RETURN "","","",""
X      WHEN l_keycnt = 5
X         RETURN "","","","",""
X      WHEN l_keycnt = 6
X         RETURN "","","","","",""
X      WHEN l_keycnt = 7
X         RETURN "","","","","","",""
X      WHEN l_keycnt = 8
X         RETURN "","","","","","","",""
X      WHEN l_keycnt = 9
X         RETURN "","","","","","","","",""
X      WHEN l_keycnt = 10
X         RETURN "","","","","","","","","",""
X      END CASE
X   END IF
X
X   CALL QDbuild_cursor()
X
X# If there's only one record, then don't bother with the selection window...
X   
X   IF l_flags MATCHES "*AS*" THEN    # If Auto-Select flag is on, then check
X      CALL QDchoice(1, 2,FALSE)      # if more than one record.
X      IF ma_desc[1] IS NULL THEN     # No? Then just select the first record
X         CALL QDchoice(1, 1,FALSE)
X      ELSE
X         CALL QDclear_desc()
X      END IF
X   ELSE
X      CALL QDclear_desc()
X   END IF
X
X   IF ma_desc[1] IS NULL THEN
X
X      IF l_desclen + 2 > 78 THEN     # Truncate long descriptive fields
X         LET l_desclen = 78 - 2
X      END IF
X
X      LET l_width = l_desclen + 2
X
X      IF l_width < 42 THEN    # This stops an "invalid opcode" error in
X         LET l_width = 42     # Informix 4.1 if the Menu list does not
X      END IF                  # all fit inside the window.
X
X      IF l_width > 76 THEN    # This keeps the window small enough to
X         LET l_width = 76     # fit on the screen!
X      END IF
X      LET l_depth = 6 + m_lpp
X
X# Open scrolly selection window...
X
X      LET l_wcol = (80 - l_width) / 2
X      OPEN WINDOW qdwin AT 6, l_wcol
X      WITH l_depth ROWS, l_width COLUMNS
X      ATTRIBUTE(BORDER, CYAN, MESSAGE LINE LAST)
X
X      LET l_wcol = 3
X      IF l_desclen THEN
X         DISPLAY l_heading AT 4, l_wcol ATTRIBUTE(DIM)
X      END IF
X
X      IF l_flags NOT MATCHES "*NS*" THEN
X         MESSAGE "Enter Line No." ATTRIBUTE (REVERSE)
X      END IF
X
X      IF QDshow_page(1, l_desclen) THEN
X         LET l_page = 1
X
X         MENU "SELECT"
X
X         BEFORE MENU
X            IF l_flags MATCHES "*NQ*" THEN    # If No Query flag is on
X               HIDE OPTION "Query"            # then turn off "Query" option
X            END IF
X            IF l_flags MATCHES "*NS*" THEN    # If No selection flag is on
X               HIDE OPTION "1"          # then turn off line selection!
X               HIDE OPTION "2"
X               HIDE OPTION "3"
X               HIDE OPTION "4"
X               HIDE OPTION "5"
X               HIDE OPTION "6"
X               HIDE OPTION "7"
X               HIDE OPTION "8"
X               HIDE OPTION "9"
X            END IF
X
X         COMMAND "Query" "Find a match based on partial information"
X            IF l_flags NOT MATCHES "*NS*" THEN
X               MESSAGE "Enter Line No." ATTRIBUTE (REVERSE)
X            END IF
X            LET l_text = QDqbewindow()
X            IF NOT check_del("Query cancelled") THEN
X               LET l_fixwhere = " WHERE ",l_text CLIPPED," AND "
X               LET m_change_text = l_select
X               CALL QDchange_text("WHERE", l_fixwhere)
X               LET m_select = m_change_text
X               CALL QDbuild_cursor()
X               LET l_page = 1
X               IF NOT QDshow_page(l_page, l_desclen) THEN
X                  CALL QDblank_window(1)
X                  CALL message_prompt("No details to display","")
X               END IF
X               MESSAGE "Enter Line No." ATTRIBUTE (REVERSE)
X            END IF
X
X         COMMAND "Next" "Display next page"
X            IF l_flags NOT MATCHES "*NS*" THEN
X               MESSAGE "Enter Line No." ATTRIBUTE (REVERSE)
X            END IF
X            CALL QDnext_page(l_page, l_desclen) 
X            RETURNING l_page
X
X         COMMAND "Previous" "Display previous page"
X            IF l_flags NOT MATCHES "*NS*" THEN
X               MESSAGE "Enter Line No." ATTRIBUTE (REVERSE)
X            END IF
X            CALL QDprev_page(l_page, l_desclen) 
X            RETURNING l_page
X
X         COMMAND "Exit" "Exit selection window"
X            CALL QDclear_desc()
X            EXIT MENU
X
X         COMMAND KEY (F3)     # Next Page
X            IF l_flags NOT MATCHES "*NS*" THEN
X               MESSAGE "Enter Line No." ATTRIBUTE (REVERSE)
X            END IF
X            CALL QDnext_page(l_page, l_desclen) 
X            RETURNING l_page
X
X         COMMAND KEY (F4)     # Prev Page
X            IF l_flags NOT MATCHES "*NS*" THEN
X               MESSAGE "Enter Line No." ATTRIBUTE (REVERSE)
X            END IF
X            CALL QDprev_page(l_page, l_desclen) 
X            RETURNING l_page
X
X         COMMAND KEY ("1")
X            CALL QDchoice(l_page, 1, TRUE)
X            IF ma_desc[1] IS NOT NULL THEN EXIT MENU END IF
X
X         COMMAND KEY ("2")
X            CALL QDchoice(l_page, 2, TRUE)
X            IF ma_desc[1] IS NOT NULL THEN EXIT MENU END IF
X
X         COMMAND KEY ("3")
X            CALL QDchoice(l_page, 3, TRUE)
X            IF ma_desc[1] IS NOT NULL THEN EXIT MENU END IF
X
X         COMMAND KEY ("4")
X            CALL QDchoice(l_page, 4, TRUE)
X            IF ma_desc[1] IS NOT NULL THEN EXIT MENU END IF
X
X         COMMAND KEY ("5")
X            CALL QDchoice(l_page, 5, TRUE)
X            IF ma_desc[1] IS NOT NULL THEN EXIT MENU END IF
X
X         COMMAND KEY ("6")
X            CALL QDchoice(l_page, 6, TRUE)
X            IF ma_desc[1] IS NOT NULL THEN EXIT MENU END IF
X
X         COMMAND KEY ("7")
X            CALL QDchoice(l_page, 7, TRUE)
X            IF ma_desc[1] IS NOT NULL THEN EXIT MENU END IF
X
X         COMMAND KEY ("8")
X            CALL QDchoice(l_page, 8, TRUE)
X            IF ma_desc[1] IS NOT NULL THEN EXIT MENU END IF
X
X         COMMAND KEY ("9")
X            CALL QDchoice(l_page, 9, TRUE)
X            IF ma_desc[1] IS NOT NULL THEN EXIT MENU END IF
X
X         END MENU
X      ELSE
X         CALL message_prompt("No details to display","")
X      END IF
X      
X      CLOSE WINDOW qdwin
X   END IF
X
X   IF check_del("") THEN
X      MESSAGE m_bell,"Query cancelled" ATTRIBUTE(REVERSE)
X   END IF
X
X   CASE
X   WHEN l_keycnt = 0
X      RETURN
X   WHEN l_keycnt = 1 
X      RETURN ma_desc[1]
X   WHEN l_keycnt = 2 
X      RETURN ma_desc[1], ma_desc[2]
X   WHEN l_keycnt = 3 
X      RETURN ma_desc[1], ma_desc[2], ma_desc[3]
X   WHEN l_keycnt = 4 
X      RETURN ma_desc[1], ma_desc[2], ma_desc[3], ma_desc[4]
X   WHEN l_keycnt = 5 
X      RETURN ma_desc[1], ma_desc[2], ma_desc[3], ma_desc[4], ma_desc[5]
X   WHEN l_keycnt = 6 
X      RETURN ma_desc[1], ma_desc[2], ma_desc[3], ma_desc[4], ma_desc[5],
X             ma_desc[6]
X   WHEN l_keycnt = 7 
X      RETURN ma_desc[1], ma_desc[2], ma_desc[3], ma_desc[4], ma_desc[5],
X             ma_desc[6], ma_desc[7]
X   WHEN l_keycnt = 8 
X      RETURN ma_desc[1], ma_desc[2], ma_desc[3], ma_desc[4], ma_desc[5],
X             ma_desc[6], ma_desc[7], ma_desc[8]
X   WHEN l_keycnt = 9 
X      RETURN ma_desc[1], ma_desc[2], ma_desc[3], ma_desc[4], ma_desc[5],
X             ma_desc[6], ma_desc[7], ma_desc[8], ma_desc[9]
X   WHEN l_keycnt = 10 
X      RETURN ma_desc[1], ma_desc[2], ma_desc[3], ma_desc[4], ma_desc[5],
X             ma_desc[6], ma_desc[7], ma_desc[8], ma_desc[9], ma_desc[10]
X   OTHERWISE
X   END CASE
XEND FUNCTION
X
X
XFUNCTION QDbuild_cursor() # Builds the cursor, based on m_select string
X
X   MESSAGE "Building list..."
X
X   PREPARE qdprep FROM m_select
X   DECLARE qdcurs SCROLL CURSOR FOR qdprep
X   OPEN qdcurs
X   MESSAGE ""
XEND FUNCTION
X
X
X# This function scans thru the SELECT string looking for directives (ie {k5})
X# and throws the various bits of information into misc arrays for later use.
X#
X# Also strips the directive text out of the SELECT string so that it makes
X# sense to Informix-SQL
XFUNCTION QDget_desc_sizes() 
XDEFINE   l_thiscol       LIKE syscolumns.colname,
X         l_desclen       SMALLINT,
X         l_lth           SMALLINT,
X         l_cnt           SMALLINT,  # Count of descriptions
X         i, j            SMALLINT
X
X   FOR i = 1 TO 10              # Clean out description length array
X      LET ma_desclen[i]=0
X      LET ma_number[i]=0
X      LET ma_key[i]=0
X   END FOR
X
X   LET l_cnt = 1
X   LET l_lth = LENGTH(m_select)
X   FOR i = 1 TO l_lth          # Scan through desccolumn string  
X      CASE
X      WHEN m_select[i]="{" # Hit a definition
X         FOR j = i-1 TO 1 STEP -1      # Try to work out the name of the column
X            IF m_select[j]=" " THEN
X               LET j = j + 1
X               EXIT FOR
X            END IF
X         END FOR
X
X         LET ma_column[l_cnt]=m_select[j, i-1]
X
X         FOR j = i+1 TO l_lth # Look for column sizes
X            CASE
X            WHEN m_select[j]="k"      # It's a QBE key column
X               LET ma_key[l_cnt]=TRUE # so remember to display it in the
X               LET m_select[j]=" "    # "Query" ring menu
X            WHEN m_select[j]="}"      # End of column size definition
X               LET ma_desclen[l_cnt] = m_select[i+1,j-1]
X               FOR i = i TO j
X                  IF m_select[i]="." THEN        # Look for a decimal point
X                     LET ma_number[l_cnt] = TRUE # Hey - it's a number
X                  END IF
X                  LET m_select[i]=" "
X               END FOR
X               LET i = j
X               LET l_cnt = l_cnt + 1
X               EXIT FOR
X            OTHERWISE
X            END CASE
X         END FOR  
X      OTHERWISE
X      END CASE
X   END FOR 
X
X# Work out total size of all descriptions bolted together...
X
X   LET l_desclen = 0
X   FOR i = 1 TO l_cnt
X      LET l_desclen = l_desclen+ma_desclen[i]
X      LET l_lth = ma_desclen[i]         # Check for numeric with decimal places
X      IF l_lth != ma_desclen[i] THEN    # If found, then add one to account
X         LET l_desclen = l_desclen + 1  # for the decimal place marker
X      END IF
X      IF l_desclen > 76 THEN
X         LET ma_desclen[i] = ma_desclen[i] - (l_desclen - 76)
X         LET l_desclen = 76
X      END IF      
X   END FOR
X   LET l_desclen = l_desclen + l_cnt - 1
X
X   RETURN l_desclen
XEND FUNCTION
X
X
XFUNCTION QDformat_heading(l_heading)
XDEFINE   l_heading            CHAR(100),
X         l_desc               CHAR(80),
X         l_cnt                SMALLINT,
X         l_lth                SMALLINT,
X         i                    SMALLINT,
X         l_s                  SMALLINT,
X         l_e                  SMALLINT,
X         l_this_name          CHAR(80),
X         l_rounded_desclen    SMALLINT
X
X# First work out what headings we've got...
X
X   LET l_desc = m_eighty_spaces
X   LET l_cnt = 1
X   LET l_lth = LENGTH(l_heading)
X   FOR i = 1 TO l_lth 
X      IF l_heading[i] = "," THEN
X         LET ma_head[l_cnt] = l_this_name
X         LET l_cnt = l_cnt + 1
X         LET l_this_name = ""
X      ELSE
X         LET l_this_name = l_this_name CLIPPED, l_heading[i]
X      END IF
X   END FOR
X   LET ma_head[l_cnt] = l_this_name CLIPPED
X
X# Build up description line...
X   LET l_e = -1
X   FOR i = 1 TO l_cnt
X      IF ma_desclen[i] THEN
X         LET l_s = l_e + 2
X         LET l_e = l_s + ma_desclen[i] -1
X         IF ma_number[i] THEN
X            LET l_lth = LENGTH(ma_head[i])    # Right justify numbers
X            IF l_lth > ma_desclen[i] THEN
X               LET l_lth = ma_desclen[i] 
X            END IF
X            LET l_s = l_e - l_lth + 1
X#           LET l_rounded_desclen = ma_desclen[i]
X#           IF ma_desclen[i] != l_rounded_desclen THEN
X#              LET l_s = l_s + 1
X#           END IF
X         END IF
X         IF ma_head[i] IS NOT NULL THEN
X            LET l_desc[l_s, l_e] = ma_head[i]
X         END IF
X      END IF
X   END FOR
X   RETURN l_desc
XEND FUNCTION
X
X
XFUNCTION QDnext_page(l_page, l_desclen)  # Next page of list
XDEFINE   l_page     SMALLINT,
X         l_desclen  SMALLINT
X
X   IF QDshow_page(l_page+1, l_desclen) THEN 
X      LET l_page = l_page + 1
X   ELSE
X      MESSAGE m_bell,"No more pages to display" ATTRIBUTE(REVERSE)
X   END IF
X   RETURN l_page
XEND FUNCTION
X
X
XFUNCTION QDprev_page(l_page, l_desclen)  # Previous page of list
XDEFINE   l_page     SMALLINT,
X         l_desclen  SMALLINT
X
X   IF l_page !=1 THEN
X      IF QDshow_page(l_page-1, l_desclen) THEN
X         LET l_page = l_page -1
X      END IF
X   ELSE
X      MESSAGE m_bell,"No previous page to display" ATTRIBUTE(REVERSE)
X   END IF
X   RETURN l_page
XEND FUNCTION
X
X
XFUNCTION QDchoice(l_page, l_selline, l_errflag) # Read a chosen line
XDEFINE   l_page     SMALLINT,
X         l_selline  SMALLINT,
X         l_errflag  SMALLINT,
X         l_rec      INTEGER
X         
X   LET l_rec = ((l_page-1) * m_lpp) + l_selline
X   FETCH ABSOLUTE l_rec qdcurs
X    INTO ma_desc[1], ma_desc[2], ma_desc[3], ma_desc[4], ma_desc[5],
X         ma_desc[6], ma_desc[7], ma_desc[8], ma_desc[9], ma_desc[10]
X   IF status !=0 THEN
X      LET ma_desc[1]= NULL
X      IF l_errflag THEN
X         MESSAGE m_bell,"Invalid line number"  ATTRIBUTE(REVERSE)
X      END IF
X   END IF
XEND FUNCTION
X
X
XFUNCTION QDshow_page(l_page, l_desclen) # Display a page full of lines
XDEFINE   l_page     SMALLINT,
X         l_desclen  SMALLINT,
X         l_rec      INTEGER,
X         i          SMALLINT,
X         l_last_ok  SMALLINT
X
X   LET l_rec = (l_page-1) * m_lpp + 1
X
X   FOR i = 1 TO m_lpp
X      LET l_last_ok = i - 1
X      IF NOT QDshow_line(l_page, l_desclen, l_rec+i-1, i) THEN
X         IF i > 1 THEN
X            CALL QDblank_window(i)  # Blank reset of window
X         END IF
X         EXIT FOR
X      END IF
X   END FOR
X
X   RETURN l_last_ok
XEND FUNCTION
X
X
XFUNCTION QDshow_line(l_page, l_desclen, l_curr, l_row) # Display a single line
XDEFINE   l_page     SMALLINT,
X         l_desclen  SMALLINT,
X         l_s        SMALLINT,
X         l_e        SMALLINT,
X         i          SMALLINT,
X         l_rec      INTEGER,
X         l_curr     INTEGER,
X         l_row      SMALLINT,
X         l_desc     CHAR(80),
X         l_text     CHAR(80),
X         l_using    CHAR(30),
X         l_lth      SMALLINT,
X         l_decimals SMALLINT,
X         l_num      CHAR(1)
X
X   LET l_desc = m_eighty_spaces
X   FETCH ABSOLUTE l_curr qdcurs 
X    INTO ma_desc[1], ma_desc[2], ma_desc[3], ma_desc[4], ma_desc[5],
X         ma_desc[6], ma_desc[7], ma_desc[8], ma_desc[9], ma_desc[10]
X   IF status = NOTFOUND THEN
X      CALL QDclear_desc()
X      RETURN FALSE
X   END IF
X   IF ma_desc[1] IS NULL THEN
X      LET l_num = " "
X   ELSE
X      LET l_num = l_row 
X   END IF
X
X# Build up description line...
X
X   LET l_e = -1
X   FOR i = 1 TO 10
X      IF ma_desclen[i] THEN
X         LET l_using = ""
X         IF ma_number[i] THEN               # If this is a numeric column
X            LET l_lth = ma_desclen[i]       # then build a "USING" string
X            LET l_decimals = (ma_desclen[i]-l_lth) *10 # How many after dpoint?
X# Build up left hand side of the using string
X            IF l_decimals THEN
X               LET l_lth = l_lth - l_decimals - 1
X            END IF 
X            IF l_lth > 1 THEN 
X               LET l_using = m_using[1,l_lth-1],"&"
X            ELSE
X               LET l_using = "&"
X            END IF
X# And tack on the right hand side if there are any decimal places
X            IF l_decimals THEN
X               LET l_using = l_using CLIPPED,".", m_using[1,l_decimals]
X            END IF
X         END IF
X      
X         LET l_s = l_e + 2
X         LET l_e = l_s + ma_desclen[i] -1
X         IF ma_number[i] THEN
X            LET l_desc[l_s, l_e] = ma_desc[i] USING l_using
X         ELSE
X            IF ma_desc[i] IS NOT NULL THEN        # This test required to stop
X               LET l_desc[l_s, l_e] = ma_desc[i]  # Informix -4518ing later on
X            END IF
X         END IF
X      END IF
X   END FOR
X
X   LET l_text = l_num, " ",l_desc[1,l_desclen]
X
X# And plonk it on the screen...
X
X   LET l_row = l_row + 4
X   DISPLAY l_text AT l_row, 1 ATTRIBUTE(NORMAL)   
X   RETURN TRUE
X
XEND FUNCTION
X
X
XFUNCTION QDblank_window(l_start_row) # Blank out the rest of the page
XDEFINE   i             SMALLINT,
X         l_start_row   SMALLINT, 
X         l_row         SMALLINT
X
X    FOR i = l_start_row TO m_lpp
X       LET l_row = i + 4
X       DISPLAY "" AT l_row, 1 ATTRIBUTE(NORMAL)
X    END FOR
XEND FUNCTION
X
X
XFUNCTION QDqbewindow() # Do the CONSTRUCT...
XDEFINE  l_text           CHAR(200),
X        l_cnt            SMALLINT,
X        l_lth            SMALLINT,
X        l_strcnt         CHAR(1),
X        l_qdkey          CHAR(10),
X        l_form           CHAR(15),
X        l_pad            CHAR(15),
X        i                SMALLINT 
X
X   LET l_text = " 1=1"
X
X# Find out how many key columns there are, so we know which form to open...
X
X   LET l_cnt = 0
X   FOR i = 1 TO 10
X      IF ma_key[i] THEN
X         LET l_cnt = l_cnt + 1
X      END IF
X   END FOR
X
X# Open the appropriate form...
X
X   CASE
X   WHEN l_cnt = 0
X      RETURN l_text
X   WHEN l_cnt = 1
X      LET l_form = "forms/coxxq01a"
X   WHEN l_cnt = 2
X      LET l_form = "forms/coxxq01b"
X   WHEN l_cnt = 3
X      LET l_form = "forms/coxxq01c"
X   WHEN l_cnt = 4
X      LET l_form = "forms/coxxq01d"
X   WHEN l_cnt = 5
X      LET l_form = "forms/coxxq01e"
X   WHEN l_cnt = 6
X      LET l_form = "forms/coxxq01f"
X   WHEN l_cnt = 7
X      LET l_form = "forms/coxxq01g"
X   WHEN l_cnt = 8
X      LET l_form = "forms/coxxq01h"
X   WHEN l_cnt = 9
X      LET l_form = "forms/coxxq01i"
X   WHEN l_cnt = 10
X      LET l_form = "forms/coxxq01j"
X   OTHERWISE
X   END CASE
X
X   OPEN WINDOW qbewind at 4, 8
X   WITH FORM l_form
X   ATTRIBUTE (CYAN, BORDER, MESSAGE LINE LAST, COMMENT LINE LAST-1)
X
X   DISPLAY "Enter data for QBE"         AT 1, 2 ATTRIBUTE(DIM)
X   DISPLAY "Esc to accept. Del to exit" AT 2, 2 ATTRIBUTE(DIM)
X
X# Display the column descriptions...
X
X   LET l_cnt = 0
X   FOR i = 1 TO 10
X      IF ma_key[i] THEN
X         LET l_cnt = l_cnt + 1
X         LET l_pad = "              :"
X         LET l_lth = LENGTH(ma_head[i])
X         IF l_lth > 14 THEN 
X            LET l_lth = 13
X         END IF
X         IF ma_head[i] IS NOT NULL THEN 
X            LET l_pad[15-l_lth, 14] = ma_head[i]
X         END IF
X         DISPLAY l_pad TO anyqbe[l_cnt].keyname ATTRIBUTE(DIM)
X      END IF
X   END FOR
X
X# Do the CONSTRUCT... (If you know a better way to do this, feel free..)
X
X   WHILE l_text = " 1=1" 
X      CASE
X      WHEN l_cnt = 1
X         CONSTRUCT l_text ON qdkey1
X         FROM keyqbe1
X         ATTRIBUTE(NORMAL)
X      WHEN l_cnt = 2
X         CONSTRUCT l_text ON qdkey1, qdkey2
X         FROM keyqbe1, keyqbe2
X         ATTRIBUTE(NORMAL)
X      WHEN l_cnt = 3
X         CONSTRUCT l_text ON qdkey1, qdkey2, qdkey3
X         FROM keyqbe1, keyqbe2, keyqbe3
X         ATTRIBUTE(NORMAL)
X      WHEN l_cnt = 4
X         CONSTRUCT l_text ON qdkey1, qdkey2, qdkey3, qdkey4
X         FROM keyqbe1, keyqbe2, keyqbe3, keyqbe4
X         ATTRIBUTE(NORMAL)
X      WHEN l_cnt = 5
X         CONSTRUCT l_text ON qdkey1, qdkey2, qdkey3, qdkey4, qdkey5
X         FROM keyqbe1, keyqbe2, keyqbe3, keyqbe4, keyqbe5
X         ATTRIBUTE(NORMAL)
X      WHEN l_cnt = 6
X         CONSTRUCT l_text ON qdkey1, qdkey2, qdkey3, qdkey4, qdkey5,
X                             qdkey6
X         FROM keyqbe1, keyqbe2, keyqbe3, keyqbe4, keyqbe5,
X              keyqbe6
X         ATTRIBUTE(NORMAL)
X      WHEN l_cnt = 7
X         CONSTRUCT l_text ON qdkey1, qdkey2, qdkey3, qdkey4, qdkey5,
X                             qdkey6, qdkey7
X         FROM keyqbe1, keyqbe2, keyqbe3, keyqbe4, keyqbe5,
X              keyqbe6, keyqbe7
X         ATTRIBUTE(NORMAL)
X      WHEN l_cnt = 8
X         CONSTRUCT l_text ON qdkey1, qdkey2, qdkey3, qdkey4, qdkey5,
X                             qdkey6, qdkey7, qdkey8
X         FROM keyqbe1, keyqbe2, keyqbe3, keyqbe4, keyqbe5,
X              keyqbe6, keyqbe7, keyqbe8
X         ATTRIBUTE(NORMAL)
X      WHEN l_cnt = 9
X         CONSTRUCT l_text ON qdkey1, qdkey2, qdkey3, qdkey4, qdkey5,
X                             qdkey6, qdkey7, qdkey8, qdkey9
X         FROM keyqbe1, keyqbe2, keyqbe3, keyqbe4, keyqbe5,
X              keyqbe6, keyqbe7, keyqbe8, keyqbe9
X         ATTRIBUTE(NORMAL)
X      WHEN l_cnt = 10
X         CONSTRUCT l_text ON qdkey1, qdkey2, qdkey3, qdkey4, qdkey5,
X                             qdkey6, qdkey7, qdkey8, qdkey9, qdkey10
X         FROM keyqbe1, keyqbe2, keyqbe3, keyqbe4, keyqbe5,
X              keyqbe6, keyqbe7, keyqbe8, keyqbe9, keyqbe10
X         ATTRIBUTE(NORMAL)
X      OTHERWISE
X      END CASE
X
X# Check everything is OK...
X      IF int_flag THEN
X         LET l_text = "!CANCEL!"
X      END IF
X      IF l_text = " 1=1" THEN
X         MESSAGE m_bell,"Cannot search for all records" ATTRIBUTE(REVERSE)
X      ELSE
X# Yep - Then change the select string so it reflects real column names...
X         LET l_cnt = 0
X         FOR i = 1 TO 10
X            IF ma_key[i] THEN
X               LET l_cnt = l_cnt + 1
X               LET l_strcnt = l_cnt
X               LET l_qdkey = "qdkey", l_strcnt
X               LET m_change_text = l_text
X               CALL QDchange_text(l_qdkey, ma_column[i])
X               LET l_text = m_change_text
X            END IF
X         END FOR
X      END IF
X   END WHILE
X
X   CLOSE WINDOW qbewind
X   RETURN l_text
XEND FUNCTION
X
X
X#  Replace l_old with l_new in m_change_text
XFUNCTION QDchange_text(l_old, l_new)
XDEFINE   l_old            CHAR(300),
X         l_new            CHAR(300),
X         l_cnt            SMALLINT,
X         l_oldlth         SMALLINT,
X         i                SMALLINT
X
X   LET l_cnt = LENGTH(m_change_text)
X   LET l_oldlth = LENGTH(l_old)
X   FOR i = 1 TO l_cnt-l_oldlth
X      IF m_change_text[i, i+l_oldlth-1]=l_old CLIPPED THEN
X         IF i > 1 THEN
X            LET m_change_text = m_change_text[1,i-1],l_new CLIPPED,
X                m_change_text[i+l_oldlth,l_cnt] CLIPPED
X         ELSE
X            LET m_change_text = l_new CLIPPED,
X                m_change_text[i+l_oldlth,l_cnt] CLIPPED
X         END IF
X         EXIT FOR
X      END IF
X   END FOR
XEND FUNCTION
X
X
XFUNCTION QDclear_desc() # Clear out current row details
XDEFINE   i      SMALLINT
X
X   FOR i = 1 TO 10
X      LET ma_desc[i] = NULL
X   END FOR
XEND FUNCTION
X
X
XFUNCTION QDgetcollen(l_table, l_column) # Get size of column (from syscolumns)
XDEFINE   l_table     LIKE systables.tabname,
X         l_column    LIKE syscolumns.colname,
X         l_desclen   SMALLINT
X
X   SELECT collength 
X     INTO l_desclen
X     FROM syscolumns, systables
X    WHERE systables.tabname  = l_table
X      AND syscolumns.tabid   = systables.tabid
X      AND syscolumns.colname = l_column
X   IF status = NOTFOUND THEN
X      LET l_desclen = 0
X   END IF
X   RETURN l_desclen
XEND FUNCTION
X
X
XFUNCTION QDsystem_error()
XDEFINE   l_status    INTEGER 
X
X   LET l_status = status
X   LET m_select = err_get(l_status)
X   LET m_select = "ERROR in coxxq01.4gl!<",m_select CLIPPED ,"<",
X                  "Please quote the above error message to your support company"
X   CALL message_prompt(m_select, "")
X   LET m_select = 
X  "SELECT ROWID FROM syscolumns WHERE ROWID = -6"
X   CALL QDbuild_cursor()
XEND FUNCTION
X 
XFUNCTION coxxq01_id()
XDEFINE    l_id    CHAR(80)
XLET l_id = '$Id: coxxq01.4gl,v 1.1 1994/05/08 12:38:44 ver4 Exp $'
XEND FUNCTION
SHAR_EOF
if [ `wc -c < coxxq01.4gl` -ne    33133 ]
then
    echo "Lengths do not match -- Bad Copy of coxxq01.4gl"
fi
echo "Extracting file coxxq01a.per"
sed -e 's/^X//' <<\SHAR_EOF > coxxq01a.per
XDATABASE formonly
XSCREEN
X{
X
X[f01            ][f02                                ] 
X
X}
X
XATTRIBUTES
Xf01 = formonly.keyname;
Xf02 = formonly.keyqbe1;
X
XINSTRUCTIONS
X    DELIMITERS " "
X    SCREEN RECORD anyqbe[1](formonly.keyname)
X    SCREEN RECORD scrrr(formonly.keyqbe1 THRU formonly.keyqbe1)
SHAR_EOF
if [ `wc -c < coxxq01a.per` -ne      290 ]
then
    echo "Lengths do not match -- Bad Copy of coxxq01a.per"
fi
echo "Extracting file coxxq01b.per"
sed -e 's/^X//' <<\SHAR_EOF > coxxq01b.per
XDATABASE formonly
XSCREEN
X{
X
X[f01            ][f02                                ] 
X[f01            ][f03                                ]  
X
X}
X
XATTRIBUTES
Xf01 = formonly.keyname;
Xf02 = formonly.keyqbe1;
Xf03 = formonly.keyqbe2;
X
XINSTRUCTIONS
X    DELIMITERS " "
X    SCREEN RECORD anyqbe[2](formonly.keyname)
X    SCREEN RECORD scrrr(formonly.keyqbe1 THRU formonly.keyqbe2)
SHAR_EOF
if [ `wc -c < coxxq01b.per` -ne      371 ]
then
    echo "Lengths do not match -- Bad Copy of coxxq01b.per"
fi
echo "Extracting file coxxq01c.per"
sed -e 's/^X//' <<\SHAR_EOF > coxxq01c.per
XDATABASE formonly
XSCREEN
X{
X
X[f01            ][f02                                ] 
X[f01            ][f03                                ]  
X[f01            ][f04                                ]  
X
X}
X
XATTRIBUTES
Xf01 = formonly.keyname;
Xf02 = formonly.keyqbe1;
Xf03 = formonly.keyqbe2;
Xf04 = formonly.keyqbe3;
X
XINSTRUCTIONS
X    DELIMITERS " "
X    SCREEN RECORD anyqbe[3](formonly.keyname)
X    SCREEN RECORD scrrr(formonly.keyqbe1 THRU formonly.keyqbe3)
SHAR_EOF
if [ `wc -c < coxxq01c.per` -ne      452 ]
then
    echo "Lengths do not match -- Bad Copy of coxxq01c.per"
fi
echo "Extracting file coxxq01d.per"
sed -e 's/^X//' <<\SHAR_EOF > coxxq01d.per
XDATABASE formonly
XSCREEN
X{
X
X[f01            ][f02                                ] 
X[f01            ][f03                                ]  
X[f01            ][f04                                ]  
X[f01            ][f05                                ]  
X
X}
X
XATTRIBUTES
Xf01 = formonly.keyname;
Xf02 = formonly.keyqbe1;
Xf03 = formonly.keyqbe2;
Xf04 = formonly.keyqbe3;
Xf05 = formonly.keyqbe4;
X
XINSTRUCTIONS
X    DELIMITERS " "
X    SCREEN RECORD anyqbe[4](formonly.keyname)
X    SCREEN RECORD scrrr(formonly.keyqbe1 THRU formonly.keyqbe4)
SHAR_EOF
if [ `wc -c < coxxq01d.per` -ne      533 ]
then
    echo "Lengths do not match -- Bad Copy of coxxq01d.per"
fi
echo "Extracting file coxxq01e.per"
sed -e 's/^X//' <<\SHAR_EOF > coxxq01e.per
XDATABASE formonly
XSCREEN
X{
X
X[f01            ][f02                                ] 
X[f01            ][f03                                ]  
X[f01            ][f04                                ]  
X[f01            ][f05                                ]  
X[f01            ][f06                                ]  
X
X
X}
X
XATTRIBUTES
Xf01 = formonly.keyname;
Xf02 = formonly.keyqbe1;
Xf03 = formonly.keyqbe2;
Xf04 = formonly.keyqbe3;
Xf05 = formonly.keyqbe4;
Xf06 = formonly.keyqbe5;
X
XINSTRUCTIONS
X    DELIMITERS " "
X    SCREEN RECORD anyqbe[5](formonly.keyname)
X    SCREEN RECORD scrrr(formonly.keyqbe1 THRU formonly.keyqbe5)
SHAR_EOF
if [ `wc -c < coxxq01e.per` -ne      615 ]
then
    echo "Lengths do not match -- Bad Copy of coxxq01e.per"
fi
echo "Extracting file coxxq01f.per"
sed -e 's/^X//' <<\SHAR_EOF > coxxq01f.per
XDATABASE formonly
XSCREEN
X{
X
X[f01            ][f02                                ] 
X[f01            ][f03                                ]  
X[f01            ][f04                                ]  
X[f01            ][f05                                ]  
X[f01            ][f06                                ]  
X[f01            ][f07                                ]  
X
X
X}
X
XATTRIBUTES
Xf01 = formonly.keyname;
Xf02 = formonly.keyqbe1;
Xf03 = formonly.keyqbe2;
Xf04 = formonly.keyqbe3;
Xf05 = formonly.keyqbe4;
Xf06 = formonly.keyqbe5;
Xf07 = formonly.keyqbe6;
X
XINSTRUCTIONS
X    DELIMITERS " "
X    SCREEN RECORD anyqbe[6](formonly.keyname)
X    SCREEN RECORD scrrr(formonly.keyqbe1 THRU formonly.keyqbe6)
SHAR_EOF
if [ `wc -c < coxxq01f.per` -ne      696 ]
then
    echo "Lengths do not match -- Bad Copy of coxxq01f.per"
fi
echo "Extracting file coxxq01g.per"
sed -e 's/^X//' <<\SHAR_EOF > coxxq01g.per
XDATABASE formonly
XSCREEN
X{
X
X[f01            ][f02                                ] 
X[f01            ][f03                                ]  
X[f01            ][f04                                ]  
X[f01            ][f05                                ]  
X[f01            ][f06                                ]  
X[f01            ][f07                                ]  
X[f01            ][f08                                ]  
X
X
X}
X
XATTRIBUTES
Xf01 = formonly.keyname;
Xf02 = formonly.keyqbe1;
Xf03 = formonly.keyqbe2;
Xf04 = formonly.keyqbe3;
Xf05 = formonly.keyqbe4;
Xf06 = formonly.keyqbe5;
Xf07 = formonly.keyqbe6;
Xf08 = formonly.keyqbe7;
X
XINSTRUCTIONS
X    DELIMITERS " "
X    SCREEN RECORD anyqbe[7](formonly.keyname)
X    SCREEN RECORD scrrr(formonly.keyqbe1 THRU formonly.keyqbe7)
SHAR_EOF
if [ `wc -c < coxxq01g.per` -ne      777 ]
then
    echo "Lengths do not match -- Bad Copy of coxxq01g.per"
fi
echo "Extracting file coxxq01h.per"
sed -e 's/^X//' <<\SHAR_EOF > coxxq01h.per
XDATABASE formonly
XSCREEN
X{
X
X[f01            ][f02                                ] 
X[f01            ][f03                                ]  
X[f01            ][f04                                ]  
X[f01            ][f05                                ]  
X[f01            ][f06                                ]  
X[f01            ][f07                                ]  
X[f01            ][f08                                ]  
X[f01            ][f09                                ]  
X
X
X}
X
XATTRIBUTES
Xf01 = formonly.keyname;
Xf02 = formonly.keyqbe1;
Xf03 = formonly.keyqbe2;
Xf04 = formonly.keyqbe3;
Xf05 = formonly.keyqbe4;
Xf06 = formonly.keyqbe5;
Xf07 = formonly.keyqbe6;
Xf08 = formonly.keyqbe7;
Xf09 = formonly.keyqbe8;
X
XINSTRUCTIONS
X    DELIMITERS " "
X    SCREEN RECORD anyqbe[8](formonly.keyname)
X    SCREEN RECORD scrrr(formonly.keyqbe1 THRU formonly.keyqbe8)
SHAR_EOF
if [ `wc -c < coxxq01h.per` -ne      858 ]
then
    echo "Lengths do not match -- Bad Copy of coxxq01h.per"
fi
echo "Extracting file coxxq01i.per"
sed -e 's/^X//' <<\SHAR_EOF > coxxq01i.per
XDATABASE formonly
XSCREEN
X{
X
X[f01            ][f02                                ] 
X[f01            ][f03                                ]  
X[f01            ][f04                                ]  
X[f01            ][f05                                ]  
X[f01            ][f06                                ]  
X[f01            ][f07                                ]  
X[f01            ][f08                                ]  
X[f01            ][f09                                ]  
X[f01            ][f10                                ]  
X
X
X}
X
XATTRIBUTES
Xf01 = formonly.keyname;
Xf02 = formonly.keyqbe1;
Xf03 = formonly.keyqbe2;
Xf04 = formonly.keyqbe3;
Xf05 = formonly.keyqbe4;
Xf06 = formonly.keyqbe5;
Xf07 = formonly.keyqbe6;
Xf08 = formonly.keyqbe7;
Xf09 = formonly.keyqbe8;
Xf10 = formonly.keyqbe9;
X
XINSTRUCTIONS
X    DELIMITERS " "
X    SCREEN RECORD anyqbe[9](formonly.keyname)
X    SCREEN RECORD scrrr(formonly.keyqbe1 THRU formonly.keyqbe9)
SHAR_EOF
if [ `wc -c < coxxq01i.per` -ne      939 ]
then
    echo "Lengths do not match -- Bad Copy of coxxq01i.per"
fi
echo "Extracting file coxxq01j.per"
sed -e 's/^X//' <<\SHAR_EOF > coxxq01j.per
XDATABASE formonly
XSCREEN
X{
X
X[f01            ][f02                                ] 
X[f01            ][f03                                ]  
X[f01            ][f04                                ]  
X[f01            ][f05                                ]  
X[f01            ][f06                                ]  
X[f01            ][f07                                ]  
X[f01            ][f08                                ]  
X[f01            ][f09                                ]  
X[f01            ][f10                                ]  
X[f01            ][f11                                ]  
X
X
X}
X
XATTRIBUTES
Xf01 = formonly.keyname;
Xf02 = formonly.keyqbe1;
Xf03 = formonly.keyqbe2;
Xf04 = formonly.keyqbe3;
Xf05 = formonly.keyqbe4;
Xf06 = formonly.keyqbe5;
Xf07 = formonly.keyqbe6;
Xf08 = formonly.keyqbe7;
Xf09 = formonly.keyqbe8;
Xf10 = formonly.keyqbe9;
Xf11 = formonly.keyqbe10;
X
XINSTRUCTIONS
X    DELIMITERS " "
X    SCREEN RECORD anyqbe[10](formonly.keyname)
X    SCREEN RECORD scrrr(formonly.keyqbe1 THRU formonly.keyqbe10)
SHAR_EOF
if [ `wc -c < coxxq01j.per` -ne     1023 ]
then
    echo "Lengths do not match -- Bad Copy of coxxq01j.per"
fi
echo "Extracting file coxxx03.4gl"
sed -e 's/^X//' <<\SHAR_EOF > coxxx03.4gl
X###############################################################################
X#                             CONDITIONS OF USE                               #
X#                                                                             #
X#                  Copyright Quanta Software Ltd 1994                         #
X#                            500 Queen Street                                 #
X#                            Auckland, New Zealand                            #
X#                            Ph. +64-9 377-4473                               #
X#                                                                             #
X# This software is offered as-is, no warranty etc etc. If you decide to use   #
X# this software I would appreciate it if you:                                 #
X#                                                                             #
X# 1. Told me who you are and where you work, either email to                  #
X#    kerry@kcbbs.gen.nz or (if bounced) to 30 Frangipani Ave, Manurewa,       #
X#    Auckland, New Zealand. I just want to know if this is being used!        #
X#    You could even phone me c/- +64-9 2666-011                               #
X#                                                                             #
X# 2. You leave all comments, from this "CONDITIONS OF USE" down to the        #
X#    "#END COMMENTS" marker, intact.                                          #
X#                                                                             #
X# 3. You don't try to sell it to anybody (but sure - use it in your           #
X#    applications!)                                                           #
X#                                                                             #
X# 4. Offer me a well-paid senior programmer type role. ;-)                    #
X#                                                                             #
X###############################################################################
X
X{******************************************************************************
X*    Filename     :   coxxx03.4gl                                             *
X*    System       :   Eunice 4GL - Common Module                              *
X*    Purpose      :   Display text in a box and let user choose an option     *
X*    Returns      :   Option user chose                                       *
X*    Author       :   Kerry S                                                 *
X*    Date Written :   04/10/93                                                *
X*    Last Change  :                                                           *
X*                                                                             *
X* 07/10/93 Kerry S  - Made code far more re-usable by splitting into          *
X*                     setup_wwrap and next_wwrap functions.                   *
X* 29/10/93 Kerry S  - Hard returns were not working since above mod           *
X* 10/11/93 Kerry S  - If only option is "Exit", don't return a value          *
X* 24/03/94 Kerry S  - next_wwrap sucks string space too much!                 *
X* 27/05/94 Kerry S  - Never try to open a window bigger than the screen       *
X*                                                                             *
X******************************************************************************}
X
X#! message_prompt(l_text, l_menu_commands) RETURNING l_choice
X#!   - Displays "l_text" in a window on-screen, and prompts the user
X#!     to make a choice from a ring menu list passed as a comma-delimted
X#!     string. The function returns the user's selection.
X#!
X#      l_text     - Text to display in window.
X#                 - The "<" character is interpreted as a hard-return.
X#                 - l_text is currently limited to 800 characters
X#      l_commands - Commands to place in ring menu, delimited by commas
X#                   eg: "Yes,No" gives the user two options
X#                 - A null "l_command" generates an "Exit" option
X#                 - Only 5 options of 10 characters may be placed in
X#                   the l_command string.
X#      l_choice   - The full text of the ring menu choice the user chose
X# 
X#! setup_wwrap(l_text, l_width) RETURNING l_depth
X#!  - Sets up a long text string for word-wrapping within l_width
X#!    characters.
X#!
X#! next_wwrap() RETURNING l_formated_text
X#!  - Returns formatted text line, being l_width characters of the
X#!    l_text string passed to setup_wwrap().
X#
X#  eg: LET l_depth = setup_wwrap(l_long_text_string, 40)
X#      FOR i = 1 TO l_depth
X#         LET l_formated_to_40_characters_string = next_wwrap()
X#         PRINT l_formatted_to_40_characters_string
X#      END FOR
X#
XDEFINE   m_text       CHAR(800),
X         m_width      SMALLINT,
X         m_spos       SMALLINT,
X         m_line_text  CHAR(132)
X
X
XFUNCTION message_prompt(l_text, l_commands)
XDEFINE   l_text       CHAR(800),
X         l_commands   CHAR(50),
X         l_choice     CHAR(10),
X         l_width      SMALLINT,
X         l_depth      SMALLINT,
X         l_col        SMALLINT,
X         l_row        SMALLINT,
X         i            SMALLINT
X
X   IF l_commands IS NULL THEN
X      LET l_commands = "Exit"
X   END IF
X
X   LET l_width = 50
X
X# Calculate depth of box...
X
X   LET l_depth = setup_wwrap(l_text, l_width)
X   LET l_depth = l_depth + 3
X
X   LET l_col = (80 - l_width) / 2
X   LET l_row = (20 - l_depth) / 2
X
X   IF l_row < 2 THEN LET l_row = 2 END IF
X   IF l_col < 2 THEN LET l_col = 2 END IF
X   IF l_depth > 19 THEN LET l_depth = 19 END IF
X
X   OPEN WINDOW msgbox AT l_row, l_col
X   WITH l_depth ROWS, l_width COLUMNS
X   ATTRIBUTE(BORDER, YELLOW)
X 
X# Display message text...
X
X   LET l_depth = l_depth - 3
X   LET l_row = 3
X   FOR i = 1 TO l_depth
X      CALL coxxx03_study_text()
X      DISPLAY m_line_text AT l_row, 1 ATTRIBUTE(NORMAL)
X      LET l_row = l_row + 1
X   END FOR
X
X# Let user select choice from ring menu...
X
X   LET l_choice = coxxx03_varimenu(l_commands)
X   CLOSE WINDOW msgbox 
X
X   IF l_commands != "Exit" THEN
X      RETURN l_choice
X   END IF
XEND FUNCTION
X
X
XFUNCTION setup_wwrap(l_text, l_width)
XDEFINE   l_text       CHAR(800),   # Text string to be formatted
X         l_width      SMALLINT,    # Width of the box
X         l_depth      SMALLINT,    # Depth of the box
X         l_lth        SMALLINT     # Length of entire text string
X
X   LET m_width = l_width
X   LET m_text  = l_text
X   LET l_depth = 0
X
X   LET l_lth = length(m_text)
X   LET m_spos = 1
X   WHILE m_spos <= l_lth 
X      CALL coxxx03_study_text()
X      LET l_depth = l_depth + 1
X   END WHILE
X   LET m_spos = 1
X   LET m_text  = l_text
X   RETURN l_depth
XEND FUNCTION
X
X
XFUNCTION next_wwrap()
XDEFINE   l_text       CHAR(132)
X
X   CALL coxxx03_study_text()
X   LET l_text = m_line_text
X   RETURN l_text
XEND FUNCTION
X
XFUNCTION coxxx03_study_text()
XDEFINE  
X         l_epos       SMALLINT,    # End position in text string
X         l_hp         SMALLINT     # Hard-return position ("<")
X
X# First look for a white-space to end the line on...
X      FOR l_epos = m_spos + m_width TO m_spos STEP -1
X         IF m_text[l_epos]=" " THEN
X            EXIT FOR  
X         END IF
X      END FOR
X      IF m_spos >= l_epos THEN           # Could not find a white-space, so
X         LET l_epos = m_spos + m_width   # just chop off end of word
X      END IF
X      FOR l_hp = m_spos TO l_epos        # Have a look for hard-return code...
X         IF m_text[l_hp]="<" THEN        # Found it...
X            LET l_epos = l_hp 
X            LET m_text[l_hp]=" "
X            EXIT FOR
X         END IF
X      END FOR
X      LET m_line_text = m_text[m_spos, l_epos] # This is our text to output
X   
X      LET m_spos = l_epos + 1
XEND FUNCTION
X
X
XFUNCTION coxxx03_varimenu(l_commands)
XDEFINE  i                  SMALLINT,
X        l_lth              SMALLINT,
X        l_cnt              SMALLINT,
X        l_s                SMALLINT,
X        l_commands         CHAR(50),
X        la_opt ARRAY[5] OF CHAR(10),
X        l_choice           CHAR(10),
X        l_menu_name        CHAR(10)
X
X# First determine which options are required...
X
X   LET l_cnt = 1
X   LET l_s   = 1
X   LET l_lth = LENGTH(l_commands)
X   FOR i = 1 TO l_lth
X      IF l_commands[i,i]="," THEN
X         LET la_opt[l_cnt] = l_commands[l_s, i-1]
X         LET l_s = i + 1
X         LET l_cnt = l_cnt + 1
X      END IF
X   END FOR
X   LET la_opt[l_cnt] = l_commands[l_s, l_lth]
X
X   IF l_cnt = 1 THEN
X      LET l_menu_name = "MESSAGE"
X   ELSE
X      LET l_menu_name = "SELECT"
X   END IF
X    
X# The following code is something that I find very embarrassing, but it's
X# necessary if this routine is going to perform well for the user...
X
X   CASE
X   WHEN l_cnt = 1
X      MENU l_menu_name
X      COMMAND la_opt[1] 
X         LET l_choice = la_opt[1]
X         EXIT MENU
X      END MENU
X
X   WHEN l_cnt = 2
X      MENU l_menu_name
X      COMMAND la_opt[1] 
X         LET l_choice = la_opt[1]
X         EXIT MENU
X      COMMAND la_opt[2] 
X         LET l_choice = la_opt[2]
X         EXIT MENU
X      END MENU
X   
X   WHEN l_cnt = 3
X      MENU l_menu_name
X      COMMAND la_opt[1] 
X         LET l_choice = la_opt[1]
X         EXIT MENU
X      COMMAND la_opt[2] 
X         LET l_choice = la_opt[2]
X         EXIT MENU
X      COMMAND la_opt[3] 
X         LET l_choice = la_opt[3]
X         EXIT MENU
X      END MENU
X   
X   WHEN l_cnt = 4
X      MENU l_menu_name
X      COMMAND la_opt[1] 
X         LET l_choice = la_opt[1]
X         EXIT MENU
X      COMMAND la_opt[2] 
X         LET l_choice = la_opt[2]
X         EXIT MENU
X      COMMAND la_opt[3] 
X         LET l_choice = la_opt[3]
X         EXIT MENU
X      COMMAND la_opt[4] 
X         LET l_choice = la_opt[4]
X         EXIT MENU
X      END MENU
X
X   WHEN l_cnt = 5
X      MENU l_menu_name
X      COMMAND la_opt[1] 
X         LET l_choice = la_opt[1]
X         EXIT MENU
X      COMMAND la_opt[2] 
X         LET l_choice = la_opt[2]
X         EXIT MENU
X      COMMAND la_opt[3] 
X         LET l_choice = la_opt[3]
X         EXIT MENU
X      COMMAND la_opt[4] 
X         LET l_choice = la_opt[4]
X         EXIT MENU
X      COMMAND la_opt[5] 
X         LET l_choice = la_opt[5]
X         EXIT MENU
X      END MENU
X   END CASE
X
X   RETURN l_choice
XEND FUNCTION
X
X 
XFUNCTION coxxx03_id()
XDEFINE    l_id    CHAR(80)
XLET l_id = '$Id: coxxx03.4gl,v 1.2 1994/05/26 21:46:25 ver4 Exp $'
XEND FUNCTION
SHAR_EOF
if [ `wc -c < coxxx03.4gl` -ne    10262 ]
then
    echo "Lengths do not match -- Bad Copy of coxxx03.4gl"
fi
echo "Extracting file coxxx12.4gl"
sed -e 's/^X//' <<\SHAR_EOF > coxxx12.4gl
X# $Id: coxxx12.4gl,v 1.1 1994/05/08 12:39:05 ver4 Exp $
X{******************************************************************************
X*    Filename: coxxx12.4gl                                                    *
X*    System  : Eunice 4GL - Library Module                                    *
X*    Purpose : check if the interrupt key has been pressed                    *
X*    Returns : TRUE/FALSE                                                     *
X*    Author  : Unknown                                                        *
X*                                                                             *
X******************************************************************************}
X
X#! check_del(message) RETURNs TRUE/FALSE
X#!               - Checks if the interrupt key (usually DEL, but
X#!                 possibly CONTROL-C) has been pressed. 
X#!               - Displays "message" if true, and returns TRUE/FALSE
X#!
X
XFUNCTION check_del(str)
X
X   DEFINE str CHAR(80)
X	
X   IF int_flag <> 0 OR quit_flag <> 0 THEN
X      MESSAGE str CLIPPED
X      LET int_flag = 0
X      LET quit_flag = 0
X      RETURN TRUE
X   END IF
X   RETURN FALSE
X
XEND FUNCTION
X 
XFUNCTION coxxx12_id()
XDEFINE    l_id    CHAR(80)
XLET l_id = '$Id: coxxx12.4gl,v 1.1 1994/05/08 12:39:05 ver4 Exp $'
XEND FUNCTION
SHAR_EOF
if [ `wc -c < coxxx12.4gl` -ne     1290 ]
then
    echo "Lengths do not match -- Bad Copy of coxxx12.4gl"
fi
echo "Extracting file make_sample"
sed -e 's/^X//' <<\SHAR_EOF > make_sample
X:
Xfglpc coxxq01.4gl
Xfglpc coxxx03.4gl
Xfglpc coxxx12.4gl
Xfglpc sample.4gl
Xcat coxxq01.4go > sample.4gi
Xcat coxxx03.4go >> sample.4gi
Xcat coxxx12.4go >> sample.4gi
Xcat sample.4go >> sample.4gi
Xmkdir forms
Xform4gl coxxq01a.per
Xform4gl coxxq01b.per
Xform4gl coxxq01c.per
Xform4gl coxxq01d.per
Xform4gl coxxq01e.per
Xform4gl coxxq01f.per
Xform4gl coxxq01g.per
Xform4gl coxxq01h.per
Xform4gl coxxq01i.per
Xform4gl coxxq01j.per
Xmv *frm forms/.
Xfglgo sample
SHAR_EOF
if [ `wc -c < make_sample` -ne      442 ]
then
    echo "Lengths do not match -- Bad Copy of make_sample"
fi
echo "Extracting file sample.4gl"
sed -e 's/^X//' <<\SHAR_EOF > sample.4gl
XDATABASE eunice   #<<<<------ You'll need to change this
XMAIN
XDEFINE l_text    CHAR(500),
X       l_table   CHAR(20),
X       l_column  CHAR(20)
X
X   LET l_text = "First we'll list all the columns in 'syscolumns' ",
X                "and return the column name selected"
X
X   CALL message_prompt(l_text,"")
X   LET l_text = "SELECT colname{0}, colno{0}, tabname{k15}, colname{k20} ",
X                 " FROM systables, syscolumns ",
X                " WHERE tabname = 'syscolumns' ",
X                  " AND systables.tabid = syscolumns.tabid ",
X                 "ORDER BY colno"
X   LET l_column = query_window(l_text, "Table,Column", 1, "")
X
X   LET l_text = "You selected ",l_column CLIPPED,". ",
X                "Now I'll force you to do a Query by example first, ",
X                "and will return 2 values to the calling function."
X   CALL message_prompt(l_text,"")
X
X   LET l_text = "SELECT tabname{k15}, colname{k20}, colno{6.1} ",
X                 " FROM systables, syscolumns ",
X                " WHERE systables.tabid = syscolumns.tabid ",
X                 "ORDER BY tabname, colno"
X   CALL query_window(l_text, "Table,Column,ColNo", 2, "FQ") RETURNING l_table, 
X                                                                      l_column
X
X   LET l_text = "You selected column ",l_column CLIPPED," from table ",
X                l_table CLIPPED,". Now I'm really going to show off with ",
X                "a list of tables and their average column length (not ",
X                "that it means anything)."
X   CALL message_prompt(l_text,"")
X
X   LET l_text = "SELECT tabname{k15}, AVG(collength){10.2} ",
X                 " FROM systables, syscolumns ",
X                " WHERE systables.tabid = syscolumns.tabid ",
X                " GROUP BY tabname",
X                " ORDER BY tabname"
X   CALL query_window(l_text, "Table,AvgColsize", 1, "") RETURNING l_table
X
X   LET l_text = "You selected '",l_table CLIPPED,"'.<",
X                "Detailed instructions on how to use ",
X                "the 'query_window' function are included in coxxq01.4gl. ",
X                "Feel free to perform your own tests. I'd appreciate hearing ",
X                "about any bugs or comments ASAP!<Thanks for your time,<",
X                "kerry@kcbbs.gen.nz"
X   CALL message_prompt(l_text, "")
XEND MAIN
X
SHAR_EOF
if [ `wc -c < sample.4gl` -ne     2292 ]
then
    echo "Lengths do not match -- Bad Copy of sample.4gl"
fi
echo "Done."
exit 0