!++ ! FILENAME: PRINT_BUFFER.TPU ! FUNCTION: This file contains procedures for filtering non printable ! characters from a buffer and for the printing of buffers. ! AUTHOR: Steven K. Shapiro, (C) Copyright SKS Enterprises, Austin TX. ! All Rights Reserved. ! ! The format, structure and contents of this file are the sole ! property of Steven K. Shapiro and are copyrighted to SKS ! Enterprises, Austin Texas. ! ! The information may be freely distributed, used and modified ! provided that the information in this header block is not ! changed, altered, disturbed or modified in any way. ! ! DATE: 25-AUG-1987 Original. ! HISTORY: current. ! CONTENTS: ! eve_print_buffer ! eve$translate_controls (char) ! eve$search_controls (this_buffer) ! ep$find_xlate_controls (this_buffer) ! ep$find_xlate_multinationals (this_buffer) ! eve_filter_buffer ! eve_print_select_range ! ep$xlate_controls (char) ! ep$xlate_multinationals (char) ! !23456789A123456789B123456789C123456789D123456789E123456789F123456789G123456789H !-- !*----------------------------------------------------------------------------*! procedure print_buffer_module_ident local file_date, module_vers; file_date := "-<( 29-DEC-1988 17:28:02.09 )>-"; module_vers := substr(file_date,5,2) + substr(file_date,8,3) + substr(file_date,14,2) + substr(file_date,17,5) ; return module_vers; endprocedure; !*----------------------------------------------------------------------------*! ! ! This procedure copies the current buffer to the translate buffer, translates ! non-printing control characters and DEC Multinational characters to readable ! character strings, writes the translate buffer to a file with the extension ! of .PNT, and submits the file to be printed. ! procedure eve_print_buffer local this_informational, ! Keyword for display of informational messages this_position, this_buffer, buffer_name, file_name, rbrack, filext, print_command, print_process; on_error if error = tpu$_createfail then message("Subprocess could not be created"); return; endif; endon_error; if get_info (system, "informational") then this_informational := on; else this_informational := off; endif; set(informational,off); set(success,off); this_position := mark(none); this_buffer := current_buffer; if get_info(translate_buffer,"type") = UNSPECIFIED then translate_buffer := create_buffer ('translation'); set (no_write, translate_buffer); endif; position (translate_buffer); erase (translate_buffer); copy_text (this_buffer); ! Make a copy of the original buffer ep$find_xlate_controls(this_buffer); ! Translate control characters. position (beginning_of (translate_buffer)); ! if search (ep$multnat_char_pat, forward) <> 0 ! then ! if eve$insist_y_n ( ! 'This buffer contains Non-printable Multinational characters. ' + ! 'Translate them? ') ! then ! ! Translate multinational characters. ep$find_xlate_multinationals(this_buffer); ! endif; ! endif; ! Get the output file name from the original buffer and use it as the file ! name for the translated buffer. buffer_name := get_info(this_buffer,"name"); file_name := get_info(this_buffer,"file_name"); ! if no output file name then ask the user for one. if file_name = "" then file_name := read_line ("Enter a file name to write buffer " + buffer_name + " or press RETURN to cancel: "); if file_name = "" then set (informational, this_informational); set(success,on); return; else if ( index(file_name,".") = 0 ) then file_name := file_name + ".;"; else if ( index(file_name,";") = 0 ) then file_name := file_name + ";" endif; endif; endif; endif; ! message("Input Filename =>"+file_name); if ( index(file_name,";") <> 0 ) then rbrack := index(file_name,"]"); ! message("rbrack =>"+str(rbrack)); filext := index(substr(file_name,rbrack+1,length(file_name)),"."); ! message("filext =>"+str(filext)); ! file_name := substr(file_name,1,index(file_name,";") - 1); file_name := substr(file_name,1,rbrack + filext); endif; file_name := file_name + "PNT"; ! message("Output Filename =>"+file_name); ! Set the output file on the original buffer ! just in case it didn't have one. ! set(output_file,this_buffer,file_name); set(output_file,translate_buffer,file_name); write_file(translate_buffer); ! ask the user for the print command ! print_command := read_line("Print command: "); ! if none returned set the default. ! if print_command = "" ! then print_command := "PRINT/QUEUE=SYS$PRINT/NOTIFY"; ! endif; print_command := print_command + " "; message(fao("Printing !AS with command !AS",buffer_name,print_command)); print_process := create_process(message_buffer,"$set noon"); send(print_command + file_name, print_process); delete(print_process); set (informational, this_informational); set (success, on); update(message_window); position(this_position); message("Output file saved in: "+file_name); endprocedure; !*----------------------------------------------------------------------------*! ! ! This procedure translates control characters to readable characters. ! procedure eve$translate_controls (char) ! The backwards questions mark is the placeholder for control characters ! from ASCII(0) thru ASCII(31) on the VT2xx series of terminals CASE char FROM '' TO '' [''] : COPY_TEXT (''); [''] : COPY_TEXT (''); [''] : COPY_TEXT (''); [''] : COPY_TEXT (''); [''] : COPY_TEXT (''); [''] : COPY_TEXT (''); [''] : COPY_TEXT (''); [''] : COPY_TEXT (''); [''] : COPY_TEXT (''); [''] : COPY_TEXT (''); [''] : COPY_TEXT (''); [''] : COPY_TEXT (''); [''] : COPY_TEXT (''); [''] : COPY_TEXT (''); [''] : COPY_TEXT (''); [''] : COPY_TEXT (''); [''] : COPY_TEXT (''); [''] : COPY_TEXT (''); [''] : COPY_TEXT (''); [''] : COPY_TEXT (''); [''] : COPY_TEXT (''); [''] : COPY_TEXT (''); [''] : COPY_TEXT (''); [''] : COPY_TEXT (''); [''] : COPY_TEXT (''); [''] : COPY_TEXT (''); [''] : COPY_TEXT (''); [INRANGE, OUTRANGE] : COPY_TEXT (char); endcase; endprocedure !*----------------------------------------------------------------------------*! ! ! This procedure controls the outer loop search for the special ! control characters that we want to view ! procedure eve$search_controls (this_buffer) local control_char_pat, control_char, char_to_translate; ! When the search fails we know that we have either hit the end of ! the buffer or there were no more special characters found. on_error position (translate_buffer); return; endon_error; if get_info(translate_buffer,"type") = UNSPECIFIED then translate_buffer := create_buffer ('translation'); set (no_write, translate_buffer); endif; control_char_pat := any (''); position (translate_buffer); erase (translate_buffer); copy_text (this_buffer); ! Make a copy of the original buffer position (beginning_of (translate_buffer)); loop ! Find all occurrences control_char := search (control_char_pat, forward); position (control_char); char_to_translate := current_character; ! Save the character erase (control_char); ! then erase it eve$translate_controls (char_to_translate); ! Substitute the new text endloop; endprocedure !*----------------------------------------------------------------------------*! ! This procedure locates the control characters in the transalate buffer that ! require translation and replaces them with printable strings. ! procedure ep$find_xlate_controls (this_buffer) local control_char_pat, control_char, char_to_translate; ! When the search fails we know that we have either hit the end of ! the buffer or there were no more special characters found. on_error position (translate_buffer); return; endon_error; control_char_pat := any (''); position (beginning_of (translate_buffer)); loop ! Find all occurrences control_char := search (control_char_pat, forward); position (control_char); char_to_translate := current_character; ! Save the character erase (control_char); ! then erase it eve$insert_text(ep$xlate_controls (char_to_translate)); ! and replace it endloop; endprocedure !*----------------------------------------------------------------------------*! ! ! This procedure locates the control characters in the transalate buffer that ! require translation and replaces them with printable strings. ! procedure ep$find_xlate_multinationals (this_buffer) local multnat_char_pat, multinat_char, multnat_char, char_to_translate; ! When the search fails we know that we have either hit the end of ! the buffer or there were no more special characters found. on_error position (translate_buffer); return; endon_error; multinat_char := "" + "" + ""; multnat_char_pat := any (multinat_char); position (beginning_of (translate_buffer)); loop ! Find all occurrences multnat_char := search (multnat_char_pat, forward); position (multnat_char); char_to_translate := current_character; ! Save the character erase (multnat_char); ! then erase it and replace eve$insert_text(ep$xlate_multinationals (char_to_translate)); ! it endloop; endprocedure !*----------------------------------------------------------------------------*! ! ! This procedure copies the current buffer to the translate buffer, translates ! non-printing control characters and DEC Multinational characters to readable ! character strings, and writes the translate buffer to a file with the ! extension of .FLT ! procedure eve_filter_buffer local this_informational, ! Keyword for display of informational messages this_position, this_buffer, buffer_name, file_name, rbrack, filext, translate_window, print_command, print_process; on_error return; endon_error; if get_info (system, "informational") then this_informational := on; else this_informational := off; endif; set(informational,off); set(success,off); this_position := mark(none); this_buffer := current_buffer; if get_info(translate_buffer,"type") = UNSPECIFIED then translate_buffer := create_buffer ('translation'); set (no_write, translate_buffer); endif; translate_window := CREATE_WINDOW (1, 10, on); position (translate_buffer); erase (translate_buffer); copy_text (this_buffer); ! Make a copy of the original buffer ep$find_xlate_controls(this_buffer); ! Translate control characters. position (beginning_of (translate_buffer)); ep$find_xlate_multinationals(this_buffer); ! Get the output file name from the original buffer and use it as the file ! name for the translated buffer. buffer_name := get_info(this_buffer,"name"); file_name := get_info(this_buffer,"file_name"); ! if no output file name then ask the user for one. if file_name = "" then file_name := read_line ("Enter a file name to write buffer " + buffer_name + " or press RETURN to cancel: "); if file_name = "" then set (informational, this_informational); set(success,on); POSITION (BEGINNING_OF (translate_buffer)); ! Move to buffer top eve_split_window; eve$set_status_line (translate_window); return; else if ( index(file_name,".") = 0 ) then file_name := file_name + ".;"; else if ( index(file_name,";") = 0 ) then file_name := file_name + ";" endif; endif; endif; endif; ! message("Input Filename =>"+file_name); if ( index(file_name,";") <> 0 ) then rbrack := index(file_name,"]"); ! message("rbrack =>"+str(rbrack)); filext := index(substr(file_name,rbrack+1,length(file_name)),"."); ! message("filext =>"+str(filext)); ! file_name := substr(file_name,1,index(file_name,";") - 1); file_name := substr(file_name,1,rbrack + filext); endif; file_name := file_name + "FLT"; ! message("Output Filename =>"+file_name); ! Set the output file on the original buffer ! just in case it didn't have one. ! set(output_file,this_buffer,file_name); set(output_file,translate_buffer,file_name); write_file(translate_buffer); set (informational, this_informational); set (success, on); update(message_window); position(this_position); message("Output file saved in: "+file_name); POSITION (BEGINNING_OF (translate_buffer)); ! Move to buffer top eve_split_window; eve$set_status_line (translate_window); endprocedure; !*----------------------------------------------------------------------------*! ! ! This procedure will print a selected range. If there is no selected range ! active, it will inform the user and quit. It copies the current buffer to ! the translate buffer, translates non-printing control characters and DEC ! Multinational characters to readable character strings, and then submits it ! to be printed. The selected range is written to a file with the extension SEL. ! procedure eve_print_select_range local this_informational, ! Keyword for display of informational messages this_position, this_buffer, buffer_name, file_name, rbrack, filext, print_command, v_range, v_line, v_pos, print_process; on_error if error = tpu$_createfail then message("Subprocess could not be created"); return; endif; endon_error; if get_info (system, "informational") then this_informational := on; else this_informational := off; endif; set(informational,off); set(success,off); this_position := mark(none); this_buffer := current_buffer; v_pos := mark(none); if (eve$x_select_position = 0) then message ("No select range active."); return; ! v_range := create_range (beginning_of(current_buffer), ! end_of(current_buffer), none); else v_range := create_range (eve$x_select_position, mark(none), none); endif; if get_info(translate_buffer,"type") = UNSPECIFIED then translate_buffer := create_buffer ('translation'); set (no_write, translate_buffer); endif; position (translate_buffer); erase (translate_buffer); copy_text (v_range); ! Copy range into translation buffer. ep$find_xlate_controls(this_buffer); ! Translate control characters. position (beginning_of (translate_buffer)); ! Move back to beginning of buf. ep$find_xlate_multinationals(this_buffer); ! Translate multinational chars. ! Get the output file name from the original buffer and use it as the file ! name for the translated buffer. buffer_name := get_info(this_buffer,"name"); file_name := get_info(this_buffer,"file_name"); file_name := buffer_name; ! message("Buffer Filename =>"+buffer_name); ! if no output file name then ask the user for one. if file_name = "" then file_name := read_line ("Enter a file name to write buffer " + buffer_name + " or press RETURN to cancel: "); if file_name = "" then set (informational, this_informational); set(success,on); return; endif; endif; if ( index(file_name,".") = 0 ) then file_name := file_name + ".;"; else if ( index(file_name,";") = 0 ) then file_name := file_name + ";" endif; endif; if ( index(file_name,";") <> 0 ) then rbrack := index(file_name,"]"); ! message("rbrack =>"+str(rbrack)); filext := index(substr(file_name,rbrack+1,length(file_name)),"."); ! message("filext =>"+str(filext)); ! file_name := substr(file_name,1,index(file_name,";") - 1); file_name := substr(file_name,1,rbrack + filext); endif; file_name := file_name + "SEL"; ! message("Output Filename =>"+file_name); ! Set the output file on the original buffer ! just in case it didn't have one. set(output_file,translate_buffer,file_name); write_file(translate_buffer); print_command := "PRINT/QUEUE=SYS$PRINT/NOTIFY "; message(fao("Printing !AS with command !AS",file_name,print_command)); print_process := create_process(message_buffer,"$set noon"); send(print_command + file_name, print_process); delete(print_process); set (informational, this_informational); set (success, on); update(message_window); position(this_position); message("Output file saved in: "+file_name); endprocedure; !*----------------------------------------------------------------------------*! ! This procedure returns a printable string for a non-printable control ! character. procedure ep$xlate_controls (char) ! The backwards questions mark is the placeholder for many control ! characters from ASCII(0) thru ASCII(31) on the VT2xx series of terminals ! The checkerboard mark is the placeholder for most control characters ! from ASCII(0) thru ASCII(31) on the VT1xx series of terminals CASE char FROM '' TO '' [''] : return (''); ! 00 [''] : return (''); ! 01 [''] : return (''); ! 02 [''] : return (''); ! 03 [''] : return (''); ! 04 [''] : return (''); ! 05 [''] : return (''); ! 06 [''] : return (''); ! 07 [''] : return (''); ! 08 ! [' '] : return (''); ! 09 [' '] : return (''); ! 10 [' '] : return (''); ! 11 [' '] : return (''); ! 12 [' '] : return (''); ! 13 ! [''] : return (''); ! 14 [''] : return (''); ! 15 [''] : return (''); ! 16 [''] : return (''); ! 17 [''] : return (''); ! 18 [''] : return (''); ! 19 [''] : return (''); ! 20 [''] : return (''); ! 21 [''] : return (''); ! 22 [''] : return (''); ! 23 [''] : return (''); ! 24 [''] : return (''); ! 25 [''] : return (''); ! 26 [''] : return (''); ! 27 [''] : return (''); ! 28 [''] : return (''); ! 29 [''] : return (''); ! 30 [''] : return (''); ! 31 [INRANGE, OUTRANGE] : return (char); endcase; endprocedure; !*----------------------------------------------------------------------------*! ! This procedure returns a printable string for a non-printable DEC ! Multinational character. procedure ep$xlate_multinationals (char) ! The backwards questions mark is the placeholder for many DEC ! Multinational characters in the range from ASCII(127) thru ! ASCII(255) on the VT2xx series of terminals. ! The checkerboard mark is the placeholder for all DEC Multinational ! characters in the range from ASCII(127) thru ASCII(255) on the ! VT1xx series of terminals. CASE char FROM '' TO '' [''] : return (''); ! 127 [''] : return (''); ! 128 [''] : return (''); ! 129 [''] : return (''); ! 130 [''] : return (''); ! 131 [''] : return (''); ! 132 [''] : return (''); ! 133 [''] : return (''); ! 134 [''] : return (''); ! 135 [''] : return (''); ! 136 [''] : return (''); ! 137 [''] : return (''); ! 138 [''] : return (''); ! 139 [''] : return (''); ! 140 [''] : return (''); ! 141 [''] : return (''); ! 142 [''] : return (''); ! 143 [''] : return (''); ! 144 [''] : return (''); ! 145 [''] : return (''); ! 146 [''] : return (''); ! 147 [''] : return (''); ! 148 [''] : return (''); ! 149 [''] : return (''); ! 150 [''] : return (''); ! 151 [''] : return (''); ! 152 [''] : return (''); ! 153 [''] : return (''); ! 154 [''] : return (''); ! 155 [''] : return (''); ! 156 [''] : return (''); ! 157 [''] : return (''); ! 158 [''] : return (''); ! 159 [''] : return (''); ! 160 [''] : return (''); ! 161 [''] : return (''); ! 162 [''] : return (''); ! 163 [''] : return (''); ! 164 [''] : return (''); ! 165 [''] : return (''); ! 166 [''] : return (''); ! 167 [''] : return (''); ! 168 [''] : return (''); ! 169 [''] : return (''); ! 170 [''] : return ('<<<>'); ! 171 [''] : return (''); ! 172 [''] : return (''); ! 173 [''] : return (''); ! 174 [''] : return (''); ! 175 [''] : return ('<0^>'); ! 176 [''] : return ('<+->'); ! 177 [''] : return ('<2^>'); ! 178 [''] : return ('<3^>'); ! 179 [''] : return (''); ! 180 [''] : return (''); ! 181 [''] : return (''); ! 182 [''] : return ('<.^>'); ! 183 [''] : return (''); ! 184 [''] : return ('<1^>'); ! 185 [''] : return (''); ! 186 [''] : return ('<>>>'); ! 187 [''] : return ('<1/4>'); ! 188 [''] : return ('<1/2>'); ! 189 [''] : return (''); ! 190 [''] : return (''); ! 191 [''] : return (''); ! 192 [''] : return (""); ! 193 [''] : return (''); ! 194 [''] : return (''); ! 195 [''] : return (''); ! 196 [''] : return (''); ! 197 [''] : return (''); ! 198 [''] : return (''); ! 199 [''] : return (''); ! 200 [''] : return (""); ! 201 [''] : return (''); ! 202 [''] : return (''); ! 203 [''] : return (''); ! 204 [''] : return (""); ! 205 [''] : return (''); ! 206 [''] : return (''); ! 207 [''] : return (''); ! 208 [''] : return (''); ! 209 [''] : return (''); ! 210 [''] : return (""); ! 211 [''] : return (''); ! 212 [''] : return (''); ! 213 [''] : return (''); ! 214 [''] : return (''); ! 215 [''] : return (''); ! 216 [''] : return (''); ! 217 [''] : return (""); ! 218 [''] : return (''); ! 219 [''] : return (''); ! 220 [''] : return (''); ! 221 [''] : return (''); ! 222 [''] : return (''); ! 223 [''] : return (''); ! 224 [''] : return (""); ! 225 [''] : return (''); ! 226 [''] : return (''); ! 227 [''] : return (''); ! 228 [''] : return (''); ! 229 [''] : return (''); ! 230 [''] : return (''); ! 231 [''] : return (''); ! 232 [''] : return (""); ! 233 [''] : return (''); ! 234 [''] : return (''); ! 235 [''] : return (''); ! 236 [''] : return (""); ! 237 [''] : return (''); ! 238 [''] : return (''); ! 239 [''] : return (''); ! 240 [''] : return (''); ! 241 [''] : return (''); ! 242 [''] : return (""); ! 243 [''] : return (''); ! 244 [''] : return (''); ! 245 [''] : return (''); ! 246 [''] : return (''); ! 247 [''] : return (''); ! 248 [''] : return (''); ! 249 [''] : return (""); ! 250 [''] : return (''); ! 251 [''] : return (''); ! 252 [''] : return (''); ! 253 [''] : return (''); ! 254 [''] : return (''); ! 255 [INRANGE, OUTRANGE] : return (char); endcase; endprocedure;