!==========================================================================! !--- My Editor --------------------------------------- Version 2 Rev 00 ---! !==========================================================================! !--- Version 1 works only with VAX/VMS 4.x -------------------------------! !--- Version 2 works only with VAX/VMS 5.x -------------------------------! !==========================================================================! !--------------------------------------------------------------------------! !--- 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; ! 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 ret; ! string - call_user returned string (not used) ret := call_user(10,''); if ret = '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 ret; ! string - call_user returned string (not used) message('Loading common, project and user dictionaries'); ! load common dictionary ret := call_user(1,''); if ret = '0' then message('Error - common dictionary not found'); return(0); endif; ! load project dictionary ret := call_user(2,''); if ret = '1' then project_dict := 1; else project_dict := 0; endif; ! load user dictionary ret := call_user(3,''); if ret = '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 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); ret := call_user(4,substr(word_range,1,length(word_range))); if ret = '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; !--------------------------------------------------------------------------- ! 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 cmd := substr(spell_parameter,1,1); change_case(cmd,upper); ! 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 loop position(line_begin); exitif mark(none) = beginning_of(current_buffer); move_vertical(-1); position(line_begin); if eve$paragraph_break then move_vertical(1); exitif 1; endif; endloop; start_paragraph := mark(none); position(current); ! find the end of the current paragraph loop position(line_begin); exitif mark(none) = end_of(current_buffer); exitif eve$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 ret; ! 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 ret := call_user(8,''); ! if no word was found insert the default word list into the buffer ! otherwise insert word from user dictionary into the buffer if ret = '' 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(ret); count := 1; loop ret := call_user(9,''); exitif ret = ''; split_line; copy_text(ret); 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 word_range, ! range - range of current word 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) ret := call_user(5,''); ! 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); ret := call_user(6,substr(word_range,1,length(word_range))); if ret = '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 ret = '2' then message('Error - maximum word size exceeded'); endif; if ret = '3' then message('Error - word buffer overflow'); endif; if ret = '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 ret := call_user(7,''); if ret = '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 ret = '2' then message('Error opening user dictionary file'); endif; if ret = '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 ----------! !=========================================================================== !--------------------------------------------------------------------------- ! Display Location Information About The Current Line !--------------------------------------------------------------------------- procedure my_editor_what_line local current, ! marker - current position line_num, ! 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_num := total_lines; else line_num := 0; position (beginning_of(current_buffer)); loop move_vertical(1); line_num := line_num + 1; exitif mark(none) > current; endloop; endif; percent := (((line_num * 1000) / total_lines)+5)/10; message (fao ('You are on line !SL out of !SL (!SL%)', line_num, 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 trim_range, ! range - range to be trimed on each line 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; !--------------------------------------------------------------------------- ! 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; !--------------------------------------------------------------------------- ! 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;