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