perm filename SELECT.SIM[SIM,SYS] blob sn#460222 filedate 1979-07-20 generic text, type T, neo UTF8
OPTIONS(/l);
COMMENT  SELECT --- Boolean search conditions on text files;
OPTIONS(/-A/-D/-Q/-I);
OPTIONS(/L/P/E);
EXTERNAL TEXT PROCEDURE rest, upcase;
EXTERNAL TEXT PROCEDURE scanto, from, conc;
EXTERNAL CHARACTER PROCEDURE findtrigger;
EXTERNAL BOOLEAN PROCEDURE frontcompare, puttext;
EXTERNAL INTEGER PROCEDURE scanint, search;
CLASS select;
NOT HIDDEN PROTECTED line, linecopy←buffer, operator,
set←operator←characters,
build←condition, tree←print, line←scan, array←scan,
select←errmess;
BEGIN
  CHARACTER char0, and←char, or←char, not←char;
  CHARACTER left←parenthesis, right←parenthesis;
  TEXT op←chars, select←errmess, linecopy←buffer, line;
  TEXT ARRAY line←array[1:10]; INTEGER la←index, la←max;
  BOOLEAN array←search;

  PROCEDURE set←operator←characters(t);
  VALUE t; TEXT t;
  BEGIN
    op←chars:- t;
    and←char:= t.getchar;
    or←char:= t.getchar;
    not←char:= t.getchar;
    left←parenthesis:= t.getchar;
    right←parenthesis:= t.getchar;
  END;


  CLASS operator(word);
  VALUE word; TEXT word;
  BEGIN
    BOOLEAN found, caseshift;
    loop:
    detach; INNER;
    GOTO loop;
  END;


  operator CLASS search←operator;
  BEGIN
    IF array←search THEN
    BEGIN
      found:= FALSE;
      FOR la←index:= 1 STEP 1 UNTIL la←max DO
      BEGIN
        line:- line←array[la←index]; line.setpos(1);
        IF search(line,word) <
        line.length THEN GOTO good;
      END;
      IF FALSE THEN good: found:= TRUE;
    END ELSE
    BEGIN
      line.setpos(1);
      found:= search(line,word) < line.length;
    END;
  END;


  operator CLASS and←operator(left, right);
  REF (operator) left, right;
  BEGIN
    call(left);
    IF left.found THEN
    BEGIN call(right);
      found:= right.found;
    END ELSE found:= FALSE;
  END;


  operator CLASS or←operator(left, right);
  REF (operator) left, right;
  BEGIN
    call(left);
    IF left.found THEN found:= TRUE ELSE
    BEGIN call(right);
      found:= right.found;
    END;
  END;


  operator CLASS not←operator(below);
  REF (operator) below;
  BEGIN
    call(below); found:= NOT below.found;
  END;


  BOOLEAN PROCEDURE build←condition(selection←tree,selector,
  caseshift);
  NAME selection←tree; VALUE selector;
  REF (operator) selection←tree; TEXT selector;
  BOOLEAN caseshift;
  BEGIN
    REF (operator) largest←tree;

    REF (operator) PROCEDURE interpret(selector,restrictor);
    TEXT selector; INTEGER restrictor;
    BEGIN
      REF (operator) result, below, left, right;
      CHARACTER firstchar;
      IF selector = NOTEXT THEN GOTO out;
      selector.setpos(1);
      firstchar:= selector.getchar;

      IF restrictor < 1 THEN
      BEGIN
        selector.setpos(1);
        scanto(selector,or←char); WHILE selector.more DO
        BEGIN
          left:- interpret(selector.sub(1,selector.pos-2),1);
          IF left =/= NONE THEN
          BEGIN
            right:- interpret(selector.sub(selector.pos,
            selector.length-selector.pos+1),0);
            IF right =/= NONE THEN
            BEGIN result:- NEW or←operator(selector,left,
            right); GOTO out;
            END;
          END;
          scanto(selector,or←char);
        END;
      END of or operator interpretation;

      IF restrictor < 2 THEN
      BEGIN
        selector.setpos(1);
        scanto(selector,and←char); WHILE selector.more DO
        BEGIN
          left:- interpret(selector.sub(1,selector.pos-2),2);
          IF left =/= NONE THEN
          BEGIN
            right:- interpret(selector.sub(selector.pos,
            selector.length-selector.pos+1),0);
            IF right =/= NONE THEN
            BEGIN result:- NEW and←operator(selector,left,
            right); GOTO out;
            END;
          END;
          scanto(selector,and←char);
        END;
      END of and operator interpretation;

      IF firstchar = left←parenthesis THEN
      BEGIN
        selector.setpos(selector.length);
        IF selector.getchar = right←parenthesis THEN
        BEGIN result:- interpret(selector.sub(2,
        selector.length-2),0);
          GOTO out;
        END;
      END;

      IF firstchar = not←char THEN
      BEGIN
        below:- interpret(selector.sub(2,selector.length-1),
        0);
        IF below =/= NONE THEN result:- NEW
        not←operator(selector,below);
        GOTO out;
      END;

      selector.setpos(1);
      IF findtrigger(selector,op←chars) = char0 THEN
      result:- NEW search←operator(selector);
      out: interpret:- result;
      IF (IF result == NONE THEN FALSE
      ELSE IF largest←tree == NONE THEN TRUE
      ELSE result.word.length >= largest←tree.word.length)
      THEN largest←tree:- result;
    END;

    IF caseshift THEN upcase(selector);
    selection←tree:- interpret(selector,0);
    IF selection←tree == NONE AND selector =/= NOTEXT
    THEN select←errmess:- conc(
    "?SELECT - Syntax error",
    IF largest←tree =/= NONE THEN conc(" after: ",
    largest←tree.word) ELSE NOTEXT)
    ELSE build←condition:= TRUE;
    IF selection←tree == NONE THEN selection←tree:-
    largest←tree;
    IF selection←tree =/= NONE AND caseshift THEN
    selection←tree.caseshift:= TRUE;
  END of procedure build←condition;


  PROCEDURE tree←print(top);
  REF (operator) top;
  INSPECT top WHEN search←operator DO outtext(word)
  WHEN not←operator DO
  BEGIN outchar(left←parenthesis); outchar(not←char);
    tree←print(below); outchar(right←parenthesis);
  END WHEN and←operator DO
  BEGIN outchar(left←parenthesis); tree←print(left);
  outchar(and←char);
    tree←print(right);
    outchar(right←parenthesis);
  END WHEN or←operator DO
  BEGIN outchar(left←parenthesis); tree←print(left);
  outchar(or←char);
    tree←print(right);
    outchar(right←parenthesis);
  END;
  BOOLEAN PROCEDURE line←scan(selection←tree,inline);
  REF (operator) selection←tree; TEXT inline;
  BEGIN
    IF selection←tree == NONE THEN GOTO yes;
    IF inline =/= NOTEXT THEN
    BEGIN
      IF selection←tree.caseshift THEN
      BEGIN
        IF inline.length > linecopy←buffer.length THEN
        linecopy←buffer:- blanks(inline.length+15);
        line:- linecopy←buffer.sub(1,inline.length);
        line:= inline;
        upcase(line);
      END ELSE line:- inline;
      array←search:= FALSE;
      call(selection←tree);
      IF selection←tree.found THEN GOTO yes;
    END;
    IF FALSE THEN yes: line←scan:= TRUE;
  END;
  BOOLEAN PROCEDURE array←scan(selection←tree,lines,i1,i2);
  REF (operator) selection←tree; TEXT ARRAY lines;
  INTEGER i1, i2;
  BEGIN
    INTEGER i, totallength;
    IF selection←tree == NONE THEN GOTO yes;
    FOR i:= i1 STEP 1 UNTIL i2 DO
    totallength:= totallength+lines(i).length;
    IF totallength > 0 THEN
    BEGIN
      array←search:= NOT (selection←tree.caseshift OR i2-i1 >
      9);
      IF array←search THEN
      BEGIN
        la←max:= 0;
        FOR i:= i1 STEP 1 UNTIL i2 DO
        IF lines[i] =/= NOTEXT THEN
        BEGIN
          la←max:= la←max+1; line←array[la←max]:- lines[i];
        END;
      END ELSE
      BEGIN
        totallength:= totallength+i2-i1+1;
        IF totallength > linecopy←buffer.length THEN
        linecopy←buffer:- blanks(totallength+15*(i2-i1+1));
        line:- linecopy←buffer.sub(1,totallength);
        FOR i:= i1 STEP 1 UNTIL i2 DO
        BEGIN puttext(line,lines(i)); line.putchar(char0);
        END;
        IF selection←tree.caseshift THEN upcase(line);
      END;
      call(selection←tree);
      IF selection←tree.found THEN GOTO yes;
    END;
    IF FALSE THEN yes: array←scan:= TRUE;
  END;


  set←operator←characters("&+-()");
END of select class;