program editor;                        { A simple full-screen editor. }

uses crt;                        { ^Z is used for the end-of-file marker,    }
                                 {   whether it is in the input file or not. }

const
  last_screen_line = 25;     { Count of number of lines on screen. }

label
  top_of_file, get_keystrokes;

type
  pointertype = ^char_node;
  char_node = record prev_character : pointertype;
                     character : char;
                     next_character : pointertype;
                     end;
var
  bof_pointer, pointer, prev_pointer,
    eof_pointer, saved_pointer : pointertype;
  filename, filenamebak : string[64];
  infile : text;
  ch : char;
  sub, errcode, current_row, current_col, saved_row, saved_col : integer;
  key : array[1..2] of char;
  ctrl_z_in_file, error_flag, error_message_on_screen, in_letter_mode : boolean;
  list_count : longint;


{============================== PROCEDURES ==================================}

function at_beginning_of_file : boolean;
begin
at_beginning_of_file := FALSE;
if pointer = bof_pointer then
  at_beginning_of_file := TRUE;
end;

function at_end_of_file : boolean;
begin
at_end_of_file := FALSE;
if pointer = eof_pointer then
  at_end_of_file := TRUE;
end;

function at_beginning_of_line : boolean;
begin
at_beginning_of_line := FALSE;
if at_beginning_of_file or (pointer^.prev_character^.character = chr(10)) then
  at_beginning_of_line := TRUE;
end;

function at_end_of_line : boolean;
begin
at_end_of_line := FALSE;
if at_end_of_file or (pointer^.character = chr(13)) then
  at_end_of_line := TRUE;
end;

procedure insert_char(char_to_insert : char; before_pointer : pointertype);
var new_pointer : pointertype;
begin
new(new_pointer);                      { Allocate space for character. }
new_pointer^.character := char_to_insert;
new_pointer^.next_character := before_pointer;
if before_pointer = bof_pointer then  { Insert before very start of file? }
  begin
  before_pointer^.prev_character := new_pointer;
  new_pointer^.prev_character := nil;
  bof_pointer := new_pointer;
  end
else
  begin
  new_pointer^.prev_character := before_pointer^.prev_character;
  before_pointer^.prev_character^.next_character := new_pointer;
  before_pointer^.prev_character := new_pointer;
  end;
end;

procedure check_list(message : string); { Check all pointers and show mess. }
var traversing_pointer, prev_pointer : pointertype;  { if any error.        }
begin
list_count := 0;
if bof_pointer^.prev_character <> nil then
  begin
  writeln(^M,^J,message,^G);
  writeln('*** ERROR: prev_character <> nil for bof character');
  halt(1);
  end;
if eof_pointer^.character <> chr(26) then
  begin
  writeln(^M,^J,message,^G);
  writeln('*** ERROR: eof_character <> ^Z');
  halt(1);
  end;
if eof_pointer^.next_character <> nil then
  begin
  writeln(^M,^J,message,^G);
  writeln('*** ERROR: eof character. (^Z) points to another character!');
  halt(1);
  end;
traversing_pointer := bof_pointer;
prev_pointer := nil;
while traversing_pointer^.next_character <> nil do
  begin
  list_count := list_count + 1;
  if traversing_pointer^.prev_character <> prev_pointer then
	begin
    writeln(^M,^J,message,^G);
	writeln('*** ERROR; prev_character doesn''t point to prev. char ***');
	halt(1);
	end;
  prev_pointer := traversing_pointer;
  traversing_pointer := traversing_pointer^.next_character;
  end;
if traversing_pointer <> eof_pointer then
  begin
  writeln(^M,^J,message,^G);
  writeln('*** ERROR: eof pointer not pointing to last char. in list ***');
  halt(1);
  end;
end;

procedure place_cursor(row, col : integer);
begin
if row > last_screen_line then
  begin
  row := last_screen_line;
  write(chr(7));
  gotoxy(1,25);
  write('*** cursor positioning error: row too big ***');
  end;
if col > 80 then
  col := 80;
gotoxy(col,row);
end;

procedure write_char_and_update(the_char : char; var row, col : integer);
begin
place_cursor(row,col);
if the_char = chr(13) then
  clreol;
write(the_char);                 { Write letter or whatever. }
if the_char = chr(10) then
  row := row + 1
else
  if the_char = chr(13) then
    col := 1         { Reset col if return.    }
  else
    inc(col);
end;

procedure pointer_bol(var pointer : pointertype; var error_flag : boolean);
                          { Moves pointer to beginning of line, or beginning }
                          {   of previous line.  Returns new pointer value   }
                          {   (and error flag if we're at start of file).    }
label pointer_bol_exit;
begin
error_flag := FALSE;
if at_beginning_of_file then
  begin
  error_flag := TRUE;
  goto pointer_bol_exit;
  end;
repeat
  pointer := pointer^.prev_character           { Move back a character }
until at_beginning_of_line;
pointer_bol_exit:
end;

procedure pointer_eol(var pointer : pointertype; var error_flag : boolean);
                         { Move pointer to beginning of next line.  If this }
                         {   is last line in file (no next line) then flag  }
                         {   will be set TRUE and pointer will be on the    }
                         {   last character in the file.                    }
label pointer_eol_exit;
begin
error_flag := FALSE;
if at_end_of_file then
  begin
  error_flag := TRUE;
  goto pointer_eol_exit;
  end;
repeat
  pointer := pointer^.next_character
until at_end_of_line;
pointer_eol_exit:
end;

procedure end_of_line(var error_flag : boolean);
label end_of_line_exit;
begin
error_flag := FALSE;
if at_end_of_line then
  begin
  error_flag := TRUE;
  goto end_of_line_exit;
  end;
while not at_end_of_line do
  begin
  write_char_and_update(pointer^.character,current_row,current_col);
  pointer := pointer^.next_character;
  end;
place_cursor(current_row,current_col);
clreol;
end_of_line_exit:
end;

procedure uparrow(var error_flag : boolean);
label uparrow_exit;
begin
error_flag := FALSE;
if not at_beginning_of_line then
  begin
  pointer_bol(pointer,error_flag);     { Move pointer to start of this line. }
  if error_flag then
    begin
    writeln('*** ERROR #1 in procedure uparrow ***');
    halt(1);
    end;
  current_col := 1;
  place_cursor(current_row,current_col);
  goto uparrow_exit;
  end;
pointer_bol(pointer,error_flag);  { Move pointer to start of previous line. }
if error_flag then    { Beginning of file?   }
  goto uparrow_exit;
if current_row > 1 then                  { Are we on 1st line? }
  begin                                  { Nope. Just move cursor. }
  dec(current_row);
  place_cursor(current_row,current_col);
  goto uparrow_exit;
  end;
insline;            { Insert blank line at top of display.   }
place_cursor(last_screen_line,1); { Clear last line, which was pushed down. }
clreol;
place_cursor(1,1);
end_of_line(error_flag);   { Error is ok. }
if not error_flag then
  pointer_bol(pointer,error_flag);   { Go to start of line we just wrote. }
error_flag := FALSE;   { This error is ok, too. }
current_row := 1;
current_col := 1;
place_cursor(1,1);
uparrow_exit:
end;

procedure downarrow(var error_flag : boolean);
label downarrow_exit;
begin
error_flag := FALSE;
if at_end_of_file then
  begin
  error_flag := TRUE;
  goto downarrow_exit;
  end;
repeat
  write_char_and_update(pointer^.character,current_row,current_col);
  pointer := pointer^.next_character;
until (at_end_of_file or at_beginning_of_line);
if at_end_of_file then
  goto downarrow_exit;
if current_row > last_screen_line - 2 then
  begin
  writeln(^J);
  current_row := last_screen_line - 2;
  place_cursor(last_screen_line - 2,1);
  repeat
    write_char_and_update(pointer^.character,current_row,current_col);
    pointer := pointer^.next_character;
  until at_end_of_file or at_beginning_of_line;
  pointer_bol(pointer,error_flag);
  if error_flag then
    begin
    writeln('*** ERROR #1 in downarrow ***');
    halt(1);
    end;
  dec(current_row);
  place_cursor(current_row,current_col);
  end;
downarrow_exit:
end;

procedure rightarrow(var error_flag : boolean);
label rightarrow_exit;
begin
error_flag := FALSE;
if at_end_of_file then
  begin
  error_flag := TRUE;
  goto rightarrow_exit;
  end;
if at_end_of_line then
  begin
  downarrow(error_flag);
  if error_flag then
    begin
    writeln('*** Error #1 in rightarrow ***');
    halt(1);
    end;
  goto rightarrow_exit;
  end;
pointer := pointer^.next_character;
inc(current_col);
place_cursor(current_row,current_col);
rightarrow_exit:
end;

procedure leftarrow(var error_flag : boolean);
label leftarrow_exit;
begin
error_flag := FALSE;
if at_beginning_of_file then
  begin
  error_flag := TRUE;
  goto leftarrow_exit;
  end;
if at_beginning_of_line then   { At start of line? }
  begin
  uparrow(error_flag);
  if error_flag then
    begin
    writeln('*** Error #1 in leftarrow ***');
    halt(1);
    end;
  end_of_line(error_flag);    { Error is ok. }
  error_flag := FALSE;
  place_cursor(current_row,current_col);
  goto leftarrow_exit;
  end;
pointer := pointer^.prev_character;
dec(current_col);
place_cursor(current_row,current_col);
leftarrow_exit:
end;

procedure home(var error_flag : boolean);
label home_exit;
begin
error_flag := FALSE;
if at_beginning_of_line then
  begin
  error_flag := TRUE;
  goto home_exit;
  end;
pointer_bol(pointer,error_flag);
if error_flag then
  begin
  writeln('*** Error #1 in home ***');
  halt(1);
  end;
current_col := 1;
place_cursor(current_row,current_col);
home_exit:
end;

procedure pgdn(var error_flag : boolean);
label pgdn_exit;
var temp : integer;
begin
error_flag := FALSE;
if at_end_of_file then
  begin
  error_flag := TRUE;
  goto pgdn_exit;
  end;
temp := 0;
repeat
  downarrow(error_flag);
  inc(temp);
until (error_flag or (temp > 20));
error_flag := FALSE;
pgdn_exit:
end;

procedure pgup(var error_flag : boolean);
label pgup_exit;
var temp : integer;
begin
error_flag := FALSE;
if at_beginning_of_file then
  begin
  error_flag := TRUE;
  goto pgup_exit;
  end;
temp := 0;
repeat
  uparrow(error_flag);
  inc(temp);
until (error_flag or (temp > 20));
error_flag := FALSE;
pgup_exit:
end;

procedure backspace(var error_flag : boolean);   { Delete previous char.. }
label backspace_exit;
var cr_pointer, lf_pointer, saved_pointer : pointertype;
  saved_row, saved_col : integer;
begin
error_flag := FALSE;
if at_beginning_of_file then
  begin
  error_flag := TRUE;
  goto backspace_exit;
  end;
if at_beginning_of_line then     { Delete CR/LF. }
  begin
  saved_pointer := pointer;    { Save where we want pointer to end up. }
  leftarrow(error_flag);       { Here we go to where we want the  }
  if error_flag then
    begin
    writeln('*** ERROR #1 in backspace ***');
    halt(1);
    end;
  saved_row := current_row;    {   cursor to end up when we're    }
  saved_col := current_col;    {   done concatenating the two     }
  rightarrow(error_flag);      {   lines and save the position.   }
  if error_flag then
    begin
    writeln('*** ERROR #2 in backspace ***');
    halt(1);
    end;
  cr_pointer := pointer^.prev_character^.prev_character;
  lf_pointer := pointer^.prev_character;
  if pointer^.prev_character^.prev_character = bof_pointer then
    begin
    bof_pointer := pointer;
    pointer^.prev_character := nil;
    end
  else
    begin
    pointer^.prev_character^.prev_character^.prev_character^.next_character :=
     pointer;                     { Make char. before CR/LF pointer to us. }
    pointer^.prev_character :=
     pointer^.prev_character^.prev_character^.prev_character; { Set prev.. }
    end;
  dispose(cr_pointer);   { Get rid of CR. }
  dispose(lf_pointer);   { Get rid of LF. }
  check_list('*** List check error in backspace after disposing CR/LF ***');
  while not at_beginning_of_line do        { Back up to start of this line }
    pointer := pointer^.prev_character;
  dec(current_row);                        {   and move cursor back there. }
  place_cursor(current_row,current_col);
  while (current_row < last_screen_line - 2) and (not error_flag) do
    downarrow(error_flag);
  clreol;
  end_of_line(error_flag);
  error_flag := FALSE;
  pointer := saved_pointer;
  current_row := saved_row;
  current_col := saved_col;
  place_cursor(current_row,current_col);
  goto backspace_exit;
  end;
saved_pointer := pointer;         { Save where we want pointer to end up. }
pointer := pointer^.prev_character;   { Back up to char. we want to delete. }
dec(current_col);
saved_row := current_row;         { Also save cursor position on screen.  }
saved_col := current_col;
place_cursor(current_row,current_col);
if at_beginning_of_file then
  bof_pointer := pointer^.next_character
else
  pointer^.prev_character^.next_character := pointer^.next_character;
pointer^.next_character^.prev_character := pointer^.prev_character;
dispose(pointer);                             { Free up this memory. }
pointer := saved_pointer;
end_of_line(error_flag);    { Error is ok. }
error_flag := FALSE;
clreol;
pointer := saved_pointer;        { Restore everything to where we were. }
current_row := saved_row;
current_col := saved_col;
place_cursor(current_row,current_col);
backspace_exit:
end;

procedure delete_char(var error_flag : boolean);  { Delete current char.. }
begin
rightarrow(error_flag);
if not error_flag then
  backspace(error_flag);
end;

procedure error_message(mess : string);
begin
place_cursor(last_screen_line,1);
clreol;
write(mess,^G);
place_cursor(current_row,current_col);
error_message_on_screen := TRUE;
end;

procedure new_char(the_char : char);    { Inserts typed char. into text. }
label new_char_exit;
var saved_row, saved_col : integer;
  saved_pointer : pointertype;
  error_flag : boolean;
begin
if the_char = chr(13) then      { CR processing. }
  begin
  if current_row = last_screen_line - 1 then   { If at bottom of screen, }
    begin                                      {  move things up a line. }
    saved_col := current_col;
    place_cursor(last_screen_line,1);
    write(^J);
    current_row := last_screen_line - 2;
    current_col := saved_col;
    place_cursor(current_row,current_col);
    end;
  clreol;
  insert_char(chr(13),pointer);    { Insert CR         }
  insert_char(chr(10),pointer);    {   and LF in list. }
  pointer := pointer^.prev_character^.prev_character;  { Point to CR. }
  if not at_beginning_of_line then
    begin
    pointer_bol(pointer,error_flag);
    if error_flag then
      begin
      writeln('*** ERROR #1 in new_char ***');
      halt(1);
      end;          { Pointer is at start of line we returned on. }
    end;
  current_col := 1;
  saved_row := current_row;
  saved_pointer := pointer;
  place_cursor(current_row,current_col);
  error_flag := FALSE;
  while (current_row < last_screen_line - 2) and (not error_flag) do
    downarrow(error_flag);
  clreol;
  end_of_line(error_flag);
  error_flag := FALSE;
  pointer := saved_pointer;
  current_row := saved_row;
  current_col := 1;
  place_cursor(current_row,current_col);
  downarrow(error_flag);
  if error_flag then
    begin
    writeln('*** ERROR after last downarrow while inserting CR ***');
    halt(1);
    end;
  if in_letter_mode then
    begin
    repeat
      write_char_and_update(chr(32),current_row,current_col);
      insert_char(chr(32),pointer);
    until current_col > 15;
    saved_col := current_col;
    saved_row := current_row;
    saved_pointer := pointer;
    clreol;
    end_of_line(error_flag);
    pointer := saved_pointer;
    current_row := saved_row;
    current_col := saved_col;
    place_cursor(current_row,current_col);
    end;
  goto new_char_exit;    { End of CR processing. }
  end;
write_char_and_update(the_char,current_row,current_col);
insert_char(the_char,pointer);       { Insert char. into linked list. }
saved_row := current_row;
saved_col := current_col;
saved_pointer := pointer;
end_of_line(error_flag);     { Write out rest of line; ok if error. }
pointer := saved_pointer;
current_row := saved_row;
current_col := saved_col;
place_cursor(current_row,current_col);

if in_letter_mode and (current_col > 70) then    { Reached right margin? }
  begin
  write(chr(7));
  end;                    { This code needs to be written for right margins. }

new_char_exit:
end;

procedure ensure_cr_and_lf_at_eof;
begin
if  (eof_pointer^.prev_character = bof_pointer)
 or (eof_pointer^.prev_character^.prev_character = bof_pointer)
 or (eof_pointer^.prev_character^.character <> chr(10)) { File term. w CR/LF? }
 or (eof_pointer^.prev_character^.prev_character^.character <> chr(13)) then
  begin
  insert_char(chr(13),eof_pointer);   { We need a cr/lf at eof. }
  insert_char(chr(10),eof_pointer);
  end;
end;


{============================== MAIN CODE ===================================}
begin
clrscr;
if paramcount <> 1 then                { Get name of file to edit. }
  begin
  writeln('');
  writeln('*** ERROR ACTIVATING PROGRAM ***');
  writeln('Use the format:   EDITOR file.ext');
  writeln('');
  halt(2);
  end;
filename := paramstr(1);               { Save file name for later use. }
if pos('.',filename) = 0 then
  filename := filename + '.';

assign(infile,filename);             { Open file. }
{$I-}
reset(infile);
{$I+}
errcode := ioresult;
if errcode <> 0 then                  { Problem opening file? }
  begin
  if errcode = 2 then        { Create file if it doesn't exist. }
    begin
    rewrite(infile);
    close(infile);
    reset(infile);
    end
  else
    begin
    writeln('');
    writeln('*** ERROR; INVALID FILE NAME SPECIFIED ***');
    halt(errcode);                 { Give DOS file lookup error code. }
    end;
  end;
writeln('Loading ',filename,'....');

new(pointer);
bof_pointer := pointer;
pointer^.prev_character := nil;     { Make EOF marker only thing in list. }
pointer^.character := chr(26);
pointer^.next_character := nil;
eof_pointer := pointer;            { Save this pointer. }

ctrl_z_in_file := FALSE;
while not eof(infile) do
  begin
  read(infile,ch);
  if ch = chr(26) then ctrl_z_in_file := TRUE;
  if not ctrl_z_in_file then insert_char(ch,eof_pointer);
  end;
close(infile);

ensure_cr_and_lf_at_eof;         { In case input file had none. }


top_of_file:                           { Puts us on 1st char. of file. }
clrscr;
current_row := 1;
current_col := 1;
pointer := bof_pointer;
while ((current_row < last_screen_line - 1)) and (not at_end_of_file) do
  begin
  write_char_and_update(pointer^.character,current_row,current_col);
  pointer := pointer^.next_character;
  end;
current_row := 1;
current_col := 1;
place_cursor(current_row,current_col);
pointer := bof_pointer;
check_list('List error after initially loading file.');

downarrow(error_flag);

in_letter_mode := TRUE;
error_message('Letter mode on; type Alt-L to toggle letter mode off.');

get_keystrokes:                        { This is where we get all KB input. }
if not keypressed then
  goto get_keystrokes;
key[1] := readkey;
if key[1] = chr(0) then                { It's left in key[1] and key[2].    }
  key[2] := readkey;

if error_message_on_screen then
  begin
  place_cursor(last_screen_line,1);      { Wipe out any message. }
  clreol;
  place_cursor(current_row,current_col);
  error_message_on_screen := FALSE;
  check_list('List error after removing error message from screen.');
  end;

if key[1] = chr(27) then
  error_message('08/07/1992 -- Alt-X: save, Alt-Q: quit, Alt-L: letter mode')
else
if (key[1] = chr(0)) and (key[2] = chr(119)) then
  goto top_of_file
else
if (key[1] = chr(0)) and (key[2] = chr(38)) then
  begin
  if in_letter_mode then
    begin
    in_letter_mode := FALSE;
    error_message('Letter mode turned off; type Alt-L to turn on.');
    end
  else
    begin
    in_letter_mode := TRUE;
    error_message('Letter mode turned on; type Alt-L to turn off.');
    end;
  end
else
if (key[1] = chr(0)) and (key[2] = chr(72)) then
  begin
  uparrow(error_flag);
  if error_flag then
    error_message('Top of file.');
  end
else
if (key[1] = chr(0)) and (key[2] = chr(80)) then
  begin
  downarrow(error_flag);
  if error_flag then
    error_message('End of file.');
  end
else
if (key[1] = chr(0)) and (key[2] = chr(77)) then
  begin
  rightarrow(error_flag);
  if error_flag then
    error_message('End of file.');
  end
else
if (key[1] = chr(0)) and (key[2] = chr(75)) then
  begin
  leftarrow(error_flag);
  if error_flag then
    error_message('Top of file.');
  end
else
if (key[1] = chr(0)) and (key[2] = chr(71)) then
  begin
  home(error_flag);
  if error_flag then
    error_message('Already at beginning of line.');
  end
else
if (key[1] = chr(0)) and (key[2] = chr(79)) then
  begin
  end_of_line(error_flag);
  if error_flag then
    error_message('Already at end of line.');
  end
else
if (key[1] = chr(0)) and (key[2] = chr(81)) then
  begin
  pgdn(error_flag);
  if error_flag then
    error_message('Attempt to page down past end of file.');
  end
else
if (key[1] = chr(0)) and (key[2] = chr(73)) then
  begin
  pgup(error_flag);
  if error_flag then
    error_message('Attempt to page up past top of file.');
  end
else
if (key[1] = chr(0)) and (key[2] = chr(83)) then
  begin
  delete_char(error_flag);
  if error_flag then
    error_message('Attempt to delete past end of file.');
  end
else
if key[1] = chr(8) then
  begin
  backspace(error_flag);
  if error_flag then
    error_message('Attempt to delete past top of file.');
  end
else
if (upcase(key[1]) in ['A'..'Z']) or (key[1] in ['0'..'9'])
 or (key[1] in ['~','`','!','@','#','$','%','^','&','*','(',')'])
 or (key[1] in ['-','_','=','+','\','|','[','{',']','}',';',':'])
 or (key[1] in ['"',',','<','.','>','/','?',' ',chr(13),chr(44),chr(39)]) then
  new_char(key[1])
else
if key[1] = chr(9) then     { Tab should insert 4 spaces. }
  begin
  new_char(chr(32));
  new_char(chr(32));
  new_char(chr(32));
  new_char(chr(32));
  end
else
if (key[1] = chr(0)) and (key[2] = chr(45)) then   { Write out file. }
  begin
  place_cursor(25,1);
  writeln(^J,'Exiting ',filename);
  filenamebak := '';                      { Delete any previous .bak file. }
  for sub := 1 to pos('.',filename) do
    filenamebak := filenamebak + filename[sub];
  filenamebak := filenamebak + 'bak';
  assign(infile,filenamebak);
  {$I-}
  erase(infile);
  {$I+}                  { Error here is ok as backup may not exist. }
  if ioresult <> 0 then  {  Test ioresult to clear it, though.       }
    write('');           { Do nothing. }
  assign(infile,filename);          { Now rename current file to backup. }
  {$I-}
  rename(infile,filenamebak);
  {$I+}
  if ioresult <> 0 then
    begin
    writeln('*** Error renaming current file to .bak ***');
    writeln('Filename:    ',filename);
    writeln('Filenamebak: ',filenamebak);
    halt(1);
    end;
  assign(infile,filename);          { Now write out file. }
  rewrite(infile);
  ensure_cr_and_lf_at_eof;    { In case user left non-terminated line at eof. }
  pointer := bof_pointer;
  while pointer^.character <> chr(26) do
    begin
    write(infile,pointer^.character);
    pointer := pointer^.next_character;
    end;
  if ctrl_z_in_file then
    write(infile,chr(26));
  close(infile);
  halt(0);
  end
else
if (key[1] = chr(0)) and (key[2] = chr(16)) then   { Quit. }
  begin
  place_cursor(25,1);
  writeln(^J,'Quitting ',filename);
  halt(0);
  end
else
  begin
  place_cursor(last_screen_line,1);  { Write out key codes on last line. }
  clreol;
  write('Key code: ',ord(key[1]));
  if ord(key[1]) = 0 then
    write(',',ord(key[2]));
  if key[1] = chr(1) then
    write('      List count: ',list_count);
  place_cursor(current_row,current_col);
  end;
goto get_keystrokes;

end.