! ABEL_MISC.TPU ! ! Table of Contents as of 27-Mar-1988 ! ! Procedure name Page Description ! -------------- ---- ----------- ! ! eve_fx 1 Provide video attributes in text ! eve_dcl 3 Revised DCL interface ! eve_set_dcl 4 Change interactive-DCL setting ! eve_return 5 The carriage return routine ! eve_fill_paragraph 6 Paragraph justification ! eve_nowist 7 Creates text to play with ! Page 1 procedure eve_fx ! Provide video attributes in text ! Effects (Effects) ! Provides a way of inserting special video characters. ! ! Normally, Abel "translates" (TPU term) escape sequences into their ! constituent characters to display on the screen; this can make it difficult ! to see the results of the escape sequences. FX creates a window at the ! bottom of the screen to show the current line in its untranslated form so you ! can see the results of the escape sequences. When called with any of the ! video attribute qualifiers, FX inserts the necessary escape sequences into ! your text. The FX window at the bottom of the screen can be removed by ! another call to FX with no qualifiers. ! ! When the video attribute qualifiers are used, FX inserts the necessary escape ! sequences into the text to turn on and off the attributes, and leaves the ! cursor imbedded in the sequences. You may type in the text to be highlighted ! and see it in the bottom window. When you are done, call FX without ! parameters to remove the bottom FX window and move the cursor past the off ! portion of the escape sequences. ! ! Qualifiers: ! /normal boolean turn off all attributes ! /bold boolean bold ! /underline boolean underline ! /blink boolean blink ! /reverse boolean reverse ! ! Source: ! Eva2 local cw, starting_position, normal; on_error endon_error cw:=current_window; starting_position:=mark(none); normal:=ascii(27)+"[m"; if get_info(abl$fx_window,"type")<>window then abl$fx_window:=create_window(24,1,off); set(text,abl$fx_window,no_translate); endif; if abl$q_normal then copy_text(normal); return; endif; if (abl$q_bold) or (abl$q_underline) or (abl$q_blink) or (abl$q_reverse) then map(abl$fx_window,current_buffer); position(cw); if search(anchor & normal,forward)<>0 then move_horizontal(4) endif; copy_text(ascii(27)+"["); if abl$q_bold then copy_text("1;") endif; if abl$q_underline then copy_text("4;") endif; if abl$q_blink then copy_text("5;") endif; if abl$q_reverse then copy_text("7;") endif; erase_character(-1); copy_text("m"); copy_text(normal); position(search(normal,reverse)); else if get_info(abl$fx_window,"visible") then starting_position:=mark(none); unmap(abl$fx_window); position(starting_position); if search(anchor & normal,forward)<>0 then move_horizontal(3) endif; else map(abl$fx_window,current_buffer); position(cw); endif; endif; endprocedure ! Page 2 !procedure eve_control_characters($selection) ! !local ! selection; ! !if not abl$prompt_word("/translate/notranslate",$selection,selection, ! "Translate undisplayable characters (translate, notranslate) []? ", ! "Aborted...") then ! return 0; !endif; ! !if selection = "translate" then ! usr_translate_cc !else ! usr_unexpand_cc !endif; !endprocedure ! ! !procedure usr_unexpand_cc !Make invisible chars invisible !local ! cc_pattern, ! pattern to find control characters ! cc_range, ! the pattern as found in the text ! cc_text, ! the text of the find ! attempts, ! how many times we've tried ! failures, ! how many times we've failed ! here, ! the user's starting position ! oldmode; ! the user's starting mode ! !oldmode:=get_info(current_buffer,"mode"); !set(insert,current_buffer); !here:=mark(none); !position(beginning_of(current_buffer)); !cc_pattern:="<" & arb(3) & ">"; !attempts:=0; !failures:=0; !loop ! cc_range := search(cc_pattern,forward,exact); ! exitif cc_range=0; ! attempts := attempts+1; ! position(cc_range); ! cc_text := substr(cc_range,2,255); ! cc_text := "/" + substr(cc_text,1,length(cc_text)-1); ! change_case(cc_text,upper); ! cc_table_ptr := index(abl$cc_translate_table,cc_text); ! if cc_table_ptr = 0 then ! failures:=failures+1; ! move_horizontal(1); ! else ! erase(cc_range); ! copy_text(substr(abl$cc_translate_table,cc_table_ptr+4,1)); ! endif; ! delete(cc_range); !endloop; !message(str(attempts-failures)+" substitutions made, "+str(failures)+ ! " failures"); !position(here); !set(oldmode,current_buffer); !endprocedure ! ! !procedure usr_expand_cc !Translate invisible characters !local ran,curchar,x,y,here,oldmode; !oldmode:=get_info(current_buffer,"mode"); !set(insert,current_buffer); !here:=mark(none); !position(beginning_of(current_buffer)); !y:=0; !loop ! ran:=search(any(usr_cc_enc),forward,exact); ! exitif ran=0; ! y:=y+1; ! position(ran); ! curchar:=current_character; ! erase(ran); ! x:=index(usr_cc_enc,curchar); ! copy_text("<"+substr(usr_cc_dec,x*4-3,3)+">"); !endloop; !message(str(y)+" substitutions made"); !position(here); !set(oldmode,current_buffer); !endprocedure ! Page 3 procedure eve_dcl($dcl_string) ! Revised DCL interface ! Gives user access to DCL in a buffer ! ! Parameters: ! /cr boolean send a carriage-return even if no dcl string ! /eof boolean send an end-of-file ! /echo boolean echo the typed command in the DCL window ! ! Source: ! Eve local dcl_string, ! Local copy of dcl_parameter this_position, ! Marker for current cursor position this_buffer; ! Current buffer on_error if error = tpu$_createfail then message ("DCL subprocess could not be created"); return (0); endif; endon_error; ! ! Prompt for DCL string if we have nothing to give to DCL yet ! dcl_string := $dcl_string; if not (abl$q_eof or abl$q_cr) then if not (eve$prompt_string (dcl_string, dcl_string,"DCL command: ", "No DCL command given")) then return 0; endif; endif; ! ! Create the DCL subprocess if necessary ! if (get_info (eve$x_dcl_process, eve$kt_type) = unspecified) or (eve$x_dcl_process = 0) then message ("Creating DCL subprocess..."); eve$x_dcl_process := create_process (eve$dcl_buffer, "$ set noon"); endif; ! ! Map the DCL buffer if necessary ! this_buffer := current_buffer; this_position := mark (none); if this_buffer <> eve$dcl_buffer then if get_info(eve$dcl_buffer,"map_count") = 0 then if eve$x_number_of_windows = 2 then eve_other_window; if current_buffer <> eve$dcl_buffer then map (current_window, eve$dcl_buffer); endif; else unmap (eve$main_window); map (eve$top_window, this_buffer); eve$set_status_line (eve$top_window); update (eve$top_window); map (eve$bottom_window, eve$dcl_buffer); eve$x_number_of_windows := 2; eve$x_this_window := eve$bottom_window; endif; endif; endif; eve$update_status_lines; position (end_of (eve$dcl_buffer)); ! ! Process the DCL string - need to include the $ ! if (dcl_string <> "") or (abl$q_cr) then if abl$q_echo then split_line; copy_text (dcl_string); endif; send (dcl_string, eve$x_dcl_process); if (abl$q_cr) and (dcl_string = "") then message("Sent DCL a carriage return") endif; endif; if abl$q_eof then send_eof(eve$x_dcl_process); message("Sent DCL an end-of-file"); endif; ! ! Clean up ! update (current_window); position (end_of (eve$dcl_buffer)); update (current_window); if this_buffer <> eve$dcl_buffer then eve_other_window; ! position(this_position); endif; return 1; endprocedure; ! Page 4 procedure eve_set_dcl($mode) ! Change interactive-DCL setting ! Turn on/off interactive DCL mode; when on, any carriage-returns pressed while ! in the DCL buffer will transmit the line to DCL ! ! Source: ! Abel local unchanged_text, mode; ! ! Set unchanged text ! if abl$dcl_interactive then unchanged_text := "DCL mode unchanged; interactive" else unchanged_text := "DCL mode unchanged; normal" endif; ! ! Prompt for mode ! if not abl$prompt_word("/interactive/normal",$mode,mode, "Set DCL mode (interactive, normal) [] ? ",unchanged_text) then return 0; endif; ! ! Change flag as necessary ! if mode = "interactive" then abl$dcl_interactive := 1; message("DCL buffer mode interactive"); else abl$dcl_interactive := 0; message("DCL buffer mode normal"); endif; endprocedure ! Page 5 procedure eve_return ! The carriage return routine ! Procedure invoked by the Return key. Split the current line, obeying ! margin settings. Enhanced to support interactive DCL buffer; if return ! is pressed while in the DCL buffer and interactive DCL is set then the ! current line is send to the DCL subprocess. ! ! Source: ! Eve local left_margin; ! Left margin of current buffer on_error endon_error; ! ! If we're in the command window... ! if current_window = eve$command_window then eve$exit_command_window; return; endif; ! ! If we're in the DCL buffer, do the current line ! if (current_buffer = eve$dcl_buffer) and (abl$dcl_interactive) then abl$do("eve_dcl('"+current_line+"')", "abl$q_cr:=1;abl$q_eof:=0;abl$q_echo:=0"); endif; ! ! Process a regular return ! if get_info (current_buffer, eve$kt_offset_column) > get_info (current_buffer, eve$kt_right_margin) then eve$fill_line (0); else eve$split_line; endif; eve$show_first_line; left_margin := get_info (current_buffer, eve$kt_left_margin); if left_margin > 1 then eve$to_column (left_margin); endif; endprocedure; ! Page 6 procedure eve_fill_paragraph ! Paragraph justification ! Performs justification on the current paragraph. A paragraph is delimited by ! blank lines (empty or whitespace). Current margin settings are used by ! default ! ! Qualifiers: ! /indent integer offset of first line from left margin ! /whole boolean process entire paragraph, else from here to end ! /autoleft boolean determine left margin from current line whtspc ! /left_margin integer left margin to use ! /right_margin integer right margin to use ! ! Source: ! Eve local found, indent_mark, old_dir, this_position, ! Marker for current cursor position start_paragraph, ! Marker for start of current paragraph stop_paragraph, ! Marker for end of current paragraph fill_range; ! Range for current paragraph on_error endon_error; if (abl$q_indent<>0) and (not abl$q_whole) then message("Can't specify /INDENT and /NOWHOLE"); return 0; endif; ! Can't fill an empty buffer - avoid additional checks later on if beginning_of (current_buffer) = end_of (current_buffer) then message ("Nothing to fill"); return; endif; this_position := mark (none); ! If "auto" then figure out the left margin setting from the amount of ! whitespace at the beginning of this line if abl$q_autoleft then if abl$q_left_margin <> 0 then message("Cannot specify both /LEFT_MARGIN and /AUTOLEFT"); else move_horizontal(-current_offset); found := search(anchor & span(eve$x_whitespace),forward); if not found then abl$q_left_margin := 1; else position(end_of(found)); move_horizontal(1); update(current_window); abl$notab_offset(abl$q_left_margin); abl$q_left_margin := abl$q_left_margin + 1; endif; endif; else if abl$q_left_margin = 0 then abl$q_left_margin:=get_info(current_buffer,"left_margin") endif; endif; if abl$q_right_margin = 0 then abl$q_right_margin:=get_info(current_buffer,"right_margin") endif; message(fao("Filling margins !SL and !SL", abl$q_left_margin,abl$q_right_margin)); ! Find beginning and end of paragraph ! If on a blank line do preceding paragraph move_horizontal (- current_offset); if abl$q_whole then loop exitif mark (none) = beginning_of (current_buffer); move_vertical (-1); if eve$paragraph_break then move_vertical (1); exitif 1; endif; endloop; endif; start_paragraph := mark (none); position (this_position); move_horizontal (- current_offset); loop exitif mark (none) = end_of (current_buffer); exitif eve$paragraph_break; move_vertical (1); endloop; if start_paragraph = mark (none) then message ("Nothing to fill"); position (this_position); else move_horizontal (-1); stop_paragraph := mark (none); ! Now fill the paragraph fill_range := create_range (start_paragraph, stop_paragraph, none); if abl$q_indent=0 then fill (fill_range, eve$x_word_separators, abl$q_left_margin, abl$q_right_margin); else if (abl$q_left_margin+abl$q_indent<1) or (abl$q_left_margin+abl$q_indent>abl$q_right_margin) then message("Cannot use requested setting of /indent"); position(this_position); return 0; endif; position(start_paragraph); eve$compress_whitespace; copy_text(substr(eve$x_spaces,1,abl$q_indent+abl$q_left_margin-1)); if abl$q_indent<0 then move_horizontal(-abl$q_indent) endif; indent_mark:=mark(none); fill_range:=create_range(indent_mark,stop_paragraph,none); fill(fill_range, eve$x_word_separators, abl$q_left_margin, abl$q_right_margin); endif; position (stop_paragraph); eve$show_first_line; endif; endprocedure; ! Page 7 procedure eve_nowist($phrase) ! Creates text to play with ! Creates text to play with; I use it to show Abel features ! ! Parameters: ! $phrase string phrase to use instead of "Now is the time..." ! ! Qualifiers: ! /lines integer number of lines to generate ! ! Source: ! Eva2 local x, phrase, cur_buf; cur_buf:=current_buffer; phrase := $phrase; if phrase = "" then phrase := "Now is the time for all good men to come to the aid of their country." endif; if get_info(abl$nowist_buffer,"type") <> buffer then abl$nowist_buffer:=create_buffer("nowist"); set(no_write,abl$nowist_buffer); endif; erase(abl$nowist_buffer); position(abl$nowist_buffer); x:=abl$q_lines; loop exitif x=0; x:=x-1; copy_text(phrase); split_line; endloop; append_line; position(cur_buf); set(screen_update,off); if get_info(abl$nowist_buffer,"map_count")=0 then if eve$x_number_of_windows=2 then eve_other_window; else eve_two_windows; endif; map(current_window,abl$nowist_buffer); endif; eve$update_status_lines; position(beginning_of(abl$nowist_buffer)); set(screen_update,on); endprocedure procedure eve_define_key (define_parameter) ! Associate a key with an Eve command. Prompts for the key. ! Defined keys can be indentified by a leading space in the comment field. ! Need this to be able to differentiate during keypad initialization. ! ! Abel needs the defined command to be processed through EVE_DO instead of ! directly so that the command's qualifiers get initialized and provided ! qualifiers get set. ! ! Parameters: ! define_parameter String containing command name - input ! ! Source: ! Eve local command_name, ! Local copy of define_parameter full_command_name, ! Full command string returned by eve$parse the_key, ! Keyword for key to be defined paren_index, ! Index into full_command_name to end name define_comment; ! String (with leading space) to associate ! with the_key on_error if error = tpu$_notdefinable then message ("No key defined"); return; endif; endon_error; if not (eve$prompt_string (define_parameter, command_name, eve$x_eve_command_prompt, "No key defined")) then return; endif; full_command_name := eve$parse (command_name); ! Eve$Parse will display messages and handle ambiguities if full_command_name = eve$kt_null then return; endif; the_key := eve$prompt_key ("Press the key that you want to define: "); paren_index := index (full_command_name, "("); if paren_index = 0 then define_comment := substr (full_command_name, 5, length (full_command_name)); else define_comment := substr (full_command_name, 5, paren_index - 5); endif; ! Return gets you out without redefining a key if the_key = ret_key then message ("No key defined"); else if eve$lookup_comment (the_key) = "do" then message ("You cannot bind another command to the DO key"); else if eve$alphabetic (the_key) = eve$kt_null then define_key ("eve_do("""+command_name+""")", the_key, define_comment, eve$x_user_keys); message ("Key defined"); else message ("You cannot bind another command to a typing key"); endif; endif; endif; endprocedure; !procedure tpu$local_init ! !abl$cc_translate_table := ! "/NUL" + ascii(0) + "/SOH" + ascii(1) + "/STX" + ascii(2) + ! "/ETX" + ascii(3) + "/EOT" + ascii(4) + "/ENQ" + ascii(5) + ! "/ACK" + ascii(6) + "/BEL" + ascii(7) + "/BS_" + ascii(8) + ! "/LF_" + ascii(10) + "/VT_" + ascii(11) + "/FF_" + ascii(12) + ! "/CR_" + ascii(13) + "/SO_" + ascii(14) + "/SI_" + ascii(15) + ! "/DLE" + ascii(16) + "/DC1" + ascii(17) + "/DC2" + ascii(18) + ! "/DC3" + ascii(19) + "/DC4" + ascii(20) + "/NAK" + ascii(21) + ! "/SYN" + ascii(22) + "/ETB" + ascii(23) + "/CAN" + ascii(24) + ! "/EM_" + ascii(25) + "/SUB" + ascii(26) + "/ESC" + ascii(27) + ! "/FS_" + ascii(28) + "/GS_" + ascii(29) + "/RS_" + ascii(30) + ! "/US_" + ascii(31) + "/IND" + ascii(132) + "/NEL" + ascii(133) + ! "/HTS" + ascii(136) + "/VTS" + ascii(138) + "/PLD" + ascii(139) + ! "/PLU" + ascii(140) + "/RI_" + ascii(141) + "/SS2" + ascii(142) + ! "/SS3" + ascii(143) + "/DCS" + ascii(144) + "/CSI" + ascii(155) + ! "/ST_" + ascii(156) + "/DEL" + ascii(127);