home *** CD-ROM | disk | FTP | other *** search
/ CP/M / CPM_CDROM.iso / cpm / cpm86 / trbtol86.lbr / CHAPTER5.PQS / CHAPTER5.PAS
Pascal/Delphi Source File  |  1985-10-23  |  9KB  |  411 lines

  1.  
  2. {
  3.         Copyright (c) 1981
  4.         By:     Bell Telephone Laboratories, Inc. and
  5.                 Whitesmith's Ltd.,
  6.  
  7.         This software is derived from the book
  8.                 "Software Tools in Pascal", by
  9.                 Brian W. Kernighan and P. J. Plauger
  10.                 Addison-Wesley, 1981
  11.                 ISBN 0-201-10342-7
  12.  
  13.         Right is hereby granted to freely distribute or duplicate this
  14.         software, providing distribution or duplication is not for profit
  15.         or other commercial gain and that this copyright notice remains
  16.         intact.
  17. }
  18.  
  19. CONST
  20.   MAXPAT=MAXSTR;
  21.   CLOSIZE=1;
  22.   CLOSURE=STAR;
  23.   BOL=PERCENT;
  24.   EOL=DOLLAR;
  25.   ANY=QUESTION;
  26.   CCL=LBRACK;
  27.   CCLEND=RBRACK;
  28.   NEGATE=CARET;
  29.   NCCL=EXCLAM;
  30.   LITCHAR=67;
  31.  
  32. FUNCTION MAKEPAT (VAR ARG:XSTRING; START:INTEGER;
  33.   DELIM:CHARACTER; VAR PAT:XSTRING):INTEGER;FORWARD;
  34.   
  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.  
  39. FUNCTION MAKEPAT;
  40. VAR
  41.   I,J,LASTJ,LJ:INTEGER;
  42.   DONE,JUNK:BOOLEAN;
  43.  
  44. FUNCTION GETCCL(VAR ARG:XSTRING; VAR I:INTEGER;
  45.   VAR PAT:XSTRING; VAR J:INTEGER):BOOLEAN;
  46. VAR
  47.   JSTART:INTEGER;
  48.   JUNK:BOOLEAN;
  49.  
  50. PROCEDURE DODASH(DELIM:CHARACTER; VAR SRC:XSTRING;
  51.   VAR I:INTEGER; VAR DEST:XSTRING;
  52.   VAR J:INTEGER; MAXSET:INTEGER);
  53. CONST ESCAPE=ATSIGN;
  54. VAR K:INTEGER;
  55. JUNK:BOOLEAN;
  56.  
  57. FUNCTION ESC(VAR S:XSTRING; VAR I:INTEGER):CHARACTER;
  58. BEGIN
  59.   IF(S[I]<>ESCAPE) THEN
  60.     ESC:=S[I]
  61.   ELSE IF (S[I+1]=ENDSTR) THEN
  62.     ESC:=ESCAPE
  63.   ELSE BEGIN
  64.     I:=I+1;
  65.     IF (S[I]=ORD('N')) THEN
  66.       ESC:=NEWLINE
  67.     ELSE IF (S[I]=ORD('T')) THEN
  68.       ESC:=TAB
  69.     ELSE
  70.       ESC:=S[I]
  71.     END
  72. END;
  73.  
  74. BEGIN
  75.   WHILE(SRC[I]<>DELIM) AND (SRC[I]<>ENDSTR) DO BEGIN
  76.     IF(SRC[I]=ESCAPE)THEN
  77.       JUNK:=ADDSTR(ESC(SRC,I),DEST,J,MAXSET)
  78.     ELSE IF (SRC[I]<>DASH) THEN
  79.       JUNK:=ADDSTR(SRC[I],DEST,J,MAXSET)
  80.     ELSE IF (J<=1) OR (SRC[I+1]=ENDSTR) THEN
  81.       JUNK:=ADDSTR(DASH,DEST,J,MAXSET)
  82.     ELSE IF (ISALPHANUM(SRC[I-1]))
  83.       AND (ISALPHANUM(SRC[I+1]))
  84.       AND (SRC[I-1]<=SRC[I+1]) THEN BEGIN
  85.         FOR K:=SRC[I-1]+1 TO SRC[I+1] DO
  86.           JUNK:=ADDSTR(K,DEST,J,MAXSET);
  87.             I:=I+1
  88.     END
  89.     ELSE
  90.       JUNK:=ADDSTR(DASH,DEST,J,MAXSET);
  91.     I:=I+1
  92.   END
  93. END;
  94.  
  95. BEGIN
  96.   I:=I+1;
  97.   IF(ARG[I]=NEGATE) THEN BEGIN
  98.     JUNK:=ADDSTR(NCCL,PAT,J,MAXPAT);
  99.     I:=I+1
  100.   END
  101.   ELSE
  102.     JUNK:=ADDSTR(CCL,PAT,J,MAXPAT);
  103.   JSTART:=J;
  104.   JUNK:=ADDSTR(0,PAT,J,MAXPAT);
  105.   DODASH(CCLEND,ARG,I,PAT,J,MAXPAT);
  106.   PAT[JSTART]:=J-JSTART-1;
  107.   GETCCL:=(ARG[I]=CCLEND)
  108. END;
  109.  
  110. PROCEDURE STCLOSE(VAR PAT:XSTRING;VAR J:INTEGER;
  111.   LASTJ:INTEGER);
  112. VAR
  113.   JP,JT:INTEGER;
  114.   JUNK:BOOLEAN;
  115. BEGIN
  116.   FOR JP:=J-1 DOWNTO LASTJ DO BEGIN
  117.     JT:=JP+CLOSIZE;
  118.     JUNK:=ADDSTR(PAT[JP],PAT,JT,MAXPAT)
  119.   END;
  120.   J:=J+CLOSIZE;
  121.   PAT[LASTJ]:=CLOSURE
  122. END;
  123.  
  124. BEGIN
  125.   J:=1;
  126.   I:=START;
  127.   LASTJ:=1;
  128.   DONE:=FALSE;
  129.   WHILE(NOT DONE) AND (ARG[I]<>DELIM)
  130.     AND (ARG[I]<>ENDSTR) DO BEGIN
  131.       LJ:=J;
  132.       IF(ARG[I]=ANY) THEN
  133.         JUNK:=ADDSTR(ANY,PAT,J,MAXPAT)
  134.       ELSE IF (ARG[I]=BOL) AND (I=START) THEN
  135.         JUNK:=ADDSTR(BOL,PAT,J,MAXPAT)
  136.       ELSE IF (ARG[I]=EOL) AND (ARG[I+1]=DELIM) THEN
  137.         JUNK:=ADDSTR(EOL,PAT,J,MAXPAT)
  138.       ELSE IF (ARG[I]=CCL) THEN
  139.         DONE:=(GETCCL(ARG,I,PAT,J)=FALSE)
  140.       ELSE IF (ARG[I]=CLOSURE) AND (I>START) THEN BEGIN
  141.         LJ:=LASTJ;
  142.         IF(PAT[LJ] IN [BOL,EOL,CLOSURE]) THEN
  143.           DONE:=TRUE
  144.         ELSE
  145.           STCLOSE(PAT,J,LASTJ)
  146.       END
  147.       ELSE BEGIN
  148.         JUNK:=ADDSTR(LITCHAR,PAT,J,MAXPAT);
  149.         JUNK:=ADDSTR(ESC(ARG,I),PAT,J,MAXPAT)
  150.       END;
  151.       LASTJ:=LJ;
  152.       IF(NOT DONE) THEN
  153.         I:=I+1
  154.     END;
  155.     IF(DONE) OR (ARG[I]<>DELIM) THEN
  156.       MAKEPAT:=0
  157.     ELSE IF (NOT ADDSTR(ENDSTR,PAT,J,MAXPAT)) THEN
  158.       MAKEPAT:=0
  159.     ELSE
  160.       MAKEPAT:=I
  161.   END;
  162.   
  163.  
  164. FUNCTION AMATCH;
  165.  
  166.  
  167. VAR I,K:INTEGER;
  168.    DONE:BOOLEAN;
  169.  
  170.  
  171. FUNCTION OMATCH(VAR LIN:XSTRING; VAR I:INTEGER;
  172.   VAR PAT:XSTRING; J:INTEGER):BOOLEAN;
  173. VAR
  174.   ADVANCE:-1..1;
  175.  
  176.  
  177. FUNCTION LOCATE (C:CHARACTER; VAR PAT: XSTRING;
  178.   OFFSET:INTEGER):BOOLEAN;
  179. VAR
  180.   I:INTEGER;
  181. BEGIN
  182.   LOCATE:=FALSE;
  183.   I:=OFFSET+PAT[OFFSET];
  184.   WHILE(I>OFFSET) DO
  185.     IF(C=PAT[I]) THEN BEGIN
  186.       LOCATE :=TRUE;
  187.       I:=OFFSET
  188.     END
  189.     ELSE
  190.       I:=I-1
  191. END;BEGIN
  192.   ADVANCE:=-1;
  193.   IF(LIN[I]=ENDSTR) THEN
  194.     OMATCH:=FALSE
  195.   ELSE IF (NOT( PAT[J] IN
  196.    [LITCHAR,BOL,EOL,ANY,CCL,NCCL,CLOSURE])) THEN
  197.      ERROR('IN OMATCH:CAN''T HAPPEN')
  198.   ELSE
  199.     CASE PAT[J] OF
  200.     LITCHAR:
  201.       IF (LIN[I]=PAT[J+1]) THEN
  202.         ADVANCE:=1;
  203.     BOL:
  204.       IF (I=1) THEN
  205.         ADVANCE:=0;
  206.     ANY:
  207.       IF (LIN[I]<>NEWLINE) THEN
  208.         ADVANCE:=1;
  209.     EOL:
  210.       IF(LIN[I]=NEWLINE) THEN
  211.         ADVANCE:=0;
  212.     CCL:
  213.       IF(LOCATE(LIN[I],PAT,J+1)) THEN
  214.         ADVANCE:=1;
  215.     NCCL:
  216.       IF(LIN[I]<>NEWLINE)
  217.         AND (NOT LOCATE (LIN[I],PAT,J+1)) THEN
  218.           ADVANCE:=1
  219.         END;
  220.     IF(ADVANCE>=0) THEN BEGIN
  221.       I:=I+ADVANCE;
  222.       OMATCH:=TRUE
  223.     END
  224.     ELSE
  225.       OMATCH:=FALSE
  226.   END;
  227.   
  228. FUNCTION PATSIZE(VAR PAT:XSTRING;N:INTEGER):INTEGER;
  229. BEGIN
  230.   IF(NOT (PAT[N] IN
  231.    [LITCHAR,BOL,EOL,ANY,CCL,NCCL,CLOSURE])) THEN
  232.     ERROR('IN PATSIZE:CAN''T HAPPEN')
  233.   ELSE
  234.     CASE PAT[N] OF
  235.       LITCHAR:PATSIZE:=2;
  236.       BOL,EOL,ANY:PATSIZE:=1;
  237.       CCL,NCCL:PATSIZE:=PAT[N+1]+2;
  238.       CLOSURE:PATSIZE:=CLOSIZE
  239.     END
  240. END;
  241.  
  242. BEGIN
  243.   DONE:=FALSE;
  244.   WHILE(NOT DONE) AND (PAT[J]<>ENDSTR) DO
  245.     IF(PAT[J]=CLOSURE) THEN BEGIN
  246.       J:=J+PATSIZE(PAT,J);
  247.       I:=OFFSET;
  248.       WHILE(NOT DONE) AND (LIN[I]<>ENDSTR) DO
  249.         IF (NOT OMATCH(LIN,I,PAT,J)) THEN
  250.           DONE:=TRUE;
  251.       DONE:=FALSE;
  252.       WHILE (NOT DONE) AND (I>=OFFSET) DO BEGIN
  253.         K:=AMATCH(LIN,I,PAT,J+PATSIZE(PAT,J));
  254.         IF(K>0) THEN
  255.           DONE:=TRUE
  256.         ELSE
  257.           I:=I-1
  258.       END;
  259.       OFFSET:=K;
  260.       DONE:=TRUE
  261.     END
  262.     ELSE IF (NOT OMATCH(LIN,OFFSET,PAT,J))
  263.       THEN BEGIN
  264.       OFFSET :=0;
  265.       DONE:=TRUE
  266.     END
  267.     ELSE
  268.       J:=J+PATSIZE(PAT,J);
  269.   AMATCH:=OFFSET
  270. END;
  271. FUNCTION MATCH;
  272.  
  273. VAR
  274.   I,POS:INTEGER;
  275.  
  276.   
  277.                                                                                
  278. BEGIN
  279.   POS:=0;
  280.   I:=1;
  281.   WHILE(LIN[I]<>ENDSTR) AND (POS=0) DO BEGIN
  282.     POS:=AMATCH(LIN,I,PAT,1);
  283.     I:=I+1
  284.   END;
  285.   MATCH:=(POS>0)
  286. END;
  287.  
  288.  
  289.  
  290.  
  291. PROCEDURE FIND;
  292.   
  293. VAR
  294.   ARG,LIN,PAT:XSTRING;
  295.  
  296. FUNCTION GETPAT(VAR ARG,PAT:XSTRING):BOOLEAN;
  297.  
  298.   
  299.  
  300. BEGIN
  301.   GETPAT:=(MAKEPAT(ARG,1,ENDSTR,PAT)>0)
  302. END;
  303.  
  304.  
  305. BEGIN
  306.   IF(NOT GETARG(2,ARG,MAXSTR))THEN
  307.     ERROR('USAGE:FIND PATTERN');
  308.   IF (NOT GETPAT(ARG,PAT)) THEN
  309.     ERROR('FIND:ILLEGAL PATTERN');
  310.   WHILE(GETLINE(LIN,STDIN,MAXSTR))DO
  311.     IF (MATCH(LIN,PAT))THEN
  312.       PUTSTR(LIN,STDOUT)
  313. END;
  314.  
  315. PROCEDURE CHANGE;
  316. CONST
  317.   DITTO=255;
  318. VAR
  319.   LIN,PAT,SUB,ARG:XSTRING;
  320.  
  321. FUNCTION GETPAT(VAR ARG,PAT:XSTRING):BOOLEAN;
  322.  
  323.   
  324.  
  325. BEGIN
  326.   GETPAT:=(MAKEPAT(ARG,1,ENDSTR,PAT)>0)
  327. END;
  328. FUNCTION GETSUB(VAR ARG,SUB:XSTRING):BOOLEAN;
  329.  
  330. FUNCTION MAKESUB(VAR ARG:XSTRING; FROM:INTEGER;
  331.   DELIM:CHARACTER; VAR SUB:XSTRING):INTEGER;
  332. VAR I,J:INTEGER;
  333.    JUNK:BOOLEAN;
  334. BEGIN
  335.   J:=1;
  336.   I:=FROM;
  337.   WHILE (ARG[I]<>DELIM) AND (ARG[I]<>ENDSTR) DO BEGIN
  338.     IF(ARG[I]=ORD('&')) THEN
  339.       JUNK:=ADDSTR(DITTO,SUB,J,MAXPAT)
  340.     ELSE
  341.       JUNK:=ADDSTR(ESC(ARG,I),SUB,J,MAXPAT);
  342.     I:=I+1
  343.   END;
  344.   IF (ARG[I]<>DELIM) THEN
  345.     MAKESUB:=0
  346.   ELSE IF (NOT ADDSTR(ENDSTR,SUB,J,MAXPAT)) THEN
  347.     MAKESUB:=0
  348.   ELSE
  349.     MAKESUB:=I
  350. END;
  351.  
  352. BEGIN
  353.   GETSUB:=(MAKESUB(ARG,1,ENDSTR,SUB)>0)
  354. END;
  355.  
  356. PROCEDURE SUBLINE(VAR LIN,PAT,SUB:XSTRING);
  357. VAR
  358.   I, LASTM, M:INTEGER;
  359.   JUNK:BOOLEAN;
  360.  
  361.  
  362. PROCEDURE PUTSUB(VAR LIN:XSTRING; S1,S2:INTEGER;
  363.   VAR SUB:XSTRING);
  364. VAR
  365.   I,J:INTEGER;
  366.   JUNK:BOOLEAN;
  367. BEGIN
  368.   I:=1;
  369.   WHILE (SUB[I]<>ENDSTR) DO BEGIN
  370.     IF(SUB[I]=DITTO) THEN
  371.       FOR J:=S1 TO S2-1 DO
  372.         PUTC(LIN[J])
  373.       ELSE
  374.         PUTC(SUB[I]);
  375.       I:=I+1
  376.   END
  377. END;
  378.  
  379. BEGIN
  380.   LASTM:=0;
  381.   I:=1;
  382.   WHILE(LIN[I]<>ENDSTR) DO BEGIN
  383.     M:=AMATCH(LIN,I,PAT,1);
  384.     IF (M>0) AND (LASTM<>M) THEN BEGIN
  385.       PUTSUB(LIN,I,M,SUB);
  386.       LASTM:=M
  387.     END;
  388.     IF (M=0) OR (M=I) THEN BEGIN
  389.       PUTC(LIN[I]);
  390.       I:=I+1
  391.     END
  392.     ELSE
  393.       I:=M
  394.     END
  395. END;
  396.  
  397. BEGIN
  398.   IF(NOT GETARG(2,ARG,MAXSTR)) THEN
  399.     ERROR('USAGE:CHANGE FROM [TO]');
  400.   IF (NOT GETPAT(ARG,PAT)) THEN
  401.     ERROR('CHANGE:ILLEGAL "FROM" PATTERN');
  402.   IF (NOT GETARG(3,ARG,MAXSTR)) THEN
  403.     ARG[1]:=ENDSTR;
  404.   IF(NOT GETSUB(ARG,SUB)) THEN
  405.     ERROR('CHANGE:ILLEGAL "TO" STRING');
  406.   WHILE (GETLINE(LIN,STDIN,MAXSTR)) DO
  407.     SUBLINE(LIN,PAT,SUB)
  408. END;
  409.  
  410.  
  411.