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;