!==========================================================================! !--- My Editor --------------------------------------- Version 0 Rev 02 ---! !==========================================================================! !--------------------------------------------------------------------------! !--- My editor is the standard EVE editor extended with a spelling --------! !--- checker and other commands and key definitions. ---------------------! !--------------------------------------------------------------------------! !--- The routines in this file are either new eve commands, support -------! !--- routines, replacements for existing eve procedures/commands, ---------! !--- commands associated with keys or commands executed from the menu. ----! !--------------------------------------------------------------------------! !--- All routines with names starting with 'eve_' can be executed as ------! !--- standard eve commands. -----------------------------------------------! !--------------------------------------------------------------------------! !--- To build an editor with only the spelling checker, remove the --------! !--- marked routines at the bottom of this file. You might want to -------! !--- keep the replacement for eve help. -----------------------------------! !--------------------------------------------------------------------------! !==========================================================================! !--------------------------------------------------------------------------- ! Initialize Global Variables !--------------------------------------------------------------------------- procedure tpu$local_init ! definitions for the spelling checker eve$arg1_spell := 'string'; dictionary$available := 0; dictionary$buffer := 0; default$buffer := 0; ! definitions for the bullet formatter eve$arg1_bullet := 'string'; eve$arg2_bullet := 'string'; eve$arg3_bullet := 'string'; bullet_item_left := 0; bullet_text_left := 0; bullet_text_right := 0; item_characters := 'abcdefghijklmnopqrstuvwxyz' + 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' + '[]{}<>()0123456789;:."''' + '!@#$%^&*~|/\?-_+='; item_pattern := span(item_characters); ! definitions for the game of life eve$arg1_life := 'integer'; ! definitions for the buffer sort command eve$arg1_sort_buffer := eve$arg1_buffer; ! eve commands connected to key(s) define_key ('eve_other_window', F10); define_key ('eve_start_of_line', F11); define_key ('eve_end_of_line', F12); define_key ('eve_move_by_word', F9); define_key ('eve_one_window', key_name('1',shift_key)); define_key ('eve_two_windows', key_name('2',shift_key)); define_key ('eve_uppercase_word', key_name('u',shift_key)); define_key ('eve_lowercase_word', key_name('l',shift_key)); ! my commands connected to key(s) define_key ('my_editor_what_line', CTRL_L_KEY); define_key ('my_editor_delete_line', CTRL_D_KEY); define_key ('my_editor_show_position',CTRL_P_KEY); define_key ('eve_menu', key_name('x',shift_key)); define_key ('my_editor_transpose', key_name('t',shift_key)); define_key ('my_editor_toggle_width', key_name('w',shift_key)); ! define an alternate shift key set (shift_key,pf1); ! define EDT keypad my_editor_define_edt_keypad; endprocedure; !--------------------------------------------------------------------------- ! Define An EDT Type Keypad !--------------------------------------------------------------------------- procedure my_editor_define_edt_keypad ! dummy routine to be replaced endprocedure; !--------------------------------------------------------------------------- ! Toggle Internal Debug Flag !--------------------------------------------------------------------------- procedure eve_debug local func, ! integer - call_user function code ret; ! string - call_user returned string (not used) func := 10; ret := call_user(func,''); if func = 1 then message('Debug on'); else message('Debug off'); endif; endprocedure; !--------------------------------------------------------------------------- ! Load Dictionaries Into Internal Data Structure(s) !--------------------------------------------------------------------------- procedure load_dictionaries local project_dict, ! integer - project dict available flag use_dict, ! integer - user dictionary available flag func, ! integer - call_user function code ret; ! string - call_user returned string (not used) message('Loading common, project and user dictionaries'); ! load common dictionary func := 1; ret := call_user(func,''); if func = 0 then message('Error - common dictionary not found'); return(0); endif; ! load project dictionary func := 2; ret := call_user(func,''); if func = 1 then project_dict := 1; else project_dict := 0; endif; ! load user dictionary func := 3; ret := call_user(func,''); if func = 1 then user_dict := 1; else user_dict := 0; endif; ! display a warning messages if appropriate if (project_dict = 0) and (user_dict = 0) then message('Warning - project and user dictionaries not found'); endif; if (project_dict = 0) and (user_dict = 1) then message('Warning - project dictionary not found'); endif; if (project_dict = 1) and (user_dict = 0) then message('Warning - user dictionary not found'); endif; dictionary$available := 1; return(1); endprocedure; !--------------------------------------------------------------------------- ! Spell Check A Specified Range !--------------------------------------------------------------------------- procedure spell_check_range (spell_range) local word_range, ! range - range of current word word_pattern, ! pattern - word recognition pattern replacement_word, ! string - replacement word func, ! integer - call_user function code ret; ! string - call_user returned string (not used) ! ignore string not found error on_error if error <> TPU$_STRNOTFOUND then message('Internal error - contact system support'); return (0); endif; endon_error; ! set buffer direction set (forward,current_buffer); ! check the spelling of all of the words within the range word_pattern := span('abcdefghijklmnopqrstuvwxyz'); position(beginning_of(spell_range)); loop word_range := search(word_pattern,forward,no_exact); exitif word_range = 0; exitif beginning_of(word_range) >= end_of(spell_range); position(end_of(word_range)); word_range := create_range(beginning_of(word_range), end_of(word_range),reverse); update(current_window); func := 4; ret := call_user(func,substr(word_range,1,length(word_range))); if func = 0 then replacement_word := read_line ('Enter replacement word : '); update(eve$command_window); if last_key = ctrl_z_key then word_range := create_range(beginning_of(word_range), end_of(word_range),none); return(1); endif; if length(replacement_word) > 0 then erase(word_range); copy_text(replacement_word); update(current_window); endif; endif; word_range := create_range(beginning_of(word_range), end_of(word_range),none); move_horizontal(1); endloop; position(end_of(spell_range)); return(1); endprocedure; !--------------------------------------------------------------------------- ! Check If The Current Line Is A Paragraph Break !--------------------------------------------------------------------------- procedure check_for_paragraph_break local paragraph_break; on_error return (0); endon_error; paragraph_break := anchor & line_begin & ((eve$x_null | span(eve$x_word_separators)) & line_end); if search(paragraph_break,forward) <> 0 then return (1); endif; endprocedure; !--------------------------------------------------------------------------- ! Select A Range Of Lines In The Current Buffer To Spell Check ! And The Method Of How It Will Be Checked !--------------------------------------------------------------------------- procedure eve_spell (spell_parameter) local cmd, ! string - first letter of selection current, ! marker - current position start_paragraph, ! marker - start of the current paragraph end_paragraph, ! marker - end of the current paragraph spell_range; ! range - range to be spell checked ! set the buffer direction to forward set (forward,current_buffer); ! check for empty buffer if beginning_of(current_buffer) = end_of(current_buffer) then message('Buffer empty'); return(1); endif; ! load the dictionaries if they are not already available if dictionary$available = 0 then if load_dictionaries = 0 then return(1); endif; endif; ! check for empty (null) parameter, if yes spell check current buffer. if length(spell_parameter) = 0 then spell_range := create_range(beginning_of(current_buffer), end_of(current_buffer),none); if spell_check_range(spell_range)then message('End of Spelling Check'); endif; return(1); endif; ! get the first character of the parameter change_case(spell_parameter,upper); cmd := substr(spell_parameter,1,1); ! check if the spell parameter is 'HERE' if cmd = 'H' then move_horizontal(-current_offset); spell_range := create_range(mark(none),end_of(current_buffer),none); if spell_check_range(spell_range)then message('End of Spelling Check'); endif; return(1); endif; ! check if the spell parameter is 'BUFFER' if cmd = 'B' then spell_range := create_range(beginning_of(current_buffer), end_of(current_buffer),none); if spell_check_range(spell_range)then message('End of Spelling Check'); endif; return(1); endif; ! check if the spell parameter is 'PARAGRAPH' if cmd = 'P' then ! save current position current := mark(none); ! find the beginning of the current paragraph move_horizontal(-current_offset); loop exitif mark(none) = beginning_of(current_buffer); move_vertical(-1); if check_for_paragraph_break then move_vertical(1); exitif 1; endif; endloop; start_paragraph := mark(none); ! find the end of the current paragraph position(current); move_horizontal(-current_offset); loop exitif mark(none) = end_of(current_buffer); exitif check_for_paragraph_break; move_vertical(1); endloop; end_paragraph := mark(none); ! set the spell check range to current paragraph spell_range := create_range(start_paragraph,end_paragraph,none); if spell_check_range(spell_range)then message('End of Spelling Check'); endif; return(1); endif; ! check if the spell parameter is 'C' if cmd = 'C' then if spell_check_c then message('End of Spelling Check'); endif; return(1); endif; ! check if the spell parameter is 'DCL' if cmd = 'D' then if spell_check_dcl then message('End of Spelling Check'); endif; return(1); endif; ! check if the spell parameter is 'FORTRAN' if cmd = 'F' then if spell_check_fortran then message('End of Spelling Check'); endif; return(1); endif; ! check if the spell parameter is 'MACRO' if cmd = 'M' then if spell_check_macro then message('End of Spelling Check'); endif; return(1); endif; ! check if the spell parameter is 'RNO' if cmd = 'R' then if spell_check_rno then message('End of Spelling Check'); endif; return(1); endif; ! display error message message(fao('Unknown spell parameter (!AS)',spell_parameter)); endprocedure; !--------------------------------------------------------------------------- ! Test If A Buffer Already Exists And Return It !--------------------------------------------------------------------------- procedure test_if_buffer_exists (buffer_name,buffer_variable) local loop_buffer, ! buffer - loop buffer variable test_buffer; ! buffer - buffer to be located test_buffer := buffer_name; change_case(test_buffer,upper); loop_buffer := get_info(buffers,'first'); loop exitif loop_buffer = 0; if get_info(loop_buffer,'name') = test_buffer then buffer_variable := loop_buffer; return(1); else loop_buffer := get_info(buffers,'next'); endif; endloop; return(0); endprocedure; !--------------------------------------------------------------------------- ! Load The Words In The User Dictionary Into A Special Buffer !--------------------------------------------------------------------------- procedure eve_load_user_dictionary local dummy_buffer, ! buffer - place holder in routine call count, ! integer - word count func, ! integer - call_user function code retstr; ! string - call_user returned string ! save the current buffer default$buffer := current_buffer; ! test if the user dictionary buffer already exists if test_if_buffer_exists('USER DICTIONARY',dummy_buffer) = 0 then dictionary$buffer := create_buffer('USER DICTIONARY'); set (no_write,dictionary$buffer,on); endif; ! empty the user dictionary buffer and map it to the current window erase (dictionary$buffer); map(current_window,dictionary$buffer); eve$set_status_line(current_window); ! get first word from use dictionary func := 8; retstr := call_user(func,''); ! if no word was found insert the default word list into the buffer ! otherwise insert word from user dictionary into the buffer if func = 0 then copy_text('a'); split_line; copy_text('i'); split_line; copy_text('the'); split_line; message('User dictionary empty, initial word list loaded into buffer'); else copy_text(retstr); count := 1; loop func := 9; retstr := call_user(func,''); exitif func = 0; split_line; copy_text(retstr); count := count + 1; endloop; message(fao('!SL word(s) loaded from user dictionary',count)); endif; endprocedure; !--------------------------------------------------------------------------- ! Insert The Words In The Current Buffer Into The User Dictionary !--------------------------------------------------------------------------- procedure eve_update_user_dictionary local word_pattern, ! pattern - word recognition pattern word_count, ! integer - number of words saved in dictionary func, ! integer - call_user function code ret; ! string - call_user returned string (not used) ! ignore string not found error on_error if error <> TPU$_STRNOTFOUND then message('Internal error - contact system support'); return(0); endif; endon_error; ! set the buffer direction to forward set (forward,current_buffer); ! initialize use dictionary data structure(s) func := 5; ret := call_user(func,''); ! insert all of the words in the current buffer into the user dictionary word_pattern := span('abcdefghijklmnopqrstuvwxyz'); position(beginning_of(current_buffer)); loop word_range := search(word_pattern,forward,no_exact); exitif word_range = 0; exitif beginning_of(word_range) >= end_of(current_buffer); word_range := create_range(beginning_of(word_range), end_of(word_range),reverse); update(current_window); func := 6; ret := call_user(func,substr(word_range,1,length(word_range))); if func = 1 then word_count := word_count + 1; word_range := create_range(beginning_of(word_range), end_of(word_range),none); position(end_of(word_range)); move_horizontal(1); else if func = 2 then message('Error - maximum word size exceeded'); endif; if func = 3 then message('Error - word buffer overflow'); endif; if func = 4 then message('Error - maximum number of words exceeded'); endif; word_range := create_range(beginning_of(word_range), end_of(word_range),none); return(0); endif; endloop; position(end_of(current_buffer)); ! write the user dictionary data structure(s) to a file func := 7; ret := call_user(func,''); if func = 1 then if default$buffer <> 0 then map(current_window,default$buffer); eve$set_status_line(current_window); endif; message(fao('!SL word(s) stored in user dictionary file',word_count)); else if func = 2 then message('Error opening user dictionary file'); endif; if func = 3 then message('Error writing user dictionary file'); endif; endif; endprocedure; !--------------------------------------------------------------------------- ! Spell Check A C Source Code File !--------------------------------------------------------------------------- procedure spell_check_c local spell_range, ! range - range to be spell checked pat1; ! pattern - comment recognition pattern on_error if error <> TPU$_STRNOTFOUND then message('Internal error - contact system support'); return(0); endif; endon_error; ! create recognition pattern(s) pat1 := '/*' & match('*/'); ! C comment ! spell check comments position(beginning_of(current_buffer)); loop spell_range := search(pat1,forward); exitif spell_range = 0; spell_check_range(spell_range); if last_key = ctrl_z_key then return(1); endif; position(end_of(spell_range)); endloop; position(end_of(current_buffer)); return(1); endprocedure; !--------------------------------------------------------------------------- ! Spell Check A DCL Command File !--------------------------------------------------------------------------- procedure spell_check_dcl local spell_range, ! range - range to be spell checked pat1; ! pattern - comment recognition pattern on_error if error <> TPU$_STRNOTFOUND then message('Internal error - contact system support'); return(0); endif; endon_error; ! create recognition pattern(s) pat1 := any("!") & remain; ! DCL comment ! spell check comments position(beginning_of(current_buffer)); loop exitif mark(none) = end_of(current_buffer); move_horizontal(-current_offset); spell_range := search(pat1,forward,no_exact); ! look for a comment if spell_range <> 0 then spell_check_range(spell_range); if last_key = ctrl_z_key then return(1); endif; endif; move_vertical(1); endloop; position(end_of(current_buffer)); return(1); endprocedure; !--------------------------------------------------------------------------- ! Spell Check A FORTRAN Source Code File !--------------------------------------------------------------------------- procedure spell_check_fortran local spell_range, ! range - range to be spell checked pat1, ! pattern - comment recognition pattern pat2, ! pattern - comment recognition pattern pat3; ! pattern - character constant recognition pattern on_error if error <> TPU$_STRNOTFOUND then message('Internal error - contact system support'); return(0); endif; endon_error; ! create recognition pattern(s) pat1 := anchor & line_begin & ("c" | "C") & remain; ! FORTRAN comment pat2 := any("!") & remain; ! FORTRAN comment pat3 := any("'") & scan("'"); ! character constant ! spell check comments position(beginning_of(current_buffer)); loop ! look for comment lines starting with a "C" in column one exitif mark(none) = end_of(current_buffer); move_horizontal(-current_offset); spell_range := search(pat1,forward); if spell_range <> 0 then if length(spell_range) > 1 then move_horizontal(1); spell_range := create_range(mark(none),end_of(spell_range),none); spell_check_range(spell_range); if last_key = ctrl_z_key then return(1); endif; endif; else ! look for comment starting with a "!" spell_range := search(pat2,forward,no_exact); if spell_range <> 0 then spell_check_range(spell_range); if last_key = ctrl_z_key then return(1); endif; endif; endif; move_vertical(1); endloop; ! spell check character constants message('Spell checking all character constants'); position(beginning_of(current_buffer)); loop exitif mark(none) = end_of(current_buffer); spell_range := search(pat3,forward,no_exact); exitif spell_range = 0; spell_check_range(spell_range); exitif last_key = ctrl_z_key; position(end_of(spell_range)); move_horizontal(1); endloop; position(end_of(current_buffer)); return(1); endprocedure; !--------------------------------------------------------------------------- ! Spell Check A MACRO Source Code File !--------------------------------------------------------------------------- procedure spell_check_macro local spell_range, ! range - range to be spell checked pat1; ! pattern - comment recognition pattern on_error if error <> TPU$_STRNOTFOUND then message('Internal error - contact system support'); return(0); endif; endon_error; ! create recognition pattern(s) pat1 := any(";") & remain; ! spell check comments ! MACRO comment position(beginning_of(current_buffer)); loop exitif mark(none) = end_of(current_buffer); move_horizontal(-current_offset); spell_range := search(pat1,forward,no_exact); ! look for a comment if spell_range <> 0 then spell_check_range(spell_range); if last_key = ctrl_z_key then return(1); endif; endif; move_vertical(1); endloop; position(end_of(current_buffer)); return(1); endprocedure; !--------------------------------------------------------------------------- ! Spell Check A RUNOFF Source Code File !--------------------------------------------------------------------------- procedure spell_check_rno local spell_range, ! range - range to be spell checked pat1; ! pattern - command recognition pattern on_error if error <> TPU$_STRNOTFOUND then message('Internal error - contact system support'); return(0); endif; endon_error; ! create recognition pattern(s) pat1 := anchor & notany(".") & remain; ! RUNOFF command ! spell check comments position(beginning_of(current_buffer)); loop exitif mark(none) = end_of(current_buffer); spell_range := search(pat1,forward,no_exact); if spell_range <> 0 then spell_check_range(spell_range); if last_key = ctrl_z_key then return(1); endif; endif; move_horizontal(-current_offset); move_vertical(1); endloop; position(end_of(current_buffer)); return(1); endprocedure; !=========================================================================== !--- The Following Routines Are Not Part Of the Spelling Checker ----------! !=========================================================================== !--------------------------------------------------------------------------- ! Replacement For EVE Help !--------------------------------------------------------------------------- procedure eve_help (user_topic) local user_topic, ! user selected topic this_buffer; ! current buffer this_buffer := current_buffer; erase (help_buffer); eve$set_status_line(current_window); map(current_window,help_buffer); set(status_line,current_window,reverse,'Press CTRL/Z to resume editing'); help_text('extended_eve_help:',user_topic,on,help_buffer); map(current_window,this_buffer); erase (help_buffer); eve$set_status_line(current_window); return (1); endprocedure; !--------------------------------------------------------------------------- ! Display Location Information About The Current Line !--------------------------------------------------------------------------- procedure my_editor_what_line local current, ! marker - current position line_number, ! integer - number of current line total_lines, ! integer - total lines in buffer percent; ! integer - percent of way through buffer current := mark (none); total_lines := get_info (current_buffer,'record_count') + 1; if current = end_of(current_buffer) then line_number := total_lines; else line_number := 0; position (beginning_of(current_buffer)); loop move_vertical(1); line_number := line_number + 1; exitif mark(none) > current; endloop; endif; percent := (((line_number * 1000) / total_lines)+5)/10; message (fao ('You are on line !SL out of !SL (!SL%)', line_number, total_lines, percent)); position(current); endprocedure; !--------------------------------------------------------------------------- ! Delete The Current Line !--------------------------------------------------------------------------- procedure my_editor_delete_line local location; location := current_offset; if current_direction = forward then move_horizontal(-location); erase_line; if location > length(current_line) then move_horizontal(length(current_line)); else move_horizontal(location); endif; else move_horizontal(location); erase_line; if location > length(current_line) then move_horizontal(-length(current_line)); else move_horizontal(-location); endif; endif; endprocedure; !--------------------------------------------------------------------------- ! Display The Position Of The Cursor On The Current Line !--------------------------------------------------------------------------- procedure my_editor_show_position message (fao ('Current character position is !SL',current_offset+1)); endprocedure; !--------------------------------------------------------------------------- ! Toggle Screen Width Between 80 and 132 Characters Wide !--------------------------------------------------------------------------- procedure my_editor_toggle_width if get_info(screen,"width") = 80 then eve_set_width(132); else eve_set_width(80); endif; endprocedure; !--------------------------------------------------------------------------- ! Transpose The Two Characters To The Left Of The Cursor !--------------------------------------------------------------------------- procedure my_editor_transpose local tmark; move_horizontal(-2); tmark := mark(none); move_horizontal(2); move_text(create_range(tmark,tmark,none)); endprocedure; !--------------------------------------------------------------------------- ! Trim The spaces And Tabs From Every Line in The Current Buffer !--------------------------------------------------------------------------- procedure eve_trim_buffer local tab_char, ! string - TAB character string this_pos, ! marker - current position in buffer trim_range, ! range - range to be trimed on each line tab_count, ! integer - number of tabs deleted blank_count; ! integer - number of blanks deleted on_error if error = TPU$_STRNOTFOUND then trim_range := 0; endif; endon_error; message('Trimming buffer...'); tab_char := ascii(9); this_pos := mark(none); tab_count := 0; blank_count := 0; loop got_one := 0; position(beginning_of(current_buffer)); ! trim blanks at the end of each line loop trim_range := search(span(' ')&line_end,forward); exitif trim_range = 0; position(beginning_of(trim_range)); blank_count := blank_count + length(trim_range); erase_character(length(trim_range)); got_one := 1; endloop; position(beginning_of(current_buffer)); ! trim tabs at the end of each line loop trim_range := search(span(tab_char)&line_end,forward); exitif trim_range = 0; position(beginning_of(trim_range)); tab_count := tab_count + 1; erase_character(length(trim_range)); got_one := 1; endloop; exitif got_one = 0; endloop; position(this_pos); message(fao('!SL space(s) and !SL TAB(s) trimmed',blank_count,tab_count)); endprocedure; !--------------------------------------------------------------------------- ! Replace All TAB Characters With Eight Blanks !--------------------------------------------------------------------------- procedure my_editor_replace_tabs local tab_char, ! string - TAB character tab_count, ! integer - number of tabs replaced eight_blanks, ! string - eight blank characters this_pos; ! marker - current position in buffer on_error if error = TPU$_STRNOTFOUND then trim_range := 0; endif; endon_error; message('Replacing TABs with eight blanks...'); tab_char := ascii(9); this_pos := mark(none); eight_blanks := ' '; tab_count := 0; position(beginning_of(current_buffer)); loop trim_range := search(tab_char,forward); exitif trim_range = 0; position(beginning_of(trim_range)); erase_character(1); copy_text(eight_blanks); tab_count := tab_count + 1; endloop; position(this_pos); message(fao('!SL TABs replaced',tab_count)); endprocedure; !--------------------------------------------------------------------------- ! Replace Control Characters (0 - 31) With Displayable Strings !--------------------------------------------------------------------------- procedure my_editor_replace_control_characters local this_pos, ! marker - cursor position at start of routine char_range, ! range - found character char, ! string - search character count, ! integer - replacement count idx; ! integer - loop index on_error if error = TPU$_STRNOTFOUND then char_range := 0; endif; endon_error; message('Replacing control characters'); set(timer,on,'working'); this_pos := mark(none); count := 0; idx := 0; loop; exitif idx > 31; position(beginning_of(current_buffer)); char := ascii(idx); loop; char_range := search(char,forward); exitif char_range = 0; count := count + 1; position(beginning_of(char_range)); erase_character(1); case idx from 0 to 31 [0]: copy_text(''); [1]: copy_text(''); [2]: copy_text(''); [3]: copy_text(''); [4]: copy_text(''); [5]: copy_text(''); [6]: copy_text(''); [7]: copy_text(''); [8]: copy_text(''); [9]: copy_text(''); [10]: copy_text(''); [11]: copy_text(''); [12]: copy_text(''); [13]: copy_text(''); [14]: copy_text(''); [15]: copy_text(''); [16]: copy_text(''); [17]: copy_text(''); [18]: copy_text(''); [19]: copy_text(''); [20]: copy_text(''); [21]: copy_text(''); [22]: copy_text(''); [23]: copy_text(''); [24]: copy_text(''); [25]: copy_text(''); [26]: copy_text(''); [27]: copy_text(''); [28]: copy_text(''); [29]: copy_text(''); [30]: copy_text(''); [31]: copy_text(''); endcase; endloop; idx := idx + 1; endloop; position(this_pos); set(timer,off); message(fao('!SL control characters replaced with ASCII strings',count)); endprocedure; !--------------------------------------------------------------------------- ! Replace ASCII Strings With Control Characters (0 - 31) !--------------------------------------------------------------------------- procedure my_editor_replace_ascii_strings local this_pos, ! marker - cursor position at start of routine string_range, ! range - found string search_string, ! string - search string count, ! integer - replacement count idx; ! integer - loop index on_error if error = TPU$_STRNOTFOUND then string_range := 0; endif; endon_error; message('Replacing control characters'); set(timer,on,'working'); this_pos := mark(none); count := 0; idx := 0; loop; exitif idx > 31; position(beginning_of(current_buffer)); case idx from 0 to 31 [0]: search_string := ''; [1]: search_string := ''; [2]: search_string := ''; [3]: search_string := ''; [4]: search_string := ''; [5]: search_string := ''; [6]: search_string := ''; [7]: search_string := ''; [8]: search_string := ''; [9]: search_string := ''; [10]: search_string := ''; [11]: search_string := ''; [12]: search_string := ''; [13]: search_string := ''; [14]: search_string := ''; [15]: search_string := ''; [16]: search_string := ''; [17]: search_string := ''; [18]: search_string := ''; [19]: search_string := ''; [20]: search_string := ''; [21]: search_string := ''; [22]: search_string := ''; [23]: search_string := ''; [24]: search_string := ''; [25]: search_string := ''; [26]: search_string := ''; [27]: search_string := ''; [28]: search_string := ''; [29]: search_string := ''; [30]: search_string := ''; [31]: search_string := ''; endcase; loop; string_range := search(search_string,forward); exitif string_range = 0; count := count + 1; position(beginning_of(string_range)); erase(string_range); copy_text(ascii(idx)); endloop; idx := idx + 1; endloop; position(this_pos); set(timer,off); message(fao('!SL ASCII strings replaced with control characters',count)); endprocedure; !--------------------------------------------------------------------------- ! Display A Menu Of Special Functions And Execute One !--------------------------------------------------------------------------- procedure eve_menu local original_buffer, ! buffer - current buffer menu_buffer, ! buffer - buffer for menu text cmd; ! string - command string ! save the current buffer original_buffer := current_buffer; ! test if the menu buffer already exists if test_if_buffer_exists('MY EDITOR MENU',menu_buffer) = 0 then menu_buffer := create_buffer('MY EDITOR MENU'); set(no_write,menu_buffer,on); endif; ! map the menu buffer to the current window erase(menu_buffer); map(current_window,menu_buffer); eve$set_status_line(current_window); ! write menu items into menu buffer split_line; copy_text( ' My Editor Menu'); split_line; split_line; split_line; copy_text( ' Function Description'); split_line; split_line; copy_text( ' 1 Remove All TABs and spaces from the end of every line.'); split_line; split_line; copy_text( ' 2 Convert all TABs to eight spaces.'); split_line; split_line; copy_text( ' 3 Replace control characters with descriptive ASCII strings.'); split_line; split_line; copy_text( ' 4 Replace descriptive ASCII strings with control characters.'); split_line; split_line; copy_text( ' 9 Exit this menu with no action.'); split_line; split_line; copy_text( ' Note: Menu items 3 and 4 are inverse functions. Control characters'); split_line; copy_text( ' are the values 0 thru 31.'); split_line; split_line; split_line; update(current_window); ! ask the user for a function to perform cmd := read_line('Enter menu selection [exit] ',5); cmd := int(cmd); ! go back to the original buffer map(current_window,original_buffer); eve$set_status_line(current_window); update(current_window); case cmd from 1 to 4 [1]: eve_trim_buffer; [2]: my_editor_replace_tabs; [3]: my_editor_replace_control_characters [4]: my_editor_replace_ascii_strings endcase; endprocedure; !------------------------------------------------------------------------------- ! format a bullet !------------------------------------------------------------------------------- procedure eve_bullet (arg1,arg2,arg3) local current, ! marker - current position in buffer narg1, ! integer - parameter numeric value narg2, ! integer - parameter numeric value narg3, ! integer - parameter numeric value item_range, ! range - range of bullet item item_string, ! string - bullet item string item_area_size, ! integer - size of bullet item area start_bullet, ! marker - start of bullet marker end_bullet, ! marker - end of bullet marker bullet_range; ! range - range to be formatted into a bullet ! set the working direction set (forward,current_buffer); ! calculate the bullet item and text columns if bullet_item_left = 0 then bullet_item_left := get_info(current_buffer,"left_margin"); endif; if bullet_text_left= 0 then bullet_text_left := bullet_item_left + 10; endif; if bullet_text_right = 0 then bullet_text_right := get_info(current_buffer,"right_margin"); endif; ! calculate the maximum size of the item area in front of the bullet text item_area_size := bullet_text_left - bullet_item_left; narg1 := int(arg1); narg2 := int(arg2); narg3 := int(arg3); if length(arg1) > 0 then if (narg1 = 0) then message(fao( 'Bullet item margin !SL; item area size !SL; text margins !SL to !SL', bullet_item_left,item_area_size,bullet_text_left,bullet_text_right)); return (1); endif; if (narg1 > 0) and (narg2 = 0) and (narg3 = 0) then bullet_text_left := bullet_item_left + narg1; item_area_size := bullet_text_left - bullet_item_left; else if (narg1 > 0) and (narg2 > 0) and (narg3 > 0) and (narg1 < narg2) and (narg2 < narg3) then bullet_item_left := narg1; bullet_text_left := narg2; bullet_text_right := narg3; item_area_size := bullet_text_left - bullet_item_left; else message('ERROR - Illegal bullet command parameters'); return (1); endif; endif; endif; ! save the current position current := mark(none); ! mark the start of the bullet text move_horizontal(-current_offset); loop exitif mark(none) = beginning_of(current_buffer); move_vertical(-1); if check_for_paragraph_break then move_vertical(1); exitif 1; endif; endloop; start_bullet := mark(none); ! mark the end of the bullet text position(current); move_horizontal(-current_offset); loop exitif mark(none) = end_of(current_buffer); if check_for_paragraph_break then move_vertical(-1); exitif 1; endif; move_vertical(1); endloop; move_horizontal(length(current_line)); end_bullet := mark(none); ! create a range for the bullet text bullet_range := create_range(start_bullet,end_bullet,none); if bullet_range = 0 then return (1); endif; ! extract the bullet item from the bullet text position(beginning_of(bullet_range)); item_range := search(item_pattern,forward); if item_range = 0 then return (1); endif; ! test if the bullet item fits in the bullet item area if item_area_size < length(item_range) then message(fao('ERROR - Bullet item is to large for the item space')); return (1); endif; ! remove item string from bullet buffer position(beginning_of(item_range)); item_string := erase_character(length(item_range)); ! format the bullet text fill(bullet_range,' ',bullet_text_left,bullet_text_right); ! insert item in front of the bullet text position(beginning_of(bullet_range)); move_horizontal(bullet_item_left - 1 - current_offset); erase_character(length(item_string)); move_horizontal(bullet_item_left - 1 - current_offset); copy_text(item_string); ! move to the end of the bullet range position(end_of(bullet_range)); return(1); endprocedure; !--------------------------------------------------------------------------- ! Insert The System Date At The Current Cursor Location !--------------------------------------------------------------------------- procedure eve_date local day, full_date, full_month, raw_date, raw_month; raw_date := fao("!%D",0); raw_month := substr(raw_date,4,3); if raw_month = "JAN" then full_month := "January "; else if raw_month = "FEB" then full_month := "February "; else if raw_month = "MAR" then full_month := "March "; else if raw_month = "APR" then full_month := "April "; else if raw_month = "MAY" then full_month := "May "; else if raw_month = "JUN" then full_month := "June "; else if raw_month = "JUL" then full_month := "July "; else if raw_month = "AUG" then full_month := "August "; else if raw_month = "SEP" then full_month := "September "; else if raw_month = "OCT" then full_month := "October "; else if raw_month = "NOV" then full_month := "November "; else if raw_month = "DEC" then full_month := "December "; endif; endif;endif;endif;endif;endif;endif;endif;endif;endif;endif;endif; if substr(raw_date,1,1) = " " then day := substr(raw_date,2,1); else day := substr(raw_date,1,2); endif; full_date := day + " " + full_month + substr(raw_date,8,4); copy_text(full_date); endprocedure; !--------------------------------------------------------------------------- ! Insert The System Time At The Current Cursor Location !--------------------------------------------------------------------------- procedure eve_time local raw_time, half, hour; raw_time := fao("!%T",0); hour := int( substr(raw_time,1,2)); if hour >= 12 then half := " PM"; if hour > 12 then hour := hour - 12; endif; else half := " AM"; endif; copy_text (str(hour) + substr(raw_time,3,3) + half); endprocedure; !--------------------------------------------------------------------------- ! Display A Ruler On The Status Line With Tabs Marked ! ! An attempt is made to move the current line to the bottom of the window. ! The ruler will disappear with the next command that changes the status ! line or another eve_ruler invocation. !--------------------------------------------------------------------------- procedure eve_ruler local tab_stop, ! constant for SET TAB EVERY (AT's won't show) cur_stop, ! which tab stop we are on now (multiple of tab_stop) ruler_string, ! from the MMC$___ folks first_half, ! substring last_half, ! " move_size; ! scrolling differential ruler_string := "....|....1....|....2....|....3....|....4....|....5" + "....|....6....|....7....|....8....|....9....|....0" + "....|....1....|....2....|....3.."; if substr(get_info(current_window,"status_line"),1,8) = " Buffer " then cur_stop := 0; tab_stop := get_info (current_buffer,"tab_stops"); if get_info (tab_stop,"type") = integer then loop cur_stop := cur_stop + tab_stop; exitif cur_stop > 132; first_half := substr (ruler_string,1,cur_stop-1); last_half := substr (ruler_string,cur_stop+1,132); ruler_string := first_half + "^" + last_half; endloop; endif; move_size := get_info(current_window,"visible_bottom") - get_info(current_window,"current_row"); scroll (current_window,-move_size); move_vertical (+move_size); set (status_line,current_window,bold,ruler_string); else eve$set_status_line(current_window); endif; endprocedure; !--------------------------------------------------------------------------- ! The Game Of Life (consists of several procedures) ! ! A TPU implementation of Conway's Life experiment, from the Spr'86 DECUS ! Langs&Tools Session Notes (Author's name currently unknown) !--------------------------------------------------------------------------- procedure life$go_horizontal (amount) local offset; offset := current_offset; ! or now we can't go beyond the begining of the line if (offset = 0) and (amount<0) then return(0); endif; ! if we're going beyond the end of line, add a space if (offset+1 = length(current_line)) and (amount >0) then move_horizontal (1); copy_text (" "); move_horizontal (-1); else move_horizontal (amount); endif; return(1); endprocedure; ! life$go_horizontal procedure life$go_vertical (amount) local offset; on_error if error <> tpu$_noeobstr then ! if at end of buffer, add a line if error = tpu$_endofbuf then position (search (line_end,forward)); split_line; else ! if at begining of buffer, add a line if error = tpu$_begofbuf then position (search(line_begin,reverse)); split_line; move_vertical (-1); else ! whatever happened, we can't deal with it abort; endif; endif; endif; endon_error; ! save where we are offset := current_offset; move_vertical (amount); ! if we're no longer there, add the necessary spaces if (offset <> current_offset) or (offset = length(current_line)) then offset := offset - current_offset; copy_text (fao("!#* ",offset + 1)); move_horizontal (-1); endif; endprocedure; ! life$go_vertical ! evaluate the region around the cell procedure life$evaluate_cell (cell_range) local cell_mark; ! start by dealing with current row cell_mark := beginning_of (cell_range); life$evaluate_row (cell_mark); ! deal with preceding row life$go_vertical (-1); life$evaluate_row (mark(none)); position (cell_mark); ! deal with following row if we have one life$go_vertical (1); life$evaluate_row (mark(none)); position (cell_mark); endprocedure; ! life$evaluate_cell ! evaluate a single row procedure life$evaluate_row (cell_mark) local trans_range, end_mark, start_mark, status; status := life$go_horizontal(-1); start_mark := mark(reverse); if status then position (cell_mark); endif; status := life$go_horizontal(1); end_mark := mark(reverse); if status then position (cell_mark); endif; trans_range := create_range (start_mark, end_mark, reverse); translate (trans_range, life$translate_out, life$translate_in); endprocedure ! life$evaluate_row procedure life$init_life local counter, in_string, out_string; !build the input string counter := 0; in_string := ''; loop in_string := in_string + ascii(counter); counter := counter + 1; exitif counter > 255; endloop; ! build output string counter := 0; out_string := ''; loop case counter from 0 to 255 [32] : out_string := out_string + ' '; [inrange] : out_string := out_string + '*'; endcase; counter := counter + 1; exitif counter > 255; endloop; ! translate the buffer contents translate (current_buffer, out_string, in_string); ! init various strings life$status := " Buffer " + get_info(current_buffer,"name") + " (Life Environment --- Generation: !SL)"; life$translate_in := " abcdefg012345678"; life$translate_out := "abcdefgh123456789"; ! setup the status line and update the window set (status_line, current_window, reverse, fao(life$status,0)); update(current_window); endprocedure; ! life$init_life; ! procedure implemenmts the life game ! uses buffer to store state as we evaluate each cell procedure eve_life (input_generation) local saving_range, cell_pattern, cell_range, current_gen, max_gen; ! eat "no string found" mssg on_error if error <> tpu$_strnotfound then abort; endif; endon_error; if not eve$prompt_number (input_generation, max_gen, 'Number of generations to run simulation: ', 'Aborting simulation.') then return; endif; current_gen := 0; cell_pattern := any('0123456789'); life$init_life; loop set (screen_update, on); ! [mpg] exitif current_gen >= max_gen; current_gen := current_gen + 1; translate (current_buffer, '0', '*'); ! prepare to evaluate buf set (screen_update, off); ! [mpg] position(beginning_of(current_buffer)); loop cell_range := search (cell_pattern, forward); exitif cell_range = 0; position (cell_range); life$evaluate_cell (cell_range); position (cell_range); life$go_horizontal(1); endloop; position (beginning_of(current_buffer)); translate (current_buffer, ' * ** ', ' abcdefgh0123456789'); set (status_line, current_window, reverse,fao(life$status,current_gen)); update (current_window); endloop; message ("Simulation complete."); endprocedure; ! eve_life !--------------------------------------------------------------------------- ! Sort A Named Buffer In Assending Order !--------------------------------------------------------------------------- ! ! Sort the named buffer. Prompt for buffer name if not specified ! procedure eve_sort_buffer (buffer_to_sort) local v_buf ,p_buf; if not eve$prompt_string (buffer_to_sort,v_buf,"Sort buffer: ","Cancelled") then return; endif; p_buf := sort_find_buffer (v_buf); if (p_buf <> 0) then shell_sort (p_buf); else message ("Buffer "+v_buf+" not found"); endif; endprocedure ! ! Compare two strings ! ! Returns: ! 1 if string1 > string2 ! 0 if string1 = string2 ! -1 if string1 < string2 ! procedure sort_string_compare (string1,string2) local v_alpha, v_c1, v_p1, v_c2, v_i, v_p2; v_alpha := " " + !Treat all control chars as spaces??? " " + " !""#$%&'()*+,-./"+ "0123456789:;<=>?" + "@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_" + "`abcdefghijklmnopqrstuvwxyz{|}~"; v_i := 1; loop if (length (string2) < v_i) then if (length (string2) = length (string1)) then return 0 else return 1 endif; endif; if (length (string1) < v_i) then return -1; endif; v_c1 := substr (string1,v_i,1); change_case (v_c1,upper); v_c2 := substr (string2,v_i,1); change_case (v_c2, upper); v_p1 := index (v_alpha,v_c1); v_p2 := index (v_alpha,v_c2); if (v_p1 < v_p2) then return -1; endif; if (v_p1 > v_p2) then return 1; endif; v_i := v_i + 1; endloop; return 1; endprocedure ! ! This is the shell sort, described in knuth and also ! referred to as the Diminishing Increment Sort. ! procedure shell_sort (buffer_to_sort) local v_pos ,v_iline ,v_jline ,v_i ,v_j ,v_record ; on_error position (v_pos); return; endon_error; v_pos := mark (none); position (buffer_to_sort); shell_sort_step_0 := 1; shell_sort_step_1 := 4; shell_sort_step_2 := 13; shell_sort_step_3 := 40; shell_sort_step_4 := 121; shell_sort_step_5 := 364; shell_sort_step_6 := 1093; shell_sort_step_7 := 3280; shell_sort_step_8 := 9841; shell_sort_step_9:= 32767; sort_gshell := 0; shell_sort_index := 0; ! ! Find the highest step to use ! loop sort_gshell := 0; exitif (shell_sort_index >= 6); execute ("if (get_info (current_buffer,'record_count') <"+ fao ("shell_sort_step_!UL)",shell_sort_index+2)+ " then sort_gshell := 1;endif;"); if sort_gshell then exitif 1; endif; shell_sort_index := shell_sort_index + 1; endloop; v_record := get_info (current_buffer,'record_count'); ! ! Now we can sort the buffer. Outer loop loops over all the steps, ! decrementing shell_sort_index. ! loop execute (fao("sort_gshell := shell_sort_step_!UL", shell_sort_index)); v_j := sort_gshell + 1; !Set up loop for step+1-index loop position (beginning_of (current_buffer)); move_vertical (v_j - 1); !Get j'th line v_jline := current_line; v_i := v_j - sort_gshell; !i = j - h loop position (beginning_of (current_buffer)); move_vertical (v_i - 1); v_iline := current_line; if (sort_string_compare(v_jline,v_iline) >= 0) then position (beginning_of (current_buffer)); move_vertical (v_i + sort_gshell - 1); erase_line; split_line; move_vertical (-1); copy_text (v_jline); exitif 1; else position (beginning_of (current_buffer)); move_vertical (v_i + sort_gshell - 1); erase_line; split_line; move_vertical (-1); copy_text (v_iline); v_i := v_i - sort_gshell; if (v_i < 1) then position (beginning_of (current_buffer)); move_vertical (v_i + sort_gshell - 1); erase_line; split_line; move_vertical (-1); copy_text (v_jline); exitif 1; endif; endif; endloop; v_j := v_j + 1; exitif (v_j > v_record); endloop; shell_sort_index := shell_sort_index - 1; exitif (shell_sort_index < 0); endloop; position (v_pos); endprocedure ! ! translate a buffer name to a buffer pointer ! procedure sort_find_buffer(buffer_name) ! Find a buffer by name local the_buffer, ! Used to hold the buffer pointer the_name; ! A read/write copy of the name the_name := buffer_name; change_case(the_name,UPPER); the_buffer := get_info(buffers,"first"); loop exitif (the_buffer = 0); exitif (the_name = get_info(the_buffer,"name")); the_buffer := get_info(buffer,"next"); endloop; return the_buffer; endprocedure !--------------------------------------------------------------------------- ! Select A Buffer !--------------------------------------------------------------------------- procedure eve_list_buffers local original_buffer, ! buffer - buffer where user came from selected_buffer, ! buffer - buffer where user is going loop_buffer, ! buffer - search loop buffer loop_exit, ! integer - exit outer loop flag cmd; ! string - command string ! save the current buffer original_buffer := current_buffer; ! list all of the existing buffers build_buffer_list(1); ! loop until a buffer is selected loop_exit := 0; loop exitif(loop_exit = 1); ! ask the user to select a buffer name cmd := read_line(fao('Enter buffer name [!AS] ', get_info(original_buffer,'name'))); if length(cmd) = 0 then map(current_window,original_buffer); loop_exit := 1; else ! see if that buffer exists and if it does map to it change_case(cmd,upper); loop_buffer := get_info(buffers,'first'); loop exitif (loop_buffer = 0); if cmd = substr(get_info(loop_buffer,'name'),1,length(cmd)) then map(current_window,loop_buffer); loop_exit := 1; exitif(1); else loop_buffer := get_info(buffers,'next'); endif; endloop; endif; endloop; ! lets see the new buffer eve$set_status_line(current_window); update(current_window); endprocedure; !--------------------------------------------------------------------------- ! Build A List Of The Existing Buffers !--------------------------------------------------------------------------- procedure build_buffer_list(system_flag) local list_buffer, ! buffer - work buffer last_buffer, ! buffer - last buffer in buffer list loop_buffer, ! buffer - current buffer being looked temp; ! string - temporary string ! test if the work buffer already exists if test_if_buffer_exists('LIST OF BUFFERS',list_buffer) = 0 then list_buffer := create_buffer('LIST OF BUFFERS'); set(no_write,list_buffer,on); endif; ! map the list buffer to the current window erase(list_buffer); map(current_window,list_buffer); eve$set_status_line(current_window); ! write buffer list items into list buffer copy_text(' Buffer name Lines Attributes'); split_line; last_buffer := get_info(buffers,'last'); loop_buffer := get_info(buffers,'first'); loop exitif (loop_buffer = 0); if (system_flag or (get_info(loop_buffer,'system') = 0)) then split_line; copy_text(get_info(loop_buffer,'name')); loop exitif (current_offset > 33); copy_text(' '); endloop; temp := fao("!6UL ", get_info(loop_buffer,'record_count')); copy_text(temp); if (get_info(loop_buffer,'modified')) then copy_text('Modified '); else copy_text(' '); endif; if (get_info(loop_buffer,'no_write')) then copy_text('No_write '); else copy_text(' '); endif; if (get_info(loop_buffer,'system')) then copy_text('System '); else copy_text(' '); endif; if (get_info(loop_buffer,'permanent')) then copy_text('Permanent'); else copy_text(' '); endif; temp := current_line; move_horizontal (-current_offset); erase(create_range(mark(none),end_of(current_buffer),none)); edit(temp,trim_trailing); copy_text(temp); endif; exitif (loop_buffer = last_buffer); loop_buffer := get_info(buffers,'next'); endloop; update(current_window); endprocedure;