subroutine U01AD( proc, ibn, pib, sib, ip, obn, pob, sob ) ******************************************************************************* * * Perform a file translation from a ProVerb * * Module %M% Version %I% Date %H% * * (c) Copyright 1998 Ardent Software Inc. - All Rights Reserved * This is unpublished proprietary source code of Ardent Software Inc. * The copyright notice above does not evidence any actual or intended * publication of such source code. * ******************************************************************************* * * Maintenence log - insert most recent change descriptions at top * * Date.... GTAR# WHO Description......................................... * 10/14/98 23801 SAP Change copyrights. * 11/02/95 17595 SHJ Don't convert blanks when printing to terminal * 04/15/92 9342 JWT Fix case for pib len = 0 * 01/03/92 8557 GMH Corrected placement in pib * 07/25/88 - - Maintenence log purged at 5.2.1, see release 5.1.10. * ******************************************************************************* * * This "user-exit", called from a ProVerb, takes the filename, * item-ID, and translation attribute number specified and returns * the looked-up value to the named target. * * Usage: * U01AD * file.ref item.ref amc.ref target * error return * success return * * Where target can be: * T - terminal * S - Current output buffer * A - Alternate output buffer * P - Primary input buffer * V - Verify existence (produces no output) * VA - Verify nonnull attribute * * All references can be indirect through the proc buffers. * Work files are not supported. * * Arguments to this subroutine are: * proc - the text of the proc itself * ibn - the current input buffer number (0 = primary; * 1 = secondary) * pib - the primary input buffer * sib - the secondary input buffer * ip - the input buffer pointer (character count) * obn - the current output buffer number (0 = primary; * 1 = secondary) * pob - the primary output buffer * sob - the secondary output buffer * ******************************************************************************* * * * DIM words( 10 ) REMOVE line FROM proc SETTING x line = TRIM( line ) MATPARSE words FROM line," " CALL $INDIRECT( fileref, pib, sib, pob, sob, obn, words( 1 )) IF fileref[ 1,1 ] = "*" THEN Dstr = "DICT" fileref = fileref[ 2, 999 ] END ELSE Dstr = "" END CALL $INDIRECT( itemref, pib, sib, pob, sob, obn, words( 2 )) CALL $INDIRECT( amcref, pib, sib, pob, sob, obn, words( 3 )) CALL $INDIRECT( target, pib, sib, pob, sob, obn, words( 4 )) found = 1 OPEN Dstr, fileref TO fvu01ad ELSE RETURN END READV item FROM fvu01ad, itemref, amcref ELSE found = 0 END IF found THEN * * If the target designation is prefaced with a "B", then we're * to replace all embedded blanks with backslashes. * IF target[ 1, 1 ] = "B" THEN CONVERT " " TO "\" IN item target = target[ 2, LEN( target )] END ELSE IF target[ 1, 1 ] # "T" THEN CONVERT " " TO @AM IN item END BEGIN CASE CASE target = "T" print item CASE target = "T+" print item: CASE target = "S" IF( obn ) THEN sob := item END ELSE pob := item END CASE target = "A" IF ( obn ) THEN pob = item END ELSE sob = item END CASE target = "P" pib.len = len(pib) IF ip = pib.len THEN IF pib[ip,1] # @AM AND pib.len THEN pib := @AM pib := item END ELSE IF pib[ ip, 1 ] = @AM THEN ip += 1 first.part = pib[ 1, ip - 1 ] : item : @AM last.part = pib[ ip + 1, len( pib )] IF pib[ ip, 1 ] # @AM THEN DEL last.part< 1 > pib = first.part : last.part END CASE target = "V" NULL CASE target = "VA" IF item = "" THEN found = 0 END END CASE END * * If we found an item, we must remove the error return line * from the proc. * IF found THEN REMOVE line FROM proc SETTING x END RETURN END