!-------------------------------------------------------------------------- ! ! WPE - Word Processing Editor ! VERSION 5.2 ! (for use with EVE T2.0, TPU V2.0) and ! (for use with EVE T2.2, TPU V2.2) ! !-------------------------------------------------------------------------- ! ! Note: See the following files for information: ! WPE_MASTER.FILE contains information on bug fixes and revision levels. ! WPE_VERSION.DAT documents the current Version Number. ! ! FACILITY: ! Word Processing Editor (WPE) ! using..... ! EVE - { Extensible | Easy | Efficient } Vax Editor ! Text Processing Utility (VAXTPU) ! ! Alternate facility EDW = EDT Editor with WPE Extensions ! ! ABSTRACT: ! This is the source program for the WPE extension to the EVE interface ! of TPU. WPE emulates most of the capabilities of WPS-PLUS (TM), ! and provides some extensions. ! ! For Version 5.0 of VMS, use is made of the WPS features of the EVE ! editor. WPE corrects some mis-behavior of this emulator. Known ! problems, corrected by WPE, are: ! 1. W always writes full buffer (rather than a selected ! region), and always to the input file name. ! (EVE procedure eve_write_file) ! [The behavior remains the same in EVE T2.2] ! 2. Cut functions, where select range is zero-length, cuts 1 char. ! (eve$x_select_remove_flag should be := FALSE) ! [The behavior remains the same in EVE T2.2] ! 3. Page (Paginate) puts correct number of lines on the first ! page, but one line less than the correct number on all other ! pages. (EVE procedure eve$wps_paginate) Also, a problem was ! caused by EVE inserting a new line to hold the page marker. ! Printing then effectively starts one line lower on page 2-x ! than it does on page 1. The problems are related. ! [Most of The behavior remains the same in EVE T2.2; ! WPE mods are maintained to support settable CT len.] ! 4. Similarly, Gold P and Gold N inserts an unnecessary line. ! [The behavior remains the same in EVE T2.2] ! 5. EVE has a bug in the word-wrap routine. Create a text line ! of words until about column 75. Then type spaces after the ! last character. If the bug exists, EVE won't do a wrap until ! a non-space character is typed. We compensate for this ! behavior in wpe_word_wrap_routine. ! [The behavior remains the same in EVE T2.2] ! ! When/If EVE/WPS performs correctly, corrective code can be removed ! from WPE. ! ! TPU bugs: ! 1. In TPU V2.2, the build_in get_info(screen,"line_editing") ! returns the info as it was when TPU was activated - not as it ! may have been set by our call_user routine. In addition, doing a SPAWN ! restores the entering terminal status (what we would hope), but the ! logout from the spawn does not change back to the original environment ! of the TPU session. We are thus forced to write wpe_spawn, just to ! take care of this. Also, wpe_spell is required, and the spawn code in ! wpe_print_file is affected. ! ! ENVIRONMENT: ! VAX/VMS Version 5.0 and above. ! EVE Version T2.0 or T2.2 ! TPU Version V2.0 or V2.2 ! ! Author: ! Dale E. Coy ! ! International Business Machines Corporation ! Office Interconnect Systems ! 5 West Kirkwood Boulevard 01-04-60 ! Roanoke, TX 76299-0001 ! (817) 962-3323 ! ! ! CREATION DATE: January, 1987 ! ! MODIFIED BY: ! ! Dale E. Coy (V2.2 --> V2.3) ! Added Buffer recall capability. ! Cleaned up Help. ! Changed the way keys are redefined. ! Added capability to display characters (Gold ?). ! Added line number display (Gold |). ! Added capability to print files with controls. ! Added capability to fix files with CR & LF ! Added capability to match () (Gold X). ! Added Ctrl_F to return to editing. ! Bug fixes. ! 5-APR-1987 ! ! Application / Numeric Keypad Switch ! Karl Nielsen 11-APR-1987 ! ! Dale E. Coy (V2.3 --> V2.4) 18-NOV-1987 ! Added : F18 toggles between 2 & 1 window (WPE_TOGGLE_WINDOWS) ! Added : @ inserts SYS$LOGIN:SIGNATURE.WPE (WPE_SIGNATURE) ! Minor bug fix. ! ! Dale E. Coy (V2.4 --> V2.5) 24-MAR-1988 ! 2.501 Added NoTabs function ! ! Note: Versions 3 and 4 were "skipped" to synchronize with VMS ! ! Dale E. Coy - Version 5.0 July/August 1988 --- ! Complete rewrite for compatibility with ! (and to take advantage of) TPU V2/EVE T2.0 ! Bug fixes to EVE T2.0 emulation of WPS. ! Added: SET PAGE LENGTH as a synonym for CT. ! Added: Print command (asks "translated or untranslated") ! Print Untranslated mode. ! Added: EDW Keypad (EDT Keypad with all other WPE extensions) ! ! Baseline Version 5.000 completed 1-SEP-1988 ! ! Dale E. Coy - Version 5.1 July/September 1989 --- ! Fixes for changes between EVE T2.0 and T2.2 ! Fixes for changes between TPU V2.0 and V2.2 ! Added translation between EBCDIC and ASCII ! Bug fix for TPU Spawn and eve_spell ! ! Dale E. Coy - Version 5.2 September/Oct 1989 --- ! Fix for changes to eve_get_file ! Change in wpe_save_position (take advantage of TPU V2.2) ! Combined init modules ! Improved mail editor ! New functions in paragraph, get_file, include_file, and ! print_file ! Misc. bug fixes and technical changes. ! ! WPE_MASTER.FILE contains information on bug fixes and revision levels. ! WPE_VERSION.DAT documents the current Version Number. ! ! 5.001 = Bug Fix - map EDT ENTER key to wpe_return, not eve_return ! 5.002 = Define > and < for VT-100s ! 5.003 = Feature change (EVE Problem Fix) - Paginate, Gold P, Gold N, ! and Ctrl/L fixed to put FF on same line as existing text. ! 5.004 = Fixes to WPE modules to always return True/False Status. ! 5.005 = Added shift left/right capability. ! 5.006 = Added code to support revised operation of MORE.COM ! 5.007 = Added code for direct use as a mail editor. ! 5.008 = Improved call_user (set terminal/noline). ! 5.009 = Code cleanup. ! 5.010 = DECUS release version. - October, 1988 !-- ! 5.100 = Temporary Patches for VMS V5.1 ! 5.101 = Add translation between EBCDIC and ASCII ! 5.102 = Fix bug in TPU Spawn (set terminal /noline upon return) & spell ! 5.103 = Change wpe_eve$file_module_init_xx to conform to EVE T2.2 ! 5.104 = Add wpe_other_window for F19, if EVE T2.2 ! 5.105 = EVE T2.2 use eve$clear_select_position to cancel select range ! (no need with T2.2 to use eve$selection instead of ! comparing eve$x_select_position <> 0) !-- ! 5.200 = Sync with VMS (no EVE changes between VMS 5.1 and 5.2) ! 5.201 = EVE T2.2 use eve$get_file1 with buffer name, instead of ! eve_get_file (which ignores version number) ! 5.202 = Take advantage of TPU V2.2 in wpe_save_position ! 5.203 = Combine wpe_eve$file_module_init_replace and _mail to make ! maintenance easier, and save 9 blocks section file space. ! 5.204 = Improve exit behavior of mail editor. ! 5.205 = Add wpe_paragraph: finds next procedure in .TPU file, next ! topic in .HLP file. ! 5.206 = Add wpe_get_file feature emulating eve_open_selected. ! 5.207 = Add wpe_include_file feature simulating eve_include_selected. ! 5.208 = Add wpe_print_file feature to special-case DM$ print commands. ! 5.209 = Remove some dependencies on EVE T2.2 (get_file, other_window) ! 5.210 = DECUS release version. - November, 1989 !-- ! ! WPE.TPU ! ! Table of Contents as of (Version 5.2) ! ! Procedure name Description ! -------------- ------------ ! ! --- Modules required by EVE$BUILD --- ! ! wpe_module_ident Identification ! wpe_process_command Parser ! wpe_declare_synonym WPE Synonyms ! wpe_module_pre_init Intercept /nojournal for MORE interface ! wpe_module_init Initialization ! wpe_exit_handler Special handling for Exit ! wpe_quit_handler Special handling for Quit ! wpe_status_field Put facility name on Status Line ! ! --- Modules for Initialization --- ! ! - Executed during Build - ! wpe_init_keyboard Define keymaps and keys ! - Executed during Startup - ! wpe_fill_file_list Create array of wildcard files ! wpe_init_variables Define WPE Variables & Constants ! wpe_init_wpe Define the rest of WPE ! wpe$local_init Dummy init. for other layers ! wpe_set_mail_mode Startup if WPE is used as mail editor ! ! - Executed at Buffer Create/Switch - ! wpe_set_buffer_margin Right margin (.HLP files) ! wpe_get_file Jacket for eve_get_file ! - Extends Eve$KT_Word_Wrap_Routine - ! wpe_word_wrap_routine Line continuations, etc. ! ! ! --- Modules for Exit and Quit Handling --- ! ! wpe_exit Exit Handler ! wpe_quit Quit Handler ! wpe_save_position Save /Start_Position ! ! ! --- WPE Functional Modules --- ! ! wpe_delete_line Take out whole line ! wpe_delete_to_end_of_line F20 ! wpe_restore_line Put it back ! wpe_delete_word Replaces eve$edt_delete_word ! wpe_view View Tabs (Gold V) ! wpe_top eve_top + change direction ! wpe_toggle_width Toggle 80/132 col (Gold E) ! wpe_write_file Gold W ! wpe_buffer Switch Buffer (pre eve_buffer) ! wpe_show_buffers Show Buffers ! wpe_return Return Key ! wpe_gold_return Gold Return ! wpe_delete ! wpe_find_matching Find ) matching ( ! wpe_find_matching_paren Support routine ! wpe_signature Insert sys$login:signature.wpe ! wpe_shift_right Preprocess Gold Right to shift ! wpe_shift_left Preprocess Gold Left to shift ! wpe_spawn Postprocess Spawn ! wpe_spell Postprocess Spell (spawn) ! wpe_other_window Do other window OR next buffer ! wpe_paragraph Add find next procedure (.TPU) ! wpe_include_file Preprocess Gold G - simulates ! include_selected ! wpe_selected_filename Support procedure for incl/get ! ! wpe_ask_hlp_file Optional prompting ! wpe_ask_long_lines Optional prompting ! ! --- WPE added EVE Commands --- ! ! --- for Keyboard Mapping --- ! eve_set_keypad_edt EDT Keypad Overlay ! eve_set_keypad_noedt Return to WPE Keypad ! eve_set_keypad_numeric Replacement (= eve_numeric) ! eve_numeric Put keypad in numeric ! eve_application Put keypad in application ! eve_set_keypad_wps Replacement (= nonum,noedt) ! eve_set_keypad_wpe Synonym for wps ! eve_set_keypad_nowps Replacement (= message) ! eve_set_keypad_edw Synonym for edt ! eve_set_keypad_noedw Synonym for noedt ! --- Other Routines --- ! eve_notabs Use spaces instead of tabs ! eve_ctlength Set Page Length ! eve_print Top level print routine ! eve_print_translated Print file w/controls ! wpe$translate_controls Support routine for above ! eve_print_untranslated Print file without translate ! wpe_print_file Support routine for printing ! eve_fix_mem Remove CRLFs ! wpe_get_fix_line Support routine for above ! eve_etoa Translate EBCDIC to ASCII ! eve_atoe Translate ASCII to EBCDIC ! eve_set_trimming Omission in EVE code ! eve_set_notrimming Omission in EVE code ! ! ! --- Modules for EVE T2.2 functions with EVE T2.0 --- ! ! These modules are correct in EVE T2.2 - and are only needed ! for WPE if EVE is less than 2.2. They are ONLY compiled if EVE ! is less than T2.2. ! ! eve_next_buffer Next non-system buffer ! (from module eve$$next_buffer in EVE$FILE.TPU) ! eve_other_window Pre-process eve_next_window T2.0 ! (from part of module eve_next_window in EVE$WINDOWS.TPU) ! ! ! --- Modules which replace EVE functions --- ! ! These modules are placed last, for ease of modification. ! They are modified from copies of EVE code, and should be ! checked each time EVE has a new version. ! ! ! wpe$wps_paginate GOLD/PAGE - paginate ! (from module eve$wps_paginate in EVE$WPS.TPU) ! wpe_insert_page_break Insert a page break (FF) ! (from module eve_insert_page_break in EVE$CORE.TPU ) ! wpe$wps_page_marker Page marker (GOLD/P) soft FF-NL ! (from module eve$wps_page_marker in EVE$WPS.TPU ) ! wpe_eve$file_module_init_replace For MORE, allows wildcard file names. ! and for wpe as a mail editor. ! (from module eve$file_module_init in EVE$FILE.TPU) ! ! --- Executable Instructions for Build Phase --- ! ! Global string constant definitions ! Execution of the build procedures to define keys and keymaps ! ! !-------------------------------------------------------------------------- ! The supplied CALL_USER function does the following: ! ! Integer Function TPU$CallUser (N, Str) ! Inputs are an integer and a string. The string is returned. ! ! N Action of this routine ! === ======================== ! 1 Set logical TPU$POSITION to value of STR ! 2 Delete logical TPU$POSITION ! 3 Set Terminal NO_LINE_EDITING ! 4 Set Terminal LINE_EDITING ! Other Just return ! !-------------------------------------------------------------------------- ! Optional features of WPE are marked by the comment lines: !WPE_OPTION !WPE_KEYOPTION !-------------------------------------------------------------------------- !<><><><><><><><><><><><> procedure wpe_module_ident return "V05.210"; endprocedure; !<><><><><><><><><><><><> procedure wpe_process_command (wpe_command) return (FALSE); endprocedure; ! wpe_process_command (wpe_command) !<><><><><><><><><><><><> procedure wpe_declare_synonym eve$build_synonym ("ctlength", "set_page_length", 1); eve$build_synonym ("application", "set_keypad_nonumeric", 1); eve$build_synonym ("application", "set_keypad_application", 1); endprocedure; ! wpe_declare_synonym !<><><><><><><><><><><><> procedure wpe_module_pre_init ! For the "MORE" interface, we allow wildcard filenames. So, ! we compile a short procedure which replaces ! eve$file_module_init with a procedure which calls our ! modified copy of the procedure. ! Get the current WPE Version. It will be used in the SHOW routine. ! NOTE: ! Every time EVE$BUILD is run it creates a procedure named EVE$VERSION ! which contains the product name (gotten from the EVE$BUILD command ! line), the product version (gotten from the WPE_VERSION.DAT file), ! and the the build date and time. This version can thus be used to ! trace the product back to the specific build and its .LIST and .INIT ! files. The versions of WPE, EVE, and TPU are fixed at build time. wpe$x_wpe_version := eve$version + " - EVE " + eve$kt_version + " - TPU V" + str(get_info(system,"version")) + "." + str(get_info(system, "update")); compile ("procedure eve$version" + " return wpe$x_wpe_version; endprocedure;"); ! If nojournal, the facility name is MORE if get_info (COMMAND_LINE, "journal") = 0 then wpe_more_mode := TRUE; wpe$x_facility_name := "MORE"; else wpe_more_mode := FALSE; wpe$x_wild_file := FALSE; ! Otherwise, the facility name is picked up from the first three ! characters of the version (WPE or EDW) wpe$x_facility_name := Substr(wpe$x_wpe_version,1,3); endif; ! Stuff a lowercase version away, to use on the status line. wpe$x_lowercase_facility_name := " " + wpe$x_facility_name; change_case (wpe$x_lowercase_facility_name, LOWER); wpe$x_has_display := get_info (system, "display"); if wpe$x_has_display then set (timer, ON, " " + wpe$x_facility_name + " Startup... "); endif; ! Set default right margin to -2 (78 or 130). We need 2 spaces for .COM ! file continuations. eve$x_default_right_margin := 2; wpe_file_count := 1; wpe_processing_file := 1; wpe_input_filename := get_info (COMMAND_LINE, "file_name"); wpe_output_filename := get_info (COMMAND_LINE, "output_file"); !WPE_OPTION ! Although not advertised, limited wildcarding is enabled for WPE. ! To disable wildcarding for WPE, UNcomment the major "if" below... ! (remove "!ena" characters from two lines) !ena if wpe_more_mode = TRUE then ! Check for wildcard filename if index(wpe_input_filename, "THIS_IS_A_TEMPORARY_FILE_USED_BY_MORE.__IT_MAY_BE_DELETED_NOW" ) <> 0 then wpe$x_use_file_list := TRUE; else wpe$x_use_file_list := FALSE; endif; if ((eve$is_wildcard (wpe_input_filename) = TRUE) OR (wpe$x_use_file_list )) then ! Input file is a wildcard spec or file_list file wpe$x_wild_file := TRUE; compile ("procedure eve$file_module_init" + " wpe_eve$file_module_init_replace; endprocedure;"); else wpe_file_count := 1; wpe_processing_file := 1; wpe$x_wild_file := FALSE; endif; !ena endif; ! Check to see if we're a mail editor, and take appropriate action. Among ! other things, we compile the new replacement for ! eve$file_module_init. if wpe_output_filename <> "" then wpe$x_send_index := index(wpe_output_filename, "_SEND.TMP" ); if ((index(wpe_output_filename, "MAIL_" ) <> 0) AND (wpe$x_send_index <> 0)) then wpe$x_is_a_mail_editor := TRUE; if (NOT wpe$x_wild_file) then compile ("procedure eve$file_module_init" + " wpe_eve$file_module_init_replace; endprocedure;"); endif; else wpe$x_is_a_mail_editor := FALSE; endif; else wpe$x_is_a_mail_editor := FALSE; endif; endprocedure; ! wpe_module_pre_init !<><><><><><><><><><><><> procedure wpe_module_init if wpe$x_has_display then set (timer, ON, " " + wpe$x_facility_name + " Working... "); endif; wpe_init_variables; ! Define WPE Variables & Constants wpe_init_wpe; ! Define the rest of WPE if wpe$x_is_a_mail_editor then wpe_set_mail_mode; endif; if wpe$x_has_display then eve$clear_message; ! Clear the "read file" message endif; endprocedure; ! wpe_module_init !<><><><><><><><><><><><> procedure wpe_exit_handler wpe_save_position; return (FALSE); endprocedure; ! wpe_exit_handler !<><><><><><><><><><><><> procedure wpe_quit_handler return (FALSE); endprocedure; ! wpe_quit_handler !<><><><><><><><><><><><> ! Provide an indicator on the status line of the facility name. ! Several alternatives are provided here. For no indicator, use the ! "null" return procedure wpe_status_field (the_length, ! Status line indicator the_format) ! local lowercase_facility on_error [OTHERWISE]: endon_error; ! Return nothing, if desired... ! return ""; ! ! By convention, we should do: ! return fao (the_format, wpe$x_lowercase_facility_name); ! if get_info (SCREEN, "dec_crt2") then ! return (" " + wpe$x_lowercase_facility_name); ! Alternative ! return (" " + wpe$x_lowercase_facility_name); ! Alternative ! else return (wpe$x_lowercase_facility_name); ! endif; endprocedure; ! wpe_status_field !<><><><><><><><><><><><> procedure wpe_init_keyboard ! This module is executed during the build phase. ! Insert WPE key maps in the appropriate key_map_lists wpe$x_standard_keys := create_key_map ("wpe$standard_keys"); wpe$x_special_keys := create_key_map ("wpe$special_keys"); remove_key_map (eve$x_key_map_list, eve$x_user_keys, ALL); add_key_map (eve$x_key_map_list, "first", wpe$x_standard_keys); add_key_map (eve$x_key_map_list, "first", wpe$x_special_keys); add_key_map (eve$x_key_map_list, "first", eve$x_user_keys); remove_key_map (eve$x_command_key_map_list, eve$x_user_keys, ALL); add_key_map (eve$x_command_key_map_list, "first", wpe$x_standard_keys); add_key_map (eve$x_command_key_map_list, "first", wpe$x_special_keys); add_key_map (eve$x_command_key_map_list, "first", eve$x_user_keys); ! Define WPE Standard Keys ! Replacements for EVE's Exit and Quit Keys define_key (eve$$kt_return + "wpe_exit", key_name ("f", SHIFT_KEY), "exit", wpe$x_standard_keys); define_key (eve$$kt_return + "wpe_exit", F10, "exit", wpe$x_standard_keys); define_key (eve$$kt_return + "wpe_exit", CTRL_Z_KEY, "exit", wpe$x_standard_keys); define_key (eve$$kt_return + "wpe_quit", key_name ("k", SHIFT_KEY), "quit", wpe$x_standard_keys); !WPE_KEYOPTION ! Previous versions of WPE define KP3 as equivalent to EXIT (for ! compatibility with DM). To preserve that behavior, un-comment the ! next statement. !define_key (eve$$kt_return + "wpe_exit", KP3,"exit", wpe$x_standard_keys); ! Replacements/Additions for EVE's TOP and BOTTOM Keys define_key (eve$$kt_return + "wpe_top", key_name ("t", SHIFT_KEY), "top", wpe$x_standard_keys); define_key (eve$$kt_return + "wpe_top", key_name (UP, SHIFT_KEY), " top", wpe$x_standard_keys); ! bug in EVE define_key (eve$$kt_return + "eve$wps_bottom", key_name (DOWN, SHIFT_KEY), " bottom", wpe$x_standard_keys); ! bug in EVE define_key (eve$$kt_return + "wpe_top", key_name (E5, SHIFT_KEY), " top", wpe$x_standard_keys); ! addition define_key (eve$$kt_return + "eve$wps_bottom", key_name (E6, SHIFT_KEY), " bottom", wpe$x_standard_keys); ! addition ! Function Keys and GOLD Function Keys define_key (eve$$kt_return + "wpe_delete_line", f6, "wpe delete_line (Del Lin)", wpe$x_standard_keys); define_key (eve$$kt_return + "wpe_restore_line", key_name (f6, shift_key), "restore_line", wpe$x_standard_keys); define_key (eve$$kt_return + "eve_quote", f7, "wpe quote", wpe$x_standard_keys); define_key (eve$$kt_return + "eve$insert_text (ascii (27))", key_name (f7, shift_key), "wpe escape (Ins ESC)", wpe$x_standard_keys); define_key (eve$$kt_return + "eve_capitalize_word", f8, "capitalize_word", wpe$x_standard_keys); define_key (eve$$kt_return + "eve_uppercase_word", key_name (f8, shift_key), "uppercase_word", wpe$x_standard_keys); !WPE_KEYOPTION ! This is a non-standard definition for F12. To preserve the standard ! definition (EOL/BOL), comment the following statement... define_key (eve$$kt_return + "eve$wps_line", F12, "KEYPAD WPS_Line", wpe$x_standard_keys); !WPE_KEYOPTION ! This is a non-standard definition for F13. To preserve the standard ! definition (erase previous word), comment the following statement... define_key (eve$$kt_return + "eve_erase_word", f13, "erase_word", wpe$x_standard_keys); define_key (eve$$kt_return + "eve_one_window", f17, "wpe one_window", wpe$x_standard_keys); define_key (eve$$kt_return + "eve_two_windows", f18, "wpe two_windows", wpe$x_standard_keys); define_key (eve$$kt_return + "wpe_get_file('')",key_name(f18, shift_key), "wpe get_file",wpe$x_standard_keys); define_key (eve$$kt_return + "wpe_other_window", f19, "wpe other_window", wpe$x_standard_keys); define_key (eve$$kt_return + "wpe_buffer", key_name(f19, shift_key), "wpe buffer", wpe$x_standard_keys); define_key (eve$$kt_return + "wpe_delete_to_end_of_line", f20, "wpe delete_to_eol (Del EOL)", wpe$x_standard_keys); define_key (eve$$kt_return + "wpe_restore_line", key_name (f20, shift_key), "restore_line", wpe$x_standard_keys); ! Keypad Keys and GOLD Keypad Keys define_key (eve$$kt_return + "wpe$wps_paginate", key_name (PF2, SHIFT_KEY), "wpe paginate", wpe$x_standard_keys); !WPE_KEYOPTION ! PF3 - is defined as a special function, wpe_delete_word. It is designed ! to facilitate documentation statement editing. If you wish to use the ! more standard function, comment out the definition below. define_key (eve$$kt_return + "wpe_delete_word", PF3, "KEYPAD delete_word", wpe$x_standard_keys); define_key (eve$$kt_return + "eve_restore_character", key_name (pf4, shift_key), "restore_character", wpe$x_standard_keys); !WPE_KEYOPTION ! KP5 - is defined to special-case .TPU files, going to the next procedure ! rather than the next paragraph. If you don't want this feature, ! comment out the definition below. define_key (eve$$kt_return + "wpe_paragraph", KP5, "wpe paragraph", wpe$x_standard_keys); define_key (eve$$kt_return + "wpe_fill", key_name (KP5, SHIFT_KEY), "fill", wpe$x_standard_keys); !WPE_KEYOPTION ! Duplicate definitions mapping KP6 like KP3 define_key (eve$$kt_return + "eve$wps_upper_case", KP6, "KEYPAD upper_case", wpe$x_standard_keys); define_key (eve$$kt_return + "eve$wps_lower_case", key_name (KP6, SHIFT_KEY), "KEYPAD lower_case", wpe$x_standard_keys); define_key (eve$$kt_return + "eve_go_to('')", key_name (kp9, shift_key), "go_to", wpe$x_standard_keys); define_key (eve$$kt_return + "eve_mark('')", kp9, "mark", wpe$x_standard_keys); define_key (eve$$kt_return + "wpe_shift_right", key_name (RIGHT, SHIFT_KEY), "wpe shift_right", wpe$x_standard_keys); define_key (eve$$kt_return + "wpe_shift_left", CTRL_H_KEY, "wpe shift_left", wpe$x_standard_keys); define_key (eve$$kt_return + "wpe_shift_left", key_name (LEFT, SHIFT_KEY), "wpe shift_left", wpe$x_standard_keys); ! Normal Keys define_key (eve$$kt_return + "wpe_return", ret_key, "return", wpe$x_standard_keys); define_key (eve$$kt_return + "wpe_delete", del_key, "delete", wpe$x_standard_keys); ! GOLD Normal Keys define_key (eve$$kt_return + "wpe_toggle_width", key_name ('e', shift_key), "wpe change_width", wpe$x_standard_keys); !WPE_KEYOPTION ! Gold G - is defined as wpe_include_file. It is designed to simulate ! a function eve_include_selected, if a selection is present. Gold G ! is defined in EVE$WPS, so if you don't like this one, just comment it out. define_key (eve$$kt_return + "wpe_include_file('')",key_name('g', shift_key), "wpe include_file",wpe$x_standard_keys); define_key (eve$$kt_return + "eve_dcl ('')", key_name ('i', shift_key), "dcl", wpe$x_standard_keys); define_key (eve$$kt_return + "wpe_insert_page_break", key_name ("n", SHIFT_KEY), "wpe new_page", wpe$x_standard_keys); define_key (eve$$kt_return + "wpe$wps_page_marker", key_name ("p", SHIFT_KEY), "wpe page_marker", wpe$x_standard_keys); define_key (eve$$kt_return + "wpe_spell", key_name ("s", SHIFT_KEY), "spell", wpe$x_standard_keys); define_key (eve$$kt_return + "wpe_view", key_name ('v', shift_key), "wpe view", wpe$x_standard_keys); define_key (eve$$kt_return + "wpe_find_matching", key_name ('x', shift_key), "wpe find_matching", wpe$x_standard_keys); define_key (eve$$kt_return + "eve_show", key_name ('z', shift_key), "show", wpe$x_standard_keys); define_key (eve$$kt_return + "eve_show", key_name ('~', shift_key), "show", wpe$x_standard_keys); define_key (eve$$kt_return + "wpe_gold_return", key_name (ret_key, shift_key), "wpe gold_return", wpe$x_standard_keys); define_key (eve$$kt_return + "wpe_signature", key_name ('@', shift_key), "wpe signature", wpe$x_standard_keys); define_key (eve$$kt_return + "wpe_spawn", key_name ("$", SHIFT_KEY), "spawn", wpe$x_standard_keys); define_key (eve$$kt_return + "eve_what_line", key_name ('|', shift_key), "what_line", wpe$x_standard_keys); define_key (eve$$kt_return + "wpe_display_character", key_name ('?', shift_key), "wpe display_char", wpe$x_standard_keys); define_key (eve$$kt_return + "eve$wps_previous_screen", key_name ('<', shift_key), "previous_screen", wpe$x_standard_keys); !WPE_KEYOPTION ! Note: The following definition supersedes the EVE/WPS definition for ! LEARN, used for VT-100 keyboards. define_key (eve$$kt_return + "eve$wps_next_screen", key_name ('>', shift_key), "next_screen", wpe$x_standard_keys); ! When/If the eve$wps.tpu module eve$wps_date_time is internationalized, ! this definition may need to be changed or deleted. define_key ("if eve$wps_date_time then erase_character (-3); endif;", key_name ('\', shift_key), "KEYPAD insert_date_time (insert date/time)", wpe$x_standard_keys); ! Gold W is re-defined until the WPS emulator in TPU gets less brain-damaged. define_key (eve$$kt_return + "wpe_write_file", key_name ('w', shift_key), "wpe write_file", wpe$x_standard_keys); ! Gold "Token" keys - put in double parens, brackets, etc. define_key ("copy_text ('()'); move_horizontal (-1);", key_name ('(', shift_key), "wpe token", wpe$x_standard_keys); define_key ("copy_text ('()'); move_horizontal (-1);", key_name (')', shift_key), "wpe token", wpe$x_standard_keys); define_key ("copy_text ('[]'); move_horizontal (-1);", key_name ('{', shift_key), "wpe token", wpe$x_standard_keys); define_key ("copy_text ('[]'); move_horizontal (-1);", key_name ('}', shift_key), "wpe token", wpe$x_standard_keys); define_key ("copy_text('""'); move_horizontal(-1); copy_text('""'); ", key_name ('"', shift_key), "wpe token", wpe$x_standard_keys); ! Control Keys define_key ("eve$check_bad_window", ctrl_f_key, "wpe return_to_edit", wpe$x_standard_keys); !WPE_KEYOPTION ! Ctrl/L is defined by EVE/WPS as "insert FF" - WPE redefines it as "learn". ! The alternative definition is supplied below. define_key (eve$$kt_return + "eve_learn", CTRL_L_KEY, "learn", wpe$x_standard_keys); !define_key (eve$$kt_return + "wpe_insert_page_break", CTRL_L_KEY, ! " insert_page_break", wpe$x_standard_keys); ! Set up WPS keys that will not be done in WPE ! Regular keys ! Control keys define_key ( "message ('Ctrl-A (Create Multinational) is not implemented in WPE')", ctrl_a_key, "wpe not_implemented", wpe$x_standard_keys); define_key ( "message ('Ctrl-D (External Application) is not implemented in WPE')", ctrl_d_key, "wpe not_implemented", wpe$x_standard_keys); define_key ( "message ('Ctrl-E (Technical Character Set) is not implemented in WPE')", ctrl_e_key, "wpe not_implemented", wpe$x_standard_keys); ! Gold Regular Keys define_key ("message ('Subscripts are not implemented in WPE')", key_name ('a', shift_key), "wpe not_implemented", wpe$x_standard_keys); define_key ("message ('Dead key is not implemented in WPE')", key_name ('d', shift_key), "wpe not_implemented", wpe$x_standard_keys); define_key ("message ('Linguistic Aids are not implemented in WPE')", key_name ('j', shift_key), "wpe not_implemented", wpe$x_standard_keys); define_key ("message ('Library is not implemented in WPE')", key_name ('l', shift_key), "wpe not_implemented", wpe$x_standard_keys); define_key ("message ('Editing menu is not implemented in WPE')", key_name ('m', shift_key), "wpe not_implemented", wpe$x_standard_keys); define_key ("message ('Superscripts are not implemented in WPE')", key_name ('q', shift_key), "wpe not_implemented", wpe$x_standard_keys); define_key ("message ('UDPs are not implemented in WPE')", key_name ('u', shift_key), "wpe not_implemented", wpe$x_standard_keys); define_key ("message ('Footnotes are not implemented in WPE')", key_name ('y', shift_key), "wpe not_implemented", wpe$x_standard_keys); define_key ("message ('Nonbreaking Space is not implemented in WPE')", key_name (' ', shift_key), "wpe not_implemented", wpe$x_standard_keys); define_key ( "message ('Desk Calculator is planned but not yet implemented in WPE')", key_name ('#', shift_key), "wpe not_implemented", wpe$x_standard_keys); define_key ("message ('Print hyphens are not implemented in WPE')", key_name ('-', shift_key), "wpe not_implemented", wpe$x_standard_keys); define_key ("message ('Invisible print hyphens are not implemented in WPE')", key_name ('_', shift_key), "wpe not_implemented", wpe$x_standard_keys); define_key ("message ('Abbreviation documents are not implemented in WPE')", key_name ('=', shift_key), "wpe not_implemented", wpe$x_standard_keys); define_key ("message ('Abbreviation documents are not implemented in WPE')", key_name ('+', shift_key), "wpe not_implemented", wpe$x_standard_keys); define_key ("message ('Two Dimensional Editor is not implemented in WPE')", key_name (']', shift_key), "wpe not_implemented", wpe$x_standard_keys); define_key ("message ('Gold Tab is not implemented in WPE')", key_name (tab_key, shift_key), "wpe not_implemented", wpe$x_standard_keys); ! Gold Function Keys define_key ("message ('Technical Character Set is not implemented in WPE')", key_name (F11, shift_key), "wpe not_implemented", wpe$x_standard_keys); define_key ("message ('Hyphen Pull is not implemented in WPE')", key_name (F12, shift_key), "wpe not_implemented", wpe$x_standard_keys); ! Gold auxiliary keypad keys define_key ("message ('Highlighting is not implemented in WPE')", key_name (kp2, shift_key), "wpe not_implemented ( )", wpe$x_standard_keys); endprocedure; ! wpe_init_keyboard !<><><><><><><><><><><><> ! Create an array of files, for wildcard and multiple file edit. ! Note that TPU does NOT pass LISTS - just a single file spec, which may ! have wildcards. ! ! the MORE.COM file will either pass us a single file spec (possibly with ! wildcard(s), OR will pass a special file name. The contents of that ! file are expected to be a one-column list of files to be "mored". ! NOTE: In the latter case, the contents of the special file are left in ! the SHOW buffer - it will be erased the first time a user does a ! command which uses the SHOW buffer; before that time, the user may do ! BUFFER SHOW to see exactly what files are in the list. procedure wpe_fill_file_list local local_position, file_search_result; on_error [TPU$_SEARCHFAIL]: eve$message ("Search Failed - Exiting", eve$k_fatal); exit; [OTHERWISE]: return; endon_error; edit(wpe_input_filename,COLLAPSE,UPPER); wpe_file_list := create_array(10); wpe_file_count := 0; if wpe$x_use_file_list then ! Get filenames from the Input File named ! "THIS_IS_A_TEMPORARY_FILE_USED_BY_MORE.__IT_MAY_BE_DELETED_NOW" local_position := mark(none); position (tpu$x_show_buffer); read_file (wpe_input_filename); position (beginning_of (current_buffer)); loop exitif mark(none) = end_of(current_buffer); file_search_result := current_line; ! All true file names will contain a '['. The only known weird ! condition (at the moment) is a "no privilege" condition, which ! occurs (e.g.) when the input was DIR *.*/since=today, and ! therefore the file name was found, but there was not privilege ! to open the file so that the date could be read. In that ! case, we get the filename line followed by a "no priv" line. ! Anything which doesn't fit one of these two cases is ! discarded. if index (file_search_result, '[') <> 0 then wpe_file_count := wpe_file_count + 1; wpe_file_list {wpe_file_count} := file_search_result; else if index (file_search_result, 'no privilege for attempted operation') <> 0 then ! effectively, remove the previous file from the list. wpe_file_count := wpe_file_count - 1; else ! ignore whatever is on the line! endif; endif; move_vertical (1); endloop; position (local_position); else ! Single wildcard file specification - use file_search to get ! the file names. local_position := mark(none); position (tpu$x_show_buffer); ! Protect against earlier file_search with same file name. eve$reset_file_search; loop file_search_result := file_search (wpe_input_filename); if file_search_result = 0 then file_search_result := ""; endif; exitif file_search_result = ""; wpe_file_count := wpe_file_count + 1; wpe_file_list {wpe_file_count} := file_search_result; copy_text (file_search_result); split_line; endloop; position (local_position); endif; endprocedure; ! wpe_fill_file_list !<><><><><><><><><><><><> procedure wpe_init_wpe local calluser_status eve$x_select_remove_flag := FALSE; ! Fix zero-char select/cut eve$x_enable_parser_wpe := FALSE; !WPE_OPTION ! Set to FALSE for free cursor. eve$x_bound_cursor := TRUE; ! Define the help library eve$declare_help_library ("WPE", "wpehelp", "", "For help on the WPE editor, type WPE and press RETURN."); ! Shorten journaling interval, etc. set (journaling,1); ! Reset direction & mode for command-line editing set (forward, eve$command_buffer); set (insert, eve$command_buffer); !WPE_OPTION ! Set the scrolling margins - user preference feature. ! The values are in percentages. We do it this way to prevent getting a ! bothersome message, as we would from eve_set_scroll_margins. ! The effect of 10% and 5% is: ! full-screen buffer, keep the cursor out of top 2 and bottom 1 lines. ! half-screen buffer, keep the cursor out of the top line. ! smaller buffers - no effect. ! NOTE: Don't set scroll margins if decwindows is active! if wpe$x_has_display then if not eve$x_decwindows_active then eve$x_scroll_top := 10; eve$x_scroll_bottom := 5; eve$set_scroll_margins (current_window, eve$x_scroll_top, eve$x_scroll_bottom); endif; if get_info(current_buffer,"name") = "MAIN" then if wpe_more_mode = TRUE then if wpe_input_filename <> "" then eve$message ("No files were found with specification " + wpe_input_filename, eve$k_warning); else eve$message ("No input file specified.", eve$k_warning); endif; exit; else if wpe_input_filename <> "" then eve$message ("No files were found with specification " + wpe_input_filename, eve$k_warning); endif; endif; else wpe_set_buffer_margin; ! Margin if .HLP file ! we will accept the fact that, if this is a .HLP file, the ! eve$default_buffer will have a right margin of 66 instead of 78. ! Since we don't get control after the default buffer is created ! (tpu$init_postprocedure), there seems to be no way around it. endif; endif; ! Capture eve's right margin action, so we can add to it. wpe_eve_right_margin_action := get_info (current_buffer, "right_margin_action"); set (right_margin_action, current_buffer, "wpe_word_wrap_routine"); ! This will eventually have the effect ... ! set (right_margin_action, eve$default_buffer, "wpe_word_wrap_routine"); ! because the first user buffer is also eve$x_source_for_default_buffer ! The .EXE which runs WPE should make sure the terminal is in ! no_line_edit mode. It should establish an exit handler to ! restore line_edit (if needed). ! If the pre-processor .COM or .EXE does not put the terminal in ! no_line_edit mode, we'll do it here. It APPEARS that TPU at VMS V5.0 ! is saving the line_edit status of the terminal, and establishing an ! exit AST to reset it. if get_info(screen, "line_editing") <> 0 then calluser_status := call_user (3, "X"); ! /NOLINE_EDIT endif; ! Now, call something to allow lower level procedures to initialize: WPE$Local_INIT; endprocedure; ! wpe_init_wpe !<><><><><><><><><><><><> procedure wpe$local_init ! This can be over-ridden by a real procedure in a layered interface. endprocedure ! wpe$local_init !<><><><><><><><><><><><> procedure wpe_set_mail_mode if wpe$x_mail_answer then eve_two_windows; eve_other_window; eve_shrink_window (4); eve_buffer (wpe$x_answer_buffer_name); move_vertical (5); eve_other_window; endif; endprocedure ! wpe_set_mail_mode !<><><><><><><><><><><><> procedure wpe_init_variables wpe_first_buffer := current_buffer; wpe$x_deleted_eol := TRUE; wpe$x_for_contin_number := 1; wpe$x_num_keys_on := FALSE; ! application keypad wpe$x_standard_keys := "wpe$standard_keys"; wpe$x_special_keys := "wpe$special_keys"; wpe$$x_page_size := 60; ! Default paginate page size if eve$x_option_w$pe_is_edw = 0 then wpe$x_edw_keys_on := FALSE; else wpe$x_edw_keys_on := TRUE; endif; !WPE_OPTION ! Optional prompting for .HLP file setup and long_line setup. ! To enable prompting, set the two variables to TRUE. ! The default action, if these variables are FALSE, is: ! Automatically set margins for .HLP files (don't ask - just do it) ! Do not check for long lines, hence don't ask about setting 132-wide. wpe$x_prompt_for_hlp_files := FALSE; ! Don't ask wpe$x_prompt_for_long_lines := FALSE; ! Don't check or ask endprocedure; ! wpe_init_variables !<><><><><><><><><><><><> procedure wpe_set_buffer_margin ! Sets buffer right margin correctly. By default, the margin comes from ! the eve$default_buffer. We change it only for .HLP files local left_margin_now, file_extension; on_error return; endon_error file_extension := file_parse (get_info (current_buffer, "name"), eve$kt_null, eve$kt_null, type); if file_extension = ".HLP" then if wpe$x_prompt_for_hlp_files then if wpe_ask_hlp_file then left_margin_now := get_info (current_buffer, "left_margin"); set (MARGINS, current_buffer, left_margin_now, 66); endif; else left_margin_now := get_info (current_buffer, "left_margin"); set (MARGINS, current_buffer, left_margin_now, 66); endif; else if wpe$x_prompt_for_long_lines then if wpe_ask_long_lines then wpe_toggle_width; endif; endif; endif; endprocedure; ! wpe_set_buffer_margin !<><><><><><><><><><><><> procedure wpe_get_file (get_file_parameter) ! ! Simulate eve_open_selected if a valid file has been selected. ! This is particularly useful after doing a I Directory command ! (for the current directory), or DIREctory/NOHEad for other directories. ! Otherwise, do an extended eve_get_file. local getfile_status, selected_name, full_name; on_error [TPU$_PARSEFAIL]: ! this prevents an error message if garbage is parsed. [OTHERWISE]: endon_error; if get_file_parameter <> "" then ! Protect against earlier file_search with same file name. eve$reset_file_search; full_name := str(file_search(get_file_parameter, "", "", NODE,DEVICE,DIRECTORY,NAME,TYPE,VERSION)); else full_name := wpe_selected_filename; endif; if full_name <> "" then ! everything checks out - go for it. selected_name := file_parse (full_name, "", "", NAME,TYPE,VERSION); ! Use eve$get_file1 for EVE 2.2 - so that file version is included in buffer ! name (second parameter) !%IF eve$x_option_w$pe_at_least_eve_2_2 !%THEN getfile_status := eve$get_file1 (full_name, selected_name); !%ELSE !% getfile_status := eve_get_file (full_name); !%ENDIF; else ! get_file_parameter string didn't produce a valid file. ! OR it was null. Let EVE handle the situation. getfile_status := eve_get_file (get_file_parameter); endif; if getfile_status then wpe_set_buffer_margin; endif; return (getfile_status); endprocedure; ! wpe_get_file !<><><><><><><><><><><><> procedure wpe_word_wrap_routine ! Handles line continuations in "special" file types, as an extension to ! the eve$kt_word_wrap_routine (eve$$word_wrap) local file_extension, ! Type of file. d_line, ! For FORTRAN Debug Lines cp_line, ! For FORTRAN CPAR$ Lines cd_line, ! For FORTRAN CDEC$ Lines next_contin, ! Next continuation number here, ! Where the cursor is u_line, ! Uppercase version of a line u_char, ! Uppercase version of a character this_offset; ! Offset of where the cursor is on_error [OTHERWISE]: endon_error; file_extension := file_parse (get_info (current_buffer, "name"), eve$kt_null, eve$kt_null, type); CASE file_extension [".COM"] : if last_key = space_key then if (substr ( current_line, 1, 3) = "$ !" ) OR (substr ( current_line, 1, 2) = "$!" ) then wpe_gold_return; else copy_text (" -"); wpe_return; endif; else this_offset := current_offset; here := mark(none); execute (wpe_eve_right_margin_action); if current_offset <> this_offset then ! did something move_vertical (-1); position (line_end); if (substr ( current_line, 1, 3) = "$ !" ) OR (substr ( current_line, 1, 2) = "$!" ) then wpe_gold_return; else copy_text (" -"); wpe_return; endif; eve_erase_character; ! position (line_end); position (here); else ! right margin action did nothing - give up. endif; endif; [".FOR"] : u_line := current_line; edit (u_line, UPPER, OFF); u_char := substr (u_line, 1, 1); if u_char = "C" then if index (u_line, "CPAR$") = 1 then cp_line := TRUE; cd_line := FALSE; else if index (u_line, "CDEC$") = 1 then cp_line := FALSE; cd_line := TRUE; else cp_line := FALSE; cd_line := FALSE; endif; endif; d_line := FALSE; else cp_line := FALSE; cd_line := FALSE; if u_char = "D" then d_line := TRUE; else d_line := FALSE; endif; endif; if last_key = space_key then if (u_char = "C") AND NOT (cp_line OR cd_line) then wpe_gold_return; else here := mark(none); next_contin := wpe$x_for_contin_number; wpe_return; ! put in Number, 4 spaces copy_text ( str(next_contin) + " "); wpe$x_for_contin_number := next_contin + 1; if wpe$x_for_contin_number > 9 then wpe$x_for_contin_number := 1; endif; if (d_line) OR (cp_line) OR (cd_line) then position (line_begin); if (d_line) then copy_text ("D"); else if (cp_line) then copy_text ("CPAR$"); else copy_text ("CDEC$"); endif; endif; endif; position (here); endif; else ! Last key was a typing key, not the space key. this_offset := current_offset; here := mark(none); execute (wpe_eve_right_margin_action); if current_offset <> this_offset then ! did something move_vertical (-1); if (u_char = "C") AND (NOT (cp_line OR cd_line)) then position (line_end); wpe_gold_return; eve_erase_character; position (here); ! position (line_end); else move_vertical (1); position (line_begin); if d_line then copy_text ("D"); else if (cp_line) then copy_text ("CPAR$"); else if (cd_line) then copy_text ("CDEC$"); endif; endif; endif; ! put in HT, Number, 4 spaces eve_tab; copy_text (str(wpe$x_for_contin_number) + " "); wpe$x_for_contin_number := wpe$x_for_contin_number + 1; if wpe$x_for_contin_number > 9 then wpe$x_for_contin_number := 1; endif; position (here); ! position (line_end); endif; else ! right margin action did nothing - give up. endif; endif; [".HLP"] : if last_key = space_key then if substr ( current_line, 1, 1) = "!" then wpe_gold_return; else wpe_return; endif; else this_offset := current_offset; here := mark(none); execute (wpe_eve_right_margin_action); if current_offset <> this_offset then ! did something move_vertical (-1); position (line_end); if substr ( current_line, 1, 1) = "!" then wpe_gold_return; else wpe_return; endif; eve_erase_character; position (here); ! position (line_end); else ! right margin action did nothing - give up. endif; endif; [".TPU"] : if last_key = space_key then if substr ( current_line, 1, 1) = "!" then wpe_gold_return; else split_line; ! wpe_return; ! Use this if wpe_return has special action. endif; else this_offset := current_offset; here := mark(none); execute (wpe_eve_right_margin_action); if current_offset <> this_offset then ! did something move_vertical (-1); if substr ( current_line, 1, 1) = "!" then position (line_end); wpe_gold_return; eve_erase_character; else ! rewrite this (see .HLP) if wpe_return has special action. move_vertical (1); endif; position (here); ! position (line_end); else ! right margin action did nothing - give up. endif; endif; [OTHERWISE] : ! eve now has a "bug" associated with typing a space at the end ! of a long line. This "hack" sort-of fixes it. However, if ! eve ever gets fixed, we should only execute word_wrap_routine. ! The bug exists as late as EVE T2.2. To test, use the EVE ! section (or modify the next few lines), create a text line ! of words until about column 75. Then type spaces after the ! last character. If the bug exists, EVE won't do a wrap until ! a non-space character is typed. if last_key = space_key then split_line; ! wpe_return; ! Use this if wpe_return has special action. else execute (wpe_eve_right_margin_action); ! has the effect of: execute (eve$kt_word_wrap_routine); endif; ENDCASE; endprocedure; ! wpe_word_wrap_routine !<><><><><><><><><><><><> procedure wpe_exit if wpe_more_mode then wpe_quit; else if wpe_processing_file < wpe_file_count then wpe_processing_file := wpe_processing_file + 1; wpe_get_file (wpe_file_list {wpe_processing_file}); else if wpe$x_is_a_mail_editor then if get_info (wpe$x_mail_create_buffer, "modified") then ! We want to write this one without any ! question, even if the current position is ! in some other window... eve$write_file (wpe$x_mail_create_buffer, get_info( wpe$x_mail_create_buffer, "output_file"), 0); endif; endif; eve_exit; endif; endif; endprocedure; ! wpe_exit !<><><><><><><><><><><><> procedure wpe_quit local success_on, question_answer if wpe_processing_file < wpe_file_count then wpe_processing_file := wpe_processing_file + 1; wpe_get_file (wpe_file_list {wpe_processing_file}); else success_on := get_info (system, "success"); if wpe$x_is_a_mail_editor then if get_info (wpe$x_mail_create_buffer, "modified") then eve$clear_message; question_answer := eve$insist_y_n (" Your mail message will NOT be sent if you QUIT. " + "Continue quitting (Y or N)? "); if question_answer then set (success, OFF); quit (OFF, 1); ! Unconditional else eve$message ("QUIT canceled by request") endif; else eve_exit; endif; else eve_quit; ! which may prompt (if anything is modified) and may return ! here. If it does, we need to clean up: endif; if success_on then set (success, ON); endif; endif; endprocedure; ! wpe_quit !<><><><><><><><><><><><> procedure wpe_save_position; ! modified from EVE$EDIT.TPU, module eve_what_line ! modifications are delimited by: ! !*** START WPE MOD *** ! !*** END WPE MOD *** local saved_mark, ! marker - current position text_mark, ! marker - after snapping to text this_line_position, ! marker - position at start of this_line total_lines, ! integer - total lines in buffer high_line, ! integer - high line limit for binary search low_line, ! integer - low line limit for binary search low_position, ! marker - beginning of low line this_line, ! integer - line number of current guess !*** START WPE MOD *** first_mark, ! marker - current position in first buffer restart_position; ! string - current position in buffer !*** END WPE MOD *** on_error [TPU$_CONTROLC]: eve$$restore_position (saved_mark); ! restore free cursor position eve$learn_abort; abort; [OTHERWISE]: eve$$restore_position (saved_mark); endon_error; if wpe$x_is_a_mail_editor then return; endif; ! Initialization saved_mark := mark (FREE_CURSOR); !*** START WPE MOD *** if get_info(wpe_first_buffer,"type") = BUFFER then position (wpe_first_buffer); ! Make sure we're in first edit buff. else ! Buffer was probably deleted return; endif; first_mark := mark (FREE_CURSOR); !*** END WPE MOD *** position (search (ANCHOR, FORWARD)); ! snap the cursor (move_vertical pads) text_mark := mark (NONE); ! We don't have to do a binary search if TPU is V2.2 or above.... !%IF eve$x_at_least_tpu_2_2 !%THEN low_line := get_info (text_mark,"record_number"); !%ELSE !%total_lines := get_info (current_buffer, "record_count"); !%high_line := total_lines + 1; !% if text_mark = end_of (current_buffer) then !% if text_mark = beginning_of (current_buffer) !% then !%!*** START WPE MOD *** !% low_line := 1; !% else !% low_line := total_lines + 1; !%!*** END WPE MOD *** !% endif; !% else !% low_line := 1; !% low_position := beginning_of (current_buffer); !% endif; !% !%! Binary search !% !% loop !% exitif high_line - low_line <= 1; !% this_line := (high_line + low_line) / 2; !% position (low_position); !% move_vertical (this_line - low_line); !% if mark (FREE_CURSOR) > first_mark !% then !% high_line := this_line; !% else !% low_line := this_line; !% low_position := mark (FREE_CURSOR); !% if mark (FREE_CURSOR) = first_mark !% then !% high_line := this_line; !% endif; !% endif; !% endloop; !%ENDIF; !*** START WPE MOD *** ! % calculation deleted !*** END WPE MOD *** position (saved_mark); !*** START WPE MOD *** ! low_line contains the number of the current line. restart_position := '/START_POSITION=(' + str(low_line) + ',' + str(current_offset + 1) + ')'; restart_position := call_user (1, restart_position); !*** END WPE MOD *** endprocedure; ! wpe_save_position !<><><><><><><><><><><><> procedure wpe_delete_line if current_buffer = eve$command_buffer then if index (current_line, eve$x_command_prompt) = 1 then move_horizontal (-current_offset); move_horizontal (length(eve$x_command_prompt)); wpe_delete_to_end_of_line; return (TRUE); endif; else move_horizontal (-current_offset); if eve_erase_line then wpe$x_deleted_eol := TRUE; return (TRUE); endif; endif; endprocedure ! wpe_delete_line !<><><><><><><><><><><><> procedure wpe_delete_to_end_of_line ! Erase to end of line - excluding EOL if current_offset = length (current_line) then return (TRUE); else if eve_erase_line then wpe$x_deleted_eol := FALSE; if NOT eve$in_prompting_window then split_line; move_horizontal (-1); endif; return (TRUE); endif; endif; endprocedure ! wpe_delete_to_end_of_line !<><><><><><><><><><><><> procedure wpe_restore_line local restore_temp_char; if eve_restore_line then if NOT wpe$x_deleted_eol then restore_temp_char := eve$x_restore_char; eve_erase_character; eve$x_restore_char := restore_temp_char; move_horizontal (-1); endif; return (TRUE); else return (FALSE); endif; endprocedure ! wpe_restore_line !<><><><><><><><><><><><> ! Special Delete Word procedure for WPE ! modified from procedure eve$edt_delete_word procedure wpe_delete_word ! Delete word local text_mark, word_mark, word_range, saved_mark; on_error [TPU$_CONTROLC]: eve$$restore_position (saved_mark); ! restore free cursor position eve$learn_abort; abort; [OTHERWISE]: eve$$restore_position (saved_mark); endon_error; saved_mark := mark (FREE_CURSOR); if eve$edt_eol_nopad_delete then return (TRUE); endif; if not get_info (current_window, "beyond_eob") then if not (get_info (current_window, "before_bol") or get_info (current_window, "middle_of_tab")) then position (TEXT); ! snap to text endif; else position (TEXT); ! snap to text saved_mark := mark (FREE_CURSOR); endif; text_mark := mark (NONE); if text_mark = end_of (current_buffer) then move_vertical (1); ! force an error message endif; if current_character <> "" then eve$end_of_word; move_horizontal (-1); else if eve$in_prompting_window then eve$x_restore_word := 0; return (TRUE); endif; endif; ! Modifications start here. Word_range is candidate "regular" range to be ! deleted - and is OK, if we don't want to stop sooner. word_mark := mark (NONE); word_range := create_range (text_mark, word_mark, NONE); position (text_mark); ! original position if index ("([{",current_character) <> 0 then if current_character = "(" then position (search_quietly ( ")" | line_end, forward )); else if current_character = "[" then position (search_quietly ( "]" | line_end, forward )); else if current_character = "{" then position (search_quietly ( "}" | line_end, FORWARD )); endif; endif; endif; else ! The behavior of this section may be helpful, or may be annoying. If it ! proves to be annoying, it will be modified in a future version. ! MAYBE we should change this to NOT skip several )))) and THEN match. ! --- doing )))))x) deletes first 5 )'s ---- if (file_parse (get_info (current_buffer, "name"), eve$kt_null, eve$kt_null, type) = ".COM") OR (current_window = eve$command_window) then position (end_of (search_quietly ( scan (')]}"''_/;:.,-'), FORWARD ))); else position (end_of (search_quietly ( scan ("_)]}"), FORWARD ))); endif; endif; if mark (NONE) < word_mark then word_range := create_range (text_mark, mark (NONE), NONE); else position (word_mark); endif; eve$x_erased_word_forward := TRUE; eve$x_restore_word := eve$erase_text (word_range, eve$x_word_buffer, FALSE); if eve$x_restore_line = 0 then eve$learn_abort; return (FALSE); endif; if length (eve$x_restore_word) = 0 then position (saved_mark); endif; return (TRUE); endprocedure ! wpe_delete_word !<><><><><><><><><><><><> procedure wpe_view local text_type; ! 14 for Blank_Tabs, 24 for Graphic_Tabs on_error return (FALSE); endon_error text_type := get_info ( current_window, "text"); if text_type = blank_tabs then ! it's now blank_tabs (normal) set ( text, current_window, graphic_tabs ); else if text_type = graphic_tabs then ! it's now graphic_tabs (view) set ( text, current_window, blank_tabs ); ! For reference, NO_TRANSLATE else ! if it's something else, set blank set ( text, current_window, blank_tabs ); endif; ! (lets us get out of no_translate easily) endif; return (TRUE); endprocedure ! wpe_view !<><><><><><><><><><><><> procedure wpe_top ! eve$wps_top, and then make sure direction is forward eve$wps_top; eve_forward; return (TRUE); endprocedure ! eve_top !<><><><><><><><><><><><> procedure wpe_toggle_width ! Buffer right margin (except for .HLP buffers) is set using "delta", ! because the user may have reset the right margin. local right_delta, right_was_margin, right_set_margin, left_margin_now, file_extension, the_buffer; on_error return (FALSE); endon_error if get_info (screen, "width") <= 80 then eve_set_width (132); right_delta := 52; else eve_set_width (80); right_delta := (-52); endif; ! Set all existing user buffers to the correct right margin the_buffer := get_info (BUFFERS, "first"); loop exitif the_buffer = 0; if not get_info (the_buffer, "system") then if file_parse (get_info (the_buffer, "name"), eve$kt_null, eve$kt_null, type) <> ".HLP" then left_margin_now := get_info (the_buffer, "left_margin"); right_was_margin := get_info (the_buffer, "right_margin"); right_set_margin := right_was_margin + right_delta; set (MARGINS, the_buffer, left_margin_now, right_set_margin); endif; endif; the_buffer := get_info (BUFFERS, "next"); endloop; update (message_window); return (TRUE); endprocedure ! wpe_toggle_width !<><><><><><><><><><><><> procedure wpe_write_file ! Write selected region if there is one, write whole buffer if not. local wpe_write_file_name, what_key, question_answer, parsed_name; ! Used to detect errors. if eve$x_select_position <> 0 then !Select range active if get_info (eve$x_select_position, eve$kt_buffer) <> current_buffer then eve$message ("Write Selected Text must be used in the same buffer as Select.",0); return (FALSE); endif; eve$clear_message; ! Clear message space ! wpe_write_file_name := read_line ("File for Selected Text: "); wpe_write_file_name := eve$prompt_line ("File for Selected Text: ", eve$$x_prompt_terminators, ""); if wpe_write_file_name = eve$kt_null then eve$message ("No file written.", eve$k_warning); return (FALSE); else parsed_name := file_parse (wpe_write_file_name); ! Don't try if the file name is bad - & don't kill select range if parsed_name <> "" then if eve$x_trimming then eve$message ("Trimming buffer..."); eve$trim_buffer (current_buffer); eve$message ("Trimming completed."); endif; eve$message (fao ("Writing selected text to !AS", wpe_write_file_name), eve$k_warning); write_file (select_range, wpe_write_file_name); !%IF eve$x_option_w$pe_at_least_eve_2_2 !%THEN eve$clear_select_position; !%ELSE !% eve$x_select_position := 0; !%ENDIF; else eve$message ("Bad file name " + wpe_write_file_name + " - No file written.", eve$k_warning); return (FALSE); endif; endif; else !No select range eve$message (message_text(EVE$_WRITEFILEPROMPT,1, get_info (current_buffer,"name"))); ! We must use read_line here, because we're being fancy with "recall" wpe_write_file_name := read_line (" Filename: "); eve$clear_message; ! Clear message space if wpe_write_file_name = eve$kt_null then what_key := eve$$lookup_comment (last_key,""); if (what_key = "move_up") or (what_key = "eve_recall" ) then ! Take a stab at recall wpe_write_file_name := get_info (current_buffer,"output_file"); if (get_info (wpe_write_file_name, "type") <> string) or (wpe_write_file_name = "") then ! No file name eve$message ("No information available for output file. No file written.", eve$k_warning); return (FALSE); else parsed_name := file_parse (wpe_write_file_name, "", "", NODE,DEVICE,DIRECTORY,NAME,TYPE); question_answer := eve$insist_y_n (FAO (" Write file to !AS ? [Yes] ", parsed_name)); if question_answer then wpe_write_file_name := parsed_name; eve_write_file (wpe_write_file_name); else eve$message ("No file written.", eve$k_warning); return (FALSE); endif; endif; else eve$message ("No file written.", eve$k_warning); return (FALSE); endif; else parsed_name := file_parse (wpe_write_file_name); ! Don't try if the file name is bad ... if parsed_name <> "" then if eve$x_trimming then eve$message ("Trimming buffer..."); eve$trim_buffer (current_buffer); eve$message ("Trimming completed."); endif; eve$message (fao ("Writing buffer to !AS", wpe_write_file_name), eve$k_warning); write_file (current_buffer, wpe_write_file_name); else eve$message ("Bad file name " + wpe_write_file_name + " - No file written.", 0); return (FALSE); endif; endif; endif; return (TRUE); endprocedure; ! wpe_write_file !<><><><><><><><><><><><> procedure wpe_buffer ! Pre-processor for eve_buffer: allows use of wpe_show_buffer via "recall". local wpe_buffer_name, returned_buffer_file, ! File for new buffer saved_buffer, ! Current buffer saved_mark, ! Current cursor position saved_window, ! Current window what_key; on_error [TPU$_CONTROLC]: eve$$restore_position (saved_window, saved_mark); eve$learn_abort; abort; [OTHERWISE]: eve$$restore_position (saved_window, saved_mark); endon_error; if eve$check_bad_window then eve$message (EVE$_CURSINTEXT); eve$learn_abort; return (FALSE); endif; saved_mark := mark (FREE_CURSOR); saved_window := current_window; saved_buffer := current_buffer; ! We must use read_line here, because we're being fancy with "recall" wpe_buffer_name := read_line (message_text(EVE$_BUFNAM,1)); if wpe_buffer_name = eve$kt_null then what_key := eve$$lookup_comment (last_key,""); if (what_key = "move_up") or (what_key = "eve_recall" ) then wpe_show_buffers; else eve$message (message_text(EVE$_BUFNOTSWITCH, eve$k_warning)); eve$learn_abort; return (FALSE); endif; else if eve_buffer (wpe_buffer_name) then wpe_set_buffer_margin; if NOT get_info (current_buffer, "system") then ! make sure there's an output file name for writing. returned_buffer_file := get_info (current_buffer,"output_file"); if (get_info (returned_buffer_file, "type") <> string) or (returned_buffer_file = "") then ! Use input file name if possible, otherwise buffer name. returned_buffer_file := get_info (current_buffer,"file_name"); if (get_info (returned_buffer_file, "type") <> string) or (returned_buffer_file = "") then returned_buffer_file := file_parse (wpe_buffer_name); else returned_buffer_file := file_parse (returned_buffer_file); endif; set (output_file, current_buffer, returned_buffer_file); endif; endif; endif; endif; return (TRUE); endprocedure; ! wpe_buffer !<><><><><><><><><><><><> procedure wpe_show_buffers local saved_mark, saved_window, saved_program, saved_comment, this_buffer_pat, the_buffer, ! The buffer being listed state_flag, ! Flag for error handler temp; ! Used for marking on_error [TPU$_CONTROLC]: set (MODIFIABLE, eve$x_bufed_buffer, OFF); if state_flag ! unmap the BUFFER LIST buffer then eve_buffer (get_info (get_info (saved_mark, "buffer"), "name")); endif; eve$$restore_position (saved_window, saved_mark); eve$learn_abort; abort; [TPU$_ENDOFBUF]: ! prevent EOB message if BUFFER LIST blank [OTHERWISE]: endon_error; saved_mark := mark (FREE_CURSOR); saved_window := current_window; this_buffer_pat := line_begin + " " + get_info (current_buffer,"name") + " "; if eve_show_buffers then state_flag := TRUE; set (MODIFIABLE, eve$x_bufed_buffer, ON); position (end_of (current_buffer)); eve$$bufed_format_line (tpu$x_message_buffer); position (beginning_of (current_buffer)); move_vertical (1); temp := search_quietly (this_buffer_pat, FORWARD, EXACT); if temp <> 0 then position (temp); move_horizontal (2); else position (beginning_of (current_buffer)); move_vertical (2); move_horizontal (2); endif; set (MODIFIABLE, eve$x_bufed_buffer, OFF); endif; return (TRUE); endprocedure; ! wpe_show_buffers !<><><><><><><><><><><><> ! Procedure invoked by the Return key. If we recognize the file ! type, split the line (obeying margin settings) and put in an appropriate ! line beginning. ! NOTE: Recognizes only files matching the CASE statement ! (currently, .COM, .FOR, .HLP) procedure wpe_return local file_extension, ! Type of file. continuation_line, ! True if this is a continuation inserted_b4, ! True if starting pos'n is col. 1 default_left_margin; ! True if left margin of current buffer = 1 ! Disregard end-of-buffer errors, etc. on_error [TPU$_NOEOBSTR]: ! prevent current_character error at EOB [OTHERWISE]: ! user may have done own RETURN endon_error; position (search (ANCHOR, FORWARD)); ! snap cursor to text if current_window = eve$command_window then return (eve_return); endif; if get_info (current_buffer, "system") then if current_buffer = eve$x_bufed_buffer then return (eve_select); else return (eve_return); endif; endif; if not eve$test_if_modifiable (current_buffer) then eve$learn_abort; return (FALSE); endif; file_extension := file_parse (get_info (current_buffer, "name"), eve$kt_null, eve$kt_null, type); if get_info (current_buffer, "left_margin") = 1 then default_left_margin := TRUE; else default_left_margin := FALSE; endif; if mark(none) = end_of(current_buffer) then inserted_b4 := TRUE; else if mark(none) = beginning_of(current_buffer) then inserted_b4 := TRUE; else if current_offset < 1 then ! Start of line inserted_b4 := TRUE; else inserted_b4 := FALSE; endif; endif; endif; CASE file_extension [".COM"] : ! Recognize continuation only if not comment line continuation_line := FALSE; if NOT inserted_B4 then if (substr ( current_line, 1, 3) <> "$ !" ) AND (substr ( current_line, 1, 2) <> "$!" ) then if current_character = "-" then ! Continuation line next continuation_line := TRUE; move_horizontal (1); else move_horizontal (-1); if current_character = "-" then ! Continuation line next continuation_line := TRUE; endif; move_horizontal (1); endif; endif; endif; eve_return; if inserted_b4 then move_horizontal (-1); copy_text ("$"); ! $ HT eve_tab; else if continuation_line then eve_tab; copy_text (" "); ! HT space space else copy_text ("$"); ! $ HT eve_tab; endif; endif; [".FOR"] : eve_return; wpe$x_for_contin_number := 1; if default_left_margin then ! Otherwise, don't mess with it. if inserted_b4 then move_horizontal (-1); endif; eve_tab; endif; [".HLP"] : eve_return; if default_left_margin then ! Otherwise, don't mess with it. if inserted_b4 then move_horizontal (-1); endif; copy_text (" "); ! One space endif; [OTHERWISE] : return (eve_return); ENDCASE; return (TRUE); endprocedure; ! wpe_return !<><><><><><><><><><><><> ! Procedure invoked by the Return key. If we recognize the file ! type, split the line (obeying margin settings) and put in an appropriate ! comment line beginning. Otherwise, put out a message. ! (currently .COM, .FOR, .HLP, .TPU are recognized) procedure wpe_gold_return local file_extension, ! Type of file. inserted_b4, ! True if starting pos'n is col. 1 comment_chars, ! Characters for Comment u_line, ! Uppercase version of a line u_char, ! Uppercase version of a character default_left_margin; ! True if left margin of current buffer = 1 ! Disregard end-of-buffer errors, etc. on_error [TPU$_NOEOBSTR]: ! prevent current_character error at EOB [OTHERWISE]: ! user may have done own RETURN endon_error; position (search (ANCHOR, FORWARD)); ! snap cursor to text if current_window = eve$command_window then return (FALSE); endif; if get_info (current_buffer, "system") then eve$message ("Para Marker is not implemented in WPE"); return (FALSE); endif; if not eve$test_if_modifiable (current_buffer) then eve$learn_abort; return (FALSE); endif; file_extension := file_parse (get_info (current_buffer, "name"), eve$kt_null, eve$kt_null, type); if get_info (current_buffer, "left_margin") = 1 then default_left_margin := TRUE; else default_left_margin := FALSE; endif; if mark(none) = end_of(current_buffer) then inserted_b4 := TRUE; else if mark(none) = beginning_of(current_buffer) then inserted_b4 := TRUE; else if current_offset < 1 then ! Start of line inserted_b4 := TRUE; else inserted_b4 := FALSE; endif; endif; endif; CASE file_extension [".COM"] : if inserted_b4 then comment_chars := "$ ! "; else if substr ( current_line, 1, 3) = "$ !" then comment_chars := "$ ! "; else if substr ( current_line, 1, 2) = "$!" then comment_chars := "$! "; else comment_chars := "$ ! "; endif; endif; endif; eve_return; if inserted_b4 then move_horizontal (-1); endif; copy_text (comment_chars); [".FOR"] : if inserted_b4 then comment_chars := "C "; else u_line := current_line; edit (u_line, UPPER, OFF); u_char := substr (u_line, 1, 1); if (u_char = "C") AND (index (u_line, "CPAR$") <> 1) AND (index (u_line, "CDEC$") <> 1) then comment_chars := "C "; else comment_chars := "C "; endif; endif; eve_return; wpe$x_for_contin_number := 1; if default_left_margin then ! Otherwise, don't mess with it. if inserted_b4 then move_horizontal (-1); endif; copy_text (comment_chars); endif; [".HLP",".TPU"] : if inserted_b4 then comment_chars := "! "; else if substr ( current_line, 1, 1) = "!" then comment_chars := "! "; ! ! + 7sp else comment_chars := "! "; endif; endif; eve_return; if default_left_margin then ! Otherwise, don't mess with it. if inserted_b4 then move_horizontal (-1); endif; copy_text (comment_chars); endif; [OTHERWISE] : eve$message ("Para Marker is not implemented in WPE"); ENDCASE; return (TRUE); endprocedure; ! wpe_gold_return !<><><><><><><><><><><><> ! Procedure invoked by the Delete (<><><><><><><><><><><> procedure wpe_fill local file_extension, hlp_left, hlp_right, hlp_offset, para_mark, start_mark, start_fix, next_para; file_extension := file_parse (get_info (current_buffer, "name"), eve$kt_null, eve$kt_null, type); ! Don't do it if in a special file (except .HLP) CASE file_extension [".COM"] : eve$message ("Paragraph Wrap doesn't make sense in a .COM file", eve$k_warning); return (FALSE); [".TPU"] : eve$message ("Paragraph Wrap doesn't make sense in a .TPU file", eve$k_warning); return (FALSE); [".FOR"] : eve$message ("Paragraph Wrap doesn't make sense in a .FOR file", eve$k_warning); return (FALSE); [OTHERWISE] : ENDCASE; ! If there is a select range in this buffer, just do a regular fill and move ! right one position if (eve$x_select_position <> 0) then if get_info (eve$x_select_position, "buffer") = current_buffer then eve_fill; move_horizontal (1); !%IF eve$x_option_w$pe_at_least_eve_2_2 !%THEN eve$clear_select_position; !%ELSE !% eve$x_select_position := 0; !%ENDIF; return (TRUE); endif; endif; if get_info (eve$x_found_range, "type") = RANGE then if get_info (eve$x_found_range, "buffer") = current_buffer then eve_fill; move_horizontal (1); return (TRUE); endif; endif; ! Save current position, find next paragraph, then... ! Position to start of paragraph. para_mark := mark(none); ! Go forward to next para, then back to start of this one. if current_direction = forward then if mark(none) <> end_of (current_buffer) then eve$wps_paragraph; endif; next_para := mark(none); eve_reverse; eve$wps_paragraph; eve_forward; else eve_forward; if mark(none) <> end_of (current_buffer) then eve$wps_paragraph; endif; next_para := mark(none); eve_reverse; eve$wps_paragraph; endif; if file_extension = ".HLP" then ! Find out if we want to fix first line of the paragraph. hlp_left := get_info (current_buffer, "left_margin"); hlp_right := get_info (current_buffer, "right_margin"); hlp_offset := get_info (screen, "current_column"); if (hlp_offset <= hlp_left) AND (current_character <> " ") then start_mark := mark(none); start_fix := TRUE; ! First char is in column 1 else start_fix := FALSE; endif; set (MARGINS, current_buffer, hlp_left + 1, hlp_right); endif; position (para_mark); ! Do the fill, then .... if eve_fill then if file_extension = ".HLP" then set (MARGINS, current_buffer, hlp_left, hlp_right); if start_fix then ! Put first char. at column 1 position (start_mark); split_line; eve_delete; endif; endif; ! Now, position to the next paragraph, if possible position (next_para); else if file_extension = ".HLP" then set (MARGINS, current_buffer, hlp_left, hlp_right); endif; return (TRUE); endif; return (TRUE); endprocedure; ! wpe_fill !<><><><><><><><><><><><> ! DISPLAY_CHARACTER.TPU !- ! This procedure writes a one line message describing the current character ! in terms of Octal, Decimal, Hexadecimal and (sometimes ) '^' notation. ! ! Borrowed and modified from EVEPlus ! procedure wpe_display_character local a_index, this_character, ! Copy of current_character control_character; ! Control string if warranted ! Handle end-of-buffer condition if mark( none ) = end_of( current_buffer ) then eve$message( 'At end of buffer, no current character.', eve$k_warning); return (FALSE); endif; this_character := current_character; ! Check for end of line if this_character = "" then eve$message("The current character is the TPU line_end character.", eve$k_warning); return (TRUE); endif; ! Convert the character to an integer. a_index := ascii (this_character); if a_index > 255 then a_index := 0; ! on overflow, reset to null endif; ! Translate the character this_character := wpe_translate_char (this_character); ! Provide ^ notation for ascii control characters if a_index < 32 then control_character := '^' + ascii(a_index+64); else control_character := ''; endif; ! Format and output the results if a_index < 32 then eve$message( fao( "Current character is !AS " + "Decimal = !UB, " + "Octal = !-!OB, " + "Hex = !-!XB !AS", this_character, a_index, control_character ) ); else eve$message( fao( "The current character is !AS " + "Decimal = !UB, " + "Octal = !-!OB, " + "Hex = !-!XB !AS", this_character, a_index, control_character ) ); endif; return (TRUE); endprocedure; ! wpe_display_character !<><><><><><><><><><><><> ! ! This procedure translates control characters to readable characters. ! The output (return code only) is either the single-character ! input (unchanged), or a several-char symbol. Note that the ! character is not changed. ! ! The characters handled are 0-32, 127-159. ! 33 thru 126 and 160 thru 255 are changed by wrapping them in {} (e.g., the ! character e will become {e}. However, 123 and 125 are not changed to ! {{} and {}}, to prevent visual confusion. ! ! Borrowed and modified from EVEPlus ! procedure wpe_translate_char (char) local t_char; ! Translated character ! 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 '' ! 0 to 159 ! 0 thru 7 [''] : t_char := '{NUL}'; [''] : t_char := '{SOH}'; [''] : t_char := '{STX}'; [''] : t_char := '{ETX}'; [''] : t_char := '{EOT}'; [''] : t_char := '{ENQ}'; [''] : t_char := '{ACK}'; [''] : t_char := '{BEL}'; ! 8 thru 15 [''] : t_char := '{BS}'; [' '] : t_char := '{HT}'; [' '] : t_char := '{LF}'; [' '] : t_char := '{VT}'; [' '] : t_char := '{FF}'; [' '] : t_char := '{CR}'; [''] : t_char := '{SO }'; [''] : t_char := '{SI }'; ! 16 thru 23 [''] : t_char := '{DLE}'; [''] : t_char := '{DC1 }'; [''] : t_char := '{DC2}'; [''] : t_char := '{DC3 }'; [''] : t_char := '{DC4}'; [''] : t_char := '{NAK}'; [''] : t_char := '{SYN}'; [''] : t_char := '{ETB}'; ! 24 thru 31 [''] : t_char := '{CAN}'; [''] : t_char := '{EM}'; [''] : t_char := '{SUB}'; [''] : t_char := '{ESC}'; [''] : t_char := '{FS}'; [''] : t_char := '{GS}'; [''] : t_char := '{RS}'; [''] : t_char := '{US}'; ! 32 (space) [' '] : t_char := '{SPace}'; ! 123 Don't translate ['{'] : t_char := char; ! 125 Don't translate ['}'] : t_char := char; ! 127 [''] : t_char := '{DEL}'; ! 128 thru 135 [''] : t_char := '{128}'; [''] : t_char := '{129}'; [''] : t_char := '{130}'; [''] : t_char := '{131}'; [''] : t_char := '{IND}'; [''] : t_char := '{NEL}'; [''] : t_char := '{SSA}'; [''] : t_char := '{ESA}'; ! 136 thru 143 [''] : t_char := '{HTS}'; [''] : t_char := '{HTJ}'; [''] : t_char := '{VTS}'; [''] : t_char := '{PLD}'; [''] : t_char := '{PLU}'; [''] : t_char := '{RI}'; [''] : t_char := '{SS2}'; [''] : t_char := '{SS3}'; ! 144 thru 151 [''] : t_char := '{DCS}'; [''] : t_char := '{PU1}'; [''] : t_char := '{PU2}'; ! WARNING: SENDING CHARACTER 147 (STS) MAY BE DANGEROUS TO ! YOUR SESSION ON THE COMPUTER. [''] : t_char := '{STS}'; [''] : t_char := '{CCH}'; [''] : t_char := '{MW}'; [''] : t_char := '{SPA}'; [''] : t_char := '{EPA}'; ! 152 and 159 [''] : t_char := '{152}'; [''] : t_char := '{153}'; [''] : t_char := '{154}'; [''] : t_char := '{CSI}'; [''] : t_char := '{ST}'; [''] : t_char := '{OSC}'; [''] : t_char := '{PM}'; [''] : t_char := '{APC}'; [INRANGE] : t_char := '{' + char + '}'; [OUTRANGE] : t_char := '{' + char + '}'; endcase; return (t_char); endprocedure; ! wpe_translate_char !<><><><><><><><><><><><> ! Finds matching token for the token at current_character ! Currently for () only ! procedure wpe_find_matching local key_pressed, end_offset, target_line; !globals: ! wpe$x_starting_token, ! Where we started ! wpe$x_ending_token; ! Where we finally quit if get_info (wpe$x_ending_token, "type") = marker then delete (wpe$x_ending_token); endif; if current_character <> "(" then eve$message (" You must start at a '(' character"); if get_info (wpe$x_starting_token, "type") = marker then delete (wpe$x_starting_token); endif; return (FALSE); else eve$clear_message; wpe$x_starting_token := mark(reverse); endif; if wpe_find_matching_paren then wpe$x_ending_token := mark(reverse); end_offset := current_offset; else delete (wpe$x_starting_token); eve$message (" No matching ')' found"); return (FALSE); endif; target_line := substr(current_line, 1, end_offset) + substr(current_line, (end_offset + 1), 1) + substr(current_line, (end_offset + 2), length(current_line)); eve$message (target_line, eve$k_warning); position (wpe$x_starting_token); update (current_window); key_pressed := eve$prompt_key ("'X' erases marks, SELect moves to end mark, " + "any other key returns to editing"); if ((key_pressed = period) or (key_pressed = e4)) then position (wpe$x_ending_token); else if ((key_pressed = key_name("x")) or (key_pressed = key_name("X"))) then delete (wpe$x_ending_token); delete (wpe$x_starting_token); endif; endif; return (TRUE); endprocedure; ! wpe_find_matching !<><><><><><><><><><><><> ! Finds matching ) for the ( at current_character ! procedure wpe_find_matching_paren local next_close, ! Marks next closing paren next_open, ! Marks next open paren next_close_mark, next_open_mark, temp_mark; on_error ! Ignore search fails endon_error; loop move_horizontal (1); next_close := search (")",forward); if next_close = 0 then ! eve$message (" No matching ')' found"); return (FALSE); else temp_mark := mark(none); position (next_close); next_close_mark := mark(none); position (temp_mark); endif; next_open := search ("(",forward); if next_open <> 0 then position (next_open); next_open_mark := mark(none); if next_open_mark < next_close_mark then ! Do wpe_find_matching_paren (recursively). If it succeeds, ! continue with the loop. Otherwise, return error. if (not wpe_find_matching_paren) then return (FALSE); endif; else position (next_close); exitif 1; endif; else position (next_close); exitif 1; endif; endloop; return (TRUE); endprocedure; ! wpe_find_matching_paren !<><><><><><><><><><><><> ! procedure wpe_signature ! @ inserts signature file ! ! Insert sys$login:signature.wpe at current location in text. ! local l_offset, l_margin, put_here; on_error return (FALSE); endon_error; if current_buffer = eve$command_buffer then return (FALSE); ! too complex to worry with endif; l_margin := get_info (current_buffer, "left_margin"); l_offset := get_info (screen, "current_column"); if l_offset > l_margin then move_horizontal (-current_offset); move_vertical (1); endif; put_here := mark (none); if eve_include_file ('sys$login:signature.wpe') then position (put_here); return (TRUE); else return (FALSE); endif; endprocedure; ! wpe_signature !<><><><><><><><><><><><> ! If at end of line, then shift right (8), otherwise ! just do eve_end_of_line. procedure wpe_shift_right local cursor_is_free; on_error [OTHERWISE]: endon_error; if eve$in_prompting_window then return (eve_end_of_line); ! Let EVE handle it. endif; if current_window = eve$command_window then return (eve_end_of_line); ! Let EVE handle it. endif; cursor_is_free := not (get_info (current_buffer, "bound")); position (TEXT); ! snap cursor to text if mark (NONE) = end_of (current_buffer) then if not cursor_is_free then return (eve_end_of_line); ! Let EVE handle the error endif; else if current_character = "" then if not cursor_is_free then ! We are here to handle this one !!! eve_shift_right (8); endif; else return (eve_end_of_line); endif; endif; return (TRUE); endprocedure; ! wpe_shift_right !<><><><><><><><><><><><> ! If at beginning of line, then shift left (8) if shifted right, otherwise ! just do eve_start_of_line. procedure wpe_shift_left local cursor_is_free; on_error [OTHERWISE]: endon_error; if eve$in_prompting_window then return (eve_start_of_line); ! Let EVE handle it. endif; if current_window = eve$command_window then return (eve_start_of_line); ! Let EVE handle it. endif; cursor_is_free := not (get_info (current_buffer, "bound")); position (TEXT); ! snap cursor to text if cursor_is_free then return (eve_start_of_line); else if current_offset = 0 then ! We are here to handle this one !!! if get_info (current_window, "shift_amount") <> 0 then eve_shift_left (8); else ! Shift amount = 0, therefore we can't do anything. return (eve_start_of_line); endif; else return (eve_start_of_line); endif; endif; return (TRUE); endprocedure; ! wpe_shift_left !<><><><><><><><><><><><> ! Fix for TPU spawn not preserving /NOLINE terminal attribute. ! Doing a SPAWN ! restores the entering terminal status (what we would hope), but the ! logout from the spawn does not change back to the original environment ! of the TPU session. We are thus forced to write wpe_spawn, just to ! take care of this. ! procedure wpe_spawn local calluser_status on_error [OTHERWISE]: endon_error; if eve_spawn('') then calluser_status := call_user (3, "X"); ! /NOLINE_EDIT return (TRUE); else return (FALSE); endif; endprocedure; ! wpe_spawn !<><><><><><><><><><><><> ! Fix for TPU spawn not preserving /NOLINE terminal attribute. ! Spawn is used by eve_spell, but we don't use returned status for spell. ! Doing a SPAWN ! restores the entering terminal status (what we would hope), but the ! logout from the spawn does not change back to the original environment ! of the TPU session. We are thus forced to write wpe_spell, just to ! take care of this. procedure wpe_spell local calluser_status, spell_status; on_error [OTHERWISE]: endon_error; spell_status := eve_spell; calluser_status := call_user (3, "X"); ! /NOLINE_EDIT if spell_status then return (TRUE); else return (FALSE); endif; endprocedure; ! wpe_spell !<><><><><><><><><><><><> ! F19 will do "next buffer" if there is only one window. If there are ! 2 or more windows, then does "next window". Handle choice window ! if we have only one window. ! procedure wpe_other_window on_error [OTHERWISE]: endon_error; if eve$x_number_of_windows = 1 then if get_info (eve$choice_window, "buffer") <> 0 then if current_window = eve$command_window then position (eve$choice_window); return (TRUE); else if current_window = eve$choice_window then position (eve$command_window); return (TRUE); endif; endif; else return (eve_next_buffer); endif; else return (eve_other_window); endif; endprocedure; ! wpe_other_window !<><><><><><><><><><><><> ! Find next procedure, if a .TPU file - otherwise, do standard paragraph ! function. procedure wpe_paragraph local file_extension, saved_mark, procedure_hit; on_error [TPU$_CONTROLC]: eve$$restore_position (saved_mark); eve$learn_abort; abort; [OTHERWISE]: eve$$restore_position (saved_mark); endon_error; file_extension := file_parse (get_info (current_buffer, "name"), eve$kt_null, eve$kt_null, type); CASE file_extension [".TPU",".HLP"] : ! The following is "borrowed" from eve$wps_paragraph, with changes... saved_mark := mark (FREE_CURSOR); if (current_direction = FORWARD) then if saved_mark = end_of (current_buffer) then move_vertical (1); ! force error message + return endif; else if (current_direction = REVERSE) then if saved_mark = beginning_of (current_buffer) then move_vertical (-1); ! force error message + return endif; endif; endif; if (current_direction = FORWARD) then if mark (NONE) = end_of (current_buffer) then return (TRUE); else move_horizontal (1); ! Get off of this procedure, if applicable endif; else if mark (NONE) = beginning_of (current_buffer) then return (TRUE); else move_horizontal (-1); ! Get off of this procedure, if applicable endif; endif; ! Either TPU or HLP CASE file_extension [".TPU"] : if (current_direction = FORWARD) then procedure_hit := search_quietly (eve$pattern_startprocedure, FORWARD); if procedure_hit = 0 then eve$message ("There is no procedure forward of this line.", eve$k_warning); eve$$restore_position (saved_mark); return (FALSE); endif; else procedure_hit := search_quietly (eve$pattern_startprocedure, REVERSE); if procedure_hit = 0 then eve$message ("There is no procedure previous to this line.", eve$k_warning); eve$$restore_position (saved_mark); return (FALSE); endif; endif; [".HLP"] : if (current_direction = FORWARD) then procedure_hit := search_quietly (LINE_BEGIN + any("123456789"), FORWARD); if procedure_hit = 0 then eve$message ("There is no help topic forward of this line.", eve$k_warning); eve$$restore_position (saved_mark); return (FALSE); endif; else procedure_hit := search_quietly (LINE_BEGIN + any("123456789"), REVERSE); if procedure_hit = 0 then eve$message ("There is no help topic previous to this line.", eve$k_warning); eve$$restore_position (saved_mark); return (FALSE); endif; endif; [OTHERWISE] : ENDCASE; ! .TPU or .HLP position (procedure_hit); position (LINE_BEGIN); !%IF eve$x_option_evej !%THEN !% eve$conversion_start; !%ENDIF [OTHERWISE] : eve$wps_paragraph; ENDCASE; return (TRUE); endprocedure ! wpe_paragraph !<><><><><><><><><><><><> ! ! Simulate eve_include_selected if a valid file has been selected. ! This is particularly useful after doing a I Directory command ! (for the current directory), or DIREctory/NOHEad for other directories. ! Otherwise, do a normal eve_include_file. (Gold G). procedure wpe_include_file (include_file_parameter) local includefile_status, full_name; on_error [OTHERWISE]: endon_error; if include_file_parameter <> "" then includefile_status := eve_include_file (include_file_parameter); else full_name := wpe_selected_filename; ! full_name will either be totally valid, or null. ! Let EVE handle it. includefile_status := eve_include_file (full_name); endif; return (includefile_status); endprocedure ! wpe_include_file !<><><><><><><><><><><><> ! procedure wpe_selected_filename ! ! This routine returns a string. If the string is null, either there was no ! selected region, OR the selected region was not the name of an existing ! file. For reasonable cases, a message is output as an advisory to the ! user. local saved_mark, selected_name, full_name; on_error [TPU$_PARSEFAIL]: ! this prevents error message if garbage selected. [TPU$_TRUNCATE]: ! prevents failure if selected text > 65471 characters. [OTHERWISE]: endon_error; eve$clear_message; if eve$x_select_position <> 0 then ! Select range active if get_info (eve$x_select_position, eve$kt_buffer) <> current_buffer then saved_mark := mark (FREE_CURSOR); position (get_info (eve$x_select_position, eve$kt_buffer)); selected_name := str(select_range); eve$$restore_position (saved_mark); ! restore free cursor pos. else selected_name := str(select_range); endif; if length(selected_name) < 256 then edit (selected_name, COLLAPSE,TRIM,UPPER); ! Protect against earlier file_search with same file name. eve$reset_file_search; full_name := str(file_search(selected_name, "", "", NODE,DEVICE,DIRECTORY,NAME,TYPE,VERSION)); ! If the search fails, give a message indicating the problem. if full_name = "" then selected_name := str(file_parse (selected_name, "", "", NAME,TYPE,VERSION)); if (selected_name = "") OR (selected_name = ".;") then eve$message ("The selected text is not a valid Filename.", eve$k_warning); else eve$message ("No file with selected Filename found in " + file_parse (selected_name, "", "", DEVICE,DIRECTORY), eve$k_warning); endif; endif; else full_name := ""; endif; if full_name <> "" then ! everything checks out - go for it. !%IF eve$x_option_w$pe_at_least_eve_2_2 !%THEN eve$clear_select_position; !%ELSE !% eve$x_select_position := 0; !%ENDIF; endif; return (full_name); ! May be null string else ! No selection return (""); endif; endprocedure; ! wpe_selected_filename !<><><><><><><><><><><><> ! procedure wpe_ask_hlp_file ! ! Ask about tailoring for .HLP files (assumes we're in a .HLP file) ! local buffer_name, question_answer; on_error return (FALSE); endon_error; ! .HLP buffer right margin is 66 if it has been set. if get_info (current_buffer, "right_margin") <= 66 then return (FALSE); endif; buffer_name := get_info (current_buffer, "name"); eve$message (" File " + buffer_name , eve$k_warning); question_answer := eve$insist_y_n (" Do you want " + wpe$x_facility_name + " to tailor this buffer for " + "editing HELP files? [Yes] "); if question_answer = 1 then eve$message (" Tailoring " + wpe$x_facility_name + " to edit .HLP file ", eve$k_warning); return (TRUE); else return (FALSE); endif; endprocedure; ! wpe_ask_hlp_file !<><><><><><><><><><><><> ! procedure wpe_ask_long_lines ! ! Ask about tailoring for long lines, IF screen is 80 and we have long lines ! ! This is efficient, but it effectively counts characters. Since ! a tab counts for 1 character, it will not find "long lines" which ! are long because they contain tabs. ! If it's important to really find long lines, then look at ! using a loop, ! position(search(line_end,forward) ! get_info(current_buffer,"offset_column") ! etc. ! but.... this would take a comparatively long time to run. ! local long_line, entry_mark, buffer_name, question_answer; on_error return (FALSE); endon_error; if get_info (screen, "width") > 80 then return (FALSE); endif; buffer_name := get_info (current_buffer, "name"); entry_mark := mark (none); position ( beginning_of( current_buffer)); wpe$x_long_line := line_begin & arb(81); long_line := search_quietly (wpe$x_long_line, forward); position (entry_mark); if long_line <> 0 then eve$message (" File " + buffer_name, eve$k_warning); question_answer := eve$insist_y_n (" You have lines longer than 80 characters. " + "Go to 132-column screen? [Yes] "); if question_answer = 1 then return (TRUE); else return (FALSE); endif; else return (FALSE); endif; endprocedure; ! wpe_ask_long_lines !<><><><><><><><><><><><> ! procedure eve_set_keypad_edt ! ! Replacement for EVE procedure ! Applies an EDT overlay to the keypad - keeping other WPE functions. ! on_error endon_error; if wpe$x_edw_keys_on then eve$message ("The Keyboard is in EDT mode."); else define_key (eve$$kt_return + "eve_help('keypad')", PF2, "help (help keypad)", wpe$x_special_keys); define_key (eve$$kt_return + "eve$edt_fndnxt", PF3, "KEYPAD FndNxt", wpe$x_special_keys); define_key (eve$$kt_return + "eve$edt_delete_line", PF4, "KEYPAD delete_line (Del_L)", wpe$x_special_keys); define_key (eve$$kt_return + "eve_move_by_page", KP7, "move_by_page", wpe$x_special_keys); define_key (eve$$kt_return + "eve$edt_sect", KP8, "KEYPAD sect", wpe$x_special_keys); define_key (eve$$kt_return + "eve$edt_append", KP9, "KEYPAD append", wpe$x_special_keys); define_key (eve$$kt_return + "wpe_delete_word", MINUS, "KEYPAD delete_word (Del_W)", wpe$x_special_keys); define_key (eve$$kt_return + "eve_forward", KP4, "forward", wpe$x_special_keys); define_key (eve$$kt_return + "eve_reverse", KP5, "reverse", wpe$x_special_keys); define_key (eve$$kt_return + "eve_remove", KP6, "remove", wpe$x_special_keys); define_key (eve$$kt_return + "eve$edt_delete_char", COMMA, "KEYPAD delete_character (Del_C)", wpe$x_special_keys); define_key (eve$$kt_return + "eve_move_by_word", KP1, "move_by_word (Word)", wpe$x_special_keys); define_key (eve$$kt_return + "eve$edt_eol", KP2, "KEYPAD EOL", wpe$x_special_keys); define_key (eve$$kt_return + "eve$edt_char", KP3, "KEYPAD Character (Char)", wpe$x_special_keys); define_key (eve$$kt_return + "eve$edt_line", KP0, "KEYPAD EDT_Line", wpe$x_special_keys); define_key (eve$$kt_return + "eve_select", PERIOD, "Select", wpe$x_special_keys); define_key (eve$$kt_return + "wpe_return", ENTER, " return", wpe$x_special_keys); define_key (eve$$kt_return + "eve_help('keys')", key_name (PF2, SHIFT_KEY), "help (help keys)", wpe$x_special_keys); define_key (eve$$kt_return + "eve_find('')", key_name (PF3, SHIFT_KEY), "Find", wpe$x_special_keys); define_key (eve$$kt_return + "wpe_restore_line", key_name (PF4, SHIFT_KEY), " restore_line", wpe$x_special_keys); define_key (eve$$kt_return + "eve_do('')", key_name (KP7, SHIFT_KEY), "do", wpe$x_special_keys); define_key (eve$$kt_return + "wpe_fill", key_name (KP8, SHIFT_KEY), "fill", wpe$x_special_keys); define_key (eve$$kt_return + "eve$edt_replace", key_name (KP9, SHIFT_KEY), "KEYPAD EDT_Replace", wpe$x_special_keys); define_key (eve$$kt_return + "eve_restore_word", key_name (MINUS, SHIFT_KEY), " restore_word", wpe$x_special_keys); define_key (eve$$kt_return + "eve_bottom", key_name (KP4, SHIFT_KEY), "Bottom", wpe$x_special_keys); define_key (eve$$kt_return + "eve_top", key_name (KP5, SHIFT_KEY), "Top", wpe$x_special_keys); define_key (eve$$kt_return + "eve_insert_here", key_name (KP6, SHIFT_KEY), "insert_here", wpe$x_special_keys); define_key (eve$$kt_return + "eve_restore_character", key_name (COMMA, SHIFT_KEY), " restore_char", wpe$x_special_keys); define_key (eve$$kt_return + "eve$edt_chngcase", key_name (KP1, SHIFT_KEY), "KEYPAD ChngCase", wpe$x_special_keys); define_key (eve$$kt_return + "eve$edt_delete_eol", key_name (KP2, SHIFT_KEY), "KEYPAD Del_EOL", wpe$x_special_keys); define_key (eve$$kt_return + "eve$edt_specins", key_name (KP3, SHIFT_KEY), "KEYPAD SpecIns", wpe$x_special_keys); ! default action if user pressed GOLD/KP3 ! without having already pressed GOLD/number define_key (eve$$kt_return + "eve$edt_open_line", key_name (KP0, SHIFT_KEY), "KEYPAD Open_Line", wpe$x_special_keys); define_key (eve$$kt_return + "eve_reset", key_name (PERIOD, SHIFT_KEY), "reset", wpe$x_special_keys); define_key (eve$$kt_return + "eve$edt_substitute",key_name (ENTER, SHIFT_KEY), "KEYPAD Subs", wpe$x_special_keys); ! We don't have to do this, because the WPS keypad is always underneath. ! define_key (eve$$kt_return + "eve$edt_repeat(0)", key_name ("0", SHIFT_KEY), ! "KEYPAD repeat", wpe$x_special_keys); ! define_key (eve$$kt_return + "eve$edt_repeat(1)", key_name ("1", SHIFT_KEY), ! "KEYPAD repeat", wpe$x_special_keys); ! define_key (eve$$kt_return + "eve$edt_repeat(2)", key_name ("2", SHIFT_KEY), ! "KEYPAD repeat", wpe$x_special_keys); ! define_key (eve$$kt_return + "eve$edt_repeat(3)", key_name ("3", SHIFT_KEY), ! "KEYPAD repeat", wpe$x_special_keys); ! define_key (eve$$kt_return + "eve$edt_repeat(4)", key_name ("4", SHIFT_KEY), ! "KEYPAD repeat", wpe$x_special_keys); ! define_key (eve$$kt_return + "eve$edt_repeat(5)", key_name ("5", SHIFT_KEY), ! "KEYPAD repeat", wpe$x_special_keys); ! define_key (eve$$kt_return + "eve$edt_repeat(6)", key_name ("6", SHIFT_KEY), ! "KEYPAD repeat", wpe$x_special_keys); ! define_key (eve$$kt_return + "eve$edt_repeat(7)", key_name ("7", SHIFT_KEY), ! "KEYPAD repeat", wpe$x_special_keys); ! define_key (eve$$kt_return + "eve$edt_repeat(8)", key_name ("8", SHIFT_KEY), ! "KEYPAD repeat", wpe$x_special_keys); ! define_key (eve$$kt_return + "eve$edt_repeat(9)", key_name ("9", SHIFT_KEY), ! "KEYPAD repeat", wpe$x_special_keys); ! Editing Keypad keys for EDT define_key (eve$$kt_return + "eve$edt_section(forward)", E6, "KEYPAD next_screen", wpe$x_special_keys); define_key (eve$$kt_return + "eve$edt_section(reverse)", E5, "KEYPAD previous_screen", wpe$x_special_keys); ! Control and main keyarray keys defined for EDT ! This may look like duplicate definitions, but it keeps us out of trouble. define_key (eve$$kt_return + "eve$edt_delete_start_word", CTRL_J_KEY, "KEYPAD delete_previous_word", wpe$x_special_keys); define_key (eve$$kt_return + "eve$edt_delete_start_word", F13, "KEYPAD delete_previous_word", wpe$x_special_keys); define_key (eve$$kt_return + "eve$edt_delete_start_word", LF_KEY, "KEYPAD delete_previous_word", wpe$x_special_keys); define_key (eve$$kt_return + "eve$edt_backspace", CTRL_H_KEY, "KEYPAD BACKSPACE (start_of_line)", wpe$x_special_keys); define_key (eve$$kt_return + "eve$edt_backspace", BS_KEY, "KEYPAD BACKSPACE (start_of_line)", wpe$x_special_keys); define_key (eve$$kt_return + "eve$edt_backspace", F12, "KEYPAD BACKSPACE (start_of_line)", wpe$x_special_keys); define_key (eve$$kt_return + "eve$delete_start_line", CTRL_U_KEY, "KEYPAD delete_start_line", wpe$x_special_keys); !! eve$$add_do_key (key_name (KP7, SHIFT_KEY), wpe$x_special_keys); wpe$x_edw_keys_on := TRUE; wpe$x_num_keys_on := FALSE; eve$message ("The Keyboard is now in EDT mode", eve$k_warning); if wpe$x_facility_name = "WPE" then wpe$x_facility_name := "EDW"; wpe$x_lowercase_facility_name := " edw"; eve$update_status_lines; ! We keep the original name on the "Working..." message. endif; endif; return (TRUE); endprocedure; ! eve_set_keypad_edt !<><><><><><><><><><><><> ! procedure eve_set_keypad_noedt ! ! Removes the EDT overlay from the keypad - restoring WPE/WPS functions. ! on_error endon_error; if not wpe$x_edw_keys_on then if wpe$x_num_keys_on then eve$message ("The Keyboard is in WPS Numeric mode."); else eve$message ("The Keyboard is in WPS mode."); endif; return (TRUE); ! Just exit procedure endif; undefine_key (PF2, wpe$x_special_keys); undefine_key (PF3, wpe$x_special_keys); undefine_key (PF4, wpe$x_special_keys); undefine_key (KP7, wpe$x_special_keys); undefine_key (KP8, wpe$x_special_keys); undefine_key (KP9, wpe$x_special_keys); undefine_key (MINUS, wpe$x_special_keys); undefine_key (KP4, wpe$x_special_keys); undefine_key (KP5, wpe$x_special_keys); undefine_key (KP6, wpe$x_special_keys); undefine_key (COMMA, wpe$x_special_keys); undefine_key (KP1, wpe$x_special_keys); undefine_key (KP2, wpe$x_special_keys); undefine_key (KP3, wpe$x_special_keys); undefine_key (KP0, wpe$x_special_keys); undefine_key (PERIOD, wpe$x_special_keys); undefine_key (ENTER, wpe$x_special_keys); undefine_key (key_name (PF2, SHIFT_KEY), wpe$x_special_keys); undefine_key (key_name (PF3, SHIFT_KEY), wpe$x_special_keys); undefine_key (key_name (PF4, SHIFT_KEY), wpe$x_special_keys); undefine_key (key_name (KP7, SHIFT_KEY), wpe$x_special_keys); undefine_key (key_name (KP8, SHIFT_KEY), wpe$x_special_keys); undefine_key (key_name (KP9, SHIFT_KEY), wpe$x_special_keys); undefine_key (key_name (MINUS, SHIFT_KEY), wpe$x_special_keys); undefine_key (key_name (KP4, SHIFT_KEY), wpe$x_special_keys); undefine_key (key_name (KP5, SHIFT_KEY), wpe$x_special_keys); undefine_key (key_name (KP6, SHIFT_KEY), wpe$x_special_keys); undefine_key (key_name (COMMA, SHIFT_KEY), wpe$x_special_keys); undefine_key (key_name (KP1, SHIFT_KEY), wpe$x_special_keys); undefine_key (key_name (KP2, SHIFT_KEY), wpe$x_special_keys); undefine_key (key_name (KP3, SHIFT_KEY), wpe$x_special_keys); undefine_key (key_name (KP0, SHIFT_KEY), wpe$x_special_keys); undefine_key (key_name (PERIOD, SHIFT_KEY), wpe$x_special_keys); undefine_key (key_name (ENTER, SHIFT_KEY), wpe$x_special_keys); !undefine_key (key_name ("0", SHIFT_KEY), wpe$x_special_keys); !undefine_key (key_name ("1", SHIFT_KEY), wpe$x_special_keys); !undefine_key (key_name ("2", SHIFT_KEY), wpe$x_special_keys); !undefine_key (key_name ("3", SHIFT_KEY), wpe$x_special_keys); !undefine_key (key_name ("4", SHIFT_KEY), wpe$x_special_keys); !undefine_key (key_name ("5", SHIFT_KEY), wpe$x_special_keys); !undefine_key (key_name ("6", SHIFT_KEY), wpe$x_special_keys); !undefine_key (key_name ("7", SHIFT_KEY), wpe$x_special_keys); !undefine_key (key_name ("8", SHIFT_KEY), wpe$x_special_keys); !undefine_key (key_name ("9", SHIFT_KEY), wpe$x_special_keys); ! Editing Keypad keys for EDT undefine_key (E6, wpe$x_special_keys); undefine_key (E5, wpe$x_special_keys); ! Control and main keyarray keys defined for EDT. undefine_key (CTRL_J_KEY, wpe$x_special_keys); undefine_key (F13, wpe$x_special_keys); undefine_key (LF_KEY, wpe$x_special_keys); undefine_key (CTRL_H_KEY, wpe$x_special_keys); undefine_key (BS_KEY, wpe$x_special_keys); undefine_key (F12, wpe$x_special_keys); undefine_key (CTRL_U_KEY, wpe$x_special_keys); !! eve$$redefine_do_key (key_name (KP7, SHIFT_KEY), "", 0, 1); wpe$x_edw_keys_on := FALSE; message ("The Keyboard is now in WPS mode", eve$k_warning); if wpe$x_facility_name = "EDW" then wpe$x_facility_name := "WPE"; wpe$x_lowercase_facility_name := " wpe"; eve$update_status_lines; ! We keep the original name on the "Working..." message. endif; if wpe$x_num_keys_on then sleep (2); ! So user can read this message. wpe$x_num_keys_on := FALSE; ! Will be reset to true by procedure. eve_numeric; ! Gives another message endif; return (TRUE); endprocedure; ! eve_set_keypad_noedt !<><><><><><><><><><><><> ! ! This procedure replaces the EVE procedure of the same name, so ! that we can actually overlay the numeric keypad. ! ! Note: Synonym won't work if there is a procedure defined. procedure eve_set_keypad_numeric return (eve_numeric); endprocedure; ! eve_set_keypad_numeric !<><><><><><><><><><><><> ! ! The following procedure will put the keypad in numeric mode. ! eve_application must be used to put it back. ! ! Must begin with 'eve_' so the command parser will find it. ! procedure eve_numeric if wpe$x_num_keys_on then if wpe$x_edw_keys_on then eve$message ("The Keypad is in EDT numeric mode."); else eve$message ("The Keypad is in WPS numeric mode."); endif; else define_key (eve$$kt_return + "copy_text ('0')", KP0, " typing (0)", wpe$x_special_keys); define_key (eve$$kt_return + "copy_text ('1')", KP1, " typing (1)", wpe$x_special_keys); define_key (eve$$kt_return + "copy_text ('2')", KP2, " typing (2)", wpe$x_special_keys); define_key (eve$$kt_return + "copy_text ('3')", KP3, " typing (3)", wpe$x_special_keys); define_key (eve$$kt_return + "copy_text ('4')", KP4, " typing (4)", wpe$x_special_keys); define_key (eve$$kt_return + "copy_text ('5')", KP5, " typing (5)", wpe$x_special_keys); define_key (eve$$kt_return + "copy_text ('6')", KP6, " typing (6)", wpe$x_special_keys); define_key (eve$$kt_return + "copy_text ('7')", KP7, " typing (7)", wpe$x_special_keys); define_key (eve$$kt_return + "copy_text ('8')", KP8, " typing (8)", wpe$x_special_keys); define_key (eve$$kt_return + "copy_text ('9')", KP9, " typing (9)", wpe$x_special_keys); define_key (eve$$kt_return + "copy_text ('.')", PERIOD, " typing (.)", wpe$x_special_keys); define_key (eve$$kt_return + "copy_text (',')", COMMA, " typing (,)", wpe$x_special_keys); define_key (eve$$kt_return + "copy_text ('-')", MINUS, " typing (-)", wpe$x_special_keys); define_key (eve$$kt_return + "wpe_return", ENTER, " return (Return)", wpe$x_special_keys); wpe$x_num_keys_on := TRUE; if wpe$x_edw_keys_on then eve$message ("The Keypad is now in EDT numeric mode", eve$k_warning); else eve$message ("The Keypad is now in WPS numeric mode", eve$k_warning); endif; endif; return (TRUE); endprocedure; ! eve_numeric !<><><><><><><><><><><><> ! ! The following procedure cancels the effect of eve_numeric. ! ! it must start with 'eve_' so the command parser will find it. ! procedure eve_application if not wpe$x_num_keys_on then if wpe$x_edw_keys_on then eve$message ("The Keypad is in EDT application mode."); else eve$message ("The Keypad is in WPS application mode."); endif; else if wpe$x_edw_keys_on then wpe$x_edw_keys_on := FALSE; ! Will be reset to true by procedure. eve_set_keypad_edt; wpe$x_num_keys_on := FALSE; else undefine_key (KP0, wpe$x_special_keys); undefine_key (PERIOD, wpe$x_special_keys); undefine_key (ENTER, wpe$x_special_keys); undefine_key (KP1, wpe$x_special_keys); undefine_key (KP2, wpe$x_special_keys); undefine_key (KP3, wpe$x_special_keys); undefine_key (KP4, wpe$x_special_keys); undefine_key (KP5, wpe$x_special_keys); undefine_key (KP6, wpe$x_special_keys); undefine_key (COMMA, wpe$x_special_keys); undefine_key (KP7, wpe$x_special_keys); undefine_key (KP8, wpe$x_special_keys); undefine_key (KP9, wpe$x_special_keys); undefine_key (MINUS, wpe$x_special_keys); wpe$x_num_keys_on := FALSE; if wpe$x_edw_keys_on then eve$message ("The Keypad is now in EDT application mode", eve$k_warning); else eve$message ("The Keypad is now in WPS application mode", eve$k_warning); endif; endif; endif; return (TRUE); endprocedure; ! eve_application !<><><><><><><><><><><><> ! ! This procedure replaces the EVE procedure of the same name. ! ! Note: Synonym won't work if there is a procedure already defined. procedure eve_set_keypad_wps eve$set_wps_keypad; ! In case somebody set it to VT100 if wpe$x_num_keys_on then eve_application; if wpe$x_edw_keys_on then eve_set_keypad_noedt; endif; else if wpe$x_edw_keys_on then eve_set_keypad_noedt; else eve$message ("The Keypad is in WPS application mode."); endif; endif; return (TRUE); endprocedure; ! eve_set_keypad_wps !<><><><><><><><><><><><> ! ! Note: Synonym won't work to implement this. procedure eve_set_keypad_wpe return (eve_set_keypad_wps); endprocedure; ! eve_set_keypad_wpe !<><><><><><><><><><><><> ! ! This procedure replaces the EVE procedure of the same name. ! ! Note: Synonym won't work if there is a procedure already defined. procedure eve_set_keypad_nowps eve$message ( "Set Keypad NOWPS is disabled when using WPE. Do: SET KEYPAD to see options", eve$k_warning); return (FALSE); endprocedure; ! eve_set_keypad_nowps !<><><><><><><><><><><><> ! ! Note: Synonym won't work to implement this. procedure eve_set_keypad_edw return (eve_set_keypad_edt); endprocedure; ! eve_set_keypad_edw !<><><><><><><><><><><><> ! ! Note: Synonym won't work to implement this. procedure eve_set_keypad_noedw return (eve_set_keypad_noedt); endprocedure; ! eve_set_keypad_noedw !<><><><><><><><><><><><> ! ! This procedure invokes the "use spaces instead of tabs" mode: ! (1) Fix all tabs in the current buffer to be spaces. ! (2) Define the Tab key to insert spaces. ! ! NOTES: There is no inverse for this procedure. However, the command ! SET TABS INSERT will make the tab key insert HT. ! Tabs are only removed from the current buffer (the procedure ! can be re-issued for other buffers, however). ! Any inserts where tabs are present will continue to have ! the tabs left in. ! ! procedure eve_notabs local this_position, found_ht; eve_set_tabs ("SPACES"); ! Fix Tabs this_position := mark(none); if mark(none) <> beginning_of (current_buffer) then eve_top; endif; loop found_ht := search_quietly (' ', forward); ! Find HT exitif found_ht = 0; position (found_ht); erase_character(1); eve_tab; endloop; position (this_position); return (TRUE); endprocedure; ! eve_notabs !<><><><><><><><><><><><> ! Set current text lines per page parameter (CT) ! Note: this is named eve_ctlength so the command_line parser can ! handle it. procedure eve_ctlength (ct_input) local ct_requested; ! Local copy of ct parameter if not (eve$prompt_number (ct_input, ct_requested, FAO("[Now !SL Line!%S per Page]",wpe$$x_page_size) + " Enter new value for Text Lines per Page (CT): ", "Current value of CT not changed.")) then return (FALSE); endif; if ct_requested <= 0 then eve$message ("CT must be greater than 0.", eve$k_warning); return (FALSE); else eve$message (fao ("Current Text length set to !SL lines per page", ct_requested), eve$k_warning); update (message_window); wpe$$x_page_size := ct_requested; return (TRUE); endif; endprocedure ! eve_ctlength !<><><><><><><><><><><><> procedure eve_print ! Generic print procedure - prompts for translated/untranslated if eve$x_select_position <> 0 then ! Select range active if get_info (eve$x_select_position, eve$kt_buffer) <> current_buffer then eve$message ("Print Selected Text must be used in " + "the same buffer as Select.", eve$k_warning); return (FALSE); endif; endif; if eve$insist_y_n ("Do you want to translate Control Codes to Printable Text? [Yes] ") then return (eve_print_translated); else return (eve_print_untranslated); endif; endprocedure ! eve_print !<><><><><><><><><><><><> ! ! Print the current select range (if active), or the entire buffer. ! Translate control characters before printing. ! ! Concept Plagiarized from EVEPlus.TPU ! Modified by D.E.C. ! ! ! Note: must begin with 'eve_' so the command parser can find it ! procedure eve_print_translated local this_position, this_buffer, translate_range, print_file_name, file_temp, ident_name, ! Short name for file (screen message) unique; ! Unique add-on for saving file on_error endon_error; set (success,off); this_position := mark (none); this_buffer := current_buffer; if get_info (wpe$x_translate_buffer,"type") = UNSPECIFIED then wpe$x_translate_buffer := create_buffer ('translation'); set (eob_text, wpe$x_translate_buffer, "End of file"); set (no_write, wpe$x_translate_buffer); endif; if eve$x_select_position <> 0 then ! Select range active if get_info (eve$x_select_position, eve$kt_buffer) <> current_buffer then eve$message ("Print Selected Text must be used in " + "the same buffer as Select.", eve$k_warning); return (FALSE); else translate_range := select_range; position (wpe$x_translate_buffer); erase (wpe$x_translate_buffer); eve$message ("Translating a copy of the Selected Range for printing...", 0); copy_text (translate_range); ! Make a copy of the select range endif; else !No select range position (wpe$x_translate_buffer); erase (wpe$x_translate_buffer); eve$message ("Translating a copy of this Buffer for printing...", eve$k_warning); copy_text (this_buffer); ! Make a copy of the buffer endif; ! Now translate the control characters wpe$translate_controls (wpe$x_translate_buffer); ! Translate control characters. ! Get the output file from the original buffer and use it to write the ! translated buffer (after making it unique). ! ! This procedure does not do a lot of error checking. It is assumed that ! the user knows what he/she is doing, if smart enough to get here. ! print_file_name := get_info (this_buffer,"file_name"); if (get_info (print_file_name, "type") <> string) or (print_file_name = "") then ! No file name print_file_name := get_info (this_buffer,"output_file"); endif; if (get_info (print_file_name, "type") <> string) or (print_file_name = "") then ! No file name print_file_name := eve$prompt_line (message_text (EVE$_NEWBUFPROMPT, 1), eve$$x_prompt_terminators, ""); if (print_file_name = 0) OR (print_file_name = "") then set (success,on); return (FALSE); endif; endif; ! Make a unique file name in SYS$LOGIN ! Get time string, e.g., 30-MAR-1987 21:35:14 unique := substr( fao ("!%D",0), 1, 20); ! Pack out blank, -:., - replace by underscore. translate (unique, "____", " -:."); file_temp := file_parse (print_file_name, "", "", NAME,TYPE); if file_temp = "" then ! Bad file name return (FALSE); endif; print_file_name := "SYS$LOGIN:" + file_temp + unique + ";1"; if eve$x_select_position <> 0 then !Select range active ident_name := "Selected Text"; else ident_name := file_temp; endif; set (output_file, wpe$x_translate_buffer, print_file_name); write_file (wpe$x_translate_buffer); wpe_print_file (print_file_name, ident_name); position (this_position); if eve$x_select_position <> 0 then !Select range active !%IF eve$x_option_w$pe_at_least_eve_2_2 !%THEN eve$clear_select_position; !%ELSE !% eve$x_select_position := 0; !%ENDIF; translate_range := 0; endif; return (TRUE); endprocedure; ! eve_print_translated !<><><><><><><><><><><><> ! Translate control characters for printing ! ! Concept Plagiarized from EVEPlus.TPU ! Modified by D.E.C. ! ! ! This procedure controls the outer loop search for the special ! control characters that we want to view ! ! NOTE: You always end up in "original_buffer" ! procedure wpe$translate_controls (original_buffer) local wpe$x_translate_pattern, 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 (original_buffer); return (FALSE); endon_error; ! 0 thru 31 + 127 thru 159 wpe$x_translate_pattern := any (' '); position (beginning_of (wpe$x_translate_buffer)); loop ! Find all occurrences control_char := search_quietly (wpe$x_translate_pattern, forward); exitif (control_char = 0); position (control_char); char_to_translate := current_character; ! Save the character erase (control_char); ! then erase it ! & Substitute the new text copy_text (wpe_translate_char (char_to_translate)); endloop; position (original_buffer); return (TRUE); endprocedure; ! wpe$translate_controls !<><><><><><><><><><><><> ! ! Print the current select range (if active), or the entire buffer. ! ! ! Note: must begin with 'eve_' so the command parser can find it ! procedure eve_print_untranslated local print_file_name, has_been_modified, file_temp, ident_name, ! Short name for file (screen message) unique; ! Unique add-on for saving file on_error endon_error; set (success,off); if eve$x_select_position <> 0 then ! Select range active if get_info (eve$x_select_position, eve$kt_buffer) <> current_buffer then eve$message ("Print Selected Text must be used in " + "the same buffer as Select.", eve$k_warning); return (FALSE); endif; endif; ! Get the output file from the original buffer and use it to write the ! buffer (after making it unique). ! print_file_name := get_info (current_buffer,"file_name"); if (get_info (print_file_name, "type") <> string) or (print_file_name = "") then ! No file name print_file_name := get_info (current_buffer,"output_file"); endif; if (get_info (print_file_name, "type") <> string) or (print_file_name = "") then ! No file name print_file_name := eve$prompt_line (message_text (EVE$_NEWBUFPROMPT, 1), eve$$x_prompt_terminators, ""); if (print_file_name = 0) OR (print_file_name = "") then set (success,on); return (FALSE); endif; endif; ! Make a unique file name in SYS$LOGIN ! Get time string, e.g., 30-MAR-1987 21:35:14 unique := substr( fao ("!%D",0), 1, 20); ! Pack out blank, -:., - replace by underscore. translate (unique, "____", " -:."); file_temp := file_parse (print_file_name, "", "", NAME,TYPE); if file_temp = "" then ! Bad file name return (FALSE); endif; print_file_name := "SYS$LOGIN:" + file_temp + unique + ";1"; if eve$x_select_position <> 0 then !Select range active ident_name := "Selected Text"; else ident_name := file_temp; endif; if eve$x_select_position <> 0 then !Select range active write_file (select_range, print_file_name); !%IF eve$x_option_w$pe_at_least_eve_2_2 !%THEN eve$clear_select_position; !%ELSE !% eve$x_select_position := 0; !%ENDIF; else has_been_modified := get_info (current_buffer, "modified"); write_file (current_buffer, print_file_name); ! Restore modified status, if needed, by making a change. if has_been_modified then ! This built-in is not documented as of VMS V5.0 set (MODIFIED, current_buffer, ON); endif; endif; wpe_print_file (print_file_name, ident_name); return (TRUE); endprocedure ! eve_print_untranslated !<><><><><><><><><><><><> procedure wpe_print_file (file_to_print, short_name) ! Note that file_to_print MUST be fully-qualified with the version number, ! since we may do a delete of this file after printing it. ! The file is deleted IFF the print command starts with 'DM$' local print_command, calluser_status; on_error [TPU$_CREATEFAIL, TPU$_CAPTIVE]: !%IF eve$x_option_decwindows !%THEN if eve$x_decwindows_active then eve$popup_message (message_text (EVE$_CANTCREADCL, 1)); else eve$message (EVE$_CANTCREADCL); endif; !%ELSE !% eve$message (EVE$_CANTCREADCL); !%ENDIF eve$learn_abort; return (FALSE); [OTHERWISE]: endon_error; print_command := eve$prompt_line ("Print command [Print/Delete]: ", eve$$x_prompt_terminators, ""); if print_command = "" then print_command := "PRINT/DELETE"; else edit (print_command, COMPRESS,TRIM,UPPER); endif; print_command := print_command + " "; ! Make this work with the usual DM/SD definition for an attached printer ! The symbol is usually DM$ATP, and may be followed by parameters. ! However, we look for anything starting with DM$ if substr(print_command, 1, 3) = "DM$" then eve$message (fao ("Printing !AS using command !AS", short_name, print_command)); if eve_spawn(print_command + file_to_print) then eve_spawn ("DELETE " + file_to_print); ! Fix for TPU spawn not preserving /NOLINE terminal attribute. calluser_status := call_user (3, "X"); ! /NOLINE_EDIT eve$clear_message; ! Clear message space endif; else ! using create_process gets normal "queue" messages displayed on the message ! line. if print_command = "PRINT/DELETE " then eve$message (fao ("Printing !AS using command !AS", short_name, print_command)); else eve$message (fao ("Printing !AS using command !AS", file_to_print, print_command)); endif; if (get_info (wpe$x_print_process, "type") = UNSPECIFIED) or (wpe$x_print_process = 0) then eve$message (EVE$_CREATEDCL); wpe$x_print_process := create_process (message_buffer, "$ set noon"); endif; send (print_command + file_to_print, wpe$x_print_process); endif; set (success,on); update (message_window); return (TRUE); endprocedure ! wpe_print_file !<><><><><><><><><><><><> ! FIX_MEM - Routine to turn CRLFs into line breaks ! and remove leading CRs and trailing CRLFs ! ! Frequently used with .MEM files - hence the name ! ! Concept Plagiarized from EVEPlus.TPU ! Modified by D.E.C. ! ! This procedure does not do a lot of error checking. It is assumed that ! the user knows what he/she is doing, if smart enough to get here. ! ! ! Note: must begin with 'eve_' so the command parser can find it ! procedure eve_fix_mem Local first_line, ! First of "overstrike" lines (bare CRs) second_line, ! Next line left_end, ! Marks left end of bold region right_end, ! bold_on, ! Escape sequence to turn bolding on bold_off, ! bolding, ! Logical to control if we're bolding bold_requested, ! Logical to control if we have asked copy_filename, ! Name for new buffer/file fix_range, ! Range to copy this_buffer, ! Buffer of origin this_buffer_name, ! Name of original buffer fix_buffer, ! Buffer to create (NOTE: Global) fix_buffer_name, ! Name of FIX buffer file_temp, question_answer, this_mode, ! Used to save the editing mode the_range; ! ! global wpe$x_fix_buffer - same as fix_buffer, due to error handling on_error [TPU$_STRNOTFOUND]: [TPU$_DUPBUFNAME]: eve$message (fao("Erasing existing buffer !AS ", fix_buffer_name ), 0); eve_buffer (fix_buffer_name); wpe$x_fix_buffer := current_buffer; erase (wpe$x_fix_buffer); eve_buffer (this_buffer_name); [OTHERWISE]: set (success,on); return (FALSE); endon_error; if eve$x_select_position <> 0 then ! Select range active if get_info (eve$x_select_position, eve$kt_buffer) <> current_buffer then eve$message ("FIX Selected Text must be used in " + "the same buffer as Select.", eve$k_warning); return (FALSE); endif; endif; bold_on := ""; bold_off := ""; bold_requested := FALSE; set (success,off); this_mode := get_info (current_buffer, eve$kt_mode); this_buffer := current_buffer; this_buffer_name := get_info (this_buffer,"name"); ! Get the output file from the original buffer and use it to write a ! translated buffer (after making it different). ! copy_filename := get_info (this_buffer,"output_file"); if (get_info (copy_filename, "type") <> string) or (copy_filename = "") then ! No file name ! copy_filename := read_line ! ("Enter a name for the FIX buffer. Press RETURN to cancel: "); copy_filename := eve$prompt_line ("Enter a name for the FIX buffer. Press RETURN to cancel: ", eve$$x_prompt_terminators, ""); if copy_filename = "" then set (success,on); return (FALSE); endif; fix_buffer_name := file_parse (copy_filename, "", "", NAME,TYPE); else ! Make a unique file name. file_temp := file_parse (copy_filename, "", "", TYPE); if file_temp = ".LIS" then file_temp := ".TXT"; else file_temp := ".LIS"; ! Preferred endif; fix_buffer_name := file_parse (copy_filename, "", "", NAME) + file_temp; copy_filename := file_parse (copy_filename, "", "", NODE,DEVICE,DIRECTORY) + fix_buffer_name; endif; fix_buffer := create_buffer (fix_buffer_name); if get_info (fix_buffer, "type") <> buffer then ! failed - see on_error fix_buffer := wpe$x_fix_buffer; else wpe$x_fix_buffer := fix_buffer; endif; set (output_file, wpe$x_fix_buffer, copy_filename); set (eob_text, wpe$x_fix_buffer, "End of file"); ! ! Copy the contents to the new buffer, positioning in the new buffer. ! if eve$x_select_position <> 0 then ! Select range active if get_info (eve$x_select_position, eve$kt_buffer) <> current_buffer then eve$message ("FIX Selected Text must be used in " + "the same buffer as Select.", eve$k_warning); return (FALSE); else fix_range := select_range; position (wpe$x_fix_buffer); eve$message (fao ("Copying the Selected Range to new buffer !AS ", fix_buffer_name ), 0); copy_text (fix_range); ! Make a copy of the select range endif; else !No select range position (wpe$x_fix_buffer); eve$message (fao ("Copying buffer !AS to new buffer !AS ", this_buffer_name, fix_buffer_name), eve$k_warning); copy_text (this_buffer); ! Make a copy of the buffer endif; position (beginning_of(current_buffer)); map (current_window, wpe$x_fix_buffer); eve$update_status_lines; update (current_window); ! NOW TO CONVERT THE NEW BUFFER. ! ! First remove the CRLFs. If they are not at the EOL, add a line break. ! eve$message (fao ("Removing CRLFs from buffer !AS ", fix_buffer_name), eve$k_warning); position(beginning_of(current_buffer)); loop the_range := search(ascii(13)+ascii(10), FORWARD); exitif (the_range = 0); erase(the_range); position(beginning_of(the_range)); if (current_character <> "") then split_line; endif; endloop; ! ! Next remove naked LFs. If they are not at the EOL, add a line break. ! position(beginning_of(current_buffer)); update (current_window); eve$message (fao ("Removing naked LFs from buffer !AS ", fix_buffer_name), eve$k_warning); loop the_range := search(ascii(10), FORWARD); exitif (the_range = 0); erase(the_range); position(beginning_of(the_range)); if (current_character <> "") then split_line; endif; endloop; ! ! Finally, remove naked CRs. If they are not at the BOL, add a line break. ! These lines are "overstrikes" - for more modern printers, we would ! like to do this by bolding or shadow printing. Since we are trying ! to be "general", this gets a little complex. It must take care ! of situations where only a part of the line is overstruck. ! Assumptions: ! 1. The overstruck part is the FIRST line, ! 2. This may only be a substring of subsequent lines, ! 3. If it isn't a substring then we REALLY want to leave ! the naked CR - because we're doing composite chars. ! However, for most printers, we also need to tab up, ! so we use {CR}{ESC}[k ! position(beginning_of(current_buffer)); update (current_window); eve$message (fao ("Removing naked CRs from buffer !AS ", fix_buffer_name), eve$k_warning); loop the_range := search( " ", FORWARD); exitif (the_range = 0); position(end_of(the_range)); if (current_offset <> 0) then if (current_offset <> (length(current_line) - 1)) then ! Mid-line split_line; erase(the_range); else ! CR is at the end of the line erase(the_range); ! Get rid of CR exitif mark(none) = end_of (current_buffer); wpe_get_fix_line (first_line, right_end, left_end); ! ! We got rid of one copy. Now for the next line... loop ! Until we don't find CR on a line if mark(none) = end_of (current_buffer) then copy_text (first_line); exitif 1; endif; the_range := search ( (anchor & scan(" ")), forward); if the_range <> 0 then ! Found CR in line position (end_of(the_range)); move_horizontal (1); erase_character (1); ! Get rid of CR move_horizontal (-current_offset); the_range := index (current_line, first_line); if the_range = 0 then ! First line didn't match copy_text (first_line + " "); ! Put it back in split_line; ! and pick up a new first line ! else ! Found a substring match. Pick up new line endif; exitif mark(none) = end_of (current_buffer); wpe_get_fix_line (first_line, right_end, left_end); else ! Didn't find CR on line if length (current_line) <> 0 then the_range := index (current_line, first_line); else the_range := 0; endif; if the_range = 0 then ! First line didn't match copy_text (first_line + " "); ! Put it back in split_line; exitif 1; ! Go out to main loop else ! First line did match if (not bold_requested) then ! Prompt once only. ! Put it in so we can see it copy_text (first_line); ! Put it back in split_line; update (current_window); question_answer := eve$insist_y_n ("Overstruck lines exist in this file. " + "Insert BOLD codes? [Yes] "); bold_requested := TRUE; ! update (EVE$PROMPT_WINDOW); if question_answer then bolding := TRUE; else bolding := FALSE; endif; ! Take out the line we put in. move_vertical (-1); erase_line; update (current_window); endif; move_horizontal (right_end); if bolding then copy_text (bold_off); move_horizontal (- current_offset); move_horizontal (left_end); copy_text (bold_on); endif; exitif 1; ! Out to main loop endif; endif; endloop; endif; else ! Current_offset = 0, therefore null line. erase(the_range); endif; endloop; eve$clear_message; ! Clear message space set (this_mode, wpe$x_fix_buffer); ! fix_buffer same mode as original eve$update_status_lines; position (beginning_of(current_buffer)); set (success,on); return (TRUE); endprocedure; ! eve_fix_mem !<><><><><><><><><><><><> ! Support procedure for eve_fix_mem ! ! procedure wpe_get_fix_line (first_line, right_end, left_end) first_line := current_line; if length(first_line) > 0 then edit (first_line, trim_trailing, off); right_end := length (first_line); move_horizontal (-current_offset); loop exitif index (eve$kt_whitespace, current_character) = 0; exitif current_offset >= length(current_line); move_horizontal (1); endloop; left_end := current_offset; if left_end > right_end then left_end := right_end; endif; move_horizontal (-current_offset); erase_line; else right_end := 0; left_end := 0; endif; return (TRUE); endprocedure; ! wpe_get_fix_line !<><><><><><><><><><><><> ! ! Translate EBCDIC to ASCII ! procedure eve_etoa if eve$x_select_position <> 0 then ! Select range active if get_info (eve$x_select_position, eve$kt_buffer) <> current_buffer then eve$message ("ETOA must be used in " + "the same buffer as Select.", eve$k_warning); return; else translate (select_range, wpe$etoa_replacements, wpe$all_characters); !%IF eve$x_option_w$pe_at_least_eve_2_2 !%THEN eve$clear_select_position; !%ELSE !% eve$x_select_position := 0; !%ENDIF; endif; else !No select range translate (current_buffer, wpe$etoa_replacements, wpe$all_characters); endif; endprocedure; ! eve_etoa !<><><><><><><><><><><><> ! Translate ASCII to EBCDIC ! procedure eve_atoe if eve$x_select_position <> 0 then ! Select range active if get_info (eve$x_select_position, eve$kt_buffer) <> current_buffer then eve$message ("ATOE must be used in " + "the same buffer as Select.", eve$k_warning); return; else translate (select_range, wpe$atoe_replacements, wpe$all_characters); !%IF eve$x_option_w$pe_at_least_eve_2_2 !%THEN eve$clear_select_position; !%ELSE !% eve$x_select_position := 0; !%ENDIF; endif; else !No select range translate (current_buffer, wpe$atoe_replacements, wpe$all_characters); endif; endprocedure; ! eve_atoe !<><><><><><><><><><><><> ! ! Correct deficiency in EVE - no builtins for trimming procedure eve_set_trimming eve$x_trimming := TRUE; message ("WPE will trim buffers before writing."); endprocedure; ! eve_set_trimming !<><><><><><><><><><><><> ! ! Correct deficiency in EVE - no builtins for trimming procedure eve_set_notrimming eve$x_trimming := FALSE; message ("WPE will not trim buffers before writing."); endprocedure; ! eve_set_notrimming ! ! +-----------------------------------------+ ! |-- Modules which replace EVE functions --| ! +-----------------------------------------+ ! !<><><><><><><><><><><><> ! ! NOTE: This module is present in EVE T2.2 - and is only needed for ! WPE if EVE is less than 2.2. It is ONLY compiled if EVE is less ! than T2.2. It makes WPE work the same when F19 is pressed. !%IF eve$x_option_w$pe_at_least_eve_2_2 !%THEN !%ELSE !% !%procedure eve_next_buffer ! Buffer indicator = Next buffer !% !%local the_current_buffer, !% the_next_buffer; !% !% ! Point to the current buffer in the buffer list, then switch to the first !% ! non-system buffer after that. If we get to the last buffer in the list, !% ! circle around to the first one. Quit if we get back to our starting !% ! point. !% !%the_current_buffer := get_info (BUFFERS, "current"); !%loop !% the_next_buffer := get_info (BUFFERS, "next"); !% if the_next_buffer = the_current_buffer !% then !%IF eve$x_at_least_tpu_2_2 !%THEN eve$message (EVE$_NOOTHERBUFFERS); !%ELSE !% eve$message ("No other non-system buffers.", eve$k_warning); !%ENDIF; !% return (FALSE); !% endif; !% if the_next_buffer = 0 !% then !% the_next_buffer := get_info (BUFFERS, "first"); !% endif; !% if not get_info (the_next_buffer, "system") !% then !% eve_buffer (get_info (the_next_buffer, "name")); !% return (TRUE); !% endif; !%endloop; !% !%endprocedure; ! eve_next_buffer !%ENDIF ! !<><><><><><><><><><><><> ! ! NOTE: This module pre-processes EVE_NEXT_WINDOW, which works ! correctly for the CHOICE sequence in EVE T2.2 ! It is ONLY compiled if EVE is less than T2.2. ! The behavior is not terribly useful with EVE T2.0, but it does ! correct a problem where F19 went to another window, but wouldn't come ! back. The feature is useful in T2.2, because SELect works in CHOICES. !%IF eve$x_option_w$pe_at_least_eve_2_2 !%THEN !%ELSE !% !%procedure eve_other_window ! Preprocess NEXT_WINDOW for EVE T2.0 !% !%local next_window; ! next window !% !%on_error !% [TPU$_CONTROLC]: !% eve_next_window; !% eve$learn_abort; !% abort; !% [TPU$_NOTARRAY]: !% if eve$eve_in_control !% then !% eve$message (error_text, error); !% endif; !% eve$learn_abort; !% return (0); !% [OTHERWISE]: !%endon_error; !% !% if get_info (eve$choice_window, "buffer") <> 0 !% then !% if current_window = eve$command_window !% then !% position (eve$choice_window); !% return (TRUE); !% else !% if current_window = eve$choice_window !% then !% position (eve$command_window); !% return (TRUE); !% endif; !% endif; !% endif; !% !%eve_next_window; !% !%return (TRUE); !% !%endprocedure; ! eve_other_window !%ENDIF !<><><><><><><><><><><><> procedure wpe$wps_paginate ! GOLD/PAGE - paginate ! Originally eve$wps_paginate from eve$wps.tpu ! Modified so that page length can be changed. ! Constant eve$$x_page_size changed to variable wpe$$x_page_size ! Also fixed a "bug" which caused the first page to be 1 line too long. ! Changed to insert the page marker at the start of an existing line, rather ! than creating a new line. A new line creates problems when printing, ! as an empty line is at the top of every page after page 1. local start_page, end_page, first_page, ! Addition for bug fix saved_left_margin, already_there, the_page_break, hard_range, soft_range; ! MODIFICATION !constant eve$$x_page_size := ! 54; ! May become global constant or variable ! Constant eve$$x_page_size changed to variable wpe$$x_page_size on_error [TPU$_CONTROLC]: if saved_left_margin <> 0 then set (LEFT_MARGIN, current_buffer, saved_left_margin); endif; eve$learn_abort; abort; [TPU$_ENDOFBUF, TPU$_BEGOFBUF]: [OTHERWISE]: if saved_left_margin <> 0 then set (LEFT_MARGIN, current_buffer, saved_left_margin); endif; endon_error; !%IF eve$x_option_w$pe_at_least_eve_2_2 !%THEN eve$$x_state_array {eve$$k_wps_upper_case} := FALSE; eve$$x_state_array {eve$$k_wps_lower_case} := FALSE; !%ELSE eve$$x_wps_upper_case := FALSE; eve$$x_wps_lower_case := FALSE; !%ENDIF eve$wps_set_direction (FORWARD); !*** WPS does this, DPE doesn't--WPS+? if not eve$test_if_modifiable (current_buffer) then eve$learn_abort; return (FALSE); endif; start_page := search_quietly ((LINE_BEGIN + (ascii (12) + (ascii (0) | "")) + LINE_END) | (ascii (12) + (ascii (0) | "")), REVERSE, EXACT); ! If maintaining "separate line" behavior, uncomment the first_page lines. if start_page = 0 then start_page := beginning_of (current_buffer); ! first_page := TRUE; ! for bug fix else ! first_page := FALSE; ! for bug fix endif; position (start_page); ! MODIFICATION ! If maintaining "separate line" behavior, comment out the next line and ! uncomment the if/endif structure. move_vertical (wpe$$x_page_size); !if first_page then ! for bug fix ! move_vertical (wpe$$x_page_size); ! originally just this line !else ! move_vertical (wpe$$x_page_size +1); !endif; ! for bug fix position (LINE_BEGIN); already_there := (search_quietly (ANCHOR + PAGE_BREAK, FORWARD, EXACT) <> 0); move_horizontal (-1); end_page := mark (NONE); position (start_page); loop move_horizontal (1); the_page_break := search_quietly ((LINE_BEGIN + ((ascii (12) + ascii (0) @ soft_range) | (ascii (12) @ hard_range)) + LINE_END) | ((ascii (12) + ascii (0) @ soft_range) | (ascii (12) @ hard_range)), FORWARD, NO_EXACT, create_range (mark (NONE), end_page, NONE)); exitif the_page_break = 0; if get_info (hard_range, "type") = RANGE then ! Found an intervening hard FF position (beginning_of (the_page_break)); move_horizontal (-1); end_page := mark (NONE); already_there := TRUE; exitif 1; else ! Found a soft one if the_page_break <> soft_range then ! Soft FF on a line by itself position (end_page); move_vertical (1); position (LINE_END); end_page := mark (NONE); position (the_page_break); endif; erase (the_page_break); endif; endloop; position (end_page); move_horizontal (1); if mark (NONE) <> end_of (current_buffer) then if not already_there then saved_left_margin := get_info (current_buffer, "left_margin"); set (LEFT_MARGIN, current_buffer, 1); ! The 5 modifications/additions below put the Page Marker at the start of a ! line, rather than on a separate line. ! split_line; ! Mod (Comment) ! move_horizontal (-1); ! Mod (Comment) eve$insert_text (ascii (12) + ascii (0)); ! move_horizontal (1); ! Mod (Comment) move_horizontal (-2); ! Added move_vertical (1); ! Added set (LEFT_MARGIN, current_buffer, saved_left_margin); else position (LINE_END); move_horizontal (1); endif; endif; eve$position_in_middle (mark (NONE)); return (TRUE); endprocedure; ! wpe$wps_paginate !<><><><><><><><><><><><> procedure wpe_insert_page_break ! Insert a page break ! Modified from EVE$CORE.TPU procedure eve_insert_page_break ! Changed to put FF at the beginning of an existing line. ! NOTE: This procedure is similar to wpe$wps_page_marker, except that ! it just inserts FF instead of FF-NL. on_error [TPU$_NOEOBSTR]: ! prevent current_character error at EOB [OTHERWISE]: endon_error; if not eve$test_if_modifiable (current_buffer) then eve$learn_abort; return (FALSE); endif; if eve$in_prompting_window then copy_text (ascii (12)); !%IF eve$x_option_evej !%THEN !% eve$conversion_start; !%ENDIF return (TRUE); endif; if current_offset <> 0 then split_line; endif; if current_character = "" then copy_text (ascii (12)); move_horizontal (1); else eve$insert_text (ascii (12)); ! split_line; !Mod to put FF at the start of an existing line. endif; !%IF eve$x_option_evej !%THEN !% eve$conversion_start; !%ENDIF return (TRUE); endprocedure ! wpe_insert_page_break !<><><><><><><><><><><><> procedure wpe$wps_page_marker ! Page marker (GOLD/P) soft FF ! Modified from EVE$WPS.TPU procedure eve$wps_page_marker ! Changed to put FF-NL at the beginning of an existing line. ! NOTE: This procedure is similar to wpe_insert_page_break, except that ! it inserts FF-NL instead of just FF. on_error [TPU$_NOEOBSTR]: ! prevent current_character error at EOB [OTHERWISE]: endon_error; if not eve$test_if_modifiable (current_buffer) then eve$learn_abort; return (FALSE); endif; if eve$in_prompting_window then copy_text (ascii (12) + ascii (0)); !%IF eve$x_option_evej !%THEN !% eve$conversion_start; !%ENDIF return (TRUE); endif; if current_offset <> 0 then split_line; endif; if current_character = "" then copy_text (ascii (12) + ascii (0)); move_horizontal (1); else eve$insert_text (ascii (12) + ascii (0)); ! split_line; !Mod to put FF-NL at the start of an existing line. endif; !%IF eve$x_option_evej !%THEN !% eve$conversion_start; !%ENDIF return (TRUE); endprocedure; ! wpe$wps_page_marker !<><><><><><><><><><><><> procedure wpe_eve$file_module_init_replace ! MORE/MAIL Module Init ! modified from EVE$FILE.TPU module eve$file_module_init ! EVE T2.2 - TPU V2.2 - VMS V5.1 ! ! modifications are delimited by: ! !*** START WPE MOD *** ! !*** END WPE MOD *** local line_editing_mode, ! Line editing mode of terminal output_file_name, ! Original output file name parsed_output_file_name,! Full filespec for output file input_file_name_only, ! No node, disk, directory, or version temp, ! Temporary for a get_info return temp_file_name, ! Temporary for get_file file_count, ! Counts files found by file_search file_search_result, ! File_search result opening_outfile, ! True when we get to the output file input_file, ! Input file spec from command line input_error, ! True if can't parse/find input file name output_error, ! True if can't parse/find output file name get_file_error, ! True if can't do GET FILE on input file name saved_window, ! Save current buffer facility, ! For prompt_line key test legend, ! For prompt_line key test topic, ! For prompt_line key test is_wildcard, ! For wildcard output file journal_file; ! Journal file spec from command line on_error [TPU$_SEARCHFAIL]: if opening_outfile = 0 then ! error searching for input file input_error := TRUE; eve$message (EVE$_NOSUCHFILE, eve$k_warning, input_file); else ! error in finding output file output_error := TRUE; endif; [TPU$_TRUNCATE]: eve$message (error_text, error); [OTHERWISE]: eve$$restore_position (saved_window); endon_error; !*** START WPE MOD *** input_error := FALSE; get_file_error := FALSE; ! assume we can get file. if wpe$x_is_a_mail_editor then ! We know we're doing mail, and the output file name is xxxMAIL_pid_SEND.TMP ! If the input filename is xxxMAIL_pid_EDIT.TMP then we're doing a reply. ! Otherwise, we're not. ! NOTE: Due to lack of information from the MAIL program, we can not have ! the symbol MAIL :== MAIL/EDIT=(SEND,REPLY=EXTRACT,FORWARD) - because ! both reply=extract and forward send us a _EDIT.TMP file. We choose to ! handle (SEND,REPLY=EXTRACT), and to create two windows in the ! reply=extract case; one for viewing the original, and one for creating ! the reply. ! ! It would be equally possible to handle (SEND,REPLY,FORWARD) - note, ! without the =extract qualifier - by, in the case of FORWARD, using the ! standard mechanism with one window to read the input (forward) file ! into the buffer. Code changes would be required in this procedure, and ! all procedures depending on wpe$x_mail_answer would not be needed. temp_file_name := substr(wpe_output_filename, 1, wpe$x_send_index-1) + "_EDIT.TMP"; if temp_file_name = wpe_input_filename then wpe$x_mail_answer := TRUE; else wpe$x_mail_answer := FALSE; endif; endif; ! wpe$x_is_a_mail_editor !*** END WPE MOD *** eve$x_read_only := message_text (EVE$_READ_ONLY, 1); !%IF eve$x_at_least_tpu_2_2 !%THEN eve$x_nowrite := message_text (EVE$_NOWRITE, 1); eve$x_write := message_text (EVE$_WRITE, 1); !%ELSE !% eve$x_nowrite := "Nowrite"; !% eve$x_write := "Write"; !%ENDIF; eve$x_max_buffer_name_length := 43;! Buffer names can be any size, but this is ! the largest size that will be shown on ! the status line without being truncated eve$$x_right_action_program := 0; ! default action routine (no left) eve$arg1_buffer := "string"; ! leave in for V1 compatibility ! (EVE assigned to this variable ! so users probably did too) eve$arg1_set_width := "integer"; eve$arg1_shift_left := "integer"; eve$arg1_shift_right := "integer"; eve$pattern_trim := span (" " + ascii (9)) + LINE_END; ! Used for trimming buffer ! create the mark array, index = mark name (string), element = marker eve$$x_mark_array := create_array (); ! Create all the necessary default buffers ! Create a main buffer !*** START WPE MOD *** if wpe$x_is_a_mail_editor then if wpe$x_mail_answer then wpe$x_mail_create_buffer := create_buffer ("Create Reply to Send"); set (EOB_TEXT, wpe$x_mail_create_buffer, "[End of Reply]"); else wpe$x_mail_create_buffer := create_buffer ("Create Mail Message to Send"); set (EOB_TEXT, wpe$x_mail_create_buffer, "[End of Created Memo]"); endif; ! The following is done later ! set (OUTPUT_FILE, wpe$x_mail_create_buffer, wpe_output_filename); main_buffer := wpe$x_mail_create_buffer; else ! The following two lines are not modified from the prototype main_buffer := create_buffer ("Main"); set (EOB_TEXT, main_buffer, message_text (EVE$_EOBTEXT, 1)); endif; ! wpe$x_is_a_mail_editor !*** END WPE MOD *** set (LEFT_MARGIN, main_buffer, eve$x_default_left_margin); if get_info (COMMAND_LINE, "display") then set (RIGHT_MARGIN, main_buffer, (get_info (eve$main_window, "width") - eve$x_default_right_margin)); set (RIGHT_MARGIN_ACTION, main_buffer, eve$kt_word_wrap_routine); endif; if get_info (eve$main_window, "type") = WINDOW then map (eve$main_window, main_buffer); endif; ! Command buffer eve$command_buffer := eve$init_buffer ("Commands", ""); set (PERMANENT, eve$command_buffer); set (KEY_MAP_LIST, eve$x_command_key_map_list, eve$command_buffer); line_editing_mode := get_info (SCREEN, "line_editing"); if line_editing_mode <> 0 then set (line_editing_mode, eve$command_buffer); else set (OVERSTRIKE, eve$command_buffer);! for VMS V4 line-editing compatibility endif; set (REVERSE, eve$command_buffer); ! for VMS V4 line-editing compatibility if get_info (eve$command_window, "type") = WINDOW then map (eve$command_window, eve$command_buffer); endif; ! Prompt buffer eve$prompt_buffer := eve$init_buffer ("$Prompts$", ""); if get_info (eve$prompt_window, "type") = WINDOW then set (VIDEO, eve$prompt_window, REVERSE); endif; ! Message buffer--mapped to the message window ! ! No message buffer if /NODISPLAY if get_info (COMMAND_LINE, 'display') then tpu$x_message_buffer := eve$init_buffer ("Messages", ""); set (PERMANENT, tpu$x_message_buffer); if message_window <> 0 then map (message_window, tpu$x_message_buffer); eve$clear_message; ! remove /COMMAND file-read message endif; ! output to sys$output endif; ! Misc buffers tpu$x_show_buffer := eve$init_buffer ("Show", ""); ! Buffer used by parser to display choices when a name is ambiguous eve$choice_buffer := eve$init_buffer ("$Choices$", ""); set (PERMANENT, eve$choice_buffer); ! Create the matches buffer for use by the parser eve$match_buffer := eve$init_buffer ("$Matches$", ""); set (PERMANENT, eve$match_buffer); ! Buffer used by prompt_line, to get the previous reply eve$recall_line_buffer := eve$init_buffer ("$RECALL_LINE$", ""); set (PERMANENT, eve$recall_line_buffer); ! Now do the paste buffer paste_buffer := eve$init_buffer ("Insert Here", message_text (EVE$_PASTEEOBTEXT, 1)); ! Give these buffer variables a value so we can delay their creation until ! they're needed. Otherwise, EVE$ERASE_TEXT can't distinguish between ! buffers (passed as a argument) that aren't created yet (they're = ! unspecified). eve$restore_buffer := 0; eve$x_char_buffer := eve$init_buffer ("$Restore$Char$", ""); eve$x_word_buffer := 2; eve$x_line_buffer := 3; eve$x_sentence_buffer := 4; ! Create a buffer using get_file !*** START WPE MOD *** ! WAS---> input_file := get_info (COMMAND_LINE, "file_name"); if wpe$x_is_a_mail_editor then input_file := wpe_input_filename; else wpe_fill_file_list; if wpe_file_count > 0 then input_file := wpe_file_list {1}; else input_file := "" endif; endif; ! wpe$x_is_a_mail_editor !*** END WPE MOD *** if get_info (eve$main_window, "type") = WINDOW then position (eve$main_window); ! Assume eve$$init_buffer had left us if input_file = "" ! in last buffer created. then eve$set_status_line (current_window); else ! Simulate an EVE_GET_FILE on the input_file (to insure that when ! we do call it, we'll have a valid filespec): loop ! Protect against earlier file_search with same file name. eve$reset_file_search; erase (eve$choice_buffer); temp_file_name := ""; file_count := 0; loop file_search_result := eve$$file_search (input_file); if file_search_result = 0 then input_error := TRUE; file_search_result := ""; endif; exitif file_search_result = ""; file_count := file_count + 1; eve$add_choice (file_search_result); temp_file_name := file_search_result; endloop; if file_count > 1 then eve$message (EVE$_AMBFILE, eve$k_warning, input_file); !%IF eve$x_option_decwindows !%THEN ! Ignore eve$$x_state_array {eve$$k_dialog_box} here, ! we have to put up the box to disambiguate the filename. if eve$x_decwindows_active then eve$x_open_file_selection := create_widget ("OPEN_FILE_SELECTION", eve$x_widget_hierarchy, SCREEN, eve$kt_callback_routine); set (WIDGET, eve$x_open_file_selection, eve$dwt$c_ndirmask, input_file); manage_widget (eve$x_open_file_selection); temp_file_name := ""; exitif; endif; !%ENDIF ! If get_file is called from eve$init_procedure, we must handle ! the ambiguity here so that /COMMAND and /INIT files (that ! occur after eve$init_procedure) can be applied to the user's ! file. ! Simulate eve$display_choices: saved_window := current_window; position (beginning_of (eve$choice_buffer)); eve$format_choices; position (beginning_of (eve$choice_buffer)); eve$map_choices; loop temp_file_name := eve$prompt_line (message_text (EVE$_UNAMBFILEPROMPT, 1), eve$$x_prompt_terminators, input_file); if temp_file_name = 0 then temp_file_name := ""; exitif; endif; ! Allow NEXT/PREV SCREEN in choice buffer eve$$parse_comment (last_key, eve$current_key_map_list, facility, legend, topic); if (eve$test_synonym ("next_screen", topic)) or (eve$on_a_pre_lk201 and (eve$test_synonym ("move_down", topic))) then eve$move_by_screen (1); else if (eve$test_synonym ("previous_screen", topic)) or (eve$on_a_pre_lk201 and (eve$test_synonym ("move_up", topic))) then eve$move_by_screen (-1); else exitif; endif; endif; endloop; ! end of looping on NEXT/PREV SCREEN in choices position (saved_window); eve$unmap_if_mapped (eve$choice_window); eve$clear_message; ! end of simulating eve$display_choices else exitif; ! file_count = 0 or 1 endif; if temp_file_name = "" then eve$set_status_line (current_window); ! MAIN status line exitif; endif; input_file := temp_file_name; ! loop until get 1 file or "" endloop; if temp_file_name = "" ! No file spec? then if (input_error = 0) and ! User didn't reply with bogus file spec (file_count = 0) ! & user didn't erase ambiguous spec. then if eve$is_wildcard (input_file) then eve$message (EVE$_NOFILMATCH, eve$k_warning, input_file); else ! No file exists, get_file will temp_file_name := input_file;! make buffer = bogus file name endif; endif; endif; ! end of EVE_GET_FILE simulation if temp_file_name <> "" then ! make it look like we executed a GET FILE position (beginning_of (eve$command_buffer)); copy_text (eve$x_command_prompt + "get file " + input_file); position (end_of (eve$command_buffer)); !*** START WPE MOD *** if wpe$x_is_a_mail_editor then if wpe$x_mail_answer then wpe$x_answer_buffer_name := "Answering this Mail Memo"; wpe$x_mail_answer_buffer := create_buffer (wpe$x_answer_buffer_name, temp_file_name); set (EOB_TEXT, wpe$x_mail_answer_buffer, "[End of memo being answered]"); set (NO_WRITE, wpe$x_mail_answer_buffer); position (wpe$x_mail_create_buffer); else ! This is "send filename" - so pre-fill create buffer. position (wpe$x_mail_create_buffer); erase (wpe$x_mail_create_buffer); read_file (temp_file_name); endif; else !--WAS if not eve_get_file (temp_file_name) ! now a real GET FILE... if not wpe_get_file (temp_file_name) ! now a real GET FILE... then position (main_buffer); get_file_error := TRUE; ! prevent qualifiers endif; endif; ! wpe$x_is_a_mail_editor else if wpe$x_is_a_mail_editor then position (wpe$x_mail_create_buffer); erase (wpe$x_mail_create_buffer); set (MODIFIED, current_buffer, OFF); endif; ! wpe$x_is_a_mail_editor !*** END WPE MOD *** eve$set_status_line (current_window); ! MAIN... endif; if (current_buffer <> main_buffer) and (current_window = eve$main_window) then delete (main_buffer); ! Position to the location specified by /START_POSITION ! in the command line, defaulting to 1,1. position (beginning_of (current_buffer)); temp := get_info (COMMAND_LINE, 'start_record'); if temp < 0 then message (EVE$_BADSTARTREC); else if temp > get_info (current_buffer, "record_count") then position (end_of (current_buffer)); else if temp <> 0 then move_vertical (temp - 1); endif; endif; endif; temp := get_info (COMMAND_LINE, 'start_character'); if (temp < 0) then message (EVE$_BADSTARTCHAR); else if mark (NONE) <> end_of (current_buffer) then if temp > length (current_line) then move_horizontal (length (current_line)); else if temp <> 0 then move_horizontal (temp - 1); endif; endif; endif; endif; endif; endif; else if input_file <> "" then input_file := file_parse (input_file); if input_file <> "" then input_file := eve$$file_search (input_file); if input_file = 0 then input_error := TRUE; input_file := ""; endif; if input_file <> "" then delete (main_buffer); main_buffer := create_buffer ("Main", input_file); set (LEFT_MARGIN, main_buffer, eve$x_default_left_margin); if get_info (COMMAND_LINE, "display") then set (RIGHT_MARGIN, main_buffer, (get_info (eve$main_window, "width") - eve$x_default_right_margin)); set (RIGHT_MARGIN_ACTION, main_buffer, eve$kt_word_wrap_routine); endif; endif; endif; endif; position (main_buffer); endif; ! Process the qualifiers (/NOCREATE was processed by EVE_GET_FILE call above) ! if no errors on the input file if (not get_file_error) and (not input_error) then !*** START WPE MOD *** ! No qualifiers that are appropriate to mail are used here if NOT wpe$x_is_a_mail_editor then ! /NOOUTPUT implies NO_WRITE to ON for the buffer. if not get_info (COMMAND_LINE, "output") then set (NO_WRITE, current_buffer, ON); endif; ! /READ_ONLY implies NO_WRITE to ON and MODIFIABLE to OFF for the buffer. if get_info (COMMAND_LINE, "read_only") then set (NO_WRITE, current_buffer, ON); set (MODIFIABLE, current_buffer, OFF); endif; ! /WRITE implies NO_WRITE to OFF and MODIFIABLE to ON for the buffer. if get_info (COMMAND_LINE, "write") then set (NO_WRITE, current_buffer, OFF); set (MODIFIABLE, current_buffer, ON); endif; ! /MODIFY implies MODIFIABLE to ON for the buffer. if get_info (COMMAND_LINE, "modify") then set (MODIFIABLE, current_buffer, ON); endif; ! /NOMODIFY implies MODIFIABLE to OFF for the buffer. if get_info (COMMAND_LINE, "nomodify") then set (MODIFIABLE, current_buffer, OFF); endif; ! Abort the editing session if the user specified an output file, ! but also set the buffer NO_WRITE. if (get_info (current_buffer, "no_write")) and (get_info (COMMAND_LINE, "output_file") <> "") then if get_info (COMMAND_LINE, "read_only") then eve$message (EVE$_ILLQUALCOMB, eve$k_warning, "/OUTPUT=filespec", "/READ_ONLY"); else eve$message (EVE$_ILLQUALCOMB, eve$k_warning, "/OUTPUT=filespec", "/NOWRITE"); endif; exit; endif; endif; ! NOT wpe$x_is_a_mail_editor !*** END WPE MOD *** ! The output file should be written to the current directory by default ! unless there is another directory specified in the output_file_name. ! We also DON'T want the node, device or directory of the input file, just ! the name. opening_outfile := TRUE; if not get_info (current_buffer, "no_write") then output_file_name := get_info (COMMAND_LINE, "output_file"); if output_file_name <> "" then if (input_error = 0) then input_file_name_only := file_parse (input_file, "", "", NAME, TYPE); else input_file_name_only := ""; endif; parsed_output_file_name := file_parse (output_file_name, input_file_name_only); if parsed_output_file_name <> "" then if eve$is_wildcard (parsed_output_file_name) then ! Don't call eve$popup_message during initialization eve$message (EVE$_CANTCREATE, eve$k_warning, parsed_output_file_name); is_wildcard := TRUE; else temp := parsed_output_file_name; parsed_output_file_name := eve$$file_search (temp); if parsed_output_file_name = 0 then output_error := TRUE; endif; if not output_error then set (OUTPUT_FILE, current_buffer, temp); endif; endif; else temp := output_file_name; output_file_name := eve$$file_search (output_file_name); if output_file_name = 0 then output_error := TRUE; endif; if not output_error then set (OUTPUT_FILE, current_buffer, temp); endif; endif; if (not is_wildcard) and (get_info (current_buffer, "modifiable")) and (not output_error) then ! Want this buffer to be considered modified so it will ! be written on exit - for use especially with mail/edit !*** START WPE MOD *** ! Don't do this for WPE in mail mode if NOT wpe$x_is_a_mail_editor then split_line; append_line; endif; ! NOT wpe$x_is_a_mail_editor !*** END WPE MOD *** endif; endif; endif; endif; ! Show any new buffer settings just set. if get_info (COMMAND_LINE, "display") then eve$set_status_line (current_window); endif; ! The following can be overwritten by the user /COMMAND or ! /INITIALIZATION files to specify the buffer whose attributes are ! copied to the default buffer in procedure TPU$INIT_POSTPROCEDURE. eve$x_source_for_default_buffer := current_buffer; ! Start journalling. Try to use journal file name, then input file name, ! then output file, and finally "TPU.TJL". !*** START WPE MOD *** ! NO JOURNALING IN WPE MAIL - ENTIRE SECTION DELETED - NO MODS ! The reason for no journaling is that we can't figure out how to get ! MAIL to set the /RECOVER switch. Without being able to set this ! switch, we can't do anything with a mail journal file - so it's useless ! to create one. If we could figure out how to turn off the "is not ! being journaled" message, we would do that, too! !-- if NOT wpe$x_is_a_mail_editor then if (get_info (COMMAND_LINE, "journal") = 1) then journal_file := get_info (COMMAND_LINE, "journal_file"); input_file_name_only := file_parse (get_info (current_buffer, "file_name"), "", "", NAME); if input_file_name_only = "" then temp := get_info (current_buffer, "output_file"); if temp <> 0 then input_file_name_only := file_parse (temp, "", "", NAME); endif; endif; if input_file_name_only = "" then input_file_name_only := "tpu.tjl"; else input_file_name_only := input_file_name_only + ".tjl"; endif; journal_file := file_parse (journal_file, input_file_name_only); if not eve$$journal_open (journal_file) then eve$test_default_directory; endif; endif; endif; ! NOT wpe$x_is_a_mail_editor !*** END WPE MOD *** !*** START WPE MOD *** ! EVE T2.0 does not have an eve$define_indicator procedure !%IF eve$x_option_w$pe_at_least_eve_2_2 !%THEN eve$define_indicator ("eve_next_buffer", "Buffer", "next_buffer"); eve$define_indicator ("eve_set_buffer('read_only')", "write", "set_buffer (set_buffer ""read_only"")"); eve$define_indicator ("eve_set_buffer('write')", "read-only", "set_buffer (set_buffer ""write"")"); eve$define_indicator ("eve_set_buffer('modifiable')", "unmodifiable", "set_buffer (set_buffer ""modifiable"")"); !%ENDIF !*** END WPE MOD *** endprocedure; ! wpe_eve$file_module_init_replace ! ======================================================================== ! -- Executables for Build Phase -- ! Global string constants ! WPE help topics ! NOTE: The maximum length of a help topic is 15 characters. This limits ! the text that can appear on the right side of these statements and ! therefore limits the name of the constant. ! constant eve$kt_topic_wpe_application := "application"; constant eve$kt_topic_wpe_atoe := "atoe"; constant eve$kt_topic_wpe_buffer := "buffer"; constant eve$kt_topic_wpe_change_width := "change_width"; constant eve$kt_topic_wpe_ctlength := "ctlength"; constant eve$kt_topic_wpe_ctrl_commands := "ctrl_commands"; constant eve$kt_topic_wpe_delete_line := "delete_line"; constant eve$kt_topic_wpe_delete_to_eol := "delete_to_eol"; constant eve$kt_topic_wpe_differences := "differences"; constant eve$kt_topic_wpe_display_char := "display_char"; constant eve$kt_topic_wpe_edt_keypad := "edt_keypad"; constant eve$kt_topic_wpe_escape := "escape"; constant eve$kt_topic_wpe_etoa := "etoa"; constant eve$kt_topic_wpe_find_matching := "find_matching"; constant eve$kt_topic_wpe_fix := "fix"; constant eve$kt_topic_wpe_function_keys := "function_keys"; constant eve$kt_topic_wpe_get_file := "get_file"; constant eve$kt_topic_wpe_go_to := "go_to"; constant eve$kt_topic_wpe_gold_keys := "gold_keys"; constant eve$kt_topic_wpe_gold_return := "gold_return"; constant eve$kt_topic_wpe_help := "help"; constant eve$kt_topic_wpe_include_file := "include_file"; constant eve$kt_topic_wpe_mark := "mark"; constant eve$kt_topic_wpe_mail_editing := "mail_editing"; constant eve$kt_topic_wpe_new_features := "new_features"; constant eve$kt_topic_wpe_new_page := "new_page"; constant eve$kt_topic_wpe_notabs := "notabs"; constant eve$kt_topic_wpe_not_implemented := "not_implemented"; constant eve$kt_topic_wpe_numeric := "numeric"; constant eve$kt_topic_wpe_one_window := "one_window"; constant eve$kt_topic_wpe_other_window := "other_window"; constant eve$kt_topic_wpe_page_marker := "page_marker"; constant eve$kt_topic_wpe_paginate := "paginate"; constant eve$kt_topic_wpe_paragraph := "paragraph"; constant eve$kt_topic_wpe_print_trans := "print_trans"; constant eve$kt_topic_wpe_print_untrans := "print_untrans"; constant eve$kt_topic_wpe_quote := "quote"; constant eve$kt_topic_wpe_return := "return"; constant eve$kt_topic_wpe_return_to_edit := "return_to_edit"; constant eve$kt_topic_wpe_select_buffer := "select_buffer"; constant eve$kt_topic_wpe_set_keypad_app := "set_keypad_app"; constant eve$kt_topic_wpe_set_keypad_edt := "set_keypad_edt"; constant eve$kt_topic_wpe_set_keypad_edw := "set_keypad_edw"; constant eve$kt_topic_wpe_set_key_noedt := "set_key_noedt"; constant eve$kt_topic_wpe_set_key_noedw := "set_key_noedw"; constant eve$kt_topic_wpe_set_key_nonum := "set_key_nonum"; constant eve$kt_topic_wpe_set_key_nowps := "set_key_nowps"; constant eve$kt_topic_wpe_set_keypad_num := "set_keypad_num"; constant eve$kt_topic_wpe_set_keypad_wpe := "set_keypad_wpe"; constant eve$kt_topic_wpe_set_keypad_wps := "set_keypad_wps"; constant eve$kt_topic_wpe_set_page_length := "set_page_length"; constant eve$kt_topic_wpe_shift_left := "shift_left"; constant eve$kt_topic_wpe_shift_right := "shift_right"; constant eve$kt_topic_wpe_signature := "signature"; constant eve$kt_topic_wpe_special_comds := "special_comds"; constant eve$kt_topic_wpe_token := "token"; constant eve$kt_topic_wpe_two_windows := "two_windows"; constant eve$kt_topic_wpe_vt100_commands := "vt100_commands"; constant eve$kt_topic_wpe_view := "view"; constant eve$kt_topic_wpe_wps_differences := "wps_differences"; constant eve$kt_topic_wpe_write_file := "write_file"; !constant eve$kt_topic_wpe_ := ""; constant wpe$all_characters := '  !"#$%&' + "'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOP" + 'QRSTUVWXYZ[\]^_`abcdefghijklmnopqrstuvwxyz' + '{|}~' + '' + '' + ''; constant wpe$atoe_replacements := "./% <=?'@O{[lP}M" + ']\Nk`Kaz^L~no|' + 'JZ_my' + 'jС !"#$()*+, 01345689:;>ABC' + 'DEFGHIQRSTUVWXYbcdefghipqrstuvwx' + '' + ''; constant wpe$etoa_replacements := '  ' + '  [.<' + '(+!&]$*);^-/|,%_>?' + "`:#@'=" + '"abcdefghijklmnopqr~stuvwx' + 'yz{ABCDEFGHI}' + 'JKLMNOPQR\STUVWXYZ0123456789' + ''; ! Execute the build procedures eve$set_wps_keypad; wpe_init_keyboard; ! Define keymaps and keys ! Arrange to NOT save DEBUG parameters eve$$x_save_names := -1; !%IF eve$x_option_w$pe_is_edw !%THEN wpe$x_edw_keys_on := FALSE; ! Define it so set will work eve_set_keypad_edt; !%ELSE !%ENDIF