333 lines
		
	
	
	
		
			10 KiB
		
	
	
	
		
			OpenEdge ABL
		
	
	
	
	
	
			
		
		
	
	
			333 lines
		
	
	
	
		
			10 KiB
		
	
	
	
		
			OpenEdge ABL
		
	
	
	
	
	
| (*  COPYRIGHT 1979 YAVUZ ONDER, UNIVERSITY OF MANCHESTER  *)
 | |
| (*$G-*) 
 | |
| 
 | |
| PROGRAM TAILOR ( INPUT, INFILE, error, output );
 | |
| (*         HOW TO USE 'TAILOR'
 | |
|  *  -ANY VERSION IN TEXT IS OPENED BY (*SNN() AND 
 | |
|                             CLOSED BY ()SNN*) (*
 | |
|  *        WHERE S IS '+' OR '-' (NO DEFAULT), 
 | |
|  *             NN IS AN UNSIGNED TWO DIGIT INTEGER (NO ZERO SUPRESSION) 
 | |
|  *        IN SOME CASES output WILL CONTAIN '+)' INSTEAD OF
 | |
|  *             'ASTERISK)' AS COMMENT CLOSER. 
 | |
|  *  -THE NAME OF THE FILE TO BE TAILORED IS THE FIRST ARGUMENT. 
 | |
|  *  -THERE ARE THREE BASIC OPERATIONS :  
 | |
|  *        'INCLUDE'  :  (I) REMOVES VERSION ENTRY AND CLOSING
 | |
|  *                          SYMBOLS AND CHANGES '+)'S TO 'ASTERISK )'S
 | |
|  *                          WITHIN THE VERSION ;
 | |
|  *                     (II) CHANGES ALL 'ASTERISK )'S TO '+)'S
 | |
|  *                          WITHIN THE COMPLEMENTED VERSION, EXCEPT IN 
 | |
|  *                          VERSION CLOSER. 
 | |
|  *        'SKIP'     :  (I) REMOVES ALL VERSION INCLUDING ENTRY AND
 | |
|  *                          CLOSING SYMBOLS ; 
 | |
|  *                     (II) PERFORMS 'INCLUDE' (I) ON COMPLEMENTED VERSION
 | |
|  *       'LEAVE ALONE':      IF NO COMMAND EXISTS FOR ANY ONE OF THE VERSIONS 
 | |
|  *                          IN THE TEXT 'INCLUDE' IS PERFORMED ON 
 | |
|  *                          -(ABS(VERSION-NOT-IN-TEXT)).
 | |
|  *  -COMMANDS ARE INPUT WHEN REQUIRED BY 'TAILOR'.
 | |
|  *  -TO 'INCLUDE' ANY VERSION GIVE ITS NUMBER ('+'S NEED NOT BE GIVEN.).
 | |
|  *  -TO 'SKIP' ANY VERSION ENTER ABS(ITS-NUMBER)+100 SIGNED AS IN TEXT... 
 | |
|  *
 | |
|  *        ... E.G.  COMMAND SEQUENCE ' 1 -102 103 -20 200 ' MEANS
 | |
|  *              (PERFORM 'INCLUDE' ON 1,2,-3 AND -20 ) AND
 | |
|  *              (PERFORM 'SKIP'    ON -2 AND 3 )     AND
 | |
|  *              (PERFORM 'LEAVE ALONE' ON ALL OTHER VERSIONS IN TEXT.). 
 | |
|  *  -TO TERMINATE COMMAND SEQUENCE BEFORE THIRTY-SECOND ENTER ANY COMMAND>=300
 | |
|  *         THIRTYTWO OR MORE COMMANDS START THE EXECUTION OF THE TAILOR 
 | |
|  *         AND ONLY FIRST THIRTYTWO (NOW APPROX 50) ARE ACCEPTED.
 | |
|  *  -IF ANY VERSION OR ITS COMPLEMENT TAKES PLACE IN MORE THAN ONE
 | |
|  *         COMMAND THE LAST ONE IS OBEYED.
 | |
|  *  -ZERO CANNOT BE USED AS VERSION NUMBER OR IN COMMANDS.
 | |
|  *  -TO REMOVE ALL TAILORING BRACKETS (USEFUL PRIOR TO XREF) INPUT 1000 ONLY.
 | |
|  *  -LINE NUMBER ARE REMOVED FROM FILES, EXCEPT WITH THE 1000 COMMAND.
 | |
|  *  -THE TAILORED PROGRAM APPEARS ON THE STANDARD OPUTPUT.
 | |
|  *  -ERROR MESSAGES APPEAR ON THE FILE GIVEN BY THE SECOND ARGUMENT.
 | |
|  ************* END OF HOW TO USE ************************************)
 | |
| 
 | |
| CONST verslimit=50;
 | |
| VAR   VERLIST : ARRAY[1..verslimit]OF INTEGER;
 | |
|       INFILE : TEXT;
 | |
|       error : TEXT;
 | |
|       (* INPUT AND OUTPUT FILES *)
 | |
|       NOOFVER         : INTEGER; 
 | |
|       (* NUMBER OF COMMANDS (MAX. verslimit) *)
 | |
|       INLFLAG, INIFLAG : INTEGER;
 | |
|       (* FLAGS SHOWING WHETHER IN A 'LEAVE ALONE' OR
 | |
|                  'INCLUDE' RESPECTIVELY *)
 | |
|       LINBUF           : ARRAY[1..200]OF CHAR; 
 | |
|       (* TEMPORARY STORAGE FOR MANIPULATION OF
 | |
|                  THE CURRENT LINE *)
 | |
|       FIRSTNONBLANK    : INTEGER; (* KEEPS THE POSITION OF FIRST 
 | |
|          NONBLANK 
 | |
|                                  CHAR IN LINBUF *)
 | |
|       INCLUDEALL       : BOOLEAN;
 | |
|       (*******************************************************) 
 | |
| 
 | |
| PROCEDURE INITIALISE ( VAR NOOFVER : INTEGER );
 | |
|   (* READS COMMANDS AND INITIALISES THE GLOBALS *)
 | |
| 
 | |
|   LABEL 9;
 | |
| 
 | |
|   VAR   VERNO, I : INTEGER;
 | |
| BEGIN 
 | |
| INCLUDEALL := FALSE; 
 | |
| I := 0;
 | |
| REPEAT
 | |
|   IF I < verslimit THEN
 | |
|     BEGIN 
 | |
|     I := I+1;
 | |
|     READ ( VERNO ); 
 | |
|     IF VERNO < 300 THEN 
 | |
|       VERLIST[I]:= VERNO 
 | |
|     ELSE
 | |
|       BEGIN 
 | |
|       I := I-1;
 | |
|       IF ( VERNO=1000 ) AND ( I=0 ) THEN
 | |
|         INCLUDEALL := TRUE;
 | |
|       GOTO 9
 | |
|       END;
 | |
|     END 
 | |
|   ELSE
 | |
|     GOTO 9
 | |
| UNTIL 1=0;
 | |
| 9: NOOFVER := I;
 | |
| INLFLAG := 0;
 | |
| INIFLAG := 0;
 | |
| FOR I := 1 TO 120 DO 
 | |
|   LINBUF[I]:= ' '; 
 | |
| FIRSTNONBLANK := 1(*0*);
 | |
| RESET ( INFILE ); 
 | |
| REWRITE ( output );
 | |
| REWRITE ( error );
 | |
| END;
 | |
| (*******************************************************) 
 | |
| 
 | |
| PROCEDURE SEARCHVER;
 | |
|   (* SEARCHES FOLLOWING VERSION IN THE TEXT 
 | |
|     WHEN FOUND CALLS PROC SCANLIST          *)
 | |
| 
 | |
|   LABEL 99; 
 | |
| 
 | |
|   VAR   CH    : CHAR;
 | |
|         I, II : INTEGER;
 | |
| 
 | |
|   PROCEDURE SCANLIST; 
 | |
|     FORWARD;
 | |
|   (****************************)
 | |
| 
 | |
|   PROCEDURE FINDEND ( VER : INTEGER ); 
 | |
|     (*  SEARCHES END OF THE VERSION GIVEN IN PARAMETER
 | |
|       IF ENCOUNTERS ANOTHER VERSION ENTRY IN THE MEANTIME 
 | |
|       CALLS PROC SCANLIST ( AND ITSELF INDIRECTLY )       *)
 | |
| 
 | |
|     LABEL 999, 888, 9999;
 | |
| 
 | |
|     VAR   II, FIXI, ABVER, CLSVER : INTEGER; 
 | |
|           OP                      : CHAR;
 | |
|   BEGIN 
 | |
|   FIXI := I; 
 | |
|   ABVER := ABS ( VER );
 | |
|   IF ABVER < 100 THEN 
 | |
|     OP := 'I'
 | |
|   ELSE
 | |
|     BEGIN 
 | |
|     IF ABVER < 200 THEN 
 | |
|       OP := 'S'
 | |
|     ELSE
 | |
|       OP := 'L'; 
 | |
|     VER := ( ABVER MOD 100 )*VER DIV ABVER;
 | |
|     END;
 | |
|   REPEAT
 | |
|     while EOLN ( INFILE ) (* END-OF-LINE ACTION *) 
 | |
|     do
 | |
|       BEGIN 
 | |
|       IF NOT ( OP='S' ) THEN
 | |
|         IF FIRSTNONBLANK <> 0 THEN
 | |
|           BEGIN 
 | |
|           FOR II := 1 TO I DO
 | |
|             WRITE ( output, LINBUF[II]); 
 | |
|           WRITELN ( output ) 
 | |
|           END 
 | |
|         ELSE (*NOTHING*)
 | |
|       ELSE
 | |
|         IF  (FIXI>=FIRSTNONBLANK) AND (FIRSTNONBLANK <> 0) THEN 
 | |
|           BEGIN 
 | |
|           FOR II := 1 TO FIXI-1 DO 
 | |
|             WRITE ( output, LINBUF[II]); 
 | |
|           WRITELN ( output ) 
 | |
|           END
 | |
|       ELSE writeln(output) (*to keep line nos in step*);
 | |
|       READLN ( INFILE );
 | |
|       IF EOF ( INFILE ) THEN
 | |
|         GOTO 888;
 | |
|       if (infile^ in ['0'..'9']) AND NOT INCLUDEALL then
 | |
|         for ii := 1 to 6 do get(infile); (*ignore line numbers*) 
 | |
|       I := 0;
 | |
|       fixi := 0;
 | |
|       FIRSTNONBLANK := 1(*0*) 
 | |
|       END;
 | |
|     READ ( INFILE, CH );
 | |
|     (* ACTION FOR EVERY CHARACTER *)
 | |
|     I := I+1;
 | |
|     LINBUF[I]:= CH;
 | |
|     IF ( FIRSTNONBLANK=0 ) THEN 
 | |
|       IF CH<>' ' THEN 
 | |
|         BEGIN 
 | |
|         FIRSTNONBLANK := I;
 | |
|         FIXI := I-1
 | |
|         END;
 | |
|     IF ( CH=')' ) AND ( I > 6 ) (* A VERSIN CLOSER ? *) 
 | |
|     THEN
 | |
|       IF LINBUF[I-6]='(' THEN 
 | |
|         IF LINBUF[I-5]=')' THEN 
 | |
|           IF ( LINBUF[I-1]='*' ) OR ( LINBUF[I-1]='+' ) THEN
 | |
|             IF ( LINBUF[I-2]IN['0'..'9']) AND ( LINBUF[I-3]IN['0'..'9']) AND ( LINBUF[I-4]IN['+', '-']) THEN
 | |
|               BEGIN 
 | |
|               CLSVER := ORD ( LINBUF[I-2])-ORD ( '0' )+( ORD ( LINBUF[I-3])-ORD ( '0' ) )*10;
 | |
|               IF LINBUF[I-4]='-' THEN 
 | |
|                 CLSVER :=-CLSVER;
 | |
|               IF ( VER=CLSVER ) OR INCLUDEALL THEN
 | |
|                 BEGIN 
 | |
|                 IF ( OP='I' ) OR INCLUDEALL THEN
 | |
|                   IF FIRSTNONBLANK=I-6 THEN 
 | |
|                     BEGIN 
 | |
|                     FOR II := I DOWNTO I-6 DO
 | |
|                       LINBUF[II]:= ' ';
 | |
|                     FIRSTNONBLANK := 1(*0*) 
 | |
|                     END 
 | |
|                   ELSE
 | |
|                     I := I-7;
 | |
|                 IF OP='S' THEN
 | |
|                   BEGIN 
 | |
|                   I := FIXI; 
 | |
|                   IF FIRSTNONBLANK >= FIXI THEN 
 | |
|                     FIRSTNONBLANK := 1(*0*) 
 | |
|                   END;
 | |
|                 GOTO 9999;
 | |
|                 END;
 | |
|               END;
 | |
|     IF OP='S' THEN
 | |
|       GOTO 999; 
 | |
|     IF ( CH=')' ) AND ( I > 6 ) (* A NEW VERSION ENTRY ? *) 
 | |
|     THEN
 | |
|       IF LINBUF[I-6]='(' THEN 
 | |
|         IF LINBUF[I-1]='(' THEN 
 | |
|           IF LINBUF[I-5]='*' THEN 
 | |
|             IF ( LINBUF[I-2]IN['0'..'9']) AND ( LINBUF[I-3]IN['0'..'9']) AND ( LINBUF[I-4]IN['+', '-']) THEN
 | |
|               SCANLIST; 
 | |
|     IF I>1 THEN 
 | |
|       IF LINBUF[I]=')' (* CORRECTIONS ON COMMENT CLOSERS
 | |
|          *) 
 | |
|       THEN
 | |
|       BEGIN 
 | |
|       IF ( INLFLAG > 0 ) AND ( LINBUF[I-1]='*' ) THEN 
 | |
|         LINBUF[I-1]:= '+'; 
 | |
|       IF ( INIFLAG > 0 ) AND ( INLFLAG=0 ) AND ( LINBUF[I-1]='+' ) THEN 
 | |
|         LINBUF[I-1]:= '*'; 
 | |
|       END;
 | |
| 999:
 | |
|   UNTIL EOF ( INFILE ); 
 | |
| 888:
 | |
|   WRITELN ( error, 'VERSION ', VER : 2, ' NOT CLOSED AT EOF.' );
 | |
| 9999:  
 | |
|   END;
 | |
|   (******************************)
 | |
| 
 | |
|   PROCEDURE SCANLIST; 
 | |
| 
 | |
|     VAR   II, III, VERSN, COMMAND, ABSVER : INTEGER; 
 | |
|   BEGIN 
 | |
|   (* COMPUTES VERSION NUMBER FROM TEXT *) 
 | |
|   VERSN := ORD ( LINBUF[I-2])-ORD ( '0' )+( ORD ( LINBUF[I-3])-ORD ( '0' ) )*10; 
 | |
|   IF LINBUF[I-4]='-' THEN 
 | |
|     VERSN :=-VERSN;
 | |
|   ABSVER := ABS ( VERSN ); 
 | |
|   COMMAND :=-ABS ( VERSN );
 | |
|   (* FINDS COMMAND RELATED TO CURRENT VERSION, IF ANY *)
 | |
|   FOR II := 1 TO NOOFVER DO
 | |
|     IF ( ABSVER=ABS ( VERLIST[II]) ) OR ( ABSVER=ABS ( VERLIST[II])-100 ) or (absver=abs(verlist[ii])-200) THEN
 | |
|       COMMAND := VERLIST[II];
 | |
|   IF ( COMMAND=VERSN ) OR ( ABS ( COMMAND+VERSN )=100 ) OR INCLUDEALL (*
 | |
|          CHECK & ACTION FOR 'INCLUDE' CONDITION 
 | |
|          *) 
 | |
|   THEN
 | |
|     BEGIN 
 | |
|     FOR III := I DOWNTO I-6 DO 
 | |
|       LINBUF[III]:= ' '; 
 | |
|     IF FIRSTNONBLANK=I-6 THEN 
 | |
|       FIRSTNONBLANK := 1(*0*) 
 | |
|     ELSE
 | |
|       I := I-7;
 | |
|     INIFLAG := INIFLAG+1;
 | |
|     FINDEND ( VERSN );
 | |
|     INIFLAG := INIFLAG-1;
 | |
|     END 
 | |
|   ELSE
 | |
|     IF COMMAND+VERSN=0 (* CHECK & ACTION FOR 'LEAVE ALONE 
 | |
|             ' CONDITION *)
 | |
|     THEN
 | |
|       BEGIN 
 | |
|       INLFLAG := INLFLAG+1;
 | |
|       FINDEND ( ( ABSVER+200 )*VERSN DIV ABSVER );
 | |
|       INLFLAG := INLFLAG-1;
 | |
|       END 
 | |
|     ELSE
 | |
|       BEGIN 
 | |
|       (* ACTION FOR 'SKIP' CONDITION *) 
 | |
|       I := I-7;
 | |
|       IF FIRSTNONBLANK=I-6 THEN 
 | |
|         FIRSTNONBLANK := 1(*0*);
 | |
|       FINDEND ( ( ABSVER+100 )*VERSN DIV ABSVER );
 | |
|       END;
 | |
|   END;
 | |
|   (*******************************) 
 | |
| BEGIN (* BODY OF SEARCHVER *) 
 | |
| if (infile^ in ['0'..'9']) AND NOT INCLUDEALL then
 | |
|   for ii := 1 to 6 do get(infile); (*ignore line numbers*)
 | |
| I := 0;
 | |
| REPEAT
 | |
|   while EOLN ( INFILE ) do
 | |
|     begin 
 | |
|     (* ACTION FOR EOLN S OUT OF ANY VERSION *)
 | |
|     IF FIRSTNONBLANK <> 0 THEN
 | |
|       BEGIN 
 | |
|       FOR II := 1 TO I DO
 | |
|         WRITE ( output, LINBUF[II]); 
 | |
|       WRITELN ( output );
 | |
|       READLN ( INFILE );
 | |
|       IF EOF ( INFILE ) THEN
 | |
|         GOTO 99;
 | |
|       FIRSTNONBLANK := 1(*0*);
 | |
|       END 
 | |
|     ELSE
 | |
|       BEGIN 
 | |
|       if eof(infile) then goto 99;
 | |
|       READLN ( INFILE );
 | |
|       IF EOF ( INFILE ) THEN
 | |
|         GOTO 99 
 | |
|       END;
 | |
|     if (infile^ in ['0'..'9']) AND NOT INCLUDEALL then
 | |
|       for ii := 1 to 6 do get(infile); (*ignore line numbers*)
 | |
|     I := 0;
 | |
|     end;
 | |
|   READ ( INFILE, CH );
 | |
|   I := I+1;
 | |
|   LINBUF[I]:= CH;
 | |
|   IF FIRSTNONBLANK=0 THEN 
 | |
|     IF CH<>' ' THEN 
 | |
|       FIRSTNONBLANK := I;
 | |
|   IF ( CH=')' ) AND ( I > 5 ) (* A VERSION ENTRY ? *) 
 | |
|   THEN
 | |
|     IF LINBUF[I-1]='(' THEN 
 | |
|       IF LINBUF[I-5]='*' THEN 
 | |
|         IF LINBUF[I-6]='(' THEN 
 | |
|           IF ( LINBUF[I-2]IN['0'..'9']) AND ( LINBUF[I-3]IN['0'..'9']) AND ( LINBUF[I-4]IN['+', '-']) THEN
 | |
|             SCANLIST; 
 | |
| UNTIL EOF ( INFILE );
 | |
| 99:
 | |
| END;
 | |
| (***************************************************************) 
 | |
| 
 | |
| BEGIN 
 | |
| INITIALISE ( NOOFVER ); 
 | |
| SEARCHVER;
 | |
| END.
 |