{$M+}
{$E+}
PROGRAM Mock;

{$I i:\opus.i}
{$I i:\gctv.inc}

{$I i:\vdi_aes.def}
{$I i:\gemsubs.def}
{$I i:\auxsubs.def}
{$I d:\pascal\opus\graphout.def}

PROCEDURE REAL_TO_STRING ( real_num: REAL; VAR string_real: STRING;
                           digits: INTEGER; sci_not: BOOLEAN );
   EXTERNAL;
FUNCTION STRING_TO_REAL ( VAR string_real : STR30 ) : REAL;
   EXTERNAL;
PROCEDURE INT_TO_STRING ( a : INTEGER; VAR b : STR10 );
   EXTERNAL;

PROCEDURE HANDLE_MESSAGE;
   EXTERNAL;

PROCEDURE EVALUATE_FORMULA ( row,col  : INTEGER;
                             force,
                             new_form : BOOLEAN;
                             cell     : CellPtr );
   EXTERNAL;

FUNCTION REQUEST_MEMORY ( what : ReqType ) : BOOLEAN;
   FORWARD;
PROCEDURE INIT_CELL ( what : CellPtr; row,col : INTEGER );
   FORWARD;
FUNCTION LOCATE_CELL ( row,col : INTEGER ) : CellPtr;
   FORWARD;
FUNCTION NEW_CELL ( row,col : INTEGER ) : CellPtr;
   FORWARD;
PROCEDURE DELETE_CELL ( row,col    : INTEGER; 
                        total_kill : BOOLEAN  );
   FORWARD;
PROCEDURE FIND_SCREEN_POS (     row,col             : INTEGER;
                            VAR l_scr_row,l_scr_col : INTEGER );
   FORWARD;
PROCEDURE SAVE_ATTR;
   FORWARD;
PROCEDURE RETURN_ATTR;
   FORWARD;
PROCEDURE CELL_ON_SCREEN ( draw_or_toggle,row,col : INTEGER; force : BOOLEAN );
   FORWARD;
PROCEDURE STRING_A_CELL ( row,col : INTEGER; VAR temp : STR10 );
   FORWARD;
PROCEDURE OUT_MEM_CELL ( row,col : INTEGER; specific : STR10 );
   FORWARD;
FUNCTION REL_OVERFLOW ( row,col : INTEGER; VAR what : STR10 ) : INTEGER;
   FORWARD;
PROCEDURE FREE_DEP_LIST ( ptr : CellPtr );
   FORWARD;
FUNCTION LIST_END ( ptr : CellPtr ) : DepPtr;
   FORWARD;
FUNCTION DUPLICATING ( dep_row,dep_col : INTEGER; ptr : CellPtr ) : BOOLEAN;
   FORWARD;
PROCEDURE LIST_INSERT ( fx_row,fx_col,dep_row,dep_col : INTEGER );
   FORWARD;
PROCEDURE LIST_DELETE ( fx_row,fx_col,dep_row,dep_col : INTEGER );
   FORWARD;
PROCEDURE STRIP_NUM ( VAR num_str : LorFstr;
                      VAR str     : LorFstr;
                      VAR str_pos,
                          len     : INTEGER );
   FORWARD;
FUNCTION VALID_COL_NAME ( VAR temp       : STR10;
                          VAR col_number : INTEGER ) : BOOLEAN;
   FORWARD;
PROCEDURE GET_COL ( VAR str : LorFstr; VAR str_pos : INTEGER;
                        len : INTEGER; VAR col : INTEGER;
                    VAR col_rel : BOOLEAN; VAR status : StatusType );
   FORWARD;
PROCEDURE GET_ROW ( VAR str : LorFstr; VAR str_pos : INTEGER;
                        len : INTEGER; VAR row : INTEGER;
                    VAR row_rel : BOOLEAN; VAR status : StatusType );
   FORWARD;
FUNCTION TRANSLATE_CELL ( VAR str      : LorFstr;    { cell_str or formula  }
                          VAR str_pos  : INTEGER;    { position; 1 for cell }
                              len      : INTEGER;    { length of string     }
                          VAR row,col  : INTEGER;
                          VAR row_rel,               { relative reference?  }
                              col_rel  : BOOLEAN ) : StatusType;
   FORWARD;
FUNCTION SCAN_FOR_CELLS ( VAR str       : LorFstr; 
                          VAR str_pos   : INTEGER;
                              len       : INTEGER;
                          VAR cell_pos  : INTEGER;    
                          VAR row,col   : INTEGER;
                          VAR row_rel,
                              col_rel   : BOOLEAN   ) : BOOLEAN;
   FORWARD;
FUNCTION ADJUST_EXPR (  action             : INTEGER;  { add,remove, }
                        ptr                : CellPtr;  { adj_refs    }
                        src_row,src_col,
                        dest_row,dest_col,
                        row_st,col_st,
                        row_end,col_end    : INTEGER  ) : StatusType;
   FORWARD;
PROCEDURE ALL_LISTS ( action : INTEGER; ptr : CellPtr; row,col : INTEGER );
   FORWARD;
PROCEDURE DEFAULT_DRAW_ATTRIBUTES;
   FORWARD;
PROCEDURE REDRAW_MESSAGE ( hdl,x,y,w,h : INTEGER );
   FORWARD;
PROCEDURE Send_Redraw ( all_windows : BOOLEAN;
                        x,y,w,h     : INTEGER  );
   FORWARD;
PROCEDURE ADJUST_MENU ( enable : BOOLEAN );
   FORWARD;
FUNCTION FIND_PREC ( ptr : CellPtr ) : INTEGER;
   FORWARD;
FUNCTION FIND_JUST ( ptr : CellPtr ) : VDI_Just;
   FORWARD;
FUNCTION ASSIGNED ( row,col : INTEGER; VAR ptr : CellPtr ) : AssignedStatus;
   FORWARD;
FUNCTION VALID_NUMBER ( VAR num_str : LorFstr ) : StatusType;
   FORWARD;
PROCEDURE PREPARE_NUM ( ptr : CellPtr; VAR temp : STRING );
   FORWARD;
PROCEDURE MASK_OUT_RECALC;
   FORWARD;
FUNCTION ASSIGN ( VAR temp : LorFstr ) : CellPtr;
   FORWARD;
FUNCTION SIZE ( row,col : INTEGER ) : INTEGER;
   FORWARD;
FUNCTION COMP_ASSIGN ( src_row,src_col,dest_row,dest_col : INTEGER;
                       build                             : BOOLEAN ) : BOOLEAN;
   FORWARD;
PROCEDURE DELETE_RANGE ( s_row,s_col,f_row,f_col : INTEGER; draw : BOOLEAN );
   FORWARD;
PROCEDURE CLEAR_WORKSHEET;
   FORWARD;
PROCEDURE SIMULATE_MESSAGE ( msg_type,three,four : INTEGER );
   FORWARD;
PROCEDURE HOME_CURSOR ( extent : HomeType );
   FORWARD;
PROCEDURE MY_LINE_STYLE ( style : INTEGER );
   FORWARD;
PROCEDURE SWITCH_WINDOW;
   FORWARD;
PROCEDURE DEP_RECALC ( dep : DepPtr );
   FORWARD;
PROCEDURE CLEAR_BUFFER;
   FORWARD;
FUNCTION FIND_FIRST_AND_LAST ( virtual_or_actual : BOOLEAN ) : BOOLEAN;
   FORWARD;
PROCEDURE BLOCK_TOO_BIG ( col,row : STR10 );
   FORWARD;
PROCEDURE HIDE;
   FORWARD;
PROCEDURE UNHIDE ( menu : Tree_Index );
   FORWARD;

FUNCTION MOUSE_ROW_COL ( mouse_x,mouse_y     : INTEGER;
                         VAR new_row,new_col : INTEGER ) : BOOLEAN;
   { gives the data[x,y] positions of the cell encompassing the area
     containing the coordinates mouse,x,mouse_y; returns true if within a
     cell. passes back data[x,y] in new_row,new_col. Used by OPUS.PAS and
     window_input }
   VAR i,j           : INTEGER;
       row_ok,col_ok : BOOLEAN;  
   BEGIN
       row_ok := FALSE;
       col_ok := FALSE;
       j := y_1+y_margin;
       i := start_row;
       WHILE i <= finish_row DO BEGIN
          IF (mouse_y > j) AND
             (mouse_y < j+cell_height) THEN BEGIN
             new_row := i;
             row_ok := TRUE;
             i := finish_row
          END;
          j := j+cell_height;
          i := i+1
      END;
      j := 1;
      i := start_col;
      WHILE i <= finish_col DO BEGIN
         IF (mouse_x > vert_grid[j]+4) AND
            (mouse_x < vert_grid[j+1]-4) THEN BEGIN
            new_col := i;
            col_ok := TRUE;
            i := finish_col
         END;
         j := j+1;
         i := i+1
      END;
      IF (row_ok) AND (col_ok) THEN
         mouse_row_col := TRUE
      ELSE
         mouse_row_col := FALSE
   END; { MOUSE_ROW_COL }
   
(*************************************************)
(*  Functions to manipulate main data structure  *)
(*************************************************)

FUNCTION REQUEST_MEMORY;
   VAR resulting_free_mem : LONG_INTEGER;
   BEGIN
       IF what = ACell THEN
          resulting_free_mem := working_memory-cell_size
       ELSE
          resulting_free_mem := working_memory-str_size;
       IF resulting_free_mem < 0 THEN BEGIN
          alert := Do_Alert (
             '[1][Running out of memory.|Request denied...][  OK  ]',1 );
          request_memory := FALSE
       END
       ELSE BEGIN
          working_memory := resulting_free_mem;
          request_memory := TRUE
       END
   END; { REQUEST_MEMORY }

FUNCTION LOCATE_CELL;
   { searches for a cell in a given row; if it exists, returns the address,
     otherwise returns NIL }
   VAR found,passed : BOOLEAN;
       ptr          : CellPtr;
   BEGIN
       ptr := data[row];
       found := FALSE;
       passed := FALSE;
       WHILE (ptr <> NIL) AND (NOT found) AND (NOT passed) DO
          IF ptr^.c = col THEN
             found := TRUE
          ELSE IF ptr^.c > col THEN
             passed := TRUE
          ELSE
             ptr := ptr^.next;
       IF found THEN
          locate_cell := ptr
       ELSE
          locate_cell := NIL
   END; { LOCATE_CELL }

PROCEDURE INIT_CELL;
   { called by NEW_CELL; does NOT handle adjustment of pointers }
   BEGIN
       WITH what^ DO BEGIN
          c := col;
          class := Val;
          num := 0;
          format := default_format;
          status := Empty;
          str := NIL;
          sub := NIL;
          next := NIL
       END
   END; { INIT_CELL }

FUNCTION NEW_CELL;
   { creates a new cell or if the cell already exists, returns the address. If
     not enough mem, returns NIL }
   VAR found          : BOOLEAN;
       dumbo,temp,ptr : CellPtr;
   BEGIN
       ptr := locate_cell(row,col);
       IF ptr = NIL THEN
          IF request_memory(ACell) THEN BEGIN
             ptr := data[row];
             found := FALSE;
             IF ptr <> NIL THEN 
                IF ptr^.c > col THEN BEGIN
                   NEW(dumbo);
                   init_cell(dumbo,row,col);
                   data[row] := dumbo;
                   data[row]^.next := ptr;
                   new_cell := dumbo
                END
                ELSE BEGIN   
                   WHILE (ptr^.next <> NIL) AND (NOT found) DO
                      IF ptr^.next^.c > col THEN
                         found := TRUE
                      ELSE
                         ptr := ptr^.next;
                   temp := ptr^.next; { save cell addr to follow new one or NIL }
                   NEW(dumbo);
                   init_cell(dumbo,row,col);
                   ptr^.next := dumbo;
                   new_cell := dumbo;
                   ptr^.next^.next := temp
                END
             ELSE BEGIN
                NEW(data[row]);
                new_cell := data[row];
                init_cell(data[row],row,col)
             END
          END
          ELSE
             new_cell := NIL
       ELSE
          new_cell := ptr
   END; { NEW_CELL }

PROCEDURE DELETE_CELL;
   { removes a cell from the sheet; i.e. a list. However, if the cell has
     dependents, the cell won't be deallocated unless total_kil = TRUE or if
     it already has a NIL dep list }
   VAR i          : INTEGER;
       found      : BOOLEAN;
       dep        : DepPtr;
       ptr,temp   : CellPtr;
   BEGIN
       found := FALSE;
       ptr := locate_cell(row,col);
       IF ptr <> NIL THEN
          all_lists(remove,ptr,row,col);
       { now, all_lists may have removed a cell in front of and
         directly pointing to this cell; this can happen if in the
         cell to have its dep list modified, it turned out that 
         sub = NIL and status = Empty. Thus, ptr^.next no longer
         points to OUR cell, since "ptr" is no longer defined. So, do the 
         all_lists call first. }
       ptr := data[row];
       IF ptr <> NIL THEN BEGIN
          IF ptr^.c <> col THEN BEGIN
             WHILE (ptr^.next <> NIL) AND (NOT found) DO
                IF ptr^.next^.c = col THEN
                   found := TRUE
                ELSE
                   ptr := ptr^.next;
             { ptr^.next will represent the desired cell, if found, and
               of course will be non-NIL }
             IF found THEN BEGIN
                IF ptr^.next^.str <> NIL THEN BEGIN
                   DISPOSE(ptr^.next^.str);
                   ptr^.next^.str := NIL;
                   working_memory := working_memory+str_size
                END;
                IF total_kill THEN           { so only destroy dep list if }
                   free_dep_list(ptr^.next); { clearing wks }
                IF ptr^.next^.sub = NIL THEN BEGIN { no point in keeping the }
                   working_memory := working_memory+cell_size; { cell around }
                   temp := ptr^.next^.next;
                   DISPOSE(ptr^.next);
                   ptr^.next := temp
                END
                ELSE
                   ptr^.next^.status := Empty
             END { IF found }
          END { IF ptr^.c <> col }
          ELSE BEGIN { first cell in list }
             found := TRUE;
             IF ptr^.str <> NIL THEN BEGIN
                DISPOSE(ptr^.str);
                ptr^.str := NIL;
                working_memory := working_memory+str_size
             END;
             IF total_kill THEN
                free_dep_list(ptr);
             IF ptr^.sub = NIL THEN BEGIN
                working_memory := working_memory+cell_size;
                temp := ptr^.next;
                DISPOSE(ptr);
                data[row] := temp
             END
             ELSE
                ptr^.status := Empty
          END { ELSE from IF found }
       END
   END; { DELETE_CELL }
   
FUNCTION ASSIGNED;
   { if found, returns address in ptr or NIL }
   BEGIN
       ptr := locate_cell(row,col);
       IF ptr <> NIL THEN
          WITH ptr^ DO
             IF status = Empty THEN
                assigned := Desolate
             ELSE IF status <> Full THEN
                assigned := Error
             ELSE IF (class = Val) OR (class = Expr) THEN
                assigned := Value
             ELSE
                assigned := NonValue
       ELSE
          assigned := Void
   END; { ASSIGNED }
   
PROCEDURE MASK_OUT_RECALC;
   VAR i : INTEGER;
   BEGIN
       IF did_recalc THEN BEGIN
          FOR i := 1 TO n_rows DO BEGIN
              ptr := data[i];
              WHILE ptr <> NIL DO BEGIN
                 IF ptr^.class = Expr THEN
                    ptr^.format := ptr^.format & no_recalc_mask &
                                   not_pending_mask;
                 ptr := ptr^.next
              END
          END;    
          did_recalc := FALSE
       END
   END; { MASK_OUT_RECALC }

PROCEDURE DEP_RECALC;
   VAR ptr : CellPtr;
   BEGIN
       IF dep <> NIL THEN BEGIN
          did_recalc := TRUE;
          WHILE dep <> NIL DO BEGIN
             ptr := locate_cell(dep^.r,dep^.c);
             IF ptr <> NIL THEN
                IF (ptr^.class = Expr) AND
                   (ptr^.format & recalc_mask = 0) AND 
                   (ptr^.format & pending_mask = 0) THEN
                   evaluate_formula(dep^.r,dep^.c,FALSE,FALSE,ptr);
             dep := dep^.next
          END
       END
   END; { DEP_RECALC }

FUNCTION ASSIGN;
   VAR number          : REAL;
       changed,failed  : BOOLEAN;
       old_status      : StatusType;
       ptr             : CellPtr;
   PROCEDURE CAPITALIZE_AND_EAT_UP_SPACES ( VAR temp : LorFstr );
      VAR i : INTEGER;
      BEGIN
          i := 1;
          WHILE i <= LENGTH(temp) DO BEGIN
             IF temp[i] = ' ' THEN
                DELETE(temp,i,1)
             ELSE IF temp[i] IN low_case THEN BEGIN
                temp[i] := CHR(ORD(temp[i])-$20);
                i := i+1
             END
             ELSE
                i := i+1
          END
      END; { CAPITALIZE_AND_EAT_UP_SPACES }
   BEGIN
       Set_Mouse(M_Bee);
       changed := FALSE;
       ptr := locate_cell(data_row,data_col);
       all_lists(remove,ptr,data_row,data_col);
       ptr := new_cell(data_row,data_col);
       IF ptr <> NIL THEN
          WITH ptr^ DO BEGIN
             CASE class OF
                Val : BEGIN
                   old_status := status;
                   number := string_to_real(temp);
                   IF format & perc_mask <> 0 THEN
                      number := number/100;
                   IF temp = 'OVERFLOW' THEN
                      IF status <> Overflow THEN BEGIN
                         changed := TRUE;
                         status := Overflow
                      END
                      ELSE
                   ELSE BEGIN
                      status := Full;
                      IF ((num <> number) OR 
                          (old_status <> status)) THEN BEGIN
                         num := number;
                         changed := TRUE
                      END
                   END;
                   IF (auto_recalc) AND (changed) THEN
                      dep_recalc(sub)
                END; { Val }
                Labl : BEGIN
                   IF str = NIL THEN
                      IF request_memory(AString) THEN
                         NEW (str)
                      ELSE
                         status := GenError;
                    IF status <> GenError THEN BEGIN
                       str^ := temp;
                       status := Full
                    END
                END; { Labl }
                Expr : BEGIN
                   failed := FALSE;
                   IF str = NIL THEN
                      IF request_memory(AString) THEN 
                         NEW (str)
                      ELSE BEGIN
                         status := GenError;
                         failed := TRUE
                      END;   
                   IF NOT failed THEN BEGIN
                      capitalize_and_eat_up_spaces(temp);
                      IF ptr <> NIL THEN BEGIN
                         str^ := temp;
                         { evaluate_formula will recalc dependents if
                           appropriate }
                         REPEAT { user can edit errors in a dialog box }
                            mask_out_recalc; { in case we're doing again }
                            did_recalc := TRUE;
                            old_form := str^; { eval uses global temp }
                            evaluate_formula(data_row,data_col,FALSE,TRUE,ptr);
                            capitalize_and_eat_up_spaces(str^);
                         UNTIL (str^ = old_form) OR (str^ = '');
                         all_lists(add,ptr,data_row,data_col)
                      END   
                   END
                END { Expr }
             END (* CASE *)
          END; (* WITH *)
       Set_Mouse(M_Arrow);
       assign := ptr
   END; (* ASSIGN *)

FUNCTION SIZE;
   VAR cell_mem : INTEGER;
       dep      : DepPtr;
       ptr      : CellPtr;
   BEGIN
       cell_mem := 0;
       IF assigned(row,col,ptr) <> Void THEN BEGIN
          cell_mem := cell_size;
          WITH ptr^ DO BEGIN
             IF str <> NIL THEN
                cell_mem := cell_mem+str_size;
             dep := sub;
             WHILE dep <> NIL DO BEGIN
                 cell_mem := cell_mem+dep_size;
                 dep := dep^.next
             END
          END
       END;
       size := cell_mem
   END; { SIZE }

FUNCTION COMP_ASSIGN;
   { COMPrehensive ASSIGNment between two CELLs; builds dep lists of other
     cells if build is TRUE; note that the dest cell's dep lists will not
     be affected if it already exists }
   VAR src_ptr,dest_ptr : CellPtr;
       dep              : DepPtr;
   BEGIN
       comp_assign := TRUE;
       delete_cell(dest_row,dest_col,FALSE);
       IF assigned(src_row,src_col,src_ptr) <> Void THEN BEGIN
          dest_ptr := new_cell(dest_row,dest_col);
          IF dest_ptr <> NIL THEN BEGIN
             WITH src_ptr^ DO BEGIN
                dest_ptr^.class := class;
                dest_ptr^.num := num;
                dest_ptr^.status := status;
                dest_ptr^.format := format
             END;
             IF src_ptr^.str <> NIL THEN
                IF request_memory(AString) THEN BEGIN
                   NEW(dest_ptr^.str);
                   dest_ptr^.str^ := src_ptr^.str^;
                   IF build THEN
                      all_lists(add,dest_ptr,dest_row,dest_col)
                END
                ELSE BEGIN
                   comp_assign := FALSE;
                   dest_ptr^.status := GenError
                END
             ELSE
          END
          ELSE { not enough memory }
             comp_assign := FALSE
       END
   END; { COMP_ASSIGN }

(********************************************************)
(*  End of Functions to manipulate main data structure  *)
(********************************************************)


(************************************)
(* Dependent-cell list manipulation *)
(************************************)

PROCEDURE FREE_DEP_LIST;
   VAR temp : DepPtr;
   BEGIN
      IF ptr <> NIL THEN
         WHILE ptr^.sub <> NIL DO BEGIN
            temp := ptr^.sub^.next;
            DISPOSE(ptr^.sub);
            ptr^.sub := temp;
            working_memory := working_memory+dep_size
         END
   END; { FREE_DEP_LIST }

FUNCTION LIST_END;
   { returns a POINTER to the element at the end of the list; i.e. the
     element whose next points to the last one }
   VAR dep : DepPtr;
   BEGIN
       IF ptr <> NIL THEN BEGIN
          dep := ptr^.sub;
          IF dep <> NIL THEN
             WHILE dep^.next <> NIL DO
                dep := dep^.next;
          list_end := dep
       END
       ELSE
          list_end := NIL
   END; { LIST_END }

FUNCTION DUPLICATING;
   { traverses a cell's dependency list and locates any pre-existing entries }
   { for the cell to be added to the list, i.e. prevents duplicates }
   VAR
       found : BOOLEAN;
       dep   : DepPtr;
   BEGIN
       found := FALSE;
       dep := ptr^.sub;
       WHILE (dep <> NIL) AND (NOT found) DO
          IF (dep^.r = dep_row) AND (dep^.c = dep_col) THEN
             found := TRUE
          ELSE
             dep := dep^.next;
       duplicating := found
   END; { DUPLICATING }

PROCEDURE LIST_INSERT;
   { inserts an element at the end of the list for the cell fx_row,fx_col;
     'fx' = 'affects' a dependent cell dep_row,dep_col }
   VAR dep            : DepPtr;
       fx_ptr,dep_ptr : CellPtr;
   BEGIN
       fx_ptr := new_cell(fx_row,fx_col);
       dep_ptr := locate_cell(dep_row,dep_col);
       IF (fx_ptr <> NIL) AND (dep_ptr <> NIL) THEN
          IF NOT duplicating(dep_row,dep_col,fx_ptr) THEN
             IF working_memory-dep_size > 0 THEN BEGIN
                IF fx_ptr^.sub = NIL THEN BEGIN
                   NEW(fx_ptr^.sub);
                   fx_ptr^.sub^.next := NIL
                END
                ELSE BEGIN
                   dep := list_end(fx_ptr);
                   NEW(dep^.next);
                   dep^.next^.next := NIL
                END;
                dep := list_end(fx_ptr);
                dep^.r := dep_row;
                dep^.c := dep_col;
                working_memory := working_memory-dep_size
             END
             ELSE
                alert := Do_Alert (
                   '[1][Running out of memory.|Request denied...][  OK  ]',1)
   END; { LIST_INSERT }

PROCEDURE LIST_DELETE;
   VAR found    : BOOLEAN;
       dep,temp : DepPtr;
       ptr      : CellPtr;
   BEGIN
       ptr := locate_cell(fx_row,fx_col);
       IF ptr <> NIL THEN BEGIN
          dep := ptr^.sub;
          IF dep <> NIL THEN
             IF (dep^.r <> dep_row) OR (dep^.c <> dep_col) THEN BEGIN
                found := FALSE;
                WHILE (NOT found) AND (dep^.next <> NIL) DO
                   IF (dep^.next^.r = dep_row) AND
                      (dep^.next^.c = dep_col) THEN
                      found := TRUE
                   ELSE
                      dep := dep^.next;
                IF found THEN BEGIN
                   temp := dep^.next^.next;
                   DISPOSE(dep^.next);
                   dep^.next := temp;
                   working_memory := working_memory+dep_size
                END
             END
             ELSE BEGIN { was first element in list }
                temp := dep^.next;
                DISPOSE(dep);
                ptr^.sub := temp;
                working_memory := working_memory+dep_size
             END
       END
   END; { LIST_DELETE }

PROCEDURE ALL_LISTS;
   { adds/removes all references to this cell to/from the dependency 
     lists of each cell that should/already has an entry for it. Action
     equals: 'add', 'remove' }
   VAR dummy  : INTEGER;
       result : StatusType;
   BEGIN
       IF ptr <> NIL THEN
          IF ptr^.class = Expr THEN
             IF ptr^.str <> NIL THEN 
                result := adjust_expr(action,ptr,
                                      row,col,
                                      dummy,dummy,dummy,dummy,dummy,dummy)
   END; { ALL_LISTS }

(*******************************************)
(* End of Dependent-cell list manipulation *)
(*******************************************)


(************************)
(* Screen-related stuff *)
(************************)

PROCEDURE FIND_SCREEN_POS;
   { takes sheet pos in row,col and returns screen pos;
     called by MOUSE,draw_cell,display_data,reset_window }
   VAR i : INTEGER;
   BEGIN
       l_scr_row := 1;
       l_scr_col := 1;
       i := start_row;
       REPEAT
           IF i < row THEN
              l_scr_row := l_scr_row+1;
           i := i+1
       UNTIL i >= row;
       i := start_col;
       REPEAT
           IF i < col THEN
              l_scr_col := l_scr_col+1;
           i := i+1
       UNTIL i >= col
   END; { FIND_SCREEN_POS }

PROCEDURE SAVE_ATTR;
   BEGIN
       w_pos[w_idx,w_hdl] := act_hdl;
       w_pos[w_idx,first_row] := start_row;
       w_pos[w_idx,last_row] := finish_row;
       w_pos[w_idx,first_col] := start_col;
       w_pos[w_idx,last_col] := finish_col;
       w_pos[w_idx,hot_row] := data_row;
       w_pos[w_idx,hot_col] := data_col;
       w_vert_grid[w_idx] := vert_grid
   END; { SAVE_ATTR }

PROCEDURE RETURN_ATTR;
   BEGIN
       act_hdl := w_pos[w_idx,w_hdl];
       start_row := w_pos[w_idx,first_row];
       finish_row := w_pos[w_idx,last_row];
       start_col := w_pos[w_idx,first_col];
       finish_col := w_pos[w_idx,last_col];
       data_row := w_pos[w_idx,hot_row];
       data_col := w_pos[w_idx,hot_col];
       vert_grid := w_vert_grid[w_idx];
       h_entry := finish_col-start_col+1;
       v_entry := finish_row-start_row+1;
       IF finish_col < n_cols THEN BEGIN
          virtual_f_col := finish_col+1;
          virtual_h_entry := h_entry+1
       END
       ELSE BEGIN
          virtual_f_col := finish_col;
          virtual_h_entry := h_entry
       END;
       IF finish_row < n_rows THEN BEGIN
          virtual_f_row := finish_row+1;
          virtual_v_entry := v_entry+1
       END
       ELSE BEGIN
          virtual_f_row := finish_row;
          virtual_v_entry := v_entry
       END;
       find_screen_pos(data_row,data_col,scr_row,scr_col)
   END; { RETURN_ATTR }

PROCEDURE SWITCH_WINDOW;
   BEGIN
       save_attr;
       w_idx := ABS(w_idx-3);
       return_attr
   END; { SWITCH_WINDOW }    

PROCEDURE CELL_ON_SCREEN;
   { update a cell; if two windows are open and cell is visible in both, it
     will be updated in both. }
   VAR a1,a2,b1,b2,c1,c2,d1,d2 : INTEGER;
   BEGIN
       IF n_hdls = 2 THEN BEGIN
          Border_Rect(w_pos[1,w_hdl],a1,b1,c1,d1);
          Border_Rect(w_pos[2,w_hdl],a2,b2,c2,d2);
          IF NOT Rect_Intersect( a1,b1,c1,d1,a2,b2,c2,d2) THEN BEGIN
             switch_window;
             IF (row >= start_row) AND (row <= virtual_f_row) AND
                (col >= start_col) AND (col <= virtual_f_col) THEN BEGIN
                Hide_Mouse;
                IF draw_or_toggle = 1 THEN { completely draw the cell;        }
                   draw_cell(row,col,TRUE) { avoid draw_cell inversing it     }
                ELSE BEGIN                 { as it would if FALSE was passed. }
                   Work_Rect(act_hdl,x_1,y_1,w_1,h_1); { since toggle does }
                   Set_Clip(x_1,y_1,w_1,h_1);          { NOT affect clip   }
                   toggle_inverse(Black,row,col)
                END;
                Show_Mouse
             END;
             switch_window;
             Work_Rect(act_hdl,x_1,y_1,w_1,h_1); { just in case toggle was }
             Set_Clip(x_1,y_1,w_1,h_1)           { used; antibug... }
          END
          ELSE BEGIN    { completely redraw the portion(s) of the inactive }
                        { window using the GEM message queue to make sure  }
             switch_window; { we get the proper clip values        }
             IF (row >= start_row) AND (row <= virtual_f_row) AND
                (col >= start_col) AND (col <= virtual_f_col) THEN BEGIN
                First_Rect(act_hdl,a1,b1,c1,d1);
                WHILE (c1 <> 0) AND (d1 <> 0) DO BEGIN
                   Send_Redraw(FALSE,a1,b1,c1,d1);
                   Next_Rect(act_hdl,a1,b1,c1,d1)
                END
             END;
             switch_window
          END
       END;
       { now do active window }
       IF (row >= start_row) AND (row <= virtual_f_row) AND
          (col >= start_col) AND (col <= virtual_f_col) THEN BEGIN
          Hide_Mouse;
          IF draw_or_toggle = 1 THEN
             draw_cell(row,col,force)
          ELSE
             toggle_inverse(Black,row,col);
          Show_Mouse
       END
   END; { CELL_ON_SCREEN }

PROCEDURE DEFAULT_DRAW_ATTRIBUTES;
   BEGIN
      Paint_Style(Solid);
      Paint_Outline(FALSE);
      Paint_Color(White);
      Text_Color(Black);
      Draw_Mode(Replace_Mode);
      Text_Style(Normal)
   END; { DEFAULT_DRAW_ATTRIBUTES }
   
PROCEDURE REDRAW_MESSAGE;
   VAR
       other_window : BOOLEAN;
   BEGIN
       default_draw_attributes;
       First_Rect(hdl,redraw_x,redraw_y,redraw_w,redraw_h);
       WHILE (redraw_w <> 0) AND (redraw_h <> 0) DO BEGIN
          IF Rect_Intersect(x,y,w,h,
                            redraw_x,redraw_y,
                            redraw_w,redraw_h) THEN BEGIN
             other_window := FALSE;
             IF hdl <> act_hdl THEN BEGIN
                switch_window;
                other_window := TRUE
             END;
             redraw_flag := TRUE; { confine sheet_redraw clip rect }
             { draw whole sheet, but within bounds of redraw_x, etc.}
             sheet_redraw(WholeSheet,FALSE,None); { it saves attr }
             IF other_window THEN 
                switch_window
          END;
          Next_Rect(hdl,redraw_x,redraw_y,redraw_w,redraw_h)
       END
   END; { REDRAW_MESSAGE }

PROCEDURE Send_Redraw;
   { write a redraw message to the event queue after displaying fsel so
     that after LOAD, we can redraw the entire screen, instead of first
     redrawing the area covered by the fsel then doing a full redraw of the
     screen. The AES merges the two messages into one. Also, used to send
     the message to redraw the area covered by the 'action indicator'
     which show whether a file is to be loaded, saved, etc. The AES always
     merges this redraw w/ the one generated by fsel. }
   BEGIN
       msg[0] := WM_Redraw;
       msg[1] := ap_id;
       msg[2] := 0;
       msg[3] := act_hdl;
       msg[4] := x;
       msg[5] := y;
       msg[6] := w;
       msg[7] := h;
       Write_Message(ap_id,16,msg);
       IF all_windows THEN
          IF n_hdls = 2 THEN BEGIN
             IF act_hdl = w_pos[1,w_hdl] THEN
                msg[3] := w_pos[2,w_hdl]
             ELSE
                msg[3] := w_pos[1,w_hdl];
             Write_Message(ap_id,16,msg)
          END
   END; { Send_Redraw }

PROCEDURE HOME_CURSOR;
   { note that home to row,col = 1,1 requires a redraw unless 1,1 is on
     screen- in that case should use both, not origin. Use of both,r,s implies
     that the cell to be moved to already resides on the screen }
   BEGIN
       IF extent = Origin THEN BEGIN
          data_row := logical_row_1;
          data_col := logical_col_1;
          start_row := data_row;
          start_col := data_col
       END;
       IF (extent = R) OR (extent = Both) THEN BEGIN
          data_row := start_row;
          scr_row := 1
       END;
       IF (extent = C) OR (extent = Both) THEN BEGIN
          data_col := start_col;
          scr_col := 1
       END
   END; { HOME_CURSOR }

PROCEDURE MY_LINE_STYLE;
   { uses VDI calls for a custom line style; looks better than the 6 default
     patterns provided by VDI; dots are closer together for the vertical
     line }
   BEGIN
       Create_User_Line_Type(style);
       User_Line_Style { like Pasgem Line_Type }
   END; { MY_LINE_STYLE }


(*******************************)
(* End of Screen-related stuff *)
(*******************************)


PROCEDURE STRING_A_CELL;
   { take a row and col and convert them to a cell; i.e. 5,2 => B5 }
   BEGIN
       int_to_string(row,temp);
       temp := CONCAT(col_name[col],temp)
   END; { STRING_A_CELL }

PROCEDURE OUT_MEM_CELL;
   BEGIN
       string_a_cell(row,col,temp);
       temp := CONCAT('[1][Out of memory in cell ' , temp , ',|' ,
                      'which was NOT ' , specific , '.]' ,
                      '[  OK  ]' );
       alert := Do_Alert(temp,1)
   END; { OUT_MEM_CELL }

FUNCTION REL_OVERFLOW;
   { called by perform_2 in adjust_expr }
   BEGIN
       string_a_cell(row,col,temp);
       temp := CONCAT('[1][A relative cell reference|' ,
                          'caused a boundary overflow|' ,
                          'to occur upon incrementing|' ,
                          'a reference in cell ', what ,
                          '.][Cancel|Continue]');
       Set_Mouse(M_Arrow);
       rel_overflow := Do_Alert(temp,2);
       { restore mouse to bee since the caller had it set to bee }
       Set_Mouse(M_Bee);
   END; { REL_OVERFLOW }


(***********************)
(* Real number parsing *)
(***********************)

PROCEDURE STRIP_NUM;
   { strips a REAL from a string; str_pos = position just after last char in
     number, when done. Called by factor in evalexpr, and also by
     scan_for_cells }
   VAR original_pos,e_pos  : INTEGER;
       n_chr               : CHAR;
       e_found,e_sign,done : BOOLEAN;
   BEGIN
       e_found := FALSE;
       e_sign := FALSE;
       done := FALSE;
       original_pos := str_pos;
       num_str := '';
       WHILE (str_pos <= len) AND (NOT done) DO BEGIN
          n_chr := str[str_pos];
          IF n_chr IN float THEN BEGIN
             IF (n_chr = 'E') OR (n_chr = 'e') THEN BEGIN
                e_pos := str_pos;
                e_found := TRUE;
             END;
             IF (n_chr = '+') OR (n_chr = '-') THEN
                IF NOT e_sign THEN
                   IF str_pos > original_pos THEN { either exponent sign or }
                      IF e_found THEN             { delimiter }
                         IF str_pos-1 = e_pos THEN
                            e_sign := TRUE
                         ELSE
                            done := TRUE
                      ELSE
                         done := TRUE
                   ELSE { just the sign of the number }
                ELSE { must have been a delimiter }
                   done := TRUE;
             IF NOT done THEN BEGIN
                num_str := CONCAT(num_str,n_chr);
                str_pos := str_pos+1;
             END;
          END
          ELSE
             done := TRUE
       END { WHILE }
   END; { STRIP_NUM }

FUNCTION VALID_NUMBER;
   { sees if num_str is a valid number for real_to_string; rules
     out ALL potential errors, including E3, 1.2.3E4-3, 1.23e3-2, etc.
     called by window_input, parser. }
   VAR n_pos,num_sign_pos,exp_sign_pos,
       dec_pos,e_pos,i,len_num_str       : INTEGER;
       n_chr                             : CHAR;
       ok_num                            : StatusType;
   BEGIN
       ok_num := OK;
       n_pos := 1;
       num_sign_pos := 0;
       exp_sign_pos := 0;
       dec_pos := 0;
       e_pos := 0;
       len_num_str := LENGTH(num_str);
       IF len_num_str = 0 THEN
          ok_num := BadReal
       ELSE 
          WHILE (n_pos <= len_num_str) AND (ok_num = OK) DO BEGIN
             n_chr := num_str[n_pos];
             IF NOT (n_chr IN float) THEN
                ok_num := BadReal
             ELSE BEGIN
                 (* good and bad e or E *)
                 IF ( n_chr='E' ) OR ( n_chr='e' ) THEN
                    IF e_pos = 0 THEN
                       IF n_pos > 1 THEN
                          IF ( { account for -e & -E }
                               (n_pos = 2) AND (NOT(num_str[1] IN digits))
                             )  OR
                             (n_pos = len_num_str) THEN
                             ok_num := BadReal
                          ELSE
                             e_pos := n_pos
                       { account for e12 & E123 }
                       ELSE
                          ok_num := BadReal
                    { > 1 e's }
                    ELSE
                       ok_num := BadReal;
                 (* good and bad sign, for both number and exponent *)
                 IF  (n_chr = '+') OR (n_chr = '-') THEN
                     IF n_pos = 1 THEN { sign of number }
                        IF num_sign_pos = 0 THEN
                           IF len_num_str > 1 THEN
                              { really a pointless assignment, since nothing
                                else depends on this; it does clarify and
                                keep the routine consistent by documenting
                                this, however }
                              num_sign_pos := n_pos
                           ELSE
                              ok_num := BadReal
                        ELSE { no other possibility }
                     ELSE IF n_pos = len_num_str THEN
                        ok_num := BadReal
                     ELSE IF e_pos = 0 THEN
                        ok_num := BadReal
                     ELSE IF exp_sign_pos = 0 THEN
                        IF (
                             (POS('E',num_str)=n_pos-1) OR
                             (POS('e',num_str)=n_pos-1)
                           )  THEN
                           exp_sign_pos := n_pos
                        ELSE
                           ok_num := BadReal
                     ELSE
                        ok_num := BadReal;
                 (* good & bad decimal *)
                 IF n_chr = '.' THEN
                    IF (dec_pos = 0) AND (e_pos = 0) THEN
                       IF n_pos = len_num_str THEN
                          ok_num := BadReal
                       ELSE IF NOT (num_str[n_pos+1] IN digits) THEN
                               ok_num := BadReal
                       ELSE
                          dec_pos := n_pos
                    ELSE
                       ok_num := BadReal;
                 n_pos := n_pos+1;
             END; { ELSE }
          END; { WHILE }
       valid_number := ok_num;
   END; (* VALID_NUMBER *)

(******************************)
(* End of Real number parsing *)
(******************************)


(****************)
(* Cell Parsing *)
(****************)

FUNCTION VALID_COL_NAME;
   { column name = A,B,...,Z,AA,BB,AB,ID, etc. depending on n_cols }
   VAR first,second,sum : INTEGER;
   BEGIN
       valid_col_name := FALSE;
       sum := 0;
       IF LENGTH(temp) > 0 THEN BEGIN
          first := ORD(temp[1])-64;
          IF LENGTH(temp) > 1 THEN
             IF temp[2] IN up_case THEN BEGIN
                second := ORD(temp[2])-64;
                sum := first*26+second
             END
             ELSE
                sum := first
          ELSE
             sum := first
       END;      
       IF (sum > 0) AND (sum <= n_cols) THEN
          IF col_name[sum] = temp THEN
             valid_col_name := TRUE;
       col_number := sum { meaningless if valid_col_name set to false }
   END; { VALID_COL_NAME }

PROCEDURE GET_COL;
   VAR column : STR10;
       at_end : BOOLEAN;
   BEGIN
       IF str[str_pos] = '$' THEN BEGIN
          col_rel := FALSE;
          str_pos := str_pos+1
       END
       ELSE
          col_rel := TRUE;
       IF str_pos >= len THEN
          status := BadRef
       ELSE BEGIN
          column := '';
          at_end := FALSE;
          WHILE (NOT at_end) AND (status <> BadRef) DO BEGIN
              IF str[str_pos] IN up_case THEN BEGIN
                 column := CONCAT(column,str[str_pos]);
                 str_pos := str_pos+1;
                 IF LENGTH(column) > 2 THEN
                    status := BadRef
              END
              ELSE
                 at_end := TRUE;
              IF str_pos > len THEN
                 status := BadRef
          END;
          IF status = OK THEN
            IF NOT valid_col_name(column,col) THEN
               status := BadRef
       END
   END; { GET_COL }

PROCEDURE GET_ROW;
   VAR i,multiplier : INTEGER;
       row_str      : STR10;
       at_end       : BOOLEAN;
   BEGIN
       IF str[str_pos] = '$' THEN BEGIN
          row_rel := FALSE;
          str_pos := str_pos+1
       END
       ELSE
          row_rel := TRUE;
       IF str_pos > len THEN
          status := BadRef
       ELSE BEGIN
          row_str := '';
          at_end := FALSE;
          WHILE (status <> BadRef) AND (NOT at_end) DO BEGIN
              IF str[str_pos] IN digits THEN BEGIN
                 row_str := CONCAT(row_str,str[str_pos]);
                 str_pos := str_pos+1;
                 IF LENGTH(row_str) > 3 THEN
                    status := BadRef
              END
              ELSE
                 at_end := TRUE;
              IF str_pos > len THEN 
                 at_end := TRUE
          END;
          IF LENGTH(row_str) = 0 THEN
             status := BadRef;
          IF status = OK THEN BEGIN
             multiplier := 1;
             row := 0;
             FOR i := LENGTH(row_str) DOWNTO 1 DO BEGIN
                 row := row+(ORD(row_str[i])-$30)*multiplier;
                 multiplier := multiplier*10
             END
          END
       END { ELSE }
   END; { GET_ROW }

FUNCTION TRANSLATE_CELL;
   { A1 => 1,1; Expects the starting position of the tentative cell ref and the
     length of the string it appears in.
     After the call, if no error was found, str_pos will
     equal the position immediately following the cell reference, and
     returns OK; otherwise, returns an error message }
   VAR status : StatusType;
   BEGIN
       IF len < 2 THEN
          translate_cell := BadRef
       ELSE BEGIN
          status := OK;
          get_col(str,str_pos,len,col,col_rel,status);
          IF status = OK THEN
             get_row(str,str_pos,len,row,row_rel,status);
          IF status = OK THEN
             IF (col < 1) OR (col > n_cols) OR
                (row < 1) OR (row > n_rows) THEN
                status := OutOfRange;
          translate_cell := status
       END
   END; { TRANSLATE_CELL }

(***********************)
(* End of Cell Parsing *)
(***********************)


(********************************)
(* Expression-specific routines *)
(********************************)

FUNCTION SCAN_FOR_CELLS;
   { scans a string for cells, beginning at str_pos; returns the 
     position immediately FOLLOWING the ref. Further error checking
     by translate_cell is performed. Note str_pos is also modified
     by translate_cell so that it equals the position following the
     cell ref. To scan for all cell in a string, the caller must call
     this function until str_pos = len. If an error, str_pos may equal
     len+1, depending on where the error occurred. Also when no cell
     is found. The cell's position is returned in cell_pos }
   VAR found_status : BOOLEAN;
       dummy        : LorFstr;
   BEGIN
       found_status := FALSE;
       WHILE (str_pos < len) AND (NOT found_status) DO
          IF str[str_pos] IN up_case THEN
             IF str[str_pos+1] IN digits+['$'] THEN BEGIN
                found_status := TRUE;
                cell_pos := str_pos
             END
             ELSE IF str_pos+1 < len THEN
                IF (str[str_pos+1] IN up_case) AND
                   (str[str_pos+2] IN digits+['$']) THEN BEGIN
                   found_status := TRUE;
                   cell_pos := str_pos
                END
                ELSE
                   REPEAT
                      str_pos := str_pos+1
                   UNTIL (NOT (str[str_pos] IN up_case)) OR (str_pos = len)
             ELSE      { must have been a keyword; skip remaining caps so }
                REPEAT { that SERR, CORR won't be considered a cell. Note }
                   str_pos := str_pos+1
                UNTIL (NOT (str[str_pos] IN up_case)) OR (str_pos = len)
          ELSE IF str[str_pos] = '$' THEN BEGIN
             found_status := TRUE;
             cell_pos := str_pos
          END       
          ELSE IF str[str_pos] IN digits+['.'] THEN { don't care about sign }
             strip_num(dummy,str,str_pos,len)       { here; what if -E1? }
          ELSE
             str_pos := str_pos+1;
       scan_for_cells := found_status;
       IF found_status THEN
          IF translate_cell(str,str_pos,len,row,col,row_rel,col_rel)<>OK THEN
             scan_for_cells := FALSE { wasn't really a cell }
   END; { SCAN_FOR_CELLS }  

FUNCTION ADJUST_EXPR;
   { called by adjust_cell_refs for which it scans a string for cell
     refs and if appropriate, modifies the string so that these cell
     refs reference a different cell ( i.e. a relative adjustment ); 
     src_row..dest_col are significant as are row_st..col_end. 
     The latter four represent the scope of the
     block move; action = adj_cell_refs }
   { called by all_lists for which it scans a string for cell refs
     and updates the found cells' dep lists to contain the cell passed
     in src_row, src_col; action = add or remove }    
   { called by replicate cell for which it scans a string and modifies
     the cell refs relatively; src_row..dest_col are meaningful; so we
     can use the code of perform_2, need to pass row_st..col_end with
     values of 1,n_rows,1,n_cols since we always wish to adjust and must
     therefore define a block size equalling the entire sheet; 
     action = adj_cell_refs } 
   { the function returns a value of OK unless it was adjusting cell
     refs, a range error occurred, and the user selected 'Cancel' from
     the alert box in rel_overflow, in which case it returns OutOfRange }

   LABEL 1; { label to go to if an adjusted cell ref is invalid and the
              user wants to abort the action }  
   VAR i,j,s_r,s_c,dummy,cell_pos,
       len,str_pos,row,col,adj_r,adj_c          : INTEGER;
       row_rel,col_rel,abort,do_range           : BOOLEAN;
       dup_str                                  : LorFstr;
       status                                   : StatusType;
       dep                                      : DepPtr;
   PROCEDURE PERFORM_1 ( row,col : INTEGER );
      { row,col = the cell which appeared as a reference } 
      VAR ptr : CellPtr;
      BEGIN
          IF action = add THEN { action inherited from adj_expr }
             list_insert(row,col,src_row,src_col)
          ELSE BEGIN { action = remove }
             list_delete(row,col,src_row,src_col);
             ptr := locate_cell(row,col);
             IF ptr <> NIL THEN
                IF (ptr^.sub = NIL) AND (ptr^.status = Empty) THEN
                   delete_cell(row,col,FALSE)
          END             
      END; { PERFORM_1 }

   PROCEDURE PERFORM_2 ( row,col : INTEGER );
      { row,col = the cell which appeared as a reference } 
      VAR r,c,offset,cell_len : INTEGER;
          temp1,temp2         : STR10;
      PROCEDURE ALTER_STR;
         BEGIN
             string_a_cell(dest_row,dest_col,temp1);
             int_to_string(r,temp2);
             IF NOT row_rel THEN 
                temp2 := CONCAT('$',temp2);
             temp2 := CONCAT(col_name[c],temp2);
             IF NOT col_rel THEN
                temp2 := CONCAT('$',temp2);
             cell_len := str_pos-cell_pos;
             IF len-cell_len+LENGTH(temp2) > string_len THEN BEGIN
                temp := CONCAT('[1][Adjusting a relative cell|' ,
                                   'reference in cell ' , temp1 , '|' ,
                                   'caused the formula length to|' ,
                                   'exceed the maximum allowed.]' ,
                                   '[Cancel|Continue]');
                ptr^.status := GenError;
                IF Do_Alert(temp,2) = 1 THEN BEGIN
                   adjust_expr := GenError;
                   ptr^.str^ := dup_str;
                   cell_on_screen(1,dest_row,dest_col,TRUE);
                   write_cell_name;
                   GOTO 1
                END
             END
             ELSE BEGIN
                DELETE(ptr^.str^,cell_pos,cell_len);
                IF cell_pos > LENGTH(ptr^.str^) THEN    { can't insert to pos }
                   ptr^.str^ := CONCAT(ptr^.str^,temp2) { past end of string  }
                ELSE
                   INSERT(temp2,ptr^.str^,cell_pos);
                str_pos := cell_pos+LENGTH(temp2) { just in case }
             END;
             len := LENGTH(ptr^.str^)
         END; { ALTER_STR }
      BEGIN
          IF (row >= row_st) AND (row <= row_end) AND
             (col >= col_st) AND (col <= col_end) THEN BEGIN

             { so it's within the realm of the block passed; errors due to
               adjusted rel. refs exceeding the sheet bounds need NOT be
               checked; they are IMPOSSIBLE***, since:
               1. only valid cell refs may appear in formulas;
               2. only cell refs falling within the bounds of the block
                  are adjusted;
               3. block moves must have a destination block falling within
                  the bounds of the sheet.
               So, the above really says the following things, using rows as
               an example, for a cell ref that will be adjusted:
                    src_block_start <= row_ref <= src_block_end;
                    dest_block_start <= dest_row_ref <= dest_block_end
                                                                  <= n_rows.
               ***All the above applies to sheet inserts/deletes.

               BUT cell REPLICATION
               can still generate out-of-bounds cell refs, so must still check
               for these errors; easiest just to do for all cases, and
               hardly takes any time at all. }

             string_a_cell(dest_row,dest_col,temp1); { in case OutOfRange }
             IF row_rel THEN BEGIN
                offset := src_row-row;
                IF (dest_row-offset<1) OR (dest_row-offset>n_rows) THEN BEGIN
                   ptr^.status := GenError;
                   IF rel_overflow(dest_row,dest_col,temp1) = 1 THEN BEGIN
                      adjust_expr := OutOfRange;
                      ptr^.str^ := dup_str;
                      cell_on_screen(1,dest_row,dest_col,TRUE);
                      write_cell_name;
                      GOTO 1 { hasty exit }
                   END
                   ELSE
                      r := row { no change, continue anyway }
                END
                ELSE
                   r := dest_row-offset
             END
             ELSE 
                r := row;
             IF col_rel THEN BEGIN
                offset := src_col-col;
                IF (dest_col-offset<1) OR (dest_col-offset>n_cols) THEN BEGIN
                   ptr^.status := GenError;
                   IF rel_overflow(dest_row,dest_col,temp1) = 1 THEN BEGIN
                      adjust_expr := OutOfRange;
                      ptr^.str^ := dup_str;
                      cell_on_screen(1,dest_row,dest_col,TRUE);
                      write_cell_name;
                      GOTO 1
                   END 
                   ELSE
                      c := col
                END      
                ELSE
                   c := dest_col-offset
             END
             ELSE
                c := col;
             IF NOT do_range THEN BEGIN
                adj_r := r;
                adj_c := c
             END
             ELSE IF (adj_r > r) OR (adj_c > c) THEN BEGIN
                ptr^.status := GenError;
                temp := CONCAT('[1][A range reference in cell|' ,
                                   temp1, ' will be altered to|' ,
                                   'prevent an invalid range from|' ,
                                   'being created.][Cancel|Continue]');
                IF Do_Alert(temp,2) = 1 THEN BEGIN
                   adjust_expr := BadRef;
                   ptr^.str^ := dup_str;
                   cell_on_screen(1,dest_row,dest_col,TRUE);
                   write_cell_name;
                   GOTO 1
                END
                ELSE BEGIN
                   r := adj_r;
                   c := adj_c
                END
             END;
             alter_str
          END
          ELSE IF NOT do_range THEN BEGIN
             adj_r := row;
             adj_c := col
          END
          ELSE IF (adj_r > row) OR (adj_c > col) THEN BEGIN
             ptr^.status := GenError;
             temp := CONCAT('[1][A range reference in cell|' ,
                                temp1, ' will be altered to|' ,
                                'prevent an invalid range from|' ,
                                'being created.][Cancel|Continue]');
             IF Do_Alert(temp,2) = 1 THEN BEGIN
                adjust_expr := BadRef;
                ptr^.str^ := dup_str;
                cell_on_screen(1,dest_row,dest_col,TRUE);
                write_cell_name;
                GOTO 1
             END
             ELSE BEGIN
                r := adj_r;
                c := adj_c;
                alter_str
             END   
          END
      END; { PERFORM_2 }

   PROCEDURE PERFORM ( loc_action,s_row,s_col,e_row,e_col : INTEGER );
      VAR i,j : INTEGER;
      BEGIN
          CASE loc_action OF
             add,remove { 1,2 } : perform_1(s_row,s_col);
             adj_refs   { 3 }   : perform_2(s_row,s_col);
             4 : IF action = adj_refs THEN { action was inherited }
                    perform_2(s_row,s_col) { from parent          }
                 ELSE                      
                    FOR i := s_row TO e_row DO
                        FOR j := s_col TO e_col DO
                            perform_1(i,j)
          END
      END; { PERFORM }                         

   BEGIN { ADJUST_EXPR }
       adjust_expr := OK;
       IF ptr <> NIL THEN
          IF (ptr^.class = Expr) AND (ptr^.str <> NIL) THEN BEGIN
             abort := FALSE;
             len := LENGTH(ptr^.str^);
             dup_str := ptr^.str^;
             str_pos := 1;
             WHILE (str_pos < len) AND (NOT abort) DO BEGIN
                 do_range := FALSE;
                 IF scan_for_cells(ptr^.str^,str_pos,len,cell_pos,row,col,
                                   row_rel,col_rel) THEN
                    IF str_pos < len THEN
                       IF ptr^.str^[str_pos] <> ':' THEN
                          perform(action,row,col,dummy,dummy)
                       ELSE BEGIN { a range was referenced }
                          s_r := row;
                          s_c := col;
                          IF action = adj_refs THEN
                             perform(action,s_r,s_c,dummy,dummy);
                          str_pos := str_pos+1;
                          do_range := TRUE;
                          IF scan_for_cells(ptr^.str^,str_pos,len,cell_pos,
                                            row,col,row_rel,col_rel) THEN
                             IF action = adj_refs THEN
                                perform(action,row,col,dummy,dummy)
                             ELSE
                                perform(4,s_r,s_c,row,col)
                          ELSE
                             abort := TRUE;
                       END
                    ELSE
                       perform(action,row,col,dummy,dummy)
                 ELSE
                    abort := TRUE
             END { WHILE }       
          END;
1: END; { ADJUST_EXPR }

(***************************************)
(* End of Expression-specific routines *)
(***************************************)


(***********************)
(* Miscellaneous stuff *)
(***********************)

PROCEDURE ADJUST_MENU;
   { block set or not set }
   BEGIN
       IF enable THEN BEGIN
          Menu_Enable(main_menu,mcopy);
          Menu_Enable(main_menu,mmove);
          Menu_Enable(main_menu,mdelete);
          Menu_Text(main_menu,mfirstc,'  Show Block Start  cF');
          Menu_Text(main_menu,mlastc, '  Show Block End    cL')
       END
       ELSE BEGIN
          Menu_Disable(main_menu,mcopy);
          Menu_Disable(main_menu,mmove);
          Menu_Disable(main_menu,mdelete);
          Menu_Text(main_menu,mfirstc,'  Show First Cell   cF');
          Menu_Text(main_menu,mlastc, '  Show Last Cell    cL')
       END
   END; { ADJUST_MENU }

FUNCTION FIND_PREC;
   BEGIN
       IF ptr <> NIL THEN
          find_prec := ptr^.format & prec_mask
       ELSE
          find_prec := default_format & prec_mask
   END; { FIND_PREC }

FUNCTION FIND_JUST;
   VAR just : INTEGER;
   BEGIN
       just := 0;
       IF ptr <> NIL THEN
          just := ptr^.format & just_mask
       ELSE
          just := default_format & just_mask;
       IF just = 0 THEN
          find_just := VDI_Right
       ELSE IF just = $0030 THEN
          find_just := VDI_Center
       ELSE
          find_just := VDI_Left
   END; { FIND_JUST }

PROCEDURE PREPARE_NUM;
   { converts a number within a cell to a string,
     taking into account col_width, precision, etc.
     called by draw_cell, display_data, print }
   VAR
       prec                : INTEGER;
       number              : REAL;
       perc_set,dollar_set : BOOLEAN;
   BEGIN
       IF ptr <> NIL THEN
          WITH ptr^ DO
             IF ((class = Val) OR (class = Expr)) AND { faster than calling  }
                (status = Full) THEN BEGIN            { assigned, which must }
                number := num;                        { do a locate_cell }
                dollar_set := format & dollar_mask <> 0;
                perc_set := format & perc_mask <> 0;
                IF perc_set THEN
                   number := number*100;
                prec := find_prec(ptr);
                IF number <> 0 THEN
                   IF format & $0008 <> 0 THEN
                      real_to_string(number,temp,prec,TRUE)
                   ELSE
                      real_to_string(number,temp,prec,FALSE)
                ELSE
                   temp := '0';
                IF temp[1] = ' ' THEN
                   DELETE(temp,1,1);
                IF dollar_set THEN
                   IF temp[1] = '-' THEN
                      INSERT('$',temp,2)
                   ELSE
                      temp := CONCAT('$',temp);
                IF perc_set THEN
                   temp := CONCAT(temp,'%')
             END
             ELSE IF status < OK THEN
                temp := error_msg[status]
   END; { PREPARE_NUM }

PROCEDURE BLOCK_TOO_BIG;
   { called by load_file when "load_block at cursor position" and by 
     transport_block }
   VAR temp : STR255;
   BEGIN
       Set_Mouse(M_Arrow);
       temp := CONCAT('[3][The block is too large to|' ,
                          'insert at that position.|' ,
                          'Required row & col values:|' ,
                          'Col <= ' , col ,
                          '|Row <= ' , row , '][ Cancel ]' );
       alert := Do_Alert(temp,1)
   END; { BLOCK_TOO_BIG }

FUNCTION FIND_FIRST_AND_LAST;
   VAR i,
       pert_row,
       pert_col   : INTEGER;
       ptr        : CellPtr;
   BEGIN
      marks[5].row := n_rows;
      marks[5].col := n_cols;
      IF virtual_or_actual THEN BEGIN
         pert_row := logical_row_1;
         pert_col := logical_col_1;
         marks[6].row := logical_row_1;
         marks[6].col := logical_col_1
      END
      ELSE BEGIN
         pert_row := 1;
         pert_col := 1;
         marks[6].row := 1;
         marks[6].col := 1
      END;   
      FOR i := pert_row TO n_rows DO BEGIN
          ptr := data[i];
          WHILE ptr <> NIL DO BEGIN
             IF ptr^.c >= pert_col THEN BEGIN
                IF i < marks[5].row THEN
                   marks[5].row := i;
                IF ptr^.c < marks[5].col THEN
                   marks[5].col := ptr^.c;
                marks[6].row := i;
                IF ptr^.c > marks[6].col THEN
                   marks[6].col := ptr^.c
             END;      
             ptr := ptr^.next
          END
      END;
      IF (marks[5].row <= marks[6].row) AND 
         (marks[5].col <= marks[6].col) THEN
         find_first_and_last := TRUE
      ELSE
         find_first_and_last := FALSE
   END; { FIND_FIRST_AND_LAST }
   
PROCEDURE CLEAR_BUFFER;
   { clears out row 0, which is not used for data but rather as a buffer 
     for block moves and file i/o when "insert block at cursor" was chosen }
   VAR ptr : CellPtr;
   BEGIN
       ptr := data[0];      
       WHILE ptr <> NIL DO BEGIN 
          delete_cell(0,ptr^.c,FALSE);
          ptr := data[0]
       END
   END; { CLEAR_BUFFER }    

PROCEDURE DELETE_RANGE;
   VAR i,col : INTEGER;
       ptr   : CellPtr;
   BEGIN
       { Want to leave the dep list alone if a cell outside the range 
         accesses a cell inside the range and will exist after the deletes;
         that is the in range cell must be alive to have a dep list }
       i := s_row;
       WHILE i <= f_row DO BEGIN
          ptr := data[i];
          WHILE ptr <> NIL DO 
             IF (ptr^.c >= s_col) AND (ptr^.c <= f_col) THEN BEGIN
                col := ptr^.c;
                delete_cell(i,col,FALSE);
                ptr := locate_cell(i,col); { may still be alive }
                IF ptr = NIL THEN
                   ptr := data[i]
                ELSE
                   ptr := ptr^.next;   
                IF draw THEN
                   cell_on_screen(1,i,col,TRUE);
             END
             ELSE
                ptr := ptr^.next;
          i := i+1
       END   
   END; { DELETE_RANGE }

PROCEDURE CLEAR_WORKSHEET;
   VAR i   : INTEGER;
   BEGIN
       { can NOT use Mark..Release here because apparently these commands 
         are buggy; may have to use them within same scope. When load_block
         at cursor followed by load_file, got > 1 cell being set to the same
         address, leading to crashes. Presumably, the 'free pointer space'
         list was not properly reinited by the Release, leading to 
         new_cell returning the same ptr for > 1 cell, in cells in different
         rows, in the first col! The following, however, DISPOSEs of each
         cell individually, and although slow for large sheets, it *works* }
       FOR i := 0 TO n_rows DO
           WHILE data[i] <> NIL DO
              delete_cell(i,data[i]^.c,TRUE);
       working_memory := original_memory; { should not have changed }
       block_set := FALSE;
       adjust_menu(FALSE);
       Send_Redraw(TRUE,0,0,screen_width,screen_height)
   END; { CLEAR_WORKSHEET }

PROCEDURE SIMULATE_MESSAGE;
   { fills message_buffer and inits inp_code so the caller may then call
     handle_message; valid for MN_Selected, WM_Arrowed, etc. Does NOT write to
     GEM's queue }
   BEGIN
       IF msg_type = MN_Selected THEN
          Menu_Hilight(main_menu,three);
       msg_area[0] := msg_type;
       msg_area[3] := three;
       msg_area[4] := four;
       handle_message;
       redraw_flag := FALSE
   END; { SIMULATE_MESSAGE }
   
PROCEDURE HIDE;
   BEGIN
      Obj_SetFlags(new_desk_ptr,mathmenu,
                   Obj_Flags(new_desk_ptr,mathmenu) | Hide_Tree);
      Obj_SetFlags(new_desk_ptr,trigmenu,
                   Obj_Flags(new_desk_ptr,trigmenu) | Hide_Tree);
      Obj_SetFlags(new_desk_ptr,statmenu,
                   Obj_Flags(new_desk_ptr,statmenu) | Hide_Tree);
      Obj_SetFlags(new_desk_ptr,finmenu,
                   Obj_Flags(new_desk_ptr,finmenu) | Hide_Tree);
      Obj_SetFlags(new_desk_ptr,boolmenu,
                   Obj_Flags(new_desk_ptr,boolmenu) | Hide_Tree);
      Obj_SetFlags(new_desk_ptr,tabmenu,
                   Obj_Flags(new_desk_ptr,tabmenu) | Hide_Tree)
   END; { HIDE }
   
PROCEDURE UNHIDE;
   BEGIN
      Obj_SetFlags(new_desk_ptr,menu,
                   Obj_Flags(new_desk_ptr,menu) & ~Hide_Tree)
   END; { UNHIDE }


(******************************)
(* End of Miscellaneous stuff *)
(******************************)

BEGIN
END.