! EMACSTPU.TPU - EMACS emulation command file for VAX/VMS TPU editor ! ! Used VAX/TPU to support limited EMACS interface with following ! major differences: ! ! 1) Must use PF1 key instead of ESCAPE for meta sequences. TPU ! will not pass an ESCAPE character thru by itself. ! 2) Lines over 80 characters are not wrapped, but the screen may ! be shifted. To shift screen, set universal argument to ! desired column (left-most column is 1) and user meta-s ! (i.e., PF1-s). ! 3) May execute TPU commands using ^X-! sequence. The TPU command ! "SP" will spawn another process. The TPU command "DCL" will ! attach to another process in a buffer window. ! ! Should be used with command procedure EMACSTPU.COM. ! ! Author: Jeff Flowers ! Pilot Executive Software, Inc. ! 40 Broad Street ! Boston, MA 02109 ! ! *** emacs_init_variables: initialize global variables *** procedure emacs_init_variables ! initialize variables ! Global constants true := 1; ! standard true and false false := 0; emacs_version := "EMACS-TPU V1.0 04/17/86"; ! version number emacs_tab_set := 4; ! default tabs every four emacs_universal_count := 0; ! used for universal count emacs_ctrl_x_save := ""; ! last ctrl-x command on universal emacs_search_string := ""; ! most recent search string emacs_previous_buffer := "MAIN"; ! previous buffer name emacs_kill_position := 0; ! place text was last killed emacs_refresh_position := 0; ! place refresh last occurred emacs_process := 0; ! no process cranked up emacs_other_window := 0; ! only one window emacs_shift_column := 1; ! what column to display emacs_macro := 0; ! emacs macro sequence emacs_letters := "ABCDEFGHIJKLMNOPQRSTUVWXYZ_0123456789"; emacs_word := span(emacs_letters); ! match word patern endprocedure; ! *** upcase - make string upper-case *** procedure upcase(string_in) local string_out; string_out := string_in; ! make copy change_case(string_out, upper); ! make upper case return(string_out); endprocedure; ! *** searchstr - return position of first character found in string *** procedure searchstr(string_data, characters_data) local pos, temp; pos := 1; loop if pos > length(characters_data) then return(0); endif; if index(string_data, substr(characters_data, pos, 1)) > 0 then return(pos); endif; pos := pos + 1; endloop; endprocedure; ! *** ask_user: prompt user for input *** procedure ask_user(prompt_string) local response; response := ""; ! nothing said yet loop ! read stuff until done response := response + read_line(prompt_string + response); ! read stuff giving current if last_key = key_name(ctrl_g_key) then emacs_abort; endif; if (last_key = key_name(ctrl_h_key)) or (last_key = key_name(del_key)) then response := substr(response, 1, length(response) - 1); ! erase char else if last_key = key_name(ctrl_q_key) then response := response + read_char; message(prompt_string + response); else message(prompt_string + response); ! put it in message buffer update(message_window); ! make sure up to date return(response); endif; endif; endloop; endprocedure; ! *** err_message - print out error message with bell *** procedure err_message(message_text) set(bell, all, on); message(message_text); set(bell, all, off); set(bell, broadcast, on); endprocedure; ! *** dcl - run DCL command in separate process *** procedure dcl local dcl_text; if get_info(dcl_buffer, "type") <> buffer then dcl_buffer := emacs_system_buffer("DCL"); endif; if get_info(emacs_process, "type") <> process then ! create a new process message("Creating process..."); emacs_process := create_process(dcl_buffer); message(fao("Created process !XL.", get_info(emacs_process, "pid"))); endif; dcl_text := ask_user("DCL command? "); if current_buffer <> dcl_buffer then emacs_select_buffer("DCL"); position(end_of(current_buffer)); update(current_window); endif; if dcl_text <> "" then ! something to process send(dcl_text, emacs_process); ! send command to process endif; endprocedure; ! *** sp - spawn separate process with command processor *** procedure sp local spawn_text; spawn_text := ask_user("SPAWN command? "); spawn('@DISK0:[UTILS]EMACSTPU_SPAWN "' + spawn_text + '"'); endprocedure; ! *** tpu_command - invoke TPU command *** procedure tpu_command local tpu_code; on_error emacs_universal_count := 0; abort; endon_error; tpu_code := compile(ask_user("TPU command? ")); loop execute(tpu_code); exitif emacs_universal_count <= 1; emacs_universal_count := emacs_universal_count - 1; endloop; endprocedure; ! *** examine - print out information about type of TPU variable *** procedure examine(variable) local what_type, what_value; case get_info(variable, "type") from unspecified to learn [integer]: what_type := "integer"; what_value := str(variable); [string]: what_type := "string"; what_value := variable; [marker]: what_type := "marker"; what_value := ""; [range]: what_type := "range"; what_value := substr(variable, 1, 40); [buffer]: what_type := "buffer"; what_value := get_info(variable, "name"); [window]: what_type := "window"; what_value := ""; [process]: what_type := "process"; what_value := get_info(variable, "pid"); [unspecified]: what_type := "unspecified"; what_value := ""; [inrange, outrange]: what_type := "unknown"; what_type := ""; endcase; message(fao("Type !AS = '!AS'.", what_type, what_value)); endprocedure; ! *** Initialization procedure when starting up TPU editor *** procedure tpu$init_procedure ! change to tpu$init_procedure later local text_lines, prompt_line, message_line, input_file; emacs_init_variables; ! initialize variables screen_length := get_info(screen, "visible_length"); ! lines on screen text_lines := screen_length - 1; ! lines in main text window prompt_line := screen_length; ! line for prompts message_line := screen_length; ! line for messages set(message_flags, 1); ! print only text of message headers set(auto_repeat, on); ! allow repeating set(bell, broadcast, on); ! ring bell only on user messages set(prompt_area, prompt_line, 1, none); ! bottom line message_buffer := emacs_system_buffer("MESSAGES"); ! set messages buffer set(max_lines, message_buffer, 100); ! limit number of lines message_window := create_window(message_line, 1, off); map(message_window, message_buffer); !***! set(text, message_window, no_translate); show_buffer := emacs_system_buffer("SHOW"); ! set show buffer info_window := create_window(1, text_lines, on); ! show window kill_buffer := emacs_system_buffer("KILL"); ! create kill buffer edit_window := create_window(1, text_lines, on); ! main window set(scrolling, edit_window, on, 5, 2, (get_info(edit_window, "original_length") - 3) / 2 - 5); input_file := get_info(command_line, "file_name"); ! get input file if input_file = "" then ! no input file name given emacs_select_buffer("MAIN"); ! use main buffer else if not emacs_find_file(input_file) then ! find the file emacs_select_buffer("MAIN"); ! make sure we get some buffer endif; endif; tpu$local_init; ! execute any local initialization refresh; ! paint screens message(emacs_version + " initialization complete."); set(debug,off,all); ! make sure debug is turned off endprocedure; ! *** tpu$local_init - dummy local initialization routine *** procedure tpu$local_init endprocedure; ! *** emacs_bind_keys - bind keys to commands for EMACS *** procedure emacs_bind_keys ! Standard control keys define_key("emacs_set_mark", key_name(ascii(0)), "Set Mark"); define_key("position(search(line_begin, reverse))", ctrl_a_key, "Beginning of Line"); define_key("emacs_move_horz(-1)", ctrl_b_key, "Backward Character"); define_key("emacs_delete_char_forward", ctrl_d_key, "Delete Character Forward"); define_key("position(search(line_end, forward))", ctrl_e_key, "End of Line"); define_key("emacs_move_horz(1)", ctrl_f_key, "Forward Character"); define_key("emacs_abort", ctrl_g_key, "Abort/Cancel Prefix"); define_key("emacs_delete_char_backward", ctrl_h_key, "Delete Character Backward"); define_key("emacs_tab", ctrl_i_key, "Insert Tab"); define_key("emacs_indent", ctrl_j_key, "Newline Insert and Indent"); define_key("emacs_kill_line", ctrl_k_key, "Kill Line"); define_key("emacs_refresh", ctrl_l_key, "Redisplay screen"); define_key("split_line", ctrl_m_key, "Newline Insert"); define_key("emacs_move_vert(1)", ctrl_n_key, "Next Line"); define_key("emacs_open_line", ctrl_o_key, "Open Line"); define_key("emacs_move_vert(-1)", ctrl_p_key, "Previous Line"); define_key("emacs_quote_char", ctrl_q_key, "Quote Next Character"); define_key("emacs_search(reverse)", ctrl_r_key, "Reverse String Search"); define_key("emacs_search(forward)", ctrl_s_key, "Forward String Search"); define_key("emacs_transpose", ctrl_t_key, "Transpose Characters"); define_key("emacs_universal", ctrl_u_key, "Universal Argument"); define_key("emacs_view_next", ctrl_v_key, "View Next Screen"); define_key("emacs_wipe(true)", ctrl_w_key, "Wipe Region"); define_key("emacs_ctrl_x", ctrl_x_key, "Control X Commands"); define_key("emacs_yank", ctrl_y_key, "Yank Killed Text"); define_key("scroll(current_window, 1)", ctrl_z_key, "Scroll Up"); ! ESCAPE keys define_key("emacs_abort", key_name(ctrl_g_key, shift_key), "Abort/Cancel Prefix"); define_key("emacs_replace(true)", key_name(ctrl_r_key, shift_key), "Replace String with Query"); define_key("emacs_set_mark", key_name(" ", shift_key), "Set Mark"); define_key("emacs_case_word(lower)", key_name("l", shift_key), "Lowercase Word"); define_key("emacs_replace(false)", key_name("r", shift_key), "Replace String"); define_key("emacs_shift_window", key_name("s", shift_key), "Shift Window to Column"); define_key("emacs_case_word(upper)", key_name("u", shift_key), "Uppercase Word"); define_key("emacs_wipe(false)", key_name('w', shift_key), "Copy Region"); define_key("scroll(current_window, -1)", key_name('z', shift_key), "Scroll Down"); define_key("emacs_move_word(forward)", key_name('f', shift_key), "Forward Word"); define_key("emacs_move_word(forward)", key_name(KP6, shift_key), "Forward Word"); define_key("emacs_move_word(reverse)", key_name('b', shift_key), "Backward Word"); define_key("emacs_move_word(reverse)", key_name(KP4, shift_key), "Backward Word"); define_key("emacs_delete_word(forward)", key_name('d', shift_key), "Delete Word Forward"); define_key("emacs_delete_word(forward)", key_name(period, shift_key), "Delete Word Forward"); define_key("emacs_delete_word(reverse)", key_name('h', shift_key), "Delete Word Backward"); define_key("emacs_delete_word(reverse)", key_name(del_key, shift_key), "Delete Word Backward"); define_key("position(beginning_of(current_buffer))", key_name('<', shift_key), "Beginning of Buffer"); define_key("position(end_of(current_buffer)); emacs_move_horz(-1)", key_name('>', shift_key), "End of Buffer"); ! Special VT-100 keys define_key("position(end_of(current_buffer)); emacs_move_horz(-1)", KP1, "End of Buffer"); define_key("emacs_move_vert(1)", KP2, "Next Line"); define_key("emacs_view_next", KP3, "View Next Screen"); define_key("emacs_move_horz(-1)", KP4, "Backward Character"); define_key("emacs_set_mark", KP5, "Set Mark"); define_key("emacs_move_horz(1)", KP6, "Forward Character"); define_key("position(beginning_of(current_buffer))", KP7, "Beginning of Buffer"); define_key("emacs_move_vert(-1)", KP8, "Previous Line"); define_key("emacs_view_previous", KP9, "View Previous Screen"); define_key("emacs_move_vert(-1)", up); define_key("emacs_move_vert(1)", down); define_key("emacs_move_horz(1)", right); define_key("emacs_move_horz(-1)", left); define_key("emacs_delete_char_backward", del_key); define_key("emacs_delete_char_forward", period); endprocedure; ! *** emacs_ctrl_x - control-X command processing *** procedure emacs_ctrl_x local inkey; on_error emacs_ctrl_x_save := ""; ! no more save key return; endon_error; if (emacs_universal_count <= 0) or (emacs_ctrl_x_save = "") then inkey := read_char; ! read next character emacs_ctrl_x_save := inkey; ! remember if called for universal else inkey := emacs_ctrl_x_save; ! recall previous command endif; case inkey from "" to "z" ! check characters [""]: emacs_list_buffers; ! show current buffers [""]: emacs_quit; ! exit editor [""]: emacs_macro_exec; ! execute macro [""]: emacs_find_file(""); ! find file [""]: emacs_abort; ! abort current command [" "]: emacs_set_tab; ! set the tab stops [""]: emacs_read_file; ! read file ["", "s"]: ! save file emacs_save_file; [""]: emacs_view_next_other; ! view next other window [""]: emacs_write_file; ! write file [""]: emacs_exchange_mark; ! exchange marks [""]: emacs_view_previous_other; ! view previous other window ["b"]: emacs_select_buffer(""); ! select buffer ["e"]: emacs_macro_exec; ! execute macro ["k"]: emacs_kill_buffer(true); ! kill current buffer ["o"]: emacs_change_window; ! other window ["!"]: tpu_command; ! execute command ["^"]: emacs_grow_window; ! grow current window ["("]: emacs_macro_start; ! start macro [")"]: emacs_macro_end; ! end macro ["1"]: emacs_one_window; ! one window ["2"]: emacs_two_window; ! two windows [inrange, outrange]: err_message("Bad control-X command!"); endcase; endprocedure; ! *** emacs_system_buffer - create new system buffer *** procedure emacs_system_buffer(buffer_name) local new_buffer; ! new buffer new_buffer := create_buffer(buffer_name); set(output_file, new_buffer, ""); set(eob_text, new_buffer, ""); set(no_write, new_buffer); set(system, new_buffer); set(permanent, new_buffer); return(new_buffer); endprocedure; ! *** emacs_normal_buffer - create normal buffer and read file *** procedure emacs_normal_buffer(buffer_name, file_name) local new_buffer; if (file_name <> "") and (file_search(file_name) <> "") then message(fao("Reading !AS...", file_name)); new_buffer := create_buffer(buffer_name, file_name); else if file_name <> "" then message(fao("Created new file !AS.", file_name)); endif; new_buffer := create_buffer(buffer_name); endif; set(output_file, new_buffer, file_name); set(eob_text, new_buffer, ""); set(insert, new_buffer); set(tab_stops, new_buffer, 8); if get_info(command_line, "read_only") then ! read-only flag set(no_write, new_buffer); endif; map(edit_window, new_buffer); ! let see it! emacs_status_update; ! put up a status line position(edit_window); ! make current position return(new_buffer); endprocedure; ! *** emacs_status_update - update status line of window *** procedure emacs_status_update local buffer_name, file_name, mode_string, mod_string, shift_string; if get_info(current_buffer, "mode") = insert then mode_string := ""; else mode_string := "(Overstrike)"; endif; if get_info(current_buffer, "modified") then mod_string := "*"; else mod_string := " "; endif; buffer_name := get_info(current_buffer, "name"); file_name := get_info(current_buffer, "output_file"); if (file_name = "") or (file_name = 0) then file_name := ""; endif; if emacs_shift_column > 1 then shift_string := "left=" + str(emacs_shift_column); else shift_string := "" endif; set(status_line, current_window, reverse, fao("Emacs-TPU !AS: !AS !AS !AS !AS", buffer_name, file_name, mod_string, mode_string, shift_string)); endprocedure; ! *** emacs_find_file - if file doesn't exist, create buffer and read procedure emacs_find_file(file_name_arg) local file_name, full_name, buffer_name, found_file, new_buffer, temp; on_error if error = tpu$_parsefail then err_message(fao("Bad filename: !AS!!", file_name)); return(false); endif; endon_error; file_name := file_name_arg; ! make local copy of argument if (file_name = "") or (file_name = 0) then file_name := upcase(ask_user("Find file? ")); if file_name = "" then return(false); endif; endif; if file_parse(file_name, "", "", name) = "" then err_message(fao("Bad filename: !AS!!", file_name)); abort; endif; if current_buffer <> 0 then emacs_previous_buffer := get_info(current_buffer, "name"); endif; full_name := file_parse(file_name, "SYS$DISK:[]"); ! get full name of file found_file := 0; ! assume not found loop_buffer := get_info(buffers, "first"); ! get first buffer loop ! look for matching filename exitif loop_buffer = 0; ! finished search if get_info(loop_buffer, "output_file") = full_name then found_file := loop_buffer; ! remember buffer found exitif true; endif; loop_buffer := get_info(buffers, "next"); endloop; if found_file <> 0 then ! found filename that matches map(current_window, found_file); ! map to current window emacs_status_update; ! update status line return(true); ! found the file endif; buffer_name := file_parse(full_name, "", "", name) + file_parse(full_name, "", "", type);! default buffer name loop new_buffer := emacs_find_buffer_name(buffer_name); exitif new_buffer = 0; temp := upcase(ask_user(fao("Buffer !AS exists. Buffer? ", buffer_name))); if temp <> "" then buffer_name := temp; else if new_buffer <> current_buffer then emacs_select_buffer(buffer_name); ! select the buffer endif; emacs_kill_buffer(false); ! kill this buffer endif; endloop; new_buffer := emacs_normal_buffer(buffer_name, full_name); position(beginning_of(new_buffer)); ! goto beginning of file emacs_status_update; ! update status line return(true); endprocedure; ! *** emacs_read_file - read file into current buffer *** procedure emacs_read_file local file_name, buffer_name, new_buffer, temp; if get_info(current_buffer, "modified") then loop temp := upcase(ask_user("Clobber modified buffer (Y/N)? ")); if temp = "N" then emacs_abort; endif; exitif temp = "Y"; endloop; endif; loop file_name := ask_user("Read file? "); if file_name = "" then file_name := get_info(current_buffer, "output_file"); else if file_search(file_name) = "" then file_name := file_parse(file_name, get_info(current_buffer, "output_file"), "SYS$DISK:[]"); else file_name := file_parse(file_name, "SYS$DISK:[]"); endif; endif; exitif file_name <> ""; endloop; buffer_name := get_info(current_buffer, "name"); ! use same name emacs_kill_buffer(false); ! forget this buffer new_buffer := emacs_normal_buffer(buffer_name, file_name); position(beginning_of(new_buffer)); ! goto beginning of file emacs_status_update; ! update status line endprocedure; ! *** emacs_find_buffer_name: search for specified buffer name *** procedure emacs_find_buffer_name(buffer_name) local loop_buffer; loop_buffer := get_info(buffers, "first"); ! look thru buffers loop ! search until found exitif loop_buffer = 0; ! finished search if buffer_name = get_info(loop_buffer, "name") then return(loop_buffer); ! return found buffer endif; loop_buffer := get_info(buffers, "next"); endloop; return(0); ! return null buffer endprocedure; ! *** emacs_select_buffer - find or open specified buffer *** procedure emacs_select_buffer(buffer_name_arg) local buffer_name, new_buffer, prompt; buffer_name := buffer_name_arg; ! make local copy of argument if (buffer_name = "") or (buffer_name = 0) then ! need to prompt buffer_name := upcase(ask_user(fao("Buffer (default !AS)? ", emacs_previous_buffer))); if buffer_name = "" then buffer_name := emacs_previous_buffer; endif; endif; if buffer_name = "" then buffer_name := "MAIN"; endif; if current_buffer <> 0 then emacs_previous_buffer := get_info(current_buffer, "name"); endif; new_buffer := emacs_find_buffer_name(buffer_name); if new_buffer = 0 then ! must create a new buffer message(fao("Creating new buffer !AS.", buffer_name)); new_buffer := emacs_normal_buffer(buffer_name, ""); else map(current_window, new_buffer); ! make new buffer in window position(current_window); ! position within the window endif; emacs_status_update; ! update status line return(true); endprocedure; ! *** emacs_abort - perform abort command processing *** procedure emacs_abort emacs_universal_count := 0; ! make sure it's reset if emacs_macro = -1 then ! remembering emacs_macro := learn_end; emacs_macro := 0; endif; err_message("Aborted!"); abort; endprocedure; ! *** emacs_delete_char_forward - delete character forward *** procedure emacs_delete_char_forward if erase_character(1) = "" then if mark(none) <> end_of(current_buffer) then move_horizontal(1); ! advance to next line append_line; ! join with previous line endif endif endprocedure; ! *** emacs_delete_char_backward - delete character forward *** procedure emacs_delete_char_backward local erase_count, chr; erase_count := 0; loop chr := erase_character(-1); ! erase stuff if chr = " " then ! rubout up to four spaces erase_count := erase_count + 1; exitif erase_count >= 4; else if erase_count > 0 then copy_text(chr); exitif true; endif; if chr = "" then if mark(none) <> beginning_of(current_buffer) then append_line; ! join with previous line endif; endif; exitif true; endif; endloop; endprocedure; ! *** emacs_move_horz - move specified character positions *** procedure emacs_move_horz(count) on_error return; endon_error; ! ignore errors move_horizontal(count); endprocedure; ! *** emacs_move_vert - move specified vertical positions *** procedure emacs_move_vert(count) on_error return; endon_error; ! ignore errors move_vertical(count); endprocedure; ! *** emacs_move_word - move specified direction for a word *** procedure emacs_move_word(direction) local word_range; on_error word_range := 0; ! catch search failure endon_error; if direction = forward then word_range := search(emacs_word, forward, no_exact); if word_range <> 0 then position(end_of(word_range)); emacs_move_horz(1); endif; else if index(emacs_letters, upcase(current_character)) > 0 then emacs_move_horz(-1); endif; word_range := search(emacs_word, reverse, no_exact); if word_range <> 0 then position(beginning_of(word_range)); endif; endif; endprocedure; ! *** emacs_delete_word - delete specified direction for a word *** procedure emacs_delete_word(direction) local word_range, start_position; on_error word_range := 0; ! catch search failure endon_error; if direction = forward then start_position := mark(none); word_range := search(emacs_word, forward, no_exact); if word_range <> 0 then word_range := create_range(start_position, end_of(word_range), none); endif; else if index(emacs_letters, upcase(current_character)) > 0 then emacs_move_horz(-1); endif; start_position := mark(none); word_range := search(emacs_word, reverse, no_exact); if word_range <> 0 then word_range := create_range(beginning_of(word_range), start_position, none); endif; endif; if word_range <> 0 then erase(word_range); position(end_of(word_range)); endif; endprocedure; ! *** emacs_case_word - make case of forward word as specified *** procedure emacs_case_word(what_case) local word_range; on_error word_range := 0; ! catch search failure endon_error; word_range := search(emacs_word, forward, no_exact); if word_range <> 0 then change_case(word_range, what_case); position(end_of(word_range)); emacs_move_horz(1); endif; endprocedure; ! *** emacs_universal - perform control-u repetition counter *** procedure emacs_universal local number, inchar, inkey, key_program, temp, ignore_error; on_error if not ignore_error then emacs_universal_count := 0; emacs_ctrl_x_save := ""; emacs_abort; endif; key_program := 0; endon_error; ignore_error := false; ! don't ignore errors emacs_ctrl_x_save := ""; ! ctrl-x second key not read yet. number := ""; ! nothing read yet loop ! read complete number inchar := read_line("Arg: " + number, 1); exitif index("0123456789", inchar) = 0; number := number + inchar; endloop; if number = "" then number := "4"; endif; emacs_universal_count := int(number); ! convert to number inkey := last_key; ! get back what was read last ignore_error := true; ! forget any error key_program := lookup_key(inkey, program); ! get key's program ignore_error := false; ! pick up errors if get_info(key_program, "type") = program then ! was a program to repeat loop exitif emacs_universal_count <= 0; execute(key_program); emacs_universal_count := emacs_universal_count - 1; endloop; else ! was standard keystroke loop exitif emacs_universal_count <= 0; copy_text(inchar); ! repeat insert of keystroke emacs_universal_count := emacs_universal_count - 1; endloop; endif; endprocedure; ! *** emacs_search - search for string given the direction *** procedure emacs_search(direction_flag) local search_string, saved_position, search_range, err; on_error err := error; ! save the error code if saved_position <> 0 then position(saved_position); endif; if (err = tpu$_strnotfound) or (err = tpu$_begofbuf) or (err = tpu$_endofbuf) then err_message(fao("String '!AS' not found!!", search_string)); return; endif; endon_error; saved_position := mark(none); ! remember current position if direction_flag = forward then search_string := ask_user("Forward search? "); if mark(none) <> end_of(current_buffer) then move_horizontal(1); ! move off current match endif; else search_string := ask_user("Reverse search? "); if mark(none) <> beginning_of(current_buffer) then move_horizontal(-1); ! move off current match endif; endif; if last_key = key_name(ctrl_g_key) then position(saved_position); emacs_abort; endif; if search_string = "" then search_string := emacs_search_string; else emacs_search_string := search_string; endif; search_range := search(search_string, direction_flag, no_exact); if search_range <> 0 then if direction_flag = forward then position(end_of(search_range)); move_horizontal(1); else position(beginning_of(search_range)); endif; else position(saved_position); endif; endprocedure; ! *** emacs_kill_line - erase remainder of the line *** procedure emacs_kill_line local kill_text; if (emacs_kill_position = 0) or (emacs_kill_position <> mark(none)) then erase(kill_buffer); endif; if current_offset < length(current_line) then ! not at end-of-line kill_text := erase_character(length(current_line) - current_offset); else kill_text := ""; ! nothing killed if mark(none) <> end_of(current_buffer) then move_horizontal(1); append_line; endif; endif; position(kill_buffer); ! goto the kill buffer if kill_text <> "" then ! copy removed text copy_text(kill_text); ! put in new stuff else split_line; endif; position(current_window); ! back to the main window emacs_kill_position := mark(none); ! remember for next call endprocedure; ! *** emacs_yank - pull back text from the kill buffer *** procedure emacs_yank local start_mark; move_horizontal(-1); ! remember start of text start_mark := mark(none); move_horizontal(1); ! back to original place copy_text(kill_buffer); append_line; ! remove the extra newline emacs_set_mark; ! set mark at final location position(start_mark); ! get to beginning of inserted move_horizontal(1); emacs_exchange_mark; ! make start the mark, back to original endprocedure; ! *** emacs_wipe - wipe text from region *** procedure emacs_wipe(erase_flag) local temp_range, temp_mark; if expand_name(emacs_mark_name, variables) = "" then err_message("No mark set in buffer!"); return; endif; temp_mark := select(none); ! get current place emacs_exchange_mark; ! now get the other mark temp_range := select_range; ! get the range to wipe emacs_exchange_mark; ! put back the mark erase(kill_buffer); ! erase current kill buffer position(kill_buffer); ! copy range into kill buffer split_line; ! insert extra newline move_vertical(-1); copy_text(temp_range); position(temp_mark); ! back to original buffer if erase_flag then ! erase the range data erase(temp_range); endif; endprocedure; ! *** emacs_mark_name - return name of marker for current buffer *** procedure emacs_mark_name local buffer_name; buffer_name := get_info(current_buffer, "name"); translate(buffer_name, "_", "."); return("MARK_" + buffer_name); endprocedure; ! *** emacs_set_mark - set marker to current position of buffer *** procedure emacs_set_mark local mark_name; execute(emacs_mark_name + " := mark(reverse)"); endprocedure; ! *** emacs_exchange_mark - exchange mark with current position *** procedure emacs_exchange_mark local mark_name, temp_mark1, temp_mark2; on_error err_message("No mark set in buffer!"); abort; endon_error; mark_name := emacs_mark_name; temp_mark1 := mark(none); ! remember current place execute("position(" + mark_name + ")"); ! goto current mark temp_mark2 := mark(none); ! remember it too position(temp_mark1); ! back to original spot execute(mark_name + " := mark(reverse)"); ! mark new place position(temp_mark2); ! go to new place endprocedure; ! *** emacs_view_next - move down to next page of text *** procedure emacs_view_next scroll(current_window, get_info(current_window, "original_length") - 3); endprocedure; ! *** emacs_view_previous - move up to next page of text *** procedure emacs_view_previous scroll(current_window, -get_info(current_window, "original_length") + 3); endprocedure; ! *** emacs_set_tab - set logical tab stops *** procedure emacs_set_tab if emacs_universal_count <= 0 then emacs_universal_count := 4; endif; emacs_tab_set := emacs_universal_count; emacs_universal_count := 0; endprocedure; ! *** emacs_tab - insert tab character *** procedure emacs_tab local column, target_column, temp; update(current_window); ! make sure screen up to date column := current_column; ! read real column for sure target_column := ((column - 1) / emacs_tab_set) * emacs_tab_set + emacs_tab_set + 1; loop ! remove all previous blanks temp := erase_character(-1); if temp <> " " then copy_text(temp); ! put character back exitif true; else column := column - 1; ! now back one column endif; endloop; loop ! put in physical tabs temp := ((column - 1) / 8) * 8 + 9; ! next tab stop exitif temp > target_column; copy_text(ascii(9)); column := temp; endloop; loop ! put in spaces for rest exitif column >= target_column; copy_text(" "); column := column + 1; endloop; endprocedure; ! *** emacs_indent - create new line and tab indent *** procedure emacs_indent local current_mark, column, tabs; on_error position(current_mark); err_message("Cannot find previous indentation!"); abort; endon_error; split_line; ! make a new line current_mark := mark(none); ! remember where we started loop ! search for non-empty line move_vertical(-1); ! up one line if length(current_line) > 0 then column := 1; ! starting column loop ! find first non-space character if current_character = " " then column := column + 1; else if current_character = ascii(9) then column := ((column - 1) / 8) * 8 + 9; else exitif true; endif; endif; move_horizontal(1); endloop; position(current_mark); ! now insert correct tabs tabs := (column - 1) / emacs_tab_set; loop exitif tabs <= 0; emacs_tab; tabs := tabs - 1; endloop; return; endif; endloop; endprocedure; ! *** emacs_open_line - open up space for a line *** procedure emacs_open_line split_line; ! make room for another line move_horizontal(-1); ! move back to place where line lives endprocedure; ! *** emacs_quote_char - take next character quoted *** procedure emacs_quote_char copy_text(read_char); ! put it into buffer endprocedure; ! *** emacs_center_cursor - put cursor in center of screen *** procedure emacs_center_cursor local move_lines, temp_mark; temp_mark := mark(none); ! remember where we are move_lines := current_row - (get_info(current_window, "original_length") / 2); scroll(current_window, move_lines); position(temp_mark); ! make sure we wind up there endprocedure; ! *** emacs_refresh - refresh contents of screen *** procedure emacs_refresh emacs_status_update; ! update status line if emacs_refresh_position = mark(none) then refresh; ! really refresh screen else emacs_center_cursor; emacs_refresh_position := mark(none); endif; endprocedure; ! *** emacs_transpose - transpose two previous characters *** procedure emacs_transpose local char1, char2; char1 := erase_character(-1); char2 := erase_character(-1); copy_text(char1); copy_text(char2); endprocedure; ! *** emacs_list_buffers - list information about current buffers *** procedure emacs_list_buffers local loop_buffer, mod_flag, out_name; if current_buffer <> show_buffer then emacs_select_buffer("SHOW"); endif; erase(show_buffer); loop_buffer := get_info(buffers, "first"); loop exitif loop_buffer = 0; out_name := get_info(loop_buffer, "output_file"); if (out_name = 0) or (out_name = "") then out_name := " "; endif; if (get_info(loop_buffer, "modified")) and (not get_info(loop_buffer, "no_write")) then mod_flag := "*"; else mod_flag := " "; endif; copy_text(fao("!20AS !1AS !55AS", get_info(loop_buffer, "name"), mod_flag, out_name)); split_line; loop_buffer := get_info(buffers, "next"); endloop; endprocedure; ! *** emacs_kill_buffer - kill current buffer with optional save *** procedure emacs_kill_buffer(ask_flag) local temp, old_buffer; if get_info(current_buffer, "system") then err_message("Cannot kill system buffer!"); abort; endif; old_buffer := current_buffer; loop exitif not ask_flag; ! don't ask for new buffer emacs_select_buffer(""); ! ask for a new buffer exitif old_buffer <> current_buffer; endloop; if emacs_other_window <> 0 then ! make sure not other window emacs_change_window; ! check other window if current_buffer = old_buffer then emacs_change_window; emacs_one_window; ! eliminate the other window else emacs_change_window; endif; endif; delete(old_buffer); endprocedure; ! *** emacs_save_file - save current file *** procedure emacs_save_file local save_name; if not get_info(current_buffer, "modified") then err_message("No modifications to save!"); return; ! simply return, allowing more endif; save_name := get_info(current_buffer, "output_file"); loop exitif (save_name <> "") and (save_name <> 0); save_name := ask_user("Save file? "); save_name := file_parse(save_name, "SYS$DISK:[]"); set(output_file, current_buffer, save_name); endloop; message("Saving file..."); write_file(current_buffer); emacs_status_update; ! update status line endprocedure; ! *** emacs_write_file - write buffer out to file *** procedure emacs_write_file local save_name; split_line; ! make buffer modified append_line; save_name := ask_user("Write file? "); if save_name <> "" then save_name := file_parse(save_name, get_info(current_buffer, "output_file"), "SYS$DISK:[]"); set(output_file, current_buffer, save_name); endif; emacs_save_file; endprocedure; ! *** emacs_replace - perform replace with optional query *** procedure emacs_replace(query_flag) local count, search_range, string1, string2, query_on, start_position, do_it, inkey, check_case, match_keyword, text_temp; on_error search_range := 0; endon_error; start_position := mark(none); ! remember start if query_flag then string1 := ask_user("Query replace? "); else string1 := ask_user("Replace? "); endif; string2 := ask_user("With? "); check_case := (searchstr(string1, "ABCDEFGHIJKLMNOPQRSTUVWXYZ") = 0) and (searchstr(string2, "ABCDEFGHIJKLMNOPQRSTUVWXYZ") = 0); if searchstr(string1, "ABCDEFGHIJKLMNOPQRSTUVWXYZ") = 0 then match_keyword := no_exact; else match_keyword := exact; endif; message(fao("Replacing '!AS' with '!AS'...", string1, string2)); query_on := query_flag; count := 0; loop search_range := search(string1, forward, match_keyword); exitif search_range = 0; ! all done position(end_of(search_range)); move_horizontal(1); ! one after replace do_it := true; ! assume we replace if query_on then ! user for query update(current_window); inkey := read_char; ! read answer case inkey from "" to "y" [""]: emacs_abort; ["!"]: query_on := false; ! stop querying ["."]: exitif true; ! stop replacing ["y", "Y", " "]: do_it := true; ! do the replace [inrange, outrange]: do_it := false; ! don't do this replace endcase; endif; if do_it then position(beginning_of(search_range)); text_temp := erase_character(length(search_range)); position(end_of(search_range)); ! be in right place if check_case then ! must check the case if (searchstr(text_temp, "abcdefghijklmnopqrstuvwxyz") = 0) and (searchstr(text_temp, "ABCDEFGHIJKLMNOPQRSTUVWXYZ") > 0) then text_temp := string2; ! force to upper case change_case(text_temp, upper); copy_text(text_temp); else copy_text(string2); endif; else copy_text(string2); ! insert new stuff endif; count := count + 1; endif; endloop; position(start_position); ! back to original place if count = 0 then err_message("No replacements were performed!"); else message(fao("Total of !ZL replacements were performed.", count)); endif; endprocedure; ! *** emacs_quit - quit querying if modified buffers *** procedure emacs_quit local buffer_name, loop_buffer; loop_buffer := get_info(buffers, "first"); loop if loop_buffer = 0 then quit; ! no buffers modified, can quit endif; exitif get_info(loop_buffer, "modified") and (not get_info(loop_buffer, "no_write")); loop_buffer := get_info(buffers, "next"); endloop; buffer_name := get_info(current_buffer, "name"); emacs_list_buffers; ! show the modified buffers update(current_window); ! make sure it prints quit; ! try quitting now emacs_select_buffer(buffer_name); ! back to original buffer emacs_status_update; ! update status line endprocedure; ! *** emacs_one_window - make single window on screen *** procedure emacs_one_window local text_lines; if emacs_other_window = 0 then err_message("One window already in use!"); abort; endif; if get_info(edit_window, "original_top") = 1 then ! adjust top window adjust_window(edit_window, 0, get_info(emacs_other_window, "original_length")); else ! adjust bottom window adjust_window(edit_window, -get_info(emacs_other_window, "original_length"), 0); endif; delete(emacs_other_window); ! eliminate other window emacs_other_window := 0; set(scrolling, edit_window, on, 5, 2, (get_info(edit_window, "original_length") - 3) / 2 - 5); position(edit_window); emacs_status_update; ! update status line endprocedure; ! *** emacs_two_window - make two windows on screen *** procedure emacs_two_window local text_lines; if emacs_other_window <> 0 then err_message("Two windows already in use!"); abort; endif; text_lines := get_info(edit_window, "original_length") / 2; adjust_window(edit_window, 0, -text_lines); emacs_other_window := create_window(get_info(edit_window, "original_bottom") + 2, text_lines, on); map(emacs_other_window, current_buffer); shift(emacs_other_window, emacs_shift_column - 1); set(scrolling, edit_window, on, 3, 1, (get_info(edit_window, "original_length") - 1) / 2 - 3); set(scrolling, emacs_other_window, on, 5, 2, (get_info(emacs_other_window, "original_length") - 1) / 2 - 3); emacs_change_window; ! move to other window emacs_status_update; ! update status line emacs_change_window; ! back to this window endprocedure; ! *** emacs_change_window - move to the other window *** procedure emacs_change_window local temp_window; if emacs_other_window = 0 then err_message("Only one window in use!"); abort; endif; temp_window := edit_window; ! swap around windows edit_window := emacs_other_window; emacs_other_window := temp_window; position(edit_window); endprocedure; ! *** emacs_grow_window - grow current window *** procedure emacs_grow_window if emacs_other_window = 0 then err_message("Only one window in use!"); abort; endif; if get_info(edit_window, "original_top") <= 1 then adjust_window(emacs_other_window, 1, 0); adjust_window(edit_window, 0, 1); else adjust_window(emacs_other_window, 0, -1); adjust_window(edit_window, -1, 0); endif; endprocedure; ! *** emacs_view_next_other - view previous screen other window *** procedure emacs_view_next_other emacs_change_window; ! goto other window emacs_view_next; ! page down emacs_change_window; ! return to previous page endprocedure; ! *** emacs_view_previous_other - view previous screen other window *** procedure emacs_view_previous_other emacs_change_window; ! goto other window emacs_view_previous; ! page up emacs_change_window; ! return to previous page endprocedure; ! *** emacs_shift_window - shift current window to column *** procedure emacs_shift_window if emacs_universal_count <= 0 then err_message("Use universal argument for column!"); abort; endif; shift(current_window, emacs_universal_count - emacs_shift_column); if emacs_other_window <> 0 then shift(emacs_other_window, emacs_universal_count - emacs_shift_column); endif; emacs_shift_column := emacs_universal_count; emacs_universal_count := 0; emacs_status_update; endprocedure; ! *** emacs_macro_start - start learning for macro sequence *** procedure emacs_macro_start if emacs_macro = -1 then ! macro already in progress emacs_macro := learn_end; ! stop the process endif; emacs_macro := -1; ! macro in progress learn_begin(exact); ! start learn sequence message("Remembering macro."); endprocedure; ! *** emacs_macro_end - stop learning macro *** procedure emacs_macro_end if emacs_macro = -1 then ! was remembering a macro emacs_macro := learn_end; ! remember key sequence message("Macro ready."); ! message endif; endprocedure; ! *** emacs_macro_exec - execute saved macro *** procedure emacs_macro_exec if emacs_macro = 0 then err_message("No macro remembered!"); abort; endif; if emacs_macro = -1 then err_message("Cannot execute macro while remembering!"); emacs_macro := learn_end; emacs_macro := 0; abort; endif; execute(emacs_macro); endprocedure; if 1 then set(informational, on); emacs_bind_keys; ! prebind the keys compile("procedure emacs_bind_keys endprocedure"); ! not needed now save("emacstpu.gbl"); quit; endif;