subroutine U035A( Resultat, Status, Param ) ******************************************************************************* * * Saisie en mode editeur pleine ligne * * 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. * 08/18/96 18335 MAA Added new code to port 9 to Siemens Nixdorf. * 01/14/91 7930 JWT Added new Ucode for Siemens/Nixdorf * 17/07/89 - BHX creation du source * 10/09/90 - BHX Abandon de PTERM => TTYGET / TTYSET * ******************************************************************************* * $INCLUDE UNIVERSE.INCLUDE TTY $INCLUDE UNIVERSE.INCLUDE DEF.USERS $INCLUDE UNIVERSE.INCLUDE TERMINFO *** validiter de la demande Status = 0 Resultat = "" Nombre = 1 Position = 1 TTYGET tty$ ELSE Status = 1 ; RETURN SAVE.NL = CRMODE.ICRNL CRMODE.ICRNL = 0 TTYSET tty$ ELSE Status = 1 ; RETURN Long = EXTRACT(Param,1) CarVal = EXTRACT(Param,2) ValIni = EXTRACT(Param,3) IF LEN(ValIni) > Long THEN ValIni = ValIni[1,Long] PRINT ValIni: UnCarAGauche = KEY.MOVE.CURSOR.LEFT FOR Indice = 1 TO LEN(ValIni) PRINT UnCarAGauche: NEXT Indice Resultat = ValIni:SPACE(Long-LEN(ValIni)) ******** debut: * ******** *** saisie d'un caractere quelconque de CHAR(0) a CHAR(255) Command = KEYIN() *** Inversion upcase/downcase IF CASE.INVERT THEN IF Command >= 'a' AND Command <= 'z' THEN Command = CHAR(SEQ(Command)-32) END ELSE IF Command >= 'A' AND Command <= 'Z' THEN Command = CHAR(SEQ(Command)+32) END END END *** test du caractere recu Flag = 0 BEGIN CASE *** Caractere de validation CASE INDEX(CarVal,Command,1) > 0 Flag = 1 GOTO fin *** fleche a gauche (^Y ; basckspace sans effacement?) CASE Command = KEY.MOVE.CURSOR.LEFT Command = "" IF Nombre = 1 THEN PRINT BELL: END ELSE Flag = 2 Nombre = Nombre - 1 GOSUB Reafficher END *** fleche a droite (^X) CASE Command = KEY.MOVE.CURSOR.RIGHT Command = "" IF Nombre < LEN(Resultat) THEN Flag = 3 Nombre = Nombre + 1 GOSUB Reafficher END ELSE PRINT BELL: END *** touche Mot (^B) suppression du caractere courant CASE Command = Mot OR Command = KEY.BACKSPACE OR Command = CHAR(02) Command = "" Resultat = Resultat[1,Nombre-1]:Resultat[Nombre+1,LEN(Resultat)-Nombre]:" " GOSUB Reafficher Flag = 4 *** touche Car (^A) insertion d'un blanc devant le caractere courant CASE Command = Car OR Command = CHAR(01) Command = "" Resultat = Resultat[1,Nombre-1]:" ":Resultat[Nombre,LEN(Resultat)-Nombre] GOSUB Reafficher Flag = 5 *** touche Supp suppression de la partie droite caractere courant compris CASE Command = Supp OR Command = CHAR(03) Command = "" IF Nombre # 1 THEN *** Nombre = Nombre - 1 Resultat = Resultat[1,Nombre-1]:Space(LEN(Resultat)-Nombre+1) END ELSE Resultat = Space(LEN(Resultat)) END GOSUB Reafficher Flag = 6 END CASE *** si caractere de controle autre que ceux prevu, l'absorber IF (Command < CHAR(32) OR Command > CHAR(249)) THEN IF Flag = 0 THEN GOTO debut END END *** si longueur atteinte IF Nombre = Long + 1 THEN Command = "" PRINT BELL: END *** mise a jour du resultat IF Command # "" THEN Resultat = Resultat[1,Nombre-1]:Command:Resultat[Nombre+1,LEN(Resultat)-Nombre] Nombre = Nombre + 1 GOSUB Reafficher END GOTO debut ******* fin : * ******* *** suppression des blancs de fin de ligne Temp = Resultat FOR Indice = LEN(Resultat) TO 1 STEP -1 IF Resultat[Indice,1] = " " THEN Temp = Temp[1,Indice-1] END ELSE GOTO LSuite END NEXT Indice LSuite: Resultat = Temp IF Resultat = ValIni THEN Modif = 0 ELSE Modif = 1 Resultat = Resultat:@AM:Command:@AM:Modif CRMODE.ICRNL = SAVE.NL TTYSET tty$ ELSE Status = 1 ; RETURN RETURN ************* Reafficher: * ************* FOR Indice = 1 TO Position - 1 PRINT UnCarAGauche: NEXT Indice PRINT Resultat: Position = Nombre FOR Indice = LEN(Resultat) TO Nombre STEP -1 PRINT UnCarAGauche: NEXT Indice RETURN END