home *** CD-ROM | disk | FTP | other *** search
/ Usenet 1994 January / usenetsourcesnewsgroupsinfomagicjanuary1994.iso / sources / unix / volume3 / turbo_tools / part1 / fprims.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1986-11-30  |  6.1 KB  |  289 lines
  1. {fprims.pas}
  2.  
  3. {
  4.         Copyright (c) 1981
  5.         By:     Bell Telephone Laboratories, Inc. and
  6.                 Whitesmith's Ltd.,
  7.  
  8.         This software is derived from the book
  9.                 "Software Tools in Pascal", by
  10.                 Brian W. Kernighan and P. J. Plauger
  11.                 Addison-Wesley, 1981
  12.                 ISBN 0-201-10342-7
  13.  
  14.         Right is hereby granted to freely distribute or duplicate this
  15.         software, providing distribution or duplication is not for profit
  16.         or other commercial gain and that this copyright notice remains
  17.         intact.
  18. }
  19.  
  20. CONST
  21.   MAXPAT=MAXSTR;
  22.   CLOSIZE=1;
  23.   CLOSURE=STAR;
  24.   BOL=PERCENT;
  25.   EOL=DOLLAR;
  26.   ANY=QUESTION;
  27.   CCL=LBRACK;
  28.   CCLEND=RBRACK;
  29.   NEGATE=CARET;
  30.   NCCL=EXCLAM;
  31.   LITCHAR=67;
  32.  
  33. FUNCTION MAKEPAT (VAR ARG:XSTRING; START:INTEGER;
  34.   DELIM:CHARACTER; VAR PAT:XSTRING):INTEGER;FORWARD;
  35. FUNCTION AMATCH(VAR LIN:XSTRING;OFFSET:INTEGER;
  36.   VAR PAT:XSTRING; J:INTEGER):INTEGER;FORWARD;
  37. FUNCTION MATCH(VAR LIN,PAT:XSTRING):BOOLEAN;FORWARD;
  38. FUNCTION MAKEPAT;
  39. VAR
  40.   I,J,LASTJ,LJ:INTEGER;
  41.   DONE,JUNK:BOOLEAN;
  42.  
  43. FUNCTION GETCCL(VAR ARG:XSTRING; VAR I:INTEGER;
  44.   VAR PAT:XSTRING; VAR J:INTEGER):BOOLEAN;
  45. VAR
  46.   JSTART:INTEGER;
  47.   JUNK:BOOLEAN;
  48.  
  49. PROCEDURE DODASH(DELIM:CHARACTER; VAR SRC:XSTRING;
  50.   VAR I:INTEGER; VAR DEST:XSTRING;
  51.   VAR J:INTEGER; MAXSET:INTEGER);
  52. CONST ESCAPE=ATSIGN;
  53. VAR K:INTEGER;
  54. JUNK:BOOLEAN;
  55.  
  56. FUNCTION ESC(VAR S:XSTRING; VAR I:INTEGER):CHARACTER;
  57. BEGIN
  58.   IF(S[I]<>ESCAPE) THEN
  59.     ESC:=S[I]
  60.   ELSE IF (S[I+1]=ENDSTR) THEN
  61.     ESC:=ESCAPE
  62.   ELSE BEGIN
  63.     I:=I+1;
  64.     IF (S[I]=ORD('N')) THEN
  65.       ESC:=NEWLINE
  66.     ELSE IF (S[I]=ORD('T')) THEN
  67.       ESC:=TAB
  68.     ELSE
  69.       ESC:=S[I]
  70.     END
  71. END;
  72.  
  73. BEGIN
  74.   WHILE(SRC[I]<>DELIM) AND (SRC[I]<>ENDSTR) DO BEGIN
  75.     IF(SRC[I]=ESCAPE)THEN
  76.       JUNK:=ADDSTR(ESC(SRC,I),DEST,J,MAXSET)
  77.     ELSE IF (SRC[I]<>DASH) THEN
  78.       JUNK:=ADDSTR(SRC[I],DEST,J,MAXSET)
  79.     ELSE IF (J<=1) OR (SRC[I+1]=ENDSTR) THEN
  80.       JUNK:=ADDSTR(DASH,DEST,J,MAXSET)
  81.     ELSE IF (ISALPHANUM(SRC[I-1]))
  82.       AND (ISALPHANUM(SRC[I+1]))
  83.       AND (SRC[I-1]<=SRC[I+1]) THEN BEGIN
  84.         FOR K:=SRC[I-1]+1 TO SRC[I+1] DO
  85.           JUNK:=ADDSTR(K,DEST,J,MAXSET);
  86.             I:=I+1
  87.     END
  88.     ELSE
  89.       JUNK:=ADDSTR(DASH,DEST,J,MAXSET);
  90.     I:=I+1
  91.   END
  92. END;
  93.  
  94. BEGIN
  95.   I:=I+1;
  96.   IF(ARG[I]=NEGATE) THEN BEGIN
  97.     JUNK:=ADDSTR(NCCL,PAT,J,MAXPAT);
  98.     I:=I+1
  99.   END
  100.   ELSE
  101.     JUNK:=ADDSTR(CCL,PAT,J,MAXPAT);
  102.   JSTART:=J;
  103.   JUNK:=ADDSTR(0,PAT,J,MAXPAT);
  104.   DODASH(CCLEND,ARG,I,PAT,J,MAXPAT);
  105.   PAT[JSTART]:=J-JSTART-1;
  106.   GETCCL:=(ARG[I]=CCLEND)
  107. END;
  108.  
  109. PROCEDURE STCLOSE(VAR PAT:XSTRING;VAR J:INTEGER;
  110.   LASTJ:INTEGER);
  111. VAR
  112.   JP,JT:INTEGER;
  113.   JUNK:BOOLEAN;
  114. BEGIN
  115.   FOR JP:=J-1 DOWNTO LASTJ DO BEGIN
  116.     JT:=JP+CLOSIZE;
  117.     JUNK:=ADDSTR(PAT[JP],PAT,JT,MAXPAT)
  118.   END;
  119.   J:=J+CLOSIZE;
  120.   PAT[LASTJ]:=CLOSURE
  121. END;
  122.  
  123. BEGIN
  124.   J:=1;
  125.   I:=START;
  126.   LASTJ:=1;
  127.   DONE:=FALSE;
  128.   WHILE(NOT DONE) AND (ARG[I]<>DELIM)
  129.     AND (ARG[I]<>ENDSTR) DO BEGIN
  130.       LJ:=J;
  131.       IF(ARG[I]=ANY) THEN
  132.         JUNK:=ADDSTR(ANY,PAT,J,MAXPAT)
  133.       ELSE IF (ARG[I]=BOL) AND (I=START) THEN
  134.         JUNK:=ADDSTR(BOL,PAT,J,MAXPAT)
  135.       ELSE IF (ARG[I]=EOL) AND (ARG[I+1]=DELIM) THEN
  136.         JUNK:=ADDSTR(EOL,PAT,J,MAXPAT)
  137.       ELSE IF (ARG[I]=CCL) THEN
  138.         DONE:=(GETCCL(ARG,I,PAT,J)=FALSE)
  139.       ELSE IF (ARG[I]=CLOSURE) AND (I>START) THEN BEGIN
  140.         LJ:=LASTJ;
  141.         IF(PAT[LJ] IN [BOL,EOL,CLOSURE]) THEN
  142.           DONE:=TRUE
  143.         ELSE
  144.           STCLOSE(PAT,J,LASTJ)
  145.       END
  146.       ELSE BEGIN
  147.         JUNK:=ADDSTR(LITCHAR,PAT,J,MAXPAT);
  148.         JUNK:=ADDSTR(ESC(ARG,I),PAT,J,MAXPAT)
  149.       END;
  150.       LASTJ:=LJ;
  151.       IF(NOT DONE) THEN
  152.         I:=I+1
  153.     END;
  154.     IF(DONE) OR (ARG[I]<>DELIM) THEN
  155.       MAKEPAT:=0
  156.     ELSE IF (NOT ADDSTR(ENDSTR,PAT,J,MAXPAT)) THEN
  157.       MAKEPAT:=0
  158.     ELSE
  159.       MAKEPAT:=I
  160.   END;
  161.   
  162.  
  163. FUNCTION AMATCH;
  164.  
  165.  
  166. VAR I,K:INTEGER;
  167.    DONE:BOOLEAN;
  168.  
  169.  
  170. FUNCTION OMATCH(VAR LIN:XSTRING; VAR I:INTEGER;
  171.   VAR PAT:XSTRING; J:INTEGER):BOOLEAN;
  172. VAR
  173.   ADVANCE:-1..1;
  174.  
  175.  
  176. FUNCTION LOCATE (C:CHARACTER; VAR PAT: XSTRING;
  177.   OFFSET:INTEGER):BOOLEAN;
  178. VAR
  179.   I:INTEGER;
  180. BEGIN
  181.   LOCATE:=FALSE;
  182.   I:=OFFSET+PAT[OFFSET];
  183.   WHILE(I>OFFSET) DO
  184.     IF(C=PAT[I]) THEN BEGIN
  185.       LOCATE :=TRUE;
  186.       I:=OFFSET
  187.     END
  188.     ELSE
  189.       I:=I-1
  190. END;BEGIN
  191.   ADVANCE:=-1;
  192.   IF(LIN[I]=ENDSTR) THEN
  193.     OMATCH:=FALSE
  194.   ELSE IF (NOT( PAT[J] IN
  195.    [LITCHAR,BOL,EOL,ANY,CCL,NCCL,CLOSURE])) THEN
  196.      ERROR('IN OMATCH:CAN''T HAPPEN')
  197.   ELSE
  198.     CASE PAT[J] OF
  199.     LITCHAR:
  200.       IF (LIN[I]=PAT[J+1]) THEN
  201.         ADVANCE:=1;
  202.     BOL:
  203.       IF (I=1) THEN
  204.         ADVANCE:=0;
  205.     ANY:
  206.       IF (LIN[I]<>NEWLINE) THEN
  207.         ADVANCE:=1;
  208.     EOL:
  209.       IF(LIN[I]=NEWLINE) THEN
  210.         ADVANCE:=0;
  211.     CCL:
  212.       IF(LOCATE(LIN[I],PAT,J+1)) THEN
  213.         ADVANCE:=1;
  214.     NCCL:
  215.       IF(LIN[I]<>NEWLINE)
  216.         AND (NOT LOCATE (LIN[I],PAT,J+1)) THEN
  217.           ADVANCE:=1
  218.         END;
  219.     IF(ADVANCE>=0) THEN BEGIN
  220.       I:=I+ADVANCE;
  221.       OMATCH:=TRUE
  222.     END
  223.     ELSE
  224.       OMATCH:=FALSE
  225.   END;
  226.   
  227. FUNCTION PATSIZE(VAR PAT:XSTRING;N:INTEGER):INTEGER;
  228. BEGIN
  229.   IF(NOT (PAT[N] IN
  230.    [LITCHAR,BOL,EOL,ANY,CCL,NCCL,CLOSURE])) THEN
  231.     ERROR('IN PATSIZE:CAN''T HAPPEN')
  232.   ELSE
  233.     CASE PAT[N] OF
  234.       LITCHAR:PATSIZE:=2;
  235.       BOL,EOL,ANY:PATSIZE:=1;
  236.       CCL,NCCL:PATSIZE:=PAT[N+1]+2;
  237.       CLOSURE:PATSIZE:=CLOSIZE
  238.     END
  239. END;
  240.  
  241. BEGIN
  242.   DONE:=FALSE;
  243.   WHILE(NOT DONE) AND (PAT[J]<>ENDSTR) DO
  244.     IF(PAT[J]=CLOSURE) THEN BEGIN
  245.       J:=J+PATSIZE(PAT,J);
  246.       I:=OFFSET;
  247.       WHILE(NOT DONE) AND (LIN[I]<>ENDSTR) DO
  248.         IF (NOT OMATCH(LIN,I,PAT,J)) THEN
  249.           DONE:=TRUE;
  250.       DONE:=FALSE;
  251.       WHILE (NOT DONE) AND (I>=OFFSET) DO BEGIN
  252.         K:=AMATCH(LIN,I,PAT,J+PATSIZE(PAT,J));
  253.         IF(K>0) THEN
  254.           DONE:=TRUE
  255.         ELSE
  256.           I:=I-1
  257.       END;
  258.       OFFSET:=K;
  259.       DONE:=TRUE
  260.     END
  261.     ELSE IF (NOT OMATCH(LIN,OFFSET,PAT,J))
  262.       THEN BEGIN
  263.       OFFSET :=0;
  264.       DONE:=TRUE
  265.     END
  266.     ELSE
  267.       J:=J+PATSIZE(PAT,J);
  268.   AMATCH:=OFFSET
  269. END;
  270. FUNCTION MATCH;
  271.  
  272. VAR
  273.   I,POS:INTEGER;
  274.  
  275.   
  276.                                                                                
  277. BEGIN
  278.   POS:=0;
  279.   I:=1;
  280.   WHILE(LIN[I]<>ENDSTR) AND (POS=0) DO BEGIN
  281.     POS:=AMATCH(LIN,I,PAT,1);
  282.     I:=I+1
  283.   END;
  284.   MATCH:=(POS>0)
  285. END;
  286.  
  287.  
  288.  
  289.