Multi-screen Input -- Example: Part 1

I've had just about enough requests to justify posting the example multi-screen code to the net. I found to my surprise that the code I had was a far more rounded and complete program than I thought, and that I needed to supply a ream of supporting material. Anyway, create the database with spi.sql; compile all the forms; then compile all the C and 4GL source in one C4GL command. Run the resulting executable. It seemed to work under a cursory glance. If you like makefiles and have make trained to handle I4GL, then there's a makefile too. Most make's will handle it, but they'll require some persuading to learn how to cope with I4GL. The code comes in 2 shell archives -- I hope that they squeeze through the News feeds. If they don't, it'll come in three or four parts, I guess. Have fun. Jonathan Leffler (johnl@informix.com) #include <disclaimer.h> PS: I'm still using an old shell archive program... : "%W% %E%" #!/bin/sh # shar: Shell Archiver (v1.22) # # This is a shell archive. # Remove everything above this line and run sh on the resulting file # If this archive is complete, you will see this message at the end # "All files extracted" # # Created: Wed Apr 27 20:49:18 1994 by johnl at Sphinx Ltd. # Files archived in this archive: # spi1.4gl # spi1.per # spi2.4gl # spi2.per # spi3.4gl # spi3.per # spic.4gl # spig.4gl # spii.4gl # spim.4gl # spir.4gl # spiw.4gl # if test -f spi1.4gl; then echo "File spi1.4gl exists"; else echo "x - spi1.4gl" sed 's/^X//' << 'SHAR_EOF' > spi1.4gl && X{ X @(#)spi1.4gl 7.1 90/08/23 X @(#)Built by: FGLBLD Version 6.08 (01/12/1989) X @(#)Input function for SPI on Spi X} X XDATABASE FGLBLD X XGLOBALS "spig.4gl" X X{ Module variables -- not accessible outside this file } XDEFINE X sccs CHAR(1) { Identifier string } X X{ Input function } XFUNCTION in1_spi() X X DEFINE X io_status INTEGER, X field_no INTEGER, X n INTEGER, X iucode CHAR(1) { 'I' Insert, 'U' Update } X X LET io_status = 2 { IO_DONE } X LET io_spi.io_currform = 1 X LET io_spi.io_inbound = TRUE X LET n = io_spi.io_currform X LET fc_spi.min_field = io_spi.io_fldnumlo[n] X LET fc_spi.max_field = io_spi.io_fldnumhi[n] X LET fc_spi.prev_field = 0 X X CALL wi1_spi(2) X X INPUT i1_spi.* WITHOUT DEFAULTS FROM s_spi.* HELP 20 X X ON KEY (F8, CONTROL-E) X # Alternative exit input for FGLDB X LET io_status = 3 { IO_INTR } X EXIT INPUT X X ON KEY (F7, CONTROL-F) X CALL hlp_spi() X X ON KEY (F6, CONTROL-P) X CASE X WHEN INFIELD(tabname) X LET field_no = v01_spi("^P") X WHEN INFIELD(pkcol) X LET field_no = v02_spi("^P") X WHEN INFIELD(menuname) X LET field_no = v03_spi("^P") X WHEN INFIELD(basename) X LET field_no = v04_spi("^P") X END CASE X GOTO nxf_spi X X ON KEY (F5, CONTROL-B) X CASE X WHEN INFIELD(tabname) X LET field_no = v01_spi("F5") X WHEN INFIELD(pkcol) X LET field_no = v02_spi("F5") X WHEN INFIELD(menuname) X LET field_no = v03_spi("F5") X WHEN INFIELD(basename) X LET field_no = v04_spi("F5") X OTHERWISE X ERROR "No pop-up facility is defined for this field" X END CASE X GOTO nxf_spi X X BEFORE FIELD tabname X LET field_no = v01_spi("BF") X GOTO nxf_spi X X AFTER FIELD tabname X LET field_no = v01_spi("AF") X GOTO nxf_spi X X BEFORE FIELD pkcol X LET field_no = v02_spi("BF") X GOTO nxf_spi X X AFTER FIELD pkcol X LET field_no = v02_spi("AF") X GOTO nxf_spi X X BEFORE FIELD menuname X LET field_no = v03_spi("BF") X GOTO nxf_spi X X AFTER FIELD menuname X LET field_no = v03_spi("AF") X GOTO nxf_spi X X BEFORE FIELD basename X LET field_no = v04_spi("BF") X GOTO nxf_spi X X AFTER FIELD basename X LET field_no = v04_spi("AF") X GOTO nxf_spi X X LABEL nxf_spi: X IF field_no IS NOT NULL THEN X CASE X WHEN field_no = 0 X LET io_status = 0 { IO_CONT } X EXIT INPUT X WHEN field_no = 1 X NEXT FIELD tabname X WHEN field_no = 2 X NEXT FIELD pkcol X WHEN field_no = 3 X NEXT FIELD menuname X WHEN field_no = 4 X NEXT FIELD basename X OTHERWISE X CALL xfl_spi(field_no) X LET io_status = 0 { IO_CONT } X EXIT INPUT X END CASE X END IF X END INPUT X X CASE X WHEN INT_FLAG = TRUE OR io_status = 3 X LET io_status = 3 { IO_INTR } X LET INT_FLAG = FALSE X WHEN io_status = 2 OR io_status = 1 X LET io_status = 2 { IO_DONE } X EXIT CASE X WHEN io_status = 0 { IO_CONT } X EXIT CASE X OTHERWISE X ERROR "Can't happen" SLEEP 1 X LET io_status = 2 { IO_DONE } X END CASE X X RETURN io_status X XEND FUNCTION {in1_spi} X X{ X Validation Functions X ******************** X Unless a non-null value is assigned to retval, X the INPUT statement will continue in the default manner. X Do not assign a non-null value to retval without cause. X In general, do not set retval for BF. X} X X{ Validation code for Spi.tabname } XFUNCTION v01_spi(vcode) X X DEFINE X vcode CHAR(2), { AF, BF, ^P or F5 } X retval INTEGER { Next field number } X X LET retval = NULL X X CASE X WHEN vcode = "^P" X LET i1_spi.tabname = cp_spi.tabname X LET retval = next_field(fc_spi.*) X WHEN vcode = "F5" X ERROR "Sorry -- pop-up facility is not available" X LET retval = fc_spi.curr_field X # LET i1_spi.tabname = pop_xreftable() X # LET retval = next_field(fc_spi.*) X WHEN vcode = "BF" X LET fc_spi.curr_field = 1 X LET pr_spi.tabname = wr_spi.tabname X LET retval = ffl_spi() X # Insert code to skip tabname here X # WHEN vcode = "AF" X # Normally there is no code needed here X END CASE X X # Do not validate in BEFORE FIELD (normally) X IF vcode != "BF" THEN X # This validation should be normally be replaced X # WHENEVER ERROR CONTINUE X # VALIDATE wr_spi.tabname LIKE Spi.tabname X # WHENEVER ERROR STOP X # IF STATUS != 0 THEN X # CALL ERR_PRINT(STATUS) X # SLEEP 2 X # LET retval = fc_spi.curr_field X # END IF X CALL di1_spi() X END IF X X CALL spf_spi(vcode, retval) X X RETURN retval X XEND FUNCTION {v01_spi} X X{ Validation code for Spi.pkcol } XFUNCTION v02_spi(vcode) X X DEFINE X vcode CHAR(2), { AF, BF, ^P or F5 } X retval INTEGER { Next field number } X X LET retval = NULL X X CASE X WHEN vcode = "^P" X LET i1_spi.pkcol = cp_spi.pkcol X LET retval = next_field(fc_spi.*) X WHEN vcode = "F5" X ERROR "Sorry -- pop-up facility is n