Power-Programmierung/CD1.mdf/euphoria/ed.ex

Text File | 1994-03-10 | 32KB | 1,326 lines

    ----------------------------------------------------------
    --       This Euphoria Editor was developed by          --
    --            Rapid Deployment Software.                --
    --                                                      --
    -- Permission is freely granted to anyone to modify     --
    -- and/or redistribute this editor (ed.ex, syncolor.e). --
    -- You may even sell it as it is, or with your          --
    -- modifications.                                       --
    ----------------------------------------------------------

without type_check -- makes it a bit faster

include graphics.e

constant TRUE = 1,
     FALSE = 0

-- i/o devices
constant KEYB = 0
global constant SCREEN = 1

-- screen dimensions
constant INIT_SCREEN_LENGTH = 25, -- 25, 28, 43, 50
     SCREEN_WIDTH = 80

-- colors
constant TOP_LINE_TEXT_COLOR = 0,
     TOP_LINE_BACK_COLOR = 14,
     BACKGROUND_COLOR = 7

-- colors needed by syncolor.e:
-- Adjust to suit your monitor and your taste.
global constant NORMAL_COLOR = 8,
        COMMENT_COLOR = 4,
        KEYWORD_COLOR = 1,
        BUILTIN_COLOR = 5,
        STRING_COLOR = 6
global constant bracket_color = {NORMAL_COLOR, 0, 14, 2, 15, 3, 9}

-- cursor style
constant ED_CURSOR = UNDERLINE_CURSOR

constant TAB_WIDTH = 8

global constant BLANK_LINE = repeat('\t', SCREEN_WIDTH/TAB_WIDTH)

-- special input characters
constant ESCAPE = 27,
     CR = 13,
     BS = 8,
     HOME = 327,
     PAGE_UP = 329,
     END = 335,
     PAGE_DOWN = 337,
     INSERT = 338,
     DELETE = 339,
     CONTROL_DELETE = 403,
     ARROW_LEFT = 331,
     ARROW_RIGHT = 333,
     ARROW_UP = 328,
     ARROW_DOWN = 336

constant CONTROL_CHARS = {ESCAPE, BS, DELETE, PAGE_UP, PAGE_DOWN,
              INSERT, CONTROL_DELETE,
              ARROW_LEFT, ARROW_RIGHT, ARROW_UP, ARROW_DOWN,
              HOME, END}

sequence buffer -- In-memory buffer where the file is manipulated.
-- This is a sequence where each element is a sequence
-- containing one line of text.
-- Each line of text, except possibly the last one, ends with '\n'

type natural(integer x)
    return x >= 0
end type

type positive_int(integer x)
    return x >= 1
end type

positive_int screen_length
screen_length = INIT_SCREEN_LENGTH

type screen_line(integer x)
-- a valid line on the screen
    return x >= 1 and x <= screen_length
end type

type screen_col(integer x)
-- a valid column on the screen
    return x >= 1 and x <= SCREEN_WIDTH
end type

type buffer_line(integer x)
-- a valid buffer line
    return x >= 1 and x <= length(buffer)
end type

type char(integer x)
-- a character
    return x >= 0 and x <= 511
end type

type extended_char(integer x)
    return char(x) or x = -1
end type

type boolean(integer x)
    return x = TRUE or x = FALSE
end type

type file_number(integer x)
    return x >= -1
end type

-- auto-completion of Euphoria statements ---------------------------
boolean auto_complete
auto_complete = TRUE  -- set to FALSE if you'd rather not have it
---------------------------------------------------------------------

sequence file_name   -- name of the file that we are editing

-- These are the critical variables that all editing operations
-- must update:
buffer_line  b_line  -- current line in buffer
positive_int b_col   -- current character within line in buffer
screen_line  s_line  -- line on screen corresponding to b_line
screen_col   s_col   -- column on screen corresponding to b_col

boolean stop         -- indicates when to quit editing this file

sequence kill_buffer -- kill buffer of deleted lines or characters
kill_buffer = {}

boolean adding_to_kill -- TRUE if still accumulating deleted lines/chars

boolean multi_color   -- use colors for keywords etc.
boolean dot_e        -- TRUE if this is a .e/.ex file
boolean modified     -- TRUE if file has been modified
boolean view_only    -- binary file - view but don't save
boolean top_line_set

natural start_line, start_col

sequence error_message

sequence config -- video configuration

procedure delay(atom n)
-- an n second pause while a message is on the screen
    atom t

    t = time()
    while time() < t + n do
    end while
end procedure

function tab(positive_int pos)
-- compute equivalent number of spaces for tab
    return(floor((pos - 1) / TAB_WIDTH) + 1) * TAB_WIDTH + 1
end function

-- color display of lines
include syncolor.e

procedure DisplayLine(buffer_line line, screen_line sline, boolean all_clear)
-- display a buffer line on a given line on the screen
-- all_clear indicates that trailing whitespace is not necessary
    sequence this_line
    natural last

    this_line = buffer[line]
    last = length(this_line)
    if this_line[last] = '\n' then
    last = last - 1
    end if
    position(sline, 1)
    if multi_color then
    -- color display
    DisplayColorLine(this_line[1..last], all_clear)
    else
    -- monochrome display
    if all_clear then
        puts(SCREEN, this_line[1..last])
    else
        puts(SCREEN, this_line[1..last] & BLANK_LINE)
    end if
    end if
end procedure

procedure DisplayScreen(positive_int bline, screen_line sline)
-- print a series of buffer lines, starting at sline on screen
-- and continue until the end of screen, or end of buffer
    boolean all_clear

    if sline = 1 then
    clear_screen() -- faster
    all_clear = TRUE
    else
    all_clear = FALSE
    end if
    for b = bline to length(buffer) do
    DisplayLine(b, sline, all_clear)
    if sline = screen_length then
        return
    else
        sline = sline + 1
    end if
    end for
    -- blank any remaining screen lines after end of file
    if not all_clear then
    for s = sline to screen_length do
        position(s, 1)
        puts(SCREEN, BLANK_LINE)
    end for
    end if
end procedure

function add_line(file_number file_no)
-- add a new line to the buffer
    object line

    line = gets(file_no)
    if atom(line) then
    return FALSE -- end of file
    end if
    if length(line) = 0 then
    -- not a text file
    line = "\n"
    view_only = TRUE
    end if
    buffer = append(buffer, line)
    return TRUE
end function

procedure read_file(file_number file_no)
-- read the entire file into buffer variable

    buffer = {}

    -- read and immediately display the first screenful
    for i = 1 to screen_length do
    if not add_line(file_no) then
        exit
    end if
    end for
    DisplayScreen(1, 1)

    -- read the rest
    while add_line(file_no) do
    end while
end procedure

procedure blank_top_line()
    position(1, 1)
    puts(SCREEN, BLANK_LINE)
    position(1, 1)
end procedure

procedure reverse_video()
-- start inverse video
    text_color(TOP_LINE_TEXT_COLOR)
    bk_color(TOP_LINE_BACK_COLOR)
end procedure

procedure normal_video()
-- end inverse video
    text_color(NORMAL_COLOR)
    bk_color(BACKGROUND_COLOR)
end procedure

procedure set_top_line(sequence message)
    -- set up message on top line
    reverse_video()
    blank_top_line()
    puts(SCREEN, message)
    top_line_set = TRUE
end procedure

procedure clear_top_line()
    -- restore top line
    if length(buffer) = 0 then
    blank_top_line()
    elsif top_line_set then
    DisplayLine(b_line - s_line + 1, 1, FALSE)
    position(s_line, s_col)
    end if
    top_line_set = FALSE
end procedure

procedure save_file(sequence file_name)
-- write buffer back into the disk file
    file_number file_no

    set_top_line("")
    if view_only then
    printf(SCREEN, "Can't save %s - it contains non-text characters",
           {file_name})
    delay(3)
    stop = FALSE
    return
    end if
    file_no = open(file_name, "w")
    if file_no = -1 then
    printf(SCREEN, "Can't save %s - write permission denied",
          {file_name})
    delay(3)
    stop = FALSE
    return
    end if
    printf(SCREEN, "saving %s ...          ", {file_name})
    for i = 1 to length(buffer) do
    puts(file_no, buffer[i])
    end for
    close(file_no)
    stop = TRUE
end procedure

procedure arrow_right()
-- action for right arrow key

    positive_int temp_col

    if s_col < SCREEN_WIDTH and b_col < length(buffer[b_line]) then
    if buffer[b_line][b_col] = '\t' then
        temp_col = tab(s_col)
    else
        temp_col = s_col + 1
    end if
    if temp_col > SCREEN_WIDTH then
        return
    end if
    s_col = temp_col
    b_col = b_col + 1
    end if
end procedure

procedure arrow_left()
-- action for left arrow key

    positive_int old_b_col

    old_b_col = b_col
    b_col = 1
    s_col = 1
    for i = 1 to old_b_col - 2 do
    arrow_right()
    end for
end procedure

procedure arrow_up()
-- action for up arrow key

    b_col = 1
    s_col = 1
    if b_line > 1 then
    b_line = b_line - 1
    if s_line > 1 then
        s_line = s_line - 1
        if s_line = 1 then
        clear_top_line()
        end if
    else
        -- move all lines down, display new line at top
        scroll(-1)
        DisplayLine(b_line, 1, TRUE)
        position(1, 1)
        s_line = 1
    end if
    end if
end procedure

procedure arrow_down()
-- action for down arrow key

    b_col = 1
    s_col = 1
    if b_line < length(buffer) then
    b_line = b_line + 1
    if s_line < screen_length then
        s_line = s_line + 1
    else
        -- move all lines up, display new line at bottom
        scroll(+1)
        DisplayLine(b_line, screen_length, TRUE)
    end if
    end if
end procedure

function numeric(sequence string)
-- convert digit string to a number
    natural n
    positive_int i

    n = 0
    i = 1
    while string[i] >= '0' and string[i] <= '9' do
    n = n * 10 + string[i] - '0'
    i = i + 1
    end while
    return n
end function

procedure goto_line(integer new_line, integer new_col)
-- move to a specified line and column
-- refresh screen if line is 0
    integer new_s_line
    boolean refresh

    if length(buffer) = 0 then
    clear_screen()
    return
    end if
    if new_line = 0 then
    new_line = b_line
    refresh = TRUE
    else
    refresh = FALSE
    end if
    if new_line < 1 then
    new_line = 1
    elsif new_line > length(buffer) then
    new_line = length(buffer)
    end if
    new_s_line = new_line - b_line + s_line
    b_line = new_line
    if not refresh and screen_line(new_s_line) then
    -- new line is on the screen
    s_line = new_s_line
    else
    -- new line is off the screen, or refreshing
    position(1, 1)
    s_line = floor(screen_length/2)
    if s_line > b_line or length(buffer) < screen_length then
        s_line = b_line
    elsif b_line > length(buffer) - screen_length + s_line then
        s_line = screen_length - (length(buffer) - b_line)
    end if
    DisplayScreen(b_line - s_line + 1, 1)
    end if
    b_col = 1
    s_col = 1
    position(s_line, s_col)
    for i = 1 to new_col-1 do
    arrow_right()
    end for
end procedure

procedure page_down()
-- action for page-down key
    buffer_line prev_b_line

    if length(buffer) <= screen_length then
    return
    end if
    prev_b_line = b_line
    b_col = 1
    s_col = 1
    if b_line + screen_length + screen_length - s_line <= length(buffer) then
    b_line = b_line + screen_length
    else
    b_line = length(buffer) - (screen_length - s_line)
    end if
    if b_line != prev_b_line then
    DisplayScreen(b_line - s_line + 1, 1)
    end if
end procedure

procedure page_up()
-- action for page-up key
    buffer_line prev_b_line

    if length(buffer) <= screen_length then
    return
    end if
    prev_b_line = b_line
    b_col = 1
    s_col = 1
    if b_line - screen_length >= s_line then
    b_line = b_line - screen_length
    else
    b_line = s_line
    end if
    if b_line != prev_b_line then
    DisplayScreen(b_line - s_line + 1, 1)
    end if
end procedure

procedure new_screen_length()
-- set new number of lines on screen
    natural nlines

    set_top_line("")
    puts(SCREEN, "How many lines on screen? (25, 28, 43, 50) ")
    nlines = numeric(gets(KEYB))
    if nlines then
    screen_length = text_rows(nlines)
    if screen_length != nlines then
        sound(500)
    end if
    normal_video()
    goto_line(0, b_col) -- refresh
    if screen_length != nlines then
        sound(0)
    end if
    end if
end procedure

-- searching/replacing variables
boolean searching, replacing
searching = FALSE
replacing = FALSE

sequence prev_string
prev_string = ""
sequence replace_string -- new string to replace with

procedure replace(sequence old_string)
-- replace old string by new
-- we are currently positioned at the start of old string
    sequence line

    modified = TRUE
    line = buffer[b_line]
    line = line[1..b_col-1] & replace_string & line[b_col+length(old_string)..
                        length(line)]
    buffer[b_line] = line
    DisplayLine(b_line, s_line, FALSE)
end procedure

function search(boolean continue)
-- find a string from here to the end of the file
-- return TRUE if string is found
    natural col
    sequence old_string

    if length(buffer) = 0 then
    puts(SCREEN, "buffer empty")
    return FALSE
    end if
    set_top_line("")
    if length(prev_string) = 0 then
    puts(SCREEN, "searching for:")
    else
    printf(SCREEN, "searching for \"%s\":", {prev_string})
    end if
    if continue then
    old_string = ""
    else
    old_string = gets(KEYB)
    old_string = old_string[1..length(old_string)-1]
    if replacing then
        set_top_line("")
        puts(SCREEN, "replace with:")
        replace_string = gets(KEYB)
        replace_string = replace_string[1..length(replace_string)-1]
    end if
    end if

    normal_video()
    if length(old_string) = 0 then
    old_string = prev_string
    end if
    if length(old_string) = 0 then
    return FALSE
    end if
    prev_string = old_string
    col = match(old_string, buffer[b_line][b_col+1..length(buffer[b_line])])
    if col and s_col < SCREEN_WIDTH then
    -- found it on this line after current position
    for i = 1 to col do
        arrow_right()
    end for
    if replacing then
        replace(old_string)
    end if
    return TRUE
    else
    -- check lines following this one
    for b = b_line+1 to length(buffer) do
        col = match(old_string, buffer[b])
        if col then
        goto_line(b, 1)
        for i = 1 to col - 1 do
           arrow_right()
        end for
        if replacing and s_col < SCREEN_WIDTH then
            replace(old_string)
        end if
        set_top_line("")
        printf(SCREEN, "searching for \"%s\":", {prev_string})
        return TRUE
        end if
    end for
    set_top_line("")
    printf(SCREEN, "\"%s\" not found", {old_string})
    end if
    return FALSE
end function

procedure show_message()
-- display error message from ex.err
    if length(error_message) > 0 then
    set_top_line(error_message)
    normal_video()
    if start_line = 1 then
        delay(3)
        clear_top_line()
    end if
    end if
    position(s_line, s_col)
end procedure

function get_err_line()
-- try to get file name & line number from ex.err
-- returns file_name, sets start_line, start_col, error_message

    file_number err_file
    sequence file_name
    sequence err_lines
    object temp_line
    natural colon_pos

    err_file = open("ex.err", "r")
    if err_file = -1 then
    error_message = ""
    else
    -- read the top of the ex.err error message file
    err_lines = {}
    while length(err_lines) < 5 do
        temp_line = gets(err_file)
        if atom(temp_line) then
        exit
        end if
        err_lines = append(err_lines, temp_line)
    end while
    close(err_file)
    -- look for file name, line, column and error message
    if length(err_lines) > 0 then
        if sequence(err_lines[1]) then
        colon_pos = match(".e", err_lines[1])
        if colon_pos then
            if err_lines[1][colon_pos+2] = 'x' then
            colon_pos = colon_pos + 1
            end if
            file_name = err_lines[1][1..colon_pos+1]
            start_line = numeric(err_lines[1][colon_pos+3..
                              length(err_lines[1])])
            error_message = err_lines[2]
            if length(err_lines) > 3 then
            start_col = find('^', err_lines[length(err_lines)-1])
            end if
            return file_name
        end if
        end if
    end if
    end if
    return ""
end function

procedure shell(sequence command, boolean wait)
-- run a DOS command
    bk_color(0)
    text_color(7)
    clear_screen()
    system(command, wait)
    normal_video()
    while get_key() != -1 do
    end while
end procedure

procedure first_bold(sequence string)
-- highlight first char
    text_color(TOP_LINE_TEXT_COLOR)
    puts(SCREEN, string[1])
    text_color(TOP_LINE_TEXT_COLOR + 8)
    puts(SCREEN, string[2..length(string)])
end procedure

procedure get_escape(boolean help)
-- process escape command
    sequence command, dos_command, answer
    natural line

    cursor(ED_CURSOR)

    set_top_line("")
    if help then
    command = "h"
    else
    first_bold("help  ")
    first_bold("quit  ")
    first_bold("save  ")
    first_bold("write  ")
    if dot_e then
        first_bold("ex  ")
    end if
    first_bold("dos  ")
    first_bold("new  ")
    first_bold("find  ")
    first_bold("replace  ")
    first_bold("lines  ")
    text_color(TOP_LINE_TEXT_COLOR)
    puts(SCREEN, "<ddd>  <cr>: ")
    command = gets(KEYB)
    if length(command) = 0 then
        command = " "
    end if
    end if

    if command[1] = 'f' then
    replacing = FALSE
    searching = search(FALSE)

    elsif command[1] = 'r' then
    replacing = TRUE
    searching = search(FALSE)

    elsif command[1] = 'q' then
    if modified then
        set_top_line("quit without saving changes? ")
        if match("y", gets(KEYB)) then
        file_name = ""
        stop = TRUE
        end if
    else
        file_name = ""
        stop = TRUE
    end if

    elsif command[1] = 'n' then
    stop = TRUE
    if modified then
        set_top_line("")
        printf(SCREEN, "save changes to %s? ", {file_name})
        if match("y", gets(KEYB)) then
        save_file(file_name)
        end if
    end if
    blank_top_line()
    puts(SCREEN, "new file name? ")
    file_name = gets(KEYB)
    file_name = file_name[1..length(file_name)-1] -- drop the \n

    elsif command[1] = 'w' then
    save_file(file_name)
    modified = FALSE
    stop = FALSE

    elsif command[1] = 's' then
    save_file(file_name)
    if stop then
        file_name = ""
    end if

    elsif command[1] = 'e' and dot_e then
    if modified then
        save_file(file_name)
        modified = FALSE
        stop = FALSE
    end if
    -- execute the current file & return
    system("del ex.err > NUL", 0)
    shell("ex " & file_name, TRUE)
    goto_line(0, b_col)
    if compare(file_name, get_err_line()) = 0 then
        goto_line(start_line, start_col)
        show_message()
    end if

    elsif command[1] = 'd' then
    set_top_line("")
    puts(SCREEN, "DOS command? ")
    dos_command = gets(KEYB)
    dos_command = dos_command[1..length(dos_command)-1]
    shell(dos_command, TRUE)
    goto_line(0, b_col) -- refresh screen

    elsif command[1] = 'h' then
    set_top_line("")
    dos_command = getenv("EUDIR")
    if atom(dos_command) then
        dos_command = "ed C:\\EUPHORIA\\DOC"
    else
        dos_command = "ed " & dos_command & "\\DOC"
    end if
    if help then
        puts(SCREEN,
        "That key does nothing - do you want to view the help text? ")
        answer = gets(KEYB)
        if answer[1] != 'n' and answer[1] != 'N' then
        answer = "e"
        end if
    else
        puts(SCREEN, "Help text for ed, or for Euphoria? (e or E): ")
        answer = gets(KEYB)
    end if
    if answer[1] = 'E' then
        shell(dos_command & "\\REFMAN.DOC", FALSE)
    elsif answer[1] = 'e' then
        shell(dos_command & "\\ED.DOC", FALSE)
    else
        normal_video()
    end if
    goto_line(0, b_col)

    elsif command[1] = 'l' then
    new_screen_length()

    elsif command[1] >= '0' and command[1] <= '9' then
    line = numeric(command)
    normal_video()
    goto_line(line, 1)
    if not buffer_line(line) then
        set_top_line("")
        printf(SCREEN, "lines are 1..%d", length(buffer))
        if s_line = 1 then
        delay(3)
        end if
    end if

    else
    set_top_line("")
    if length(buffer) = 0 then
        puts(SCREEN, "empty buffer")
        delay(3)
    else
        printf(SCREEN, "%s line %d of %d, column %d of %d, ",
               {file_name, b_line, length(buffer), s_col,
            SCREEN_WIDTH})
        if modified then
        puts(SCREEN, "modified")
        else
        puts(SCREEN, "not modified")
        end if
        if s_line = 1 then
        delay(3)
        end if
    end if
    end if

    normal_video()
    if s_line = 1 or length(buffer) = 0 then
    clear_top_line()
    end if
end procedure


procedure insert(char key)
-- insert a character into the current line at the current position

    sequence tail
    positive_int new_col, b_col_save
    screen_col s_col_save

    modified = TRUE
    tail = buffer[b_line][b_col..length(buffer[b_line])]
    if key = CR or key = '\n' then
    -- truncate this line and create a new line using tail
    buffer[b_line] = buffer[b_line][1..b_col-1] & '\n'
    buffer = append(buffer[1..b_line], tail) &
            buffer[b_line+1..length(buffer)]
    if s_line = screen_length then
        s_col_save = s_col
        b_col_save = b_col
        arrow_down()
        arrow_up()
        s_col = s_col_save
        b_col = b_col_save
        position(s_line, s_col)
    end if
    DisplayScreen(b_line, s_line)
    b_line = b_line + 1
    s_line = s_line + 1
    s_col = 1
    b_col = 1
    else
    if key = '\t' then
        new_col = tab(s_col)
    else
        new_col = s_col + 1
    end if
    if new_col > SCREEN_WIDTH then
        return
    else
        s_col = new_col
    end if
    buffer[b_line] = buffer[b_line][1..b_col-1] & key & tail
    DisplayLine(b_line, s_line, TRUE)
    b_col = b_col + 1
    end if
    position(s_line, s_col)
end procedure

procedure insert_string(sequence text)
-- insert a bunch of characters at the current position
    natural save_line, save_col

    save_line = b_line
    save_col = b_col
    for i = 1 to length(text) do
    if text[i] = CR or text[i] = '\n' then
        insert(text[i])
    else
        buffer[b_line] = buffer[b_line][1..b_col-1] & text[i] &
                 buffer[b_line][b_col..length(buffer[b_line])]
        b_col = b_col + 1
        if i = length(text) then
        DisplayLine(b_line, s_line, TRUE)
        end if
    end if
    end for
    goto_line(save_line, save_col)
end procedure

-- expandable words & corresponding text
constant expand_word = {"if", "for", "while", "elsif",
            "procedure", "type", "function"},

     expand_text = {" then", "=  to  by  do", " do", " then",
            "()",
            "()" & CR & "    return",
            "()" & CR & "    return"}

procedure try_auto_complete()
-- check for a keyword that can be automatically completed
    sequence word, this_line, white_space
    natural first_non_blank, wordnum

    insert(' ')
    if not auto_complete then
    return
    end if
    this_line = buffer[b_line]
    white_space = this_line = ' ' or this_line = '\t'
    first_non_blank = find(0, white_space)
    if first_non_blank > 0 and first_non_blank < b_col - 2 then
    if not find(0, white_space[b_col..length(white_space)-1]) then
        word = this_line[first_non_blank..b_col - 2]
        wordnum = find(word, expand_word)
        if wordnum > 0 then
        sound(1000)
        -- expandable word (only word on line)
        if compare(expand_word[wordnum], "elsif") = 0 then
            insert_string(expand_text[wordnum])
            delay(0.07) -- or beep is too short
        else
            insert_string(expand_text[wordnum] & CR &
                  this_line[1..first_non_blank - 1] &
                  "end " & expand_word[wordnum])
        end if
        sound(0)
        end if
    end if
    end if
end procedure

procedure insert_kill_buffer()
-- insert the kill buffer at the current position
-- kill buffer could be a sequence of lines or a sequence of characters

    if length(kill_buffer) = 0 then
    return
    end if
    if atom(kill_buffer[1]) then
    -- inserting a sequence of chars
    insert_string(kill_buffer)
    else
    -- inserting a sequence of lines
    modified = TRUE
    buffer = buffer[1..b_line - 1] &
         kill_buffer &
         buffer[b_line..length(buffer)]
    DisplayScreen(b_line, s_line)
    arrow_up()
    arrow_down()
    end if
end procedure

procedure delete_line(buffer_line dead_line)
-- delete a line from the buffer and update the display if necessary

    integer x

    modified = TRUE
    buffer = buffer[1..dead_line-1] & buffer[dead_line+1 .. length(buffer)]
    x = dead_line - b_line + s_line
    if screen_line(x) then
    -- dead line is on the screen at line x
    if x < screen_length/3 then
        -- upper portion of screen
        -- faster to scroll up, then reprint top few lines
        -- (although top of screen will flicker a bit)
        for i = x to 2 by -1 do
        -- less noisy if we blank top lines before scrolling
        position(i, 1)
        puts(SCREEN, BLANK_LINE)
        end for
        scroll(+1)
        for i = x - 1 to 1 by -1 do
        -- redisplay top lines
        DisplayLine(b_line - s_line + i, i, TRUE)
        end for
        if length(buffer) - b_line >= screen_length - s_line then
        -- show new line at bottom
        DisplayLine(b_line + screen_length - s_line,
                screen_length, TRUE)
        end if
    else
        -- lower portion of screen
        DisplayScreen(dead_line, x)
    end if
    end if
    if b_line = 1 then
    arrow_down()
    arrow_up()
    else
    arrow_up()
    arrow_down()
    end if
    adding_to_kill = TRUE
end procedure


procedure delete_char()
-- delete the character at the current position
    char dchar
    sequence head
    natural save_b_col

    modified = TRUE
    dchar = buffer[b_line][b_col]
    head = buffer[b_line][1..b_col - 1]
    if dchar = '\n' and b_line < length(buffer) then
    -- join this line with the next one and delete the next one
    buffer[b_line] = head & buffer[b_line+1]
    DisplayLine(b_line, s_line, FALSE)
    save_b_col = b_col
    delete_line(b_line + 1)
    for i = 1 to save_b_col - 1 do
        arrow_right()
    end for
    else
    buffer[b_line] = head & buffer[b_line][b_col+1..length(buffer[b_line])]
    if length(buffer[b_line]) = 0 then
        delete_line(b_line)
    else
        DisplayLine(b_line, s_line, FALSE)
        if b_col > length(buffer[b_line]) then
        arrow_left()
        end if
    end if
    end if
    adding_to_kill = TRUE
end procedure


function good(extended_char key)
-- return TRUE if key should be processed
    if find(key, CONTROL_CHARS & '\t' & CR) or (key >= ' ' and key <= 127) then
    return TRUE
    else
    return FALSE
    end if
end function

procedure edit_file()
-- edit the file in buffer
    extended_char key

    position(1, 1)
    s_line = 1
    s_col = 1
    b_line = 1
    b_col = 1
    if length(buffer) > 0 then
    if start_line > 0 then
        if start_line > length(buffer) then
        start_line = length(buffer)
        end if
        goto_line(start_line, start_col)
        show_message()
    end if
    end if
    cursor(ED_CURSOR)
    stop = FALSE
    while not stop do
    key = get_key()

    if good(key) then
        -- normal key

        -- hide cursor while we update the screen
        cursor(NO_CURSOR)

        if length(buffer) = 0 and key != ESCAPE then
        -- empty buffer
        -- only allowed action is to insert something
        if key = INSERT or not find(key, CONTROL_CHARS) then
            -- initialize buffer
            buffer = {{'\n'}} -- one line with \n
            b_line = 1
            b_col = 1
            s_line = 1
            s_col = 1
            if key = INSERT then
            insert_kill_buffer()
            else
            insert(key)
            end if
            DisplayLine(1, 1, FALSE)
        end if

        elsif key = DELETE then
        if not adding_to_kill then
            kill_buffer = {buffer[b_line][b_col]}
        elsif sequence(kill_buffer[1]) then
            -- we were building up deleted lines,
            -- but now we'll switch to chars
            kill_buffer = {buffer[b_line][b_col]}
        else
            kill_buffer = append(kill_buffer, buffer[b_line][b_col])
        end if
        delete_char()

        elsif key = CONTROL_DELETE then
        if not adding_to_kill then
            kill_buffer = {buffer[b_line]}
        elsif atom(kill_buffer[1]) then
            -- we were building up deleted chars,
            -- but now we'll switch to lines
            kill_buffer = {buffer[b_line]}
        else
            kill_buffer = append(kill_buffer, buffer[b_line])
        end if
        delete_line(b_line)

        else
        if key = ARROW_DOWN then
            arrow_down()

        elsif key = ARROW_UP then
            arrow_up()

        elsif key = INSERT then
            insert_kill_buffer()

        elsif key = ARROW_LEFT then
            arrow_left()

        elsif key = ARROW_RIGHT then
            arrow_right()

        elsif key = ' ' then
            try_auto_complete()

        elsif key = BS then
            arrow_left()
            delete_char()

        elsif key = PAGE_DOWN then
            page_down()

        elsif key = PAGE_UP then
            page_up()

        elsif key = HOME then
            goto_line(1, 1)

        elsif key = END then
            goto_line(length(buffer), 1)

        elsif key = ESCAPE then
            -- special command
            get_escape(FALSE)

        elsif key = CR then
            if searching then
            searching = search(TRUE)
            normal_video()
            searching = TRUE -- avoids accidental <CR> insertion
            else
            insert(key)
            end if

        else
            insert(key)

        end if

        adding_to_kill = FALSE

        end if

        if key != CR and key != ESCAPE then
        searching = FALSE
        end if
        position(s_line, s_col)
        cursor(ED_CURSOR)
    elsif key != -1 then
        -- illegal key pressed
        get_escape(TRUE)  -- give him some help
    end if
    end while
end procedure

function delete_trailing_white(sequence name)
-- get rid of blanks, tabs, newlines at end of string
    while find(name[length(name)], "\n\r\t ") do
    name = name[1..length(name)-1]
    if length(name) = 0 then
        exit
    end if
    end while
    return name
end function

function lower(sequence s)
-- convert to lower case
    for i = 1 to length(s) do
    if s[i] >= 'A' and s[i] <= 'Z' then
        s[i] = s[i] + 'a' - 'A'
    end if
    end for
    return s
end function

procedure ed(sequence command)
-- editor main procedure
-- ed.ex is executed by ed.bat
-- command line will be:
--    ex ed.ex              - get filename etc. from ex.err
--    ex ed.ex filename     - filename specified

    file_number file_no

    start_line = 0
    start_col = 0

    if length(command) >= 3 then
    file_name = lower(command[3])
    else
    file_name = get_err_line()
    end if
    if length(file_name) = 0 then
    -- we still don't know the file name - so ask user
    puts(SCREEN, "file name? ")
    cursor(ED_CURSOR)
    file_name = gets(KEYB)
    end if
    file_name = delete_trailing_white(file_name)
    if length(file_name) = 0 then
    stop = TRUE
    return -- file_name was just whitespace - quit
    end if
    file_no = open(file_name, "r")

    -- turn off multi_color & auto_complete for non .e files
    multi_color = TRUE
    dot_e = FALSE
    if not config[VC_COLOR] then
    multi_color = FALSE -- mono monitor
    end if
    file_name = file_name & ' '
    dot_e = match(".ex ", file_name) or match(".e ", file_name) or
        match(".pro ", file_name)
    file_name = file_name[1..length(file_name)-1]
    if not dot_e then
    multi_color = FALSE
    auto_complete = FALSE
    end if
    if multi_color then
    init_class()
    end if

    top_line_set = FALSE
    adding_to_kill = FALSE
    modified = FALSE
    view_only = FALSE
    normal_video()
    wrap(0)
    if file_no = -1 then
    buffer = {}
    clear_screen()
    puts(SCREEN, "new file - ")
    puts(SCREEN, file_name)
    delay(1.5)
    position(1, 1)
    puts(SCREEN, BLANK_LINE)
    else
    position(1, 1)
    cursor(NO_CURSOR)
    read_file(file_no)
    close(file_no)
    end if
    edit_file()
end procedure

config = video_config()

if config[VC_XPIXELS] > 0 then
    if graphics_mode(3) then
    end if
    config = video_config()
end if

screen_length = config[VC_LINES]

ed(command_line())
while length(file_name) > 0 do
    ed({"ex", "ed.e" , file_name})
end while

-- exit editor
if screen_length != 25 then
    screen_length = text_rows(25)
end if
bk_color(0)
text_color(0)
position(screen_length, 1)
puts(SCREEN, BLANK_LINE)
position(screen_length, 1)
text_color(7)
puts(SCREEN, " \n")