! EDTSCNSEC.TPU ! ! Author: David W. Deley ! General Research Corporation ! P.O. Box 6770 ! 5383 Hollister Avenue ! Santa Barbara, CA 93160-6770 ! ! Phone: (805)964-7724 ! FAX: (805)967-7094 ! ! (New versions and upgrades are occasionally submitted to ! DECUS. Check DECUS for the latest version, or write or call ! at above address.) ! ! Dates: November 1986 - February 1987 : Version 1 ! March 1987 - May 1988 : Version 2 ! June 1988 - October 1988 : Version 3 ! November 1988 - March 1989 : Version 4 (VMS 5.0 compatible) ! May 1989 - April 1990 : Version 5 (advanced search/find capabilities) ! May 1990 - August 1990 : Version 6 (Spelling checker) ! September 1990 - November 1990 : Version 7 (Fixes for VMS 5.3 bugs. Requires at least VMS 5.1) ! December 1991 - : Version 8 (Fixes for some VMS 5.4 bugs.) ! David W. Deley © 1986, 1987, 1988, 1989, 1990, 1991 ! !-- ! This version of EDX requires at least VMS 5.1. ! ! For VMS 5.0 compile file EDTSCNSEC_VMS4.TPU ! ! For VMS 4.4-4.7 compile file EDTSCNSEC_VMS4.TPU or use the supplied ! precompiled file EDTSCNSEC_VMS4.TPU$SECTION. That precompiled section ! file is supplied since on VMS 4.4-4.7 a paging file quota (pgflquo) of ! about 50,000 is required to compile that section file, and some computers ! may not be configured with that large a paging file available. ! !-- ! SOURCE CODE: EDTSCNSEC.TPU (editor source code) ! EDX_HELP.HLP (help library source text) ! EDX_CALLUSER.MAR (external CALL_USER routines source code) ! EDX_COMMANDS.CLD (command definitions used by external CALL_USER routines) ! EDX_MESSAGES.MSG (messages used by external CALL_USER routines) ! EDX_CALLUSER.OPT (Options file used for compiling the external CALL_USER routines) ! DICTIONARY.LEX (Word list for EDX spelling checker dictionary) ! COMMONWORDS.LEX (Common word list for EDX spelling checker dictionary) ! BUILD_DICTIONARY.MAR (Program which creates EDX_DICTIONARY.DAT) ! ! EXECUTABLE: EDTSCNSEC.TPU$SECTION (editor section file) ! EDX_CALLUSER.EXE (external CALL_USER routines) ! EDX_DICTIONARY.DAT (dictionary for EDX spelling checker) ! EDX_HELP.HLB (editor help library) ! ! TO COMPILE TPU SECTION FILE: ! $ EDIT/TPU/NODISPLAY/NOSECTION/COMMAND=EDTSCNSEC (creates executable edtscnsec.tpu$section) ! For system wide use place compiled section file in SYS$LIBRARY. ! ! TO CREATE THE HELP LIBRARY: ! $ LIBRARY/CREATE/HELP SYS$HELP:EDX_HELP.HLB EDX_HELP.HLP ! ! TO COMPILE EDX_CALLUSER EXTERNAL ROUTINES: ! $ MACRO EDX_CALLUSER.MAR ! $ MESSAGE EDX_MESSAGES.MSG ! $ SET COMMAND/OBJECT EDX_COMMANDS.CLD ! $ LINK EDX_CALLUSER/SHARE/OPT ! ! TO COMPILE EDX_DICTIONARY.DAT SPELLING CHECKER DICTIONARY ! $ MACRO BUILD_DICTIONAY ! $ LINK BUILD_DICTIONARY ! $ DEFINE WORDLIST DICTIONARY.LEX ! $ DEFINE COMMONWORDS COMMONWORDS.LEX ! $ RUN BUILD_DICTIONARY ! ! TO USE: ! $ DEFINE TPU$CALLUSER disk:[directory]EDX_CALLUSER ! $ EDX :== EDIT/TPU/NOCOMMAND/SECTION=SYS$LIBRARY:EDTSCNSEC ! $ EDX filename ! !-- ! DESCRIPTION ! Upon invoking the editor the procedure TPU$INIT_PROCEDURE is automatically ! run. This procedure performs all initialization tasks; creating buffers, ! creating windows, and reading in the specified file to edit (if one was ! named). After running TPU$INIT_PROCEDURE, TPU compiles and executes the ! optional initialization file specified by the /COMMAND= qualifier if one was ! present. After that program control is determined by the keys the ! user types and the definitions those keys have. ! ! This editor was built starting with the EDT emulator SYS$LIBRARY:EDTSECINI.TPU ! Procedures were added and modified from the sources listed below. The ! prefixes to procedures and global variables indicate where the procedure ! originated from. Most if not all procedures have been modified for this ! editor. The prefixes are as follows: ! ! EDT$ - Editor: EDT Emulator ! Source: SYS$LIBRARY:EDTSECINI.TPU ! Author: DIGITAL EQUIPMENT CORPORATION © 1983, 1984, 1985 ! ! EDTP$ - Editor: EDTPLUS ! Source: DECUS VAX-211 ! Author: Edward Nieland © September 1986 ! ! EVE_ - Editor: EVE Editor ! & Source: SYS$LIBRARY:EVESECINI.TPU ! EVE$ Author: DIGITAL EQUIPMENT CORPORATION © 1983, 1984, 1985 ! ! Editor: EVEPLUS ! Source: DECUS VAX-150 ! Author: DIGITAL EQUIPMENT CORPORATION © October 1986 ! ! EDTX$ - Editor: EDTX ! Source: DECUS VAX-207 ! Author: Judith Clark © July 1986 ! ! EDTN$, VS$, JEN$, SPL$, SRT$, BUFW$, WPS$, PMT$, ! EDX$, EDX_, COMP$, PARSE$, PMTBUF$, DD1$, MRK$, CS$ ! Editor: EDX ! Source: Newly created for this editor ! Author: David Deley © 1986, 1987, 1988, 1989, 1990, 1991 ! ! User-written procedures should not begin with any of the above prefixes. ! VAXTPU internally divides procedures into 26 groups according to the ! first letter of the procedure name. Currently most procedure names ! start with the letter 'E'. For optimum performance, future procedure ! name prefixes should start with some other letter. ! ! In addition some concepts for the EDX spelling checker were taken from ! the very popular Vassar spelling checker submitted to DECUS by Mark ! Resmer - Academic Computer Center Manager, Box 248, Vassar College, ! Poughkeepsie NY 12601, who in turn gives credit to a program called ! PROOFREAD written by Matthew Temple of Smith College, Northampton MA. ! ! VARIABLE NAMES: ! Key letters following the '$' in global variables indicate the type ! of variable it is as follows: ! ...$x - String. Also integer, range, marker, keyword. ! ...$v - Integer value ! ...$m - Marker ! ...$w - Window ! ...$rn - Range ! ...$km - Key map ! ...$kml- Key map list ! ! ! THE SCREEN LAYOUT: ! The last two lines of the screen are for messages. The second to last ! line is also used for prompting. The rest of the screen is used for ! editing. In the following discussion the full editing screen refers ! to the full screen minus the last two lines at the bottom which are used ! for messages and prompting. There are three user windows defined. These ! are the MAIN_WINDOW which is the full editing screen size, the TOP_WINDOW ! which is the top half of the full editing screen, and the BOTTOM_WINDOW ! which is the bottom half of the full editing screen. All editing windows ! have a status line at the bottom which display the buffer name, the name ! of the file being edited, and the mode of the buffer - either insert or ! overstrike. If columnar cut/paste mode is in effect the status line also ! reflects this. If the file being edited has been locked to prevent others ! from editing it, the status line reflects this. The field for the file ! name is of fixed length. If the full file name is longer than will fit ! the file name is trimmed by deleting in order the disk, directory, file ! version, and file type until it fits. ! ! BUFFER NAMES: ! Internal global buffer pointer variables are of the form 'NAME_buffer' where ! NAME is the name of the buffer. Be sure you understand the difference ! between a buffer name (a string variable containing the name of the buffer) ! and a buffer pointer (a buffer variable which points to the actual buffer). ! Here NAME is the name given to a buffer when it is created. NAME_buffer is ! a buffer variable which points to the buffer. ! ! KEY MAPS: ! The default key map list TPU$KEY_MAP_LIST is used for all key maps. ! The key map edtn$km_EDT_editing_keys is used to define all the EDT editing ! function keys for the (the keypad keys, the ctrl keys, the Gold keys, etc). ! The key map edtn$km_WPS_editing_keys is used to define all the WPS editing ! function keys when SET KEYPAD WPS is in effect. The key map ! EDTN$KM_PRINTABLE_KEYS defines all printable keys. The default key map ! TPU$KEY_MAP is used for user defined keys. This way users don't have to ! deal with specifying key maps when they define keys. ! ! PHILOSOPHY: ! In general variables are not initialized until they are needed. This ! reduces startup time and also reduces the amount of initial memory ! used. (But this is also a pain and sometimes not worth it.) Many ! variables are initialized at the first call to procedure do_command. ! ! The screen is not updated unnecessarily. Procedures that modify ! characters in the middle of a line should avoid erasing and then ! reinserting a string if it doesn't change the length of the line, ! because the cursor will update the rest of the line unnecessarily if ! this is done. It's better to switch to overstrike mode and write over ! the old text, or to modify the existing text in place if possible. ! ! Buffers are created with their associated file when possible. This ! preserves the file attributes of the file. Attempts are made to do ! this when possible instead of creating an empty buffer and then reading ! in the file. ! ! The EXECUTE built-in is slow. Attempts were made to minimize the number of ! times this built-in was used. ! ! The show_buffer is used when ever a procedure needs a temporary buffer. ! This is a permanent system buffer. ! ! Also, the value of built-in symbol ERROR must be immediately saved if it ! is going to be used later or more than once in an on_error...endon_error ! statement since it is modified by every step within an on_error...endon_error. ! ! BUFFER JOURNALING: ! At VMS 5.3 buffer journaling is introduced. We do not open a journal ! file for a buffer when it is first created. Since users are limited to ! the number of open files they may have, opening a journal file for each ! buffer would limit each user to about 18 buffers before they reach their ! quota limit. We only start one when the buffer is first modified. This ! means we must be very careful not to modify a buffer without first ! starting the buffer journal file. In addition to adding and deleting ! text from a buffer, the following built-ins can also cause VAXTPU to ! enter padding characters into a buffer if the cursor is in a free ! detached state. (See VAX Text Processing Utility Manual, VAXTPU Data ! Types, Marker, discussion of free_cursor markers). ! ! APPEND_LINE ! COPY_TEXT ! CURRENT_CHARACTER ! CURRENT_LINE ! CURRENT_OFFSET ! ERASE_CHARACTER ! ERASE_LINE ! MARK (free_cursor ok) ! MOVE_MORIZONTAL ! MOVE_VERTICAL ! MOVE_TEXT ! SELECT ! SELECT_RANGE ! SPLIT_LINE ! ! When attempting to determine the current editing position, care must ! be taken not to allow VAXTPU to inadvertantly perform padding. The ! following example shows how to carefully check if we're on a character: ! ! !See if we're on a character ! nochar := FALSE; !Assume we're on a character ! If cs$cursor_outer_space then !then carefully check if we actually are ! nochar := TRUE ! Else ! if (mark(free_cursor) = end_of(current_buffer)) then ! if at eob ! nochar := TRUE ! else ! IF (current_character = "") then ! only now check if at eol ! nochar := TRUE ! ENDIF; ! endif; ! Endif; ! ! First use get_info to see if the cursor is bound, ! if bound, cursor is either on text, at eol, or at eob. ! Next check if cursor at eol ! if not at eob, only then can we check for eol ! ! ! LIMITATIONS: ! Up to VMS 5.3 a typical user process with an authorized page file quota of ! 10,240 is limited to a maximum file size of approximately 40,000 lines ! or 6000 blocks. This is due to the memory allocation limitations of a ! user's process. Since VAXTPU reads the entire file into virtual memory ! when it starts up, if the file is too big, it results in the error ! TPU-E-NOCACHE or TPU-E-GETMEM. (As of VMS 4.4 these errors lead ! directly to Fatal Internal TPU Errors. EDX checks for these errors ! and advises the user to save everything and exit immediately if the ! condition should occur.) ! ! At VMS 5.4 VAXTPU introduces work files to get around this limitation. ! ! ! /NODISPLAY MODE ! New for EDX V5.3, the editor now supports /NODISPLAY mode so it may be used ! in batch mode. A DCL command like $ EDIT/TPU/NODISPLAY/COMMAND=init.tpu ! is used to invoke the editor, and all edit commands must be in init.tpu. ! ! There are a large number of restrictions for /NODISPLAY mode. Any built-in ! which tries to create, modify, or use a window variable will fail. Also, ! we don't want to create a message_buffer so messages will instead go to ! SYS$OUTPUT. All of the following commands are to be avoided: ! 1. All of the Screen Layout Procedures: ! ADJUST_WINDOW ! CREATE_WINDOW ! MAP ! REFRESH ! SET(PAD,window,) ! SET(PROMPT_AREA,,,) ! SET(SCREEN_UPDATE,) ! SET(SCROLLING,window,,,) ! SET(STATUS_LINE,window,) ! SET(TEXT,window,) ! SET(VIDEO,window,) ! SET(WIDTH,window,) ! SHIFT(window,) ! UNMAP(window) ! UPDATE(window) ! ! 2. All of the Cursor Movement Procedures: ! CURSOR_HORIZONTAL ! CURSOR_VERTICAL ! SCROLL ! SET(COLUMN_MOVE_VERTICAL,) ! SET(CROSS_WINDOW_BOUNDS,) ! ! 3. Key Definition and Keyboard Manipulation routines: ! ADD_KEY_MAP ! CREATE_KEY_MAP ! CREATE_KEY_MAP_LIST ! DEFINE_KEY ! KEY_NAME ! LAST_KEY ! LOOKUP_KEY ! REMOVE_KEY_MAP ! SET(KEY_MAP_LIST,) ! SET(POST_KEY_PROCEDURE,,) ! SET(PRE_KEY_PROCEDURE,,) ! SET(SELF_INSERT,,) ! SET(SHIFT_KEY,,) ! SET(UNDEFINED_KEY,,) ! UNDEFINE_KEY ! LEARN_BEGIN ! LEARN_END ! LEARN_ABORT ! ! 4. Mouse Commands: ! LOCATE_MOUSE ! SET(MOUSE) ! POSITION(MOUSE) ! ! 5. Input from keyboard commands: ! READ_LINE ! READ_CHAR ! READ_KEY ! ! 6. Any other commands which use a window variable or don't make ! sense in a non-interactive environment. ! GET_INFO(WINDOWS,,) ! GET_INFO(window_variable,,,) ! SPAWN ! ATTACH ! ! ! FATAL INTERNAL TPU ERRORS ! As of VMS 4.4 there are numerous known conditions which can lead to ! fatal internal TPU errors. This section file attempts to avoid those ! conditions as much as possible. Known sources of fatal internal TPU ! errors are: ! ! 1. Creating a buffer without sufficient memory to allocate for the ! new buffer. See the explanation in procedure EDTN$CREATE_BUFFER. ! Fixed in VMS 5.0. ! ! 2. Built-in GET_INFO(DEBUG,...) . This built-in is used in the ! debugger sys$library:debug.tpu to examine local variables and ! parameters. When using the debugger to debug a procedure you ! could avoid declaring local variables in your procedure and ! only examine global variables. Examining global variables does ! not use the above built-in. Fixed in VMS 5.0. ! ! 3. The pattern matching built-in SPANL is known to be broken. This ! built-in is not used in this section file. Fixed in VMS 5.0. ! ! 4. Deleting buffers can lead to fatal internal TPU errors or lead to ! an infinite loop depending upon the circumstances. The sequence ! GOLD CTRL/L (find line number) followed immediately by the line mode ! command *FIX CRLFS can cause a fatal internal TPU error due to the ! way edtx$cursstat calls eve_fix_crlfs which in turn attempts to delete ! a buffer and then create a new one. This problem has reportedly been ! fixed as of VMS 4.6. Deleting buffers works ok if the procedure exits ! back to the user without doing anything else. Fixed in VMS 5.0. ! ! 5. The continuous scroll command (GOLD up arrow and GOLD down arrow) ! only works if the screen is not being updated when key command sequence ! is entered. Otherwise the message 'Press any key to stop scrolling' ! is displayed but the screen does not scroll. This is due to the ! internal structure of VAXTPU and how it buffers and executes key ! strokes. (Fixed in VMS 5.0, but now there's other problems with it.) ! ! 6. Windows. New as of VMS 5.0, TPU will bugcheck if the visible_length ! of a window is less than the scroll_top + scroll_bottom + scroll_amount. ! This necessitated rewriting of the ADJUST WINDOWS routine to avoid ! this possibility. (Reportedly fixed in VMS 5.3) ! ! 7. Differences. On VMS 5.3 (VAXTPU 2.4), a fatal TPU error occurs ! if the EDX line mode command DIFFERENCES is invoked, two nonmatching ! lines are highlighted, and the user presses the 'Enter' key to continue. ! This does not occur on VMS 5.4 (VAXTPU 2.6). ! ! 8. VMS 5.3 bugfixes #2 and #3. In certain situations, if a user switched ! to dual window mode for the first time, certain keys would then ! induce a fatal internal TPU error. EDX avoids those errors by ! silently mapping the bottom window and top window, printing the ! letters 'EDX editor' to the top window, updating both windows, and ! then unmapping both windows. This way when the user goes to dual ! window mode, it is not the first time the dual windows have been ! used and no fatal internal TPU error occurs. ! ! VMS 5.3 MESSAGE WINDOW BUG ! VMS 5.3 introduced a new bug to VAXTPU causing messages at the bottom ! of the screen not to appear properly for earlier versions of EDX. It ! has long been true that if part of the message window was covered by ! another window (such as the prompt window), it was necessary to ! "resynchronize" the message window to its buffer using UPDATE(MESSAGE_WINDOW). ! Apparently on VMS 5.3, the prompt created by the READ_LINE built-in now ! cases the same problem. ! ! An earlier fix used on version 6.2 submitted to DECUS was to always ! follow a READ_LINE statement with an UPDATE(MESSAGE_WINDOW) statement. ! This method has since proven to be not a very good fix. ! ! A second attempt to fix this problem was to replace all READ_LINE's ! with procedure EDX_READ_LINE, which uses only READ_KEY inside a loop ! to get the input line. (This is the way EVE does it as of VMS 5.) ! This also proved not to work, but we did get a recall buffer capability ! in the process. ! ! A third attempted fix was to replace all MESSAGE statements with procedure ! EDX_MESSAGE, and have EDX_MESSAGE use SCROLL to scroll the message window ! down as far as it would go after printing the message to insure it was ! visible. Unfortunately this led directly to a Fatal Internal TPU Error. ! ! A forth attempt is to use set(message_action_type,REVERSE) ! which forces the message window to update itself so the reverse highlight ! can be done. On VMS 5.3 the highlight isn't always done but at least ! the message ends up being displayed more often. ! ! The setup for messages: ! Set message_action_level to 1 so any message with a severity will do ! message_action_type. Then switch message_action_type from NONE to REVERSE ! for whatever messages we want highlighted, and whatever messages have ! trouble updating the window. When calling EDX_MESSAGE, use key values ! EDX$K_WARN, EDX$K_WARN_HIGHLIGHT, EDX$K_SUCCESS, EDX$K_SUCCESS_HIGHLIGHT, ! EDX$K_ERROR, EDX$K_ERROR_HIGHLIGHT, EDX$K_INFO, EDX$K_INFO_HIGHLIGHT. ! ! A fifth attempt followed after we received the microfiche for VMS 5.3 ! Careful study of the microfiche and testing in the debugger revealed ! the following problem: ! Routine SCR_UPDOLD_WINDOW in module SCREEN_UPDATE in shareable image ! TPU$CCTSHR (VMS 5.3 microfiche #0979 M03). This routine is called to ! update the message_window when a message is printed. In this routine ! the following check is made early on: ! ! !"If the window is marked for repaint, forget the other checks" ! IF (.current_window [wcb_v_repaint]) ! THEN ! call scr_redisplay_window(.current_window) ! RETURN ! ! Unfortunately SCR_REDISPLAY_WINDOW just repaints the message window as ! it already is without scrolling the most recent message into view. ! ! To fix this problem with VAXTPU in VMS 5.3 we call UPDATE(MESSAGE_WINDOW) ! just BEFORE writing a new message to the message window. This clears ! the flag [wcb_v_repaint] for the message_window so routine ! SCR_UPDOLD_WINDOW won't take the short cut and will properly (we hope!) ! display the newest message at the bottom of the screen where it belongs. ! ! We skip this fix if the current version of VAXTPU is less than 2.4. ! If the 'Working' message is displayed, that also messes up the ! message window requiring it to be refreshed before sending another message ! to it. ! ! VMS 5.4 ! 1. TPU does not buffer journal the key correctly if the buffer ! is in OVERSTRIKE mode. It results in a fatal error. For this ! reason the TAB key emulates overstrike mode by temporarily switching ! to INSERT mode, inserting a , then deleting the appropriate ! number of characters. ! Not only that, but inserting a string containing a character ! or inserting a range containing a character or copying a buffer ! containing a character or moving a range containing a ! character or moving a buffer containing a character into a ! buffer in overstrike mode can also cause a fatal internal VAXTPU error. ! A lot of work has gone in to making sure every instance of entering ! text into a buffer is either in insert mode or the buffer is a system ! which does not get journaled, or if there is a character and ! the buffer is in insert mode and is journaled then the entry of the ! character is emulated. ! ! 2. On VMS 5.4 the first page of each HELP screen is skipped and viewing ! starts on the second page. A work around for this known problem ! has since been found and is implimented in procedure EDT$HELP. !------------------------------------------------------------------------ ! CHANGES: ! V3.5-460 12-OCT-1988 David Deley Version submitted to DECUS ! V4.0-485 28-NOV-1988 David Deley VMS 5.0 compatibility ! V4.1-487 06-DEC-1988 David Deley Version submitted to DECUS ! V5.1-714 27-JUN-1989 David Deley Version submitted to DECUS ! V6.0 MAY-1990 David Deley Added SPELL checker ! V6.1-062 15-MAY-1990 David Deley VMS 5.3 compatibility ! V6.2-127 07-JUN-1990 David Deley Version submitted to DECUS ! V6.3-132 12-JUN-1990 David Deley Match parenthesis looks in both directions for initial parenthesis ! 18-JUN-1990 CTRL-Z aborts EXIT/ALL at buffer name prompt. ! 19-JUN-1990 new edt$section fix end of buffer condition. ! 20-JUN-1990 Save_Search_context (still not used fully) ! 05-JUL-1990 GOLD-P copy_to set buffer to INSERT. ! Add back "Creating show markers display..." message ! V6.3-144 11-JUL-1990 CTRL-D change_windows ! V6.3-149 19-JUL-1990 BEG_OF_LINE ! V6.3-168 19-JUL-1990 Add EDX_MESSAGE to combat VMS 5.3 bug. All messages ! now via EDX_MESSAGE. (need to add to doc & help) ! Message buffer size is now 144 lines. ! V7.0-198 21-JUL-1990 EDX_READ_LINE to bypass VMS 5.3 bug. ! (no longer support VMS 4 as of this version) ! V7.1-233 03-SEP-1990 Attempt #5 to fix message window problem on VMS 5.3 ! V7.2-246 08-SEP-1990 Add spell save of misspelled words and their corrections ! V7.2-249 11-SEP-1990 More fix message window on VMS 5.3 Update always before message. ! V7.2-250 11-SEP-1990 Add 'Press CTRL-Z to abort' messages ! V7.3-251 18-SEP-1990 Fix VMS 5.3 fatal error #2. More 'Press CTRL-Z'. ! V7.4-281 21-SEP-1990 Fix delete buffer so we don't end up in message window. ! V7.4-282 24-SEP-1990 Change tpu__getmem checks to tpu$_nocahce checks. ! V7.4-290 25-SEP-1990 Version submitted to DECUS ! V7.5-291 15-OCT-1990 Fix vs$write_file to write selected range. ! Fix recall buffer down-arrow ! V7.6-305 22-OCT-1990 Redo keymaps. Add "!?" support to fill paragraph ! V7.7-378 19-NOV-1990 Edit VMS text library support ! Version submitted to DECUS SIG Las Vegas December 1990 ! V7.8-396 11-DEC-1990 Define keys for prompt_buffer in case user ever gets caught there ! V7.8-398 15-DEC-1990 Modified edtn$time to return string ! V7.8-399 15-DEC-1990 Kludge set status line to handle special ASCII and CALENDAR buffers ! V7.8-407 17-DEC-1990 Add SHOW CALENDAR command. ! V7.8-423 25-APR-1991 Have GOTO_BUFFER and MAKE_TWO_WINDOWS check for invalid buffer names ! V7.9-425 02-MAY-1991 Fix VMS 5.3 fatal error #3. ! V7.10-451 28-JUN-1991 Disallow searching the SEARCH buffer. ! V7.11-457 28-JUN-1991 Add buffer journaling ! V7.12-472 23-OCT-1991 Buffer journaling only for modified buffers ! V8.0-539 22-NOV-1991 BETA release. Buffer journaling. VMS 5.4 bugfix ! Numerous small enhancements. New EDX manual. ! V8.0-547 02-DEC-1991 DECUS & '91 Winter Symposium. Full release. ! V8.1-549 05-DEC-1991 TPU BUGFIX2 for online help on VMS 5.4 ! DECUS & '91 Winter Symposium. Full release replacement ! V8.1-1 (1550) 16-DEC-1991 Unpaste left in paste buffer if paste buffer empty ! V8.1-2 (1551) 19-DEC-1991 Removed DES encryption ! V8.1-3 (1556) 30-DEC-1991 Fixed INCLUDE/MODULE ! V8.1-4 (1557) 03-JAN-1992 clear_message_window onlyif /DISPLAY ! V8.1-5 (1558) 06-JAN-1992 Erase search_buffer before displaying ! V8.1-6 (1560) 08-JAN-1992 edx_read_line, stay on line 1 of prompt_buffer ! V8.1-7 (1562) 16-JAN-1992 Fixed INCLUDE = * ! V8.1-8 (1563) 16-JAN-1992 Test on read in file delete old buffer if empty ! V8.1-9 (1583) 29-JAN-1992 Capitalize_range endless loop if at end of buffer ! V8.2-0 (1586) 17-FEB-1992 Add VS$BJN for buffer journaling ! V8.2-1 (1587) 19-FEB-1992 SHOW SEARCH was showing jen$x_search_case instead of jen$x_default_search_case ! V8.2-1 (1588) 22-FEB-1992 SET SEARCH {GENERAL|EXACT} set both default and current (jen$x_default_search_case & jen$x_search_case) ! V8.2-2 (1590) 26-FEB-1992 Make inserted ruler line as long as possible ! DCL command show cursor at bol so user doesn't think he needs to press RETURN again ! V8.2-3 (1592) 02-MAR-1992 Remove km_paswrd key map. No longer encrypting buffers ! V8.2-4 (1593) 14-MAR-1992 Remove ascii null character in EVE$BUILD_PATTERN ! V8.2-5 (1594) 14-MAR-1992 Fix * CHANGE {line-number} ! V8.2-6 (1598) 25-MAR-1992 Make one line windows now. ! V8.2-7 (1600) 03-APR-1992 DCL command show cursor at bol of next line ! V8.2-8 (1602) 06-APR-1992 Fix calendar incorrect day of week on leap years ! V8.2-9 (1604) 14-APR-1992 Add autoindent !------------------------------------------------------------------------------ ! ! Table of Contents ! ! Categories: ! STARTUP PROCEDURES ! CURSOR MOVEMENT ! ENTERING TEXT ! DELETING TEXT ! UNDELETING TEXT ! CUT/PASTE OPERATIONS ! FILL PARAGRAPH ROUTINES ! EDITING TEXT ! SEARCHING/SUBSTITUTING TEXT ! BUFFER/WINDOW PROCEDURES ! FILE INPUT/OUTPUT PROCEDURES ! EXIT PROCEDURES ! MARKERS ! KEY LEARN PROCEDURES ! RULER ! DATE PROCEDURES ! READ_LINE ! EDX_READ_LINE ! LINE MODE PARSERS ! HELP PROCEDURES ! ASCII AND CHARACTER TRANSLATION PROCEDURES ! SORTING ! MULTIPLE PROCESSING ! DIRECTORY ! SPELLING ! BUFFER JOURNAL RECOVERY ! MISCELLANEOUS ! VERSION SPECIFIC ! SECTION BUILDING ! !****************************************************************************** ! STARTUP PROCEDURES !****************************************************************************** ! TPU$INIT_PROCEDURE ! Editor initialization procedure ! EDT$INIT_VARIABLES ! Initialize global variables ! EDTN$INIT_BUFFERS ! Create default buffers ! EDTN$INIT_WINDOWS ! Create default windows ! EDTN$CREATE_MAIN_BUFFER ! Create main buffer ! EDTN$START_JOURNAL ! Start journal file ! EDTN$FILE_PARSE ! Parse file specification ! TPU$LOCAL_INIT ! Placeholder for user's local initialization ! !****************************************************************************** ! CURSOR STATE !****************************************************************************** ! CS$CURSOR_OUTER_SPACE ! True/False if cursor is not bound !*CURSOR_LINE_NUMBER ! Returns current cursor line number !****************************************************************************** ! CURSOR MOVEMENT !****************************************************************************** !*MOVE_RIGHT(n) ! Move right n places. !*MOVE_LEFT(n) ! Move left n places. ! EDTN$HORIZONTAL ! Left/Right arrow keys !*MOVE_UP(n) ! Move up n places. !*MOVE_DOWN(n) ! Move down n places. ! EDTN$VERTICAL ! Up/Down arrow keys !*GOTO_COLUMN(n) ! Move to text column n. ! EDTN$GOTOCOL ! Move to specified offset column !*TAB ! Handle tab_key functions. !*HARD_TAB ! Insert a !*MOVE_BY_WORD ! Move by word ! EDT$MOVE_WORD ! Move to the next word (KP2) ! EDT$BEG_WORD ! Find the beginning of word ! EDT$END_WORD ! Find the end of word ! BEG_OF_WORD ! Move to beginning of word (DD1) !*END_OF_WORD ! Move to end of word (CTRL-F) !*MOVE_BY_LINE ! Move by line ! EDTN$MOVE_BY_LINE ! Move to beginning of next line (KP0,backspace) !*END_OF_LINE ! Move to end of line ! EDTN$END_OF_LINE ! Move to end of line (KP2) ! DD1$EOL ! End of line (forward) !*NEXT_SCREEN ! Advance screen. !*PREVIOUS_SCREEN ! Previous screen. ! EDT$SECTION ! Move up/down section (16 lines) (KP8) !*MOVE_BY_PAGE ! Move to next page (KP7) !*GOTO_TOP ! Move to beginning of buffer (GOLD KP4) !*GOTO_END ! Same as GOTO_BOTTOM !*GOTO_BOTTOM ! Move to end of buffer (GOLD KP5) !*GOTO_LINE ! Go to specified line in buffer (GOLD #) and (line mode *nnnn cmd) ! !****************************************************************************** ! ENTERING TEXT !****************************************************************************** !*ENTER_TEXT (b) ! Enter printable character into buffer (all printable keys) !*NEW_LINE (b) ! Enter carriage return ! !****************************************************************************** ! DELETING TEXT !****************************************************************************** !*DELETE_PREVIOUS_CHARACTER (b) ! Erase previous character (delete) !*DELETE_CHARACTER (b) ! Delete current character (keypad comma) ! EDT$DEL_BEG_WORD (b) ! Delete to beginning of word !*DELETE_WORD (b) ! Delete word (keypad minus) !*DELETE_START_OF_LINE (b) ! Delete to beginning of line (CTRL-U) !*DELETE_END_OF_LINE (b) ! Delete to end of line (GOLD KP2) !*DELETE_LINE (b) ! Delete line (PF4) ! !****************************************************************************** ! UNDELETING TEXT !****************************************************************************** !*UNDELETE_CHARACTER (b) ! Undelete character (GOLD comma) !*UNDELETE_WORD (b) ! Undelete word (GOLD keypad minus) !*UNDELETE_LINE (b) ! Undelete line (GOLD PF4) ! !****************************************************************************** ! CUT/PASTE OPERATIONS !****************************************************************************** !*START_SELECT (m columnar) ! Select key !*CUT (m) ! Cut !*PASTE (m) ! Paste ! UNPASTE (b) ! Immediately undo unintentional paste ! EDTN$SELECT_BLOCK ! Select (keypad dot) ! EDTN$CUT_BLOCK (m) ! Cut/pick selected range (KP6) ! EDTN$PASTE_BLOCK (m) ! Paste (GOLD KP6) ! EDT$SELECT ! Normal mode select begin ! EDT$SELECT_RANGE ! Normal mode select end ! EDT$ON_SEARCH_RANGE ! Select and substitute support routine ! EDT$RESET ! Reset select range ! EDTX$COPY_TO (b,b) ! Normal mode cut/pick ! EDTX$COPY_FROM (b) ! Normal mode paste ! EDT$APPEND (b) ! Normal mode append (KP9) ! EDT$REPLACE (m) ! Normal mode replace (GOLD KP9) !------------------------------------------------------------------------------ ! COLUMNAR CUT/PASTE PROCEDURES !------------------------------------------------------------------------------ ! EDTN$COLUMNAR_SELECT (m tmpmrk) ! Columnar select dispatcher ! EDTN$COLUMNAR_SELECT_BEGIN (b tmpmrk) ! Columnar select start ! EDTN$FINISH_COLUMN_SELECT (b tmkmrk) ! Columnar select finish and show box ! EDTN$COLUMNAR_CUT (b,b) ! Columnar select cut ! EDTN$COLUMNAR_PASTE (b) ! Columnar paste ! !****************************************************************************** ! FILL PARAGRAPH ROUTINES !****************************************************************************** ! EDT$FILL (m) ! Fill select range (GOLD KP8) ! EDT$SKIP_LEADING_SPACES ! Fill select range support routine ! EDT$FIND_WHITELINE ! Fill select range support routine ! EDT$SKIP_LINES ! Fill select range support routine ! EDTN$TRIM_FILL_RANGE (x) ! Fill select range support routine ! EDTN$FILL_RANGE (b) ! Fill select range support routine !*FILL_PARAGRAPH (m) ! Fill paragraph ! EVE$PARAGRAPH_BREAK ! Determine paragraph start/end ! EDTN$FILL_TO_END (m) ! Fill from cursor to end of paragraph ! !****************************************************************************** ! EDITING TEXT !****************************************************************************** ! EDT$CHANGE_CASE (b) ! Change case of select range (GOLD KP1) !*UPPERCASE_WORD (b) ! Uppercase current word (GOLD U) !*LOWERCASE_WORD (b) ! Lowercase current word (GOLD L) !*CAPITALIZE_WORD (m) ! Capitalize current word (GOLD C) !*CAPITALIZE_RANGE (b) ! Capitalize range !*CAPITALIZE_STRING ! Capitalize string ! EVE$CURRENT_WORD ! Determine current word !*TRANSPOSE_CHARACTERS (b) ! Swap current character with next (GOLD PF2) !*CENTER_LINE (b) ! Center line on page ! !****************************************************************************** ! SEARCHING/SUBSTITUTING TEXT !****************************************************************************** ! EVE$BUILD_PATTERN ! Build pattern for wildcard search ! SAVE_SEARCH_CONTEXT ! Useful? ! RESTORE_SEARCH_CONTEXT ! Useful? ! JEN$STRNOTFOUND ! Print the 'String not found' message ! JEN$FIND_STRING ! Search for a string or pattern ! JEN$SELECT_RANGE_QUIETLY ! JEN$SAMECASE ! support for replace ! JEN$SEARCH_AND_REPLACE (b) ! Search and replace a string or pattern ! JEN$FNDNXT (m) ! Keypad "Find Next" procedure ! JEN$INIT_FIND_STRING ! Keypad "find a new string" command ! JEN$SETUP_SEARCH ! Setup global symbols for search ! EDTN$LINE_MODE_FIND (m) ! Parser for line mode FIND command ! EDTN$LINE_MODE_REPLACE (m) ! Process line mode REPLACE command ! EDTN$SUB_TOKEN ! Token extractor for EDT$LINE_MODE_SUBSTITUTE ! EDT$LINE_MODE_SUBSTITUTE (m) ! Parser for line mode SUBSTITUTE command ! EDTN$SEARCHALL ! Process line mode SEARCH command ! EDTN$SEARCH_UPDOWN(I) ! Process up/down arrow keys when in SEARCH buffer ! EDTN$SEARCH_ENTER ! Process ENTER/RETURN keys when in SEARCH buffer ! EDTN$LINE_MODE_SEARCH ! Parse line mode SEARCH command ! EDT$SUBSTITUTE (m) ! EDT keypad mode GOLD Enter (substitute) ! EDTN$FIND_PAT ! Move to beginning of next paragraph ! EDTN$FIND_CHAR ! Find first occurance of character (GOLD .) ! WPS$SEARCH_LINE ! WPS keypad key KP8 ! JEN$SEARCH_LINE ! Search current line for character(s) ! !****************************************************************************** ! BUFFER/WINDOW PROCEDURES !****************************************************************************** ! EDT$BUFFER ! Parse/dispatch line mode {= buffer} command ! EDTN$NEWBUFNAM ! Generate name of new buffer ! EDT$FIND_BUFFER ! Find buffer given name ! EDTN$CREATE_BUFFER ! Create buffer with error checking ! EDTN$GOTO_BUFFER ! Go to buffer (GOLD B) ! EDTN$DELETE_BUFFER ! Delete a buffer ! EDTP$OVERSTRIKE ! Toggle insert/overstrike mode ! EDTN$TOGGLE_WINDOWS ! Toggle one/two windows ! EDTN$MAKE_ONE_WINDOW ! Set full screen window mode !*MAKE_ONE_WINDOW ! Set full screen window mode ! EDTN$MAKE_TWO_WINDOWS ! Set dual window mode !*MAKE_TWO_WINDOWS ! Set dual window mode !*OTHER_WINDOW ! Same as change_windows !*CHANGE_WINDOWS ! Move to other window when in dual window mode (CTRL-V) NEW? ! EDTP$SET_STATUS_LINE ! Set status line of window ! EDTN$UPDATE_VISIBLE_STATLN ! Update status line of windows containing buffer_ptr ! EDTN$SET_INFO_WINDOW_STATLN ! Set info_window status line ! EDTN$TRIM_FILESPEC ! Trim filespec to given length ! EDTN$FILENAME_OF_BUFFER ! Get filename of buffer ! EDTN$MODNAM_OF_BUFFER ! Get module name of buffer if editing text library ! EDTN$TOGGLE_WINDOW_WIDTH ! Toggle window width 80/132 (GOLD CTRL-W) ! EDTN$SCROLL_WINDOW ! Continuous scroll of window (GOLD up & GOLD down) ! EDTN$SHIFT_WINDOW ! Shifts window left/right !*ADJUST_DUAL_WINDOWS ! Adjust relative heights of windows (callable) ! EDTN$ADJUST_DUAL_WINDOWS ! Adjust relative heights of windows when in dual window mode (line mode *ADJUST WINDOWS) ! EDTN$CLEAR_MESSAGE_WINDOW ! Clear contents in message window ! EDTN$SHOW_BUFFERS ! Show buffers command ! EDTN$SHOBUF_ARROW ! Show buffers command ! EDTN$SHOBUF_ENTER ! Show buffers command ! EDTN$SHOBUF_DELETE ! Show buffers command ! EDTN$SHOBUF_LOCK ! Show buffers command ! !****************************************************************************** ! FILE INPUT/OUTPUT PROCEDURES !****************************************************************************** ! PARSE$INCLUDE ! Parse line mode INCLUDE command ! EDTN$INCLUDE (m) ! Read in a file ! EDTN$READ_FILE (b) ! READ_FILE with error checking ! EDTN$READ_TLBMOD (b) ! Read in module from a text library ! PARSE$WRITE ! Parse line mode WRITE command ! EDTN$WRITE_BUFFER ! Write buffer to disk ! VS$WRITE_FILE ! WRITE_FILE with error checking ! EDTN$WRITE_TLBMOD ! Write to a text library module ! EDTN$NOCACHE_WARNING ! Print 'panic' error message when out of memory ! !****************************************************************************** ! EXIT PROCEDURES !****************************************************************************** ! EDT$EXIT ! Line mode(exit cmd) ! EDTN$CONFIRM_EXIT ! Confirm quit/exit if unwritten buffers ! !****************************************************************************** ! MARKERS !****************************************************************************** ! MRK$LINES_BETWEEN_MARKERS ! Returns number of lines between markers M1 & M2 !*SET_MARK(mark-name) ! Set marker at current location (GOLD CTRL-G) !*GOTO_MARK(mark-name) ! Go to specified marker (GOLD G) ! EDTN$SHOW_MARKERS ! Line mode SHOW MARKERS ! !****************************************************************************** ! KEY LEARN PROCEDURES !****************************************************************************** ! EDTP$LEARNING ! Begin key learn sequence (GOLD-[) ! EDTP$STOP_LEARN ! End learn sequence (GOLD-]) ! EDTN$UNLEARN ! Restore key to former function (line mode *UNLEARN cmd) ! !****************************************************************************** ! RULER !****************************************************************************** ! EDTP$INSERT_RULER (b) ! Insert ruler above current line (GOLD R) !*TOGGLE_RULER_LINE ! Toggle on/off ruler at top of screen (GOLD CTRL-R) NEW? ! EDTN$ADJUST_RULER_SHIFT ! Adjust shift offset of ruler at top of screen ! !****************************************************************************** ! DATE PROCEDURES !****************************************************************************** !*CURRENT_DATE ! Return todays date ! EDX$DATE_CONVERT ! Convert date format ! EDTN$SET_DATE_FORMAT ! Set format type of todays date (line mode *SET DATE_FORMAT cmd) ! EDTN$TIME ! Fancy show time ! EDTN$SHOW_CALENDAR ! Display calendar ! !****************************************************************************** ! READ LINE !****************************************************************************** ! EDX_READ_LINE ! !****************************************************************************** ! LINE MODE PARSERS !****************************************************************************** ! EDT$LINE_MODE ! Enter line mode (CTRL-Z) ! EDTN$PROMPT_DO_COMMAND ! Do GOLD-KP7 or DO keys. (Patch for VMS 5.3 bug) ! EDTN$DO_COMMAND ! Parse and dispatch line mode commands !*DO_COMMAND(command-string) ! Parse and dispatch line mode commands ! EDTN$STRING_TO_INTEGER ! Convert string to integer with status ! PARSE$NEXT_STATE ! Parse command line and return index into state table ! EDT$NEXT_TOKEN ! Support routine for line mode parse & dispatch ! PARSE$ADJUST ! Parse line mode ADJUST command ! PARSE$CLEAR ! Clear tab ! PARSE$DELETE ! Parse line mode DELETE command & DELETE BUFFER ! PARSE$ERASE ! Parse line mode ERASE command & ERASE BUFFER ! PARSE$FIX ! Parse line mode FIX command ! EDTN$LOCK_FILE ! Lock file to prevent others from editing it ! EDT$SET ! Parse line mode SET command ! EDTN$SET_CURSOR ! Set cursor BOUND, FREE, top:bottom !*SET_DEFAULT ! Change default directory ! EDTN$SET_KEYPAD ! Set keypad to EDT, WPS, or NUMERIC ! EDTN$SET_LOCK ! Process SET LOCK and SET NOLOCK command ! EDTN$SET_LOGICAL ! Define DCL logical name ! PARSE$SET_PROMPT ! Set prompt video attributes ! EDTN$SET_PROMPT_VIDEO ! Set prompt video attributes !*SET_SYMBOL ! Define a DCL symbol ! EDTN$SET_TAB_KEY ! Parse line mode SET TAB_KEY ! EDT$SHOW ! Parse line mode SHOW command ! EDTN$SHOW_LOGICAL ! Translate a logical name ! EDTN$SHOW_SYMBOL ! Translate a DCL symbol ! PARSE$TRANSLATE ! Parse line mode TRANSLATE command ! PARSE$TRIM ! Parse line mode TRIM command ! !****************************************************************************** ! HELP PROCEDURES !****************************************************************************** ! EDT$HELP ! Help on topics ! EDT$KEYPAD_HELP ! Print keypad help diagram !*KEYPAD_HELP ! Print keypad help diagram ! !****************************************************************************** ! ASCII AND CHARACTER TRANSLATION PROCEDURES !****************************************************************************** ! EDTN$SHOW_ASCII_TABLE ! Display ASCII table. (line mode *SHOW ASCII) ! EDTN$TRANSLATE_CHARACTER ! Return description of character !*CHAR_TO_ASCII ! Find ascii value of character ! EDTN$CNTL_CHAR (b) ! Enter a control character (GOLD KP3) ! EDTX$CURSSTAT ! Show current line, column, and character description ! EDTN$TRANSLATE_BUFFER (b) ! Translate buffer from one form to another ! EDTN$ENCRYPT_BEGIN ! Encrypt or decrypt a buffer ! EDTN$ENCRYPT_FINISH ! Encrypt or decrypt a buffer ! !****************************************************************************** ! SORTING !****************************************************************************** ! SRT$SORT ! Main entry into sort. ! SRT$SORT_SILENT ! Sort without saying "Sorting ..." ! SRT$SORT_PREPARSE ! Preparse SORT command ! SRT$SORT_DO ! Sort a range or buffer ! SRT$SORT_BUFFER ! Dispatch to file sort buffer or record sort buffer ! SRT$RECORD_SORT_BUFFER (b) ! Sort using record sort ! SRT$FILE_SORT_BUFFER (m) ! Sort using file sort ! SRT$WRITE_TEMPFILE ! Quietly write a temporary file to disk. ! SRT$READ_FILE (b) ! Quietly read in a file ! !****************************************************************************** ! MULTIPLE PROCESSING !****************************************************************************** ! EVE_DCL ! EVE_ATTACH ! EVE_SPAWN ! !****************************************************************************** ! DIRECTORY !****************************************************************************** ! ! EDTN$DIR ! Display directory listing (GOLD D) ! EDTN$DIRBUF_FILENAME ! Support routine ! EDTN$HIGHLIGHT_WORD ! Support routine ! EDTN$DIRBUF_UPDOWN ! Support routine ! EDTN$DIRBUF_LEFT ! Support routine ! EDTN$DIRBUF_RIGHT ! Support routine ! EDTN$DIRBUF_ENTER ! Support routine ! EDTN$DIRBUF_DELFILE ! Support routine ! EDTN$DIRBUF_LOCK ! Support routine ! !****************************************************************************** ! SPELLING !****************************************************************************** ! SPL$SPELL_PARSE ! Parse the line mode SPELL command ! SPL$SPELL_WORD ! Spell check a single word ! SPL$SPELL ! Main spell routine. Spell check a buffer ! SPL$WHAT_TO_DO ! Ask what to do for misspelled word ! SPL$REPLACE_WORD (b) ! Replace a misspelled word ! SPL$GUESS_MODE ! Guess which word the user meant ! SPL$DIC_BROWSE ! Browse through the dictionary ! SPL$DICBUF_ENTER (b) ! Handle ENTER or RETURN key while in DIC buffer ! SPL$DICBUF_PAGE ! Display next/previous page of dictionary ! SPL$DICBUF_UPDOWN ! Handle up/down arrow keys while in DIC buffer ! SPL$DICBUF_LEFT ! Handle left arrow key while in DIC buffer ! SPL$DICBUF_RIGHT ! Handle right arrow key while in DIC buffer !*DUMP_DICTIONARY ! Dump all words in EDX dictionary !*DUMP_COMMONWORDS ! Dump commonword list in EDX dictionary !****************************************************************************** ! BUFFER JOURNAL RECOVERY !****************************************************************************** ! JNL$RECOVERY ! !****************************************************************************** ! MISCELLANEOUS !****************************************************************************** ! EDTN$MATCH_PAREN ! Match parenthesis procedure ! EDTN$CLEAR_PAREN ! Clear matching parenthesis ! EDTN$DIFFERENCES ! Compare two buffers ! EVE$TRIM_BUFFER (b) ! Remove trailing blanks from all lines in buffer. (line mode *TRIM cmd) ! EVE_FIX_CRLFS (b) ! Remove all 's from buffer ! EDTN$INSERT_LINE (b) ! Insert separating line in buffer (GOLD -) ! EDTN$COMMENT_CHARACTER ! Support routine for insert_line ! EDTN$CALC ! Perform integer arithmetic (line mode *CALC) ! EDT$DEFINE_KEY ! Define key as TPU command (CTRL K) ! EVE_SET_LEFT_MARGIN ! Set left margin (line mode *SET LEFT MARGIN) ! EDT$GOLD_NUMBER ! GOLD 0..9 (repeat counts) ! EDTN$TPUCOMMAND ! Execute TPU command (line mode *TPU cmd) ! EDTN$TOGGLE_NUMERIC_KEYPAD ! Toggle between editing/numeric keypad !*EDX_MESSAGE ! Message a statement and overcome VMS 5.3 bug ! EDTN$FIT_MESSAGE ! Message using 1 or 2 lines depending on length !!EDTN$SIGNAL ! Message an error (not used anymore) ! EVE_ELIMINATE_TABS (b) ! Converts all tabs to spaces within buffer !*RING_BELL ! Beep the terminal ! !****************************************************************************** ! VERSION SPECIFIC !****************************************************************************** ! VS$CHECK_VERSION ! VS$UPGRADE_EDX !Perform upgrade. Creates all VMS 5 specific procedures. ! VS$MIN_VERSION !Minimum version we're compatible with ! ENABLE_BUFFER_JOURNALING !Start buffer journaling on VMS 5.3 ! !****************************************************************************** ! SECTION BUILDING !****************************************************************************** ! COMP$INIT_KEY_MAPS ! Define key maps and key map lists ! COMP$INIT_KM_EDT_EDITING_KEYS ! Define EDT editing keys ! COMP$INIT_KM_WPS_EDITING_KEYS ! Define WPS editing keys ! COMP$INIT_KM_DD1_EDITING_KEYS ! Define DD1 editing keys ! COMP$INIT_KM_PRINTABLE_KEYS ! Define printable keys ! COMP$INIT_KM_NUMERIC_KEYPAD ! Define numeric keypad ! COMP$INIT_KM_PMTBUF ! Define keys used with PROMPT buffer ! COMP$INIT_KM_SHOBUF ! Define keys used with SHOW BUFFERS display ! COMP$INIT_KM_SHOMRK ! Define keys used with SHOW MARKERS display ! COMP$INIT_KM_PASWRD ! Define keys used with ENCRYPT command ! COMP$INIT_KM_DIRBUF ! Define keys used within DIR directory buffer ! COMP$INIT_KM_DIRBUF_EDT ! Define additional keys used within DIR directory buffer when in EDT keypad mode ! COMP$INIT_KM_DIRBUF_WPS ! Define additional keys used within DIR directory buffer when in WPS keypad mode ! COMP$INIT_KM_DIRBUF_DD1 ! Define additional keys used within DIR directory buffer when in DD1 keypad mode ! COMP$INIT_KM_DICBUF ! Define keys used within DIC dictionary buffer ! COMP$INIT_KM_DICBUF_EDT ! Define additional keys used within DIC dictionary buffer when in EDT keypad mode ! COMP$INIT_KM_DICBUF_WPS ! Define additional keys used within DIC dictionary buffer when in WPS keypad mode ! COMP$INIT_KM_DICBUF_DD1 ! Define additional keys used within DIC dictionary buffer when in DD1 keypad mode ! COMP$INIT_KM_SEARCH ! Define keys used with SEARCH buffer ! COMP$INIT_KM_SEARCH_EDT ! Define additional keys used with SEARCH buffer when in EDT keypad mode ! COMP$INIT_KM_SEARCH_WPS ! Define additional keys used with SEARCH buffer when in WPS keypad mode ! COMP$INIT_KM_SEARCH_DD1 ! Define additional keys used with SEARCH buffer when in DD1 keypad mode ! ! (procedures marked with an * are available for users and are documented ! in the EDX manual.) ! (procedures marked with a (b) check to enable buffer journaling.) ! (procedures marked with a (m) call procedures which enable buffer journaling.) !------------------------------------------------------------------------------ !****************************************************************************** ! STARTUP PROCEDURES !****************************************************************************** ! ! INITIALIZATION PROCEDURE ! ! This procedure is invoked to initialize the editing session. The windows ! and buffers are created here. ! PROCEDURE TPU$INIT_PROCEDURE ! initialization procedure LOCAL temp, new_file, input_file, full_filnam, output_file_name, parsed_output_file_name, input_file_name_only, journal_file, full_command_file, keystroke_journaling, mainbufjnlok; ! INITIALIZE VARIABLES edt$init_variables; ! INITIALIZE BUFFERS edtn$init_buffers; ! INITIALIZE WINDOWS AND DO SOME WINDOW SET UP ! DO THIS SO IT LOOKS LIKE EDX IS DOING SOMETHING IF GET_INFO(SYSTEM,'DISPLAY') THEN edtn$init_windows; !Avoid second fatal error with VMS 5.3 by mapping bottom_window. !Avoid third fatal error with VMS 5.3 by mapping top_window and printing "EDX editor" set(status_line,top_window,none,""); !make status line disappear map(top_window,show_buffer); !show buffer is empty (invisible) copy_text('EDX editor'); !We have to show something to get this bugfix to work. update(top_window); !map it to set WCB of top_window erase(show_buffer); !erase so bottom_window gets mapped blank. set(status_line,bottom_window,none,""); !make status line disappear map(bottom_window,show_buffer); !show buffer is empty (invisible) update(bottom_window); !map it to set WCB of bottom_window unmap(top_window); !reset unmap(bottom_window); !reset ! MAP THE MESSAGE WINDOW position(message_buffer); Temp := 1; !Counter equal to row number of message_window we're on Loop exitif ( Temp > message_window_length - 2 ); split_line; Temp := Temp + 1; !Start messages 2 lines from end of message_window Endloop; map(message_window,message_buffer); ! ! Now position to another buffer. This is to not have the EOB line as ! the current line when the window gets mapped and updated. We want to ! see messages. Put filename in recall_buffer. ! position(recall_buffer); copy_text(get_info(command_line,'file_name')); ! ! Check VAXTPU version number for any possible upgrades (skip if /NODISPLAY) VS$CHECK_VERSION; ! ENDIF; !SET MESSAGE FLAGS set (message_flags, 1); !Set so only text will appear !!set (message_flags, 15); !Use when debugging. !!set (informational,on); !Use when debugging. !!set (line_number,on); !Use when debugging VMS 5 !!set (traceback,on); !Use when debugging VMS 5 ! DO VERSION SPECIFIC STUFF !VS$INIT_PROCEDURE; !Do version specific stuff SET(PAD_OVERSTRUCK_TABS,ON); SET(COLUMN_MOVE_VERTICAL,ON); !*** Check the filename *** ! GET INPUT FILENAME ! SEE IF FILENAME HAS '\' APPENDED TO IT BECAUSE I'M A SLOPPY TYPIST ! SEE IF INPUT FILE IS VALID. IF NOT, EXIT. input_file := get_info(command_line,'file_name'); !get filename if (substr(input_file,length(input_file),1) = "\" ) !check for "\" then input_file := substr(input_file,1,length(input_file)-1) !remove "\" endif; if (NOT edtn$file_parse(full_filnam,input_file,"","")) !check filename then exit; !And exit endif; ! ! SEE IF SPECIFIED FILE EXISTS temp := file_search(input_file); !So a search list works if (temp = "" ) THEN new_file := TRUE else new_file := FALSE; full_filnam := temp; endif; !CHECK FOR /NOCREATE !+ if /nocreate is present and file does not exist,then exit ! if (NOT get_info(command_line,'create') AND ! /nocreate specified (new_file) AND ! file does not exist (input_file <> "")) THEN ! file was specified message('Input file does not exist: '+full_filnam); QUIT(OFF,EDX$K_ERROR); ! input file doesn't exist and we're not allowed to create one else ! so exit with ERROR status. temp:=file_search("") ! reset file_search endif; !DETERMINE TYPE OF JOURNALING WE SHOULD DO if ((get_info(command_line,'journal')) and (not get_info(command_line,'read_only'))) then journal_file := get_info (command_line,'journal_file'); If ( (journal_file = "") !/JOURNAL with no = and (VS$MIN_VERSION <> VS$X_VAXTPU22) ) !and not compiled under VAXTPU V2.2 which doesn't have buffer journaling then !(NOTE: EDX will automatically ask to recompile when VMS is upgraded.) keystroke_journaling := FALSE; edtn$v_buffer_change_journaling := TRUE; !enable buffer journaling Else !Else /JOURNAL= keystroke_journaling := TRUE; edtn$v_buffer_change_journaling := FALSE; !disable buffer journaling Endif; else keystroke_journaling := FALSE; edtn$v_buffer_change_journaling := FALSE; endif; !DETERMINE IF WE ARE ATTEMPTING A RECOVERY OF BUFFER JOURNAL FILES if (get_info(command_line,'recover') and edtn$v_buffer_change_journaling) then jnl$recover; return; endif; !CREATE MAIN_BUFFER (WITH FILE IF SPECIFIED) if (new_file = 0) then edtn$fit_message("Reading in file !AS",full_filnam); if (NOT edtn$create_main_buffer(input_file)) then QUIT(OFF); endif; else if (length(input_file)=0) then full_filnam := ""; endif; edtn$fit_message("Creating new file !AS",full_filnam); main_buffer := create_buffer("MAIN"); if (length(full_filnam) <> 0) then set(output_file,main_buffer,full_filnam) endif; endif; !START BUFFER JOURNALING ON MAIN_BUFFER if edtn$v_buffer_change_journaling then set(bell,all,on); !Ring bell if error starting buffer journal file MAINBUFJNLOK := ENABLE_BUFFER_JOURNALING(MAIN_BUFFER); !start buffer journaling (VMS 5.3) set(bell,all,off); if (not mainbufjnlok) then edtn$x_goto_screen_mode:=FALSE; !pause first for errors edtn$v_buffer_change_journaling:=FALSE; !don't try buffer journaling, it didn't work endif; endif; if (get_info(command_line,'output')) then output_file_name := get_info(command_line,'output_file'); if (output_file_name <> "") then input_file_name_only := file_parse (input_file, "", "", NAME) + file_parse (input_file, "", "", TYPE); parsed_output_file_name := file_parse (output_file_name, input_file_name_only); if parsed_output_file_name <> "" then set(output_file,main_buffer,parsed_output_file_name); ! Want this buffer to be considered modified so it will be written on exit ! for use especially with MAIL/EDIT Set(MODIFIED,main_buffer,ON); ! Mark it as modified endif; endif; endif; set(eob_text,main_buffer,"[End of MAIN]"); position(beginning_of(main_buffer)); !Process /START_POSITION=(line[,column]) temp := get_info(command_line,'start_record'); if temp > 1 then goto_line(temp) endif; temp := get_info(command_line,'start_character'); if mark(none) <> end_of(current_buffer) then if temp > length(current_line) then position(LINE_END) else if temp > 1 then move_horizontal(temp-1) endif endif endif; !START KEYSTROKE JOURNALLING IF NEEDED If (keystroke_journaling) then if (input_file = "") then input_file_name_only := "TPU.TJL" else input_file_name_only := file_parse(input_file, "", "", NAME) + ".TJL" endif; journal_file := file_parse(journal_file, ".TJL", input_file_name_only); set(bell,all,on); !Ring bell if error starting keystroke journal file edtn$start_journal(journal_file); set(bell,all,off); Endif; IF GET_INFO(COMMAND_LINE,'NOMODIFY') THEN SET(MODIFIABLE,MAIN_BUFFER,OFF) ENDIF; !handle /NOMODIFY !PAUSE IF ERRORS WERE DETECTED DURING STARTUP if ( (NOT edtn$x_goto_screen_mode) AND (get_info(system,'display')) ) then message(""); !Open a line at the bottom for prompt to overwrite. (See note 1.) set(prompt_area,(screen_length),1,edtn$k_prompt_video); !Set prompt area to bottom of screen If (mainbufjnlok) then temp := read_line("Press any key to continue",1); !Let the user read the error messages Else temp := read_line("Press any key to continue. No buffers will be journaled.",1); !Let the user read the error messages Endif; set(prompt_area,(screen_length - 1),1,edtn$k_prompt_video); !Reset prompt area endif; !DISPLAY MAIN BUFFER IN MAIN WINDOW AND ADJUST MESSAGE WINDOW !Initially we leave message window large incase any large erros occur !during startup. Now just before mapping the main window, we readjust !the message window to the bottom two lines. We used to just let the !main window overlap the message window, but now with VMS 5.3 that caused !problems. Also leaving only two lines for message buffer speeds up work !over slow baud modems when using only top_window. if get_info(system,'display') then adjust_window( message_window, message_window_length-2, 0); !adjust message window message_window_length := 2; !new message_window_length map(main_window,main_buffer); !then map main window edtp$Set_Status_Line(main_window); !and set status line of main window endif; !SWITCH OFF ALL ANNOYING BELLS EXCEPT BROADCAST MESSAGES !SET MESSAGE ACTION TO HIGHLIGHT MESSAGES set (bell,broadcast,on); set (message_action_type, NONE); !set to REVERSE for certain messages set (message_action_level, 1); !all messages !SET THE "Working" TIMED MESSAGE ON ! Note: This is supposedly on by default according to the manual ! but experience shows that's not the case as of VMS 4.4 if get_info(system,'display') then set (timer,on); else set (timer,off); !Switch off if in /NODISPLAY mode endif; !BUG FIX VMS 5.3 MESSAGE WINDOW. (See description of problem at head of this file) if get_info(system,'display') then update(message_window) endif; !Sync message window !RUN USER'S LOCAL INITIALIZATION PROCEDURE (if he has one) !Note: The /COMMAND=file is actually not read in and executed until !this procedure completes, so the following command actually does !nothing unless a user has previously expanded and saved this as his own !section file. We leave it here since both EVE and EDTEM have it. ! Tpu$Local_Init; !WRITE MESSAGE IF USER SPECIFIED /COMMAND=file !On VMS 4 VAXTPU read in the command file and printed the message !"nnnn lines read from file XXXX" after this procedure exited. !On VMS 5 it prints the message first before running this procedure. !The message doesn't make it into the message_buffer because the message !buffer wasn't created yet. The message was printed using LIB$SIGNAL instead. !However, the actual running of the users /COMMAND file is after this procedure !exits. Thus we leave the message here. If (get_info(command_line,"command")) then IF (edtn$file_parse(full_command_file, get_info(command_line,'command_file'), ".TPU", "")) THEN If (file_search(full_command_file) <> "") then Message ("Initializing editing session using " + full_command_file); Endif; ENDIF; Endif; !That's it. From here on the user is on his own. ENDPROCEDURE !------------------------------------------------------------------------------ PROCEDURE EDT$INIT_VARIABLES ! initialize global variables Local Counter; !INITIALIZE DEFAULT SETTINGS edtn$k_prompt_video := REVERSE; !line mode prompt video edtn$x_mark_video := "NONE"; !May be changed by user edtn$x_keypad_mode := "EDT"; !Keypad mode. (Sync with final message and save during compilation) edtn$v_date_format_type := 2; !Long format (eg. April 15, 1987) edtn$v_date_format_case := 3; !Capitalize edtn$v_date_format_zeros:= 0; !No leading zeros edtn$x_date_format_ds:="/"; !as in 5/15/87 edtn$v_lock := FALSE; !lock all files by default? edtn$v_shift_amount := 32; !Default shift amount for Gold arrows edtn$v_columnar_mode := 0; !Set normal cut/paste select mode edt$x_wrap_position := 0; !Set nowrap edt$v_section_distance:=16; !lines to move for scroll main window edtn$v_half_section_distance:=8; !lines to move for scroll top/bottom window edtn$v_wide_window_width:=80; !Set toggle window width to 80 in case we enter at 132 edtn$v_free_cursor:=0; !Set cursor bound edtn$v_tab_key_tabs := TRUE; !Set tab_key tabs edtn$v_maxlines_match_paren := 48; !match parenthesis procedure gives up after this edtn$v_maxlines_fill_paragraph := 20; !maximum # lines fill_paragraph rewraps without prompting for confirmation edtn$v_autoindent := FALSE; !autoindent !INITIALIZE SEARCH SETTINGS edt$x_search_begin := 1; !Set search begin edtn$v_search_wild := 0; !Set search nowild jen$v_search_quietly := 1; !Set search quiet (nobeep, nobell) jen$v_search_next := 0; !Have not yet searched for a string. jen$x_search_string := 0; !(Start with no search string) jen$x_search_string_text := ""; jen$x_exclude_string:= ""; jen$x_replace_string := ""; !(missing from V6.2) jen$x_default_search_case := NO_EXACT; !Set search general jen$x_search_case := jen$x_default_search_case; !To avoid errors when unspecified jen$x_replace_case := NO_EXACT; !To avoid errors when unspecified jen$x_exclude_case := EXACT; !To avoid errors when unspecified !!Save_Search_Context; !NOT YET USEFUL. Set jen$x_save... variables. !INITIALIZE GLOBAL STRING VARIABLES edt$x_line := ""; !initialize as a string variable deleted_character := ""; deleted_word := ""; deleted_line := ""; !INITIALIZE OTHER VARIABLES edt$x_commands := 0; !Commands set at first call to do_command edt$x_delete_crlf:=0; edt$x_appended_line := 0; edt$x_beginning_of_select := 0; edt$x_search_range:=0; edt$x_select_range := 0; edtn$x_goto_screen_mode := TRUE; !Start in screen mode edt$x_repeat_count := 1; edt$x_target_column := 1; edt$x_prev_column := 1; edtn$v_locked_files:= FALSE; !Have we locked some files yet? edtn$v_tmpmrk:=0; edtn$v_left_margin:=1; !default left margin is 1 edtn$x_password := ""; bufw$m_dualpos := 0; !define as variable eve$mark_last := 0; !define as variable ! ! !SET UP GLOBAL SEARCH & PATTERN VARIABLES ! EVE$PATTERN_PARAGRAPH_BREAK := ! Blank line or Runoff command line anchor & line_begin & (("." & any (edtn$x_alphabetic)) | (("" | span (edt$x_word)) & line_end)); ! EDT$X_WHIT_PAT := ! patterns for matching a blank line line_begin &(line_end|(span(eve$x_whitespace)&line_end))&line_begin; ! EDTN$PATTERN_SENTENCE := (any(".?!")&(span(eve$x_whitespace)|line_end)); ! EDT$X_FORWARD_WORD:= ! don't move off current character position ( anchor & ! if on eol,then match that ( (line_end) | !leading spaces,on a word delimiter (span(' ') ) ) !((span(' ')) & (any(edt$x_word) | "") ) ) | !no leading spaces,on a word delimiter,move one past it (any(edt$x_word)) | !no leading spaces,on a real word,go one beyond it (scan(edt$x_word)) | !no leading spaces,on a last real word of line, match rest of line Remain ) & ! after matching, skip over trailing spaces if any ! except if match occurred at the eol. In this case,don't skip over blanks (line_begin|span(' ') | "") ;!end pattern. ! ! EDTN$PATTERN_TOKEN_END := anchor !Start at current cursor position & !and ( scan(edtn$x_alphanumeric) ! Move over stuff until we find a word | ! or if already on a word "" ! do nothing ) & !Then ( span(edtn$x_alphanumeric) ! Move over word until we find end | ! or if end of word not found remain ! then accept to end of line ); ! ! EDTN$PATTERN_WORD_END := anchor !Start at current cursor position & !and ( scan(edtn$x_alphanumeric) ! Move over stuff until we find a word | ! or if already on a word "" ! do nothing ) & !Then ( scan(eve$x_whitespace) ! Move over word until we find end | ! or if end of word not found remain ! then accept to end of line ); ENDPROCEDURE !------------------------------------------------------------------------------ PROCEDURE EDTN$INIT_BUFFERS !Create all the necessary default buffers !The order of creation here determines the !order the SHOW BUFFERS command lists them. !Create buffers for system use only first. Local line_editing_mode; !CREATE THE RULER BUFFER ruler_buffer := create_buffer("RULER"); set(eob_text,ruler_buffer,""); set(permanent,ruler_buffer); set(no_write,ruler_buffer); set(system, ruler_buffer); set(overstrike,ruler_buffer); set(max_lines,ruler_buffer,2); !Minimum value is 2. position(ruler_buffer); copy_text(edtn$x_ruler_line); !Place ruler in ruler_buffer !CREATE THE PROMPT BUFFER prompt_buffer := create_buffer("PROMPT"); set(eob_text,prompt_buffer,""); set(permanent,prompt_buffer); set(no_write,prompt_buffer); set(system,prompt_buffer); set(max_lines,prompt_buffer,2); set(key_map_list,"pmt$kml_pmtbuf",prompt_buffer); line_editing_mode := get_info (SCREEN, "line_editing"); if (line_editing_mode <> 0) then set (line_editing_mode, prompt_buffer); endif; !CREATE THE RECALL BUFFER recall_buffer := create_buffer("RECALL"); set(eob_text,recall_buffer,""); set(permanent,recall_buffer); set(no_write,recall_buffer); set(system,recall_buffer); set(max_lines,recall_buffer,40); !CREATE THE SHOW BUFFER show_buffer := create_buffer("SHOW"); set(eob_text,show_buffer,""); set(permanent,show_buffer); set(no_write,show_buffer); set(system,show_buffer); !CREATE THE MESSAGE BUFFER !Note for /NODISPLAY mode we don't want a message buffer created !so message output will go to SYS$OUTPUT. If get_info(system,'display') then message_buffer := create_buffer("MESSAGE"); set(eob_text,message_buffer,""); set(permanent,message_buffer); set(no_write,message_buffer); set(system,message_buffer); message_buffer_length := 300; set(max_lines,message_buffer,message_buffer_length); Endif; !CREATE THE DICTIONARY BROWSE BUFFER dic_buffer := create_buffer("DIC"); set(eob_text,dic_buffer,""); set(permanent,dic_buffer); set(no_write,dic_buffer); set(system,dic_buffer); set(key_map_list,"spl$kml_dicbuf",DIC_BUFFER); !CREATE THE SEARCH BUFFER search_buffer := create_buffer("SEARCH"); set(eob_text,search_buffer,"[End of SEARCH]"); set(permanent,search_buffer); set(no_write,search_buffer); set(system,search_buffer); set(key_map_list,"edtn$kml_search",SEARCH_BUFFER); !CREATE THE DIRECTORY LISTING BUFFER dir_buffer := create_buffer("DIR"); set(eob_text,dir_buffer,""); set(permanent,dir_buffer); set(no_write,dir_buffer); set(system,dir_buffer); set(key_map_list,"edtn$kml_dirbuf",DIR_BUFFER); !CREATE THE PASTE BUFFER paste_buffer := create_buffer("PASTE"); set(eob_text,paste_buffer,"[End of PASTE]"); set(permanent,paste_buffer); set(no_write,paste_buffer); set(system,paste_buffer); ENDPROCEDURE !---------------------------------------------------------------------- PROCEDURE EDTN$INIT_WINDOWS !Create all the necessary default windows !GET WINDOW DIMENSIONS screen_length := get_info(screen,'visible_length'); main_window_length := screen_length - 2; bottom_window_length := main_window_length / 2; top_window_length := main_window_length - bottom_window_length; message_window_length := 12; !CREATE MAIN WINDOWS main_window := create_window (1, main_window_length, on); top_window := create_window (1, top_window_length, on); bottom_window := create_window (top_window_length + 1, bottom_window_length, on); !SET SCROLLING LIMITS ON MAIN WINDOWS set(scrolling,main_window,on,6,7,0); set (scrolling,top_window,on,3,3,0); set (scrolling,bottom_window,on,3,3,0); !CREATE WINDOW FOR SHOW BUFFER AND HELP BUFFER info_window := create_window (1, main_window_length, off); edtn$set_info_window_statln; !CREATE WINDOW FOR MESSAGE BUFFER message_window := create_window (screen_length-message_window_length+1, message_window_length, off); set(video,message_window,none); !CREATE WINDOW FOR RULER ruler_window := create_window (1,1,off); set(video,ruler_window,reverse); !CREATE THE PROMPT AREA set(prompt_area,(screen_length - 1),1,edtn$k_prompt_video); prompt_window := create_window(screen_length - 1,1,off); set(video,prompt_window,edtn$k_prompt_video); ENDPROCEDURE !---------------------------------------------------------------------- PROCEDURE EDTN$CREATE_MAIN_BUFFER(INPUT_FILE) !This procedure is used during startup to create the main buffer !when it includes reading in a file. It is used here to catch serious errors. !The common error TPU-E-NOCACHE (Insufficient virtual memory to allocate a !new cache) occurs when the file being edited is too big. As of VMS 4.4 !this error leads instantly to a fatal internal TPU error if not caught. !This procedure is used instead of edtn$create_buffer because it is faster. !It doesn't use the EXECUTE command needed when the buffer name to be created !is not previously known. ! ON_ERROR [TPU$_NOCACHE,TPU$_GETMEM]: SET(BELL,ALL,ON); !Let's ring the bell a lot too !We do it all in one single message here so it looks better. MESSAGE("ERROR: The file you are trying to edit may be too big. "+ "***** Your process paging file quota (pgflquo) determines the maximum "+ "***** size file you may edit. "+ "***** You may ask the system manager to increase your paging file quota "+ "***** to edit larger files. "+ "ABORTING EDX EDITOR "); RETURN(0); [TPU$_TRUNCATE]: edx_message( error_text ); [OTHERWISE]: !print error and abort if bad, else return 0. !!IF ( ( MESSAGE_TEXT(ERROR,TPU$K_MESSAGE_SEVERITY) = "%E" ) IF ( GET_INFO( MAIN_BUFFER, 'TYPE' ) <> BUFFER ) THEN RETURN(0) ELSE RETURN(1) ENDIF; ENDON_ERROR; main_buffer := create_buffer("MAIN",input_file); Return(1); ENDPROCEDURE !---------------------------------------------------------------------- PROCEDURE EDTN$START_JOURNAL(journal_file) !This procedure traps errors while opening a keystroke journal file. !A common error is TPU$_BADJOUFILE which can be a result of insufficient !privilege to open a journal file in the current directory. ON_ERROR [OTHERWISE]: !print error, set edtn$x_goto_screen_mode, return(false); edtn$x_goto_screen_mode := FALSE; ENDON_ERROR; journal_open (journal_file); return(1); ENDPROCEDURE !---------------------------------------------------------------------- PROCEDURE EDTN$FILE_PARSE( output, input, def, related) !This procedure checks if a file spec is valid !and prints the error message if there is one. LOCAL default, code, result; ON_ERROR [OTHERWISE]: !Print error. Return 0. ENDON_ERROR; if (def = "") then default := ""; !Set data type to string in case file_parse bombs default := file_parse( ""); else default := def endif; output := file_parse( input, default, related); return(1); ENDPROCEDURE; !------------------------------------------------------------------------------ ! This dummy procedure is here as a hook for local ones. ! PROCEDURE TPU$LOCAL_INIT ! local initialization tpu$local_init := 1; ENDPROCEDURE !------------------------------------------------------------------------------ !****************************************************************************** ! CURSOR STATE !****************************************************************************** PROCEDURE CS$CURSOR_OUTER_SPACE !This gets changed at VMS 5.3 (TPU 2.4) !to NOT GET_INFO(CURRENT_BUFFER,'bound') RETURN( NOT GET_INFO(MARK(FREE_CURSOR),'bound')); ENDPROCEDURE PROCEDURE CURSOR_LINE_NUMBER !This gets changed at VMS 5.3 (TPU 2.4) !to GET_INFO(CURRENT_BUFFER,'record_number') RETURN(GET_INFO(mark(free_cursor),'record_number')); ENDPROCEDURE; !****************************************************************************** ! CURSOR MOVEMENT !****************************************************************************** PROCEDURE MOVE_RIGHT(num_chars) LOCAL n,dr; n := num_chars; if n < 0 then Dr := -1 else dr := 1 endif; loop exitif n=0; edtn$horizontal(dr); n := n - dr; endloop; ENDPROCEDURE PROCEDURE MOVE_LEFT(num_chars) LOCAL n,dr; n := num_chars; if n < 0 then Dr := -1 else dr := 1 endif; loop exitif n=0; edtn$horizontal(-dr); n := n - dr; endloop; ENDPROCEDURE PROCEDURE EDTN$HORIZONTAL(WHICH_WAY) IF ( (edtn$v_free_cursor) AND (get_info(system,'display')) ) THEN If (NOT ((which_way = -1) and (get_info(current_window,'current_column') + get_info(current_window,'shift_amount') = 1 )) ) then cursor_horizontal(which_way); return; Endif; ENDIF; position(TEXT); !snap cursor to text move_horizontal(which_way); ENDPROCEDURE PROCEDURE MOVE_UP(num_lines) LOCAL n,dr; n := num_lines; if n < 0 then Dr := -1 else dr := 1 endif; loop exitif n=0; edtn$vertical(-dr); n := n - dr; endloop; ENDPROCEDURE PROCEDURE MOVE_DOWN(num_lines) LOCAL n,dr; n := num_lines; if n < 0 then Dr := -1 else dr := 1 endif; loop exitif n=0; edtn$vertical(dr); n := n - dr; endloop; ENDPROCEDURE PROCEDURE EDTN$VERTICAL(WHICH_WAY) !Up/Down arrow keys ! EDT up/down arrow motion with grace near tabs; ! Originally from CSC DSIN article "How to More closely Emulate EDT Vertical Motion in TPU." ! Also from DECUS Symposium 12/85 "Programming with TPU." ! LOCAL cw, cr, vt, st, N, vb, sb, last_col, here; IF ( (edtn$v_free_cursor) AND (get_info(system,'display')) ) THEN !FREE CURSOR MOTION cw := current_window; cr := get_info (cw, 'current_row'); If (which_way = -1) then !MOVE UP ONE FREE CURSOR MOTION vt := get_info (cw, 'visible_top'); st := get_info (cw, 'scroll_top'); If (cr <= (vt + st)) then SET(SCREEN_UPDATE,OFF); !Prevent jerkey updates for 3 line windows here := mark(free_cursor); !Necessary due to a bug in scroll N := scroll (current_window, -1); !which causes the cursor to loose position(here); !its place if the screen is shifted if (cr > vt) then !and the cursor is free. cursor_vertical(-1); endif; SET(SCREEN_UPDATE,ON); !Prevent jerkey updates for 3 line windows Else cursor_vertical(-1); Endif; Else !MOVE DOWN ONE FREE CURSOR MOTION vb := get_info (cw, 'visible_bottom'); sb := get_info (cw, 'scroll_bottom'); If (cr >= (vb - sb)) then SET(SCREEN_UPDATE,OFF); !Prevent jerkey updates for 3 line windows here := mark(free_cursor); !Necessary due to a bug in scroll N := scroll (current_window, 1); !which causes the cursor to loose position(here); !its place if the screen is shifted if (cr < vb) then !and the cursor is free. cursor_vertical(1); endif; SET(SCREEN_UPDATE,ON); !Prevent jerkey updates for 3 line windows Else cursor_vertical(1); Endif; Endif; ELSE !BOUND CURSOR MOTION position(TEXT); !Synchronize cursor with editing position last_col := get_info(current_buffer,'offset_column'); If (last_col <> edt$x_prev_column) then edt$x_target_column := last_col Endif; move_vertical (which_way); edt$x_prev_column := edtn$gotocol(edt$x_target_column); !Move as close to target column as possible. ENDIF; ENDPROCEDURE !------------------------------------------------------------------------------ PROCEDURE GOTO_COLUMN(n) ! Go to text column n. Lay spaces as necessary. LOCAL new_col; edtn$gotocol(n); new_col := get_info(current_buffer,'offset_column'); if (new_col <> n) then ENABLE_BUFFER_JOURNALING(CURRENT_BUFFER); copy_text(FAO("!"+str(n-new_col)+"* ")) !Add spaces as necessary. endif; ENDPROCEDURE PROCEDURE EDTN$GOTOCOL(target_column) ! Move as close to the target offset column as possible ! Returns column moved to ! LOCAL new_col, temp_col, line_length, dis, buf; position(TEXT); buf := current_buffer; new_col := get_info(buf,'offset_column'); IF new_col <> target_column THEN !Make one attempt to jump closer, then step. !This helps speed up the procedure dis := target_column - new_col; IF (dis <= 0) then !If we need to move backwards if ( -dis <= current_offset ) !then if distance to move won't take us beyond the beginning of line then move_horizontal(dis) !then move that distance else !else position(LINE_BEGIN); !move to beginning of line endif; ELSE !Else we need to move forwards if (current_offset <> 0) then line_length := length(current_line) else line_length := 0 endif; if ( dis <= line_length - current_offset) !If distance to move won't take us beyond the end of line then move_horizontal(dis) !then move that distance else !else move_horizontal(line_length-current_offset) !move to the end of the line endif; ENDIF; !Now do the fine tuning new_col := get_info(buf,'offset_column'); IF new_col < target_column THEN !Make one attempt to jump closer, then step. dis := target_column - new_col; LOOP exitif mark(none) = end_of(buf); exitif current_character = ""; !at eol exitif new_col >= target_column; move_horizontal (1); temp_col := get_info(buf,'offset_column'); If temp_col > target_column Then move_horizontal(-1); exitif; Else new_col := temp_col Endif; ENDLOOP; ELSE LOOP exitif current_offset = 0; exitif new_col <= target_column; move_horizontal(-1); new_col := get_info(buf,'offset_column'); ENDLOOP; ENDIF; ENDIF; Return (new_col); ENDPROCEDURE !---------------------------------------------------------------------- PROCEDURE TAB ! Insert a tab or move to next tab stop LOCAL userbuf, !User's buffer col, !Starting column ncol, !New column beol, !Beyond or at end of line beob, !Beyond end of buffer entry_mode; IF (edtn$v_tab_key_tabs) THEN hard_tab; !hard_tab enables buffer journaling. Avoids VMS 5.4 fatal error ELSE ENABLE_BUFFER_JOURNALING(CURRENT_BUFFER); !GET INITIAL STATE beol := 0; beob := 0; userbuf := current_buffer; If get_info(system,'display') then col := get_info(current_window,'current_column') + get_info(current_window,'shift_amount'); Else col := get_info(current_buffer,'offset'); Endif; If (col = 1) then if (mark(free_cursor) = end_of(userbuf)) then beob := 1 endif Endif; If (not beob) then if ( (get_info(userbuf,'character') = "") and ( current_offset > 0 ) ) then beol := 1 endif Endif; !DETERMINE WHERE NEXT TAB IS position(beginning_of(ruler_buffer)); edtn$gotocol(col); loop exitif current_offset > 255; move_horizontal(1); exitif current_character = 'T'; endloop; ncol := get_info(ruler_buffer,'offset') + 1; position(userbuf); !IF NO NEXT TAB SET THEN WRAP TO NEXT LINE If (ncol >= 255) then position(TEXT); split_line; Else !MOVE TO NEXT TAB SETTING. !IF NOT BEYOND EOL AND IN INSERT MODE THEN ADD SPACES if (not beol) and (get_info(userbuf,'mode') = insert) then copy_text(FAO("!"+str(ncol-col)+"* ")); !add spaces Else !BEYOND EOL OR OVERSTRIKE MODE, MOVE CURSOR TO NEXT TAB STOP cursor_horizontal(ncol-col); Endif; Endif; ENDIF; ENDPROCEDURE PROCEDURE HARD_TAB !AVOID VMS 5.4 FATAL INTERNAL ERROR !TPU does not journal the key correctly in OVERSTRIKE mode on VMS 5.4 !It results in a fatal internal VAXTPU error. So we avoid that here by !emulating inserting a tab in overstrike mode. !If (mode=insert) then ! insert tab !else ! temporarily switch to insert mode ! save cursor column ! insert tab ! calculate how far cursor moved ! and delete that many characters from rest of line !endif Local entry_mode,save_col; ENABLE_BUFFER_JOURNALING(CURRENT_BUFFER); entry_mode := get_info(current_buffer,'mode'); IF (entry_mode = insert) THEN COPY_TEXT(EDT$X_TAB_CHAR); ELSE set(insert,current_buffer); save_col := get_info(current_buffer,'offset_column'); COPY_TEXT(EDT$X_TAB_CHAR); erase_character( get_info(current_buffer,'offset_column') - save_col ); set(overstrike,current_buffer); ENDIF; ENDPROCEDURE !------------------------------------------------------------------------------ PROCEDURE MOVE_BY_WORD edt$move_word(current_direction); ENDPROCEDURE PROCEDURE EDT$MOVE_WORD(direction) ! EDT Move to the next word (kp2 move word) position(TEXT); If (direction = forward) then if (edt$end_word = 0) then move_horizontal(1) endif; Else if (edt$beg_word = 0) then ! Move to beginning of word, back a line if none move_horizontal(-1) endif; Endif; ENDPROCEDURE !------------------------------------------------------------------------------ ! PROCEDURE EDT$BEG_WORD !Find the beginning of word LOCAL temp_length; position(TEXT); if current_offset = 0 then return 0 endif; move_horizontal(-1); ! Skip current character temp_length := 1; ! ! Count any spaces ! loop exitif current_offset = 0; exitif index (eve$x_whitespace, current_character) = 0; move_horizontal(-1); temp_length := temp_length + 1; endloop; ! ! IF we are on a word terminator count that one character. Otherwise ! scan to the next word terminator. ! if (index(edt$x_word,current_character) = 0) then loop exitif current_offset = 0; move_horizontal(-1); if (index(edt$x_word,current_character) <> 0) then move_horizontal(1); exitif; endif; temp_length := temp_length + 1; endloop; endif; return temp_length; ENDPROCEDURE !------------------------------------------------------------------------------ ! ! Find the end of the word ! PROCEDURE EDT$END_WORD !Find the end of the word LOCAL temp_range, temp_length; ON_ERROR ! Suppress "string not found" message return (0); ENDON_ERROR position(TEXT); if current_character = "" then return (0) endif; temp_range:=search(edt$x_forward_word,forward); temp_length:=length(temp_range); move_horizontal(temp_length); return (temp_length); ENDPROCEDURE !------------------------------------------------------------------------------ PROCEDURE BEG_OF_WORD position(TEXT); if (mark(none) = beginning_of(current_buffer)) then edx_message ("Attempt to move past the beginning of buffer " + get_info(current_buffer,'name') ); return 0; endif; move_horizontal(-1); ! Skip current character if current_character = "" then return endif; ! Stop if moved to end of previous line ! ! span any alphanumeric ! loop exitif current_offset = 0; exitif index (edtn$x_alphanumeric, current_character) = 0; move_horizontal(-1); endloop; ! ! scan any alphanumeric ! loop exitif current_offset = 0; exitif ( index(edtn$x_alphanumeric, current_character) <> 0 ); move_horizontal(-1); endloop; ENDPROCEDURE PROCEDURE END_OF_WORD !add (reverse|forward) parameter ! Move to end of current word. If not on a word then move to end of next word. LOCAL ran; position(TEXT); set(forward,current_buffer); ran := search(edtn$pattern_token_end, forward); If (ran = 0) then if (mark(free_cursor) = end_of(current_buffer)) then edx_message ("Attempt to move past the end of buffer " + get_info(current_buffer,'name') ) endif; Return; Endif; If length(ran) = 0 then move_horizontal(1) Else move_horizontal(length(ran)) Endif; ENDPROCEDURE; !---------------------------------------------------------------------- PROCEDURE MOVE_BY_LINE edtn$move_by_line(current_direction); ENDPROCEDURE PROCEDURE EDTN$MOVE_BY_LINE(DIRECTION) !kp0 (next line), backspace key LOCAL curs_offset; If (direction = forward) then position(TEXT); move_vertical(1); position(LINE_BEGIN); Else curs_offset := get_info(current_buffer,'offset'); position(LINE_BEGIN); if (curs_offset = 0) then move_vertical(-1); position(LINE_BEGIN); endif; Endif; ENDPROCEDURE !------------------------------------------------------------------------------ !(The procedures BEG_OF_LINE and END_OF_LINE were more complicated in VMS 4.) PROCEDURE BEG_OF_LINE POSITION(LINE_BEGIN); !goto BOL ENDPROCEDURE PROCEDURE END_OF_LINE POSITION(LINE_END); !goto EOL ENDPROCEDURE !+ ! Move to the next End of Line !- PROCEDURE EDTN$END_OF_LINE !kp2 (move to end of line) position(TEXT); if current_direction = forward then if mark(free_cursor) <> end_of (current_buffer) then if (current_character = "") !If on end of line then move_vertical(1) !then move to beginning of next line endif; position(LINE_END); endif; else position(LINE_BEGIN); move_horizontal(-1); endif; ENDPROCEDURE ! end of EOL !!PROCEDURE DD1$EOL !End of line for DD1 keypad. Always moves forward !!position(TEXT); !!if ( mark(none) <> end_of (current_buffer) ) !!then !! if (current_character = "") !If on end of line !! then !! move_vertical(1) ! move to beginning of next line !! endif; !! position(LINE_END); !!endif; !!ENDPROCEDURE ! end of EOL !------------------------------------------------------------------------------ PROCEDURE NEXT_SCREEN edt$section(forward); ENDPROCEDURE PROCEDURE PREVIOUS_SCREEN edt$section(reverse); ENDPROCEDURE PROCEDURE EDT$SECTION ( DIRECTION_TO_MOVE ) !kp8 (section) LOCAL dr; position(TEXT); if (direction_to_move = forward) then dr := 1 else dr := -1 endif; If (get_info(system,'display') and ((current_window = top_window) or (current_window = bottom_window)) ) then move_vertical ( dr * edtn$v_half_section_distance ); Else move_vertical ( dr * edt$v_section_distance ); Endif; position(LINE_BEGIN); ENDPROCEDURE !------------------------------------------------------------------------------ !+ ! Process the 7 key, PAGE. !- PROCEDURE MOVE_BY_PAGE !kp7 (move to next page) LOCAL dir, form_feed; ON_ERROR if error = tpu$_strnotfound then if dir = REVERSE then position(beginning_of(current_buffer)) else position(end_of(current_buffer)) endif; endif; return; ENDON_ERROR; position(TEXT); dir := current_direction; eve$mark_LAST := mark(free_cursor); if dir = FORWARD then move_horizontal(1) else move_horizontal(-1) endif; form_feed := search(ascii(12),dir); position(beginning_of(form_feed)); ENDPROCEDURE; !------------------------------------------------------------------------------ PROCEDURE GOTO_TOP ! Mark current position as 'LAST' and then go to beginning of buffer eve$mark_LAST := mark(free_cursor); position(beginning_of(current_buffer)); set(forward,current_buffer); ENDPROCEDURE PROCEDURE GOTO_END ! For ease of use. goto_bottom; ENDPROCEDURE PROCEDURE GOTO_BOTTOM ! Mark current position as 'LAST' and then go to end of buffer eve$mark_LAST := mark(free_cursor); position(end_of(current_buffer)); ENDPROCEDURE !------------------------------------------------------------------------------ PROCEDURE GOTO_LINE(LINE_PARAMETER) ! Go to specified line number in a buffer ! LINE_PARAMETER - line number to go to (integer) ! or "" empty string for prompting LOCAL linenum, ! Local copy of line_parameter last_line; ! Number of lines in buffer, including eob_text ON_ERROR edx_message (""); edx_message ("Cannot move to line !SL", EDX$K_WARN_HIGHLIGHT, linenum); return; ENDON_ERROR; if get_info(line_parameter,'TYPE') <> INTEGER then If get_info(system,'display') then linenum := edx_read_line("Line number: ",,"CTRL-Z"); if length(linenum) > 0 then linenum := int(linenum) endif; Else linenum := 0 Endif else linenum := line_parameter endif; if linenum <= 0 then if (last_key <> ctrl_z_key) then edx_message ("Cannot move to line !SL", EDX$K_WARN_HIGHLIGHT, linenum); endif; return; endif; last_line := get_info (current_buffer, 'record_count'); ! + 1; ! include eob_text? If linenum > last_line then if last_line > 0 then edx_message ("Buffer has only !SL line!%S", EDX$K_WARN_HIGHLIGHT, last_line); position(end_of(current_buffer)); !! else !! edx_message ("Buffer is empty"); !say nothing when starting up with an empty buffer endif; Else position(linenum); edx_message ("At line !SL of buffer !AS", EDX$K_INFO, linenum, get_info(current_buffer,'name')); Endif; ENDPROCEDURE; !---------------------------------------------------------------------- !****************************************************************************** ! ENTERING TEXT !****************************************************************************** PROCEDURE ENTER_TEXT(CHAR) ! Originally edt$wrap_word ! Bound to printable keys. Used to wrap words when SET WRAP issued. ! LOCAL word_size; ENABLE_BUFFER_JOURNALING(CURRENT_BUFFER); vs$copy_char(char); !(in case char is and current_buffer is in overstrike avoid VMS 5.4 fatal error) If (char = edt$x_space) then return Endif; IF (edt$x_wrap_position <> 0) AND (get_info(current_buffer,'offset_column') > edt$x_wrap_position+1) THEN word_size := edt$beg_word; !Wrap word to next line If (get_info(current_buffer,'offset_column') > edtn$v_left_margin) then move_horizontal(-1); if (current_character = edt$x_space) then erase_character(1) !Remove trailing space from line else !so FILL function will work properly. move_horizontal(1) endif; new_line; move_horizontal(word_size); Endif; ENDIF; ENDPROCEDURE !------------------------------------------------------------------------------ PROCEDURE NEW_LINE ! Procedure invoked by the Return key. Split the current line, ! obeying margin settings, and autoindenting. ! Inspired by eve_return local lm, curs_col, entry_mode, pat, rn, indent_string; ! SPLIT THE LINE ENABLE_BUFFER_JOURNALING(CURRENT_BUFFER); entry_mode := get_info(current_buffer,'mode'); set(insert,current_buffer); split_line; ! INDENT IF (edtn$v_autoindent) then !then indent to level of previous non-blank line move_horizontal(-1); !move back to previous line for search PAT := line_begin & ( span(eve$x_whitespace) | "" ) & notany(eve$x_whitespace); rn := search_quietly(PAT,reverse); move_horizontal(1); !move forward to new line curs_col := get_info(current_buffer,'offset_column');!hard left margin of new line lm := get_info(beginning_of(rn),'offset_column'); !hard left margin of previous line If lm > curs_col then loop copy_text(edt$x_space); curs_col := curs_col + 1; exitif curs_col >= lm; endloop; Endif; If (rn <> 0) then !if a previous indent range was found COPY_TEXT( substr(rn, 1, length(rn)-1 )); !drop the first notany(whitespace) character Endif; ENDIF; ! LEFT MARGIN (soft) lm := edtn$v_left_margin; ! Soft Left Margin curs_col := get_info(current_buffer,'offset_column'); if lm > curs_col then loop copy_text(edt$x_space); curs_col := curs_col + 1; exitif curs_col >= lm; endloop; endif; if entry_mode = overstrike then set(overstrike,current_buffer) endif; set(forward,current_buffer); ENDPROCEDURE; !---------------------------------------------------------------------- !****************************************************************************** ! DELETING TEXT !****************************************************************************** !+ ! EDT rubout key !- !Delete the previous character ! PROCEDURE DELETE_PREVIOUS_CHARACTER ! rubout key (erase prev chr) LOCAL MK; IF get_info(system,'display') THEN If get_info(current_window,'beyond_eol') then position(line_end); return; Endif; ENDIF; ENABLE_BUFFER_JOURNALING(CURRENT_BUFFER); IF current_offset = 0 then deleted_character := ascii(10); append_line; MK := mark(none); IF (MK = end_of(current_buffer)) AND (MK <> beginning_of(current_buffer)) THEN move_horizontal(-1) ENDIF; ELSE If (get_info(current_buffer,'mode') = insert) then deleted_character := erase_character(-1); Else move_horizontal(-1); deleted_character := current_character; copy_text(edt$x_space); move_horizontal(-1); Endif; ENDIF; ENDPROCEDURE !------------------------------------------------------------------------------ ! ! EDT DELETE CHARACTER ! PROCEDURE DELETE_CHARACTER !keypad comma (delete chr) local temp_line; ENABLE_BUFFER_JOURNALING(CURRENT_BUFFER); position(TEXT); IF mark(free_cursor) = end_of(current_buffer) then edx_message ("Attempt to delete past the end of buffer " + get_info(current_buffer,'name') ) ELSE If (current_character = "") then deleted_character := ascii(10); temp_line := current_line; move_horizontal(1); if (mark(none) <> end_of(current_buffer)) or (length(temp_line) = 0) then append_line else move_horizontal (-1) endif; Else if (get_info(current_buffer,'mode') = insert) then deleted_character := erase_character(1); else deleted_character := current_character; copy_text(edt$x_space); move_horizontal(-1); endif; Endif; endif; ENDPROCEDURE !------------------------------------------------------------------------------ ! ! EDT Delete to beginning of word ! PROCEDURE EDT$DEL_BEG_WORD ! support routine for delete word (forward) LOCAL temp_length ; ENABLE_BUFFER_JOURNALING(CURRENT_BUFFER); temp_length := edt$beg_word; ! Go to beginning of word if temp_length = 0 then if mark(none) = end_of (current_buffer) then move_horizontal (-1) else append_line endif; deleted_word := ascii(10); else deleted_word := erase_character(temp_length) endif; ENDPROCEDURE !------------------------------------------------------------------------------ ! ! Delete to end of word ! PROCEDURE DELETE_WORD ! keypad minus (delete word) LOCAL temp_length ; ENABLE_BUFFER_JOURNALING(CURRENT_BUFFER); temp_length := edt$end_word; if temp_length = 0 ! then we are on eol then if mark(none) <> end_of (current_buffer) then deleted_word:=ascii(10); ! line feed move_horizontal(1); if mark(none) <> end_of (current_buffer) then append_line ! join both lines else move_horizontal (-1) endif; else edx_message ("Attempt to delete past the end of buffer " + get_info(current_buffer,'name') ) endif; else deleted_word := erase_character(- temp_length) ! delete the word endif; ENDPROCEDURE !------------------------------------------------------------------------------ ! ! EDT Delete to the beginning of the line ! PROCEDURE DELETE_START_OF_LINE !ctrl u ( delete to beg. of line) ENABLE_BUFFER_JOURNALING(CURRENT_BUFFER); position(TEXT); deleted_line := erase_character(- current_offset); if deleted_line = "" ! then delete previous line then if mark(none) <> beginning_of(current_buffer) then move_vertical(-1); position(LINE_BEGIN); !(Note 1) delete_line; ! delete the entire previous line endif; endif; edt$x_delete_crlf := 0; edt$x_appended_line := 0; ENDPROCEDURE !------------------------------------------------------------------------------ ! ! EDT Delete to the end of the line ! PROCEDURE DELETE_END_OF_LINE !gold kp2 ( delete to end of line) !The below line works because the erase_character will stop at the end of line ! we will only pick up from the current point to the end of the line unless ! we are already on the end of line. In this case we are supposed to deleted ! the line terminator plus the entire next line. ! ENABLE_BUFFER_JOURNALING(CURRENT_BUFFER); position(TEXT); if mark(none) = end_of (current_buffer) then return endif; if current_offset = length (current_line) then move_vertical(1); if mark(none) <> end_of (current_buffer) then position(LINE_BEGIN); deleted_line := erase_line; edt$x_appended_line := 1; edt$x_delete_crlf := 0; else edt$x_appended_line := 0; edt$x_delete_crlf := 1; endif; move_horizontal (-1); else if mark(none) <> end_of (current_buffer) then deleted_line := erase_character(length(current_line)); edt$x_appended_line := 0; edt$x_delete_crlf := 0; else edt$x_appended_line := 0; edt$x_delete_crlf := 1; endif; endif; set(forward,current_buffer); ENDPROCEDURE !------------------------------------------------------------------------------ ! ! EDT delete line ! PROCEDURE DELETE_LINE !pf4 (delete line) ENABLE_BUFFER_JOURNALING(CURRENT_BUFFER); position(TEXT); If current_offset = 0 then if mark(none) <> end_of(current_buffer) then deleted_line := erase_line else edx_message ("Attempt to delete past the end of buffer " + get_info(current_buffer,'name') ) endif; Else deleted_line := erase_character(length(current_line)); move_vertical(1); if mark(none) <> end_of(current_buffer) then position(LINE_BEGIN); append_line; else move_horizontal(-1) endif; Endif; edt$x_delete_crlf := 1; edt$x_appended_line := 0; ENDPROCEDURE !------------------------------------------------------------------------------ !****************************************************************************** ! UNDELETING TEXT !****************************************************************************** PROCEDURE UNDELETE_CHARACTER !gold comma (undelete character) ENABLE_BUFFER_JOURNALING(CURRENT_BUFFER); if deleted_character <> ascii(10) then vs$copy_char(deleted_character) !in case deleted_character is avoid VMS 5.4 fatal error else split_line endif; move_horizontal (-1); ENDPROCEDURE !------------------------------------------------------------------------------ PROCEDURE UNDELETE_WORD !gold keypad minus(undelete word) ENABLE_BUFFER_JOURNALING(CURRENT_BUFFER); if deleted_word <> ascii(10) then if substr(deleted_word, 1, 1) = ascii(10) then split_line; vs$copy_string(substr(deleted_word, 2, length(deleted_word) - 1)); !avoid VMS 5.4 fatal error else vs$copy_string(deleted_word) !avoid VMS 5.4 fatal error endif; move_horizontal( - length (deleted_word)); else split_line; move_horizontal (-1); endif; ENDPROCEDURE !------------------------------------------------------------------------------ PROCEDURE UNDELETE_LINE !gold pf4 (undelete line) LOCAL temp_length; ENABLE_BUFFER_JOURNALING(CURRENT_BUFFER); if (edt$x_appended_line) then split_line; vs$copy_string(deleted_line); !avoid VMS 5.4 fatal error position(LINE_BEGIN); move_horizontal (-1); else temp_length := length(deleted_line); if (edt$x_delete_crlf = 1) and (mark(none) <> end_of(current_buffer)) then split_line; move_horizontal(-1); endif; vs$copy_string(deleted_line); !avoid VMS 5.4 fatal error move_horizontal( - ( temp_length ) ); endif; ENDPROCEDURE !------------------------------------------------------------------------------ !****************************************************************************** ! CUT/PASTE OPERATIONS !****************************************************************************** PROCEDURE START_SELECT !Normal start select. Here for ease of use. edtn$select_block; ENDPROCEDURE PROCEDURE CUT !Normal cut to paste buffer operation edtn$cut_block(0,paste_buffer,0); ENDPROCEDURE PROCEDURE PASTE !Normal paste here from paste buffer operation edtn$paste_block(paste_buffer); ENDPROCEDURE PROCEDURE UNPASTE !Immediately undo a paste that was unintentional !Assumptions: ! We have just done a paste and have not moved ! Text immediately before cursor matches text in PASTE buffer Local start_pos, cb, start_mark; ON_ERROR [TPU$_BEGOFBUF]: edx_message("Text before cursor doesn't match text in PASTE buffer",EDX$K_ERROR_HIGHLIGHT); position(start_pos); [OTHERWISE]: !otherwise print error and return(false); ENDON_ERROR; !SAVE USER'S BUFFER cb := current_buffer; !MAKE SURE WE ARE NOT CURRENTLY POSITIONED IN THE PASTE BUFFER If cb = PASTE_buffer then edx_message("Can not unpaste while in the paste buffer",EDX$K_ERROR_HIGHLIGHT); Return(0); Endif; !INITIALIZE. ENABLE_BUFFER_JOURNALING(CB); position(TEXT); start_pos := mark(none); !CHECK FOR AT START OF USER'S BUFFER. If start_pos = beginning_of(cb) then edx_message("Nothing above to unpaste",EDX$K_WARN_HIGHLIGHT); Return(0); Endif; !CHECK FOR PASTE BUFFER EMPTY. position(end_of(PASTE_buffer)); If mark(none) = beginning_of(PASTE_buffer) then edx_message("PASTE buffer is empty",EDX$K_WARN_HIGHLIGHT); position(start_pos); Return(1); !Since in a way we can say we did it successfully Endif; move_horizontal(-1); !in PASTE buffer. Must backup off [End of PASTE] position !MAIN LOOP. CHECK THAT WHAT WE UNPASTE MATCHES PASTE BUFFER LOOP position(PASTE_buffer); If mark(none) = beginning_of(PASTE_buffer) then !All done. Position to user buffer and erase selected range position(cb); start_mark := mark(none); position(start_pos); move_horizontal(-1); !position on last character pasted erase( create_range(start_mark,mark(none),none) ); position(start_pos); !Position back to where we started Return (1); !Normal successful return here. Endif; move_horizontal(-1); !backup one char in PASTE buffer position(cb); !go to user's buffer move_horizontal(-1); !backup one char in user's buffer !Now check chars to make sure they still match. if get_info(cb,'character') <> get_info(PASTE_buffer,'character') then !error - paste buffer doesn't sync with user buffer edx_message("PASTE buffer doesn't sync with user buffer",EDX$K_ERROR_HIGHLIGHT); position(start_pos); return (0); endif; ENDLOOP; ENDPROCEDURE !------------------------------------------------------------------------------ PROCEDURE EDTN$SELECT_BLOCK if (edtn$v_columnar_mode) then edtn$columnar_select else edt$select endif; ENDPROCEDURE PROCEDURE EDTN$CUT_BLOCK(pick,buf,move) edtn$clear_message_window; !erase 'Select started..." message if (edtn$v_columnar_mode) then return edtn$columnar_cut(pick,buf,move) else return edtx$copy_to(pick,buf) endif; ENDPROCEDURE PROCEDURE EDTN$PASTE_BLOCK(buf) if (edtn$v_columnar_mode) then edtn$columnar_paste(buf) else edtx$copy_from(buf) endif; ENDPROCEDURE !------------------------------------------------------------------------------ PROCEDURE EDT$SELECT !keypad dot (select) if edt$x_beginning_of_select <> 0 then edx_message("Select already active",EDX$K_WARN_HIGHLIGHT); else If cs$cursor_outer_space then enable_buffer_journaling(current_buffer) !it's going to lay down a space at the endif; !cursor position and modify the buffer edt$x_beginning_of_select := select(REVERSE); edx_message("Select started..."); endif; ENDPROCEDURE !------------------------------------------------------------------------------ !+ ! Procedure to create the select range !- PROCEDURE EDT$SELECT_RANGE ! cut support routine if (edt$x_beginning_of_select <> 0) then position(TEXT); ! snap for select_range edt$x_select_range := select_range; ! If the select range is zero, this means that we are still ! positioned on the beginning of the select range. Create ! a range of length zero so that EDT emulation works better. if (edt$x_select_range = 0) then position (end_of(current_buffer)); edt$x_select_range := create_range (mark(none), mark(none), none); position (edt$x_beginning_of_select); endif; edt$x_beginning_of_select := 0; else ! Check for being on search string and repeat count <= 1 if (edt$x_search_range <> 0) then if (edt$on_search_range = 1) AND (edt$x_repeat_count <= 1) then edt$x_select_range := edt$x_search_range else edt$x_select_range := 0 endif else edt$x_select_range := 0 endif; endif; ENDPROCEDURE !------------------------------------------------------------------------------ !+ ! Procedure to determine if we are sitting on the search range. !- PROCEDURE EDT$ON_SEARCH_RANGE ! Select and substitute support routine local v_on_search; IF (get_info(edt$x_search_range,'type') <> range) then v_on_search := 0 ELSE if (edt$x_search_begin) then ! If SET SEARCH BEGIN is active then we should be sitting on the first ! character of the select range if (mark(free_cursor) = beginning_of(edt$x_search_range)) then v_on_search := 1 else v_on_search := 0 endif; else ! If SET SEARCH END is active, then we need to move back one in order ! to determine if a search range selection is active IF (mark(free_cursor) = beginning_of(current_buffer)) THEN v_on_search := 0 !Then it really doesn't matter ELSE If cs$cursor_outer_space then v_on_search := 0 Else move_horizontal(-1); !we're bound to text if mark(free_cursor) = END_OF(edt$x_search_range) then v_on_search := 1 else v_on_search := 0 endif; move_horizontal(1); Endif; ENDIF endif ENDIF; return v_on_search; ENDPROCEDURE; !------------------------------------------------------------------------------ PROCEDURE EDT$RESET ! gold keypad dot(reset) LOCAL here; edt$x_beginning_of_select := 0; edt$x_select_range := 0; set(forward, current_buffer); !Erase columnar select range edtn$rn_line_bot := 0; edtn$rn_line_top := 0; edtn$m_begin_select := 0; !Carefully determine if we need to erase edtn$m_tmpmark if (edtn$v_tmpmrk) then if get_info(edtn$m_tmpmrk,'bound') then here := mark(free_cursor); if (here <> end_of(current_buffer)) then if (get_info(edtn$m_tmpmrk,'offset') = (length(current_line)-1)) !Bound and not end of buffer then position(edtn$m_tmpmrk); ! character placed so if (current_character = edt$x_space) !edt$x_tmpmrk bound then ENABLE_BUFFER_JOURNALING(CURRENT_BUFFER); !Just in case it hasn't already been done erase_character(1); !erase space endif; position(here); endif; endif; endif; endif; ENDPROCEDURE !------------------------------------------------------------------------------ PROCEDURE EDTX$COPY_TO(PICK,BUF) ! Copies select range into specified buffer ! Originally procedure jc_copy_to from EDTEXT ! Also from edt$cut ! ! PARAMETERS: ! pick - 0 for cut, 1 for pick (copy without removing) ! buf - optional buffer to cut/copy to (buffer type variable, optional) ! ! After erasing the paste buffer, insert a blank line. This blank ! line is needed for the PASTE operation. When doing the paste, have ! to know if the line terminator on the last line should be included ! in the new text. ! LOCAL to_buffer, ! Buffer that range is copied to buffer_name, ! String containing buffer name of buffer to copy temp_position, ! Current cursor position entry_mode; !FINISH SELECT OF RANGE edt$select_range; !CHECK FOR NO SELECT ACTIVE if edt$x_select_range = 0 then edx_message("No Select Active"); edt$x_repeat_count := 1; return 0; endif; !GET BUFFER TO CUT/COPY TO to_buffer := buf; !Local copy of buf. May read in local copy IF (to_buffer = 0) then !If buffer specified then don't prompt If get_info(system,'display') then buffer_name := edx_read_line("Copy to buffer [PASTE]: ",,"CTRL-Z"); edit(buffer_name,trim,upper); If (buffer_name = '*') then buffer_name := edtn$newbufnam; Endif; Else buffer_name := "PASTE" Endif; If buffer_name <> "" then to_buffer := edt$find_buffer(buffer_name); if (to_buffer = 0) then to_buffer := edtn$create_buffer(buffer_name,""); if to_buffer = 0 then edt$x_select_range := 0; return 0; endif; endif; Else if (last_key = ctrl_z_key) then edt$reset; Return(0); !User didn't want this procedure else to_buffer := paste_buffer !default to paste buffer endif Endif ENDIF; If (to_buffer = paste_buffer) then erase(paste_buffer) Endif; !CUT/COPY THE TEXT temp_position := mark(free_cursor); entry_mode := get_info(to_buffer,'mode'); IF entry_mode = overstrike then ring_bell(FAO("Setting buffer !AS to INSERT mode", get_info(to_buffer,'name'))); set (INSERT,to_buffer); edtn$update_visible_statln( to_buffer ); ENDIF; position(to_buffer); ENABLE_BUFFER_JOURNALING(TO_BUFFER); if mark(none) = beginning_of(to_buffer) then split_line; move_vertical(-1); endif; if (pick = 1) then copy_text(edt$x_select_range); !(to_buffer in insert mode) else ENABLE_BUFFER_JOURNALING(GET_INFO(EDT$X_SELECT_RANGE,"BUFFER")); move_text(edt$x_select_range); !(to_buffer in insert mode) endif; position(temp_position); edt$x_select_range := 0; !INFORM USER If (pick) then if (to_buffer = paste_buffer) then edx_message("Select range copied to PASTE buffer") else if (buf = 0) then !Inform only if prompted edx_message("Select range copied to buffer " + buffer_name ) endif endif Endif; return (1); ENDPROCEDURE !------------------------------------------------------------------------------ PROCEDURE EDTX$COPY_FROM(BUF) ! Copies contents of specified buffer to current cursor position ! Originally procedure jc_copy_from from EDTEXT ! Also from edt$paste ! ! PARAMETERS: ! buf - buffer to copy from (buffer type variable, optional) ! ! After copying the text, append the current line to the last line. ! We put an extra blank line in the paste buffer during the cut. ! This way, we can get a CUT / PASTE of text without a line terminator ! to work properly ! LOCAL from_buffer, ! Buffer whose contents is copied in_string, ! String containing buffer name of buffer to copy entry_mode; ! Mode of buffer (insert|overstrike) !GET THE BUFFER from_buffer := buf; !Local copy of buf. May change this if we prompt IF (from_buffer = 0) then If get_info(system,'display') then in_string := edx_read_line ("Copy from buffer: ",,"CTRL-Z"); Else in_string := ""; Endif; If in_string <> "" then from_buffer := edt$find_buffer(in_string); if (from_buffer = 0) then edit (in_string,trim,upper); edx_message ("buffer !AS does not exist",EDX$K_WARN_HIGHLIGHT,in_string); return (0); endif; Else if (last_key <> ctrl_z_key) then edx_message ("no buffer specified"); endif; return (0); Endif; ENDIF; !COPY THE TEXT if (beginning_of(from_buffer))<>(end_of(from_buffer)) then ! perhaps we should check if number of lines in from_buffer > 1 entry_mode := get_info(current_buffer,'mode'); if entry_mode = overstrike then ring_bell("Setting buffer to INSERT mode"); edtp$overstrike; update(current_window); endif; ENABLE_BUFFER_JOURNALING(CURRENT_BUFFER); copy_text(from_buffer); !(current_buffer switched to INSERT mode) append_line; If entry_mode <> overstrike then edtn$clear_message_window Endif; else edx_message ("Buffer !AS is empty",EDX$K_WARN_HIGHLIGHT,get_info(from_buffer,'name')); endif; ENDPROCEDURE !------------------------------------------------------------------------------ PROCEDURE EDT$APPEND !kp9 (append) LOCAL temp_pos ; edt$select_range; if edt$x_select_range <> 0 then temp_pos := mark(free_cursor); position(end_of(paste_buffer)); if (mark(free_cursor) <> beginning_of(paste_buffer)) then move_horizontal(-1) endif; ENABLE_BUFFER_JOURNALING(GET_INFO(EDT$X_SELECT_RANGE,"BUFFER")); set(insert,paste_buffer); !(paste buffer must not be journaled to avoid VMS 5.4 fatal TAB error) move_text(edt$x_select_range); edt$x_select_range:=0; position(temp_pos); else edx_message("No Select Active"); edt$x_repeat_count := 1; endif; ENDPROCEDURE !------------------------------------------------------------------------------ PROCEDURE EDT$REPLACE !gold kp9 (replace) edt$select_range; if ( edt$x_select_range <> 0) then erase(edt$x_select_range); edtx$copy_from(paste_buffer); edt$x_select_range:=0; else edx_message("No Select Active"); edt$x_repeat_count := 1; endif; ENDPROCEDURE !------------------------------------------------------------------------------ ! COLUMNAR CUT/PASTE PROCEDURES !------------------------------------------------------------------------------ !(Some procedures originally adopted from EVEPLUS) PROCEDURE EDTN$COLUMNAR_SELECT if edtn$m_begin_select = 0 !If not started selection then ! then start selection edt$reset; edtn$columnar_select_begin; return; endif; if edtn$rn_line_top <> 0 !Already started selection. then !If selection already completed edx_message("Select already active"); ! then warn user return; endif; if (get_info(edtn$m_begin_select,'buffer') <> current_buffer) !Started selection then !Starting mark was in another buffer. !Selection not yet completed edt$reset; !Start selection over again. !Complete selection edtn$columnar_select_begin; return; else !Finish the column select edtn$finish_column_select; return; endif; ENDPROCEDURE !------------------------------------------------------------------------------ PROCEDURE EDTN$COLUMNAR_SELECT_BEGIN LOCAL NOCHAR; !Make sure we are not in the PASTE buffer. If (get_info(current_buffer,'name') = "PASTE") then edx_message ("Cannot select in the PASTE buffer") Else !See if we're on a character we can highlight nochar := FALSE; !Assume we're on a character If cs$cursor_outer_space then !then carefully check if we actually are nochar := TRUE Else if (mark(free_cursor) = end_of(current_buffer)) then ! if at eob nochar := TRUE else IF (current_character = "") then ! only now check if at eol nochar := TRUE ENDIF; endif; Endif; IF (nochar) THEN ENABLE_BUFFER_JOURNALING(CURRENT_BUFFER); copy_text(edt$x_space); move_horizontal(-1); edtn$m_tmpmrk := mark(none); edtn$v_tmpmrk := 1; ELSE edtn$v_tmpmrk := 0; ENDIF; edtn$m_begin_select := mark(REVERSE); edx_message ("Columnar selection started. Move to other corner and press SELECT"); Endif; ENDPROCEDURE !------------------------------------------------------------------------------ PROCEDURE EDTN$FINISH_COLUMN_SELECT Local end_select, line_select_begin, line_select_end, temp, tmpmrk, tmpmrkv, usrbuf, here, wst, wsb, wsa, cw, win_len, nochar, MK, RN, N; !+ !Make sure there is a character at the corner of the box opposite !the begin_select mark. If the end_select mark is before the !begin_select mark, juggle the markers so that begin_select precedes !end_select. !- !See if we're on a character we can highlight nochar := FALSE; !Assume we're on a character If cs$cursor_outer_space then !then carefully check if we actually are nochar := TRUE Else if (mark(free_cursor) = end_of(current_buffer)) then ! if at eob nochar := TRUE else IF (current_character = "") then ! only now check if at eol nochar := TRUE ENDIF; endif; Endif; IF (nochar) THEN ENABLE_BUFFER_JOURNALING(CURRENT_BUFFER); copy_text(edt$x_space); !At end of line. Pad with blank move_horizontal(-1); !so marker will show below tmpmrkv := 1; !Set flag that padded blank is temporary ELSE tmpmrkv := 0; !Set flag that no padded blank was added ENDIF; here := mark(none); !Mark starting position. (We're on a character.) If here >= edtn$m_begin_select then end_select := mark(reverse) !(we're on a character) Else end_select := edtn$m_begin_select; edtn$m_begin_select := mark(reverse); !(we're on a character) Endif; position(here); !Go back to start and show the mark if get_info(system,'display') then update(current_window) endif; !FIGURE OUT WHAT COLUMN THE BOX STARTS AND ENDS IN position(end_select); edtn$v_end_column := get_info(current_buffer,'offset_column'); position(edtn$m_begin_select); edtn$v_start_column := get_info(current_buffer,'offset_column'); !SWITCH START_COLUMN/END_COLUMN IF END COMES BEFORE START. If edtn$v_start_column > edtn$v_end_column then temp := edtn$v_end_column; edtn$v_end_column := edtn$v_start_column; edtn$v_start_column := temp; Endif; !MARK TOP LINE OF RANGE position(edtn$m_begin_select); edtn$gotocol(edtn$v_start_column); line_select_begin := mark(none); edtn$gotocol(edtn$v_end_column); line_select_end := mark(none); edtn$rn_line_top := create_range(line_select_begin,line_select_end,REVERSE); position(here); !Position back where cursor was !DISPLAY THE COLUMN ONLY IF IN /DISPLAY MODE IF Get_info(system,'display') THEN !GET OLD WINDOW SETTINGS cw := current_window; !Get current window wst := get_info(cw,'scroll_top'); wsb := get_info(cw,'scroll_bottom'); wsa := get_info(cw,'scroll_amount'); win_len := (get_info(cw,'visible_bottom') - get_info(cw,'visible_top') + 1); !ANCHOR TEXT TO WINDOW SO IT DOESN'T SCROLL set(scrolling,cw,ON,0,0,0); !+ !NOW STEP THROUGH THE SELECTED LINES THAT ARE VISIBLE ON THE SCREEN. !TEMPORARILY MARK EACH LINE AND THEN MOVE TO THE NEXT. !- !MOVE UP TO TOP LINE OF WINDOW move_vertical(get_info(cw,'visible_top')-get_info(cw,'current_row')); !Should be a negative number !LOOP THROUGH LINES IN WINDOW N := 1; LOOP !See if we're in the range edtn$gotocol(edtn$v_start_column); MK := mark(none); IF ( (MK >= edtn$m_begin_select) AND (MK <= end_select) ) THEN line_select_begin := mark(none); edtn$gotocol(edtn$v_end_column); line_select_end := mark(none); RN := create_range(line_select_begin,line_select_end,REVERSE); update(cw); ENDIF; move_vertical(1); N := N + 1; exitif ( (N > win_len) OR (mark(free_cursor) = end_of(current_buffer)) ); ENDLOOP; ENDIF; !NOW MARK BOTTOM LINE OF RANGE position(end_select); edtn$gotocol(edtn$v_start_column); line_select_begin := mark(none); edtn$gotocol(edtn$v_end_column); line_select_end := mark(none); edtn$rn_line_bot := create_range(line_select_begin,line_select_end,REVERSE); !RESET EVERYTHING if (edtn$v_tmpmrk) then !erase temporary space character that was position(edtn$m_tmpmrk); !put at end of line so marker would show up if (current_offset = (length(current_line)-1)) then !Insure space is still at end of line erase_character(1); !erase space endif; endif; position(here); if (tmpmrkv) then !erase temporary space put at end of erase_character(1); !line so marker would show up endif; if get_info(system,'display') then set(scrolling,cw,ON,wst,wsb,wsa) !Reset screen scrolling region endif; ENDPROCEDURE !------------------------------------------------------------------------------ PROCEDURE EDTN$COLUMNAR_CUT(pick,buf,move) Local line_select_begin, line_select_end, end_select, to_buffer, buffer_name, here, usrbuf, usrbuf_mode, mk, lrn, rn; !CHECK FOR SELECT NOT ACTIVE OR COMPLETE IF (edtn$rn_line_top = 0) OR (edtn$rn_line_bot = 0) THEN edx_message ("Selection not complete"); return (0); ENDIF; !MARK WHERE TO BE AT END OF CUT if (move = 1) then here := beginning_of(edtn$rn_line_top) !Mark where to be for cut/paste operation else here := mark(none) !otherwise stay at current position endif; !GET BUFFER to_buffer := buf; !Local copy of buf. May read in local copy If (to_buffer = 0) then !If buffer specified then don't prompt If get_info(system,'display') then buffer_name := edx_read_line("Copy to buffer [PASTE]: ",,"CTRL-Z"); edit(buffer_name,trim,upper); If (buffer_name = '*') then buffer_name := edtn$newbufnam; Endif; Else buffer_name := "PASTE"; Endif; If buffer_name <> "" then to_buffer := edt$find_buffer(buffer_name); if (to_buffer = 0) then to_buffer := edtn$create_buffer(buffer_name,""); if to_buffer = 0 then edt$reset; return(0); endif; endif; Else if last_key = ctrl_z_key then return (0); !User didn't want this procedure else to_buffer := paste_buffer; !default to paste buffer endif; Endif; Endif; If (to_buffer = paste_buffer) then erase(paste_buffer) !Erase the paste buffer Else position(end_of(to_buffer)); !Mark starting point in to_buffer if (mark(free_cursor) <> beginning_of(to_buffer)) then move_horizontal(-1) endif; Endif; set(insert,to_buffer); !to avoid VMS 5.4 fatal TAB error !COPY LINES position(end_of(edtn$rn_line_bot)); !Go to end of columnar range end_select := mark(none); ! and mark usrbuf := current_buffer; ! and note the buffer usrbuf_mode := get_info(usrbuf,'mode'); ! and note mode of users buffer if (pick = 0) then ENABLE_BUFFER_JOURNALING(USRBUF) endif; !enable journal only if usrbuf being modified ENABLE_BUFFER_JOURNALING(TO_BUFFER); !enable buffer journaling on to_buffer. position(beginning_of(edtn$rn_line_top));!Go to beginning of columnar range LOOP !And begin looping line_select_begin := mark(free_cursor); edtn$gotocol(edtn$v_end_column); if (current_offset > 0) !Don't copy end of line null and (current_character = "") !character and (mark(free_cursor) > line_select_begin) then move_horizontal(-1) endif; line_select_end := mark(none); rn := create_range(line_select_begin,line_select_end,none); position(to_buffer); lrn := length(rn); If (lrn > 0) then if ( (pick = 1) or (usrbuf_mode = overstrike) ) then copy_text(rn) !(To_buffer in insert mode) else move_text(rn) !cut in insert mode. (To_buffer in insert mode) endif; endif; split_line; position(usrbuf); if ( (usrbuf_mode = overstrike) and (not pick) ) then position(beginning_of(rn)); if lrn > 0 then copy_text(FAO("!"+str(lrn)+"* ")); !overstrike range with blanks move_horizontal(-lrn); endif; endif; move_vertical(1); exitif (mark(none) > end_select); edtn$gotocol(edtn$v_start_column); ENDLOOP; !NOW RESET EVERYTHING edt$reset; position(here); if (pick = 1) then if (to_buffer = paste_buffer) then edx_message ("Select range copied to buffer PASTE") else edx_message ("Select range appended to buffer " + get_info(to_buffer,'name') ) endif; endif; return (1); ENDPROCEDURE !------------------------------------------------------------------------------ PROCEDURE EDTN$COLUMNAR_PASTE(buf) Local start_column, from_buffer, target_buf, here, line, num_lines, N, in_string; !GET THE BUFFER from_buffer := buf; !Local copy of buf. May change this if we prompt IF (from_buffer = 0) then If get_info(system,'display') then in_string := edx_read_line ("Copy from buffer: ",,"CTRL-Z"); Else in_string := ""; Endif; If in_string <> "" then from_buffer := edt$find_buffer(in_string); if (from_buffer = 0) then edit (in_string,trim,upper); edx_message("buffer !AS does not exist",EDX$K_WARN_HIGHLIGHT,in_string); return (0); endif; Else if (last_key <> ctrl_z_key) then edx_message ("no buffer specified"); endif; return (0); Endif; ENDIF; num_lines := get_info(from_buffer,'record_count') - 1; ! last line is blank if num_lines < 1 then !could be 0 or -1 edx_message("nothing to copy"); return; endif; target_buf := current_buffer; ENABLE_BUFFER_JOURNALING(TARGET_BUF); here := mark(none); !Mark starting line start_column := GET_INFO(current_buffer,'offset_column'); position(beginning_of(from_buffer)); !Start at the beginning N := 1; LOOP !Copy lines in the paste buffer one at a time line := ""; if (NOT cs$cursor_outer_space) then !in case our square isn't quite square if (mark(none) <> end_of(current_buffer)) then line := current_line; endif; endif; position(target_buf); if (length(line) > 0) then if (edtn$gotocol(start_column) < start_column) then loop copy_text(edt$x_space); exitif (get_info(current_buffer,'offset_column') >= start_column); endloop; endif; VS$COPY_STRING(line); !avoid VMS 5.4 fatal error endif; N := N + 1; exitif N > num_lines; move_vertical(1); position(from_buffer); move_vertical(1); ENDLOOP; position(here); edtn$gotocol(start_column); ENDPROCEDURE !------------------------------------------------------------------------------ !****************************************************************************** ! FILL PARAGRAPH ROUTINES !****************************************************************************** PROCEDURE EDT$FILL !Fill select range (GOLD KP8) LOCAL original_position, b_mark, e_mark, sub_range, all_done; ON_ERROR all_done:=1; ! cause exit ENDON_ERROR; !FINISH SELECTION edt$select_range; !CHECK FOR NO SELECT ACTIVE IF (edt$x_select_range = 0) THEN edx_message("No Select Active"); edt$x_repeat_count := 1; Return; ENDIF; !SAVE POSITIONS original_position:=mark(free_cursor); b_mark:=beginning_of(edt$x_select_range); LOOP !Skip leading blank lines before a paragraph. !Skip leading spaces on first line. edt$skip_lines(b_mark); all_done:=edt$find_whiteline(b_mark,e_mark); ! start looking here exitif all_done; !Now only fill the range created between the blank lines sub_range:=create_range(b_mark,e_mark,none); position(e_mark); !Go to line following the range position(TEXT); !may be cursor_free mark move_horizontal(1); !assume e_mark bound to text. move_vertical(1); b_mark:=mark(none); !Pick up search at end of current_range edtn$fill_range(sub_range); !Do the fill operation exitif all_done; !May have been set by error ENDLOOP; position(original_position); edt$x_select_range:=0; ENDPROCEDURE PROCEDURE EDT$SKIP_LEADING_SPACES(B_MARK) ! support routine for fill Local temp_pattern,temp_range; ON_ERROR !If string not found return ENDON_ERROR; position(b_mark); temp_pattern:=anchor&span(eve$x_whitespace); temp_range:=search(temp_pattern,forward); position(end_of(temp_range)); position(TEXT); !in case we're floating move_horizontal(1); b_mark:=mark(none); ENDPROCEDURE PROCEDURE EDT$FIND_WHITELINE(BEG_MARK,END_MARK) ! support routine for fill !Search for end of paragraph, starting at BEG_MARK, returning END_MARK. !A return value of 0 indicates end_mark set, 1 indicates all_done. !(Notice this is originally an EDT$ routine, it's the way they did it !for histerical reasons). !Takes on_error if error searching for next blank line (edt$x_whit_pat) !may be caused by no more blank lines to end of buffer. Local blank_line; on_error position(beg_mark); end_mark:= end_of(edt$x_select_range); return 0; endon_error; position(beg_mark); if beg_mark >= end_of(edt$x_select_range) then return 1 ! all done endif; blank_line:=search(edt$x_whit_pat,forward); ! get the beginning and end points right if beginning_of(blank_line) > end_of(edt$x_select_range) then end_mark:= end_of(edt$x_select_range); return 0; Else end_mark:=end_of(blank_line) Endif; position(end_mark); ! go there position(LINE_BEGIN); ! back up to previous line move_horizontal(-1); ! back up to previous line end_mark:=mark(none); return 0 ENDPROCEDURE PROCEDURE EDT$SKIP_LINES(B_MARK) ! support routine for fill !Skip multiple blank lines before a paragraph. !Skip leading spaces before first line of paragraph. Local trimline; on_error b_mark:=mark(none); return; endon_error; position(b_mark); loop position(LINE_BEGIN); exitif (mark(free_cursor) = end_of(current_buffer)); trimline := current_line; edit( trimline, TRIM, OFF); exitif (trimline <> ""); move_vertical(1); endloop; b_mark:=mark(none); edt$skip_leading_spaces(b_mark); return ENDPROCEDURE PROCEDURE EDTN$TRIM_FILL_RANGE(FILL_RANGE) ! Remove trailing blanks from each line in fill_range unless the line ! ends in a period, exclamation mark, or question mark (the end of a ! sentence), in which case place one space after the period. This is ! so sentences wrap properly. LOCAL here; ENABLE_BUFFER_JOURNALING(CURRENT_BUFFER); here := mark(none); position(beginning_of(fill_range)); loop exitif (mark(none) = end_of(current_buffer)); position(LINE_END); exitif( mark(none) > end_of(fill_range) ); If (current_offset > 0) then move_horizontal(-1); loop exitif (current_character <> edt$x_space); erase_character(1); !Remove trailing spaces from line move_horizontal(-1); endloop; if ( index( ".!?", current_character) <> 0 ) then !if end of sentence then add space move_horizontal(1); !so wrap will result in sentences copy_text(edt$x_space); !separated by two spaces. endif; position(LINE_BEGIN); Endif; move_vertical(1); endloop; position(here); ENDPROCEDURE PROCEDURE EDTN$FILL_RANGE(fill_range) !Reformat text in specified range Local lm,rm; lm := edtn$v_left_margin; If edt$x_wrap_position <> 0 then rm := edt$x_wrap_position Else if get_info(system,'display') then rm := get_info(current_window,'width') else rm := 80 endif Endif; If (lm > rm) then edx_message("Left margin must be less than or equal to right margin"); edx_message("Left margin is !ZL, right margin is !ZL",EDX$K_INFO,lm,rm); Else ENABLE_BUFFER_JOURNALING(GET_INFO(FILL_RANGE,"BUFFER")); edtn$trim_fill_range(fill_range); fill(fill_range,edt$x_word,lm,rm); position(end_of(fill_range)); position(LINE_END); move_horizontal(-1); loop exitif (current_character <> edt$x_space); erase_character(1); !Remove trailing spaces from last line. move_horizontal(-1); endloop; Endif; ENDPROCEDURE !------------------------------------------------------------------------------ PROCEDURE FILL_PARAGRAPH !From EVE. Fills the current paragraph. EDT GOLD-F ! ! Note 1: ! The paragraph may have been indented by SET LEFT_MARGIN n. On VMS 5 some ! lines may begin at offset column n with no leading spaces, while other ! lines have leading spaces to column 1. It is therefore necessary to ! position to the beginning of each line as we move to it. ! ! Note 2: ! Should replace searching line by line for start/end of paragraph with ! search like EDT$FILL does. LOCAL this_position, ! Marker for current cursor position start_paragraph, ! Marker for start of current paragraph stop_paragraph, ! Marker for end of current paragraph fill_range, ! Range for current paragraph num_lines, ! Number of lines in paragraph Y_N; ! Can't fill an empty buffer - avoid additional checks later on if beginning_of (current_buffer) = end_of (current_buffer) then edx_message ("Nothing to fill"); return; endif; Set (Forward,current_buffer); !Set forward by default position(TEXT); this_position := mark (none); ! Find beginning and end of paragraph ! If on a blank line do preceding paragraph !Search for beginning of paragraph loop position(LINE_BEGIN); !Goto beg of line. See note 1. start_paragraph := mark (none); if (start_paragraph = beginning_of(current_buffer)) then edtn$gotocol(edtn$v_left_margin); start_paragraph := mark (none); edt$skip_leading_spaces(start_paragraph); exitif; endif; move_vertical (-1); if eve$paragraph_break then move_vertical (1); edtn$gotocol(edtn$v_left_margin); start_paragraph := mark (none); edt$skip_leading_spaces(start_paragraph); exitif; endif; endloop; position (this_position); !Search for end of paragraph loop exitif ( mark(free_cursor) = end_of (current_buffer) ); position(LINE_BEGIN); !See note 1. exitif eve$paragraph_break; move_vertical (1); endloop; if start_paragraph = mark(none) then edx_message ("Nothing to fill"); position (this_position); else move_horizontal(-1); stop_paragraph := mark(none); !Confirm if more than maxlines before continuing to prevent swearing num_lines := mrk$lines_between_markers(start_paragraph,stop_paragraph); if (num_lines > edtn$v_maxlines_fill_paragraph) then ring_bell(""); Y_N := edx_read_line(FAO("Current paragraph has over !UL lines. Rewrap? (Yes or No): ", edtn$v_maxlines_fill_paragraph)); edit(Y_N,trim,upper,OFF); If ( index("YES",Y_N) <> 1) then position (this_position); Return (0); endif; endif; ! Now fill the paragraph fill_range := create_range (start_paragraph, stop_paragraph, none); edtn$fill_range(fill_range); position (stop_paragraph); endif; ENDPROCEDURE; PROCEDURE EVE$PARAGRAPH_BREAK ! Returns true if current line looks like a runoff command (starts with ! a period followed by an alphabetic character) or a blank line, ! else returns false. Assumes cursor was at start of line. ! Routine necessary to suppress 'String not found' error messages. on_error return (0); endon_error; if search (eve$pattern_paragraph_break, forward) <> 0 then return (1); endif; ENDPROCEDURE; PROCEDURE EDTN$FILL_TO_END ! Fills the current paragraph from cursor position to end of paragraph. LOCAL this_position, ! Marker for current cursor position start_paragraph, ! Marker for start of current paragraph stop_paragraph, ! Marker for end of current paragraph fill_range; ! Range for current paragraph ! Can't fill an empty buffer - avoid additional checks later on if beginning_of (current_buffer) = end_of (current_buffer) then edx_message ("Nothing to fill"); return; endif; position(TEXT); this_position := mark(none); !SKIP LEADING SPACES ON FIRST LINE start_paragraph := mark(none); edt$skip_leading_spaces(start_paragraph); ! Find end of paragraph loop position(LINE_BEGIN); exitif (mark(free_cursor) = end_of (current_buffer) ); exitif eve$paragraph_break; move_vertical (1); endloop; If start_paragraph = mark(none) then edx_message ("Nothing to fill"); position (this_position); Else move_horizontal (-1); stop_paragraph := mark(none); ! Now fill the paragraph fill_range := create_range (start_paragraph, stop_paragraph, none); edtn$fill_range(fill_range); position (stop_paragraph); Endif; ENDPROCEDURE !------------------------------------------------------------------------------ !****************************************************************************** ! EDITING TEXT !****************************************************************************** PROCEDURE EDT$CHANGE_CASE(KWD) !gold kp1 (change case) !KWD = keyword. Upper, Lower, or Invert. LOCAL character; !check for active select edt$select_range; IF edt$x_select_range <> 0 THEN ENABLE_BUFFER_JOURNALING(CURRENT_BUFFER); change_case(edt$x_select_range,kwd); edt$x_select_range:=0; ELSE !change case of current character if there is one If (not cs$cursor_outer_space) then ENABLE_BUFFER_JOURNALING(CURRENT_BUFFER); change_case(create_range(mark(none),mark(none),none),kwd); if current_direction = forward then move_horizontal(1) else move_horizontal(-1) endif; Endif; ENDIF; ENDPROCEDURE !------------------------------------------------------------------------------ PROCEDURE UPPERCASE_WORD !From EVE ! Put word in all uppercase letters ! If select range active, put all of select range in uppercase letters LOCAL word_range; ! Range for current word !Check for selected range edt$select_range; !Finish select of range (if there was one) If (edt$x_select_range <> 0) then !Check for select active ENABLE_BUFFER_JOURNALING(CURRENT_BUFFER); change_case (edt$x_select_range, upper); edt$x_select_range := 0; Else word_range := eve$current_word; if word_range <> 0 then ENABLE_BUFFER_JOURNALING(CURRENT_BUFFER); change_case(word_range, upper); endif; Endif; ENDPROCEDURE PROCEDURE LOWERCASE_WORD !From EVE ! Put word in all lowercase letters. ! If select range active, put all of select range in lowercase letters. LOCAL word_range; ! Range for current word !Check for selected range edt$select_range; !Finish select of range (if there was one) If (edt$x_select_range <> 0) then !Check for select active ENABLE_BUFFER_JOURNALING(CURRENT_BUFFER); change_case (edt$x_select_range, lower); edt$x_select_range := 0; Else word_range := eve$current_word; if word_range <> 0 then enable_buffer_journaling(current_buffer); change_case(word_range, lower); endif; Endif; ENDPROCEDURE; PROCEDURE CAPITALIZE_WORD !From EVE ! Capitalize first letter, put rest of word in lowercase. LOCAL word_range; ! Range for current word word_range := eve$current_word; if ((word_range <> 0) and (get_info(current_buffer,'offset_column') > 0)) then capitalize_range(word_range); position(end_of(word_range)); move_horizontal(1); endif; ENDPROCEDURE; PROCEDURE CAPITALIZE_RANGE (CAP_RANGE) ! Capitalize a range - like change_case (string, capital) would be ! Ignore leading punctuation, so things like "Hi" and (foo) can be ! capitalized. Taken from eve$capitalize_string. ! Parameters: ! cap_range Range to be capitalized - input/output LOCAL initial_index, ! Loop index used in search for first letter cap_range_length; ! Length of cap_range parameter ENABLE_BUFFER_JOURNALING(GET_INFO(CAP_RANGE,"BUFFER")); initial_index := 1; cap_range_length := length (cap_range); change_case(cap_range,lower); position(beginning_of(cap_range)); loop change_case(create_range(mark(none),mark(none),none),upper); exitif initial_index = cap_range_length; exitif (mark(none)=end_of(current_buffer)); exitif (index (edtn$x_alphabetic,current_character) <> 0); initial_index := initial_index + 1; move_horizontal(1); endloop; ENDPROCEDURE; PROCEDURE CAPITALIZE_STRING (CAP_STRING) ! Capitalize a string - like change_case (string, capital) would be ! Ignore leading punctuation, so things like "Hi" and (foo) can be ! capitalized. ! Formerly EVE$CAPITALIZE_STRING ! Parameters: ! cap_string String to be capitalized - input/output LOCAL initial_letter, ! Initial substring ending at first letter initial_index, ! Loop index used in search for first letter cap_string_length, ! Length of cap_string parameter rest_of_string; ! Remainder of cap_string after initial_letter initial_index := 1; cap_string_length := length (cap_string); loop initial_letter := substr (cap_string, 1, initial_index); exitif initial_index >= cap_string_length; exitif index (edtn$x_alphabetic, substr (cap_string, initial_index, 1)) <> 0; initial_index := initial_index + 1; endloop; rest_of_string := substr (cap_string, initial_index + 1, cap_string_length); change_case (initial_letter, upper); change_case (rest_of_string, lower); cap_string := initial_letter + rest_of_string; ENDPROCEDURE; PROCEDURE EVE$CURRENT_WORD ! Returns a range for the current word (the next word if between words). ! Cursor moves to end of the word. Returns 0 if no current word. ! Used by change-case commands and others. LOCAL start_current_word, ! Marker for start of range end_current_word, ! Marker for end of range this_position; position(TEXT); this_position := mark (none); If (this_position = end_of(current_buffer)) then Return (0) Endif; !See if we're one step beyond the end of a word IF (((current_character = "") OR (index (edt$x_word, current_character) <> 0)) AND (current_offset <> 0)) THEN move_horizontal(-1); !Check out previous character If (index (edt$x_word, current_character) <> 0) then move_horizontal(1) !Wasn't end of word, go back. Endif; ENDIF; IF current_character = "" then move_horizontal (1); return (create_range (this_position, this_position, none)); ENDIF; ! If current character is a word separator, go to next word If index (edt$x_word, current_character) <> 0 then edt$end_word endif; !Go to end of word first - edt$end_word goes back a word !when current cursor is at the start of a word edt$end_word; move_horizontal (-1); end_current_word := mark (none); move_horizontal (1); edt$beg_word; start_current_word := mark (none); edt$end_word; return (create_range (start_current_word, end_current_word, none)); ENDPROCEDURE; !------------------------------------------------------------------------------ PROCEDURE TRANSPOSE_CHARACTERS ! Swap current character with the next character LOCAL ch1,ch2,entry_mode; !DO NOTHING IF NOT CURRENTLY ON SOME CHARACTERS if (cs$cursor_outer_space) then return endif; if (mark(free_cursor) = end_of(current_buffer)) then return endif; if (current_character = "") then return endif; !only now can we test for eol ENABLE_BUFFER_JOURNALING(CURRENT_BUFFER); !we're going to do it... !WE DO IT IN OVERSTRIKE MODE BECAUSE IT'S FASTER !(The cursor does not repaint to the end of the line this way) !Unless one of the characters to be swapped is a character !in which case it doesn't work right in overstrike mode and could !result in the VMS 5.4 fatal error with inserting s in overstrike mode. !GET CHARACTERS TO BE SWAPPED ch1 := current_character; move_horizontal(+1); ch2 := current_character; entry_mode := get_info(current_buffer,'mode'); !SWAP THE CHARACTERS If ((ch1 <> edt$x_tab_char) and (ch2 <> edt$x_tab_char)) then set(overstrike,current_buffer); copy_text(ch1); move_horizontal(-2); copy_text(ch2); move_horizontal(-1); Else set(insert,current_buffer); erase_character(1); erase_character(-1); copy_text(ch2); copy_text(ch1); move_horizontal(-2); Endif; !RESET BUFFER TO ORIGINAL MODE set (entry_mode,current_buffer) ENDPROCEDURE !------------------------------------------------------------------------------ PROCEDURE CENTER_LINE !From EVE ! Center the current line between the margins LOCAL this_position, ! Marker for current cursor position count, ! Number of spaces to erase at start of line lm, ! Left margin for current buffer rm, ! Right margin for current buffer width_of_screen, ! Screen width this_column, ! Current column this_buffer, ! Current buffer this_mode, ! Keyword for current mode col; ENABLE_BUFFER_JOURNALING(CURRENT_BUFFER); position(TEXT); this_position := mark (none); if this_position = end_of (current_buffer) then return endif; !SEARCH FOR BEGINNING OF TITLE position(LINE_BEGIN); !goto beg of line. count := 0; LOOP exitif current_character = ""; !exit if beyond EOL exitif index (eve$x_whitespace, current_character) = 0; !exit if non-blank character. Found beg of line count := count + 1; move_horizontal (1); ENDLOOP; erase_character(-count); !Move string to beg of line. !TRIM BLANKS OFF END OF LINE position(LINE_END); !Goto end of line LOOP exitif current_offset = 0; move_horizontal (-1); exitif index (eve$x_whitespace, current_character) = 0; erase_character (1); !Trim blanks off end of line ENDLOOP; lm := edtn$v_left_margin; if edt$x_wrap_position <> 0 then rm := edt$x_wrap_position else if get_info(system,'display') then rm := get_info (current_window, 'width') else rm := 80 endif endif; !HOW MUCH WHITESPACE TO INSERT this_column := get_info (current_buffer, 'offset_column'); count := (((rm - lm) - this_column) / 2) + lm; !INSERT WHITESPACE this_buffer := current_buffer; this_mode := get_info (this_buffer, 'mode'); set (insert, this_buffer); position(LINE_BEGIN); !goto beg of line. col := 1; loop; copy_text (edt$x_space); col := col + 1; exitif col >= count; endloop; set (this_mode, this_buffer); position (this_position); ENDPROCEDURE; !---------------------------------------------------------------------- !****************************************************************************** ! SEARCHING/SUBSTITUTING TEXT !****************************************************************************** ! ! OUTLINE: ! ! FIND REPLACE SUBSTITUTE ! | | | ! V V V ! EDTN$LINE_MODE_FIND EDTN$LINE_MODE_REPLACE EDT$LINE_MODE_SUBSTITUTE ! | | | ! V | | ! JEN$SETUP_SEARCH <-------------------------------- ! | ! | ! | ------------------------------------ keypad 'Find Next' key ! | | ! V V ! ----JEN$FNDNXT <---- JEN$INIT_FIND_STRING <---- keypad 'Find' key ! | | ! | V ! | JEN$SEARCH_AND_REPLACE ! | | ! | V ! --->JEN$FIND_STRING ! ! GLOBAL VARIABLES: ! jen$x_search_string - string or pattern to search for ! jen$x_exclude_string - string or pattern to exclude from search ! jen$x_replace_string - string to replace found string with, or 0 if just a 'find' operation ! jen$x_search_case - case sensitivity for search-string, EXACT or NO_EXACT ! jen$x_exclude_case - case sensitivity for exclude-string, EXACT or NO_EXACT ! jen$x_replace_case - case sensitivity for replace-string, EXACT or NO_EXACT ! jen$v_search_next - 0 = First time searching for jen$x_search_string ! 1 = searching for next jen$x_search_string ! OTHER PARAMETERS: ! /QUERY - Show found string, ask before replacing, ! show change, ask before seaching for next occurance. ! /TYPE - Show found string, show change. ! /NOTYPE - Don't show found string or change unless currently querrying. ! /NUMBER= Number of changes to make. Default: unlimited. ! /WILD - Process strings as wildcard patterns !------------------------------------------------------------------------------ !PROCEDURE EVE$BUILD_PATTERN( input_string, result_string ) ! Build a pattern for pattern searching. Pattern characters are: ! ! + - beginning of line ! ; - end of line ! % - single-character wildcard ! * - multi-character wildcard, do not cross record boundaries ! \ - quote next character ! ^ - next char. is ctrl character ! ! BUILD_PATTERN takes a search string in INPUT_STRING and returns either ! a search string or a pattern string in RESULT_STRING. If RESULT_STRING ! is a search string, BUILD_PATTERN returns 0. If it is a pattern string, ! BUILD_PATTERN returns 1. ! ! Modified by David Deley !- PROCEDURE EVE$BUILD_PATTERN( input_string, result_string ) LOCAL s1, s2, i, j, c, ctlv, quote_next, ctrl_next, match_started, pat; s1 := ""; s2 := ""; pat := ""; i := 1; quote_next := 0; ctrl_next := 0; match_started := 0; !+ ! Process each character in the input string !- LOOP EXITIF i > LENGTH(input_string); c := SUBSTR(input_string, i, 1); !+ ! Do quoting if we're supposed to !- IF quote_next = 1 THEN IF c = "'" THEN s1 := s1 + "''" ELSE s1 := s1 + c ENDIF; s2 := s2 + c; i := i + 1; quote_next := 0 ELSE !+ ! Do CTRL/n quoting if we're supposed to !- IF ctrl_next = 1 THEN CHANGE_CASE(c, UPPER); ctlv := INDEX("@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_", c); if (ctlv = 0) then edx_message("Wild card search can not make control character from '!AS'.", EDX$K_ERROR_HIGHLIGHT,ascii(ctlv-1)); abort; else c := ascii(ctlv-1); endif; s1 := s1 + c; s2 := s2 + c; i := i + 1; ctrl_next := 0 ELSE !+ ! A normal character or wildcard !- IF index('+;*%',c) <> 0 THEN !+ ! Close any match or string started !- IF match_started THEN pat := pat + s1 + "')"; s1 := ""; match_started := 0 ENDIF; IF LENGTH(s1) > 0 THEN pat := pat + "& '" + s1 + "'"; s1 := ""; ENDIF; ENDIF; CASE c FROM ' ' TO '~' ['\']: !+ ! quote next character !- quote_next := 1; i := i + 1; ['^']: !+ ! CTRL next character !- ctrl_next := 1; i := i + 1; ['+']: !+ ! Begin-of-line !- pat := pat + "& LINE_BEGIN"; i := i + 1; [';']: !+ ! End-of-line !- pat := pat + "& LINE_END"; i := i + 1; ['*']: !+ ! General wildcard, not crossing record boundaries ! ! Eat following *'s and %'s !- LOOP EXITIF i > LENGTH(input_string); EXITIF INDEX('*%',SUBSTR(input_string, i, 1)) = 0; i := i + 1 ENDLOOP; !+ ! Use REMAIN if at end of input_string ! or if + or ; follows !- IF ( (i > LENGTH(input_string)) OR (INDEX('+;',substr(input_string,i,1)) <> 0) ) THEN pat := pat + "& REMAIN" ELSE !+ ! Use the MATCH built-in. We will accumulate ! MATCH characters until another special marker ! is encountered. MATCH does not cross record ! boundaries. !- pat := pat + "& MATCH('"; match_started := 1 ENDIF; ['%']: !+ ! Single-character wildcard. !- ! Start by counting consecutive %s j := 0; LOOP EXITIF i > LENGTH(input_string); EXITIF SUBSTR(input_string, i, 1) <> "%"; i := i + 1; j := j + 1 ENDLOOP; !+ ! Put it in the pattern !- pat := pat + "& ARB(" + STR(j) + ")"; ["'"]: !+ ! Apostrophes must be doubled in STR1 !- s1 := s1 + "''"; s2 := s2 + "'"; i := i + 1; [OTHERWISE]: !+ ! Just an ordinary character !- s1 := s1 + c; s2 := s2 + c; i := i + 1; ENDCASE ENDIF ENDIF ENDLOOP; !+ ! Empty out STR1 !- IF (LENGTH(s1) > 0) AND (LENGTH(pat) > 0) THEN IF match_started THEN pat := pat + s1 + "')" ELSE pat := pat + "& '" + s1 + "'" ENDIF ENDIF; !+ ! Return either a string or a pattern string !- IF LENGTH(pat) > 0 THEN result_string := SUBSTR(pat, 3, LENGTH(pat) - 2); RETURN 1 ELSE result_string := s2; RETURN 0 ENDIF ENDPROCEDURE !------------------------------------------------------------------------------ ! PROCEDURE SAVE_SEARCH_CONTEXT ! PROCEDURE RESTORE_SEARCH_CONTEXT ! Save and later restore the search context. ! ! GLOBAL VARIABLES: ! jen$x_search_string - string or pattern to search for ! jen$x_exclude_string - string or pattern to exclude from search ! jen$x_replace_string - string to replace found string with, or 0 if just a 'find' operation ! jen$x_search_case - case sensitivity for search-string, EXACT or NO_EXACT ! jen$x_exclude_case - case sensitivity for exclude-string, EXACT or NO_EXACT ! jen$x_replace_case - case sensitivity for replace-string, EXACT or NO_EXACT ! jen$v_search_next - 0 = First time searching for jen$x_search_string ! 1 = searching for next jen$x_search_string ! jen$x_search_string_text - string of text or wildcard pattern to search for PROCEDURE SAVE_SEARCH_CONTEXT jen$x_save_search_string := jen$x_search_string; jen$x_save_exclude_string := jen$x_exclude_string; jen$x_save_replace_string := jen$x_replace_string; jen$x_save_search_case := jen$x_search_case; jen$x_save_exclude_case := jen$x_exclude_case; jen$x_save_replace_case := jen$x_replace_case; jen$v_save_search_next := jen$v_search_next; jen$x_save_search_string_text := jen$x_search_string_text; ENDPROCEDURE PROCEDURE RESTORE_SEARCH_CONTEXT jen$x_search_string := jen$x_save_search_string; jen$x_exclude_string := jen$x_save_exclude_string; jen$x_replace_string := jen$x_save_replace_string; jen$x_search_case := jen$x_save_search_case; jen$x_exclude_case := jen$x_save_exclude_case; jen$x_replace_case := jen$x_save_replace_case; jen$v_search_next := jen$v_save_search_next; jen$x_search_string_text := jen$x_save_search_string_text; ENDPROCEDURE !------------------------------------------------------------------------------ PROCEDURE JEN$STRNOTFOUND !Print the 'String not found' message in reverse highlight LOCAL old_bell; If (not jen$v_search_quietly) then old_bell := get_info(SYSTEM,'bell'); !Save old bell setting set (bell,all,on); !Prepare to ring the warning bell Endif; If (get_info(jen$x_search_string,'type')=STRING) Then edx_message("String '!AS' not found",EDX$K_WARN_HIGHLIGHT,jen$x_search_string) Else edx_message("Wildcard pattern '!AS' not found",EDX$K_WARN_HIGHLIGHT,jen$x_search_string_text) Endif; If (not jen$v_search_quietly) then set (bell,all,off); if (old_bell <> 0) then !Reset bell to former setting set (bell,old_bell,on) endif; Endif; ENDPROCEDURE !------------------------------------------------------------------------------ PROCEDURE JEN$FIND_STRING ! Implicit Inputs: ! jen$x_search_string - string or pattern to search for ! jen$x_search_case - search case to use (EXACT or NO_EXACT) ! jen$x_exclude_string - string or pattern to exclude from search ! jen$x_exclude_case - exclude case to use (EXACT or NO_EXACT) ! jen$v_search_next - 0 = First time searching for jen$x_search_string ! 1 = searching for next jen$x_search_string !Assumed state at entry: ! current_buffer - buffer to search ! current position - position to start search ! current_direction - direction to search ! ! Outputs: ! Return 0 if string not found. ! Cursor remains where it was. ! Calling procedure must print error message. ! Global variable jen$v_search_next remains unchanged. ! Global variable edt$x_search_range := 0; ! Return 1 if string found. ! Cursor positioned at beginning of found string if SET SEARCH BEGIN, ! or end of found string if SET SEARCH END. ! Global variable jen$v_search_next := 1; ! Global variable edt$x_search_range is found search string. ! LOCAL exclude_range, exclude_pattern, direction_distance, start_position; ON_ERROR position(start_position); return(0); ENDON_ERROR; !SAVE OUR CURRENT POSITION position(TEXT); start_position:=mark(none); !SET UP EXCLUDE_PATTERN If jen$x_exclude_string = "" then exclude_pattern := 0 Else exclude_pattern := jen$x_exclude_string | line_end Endif; !ENTER MAIN LOOP LOOP !MOVE TO WHERE WE SHOULD START SEARCHING FROM IF current_direction = FORWARD then If (mark(free_cursor) = end_of(current_buffer)) then return(0) Else direction_distance := 1 Endif ELSE If (mark(free_cursor) = beginning_of(current_buffer)) then return(0) Else direction_distance:=-1 Endif ENDIF; if (jen$v_search_next) and (edt$x_search_begin = 0) and (direction_distance = -1) and (edt$on_search_range) then position(beginning_of(edt$x_search_range)) ! (move to beginning of range first) endif; move_horizontal(direction_distance); !NOW SEARCH edt$x_search_range := search(jen$x_search_string, current_direction, jen$x_search_case); IF (edt$x_search_range = 0) then position(start_position); !String not found return(0); ELSE !Else string was found jen$v_search_next := 1; !Next search is search next position(edt$x_search_range); !String found If exclude_pattern = 0 then !String found, no exclude patterns to search if (NOT edt$x_search_begin) then position(end_of(edt$x_search_range)); ! SET SEARCH END is set move_horizontal(1); endif; return(1); endif; position(LINE_BEGIN); !NOW CHECK IF WE SHOULD EXCLUDE THIS MATCH LOOP exclude_range := search( exclude_pattern, forward, jen$x_exclude_case); Position(beginning_of(exclude_range)); IF end_of(exclude_range) <= beginning_of(edt$x_search_range) THEN position(beginning_of(exclude_range)); !search again move_horizontal(1); ELSE IF ( ( beginning_of(exclude_range) > end_of(edt$x_search_range) ) OR ( current_character = "" ) ) !exclude range was end of line THEN !parenthesis are important or TPU screws it up !Accept string. Position on found string. If (edt$x_search_begin) then position(beginning_of(edt$x_search_range)) ! SET SEARCH BEGIN is set Else position(end_of(edt$x_search_range)); ! SET SEARCH END is set move_horizontal(1); Endif; return(1); ENDIF; !IF beginning_of(exclude_range < end_of(edt$x_search_range) EXITIF; !EXIT exclude loop here. Matched string was rejected ENDIF; !IF end_of(exclude_range) <= beginning_of(edt$x_search_range) ENDLOOP; !Search for exclude match loop ENDIF; !If (edt$x_search_range <> 0) position(edt$x_search_range); ENDLOOP; !Search for string loop ENDPROCEDURE !------------------------------------------------------------------------------ PROCEDURE JEN$SELECT_RANGE_QUIETLY !Supress "zero length range" messages LOCAL rn; ON_ERROR ENDON_ERROR; position(TEXT); ! snap for select_range rn := select_range; return (rn); ENDPROCEDURE !------------------------------------------------------------------------------ PROCEDURE JEN$SAMECASE( TARGET, REPLACEMENT ) ! Returns replacement string in uppercase, lowercase, or capitalized ! depending upon target string. Local lowercase_replacement, ! Lowercase version of replacement string lowercase_target, ! Lowercase version of target string uppercase_replacement, ! Uppercase version of replacement string uppercase_target, ! Uppercase version of target string capital_replacement, ! Capitalized version of replacement string capital_target; ! Capitalized version of target string lowercase_target := target; change_case( lowercase_target, LOWER ); lowercase_replacement := replacement; change_case( lowercase_replacement, LOWER ); uppercase_target := target; change_case( uppercase_target, UPPER ); uppercase_replacement := replacement; change_case (uppercase_replacement, UPPER); capital_target := target; capitalize_string (capital_target); capital_replacement := replacement; capitalize_string (capital_replacement); !Check lowercase first so non-alphabetic target is replaced by lowercase If target = lowercase_target then return (lowercase_replacement) Else if target = uppercase_target then return (uppercase_replacement) else if target = capital_target then return (capital_replacement) else return (replacement) endif endif Endif; ENDPROCEDURE !------------------------------------------------------------------------------ PROCEDURE JEN$SEARCH_AND_REPLACE(QUERY_PARAM,SHOW_CHANGES_PARAM,NCHANGE) ! Search in default direction starting at current cursor position for next ! occurance of jen$x_search_string using jen$x_search_case which does not ! also match jen$x_exclude_string using jen$x_exclude_case, and replace ! it with jen$x_replace_string using jen$x_replace_case. ! ! Various degrees of prompting and displaying are controlled by input ! parameters: ! QUERY - 1 = ask before replacing and before continuing. ! (Forces SHOW to true). ! 0 = replace without asking. ! ! SHOW_CHANGES ! - 1 = Show replacements as they happen. Highlight found string ! and update window after replacing string. ! 0 = Don't update window as replacements happen. ! ! NCHANGE - Number of replacements to make. -1 = unlimited. ! ! Implicit Inputs: ! jen$x_search_string - string or pattern to search for ! jen$x_search_case - EXACT or NO_EXACT for search-string ! jen$v_search_next - 0 = First time searching for jen$x_search_string ! 1 = searching for next jen$x_search_string ! jen$x_exclude_string - string or pattern to exclude from search ! jen$x_exclude_case - EXACT or NO_EXACT for exclude-string ! jen$x_replace_string - string to replace found string with. MUST BE STRING. ! jen$x_replace_case - EXACT or NO_EXACT for replace-string ! Local this_mode, ! Keyword for current mode (insert/overstrike) query, ! 1 = prompt, 0 = noprompt show_changes, ! 1 = show, 0 = don't show highlight_range, ! Reverse-video version of replace_range replace_action, ! String reply to prompt this_occurrence, ! String of replace_range occurrences, ! Number of replacements made so far Y_N, ! Yes or No reply old_place, ! Starting position found_one, ! True if at least one match was found start_range; ! Start of replacement word range !INITIALIZE old_place := mark(free_cursor); found_one := FALSE; query := query_param; show_changes := show_changes_param; occurrences := 0; replace_action := "y"; !Default is "yes" if noquery. If (NOT get_info(system,'display')) then query := 0; !Can't ask in /NODISPLAY mode. show_changes := 0; !Can't show changes in /NODISPLAY mode. Endif; !REPLACE OCCURANCES position(TEXT); LOOP !SEARCH FOR TARGET STRING exitif (NOT jen$find_string); !Exit if string not found found_one := TRUE; !HIGHLIGHT TARGET STRING If (show_changes or query) then highlight_range := create_range (beginning_of (edt$x_search_range), end_of (edt$x_search_range), reverse); update (current_window); Endif; !DETERMINE REPLACEMENT ACTION If query then Loop replace_action := edx_read_line ("Replace? Type yes, no, all, last, or quit: ",1); !Accept single character inputs edit(replace_action,lower,trim,OFF); if (replace_action = "") then if (last_key = ctrl_z_key) then replace_action := "q" !User wants to quit else replace_action := "y" !Otherwise default to "yes" endif; endif; exitif (index("ynalq", replace_action) <> 0); !Exit loop if acceptable answer. {yes,no,all,last,quit} Endloop; Endif; If (replace_action = "a") then !all query := 0; !If all then set NOQUERY replace_action := "y"; ! and "yes" to all edx_message ("Replacing all occurrences..."); Endif; !PROCESS REPLACEMENT ACTION IF (index("yl", replace_action) <> 0) !yes,last THEN ! DO THE REPLACEMENT ! ERASE OLD WORD ENABLE_BUFFER_JOURNALING(CURRENT_BUFFER); position(beginning_of(edt$x_search_range)); this_mode := get_info (current_buffer, 'mode'); !Our mode (insert/overstrike) set (insert, current_buffer); !Do replacements in insert mode. this_occurrence := erase_character (length (edt$x_search_range)); ! INSERT NEW WORD start_range := select(REVERSE); !don't need to snap IF ((jen$x_replace_case = exact) OR (get_info(jen$x_search_string, 'type') <> string)) THEN copy_text (jen$x_replace_string) !buffer in insert mode ELSE copy_text( jen$samecase( this_occurrence, jen$x_replace_string ) ); !buffer in insert mode ENDIF; highlight_range := jen$select_range_quietly; !Finish range selection start_range := 0; !Stop range selection ! RESET AND UPDATE EVERYTHING set (this_mode, current_buffer); !Reset insert/overstrike to original form If current_direction = reverse then !Position cursor move_horizontal (- length (jen$x_replace_string)) Endif; occurrences := occurrences + 1; !Update number of replacements ENDIF; !PROCESS REPLACEMENT ACTION EXITIF ( (index("ql",replace_action) <> 0) !quit,last, or quota and not all or ((occurrences = nchange) and (replace_action <> "a")) ); !UPDATE SCREEN IF NECESSARY If (show_changes or query) then update (current_window); if (query AND (replace_action <> "n")) then Y_N := edx_read_line ("Search for next occurrance? (Yes or No): ",1); !Accept single character inputs edit(Y_N,upper,trim,OFF); exitif (Y_N = 'N'); !Exit the big loop and end exitif (last_key = ctrl_z_key); endif; highlight_range := 0; Endif; ENDLOOP; highlight_range := 0; IF (NOT found_one) then !If string not found on first search then print message jen$strnotfound; !Message string not found ELSE eve$mark_LAST := old_place; !Set marker LAST to where we started edx_message("Replaced !SL occurrence!%S. Press 'Find Next' key to resume search and replace.", EDX$K_INFO_HIGHLIGHT, occurrences); ENDIF; ENDPROCEDURE; !------------------------------------------------------------------------------ PROCEDURE JEN$FNDNXT( QUERY, TYP, NCHANGE) ! Keypad "Find Next" procedure. ! Dispatch either to FIND_STRING (first time or again), ! or to SEARCH_AND_REPLACE (first time or again). ! ! Implicit Inputs: ! jen$x_search_string - string or pattern to search for ! jen$x_search_case - search case to use (EXACT or NO_EXACT) ! jen$v_search_next - 0 = First time searching for jen$x_search_string ! 1 = searching for next jen$x_search_string ! jen$x_exclude_string - string or pattern to exclude from search ! jen$x_exclude_case - exclude case to use (EXACT or NO_EXACT) ! jen$x_replace_string - string to replace found string with, or 0. ! If string then this is "search and replace" command, ! otherwise this is "just find string" command. ! jen$x_replace_case - EXACT or NO_EXACT for replace-string ! !Assumed state at entry: ! current_buffer - buffer to search ! current-position - position to start search ! current_direction - direction to search ! Local old_place; IF jen$x_search_string = 0 THEN jen$init_find_string(edtn$v_search_wild); !No previous search string. ELSE IF get_info(jen$x_replace_string,'type') = STRING THEN jen$search_and_replace( query, typ, nchange); ELSE old_place := mark(free_cursor); If (NOT jen$find_string) !If string not found then print message then jen$strnotfound; !Message 'String not Found' Return(0); Else eve$mark_LAST := old_place; !String found. Reset marker LAST to previous position Return(1); Endif; ENDIF; ENDIF; ENDPROCEDURE !------------------------------------------------------------------------------ !+ ! Keypad "find a new string" command. ! PROCEDURE JEN$INIT_FIND_STRING ( SEARCH_WILD ) !Inputs: ! search _wild - 0 = normal search ! 1 = wildcard search !Implicit Outputs: ! jen$x_search_string - string or pattern to search for ! jen$x_search_string_text - string or text of wildcard pattern to search for ! jen$x_search_case - search case to use, EXACT or NO_EXACT. (jen$x_default_search_case) ! jen$x_exclude_string - string or pattern to exclude from search (null) ! jen$x_replace_string - set to 0 for find only. ! jen$v_search_next - 0 = First time searching for jen$x_search_string ! LOCAL search_string, prompt_string; !GET THE STRING TO SEARCH FOR If (NOT get_info(system,'display')) then return (0); endif; If (search_wild) then !Set the prompt prompt_string := "Wildcard search: " Else prompt_string := "Search for: " Endif; search_string := edx_read_line(prompt_string,,"CTRL-Z"); !Get the string If length(search_string) = 0 then !Test for empty string if last_key <> E1 then !(Pressing FIND key twice gives search/next) return; !User didn't want to search for anything else !user pressed FIND key twice. Do 'find next. !Setup prompt window to what we are searching for erase(prompt_buffer); position(prompt_buffer); pmt$v_prompt_length := length( prompt_string ); copy_text( prompt_string ); !(prompt buffer not journaled) copy_text( jen$x_search_string_text ); !(prompt buffer not journaled) position(beginning_of(prompt_buffer)); !Move cursor to beginnig of line to let user know map(prompt_window,prompt_buffer); update(prompt_window); unmap( prompt_window ); !(it still stays there until we refresh) return jen$fndnxt(1,1,-1); !Do 'find next' endif; Endif; jen$x_search_string_text := search_string; If (search_wild) then if eve$build_pattern(search_string,search_string) then execute( "jen$x_search_string := " + search_string ) !Convert to a pattern variable else jen$x_search_string := search_string endif Else jen$x_search_string := search_string Endif; jen$v_search_next := 0; !First time searching for jen$x_search_string jen$x_replace_string := 0; !This is a find only. jen$x_exclude_string := ""; !No string to exclude. jen$x_search_case := jen$x_default_search_case; If last_key= kp5 then !If the terminator was forward or reverse key, set(reverse,current_buffer); ! then reset the direction permanently Else if last_key = kp4 then set(forward,current_buffer); endif Endif; ! DISPATCH TO FIND_STRING ROUTINE jen$fndnxt(1,1,-1); ENDPROCEDURE !------------------------------------------------------------------------------ ! PROCEDURE JEN$SETUP_SEARCH ! Parse inputs, prepare global outputs, ready cursor and buffer for search. !Inputs: ! search_string, !String to search for ! exclude_string, !String not to search for ! replace_string, !String to replace found-string with, or 0. ! search_case, !EXACT or NO_EXACT for search-string ! exclude_case, !EXACT or NO_EXACT for exclude-string ! replace_case, !EXACT or NO_EXACT for replac-string ! search_wild, !Wild card search-string (1 or 0) ! exclude_wild, !Wild card exclude-string (1 or 0) ! replace_wild, !Wild card replace-string (1 or 0) ! whole, !Search entire buffer (1 or 0) ! search_direction !FORWARD or REVERSE ! query, !Ask before replacing ! typ, !Show replacements ! num, !Number of replacements. -1 = unlimited. ! !Implicit Outputs: ! jen$x_search_string - string or pattern to search for ! jen$x_search_string_text - string or text of wildcard pattern to search for ! jen$x_search_case - search case to use (EXACT or NO_EXACT) ! jen$v_search_next - 0 = First time searching for jen$x_search_string ! 1 = searching for next jen$x_search_string ! jen$x_exclude_string - string or pattern to exclude from search ! jen$x_exclude_case - exclude case to use (EXACT or NO_EXACT) ! jen$x_replace_string - string to replace found string with, or 0. ! If string then this is "search and replace" command, ! otherwise this is "just find string" command. ! jen$x_replace_case - EXACT or NO_EXACT for replace-string ! PROCEDURE JEN$SETUP_SEARCH(search_string_param, exclude_string_param, replace_string_param, search_case, exclude_case, replace_case, search_wild, exclude_wild, replace_wild, whole, search_direction, query, typ, num ) LOCAL search_string, exclude_string, replace_string; !VALIDATE THAT WE HAVE A SEARCH STRING If (search_string_param = edt$x_empty) then edx_message("Search string required"); return 0; Endif; !SET GLOBAL PARAMETERS, PROCESS WILDCARDS, AND POSITION OURSELVES search_string := search_string_param; exclude_string := exclude_string_param; replace_string := replace_string_param; IF (replace_wild) then If get_info(replace_string,'type') = STRING !May be just 'find' command then if eve$build_pattern(replace_string,replace_string) !Returns TRUE if output is pattern variable then edx_message("Wildcards in replacement string not allowed. Only wildcard representations"); edx_message("of control characters (such as ^B for CTRL-B) allowed."); return(0); !Test replace_string first in case we abort here else jen$x_replace_string := replace_string; !String may have changed endif; Else jen$x_replace_string := replace_string; Endif; ELSE jen$x_replace_string := replace_string; ENDIF; jen$x_search_string_text := search_string; IF (search_wild) then If eve$build_pattern(search_string,search_string) !Returns TRUE if output is pattern variable Then execute( "jen$x_search_string := " + search_string ) !Convert to a pattern variable Else jen$x_search_string := search_string; !String may have been changed Endif; ELSE jen$x_search_string := search_string; ENDIF; IF (exclude_wild) then If eve$build_pattern(exclude_string,exclude_string) !Returns TRUE if output is pattern variable Then execute( "jen$x_exclude_string := " + exclude_string ) !Convert to a pattern variable Else jen$x_exclude_string := exclude_string; !String may have been changed Endif; ELSE jen$x_exclude_string := exclude_string; ENDIF; jen$x_search_case := search_case; jen$x_replace_case := replace_case; jen$x_exclude_case := exclude_case; jen$v_search_next := 0; !First time searching for jen$x_search_string If (whole) then !Position us where to start if (search_direction = REVERSE) then position(end_of(current_buffer)) else position(beginning_of(current_buffer)) endif Endif; Set(search_direction, current_buffer); !DISPATCH TO FIND_STRING or SEARCH_AND_REPLACE routine Return jen$fndnxt(query,typ,num); ENDPROCEDURE !------------------------------------------------------------------------------ !+ ! Line mode FIND command (find a new string) !- PROCEDURE EDTN$LINE_MODE_FIND( DELIMITER ) ! Parse the line mode FIND command. The command line reads: ! ! FIND [/qualifiers] search_string [/qualifiers] ! ! If you wish to include a space, tab, slash ('/'), or equals ! sign ('=') within the search-string, exclude-string, or ! replace-string, then enclose the string in either single or double ! quotes. Otherwise the search-string does not have to be enclosed ! in quotes. If you wish to include within a quoted string the same ! quote character used to quote the string, use two consecutive ! quotes. For example, the string: "quote ""this"" string" would be ! interpreted as: quote "this" string. ! LOCAL search_string, !String to search for exclude_string, !String not to search for replace_string, !String to replace found-string with search_state, !0 if FIND/EXACT, 1 if EXCLUDE/EXACT, 2 if REPLACE/EXACT search_case, !EXACT or NO_EXACT for search-string exclude_case, !EXACT or NO_EXACT for exclude-string replace_case, !EXACT or NO_EXACT for replac-string search_wild, !Wild card search string (1 or 0) exclude_wild, !Wild card exclude string (1 or 0) replace_wild, !Wild card replace string (1 or 0) whole, !Search entire buffer buffer_name, !Name of buffer to search. Default= current buffer buffer_ptr, !Buffer to search. initial_bufptr, !Entry buffer term_char, prev_term_char, state_token, state_index, query, typ, num, val, search_direction; !INITIALIZE STATES search_string := ""; exclude_string := ""; replace_string := 0; search_state := 0; search_case := jen$x_default_search_case; exclude_case := search_case; replace_case := NO_EXACT; buffer_name := get_info(current_buffer,'name'); search_wild := edtn$v_search_wild; exclude_wild := search_wild; replace_wild := 0; term_char := delimiter; whole := 0; !Just start from cursor position query := 1; !Ask before replacing typ := 1; !Show replacement before continuing num := -1; !No limit search_direction := FORWARD;!Default to forward ! PARSE THE REST OF THE LINE LOOKING FOR QUALIFIERS AND SEARCH_STRING LOOP prev_term_char := term_char; state_token := edt$next_token('/='+eve$x_whitespace,term_char); if (state_token = "") then exitif; endif; IF (prev_term_char <> '/') then !Then this token isn't a qualifier and must be the search string. if (search_string = edt$x_empty) then search_string := state_token; search_state := 0; !Found search-string else edx_message("Invalid qualifier "+state_token); return 0; endif ELSE change_case(state_token,upper); state_index := index(edtn$x_find_qualifiers,('/' + state_token)); state_index := ((state_index + edtn$v_search_tablen - 1) / edtn$v_search_tablen); CASE state_index FROM 0 TO 14 [0]: !(UNRECOGNISED) edx_message("Unsupported SEARCH option: " + state_token); return 0; [2]: !/EXACT CASE search_state FROM 0 TO 2 [0]: search_case := EXACT; [1]: exclude_case := EXACT; [2]: replace_case := EXACT; ENDCASE; [3]: !/EXCLUDE= if (term_char <> '=') then edx_message("Error parsing /EXCLUDE= "); return 0; endif; exclude_string := edt$next_token('/='+eve$x_whitespace,term_char); search_state := 1; !Found /EXCLUDE [4]: !/NUMBER=repeat_count (comes first so can shorten to N=) If term_char <> "=" then edx_message("Error parsing repeat count value"); return 0; Endif; val := edt$next_token('/='+eve$x_whitespace,term_char); If edtn$string_to_integer(val) then num := int(val); Else edx_message("Error parsing repeat count value"); return 0; Endif; [5]: !/NOEXACT CASE search_state FROM 0 TO 2 [0]: search_case := NO_EXACT; [1]: exclude_case := NO_EXACT; [2]: replace_case := NO_EXACT; ENDCASE; [6]: query := 0; !/NOQUERY [7]: typ := 0; !/NOTYPE [8]: !/NOWILD CASE search_state FROM 0 TO 2 [0]: search_wild := 0; [1]: exclude_wild := 0; [2]: replace_wild := 0; ENDCASE; [9]: query := 1; !/QUERY [10]: ! /REPLACE= if (term_char <> '=') then edx_message("Error parsing /REPLACE= "); return 0; endif; replace_string := edt$next_token('/='+eve$x_whitespace,term_char); search_state := 2; !Found /REPLACE [11]: search_direction := REVERSE; !/REVERSE [12]: typ := 1; !/TYPE [13,1]: !/WHOLE or /ALL whole := 1; num := -1; [14]: !/WILD CASE search_state FROM 0 TO 2 [0]: search_wild := 1; [1]: exclude_wild := 1; [2]: replace_wild := 1; ENDCASE; ENDCASE; ENDIF; ENDLOOP; !DISPATCH Return Jen$setup_search( search_string, exclude_string, replace_string, search_case, exclude_case, replace_case, search_wild, exclude_wild, replace_wild, whole, search_direction, query, typ, num ); ENDPROCEDURE !------------------------------------------------------------------------------ PROCEDURE EDTN$LINE_MODE_REPLACE Local search_string, replace_string, term_char; !GET STRINGS search_string := edt$next_token(eve$x_whitespace,term_char); IF (search_string = "") then search_string := edx_read_line("Old string: ",,"CTRL-Z"); If length(search_string)= 0 then edx_message("No string to replace"); return; Endif; ENDIF; replace_string := edt$next_token(eve$x_whitespace,term_char); IF (replace_string = "") then edtn$clear_message_window; replace_string := edx_read_line ("New string: "); ! empty string is ok here ENDIF; !DISPATCH Jen$setup_search( search_string, !Search string "", !Exclude string replace_string, !Replace string jen$x_default_search_case, !Search case EXACT, !Exclude case NO_EXACT, !Replace case edtn$v_search_wild, !Search wild 0, !Replace wild 0, !Exclude wild 0, !Whole current_direction, !Search direction 1, !Query 1, !Typ -1 ); !Num ENDPROCEDURE !------------------------------------------------------------------------------ PROCEDURE EDTN$SUB_TOKEN ( DELIMITERS, TERM_CHAR) ! Parser for substitute. This will return the next token from the line. ! Required since edt$next_token interprets quotes as defining a quoted string. ! Parameters: ! Delimiters - characters which can delimit a token ! Term_char - actual character that delimited returned token ! edt$x_line - what is left of the current line mode command LOCAL line_length, ! Length of line cp, ! Current pointer into line char, ! Current character token; ! Token to return token := ""; !initialize as string variable line_length := length(edt$x_line); !We assume there's at least one character. (It may be the end of string null character if string is empty). !Look for specified delimiter and extract the token cp := 1; LOOP term_char := substr(edt$x_line,cp,1); exitif cp > line_length; exitif (index(delimiters,term_char) <> 0); !exit if next character is delimiter cp := cp + 1 ENDLOOP; token := substr(edt$x_line,1,(cp - 1)); edt$x_line := substr(edt$x_line,(cp+1),line_length); return token; ENDPROCEDURE !------------------------------------------------------------------------------ !+ ! EDT line mode SUBSTITUTE command !- PROCEDURE EDT$LINE_MODE_SUBSTITUTE( DELIMITER ) ! support routine for line mode(subs cmd) local term_char, search_string, replace_string, whole, query, typ, num, val, how_exact, search_wild, state_token, state_index; ! ! This procedure searches and replaces a given string by a second string ! if found and more than one or global replacement requested, then the search ! and replace will continue until EOB or string-not-found. ! ! The command line reads: ! SUBSTITUTE /old/new/ [whole|rest] [/{no}query] [/{no}type] [/{no}exact] [/n=repeat_count] ! ! a '.' may be used instead of a '/' as a delimiter. ! ! Parse the rest of the line looking for old string and new string search_string := edtn$sub_token(delimiter,term_char); !parse "old/" replace_string := edtn$sub_token(delimiter,term_char); !parse "new/" if (term_char = "") then edx_message ('Delimiter for SUBSTITUTE could not be found'); RETURN 0; endif; !------------------------------------------------------------------------------ !NOW PARSE /[whole|rest], /[{no}query], /[{no}type], /[N=count], /[{no}exact] !INITIALIZE STATES whole := 0; query := 1; typ := 1; num := 1; search_wild := 0; how_exact := NO_EXACT; edit(edt$x_line,upper,off); LOOP state_token := edt$next_token(edtn$x_token_delimiters,term_char); if (state_token = "") then exitif; endif; state_index := index(edtn$x_sub_qualifiers,('/' + state_token)); state_index := ((state_index + edtn$v_sub_tablen - 1) / edtn$v_sub_tablen); CASE state_index FROM 0 TO 10 [0]: edx_message('Unsupported SUBSTITUTE option: ' + state_token); return 0; [1]: !/WHOLE whole := 1; num := -1; [2]: !/REST whole := 0; num := -1; [3]: !/N=repeat_count if term_char <> "=" then edx_message("Error parsing repeat count value"); return 0; endif; val := edt$next_token(edtn$x_token_delimiters,term_char); num := int(val); [4]: query := 1; !/QUERY [5]: query := 0; !/NOQUERY [6]: typ := 1; !/TYPE [7]: typ := 0; !/NOTYPE [8]: how_exact := EXACT; !/EXACT [9]: how_exact := NO_EXACT;!/NOEXACT [10]: search_wild := 1; !/WILD ENDCASE; ENDLOOP; !DISPATCH Jen$setup_search( search_string, !Search string "", !Exclude string replace_string, !Replace string jen$x_default_search_case, !Search case EXACT, !Exclude case how_exact, !Replace case search_wild, !Wildcard search 0, !exclude_wild 0, !replace_wild whole, !Whole current_direction, !Search direction query, !Query typ, !Typ num ); !Num ENDPROCEDURE !------------------------------------------------------------------------------ PROCEDURE EDTN$SEARCHALL ! ! This procedure searches for a given string. If found, the line containing ! the found string is copied to buffer SEARCH. The search continues until all ! lines containing said string are found and copied to the output buffer. !Implicit Inputs: ! jen$x_search_string - String or pattern to search for ! jen$x_exclude_string - string or pattern to exclude from search ! jen$x_search_case - Keyword EXACT or NO_EXACT ! jen$v_search_next - 0 = First time searching for jen$x_search_string ! 1 = searching for next jen$x_search_string !Assumed state at entry: ! current_buffer - buffer to search ! current-position - position to start search ! current_direction - direction to search ! jen$v_search_next = 0. ! In dual window mode, with buffer containing eve$mark_LAST in ! current window, and SEARCH_buffer in other window. ! LOCAL found_line, curs_line, buffer_ptr; !INITIALIZE SEARCH buffer_ptr := current_buffer; !ENTER MAIN LOOP LOOP IF (JEN$FIND_STRING) THEN !GET THE LINE AND LINE NUMBER found_line := current_line; curs_line := cursor_line_number; !PRINT OUT THE LINE WITH LINE NUMBER position(search_buffer); copy_text( FAO("!6UL !AS",curs_line,found_line) ); !(search_buffer not journaled) update(current_window); split_line; position(buffer_ptr); !GET READY FOR NEXT SEARCH If (current_direction = forward) then position(LINE_END); Else position(LINE_BEGIN); Endif; ELSE If (NOT jen$v_search_next) then !If we have not found string at least once... jen$strnotfound; !Message 'String not found' Endif; Exitif; !Exit search loop. String not found. ENDIF; ENDLOOP; !Loop until we exit when string not found. !NOW CLEAN UP position(search_buffer); append_line; !Remove last split_line position(LINE_BEGIN); edtn$highlight_word(jen$rn_search); !Highlight line number change_windows; ENDPROCEDURE PROCEDURE EDTN$SEARCH_UPDOWN(I) !Move pointer up. Highlight current word (hopefully a file name) edt$beg_word; move_vertical(I); edtn$highlight_word(jen$rn_search); ENDPROCEDURE PROCEDURE EDTN$SEARCH_ENTER LOCAL linum; If (get_info(jen$rn_search,'type')=RANGE) then linum := substr(jen$rn_search,1,length(jen$rn_search)); IF edtn$string_to_integer(linum) then If change_windows then eve$mark_LAST := mark(free_cursor); goto_line( INT(linum) ); Endif; ELSE edx_message("No line number to go to"); ENDIF; Else edx_message("No line number to go to"); Endif; ENDPROCEDURE !------------------------------------------------------------------------------ !+ ! Line mode SEARCH command !- PROCEDURE EDTN$LINE_MODE_SEARCH( DELIMITER ) ! Parse the line mode SEARCH command. The command line reads: ! ! SEARCH [/qualifiers] search_string [/qualifiers] ! ! If you wish to include a space, tab, slash ('/'), or equals sign ! ('=') within the search-string or exclude-string, then enclose the ! string in either single or double quotes. Otherwise the search-string ! does not have to be enclosed in quotes. If you wish to include within ! a quoted string the same quote character used to quote the string, use ! two consecutive quotes. For example, the string: "quote ""this""string" ! would be interpreted as: quote "this" string. ! LOCAL search_string, !String to search for exclude_string, !String not to search for search_case, !EXACT or NO_EXACT exclude_case, !EXACT or NO_EXACT search_state, !0 = FIND/EXACT 1 = /EXCLUDE=()/EXACT whole, !Search entire buffer search_wild, !Wild card search exclude_wild, !Wild card exclude search_in_reverse, !Search forwards or reverse buffer_name, !Name of buffer to search. Default= current buffer buffer_ptr, !Buffer to search. initial_bufptr, !Entry buffer term_char, prev_term_char, state_token, state_index, old_place; !INITIALIZE STATES search_string := ""; exclude_string := ""; search_state := 0; search_case := jen$x_default_search_case; exclude_case := NO_EXACT; buffer_name := get_info(current_buffer,'name'); search_wild := edtn$v_search_wild; term_char := delimiter; whole := 0; search_in_reverse := 0; ! PARSE THE REST OF THE LINE LOOKING FOR QUALIFIERS AND SEARCH_STRING LOOP prev_term_char := term_char; state_token := edt$next_token('/='+eve$x_whitespace,term_char); if (state_token = "") then exitif; endif; IF (prev_term_char <> '/') then !Then this token isn't a qualifier and must be the search string. if (search_string = edt$x_empty) then search_string := state_token; search_state := 0; else edx_message("Invalid qualifier "+state_token); return 0; endif ELSE change_case(state_token,upper); state_index := index(edtn$x_search_qualifiers,('/' + state_token)); state_index := ((state_index + edtn$v_search_tablen - 1) / edtn$v_search_tablen); CASE state_index FROM 0 TO 15 [0]: !(UNRECOGNISED) edx_message("Unsupported SEARCH option: " + state_token); return 0; [2]: !/BUFFER= if (term_char <> '=') then edx_message("Error parsing /BUFFER= "); return 0; endif; buffer_name := edt$next_token('/='+eve$x_whitespace,term_char); [3]: !/EXACT CASE search_state FROM 0 TO 1 [0]: search_case := EXACT; [1]: exclude_case := EXACT; ENDCASE; [4]: !/EXCLUDE= if (term_char <> '=') then edx_message("Error parsing /EXCLUDE= "); return 0; endif; exclude_string := edt$next_token('/='+eve$x_whitespace,term_char); search_state := 1; [5]: !/NOEXACT CASE search_state FROM 0 TO 1 [0]: search_case := NO_EXACT; [1]: exclude_case := NO_EXACT; ENDCASE; [6]: !/NOWILD CASE search_state FROM 0 TO 1 [0]: search_wild := 0; [1]: exclude_wild := 0; ENDCASE; [7]: search_in_reverse := 1; !/REVERSE [8,1]: !/WHOLE or /ALL whole := 1; [9]: !/WILD CASE search_state FROM 0 TO 1 [0]: search_wild := 1; [1]: exclude_wild := 1; ENDCASE; ENDCASE; ENDIF; ENDLOOP; !VALIDATE THAT WE HAVE A SEARCH STRING if (search_string = edt$x_empty) then edx_message("Search string required"); return 0; endif; !VALIDATE THAT WE HAVE A BUFFER TO SEARCH !DISALLOW SEARCHING THE SEARCH BUFFER If (buffer_name = "SEARCH") then edx_message("Cannot search the SEARCH buffer"); return 0; Endif; buffer_ptr := edt$find_buffer(buffer_name); !Get buffer to search If buffer_ptr = 0 then edx_message("No such buffer "+buffer_name); return 0; Endif; !SET GLOBAL PARAMETERS AND PROCESS WILDCARDS jen$x_search_string_text := search_string; IF (search_wild) then If eve$build_pattern(search_string,search_string) !Returns TRUE if output is pattern variable Then execute( "jen$x_search_string := " + search_string ) !Convert to a pattern variable Else jen$x_search_string := search_string; !String may have been changed Endif; ELSE jen$x_search_string := search_string; ENDIF; IF (exclude_wild) then If eve$build_pattern(exclude_string,exclude_string) !Returns TRUE if output is pattern variable Then execute( "jen$x_exclude_string := " + exclude_string ) !Convert to a pattern variable Else jen$x_exclude_string := exclude_string; !String may have been changed Endif; ELSE jen$x_exclude_string := exclude_string; ENDIF; jen$x_search_case := search_case; jen$x_exclude_case := exclude_case; jen$x_replace_string := 0; !Just a find only command jen$v_search_next := 0; !First time searching for new string !INITIALIZE THE SEARCH position(TEXT); !Sync the cursor old_place := mark(none); !Mark our starting location initial_bufptr := current_buffer; !Save our entry buffer if get_info(search_buffer,'type') = BUFFER then erase(search_buffer); !Erase SEARCH buffer endif; make_two_windows( "SEARCH", 0); !Display SEARCH buffer If get_info(top_window,'visible') then update(top_window) !Get status line separating windows Endif; update(current_window); ! position(buffer_ptr); !Go to the buffer to search. If initial_bufptr <> buffer_ptr then whole := 1 !Default to /WHOLE if /BUFFER=another-buffer Endif; If (whole) then !Position us where to start if (search_in_reverse) then position(end_of(current_buffer)) else position(beginning_of(current_buffer)) endif Endif; If (search_in_reverse) then set(reverse, current_buffer) Else set(forward, current_buffer) Endif; edtn$searchall; !Dispatch to search all routine position(old_place); set (forward,current_buffer); !By default set buffer to forward change_windows; !Put cursor in search window ENDPROCEDURE !------------------------------------------------------------------------------ PROCEDURE EDT$SUBSTITUTE !gold enter (substitute) If (edt$x_search_range = 0) !Make sure we found a string or (not edt$on_search_range) !and we're positioned on the search range then jen$strnotfound; !Message 'String not found' edt$x_repeat_count := 1; Else enable_buffer_journaling(current_buffer); erase (edt$x_search_range); edtx$copy_from(paste_buffer); jen$fndnxt(1,1,-1); !Search for next string Endif; ENDPROCEDURE !------------------------------------------------------------------------------ PROCEDURE EDTN$FIND_PAT(pat1,pat2) ! Used by WPS keypad KP7 key. !Used to go to beginning of next sentence !or go to beginning of next paragraph LOCAL rn1, rn2; position(TEXT); if current_direction = reverse then if (mark(free_cursor) <> beginning_of(current_buffer)) then move_horizontal(-1); rn2 := search(pat2,reverse,exact); if rn2 <> 0 then position(beginning_of(rn2)); if (mark(free_cursor) <> beginning_of(current_buffer)) then move_horizontal(-1); endif; endif; endif; endif; rn1 := search( pat1, current_direction, exact); !Search for end of sentence if rn1 = 0 then !If no end of sentence found if current_direction = reverse then !then position(beginning_of(current_buffer)) ! go to beginning of buffer else !or position(end_of(current_buffer)) ! go to end of buffer endif; return (0); !and return endif; position(end_of(rn1)); !go to end of sentence rn2 := search(pat2,forward,exact); !and search for beginning of next sentence if rn2 = 0 then return (0) !if no new beginning found then return else position(end_of(rn2)) endif; !else position to beginning of next sentence ENDPROCEDURE !------------------------------------------------------------------------------ PROCEDURE EDTN$FIND_CHAR(direction;character) !Search in specified direction for first occurance of character Local char,rn,dr; if character = tpu$k_unspecified then char := read_char else char := character endif; If (direction = forward) then dr := 1 Else dr := -1 Endif; position(TEXT); if ((dr = -1) and (mark(none) <> beginning_of(current_buffer))) then move_horizontal(-1); if (mark(none) <> beginning_of(current_buffer)) then move_horizontal(-1) endif; endif; if ( ((dr = 1) and (mark(none) = end_of(current_buffer))) or ((dr = -1) and (mark(none) = beginning_of(current_buffer))) ) then return endif; rn := search(char,direction,no_exact); if rn <> 0 then position(end_of(rn)); move_horizontal(1); return 1; else return 0; endif; ENDPROCEDURE !------------------------------------------------------------------------------ PROCEDURE WPS$SEARCH_LINE !For WPS keypad KP8 which searches current line for a tab character !Move one character in current direction, then !search line in current direction for first occurance of character. !Place cursor one character beyond found character. !Else go to start of next line, or beginning of this line. Local dr; position(TEXT); If (current_direction = forward) then dr := 1 Else dr := -1 Endif; if ((dr = -1) and (mark(none) <> beginning_of(current_buffer))) then move_horizontal(dr) endif; if ( ((dr = 1) and (mark(none) = end_of(current_buffer))) or ((dr = -1) and (mark(none) = beginning_of(current_buffer))) ) then return endif; If (jen$search_line(edt$x_tab_char,dr)) then move_horizontal(1); Else move_by_line; Endif; ENDPROCEDURE !------------------------------------------------------------------------------ PROCEDURE JEN$SEARCH_LINE(chars,dr) !Search current line in direction dr (1=forward, -1=reverse) from cursor !to end or beginning of line for one of 'chars'. ! Return 1 if char found, cursor positioned on char. ! Return 0 if char not found, cursor stays same. LOCAL here; position(TEXT); Here := mark(none); !(snapped to text) if (here = end_of(current_buffer)) then return(0) endif; LOOP if (INDEX(chars,current_character) <> 0) then !Found character we're looking for return(1); !FOUND endif; if ( ((dr = 1) and (current_character = "")) !Went to end of line or ((dr = -1) and (current_offset = 0)) ) !Went to start of line then position(here); !reposition return(0); !not found endif; move_horizontal(dr); !move to next character ENDLOOP; ENDPROCEDURE !------------------------------------------------------------------------------ !****************************************************************************** ! BUFFER/WINDOW PROCEDURES !****************************************************************************** !+ ! Process the line mode =buffer command !- PROCEDURE EDT$BUFFER ! support routine for line mode(= buffer cmd) ! This is to move to a new buffer and map it to the main window. If ! the buffer does not exist, create it with the NO_WRITE attribute. ! Get the name from the command line. LOCAL term_char, buffer_name; buffer_name := edt$next_token(edtn$x_token_delimiters,term_char); if (buffer_name = "") then edx_message('No buffer specified'); return (0) endif; If (buffer_name = '*') then buffer_name := edtn$newbufnam Endif; edtn$goto_buffer(buffer_name,0); ENDPROCEDURE PROCEDURE EDTN$NEWBUFNAM !Generate a new, unique buffer name. !Buffer names are A,B,C,,, AA, AB, ...ZZ !After that we prompt LOCAL i, j, bufnam; !INITIALIZE DATA j := 65; ! ascii "A" !SEARCH FOR A SINGLE CHARACTER BUFFER NAME A, B, ...Z loop bufnam := ascii(j); if (edt$find_buffer(bufnam) = 0) then return(bufnam) endif; j := j + 1; exitif (j > 90); endloop; !SEARCH FOR A DOUBLE CHARACTER BUFFER NAME AA, AB,...ZZ i := 65; ! ascii "A" j := 65; ! ascii "A" loop bufnam := ascii(i) + ascii(j); if (edt$find_buffer(bufnam) = 0) then return(bufnam) endif; j := j + 1; IF (j > 90) then If (i = 90) then edx_message ("I'm sorry, I can't count any higher than ZZ"); if get_info(system,'display') then bufnam := edx_read_line("Enter a buffer name: "); return (bufnam); else return(""); endif; Else j := 65; i := i + 1; Endif; ENDIF; endloop; ENDPROCEDURE !------------------------------------------------------------------------------ !+ ! Find the buffer by name ! (Replaced in VMS 5.3 in version specific) !- PROCEDURE EDT$FIND_BUFFER ( BUFFER_NAME) ! support routine for line mode LOCAL upcased_name , buffer_ptr ; upcased_name := buffer_name; edit(upcased_name,trim,upper); buffer_ptr := get_info(buffers,'first'); loop exitif buffer_ptr = 0; exitif upcased_name = get_info(buffer_ptr,'name'); buffer_ptr := get_info(buffers,'next'); endloop; return buffer_ptr; ENDPROCEDURE !------------------------------------------------------------------------------ !PROCEDURE EDTN$CREATE_BUFFER(buffer_name,filespec) ! Create buffer variable given the name of the buffer. ! Return the buffer pointer. ! We used to also create a global variable of the form NAME_buffer for each ! buffer. Trying this without that now. We can add it back later if we ! need it. Couldn't trap errors when using EXECUTE, so had to do it directly. ! ! Also trap Fatal Internal TPU Errors. ! And trap TPU$_OPENIN errors if can't access the specified file. ! !As of VMS 4.4 when CREATE_BUFFER generates a 'memory allocation' type !error before reading in a specified file a corrupted buffer is created !at the end of VAXTPU's internal list of buffers. A fatal internal TPU !error will occur if: ! 1. An attempt is made to go to that buffer ! 2. An attempt is made to delete that buffer ! 3. An attempt is made to modify characteristics of that buffer ! 4. An attempt is made to create yet another buffer ! 5. A line mode "SHOW BUFFERS" command is issued !If the 'memory allocation' type error occurs while a specified file is being !read in then existing buffers are left uncorrupted, the new buffer is not !added to the list, but the EOB_TEXT of the last buffer is changed to that !of the new buffer, and the screen is mapped to the last buffer in the list. !The error is apparently not signaled when execute attempts to create the !buffer, and this procedure continues changing the EOB_TEXT of the last buffer !assuming it is the newly created one. At this point a fatal internal TPU !error is not created by a "SHOW BUFFERS" type command, which is why the !user still has time to exit and confirm his exit. But a fatal internal TPU !error will occur if the user tries to create a new buffer. The exact list !of other things that can go wrong at this point is unknown. ! ! VMS 5.4 helps this problem by introducing work files. May not be such a ! problem in the future. ! !TPU$_OPENIN ! If the buffer is created with a file, and there is an error reading in the ! file, such as file not found, or file locked by another user, then the ! buffer still specifies that it was created with that file, and VAXTPU in ! an attempted buffer journal recovery would still try to read in the specified ! file even though the buffer was actually created empty. Therefore we must ! delete that corrupted buffer and create a new one without the file. ! PROCEDURE EDTN$CREATE_BUFFER(buffer_name,filespec) LOCAL buffer_ptr, full_filnam, saved_error, cw; ON_ERROR SAVED_ERROR := ERROR; IF ((SAVED_ERROR = TPU$_NOCACHE) OR (SAVED_ERROR = TPU$_GETMEM)) THEN edtn$nocache_warning(cw); !Abort ELSE IF (SAVED_ERROR = TPU$_OPENIN) !Error reading in file. Recreate buffer without file and continue. THEN Set(message_action_type,NONE); !Reset to nohighlight buffer_ptr := get_info(buffers,'last'); !Can't seem to get this passed into the ON_ERROR block. We know it's the last one because it was just created. delete(buffer_ptr); !Delete corrupted buffer buffer_ptr := create_buffer(buffer_name); !and create new one without file set(output_file, buffer_ptr, full_filnam); set (no_write, buffer_ptr); !Set standard attributes of the new buffer set(eob_text, buffer_ptr, "[End of "+buffer_name+"]"); return (buffer_ptr); ELSE IF (SAVED_ERROR = TPU$_TRUNCATE) THEN message(error_text); !Say it once and be done with it. ELSE message(error_text); !Say whatever the unexpected message was set(message_action_type,NONE); !Reset to nohighlight Return 0; !and return sorry. ENDIF; ENDIF; ENDIF; ENDON_ERROR; !SAVE OUR CURRENT POSITION AND STATUS IN CASE OF ERROR if get_info(system,'display') then cw := current_window endif; !BUGFIX VMS 5.3 PREPARE TO CREATE BUFFER !IF BUFFER IS CREATED WITH FILE THEN !PRINT MESSAGE SAYING WE'RE READING IN THE FILE (Also fixes message window for VMS 5.3) !Bug fix VMS 5.3 message window. (See description of problem at head of this file) !Just always do it !If ( (get_info(system,'version') > 2) !If TPU = 3.x or higher !or ((get_info(system,'version') = 2) !or TPU = 2.4 or higher !and (get_info(system,'update') >= 4)) ) !then If length(filespec) = 0 then if get_info(system,'display') then update(message_window) endif; !Sync message window Else if (NOT edtn$file_parse(full_filnam,filespec,"","")) then return(0) endif; edtn$fit_message("Reading in file !AS",full_filnam); Endif; !Endif; set(message_action_type,reverse); !To highlight "nnn lines read from file ..." message. Helps VMS 5.3 bug !CREATE THE BUFFER IF length(filespec)=0 then buffer_ptr := CREATE_BUFFER(buffer_name); ELSE buffer_ptr := CREATE_BUFFER(buffer_name,full_filnam); !Possible OPENIN error ENDIF; Set(message_action_type,none); !Reset to nohighlight !ENABLE BUFFER JOURNALING !BUFFER JOURNALING IS ENABLED WHEN BUFFER IS FIRST MODIFIED !!! enable_buffer_journaling(buffer_ptr); !LOCK BUFFER IF REQUESTED if ((edtn$v_lock) and (length(filespec)<>0)) then do_command("LOCK FILE " + edtn$filename_of_buffer(buffer_ptr)) endif; !SET STANDARD ATTRIBUTES OF THE NEW BUFFER set (no_write, buffer_ptr); set(eob_text, buffer_ptr, "[End of "+buffer_name+"]"); !RETURN return (buffer_ptr); ENDPROCEDURE !------------------------------------------------------------------------ PROCEDURE EDTN$GOTO_BUFFER( BUF_NAM, FIL_NAM; LINNUM, MODULE_NAME) ! Map specified buffer to current window ! Parameters: ! buf_nam - Name of buffer to go to. ! fil_nam - Name of file to read into buffer ! fil_nam = 0 - nofile ! fil_nam = "" - prompt for file name only if buffer ! buf_nam doesn't exist. ! fil_nam = "filename" - read in that file even if buffer ! buf_nam exists. ! ! GLOBAL - BUFW$M_DUALPOS; LOCAL buffer_name, !Name of buffer to go to filename, !Name of optional file to read into newly created buffer full_filnam, buffer_ptr, term_char, file_write, mark_name, mark_name_prefix, other_buf, sav_dualpos, templine, cw, !current window inmain, !true if this is the main buffer remakebuf, !true if we should delete buffer and make new one opf, !output file name nw, !no write mod; !modifiable ON_ERROR [TPU$_COMPILEFAIL]: edx_message("Invalid buffer specification: " + buffer_name); return(0); [OTHERWISE]: !Print error message, return(false); ENDON_ERROR; !IF WE'RE IN THE PROMPT_WINDOW OR INFO_WINDOW, !UNMAP THEM TO GET PROPER WINDOW TO GO TO. If get_info(prompt_window,"buffer") <> 0 then unmap(prompt_window) endif; If get_info(info_window,"buffer") <> 0 then unmap(info_window) endif; !INITIALIZE VARIABLES buffer_name := buf_nam; !Local copy of buffer name to go to filename := fil_nam; !Local copy of file to read into newly created buffer if get_info(system,'display') then cw := current_window; endif; !GET BUFFER NAME TO GO TO IF (buffer_name = '*') then buffer_name := edtn$newbufnam ELSE edit (buffer_name, TRIM, UPPER); If buffer_name = "" then if get_info(system,'display') then edtn$clear_message_window; !Clear message window buffer_name := edx_read_line ("Buffer name: ",,"CTRL-Z"); edit (buffer_name, TRIM, UPPER); If (buffer_name = '*') then buffer_name := edtn$newbufnam Endif; If (length(buffer_name) = 0) then Return(0); Endif; else edx_message("Buffer name required"); return(0); endif; Endif; ENDIF; !CHECK IF BUFFER ALREADY EXISTS buffer_ptr := edt$find_buffer(buffer_name); if (buffer_ptr = main_buffer) then inmain:=TRUE; else inmain:=FALSE; endif; !IF BUFFER IS EMPTY AND WE'RE READING IN A FILE AND BUFFER IS BEING JOURNALED !THEN DELETE IT AND START NEW. !(reading in large files is costly (slow) with buffer journaling !creating a new buffer with the file is much faster. remakebuf := FALSE; IF (get_info(buffer_ptr,'type')=BUFFER) THEN !buffer already exists IF (get_info(filename,'type')=STRING) THEN !reading in a file IF (filename <> "") THEN !reading in a file IF (get_info(current_buffer,'record_count') = 0) THEN !buffer is empty IF (enable_buffer_journaling(buffer_ptr)) !doing buffer journaling THEN remakebuf := TRUE; !delete buffer and create new one opf := edtn$filename_of_buffer(buffer_ptr); nw := get_info(buffer_ptr,"no_write"); mod := get_info(buffer_ptr,"modifiable"); ENDIF; ENDIF; ENDIF; ENDIF; ENDIF; !IF BUFFER DOESN'T ALREADY EXIST ! 1. TEST BUFFER NAME ! 2. GET OPTIONAL FILENAME IF FILENAME = "" ! 3. TEST FILENAME ! 4. CREATE BUFFER WITH OR WITHOUT OPTIONAL FILE ! 5. POSITION TO LINNUM IF SPECIFIED (LATER, COULD BE ATTACHED TO FILENAME AS /START=) IF ((buffer_ptr = 0) OR remakebuf) then !MAKE name_BUFFER? compile("edtn$testassign:="+buffer_name+"_buffer"); !TEST FOR VALID BUFFER NAME If filename = "" then if get_info(system,'display') then filename := edx_read_line(FAO("Enter optional file for new buffer !AS: ",buffer_name),,"CTRL-Z"); If ((length(filename) = 0) and (last_key = ctrl_z_key)) then Return(0) Endif; !User didn't want this procedure endif; Endif; if filename = 0 then filename := "" endif; edit (filename, trim, upper); ! PARSE FOR OPTIONAL /MODULE=modnam and /START=linnum qualifiers here (someday) ! 3. TEST FILENAME if (NOT edtn$file_parse(full_filnam,filename,"","")) then return(0) endif; ! 4. CREATE BUFFER WITH OR WITHOUT OPTIONAL FILE, OR WITH MODULE If (remakebuf) then if get_info(system,'display') then map(cw,show_buffer) endif; !this prevents message window from freezing on VMS 5.3, & 5.4 too. delete(buffer_ptr); ! show_buffer is temporary buffer so window stays mapped. endif; If (module_name = "") OR (module_name = TPU$K_UNSPECIFIED) then buffer_ptr := edtn$create_buffer(buffer_name,filename); if (buffer_ptr = 0) then return(0) endif; !Return if there was a problem creating the new buffer. (hopefully it was not the MAIN buffer) if (remakebuf) then if (inmain) then main_buffer := buffer_ptr; !must always have variable main_buffer OK set(output_file,main_buffer,opf); !main_buffer doesn't change filename endif; if (NOT nw) then set(no_write,buffer_ptr,OFF); endif; if (NOT mod) then set(modifiable,buffer_ptr,OFF) endif; endif; templine := 1; Else buffer_ptr := edtn$create_buffer(buffer_name,""); if (inmain) then main_buffer := buffer_ptr endif; !must always have variable main_buffer OK if (buffer_ptr = 0) then return(0) endif; !Return if there was a problem creating the new buffer. position(buffer_ptr); templine := cursor_line_number; edtn$read_tlbmod(full_filnam + edt$x_space + module_name); !Read in module from text library Endif; ! 5. POSITION TO LINNUM IF SPECIFIED (LATER, COULD BE ATTACHED TO FILENAME AS /START=) If get_info(linnum,'type')=INTEGER then goto_line( linnum + templine -1 ); Endif; !BUFFER ALREADY EXISTS. ! 1. TEST FILENAME IF FILENAME <> 0 | "" ! 2. READ IN THE FILE OR TEXT LIBRARY MODULE ELSE IF (get_info(filename,'type') = STRING) then edit (filename, trim, upper); IF (length(filename) > 0) then if (NOT edtn$file_parse(full_filnam,filename,"","")) then return(0) endif; ! 2. READ IN THE FILE OR TEXT LIBRARY MODULE position(buffer_ptr); templine := cursor_line_number; If (module_name = "") OR (module_name = TPU$K_UNSPECIFIED) then edtn$read_file(full_filnam); !Read, position, set status line Else edtn$read_tlbmod(full_filnam + edt$x_space + module_name); !Read in module from text library Endif; !POSITION OURSELVES if get_info(linnum,'type')=INTEGER then goto_line( linnum + templine -1 ); endif; ENDIF; ENDIF; ENDIF; !MAP CURRENT WINDOW TO BUFFER_PTR AND SET STATUS LINE. IF get_info(system,'display') then ! If using dual windows, and same buffer was in both windows, ! then save position where we were in buffer in window being unmapped. ! When unmapping buffer, if same buffer is in other window, then set marker, ! else if buffer of mark is same as buffer being unmapped, delete marker, ! because map count for that buffer is going to 0. sav_dualpos := bufw$m_dualpos; If (get_info(current_buffer,"map_count") > 1) then if (current_buffer <> buffer_ptr) !we really are going to a different buffer then bufw$m_dualpos := mark(free_cursor); else sav_dualpos := 0; !Don't move to dualpos mark, endif; !we're already where we want to be. Else if (get_info(bufw$m_dualpos,"type") = MARKER) then if (get_info(bufw$m_dualpos,"buffer") = current_buffer) then bufw$m_dualpos := 0; sav_dualpos := 0; endif; endif; Endif; ! Map the new buffer. (unmaps the old buffer) MAP(cw,buffer_ptr); ! If new buffer mapped is same as in other window, then position to ! saved position where we were when this buffer was unmapped. IF (current_window = TOP_WINDOW) THEN other_buf := get_info(bottom_window,"buffer"); ELSE If (current_window = BOTTOM_WINDOW) then other_buf := get_info(top_window,"buffer"); else other_buf := 0; endif; ENDIF; If ( get_info(other_buf,"type") = BUFFER ) then If ( buffer_ptr = other_buf ) then if (get_info( sav_dualpos, "type" ) = MARKER ) then position( sav_dualpos ); endif; Endif; Endif; edtp$set_status_line(current_window); ELSE position(buffer_ptr); !/NODISPLAY mode ENDIF; Return(1); ENDPROCEDURE !---------------------------------------------------------------------- PROCEDURE EDTN$DELETE_BUFFER(buffer_to_delete) !buffer_to_delete - buffer type variable !If the buffer is visible, then the window will be unmapped when the buffer !is deleted. If we don't take care of this situation, the user may end !up in the message_window. Local info_buffer, bottom_buffer; IF (get_info(system,'display')) then If ( get_info( buffer_to_delete, 'map_count' ) > 0 ) then if ( get_info( info_window, 'visible' ) ) then info_buffer := get_info( info_window, 'buffer' ); unmap( info_window ); else info_buffer := 0; endif; if ( get_info(top_window,'buffer') = buffer_to_delete ) THEN bottom_buffer := get_info(bottom_window,'buffer'); IF (GET_INFO(bottom_buffer,"TYPE") = BUFFER ) THEN If (bottom_buffer <> buffer_to_delete ) then unmap(top_window); unmap(bottom_window); delete(buffer_to_delete); map(main_window, bottom_buffer ); edtp$set_status_line(main_window); Else !else both top and bottom windows display the buffer we are to delete unmap(top_window); unmap(bottom_window); delete(buffer_to_delete); map(main_window, get_info(BUFFERS,'last') ); !Map to a different buffer edtp$set_status_line(main_window); Endif; ELSE !else bottom window is not mapped delete(buffer_to_delete); map(top_window, get_info(BUFFERS,'last') ); !Map to a different buffer edtp$set_status_line(top_window); ENDIF; else !else not in top window IF ( get_info( main_window,'buffer') = buffer_to_delete ) THEN delete(buffer_to_delete); map(main_window, get_info(BUFFERS,'last') ); !Map to a different buffer edtp$set_status_line(main_window); ELSE !else bottom window probably contains buffer to delete delete(buffer_to_delete); ENDIF; endif; If (get_info(info_buffer,'type')=BUFFER) then map(info_window,info_buffer); !Redisplay the info buffer as we were Endif; Else !else buffer to delete is not mapped delete(buffer_to_delete); Endif; ELSE !else we are not in display mode delete(buffer_to_delete); ENDIF; ENDPROCEDURE PROCEDURE EDTP$OVERSTRIKE ! Swap between overstrike and insert modes LOCAL buffer_ptr; buffer_ptr := current_buffer; if (get_info(buffer_ptr,'mode') = insert) then set (overstrike,buffer_ptr) else set (insert,buffer_ptr) endif; edtn$update_visible_statln( buffer_ptr ); ENDPROCEDURE !------------------------------------------------------------------------------ PROCEDURE EDTN$TOGGLE_WINDOWS ! Toggle between single and dual windows If (NOT get_info(system,'display')) then return(0) endif; !Check for /NODISPLAY mode If (get_info(bottom_window,'visible')) then !If bottom window in use then make_one_window(current_buffer) ! in dual window mode. Else ! make_two_windows("","") !otherwise switch to two windows Endif; ! Return; ENDPROCEDURE PROCEDURE EDTN$MAKE_ONE_WINDOW(THIS_BUFFER) !Here for backwards compatibility make_one_window(this_buffer); ENDPROCEDURE PROCEDURE MAKE_ONE_WINDOW(THIS_BUFFER) ! Map this_buffer to the main_window LOCAL here; If (NOT get_info(system,'display')) then return(0) endif; !Check for /NODISPLAY mode !MARK OUR CURRENT POSITION ! (In case this_buffer is in both windows we need to save our position ! Otherwise position changes as windows are unmapped.) position(this_buffer); here := mark(free_cursor); !UNMAP TOP AND BOTTOM WINDOWS IF (get_info(top_window,'visible')) then unmap (top_window); ENDIF; IF (get_info(bottom_window,'visible')) then unmap (bottom_window); ENDIF; !MAP MAIN WINDOW TO THIS BUFFER MAP (main_window, this_buffer); edtp$set_status_line(main_window); position(here); edtn$adjust_ruler_shift; !in case top window was shifted !DELETE DUALPOS MARKER bufw$m_dualpos := 0; ENDPROCEDURE PROCEDURE EDTN$MAKE_TWO_WINDOWS(SEC_BUF_NAM,SEC_FIL_NAM) !Here for backwards compatibility make_two_windows(sec_buf_nam,sec_fil_nam); ENDPROCEDURE PROCEDURE MAKE_TWO_WINDOWS(SEC_BUF_NAM,SEC_FIL_NAM) ! Current buffer goes to top_window and second buffer goes to bottom_window ! with cursor, unless main_window not mapped and current buffer is in ! bottom window in which case second buffer goes to top window with cursor. ! ! PARAMETERS: ! sec_buf_nam - name of buffer for second window. ! "" to prompt, 0 for no second buffer. ! sec_fil_nam - name of file for second buffer ! 0 for no file, "" for prompt. LOCAL first_buffer, first_window, second_bufnam, second_window, filename, second_buffer_ptr, fromain, tempbuf; ON_ERROR [TPU$_COMPILEFAIL]: edx_message("Invalid buffer specification: " + second_bufnam); return(0); [OTHERWISE]: !Print error message, return(false); ENDON_ERROR; If (NOT get_info(system,'display')) then return(0) endif; !Check for /NODISPLAY mode !INITIALIZE VARIABLES first_window := top_window; second_window := bottom_window; first_buffer := current_buffer; second_bufnam := sec_buf_nam; filename := sec_fil_nam; !ESTABLISH NAME OF SECOND BUFFER If get_info(second_bufnam,'type') = STRING then if second_bufnam = "" then second_bufnam := edx_read_line("Enter name of second buffer: ",,"CTRL-Z"); endif; edit(second_bufnam,trim,upper); If (length(second_bufnam)=0) and (last_key=ctrl_z_key) then Return endif; !User wants to abort this procedure If (second_bufnam = '*') then second_bufnam := edtn$newbufnam; Else if ( (second_bufnam <> 0) and (second_bufnam <> "") ) then second_buffer_ptr := edt$find_buffer(second_bufnam); if (second_buffer_ptr = 0) then compile("testassign:="+second_bufnam+"_buffer"); !TEST BUFFER NAME FOR ERRORS endif; endif; Endif; Endif; !NOW THAT WE'VE TESTED FOR ERRORS AND FOUND NONE, NOW WE CAN GO AHEAD. !UNMAP THE MAIN WINDOW OR CHECK WHICH WINDOW TO GO TO if (get_info(main_window,'visible')) then fromain := 1; unmap (main_window); else fromain := 0; if current_window = bottom_window then first_window := bottom_window; second_window := top_window; endif; endif; !MAP THE FIRST WINDOW if (get_info(first_window,'visible')=0) then map (first_window, first_buffer); edtp$set_status_line(first_window); if (first_window = top_window) then edtn$adjust_ruler_shift; !in case main window was shifted endif; endif; !NOW DO SECOND WINDOW if (second_bufnam = 0) then return endif; If (second_bufnam = "") then if (NOT fromain) then make_one_window(first_buffer); else edx_message("no second buffer specified"); endif; RETURN; Endif; !GOTO SECOND_WINDOW tempbuf := show_buffer; map(second_window, tempbuf); !get us in the second_window. If (NOT edtn$goto_buffer(second_bufnam,filename)) then !goto buffer & file in second window unmap(second_window); Endif; ENDPROCEDURE !---------------------------------------------------------------------- PROCEDURE OTHER_WINDOW !Placed here for better compatability return change_windows; ENDPROCEDURE PROCEDURE CHANGE_WINDOWS ! Change between windows when in dual window mode ! Local top_buf, bottom_buf; If (NOT get_info(system,'display')) then return(0) endif; !Check for /NODISPLAY mode IF ( (get_info(top_window,'visible')) AND (get_info(bottom_window,'visible')) ) THEN ! Switch windows If top_window = current_window then position(bottom_window) Else position(top_window) Endif; ! Set buffers to forward by default unless both ! top and bottom windows show the same buffer. Top_buf := get_info(top_window,'buffer'); Bottom_buf := get_info(bottom_window,'buffer'); If ( Top_buf <> Bottom_buf ) then if get_info(top_buf,'type') = BUFFER then set(forward,top_buf) endif; if get_info(bottom_buf,'type') = BUFFER then set(forward,bottom_buf) endif; Endif; ELSE edx_message('Dual windows not in use.'); return (0); ENDIF; Return (1); ENDPROCEDURE !---------------------------------------------------------------------- PROCEDURE EDTP$SET_STATUS_LINE(WHICH_WINDOW) ! Procedure to set the status line of the specified window. ! ! Buffer name 1 - 8 = 8 ! Spaces 9 - 10 = 2 ! "File: " 11 - 16 = 6 ! File name 17 - 58 = 42 (and module name if from a text library) ! Spaces 59 - 60 = 2 ! Mode 61 - 70 = 10 ! Spaces 71 - 72 = 2 ! Columnar 73 - 80 = 8 ! TOTAL 80 LOCAL Which_Buffer, Mode, file, filnam, modnam, file_field_width, Column_Mode, Full_buffer_name, Buffer_name, retcode, result; If (NOT get_info(system,'display')) then return(0) endif; !Check for /NODISPLAY mode !GET BUFFER IN WINDOW Which_Buffer:= get_info(which_window,'buffer'); if (Which_Buffer = 0) then return endif; !GET BUFFER NAME full_buffer_name := get_info(Which_Buffer,'name'); !Handle system buffers differently from user buffers IF ((full_buffer_name = "ASCII") OR (full_buffer_name = "CALENDAR") OR (get_info(Which_Buffer,'permanent'))) THEN filnam := get_info(which_buffer,'output_file'); if filnam = 0 then filnam := "" endif; file := FAO("!48AS",filnam); Buffer_name := "<" + Full_Buffer_Name + ">" + SUBSTR(" ",1,8 - length(full_buffer_name)) ELSE if (length(full_buffer_name) > 6) then Buffer_name := "<" + SUBSTR(Full_Buffer_Name,1,6) + "." !use "." to indicate buffer name longer than will fit else Buffer_name := "<" + Full_Buffer_Name + ">" + SUBSTR(" ",1,6 - length(full_buffer_name)) endif; filnam := edtn$filename_of_buffer(Which_Buffer); modnam := edtn$modnam_of_buffer(Which_Buffer); If length(modnam) > 0 then file_field_width := 39 - length(modnam); !40 - length(" "+modnam) Else file_field_width := 42; Endif; edtn$trim_filespec( filnam, file_field_width); If length(modnam) > 0 then File := 'Module: ' + modnam + edt$x_space + Filnam; Else File := 'File: ' + Filnam; Endif; ENDIF; !GET MODE if (get_info(which_buffer,'mode') = INSERT) then mode := 'Insert ' else mode := 'Overstrike' endif; !ARE WE IN COLUMNAR MODE OR IS BUFFER LOCKED? if (edtn$v_columnar_mode) then column_mode := 'Columnar' else !IS BUFFER LOCKED? column_mode := ' '; If ((edtn$v_locked_files) AND (filnam <> "")) then result := call_user(65542,filnam); !'00010006'x Check if file is locked retcode := int(substr(result,1,9)); if retcode = 1 then column_mode := 'Locked ' endif; Endif; endif; !SET STATUS LINE Set (status_line, Which_Window, REVERSE, Buffer_Name + " " + File + " " + Mode + " " + Column_Mode); ENDPROCEDURE; !---------------------------------------------------------------------- PROCEDURE EDTN$UPDATE_VISIBLE_STATLN( BUFFER_PTR ) ! Update status line of windows containing buffer_ptr ! SEE IF MAIN_WINDOW, TOP_WINDOW, OR BOTTOM_WINDOW HAS BUFFER If get_info(system,'display') then if ( get_info(main_window,'buffer') = buffer_ptr ) then edtp$Set_Status_Line(main_window); update(main_window); endif; if ( get_info(top_window,'buffer') = buffer_ptr ) then edtp$Set_Status_Line(top_window); update(top_window); endif; if ( get_info(bottom_window,'buffer') = buffer_ptr ) then edtp$Set_Status_Line(bottom_window); update(bottom_window); endif; Endif; ENDPROCEDURE !---------------------------------------------------------------------- PROCEDURE EDTN$SET_INFO_WINDOW_STATLN set(status_line,info_window,NONE,""); set(status_line,info_window,REVERSE,""); set(status_line,info_window,BLINK, "Press CTRL-F to remove INFO_WINDOW and resume editing"); ENDPROCEDURE !---------------------------------------------------------------------- PROCEDURE EDTN$TRIM_FILESPEC( FILESPEC, MAXLEN) ! Trim filespec to given length. ! This procedure is modeled after LIB$TRIM_FILESPEC ! Given a file specification and a length, this procedure builds an ! output file string by piecing together the components of the file ! specification as follows: ! 1. Name ! 2. Type ! 3. Version ! 4. Directory ! 5. Device ! 6. Node ! ! David Deley November, 1987 LOCAL ln, nam, typ, ver, dir, dev; !SEE IF FILESPEC ALREADY FITS ln := length( filespec); If ln <= maxlen then loop !If so then pad it with spaces exitif length( filespec) = maxlen; ! until it's the right length filespec := filespec + edt$x_space; ! and then return endloop; return; Endif; !PARSE FILESPEC nam := FILE_PARSE (filespec, "", "", NAME); typ := FILE_PARSE (filespec, "", "", TYPE); ver := FILE_PARSE (filespec, "", "", VERSION); dir := FILE_PARSE (filespec, "", "", DIRECTORY); dev := FILE_PARSE (filespec, "", "", DEVICE); !SEE IF NAME ALONE IS TOO LONG !If so then trim it to maxlength and return If length( nam) > maxlen then filespec := SUBSTR( nam,1,maxlen); return Endif; !SEE IF NAME.TYPE IS TOO LONG !If so then pad the name and return filespec := nam; If length( nam + typ) > maxlen then loop exitif length( filespec) = maxlen; filespec := filespec + edt$x_space; endloop; return Endif; !SEE IF NAME.TYPE;VERSION IS TOO LONG !If so then pad name.type and return filespec := nam + typ; If length( nam + typ + ver) > maxlen then loop exitif length( filespec) = maxlen; filespec := filespec + edt$x_space; endloop; return Endif; !SEE IF [DIRECTORY]NAME.TYPE;VERSION IS TOO LONG !If so then pad name.type;version and return filespec := nam + typ + ver; If length( dir + nam + typ + ver) > maxlen then loop exitif length( filespec) = maxlen; filespec := filespec + edt$x_space; endloop; return Endif; !SEE IF DISK[DIRECTORY]NAME.TYPE;VERSION IS TOO LONG !If so then pad [directory]name.type;version and return filespec := dir + nam + typ + ver; If length( dev + dir + nam + typ + ver) > maxlen then loop exitif length( filespec) = maxlen; filespec := filespec + edt$x_space; endloop; return Endif; !PAD DISK:[DIRECTORY]NAME.TYPE;VERSION AND RETURN filespec := dev + dir + nam + typ + ver; loop exitif length( filespec) = maxlen; filespec := filespec + edt$x_space; endloop; return; ENDPROCEDURE !---------------------------------------------------------------------- PROCEDURE EDTN$FILENAME_OF_BUFFER(WHICH_BUFFER) ! Return the file name of the current buffer LOCAL file, s; ! GET THE FILENAME file := get_info(Which_Buffer,'output_file'); if file = 0 then file := get_info(Which_Buffer,'file_name') endif; !TRIM OFF THE MODULE NAME IF PRESENT edit(file,trim,OFF); s := index(file,edt$x_space); if (s <> 0) then file := substr(file,1,s-1); !extract just the filename endif; Return(file); ENDPROCEDURE !------------------------------------------------------------------------------ PROCEDURE EDTN$MODNAM_OF_BUFFER(WHICH_BUFFER) ! If editing a module within a text library, ! return the module name of the current buffer ! Else return a null string (no module) LOCAL file, s, modnam; !GET THE FILENAME file := get_info(Which_Buffer,'output_file'); if file = 0 then file := get_info(Which_Buffer,'file_name') endif; !EXTRACT THE MODULE NAME IF PRESENT edit(file,trim,OFF); s := index(file,edt$x_space); if (s <> 0) then modnam := substr(file,s+1,length(file)); !extract just the module name else modnam := ""; endif; return(modnam); ENDPROCEDURE !------------------------------------------------------------------------------ PROCEDURE EDTN$TOGGLE_WINDOW_WIDTH !Toggle between 80 and 132 columns. !Actually toggle between current window setting (if <=80) and 132 ! LOCAL window_width; If (NOT get_info(system,'display')) then return(0) endif; !Check for /NODISPLAY mode window_width := get_info(current_window,'width'); if window_width <= 80 then edtn$v_wide_window_width := window_width; do_command("SET SCREEN 132"); else do_command("SET SCREEN 80"); !switch it back to 80 column mode first do_command(FAO("SET SCREEN !ZL",edtn$v_wide_window_width)); endif; ENDPROCEDURE !------------------------------------------------------------------------------ PROCEDURE EDTN$SCROLL_WINDOW(direction) !Continuous scroll of current window in given direction !PARAMETER: ! direction - keyword. Either forward or reverse. ! LOCAL cw,buf,dummy_key; If (NOT get_info(system,'display')) then return(0) endif; !Check for /NODISPLAY mode cw := current_window; !Mark current window set(direction,current_buffer); !Set direction of buffer (forward/reverse) edtn$clear_message_window; !Clear message window erase(prompt_buffer); !Prepare prompt buffer for message position(prompt_buffer); copy_text("Press any key to stop scrolling"); map(prompt_window,prompt_buffer); update(prompt_window); SCROLL(CW); !DO THE SCROLLING dummy_key := read_key; !Stop scrolling when user presses key unmap(prompt_window); !Remove message update(message_window); !Reset message_window to bottom of buffer position(cw); !Go back to user's buffer ENDPROCEDURE !------------------------------------------------------------------------------ PROCEDURE EDTN$SHIFT_WINDOW(NUMCOLS) !Shift current window left/right. !NUMCOLS = number of columns to shift (integer, positive or negative). Local N, total_shift; IF (NOT get_info(system,'display')) then edx_message("Can not shift screen in /NODISPLAY mode"); return(0); ENDIF; N := NUMCOLS; If ( N = 0 ) then N := edx_read_line("Enter number of columns to shift window (negative to shift left): ",,"CTRL-Z"); edit(N,trim,upper,OFF); if ( N = "" ) then N := 0 else N := int(N) endif; endif; total_shift := shift(current_window,N); edtn$adjust_ruler_shift; update(current_window); edx_message("Window shifted total of !UL columns",EDX$K_INFO,total_shift); edx_message(""); !This quick-fix kludge makes GOLD repeat-count !work with GOLD arrow-keys. As in GOLD 3 GOLD <- !to shift window left three times. Leave last !line in message bufffer blank so edt$gold_number !sees no change. ENDPROCEDURE !------------------------------------------------------------------------------ PROCEDURE ADJUST_DUAL_WINDOWS(NUM) LOCAL maxmove, !Maximum number of lines up/down divider may move tempbuf, !A temporary buffer tempmaptop, !A logical flag tempmapbottom, !A logical flag cw,wl,vl, !current window, window length, visible length msgstr; !mesage string !INITIALIZE cw := current_window; tempbuf := show_buffer; msgstr := "Attempt to make !AS window less than 2 lines long."; !MAKE SURE TOP WINDOW IS MAPPED If (not get_info(top_window,'visible')) then map(top_window,tempbuf); set ( status_line, top_window, none, ""); tempmaptop := 1; Else tempmaptop := 0 Endif; !MAKE SURE BOTTOM WINDOW IS MAPPED If (not get_info(bottom_window,'visible')) then map(bottom_window,tempbuf); set ( status_line, bottom_window, none, ""); tempmapbottom := 1; Else tempmapbottom := 0 Endif; !ADJUST THE DUAL WINDOWS IF num < 0 then !Then adjust upwards vl := get_info(top_window,'visible_length'); maxmove := -num; If (vl < (-num)+2) Then maxmove := vl-2; edx_message(msgstr,EDX$K_ERROR,"TOP"); Endif; If (vl > 2) then !Readjust windows adjust_window(top_window,0,-maxmove); adjust_window(bottom_window,-maxmove,0); Endif ELSE IF num > 0 then !Then adjust downwards vl := get_info(bottom_window,'visible_length'); maxmove := num; If (vl < num+2) Then maxmove := vl-2; edx_message(msgstr,EDX$K_ERROR,"BOTTOM"); Endif; If (vl > 2) then !Readjust windows adjust_window(bottom_window,maxmove,0); adjust_window(top_window,0,maxmove); Endif ENDIF; ENDIF; !Now adjust scrolling on windows so VMS 5.0 doesn't bugcheck wl := get_info(top_window,'visible_length'); set(scrolling,top_window,on,wl/3,wl/3,0); wl := get_info(bottom_window,'visible_length'); set(scrolling,bottom_window,on,wl/3,wl/3,0); if (tempmapbottom) then unmap(bottom_window) endif; if (tempmaptop) then unmap(top_window) endif; update(message_window); !Reset message_window to bottom of buffer position(cw); !Go back to user's buffer ENDPROCEDURE !------------------------------------------------------------------------------ PROCEDURE EDTN$ADJUST_DUAL_WINDOWS LOCAL prev_video, !Previous attrubutes of lower window key, !Key entered by user num, !Number entered by user maxmove, !Maximum number of lines up/down divider may move tempbuf, !A temporary buffer tempmapbottom, !A logical flag cw,wl,vl, !current window, window length, visible length msgstr; !mesage string If (NOT get_info(system,'display')) then return(0) endif; !Check for /NODISPLAY mode !MAKE SURE DUAL WINDOWS IN USE IF (not get_info(top_window,'visible')) THEN edx_message("Dual windows not in use"); return; ENDIF; !INITIALIZE cw := current_window; tempbuf := show_buffer; msgstr := "Attempt to make !AS window less than 2 lines long, no adjustment"; !MAKE TOP_WINDOW STATUS LINE BLINK set(status_line,top_window,NONE,""); set(status_line,top_window,REVERSE,""); set(status_line,top_window,BLINK,""); edtp$set_status_line(top_window); update(top_window); !MAKE SURE BOTTOM WINDOW IS MAPPED If (not get_info(bottom_window,'visible')) then map(bottom_window,tempbuf); set ( status_line, bottom_window, none, ""); tempmapbottom := 1; Else tempmapbottom := 0 Endif; !TELL USER WHAT TO DO edtn$clear_message_window; !Clear message buffer erase(prompt_buffer); !Prepare prompt buffer for message position(prompt_buffer); copy_text("Use numbers + up/down arrow keys to adjust window. Press RETURN when finished."); map(prompt_window,prompt_buffer); update(prompt_window); !LOOP UNTIL USER HITS RETURN KEY OR ENTER KEY num := 1; LOOP key := read_key; IF key = up then vl := get_info(top_window,'visible_length'); maxmove := num; If (vl < num+2) Then maxmove := vl-2; edx_message(msgstr,EDX$K_ERROR,"TOP"); Endif; If (vl > 2) then !Readjust windows adjust_window(top_window,0,-maxmove); adjust_window(bottom_window,-maxmove,0); position(cw); update(top_window); update(bottom_window); num := 1; Endif ELSE IF key = down then vl := get_info(bottom_window,'visible_length'); maxmove := num; If (vl < num+2) Then maxmove := vl-2; edx_message(msgstr,EDX$K_ERROR,"BOTTOM"); Endif; If (vl > 2) then !Readjust windows adjust_window(bottom_window,maxmove,0); adjust_window(top_window,0,maxmove); position(cw); update(top_window); update(bottom_window); num := 1; endif ELSE If ((key = ret_key) or (key = enter)) then set(status_line,top_window,NONE,""); edtp$set_status_line(top_window); update(top_window); !Now adjust scrolling on windows so VMS 5.0 doesn't bugcheck wl := get_info(top_window,'visible_length'); set(scrolling,top_window,on,wl/3,wl/3,0); wl := get_info(bottom_window,'visible_length'); set(scrolling,bottom_window,on,wl/3,wl/3,0); if (tempmapbottom) then unmap(bottom_window) endif; unmap(prompt_window); !Remove message update(message_window); !Reset message_window to bottom of buffer position(cw); !Go back to user's buffer return; return; !and exit Else ! See if it was a digit if (key = key_name('0')) then num := 0 endif; if (key = key_name('1')) then num := 1 endif; if (key = key_name('2')) then num := 2 endif; if (key = key_name('3')) then num := 3 endif; if (key = key_name('4')) then num := 4 endif; if (key = key_name('5')) then num := 5 endif; if (key = key_name('6')) then num := 6 endif; if (key = key_name('7')) then num := 7 endif; if (key = key_name('8')) then num := 8 endif; if (key = key_name('9')) then num := 9 endif; Endif ENDIF ENDIF ENDLOOP ENDPROCEDURE !------------------------------------------------------------------------------ PROCEDURE EDTN$CLEAR_MESSAGE_WINDOW !Clear message window. !Don't bother adding blank lines if in /NODISPLAY mode If get_info(system,'display') then edx_message(""); edx_message(""); Endif; ENDPROCEDURE !------------------------------------------------------------------------------ PROCEDURE EDTN$SHOW_BUFFERS !List buffers. !The first column is left blank due to a quark in the way the screen management !routines work. When the first character of a line is changed the entire line !is rewritten regardless of whether or not the buffer is in overstrike mode or !not. By leaving the first column blank we avoid this minor detail, thus !speeding up the routine. !GLOBAL edtn$m_shobuf_ptr ! LOCAL buf, cur_buf, retcode, filnam, result, rn; cur_buf := current_buffer; erase(show_buffer); set(tab_stops,show_buffer,'18 26 33'); ! For use with SHOW BUFFERS command position(show_buffer); set(insert,show_buffer); !So we can enter TABS without bombing on VMS 5.4 set(key_map_list,"edtn$kml_shobuf"); set(self_insert,"edtn$kml_shobuf",OFF); copy_text(' BUFFER NAME LINES FILE'); split_line; copy_text(' ------------------------------------------------------'); buf := get_info(buffers,'first'); loop exitif buf = 0; split_line; if (buf = cur_buf) then copy_text(" > "); move_horizontal(-2); edtn$m_shobuf_ptr := mark(reverse); move_horizontal(+2); else copy_text(" "); endif; copy_text(get_info(buf,'name')); copy_text(edt$x_tab_char); copy_text(FAO("!6UL",get_info(buf,'record_count'))); copy_text(edt$x_tab_char); filnam := edtn$filename_of_buffer(buf); If ((edtn$v_locked_files) AND (filnam <> "")) then result := call_user(65542,filnam); !'00010006'x Check if file is locked retcode := int(substr(result,1,9)); if retcode = 1 then copy_text("locked"); endif; Endif; copy_text(edt$x_tab_char); if (get_info(buf,'permanent')) then copy_text("Permanent"); else edtn$trim_filespec( filnam, get_info(info_window,'width') - 32 ); edit( filnam, trim_trailing, OFF ); copy_text(filnam); endif; buf := get_info(buffers,'next'); endloop; position(edtn$m_shobuf_ptr); !Position on " > " pointing to current buffer if get_info(system,'display') then set(status_line,info_window,none,""); set(status_line,info_window,REVERSE, " Use up/down arrow keys to move cursor. Press RETURN to select buffer."); map(info_window,show_buffer); endif; set(overstrike,show_buffer); !Now we can set overstrike (VMS 5.4 bugfix) ENDPROCEDURE PROCEDURE EDTN$SHOBUF_ARROW(I) !Move pointer up/down. Don't go beyond list boundaries. LOCAL tempmark; if (current_window <> info_window) then !Make sure we're still in "SHOW BUFFER" mode set(key_map_list,"tpu$key_map_list"); edtn$vertical(I); return; endif; if (I = -1) then !if up arrow position(beginning_of(show_buffer)); !go to first buffer listed move_vertical(2); !and mark it. Then see if move_horizontal(1); !user is trying to move tempmark := mark(none); !above it. position(edtn$m_shobuf_ptr); if edtn$m_shobuf_ptr <= tempmark then edx_message("Attempt to move past beginning of buffer list"); return; endif; else !Down arrow move_vertical(1); !See if user is trying to move tempmark := mark(none); !beyond last buffer listed position(edtn$m_shobuf_ptr); if tempmark = end_of(show_buffer) then edx_message("Attempt to move past end of buffer list"); return; endif; endif; copy_text(edt$x_space); !Erase old > by overwrite move_horizontal(-1); ! move_vertical(I); !Move up/down copy_text(">"); !Put new pointer move_horizontal(-1); ! edtn$m_shobuf_ptr := mark(reverse); !and highlight it. ENDPROCEDURE PROCEDURE EDTN$SHOBUF_ENTER(nam) ! nam - 0 -> goto selected buffer ! "" -> prompt for buffer to go to ! "string" -> go to buffer named "string" ! 1 -> requesting go to marker LOCAL sholin, bufnam, command_status; if (current_window <> info_window) then !Make sure we're still in "SHOW BUFFER" mode set(key_map_list,"tpu$key_map_list"); return; endif; if (nam = 0) then sholin := current_line; !Get name of buffer cursor is next to bufnam := substr(sholin,4,index(sholin,edt$x_tab_char)-4); else bufnam := nam; endif; Unmap(info_window); !This returns us to our original window If get_info(bufnam,"type") = STRING then command_status := edtn$goto_buffer(bufnam,""); !go to that buffer Else if (bufnam = 1) then command_status := goto_mark(""); else command_status := 0; endif; Endif; Map(info_window,show_buffer); !Temporarily Remap SHOW BUFFERS display If (command_status) then map(info_window,show_buffer); set(key_map_list,"tpu$key_map_list"); !Reset show_buffer key_map_list edtn$set_info_window_statln; unmap(info_window); edtp$set_status_line(current_window); Endif; ENDPROCEDURE PROCEDURE EDTN$SHOBUF_DELETE LOCAL sholin, bufnam, bufptr, tempmark, rn, Y_N, mods; if (current_window <> info_window) then !Make sure we're still in "SHOW BUFFER" mode set(key_map_list,"tpu$key_map_list"); delete_previous_character; return; endif; sholin := current_line; !Get name of buffer cursor is next to bufnam := substr(sholin,4,index(sholin,edt$x_tab_char)-4); bufptr := edt$find_buffer(bufnam); if (get_info(bufptr,'permanent')) then edx_message("Cannot delete a permanent buffer"); else move_horizontal(length(current_line)-1); !Ask for confirmation to delete buffer tempmark := mark(none); position(edtn$m_shobuf_ptr); rn := create_range(edtn$m_shobuf_ptr,tempmark,reverse); update(info_window); ring_bell(""); !Ring bell and edx_message(""); !clear rest of message display if get_info(bufptr,'modified') then mods := "modified" else mods := "unmodified" endif; Y_N := edx_read_line("Delete " + mods + " buffer " + bufnam + "? "); edit(Y_N,trim,upper,OFF); rn := 0; If ( index("YES",Y_N) = 1) then edtn$delete_buffer(bufptr); sholin := erase_line; if (mark(free_cursor) = end_of(current_buffer)) then !If we deleted last buffer in list move_vertical(-1); !then move up one endif; move_horizontal(1); copy_text(">"); move_horizontal(-1); edtn$m_shobuf_ptr := mark(reverse); endif; endif; ENDPROCEDURE PROCEDURE EDTN$SHOBUF_LOCK(LOCK_TYPE) ! Parameter: LOCK_TYPE = LOCK ! = UNLOCK LOCAL code, filename, result, retcode, here, sholin, bufnam, bufptr, entry_mode; If (lock_type = "LOCK") then code := 65537 !LOCK FILE x00010001 Else code := 65538 !UNLOCK FILE x00010002 Endif; here := mark(none); !in show_buffer sholin := current_line; !Get name of buffer cursor is next to bufnam := substr(sholin,4,index(sholin,edt$x_tab_char)-4); bufptr := edt$find_buffer(bufnam); filename := edtn$filename_of_buffer(bufptr); IF (filename = "") THEN edx_message("Buffer does not have file name associated with it"); ELSE result := call_user(code,filename); !Lock or unlock the buffer retcode := int(substr(result,1,9)); If (retcode = 1) then edtn$gotocol(26); !Where "locked" message goes if (lock_type = "LOCK") then entry_mode := get_info(current_buffer,'mode'); set (insert,current_buffer); copy_text("locked"); if entry_mode = overstrike then set (overstrike,current_buffer) endif; edtn$v_locked_files := TRUE; !Locked files = TRUE else loop exitif ((current_character = edt$x_tab_char) or (current_character = "")); erase_character(1); endloop; endif; Endif; ENDIF; position(here); !Reset cursor ENDPROCEDURE PROCEDURE EDTN$SHOBUF_WRITE LOCAL sholin, bufnam, bufptr; sholin := current_line; !Get name of buffer cursor is next to bufnam := substr(sholin,4,index(sholin,edt$x_tab_char)-4); bufptr := edt$find_buffer(bufnam); If vs$write_file(bufptr) then !unmark buffer as modified. We'll do that someday. Endif; ENDPROCEDURE !------------------------------------------------------------------------------ !****************************************************************************** ! FILE INPUT/OUTPUT PROCEDURES !****************************************************************************** PROCEDURE PARSE$INCLUDE ( DELIMITER ) ! support routine for line INCLUDE ! Line mode INCLUDE command ! ! Parameters: ! DELIMITER = '/' (slash was present after the WRITE indicating a qualifier follows) ! = ' ' (space, tab, or nothing followed the WRITE command) ! ! INCLUDE {filename} ! [/BUFFER=buffer-name] ! [=buffer-name] ! [/MODULE=module-name] ! [/START=line_number] ! Local term_char, prev_term_char, qualifiers_table, qualifiers_tablen, state_token, state_index, filename, buffer_name, module_name, linnum, strval, promptstr; !INITIALIZE QUALIFIERS TABLE qualifiers_table := ' /BUFFER' + ! 1 ' /MODULE' + ! 2 ' /START ' ; ! 3 qualifiers_tablen := 8; !INITIALIZE STATES filename := ""; buffer_name := ""; module_name := ""; linnum := TPU$K_UNSPECIFIED; term_char := delimiter; !MAIN LOOP LOOP !until all required parameters are specified (i.e. {filename}) edit(edt$x_line,upper,OFF); LOOP !until all qualifiers on command line parsed prev_term_char := term_char; if prev_term_char = '=' then state_token := "BUFFER"; !Special handling for =buffer-name, pretend it was /BUFFER=buffer-name. prev_term_char := '/'; else state_token := edt$next_token('/= ',term_char); endif; exitif (state_token = ""); !all qualifiers on command line parsed IF ( prev_term_char = '/' ) !if this token is a qualifier THEN state_index := index(qualifiers_table,('/' + state_token)); state_index := ((state_index + qualifiers_tablen - 1) / qualifiers_tablen); CASE state_index FROM 0 TO 3 [0]:edx_message("Unsupported INCLUDE option: !AS",EDX$K_ERROR_HIGHLIGHT,state_token); return 0; [1]:!/BUFFER=buffer-name if term_char <> "=" then edx_message("Error parsing /BUFFER=buffer-name"); return 0; else buffer_name := edt$next_token(edtn$x_token_delimiters,term_char); endif; [2]:!/MODULE=module_name If term_char <> "=" then edx_message("Error parsing /MODULE=module-name"); return 0; Else module_name := edt$next_token(edtn$x_token_delimiters,term_char); Endif; [3]:!/START=line_number If term_char <> "=" then edx_message("Error parsing /START=line-number"); return 0; Else strval := edt$next_token(edtn$x_token_delimiters,term_char); if edtn$string_to_integer(strval) then linnum := INT(strval); else edx_message("Error parsing /START=line_number"); endif; Endif; ENDCASE; ELSE !else assume prev_term_char = edt$x_space !state_token must be the filename If filename = "" then filename := state_token; Else edx_message("Invalid qualifier !AS",EDX$K_ERROR_HIGHLIGHT,state_token); return 0; Endif; ENDIF; ENDLOOP; !Loop until everything on command line is parsed. !PROMPT FOR REQUIRED ITEMS exitif(filename <> ""); !exit loop if all required items have now been specified. (filename is only required parameter) If get_info(system,'display') then if module_name = "" then promptstr := "File to read in: "; else promptstr := "Name of text library: "; endif; edt$x_line := edx_read_line(promptstr,,"CTRL-Z"); Endif; If (length(edt$x_line) = 0) then if (last_key <> ctrl_z_key) then edx_message('No file specified'); endif; Return (0); !Abort this procedure Endif; ENDLOOP; !Go back and parse command line again !DISPATCH edtn$include( filename, buffer_name, linnum, module_name ); ENDPROCEDURE !------------------------------------------------------------------------------ PROCEDURE EDTN$INCLUDE( file_name; buffer_name_param, linnum, module_name ) ! Read in a file LOCAL full_filnam, buffer_name; ON_ERROR [OTHERWISE]: !print error and return(false); ENDON_ERROR; !PARSE THE FILE NAME if (NOT edtn$file_parse(full_filnam,file_name,"","")) then return 0; endif; !PARSE THE BUFFER NAME buffer_name := buffer_name_param; If (buffer_name = "") OR (buffer_name = TPU$K_UNSPECIFIED) then buffer_name := get_info(current_buffer,'name'); Endif; return ( EDTN$GOTO_BUFFER( buffer_name, file_name, linnum, module_name ) ); ENDPROCEDURE !------------------------------------------------------------------------------ PROCEDURE EDTN$READ_FILE(file_name) !This command doesn't create any internal corruption itself but the !'out of memory' condition can lead to a fatal error. See the explanation !in procedure edtn$create_buffer. !Read file, position, set buffer output filename if appropriate. LOCAL cw, result, full_filnam, curs_lino, rec; ON_ERROR [TPU$_NOCACHE,TPU$_GETMEM]: edtn$nocache_warning(cw); !abort [OTHERWISE]: !print error message, reset message_action_type, and return(false); set(message_action_type,NONE); !Reset to nohighlight ENDON_ERROR; !SAVE OUR CURRENT POSITION AND STATUS IN CASE OF ERROR if get_info(system,'display') then cw := current_window endif; !PARSE FILENAME FOR ERRORS if (NOT edtn$file_parse(full_filnam,file_name,"","")) then return(0) endif; !ENABLE BUFFER JOURNALING enable_buffer_journaling(current_buffer); !SAVE OUR POSITION. SEE IF BUFFER IS EMPTY (rec = 0) curs_lino := cursor_line_number; rec := get_info(current_buffer,'record_count'); !PRINT MESSAGE SAYING WE'RE READING IN THE FILE (Also fixes message window for VMS 5.3) edtn$fit_message("Reading in file !AS",full_filnam); set(message_action_type,reverse); !To highlight "nnn lines read from file ..." message. Helps VMS 5.3 bug result := read_file(file_name); !READ IN THE FILE set(message_action_type,NONE); !Reset to nohighlight !REPOSITION UNLIKE EDT, BUT USERS SEEM TO LIKE IT BETTER THIS WAY. position(curs_lino); !IF READING INTO EMPTY BUFFER, SET BUFFER TO NOT MODIFIED AND SET STATUS LINE !(WE DON'T RESET MAIN BUFFER OUTPUT FILENAME. THAT'S SET BY COMMAND WHICH INVOKED EDX) If ((rec = 0) AND (current_buffer <> main_buffer)) then Set(output_file,current_buffer,result); Set(MODIFIED,current_buffer,OFF); EDTP$Set_Status_line(CW); !Check for /NODISPLAY made in procedure Endif; !LOCK FILE JUST READ IF WE'RE DOING THAT if ((edtn$v_lock) and (result <> "")) !result is the full filename then do_command("LOCK FILE " + result); Endif; ENDPROCEDURE !------------------------------------------------------------------------------ PROCEDURE EDTN$READ_TLBMOD(filmodnam) ! filmodnam = filename of text library + space + module to extract Local result, retcode, cw, curs_lino, rec, newrec; ON_ERROR [TPU$_NOCACHE,TPU$_GETMEM]: edtn$nocache_warning(cw); !abort with 'out of memory' error [OTHERWISE]: result := call_user(458755,""); !Close library '00070003'x and return(false) ENDON_ERROR; !GET CURRENT WINDOW CW := current_window; !PRINT MESSAGE SAYING WE'RE READING IN THE FILE (Also fixes message window for VMS 5.3) edtn$fit_message("Reading in text library module !AS", filmodnam ); !Open text library, and find module result := call_user(458753,filmodnam); !Initialize, open for read, lookup_key. '00070001'x If (length(result) > 0) then retcode := INT( substr(result,1,9) ); Else retcode := 0; Endif; If (not retcode) then return Endif; !abort if error !SAVE OUR POSITION. SEE IF BUFFER IS EMPTY (rec = 0) curs_lino := cursor_line_number; rec := get_info(current_buffer,'record_count'); !READ IN THE LINES FROM THE TEXT MODULE ENABLE_BUFFER_JOURNALING(CURRENT_BUFFER); set(insert,current_buffer); !To avoid VMS 5.4 fatal error LOOP result := call_user(458756,""); !Receive next record from text module '00070004'x If (length(result) > 0) then retcode := INT( substr(result,1,9) ); Else retcode := 0; Endif; Exitif ( retcode = RMS$_EOF ); !all done If (not retcode) then return Endif; !abort if error copy_text( substr(result,10,length(result)) ); !buffer in insert mode split_line; ENDLOOP; append_line; !Clean up result := call_user(458755,""); !Close library '00070003'x !PRINT MESSAGE SAYING HOW MANY LINES READ (Also fixes message window for VMS 5.3) newrec := get_info(current_buffer,'record_count'); edtn$fit_message("!UL lines read from text library !AS", newrec-rec, filmodnam ); !REPOSITION UNLIKE EDT, BUT USERS SEEM TO LIKE IT BETTER THIS WAY. position(curs_lino); !IF READING INTO EMPTY BUFFER, SET BUFFER TO NOT MODIFIED AND SET STATUS LINE !(WE DON'T RESET MAIN BUFFER OUTPUT FILENAME. THAT'S SET BY COMMAND WHICH INVOKED EDX) If ((rec = 0) AND (current_buffer <> main_buffer)) then Set( output_file, current_buffer, filmodnam ); Set(MODIFIED,current_buffer,OFF); EDTP$Set_Status_line(CW); !Check for /NODISPLAY made in procedure Endif; ENDPROCEDURE !------------------------------------------------------------------------------ PROCEDURE PARSE$WRITE ( DELIMITER ) ! Line mode WRITE command ! ! Parameters: ! DELIMITER = '/' (slash was present after the WRITE indicating a qualifier follows) ! = ' ' (space, tab, or nothing followed the WRITE command) ! ! WRITE [file-spec] !filename or name of text library if /MODULE is present. Default is shown in window status line. ! [/BUFFER=buffer_name] !buffer to write. Default is current buffer. (=buffer and /BUFFER= are identical) ! [=buffer_name] !buffer to write. Default is current buffer. ! [SELECT !keyword indicating write selected range. Disallow SELECT & WHOLE. ! [WHOLE] !keyword indicating write whole buffer. This is default. (qualifier is redundant) ! [/ALL] !write ALL modified buffers. Disallow all other qualifiers. ! [/MODULE=modnam] !Write modnam within text library ! Local term_char, prev_term_char, qualifiers_table, qualifiers_tablen, keywords_table, keywords_tablen, state_token, state_index, filename, buffer_name, buffer_ptr, module_name, all_option, select_option, modified_buffers, tempbuf, here; !INITIALIZE QUALIFIERS TABLE qualifiers_table := '/ALL ' + ! 1 (switch) '/BUFFER ' + ! 2 (=buffer-name) '/MODULE ' ; ! 3 (=module-name) qualifiers_tablen := 8; keywords_table := ' SELECT ' + ! 1 ' WHOLE ' ; ! 2 keywords_tablen := 8; !INITIALIZE STATES filename := ""; buffer_name := ""; module_name := ""; buffer_ptr := current_buffer; !Default is to write current buffer all_option := FALSE; select_option := FALSE; term_char := delimiter; edit(edt$x_line,upper,OFF); !MAIN LOOP LOOP !Loop until all qualifiers on command line parsed prev_term_char := term_char; if prev_term_char = '=' then state_token := "BUFFER"; !Special handling for =buffer-name, pretend it was /BUFFER=buffer-name. prev_term_char := "/"; else state_token := edt$next_token('/= ',term_char); endif; exitif (state_token = ""); !all qualifiers on command line parsed IF ( prev_term_char = '/' ) !if this token is a qualifier THEN state_index := index(qualifiers_table,(prev_term_char + state_token)); state_index := ((state_index + qualifiers_tablen - 1) / qualifiers_tablen); CASE state_index FROM 0 TO 3 [0]:edx_message("Unsupported WRITE option: !AS", EDX$K_ERROR_HIGHLIGHT, state_token); return 0; [1]:!/ALL all_option := TRUE; [2]:!/BUFFER=buffer_name if term_char <> "=" then edx_message("Error parsing /BUFFER=buffer-name"); return 0; endif; buffer_name := edt$next_token(edtn$x_token_delimiters,term_char); buffer_ptr := edt$find_buffer(buffer_name); if (buffer_ptr = 0) then edx_message("Buffer !AS does not exist",EDX$K_ERROR_HIGHLIGHT,buffer_name); return(0); endif; [3]:!/MODULE=module_name if term_char <> "=" then edx_message("Error parsing /MODULE=module-name"); return 0; endif; module_name := edt$next_token(edtn$x_token_delimiters,term_char); ENDCASE; ELSE !else assume prev_term_char = edt$x_space !state_token is either the filename or a keyword If filename = "" then filename := state_token; Else state_index := index(keywords_table,(prev_term_char + state_token)); state_index := ((state_index + keywords_tablen - 1) / keywords_tablen); CASE state_index FROM 0 TO 2 [0]:!filename already specified and not a recognised keyword edx_message("Invalid qualifier !AS",EDX$K_ERROR_HIGHLIGHT,state_token); return 0; [1]:!SELECT select_option := TRUE; [2]:!WHOLE !This is the default. Qualifier is here only so it will be !accepted for compatibility purposes. ENDCASE; Endif; ENDIF; ENDLOOP; !DO THE WRITE IF select_option then !Check for writing SELECT range edt$select_range; if (edt$x_select_range = 0) then edx_message("No Select Active",EDX$K_WARN_HIGHLIGHT); return (0); else if module_name = "" then vs$write_file(edt$x_select_range,filename); else here := mark(free_cursor); tempbuf := show_buffer; !Write SELECT range to text library module erase(tempbuf); !Copy range to show_buffer and write show_buffer position(tempbuf); copy_text(edt$x_select_range); !copy range to tempbuf and write tempbuf as buffer edtn$write_tlbmod(tempbuf,filename,module_name); !note filename must have been specified before SELECT keyword position(here); !go back to where we started endif; edt$x_select_range := 0; !cancel the select range endif; ELSE !Check for /ALL to write all modified buffers IF all_option then modified_buffers := FALSE; buffer_ptr := get_info(buffers,'first'); LOOP exitif buffer_ptr = 0; If (not get_info(buffer_ptr,'system')) then if (get_info(buffer_ptr,'modified')) then modified_buffers := TRUE; if (NOT edtn$write_buffer(buffer_ptr,"","") ) then Return (0) endif; endif; Endif; buffer_ptr := get_info(buffers,'next'); ENDLOOP; If (not modified_buffers) then edx_message("No modified buffers to write",EDX$K_INFO_HIGHLIGHT) Endif; ELSE !Else write specified buffer or current_buffer edtn$write_buffer(buffer_ptr,filename,module_name); ENDIF; ENDIF; ENDPROCEDURE !------------------------------------------------------------------------------ PROCEDURE EDTN$WRITE_BUFFER(buf_ptr,filnam,modnam) ! Writes the contents of the current buffer to a file or a text library module ! !Parameters: ! buf_ptr: buffer to write - input ! filnam: name of file to write - optional input. ! Will prompt for and parse for optional /MODULE=modnam if not given. ! modnam: if writing to text library, name of module to write, else "" ! LOCAL buffer_ptr, file_name, module_name, full_filnam, related, write_status, token, term_char, prev_term_char; !MAKE LOCAL COPIES OF INPUT PARAMETERS buffer_ptr := buf_ptr; file_name := filnam; module_name := modnam; !SEE IF WE NEED TO ASK FOR A FILE NAME IF (edtn$filename_of_buffer(buffer_ptr) = "") !If there's no default file name AND (file_name = "") !and if no file name was given THEN !then we need a file name If get_info(system,'display') then edt$x_line := edx_read_line( FAO( "Enter filename for buffer !AS, !UL line!%S (RETURN not to write it): ", get_info(buffer_ptr,'name'), get_info(buffer_ptr,'record_count'), "RETURN" )); Endif; IF (length(edt$x_line) = 0) then if (last_key <> ctrl_z_key) then edx_message("Buffer !AS not written",EDX$K_INFO,get_info(buffer_ptr,'name')); Return 1; !Successful return since we did what user told us to else Return 0; !A CTRL-Z answer means abort, return as failure. endif; ELSE !Parse the command line for file_name and optional /MODULE=module_name edit( edt$x_line, trim, upper); prev_term_char := edt$x_space; !Start with prev_term_char as space LOOP token := edt$next_token(edtn$x_file_delimiters,term_char); exitif( (token="") AND (term_char="") ); !token may be "" with term_char = "/" IF ( prev_term_char = "/" ) then !if this token is a qualifier IF ( index("MODULE",token) <> 1 ) !Since /MODULE is only supported qualifier we can take this short cut approach OR ( term_char <> "=" ) ! instead of using a CASE statement. THEN edx_message("Error parsing /MODULE=module-name"); Return 0; ELSE module_name := edt$next_token(edtn$x_token_delimiters,term_char); ENDIF; ELSE If ( prev_term_char = edt$x_space ) then !then this token must be the filename file_name := token; Endif; ENDIF; prev_term_char := term_char; ENDLOOP; !Loop until everything on command line parsed ENDIF; !If length(file_name) = 0 after prompting ENDIF; !If file_name = "" and edtn$filename_of_buffer = "" !PARSE THE FILE NAME related := edtn$filename_of_buffer(buffer_ptr); if (NOT edtn$file_parse(full_filnam,file_name,"",related)) then Return 0; !error parsing filename endif; !SEE IF BUFFER FILE/MODULE NAME NEEDS SETTING IF (file_name <> "") !If filename explicitly stated (else we default to filename associated with buffer) AND (NOT get_info(buffer_ptr,'system')) !Don't associate a file name with permanent system buffers (such as the paste buffer) THEN If (module_name = "") OR (module_name = TPU$K_UNSPECIFIED) then set( output_file, buffer_ptr, full_filnam); else set( output_file, buffer_ptr, full_filnam+edt$x_space+module_name); endif; edtn$update_visible_statln( buffer_ptr ); ENDIF; !WRITE THE FILE OR MODULE !(file_name/module_name are now associated with buffer) module_name := edtn$modnam_of_buffer(buffer_ptr); !check for a module name IF (module_name = "") THEN !then write a file If (get_info(buffer_ptr,'system')) then write_status := vs$write_file(buffer_ptr,full_filnam);!System buffers have no file name associated. Use the one we prompted for. Else write_status := vs$write_file(buffer_ptr); !File name was associated with buffer above Endif; ELSE !else write a text library module write_status := edtn$write_tlbmod(buffer_ptr,full_filnam,module_name); ENDIF; Return write_status; ENDPROCEDURE !------------------------------------------------------------------------------ ! VS$WRITE_FILE ! Write BUFFER or RANGE to disk file. ! Lock file written if SET LOCK is in effect. ! Return 1 if successful, 0 if not successful. ! PROCEDURE VS$WRITE_FILE( BUFFER_OR_RANGE; FILENAME ) Local full_filename, output_filename, semicolon; ON_ERROR [OTHERWISE]: !print error message, reset message_action_type, and return(false) set(message_action_type,NONE); !Reset to nohighlight ENDON_ERROR; If (get_info(filename,'type') = string) then if (NOT edtn$file_parse(output_filename,filename,"","")) then return(0) endif; Else output_filename := edtn$filename_of_buffer(buffer_or_range); Endif; semicolon := index(output_filename,';'); If semicolon <> 0 then output_filename := substr(output_filename,1,semicolon-1); Endif; !PRINT MESSAGE SAYING WE'RE WRITING THE FILE IF (get_info(buffer_or_range,'type') = BUFFER ) then edtn$fit_message("Writing buffer file !AS", get_info(buffer_or_range,'name'),output_filename); ELSE edtn$fit_message("Writing selected range to file !AS",output_filename); ENDIF; !HIGHLIGHT MESSAGE set(message_action_type,reverse); !To highlight "nnn lines written to file ..." message. Helps VMS 5.3 bug if (get_info(filename,'type') = string) then full_filename := write_file( buffer_or_range, filename ); else full_filename := write_file( buffer_or_range ); endif; set(message_action_type,NONE); !Reset to nohighlight if (edtn$v_lock) then do_command("LOCK FILE " + full_filename); endif; return (1); ENDPROCEDURE !------------------------------------------------------------------------------ PROCEDURE EDTN$WRITE_TLBMOD(buffer_ptr,tlb_filename,module_name) !Parameters: ! buffer_ptr: buffer to write ! tlb_filename: text library filename to put module in ! module_name: name of module to write ! !Outline: ! open text library and find module ! if library doesn't exist, create it ! if module doesn't exist, write it ! if module already exists, prompt for confirmation to overwrite it ! close text library ! LOCAL result, retcode, linecount, here, Y_N; ON_ERROR [OTHERWISE]: !print error, result := call_user(458752+3,""); ! close library, and return(false) ENDON_ERROR; !Open text library, search for old module result := call_user( 458752+2, tlb_filename+edt$x_space+module_name); if (length(result) > 0) then retcode := INT( substr(result,1,9) ); else retcode := 0; endif; CASE retcode FROM 0 TO 2 [0]:!Error Return(0); !abort if error [1]:!old module found. Ask for permission to replace it ring_bell(FAO("Module !AS already exists in library !AS.", module_name,tlb_filename)); Y_N := edx_read_line(FAO("Replace module !AS? ",module_name)); edit(Y_N,trim,upper,OFF); If ( index("YES",Y_N) <> 1) then result := call_user(458755,""); !close library Return (0); !and return 0 Endif; [2]:!old module not found. Go ahead and insert it ENDCASE; !Write out the lines to the text module edx_message("Writing buffer module !AS library !AS", EDX$K_INFO, get_info(buffer_ptr,'name'), module_name, tlb_filename); here := mark(free_cursor); linecount := 0; position(beginning_of(buffer_ptr)); LOOP exitif ( mark(free_cursor) = end_of(buffer_ptr) ); position(LINE_BEGIN); result := call_user(458752+5,current_line); retcode := int(substr(result,1,9)); exitif (retcode = 0); !quit on error writing line to module linecount := linecount + 1; move_vertical(1); ENDLOOP; position(here); !back to where we started result := call_user(458752+6,module_name); !Insert (/replace) new module into text library index retcode := int(substr(result,1,9)); If (retcode) then set(MODIFIED,current_buffer,OFF); !Reset buffer to not modified edx_message("!UL line!%S written to module !AS library !AS", EDX$K_INFO, linecount, module_name, tlb_filename); Endif; !now that we've written it. ENDPROCEDURE !------------------------------------------------------------------------------ PROCEDURE EDTN$NOCACHE_WARNING(CW) ! CW - Current Window before error happened ! Prints the message of impending doom if we run out of virtual memory If get_info(system,'display') then !!!!erase(message_buffer); !Buy some memory erase(recall_buffer); !Buy some memory adjust_window(message_window,-6,0); !Make room for message set(bell,all,on); !Let's ring the bell a lot too position(cw); !Go back to where we were so we don't stay in message window refresh; !Clear the screen of garbage that may have been generated Endif; !We do it all in one single message here so it looks better. message("ERROR: The file you read in may have been too big. "+ "***** This condition can lead directly to a Fatal TPU Internal Error. "+ "***** SAVE YOUR WORK AND EXIT IMMEDIATELY! (Use * EXIT/ALL) "+ "***** Your process paging file quota (pgflquo) determines the maximum "+ "***** size file you may edit "+ "***** You may ask the system manager to increase your paging file quota "+ "***** to edit larger files. "); abort; ENDPROCEDURE !------------------------------------------------------------------------------ !****************************************************************************** ! EXIT PROCEDURES !****************************************************************************** !+ ! Edt line mode EXIT command !_ PROCEDURE EDT$EXIT ( prev_term_param, exit_type) ! support routine for line mode(quit cmd) ! Parameters: ! prev_term_param = '/' (slash was present after the EXIT or QUIT indicating a qualifier follows) ! = ' ' (space, tab, or nothing followed the EXIT or QUIT command) ! exit_type = "EXIT" ! = "QUIT" LOCAL term_char, prev_term_char, filename, full_filnam, buffer_ptr, related, token, save_opt, all_opt; ON_ERROR ! If an error occurs here stop the EXIT [TPU$_NOJOURNAL]: !Supress nojournal warning and continue [OTHERWISE]: !otherwise stop the exit by return(false); ENDON_ERROR; !INITIALIZE VARIABLES filename := ""; !output file name SAVE_OPT := 0; !/SAVE ALL_OPT := 0; !/ALL prev_term_char := prev_term_param; !'/' or {space,tab,nothing} !PARSE THE COMMAND LINE LOOP token := edt$next_token(edtn$x_file_delimiters,term_char); if (token = "") then exitif; endif; IF (prev_term_char = '/') then If (index('ALL' ,token)=1) then ALL_OPT := 1 Else if (index('SAVE',token)=1) then SAVE_OPT := 1 else edx_message("Unsupported !AS option /!AS",EDX$K_ERROR_HIGHLIGHT,exit_type,token); return (0); endif; Endif; ELSE filename := token ENDIF; prev_term_char := term_char; ENDLOOP; IF (exit_type = 'QUIT') then If (NOT edtn$confirm_exit('quitting')) then return (0) endif; If (SAVE_OPT) then journal_close endif; !jump to ENDIF and exit (QUIT) ELSE !exit_type = 'EXIT' If (ALL_OPT) then If (SAVE_OPT) then journal_close endif; !Write all buffers (except system buffers) and exit. !Loop in reverse direction so buffer MAIN gets written last. 21-JUL-1990 buffer_ptr := get_info(buffers,'last'); loop exitif buffer_ptr = 0; IF (not get_info(buffer_ptr,'system')) then !If user buffer If get_info(buffer_ptr,'modified') then !and if modified if (edtn$write_buffer(buffer_ptr,"","")) !then write it then !and if successfull set(no_write,buffer_ptr); !then set buffer to no_write else return 0; !else stop the exit endif; Endif; ENDIF; buffer_ptr := get_info(buffers,'previous'); endloop; !jump to ENDIF and exit (EXIT/ALL) Else If (NOT edtn$confirm_exit('exiting')) then return (0) endif; If (SAVE_OPT) then journal_close endif; !Check output filename If (filename <> "") then related := edtn$filename_of_buffer(main_buffer); if (NOT edtn$file_parse(full_filnam,filename,"",related)) then return 0; endif; set(output_file,main_buffer,full_filnam); edtn$update_visible_statln( main_buffer ); Else if (get_info(command_line,'read_only') = 1) !If /READ_ONLY or (get_info(command_line,'output') <> 1) !or /NOOUTPUT then edx_message('File specification required'); if (get_info(info_window,'visible')) !Remove 'confirm_exit' window if visible then unmap (info_window); edtn$set_info_window_statln; endif; return (0); endif; Endif; !Set main buffer to write If (get_info(main_buffer,'type') = BUFFER) then !buffer MAIN may have been deleted If (NOT vs$write_file(main_buffer)) !Write buffer even if it hasn't been modified then Return (0); Endif; set(no_write,main_buffer); Endif; Endif; !if /ALL else Check out filename ENDIF; !if QUIT else check /ALL !Get pysical cursor out of user's text buffer so in case any extraneous !characters are sent to screen during exit (as VMS 5.3 with most vt200 !terminal clones does) user won't panic seeing a bad character in his text !just as he exits (bad character is actually part of untranslated escape !sequence). If get_info(system,'display') then position(message_window); position(end_of(message_buffer)); move_vertical(-1); goto_column( get_info(current_window,'width') ); update(message_window); Endif; QUIT(OFF); !Main exit. ENDPROCEDURE !------------------------------------------------------------------------------ PROCEDURE EDTN$CONFIRM_EXIT(exit_type) ! Displays any unwritten user buffers and asks for confirmation. ! Returns 1 if user still wishes to quit/exit. ! Returns 0 if user does not wish to quit/exit. ! Parameter: exit_type = ("quitting" or "exiting") Must be lowercase. ! LOCAL entry_window, !Position buf, !Buffer cur_buf, !Current buffer in_cur_buf, !1 or 0. Current buffer will not be written unwritten_buffers, !1 or 0. Are there any unwritten buffers rn, !Range mk, !Mark Y_N, !Yes/No answer filnam, !File name of buffer num_lines, !Number of lines in buffer result, retcode; in_cur_buf := 0; unwritten_buffers := 0; If (get_info(system,'display')) then !Check for /NODISPLAY mode entry_window := current_window; Endif; cur_buf := current_buffer; erase(show_buffer); set(tab_stops,show_buffer,'18 26 33'); ! Same as for SHOW BUFFERS command position(show_buffer); set(insert,show_buffer); !so we can enter TABS without bombing on VMS 5.4 split_line; !PUT TITLE IN REVERSE VIDEO mk := select(reverse); !don't need to snap. copy_text('THE FOLLOWING BUFFERS WILL NOT BE SAVED'); rn := select_range; !don't need to snap. mk := 0; !REST OF TITLE split_line; split_line; copy_text(' BUFFER NAME LINES FILE'); split_line; copy_text(' ------------------------------------------------------'); split_line; buf := get_info(buffers,'first'); !LOOP THROUGH THE BUFFERS SEARCHING FOR UNWRITTEN ONES AND LIST THEM LOOP exitif buf = 0; num_lines := get_info(buf,'record_count'); IF ( (get_info(buf,'system') = 0) AND (get_info(buf,'modified') = 1) AND (((get_info(buf,'no_write') = 1) and (buf <> main_buffer)) OR (exit_type = "quitting")) !("quitting" is case sensitive) AND (num_lines > 0) ) THEN unwritten_buffers := 1; If (buf = cur_buf) Then copy_text(" > "); in_cur_buf := 1; Else copy_text(" ") Endif; copy_text(get_info(buf,'name')); copy_text(edt$x_tab_char); ! insert a tab copy_text(FAO("!6UL",num_lines)); copy_text(edt$x_tab_char); ! insert a tab filnam := edtn$filename_of_buffer(buf); If ((edtn$v_locked_files) AND (filnam <> "")) then result := call_user(65542,filnam); !'00010006'x Check if file is locked retcode := int(substr(result,1,9)); if retcode = 1 then copy_text("locked"); endif; Endif; copy_text(edt$x_tab_char); copy_text(filnam); split_line; ENDIF; buf := get_info(buffers,'next'); ENDLOOP; !IF NO UNWRITTEN_BUFFERS THEN RETURN If (unwritten_buffers = 0) then position(cur_buf); !Return to original buffer Return 1; !and return Endif; !ELSE DISPLAY UNWRITTEN_BUFFERS AND ASK FOR CONFIRMATION IF (NOT get_info(system,'display')) then !Check for /NODISPLAY mode position(beginning_of(show_buffer)); loop exitif( mark(free_cursor) = end_of(current_buffer) ); edx_message(current_line); move_horizontal(1); endloop; return(1); !Assume user wanted it that way. There's no way to ask. ENDIF; !INTERACTIVE MODE ASK FOR CONFIRMATION set(status_line,info_window,none,""); map(info_window,show_buffer); update(info_window); If (in_cur_buf) then ring_bell(""); !Ring bell and edx_message(""); !clear message display Y_N := edx_read_line("The buffer you are in will not be saved. Continue " + exit_type + "? "); Else Y_N := edx_read_line("Continue " + exit_type + "? ") Endif; edit(Y_N,trim,upper,off); If ( index("YES",Y_N) = 1) then Return 1; Else unmap(info_window); edtn$set_info_window_statln; position(entry_window); Return 0; Endif; ENDPROCEDURE !------------------------------------------------------------------------------ !****************************************************************************** ! MARKERS !****************************************************************************** PROCEDURE MRK$LINES_BETWEEN_MARKERS(M1,M2) !Return as a non-negative value the number of lines between markers M1 & M2 Local X; X:=(get_info(M2,'record_number')-get_info(M1,'record_number')); If (X<0) then return (-X) else return (X) endif; ENDPROCEDURE; PROCEDURE SET_MARK (MARK_PARAMETER) !From EVE !Set a mark for later use by go to command. !Parameters: ! mark_parameter: String to use as a mark name - input ! ! Creates a global marker named EVE$MARK_name. ! !NOTE: Execute can only handle 132-character strings, so mark ! name can only be ? characters long. LOCAL mark_name, !Local copy of mark_parameter, create_mark_string, mark_video; ON_ERROR edx_message("Cannot use !AS as a mark name", EDX$K_ERROR_HIGHLIGHT, mark_name); Return; ENDON_ERROR; mark_name := mark_parameter; edit(mark_name, trim, upper, OFF); If (mark_name = "") then if get_info(system,'display') then mark_name := edx_read_line("Set mark: ",,"CTRL-Z"); edit(mark_name, trim, upper, OFF); endif; if length(mark_name) = 0 then edx_message("Current position not marked"); return(0); endif; Endif; if ((edtn$x_mark_video = "NONE") or (edtn$x_mark_video = "FREE_CURSOR")) then mark_video := "FREE_CURSOR"; else if (cs$cursor_outer_space) then enable_buffer_journaling(current_buffer); endif; mark_video := edtn$x_mark_video; endif; create_mark_string := "eve$mark_" + mark_name + " := mark (" + mark_video + ")" ; if length (create_mark_string) > 132 then edx_message("You've got to be kidding! Current position not marked."); Return(0); endif; execute (create_mark_string); edx_message("Current position marked as !AS", EDX$K_SUCCESS, mark_name); ENDPROCEDURE; !------------------------------------------------------------------------------ PROCEDURE GOTO_MARK (MARK_PARAMETER) !From EVE ! Go to a mark. If mark is in a different buffer, map that ! buffer to the screen. ! ! Also an invisible marker named LAST is set at the previous ! position so in case you decide you didn't want to go to that ! marker you can quickly go back to where you were by going to ! the marker named LAST. This marker is also set when a keypad ! go to top of buffer (GOLD KP5) or go to bottom of buffer (GOLD ! KP4) is used, when a page (KP7) advance is used, or with a search command. ! !Parameters: ! mark_parameter: String containing mark name - input ! ! NOTE: Execute can only handle 132-character strings, so mark ! can only be ? characters long. ! !GLOBAL EVE$MARK_name, ! EVE$ACTUAL_MARK; ! LOCAL mark_name, ! Local copy of go_to_parameter this_buffer, ! Current buffer buffer_of_mark, ! Buffer where mark is located old_position, ! Marker for current cursor position test; ON_ERROR if error = tpu$_nonames then edx_message("Mark !AS not set", EDX$K_ERROR_HIGHLIGHT, mark_name ); return(0); endif; ENDON_ERROR; !GET THE MARK NAME mark_name := mark_parameter; edit(mark_name, trim, upper, OFF); If (mark_name = "") then if get_info(system,'display') then mark_name := edx_read_line("Go to mark: ",,"CTRL-Z"); edit(mark_name, trim, upper, OFF); endif; if length(mark_name) = 0 then if (last_key <> ctrl_z_key) then edx_message("No mark name given"); endif; return(0); endif; Endif; !IF MARK NAME IS SPECIAL '(' OR ')' GO TO THAT MARK IF (index("()",mark_name) <> 0) then If mark_name = "(" then eve$actual_mark := edtn$m_left_paren !Can't equate edtn$m_*_paren to another permanent variable Else !or it won't delete properly in procedure edtn$clear_paren eve$actual_mark := edtn$m_right_paren Endif ELSE eve$full_mark_name := "EVE$MARK_" + mark_name; !Piece together mark name test := expand_name(eve$full_mark_name, variables); !See if mark exists. tpu$_nonames if mark not set test := test + " "; !append a space in case name is last one if (index(test,eve$full_mark_name+" ")<>0) then !If marker name is in list eve$actual_mark := mark(free_cursor); !Initialize as a marker type variable execute("eve$actual_mark := " + eve$full_mark_name);!Translate name to marker variable else edx_message("Mark '!AS' not set", EDX$K_ERROR_HIGHLIGHT, mark_name ); return(0); endif; ENDIF; !CHECK THE MARKER If (get_info(eve$actual_mark,'type') <> MARKER) then edx_message("Mark '!AS' not set", EDX$K_ERROR_HIGHLIGHT, mark_name ); return(0); endif; !GET BUFFER OF MARK this_buffer := current_buffer; old_position := mark(free_cursor); buffer_of_mark := get_info(eve$actual_mark, 'buffer'); If buffer_of_mark <> current_buffer then if get_info(system,'display') then map(current_window,buffer_of_mark); edtp$Set_Status_line(current_window); else position(buffer_of_mark); endif; Endif; !GO TO MARK position(eve$actual_mark); edx_message("At mark !AS", EDX$K_INFO, mark_name); eve$mark_LAST := old_position; !Set mark LAST eve$actual_mark := 0; !Clear temporary global marker after use set (forward,current_buffer); !By default set buffer to forward return (1); ENDPROCEDURE; !------------------------------------------------------------------------------ PROCEDURE EDTN$SHOW_MARKERS !List buffers. !The first column is left blank due to a quark in the way the screen management !routines work. When the first character of a line is changed the entire line !is rewritten regardless of whether or not the buffer is in overstrike mode or !not. By leaving the first column blank we avoid this minor detail, thus !speeding up the routine. !GLOBAL edtn$m_shobuf_ptr !(same as used in edtn$show_buffers) ! ! Make sure display columns agree with SORT command ! LOCAL marker_name, create_mark_string, mname, mbuf, mbufnam, savpos, tot_lines, mlino, term_char, text_line, search_range, num_spaces; ON_ERROR [TPU$_NONAMES]: edx_message ("No markers are set"); return(0); [TPU$_MULTIPLENAMES]: !This is expected and OK. Continue. [OTHERWISE]: !otherwise signal error and return(false); ENDON_ERROR; edx_message("Creating show markers display..."); set_mark("CURRENT"); !Displays message "Current position marked as CURRENT" edt$x_line := expand_name('EVE$MARK_', variables); erase(show_buffer); position(show_buffer); set(overstrike,show_buffer); set(key_map_list,"edtn$kml_shomrk"); loop marker_name := edt$next_token(edt$x_space, term_char); exitif (marker_name = ""); create_mark_string := "edtn$m_shobuf_ptr := " + marker_name; execute(create_mark_string); if get_info(edtn$m_shobuf_ptr,'type') = MARKER then mname := substr(marker_name,10,length(marker_name)); mbuf := get_info(edtn$m_shobuf_ptr,'buffer'); mbufnam := get_info(mbuf,'name'); POSITION(MBUF); !Save our original position SAVPOS := MARK(FREE_CURSOR); !in this buffer. position(edtn$m_shobuf_ptr); if (mark(none)<>end_of(current_buffer)) then text_line := current_line; else text_line := ""; endif; tot_lines := get_info(current_buffer,'record_count'); mlino := cursor_line_number; POSITION(SAVPOS); !back to our original place in this buffer position(show_buffer); !then go over to show_buffer. split_line; copy_text(" " + mname); !Marker name num_spaces := 17 - current_offset; if (num_spaces < 2) then num_spaces := 2 endif; copy_text(FAO("!"+str(num_spaces)+"* ")); copy_text(mbufnam); !Buffer of mark num_spaces := 29 - current_offset; if (num_spaces < 2) then num_spaces := 2 endif; copy_text(FAO("!"+str(num_spaces)+"* ")); copy_text(FAO('!5UL "!AS"',mlino,text_line)); endif; endloop; SRT$SORT_SILENT( "SORT BUFFER/KEY1=(POSITION:18,SIZE:12)" + "/KEY2=(POSITION:30,SIZE: 5)" + "/KEY3=(POSITION: 4,SIZE:12)" ); position(beginning_of(show_buffer)); copy_text(' MARKER BUFFER LINE# TEXT'); split_line; copy_text(' ------------------------------------------------------'); search_range := search(LINE_BEGIN& ' CURRENT', FORWARD, EXACT); position(beginning_of(search_range)); move_horizontal(1); copy_text(">"); move_horizontal(-1); edtn$m_shobuf_ptr := mark(reverse); if get_info(system,'display') then set(status_line,info_window,none,""); !undo any previous video attributes set(status_line,info_window,REVERSE, " Use up/down arrow keys to move cursor. Press RETURN to select marker."); map(info_window,show_buffer); endif; ENDPROCEDURE PROCEDURE EDTN$SHOMRK_ARROW(I) !Move pointer up/down. Don't go beyond list boundaries. LOCAL tempmark; if (current_window <> info_window) then !Make sure we're still in "SHOW BUFFER" mode set(key_map_list,"tpu$key_map_list"); edtn$vertical(I); return; endif; if (I = -1) then !if up arrow position(beginning_of(show_buffer)); !go to first buffer listed move_vertical(2); !and mark it. Then see if move_horizontal(1); !user is trying to move tempmark := mark(none); !above it. position(edtn$m_shobuf_ptr); if edtn$m_shobuf_ptr <= tempmark then edx_message("Attempt to move past beginning of marker list"); return; endif; else !Down arrow move_vertical(1); !See if user is trying to move tempmark := mark(none); !beyond last buffer listed position(edtn$m_shobuf_ptr); if tempmark = end_of(show_buffer) then edx_message("Attempt to move past end of marker list"); return; endif; endif; copy_text(edt$x_space); !Erase old > by overwrite move_horizontal(-1); ! move_vertical(I); !Move up/down copy_text(">"); !Put new pointer move_horizontal(-1); ! edtn$m_shobuf_ptr := mark(reverse); !and highlight it. ENDPROCEDURE PROCEDURE EDTN$SHOMRK_ENTER LOCAL mrknam, curline; if (current_window <> info_window) then !Make sure we're still in "SHOW BUFFER" mode set(key_map_list,"tpu$key_map_list"); return; endif; curline := substr(current_line,4,length(current_line)); mrknam := substr(curline,1,index(curline,edt$x_space)); set(key_map_list,"tpu$key_map_list"); !Reset show_buffer key_map_list edtn$set_info_window_statln; unmap(info_window); goto_mark(mrknam); ENDPROCEDURE PROCEDURE EDTN$SHOMRK_GOTO( WHAT ) ! WHAT = "B" -> goto_buffer (gold B) ! = "M" -> goto marker (gold G) LOCAL command_status; if (current_window <> info_window) then !Make sure we're still in "SHOW BUFFER" mode set(key_map_list,"tpu$key_map_list"); return; endif; Unmap(info_window); !Returns us to our original window If ( WHAT = "B" ) then command_status := edtn$goto_buffer("",""); !and go to that buffer Else if (WHAT = "M" ) then command_status := goto_mark(""); else command_status := 0; endif; Endif; map(info_window,show_buffer); !Temporarily remap it If (command_status) then set(key_map_list,"tpu$key_map_list"); !Reset show_buffer key_map_list unmap(info_window); edtn$set_info_window_statln; edtp$set_status_line(current_window); Endif; ENDPROCEDURE !****************************************************************************** ! KEY LEARN PROCEDURES !****************************************************************************** PROCEDURE EDTP$LEARNING ! Learn key sequence LOCAL learn_sequence; ON_ERROR [OTHERWISE]: !signal error, learn_abort, and return(false); ENDON_ERROR; !Test for learn already in progress learn_begin(exact); !Generate error and take on_error route if learn_sequence := learn_end;! learn already in effect. edtn$clear_message_window; erase(prompt_buffer); position(prompt_buffer); copy_text("Enter key to be defined"); map(prompt_window,prompt_buffer); update(prompt_window); edtp$learn_key := READ_KEY; unmap(prompt_window); update(message_window); !Reset message_window to bottom of buffer if (edtp$learn_key = ret_key) then edx_message ("LEARN aborted") else learn_begin(exact); edx_message ("LEARN Activated. Press GOLD ] to end LEARN sequence"); endif; ENDPROCEDURE PROCEDURE EDTP$STOP_LEARN ! Bound to Gold-] when learn activated LOCAL learn_sequence; ON_ERROR [OTHERWISE]: !signal error, learn_abort, and return(false); ENDON_ERROR; learn_sequence := learn_end; define_key(learn_sequence,edtp$learn_key,"user defined key","tpu$key_map"); !tpu$key_map is used for user defined keys edx_message("LEARN Completed"); ENDPROCEDURE PROCEDURE EDTN$UNLEARN ! Undefine a learned key restoring it to its original function LOCAL Unlearn_Key; If (NOT get_info(system,'display')) then edx_message("Can not unlearn a key in /NODISPLAY mode"); return(0); Endif; edtn$clear_message_window; erase(prompt_buffer); position(prompt_buffer); copy_text("Enter key to remove learned key sequence from:"); map(prompt_window,prompt_buffer); update(prompt_window); unlearn_key := READ_KEY; unmap(prompt_window); update(message_window); !Reset message_window to bottom of buffer undefine_key(unlearn_key,"tpu$key_map"); ENDPROCEDURE; !****************************************************************************** ! RULER !****************************************************************************** PROCEDURE EDTP$INSERT_RULER ! Insert a ruler into the buffer above the current line. LOCAL current_width, ruler_line, start_mark, curs_col; ENABLE_BUFFER_JOURNALING(CURRENT_BUFFER); start_mark := mark(none); !buffer journaling enabled curs_col := get_info(current_buffer,'offset_column'); !Save column ruler_line := substr( edtn$x_ruler_line, 1, 961 - curs_col ); !make ruler as long as possible !INSERT THE RULER LINE position(LINE_BEGIN); ! Move to beginning of line split_line; ! Split the line (open new line) move_horizontal(-1); ! Move to new line goto_column(curs_col); ! Move to column copy_text(ruler_line); ! Insert the ruler position (start_mark); ! Move back to original position ENDPROCEDURE !------------------------------------------------------------------------------ PROCEDURE TOGGLE_RULER_LINE ! Toggle on/off a ruler at the top of the screen. ! Taken after eve_ruler. LOCAL here, cw; !current_window If (NOT get_info(system,'display')) then return(0) endif; !Check for /NODISPLAY mode !SUPPRESS UPDATING WHILE WE FOOL AROUND WITH WINDOWS set(screen_update,off); !ARE WE TO SWITCH OFF RULER? If (get_info(ruler_window,'visible')) then unmap(ruler_window); !Remove ruler window from top of screen !Readjust windows !Main_window: If (not get_info(main_window,'visible')) then map(main_window,message_buffer); adjust_window(main_window,-1,0); unmap(main_window); Else adjust_window(main_window,-1,0) Endif; !Top_window: If (not get_info(top_window,'visible')) then map(top_window,message_buffer); adjust_window(top_window,-1,0); unmap(top_window); Else adjust_window(top_window,-1,0) Endif; set(screen_update,on); Return; Endif; !OTHERWISE PUT RULER AT TOP OF SCREEN here := mark(free_cursor); cw := current_window; map(ruler_window, ruler_buffer); !Map to screen position(cw); !Go back to user's window before adjusting ruler edtn$adjust_ruler_shift; !Adjust offset of ruler !ADJUST OTHER WINDOWS !(We do this so ruler is still visible when switching between one/two windows.) If (not get_info(main_window,'visible')) then map(main_window,message_buffer); !Temporarily map window to screen so it can be modified. adjust_window(main_window,1,0); !Message buffer is a permanent buffer. unmap(main_window); Endif; If (not get_info(top_window,'visible')) then map(top_window,message_buffer); !Temporarily map window to screen so it can be modified. adjust_window(top_window,1,0); !Message buffer is a permanent buffer. unmap(top_window); Endif; adjust_window(current_window,0,0); !This step is necessary (especially on VMS 5) !POSITION US BACK WHERE WE STARTED position(cw); position(here); set(screen_update,on); ENDPROCEDURE; !------------------------------------------------------------------------------ PROCEDURE EDTN$ADJUST_RULER_SHIFT ! If ruler window is visible make sure it is properly shifted LOCAL cw; !current_window If (NOT get_info(system,'display')) then return(0) endif; !Check for /NODISPLAY mode cw := current_window; if ( (cw = main_window) or (cw = top_window) ) and (get_info(ruler_window,'visible')) then shift(ruler_window, get_info(cw,'shift_amount') - get_info(ruler_window,'shift_amount') ); update(ruler_window); endif; ENDPROCEDURE !---------------------------------------------------------------------- !****************************************************************************** ! DATE PROCEDURES !****************************************************************************** PROCEDURE CURRENT_DATE !Return today's date. RETURN EDX$DATE_CONVERT( FAO("!%D",0), edtn$v_date_format_type, edtn$v_date_format_case, edtn$v_date_format_zeros, edtn$x_date_format_ds ); ENDPROCEDURE PROCEDURE EDX$DATE_CONVERT( DATE, FORMAT_TYPE, FORMAT_CASE, FORMAT_ZEROS, FORMAT_DS ) !Convert input date to output date format !Formats: (taken from word-11) ! format_type: (edtn$v_date_format_type) ! 1: SHORT 15-Apr-87 ! 2: LONG April 15, 1987 ! 3: FORMAL 15th April, 1987 ! 4: NUMERIC 5/15/87 ! 5: EUROPEAN 15/5/87 ! ! format_case: (edtn$v_date_format_case) ! 1: UPPERCASE ! 2: lowercase ! 3: Capitalize ! ! format_zeros: (edtn$v_date_format_zeros) ! 0: 5/9/87 (no leading zeros) ! 1: 05/09/87 (leading zeros included) ! ! (edtn$x_date_format_ds) ! format_ds:= (character to separate month/day/year. Slash '/' or dash'-') ! LOCAL day, month, short_month_list, long_month_list, year, th; short_month_list := "JAN" + ! 1 "FEB" + ! 2 "MAR" + ! 3 "APR" + ! 4 "MAY" + ! 5 "JUN" + ! 6 "JUL" + ! 7 "AUG" + ! 8 "SEP" + ! 9 "OCT" + ! 10 "NOV" + ! 11 "DEC" ; ! 12 long_month_list := "JANUARY " + ! 1 "FEBRUARY " + ! 2 "MARCH " + ! 3 "APRIL " + ! 4 "MAY " + ! 5 "JUNE " + ! 6 "JULY " + ! 7 "AUGUST " + ! 8 "SEPTEMBER" + ! 9 "OCTOBER " + ! 10 "NOVEMBER " + ! 11 "DECEMBER " ; ! 12 !DAY if (substr(date,1,1) = edt$x_space) then day := substr(date,2,1); if (format_zeros) then day := "0" + day endif; else day := substr(date,1,2) endif; !MONTH month := substr(date,4,3); CASE format_type from 1 to 5 [1]: !Short month := substr(date,4,3); [2,3]: !Long month := substr(long_month_list,(3*(index(short_month_list,substr(date,4,3)))-2),9); edit(month,trim_trailing,OFF); [4,5]: !Numeric month := str((index(short_month_list,substr(date,4,3))+2)/3); if (format_zeros) and (int(month) < 10) then month := "0" + month endif; ENDCASE; CASE format_case from 1 to 3 ! [1]:!Already in uppercase [2]: edit(month,LOWER,OFF); [3]: capitalize_string(month); ENDCASE; !YEAR CASE format_type from 1 to 5 [1,2,3]: year := substr(date, 8,4); [4,5]: year := substr(date,10,2); ENDCASE; !INSERT DATE CASE format_type from 1 to 5 [1]: return(day + format_ds + month + format_ds + year); [2]: return(month + edt$x_space + day + ", " + year); [3]: CASE (int(month)) from 1 to 31 [1,21,31]: th := "st "; [2,22]: th := "nd "; [3,23]: th := "rd "; [INRANGE]: th := "th "; ENDCASE; return(day + th + month + ", " + year); [4]: return(month + format_ds + day + format_ds + year); [5]: return(day + format_ds + month + format_ds + year); ENDCASE; ENDPROCEDURE !------------------------------------------------------------------------------ PROCEDURE EDTN$SET_DATE_FORMAT ! Line mode command SET DATE LOCAL state_table, tablen, state_index, state_token, term_char; !INITIALIZE STATE TABLE state_table := ' ? ' + ! 1 ' SHORT ' + ! 2 ' LONG ' + ! 3 ' FORMAL ' + ! 4 ' NUMERIC ' + ! 5 ' EUROPEAN ' + ! 6 ' UPPERCASE ' + ! 7 ' LOWERCASE ' + ! 8 ' CAPITALIZE' + ! 9 ' ZEROS ' + ! 10 ' NOZEROS ' + ! 11 ' DASH ' + ! 12 ' SLASH ' + ! 13 ' FULL ' ; ! 14 tablen := 11; LOOP state_token := edt$next_token(edtn$x_token_delimiters,term_char); exitif (state_token = ""); state_index := index(state_table,(edt$x_space + state_token)); state_index := ((state_index + tablen - 1) / tablen); CASE state_index FROM 0 TO 14 [0]: edx_message('Unsupported SET DATE option: ' + state_token); [1]: edt$help ("EDX_HELP","SET DATE_FORMAT"); [2]: edtn$v_date_format_type := 1; ! SHORT [3]: edtn$v_date_format_type := 2; ! LONG [4]: edtn$v_date_format_type := 3; ! FORMAL [5]: edtn$v_date_format_type := 4; ! NUMERIC [6]: edtn$v_date_format_type := 5; ! EUROPEAN [7]: edtn$v_date_format_case := 1; ! UPPERCASE [8]: edtn$v_date_format_case := 2; ! LOWERCASE [9]: edtn$v_date_format_case := 3; ! CAPITALIZE [10]: edtn$v_date_format_zeros:= 1; ! ZEROS [11]: edtn$v_date_format_zeros:= 0; ! NOZEROS [12]: edtn$x_date_format_ds := "-"; ! DASH [13]: edtn$x_date_format_ds := "/"; ! SLASH [14]: ! FULL (i.e. October 30, 1990) edtn$v_date_format_type := 2; ! long edtn$v_date_format_case := 3; ! capitalize edtn$v_date_format_zeros:= 0; ! nozeros ENDCASE; ENDLOOP; ENDPROCEDURE !------------------------------------------------------------------------------ PROCEDURE EDTN$TIME(clock_param) ! Display the current date in mellow manner. ! ! Inspired by a letter in the DEC Professional (January 1986, p. 56) ! Lets you know what time it is in a rather mellow manner. ! Adapted from .COM file Decus submission by Mic Kaczmarczik 08-Jan-86 ! Translated to TPU David Deley February, 1988 ! LOCAL Oclock, About, Clock, Hour, Minute, Z, Zone, Time; !INITIALIZE VARIABLES Oclock := ""; About := "About"; !GET TIME if clock_param = "" then clock := FAO("!%T",0) else clock := clock_param endif; Hour := int(substr(clock,1,2)); Minute := int(substr(clock,4,2)); Z := (2 * Minute + 5) / 10; ! Round to the nearest 5 minutes If Z > 6 then Hour := Hour + 1 endif; ! Round to next hour !ROUND IT OFF If ( (Z * 5) = Minute ) then About := "Exactly" Else if ( (Z * 5) > Minute ) then About := "Almost" endif Endif; !GET TRANSLATION CASE Z from 0 to 12 [00,12]: Zone := ""; If (Hour <> 0) and (Hour <> 12) then Oclock := " o'clock" endif; [01]: Zone := " five after"; [02]: Zone := " ten after"; [03]: Zone := " quarter after"; [04]: Zone := " twenty after"; [05]: Zone := " twenty five after"; [06]: Zone := " half past"; [07]: Zone := " twenty five to"; [08]: Zone := " twenty to"; [09]: Zone := " quarter to"; [10]: Zone := " ten to"; [11]: Zone := " five to"; ENDCASE; CASE Hour from 0 to 24 [00,24]: Time := "midnight"; [01,13]: Time := "one"; [02,14]: Time := "two"; [03,15]: Time := "three"; [04,16]: Time := "four"; [05,17]: Time := "five"; [06,18]: Time := "six"; [07,19]: Time := "seven"; [08,20]: Time := "eight"; [09,21]: Time := "nine"; [10,22]: Time := "ten"; [11,23]: Time := "eleven"; [12]: Time := "noon"; ENDCASE; !RETURN THE TIME STRING Return(about + zone + edt$x_space + time + Oclock + "."); ENDPROCEDURE !------------------------------------------------------------------------------ PROCEDURE EDTN$SHOW_CALENDAR( YEAR_PARAM ) ! Display a calendar in buffer CALENDAR ! Years evenly divisible by 4 are leap years ! EXCEPT for years evenly divisible by 100 which are not leap years ! EXCEPT EXCEPT for years evenly divisible by 400 which ARE leap years. LOCAL month_names, month, day, day_of_week, days_in_month, year, tnd, !total number of days from year 0 to beginning of year (sort of, partly mod 7) cyear, !Current year (numerical) cmonth, !Current month (numerical) cday, !Current day (numerical) short_month_list, tmark, N, buffer_ptr, buffer_name, date, bmark; If (NOT get_info(system,'display')) then !Check for /NODISPLAY mode edx_message("Can not display calendar in /NODIPLAY mode"); return(0); endif; calendar$range := 0; !Global variable so range stays highlighted short_month_list := "JAN" + ! 1 "FEB" + ! 2 "MAR" + ! 3 "APR" + ! 4 "MAY" + ! 5 "JUN" + ! 6 "JUL" + ! 7 "AUG" + ! 8 "SEP" + ! 9 "OCT" + ! 10 "NOV" + ! 11 "DEC" ; ! 12 month_names := " JANUARY " + ! 1 (each month 9 chars long) " FEBRUARY" + ! 2 " MARCH " + ! 3 " APRIL " + ! 4 " MAY " + ! 5 " JUNE " + ! 6 " JULY " + ! 7 " AUGUST " + ! 8 "SEPTEMBER" + ! 9 " OCTOBER " + ! 10 "NOVEMBER " + ! 11 "DECEMBER " ; ! 12 !DETERMINE YEAR FOR CALENDAR if get_info(year_param,'type')=INTEGER then year := year_param; else year := INT(substr(FAO("!%D",0),8,4)); !if year not specified use current year endif; !IF YEAR OF CALENDAR IS CURRENT YEAR, DETERMINE CURRENT MONTH AND DAY date := FAO("!%D",0); cyear := INT(substr(date, 8,4)); IF cyear = year THEN cday := substr(date,1,2); edit(cday,TRIM); !INT can't handle leading blanks cday := INT(cday); cmonth := INT(str((index(short_month_list,substr(date,4,3))+2)/3)); ELSE cday := 0; cmonth := 0; ENDIF; !DETERMINE DAY_OF_WEEK OF FIRST DAY OF YEAR tnd := (365*year + ((year-1)/4) - ((year-1)/100) + ((year-1)/400)); !8.2-8 fix day_of_week := tnd - (tnd/7)*7; !INITIALIZE CALENDAR BUFFER buffer_name := 'CALENDAR'; if get_info(current_buffer,'name') <> buffer_name then make_two_windows(buffer_name,0); !This will create buffer_name if it doesn't yet exist endif; ! It leaves us in new buffer buffer_ptr := edt$find_buffer(buffer_name); !Get buffer ptr of new buffer set ( system, buffer_ptr); !Mark buffer as system type set ( status_line, current_window, reverse, "" + FAO("!18* Calendar for year !UL",year) ); set ( output_file, buffer_ptr, FAO("Calendar for year !UL",year) ); !For status line in case user goes to this buffer again set ( EOB_TEXT, buffer_ptr, FAO("[End of CALENDAR for year !UL]",year) ); edx_message(""); edx_message("CTRL/D - Go to other window. GOLD-W - Toggle single/dual windows."); position(beginning_of(buffer_ptr)); !PRINT THE CALENDAR days_in_month := create_array(12); days_in_month{1} := 31; days_in_month{2} := 28; days_in_month{3} := 31; days_in_month{4} := 30; days_in_month{5} := 31; days_in_month{6} := 30; days_in_month{7} := 31; days_in_month{8} := 31; days_in_month{9} := 30; days_in_month{10} := 31; days_in_month{11} := 30; days_in_month{12} := 31; !Check for leap year IF (( (year = (year/4)*4) !every 4th year is a leap year AND (year <> (year/100)*100) ) !century years are not leap years !8.2-8 fix OR (year = (year/400)*400) ) !century years evenly divisible by 400 are leap years !8.2-8 fix THEN days_in_month{2} := 29; ENDIF; !MAKE 34 LINES IN BUFFER erase(buffer_ptr); N := 1; Loop split_line; N := N + 1; exitif (N > 34); Endloop; !PRINT YEAR AT TOP OF CALENDAR goto_top; goto_column(39); copy_text(str(year)); !MAIN LOOP (print the months) month := 1; LOOP !FOR MONTH = 1 TO 12 position( (((month-1)/3)*8) + 3 ); !month_row goto_column( (((month-1)-(((month-1)/3)*3))*29)+1 ); !month_column {1,30,59} copy_text( " " + substr(month_names,((month-1)*9)+1,9) ); move_vertical(1); goto_column( (((month-1)-(((month-1)/3)*3))*29)+1 ); !month_column {1,30,59} copy_text(" SU M TU W TH F SA"); move_vertical(1); goto_column( (((month-1)-(((month-1)/3)*3))*29)+1 ); !month_column {1,30,59} copy_text(FAO("!"+str(day_of_week*3)+"* ")); day := 1; Loop !FOR DAY = 1 TO days_in_month{month} loop !WHILE day_of_week <= 6 copy_text(FAO("!3UL",day)); if ((month = cmonth) and (day = cday)) then move_horizontal(-2); bmark := mark(none); move_horizontal(1); calendar$range := create_range(bmark,mark(none),REVERSE); move_horizontal(1); endif; day := day + 1; if day_of_week = 6 then day_of_week := 0; exitif; else day_of_week := day_of_week + 1; endif; exitif (day > days_in_month{month}); endloop; !while day_of_week <= 6 exitif (day > days_in_month{month}); move_vertical(1); goto_column( (((month-1)-(((month-1)/3)*3))*29)+1 ); !month_column {1,30,59} Endloop; !for day = 1 to days_in_month{month} month := month + 1; exitif month > 12; ENDLOOP; !FOR DAY = 1 TO days_in_month{month} Position(beginning_of(current_buffer)); IF get_info(calendar$range,'type')=RANGE THEN position(calendar$range); move_horizontal(1); !! edx_message(FAO("Today is !AS at !AS",current_date,edtn$time(""))); edx_message(FAO("Today is !AS",current_date)); ENDIF; DELETE(days_in_month); ENDPROCEDURE; !------------------------------------------------------------------------------ !****************************************************************************** ! READ_LINE !****************************************************************************** !On VMS 5.3 the READ_LINE built-in messes up the synchronization of the message !buffer causing messages not to appear properly. EDX_READ_LINE here was !developed as a workaround for that. Note that EVE never uses READ_LINE !but instead uses READ_KEY in a loop similar to here. !We also get a recall buffer as a bonus. !ABORT_KEY - if present, write message "Press 'abort-key' to abort this prompt" PROCEDURE EDX_READ_LINE( PROMPT; NCHARS, ABORT_KEY ) LOCAL key_keyword, key_ascii, numchars, abort_message_visible, key_func, response, timer_string; ON_ERROR [TPU$_CONTROLC]: If get_info(prompt_window,"buffer") <> 0 then unmap(prompt_window) endif; !Back to original window If timer_string <> 0 then set(timer,ON) Endif; !Restore the "Working" message Return (""); ENDON_ERROR; timer_string := get_info (system, 'timed_message'); !Save the "Working" message If timer_string <> 0 then set(timer, OFF) Endif; !Turn off the "Working" message temporarily abort_message_visible := FALSE; !Haven't yet said "Press 'abort-key' to abort" position(end_of(recall_buffer)); !To set position in case we start recalling commands erase(prompt_buffer); position(prompt_buffer); pmt$v_prompt_length := length( prompt ); copy_text( prompt ); map(prompt_window,prompt_buffer); update(prompt_window); !Make it visible LOOP numchars := length(current_line) - pmt$v_prompt_length; If (numchars = 0) then if (ABORT_KEY <> tpu$k_unspecified) then if (not abort_message_visible) then edx_message("Press !AS to abort this prompt",EDX$K_INFO, abort_key); abort_message_visible := TRUE; endif; endif; Endif; key_keyword := READ_KEY; EXITIF ( key_keyword = RET_KEY ); EXITIF ( key_keyword = ENTER ); EXITIF ( key_keyword = CTRL_Z_KEY ); EXITIF ( key_keyword = KP0 ); EXITIF ( key_keyword = KP1 ); EXITIF ( key_keyword = KP2 ); EXITIF ( key_keyword = KP3 ); EXITIF ( key_keyword = KP4 ); EXITIF ( key_keyword = KP5 ); EXITIF ( key_keyword = KP6 ); EXITIF ( key_keyword = KP7 ); EXITIF ( key_keyword = KP8 ); EXITIF ( key_keyword = KP9 ); EXITIF ( key_keyword = PF2 ); EXITIF ( key_keyword = PF3 ); EXITIF ( key_keyword = PF4 ); EXITIF ( key_keyword = MINUS ); EXITIF ( key_keyword = COMMA ); EXITIF ( key_keyword = E1 ); !'find' press twice gives 'find next' !** EXITIF ( key_keyword = E2 ); !'insert' can insert a string EXITIF ( key_keyword = E3 ); EXITIF ( key_keyword = E4 ); EXITIF ( key_keyword = E5 ); EXITIF ( key_keyword = E6 ); EXITIF ( key_keyword = DO ); key_ascii := ascii( key_keyword); If ( (key_ascii >= edt$x_space) and (key_ascii <= '~') ) !check for printable character then vs$copy_char( key_ascii ); !check for TAB character in overstrike. numchars := length(current_line) - pmt$v_prompt_length; update(current_window); !prompt window If (numchars > 0) then if (abort_message_visible) then edtn$clear_message_window; !Remove "Press 'abort-key' to abort" message abort_message_visible := FALSE; endif Endif; If NCHARS <> tpu$k_unspecified then exitif (numchars = NCHARS); !Exit if NCHARS characters have been entered Endif; Else key_func := lookup_key(key_keyword, PROGRAM); if (key_func <> 0) then execute (key_func); !May be arrow key, CTRL-A, CTRL-E, etc. if ( get_info(prompt_window,"visible") !Check for keys like GOLD-B and (current_buffer = prompt_buffer) and (cursor_line_number = 1) ) !else user may have initiated some disaster. Abort. then update(prompt_window); !prompt window else If get_info(prompt_window,"buffer") <> 0 then unmap(prompt_window) endif; !kill prompt window If timer_string <> 0 then set(timer,ON) Endif; !Restore the "Working" message abort; !abort back to interactive mode endif; endif; Endif; ENDLOOP; if (abort_message_visible) then edtn$clear_message_window !Remove "Press 'abort-key' to abort" message endif; position(beginning_of(prompt_buffer)); !Move cursor to beginnig of line to let user know update(prompt_window); !that key has been pressed. response := substr( current_line, pmt$v_prompt_length+1, length(current_line) ); !! edit(response,trim,OFF); !Don't do this. IF (response <> "") then position(end_of(recall_buffer)); !prepare to add response to end of response_buffer If (mark(none)<>beginning_of(recall_buffer)) then !check for response buffer empty move_vertical(-1); !get previous response if (response <> current_line) then !check that this response different from previous one position(end_of(recall_buffer)); copy_text( response ); !add response to recall buffer endif; Else copy_text( response ); !add response to recall buffer Endif; ENDIF; unmap(prompt_window); !Back to original window ! Note prompt window stays visible until we refresh message window or return to interactive If timer_string <> 0 then set(timer,ON) Endif; !Restore the "Working" message Return (response); ENDPROCEDURE; PROCEDURE PMTBUF$UP_ARROW !Recall previous command. Also CTRL-B. The most recent commands are at !the bottom of the recall_buffer, the oldest ones towards the top. Up !arrow to recall the previous command translates naturally into moving up !the recall_buffer, getting the line from the recall buffer, and putting !it in the prompt buffer. If we hit the top of the recall buffer, then !we put a blank response in the prompt buffer and recycle our pointers !back to the bottom of the recall_buffer. Local response, x; position(recall_buffer); position(LINE_BEGIN); if (mark(none) <> beginning_of(current_buffer)) then !If not at top of recall_buffer move_horizontal(-1); response := current_line; position(prompt_buffer); goto_column( pmt$v_prompt_length+1 ); x := erase_character(length(current_line)); copy_text( response ); else position(end_of(recall_buffer)); !Reset position in recall buffer position(prompt_buffer); goto_column( pmt$v_prompt_length+1 ); x := erase_character(length(current_line)); endif; ENDPROCEDURE PROCEDURE PMTBUF$DOWN_ARROW !Recall next command (after recall previous went too far). The most !recent commands are at the bottom of the recall_buffer, the oldest ones !towards the top. Down arrow to recall the next command translates !naturally into moving down the recall_buffer, getting the line from the !recall buffer, and putting it in the prompt buffer. If we hit the bottom !of the recall buffer, then we put a blank response in the prompt buffer. Local response, x; position(recall_buffer); if (mark(none) <> end_of(current_buffer)) then !If not at bottom of recall_buffer move_vertical(1); position(LINE_END); if (mark(none) <> end_of(current_buffer)) then !If still not at bottom of recall_buffer response := current_line; position(prompt_buffer); goto_column( pmt$v_prompt_length+1 ); x := erase_character(length(current_line)); copy_text( response ); return; endif; endif; !Else blank out prompt buffer position(prompt_buffer); goto_column( pmt$v_prompt_length+1 ); x := erase_character(length(current_line)); ENDPROCEDURE PROCEDURE PMTBUF$TOGGLE_INSERT_OVERSTRIKE !Toggle between INSERT/OVERSTRIKE modes If (get_info(current_buffer,'mode') = INSERT) then set (overstrike,current_buffer) else set (insert,current_buffer) Endif; ENDPROCEDURE PROCEDURE PMTBUF$DELETE_PREVIOUS_WORD !From edt$del_beg_word & edt$beg_word Local temp_length; if current_offset <= pmt$v_prompt_length !Don't delete past prompt then return 0 endif; move_horizontal(-1); !Skip current character temp_length := 1; ! ! Count any spaces ! loop exitif current_offset <= pmt$v_prompt_length; exitif index (eve$x_whitespace, current_character) = 0; move_horizontal(-1); temp_length := temp_length + 1; endloop; ! ! IF we are on a word terminator count that one character. Otherwise ! scan to the next word terminator. ! if (index(edt$x_word,current_character) = 0) then loop exitif current_offset <= pmt$v_prompt_length; move_horizontal(-1); if (index(edt$x_word,current_character) <> 0) then move_horizontal(1); exitif; endif; temp_length := temp_length + 1; endloop; endif; return erase_character(temp_length); ENDPROCEDURE PROCEDURE PMTBUF$DELETE_TO_BOL Local x; x := erase_character( -current_offset + pmt$v_prompt_length ); ENDPROCEDURE !------------------------------------------------------------------------------ !****************************************************************************** ! LINE MODE PARSERS !****************************************************************************** !+ ! This is bound to the ^Z key. It will read a line and parse it, looking ! for the first thing to be one of the line mode commands it can ! interpret. !- PROCEDURE EDT$LINE_MODE !ctrl z (line mode) LOCAL command, command_status; !CLEAR MESSAGE WINDOW edtn$clear_message_window; ! KEEP LOOPING UNTIL WE SEE SOMETHING THAT WILL CAUSE US TO EXIT. Loop edtn$x_goto_screen_mode := 0; command := edx_read_line('*'); command_status := do_command(command); if (edtn$x_goto_screen_mode = 1) then exitif; endif; Endloop; ENDPROCEDURE PROCEDURE EDTN$PROMPT_DO_COMMAND ! Process GOLD KP7 and DO keys. Prompts "Command: ", and executes. Local command; command := edx_read_line("Command: "); do_command( command ); ENDPROCEDURE !------------------------------------------------------------------------------ PROCEDURE EDTN$DO_COMMAND(command) !Left here for backwards compatibility. do_command(command); ENDPROCEDURE PROCEDURE DO_COMMAND(command) ! Process line mode commands. Return success if parsed and executed ! successfully. Return failure if something wrong was detected. LOCAL command_name, command_status, term_char, original_line, org_line_length, new_line_length, command_index, target, replacement, next_term_char, curbuf; !SEE IF LINE MODE COMMAND INITIALIZATION REQUIRED IF edt$x_commands = 0 THEN !Initialize some global variables needed by the line mode parser !Initialize line mode commands: edt$x_commands := ' ' + ! 1 ' ? ' + ! 2 ' ADJUST ' + ! 3 ' ATTACH ' + ! 4 ' CHANGE ' + ! 5 C for CHANGE comes first ' CALCULATE ' + ! 6 ' CENTER ' + ! 7 ' CLEAR ' + ! 8 ' DCL ' + ! 9 ' DCL_HELP ' + ! 10 ' DECIPHER ' + ! 11 ' DECRYPT ' + ! 12 ' DEFINE ' + ! 13 ' DELETE ' + ! 14 ' DIFFERENCES' + ! 15 ' DIRECTORY ' + ! 16 ' ELIMINATE ' + ! 17 ' ENCIPHER ' + ! 18 ' ENCRYPT ' + ! 19 ' ERASE ' + ! 20 ' EXIT ' + ! 21 ' FIND ' + ! 22 ' FIX ' + ! 23 ' HELP ' + ! 24 ' INCLUDE ' + ! 25 ' LOCK ' + ! 26 ' PRINT ' + ! 27 !not implemented ' QUIT ' + ! 28 ' REPLACE ' + ! 29 ' SUBSTITUTE ' + ! 30 S for SUBSTITUTE comes first ' SEARCH ' + ! 31 ' SET ' + ! 32 ' SHOW ' + ! 33 SH for SHOW before SHIFT ' SHIFT ' + ! 34 ' SORT ' + ! 35 ' SPELL ' + ! 36 SP for SPELL comes before SPAWN ' SPAWN ' + ! 37 ' TPU ' + ! 38 ' TPU_HELP ' + ! 39 ' TRANSLATE ' + ! 40 ' TRIM ' + ! 41 ' TYPE ' + ! 42 ' UNDEFINE ' + ! 43 ' UNLEARN ' + ! 44 ' UNLOCK ' + ! 45 ' UNPASTE ' + ! 46 ' WRITE ' ; ! 47 edt$x_command_length := 12; !Qualifiers for line mode SET command: edt$x_sets := ' ? ' + ! 1 ' COLUMNAR ' + ! 2 ' CURSOR ' + ! 3 ' DATE_FORMAT ' + ! 4 ' DEFAULT ' + ! 5 ' INDENTATION ' + ! 6 !really INDENT ' INSERT ' + ! 7 ' KEYPAD ' + ! 8 ' LEFT_MARGIN ' + ! 9 ' LOCK ' + ! 10 ' MARKERS ' + ! 11 !really SET MARKER ' NOCOLUMNAR ' + ! 12 ' NOLOCK ' + ! 13 ' NORECTANGULAR' + ! 14 ' NOWRAP ' + ! 15 ' OVERSTRIKE ' + ! 16 ' PROMPT ' + ! 17 ' RECTANGULAR ' + ! 18 ' SCREEN_UPDATE' + ! 19 ' SEARCH ' + ! 20 ' SHIFT_AMOUNT ' + ! 21 ' SYMBOL ' + ! 22 ' TABS ' + ! 23 !Before TAB_KEY so SET TAB means this ' TAB_KEY ' + ! 24 ' WRAP ' ; ! 25 edt$x_set_length := 14; !Qualifiers for line mode SHOW command: edt$x_shows := ' ? ' + ! 1 ' ASCII ' + ! 2 ' BUFFERS ' + ! 3 ' CALENDAR ' + ! 4 ' CURSOR ' + ! 5 ' DATE ' + ! 6 ' DEFAULT ' + ! 7 ' INDENTATION ' + ! 8 !really INDENT ' LEFT_MARGIN ' + ! 9 ' LOGICAL ' + ! 10 ' MARKERS ' + ! 11 ' SCREEN ' + ! 12 ' SEARCH ' + ! 13 ' SHIFT_AMOUNT' + ! 14 ' SYMBOL ' + ! 15 ' TIME ' + ! 16 ' VERSION ' + ! 17 ' WRAP ' ; ! 18 edt$x_show_length := 13; !Qualifiers for line mode SET SEARCH command: edt$x_searches:=' ? ' + ! 1 ' GENERAL' + ! 2 ' EXACT ' + ! 3 ' BEGIN ' + ! 4 ' END ' + ! 5 ' WILD ' + ! 6 ' NOWILD ' + ! 7 ' NOEXACT' + ! 8 ' BELL ' + ! 9 ' BEEP ' + ! 10 ' NOQUIET' + ! 11 ' NOBELL ' + ! 12 ' NOBEEP ' + ! 13 ' QUIET ' ; ! 14 edt$x_searches_length := 8; !Qualifiers for line mode SUTSTITUTE command: edtn$x_sub_qualifiers := '/WHOLE ' + ! 1 '/REST ' + ! 2 '/NUMBER ' + ! 3 '/QUERY ' + ! 4 '/NOQUERY' + ! 5 '/TYPE ' + ! 6 '/NOTYPE ' + ! 7 '/EXACT ' + ! 8 '/NOEXACT' + ! 9 '/WILD ' ; ! 10 edtn$v_sub_tablen := 8; !Qualifiers for line mode SEARCH command: edtn$x_search_qualifiers := '/ALL ' + ! 1 '/BUFFER ' + ! 2 '/EXACT ' + ! 3 '/EXCLUDE' + ! 4 '/NOEXACT' + ! 5 '/NOWILD ' + ! 6 '/REVERSE' + ! 7 '/WHOLE ' + ! 8 '/WILD ' ; ! 9 edtn$v_search_tablen := 8; !Qualifiers for line mode FIND command: edtn$x_find_qualifiers := '/ALL ' + ! 1 '/EXACT ' + ! 2 '/EXCLUDE' + ! 3 '/NUMBER ' + ! 4 '/NOEXACT' + ! 5 '/NOQUERY' + ! 6 '/NOTYPE ' + ! 7 '/NOWILD ' + ! 8 '/QUERY ' + ! 9 '/REPLACE' + ! 10 '/REVERSE' + ! 11 '/TYPE ' + ! 12 '/WHOLE ' + ! 13 '/WILD ' ; ! 14 edtn$v_find_tablen := 8; ENDIF; !PARSE THE COMMAND LINE If length(command) = 0 then ! If null command edtn$x_goto_screen_mode := 1; ! then exit line mode Return (1); Endif; edit(command,trim,OFF); edt$x_line := command; ! Make global copy of command line for other procedures to use original_line := edt$x_line; ! Save the original line in case this is a substitute command org_line_length := LENGTH (original_line); edit(edt$x_line,upper,off); !GET COMMAND NAME term_char := substr(edt$x_line,1,1); If ((term_char = '"') or (term_char = "'")) then !See if it's a string command_name := 'FIND' ! for us to search for Else command_name := edt$next_token(edtn$x_token_delimiters,term_char) Endif; command_index := index(edt$x_commands,(' '+ command_name)); command_index := ((command_index + edt$x_command_length)-1) / edt$x_command_length; CASE command_index FROM 0 TO 47 [0]:!Command not in command string !See if it was a line-number for us to go to If edtn$string_to_integer(command_name) then goto_line( INT(command_name) ); edtn$x_goto_screen_mode := 1; !Return to screen mode Return (1); Else edx_message("Command " + command_name + " not supported"); Return (0); Endif; [1]:!blank spaces entered. Do nothing. !See if it was '=' for =buffer IF (term_char = '=') then edt$buffer; !See if optional line number follows Command_name := edt$next_token(edtn$x_token_delimiters,term_char); If (command_name <> "") then if edtn$string_to_integer(command_name) then goto_line( INT(command_name) ); endif; Endif; !Else just ignore whatever we couldn't interpret update(current_window); ELSE Return (0); !Do nothing ENDIF; [3]:!ADJUST command_status := parse$adjust; [4]:!ATTACH ! Get the original line back because the case might be important new_line_length := LENGTH (edt$x_line); edt$x_line := substr (original_line, (org_line_length - new_line_length) + 1, new_line_length); command_status := eve_attach(term_char+edt$x_line); [5]:!CHANGE (C for CHANGE comes first) !See if there's an optinal line number following the CHANGE command !or an optional =buffer-name, or both. IF (term_char = '=') then edt$buffer; ENDIF; Command_name := edt$next_token(edtn$x_token_delimiters,term_char); !See if optional line number follows IF edtn$string_to_integer(command_name) then goto_line( INT(command_name) ); ENDIF; edtn$x_goto_screen_mode := 1; !Return to screen mode Return (1); [6]:!CALCULATE command_status := edtn$calc; [7]:!CENTER center_line; [8]:!CLEAR command_status := parse$clear; [9]:!DCL ! Get the original line back because the case might be important new_line_length := LENGTH (edt$x_line); edt$x_line := substr (original_line, (org_line_length - new_line_length) + 1, new_line_length); command_status := eve_DCL(edt$x_line); [10]:!DCL_HELP edt$help ("HELPLIB",edt$x_line); edtn$x_goto_screen_mode := 1; !Return to screen mode Return (1); [13]:!DEFINE edtn$set_logical; [14]:!DELETE command_status := parse$delete; [15]:!DIFFERENCES target:= edt$next_token(edtn$x_token_delimiters,term_char); !Buffer1 replacement:= edt$next_token(edtn$x_token_delimiters,term_char);!Buffer2 command_status := edtn$differences(target,replacement); [16]:!DIRECTORY command_status := edtn$dir(term_char+edt$x_line); [17]:!ELIMINATE (tabs) command_status := eve_eliminate_tabs; [11,12,18,19]:! ENCIPHER,ENCRYPT,DECIPHER,DECRYPT ring_bell("Sorry, EDX no longer encrypts buffers."); !!!! command_status := edtn$encrypt_begin; !!!! edtn$x_goto_screen_mode := 1; ! must exit line mode for read password to work [20]:!ERASE command_status := parse$erase; [21]:!EXIT command_status := edt$exit(term_char,'EXIT'); [22]:!FIND !See if it was FIND=buffer IF ( term_char = '=') then edt$buffer; update(current_window); ELSE !Assume it's a string for us to search for !We decided not to support FIND BEGIN, FIND END, FIND BUFFER. ! Get the original line back because the case might be important new_line_length := LENGTH (edt$x_line); edt$x_line := substr( original_line, (org_line_length - new_line_length) + 1, new_line_length); command_status := edtn$line_mode_find(term_char); edtn$x_goto_screen_mode := 1; ENDIF; [23]:!FIX command_status := parse$fix; [2,24]:!HELP edt$help ("EDX_HELP",edt$x_line); edtn$x_goto_screen_mode := 1; !Return to screen mode Return (1); [25]:!INCLUDE command_status := parse$include(term_char); if get_info(system,'display') then update(current_window) endif; [26]:!LOCK edtn$lock_file("LOCK"); [27]:!PRINT !! command_status := edtn$print(term_char); !not yet implimented. edx_message("PRINT command not yet implemented"); [28]:!QUIT command_status := edt$exit(term_char,'QUIT') [29]:!REPLACE command_status := edtn$line_mode_replace; [30]:!SUBSTITUTE ! Get the original line back because the case is important new_line_length := LENGTH (edt$x_line); edt$x_line := substr (original_line, (org_line_length - new_line_length) + 1, new_line_length); IF (term_char = "") then EDTN$LINE_MODE_REPLACE; ELSE !Check for possible quoted string next_term_char := substr(edt$x_line,1,1); If index(eve$x_whitespace, term_char) <> 0 And ((next_term_char = '"') or (next_term_char = "'")) Then edtn$line_mode_replace; Else command_status := edt$line_mode_substitute(term_char); Endif; ENDIF; update(current_window); [31]:!SEARCH ! Get the original line back because the case is important new_line_length := LENGTH (edt$x_line); edt$x_line := substr (original_line, (org_line_length - new_line_length) + 1, new_line_length); command_status := edtn$line_mode_search(term_char); [32]:!SET ! Get the original line back because the case might be important ! for the SET SYMBOL command. new_line_length := LENGTH (edt$x_line); edt$x_line := substr (original_line, (org_line_length - new_line_length) + 1, new_line_length); command_status := edt$set; [33]:!SHOW command_status := edt$show; [34]:!SHIFT (shift screen left/right) target := edt$next_token(edtn$x_token_delimiters,term_char); if ( target = "" ) then target := 0 else target := int(target) endif; edtn$shift_window( target ); [35]:!SORT command_status := SRT$SORT(original_line); [36]:!SPELL command_status := spl$spell_parse(term_char); [37]:!SPAWN ! Get the original line back because the case might be important new_line_length := LENGTH (edt$x_line); edt$x_line := substr (original_line, (org_line_length - new_line_length) + 1, new_line_length); command_status := eve_spawn(edt$x_line); [38]:!TPU ! Get the original line back because the case might be important new_line_length := LENGTH (edt$x_line); edt$x_line := substr (original_line, (org_line_length - new_line_length) + 1, new_line_length); command_status := edtn$TPUcommand(edt$x_line); [39]:!TPU_HELP edt$help ("TPUHELP",edt$x_line); edtn$x_goto_screen_mode := 1; !Return to screen mode Return (1); [40]:!TRANSLATE (ebcdic to ascii or ascii to ebcdic) command_status := parse$translate; [41]:!TRIM command_status := parse$trim; [42]:!TYPE (handled as SEARCH/WHOLE) ! Get the original line back because the case is important new_line_length := LENGTH (edt$x_line); edt$x_line := substr (original_line, (org_line_length - new_line_length) + 1, new_line_length); target := edt$next_token(eve$x_whitespace,term_char); edit(target,upper,off); if target = "ALL" then edt$x_line := edt$x_line + "/WHOLE"; !for TYPE ALL command. command_status := edtn$line_mode_search(term_char); else edx_message("Only TYPE ALL is supported"); endif; [43,44]:!UNDEFINE, UNLEARN command_status := edtn$unlearn; [45]:!UNLOCK edtn$lock_file("UNLOCK"); [46]:!UNPASTE command_status := unpaste; [47]:!WRITE command_status := parse$write(term_char); ENDCASE; curbuf := get_info(BUFFER,'current'); !we do this to avoid possible TPU$_NOCURRENTBUF warning if curbuf <> 0 then set(forward,curbuf) endif; !a line mode command returns with buffer in forward mode. Return (command_status); ENDPROCEDURE !---------------------------------------------------------------------- PROCEDURE EDTN$STRING_TO_INTEGER(N) !Supress error message LOCAL dummy; On_error Return 0 Endon_error; dummy := int(n); Return 1; ENDPROCEDURE !------------------------------------------------------------------------------ PROCEDURE PARSE$NEXT_STATE( state_index, state_table, tablen, kwprompt, promptnull, kwerror ) ! ! Parse the command line, prompt for input if needed, return state_index ! ! Parameters: ! state_index - Integer. Return index into state table of keyword. ! state_table - String. The table of acceptable keywords ! tablen - Intger. Length of words in state_table ! kwprompt - String. Prompt to use when prompting for keyword (i.e. "ADJUST what: ") ! promptnull - String. Message to give if keyword not given (i.e. "You must provide an option to ADJUST") ! kwerror - String or unspecified variable. ! If string, then message (FAO control string) to give if keyword given not found in state_table (i.e. "Unsupported ADJUST option !AS") ! If unspecified, then gets set to token if token not a keyword ! !Return status: 1 - success ! 0 - failure LOCAL state_token, term_char; LOOP state_token := edt$next_token(edtn$x_token_delimiters,term_char); Exitif (state_token <> ""); If get_info(system,'display') then !Can only prompt in display mode edt$x_line := edx_read_line(kwprompt,,"CTRL-Z"); !Prompt for input Endif; If (edt$x_line = "") then !null if no input given or in nodisplay mode if (last_key <> ctrl_z_key) then edx_message(promptnull); !No keyword was given. Did not abort with CTRL-Z endif; return 0; Endif; ENDLOOP; edit(state_token,trim,upper,OFF); state_index := index(state_table,(edt$x_space + state_token)); state_index := ((state_index + tablen - 1) / tablen); If state_index = 0 then if get_info(kwerror,'type')=STRING then edx_message(kwerror,EDX$K_WARN_HIGHLIGHT,state_token); Return (0); else !Note: if kwerror is not a STRING then we assume that token is kwerror := state_token; !a P1 parameter and kwerror is a variable for us to set = token. endif; !in that case we return with success and state_index = 0 and kwerror := token Endif; Return (1); ENDPROCEDURE !------------------------------------------------------------------------------ PROCEDURE EDT$NEXT_TOKEN ( DELIMITERS, TERM_CHAR) !support routine for line mode ! Line mode command parser. This will return the next token from the line. ! Parameters: ! Delimiters - characters which can delimit a token ! Term_char - actual character that delimited returned token ! if term_char was a tab then returned term_char is a space ! edt$x_line - what is left of the current line mode command LOCAL line_length, ! Length of line cp, ! Current pointer into line char, ! Current character quote_char, ! " or ' look_ahead, ! Temporary character token; ! Token to return token := ""; !initialize as string variable edit(edt$x_line,trim_leading,off); line_length := length(edt$x_line); !We assume there's at least one character. (It may be the end of string null character if string is empty). !See if the thing we are on is a quote character !If so remove it and search for the matching quote. char := substr(edt$x_line,1,1); IF (index("""'",char) <> 0) then quote_char := char; edt$x_line := substr(edt$x_line,2,line_length); cp := 1; LOOP char := substr(edt$x_line,1,1); IF (char = "") then edx_message ("Matching quote not found for " + quote_char + token); term_char := char; return ""; ELSE If (char = quote_char) then edt$x_line := substr(edt$x_line,2,line_length); look_ahead := substr(edt$x_line,1,1); if (look_ahead = quote_char) then edt$x_line := substr(edt$x_line,2,line_length); token := token + quote_char; else term_char := look_ahead; edt$x_line := substr(edt$x_line,2,line_length); exitif; !Exit loop. Matching quote found. endif Else token := token + char; edt$x_line := substr(edt$x_line,2,line_length) Endif ENDIF ENDLOOP ELSE !Else just look for a standard delimiter and extract the token cp := 1; LOOP term_char := substr(edt$x_line,cp,1); exitif cp > line_length; exitif (index(delimiters,term_char) <> 0); !exit if next character is delimiter cp := cp + 1 ENDLOOP; token := substr(edt$x_line,1,(cp - 1)); edt$x_line := substr(edt$x_line,(cp+1),line_length); ENDIF; !Now skip whitespace and search for possible term_char other than whitespace if index(eve$x_whitespace,term_char) <> 0 then !If term_char was space or tab edit(edt$x_line,trim_leading,off); !then trim leading spaces and tabs from line char := substr(edt$x_line,1,1); !get the first non-space non-tab character if (index(delimiters,char) <> 0) then !and if it's a "/" or "=" term_char := char; ! set term_char to "/" or "=" edt$x_line := substr(edt$x_line,2,line_length); ! and remove term_char from line else term_char := edt$x_space; !Return space even if it really was a tab. Makes interpreting easier. endif; endif; !Otherwise do nothing return token; ENDPROCEDURE !------------------------------------------------------------------------------ PROCEDURE PARSE$ADJUST ! Line mode command ADJUST ! LOCAL state_table, tablen, state_index; !INITIALIZE STATE TABLE state_table := ' ? ' + ! 1 ' WINDOWS' ; ! 2 tablen := 8; IF parse$next_state( state_index, state_table, tablen, "ADJUST what: ", "You must provide an option to ADJUST", "Unsupported ADJUST option: !AS" ) THEN CASE state_index FROM 1 TO 2 [1]: !HELP ADJUST edt$help ("EDX_HELP","ADJUST"); [2]: !ADJUST WINDOWS edtn$adjust_dual_windows; ENDCASE; ENDIF; ENDPROCEDURE !------------------------------------------------------------------------------ PROCEDURE PARSE$CLEAR ! Line mode command CLEAR ! LOCAL state_table, tablen, state_index; !INITIALIZE STATE TABLE state_table := ' ? ' + ! 1 ' TABS' ; ! 2 tablen := 5; IF parse$next_state( state_index, state_table, tablen, "CLEAR what: ", "You must provide an option to CLEAR", "Unsupported CLEAR option: !AS" ) THEN CASE state_index FROM 1 TO 2 [1]:!HELP CLEAR edt$help ("EDX_HELP","CLEAR"); [2]:!CLEAR TAB edtn$clear_tab; ENDCASE; ENDIF; ENDPROCEDURE !------------------------------------------------------------------------------ PROCEDURE EDTN$CLEAR_TAB ! Line mode command CLEAR TAB ! LOCAL token, term_char, here; token := edt$next_token(edtn$x_token_delimiters+',',term_char); If (token = "") then if get_info(system,'display') then token := edx_read_line("CLEAR TAB at: ",,"CTRL-Z"); endif; if (token = "") then if (last_key <> ctrl_z_key) then edx_message('Missing parameter to CLEAR TAB'); endif; return (0); endif; Endif; LOOP If token = "#" then token := get_info(current_buffer,'offset_column'); Else edit(token,trim,upper,OFF); IF (index('ALL',token) = 1) then here := mark(free_cursor); erase(ruler_buffer); position(ruler_buffer); copy_text(edtn$x_ruler_line); position(here); return; ELSE token := int(token); ENDIF; Endif; If (token > 132) OR (token < 1) then edx_message("Numeric value illegal") Else here := mark(free_cursor); position(beginning_of(ruler_buffer)); move_horizontal(token-1); copy_text(substr(edtn$x_ruler_line,token,1)); position(here); Endif; token := edt$next_token(edtn$x_token_delimiters+',',term_char); exitif (token = "") ENDLOOP; ENDPROCEDURE !------------------------------------------------------------------------------ PROCEDURE PARSE$DELETE !Line mode command DELETE LOCAL state_table, tablen, state_index; !INITIALIZE STATE TABLE state_table := ' ? ' + ! 1 ' BUFFER' ; ! 2 tablen := 7; IF parse$next_state( state_index, state_table, tablen, "DELETE what: ", "You must provide an option to DELETE", "Unsupported DELETE option: !AS" ) THEN CASE state_index FROM 1 TO 2 [1]:!HELP DELETE edt$help ("EDX_HELP","DELETE"); [2]:!DELETE BUFFER parse$delete_buffer; ENDCASE; ENDIF; ENDPROCEDURE !------------------------------------------------------------------------------ PROCEDURE PARSE$DELETE_BUFFER LOCAL buf, buf_lines, bufnam, Y_N, mods; buf := current_buffer; If (get_info(buf,'permanent')) then ring_bell("Cannot delete a permanent buffer"); return(0); Endif; buf_lines := get_info(buf,'record_count'); bufnam := get_info(buf,'name'); If (NOT get_info(system,'display')) then edx_message(FAO("Deleting buffer !AS, !UL line!%S.",bufnam,buf_lines,bufnam)); delete(buf); !No confirming in /NODISPLAY mode. No windows to deal with Else ring_bell(""); !Ring bell and edx_message(""); !clear message display if get_info(buf,'modified') then mods := "Modified" else mods := "Unmodified" endif; Y_N := edx_read_line(FAO("!AS buffer !AS contains !UL line!%S. Delete buffer !AS? ", mods, bufnam, buf_lines, bufnam)); edit(Y_N,trim,upper,OFF); If ( index("YES",Y_N) = 1) then edtn$delete_buffer(buf); endif; Endif; ENDPROCEDURE !------------------------------------------------------------------------------ PROCEDURE PARSE$ERASE !Line mode command ERASE LOCAL state_table, tablen, state_index; !INITIALIZE STATE TABLE state_table := ' ? ' + ! 1 ' BUFFER' ; ! 2 tablen := 7; IF parse$next_state( state_index, state_table, tablen, "ERASE what: ", "You must provide an option to ERASE", "Unsupported ERASE option: !AS" ) THEN CASE state_index FROM 1 TO 2 [1]:!HELP ERASE edt$help ("EDX_HELP","ERASE"); [2]:!ERASE BUFFER edtn$erase_buffer; ENDCASE; ENDIF; ENDPROCEDURE !------------------------------------------------------------------------------ PROCEDURE EDTN$ERASE_BUFFER LOCAL buf, buf_lines, bufnam, Y_N, mods; buf := current_buffer; buf_lines := get_info(buf,'record_count'); IF (buf_lines = 0) then edx_message("Buffer is empty"); ELSE bufnam := get_info(buf,'name'); If (NOT get_info(system,'display')) then edx_message("Erasing buffer !AS, !UL line!%S.",EDX$K_INFO,bufnam,buf_lines,bufnam); erase(buf); !No confirming in /NODISPLAY mode Else ring_bell(""); !Ring bell and edx_message(""); !clear rest of message display if get_info(buf,'modified') then mods := "Modified" else mods := "Unmodified" endif; Y_N := edx_read_line(FAO("!AS buffer !AS contains !UL line!%S. Erase contents of buffer !AS? ", mods, bufnam, buf_lines, bufnam)); edit(Y_N,trim,upper,OFF); If ( index("YES",Y_N) = 1) then erase(buf); endif; Endif; ENDIF; ENDPROCEDURE !------------------------------------------------------------------------------ PROCEDURE PARSE$FIX ! Line mode command FIX ! LOCAL state_table, tablen, state_index; !INITIALIZE STATE TABLE state_table := ' ? ' + ! 1 ' CRLFS' ; ! 2 tablen := 6; IF parse$next_state( state_index, state_table, tablen, "FIX what: ", "You must provide an option to FIX", "Unsupported FIX option: !AS" ) THEN CASE state_index FROM 1 TO 2 [1]: !HELP FIX edt$help ("EDX_HELP","FIX"); [2]: !FIX CRLFS eve_fix_crlfs; ENDCASE; ENDIF; ENDPROCEDURE !------------------------------------------------------------------------------ PROCEDURE EDTN$LOCK_FILE(LOCK_TYPE) ! line mode command LOCK and UNLOCK ! Parameter: LOCK_TYPE = LOCK ! = UNLOCK ! LOCAL state_table, tablen, state_index, term_char, result, code, retcode, buf, bufnam, filename; !INITIALIZE STATE TABLE state_table := ' ? ' + ! 1 ' BUFFER' + ! 2 ' FILE ' ; ! 3 tablen := 7; If (lock_type = "LOCK") then code := 65537 !LOCK FILE x00010001 Else code := 65538 !UNLOCK FILE x00010002 Endif; IF parse$next_state( state_index, state_table, tablen, LOCK_TYPE+" what: ", "You must provide an option to "+LOCK_TYPE, "Unsupported "+LOCK_TYPE+" option: !AS" ) THEN CASE state_index from 1 TO 3 [1]: !HELP LOCK edt$help ("EDX_HELP",LOCK_TYPE); return; [2]: !LOCK BUFFER bufnam := edt$next_token(edtn$x_token_delimiters,term_char); if (bufnam = "") then buf := current_buffer else buf := edt$find_buffer(bufnam); if buf = 0 then edx_message("Buffer !AS does not exist",EDX$K_ERROR_HIGHLIGHT,bufnam); return 0; endif; endif; filename := edtn$filename_of_buffer(buf); if (filename = "") then edx_message("Buffer does not have file name associated with it"); return 0; endif; [3]: !LOCK FILE filename := edt$x_line; If (filename = "") then if get_info(system,'display') then filename := edx_read_line('FILENAME: ',,"CTRL-Z"); endif; if (filename = "") then if (last_key <> ctrl_z_key) then edx_message("no filename given"); endif; return 0; endif; Endif; ENDCASE; result := call_user(code,filename); retcode := int(substr(result,1,9)); IF (retcode = 1) then edtn$v_locked_files := TRUE; !Locked files = TRUE If get_info(system,'display') then edtp$Set_Status_Line( main_window); edtp$Set_Status_Line( top_window); edtp$Set_Status_Line(bottom_window); Endif; ENDIF; ENDIF; !If parse$next_state ENDPROCEDURE !------------------------------------------------------------------------------ !+ ! Edt line mode SET command !- PROCEDURE EDT$SET !support routine for line mode(set cmd) LOCAL set_index, temp_value1, temp_value2, term_char, set_type, here, command_status, original_line, org_line_length, new_line_length, tblind, expression; ! Save the original line in case this is a SET SYMBOL command original_line := edt$x_line; org_line_length := LENGTH (original_line); edit(edt$x_line,upper,off); ! What are we setting? set_type := edt$next_token(edtn$x_token_delimiters,term_char); IF (set_type = "") then if get_info(system,'display') then edt$x_line := edx_read_line("SET what: ",,"CTRL-Z"); edit(edt$x_line,trim,upper,OFF); endif; !else edt$x_line already := ""; if (edt$x_line = "") then if (last_key <> ctrl_z_key) then edx_message('You must provide an option to SET'); endif; return 0; else return edt$set; !Recursively call ourselves endif; Endif; set_index := index(edt$x_sets,(edt$x_space + set_type)); set_index := ((set_index + edt$x_set_length - 1) / edt$x_set_length); CASE set_index FROM 0 to 25 [0]: edx_message('Unsupported SET option: ' + set_type); return (0); [1]:!HELP SET edt$help ("EDX_HELP","SET"); [2,18]:!SET COLUMNAR, RECTANGULAR if (edt$x_select_range <> 0) then edx_message("Select already active"); Return (0); endif; edt$reset; edtn$v_columnar_mode := 1; edx_message ("Columnar cut/paste mode set"); !RESET STATUS LINES ON VISIBLE WINDOWS If get_info(system,'display') then if (get_info(main_window,'visible')) then edtp$set_status_line(main_window) endif; if (get_info(top_window,'visible')) then edtp$set_status_line(top_window) endif; if (get_info(bottom_window,'visible')) then edtp$set_status_line(bottom_window) endif; Endif; [3]:!SET CURSOR command_status := edtn$set_cursor; [4]:!SET DATE command_status := edtn$set_date_format; [5]:!SET DEFAULT command_status := set_default(edt$x_line); [6]:!SET INDENT command_status := edtn$set_indent; [7]:!SET INSERT set (insert,current_buffer); edtn$update_visible_statln( current_buffer ); [8]:!SET KEYPAD command_status := edtn$set_keypad; [9]:!SET LEFT_MARGIN !Make compatible with previous version requiring LEFT MARGIN as two words. temp_value1:= edt$next_token(edtn$x_token_delimiters,term_char); if (index('MARGIN',temp_value1) = 1) then temp_value1:= edt$next_token(edtn$x_token_delimiters,term_char); endif; eve_set_left_margin(temp_value1); [10]:!SET LOCK edtn$set_lock("LOCK"); [11]:!MARKERS ! Get the {marker-name} temp_value1 := edt$next_token(edtn$x_token_delimiters,term_char); set_mark(temp_value1); [12,14]:! SET NOCOLUMNAR, NORECTANGULAR edt$reset; edtn$v_columnar_mode := 0; edx_message ("Normal cut/paste mode set"); !RESET STATUS LINES ON VISIBLE WINDOWS If get_info(system,'display') then if (get_info(main_window,'visible')) then edtp$set_status_line(main_window) endif; if (get_info(top_window,'visible')) then edtp$set_status_line(top_window) endif; if (get_info(bottom_window,'visible')) then edtp$set_status_line(bottom_window) endif; Endif; [13]:!SET NOLOCK edtn$set_lock("UNLOCK"); [15]:!SET NOWRAP edt$x_wrap_position := 0; [16]:!SET OVERSTRIKE set(overstrike,current_buffer); edtn$update_visible_statln( current_buffer ); [17]:!SET PROMPT VIDEO parse$set_prompt; [19]:!SET SCREEN {width} !SET SCREEN_UPDATE {ON|OFF} IF (NOT get_info(system,'display')) then edx_message("Can not set screen in /NODISPLAY mode"); return(0); ENDIF; temp_value1 := edt$next_token(edtn$x_token_delimiters,term_char); if (temp_value1 = "") then temp_value1 := edx_read_line("SET SCREEN [ON|OFF|width]: ",,"CTRL-Z"); edit(temp_value1,trim,upper,OFF); if (temp_value1 = "") then if (last_key <> ctrl_z_key) then edx_message('Missing width parameter for SET SCREEN'); endif; return (0); endif; endif; change_case( temp_value1, UPPER ); IF ( temp_value1 = "ON" ) then set(screen_update,on) ELSE If ( temp_value1 = "OFF" ) then set(screen_update,off) Else temp_value1 := int(temp_value1); if (temp_value1 = 0) then edx_message ("Illegal value for SET SCREEN"); return (0); else if get_info(current_window,'width') <= 80 then edtn$v_wide_window_width := get_info(current_window,'width') endif; set(width,main_window,temp_value1); set(width,message_window,temp_value1); set(width,top_window,temp_value1); set(width,bottom_window,temp_value1); set(width,ruler_window,temp_value1); set(width,info_window,temp_value1); update(message_window); endif; Endif; ENDIF; [20]:!SET SEARCH set_type := edt$next_token(edtn$x_token_delimiters,term_char); if (set_type = "") then if get_info(system,'display') then set_type := edx_read_line("SET SEARCH type: ",,"CTRL-Z"); edit(set_type,trim,upper,OFF); endif; !else edt$x_line already := ""; if (set_type = "") then if (last_key <> ctrl_z_key) then edx_message('Missing parameter to SET SEARCH'); endif; return (0); endif; endif; set_index := index(edt$x_searches,' '+set_type); set_index := ((set_index + edt$x_searches_length - 1) / edt$x_searches_length); CASE set_index FROM 0 to 14 [0]: edx_message('Unsupported SET option: ' + set_type); return (0); [1]:!HELP SET SEARCH edt$help ("EDX_HELP","SEARCH"); [2,8]:!SET SEARCH GENERAL jen$x_default_search_case := no_exact; jen$x_search_case := no_exact; [3]:!SET SEARCH EXACT jen$x_default_search_case := exact; jen$x_search_case := exact; [4]:!SET SEARCH BEGIN edt$x_search_begin := 1; [5]:!SET SEARCH END edt$x_search_begin := 0; [6]:!SET SEARCH WILD edtn$v_search_wild := 1; [7]:!SET SEARCH NOWILD edtn$v_search_wild := 0; [9,10,11]:!SET SEARCH {BELL|BEEP|NOQUIET} jen$v_search_quietly := 0; [12,13,14]:!SET SEARCH {NOBELL|NOBEEP|QUIET} jen$v_search_quietly := 1; ENDCASE; [21]:!SET SHIFT_AMOUNT temp_value1 := edt$next_token(edtn$x_token_delimiters,term_char); If (temp_value1 = "") then if get_info(system,'display') then temp_value1 := edx_read_line("SET SHIFT_AMOUNT to: ",,"CTRL-Z"); edit(temp_value1,trim,upper,OFF); endif; if (temp_value1 = "") then if (last_key <> ctrl_z_key) then edx_message('Missing parameter to SET SHIFT'); endif; return (0); endif; Endif; temp_value1 := int(temp_value1); If (temp_value1 = 0) then edx_message("Illegal value for shift amount"); return (0); Endif; edtn$v_shift_amount := temp_value1; [22]:!SET SYMBOL ! Get the original line back because the case might be important new_line_length := LENGTH (edt$x_line); edt$x_line := substr( original_line, (org_line_length - new_line_length) + 1, new_line_length); ! Get the {symbol-name} temp_value1 := edt$next_token(edtn$x_token_delimiters,term_char); ! Check for ':==' or ':=' tblind := 0; IF term_char = ":" then If substr(edt$x_line,1,2) = "==" then tblind := 2; Else if substr(edt$x_line,1,1) = "=" then tblind := 1; endif; Endif; ENDIF; If tblind = 0 then !Then didn't find ':==' or ':=' edx_message("Format: SET SYMBOL {symbol-name} :=[=] {expression}"); return (0); Endif; !The rest of edt$x_line is the {expression} edt$x_line := substr(edt$x_line,tblind+1,length(edt$x_line)); edit (edt$x_line,trim,compress,upper,on); !Now remove any quotation marks (this is rather kludgy). expression := ""; LOOP temp_value2 := edt$next_token(edt$x_space,term_char); if temp_value2 = "" then exitif; endif; expression := expression + temp_value2 + edt$x_space; ENDLOOP; edit (expression,trim_trailing,off); set_symbol(temp_value1,expression,tblind); [23]:!SET TABS temp_value1 := edt$next_token(edtn$x_token_delimiters+',',term_char); If (temp_value1 = "") then if get_info(system,'display') then temp_value1 := edx_read_line("SET TAB at: ",,"CTRL-Z"); endif; if (temp_value1 = "") then if (last_key <> ctrl_z_key) then edx_message('Missing parameter to SET TABS'); endif; return (0); endif; Endif; IF (index("EVERY",temp_value1) = 1) then temp_value1 := edt$next_token(edtn$x_token_delimiters+',',term_char); if (temp_value1 = "") then temp_value1 := edx_read_line("SET TABS EVERY: "); edit(temp_value1,trim,upper,OFF); if (temp_value1 = "") then if (last_key <> ctrl_z_key) then edx_message('Missing parameter for SET TABS EVERY'); endif; return (0); endif; endif; temp_value1 := int(temp_value1); If (temp_value1 > 132) OR (temp_value1 < 1) then edx_message("Numeric value illegal") Else here := mark(free_cursor); position(beginning_of(ruler_buffer)); copy_text(edtn$x_ruler_line); !start with new ruler position(beginning_of(ruler_buffer)); !go back to beginning LOOP copy_text('T'); !(set first tab in column 1. Helps with usage.) move_horizontal(temp_value1-1); exitif ( current_offset >= (132-temp_value1) ); ENDLOOP; position(here); Endif; ELSE LOOP If temp_value1 = "#" then temp_value1 := get_info(current_buffer,'offset_column'); Else edit(temp_value1,trim,upper,OFF); temp_value1 := int(temp_value1); Endif; If (temp_value1 > 132) OR (temp_value1 < 1) then edx_message("Numeric value illegal") Else here := mark(free_cursor); position(beginning_of(ruler_buffer)); move_horizontal(temp_value1-1); copy_text('T'); position(here); Endif; temp_value1 := edt$next_token(edtn$x_token_delimiters+',',term_char); exitif (temp_value1 = "") ENDLOOP; ENDIF; [24]:!SET TAB_KEY command_status := edtn$set_tab_key; [25]:!SET WRAP temp_value1 := edt$next_token(edtn$x_token_delimiters,term_char); If (temp_value1 = "") then if get_info(system,'display') then temp_value1 := edx_read_line("SET WRAP to: ",,"CTRL-Z"); edit(temp_value1,trim,upper,OFF); endif; if (temp_value1 = "") then if (last_key <> ctrl_z_key) then edx_message('Missing parameter to SET WRAP'); endif; return (0); endif; Endif; IF (temp_value1 = "#") then edt$x_wrap_position := get_info(current_buffer,'offset_column'); ELSE temp_value1 := int(temp_value1); If (temp_value1 > 960) OR ( temp_value1< 0 ) then !Maximum line length is 960. Room for one edx_message("Numeric value illegal"); !extra character required for enter_text return (0); Else edt$x_wrap_position := temp_value1; Endif; ENDIF; ENDCASE; return (1); ENDPROCEDURE !------------------------------------------------------------------------------ PROCEDURE EDTN$SET_CURSOR ! Line mode command SET CURSOR !Set cursor to BOUND, FREE, or values n:n for screen boundaries. ! LOCAL state_table, tablen, state_index, P1_token, term_char, top, bottom; IF (NOT get_info(system,'display')) then edx_message("Cursor can only be bound in /NODISPLAY mode"); return(0); ENDIF; !INITIALIZE STATE TABLE state_table := ' ? ' + ! 1 ' BOUND ' + ! 2 ' NOFREE ' + ! 3 ' FREE ' + ! 4 ' UNBOUND' ; ! 5 tablen := 8; P1_token := TPU$K_UNSPECIFIED; IF parse$next_state( state_index, state_table, tablen, "SET CURSOR what: ", "You must provide an option to SET CURSOR", P1_token ) THEN CASE state_index FROM 0 TO 5 [0]: top := int(P1_token); bottom := edt$next_token(edtn$x_token_delimiters,term_char); if (bottom = "") then edx_message('Illegal parameter for SET CURSOR'); return (0); endif; bottom := int(bottom); bottom := get_info(main_window,'visible_length') - bottom; set(scrolling,main_window,ON,top,bottom,0); [1]:!HELP SET CURSOR edt$help ("EDX_HELP","SET CURSOR"); [2,3]:!SET CURSOR BOUND edtn$v_free_cursor := 0; [4,5]:!SET CURSOR FREE edtn$v_free_cursor := 1; ENDCASE; ENDIF; ENDPROCEDURE !------------------------------------------------------------------------------ PROCEDURE SET_DEFAULT(DEF_PARAM) ! Def_param - Sring containing new default directory specification LOCAL def, result, code; code := 65543; !Set default x00010007 def := def_param; edit(def,trim,upper,OFF); if (def = "") then if get_info(system,'display') then def := edx_read_line("DEFAULT: ",,"CTRL-Z"); edit(def,trim,upper,OFF); endif; if (def = "") then return 0; endif; endif; result := call_user(code,def); ENDPROCEDURE; !------------------------------------------------------------------------------ PROCEDURE EDTN$SET_INDENT ! Line mode command SET IDENT ! LOCAL state_table, tablen, state_index; !INITIALIZE STATE TABLE state_table := ' ? ' + ! 1 ' AUTOMATIC' + ! 2 !really AUTO ' MANUAL ' ; ! 3 tablen := 10; IF parse$next_state( state_index, state_table, tablen, "SET INDENT to (AUTO or MANUAL): ", "You must provide an option to SET IDENT", "Unsupported SET INDENT option: !AS" ) THEN CASE state_index FROM 1 TO 3 [1]:!HELP SET INDENT edt$help ("EDX_HELP","SET INDENT"); [2]:!SET INDENT AUTO edtn$v_autoindent := TRUE; [3]:!SET INDENT MANUAL edtn$v_autoindent := FALSE; ENDCASE; ENDIF; ENDPROCEDURE !------------------------------------------------------------------------------ PROCEDURE EDTN$SET_KEYPAD LOCAL state_table, tablen, state_index; !SUPPRESS NOKEYMAP WARNING MESSAGES On_error Endon_error; !INITIALIZE STATE TABLE state_table := ' ? ' + ! 1 ' EDT ' + ! 2 ' WPS ' + ! 3 ' DD1 ' + ! 4 ' NUMERIC' ; ! 5 tablen := 8; IF parse$next_state( state_index, state_table, tablen, "SET KEYPAD to: ", "You must provide an option for SET KEYPAD", "Unsupported SET KEYPAD option: !AS" ) THEN CASE state_index FROM 1 TO 5 [1]:!HELP SET KEYPAD edt$help ("EDX_HELP","SET KEYPAD"); !DD1 is unfinished so we'll just set EDT [2,3,4]:!SET KEYPAD EDT, WPS, DD1 !Clean out mode specific key maps from all the key map lists. remove_key_map("tpu$key_map_list", "edtn$km_EDT_editing_keys" ,all); remove_key_map("tpu$key_map_list", "edtn$km_WPS_editing_keys" ,all); !!remove_key_map("tpu$key_map_list", "edtn$km_DD1_editing_keys" ,all); remove_key_map("tpu$key_map_list", "edtn$km_numeric_keypad" ,all); remove_key_map("pmt$kml_pmtbuf", "edtn$km_EDT_editing_keys" ,all); remove_key_map("pmt$kml_pmtbuf", "edtn$km_WPS_editing_keys" ,all); !!remove_key_map("pmt$kml_pmtbuf", "edtn$km_DD1_editing_keys" ,all); remove_key_map("edtn$kml_dirbuf", "edtn$km_EDT_editing_keys" ,all); remove_key_map("edtn$kml_dirbuf", "edtn$km_WPS_editing_keys" ,all); !!remove_key_map("edtn$kml_dirbuf", "edtn$km_DD1_editing_keys" ,all); remove_key_map("edtn$kml_dirbuf", "edtn$km_dirbuf_EDT" ,all); remove_key_map("edtn$kml_dirbuf", "edtn$km_dirbuf_WPS" ,all); remove_key_map("edtn$kml_dirbuf", "edtn$km_dirbuf_DD1" ,all); remove_key_map("edtn$kml_dirbuf", "tpu$key_map" ,all); !position dependent remove_key_map("spl$kml_dicbuf", "edtn$km_EDT_editing_keys" ,all); remove_key_map("spl$kml_dicbuf", "edtn$km_WPS_editing_keys" ,all); !!remove_key_map("spl$kml_dicbuf", "edtn$km_DD1_editing_keys" ,all); remove_key_map("spl$kml_dicbuf", "spl$km_dicbuf_EDT" ,all); remove_key_map("spl$kml_dicbuf", "spl$km_dicbuf_WPS" ,all); !!remove_key_map("spl$kml_dicbuf", "spl$km_dicbuf_DD1" ,all); remove_key_map("spl$kml_dicbuf", "tpu$key_map" ,all); !position dependent remove_key_map("edtn$kml_search", "edtn$km_EDT_editing_keys" ,all); remove_key_map("edtn$kml_search", "edtn$km_WPS_editing_keys" ,all); !!remove_key_map("edtn$kml_search", "edtn$km_DD1_editing_keys" ,all); remove_key_map("edtn$kml_search", "edtn$km_search_EDT" ,all); remove_key_map("edtn$kml_search", "edtn$km_search_WPS" ,all); !!remove_key_map("edtn$kml_search", "edtn$km_search_DD1" ,all); remove_key_map("edtn$kml_search", "tpu$key_map" ,all); !position dependent CASE state_index from 2 to 4 [2,4]:!SET KEYPAD EDT edtn$x_keypad_mode := "EDT"; add_key_map("tpu$key_map_list", "last", "edtn$km_EDT_editing_keys"); !Set keypad to EDT for user buffers add_key_map("pmt$kml_pmtbuf", "last", "edtn$km_EDT_editing_keys"); !Define keys for prompt_buffer in case user ever gets stuck there add_key_map( "edtn$kml_dirbuf", "last", "edtn$km_dirbuf_EDT"); !EDT mode keys for DIR buffer add_key_map( "edtn$kml_dirbuf", "last", "tpu$key_map"); !any user defined keys add_key_map( "edtn$kml_dirbuf", "last", "edtn$km_EDT_editing_keys"); !any EDT mode keys left over add_key_map( "spl$kml_dicbuf", "last", "spl$km_dicbuf_EDT"); !EDT mode keys for DIC buffer add_key_map( "spl$kml_dicbuf", "last", "tpu$key_map"); !any user defined keys add_key_map( "spl$kml_dicbuf", "last", "edtn$km_EDT_editing_keys"); !any EDT mode keys left over add_key_map( "edtn$kml_search", "last", "edtn$km_search_EDT"); !EDT mode keys for SEARCH buffer add_key_map( "edtn$kml_search", "last", "tpu$key_map"); !any user defined keys add_key_map( "edtn$kml_search", "last", "edtn$km_EDT_editing_keys"); !any EDT mode keys left over [3]:!SET KEYPAD WPS edtn$x_keypad_mode := "WPS"; add_key_map("tpu$key_map_list", "last", "edtn$km_WPS_editing_keys"); !Set keypad to WPS for user buffers add_key_map("pmt$kml_pmtbuf", "last", "edtn$km_EDT_editing_keys"); !Define keys for prompt_buffer in case user ever gets stuck there add_key_map( "edtn$kml_dirbuf", "last", "edtn$km_dirbuf_WPS"); !WPS mode keys for DIR buffer add_key_map( "edtn$kml_dirbuf", "last", "tpu$key_map"); !any user defined keys add_key_map( "edtn$kml_dirbuf", "last", "edtn$km_WPS_editing_keys"); !any EDT mode keys left over add_key_map( "spl$kml_dicbuf", "last", "spl$km_dicbuf_WPS"); !WPS mode keys for DIC buffer add_key_map( "spl$kml_dicbuf", "last", "tpu$key_map"); !any user defined keys add_key_map( "spl$kml_dicbuf", "last", "edtn$km_WPS_editing_keys"); !any WPS mode keys left over add_key_map( "edtn$kml_search", "last", "edtn$km_search_WPS"); !WPS mode keys for SEARCH buffer add_key_map( "edtn$kml_search", "last", "tpu$key_map"); !any user defined keys add_key_map( "edtn$kml_search", "last", "edtn$km_WPS_editing_keys"); !any WPS mode keys left over !![4]:!SET KEYPAD DD1 !! edtn$x_keypad_mode := "DD1"; !! add_key_map("tpu$key_map_list", "last", "edtn$km_DD1_editing_keys"); !Set keypad to EDT for user buffers !! add_key_map("pmt$kml_pmtbuf", "last", "edtn$km_DD1_editing_keys"); !Define keys for prompt_buffer in case user ever gets stuck there !! !! add_key_map( "edtn$kml_dirbuf", "last", "edtn$km_dirbuf_DD1"); !EDT mode keys for DIR buffer !! add_key_map( "edtn$kml_dirbuf", "last", "tpu$key_map"); !any user defined keys !! add_key_map( "edtn$kml_dirbuf", "last", "edtn$km_DD1_editing_keys"); !any EDT mode keys left over !! !! add_key_map( "spl$kml_dicbuf", "last", "spl$km_dicbuf_DD1"); !EDT mode keys for DIC buffer !! add_key_map( "spl$kml_dicbuf", "last", "tpu$key_map"); !any user defined keys !! add_key_map( "spl$kml_dicbuf", "last", "edtn$km_DD1_editing_keys"); !any EDT mode keys left over !! !! add_key_map( "edtn$kml_search", "last", "edtn$km_search_DD1"); !EDT mode keys for SEARCH buffer !! add_key_map( "edtn$kml_search", "last", "tpu$key_map"); !any user defined keys !! add_key_map( "edtn$kml_search", "last", "edtn$km_DD1_editing_keys"); !any EDT mode keys left over ENDCASE; [5]:!SET KEYPAD NUMERIC add_key_map("tpu$key_map_list", "first", "edtn$km_numeric_keypad"); ENDCASE; ENDIF; ENDPROCEDURE !------------------------------------------------------------------------------ PROCEDURE EDTN$SET_LOCK(LOCK_TYPE) !Line mode command SET LOCK and SET NOLOCK ! SET LOCK locks all buffers with filenames and switches autolocking ON ! SET NOLOCK unlocks all buffers with filenames and switches autolocking OFF LOCAL buf, filename; !Switch autolocking ON or OFF If (lock_type = "LOCK") then edtn$v_lock := TRUE; Else edtn$v_lock := FALSE; Endif; buf := get_info(buffers,'first'); loop exitif buf = 0; If (NOT get_info(buf,'system')) then if ( get_info(buf,'name') <> "$LOCAL$INI$" ) !don't lock user's initialization file. then filename := edtn$filename_of_buffer(buf); IF (filename <> "") then do_command(LOCK_TYPE + " FILE " + filename); ENDIF; endif; Endif; buf := get_info(buffers,'next'); endloop; ENDPROCEDURE !------------------------------------------------------------------------------ PROCEDURE EDTN$SET_LOGICAL LOCAL token, term_char, edtline, result; edtline := edt$x_line; token := edt$next_token(edt$x_space,term_char); !Log name if (token = "") then if get_info(system,'display') then edt$x_line := edx_read_line("Log name: ",,"CTRL-Z"); edit(edt$x_line,trim,upper); endif; if (edt$x_line = "") then return 0; endif; edtline := edt$x_line; token := edt$next_token(edt$x_space,term_char); !Log name endif; token := edt$next_token(edt$x_space,term_char); !Equ name if (token = "") then edt$x_line := edx_read_line("Equ name: "); edit(edt$x_line,trim,upper); if (edt$x_line = "") then return 0; endif; edtline := edtline + edt$x_space + edt$x_line; endif; result := call_user(65544,edtline); !'00010008'x Define logical ENDPROCEDURE; !------------------------------------------------------------------------------ PROCEDURE PARSE$SET_PROMPT ! Line mode command SET PROMPT ! Currently only SET PROMPT VIDEO is supported ! LOCAL state_table, tablen, state_index; !INITIALIZE STATE TABLE state_table := ' ? ' + ! 1 ' VIDEO' ; ! 2 tablen := 8; IF parse$next_state( state_index, state_table, tablen, "SET PROMPT what: ", "Only SET PROMPT VIDEO currently supported.", "Only SET PROMPT VIDEO currently supported." ) THEN CASE state_index FROM 1 TO 2 [1]:!HELP SET PROMPT edt$help ("EDX_HELP","SET PROMPT"); [2]:!SET PROMPT VIDEO edtn$set_prompt_video; ENDCASE; ENDIF; ENDPROCEDURE !------------------------------------------------------------------------------ PROCEDURE EDTN$SET_PROMPT_VIDEO ! Line mode command SET PROMPT VIDEO ! SET PROMPT VIDEO to {NONE | BOLD | BLINK | REVERSE | UNDERLINE } ! LOCAL state_table, tablen, state_index; !INITIALIZE STATE TABLE state_table := ' ? ' + ! 1 ' NONE ' + ! 2 ' BOLD ' + ! 3 ' BLINK ' + ! 4 ' REVERSE ' + ! 5 ' UNDERLINE' ; ! 6 tablen := 10; IF parse$next_state( state_index, state_table, tablen, "SET PROMPT VIDEO to {NONE | BOLD | BLINK | REVERSE | UNDERLINE } : ", "Prompt video not changed", "Unsupported SET PROMPT VIDEO option" ) THEN CASE state_index FROM 1 TO 6 [1]:!HELP SET PROMPT VIDEO edt$help ("EDX_HELP","SET PROMPT VIDEO"); [2]:!SET PROMPT VIDEO NONE edtn$k_prompt_video := NONE; [3]:!SET PROMPT VIDEO BOLD edtn$k_prompt_video := BOLD; [4]:!SET PROMPT VIDEO BLINK edtn$k_prompt_video := BLINK; [5]:!SET PROMPT VIDEO REVERSE edtn$k_prompt_video := REVERSE; [6]:!SET PROMPT VIDEO UNDERLINE edtn$k_prompt_video := UNDERLINE; ENDCASE; set(prompt_area,(screen_length - 1),1,edtn$k_prompt_video); set(video,prompt_window,edtn$k_prompt_video); ENDIF; ENDPROCEDURE !------------------------------------------------------------------------------ PROCEDURE SET_SYMBOL( SYMBOL_NAME, EXPRESSION, TBLIND) ! We separate symbol_name, expression, & tblind with ascii(0) characters ! (which we hope no one would normally use.) LOCAL result, code; code := 65547; !Set symbol x00010006 result := call_user(code, symbol_name + ascii(0) + expression + ascii(0) + str(tblind) ); ENDPROCEDURE; !------------------------------------------------------------------------------ PROCEDURE EDTN$SET_TAB_KEY ! Line mode command SET TAB_KEY ! LOCAL state_table, tablen, state_index; !INITIALIZE STATE TABLE state_table := ' ? ' + ! 1 ' SPACES' + ! 2 ' TABS ' ; ! 3 tablen := 7; IF parse$next_state( state_index, state_table, tablen, "SET TAB_KEY to (TABS or SPACES): ", "You must provide an option to SET TAB_KEY", "Unsupported SET TAB_KEY option: !AS" ) THEN CASE state_index FROM 1 TO 3 [1]:!HELP SET TAB_KEY edt$help ("EDX_HELP","SET TAB_KEY"); [2]:!SET TAB_KEY SPACES edtn$v_tab_key_tabs := FALSE; [3]:!SET TAB_KEY TABS edtn$v_tab_key_tabs := TRUE; ENDCASE; ENDIF; ENDPROCEDURE !------------------------------------------------------------------------------ !+ ! EDT line mode Show command !- PROCEDURE EDT$SHOW ! support routine for line mode(show cmd) LOCAL show_type, buf, cur_buf, pos, term_char, save_info_status, show_index, filename, result, identx, temp_value1; !+ ! What do they want to know !- show_type := edt$next_token(edtn$x_token_delimiters,term_char); if (show_type = "") then if get_info(system,'display') then edt$x_line := edx_read_line("SHOW what: ",,"CTRL-Z"); edit(edt$x_line,trim,upper,OFF); endif; if (edt$x_line = "") then if (last_key <> ctrl_z_key) then edx_message('You must provide an option to SHOW'); endif; return 0; else return edt$show; !Recursively call ourselves endif; endif; show_index := index(edt$x_shows,(edt$x_space + show_type)); show_index := ((show_index + edt$x_show_length - 1) / edt$x_show_length); CASE show_index FROM 0 TO 18 [0]: edx_message('Unsupported SHOW option: ' + show_type); return (0); [1]:!HELP SHOW edt$help ("EDX_HELP","SHOW"); [2]:!SHOW ASCII edtn$show_ascii_table; edtn$x_goto_screen_mode := 1; !Return to screen mode [3]:!SHOW BUFFERS edtn$show_buffers; edtn$x_goto_screen_mode := 1; !Return to screen mode [4]:!SHOW CALENDAR temp_value1 := edt$next_token(edtn$x_token_delimiters,term_char); if temp_value1 <> "" then temp_value1 := INT(temp_value1) endif; edtn$show_calendar(temp_value1); [5]:!SHOW CURSOR If (NOT get_info(system,'display')) then edx_message("Can not show cursor in /NODISPLAY mode"); return(0); Endif; buf := 'Cursor boundaries on main window are '; buf := buf + str((get_info(current_window,'scroll_top') + get_info(current_window,'original_top'))); buf := buf + ':'; buf := buf + str((get_info(current_window,'original_bottom') - get_info(current_window,'scroll_bottom'))); edx_message(buf); if (edtn$v_free_cursor) then edx_message("Cursor is FREE") else edx_message("Cursor is BOUND") endif; [6]:!SHOW DATE edx_message(current_date); [7]:!SHOW DEFAULT filename := file_parse(""); edx_message(substr(filename,1,length(filename)-2)); !erase '.;' at end [8]:!SHOW INDENT If (edtn$v_autoindent) then edx_message("INDENTATION set to AUTOMATIC"); Else edx_message("INDENTATION set to MANUAL"); Endif; [9]:!SHOW LEFT_MARGIN edx_message("Left margin is set to !UL", EDX$K_INFO, edtn$v_left_margin); [10]:!SHOW LOGICAL edtn$show_logical(edt$x_line); [11]:!SHOW MARKERS edtn$show_markers; edtn$x_goto_screen_mode := 1; !Return to screen mode [12]:!SHOW SCREEN If get_info(system,'display') then edx_message("Screen Width is " + str(get_info(current_window,'width'))); else edx_message("Can not show screen width in /NODISPLAY mode"); endif; [13]:!SHOW SEARCH buf := 'Search settings: '; if (edt$x_search_begin) then buf := buf + 'BEGIN ' else buf := buf + 'END ' endif; if (jen$x_default_search_case = exact) then buf := buf + 'EXACT ' else buf := buf + 'GENERAL ' endif; if (edtn$v_search_wild) then buf := buf + 'WILD ' else buf := buf + 'NOWILD ' endif; if (jen$v_search_quietly) then buf := buf + 'QUIET ' else buf := buf + 'BEEP ' endif; edx_message(buf); [14]:!SHOW SHIFT_AMOUNT edx_message("Shift amount set to !UL", EDX$K_INFO, edtn$v_shift_amount); [15]:!SHOW SYMBOL edtn$show_symbol(edt$x_line); [16]:!SHOW TIME edx_message( edtn$time("") ); [17]:!SHOW VERSION result := call_user(65545,""); !'00010009'x Show version identx := substr(result,10,length(result)); edx_message(edt$x_version + ", external ident I" + identx + " - " + "VAXTPU version V" + str(get_info(system,'version')) + "." + str(get_info(system,'update'))); edx_message(vs$min_version); [18]:!SHOW WRAP if (edt$x_wrap_position = 0) then edx_message ('Nowrap'); else edx_message('Wrap setting: ' + str (edt$x_wrap_position)); endif; ENDCASE; return (1); ENDPROCEDURE !------------------------------------------------------------------------------ PROCEDURE EDTN$SHOW_LOGICAL(LOGICAL_NAME) LOCAL lognam, result, retcode, outline; lognam := logical_name; edit(lognam,trim,upper); If (lognam = "") then if get_info(system,'display') then lognam := edx_read_line("LOGICAL: ",,"CTRL-Z"); edit(lognam,trim,upper); endif; if (lognam = "") then return 0; endif; Endif; result := call_user(65539,lognam); !'00010003'x Show logical retcode := int(substr(result,1,9)); outline := substr(result,10,length(result)); if (retcode = 1) then edx_message('!AS = "!AS"',EDX$K_INFO, lognam, outline); endif; ENDPROCEDURE; PROCEDURE EDTN$SHOW_SYMBOL(SYMBOL_NAME) LOCAL symnam, result, retcode, outline, eq; symnam := symbol_name; edit(symnam,trim,upper); If (symnam = "") then if get_info(system,'display') then symnam := edx_read_line("SYMBOL: ",,"CTRL-Z"); edit(symnam,trim,upper); endif; if (symnam = "") then return 0; endif; Endif; result := call_user(65540,symnam); !'00010004'x Show symbol retcode := int(substr(result,1,9)); outline := substr(result,10,length(result)); if (retcode = 1) then eq := ' = ' endif; !Local symbol if (retcode = 2) then eq := ' == ' endif; !Global symbol if ((retcode = 1) or (retcode = 2)) then edx_message('"!AS"!AS"!AS"',EDX$K_INFO, symnam, eq, outline); endif; ENDPROCEDURE; !------------------------------------------------------------------------------ PROCEDURE PARSE$TRANSLATE LOCAL state_table, tablen, state_index; !INITIALIZE STATE TABLE state_table := ' ? ' + ! 1 ' EBCDIC' + ! 2 ' ASCII ' ; ! 3 tablen := 7; IF parse$next_state( state_index, state_table, tablen, "TRANSLATE from what? (EBCDIC or ASCII): ", "You must provide an option to TRANSLATE", "Unsupported TRANSLATE option: !AS" ) THEN CASE state_index FROM 1 TO 5 [1]:!HELP TRANSLATE edt$help ("EDX_HELP","TRANSLATE"); [2]:!TRANSLATE EBCDIC TO ASCII edtn$translate_buffer(262145); !x00040001=translate from EBCDIC to ASCII [3]:!TRANSLATE ASCII TO EBCDIC edtn$translate_buffer(262146); !x00040002=translate from ASCII to EBCDIC ENDCASE; ENDIF; ENDPROCEDURE !------------------------------------------------------------------------------ PROCEDURE PARSE$TRIM ! Line mode command TRIM LOCAL state_table, tablen, state_index; !INITIALIZE STATE TABLE state_table := ' ? ' + ! 1 ' BUFFER' ; ! 2 tablen := 7; IF parse$next_state( state_index, state_table, tablen, "TRIM what: ", "You must provide an option to TRIM", "Unsupported TRIM option: !AS" ) THEN CASE state_index FROM 1 TO 2 [1]:!HELP TRIM edt$help ("EDX_HELP","TRIM"); [2]:!TRIM BUFFER eve$trim_buffer; edtn$x_goto_screen_mode := 1; ENDCASE; ENDIF; ENDPROCEDURE !------------------------------------------------------------------------------ !****************************************************************************** ! HELP PROCEDURES !****************************************************************************** !+ ! TPU help !- PROCEDURE EDT$HELP (HLIB,TOPIC_PARAM) ! TPU BUGFIX1 (VMS 5.3,4,5). If user enters CTRL-Z at the "Press RETURN to ! continue..." prompt, the internal buffer position marker (BPM) for the ! help_buffer is left in an inconsistant state. The current record ID ! points to the record at the bottom of the screen, but the current record ! NUMBER points to the end of the buffer. This can lead to a fatal ! internal VAXTPU error. We avoid this here by first adding to the ! current record a unique string, then use absolute positioning to ! position ourselves at the the beginning of the help buffer so the ! internal BPM is consistent again, then search for our unique string, ! position ourselves at the unique string (back where we started), and ! delete the unique string. ! ! TPU BUGFIX2 (VMS 5.4,5) (EDX 8.1 fix) ! Help displays by starting with the second screenfull of help text skipping ! the first screenfull. This is fixed by setting the scrolling top to the ! bottom of the screen. LOCAL unique_string, saved_scroll_top, saved_scroll_bottom, saved_scroll_amount, onoff, visible_length; if (NOT get_info(system,'display')) then edx_message("Can not get help in /NODISPLAY mode"); endif; if get_info(help_buffer,'type') = UNSPECIFIED then ! Get the help buffer help_buffer := create_buffer("HELP"); set(eob_text,help_buffer,""); !! set ( max_lines, help_buffer, 500); !No longer limited. set(no_write,help_buffer); set(system,help_buffer); endif; !SETUP THE HELP WINDOW set(status_line,info_window,none,""); map(info_window,help_buffer); !NOW FOR BUGFIX2 save_scroll_top := get_info(info_window,"scroll_top"); save_scroll_bottom := get_info(info_window,"scroll_bottom"); save_scroll_amount := get_info(info_window,"scroll_amount"); If get_info(info_window,"scroll") then onoff := ON; !keyword ON Else onoff := OFF; !keyword OFF Endif; visible_length := get_info(info_window,"visible_length"); set(scrolling,info_window,onoff,visible_length-1,0,0); !NOW GET THE HELP if (topic_param = "") then help_text( hlib, edx_read_line('Topic: '), on, help_buffer); else help_text( hlib, topic_param, on, help_buffer); endif; !BUGFIX2 - Reset the Scrolling Regions set(scrolling, info_window, onoff, saved_scroll_top, saved_scroll_bottom, saved_scroll_amount); !NOW FOR BUGFIX1 unique_string := ascii(145) + ascii(146) + ascii(000) + ascii(146) + ascii(145); set(insert,help_buffer); !Just to make sure copy_text(unique_string); position(beginning_of(help_buffer)); !resync BPM position( search(unique_string,forward,EXACT) ); !go back to where we where erase_character(5); !erase our text unmap(info_window); edtn$set_info_window_statln; ENDPROCEDURE PROCEDURE EDT$KEYPAD_HELP ! Here for bakwards compatibility keypad_help; ENDPROCEDURE PROCEDURE KEYPAD_HELP LOCAL diagram_prompt, keypad_window, text_prompt, current_prompt, temp_string, timer_string, help_key, diagram_buffer, diagram_name, in_key, comment_string; if (NOT get_info(system,'display')) then edx_message("Can not get keypad help in /NODISPLAY mode"); endif; ! First check to see if the screen has at least a length of ! 22 or more - if not then this command doesn't ! make sense (may mess up the user's screen) if (get_info (screen, 'visible_length') < 22) then edx_message ('To use keypad help the screen must have length 22 or greater'); return; endif; !CREATE THE KEYPAD VIEWING WINDOW keypad_window := create_window(1,22,off); set(text,keypad_window,no_translate); edx_message("Press L, R, or K for next diagram. Press RETURN to resume editing."); !Enter Main Loop: LOOP !ASK WHICH KEY DIAGRAM TO VIEW in_key := edx_read_line ("(L)eft half kbd, (R)ight half kbd, or (K)eypad diagram? (L,R,K): ",1); If get_info( keypad_window, 'visible') then unmap (keypad_window) Endif; IF ((in_key = 'L') or (in_key = 'l')) then Diagram_name := "Left_keyboard" ELSE If ((in_key = 'R') or (in_key = 'r')) then Diagram_name := "Right_keyboard" Else if ((in_key = 'K') or (in_key = 'k')) then Diagram_name := "Keypad" else exitif endif Endif ENDIF; !Affix EDT or WPS or DD1 diagram_name := "DIAGRAMS " + edtn$x_keypad_mode + "_mode " + diagram_name; !CREATE THE KEY DIAGRAM BUFFER diagram_buffer := edt$find_buffer(diagram_name); IF (diagram_buffer = 0) then diagram_buffer := create_buffer(diagram_name); set(no_write,diagram_buffer); set(system,diagram_buffer); set(eob_text,diagram_buffer,""); erase (diagram_buffer); help_text("EDX_HELP",diagram_name,off,diagram_buffer); !CLEAN UP THE TEXT IN THE BUFFER position(beginning_of(diagram_buffer)); !also syncs editing position. Avoids fatal help error. erase_line; !Get rid of the topic lines erase_line; erase_line; erase_line; erase_line; erase_line; erase_line; loop !Now delete the 7 spaces at the beginning of each line exitif mark(none) = end_of(diagram_buffer); erase_character(7); move_vertical(1); endloop; ENDIF; position(beginning_of(diagram_buffer)); !MAP DIAGRAM BUFFER TO WINDOW !Turn off the timer temporarily timer_string := get_info (system, 'timed_message'); if timer_string <> 0 then SET (TIMER, OFF); endif; !!diagram_prompt := 'Press the key that you want help on or RETURN to leave help '; !!text_prompt := 'Press the key that you want help on, PF2 for diagram, or RETURN to leave help'; !!set (status_line, edt$w_keypad_window, reverse, diagram_prompt); !! diagram_prompt := !! "Press L, R, or K for next diagram. Press RETURN to resume editing."; !! set (status_line, keypad_window, none, diagram_prompt); set (status_line, keypad_window, none, ""); !Make status line invisible map(keypad_window,diagram_buffer); update(keypad_window); !!loop !! comment_string := lookup_key (help_key, COMMENT); !! EXITIF comment_string = "return"; !! if comment_string = "keypad_diagram" !! then !! edt$get_keypad_diagram; !! set (status_line, edt$w_keypad_window, reverse, diagram_prompt); !! current_prompt := diagram_prompt; !! else !! set (text, edt$w_keypad_window, blank_tabs); !! set (status_line, edt$w_keypad_window, reverse, text_prompt); !! current_prompt := text_prompt; !! if comment_string = "" !! then !! comment_string := "no" !! endif; !! help_text ('edx_help', comment_string, OFF, edt$x_keypad_buffer);!Needs work !! position (beginning_of (edt$x_keypad_buffer)); !! erase_line; !! erase_line; !! erase_line; !! erase_line; !! position (beginning_of (edt$x_keypad_buffer)); !! endif; !! update(edt$w_keypad_window); !! help_key := READ_KEY; !!endloop; ENDLOOP; ! Restore the timer and clear message window edtn$clear_message_window; if timer_string <> 0 then SET (TIMER, ON); endif; ENDPROCEDURE !------------------------------------------------------------------------------ !****************************************************************************** ! ASCII AND CHARACTER TRANSLATION PROCEDURES !****************************************************************************** PROCEDURE EDTN$SHOW_ASCII_TABLE LOCAL buffer_name, buffer_ptr, dec, hex, oct, sp3, title, N; If (NOT get_info(system,'display')) then !Check for /NODISPLAY mode edx_message("Can not display ascii table in /NODIPLAY mode"); return(0); endif; !INITIALIZE CONSTANTS sp3 := " "; ! (3 spaces) title := "The American Standard Code for Information Interchange"; !INITIALIZE ASCII BUFFER buffer_name := 'ASCII'; if get_info(current_buffer,'name') <> buffer_name then make_two_windows(buffer_name,0); !This will create buffer_name if it doesn't yet exist endif; ! It leaves us in new buffer buffer_ptr := edt$find_buffer(buffer_name); !Get buffer ptr of new buffer set ( system, buffer_ptr); !Mark buffer as system type set ( status_line, current_window, reverse, "" + sp3 + sp3 + title ); set ( output_file, buffer_ptr, "ASCII character set"); !For status line in case user goes to this buffer again update(top_window); !Get status line separating windows If current_window <> top_window then update(current_window); Endif; edx_message(""); edx_message("CTRL/D - Go to other window. GOLD-W - Toggle single/dual windows."); position(beginning_of(buffer_ptr)); !IF ASCII TABLE PREVIOUSLY WRITTEN THEN JUST GO TO IT If get_info(buffer_ptr,'record_count') <> 0 then return; endif; !PRINT THE ASCII TABLE copy_text(sp3 + sp3 + title + " (ASCII)"); split_line; split_line; copy_text(" DEC HEX OCT DESCRIPTION"); split_line; N := 0; !SHOW CHARACTERS LOOP DEC := FAO("!3UL",N); HEX := FAO("!3XL",N); OCT := FAO("!3OL",N); If (N = 32) then split_line; copy_text(" PRINTABLE CHARACTERS"); Endif; If (N = 128) then split_line; copy_text("DEC Multinational Character Set Extension of the ASCII character set"); Endif; If (N = 32) or (N = 128) then split_line; split_line; copy_text(" DEC HEX OCT DESCRIPTION"); split_line; Endif; If (N <> 9) and (N<>127) then copy_text(sp3+DEC+sp3+HEX+sp3+OCT+sp3+ascii(N)+sp3+edtn$translate_character(N)); Endif; If (N = 9) then copy_text(sp3+DEC+sp3+HEX+sp3+OCT+sp3+"TAB "+edtn$translate_character(N)); Endif; If (N = 127) then copy_text(sp3+DEC+sp3+HEX+sp3+OCT+sp3+edtn$translate_character(N)); Endif; split_line; N := N + 1; exitif N > 255; ENDLOOP; position(beginning_of(buffer_ptr)); ENDPROCEDURE !------------------------------------------------------------------------------ PROCEDURE EDTN$TRANSLATE_CHARACTER(i) !Given the ascii integer value of a character, return with a string describing that character !An attempt was made to make this procedure as compact as possible in terms !of memory used and in terms of section file blocks. It still adds 24 blocks !to the section file which may or may not be justified. ! LOCAL tran,uppercase,lowercase,number,ctrl,reserved,with,grave_accent, acute_accent,circumflex,tilde,umlaut,sign,sp2,sp3,sp4; !Initialize some common words Uppercase := "Uppercase "; Lowercase := "Lowercase "; Number := "Number "; Ctrl := "CTRL-"; Reserved := "[reserved]"; With := " with "; Grave_accent := "grave accent"; Acute_accent := "acute accent"; circumflex := "circumflex"; tilde := "tilde"; umlaut := "umlaut, (diaeresis)"; sign := " sign"; sp2 := " "; !Two spaces sp3 := " "; !Three spaces sp4 := " "; !Four spaces CASE I FROM 0 TO 255 [000]: tran := CTRL + "@" + sp3 + "NULL" + sp2 + "null"; [001]: tran := CTRL + "A" + sp3 + "SOH" + sp3 + "start of heading"; [002]: tran := CTRL + "B" + sp3 + "STX" + sp3 + "start of text"; [003]: tran := CTRL + "C" + sp3 + "ETX" + sp3 + "end of text"; [004]: tran := CTRL + "D" + sp3 + "EOT" + sp3 + "end of transmission"; [005]: tran := CTRL + "E" + sp3 + "ENQ" + sp3 + "enquiry"; [006]: tran := CTRL + "F" + sp3 + "ACK" + sp3 + "acknowledge"; [007]: tran := CTRL + "G" + sp3 + "BEL" + sp3 + "bell"; [008]: tran := CTRL + "H" + sp3 + "BS" + sp4 + "backspace"; [009]: tran := CTRL + "I" + sp3 + "HT" + sp4 + "horizontal tab"; [010]: tran := CTRL + "J" + sp3 + "LF" + sp4 + "line feed"; [011]: tran := CTRL + "K" + sp3 + "VT" + sp4 + "vertical tab"; [012]: tran := CTRL + "L" + sp3 + "FF" + sp4 + "form feed"; [013]: tran := CTRL + "M" + sp3 + "CR" + sp4 + "carriage return"; [014]: tran := CTRL + "N" + sp3 + "SO" + sp4 + "shift out"; [015]: tran := CTRL + "O" + sp3 + "SI" + sp4 + "shift in"; [016]: tran := CTRL + "P" + sp3 + "DLE" + sp3 + "data link escape"; [017]: tran := CTRL + "Q" + sp3 + "XON" + sp3 + "start output"; [018]: tran := CTRL + "R" + sp3 + "DC2"; [019]: tran := CTRL + "S" + sp3 + "XOFF" + sp2 + "stop output"; [020]: tran := CTRL + "T" + sp3 + "DC4"; [021]: tran := CTRL + "U" + sp3 + "NAK" + sp3 + "negative acknowledge"; [022]: tran := CTRL + "V" + sp3 + "SYN" + sp3 + "synchronous idle"; [023]: tran := CTRL + "W" + sp3 + "ETB" + sp3 + "end of transmission block"; [024]: tran := CTRL + "X" + sp3 + "CAN" + sp3 + "cancel"; [025]: tran := CTRL + "Y" + sp3 + "EM" + sp4 + "end of medium"; [026]: tran := CTRL + "Z" + sp3 + "SUB" + sp3 + "substitute"; [027]: tran := CTRL + "[" + sp3 + "ESC" + sp3 + "escape"; [028]: tran := CTRL + "\" + sp3 + "FS" + sp4 + "file separator"; [029]: tran := CTRL + "]" + sp3 + "GS" + sp4 + "group separator"; [030]: tran := CTRL + "^" + sp3 + "RS" + sp4 + "record separator"; [031]: tran := CTRL + "_" + sp3 + "US" + sp4 + "unit separator"; [032]: tran := "space"; [033]: tran := "exclamation point"; [034]: tran := "quotation mark (double quote)"; [035]: tran := "number" + sign; [036]: tran := "dollar" + sign; [037]: tran := "percent" + sign; [038]: tran := "ampersand"; [039]: tran := "apostrophe (single quote)"; [040]: tran := "opening parenthesis"; [041]: tran := "closing parenthesis"; [042]: tran := "asterisk"; [043]: tran := "plus" + sign; [044]: tran := "comma"; [045]: tran := "hyphen or Minus" + sign; [046]: tran := "period or Decimal point"; [047]: tran := "slash"; [048]: tran := number + "zero"; [049]: tran := number + "one"; [050]: tran := number + "two"; [051]: tran := number + "three"; [052]: tran := number + "four"; [053]: tran := number + "five"; [054]: tran := number + "six"; [055]: tran := number + "seven"; [056]: tran := number + "eight"; [057]: tran := number + "nine"; [058]: tran := "colon"; [059]: tran := "semicolon"; [060]: tran := "left angle bracket"; [061]: tran := "equal sign"; [062]: tran := "right angle bracket"; [063]: tran := "question mark"; [064]: tran := "at" + sign; [65,66,67,68,69,70,71,72,73,74,75,76,77, 78,79,80,81,82,83,84,85,86,87,88,89,90]: tran := uppercase + ascii(i); !Letters A-Z [091]: tran := "left bracket"; [092]: tran := "back slash"; [093]: tran := "right bracket"; [094]: tran := "caret"; [095]: tran := "underscore"; [096]: tran := grave_accent; [097,98,99,100,101,102,103,104,105,106,107,108,109, 110,111,112,113,114,115,116,117,118,119,120,121,122]: tran := lowercase + ascii(i); !Letters a-z [123]: tran := "left brace"; [124]: tran := "stile"; [125]: tran := "right brace"; [126]: tran := tilde; [127]: tran := "DEL" + sp3 + "delete, rubout"; [132]: tran := "IND" + sp3 + "index"; [133]: tran := "NEL" + sp3 + "next line"; [134]: tran := "SSA" + sp3 + "start of selected area"; [135]: tran := "ESA" + sp3 + "end of selected area"; [136]: tran := "HTS" + sp3 + "horizontal tab set"; [137]: tran := "HTJ" + sp3 + "horizontal tab set with justification"; [138]: tran := "VTS" + sp3 + "vertical tab set"; [139]: tran := "PLD" + sp3 + "partial line down"; [140]: tran := "PLU" + sp3 + "partial line up"; [141]: tran := "RI" + sp4 + "reverse index"; [142]: tran := "SS2" + sp3 + "single shift 2"; [143]: tran := "SS3" + sp3 + "single shift 3"; [144]: tran := "DCS" + sp3 + "device control string"; [145]: tran := "PU1" + sp3 + "private use 1"; [146]: tran := "PU2" + sp3 + "private use 2"; [147]: tran := "STS" + sp3 + "set transmit state"; [148]: tran := "CCH" + sp3 + "cancel character"; [149]: tran := "MW" + sp4 + "message waiting"; [150]: tran := "SPA" + sp3 + "start of protected area"; [151]: tran := "EPA" + sp3 + "end of protected area"; [155]: tran := "CSI" + sp3 + "control sequence introducer"; [156]: tran := "ST" + sp4 + "string terminator"; [157]: tran := "OSC" + sp3 + "operating system command"; [158]: tran := "PM" + sp4 + "privacy message"; [159]: tran := "APC" + sp3 + "application program command"; [161]: tran := "inverted exclamation point"; [162]: tran := "cent" + sign; [163]: tran := "pound" + sign; [165]: tran := "yen" + sign; [167]: tran := "section" + sign; [168]: tran := "general currency" + sign; [169]: tran := "copyright" + sign; [170]: tran := "feminine ordinal indicator"; [171]: tran := "angle quotation mark left"; [176]: tran := "degree" + sign; [177]: tran := "plus/minus" + sign; [178]: tran := "superscript 2"; [179]: tran := "superscript 3"; [181]: tran := "micro" + sign; [182]: tran := "paragraph" + sign + ", pilcrow"; [183]: tran := "middle dot"; [185]: tran := "superscript 1"; [186]: tran := "masculine ordinal indicator"; [187]: tran := "angle quotation mark right"; [188]: tran := "fraction one quarter"; [189]: tran := "fraction one half"; [191]: tran := "inverted question mark"; [192]: tran := Uppercase + "A" + with + grave_accent; [193]: tran := Uppercase + "A" + with + acute_accent; [194]: tran := Uppercase + "A" + with + circumflex; [195]: tran := Uppercase + "A" + with + tilde; [196]: tran := Uppercase + "A" + with + umlaut; [197]: tran := Uppercase + "A" + with + "ring"; [198]: tran := Uppercase + "AE diphthong"; [199]: tran := Uppercase + "C" + with + "cedilla"; [200]: tran := Uppercase + "E" + with + grave_accent; [201]: tran := Uppercase + "E" + with + acute_accent; [202]: tran := Uppercase + "E" + with + circumflex; [203]: tran := Uppercase + "E" + with + umlaut; [204]: tran := Uppercase + "I" + with + grave_accent; [205]: tran := Uppercase + "I" + with + acute_accent; [206]: tran := Uppercase + "I" + with + circumflex; [207]: tran := Uppercase + "I" + with + umlaut; [209]: tran := Uppercase + "N" + with + tilde; [210]: tran := Uppercase + "O" + with + grave_accent; [211]: tran := Uppercase + "O" + with + acute_accent; [212]: tran := Uppercase + "O" + with + circumflex; [213]: tran := Uppercase + "O" + with + tilde; [214]: tran := Uppercase + "O" + with + umlaut; [215]: tran := Uppercase + "OE ligature"; [216]: tran := Uppercase + "O" + with + "slash"; [217]: tran := Uppercase + "U" + with + grave_accent; [218]: tran := Uppercase + "U" + with + acute_accent; [219]: tran := Uppercase + "U" + with + circumflex; [220]: tran := Uppercase + "U" + with + umlaut; [221]: tran := Uppercase + "Y" + with + umlaut; [223]: tran := "German lowercase sharp s"; [224]: tran := Lowercase + "a" + with + grave_accent; [225]: tran := Lowercase + "a" + with + acute_accent; [226]: tran := Lowercase + "a" + with + circumflex; [227]: tran := Lowercase + "a" + with + tilde; [228]: tran := Lowercase + "a" + with + umlaut; [229]: tran := Lowercase + "a" + with + "ring"; [230]: tran := Lowercase + "ae diphthong"; [231]: tran := Lowercase + "c" + with + "cedilla"; [232]: tran := Lowercase + "e" + with + grave_accent; [233]: tran := Lowercase + "e" + with + acute_accent; [234]: tran := Lowercase + "e" + with + circumflex; [235]: tran := Lowercase + "e" + with + umlaut; [236]: tran := Lowercase + "i" + with + grave_accent; [237]: tran := Lowercase + "i" + with + acute_accent; [238]: tran := Lowercase + "i" + with + circumflex; [239]: tran := Lowercase + "i" + with + umlaut; [241]: tran := Lowercase + "n" + with + tilde; [242]: tran := Lowercase + "o" + with + grave_accent; [243]: tran := Lowercase + "o" + with + acute_accent; [244]: tran := Lowercase + "o" + with + circumflex; [245]: tran := Lowercase + "o" + with + tilde; [246]: tran := Lowercase + "o" + with + umlaut; [247]: tran := Lowercase + "oe ligature"; [248]: tran := Lowercase + "o" + with + "slash"; [249]: tran := Lowercase + "u" + with + grave_accent; [250]: tran := Lowercase + "u" + with + acute_accent; [251]: tran := Lowercase + "u" + with + circumflex; [252]: tran := Lowercase + "u" + with + umlaut; [253]: tran := Lowercase + "y" + with + umlaut; [128,129,130,131,152,153,154,160,164,166,172, 173,174,175,180,184,190,208,222,240,254,255]: tran := reserved; ENDCASE; RETURN (tran); ENDPROCEDURE !------------------------------------------------------------------------------ PROCEDURE CHAR_TO_ASCII(CHAR) ! In VMS 4 we had to do this the hard way. ! In VMS 5 the proper built-in came along. ! Left here for backwards compatibility because ! EDX made this a user available function in VMS 4. IF LENGTH(CHAR)=0 THEN RETURN 0; ELSE RETURN( ASCII(CHAR) ); ENDIF; ENDPROCEDURE !------------------------------------------------------------------------------ !PROCEDURE EDTN$CNTL_CHAR !Enter a control character ! ! (From DSIN article "How To Determine The Results From The READ_KEY Function") ! DATE: 30-Apr-1986 ! ! The value returned from READ_KEY can be broken down into bit fields. ! Printing the value out in hexadecimal radix will be extremely helpful. ! ! The function READ_KEY is based on the following presumed keyname layout: ! ! +---+---+-------+-------+-------+ ! | | | | | | ! | | | | | | ! +---+---+-------+-------+-------+ ! ^ ^ ^ ^ ^ ! | | | | | ! | | | | +--- Byte 0 (bits 0-7) - Low byte ! | | | +----------- Byte 1 (bits 8-15) - Index ! | | +------------------- Byte 2 (bits 16-23) - Not used ! | +------------------------- Nibble 6 (bits 24-27) - Type ! +----------------------------- Nibble 7 (bits 28-31) - Always = 4 ! ! Bits 0-7: This field should probably be ignored when doing ! compares. For printing keys (not shifted printing keys), the low ! byte (byte 0) is equal to the index (byte 1). For all others, the ! low byte is always zero. ! ! Bits 8-15: This contains the index. This will generally be the ! ASCII code of the key pressed. In the case of a key that sends ! multiple characters (such as any of the keypad keys), this will be ! the ASCII code of the most significant character. ! ! Bits 16-23: For all types, byte 2 is always zero. ! ! Bits 24-27: This is a 4-bit field that contains the type of key. ! There are eight types: ! ! Value of bits 24-27 Meaning ! ------------------------------------------ ! 0 printing ! 1 keypad ! 2 function ! 3 control ! 4 shift_printing ! 5 shift_keypad ! 6 shift_function ! 7 shift_control ! ! Shift (in this context) does not refer to the key on the keyboard ! marked "SHIFT." Instead, it refers to a key set up as the shift key ! with with the SET(SHIFT_KEY,...) TPU built-in . Often this ! is the PF1 key. ! ! Clearly, some of these combinations can never actually occur (printing keys ! can't have an index less than 32, for instance). However, TPU allows these ! values to be passed to define_key. ! ! Note that this information is not documented in the VMS documentation set ! and is, therefore, subject to change without notice. Although it has not ! been tested exhaustively, it seems correct for all cases tested thus far. ! We do not guarantee its correctness. !- PROCEDURE EDTN$CNTL_CHAR !Enter a control character LOCAL cw, idx, key, key_type; cw := current_window; !Mark current window edtn$clear_message_window; !Clear message window erase(prompt_buffer); !Prompt for input position(prompt_buffer); ! . copy_text("Control character:"); ! . map(prompt_window,prompt_buffer); ! . position(cw); !Go back to user's buffer update(prompt_window); ! . key := READ_KEY; !Read input unmap(prompt_window); !Remove prompt update(message_window); !Reset message_window to bottom of buffer key := int(key); !VAXTPU version 2 requires this idx := (key - ((key/65536) * 65536 )) / 256; !(key - ((key/10000X) * 10000X)) / 100X; integer division. key_type := ((( key * 16 ) / 16 ) / 16777216 ); !((( key * 10X ) / 10X ) / 1000000X ); integer division. CASE key_type from 0 to 7 [0,4]:!PRINTABLE CHARACTER or SHIFT PRINTABLE CHARACTER if (idx >= 64) and (idx <= 95) then ENABLE_BUFFER_JOURNALING(CURRENT_BUFFER); vs$copy_char(ascii(idx-64)); else if (idx >= 97) and (idx <= 122) then ENABLE_BUFFER_JOURNALING(CURRENT_BUFFER); vs$copy_char(ascii(idx-96)); else edx_message("Can not make control character from '!AS'. (ASCII !UL, HEX !XB)", EDX$K_ERROR_HIGHLIGHT,ascii(idx),idx,idx); endif; endif; [1,5]:!KEYPAD KEY edx_message ("Can not make control character from keypad key"); [2,6]:!FUNCTION KEY edx_message ("Can not make control character from function key"); [3,7]:!CONTROL CHARACTER or SHIFT CONTROL CHARACTER ENABLE_BUFFER_JOURNALING(CURRENT_BUFFER); vs$copy_char(ascii(idx)); ENDCASE; RETURN; ENDPROCEDURE !------------------------------------------------------------------------------ PROCEDURE EDTX$CURSSTAT(line_num) ! Displays current column and character ! Taken from EDTEXT procedure jc_cursstat and modified. ! This procedure is generally faster than eve_what_line ! LOCAL char, ! Current character trans, ! Translation of character start_pos,! Starting position curs_line,! Cursor line number curs_col, ! Cursor column key_func, ! execute key function inkey, ! Read next key ascn, ! Ascii value of current character tot_lines,! Total number of lines in buffer msgln; ! Message line msgln:=""; char := 0; !initialize to no character start_pos := mark(free_cursor); curs_col := get_info(current_buffer,'offset_column'); IF (get_info(start_pos,'beyond_eol')) THEN trans := "[beyond end of line]" ELSE If (get_info(start_pos,'beyond_eob')) then trans := "[beyond end of buffer]" Else if (get_info(start_pos,'before_bol')) then trans := "[before beginning of line]" else IF (start_pos = end_of(current_buffer)) then trans := "[End of Buffer]" ELSE char := current_character; !now it's safe to get character ascn := char_to_ascii(char); !Get ascii value of character trans := edtn$translate_character(ascn);!Translate character ENDIF; endif; Endif; ENDIF; IF (line_num) THEN tot_lines := get_info(current_buffer,'record_count'); curs_line := cursor_line_number; msgln := FAO("Line !ZL of !ZL ", curs_line, tot_lines); ENDIF; If (get_info(char,'TYPE') = STRING) then msgln := ( FAO( "!ASCurrent Character is '!AS', Decimal=!UB, " + "Hex=!-!XB, Octal=!-!OB", msgln, char, ascn ) ); Endif; IF ( get_info(system,'display') AND (get_info(current_window,'status_line') <> 0) ) THEN set (status_line, current_window, reverse, FAO("Column: !ZL Character: !AS", curs_col, trans)); update (current_window); ELSE edx_message("Column: !ZL Character: !AS", EDX$K_INFO_HIGHLIGHT, curs_col, trans); edx_message(msgln); return; ENDIF; edx_message(msgln); inkey := read_key; !Press any key to continue EDTP$set_status_line(CURRENT_WINDOW); !Reset status line !The following code can cause a fatal TPU internal error if the user enters the !line mode command FIX CRLFS. This problem has been fixed as of VMS 4.6 key_func := lookup_key(inkey,program); if (key_func <> 0) then execute (key_func) endif; ENDPROCEDURE !------------------------------------------------------------------------------ PROCEDURE EDTN$TRANSLATE_BUFFER(CODE) LOCAL old_line, result, retcode, replacement_line, entry_mode; ENABLE_BUFFER_JOURNALING(CURRENT_BUFFER); entry_mode := get_info(current_buffer,'mode'); !Do it in insert mode to avoid VMS 5.4 fatal error set (insert,current_buffer); position(beginning_of(current_buffer)); loop exitif ( mark(none) = end_of (current_buffer) ); !(snapped to text) position(LINE_BEGIN); old_line := erase_character(length(current_line)); result := call_user(code,old_line); retcode := int(substr(result,1,9)); if (retcode = 0) then copy_text(old_line); !Replace deleted line exitif; !and quit. Error was signaled. endif; replacement_line := substr(result,10,length(result)); copy_text(replacement_line); move_vertical(1); endloop; position(beginning_of(current_buffer)); if entry_mode = overstrike then set (overstrike,current_buffer) endif; ENDPROCEDURE !------------------------------------------------------------------------------ !ENCRYPT !User or system manager may supply an encryption algorithm !and reinstate the below code. For now we do nothing. !!PROCEDURE EDTN$ENCRYPT_BEGIN !!!This routine prompts for a password. Control returns to edtn$encrypt_finish !!!after the password has been entered. !!! !!!GLOBAL edtn$w_previous_window; !! !! If (NOT get_info(system,'display')) then !! edx_message("Can not encrypt buffer in /NODISLPAY mode"); !! return(0); !! Endif; !! !! edtn$w_previous_window := current_window; !Mark current window !! edtn$clear_message_window; !Clear message window !! erase(prompt_buffer); !Prompt for input !! position(prompt_buffer); !! copy_text("Password:"); !! map(prompt_window,prompt_buffer); !! update(prompt_window); !! set(key_map_list,"edtn$kml_paswrd",SHOW_BUFFER); !Get the password !! erase(SHOW_BUFFER); !! position(beginning_of(SHOW_BUFFER)); !! set(screen_update,off); !In case he has SHOW buffer mapped to screen !! edtn$x_password := ""; !!ENDPROCEDURE !! !!PROCEDURE EDTN$ENCRYPT_FINISH !!LOCAL paswrd, verwrd, result, retcode; !! verwrd := edtn$x_password; !! edt$x_password := ""; !! position(beginning_of(SHOW_BUFFER)); !! If mark(none) <> end_of(SHOW_BUFFER) then !check for zero length password !! paswrd := current_line; !! edit(paswrd,trim,upper,off); !Trim password and upcase !! Else !! paswrd := ""; !! Endif; !! erase(SHOW_BUFFER); !Erase password !! !! IF ( (verwrd <> "") !If this was the verification pass !! OR (length(paswrd) = 0 ) ) !or we got zero length password !! THEN !then reset everything. !! set(key_map_list,"tpu$key_map_list"); !Return show_buffer to normal state !! position(edtn$w_previous_window); !Go back to original user position !! unmap(prompt_window); !Remove "Password:" prompt !! set(screen_update,on); !Now we may refresh the screen now that password is deleted !! ENDIF; !! !! IF (verwrd <> "") !If this was the verification pass !! THEN !then check passwords and encrypt !! If (verwrd = paswrd) then !! edx_message("Encrypting buffer"); !! result := call_user(262147,paswrd); !Initialize the Random Number Generator x00040003 !! retcode := int(substr(result,1,9)); !! if (retcode <> 1) then return endif; !! edtn$translate_buffer(262148); !encrypt the buffer x00040004 !! Else !! edx_message ("Password verification error"); !! Endif; !! ELSE !! IF length(paswrd) > 0 !Not verification pass. If not zero length initial password !! THEN !then prompt for verification !! edtn$x_password := paswrd; !Save initial password !! erase(prompt_buffer); !Prompt to verify password !! position(prompt_buffer); !! copy_text("Verification:"); !! set(screen_update,on); !! update(prompt_window); !! set(screen_update,off); !! position(show_buffer); !Show buffer already erased !!!! ELSE !!!! else primary password was zero length. !!!! user didn't want this, just return quietly. !! ENDIF; !! ENDIF; !!ENDPROCEDURE !! !------------------------------------------------------------------------------ !****************************************************************************** ! SORTING !****************************************************************************** PROCEDURE SRT$SORT(command) !Regular sort, nosilent. SRT$SORT_DO(command,0); ENDPROCEDURE PROCEDURE SRT$SORT_SILENT(command) !Sort without saying "Sorting buffer...","Sorting complete" SRT$SORT_DO(command,1) ENDPROCEDURE PROCEDURE SRT$SORT_DO(command,silent) LOCAL result, retcode, here, tempbuf, userbuf, status; !Save the sort command in case srt$record_sort_buffer has to abort. !Srt$record_sort_buffer will restart the sort using srt$file_sort_buffer !but it must preparse the command line over again in order to restart SORT. SRT$X_COMMAND := command; result := call_user(327681,SRT$X_COMMAND); !Preparse the SORT command if (length(result) > 0) then retcode := INT( substr(result,1,9) ); else retcode := 0; endif; CASE RETCODE FROM 2 TO 4 [2]:!SORT RANGE tempbuf := show_buffer; erase(tempbuf); set(INSERT,tempbuf); if (NOT edtn$cut_block(0,tempbuf,1)) then !Cut the block return (0); endif; if (not silent) then edx_message("Sorting Range...") endif; here := mark(free_cursor); !Mark our position before we move position(end_of(tempbuf)); !Go to the temporary buffer append_line; !Get rid of blank line at end STATUS := SRT$SORT_BUFFER; !Do the actual sort position(end_of(tempbuf)); split_line; !Replace blank line at end position(here); !Go to right place to paste it back edtn$paste_block(tempbuf); !Paste it back if (not silent) then edx_message("Sorting complete.") endif; [3]:!SORT BUFFER if (not silent) then edx_message("Sorting Buffer...") endif; STATUS := SRT$SORT_BUFFER; if (not silent) then edx_message("Sorting Complete.") endif; [4]:!HELP SORT edt$help ("EDX_HELP","SORT"); [OUTRANGE]: !ERROR return(0); ENDCASE ENDPROCEDURE PROCEDURE SRT$SORT_BUFFER !Decide whether to use record sort or file sort !Record sort is fast for small number of lines, all < 132 characters long. !File sort is for large number of lines, or lines > 132 long. !Crossover point set at 200 lines. !Somewhat arbitrary, based on experiments. IF GET_INFO(CURRENT_BUFFER,'RECORD_COUNT') < 200 THEN RETURN SRT$RECORD_SORT_BUFFER; ELSE RETURN SRT$FILE_SORT_BUFFER; ENDIF; ENDPROCEDURE PROCEDURE SRT$RECORD_SORT_BUFFER !Sort current buffer using record sort format. !Procedure returns 1 or 0 for success or failure. LOCAL retcode, result, entry_mode; result := call_user(327683,""); !'Postparse command line' if (length(result) > 0) then retcode := INT( substr(result,1,9) ); else retcode := 0; endif; if (not retcode) then return(0) endif; !abort if error position(beginning_of(current_buffer)); !PASS RECORDS TO SORT LOOP exitif ( mark(none) = end_of (current_buffer) );!(snapped to text) result := call_user(327684,current_line); !'Pass a record to sort' if (length(result) > 0) then retcode := INT( substr(result,1,9) ); else retcode := 0; endif; CASE RETCODE FROM 0 TO 2 [0,OUTRANGE]:!error. Abort the sort. (Error was signaled by call_user) Return (0); [1]:!Success. Continue. move_vertical(1); !Move down to next line [2]:!Line too long. Abort record sort, switch to file sort. result := call_user(327681,SRT$X_COMMAND); !Preparse the SORT command over again RETURN SRT$FILE_SORT_BUFFER; !Switch to file sort ENDCASE; ENDLOOP; result := call_user(327685,""); !DO THE SORT if (length(result) > 0) then retcode := INT( substr(result,1,9) ); else retcode := 0; endif; if (not retcode) then return(0) endif; !abort if error erase(current_buffer); !GET RECORDS FROM SORT ENABLE_BUFFER_JOURNALING(CURRENT_BUFFER); !enable buffer journaling entry_mode := get_info(current_buffer,'mode'); !Do it in insert mode to avoid VMS 5.4 fatal error loop result := call_user(327686,""); !'Receive a record from sort' if (length(result) > 0) then retcode := INT( substr(result,1,9) ); else retcode := 0; endif; exitif ( retcode = SS$_ENDOFFILE ); !all done if (not retcode) then return endif; !abort if error copy_text( substr(result,10,length(result)) ); !(in insert mode) split_line; endloop; append_line; result := call_user(327687,""); !CLEAN UP if entry_mode = overstrike then set (overstrike,current_buffer) endif; return (1); ENDPROCEDURE PROCEDURE SRT$FILE_SORT_BUFFER !Sorts the current buffer using VMS SOR$... routines with file interface. !Procedure returns 1 or 0 for success or failure. !Outline: ! 1. Assume SRT$SORT_PREPARSE was already called ! 2. Quietly write current buffer to temporary file EDX_TEMPSORT.DAT ! If error then return. ! 3. Sort file. CALL_USER returns to us the name of the sorted file. ! 4. Erase buffer and read in sorted file ! 5. Delete temporary sorted file LOCAL retcode, result, result2, tmpfn_unsort, !temporary filename of unsorted file full_tmpfn_unsort, !full temporary filename of actual unsorted file full_tmpfn_sort; !full temporary filename of actual sorted file ! Quietly write current buffer to temporary file EDX_TEMPSORT.DAT tmpfn_unsort := "EDX_TEMPSORT.DAT"; full_tmpfn_unsort := srt$write_tempfile( current_buffer, tmpfn_unsort ); ENABLE_BUFFER_JOURNALING(CURRENT_BUFFER); split_line; append_line; !Set buffer modified (gets set to unmodified by write) If (full_tmpfn_unsort = "") then return(0) endif; !Error creating temporary file ! Do the SORT result := call_user(327682,full_tmpfn_unsort); !DO THE SORT. Pass filename of file to sort result2 := call_user(65546,full_tmpfn_unsort); !'0001000A'x Delete unsorted file if (length(result) > 0) then retcode := INT( substr(result,1,9) ); else retcode := 0; endif; if (not retcode) then return(0) endif; !abort if error full_tmpfn_sort := substr(result,10,length(result));!name of sorted file ! Read in sorted file erase(current_buffer); srt$read_file( full_tmpfn_sort ); !Read in file quietly ! Delete sorted file result := call_user(65546,full_tmpfn_sort); !'0001000A'x Delete file ! Return success Return (1); ENDPROCEDURE PROCEDURE SRT$WRITE_TEMPFILE( BUFFER_PTR, FILENAME ) !Quietly write BUFFER to file FILENAME and return full name of file written. !If an error is detected during the write then delete the temporary file !created and return a null string "". !In order to suppress the "xxx lines written to file y" message, we temporarily !switch off success messages. ! LOCAL RESULT, FULL_FILESPEC, !full filespec of file written SUCCESS_ON; !Integer 1 = ON, 0 = OFF ON_ERROR IF (FULL_FILESPEC <> "") THEN !If any file at all was made then delete it RESULT := CALL_USER(65546,FULL_FILESPEC); !'0001000A'x Delete remains of temporary file ENDIF; IF (SUCCESS_ON) THEN SET(SUCCESS,ON) ENDIF; !Reset success message setting RETURN ""; ENDON_ERROR; SUCCESS_ON := GET_INFO( SYSTEM, "SUCCESS" ); !Get success message setting SET(SUCCESS,OFF); !Switch off success messages FULL_FILESPEC := ""; !Initialize as null string "". FULL_FILESPEC := WRITE_FILE( BUFFER_PTR, FILENAME ); !Write the file. IF (SUCCESS_ON) THEN SET(SUCCESS,ON) ENDIF; !Reset success message setting RETURN (FULL_FILESPEC); !Return the full file specification of the file written ENDPROCEDURE PROCEDURE SRT$READ_FILE( FILENAME ) !Quietly read in FILENAME. !In order to suppress the "xxx lines read from file y" message, we temporarily !switch off success messages. LOCAL SUCCESS_ON; !Integer 1 = ON, 0 = OFF ON_ERROR IF (SUCCESS_ON) THEN SET(SUCCESS,ON) ENDIF; !Reset success message setting ENDON_ERROR; SUCCESS_ON := GET_INFO( SYSTEM, "SUCCESS" ); !Get success message setting SET(SUCCESS,OFF); !Switch off success messages ENABLE_BUFFER_JOURNALING(CURRENT_BUFFER); !enable buffer journaling READ_FILE( FILENAME ); !Read in the file IF (SUCCESS_ON) THEN SET(SUCCESS,ON) ENDIF; !Reset success message setting ENDPROCEDURE !****************************************************************************** ! MULTIPLE PROCESSING !****************************************************************************** PROCEDURE EVE_DCL (dcl_parameter) ! Run a DCL command and put the output in a second window on the screen. ! This is the only command to automatically create a second window if ! needed, but the user is left in the current buffer at the end of the ! command (reduce trap-door risk). ! Parameters: ! dcl_parameter String containing DCL command - input ! LOCAL dcl_string, ! Local copy of dcl_parameter buffer_name, buffer_ptr, line, create_msg; If (NOT get_info(system,'display')) then edx_message("Can not perform DCL command while in /NODISPLAY mode"); return(0); Endif; !GET DCL COMMAND dcl_string := dcl_parameter; edit(dcl_string,trim,OFF); if (length(dcl_string) = 0) then dcl_string := edx_read_line("DCL command: ",,"CTRL-Z"); if (length(dcl_string)=0) then Return; !User wants to abort this procedure endif; edit(dcl_string,trim,OFF); endif; !GET THE PROCESS if (get_info (EVE$X_DCL_PROCESS, 'type') <> PROCESS) or (EVE$X_DCL_PROCESS = 0) then create_msg := "Creating DCL subprocess..."; edx_message (create_msg); EVE$X_DCL_PROCESS := create_process (show_buffer, "$ set noon"); if (EVE$X_DCL_PROCESS = 0) then edx_message ("procedure aborted"); return (0); endif; endif; !INITIALIZE DCL BUFFER buffer_name := 'DCL'; if get_info(current_buffer,'name') <> buffer_name then make_two_windows(buffer_name,0); !This will create buffer_name if it doesn't yet exist endif; ! It leaves us in new buffer buffer_ptr := edt$find_buffer(buffer_name); !Get buffer ptr of new buffer set ( system, buffer_ptr); !Mark buffer as system type set ( max_lines, buffer_ptr, 500); set ( status_line, current_window, reverse, ""); position (end_of (buffer_ptr)); update(top_window); !Get status line separating windows If current_window <> top_window then update(current_window) Endif; edx_message(""); edx_message("CTRL/D - Go to other window. GOLD-W - Toggle single/dual windows."); ! PROCESS THE DCL STRING - (NEED TO INCLUDE THE $) split_line; copy_text ("$ " + dcl_string); split_line; !so user doesn't think he needs to press RETURN update (current_window); erase(show_buffer); send (dcl_string, eve$x_dcl_process); LOOP position(beginning_of(show_buffer)); exitif (mark(none) = end_of(current_buffer)); line := erase_line; position(buffer_ptr); copy_text(line); split_line; update(current_window); ENDLOOP; position(buffer_ptr); change_windows; ENDPROCEDURE; !---------------------------------------------------------------------- PROCEDURE EVE_ATTACH(attach_param) ! Attach back to the parent process. Used when the editor is spawned ! from DCL and run in a subprocess. The VAXTPU attach command can be used ! for more flexible process control. ! D.D. 05-DEC-1990 Accept /IDENTIFICATION=pid qualifier instead of "process-name" ! LOCAL term_char, qual, !qaualifer /IDENTIFICATION spid, !String pid value dpid; !decimal integer pid value ON_ERROR [TPU$_NOPARENT]: edx_message ("You are not running the editor in a subprocess"); return(0); [OTHERWISE]: !print error and return 0 ENDON_ERROR; If (NOT get_info(system,'display')) then edx_message("Can not attach to process while in /NODISPLAY mode"); return(0); Endif; edtn$clear_message_window; ! Clear out old message edit (attach_param,trim_leading,OFF); IF (length(attach_param) = 0) then edx_message ("Attaching to parent process"); attach; ELSE !Check for possible /ID=pid qualifier IF substr(attach_param,1,1) = '/' then qual := edt$next_token(edtn$x_token_delimiters,term_char); edit(qual,upper); IF ((index("IDENTIFICATION",qual) <> 1) OR (term_char <> '=')) THEN edx_message("Error parsing ATTACH command qualifier", EDX$K_ERROR_HIGHLIGHT); return(0); ENDIF; spid := edt$next_token(edtn$x_token_delimiters,term_char); dpid := INT( spid, 16 ); !Convert base 16 (hex) edx_message ("Attaching to " + spid); attach(dpid); ELSE !attach_param must be "process-name" to attach to edx_message ("Attaching to " + attach_param); attach(attach_param); ENDIF; ENDIF; edtn$clear_message_window; ! Clear out message window upon return ENDPROCEDURE; !---------------------------------------------------------------------- PROCEDURE EVE_SPAWN(spawn_param) ! Spawn a new DCL subprocess and go to that subprocess. Logging out of ! the subprocess will resume the Eve session. Useful for running ! screen-oriented programs that can't go through VMS mailboxes. ! ON_ERROR if error = tpu$_createfail then edx_message ("DCL subprocess could not be created"); return; endif; ENDON_ERROR; If (NOT get_info(system,'display')) then edx_message("Can not spawn subprocess while in /NODISPLAY mode"); return(0); Endif; edtn$clear_message_window; ! Clear out old message edx_message ("Spawning subprocess..."); edit (spawn_param,trim_leading,OFF); if (length(spawn_param) = 0) then spawn; else spawn(spawn_param); endif; edtn$clear_message_window; ! Clear out message window upon return ENDPROCEDURE; !---------------------------------------------------------------------- !****************************************************************************** ! DIRECTORY !****************************************************************************** PROCEDURE EDTN$DIR(dirspec_parameter) ! Display a directory listing. Prompts for a directory ! specification if one isn't passed. Wildcards are accepted ! including [*...]*.*;* Also the qualifiers /SIZE and /DATE ! are accepted. ! If user is currently in full-window mode, the screen is split ! in two, the current buffer moves to the top half of the screen ! and the directory is displayed in the bottom half. If two ! windows are currently in use, the directory is displayed in ! the other window. The user is left in the directory buffer ! where he may scroll up/down to view the whole listing. ! David Deley. July, 1988 ! Return codes: ! 2 - SRCHLP_CODE. Print outline and call again ! 3 - PROOT_CODE. Print outline followed by two blank lines and call again ! 4 - NXTTAB_CODE. Print outline followed by one blank line and call again ! 5 - ADFILE_CODE. Print outline and call again ! 6 - GETATR_CODE. Print outline and call again ! 7 - RMS_ERR. EDX signaled error. Just return. ! 8 - FNF_ERR. File not found. Message "no files found" and exit ! 9 - NMF_ERR. No more files. Normal exit. LOCAL retcode, result, outline, dirspec, buffer_name, buffer_ptr; If (NOT get_info(system,'display')) then edx_message("Can not show directory while in /NODISPLAY mode"); return(0); Endif; !GET DIRECTORY SPECIFICATION dirspec := dirspec_parameter; edit(dirspec,trim,OFF); if (length(dirspec) = 0) then dirspec := edx_read_line('Directory: ',,"CTRL-Z"); if (length(dirspec)=0) and (last_key = ctrl_z_key) then Return !User wants to abort this procedure endif; edit(dirspec,trim,OFF); endif; !TEST THE FILE SPECIFICATION WITH THE FIRST FILE result := call_user(196609,'DIRECTORY '+dirspec); !'00030001'x Initial directory call retcode := substr(result,1,9); if (retcode = "") then return endif; !Error and zero length string returned retcode := int(retcode); outline := substr(result,10,length(result)); CASE retcode from 3 to 8 [7]: !RMS_ERR Return; [8]: !FNF_ERR Edx_message ("no files found"); Return; [INRANGE,OUTRANGE]: Return; !Error. [3]: !Expected code to receive. Initialize dir buffer and window !INITIALIZE DIR BUFFER buffer_name := 'DIR'; if get_info(current_buffer,'name') <> buffer_name then make_two_windows(buffer_name,0) !This will create buffer_name if it doesn't yet exist endif; ! It leaves us in new buffer buffer_ptr := edt$find_buffer(buffer_name); !Get buffer ptr of new buffer set ( system, buffer_ptr); !Mark buffer as system type erase(buffer_ptr); edtn$trim_filespec( outline, 71); edit(outline,trim_trailing,OFF); set ( status_line, current_window, reverse, " " + outline); set ( output_file, buffer_ptr, outline); !For status line in case user goes to this buffer again If get_info(top_window,'visible') then update(top_window) !Get status line separating windows Endif; If current_window <> top_window then update(current_window) Endif; edx_message("CTRL/D - Go to other window. GOLD-W - Toggle single/dual windows."); edx_message("ENTER - File to current window. SPACE_BAR - File to other window."); ENDCASE; !ENTER MAIN LOOP LOOP result := call_user(196608+retcode,""); !'00030000'x + retcode retcode := int(substr(result,1,9)); outline := substr(result,10,length(result)); CASE retcode from 2 to 9 [9]: !No more files. Take normal exit. If (length(outline) > 0) then split_line; copy_text(outline); Endif; position(LINE_BEGIN); edtn$highlight_word(edtn$rn_dirfil); Return; [2,5,6]: !Print outline and call again split_line; copy_text(outline); [3]: !Print outline followed by two blank lines and call again split_line; copy_text(outline); split_line; split_line; [4]: !Print outline followed by one blank line split_line; copy_text(outline); split_line; [INRANGE,OUTRANGE]: return; !Error ENDCASE; update(current_window); ENDLOOP; ENDPROCEDURE ! PROCEDURE EDTN$DIRBUF_FILENAME !Get filename in range LOCAL filename, dirspec, full_filespec, start_current_word, end_current_word, rn, temp; ON_ERROR edx_message("Error searching for 'Directory ' specification."); return ""; ENDON_ERROR; !GET FILENAME.TYPE;VERSION if (edtn$rn_dirfil = 0) !If no range then edx_message("No filename selected"); return ""; else if (length(edtn$rn_dirfil) = 0) !Test only after determining edtn$rn_dirfil is a range instead of 0 then edx_message("No filename selected"); !Range was zero length return ""; else filename := substr(edtn$rn_dirfil,1,length(edtn$rn_dirfil)) endif; endif; !SEARCH UPWARDS FOR 'Directory ' rn := search(LINE_BEGIN& 'Directory ', REVERSE, EXACT); position(end_of(rn)); end_current_word := mark(none); !EXTRACT DIRECTORY SPECIFICATION position(line_end); rn := create_range(end_current_word,mark(none),none); dirspec := substr( rn,1,length(current_line)); position(end_of(edtn$rn_dirfil)); !Go back to where we started. if (edtn$file_parse( full_filespec, filename, dirspec, "")) then temp := file_search(""); !Reset file search if (file_search(full_filespec) <> "") then return full_filespec; else edx_message("File !AS not found",EDX$K_ERROR_HIGHLIGHT,full_filespec); return ""; endif; else return ""; endif; ENDPROCEDURE PROCEDURE EDTN$HIGHLIGHT_WORD(rn) !assume we are in a buffer not being journaled, or journal already started !and not in overstrike mode (to avoid VMS 5.4 fatal error.) LOCAL start_current_word, end_current_word; ON_ERROR ! Suppress "string not found" message return (0); ENDON_ERROR; rn := 0; !Go to end of word first - edt$beg_word goes back a word !when current cursor is at the start of a word move_horizontal(length(search(edtn$pattern_word_end, forward))); move_horizontal (-1); end_current_word := mark(none); move_horizontal (1); edt$beg_word; start_current_word := mark(none); move_horizontal(length(search(edtn$pattern_word_end, forward))); rn := create_range (start_current_word, end_current_word, reverse) ENDPROCEDURE; PROCEDURE EDTN$DIRBUF_UPDOWN(I) !Move pointer up. Highlight current word (hopefully a file name) edt$beg_word; move_vertical(I); edtn$highlight_word(edtn$rn_dirfil); ENDPROCEDURE PROCEDURE EDTN$DIRBUF_LEFT !Move left. Highlight current word (hopefully a file name) edt$move_word(reverse); edt$move_word(reverse); edtn$highlight_word(edtn$rn_dirfil); ENDPROCEDURE PROCEDURE EDTN$DIRBUF_RIGHT edt$move_word(forward); edtn$highlight_word(edtn$rn_dirfil); ENDPROCEDURE PROCEDURE EDTN$DIRBUF_ENTER(WD) ! WD - 'CURRENT' or ! 'OTHER' LOCAL full_filespec, bufnam, newbuf; full_filespec := edtn$dirbuf_filename; if (full_filespec = "") then return endif; newbuf := edtn$newbufnam; bufnam := edx_read_line(FAO("Buffer name [!AS]: ",newbuf),,"CTRL-Z"); edit(bufnam,trim,OFF); if (length(bufnam)=0) then if (last_key = ctrl_z_key) then Return !User wants to abort this procedure else bufnam := newbuf endif endif; If (WD = 'OTHER') then make_two_windows(bufnam,full_filespec); Else edtn$goto_buffer(bufnam,full_filespec); Endif; ENDPROCEDURE PROCEDURE EDTN$DIRBUF_DELFILE LOCAL full_filespec, retcode, result, old_bell, Y_N, entry_mode, rn, num_spaces; !DELETE FILE full_filespec := edtn$dirbuf_filename; if (full_filespec <> "") then ring_bell(""); !Ring bell edx_message(""); !and clear message buffer Y_N := edx_read_line("Delete file " + full_filespec + "? "); edit(Y_N,trim,upper,OFF); rn := 0; If ( index("YES",Y_N) = 1) then result := call_user(65546,full_filespec); !'0001000A'x Delete file retcode := int(substr(result,1,9)); if (retcode = 1) then entry_mode := get_info(current_buffer,'mode'); set(overstrike,current_buffer); position(beginning_of(edtn$rn_dirfil)); num_spaces := length(edtn$rn_dirfil) - 9; if num_spaces < 0 then num_spaces := 0 endif; copy_text(FAO("(Deleted)!"+str(num_spaces)+"* ")); if (current_character = "") then erase_character(-num_spaces) endif; position(beginning_of(edtn$rn_dirfil)); edtn$highlight_word(edtn$rn_dirfil); endif; ENDIF; endif; ENDPROCEDURE PROCEDURE EDTN$DIRBUF_LOCK(LOCK_TYPE) ! Parameter: LOCK_TYPE = LOCK ! = UNLOCK LOCAL code, full_filespec, result; If (lock_type = "LOCK") then code := 65537 !LOCK FILE x00010001 Else code := 65538 !UNLOCK FILE x00010002 Endif; full_filespec := edtn$dirbuf_filename; If (full_filespec <> "") then result := call_user(code,full_filespec);!Lock or unlock the buffer edtn$v_locked_files := TRUE; !Locked files = TRUE Endif; ENDPROCEDURE !------------------------------------------------------------------------------ !****************************************************************************** ! SPELLING !****************************************************************************** PROCEDURE SPL$SPELL_PARSE(prev_term_char) !Parse and dispatch the line mode SPELL command. LOCAL word, word_range, word_offset, word_length, token, term_char, stofst, result, retcode, R1, curline; IF (prev_term_char = "/") then token := edt$next_token(edtn$x_token_delimiters,term_char); If (index("DICTIONARY",token) = 1) then word := edt$next_token(edtn$x_token_delimiters,term_char); return (spl$dic_browse( word )); !Aborts back to interactive TPU Else if (index("WORD",token) = 1) then word_range := eve$current_word; stofst := get_info(beginning_of(word_range),"offset"); curline := FAO("!"+str(stofst)+"*"+" !AS",substr(current_line,stofst+1,length(word_range))); result := call_user(393220,curline); !spell check word retcode := int(substr(result,1,9)); IF (retcode = LIB__NOTFOU) THEN !if word was not found in dictionary edt$x_line := substr(result,10,length(result)); word_offset := int(edt$next_token(" ",term_char)); word_length := int(edt$next_token(" ",term_char)); position(LINE_BEGIN); move_horizontal( word_offset ); R1 := mark(none); move_horizontal(word_length-1); SPL$RN_MISSPELLED := create_range(R1,mark(none),reverse); update(current_window); word := substr(SPL$RN_MISSPELLED,1,length(SPL$RN_MISSPELLED)); change_case( word, UPPER ); edx_message( "!AS was not found in the dictionary", EDX$K_WARN_HIGHLIGHT, word ); Spl$what_to_do(SPL$RN_MISSPELLED,0,""); SPL$RN_MISSPELLED := 0; !Erase highlight ELSE If retcode = LIB__NORMAL then edit(curline,trim,upper,off); edx_message( "!AS was found in the dictionary", EDX$K_SUCCESS, curline ); Endif; ENDIF; else edx_message("Unsupported qualifier /"+token); endif; Endif; ELSE word := edt$next_token(edtn$x_token_delimiters,term_char); If word = "" then spl$spell Else spl$spell_word( word ) Endif; ENDIF; ENDPROCEDURE PROCEDURE SPL$SPELL_WORD( WORD_PARAM ) !Spell check a single word. LOCAL word, result, retcode, CMD, prompted, uppercase_target, browse_word; prompted := FALSE; word := word_param; LOOP If word = "" then word := edx_read_line("Word to check: "); If word = "" then return(0) endif; change_case( word, UPPER ); prompted := TRUE; Endif; result := call_user(393220,word); !spell textline retcode := int(substr(result,1,9)); If retcode = LIB__NORMAL then edx_message( "!AS was found in the dictionary", EDX$K_SUCCESS, word ); exitif( not prompted); word := ""; Endif; If (retcode = LIB__NOTFOU) then edx_message( "!AS was not found in the dictionary", EDX$K_WARN_HIGHLIGHT, word ); !'Ask what to do' loop LOOP CMD := edx_read_line("Options: (D)ictionary, (G)uess, (Q)uit, (S)pell: ",1); change_case(CMD,upper); If (length(CMD) = 0) then CMD := "Q" Endif; !no response or Quit, exit 'Ask what to do' loop CASE CMD FROM "A" TO "Z" ["D"]:!DICTIONARY uppercase_target := word; change_case( uppercase_target, UPPER ); browse_word := edx_read_line(FAO("Word to lookup [!AS]: ",uppercase_target),,"CTRL-Z"); If (length(browse_word)=0) then browse_word := uppercase_target endif; Return spl$dic_browse( browse_word ); !dic_browse Aborts straight to interactive mode ["G"]:!GUESS If ( spl$guess_mode <> "" ) then Return Endif; !User accepted guess word ["Q"]:!QUIT Return; ["S"]:!SPELL Word := ""; Exitif; ENDCASE; !CASE OF what to do ENDLOOP; !'Ask what to do' loop Endif; ENDLOOP; ENDPROCEDURE PROCEDURE SPL$SPELL !Main spell routine. Spell check a buffer, starting a current cursor position. LOCAL R1, ! Marker (beginning of range RN) buffer_name, ! name of buffer spell checking buffer_ptr, ! buffer spell checking curline, ! Current line guess_word, ! Returned by spl$spell_guess line_num, ! Current line number result, ! return string from call_user retcode, ! return code from call_user target, ! misspelled word term_char, ! dummy variable word, ! word word_length, ! length of misspelled word word_offset, ! offset from beginning of line of misspelled word Y_N, spl$m_end_spell, suggested_replacement; set (Forward,current_buffer); !Spell check in forward direction set (Insert, current_buffer); !Do replacements in insert mode. edtp$set_status_line(current_window); !Reset status line !GET BEGIN AND END MARKS !Check for selected range edt$select_range; !Finish select of range (if there was one) If (edt$x_select_range <> 0) then !Check for select active spl$m_end_spell := end_of(edt$x_select_range); position(beginning_of(edt$x_select_range)); position(TEXT); edt$x_select_range := 0; edx_message("Spell checking selected range..."); Else position(TEXT); If mark(none) <> end_of(current_buffer) then move_horizontal(1) !So edt$beg_word doesn't go to previous word endif; edt$beg_word; !Move to beginning of current word spl$m_end_spell := end_of(current_buffer); !Set where to end spell checking edx_message("Spell checking..."); Endif; !Spell check a line of text loop. !Each time through main loop a line or subline of text is spell checked. LOOP exitif (mark(none)=end_of(current_buffer)); !exit if at end of buffer exitif (mark(none) >= spl$m_end_spell); curline := FAO("!"+str(current_offset)+"*"+" !AS",substr(current_line,current_offset+1,length(current_line))); result := call_user(393220,curline); !spell textline retcode := int(substr(result,1,9)); IF (retcode = LIB__NOTFOU) THEN !if a word was not found in dictionary edt$x_line := substr(result,10,length(result)); word_offset := int(edt$next_token(" ",term_char)); word_length := int(edt$next_token(" ",term_char)); suggested_replacement := edt$next_token(" ",term_char); position(LINE_BEGIN); move_horizontal( word_offset ); R1 := mark(none); move_horizontal(word_length-1); SPL$RN_MISSPELLED := create_range(R1,mark(none),reverse); update(current_window); ! Show word and line number word := substr( SPL$RN_MISSPELLED, 1, length(SPL$RN_MISSPELLED) ); change_case( word, UPPER); line_num := cursor_line_number; If (suggested_replacement <> "") then edtn$clear_message_window; Else EDX_MESSAGE("Unknown word !AS at line !ZL of !ZL", EDX$K_INFO, word, line_num, get_info(current_buffer,'record_count') ); Endif; ! Ask what to do Exitif (not Spl$what_to_do(SPL$RN_MISSPELLED,1,suggested_replacement)); !query Accept, Ignore, Guess, Dictionary,... SPL$RN_MISSPELLED := 0; !Unhighlight word update(current_window); Edx_message("Spell checking..."); !Say continuing spell checking ELSE !IF retcode = LIB$NOTFOU If (retcode <> LIB__NORMAL) then return(0) Endif; !Unknown error. Wasn't lib$_normal or lib$_notfou. move_by_line; !Go to next line ENDIF; !IF retcode = LIB$NOTFOU ENDLOOP; !'Spell check a line of text' loop EDX_MESSAGE("Finished spell checking."); ENDPROCEDURE !------------------------------------------------------------------------------ PROCEDURE SPL$WHAT_TO_DO( old_word_range, askcont, suggested_replacement ) ! target word is old_word_range ! ASKCONT = 1 ask user if should continue before continuing ! 0 continue without asking ! SUGGESTED_REPLACEMENT = word (or "") which is suggested correct word to use ! Ask user what to do about this target word. ! Handle replacement of target word. ! Returns 1 for continue, target word handled ! Returns 0 for don't continue, user requested stop ! If dictionary browse is initiated we abort straight back to TPU. LOCAL CMD, result, word, guess_word, new_word, Y_N, uppercase_target; ! upcased misspelled word !First check if there is a suggested replacement word supplied IF (suggested_replacement <> "") THEN uppercase_target := substr(old_word_range,1,length(old_word_range)); change_case( uppercase_target, UPPER ); Y_N := edx_read_line( FAO("Replace !AS with !AS? [(Y)es, (N)o]: ", uppercase_target, suggested_replacement),1); change_case(Y_N,UPPER); If (Y_N = "Y") then return spl$replace_word(old_word_range,suggested_replacement,1,askcont,0); Endif; ENDIF; !'Ask what to do' loop LOOP CMD := edx_read_line("Options: (A)ccept, (D)ictionary, (E)dit, (G)uess, (I)gnore, (P)ersdic, (Q)uit: ",1); change_case(CMD,upper); If (length(CMD) = 0) then CMD := "Q" Endif; !no response or Quit, exit 'Ask what to do' loop CASE CMD FROM "A" TO "Z" ["A"]:!ACCEPT WORD result := call_user(393222,""); !Accept word. Insert in binary tree of words to accept. move_horizontal(1); return(1); ["D"]:!DICTIONARY uppercase_target := substr(old_word_range,1,length(old_word_range)); change_case( uppercase_target, UPPER ); word := edx_read_line(FAO("Word to lookup [!AS]: ",uppercase_target),,"CTRL-Z"); IF ( (last_key <> ctrl_z_key) OR (length(word) <> 0) ) THEN If (length(word)=0) then word := uppercase_target endif; Return spl$dic_browse( word ); !dic_browse Aborts straight to interactive mode ENDIF; ["E"]:!EDIT new_word := edx_read_line("Enter exact replacement: ",,"CTRL-Z"); if new_word <> "" then return spl$replace_word(old_word_range,new_word,0,askcont,1); endif; ["G"]:!GUESS guess_word := spl$guess_mode; if ( guess_word <> "" ) then return spl$replace_word(old_word_range,guess_word,1,askcont,0); endif; ["I"]:!IGNORE move_horizontal(1); return(1); !just continue ["P"]:!Private Dictionary result := call_user(393223,""); !Add word to private dictionary. result := call_user(393222,""); !Accept word. Insert in binary tree of words to accept. move_horizontal(1); return(1); ["Q"]:!QUIT move_horizontal(1); SPL$RN_MISSPELLED := 0; !Unhighlight word update(current_window); Return(0); !Don't continue ENDCASE; !CASE OF what to do ENDLOOP; !'Ask what to do' loop ENDPROCEDURE !------------------------------------------------------------------------------ PROCEDURE SPL$REPLACE_WORD(old_word_range,new_word,samecase,askcont,posbeg) ! OLD_WORD_RANGE is range, usually SPL$RN_MISSPELLED ! NEW_WORD is string to replace old_word_range with ! SAMECASE = 1 for case sensitive word replacement ! 0 for exact word replacement ! ASKCONT = 1 ask user if should continue before continuing ! 0 continue without asking ! POSBEG = 1 position at beginning of word upon return ! 0 position at end of word upon return ! ! RETURNS 1 for continue ! 0 for don't continue LOCAL R1, Y_N, result; ENABLE_BUFFER_JOURNALING(CURRENT_BUFFER); deleted_word := substr(old_word_range,1,length(old_word_range)); erase(old_word_range); If (samecase = 1) then copy_text( jen$samecase(deleted_word,new_word) ); !spell done in insert mode else copy_text(new_word); !spell switches to insert mode endif; !Place deleted_word,new_word in spell memory for future reference result := call_user(393225,deleted_word+edt$x_space+new_word); !'00060009'x Save word correction move_horizontal( - length(new_word) ); R1 := mark(none); move_horizontal(length(new_word)-1); old_word_range := create_range(R1,mark(none),reverse); !Highlight new word move_horizontal(1); update(current_window); IF (askcont) then Y_N := edx_read_line("Continue? (Yes or No): ", 1); change_case(Y_N,UPPER); ELSE Y_N := "Y"; !don't ask, just continue. ENDIF; old_word_range := 0; !Unhighlight new word update(current_window); if (Y_N = "Y") then if (posbeg) then position(R1) endif; !Go to beginning of new word and check it too return (1); !Continue spell checking else return (0); !Don't continue spell checking endif; ENDPROCEDURE PROCEDURE SPL$GUESS_MODE ! Returns guessed word if user accepts one ! returns "" if no guesses were accpeted Local cw, Y_N, result, retcode, R1, target, guess_word; cw := current_window; edtn$clear_message_window; !Clear message window LOOP !'guess again' loop erase(prompt_buffer); !Prepare prompt buffer for message position(prompt_buffer); copy_text("Guessing, please wait..."); map(prompt_window,prompt_buffer); !Say "Guessing..." position(cw); update(prompt_window); result := call_user(393221,""); !Guess mode retcode := int(substr(result,1,9)); unmap(prompt_window); !Remove "Guessing..." message IF (retcode = LIB__NORMAL) THEN guess_word := substr(result,10,length(result)); Y_N := edx_read_line(FAO("I guess !AS, is that what you meant? [(Y)es, (N)o, (Q)uit guessing]: ",guess_word),1); change_case(Y_N,UPPER); If (Y_N = "Y") then return (guess_word); Else if (Y_N = "Q") then return(""); endif; Endif; ELSE !If retcode = lib$normal, else error or no more guesses Y_N := edx_read_line("I don't have any more guesses. Press RETURN",1); return(""); !didn't replace word ENDIF; !If retcode = lib$normal, else error or no more guesses ENDLOOP; !'guess again' loop ENDPROCEDURE !------------------------------------------------------------------------------ PROCEDURE SPL$DIC_BROWSE( WORD_PARAM ) ! Displays dictionary listing in buffer DIC ! Issues ABORT to return directly to interactive TPU ! Parameters: ! WORD_PARAM - can be one of three items: ! 1. string containing word to look up ! 2. integer = 1. Display next dictionary page ! 3. integer = -1. Display previous dictionary page LOCAL buffer_name, buffer_ptr, word, code, wl, wd, result, retstr, retcode, line, I, word_column_length; word_column_length := 20; !Also defined in edx_calluser !'00060001'x browse prev page code := 393218; !'00060002'x !'00060002'x browse using word !'00060003'x browse next page word := word_param; If ( get_info( word, 'type' ) = INTEGER ) then code := code + word; word := ""; Else if word = "" then word := edx_read_line("Word to look up: ",,"CTRL-Z"); IF length(word) = 0 then if (last_key = ctrl_z_key) then Return 0; !User wants to abort endif; ENDIF; endif; Endif; !INITIALIZE DIC BUFFER buffer_name := 'DIC'; if get_info(current_buffer,'name') <> buffer_name then make_two_windows(buffer_name,0) !This will create buffer_name if it doesn't yet exist endif; ! It leaves us in new buffer buffer_ptr := edt$find_buffer(buffer_name); !Get buffer ptr of new buffer set ( system, buffer_ptr); !Mark buffer as system type erase(buffer_ptr); wl := get_info(current_window,'visible_length') -2; wd := get_info(current_window,'width'); result := call_user( code, FAO("!8XL!8XL!AS", wl, wd, word ) ); !DIC BROWSE retcode := int(substr(result,1,9)); if retcode <> 1 then return(0) endif; retstr := substr(result,10,length(result)); change_case( retstr, LOWER ); IF word <> "" THEN If ( (get_info(top_window,'visible')) And (get_info(bottom_window,'visible')) ) Then EDX_MESSAGE("GOLD-W - Toggle single/dual windows. CTRL/D - Go to other window."); Else EDX_MESSAGE("GOLD-W - Toggle single/dual windows."); Endif; If ( Get_info(SPL$RN_MISSPELLED,'type') = RANGE ) Then EDX_MESSAGE("CTRL/Z - Enter line mode command. ENTER - Select word."); Else EDX_MESSAGE("CTRL/Z - Enter line mode command. SELECT - Copy word to PASTE buffer."); Endif; ENDIF; I := 1; loop exitif( I > length(retstr) ); line := substr(retstr,I,wd); !break up retstr into 80 character sublines edit( line, TRIM_TRAILING, OFF); !remove trailing blanks copy_text( line ); !put it on the screen (no s in dictionary) split_line; ! I := I + wd; ! endloop; !loop until all of retstr is on screen append_line; goto_top; I := 0; loop !now position ourselves on the middle column exitif( I = (wd/word_column_length)/2 );!exit when we're at the right column edt$move_word(forward); !move right over a column I := I + 1; endloop; edtn$highlight_word(spl$rn_dicword); !highlight our current word Abort; !Go straight to interactive move ENDPROCEDURE !------------------------------------------------------------------------------ PROCEDURE SPL$DICBUF_ENTER !Process the ENTER or RETURN key while in the DIC buffer. Select current !word and replace misspelled word with selected word. Local bufptr, bufnam, target, uppercase_target, uppercase_replacement, Y_N, R1; If get_info(SPL$RN_MISSPELLED,'type') <> RANGE then return endif; bufptr := get_info( SPL$RN_MISSPELLED, "buffer" ); bufnam := get_info( bufptr, "name" ); make_two_windows( bufnam, "" ); position( SPL$RN_MISSPELLED ); target := substr(SPL$RN_MISSPELLED,1,length(SPL$RN_MISSPELLED)); uppercase_target := target; change_case( uppercase_target, UPPER ); uppercase_replacement := substr(SPL$RN_DICWORD,1,length(SPL$RN_DICWORD)); change_case( uppercase_replacement, UPPER ); Y_N := edx_read_line(FAO("Replace !AS with !AS ? (Yes or No): ", uppercase_target,uppercase_replacement),1); change_case(Y_N,UPPER); If (Y_N = "Y") then ENABLE_BUFFER_JOURNALING(CURRENT_BUFFER); erase(SPL$RN_MISSPELLED); copy_text( jen$samecase(target,uppercase_replacement) ); move_horizontal(-1); R1 := mark(none); move_horizontal( -length(uppercase_replacement) + 1 ); SPL$RN_MISSPELLED := create_range(R1,mark(none),reverse); update(current_window); Y_N := edx_read_line("Continue spell checking? (Yes or No): ", 1); change_case(Y_N,UPPER); SPL$RN_MISSPELLED := 0; !unhighlight word if (Y_N = "Y") then spl$spell; !call spell and go endif; Else other_window; !Else go back to the dictionary buffer Endif; ! where we started. ENDPROCEDURE PROCEDURE SPL$DICBUF_SELECT !Process the SELECT (E4 or GOLD kp-period) key while in the DIC buffer. !Copy current word to paste buffer Local temp_position, word; temp_position := mark(none); erase(paste_buffer); position(paste_buffer); word := substr(SPL$RN_DICWORD,1,length(SPL$RN_DICWORD)); copy_text( substr(SPL$RN_DICWORD,1,length(SPL$RN_DICWORD))); position(temp_position); edx_message("Word '!AS' copied to PASTE buffer",EDX$K_INFO,word); ENDPROCEDURE PROCEDURE SPL$DICBUF_PAGE( DIRECTION ) !Process the Prev-screen / next-screen, advance section or reverse section !keys while in the DIC buffer. We display either the next or previous page !of the dictionary. if (direction = forward) then spl$dic_browse( 1 ) else spl$dic_browse( -1 ) endif; ENDPROCEDURE PROCEDURE SPL$DICBUF_UPDOWN(I) !Process the up/down arrow keys when in the DIC buffer !Move pointer up/down. Highlight current word (hopefully a dictionary word) edt$beg_word; move_vertical(I); edtn$highlight_word(spl$rn_dicword); ENDPROCEDURE PROCEDURE SPL$DICBUF_LEFT !Process the left arrow key when in the DIC buffer !Move left. Highlight current word. edt$move_word(reverse); edt$move_word(reverse); edtn$highlight_word(spl$rn_dicword); ENDPROCEDURE PROCEDURE SPL$DICBUF_RIGHT !Process the right arrow key when in the DIC buffer edt$move_word(forward); edtn$highlight_word(spl$rn_dicword); ENDPROCEDURE PROCEDURE DUMP_DICTIONARY !Lists ALL of the words in the EDX dictionary database file EDX_DICTIONARY.DAT !This information would be used by a system manager when creating a new !dictionary database file. LOCAL code, result, retstr, retcode, word_column_length, stchr, !first character of current word prev_1stchr; !first character of previous word word_column_length := 20; !Also defined in edx_calluser. These values should match. code := 393218; !'00060002'x Start browse at word do_command("FIND=*"); !Go to new empty buffer edx_message("Dumping contents of EDX dictionary to buffer"); result := call_user( code, !Starting the browse at "A" causes DIC_BROWSE FAO("!8XL!8XL!AS", 1, word_column_length, "A" ) ); !to return "" as the first string. retcode := int(substr(result,1,9)); if retcode <> 1 then return endif; code := 393219; !'00060003'x browse next word prev_1stchr := ""; LOOP result := call_user( code, FAO("!8XL!8XL", 1, 0 ) ); !DIC BROWSE (get next first word) (A 0 is specified for column length) retcode := int(substr(result,1,9)); !(EDX_CALLUSER returns 80 chars when 0 column length specified) exitif (retcode <> 1); retstr := substr(result,10,length(result)); edit( retstr, TRIM_TRAILING, LOWER, OFF ); exitif (retstr = ""); !At end of dictionary copy_text(retstr); split_line; stchr := substr( retstr, 1, 1); if (stchr <> prev_1stchr) then prev_1stchr := stchr; change_case( stchr, UPPER ); edx_message("Working on " + stchr + "..."); endif; ENDLOOP; edx_message("Dump complete"); ENDPROCEDURE PROCEDURE DUMP_COMMONWORDS !Displays in a buffer the commonwords list of the EDX dictionary database file. !This information is used by a system manager when creating a new dictionary !database. LOCAL code, result, retstr, retcode, save_wrap, save_lm; code := 393224; !'00060008'x Dump commonwords list result := call_user( code, "" ); !Get commonwords retcode := int(substr(result,1,9)); if retcode <> 1 then return (0) endif; retstr := substr(result,10,length(result)); do_command("FIND=*"); !Go to new empty buffer copy_text( retstr ); !common_words not journaled. Should not be accidentally changed anyway. position(beginning_of(current_buffer)); delete_character; save_wrap := edt$x_wrap_position; save_lm := edtn$v_left_margin; edt$x_wrap_position := 2; edtn$v_left_margin := 1; FILL_PARAGRAPH; edt$x_wrap_position := save_wrap; edtn$v_left_margin := save_lm; position(beginning_of(current_buffer)); ENDPROCEDURE !****************************************************************************** ! BUFFER JOURNAL RECOVERY !****************************************************************************** PROCEDURE JNL$RECOVER LOCAL file_info, dirspec, file_spec, mrk1, mrk2, rn1, buffer_name, buffer_ptr, session_start, cnum, sessnum, sessmax, CW, buffer_filename, domain, real_message_buffer; !SET FOR FULL MESSAGES SET(MESSAGE_FLAGS,15); !SAVE MESSAGE BUFFER real_message_buffer := message_buffer; !ADJUST MESSAGE WINDOW SIZE adjust_window( message_window, message_window_length-2, 0); !adjust message window message_window_length := 2; !new message_window_length !The real reason we ask the user to press return is to skip over that !VAXTPU 'Journal file not open' message. VAXTPU is still trying to do !a keystroke recovery. We know better. While the user is pressing return, !that message is silently passing by the message buffer. UNMAP(MESSAGE_WINDOW); !so user won't see VAXTPU 'Journal file not open' message CNUM := EDX_READ_LINE("Buffer Journal Recovery. Press "); ERASE(MESSAGE_BUFFER); !clear out the message MAP(MESSAGE_WINDOW,MESSAGE_BUFFER); EDTN$CLEAR_MESSAGE_WINDOW; !to erase edx_read_line prompt IF LAST_KEY = CTRL_Z_KEY THEN QUIT ENDIF; !even though we couldn't publicize it !INITIALIZE $RECOVER$ BUFFER buffer_name := '$RECOVER$'; set(screen_update,OFF); !don't show the mappings make_one_window(show_buffer); !goto main window CW := CURRENT_WINDOW; edtn$goto_buffer(buffer_name,0); buffer_ptr := edt$find_buffer(buffer_name); !Get buffer ptr of new buffer erase( buffer_ptr); set ( eob_text,buffer_ptr,""); set ( system, buffer_ptr); !Mark buffer as system type set ( status_line, cw, none, ""); set ( output_file, buffer_ptr, "Recover"); !For status line in case user goes to this buffer again set(screen_update,ON); update(cw); erase(show_buffer); !WE ALSO NEED A SCRATCH BUFFER. WE'LL USE THE SHOW_BUFFER dirspec := "TPU$JOURNAL:*.TPU$JOURNAL;*"; !'TPU$JOURNAL:*.TPU$JOURNAL' file_spec := FILE_SEARCH(""); !INITIALIZE FILE SEARCH !GET THE FIRST JOURNAL FILE file_spec := FILE_SEARCH(dirspec); If (file_spec = "") then split_line; split_line; copy_text("Sorry. No buffer journal files found. Try $ HELP @EDX_HELP RECOVER"); update(cw); quit; Endif; !GET THE EDITING SESSION DATES. PUT THEM IN SHOW_BUFFER FOR SORTING LOOP unmap(message_window); !don't show confusing messages but record them file_info := vs$get_journal_info(file_spec); !Attempt to open file. File may be locked by another user. edtn$clear_message_window; !reset message_window map(message_window,message_buffer); position(CW); !back to our window position(show_buffer); !back to our silent buffer If (get_info(file_info,'TYPE') = ARRAY) then COPY_TEXT(edx$date_convert(file_info{3},4,1,1,"-")+file_info{3}); !One for sorting, one for showing split_line; Endif; file_spec := FILE_SEARCH(dirspec); !GET NEXT FILE exitif file_spec = ""; !EXIT IF NO MORE FILES ENDLOOP; !NOW SORT THE EDITING START DATES. append_line; If mark(none) = end_of(show_buffer) then position(buffer_ptr); split_line; split_line; copy_text("Sorry. All buffer journal files inaccessible. Try $ HELP @EDX_HELP RECOVER"); update(cw); quit; Endif; SRT$SORT_SILENT("SORT BUFFER"+ "/KEY1=(POSITION:7,SIZE:2,DESCENDING)"+ !year "/KEY2=(POSITION:1,SIZE:2,DESCENDING)"+ !month "/KEY3=(POSITION:4,SIZE:2,DESCENDING)"+ !day "/KEY4=(POSITION:21,SIZE:11,DESCENDING)"+ !hour,minute,second "/NODUPLICATES"); !one of each !DETERMINE EDITING SESSION START TIME TO RECOVER SESSMAX := get_info (show_buffer, 'record_count'); position(buffer_ptr); IF (SESSMAX > 1) then copy_text(FAO("There are !UL recoverable editing sessions found. Which one is yours?",SESSMAX)); split_line; update(cw); !DISPLAY ALL THE EDITING SESSIONS. IN ORDER. BUFFER 'MAIN' FIRST. sessnum := 1; LOOP position(show_buffer); position(sessnum); session_start := substr(current_line,9,23); position(buffer_ptr); split_line; copy_text(FAO("!UL Session start time: !AS",sessnum,substr(session_start,1,20))); split_line; !DO DOMAIN=TRUE,FALSE DOMAIN:=TRUE; LOOP !LOOK FOR FILES WITH START DATE sesssion_start file_spec := FILE_SEARCH(""); position(buffer_ptr); LOOP file_spec := FILE_SEARCH(dirspec); exitif file_spec = ""; unmap(message_window); !don't show confusing messages but record them file_info := vs$get_journal_info(file_spec); edtn$clear_message_window; !reset message_window map(message_window,message_buffer); position(CW); !back to our window IF (get_info(file_info,'TYPE') = ARRAY) then IF (file_info{3} = session_start) then IF ((DOMAIN) AND (file_info{1} = "MAIN")) OR ((NOT DOMAIN) AND (file_info{1} <> "MAIN")) THEN If file_info{5} <> "" then buffer_filename := file_info{5}; !output file Else if file_info{6} <> "" then buffer_filename := file_info{6}; !original input file else buffer_filename := "(no file specified)"; endif; Endif; copy_text(FAO("!7* !12AS!AS",file_info{1},buffer_filename)); split_line; update(cw); ENDIF; ENDIF; ENDIF; ENDLOOP; EXITIF (NOT DOMAIN); DOMAIN:=FALSE; ENDLOOP; sessnum := sessnum + 1; exitif(sessnum > SESSMAX); ENDLOOP; !NOW ASK USER WHICH ONE edtn$clear_message_window; LOOP cnum := edx_read_line(FAO("Choose session number between 1 and !UL to recover: ",sessmax),,"CTRL-Z"); If (last_key = ctrl_z_key) then quit Endif; sessnum := int(cnum); !convert text to integer Exitif ( (sessnum > 0) AND (sessnum <= SESSMAX) ); ENDLOOP; split_line; split_line; ELSE !else SESSMAX = 1 (hopefully) sessnum := 1; ENDIF; ! position(show_buffer); position(sessnum); session_start := substr(current_line,9,23); !Full session start time position(buffer_ptr); !RECOVER BUFFER 'MAIN' !DO DOMAIN = TRUE,FALSE 1=recover buffer MAIN. 2=recover other buffers <> MAIN DOMAIN:=TRUE; LOOP file_spec := FILE_SEARCH(""); position(buffer_ptr); LOOP file_spec := FILE_SEARCH(dirspec); exitif file_spec = ""; unmap(message_window); !don't show confusing messages but record them file_info := vs$get_journal_info(file_spec); !get info on journal file edtn$clear_message_window; !reset message_window map(message_window,message_buffer); position(CW); !back to our window and our buffer IF (get_info(file_info,'TYPE') = ARRAY) then IF (file_info{3} = session_start) then IF ((DOMAIN) AND (file_info{1} = "MAIN")) OR ((NOT DOMAIN) AND (file_info{1} <> "MAIN")) THEN COPY_TEXT("RECOVERING"); move_horizontal(-1); mrk2 := mark(none); position(LINE_BEGIN); mrk1 := mark(none); rn1 := create_range(mrk1,mrk2,BLINK); POSITION(LINE_END); update(cw); position(show_buffer); !must position to another buffer message_buffer := buffer_ptr; !so messages can be freely scrolled RECOVER_BUFFER(file_info{1},file_spec); message_buffer := real_message_buffer; position(end_of(buffer_ptr)); COPY_TEXT("PRESS ANY KEY TO CONTINUE:"); !pause while user reads messages move_horizontal(-1); !from RECOVER_BUFFER. mrk2 := mark(none); position(LINE_BEGIN); mrk1 := mark(none); rn1 := create_range(mrk1,mrk2,REVERSE); POSITION(LINE_END); update(cw); CNUM := READ_KEY; rn1 := 0; erase_line; !Erase prompt split_line; split_line; update(cw); ENDIF; ENDIF; ENDIF; ENDLOOP; EXITIF (NOT DOMAIN); !already done both MAIN and others DOMAIN:=FALSE; !now do others ENDLOOP; !LEAVE USER IN BUFFER MAIN (whether or not it was recovered.) edtn$goto_buffer("MAIN",0); position(beginning_of(current_buffer)); edtn$clear_message_window; edx_message("RECOVERY COMPLETE -- Now save everything and exit the editor",EDX$K_SUCCESS_HIGHLIGHT); update(cw); set(message_flags,1); !Back to normal with just the text. !Now user's /COMMAND file gets run automatically. ENDPROCEDURE !****************************************************************************** ! MISCELLANEOUS !****************************************************************************** PROCEDURE EDTN$MATCH_PAREN Local pairlist, !List of parenthesis paren, !The starting parenthesis (either right or left) endparen, !The matching parenthesis to look for parenpar, !Paren + endparen pat, !Pattern ran, !Search range char, !current character X, !Index into pairlist dr, !Direction +1 or -1 direction, !Direction forward or reverse nested, !Number of nested parenthesis start_mark, !Position of starting paren MK; !Marker !INITIALIZE position(TEXT); MK := mark(none); pairlist := "{[<(}]>)"; !SEARCH FOR FIRST PARENTHESIS If (current_direction = forward) then dr := 1; Else dr := -1; Endif; !IF CURRENTLY ON HIGHLIGHTED PARENTHESIS THEN MOVE OFF IT. !UNLESS WE ARE AT BEGINNING OR END OF LINE. If ((MK = edtn$m_right_paren) or (MK = edtn$m_left_paren)) then !If currently on a previously set mark if (current_offset=0) then dr := 1; endif; !if at beginning of line move_horizontal(dr); Endif; !SEARCH FOR PAREHTHESIS If (NOT jen$search_line(pairlist,dr)) then !If parenthesis not found in dr direction then position(MK); !go back to start dr := -dr; !switch directions if (current_offset<>0) then move_horizontal(dr); endif; !move one char off start (unless at beginning of line) if (NOT jen$search_line(pairlist,dr)) then !Search again (other direction) position(MK); edx_message("Parenthesis not found on current line"); !if not found then no more parenthesis on this line return(0); endif; Endif; !Else parenthesis found, cursor on parenthesis !MARK PARENTHESIS AND PREPARE TO SEARCH FOR MATCH start_mark := mark(none); !Mark starting position X := index(pairlist,current_character); !Find what parenthesis it is if (X <= 4) then !If a left paren dr := 1; !set search forward direction := forward; edtn$m_left_paren := mark(reverse); !and highlight left paren edtn$m_right_paren := 0; !reset other global marker else !else a right paren dr := -1; !set search reverse direction := reverse; edtn$m_right_paren := mark(reverse); !and highlight right paren edtn$m_left_paren := 0; !reset other global marker endif; !GET CHARACTER TO SEARCH FOR paren := current_character; endparen := substr(pairlist, X+(dr*4),1); parenpar := endparen + paren ; pat := any(parenpar); !SEARCH FOR MATCHING PARENTHESIS nested := 1; !Start at nested value 1 LOOP move_horizontal(dr); !Don't match current character IF (index(parenpar,current_character)=0) then !Don't trust search to catch current character ran := search(pat,direction,exact); !Search for next paren If (ran <> 0) then position(beginning_of(ran)); Else edx_message ("Matching parenthesis not found"); !give message edtn$clear_paren; exitif; !and exit Endif; ENDIF; IF (current_character = paren) then if ( mrk$lines_between_markers(start_mark,mark(none)) > edtn$v_maxlines_match_paren ) then edx_message ("Matching parenthesis not found"); !give message edtn$clear_paren; exitif; !and exit else nested := nested + 1; endif; ELSE nested := nested -1; if (nested = 0) then !We've found the matching parenthesis if (dr = 1) then edtn$m_right_paren := mark(reverse); else edtn$m_left_paren := mark(reverse); endif; exitif; !exit search. Match found endif; ENDIF; ENDLOOP; position(start_mark); !End at where we started ENDPROCEDURE PROCEDURE EDTN$CLEAR_PAREN !Clear the marks on the matching parenthesis !Also clear the highlight on latest misspelled word found by SPELL edtn$m_right_paren := 0; edtn$m_left_paren := 0; spl$rn_misspelled := 0; ENDPROCEDURE !------------------------------------------------------------------------------ PROCEDURE EDTN$DIFFERENCES(bufnam1,bufnam2) !Compare buffer bufnam1 with buffer bufnam2. ! !If parameters bufnam1 and bufnam2 are given, then map bufnam1 to top !window, map bufnam2 to bottom window, and start at the top of each !buffer comparing line by line until a difference is found. ! !If bufnam1 and bufnam2 are null strings, then assume dual windows are !already in use with the two buffers to be compared. Compare the current !line in the top window with the current line in the bottom window. If !the two match, move to the next line. Continue comparing line by line !until a difference is found. ! !When a difference is found, temporarily highlight the lines which don't !match. ! !26-MAR-1990 Modified so you can check the same buffer at two different ! places. D.D. ! !08-NOV-1991 Modified so it shows where in the line the difference is. ! Removed recursive call to ourselves. ! LOCAL buf1, buf2, line1, line2, mark1a, mark1b, mark2a, mark2b, R1, R2, window1, window2, inkey, key_func, indx, R1U, R2U, mark1u, mark2u; If (NOT get_info(system,'display')) then edx_message("Can not do differences while in /NODISPLAY mode"); return(0); Endif; IF (bufnam1 <> "") and (bufnam2 <> "") then !Start fresh. Two buffers given !SEE IF BUFFERS EXIST buf1 := edt$find_buffer(bufnam1); if buf1 = 0 then edx_message("buffer !AS does not exist",EDX$K_ERROR_HIGHLIGHT,bufnam1); return 0; endif; buf2 := edt$find_buffer(bufnam2); if buf2 = 0 then edx_message("buffer !AS does not exist",EDX$K_ERROR_HIGHLIGHT,bufnam2); return 0; endif; !MAP BUFFERS TO SCREEN if (get_info(main_window,'visible')) then unmap (main_window) endif; map (top_window, buf1); edtp$set_status_line(top_window); position(beginning_of(buf1)); update(top_window); map (bottom_window, buf2); position(beginning_of(buf2)); update(bottom_window); edtp$set_status_line(bottom_window); position(top_window); ELSE !Assume already set up. Top and bottom windows are mapped. !Cursor positioned on two matching lines. !SEE IF WE'RE ALREADY SET UP If not ( get_info(top_window,'visible') and get_info(bottom_window,'visible') ) then edx_message("Dual windows not in use."); return 0; endif; ENDIF; if (current_window = top_window) then window1 := top_window; buf1 := get_info(top_window,'buffer'); window2 := bottom_window; buf2 := get_info(bottom_window,'buffer'); else window1 := bottom_window; buf1 := get_info(bottom_window,'buffer'); window2 := top_window; buf2 := get_info(top_window,'buffer'); endif; !We are positioned in buf1 and wish to compare it with buf2 position(window2); ! position(buf2); position(TEXT); move_horizontal(1); position(LINE_BEGIN); line2 := current_line; position(window1); ! position(buf1); position(TEXT); move_horizontal(1); position(LINE_BEGIN); line1 := current_line; LOOP !Compare line1 with line2 IF (line1 <> line2) then !BOLD DIFFERING LINES position(window1); ! position(buf1); position(LINE_BEGIN); mark1a := mark(none); position(LINE_END); mark1b := mark(none); R1 := create_range(mark1a,mark1b,bold); position(window2); ! position(buf2); position(LINE_BEGIN); mark2a := mark(none); position(LINE_END); mark2b := mark(none); R2 := create_range(mark2a,mark2b,bold); !UNDERLINE FROM START OF LINE TO FIRST DIFFERENCE indx := 1; !Find where first difference in line is LOOP exitif(substr(line1,indx,1) <> substr(line2,indx,1)); indx := indx + 1; !seems to work if you pass the end of line ENDLOOP; position(window1); !Do window1 first position(LINE_BEGIN); move_horizontal(indx-1); mark1u := mark(BLINK); R1U := create_range(mark1a,mark1u,UNDERLINE); update(window1); !Lock cursor at current position position(window2); !Now do window2 position(LINE_BEGIN); move_horizontal(indx-1); mark2u := mark(BLINK); R2U := create_range(mark2a,mark2u,UNDERLINE); update(window2); !Lock cursor at current position !PROMPT FOR INPUT position(window1); !Go back to where we really are edx_message("Press keypad ENTER to continue differences"); inkey := read_key; !Press any key to continue !The following code can cause a fatal TPU internal error if the user enters the !line mode command FIX CRLFS. This problem has been fixed as of VMS 4.6 If (inkey <> ENTER) then key_func := lookup_key(inkey,program); if (key_func <> 0) then execute (key_func) endif; return; Endif; ENDIF; !Get next lines position(window2); ! position(buf2); move_vertical(1); if mark(none) = end_of(current_buffer) then update(window2); !Lock cursor at new position position(window1); ! position(buf1); move_vertical(1); return; endif; line2 := current_line; position(window1); ! position(buf1); move_vertical(1); if mark(none) = end_of(current_buffer) then position(window2); ! position(buf2); update(window2); !Lock cursor at new position position(window1); ! position(buf1); return; endif; line1 := current_line; ENDLOOP; ENDPROCEDURE !------------------------------------------------------------------------------ PROCEDURE EVE$TRIM_BUFFER ! Remove trailing spaces from each line in a buffer. ! Only trim spaces, not other whitespace. ! LOCAL this_position, ! Marker for current cursor position trim_range; ! Range with trailing spaces ON_ERROR if error = tpu$_strnotfound then trim_range := 0; endif; ENDON_ERROR; edx_message("Trimming buffer..."); ENABLE_BUFFER_JOURNALING(CURRENT_BUFFER); this_position := mark(free_cursor); position (beginning_of (current_buffer)); loop trim_range := search ( span(eve$x_whitespace) & line_end, forward, exact); exitif trim_range = 0; position (beginning_of (trim_range)); erase_character (length (trim_range)); endloop; position (this_position); edx_message("Trimming complete."); ENDPROCEDURE; !------------------------------------------------------------------------------ PROCEDURE EVE_FIX_CRLFS !+ ! FIX_CRLFS.TPU - Routine to turn CRLFs into line breaks ! and remove leading CRs and trailing CRLFs !- LOCAL the_range, cw, !current window filename, !file name nw, !no_write buf, !buffer bufnam, !buffer name here, !Current location opf, !Output file name inmain; !TRUE if we are doing buffer MAIN ON_ERROR [TPU$_STRNOTFOUND]: !suppress string not found message and continue [OTHERWISE]: !otherwise return(false) ENDON_ERROR; ! Insure this is a buffer we can fix IF (GET_INFO(CURRENT_BUFFER,"SYSTEM")) THEN EDX_MESSAGE("You are in a system buffer."); RETURN (0); ENDIF; ! ! First remove the CRLFs. If they are not at the EOL, add a line break. ! ENABLE_BUFFER_JOURNALING(CURRENT_BUFFER); 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)); 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. ! position(beginning_of(current_buffer)); loop the_range := search(ascii(13), FORWARD); exitif (the_range = 0); position(end_of(the_range)); if (current_offset <> 0) then split_line; endif; erase(the_range); endloop; !NOW INSURE THE BUFFER WILL BE WRITTEN WITH PROPER RECORD ATTRIBUTES ! OF CARRIAGE RETURN CARRIAGE CONTROL !This need only be done if the current buffer was created with a file in it. !If so, then we copy over the contents of the buffer to a new buffer !The old buffer is deleted, and the new buffer is created with the same name. !If there are buffer pointer variables, such as main_buffer, that's a problem. !Here we check if main_buffer points to this buffer and reassign it if !necessary. filename := get_info(current_buffer,'file_name'); IF (filename <> "") then !Hope we are not already in the show buffer !The show buffer is created without a name so we should be safe here. here := mark(none); buf := current_buffer; if get_info(system,'display') then cw := current_window endif; bufnam := get_info(buf,'name'); nw := get_info(buf,"no_write"); opf := get_info(buf,'output_file'); erase(show_buffer); position(show_buffer); copy_text(buf); !show_buffer not journaled If (buf = main_buffer) then inmain := TRUE; !we're doing the main buffer Else inmain := FALSE; Endif; delete(buf); !(current_window saved in cw) buf := edtn$create_buffer(bufnam,""); If (inmain) then main_buffer := buf endif; !Reassign main_buffer ENABLE_BUFFER_JOURNALING(BUF); if (opf = 0) then opf := filename; endif; set(output_file,buf,opf); if (NOT nw) then set(no_write, buf, OFF); endif; position(beginning_of(buf)); move_text(show_buffer); !buf is created in insert mode. No TAB errors. if get_info(system,'display') then map(cw, buf); else position(buf); endif; Endif; ENDPROCEDURE !------------------------------------------------------------------------------ PROCEDURE EDTN$INSERT_LINE(char) ! Insert a line of characters above the current line to use as a delimiter ! Char - character to make line out of. "" to prompt. LOCAL line_char, rm, lead_chars, trail_chars, N; !GET THE CHARACTER TO USE FOR THE LINE If (char = "") then line_char := edx_read_line('Char: ',1,"CTRL-Z"); if length(line_char) = 0 then return; endif; else line_char := substr(char,1,1); endif; !IF AT BEGINNING OF LINE THEN !ADD APPROPRIATE COMMENT CHARACTER(S) FOR THIS TYPE FILE ENABLE_BUFFER_JOURNALING(CURRENT_BUFFER); if (current_offset = 0) then if (edtn$comment_character(current_buffer,lead_chars,trail_chars)) then copy_text(lead_chars); !(no s ) endif; else lead_chars := ""; trail_chars := ""; endif; !CALCULATE THE NUMBER OF LINE_CHAR'S TO FINISH OFF LINE if edt$x_wrap_position <> 0 then rm := edt$x_wrap_position; else rm := get_info (current_window,'width'); endif; N := rm - get_info(current_buffer,'offset_column') - length(trail_chars); !PUT IN THE LINE if (N > 0) then copy_text(FAO("!"+str(N)+"*"+line_char)); !Faster than looping? endif; if (length(trail_chars) > 0) then copy_text(trail_chars); !(no s ) endif; !END BY GOING TO NEW LINE if (current_character = "") then move_horizontal(1); endif; ENDPROCEDURE PROCEDURE EDTN$COMMENT_CHARACTER(WHICH_BUFFER,LEAD_CHARS,TRAIL_CHARS) ! Determine the file type of the current buffer and return the appropriate ! comment character(s) for that file type. ! PARAMETERS: ! which_buffer - buffer to check ! lead_chars - characters inserted at the beginning to delimit a comment ! trail_chars - characters inserted at the end to delimit a comment ! Return status = 0 - no comment characters returned ! 1 - comment characters returned LOCAL file_name, file_type; lead_chars := ""; trail_chars := ""; File_name := edtn$filename_of_buffer(which_buffer); If file_name = "" then Return (0); Endif; file_type := file_parse(file_name,"","",TYPE); IF (file_type = '.FOR') OR (file_type = '.FTN') OR (file_type = '.IFT') OR (file_type = '.DK') THEN lead_chars := "C"; Return(1); ENDIF; IF (file_type = '.COM') THEN lead_chars := "$!"; Return(1); ENDIF; IF (file_type = '.MAR') THEN lead_chars := ";" ; Return(1); ENDIF; IF (file_type = '.TPU') OR (file_type = '.HLP') OR (file_type = '.FDL') THEN lead_chars := "!"; Return(1); ENDIF; IF (file_type = '.PAS') THEN lead_chars := "(*"; trail_chars := "*)"; Return (1); ENDIF; IF (file_type = '.ADA') THEN lead_chars := "--"; Return (1); ENDIF; IF (file_type = '.C') THEN lead_chars := "/*"; trail_chars := "*/"; Return (1); ENDIF; IF (file_type = '.BAS') THEN lead_chars := "REM "; Return (1); ENDIF; Return(0); ENDPROCEDURE !------------------------------------------------------------------------------ PROCEDURE EDTN$CALC If (length(edt$x_line) = 0) then if get_info(system,'display') then edt$x_line := Edx_read_line("CALC> ",,"CTRL-Z"); endif; if (length(edt$x_line)=0) then return; endif; Endif; execute("edx_message(str("+edt$x_line+"))"); ENDPROCEDURE !------------------------------------------------------------------------------ PROCEDURE EDT$DEFINE_KEY !ctrl k (define key) ! Define a key as a VAXTPU command LOCAL def, input_key, cw; def := edx_read_line('Enter VAXTPU Definition for key: ',,"CTRL-Z"); if (length(def) = 0) then return; endif; cw := current_window; !Mark current window edtn$clear_message_window; !Clear message window erase(prompt_buffer); !Prompt for input position(prompt_buffer); ! . copy_text("Press key to define:"); ! . map(prompt_window,prompt_buffer); ! . position(cw); !Go back to user's buffer update(prompt_window); ! . input_key := READ_KEY; !Read input unmap(prompt_window); !Remove prompt update(message_window); !Reset message_window to bottom of buffer if (input_key = ret_key) then edx_message("Can not redefine RETURN key"); else define_key(def,input_key); endif; ENDPROCEDURE !------------------------------------------------------------------------------ PROCEDURE EVE_SET_LEFT_MARGIN(LM) local new_left_margin, ! Local copy of set_parameter set_parameter, term_char; set_parameter := LM; if (set_parameter = "") then if get_info(system,'display') then set_parameter := edx_read_line('Set left margin to: ',,"CTRL-Z"); endif; if (set_parameter = "") then edx_message("Left margin unchanged"); return; endif; endif; if set_parameter = "#" then new_left_margin := get_info(current_buffer,'offset_column'); else new_left_margin := INT(set_parameter); if (new_left_margin <= 0) then edx_message("Left margin must be a positive integer"); return; endif; endif; edtn$v_left_margin := new_left_margin; edx_message("Left margin set to !SL", EDX$K_INFO, new_left_margin); ENDPROCEDURE; !------------------------------------------------------------------------------ !+ ! Procedures for emulating the EDT style GOLD digit commands. !- PROCEDURE EDT$GOLD_NUMBER ( FIRST_DIGIT) !gold 0..9 (repeat counts) LOCAL number, key, key_code, key_type, keynum, idx, here, cw; !+ ! Now get the count in here !- number := first_digit; here := mark(free_cursor); !Mark current position cw := current_window; !Mark current window edtn$clear_message_window; !Clear message window erase(prompt_buffer); !Prompt for input position(prompt_buffer); ! . copy_text(number); ! . map(prompt_window,prompt_buffer); ! . loop update(prompt_window); ! . key := READ_KEY; !Read next key if (key = ctrl_z_key) then !User wants to abort unmap(prompt_window); !Remove prompt update(message_window); !Reset message_window to bottom of buffer return; endif; ! See if it was a digit keynum := ""; if (key = key_name('0')) then keynum := '0' endif; if (key = key_name('1')) then keynum := '1' endif; if (key = key_name('2')) then keynum := '2' endif; if (key = key_name('3')) then keynum := '3' endif; if (key = key_name('4')) then keynum := '4' endif; if (key = key_name('5')) then keynum := '5' endif; if (key = key_name('6')) then keynum := '6' endif; if (key = key_name('7')) then keynum := '7' endif; if (key = key_name('8')) then keynum := '8' endif; if (key = key_name('9')) then keynum := '9' endif; if (keynum <> "") then number := number + keynum; copy_text(keynum); !in prompt_buffer else exitif; endif; endloop; position(cw); !Return to former position position(here); ! unmap(prompt_window); !Remove prompt update(message_window); !Reset message_window to bottom of buffer edt$x_repeat_count := int(number); !Get the numeric value If (key = key_name(kp3,shift_key)) then !If the key was special insert ENABLE_BUFFER_JOURNALING(CURRENT_BUFFER); vs$copy_char(ascii(edt$x_repeat_count)); !stick the character in Else !else do repeat counts ! ! Look up the key definition. If there was one, then execute it ! If there isn't a definition, check to see if it is a printable they ! are trying to insert. ! key_code := lookup_key(key,program); if (key_code <> 0) then loop !We check for an execute error by checking for a change !in the message buffer. execute(key_code); here := mark(free_cursor); position(end_of(message_buffer)); move_vertical(-1); if current_character <> "" then edt$x_repeat_count := 1 endif; position(here); edt$x_repeat_count := edt$x_repeat_count - 1; exitif edt$x_repeat_count < 1; endloop; else key := int(key); !VAXTPU version 2 requires this idx := (key - ((key/65536) * 65536 )) / 256; !(key - ((key/10000X) * 10000X)) / 100X; integer division. key_type := ((( key * 16 ) / 16 ) / 16777216 ); !((( key * 10X ) / 10X ) / 1000000X ); integer division. CASE key_type from 0 to 7 [0,4]:!PRINTABLE CHARACTER or SHIFT PRINTABLE CHARACTER ENABLE_BUFFER_JOURNALING(CURRENT_BUFFER); loop vs$copy_char(ascii(idx)); edt$x_repeat_count := edt$x_repeat_count - 1; exitif edt$x_repeat_count < 1; endloop; ENDCASE; endif; Endif; edt$x_repeat_count := 1; ENDPROCEDURE; !------------------------------------------------------------------------------ PROCEDURE EDTN$TPUCOMMAND(LINE_READ) !Originally from edt$command LOCAL upcase_line_read, inf, x; !CHECK FOR THE NULL COMMAND If (line_read = "") then Return (1); Endif; !GET OLD SETTINGS AND SWITCH INFORMATIONAL MESSAGES ON inf := get_info(system, 'informational'); set (informational,on); !CHECK THE COMMAND edit (line_read, trim_leading, OFF); !See if the person typed help. If so, display help for TPU upcase_line_read := line_read; edit (upcase_line_read, upper, trim, OFF); If ( index('HELP',upcase_line_read) = 1) then edt$help ("EDX_HELP","HELP TPU"); Return (1); Endif; !FIX MESSAGE WINDOW (VMS 5.3 BUG) update(message_window); !COMPILE THE COMMAND x:=compile(line_read); !EXECUTE IF NO ERROR COMPILING If get_info(x,'type') = PROGRAM then execute(x); Endif; !RESET OLD INFO SETTING if (inf=0) then set (informational,off); endif; ENDPROCEDURE !------------------------------------------------------------------------------ PROCEDURE EDTN$TOGGLE_NUMERIC_KEYPAD LOCAL keymap_name; !SEE IF WE'RE IN NUMERIC KEYPAD MODE keymap_name := get_info(key_map,"first","tpu$key_map_list"); loop exitif keymap_name = 0; if keymap_name = "EDTN$KM_NUMERIC_KEYPAD" then remove_key_map("tpu$key_map_list", "edtn$km_numeric_keypad", all); edx_message("Exiting numeric keypad mode"); return; endif; keymap_name := get_info(key_map,"next","tpu$key_map_list"); endloop; !IF WE DROP OUT THE BOTTOM THEN WE WEREN'T IN NUMERIC KEYPAD MODE !SET NUMERIC KEYPAD MODE add_key_map("tpu$key_map_list", "first", "edtn$km_numeric_keypad"); edx_message("Entering numeric keypad mode"); ENDPROCEDURE !------------------------------------------------------------------------------ !Here so we can fix up the message window on VMS 5.3 so messages will !be displayed properly. The trick is to update the message window BEFORE !printing the message IF internally .message_window[wcb_v_repaint] is TRUE. PROCEDURE EDX_MESSAGE( MESSAGE_STRING; CODE, FAO_1, FAO_2, FAO_3, FAO_4, FAO_5, FAO_6, FAO_7, FAO_8, FAO_9, FAO_10) LOCAL HIGHLIGHT_MESSAGE, SEVERITY_CODE; !Bug fix VMS 5.3 message window. (See description of problem at head of this file) !Just always do it !If ( (get_info(system,'version') > 2) !If TPU = 3.x or higher !or ((get_info(system,'version') = 2) !or TPU = 2.4 or higher !and (get_info(system,'update') >= 4)) ) !then If get_info(message_window,"type") = WINDOW then If get_info(message_window,"buffer") <> 0 then update(message_window) !Sync message window Endif; Endif; !Endif; If code = TPU$K_UNSPECIFIED then Message( message_string ); Else highlight_message := (code and 8); ! code .and. '1000' (i.e. test bit 3) severity_code := (code and 3); ! code .and. '0011' (i.e. omit bit 3) if (highlight_message<>0) then set(message_action_type,reverse); !highlight this message (sync message window) endif; Message( message_string, severity_code, fao_1, fao_2, fao_3, fao_4, fao_5, fao_6, fao_7, fao_8, fao_9, fao_10); if (highlight_message<>0) then set(message_action_type,NONE); !Reset to nohighlight endif; Endif; ENDPROCEDURE !------------------------------------------------------------------------------ PROCEDURE EDTN$FIT_MESSAGE( MSGSTR, FAO1; FAO2 ); !Used to write the following messages: ! "Reading in file !AS" FAO1 = filename ! "Reading in text library module !AS" FAO1 = module_name ! "Creating new file !AS" FAO1 = filename ! "Writing buffer file !AS" FAO1 = buffer_name, FAO2 = filename ! "Writing selected range to file !AS" FAO1 = filename ! "!UL lines read from text library !AS" FAO1 = buffer_name, FAO2 = module_name ! ! In all cases, if the whole message is too long to fit on one line of the ! message window, the message is broken up into two lines with the filename ! (being the last FAO parameter) on the second line. ! ! If future needs arise we can easily add FAO3, FAO4,... to parameter list ! Local message_window_width, message_string, message_length, message_1, message_2; !GET MESSAGE WINDOW WIDTH If get_info(system,'display') then message_window_width := get_info(message_window,'width'); ! the width of the screen Else message_window_width := 80; ! default width to 80 in /nodisplay mode Endif; !FIGURE TOTAL LENGTH OF MESSAGE message_string := FAO( msgstr, FAO1, FAO2 ); message_string_length := length(message_string); !PRINT THE MESSAGE If (message_string_length <= message_window_width) then edx_message( message_string ); Else message_1 := FAO( substr(msgstr,1,length(msgstr)-4), FAO1, FAO2 ); !Strip of the last " !AS" from FAO control string edx_message( message_1 ); edx_message( substr(message_string,length(message_1)+1,message_string_length)); Endif; ENDPROCEDURE !------------------------------------------------------------------------------ !PROCEDURE EDTN$SIGNAL( ERR; ERRTXT ) !! NO LONGER USED !! This procedure causes the error message associated with the !! error that was trapped to be printed. !! If severity was ERROR then message was already printed by TPU. !! If severity was WARNING then we must print the message. !! Parameters: !! ERR - error that was trapped. !! ERRTXT - optional error text string to use. !! !LOCAL result, saved_flags; !CASE get_info( ERR, "type" ) ! [INTEGER]: ! result := call_user(65541,str(err)); !'00010005'x Signal error ! [KEYWORD]: ! !Print only if this is a warning severity message. ! !Error severity messages are already printed automatically by TPU ! If ( message_text(err,TPU$K_MESSAGE_SEVERITY) = "%W" ) then !If warning ! saved_flags := get_info( SYSTEM, "message_flags" ); ! set(message_flags,15); !Set all message flags to identify this ! if errtxt <> tpu$k_unspecified then ! edx_message( errtxt ); ! else ! edx_message( err ); !as an unexpected warning. ! endif; ! set(message_flags,saved_flags); ! Endif ! [STRING]: ! edx_message( err ); ! ENDCASE; !ENDPROCEDURE !------------------------------------------------------------------------------ PROCEDURE EVE_ELIMINATE_TABS ! Turn TABs to spaces LOCAL target, n, entry_mode; ON_ERROR ENDON_ERROR; ENABLE_BUFFER_JOURNALING(CURRENT_BUFFER); entry_mode := get_info(current_buffer,'mode'); set (insert,current_buffer); position(beginning_of(current_buffer)); loop target := search(ascii(9), FORWARD); exitif (target = 0); position(beginning_of(target)); erase_character(1); n := current_offset; n := n - (8 * (n / 8)); copy_text(substr(" ", 1, 8 - n)); endloop; position(end_of(current_buffer)); if entry_mode = overstrike then set (overstrike,current_buffer) endif; ENDPROCEDURE !------------------------------------------------------------------------------ PROCEDURE RING_BELL(MSGSTR) LOCAL old_bell; old_bell := get_info(SYSTEM,'bell'); !Save old bell setting set (bell,all,on); !Prepare to ring the warning bell edx_message(MSGSTR); !Ring bell by printing message set (bell,all,off); if (old_bell <> 0) then !Reset bell to former setting set (bell,old_bell,on) endif; ENDPROCEDURE !------------------------------------------------------------------------------ !****************************************************************************** ! VERSION SPECIFIC !****************************************************************************** !This section contains routines which require TPU version TPU 2.4 or greater !They use new features of TPU introduced in the higher versions. The editor !attempts to upgrade itself when it detects a version upgrade has been taken !place. These routines are prefixed with VS$ indicating version specific. !------------------------------------------------------------------------------ ! PROCEDURE VS$CHECK_VERSION !Check the VAXTPU version number. If there has been an upgrade ask !for the system manager. !This version of VS$CHECK_VERSION checks to see if TPU 2.4 exists. LOCAL Y_N, SECFILE; IF ( (GET_INFO(SYSTEM,'VERSION') > 2) !If TPU = 3.x or higher OR ((GET_INFO(SYSTEM,'VERSION') = 2) !or TPU = 2.4 or higher AND (GET_INFO(SYSTEM,'UPDATE') >= 4)) ) THEN set(bell,all,on); !Ring bell once message("Apparently there has been a recent system upgrade. EDX would like to perform"); set(bell,all,off); message("an internal upgrade to make use of new features now available."); message(""); !Open a line at the bottom for prompt to overwrite set(prompt_area,(screen_length),1,reverse); !Set prompt area to bottom of screen Y_N := read_line("Are you the system manager? [NO]: "); update(message_window); !necessary to avoid VMS 5.3 bug edit(Y_N,trim,upper,OFF); IF (index("YES",Y_N) = 1) THEN Y_N := FILE_SEARCH(""); SECFILE := FILE_SEARCH(FILE_PARSE(GET_INFO(SYSTEM,'SECTION_FILE'),".TPU$SECTION")); message(FAO("The current EDX section file is !AS",SECFILE)); message("With your permission EDX will recompile a few internal routines and create a"); message("new section file. You must have enough privilege to create a file in the above"); message("directory. The old section file is left behind. This message will not appear"); message("after the upgrade has been completed. Enhanced features are:"); message(" 1. Buffer Journaling instead of keystroke journaling"); message(" 2. Bugfixes for VMS 5.4 fatal internal VAXTPU errors"); message(""); !Open a line at the bottom for prompt to overwrite Y_N := read_line("Do you wish to do this now? [NO]: "); update(message_window); !necessary to avoid VMS 5.3 bug edit(Y_N,trim,upper,OFF); IF (index("YES",Y_N) = 1) THEN set (message_flags, 15); !Full messages set (informational,on); !Include informational VS$UPGRADE_EDX; !Do the upgrade COMPILE("PROCEDURE VS$UPGRADE_EDX ENDPROCEDURE"); !Don't need this procedure anymore. SECFILE := SUBSTR(SECFILE,1,INDEX(SECFILE,";")); SAVE(SECFILE); message(""); do_command("SHOW VERSION"); !Show the new version message(""); message("Check the new section file's protection and ownership."); QUIT; ENDIF; ENDIF; set(prompt_area,(screen_length - 1),1,reverse); !Reset prompt area ENDIF; ENDPROCEDURE PROCEDURE VS$UPGRADE_EDX !This is all the new VMS 5 (TPU 2.4) specific stuff. !Place new stuff here COMPILE("PROCEDURE VS$SET_JOURNALING(B) ON_ERROR [TPU$_JRNLNOTSAFE]:MESSAGE(ERROR_TEXT);MESSAGE(VS$X_JRNLNOTSAFE);RETURN(0);[OTHERWISE]:RETURN(0);ENDON_ERROR;SET(JOURNALING,B,ON,VS$BJN(B));RETURN(1);ENDPROCEDURE"); COMPILE("PROCEDURE ENABLE_BUFFER_JOURNALING(BUF) IF GET_INFO(BUF,'JOURNAL_FILE') = 0 THEN IF NOT GET_INFO(BUF,'SYSTEM') THEN IF EDTN$V_BUFFER_CHANGE_JOURNALING THEN RETURN(VS$SET_JOURNALING(BUF));ENDIF;ENDIF;ENDIF;RETURN(1);ENDPROCEDURE"); COMPILE("PROCEDURE CURSOR_LINE_NUMBER RETURN(GET_INFO(CURRENT_BUFFER,'record_number')) ENDPROCEDURE"); COMPILE("PROCEDURE CS$CURSOR_OUTER_SPACE RETURN(NOT GET_INFO(CURRENT_BUFFER,'bound')) ENDPROCEDURE"); COMPILE("PROCEDURE EDT$FIND_BUFFER(BUFFER_NAME) RETURN(GET_INFO(BUFFER,'find_buffer',BUFFER_NAME)) ENDPROCEDURE"); COMPILE("PROCEDURE VS$GET_JOURNAL_INFO(THE_FILE) RETURN GET_INFO(THE_FILE,'JOURNAL') ENDPROCEDURE"); COMPILE("PROCEDURE VS$MIN_VERSION RETURN(VS$X_VAXTPU24) ENDPROCEDURE"); COMPILE("PROCEDURE VS$CHECK_VERSION ENDPROCEDURE"); !No more upgrades to do. ENDPROCEDURE PROCEDURE VS$MIN_VERSION RETURN(VS$X_VAXTPU22); ENDPROCEDURE; PROCEDURE ENABLE_BUFFER_JOURNALING(BUF) !In TPU 2.4 (VMS 5.3) we'll start buffer journaling here. !For now we do nothing - keyboard journaling is enabled. RETURN(1); ENDPROCEDURE; PROCEDURE VS$GET_JOURNAL_INFO(THE_FILE) !At VMS 5.3 this becomes GET_INFO(THE_FILE,'JOURNAL') for buffer journaling RETURN 0; !For now it should never even have been called. ENDPROCEDURE PROCEDURE VS$COPY_CHAR(CHAR) !In TPU 2.6 (VMS 5.4) we bomb if CHAR is and buffer is in overstrike IF (CHAR = EDT$X_TAB_CHAR) THEN HARD_TAB !Special handling for tab character ELSE COPY_TEXT(CHAR) ENDIF; ENDPROCEDURE PROCEDURE VS$COPY_STRING(THE_STRING) !In TPU 2.6 (VMS 5.4) we bomb if STRING contains a and buffer is in overstrike LOCAL C,I,L; IF ((GET_INFO(CURRENT_BUFFER,'MODE') = INSERT) !if not in overstrike OR (INDEX(THE_STRING,EDT$X_TAB_CHAR) = 0)) !or no char in string THEN !then go ahead COPY_TEXT(THE_STRING); ELSE I := 1; L := LENGTH(THE_STRING); LOOP !we'll just copy the string one character at a time EXITIF (I > L); !exit when we're at the end of the string VS$COPY_CHAR( SUBSTR(THE_STRING,I,1) ); I := I + 1 ENDLOOP; ENDIF; ENDPROCEDURE ! PROCEDURE VS$BJN(BUFFER_PTR) ! Buffer Journal Name. ! The VAXTPU default buffer journal file naming algorithm has a slight problem ! If the name of the buffer happens to also be a defined logical name, the ! results may no longer be what we intended. For example, if we try to start ! journaling on buffer 'TT', the journaling goes to the screen! ! Internally, when calling RMS $OPEN to open a buffer journal file, VAXTPU ! sets in the FAB block the file name (FAB$L_FNA) to the name of the buffer ! (i.e. 'MAIN', 'TT', etc.) and the default file name (FAB$L_DNA) to the ! string 'TPU$JOURNAL:.TPU$JOURNAL'. RMS, upon seeing there is no punctuation ! on the file name (FAB$L_FNA), assumes it may be a logical name and attempts ! logical name translation. ! By putting the whole string together ourselves and passing it as a whole ! RMS then does not perform logical name translation on the NAME field because ! of the trailing punctuation, but does still parse 'TPU$JOURNAL:' as a device ! name worthy of a logical name translation attempt. ! Flow: ! ENABLE_BUFFER_JOURNALING --> VS$SET_JOURNALING --> VS$BJN ! PROCEDURE VS$BJN(BUFFER_PTR) RETURN( FAO('TPU$JOURNAL:!AS.TPU$JOURNAL',GET_INFO(BUFFER_PTR,'NAME')) ); ENDPROCEDURE; !------------------------------------------------------------------------------ !****************************************************************************** ! SECTION BUILDING !****************************************************************************** !+ !+ ! This is the code to be executed when the section is being built ! It must be placed here at the end of this section file after all the ! procedures or the program will not compile properly. ! ! This code is run when the section file is being compiled. ! It defines some constants, the key map lists, the key maps, ! the key definitions for the key maps, and the initial set up ! of the key map lists. !- !INITIALIZE GLOBAL CONSTANTS CONSTANT EDT$X_VERSNO := "V8.2-9 (1607)"; CONSTANT EDT$X_VERSION := "EDX editor version " + edt$x_versno; !SET THE VERSION NUMBER CONSTANT VS$X_JRNLNOTSAFE := "Buffer not being journaled. Copy contents to a new buffer."; !To save space in VS$ procedure CONSTANT VS$X_VAXTPU22 := "Compatible with VAXTPU Version V2.2 (VMS V5.1, V5.2)"; CONSTANT VS$X_VAXTPU24 := "Compatible with VAXTPU V2.4, V2.6 (VMS V5.3, V5.4) -- Buffer journaling."; CONSTANT edt$x_empty := ""; !empty string CONSTANT edt$x_space := ASCII(32); !space character CONSTANT edt$x_tab_char := ASCII(9); !tab character CONSTANT EDX$K_WARN := 0; !Message WARNING severity CONSTANT EDX$K_SUCCESS := 1; !Message SUCCESS severity CONSTANT EDX$K_ERROR := 2; !Message ERROR severity CONSTANT EDX$K_INFO := 3; !Message INFORMATIONAL severity CONSTANT EDX$K_WARN_HIGHLIGHT := 8; !Message WARNING severity = binary '1000' CONSTANT EDX$K_SUCCESS_HIGHLIGHT := 9; !Message SUCCESS severity = binary '1001' CONSTANT EDX$K_ERROR_HIGHLIGHT := 10; !Message ERROR severity = binary '1010' CONSTANT EDX$K_INFO_HIGHLIGHT := 11; !Message INFORMATIONAL severity = binary '1011' CONSTANT LIB__NOTFOU := 1409652; ! from $LIBDEF CONSTANT LIB__NORMAL := 1409025; ! from $LIBDEF CONSTANT SS$_ENDOFFILE := 2160; ! from $SSDEF CONSTANT RMS$_EOF := 98938; ! from $RMSDEF CONSTANT EVE$X_WHITESPACE := EDT$x_Space + EDT$x_Tab_Char; CONSTANT EDTN$X_FILE_DELIMITERS := eve$x_whitespace + "/="; CONSTANT EDTN$X_TOKEN_DELIMITERS := eve$x_whitespace + "!%./:;=\^`{|}~"; !Allow anything that doesn't mess us up elsewhere. CONSTANT EDTN$X_ALPHABETIC := "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ"; ! Alphabetic characters CONSTANT EDTN$X_ALPHANUMERIC := edtn$x_alphabetic + "1234567890"; ! Alphabetic and numeric characters ! Define characters which precede a word defining the beginning of a word ! and which follow a word defining the end of a word CONSTANT EDT$X_line_feed := ASCII(10); CONSTANT EDT$X_vertical_tab := ASCII(11); CONSTANT EDT$X_form_feed := ASCII(12); CONSTANT EDT$X_carriage_return := ASCII(13); CONSTANT EDT$X_WORD := EDT$x_Space + EDT$x_Tab_Char + EDT$X_Form_Feed + EDT$X_Line_Feed + EDT$X_Carriage_return + EDT$X_Vertical_Tab; CONSTANT EDTN$X_RULER_LINE := "....v....1....v....2....v....3....v....40...v....5....v....6....v....7....v....80...v....9....v...." + "0....v....1....v....120..v....3....v....4....v....5....v....160..v....7....v....8....v....9....v...." + "200..v....1....v....2....v....3....v....240..v....5....v....6....v....7....v....280..v....9....v...." + "0....v....1....v....320..v....3....v....4....v....5....v....360..v....7....v....8....v....9....v...." + "400..v....1....v....2....v....3....v....440..v....5....v....6....v....7....v....480..v....9....v...." + "0....v....1....v....520..v....3....v....4....v....5....v....560..v....7....v....8....v....9....v...." + "600..v....1....v....2....v....3....v....640..v....5....v....6....v....7....v....680..v....9....v...." + "0....v....1....v....720..v....3....v....4....v....5....v....760..v....7....v....8....v....9....v...." + "800..v....1....v....2....v....3....v....840..v....5....v....6....v....7....v....880..v....9....v...." + "0....v....1....v....920..v....3....v....4....v....5....v....|"; !DEFINE SOME VARIABLES jen$rn_search := 0; !Define as variable edtn$rn_dirfil := 0; !Define as variable spl$rn_dicword := 0; !Define as variable spl$rn_misspelled := 0; !Define as variable edt$x_commands := 0; !Define as variable := 0 !------------------------------------------------------------------------------ ! !***COMP$INIT_KEY_MAPS*** ! ! CREATE THE KEY MAPS ! The key map list TPU$KEY_MAP_LIST exists by default and is used for all ! buffers by default. The key map TPU$KEY_MAP exists by default and is used ! for user defined keys. This way the user doesn't have to specify the ! key map when defining his own keys. The key map EDTN$KM_PRINTABLE_KEYS is ! used for printable keys. It insures words are wrapped properly when a ! SET WRAP is in effect. ! ! EDTN$KM_EDT_EDITING_KEYS defines the EDT mode editing keys ! EDTN$KM_WPS_EDITING_KEYS defines the WPS mode editing keys !!! EDTN$KM_DD1_EDITING_KEYS defines the DD1 mode editing keys ! EDTN$KM_NUMERIC_KEYPAD defines the keypad as a numeric keypad ! PMT$KM_PMTBUF defines keyps used for the PROMPT buffer (EDX_READ_LINE) ! EDTN$KM_SHOBUF defines keys for the SHOW BUFFERS display ! EDTN$KM_SHOMRK defines keys for the SHOW MARKERS display !!! EDTN$KM_PASWRD defines keys for the ENCRYPT command (get password) ! EDTN$KM_DIRBUF defines keys for the DIR buffer (DIRECTORY) ! EDTN$KM_DIRBUF_EDT defines additional keys for the DIR buffer in EDT keypad mode ! EDTN$KM_DIRBUF_WPS defines additional keys for the DIR buffer in WPS keypad mode !!! EDTN$KM_DIRBUF_DD1 defines additional keys for the DIR buffer in DD1 keypad mode ! SPL$KM_DICBUF defines keys for the DIC buffer (DICTIONARY) ! SPL$KM_DICBUF_EDT defines additional keys for the DIC buffer in EDT keypad mode ! SPL$KM_DICBUF_WPS defines additional keys for the DIC buffer in WPS keypad mode !!! SPL$KM_DICBUF_DD1 defines additional keys for the DIC buffer in DD1 keypad mode ! EDTN$KM_SEARCH defines keys for the SEARCH buffer (SEARCH) ! EDTN$KM_SEARCH_EDT defines additional keys for the SEARCH buffer in EDT keypad mode ! EDTN$KM_SEARCH_WPS defines additional keys for the SEARCH buffer in WPS keypad mode !!! EDTN$KM_SEARCH_DD1 defines additional keys for the SEARCH buffer in DD1 keypad mode create_key_map("edtn$km_EDT_editing_keys"); create_key_map("edtn$km_WPS_editing_keys"); !!create_key_map("edtn$km_DD1_editing_keys"); create_key_map("edtn$km_printable_keys"); create_key_map("edtn$km_numeric_keypad"); create_key_map("pmt$km_pmtbuf" ); create_key_map("edtn$km_shobuf"); create_key_map("edtn$km_shomrk"); create_key_map("edtn$km_dirbuf"); !!create_key_map("edtn$km_paswrd"); create_key_map("edtn$km_dirbuf_EDT"); create_key_map("edtn$km_dirbuf_WPS"); !!create_key_map("edtn$km_dirbuf_DD1"); create_key_map("spl$km_dicbuf"); create_key_map("spl$km_dicbuf_EDT"); create_key_map("spl$km_dicbuf_WPS"); !!create_key_map("spl$km_dicbuf_DD1"); create_key_map("edtn$km_search"); create_key_map("edtn$km_search_EDT"); create_key_map("edtn$km_search_WPS"); !!create_key_map("edtn$km_search_DD1"); ! ! SET UP THE KEY MAP LISTS create_key_map_list( "pmt$kml_pmtbuf", "pmt$km_pmtbuf" ); create_key_map_list( "edtn$kml_shobuf", "edtn$km_shobuf"); create_key_map_list( "edtn$kml_shomrk", "edtn$km_shomrk"); !!create_key_map_list( "edtn$kml_paswrd", "edtn$km_paswrd"); create_key_map_list( "edtn$kml_dirbuf", "edtn$km_dirbuf"); create_key_map_list( "spl$kml_dicbuf", "spl$km_dicbuf"); create_key_map_list( "edtn$kml_search", "edtn$km_search"); add_key_map( "tpu$key_map_list", "last", "edtn$km_printable_keys"); !default for user buffers set(self_insert,"pmt$kml_pmtbuf",OFF); set(self_insert,"edtn$kml_dirbuf",OFF); set(self_insert,"spl$kml_dicbuf" ,OFF); set(self_insert,"edtn$kml_search",OFF); set(self_insert,"edtn$kml_shomrk",OFF); ! !------------------------------------------------------------------------------ !***COMP$INIT_KM_EDT_EDITING_KEYS*** ! Define editing keys to emulate EDT ! ! DEFINE THE EDT EDITING KEYS ! !*** ARROW KEYS *** DEFINE_KEY('edtn$horizontal(-1)', left, "", 'edtn$km_EDT_editing_keys'); !left arrow DEFINE_KEY('edtn$horizontal(1);set(forward,current_buffer)', right, "", 'edtn$km_EDT_editing_keys'); !right arrow DEFINE_KEY('edtn$vertical(-1)', up, "", 'edtn$km_EDT_editing_keys'); !up arrow DEFINE_KEY('edtn$vertical(1);set(forward,current_buffer)', down, "", 'edtn$km_EDT_editing_keys'); !down arrow DEFINE_KEY('edtn$shift_window(edtn$v_shift_amount)', KEY_NAME(LEFT,SHIFT_KEY), "", 'edtn$km_EDT_editing_keys'); !Gold <- shift screen left DEFINE_KEY('edtn$shift_window(-edtn$v_shift_amount)', KEY_NAME(RIGHT,SHIFT_KEY), "", 'edtn$km_EDT_editing_keys'); !Gold -> shift screen right DEFINE_KEY('edtn$scroll_window(reverse)', KEY_NAME(UP,SHIFT_KEY), "", 'edtn$km_EDT_editing_keys'); !Gold up. Continuous scroll up DEFINE_KEY('edtn$scroll_window(forward)', KEY_NAME(DOWN,SHIFT_KEY), "", 'edtn$km_EDT_editing_keys'); !Gold down. Continuous scroll down ! ! !*** EDITING KEYPAD KEYS *** DEFINE_KEY('jen$init_find_string(0)', E1, "", 'edtn$km_EDT_editing_keys'); !Find DEFINE_KEY('edtn$paste_block(paste_buffer)', E2, "", 'edtn$km_EDT_editing_keys'); !Paste DEFINE_KEY('edtn$cut_block(0,paste_buffer,0)', E3, "", 'edtn$km_EDT_editing_keys'); !Cut DEFINE_KEY('edtn$select_block', E4, "", 'edtn$km_EDT_editing_keys'); !Select DEFINE_KEY('edt$section(reverse)', E5, "", 'edtn$km_EDT_editing_keys'); !Prev screen DEFINE_KEY('edt$section(forward);set(forward,current_buffer)', E6, "", 'edtn$km_EDT_editing_keys'); !Next screen DEFINE_KEY('jen$init_find_string(1)', KEY_NAME(E1,SHIFT_KEY), "", 'edtn$km_EDT_editing_keys'); !Find DEFINE_KEY('unpaste', KEY_NAME(E2,SHIFT_KEY), "", 'edtn$km_EDT_editing_keys'); !Find DEFINE_KEY('edtn$cut_block(1,paste_buffer,0)', KEY_NAME(E3,SHIFT_KEY), "", 'edtn$km_EDT_editing_keys'); !Copy to buffer. DEFINE_KEY('edt$reset;edx_message("Select canceled.");', KEY_NAME(E4,SHIFT_KEY), "", 'edtn$km_EDT_editing_keys'); !Select ! ! ! KEYPAD KEYS ! DEFINE_KEY('move_by_line', KP0, "", 'edtn$km_EDT_editing_keys'); !Line DEFINE_KEY('edt$move_word(current_direction)', KP1, "", 'edtn$km_EDT_editing_keys'); !Word DEFINE_KEY('edtn$end_of_line', KP2, "", 'edtn$km_EDT_editing_keys'); !End of line DEFINE_KEY('if current_direction=forward then edtn$horizontal(1) else edtn$horizontal(-1) endif', KP3, "", 'edtn$km_EDT_editing_keys'); !Character DEFINE_KEY('set(forward,current_buffer)', KP4, "", 'edtn$km_EDT_editing_keys'); !Advance DEFINE_KEY('set(reverse,current_buffer)', KP5, "", 'edtn$km_EDT_editing_keys'); !Reverse DEFINE_KEY('edtn$cut_block(0,paste_buffer,0)', KP6, "", 'edtn$km_EDT_editing_keys'); !Cut DEFINE_KEY('move_by_page', KP7, "", 'edtn$km_EDT_editing_keys'); !Page DEFINE_KEY('edt$section(current_direction)', KP8, "", 'edtn$km_EDT_editing_keys'); !Section DEFINE_KEY('edt$append', KP9, "", 'edtn$km_EDT_editing_keys'); !Append DEFINE_KEY('keypad_help', PF2, "", 'edtn$km_EDT_editing_keys'); !Keypad help DEFINE_KEY('jen$fndnxt(1,1,-1)', PF3, "", 'edtn$km_EDT_editing_keys'); !Find next DEFINE_KEY('delete_line', PF4, "", 'edtn$km_EDT_editing_keys'); !Delete line DEFINE_KEY('delete_word', MINUS, "", 'edtn$km_EDT_editing_keys'); !Delete word DEFINE_KEY('delete_character', COMMA, "", 'edtn$km_EDT_editing_keys'); !Delete character DEFINE_KEY('edtn$select_block', PERIOD, "", 'edtn$km_EDT_editing_keys'); !Select ! ! !*** SHIFT KEYPAD KEYS *** DEFINE_KEY('enable_buffer_journaling(current_buffer);split_line;move_horizontal(-1)', KEY_NAME(KP0,SHIFT_KEY), "", 'edtn$km_EDT_editing_keys'); !Open line DEFINE_KEY('edt$change_case(invert)', KEY_NAME(KP1,SHIFT_KEY), "", 'edtn$km_EDT_editing_keys'); !Change case DEFINE_KEY('delete_end_of_line', KEY_NAME(KP2,SHIFT_KEY), "", 'edtn$km_EDT_editing_keys'); !Delete to end of line DEFINE_KEY('edtn$cntl_char', KEY_NAME(KP3,SHIFT_KEY), "", 'edtn$km_EDT_editing_keys'); !Specins DEFINE_KEY('goto_bottom', KEY_NAME(KP4,SHIFT_KEY), "", 'edtn$km_EDT_editing_keys'); !Bottom DEFINE_KEY('goto_top', KEY_NAME(KP5,SHIFT_KEY), "", 'edtn$km_EDT_editing_keys'); !Top DEFINE_KEY('edtn$paste_block(paste_buffer)', KEY_NAME(KP6,SHIFT_KEY), "", 'edtn$km_EDT_editing_keys'); !Paste DEFINE_KEY('edtn$prompt_do_command', KEY_NAME(KP7,SHIFT_KEY), "", 'edtn$km_EDT_editing_keys'); !Command DEFINE_KEY('edt$fill', KEY_NAME(KP8,SHIFT_KEY), "", 'edtn$km_EDT_editing_keys'); !Fill DEFINE_KEY('edt$replace', KEY_NAME(KP9,SHIFT_KEY), "", 'edtn$km_EDT_editing_keys'); !Replace DEFINE_KEY('transpose_characters', KEY_NAME(PF2,SHIFT_KEY), "", 'edtn$km_EDT_editing_keys'); !Transpose characters DEFINE_KEY('jen$init_find_string(edtn$v_search_wild)', KEY_NAME(PF3,SHIFT_KEY), "", 'edtn$km_EDT_editing_keys'); !Find DEFINE_KEY('undelete_line', KEY_NAME(PF4,SHIFT_KEY), "", 'edtn$km_EDT_editing_keys'); !Undelete line DEFINE_KEY('undelete_word', KEY_NAME(MINUS,SHIFT_KEY), "", 'edtn$km_EDT_editing_keys'); !Undelete word DEFINE_KEY('undelete_character', KEY_NAME(COMMA,SHIFT_KEY), "", 'edtn$km_EDT_editing_keys'); !Undelete character DEFINE_KEY('edt$reset;edx_message("Select canceled.")', KEY_NAME(PERIOD,SHIFT_KEY), "", 'edtn$km_EDT_editing_keys'); !Reset DEFINE_KEY('edt$substitute', KEY_NAME(ENTER,SHIFT_KEY), "", 'edtn$km_EDT_editing_keys'); !Substitute ! ! !*** SHIFT KEYBOARD KEYS *** DEFINE_KEY('edtn$goto_buffer("","")', KEY_NAME('B',SHIFT_KEY), "", 'edtn$km_EDT_editing_keys'); !Gold B. Goto buffer. DEFINE_KEY('capitalize_word', KEY_NAME('C',SHIFT_KEY), "", 'edtn$km_EDT_editing_keys'); !Gold C. Capitalize Word. DEFINE_KEY('edtn$dir("")', KEY_NAME('D',SHIFT_KEY), "", 'edtn$km_EDT_editing_keys'); !Gold D. Directory. DEFINE_KEY('fill_paragraph', KEY_NAME('F',SHIFT_KEY), "", 'edtn$km_EDT_editing_keys'); !Gold F. Fill paragraph. DEFINE_KEY('goto_mark("")', KEY_NAME('G',SHIFT_KEY), "", 'edtn$km_EDT_editing_keys'); !Gold G. Goto mark. DEFINE_KEY('do_command("INCLUDE")', KEY_NAME('I',SHIFT_KEY), "", 'edtn$km_EDT_editing_keys'); !Gold I. Include file. DEFINE_KEY('lowercase_word', KEY_NAME('L',SHIFT_KEY), "", 'edtn$km_EDT_editing_keys'); !Gold L. Lowercase word. DEFINE_KEY('edtn$goto_buffer("MAIN","")', KEY_NAME('M',SHIFT_KEY), "", 'edtn$km_EDT_editing_keys'); !Gold M. Goto buffer MAIN DEFINE_KEY('edtn$toggle_numeric_keypad', KEY_NAME('N',SHIFT_KEY), "", 'edtn$km_EDT_editing_keys'); !Gold N. Toggle numeric keypad. DEFINE_KEY('edtn$paste_block(0)', KEY_NAME('O',SHIFT_KEY), "", 'edtn$km_EDT_editing_keys'); !Gold O. Copy from buffer. DEFINE_KEY('edtn$cut_block(1,0,0)', KEY_NAME('P',SHIFT_KEY), "", 'edtn$km_EDT_editing_keys'); !Gold P. Copy to buffer. DEFINE_KEY('edt$x_line:="";edt$exit("","QUIT")', KEY_NAME('Q',SHIFT_KEY), "", 'edtn$km_EDT_editing_keys'); !Gold Q. Quit. DEFINE_KEY('edtp$insert_ruler', KEY_NAME('R',SHIFT_KEY), "", 'edtn$km_EDT_editing_keys'); !Gold R. Insert ruler. DEFINE_KEY('do_command("SHOW BUFFERS")', KEY_NAME('S',SHIFT_KEY), "", 'edtn$km_EDT_editing_keys'); !Gold S. Show buffers. DEFINE_KEY('uppercase_word', KEY_NAME('U',SHIFT_KEY), "", 'edtn$km_EDT_editing_keys'); !Gold U. Uppercase word. DEFINE_KEY('edtn$toggle_windows', KEY_NAME('W',SHIFT_KEY), "", 'edtn$km_EDT_editing_keys'); !Gold W. Toggle single/dual windows. DEFINE_KEY('edt$x_line:="";edt$exit("","EXIT")', KEY_NAME('X',SHIFT_KEY), "", 'edtn$km_EDT_editing_keys'); !Gold X. Exit DEFINE_KEY('edtp$learning', KEY_NAME('[',SHIFT_KEY), "", 'edtn$km_EDT_editing_keys'); !Gold [. Start learn key sequence. DEFINE_KEY('edtp$stop_learn', KEY_NAME(']',SHIFT_KEY), "", 'edtn$km_EDT_editing_keys'); !Gold ]. End learn key sequence. DEFINE_KEY('goto_line("")', KEY_NAME('#',SHIFT_KEY), "", 'edtn$km_EDT_editing_keys'); !Gold #. Goto line number. DEFINE_KEY('center_line', KEY_NAME('=',SHIFT_KEY), "", 'edtn$km_EDT_editing_keys'); !Gold =. Center line. DEFINE_KEY('edtn$insert_line("")', KEY_NAME('-',SHIFT_KEY), "", 'edtn$km_EDT_editing_keys'); !Gold -. Insert separating line. DEFINE_KEY('edtn$find_char(current_direction)', KEY_NAME('.',SHIFT_KEY), "", 'edtn$km_EDT_editing_keys'); !Gold .. Find character. DEFINE_KEY('edtx$cursstat(1)', KEY_NAME('?',SHIFT_KEY), "", 'edtn$km_EDT_editing_keys'); !Gold ?. Cursor status. DEFINE_KEY('edtn$match_paren', KEY_NAME("'",SHIFT_KEY), "", 'edtn$km_EDT_editing_keys'); !Gold '. Find matching parenthesis. DEFINE_KEY('edtn$clear_paren', KEY_NAME('"',SHIFT_KEY), "", 'edtn$km_EDT_editing_keys'); !Gold ". Clear matching parenthesis. ! ! !*** CONTROL KEYS *** DEFINE_KEY('edtp$overstrike', CTRL_A_KEY, "", 'edtn$km_EDT_editing_keys'); !ctrl a. Toggle insert/overstrike DEFINE_KEY ('change_windows', CTRL_D_KEY, "", 'edtn$km_EDT_editing_keys'); !ctrl D. Change window. DEFINE_KEY('edtn$end_of_line', CTRL_E_KEY, "", 'edtn$km_EDT_editing_keys'); !ctrl e. Goto end of word. DEFINE_KEY('If get_info(info_window,"visible") then unmap(info_window) else end_of_word endif;', CTRL_F_KEY, "", 'edtn$km_EDT_editing_keys'); DEFINE_KEY('tab', TAB_KEY, "", 'edtn$km_EDT_editing_keys'); !ctrl i (tab key) DEFINE_KEY('edt$del_beg_word', LF_KEY, "", 'edtn$km_EDT_editing_keys'); !ctrl j (line feed) DEFINE_KEY('edt$define_key', CTRL_K_KEY, "", 'edtn$km_EDT_editing_keys'); !ctrl K DEFINE_KEY('enable_buffer_journaling(current_buffer);copy_text(ascii(12))', CTRL_L_KEY, "", 'edtn$km_EDT_editing_keys'); !ctrl L DEFINE_KEY("refresh", CTRL_R_KEY, "", 'edtn$km_EDT_editing_keys'); !ctrl R. Refresh DEFINE_KEY('delete_start_of_line', CTRL_U_KEY, "", 'edtn$km_EDT_editing_keys'); !ctrl U. Delete to beg of line. DEFINE_KEY ('change_windows', CTRL_V_KEY, "", 'edtn$km_EDT_editing_keys'); !ctrl V. Change window. DEFINE_KEY("refresh", CTRL_W_KEY, "", 'edtn$km_EDT_editing_keys'); !ctrl W. Refresh. DEFINE_KEY('edt$line_mode', CTRL_Z_KEY, "", 'edtn$km_EDT_editing_keys'); !ctrl Z. Enter line mode. ! ! !*** GOLD CTRL KEYS *** DEFINE_KEY('enable_buffer_journaling(current_buffer);copy_text(current_date)', KEY_NAME(CTRL_D_KEY,SHIFT_KEY), "", 'edtn$km_EDT_editing_keys'); !Gold ctrl D. Insert today's date. DEFINE_KEY('set_mark("")', KEY_NAME(CTRL_G_KEY,SHIFT_KEY), "", 'edtn$km_EDT_editing_keys'); !Gold ctrl G. Mark position. DEFINE_KEY('hard_tab', KEY_NAME(CTRL_I_KEY,SHIFT_KEY), "", 'edtn$km_EDT_editing_keys'); !Gold ctrl L. Cursor status with line number. DEFINE_KEY('edtx$cursstat(1)', KEY_NAME(CTRL_L_KEY,SHIFT_KEY), "", 'edtn$km_EDT_editing_keys'); !Gold ctrl L. Cursor status with line number. DEFINE_KEY('toggle_ruler_line', KEY_NAME(CTRL_R_KEY,SHIFT_KEY), "", 'edtn$km_EDT_editing_keys'); !Gold ctrl R. Toggle ruler window. DEFINE_KEY('edtn$toggle_window_width', KEY_NAME(CTRL_W_KEY,SHIFT_KEY), "", 'edtn$km_EDT_editing_keys'); !Gold ctrl W. Toggle window width. ! ! !*** EDITING KEYS *** DEFINE_KEY('new_line', RET_KEY, "", 'edtn$km_EDT_editing_keys'); ! return DEFINE_KEY('edtn$move_by_line(reverse)',BS_KEY, "", 'edtn$km_EDT_editing_keys'); ! Backspace DEFINE_KEY('delete_previous_character;set(forward,current_buffer)', DEL_KEY, "", 'edtn$km_EDT_editing_keys'); ! rubout ! ! Define the numeric keys for use with edt$gold_number ! these are necessary to emulate EDT repeat counts ! DEFINE_KEY('edt$gold_number("0")', key_name('0',shift_key), "", 'edtn$km_EDT_editing_keys'); DEFINE_KEY('edt$gold_number("1")', key_name('1',shift_key), "", 'edtn$km_EDT_editing_keys'); DEFINE_KEY('edt$gold_number("2")', key_name('2',shift_key), "", 'edtn$km_EDT_editing_keys'); DEFINE_KEY('edt$gold_number("3")', key_name('3',shift_key), "", 'edtn$km_EDT_editing_keys'); DEFINE_KEY('edt$gold_number("4")', key_name('4',shift_key), "", 'edtn$km_EDT_editing_keys'); DEFINE_KEY('edt$gold_number("5")', key_name('5',shift_key), "", 'edtn$km_EDT_editing_keys'); DEFINE_KEY('edt$gold_number("6")', key_name('6',shift_key), "", 'edtn$km_EDT_editing_keys'); DEFINE_KEY('edt$gold_number("7")', key_name('7',shift_key), "", 'edtn$km_EDT_editing_keys'); DEFINE_KEY('edt$gold_number("8")', key_name('8',shift_key), "", 'edtn$km_EDT_editing_keys'); DEFINE_KEY('edt$gold_number("9")', key_name('9',shift_key), "", 'edtn$km_EDT_editing_keys'); DEFINE_KEY('edt$gold_number("")', key_name('+',shift_key), "", 'edtn$km_EDT_editing_keys'); !!define_key('edt$gold_number("-")', key_name('-',shift_key), "", 'edtn$km_EDT_editing_keys');!(Defined elsewhere) ! ! Define the Function keys on VT-200 series ! DEFINE_KEY('keypad_help', HELP, "", 'edtn$km_EDT_editing_keys'); !Keypad help DEFINE_KEY('edtn$prompt_do_command', DO, "", 'edtn$km_EDT_editing_keys'); !Command DEFINE_KEY('edtn$fill_to_end', F10, "", 'edtn$km_EDT_editing_keys'); ! DEFINE_KEY('edtn$move_by_line(reverse)', F12, "", 'edtn$km_EDT_editing_keys'); ! Backspace DEFINE_KEY('edt$del_beg_word', F13, "", 'edtn$km_EDT_editing_keys'); !ctrl j (line feed) DEFINE_KEY('change_windows', F14, "", 'edtn$km_EDT_editing_keys'); ! DEFINE_KEY('edtn$goto_buffer("MAIN","")', F17, "", 'edtn$km_EDT_editing_keys'); DEFINE_KEY('edtn$goto_buffer( "A","")', F18, "", 'edtn$km_EDT_editing_keys'); DEFINE_KEY('edtn$goto_buffer( "B","")', F19, "", 'edtn$km_EDT_editing_keys'); DEFINE_KEY('edtn$goto_buffer( "C","")', F20, "", 'edtn$km_EDT_editing_keys'); ! !------------------------------------------------------------------------------ !***COMP$INIT_KM_WPS_EDITING_KEYS*** !Define editing keys to emulate WORD 11 DECMATE WPS keypad ! ! DEFINE THE WPS EDITING KEYS ! !*** ARROW KEYS *** DEFINE_KEY('edtn$horizontal(-1);set(reverse,current_buffer)', left, "", 'edtn$km_WPS_editing_keys'); !left arrow DEFINE_KEY('edtn$horizontal(1);set(forward,current_buffer)', right, "", 'edtn$km_WPS_editing_keys'); !right arrow DEFINE_KEY('edtn$vertical(-1);set(reverse,current_buffer)', up, "", 'edtn$km_WPS_editing_keys'); !up arrow DEFINE_KEY('edtn$vertical(1);set(forward,current_buffer)', down, "", 'edtn$km_WPS_editing_keys'); !down arrow DEFINE_KEY('edtn$shift_window(edtn$v_shift_amount)', KEY_NAME(LEFT,SHIFT_KEY), "", 'edtn$km_WPS_editing_keys'); !Gold <- DEFINE_KEY('edtn$shift_window(-edtn$v_shift_amount)', KEY_NAME(RIGHT,SHIFT_KEY), "", 'edtn$km_WPS_editing_keys'); !Gold -> DEFINE_KEY('goto_top', KEY_NAME(UP,SHIFT_KEY), "", 'edtn$km_WPS_editing_keys'); !Gold up. Goto top of buffer. DEFINE_KEY('goto_bottom', KEY_NAME(DOWN,SHIFT_KEY), "", 'edtn$km_WPS_editing_keys'); !Gold down. Goto bottom of buffer. ! ! !*** EDITING KEYPAD KEYS *** DEFINE_KEY('jen$init_find_string(0)', E1, "", 'edtn$km_WPS_editing_keys'); !Find DEFINE_KEY('edtn$paste_block(paste_buffer)', E2, "", 'edtn$km_WPS_editing_keys'); !Paste DEFINE_KEY('edtn$cut_block(0,paste_buffer,0)', E3, "", 'edtn$km_WPS_editing_keys'); !Cut DEFINE_KEY('edtn$select_block;set(forward,current_buffer)', E4, "", 'edtn$km_WPS_editing_keys'); !Select DEFINE_KEY('edt$section(reverse)', E5, "", 'edtn$km_WPS_editing_keys'); !Prev screen DEFINE_KEY('edt$section(forward);set(forward,current_buffer)', E6, "", 'edtn$km_WPS_editing_keys'); !Next screen DEFINE_KEY('jen$init_find_string(1)', KEY_NAME(E1,SHIFT_KEY), "", 'edtn$km_WPS_editing_keys'); !Find DEFINE_KEY('unpaste', KEY_NAME(E2,SHIFT_KEY), "", 'edtn$km_WPS_editing_keys'); !Find DEFINE_KEY('edtn$cut_block(1,paste_buffer,0)', KEY_NAME(E3,SHIFT_KEY), "", 'edtn$km_WPS_editing_keys'); !Copy to buffer. DEFINE_KEY('edt$reset;edx_message("Select canceled.")', KEY_NAME(E4,SHIFT_KEY), "", 'edtn$km_WPS_editing_keys'); !Select ! ! ! KEYPAD KEYS DEFINE_KEY('position(TEXT);move_horizontal(1);set(forward,current_buffer);', KP0, "", 'edtn$km_WPS_editing_keys'); !Advance character DEFINE_KEY('position(TEXT);move_horizontal(-1);set(reverse,current_buffer)', KP1, "", 'edtn$km_WPS_editing_keys'); !Backup character DEFINE_KEY('move_by_line', KP2, "", 'edtn$km_WPS_editing_keys'); !Line DEFINE_KEY('edt$change_case(upper);set(forward,current_buffer)', KP3, "", 'edtn$km_WPS_editing_keys'); !Uppercase range DEFINE_KEY('edt$move_word(current_direction)', KP4, "", 'edtn$km_WPS_editing_keys'); !word DEFINE_KEY('edtn$find_pat(edt$x_whit_pat,notany(edt$x_word))', KP5, "", 'edtn$km_WPS_editing_keys'); !Next paragraph DEFINE_KEY('edtn$find_pat(edtn$pattern_sentence,notany(edt$x_word))', KP7, "", 'edtn$km_WPS_editing_keys'); !Sentence DEFINE_KEY('wps$search_line', KP8, "", 'edtn$km_WPS_editing_keys'); !Tab DEFINE_KEY('move_by_page', PF2, "", 'edtn$km_WPS_editing_keys'); !Page DEFINE_KEY('delete_word', PF3, "", 'edtn$km_WPS_editing_keys'); !Delete word DEFINE_KEY('delete_character', PF4, "", 'edtn$km_WPS_editing_keys'); !Delete character DEFINE_KEY('edtn$cut_block(0,paste_buffer,0)', MINUS, "", 'edtn$km_WPS_editing_keys'); !Cut DEFINE_KEY('edtn$paste_block(paste_buffer)', COMMA, "", 'edtn$km_WPS_editing_keys'); !Paste DEFINE_KEY('edtn$select_block;set(forward,current_buffer)', PERIOD, "", 'edtn$km_WPS_editing_keys'); !Select DEFINE_KEY('edtn$find_char(current_direction,">")', ENTER, "", 'edtn$km_WPS_editing_keys'); !Find ">" ! ! !*** SHIFT KEYPAD KEYS *** DEFINE_KEY('edtn$scroll_window(forward)', KEY_NAME(KP0,SHIFT_KEY), "", 'edtn$km_WPS_editing_keys'); !Continuous scroll down DEFINE_KEY('edtn$scroll_window(reverse)', KEY_NAME(KP1,SHIFT_KEY), "", 'edtn$km_WPS_editing_keys'); !Continuous scroll up DEFINE_KEY('edt$change_case(lower);set(forward,current_buffer)', KEY_NAME(KP3,SHIFT_KEY), "", 'edtn$km_WPS_editing_keys'); !Lowercase range DEFINE_KEY('fill_paragraph', KEY_NAME(KP5,SHIFT_KEY), "", 'edtn$km_WPS_editing_keys'); !Fill paragraph DEFINE_KEY('undelete_word', KEY_NAME(PF3,SHIFT_KEY), "", 'edtn$km_WPS_editing_keys'); !Undelete word DEFINE_KEY('undelete_character', KEY_NAME(PF4,SHIFT_KEY), "", 'edtn$km_WPS_editing_keys'); !Undelete character DEFINE_KEY('edtn$cut_block(1,0,0)', KEY_NAME(MINUS,SHIFT_KEY), "", 'edtn$km_WPS_editing_keys'); !Copy to buffer DEFINE_KEY('edtn$paste_block(0)', KEY_NAME(COMMA,SHIFT_KEY), "", 'edtn$km_WPS_editing_keys'); !Copy from buffer DEFINE_KEY('edt$reset;edx_message("Select canceled.")', KEY_NAME(PERIOD,SHIFT_KEY), "", 'edtn$km_WPS_editing_keys'); !Reset DEFINE_KEY('transpose_characters', KEY_NAME(ENTER,SHIFT_KEY), "", 'edtn$km_WPS_editing_keys'); !Transpose characters ! ! !*** GOLD KEYS *** DEFINE_KEY('edt$append;set(forward,current_buffer)', KEY_NAME("A",SHIFT_KEY), "", 'edtn$km_WPS_editing_keys'); !Gold A. Append DEFINE_KEY('goto_bottom', KEY_NAME("B",SHIFT_KEY), "", 'edtn$km_WPS_editing_keys'); !Gold B. Bottom DEFINE_KEY('center_line', KEY_NAME("C",SHIFT_KEY), "", 'edtn$km_WPS_editing_keys'); !Gold C. Center line. DEFINE_KEY ('change_windows', KEY_NAME("E",SHIFT_KEY), "", 'edtn$km_WPS_editing_keys'); !Gold O. Other window. DEFINE_KEY('edt$x_line:="";edt$exit("","EXIT")', KEY_NAME("F",SHIFT_KEY), "", 'edtn$km_WPS_editing_keys'); !Gold F. Exit DEFINE_KEY('do_command("INCLUDE")', KEY_NAME("G",SHIFT_KEY), "", 'edtn$km_WPS_editing_keys'); !Gold G. Get file DEFINE_KEY('edtn$goto_buffer("","")', KEY_NAME("J",SHIFT_KEY), "", 'edtn$km_WPS_editing_keys'); !Gold J. Jump to buffer. DEFINE_KEY('edtp$learning', KEY_NAME("K",SHIFT_KEY), "", 'edtn$km_WPS_editing_keys'); !Gold K. Start learn key sequence. DEFINE_KEY('edtx$cursstat(1)', KEY_NAME("L",SHIFT_KEY), "", 'edtn$km_WPS_editing_keys'); !Gold ctrl L. Cursor status with line number. DEFINE_KEY('enable_buffer_journaling(current_buffer);copy_text(ascii(12));set(forward,current_buffer)', KEY_NAME("N",SHIFT_KEY), "", 'edtn$km_WPS_editing_keys'); !Gold N. New page DEFINE_KEY('enable_buffer_journaling(current_buffer);split_line;move_horizontal(-1)', KEY_NAME("O",SHIFT_KEY), "", 'edtn$km_WPS_editing_keys'); !Gold O. Open line DEFINE_KEY('enable_buffer_journaling(current_buffer);copy_text(ascii(12));set(forward,current_buffer)', KEY_NAME("P",SHIFT_KEY), "", 'edtn$km_WPS_editing_keys'); !Gold P. Page marker DEFINE_KEY('edt$x_line:="";edt$exit("","QUIT")', KEY_NAME("Q",SHIFT_KEY), "", 'edtn$km_WPS_editing_keys'); !Gold Q. Quit. DEFINE_KEY('edtn$cntl_char;set(forward,current_buffer)', KEY_NAME("S",SHIFT_KEY), "", 'edtn$km_WPS_editing_keys'); !Gold S. Specins DEFINE_KEY('goto_top;set(forward,current_buffer)', KEY_NAME("T",SHIFT_KEY), "", 'edtn$km_WPS_editing_keys'); !Gold T. Top DEFINE_KEY('edtn$toggle_windows', KEY_NAME("W",SHIFT_KEY), "", 'edtn$km_WPS_editing_keys'); !Gold W. Toggle single/dual windows. DEFINE_KEY('set_mark("")', KEY_NAME("X",SHIFT_KEY), "", 'edtn$km_WPS_editing_keys'); !Gold X. Mark position. DEFINE_KEY('goto_mark("")', KEY_NAME("Z",SHIFT_KEY), "", 'edtn$km_WPS_editing_keys'); !Gold Z. Zip to mark. DEFINE_KEY('edtn$prompt_do_command', KEY_NAME("[",SHIFT_KEY), "", 'edtn$km_WPS_editing_keys'); !Gold [. Command DEFINE_KEY('edtp$stop_learn', KEY_NAME(']',SHIFT_KEY), "", 'edtn$km_WPS_editing_keys'); !Gold ]. End learn key sequence. DEFINE_KEY('jen$init_find_string(edtn$v_search_wild)', KEY_NAME(",",SHIFT_KEY), "", 'edtn$km_WPS_editing_keys'); !Gold ,. Search for DEFINE_KEY('jen$fndnxt(1,1,-1)', KEY_NAME(".",SHIFT_KEY), "", 'edtn$km_WPS_editing_keys'); !Gold .. Search next DEFINE_KEY('edtx$cursstat(1)', KEY_NAME('?',SHIFT_KEY), "", 'edtn$km_WPS_editing_keys'); !Gold ?. Cursor status. DEFINE_KEY('edt$substitute', KEY_NAME("'",SHIFT_KEY), "", 'edtn$km_WPS_editing_keys'); !Gold `. Substitute DEFINE_KEY('enable_buffer_journaling(current_buffer);copy_text(current_date)', KEY_NAME("\",SHIFT_KEY), "", 'edtn$km_WPS_editing_keys'); !Gold \. Insert today's date. DEFINE_KEY('delete_start_of_line', KEY_NAME(DEL_KEY,SHIFT_KEY), "", 'edtn$km_WPS_editing_keys'); !Gold delete. Delete to beginning of line. ! ! !*** CONTROL KEYS *** DEFINE_KEY('edtp$overstrike', CTRL_A_KEY, "", 'edtn$km_WPS_editing_keys'); !ctrl a. Toggle insert/overstrike DEFINE_KEY('enable_buffer_journaling(current_buffer);copy_text(ascii(02));set(forward,current_buffer)', CTRL_B_KEY, "", 'edtn$km_WPS_editing_keys'); !ctrl B DEFINE_KEY('If get_info(info_window,"visible") then unmap(info_window) else end_of_word endif;', CTRL_F_KEY, "", 'edtn$km_WPS_editing_keys'); DEFINE_KEY('tab', TAB_KEY, "", 'edtn$km_WPS_editing_keys'); !ctrl i (tab key) DEFINE_KEY('edt$del_beg_word', LF_KEY, "", 'edtn$km_WPS_editing_keys'); !ctrl j (line feed) DEFINE_KEY("refresh", CTRL_R_KEY, "", 'edtn$km_WPS_editing_keys'); !ctrl R. Refresh DEFINE_KEY('enable_buffer_journaling(current_buffer);copy_text(ascii(21));set(forward,current_buffer);', CTRL_U_KEY, "", 'edtn$km_WPS_editing_keys'); !ctrl U DEFINE_KEY("refresh", CTRL_W_KEY, "", 'edtn$km_WPS_editing_keys'); !ctrl W. Refresh. DEFINE_KEY('edt$line_mode', CTRL_Z_KEY, "", 'edtn$km_WPS_editing_keys'); !ctrl Z. Enter line mode. ! ! !*** GOLD CONTROL KEYS *** DEFINE_KEY('hard_tab', KEY_NAME(CTRL_I_KEY,SHIFT_KEY), "", 'edtn$km_WPS_editing_keys'); !Gold ctrl R. Toggle ruler window. DEFINE_KEY('toggle_ruler_line', KEY_NAME(CTRL_R_KEY,SHIFT_KEY), "", 'edtn$km_WPS_editing_keys'); !Gold ctrl R. Toggle ruler window. ! ! !*** EDITING KEYS *** DEFINE_KEY('new_line', RET_KEY, "", 'edtn$km_WPS_editing_keys'); ! return DEFINE_KEY('edtn$move_by_line(reverse)',BS_KEY, "", 'edtn$km_WPS_editing_keys'); ! Backspace DEFINE_KEY('delete_previous_character', DEL_KEY, "", 'edtn$km_WPS_editing_keys'); ! rubout ! ! ! Define the Function keys on VT-200 series ! DEFINE_KEY('keypad_help', HELP, "", 'edtn$km_WPS_editing_keys'); !Keypad help DEFINE_KEY('edtn$prompt_do_command', DO, "", 'edtn$km_WPS_editing_keys'); !Command DEFINE_KEY('edtn$fill_to_end', F10, "", 'edtn$km_WPS_editing_keys'); ! DEFINE_KEY('edtn$move_by_line(reverse)', F12, "", 'edtn$km_WPS_editing_keys'); ! Backspace DEFINE_KEY('edt$del_beg_word', F13, "", 'edtn$km_WPS_editing_keys'); !ctrl j (line feed) DEFINE_KEY('change_windows', F14, "", 'edtn$km_WPS_editing_keys'); ! DEFINE_KEY('edtn$goto_buffer("MAIN","")', F17, "", 'edtn$km_WPS_editing_keys'); DEFINE_KEY('edtn$goto_buffer( "A","")', F18, "", 'edtn$km_WPS_editing_keys'); DEFINE_KEY('edtn$goto_buffer( "B","")', F19, "", 'edtn$km_WPS_editing_keys'); DEFINE_KEY('edtn$goto_buffer( "C","")', F20, "", 'edtn$km_WPS_editing_keys'); ! !------------------------------------------------------------------------------ !!!***COMP$INIT_KM_DD1_EDITING_KEYS*** !!! Define editing keys for the DD1 editing keypad !!! !!! DEFINE THE DD1 EDITING KEYS !!! !!!*** ARROW KEYS *** !!DEFINE_KEY('edtn$horizontal(-1)', left, "", 'edtn$km_DD1_editing_keys'); !left arrow !!DEFINE_KEY('edtn$horizontal(1);', right, "", 'edtn$km_DD1_editing_keys'); !right arrow !!DEFINE_KEY('edtn$vertical(-1)', up, "", 'edtn$km_DD1_editing_keys'); !up arrow !!DEFINE_KEY('edtn$vertical(1)', down, "", 'edtn$km_DD1_editing_keys'); !down arrow !!DEFINE_KEY('edtn$shift_window(edtn$v_shift_amount)', !! KEY_NAME(LEFT,SHIFT_KEY), "", 'edtn$km_DD1_editing_keys'); !Gold <- shift screen left !!DEFINE_KEY('edtn$shift_window(-edtn$v_shift_amount)', !! KEY_NAME(RIGHT,SHIFT_KEY), "", 'edtn$km_DD1_editing_keys'); !Gold -> shift screen right !!DEFINE_KEY('edtn$scroll_window(reverse)', !! KEY_NAME(UP,SHIFT_KEY), "", 'edtn$km_DD1_editing_keys'); !Gold up. Continuous scroll up !!DEFINE_KEY('edtn$scroll_window(forward)', !! KEY_NAME(DOWN,SHIFT_KEY), "", 'edtn$km_DD1_editing_keys'); !Gold down. Continuous scroll down !!! !!! !!!*** EDITING KEYPAD KEYS *** !!DEFINE_KEY('jen$init_find_string(0)', E1, "", 'edtn$km_DD1_editing_keys'); !Find !!DEFINE_KEY('edtn$paste_block(paste_buffer)', E2, "", 'edtn$km_DD1_editing_keys'); !Paste !!DEFINE_KEY('edtn$cut_block(0,paste_buffer,0)', E3, "", 'edtn$km_DD1_editing_keys'); !Cut !!DEFINE_KEY('edtn$select_block', E4, "", 'edtn$km_DD1_editing_keys'); !Select !!DEFINE_KEY('edt$section(reverse)', E5, "", 'edtn$km_DD1_editing_keys'); !Prev screen !!DEFINE_KEY('edt$section(forward)', E6, "", 'edtn$km_DD1_editing_keys'); !Next screen !!DEFINE_KEY('jen$init_find_string(1)', !! KEY_NAME(E1,SHIFT_KEY), "", 'edtn$km_DD1_editing_keys'); !Find !!DEFINE_KEY('unpaste', !! KEY_NAME(E2,SHIFT_KEY), "", 'edtn$km_DD1_editing_keys'); !Find !!DEFINE_KEY('edtn$cut_block(1,paste_buffer,0)', !! KEY_NAME(E3,SHIFT_KEY), "", 'edtn$km_DD1_editing_keys'); !Copy to buffer. !!DEFINE_KEY('edt$reset;edx_message("Select canceled.");', !! KEY_NAME(E4,SHIFT_KEY), "", 'edtn$km_DD1_editing_keys'); !Select !!DEFINE_KEY('goto_top', !! KEY_NAME(E5,SHIFT_KEY), "", 'edtn$km_DD1_editing_keys'); !Find !!DEFINE_KEY('goto_bottom', !! KEY_NAME(E6,SHIFT_KEY), "", 'edtn$km_DD1_editing_keys'); !Find !!! !!! !!! KEYPAD KEYS !!! !!DEFINE_KEY('edtn$move_by_line(forward)', !! KP0, "", 'edtn$km_DD1_editing_keys'); !Line !!!DEFINE_KEY('', !!! KP1, "", 'edtn$km_DD1_editing_keys'); !Word !!DEFINE_KEY('dd1$eol', !! KP2, "", 'edtn$km_DD1_editing_keys'); !Cut !!DEFINE_KEY('edtn$cut_block(0,paste_buffer,0)', !! KP3, "", 'edtn$km_DD1_editing_keys'); !Character !!DEFINE_KEY('edt$move_word(reverse)', !! KP4, "", 'edtn$km_DD1_editing_keys'); !Advance !!DEFINE_KEY('edt$move_word(forward)', !! KP5, "", 'edtn$km_DD1_editing_keys'); !Reverse !!DEFINE_KEY('end_of_word', !! KP6, "", 'edtn$km_DD1_editing_keys'); !End of line !!DEFINE_KEY('edt$section(reverse)', !! KP7, "", 'edtn$km_DD1_editing_keys'); !Page !!DEFINE_KEY('edt$section(forward)', !! KP8, "", 'edtn$km_DD1_editing_keys'); !Section !!DEFINE_KEY('edtn$move_by_line(reverse)', !! KP9, "", 'edtn$km_DD1_editing_keys'); !Append !!DEFINE_KEY('jen$fndnxt(1,1,-1)', !! PF2, "", 'edtn$km_DD1_editing_keys'); !Keypad help !!DEFINE_KEY('jen$fndnxt(1,1,-1)', !! PF3, "", 'edtn$km_DD1_editing_keys'); !Find next !!DEFINE_KEY('delete_line', !! PF4, "", 'edtn$km_DD1_editing_keys'); !Delete line !!DEFINE_KEY('delete_word', !! MINUS, "", 'edtn$km_DD1_editing_keys'); !Delete word !!DEFINE_KEY('delete_character', !! COMMA, "", 'edtn$km_DD1_editing_keys'); !Delete character !!DEFINE_KEY('edtn$select_block', !! PERIOD, "", 'edtn$km_DD1_editing_keys'); !Select !!! !!! !!!*** SHIFT KEYPAD KEYS *** !!DEFINE_KEY('enable_buffer_journaling(current_buffer);split_line;move_horizontal(-1)', !! KEY_NAME(KP0,SHIFT_KEY), "", 'edtn$km_DD1_editing_keys'); !Open line !!DEFINE_KEY('edt$change_case(invert)', !! KEY_NAME(KP1,SHIFT_KEY), "", 'edtn$km_DD1_editing_keys'); !Change case !!DEFINE_KEY('delete_end_of_line', !! KEY_NAME(KP2,SHIFT_KEY), "", 'edtn$km_DD1_editing_keys'); !Paste !!DEFINE_KEY('edtn$paste_block(paste_buffer)', !! KEY_NAME(KP3,SHIFT_KEY), "", 'edtn$km_DD1_editing_keys'); !Specins !!!DEFINE_KEY('', !!! KEY_NAME(KP4,SHIFT_KEY), "", 'edtn$km_DD1_editing_keys'); !Bottom !!!DEFINE_KEY('', !!! KEY_NAME(KP5,SHIFT_KEY), "", 'edtn$km_DD1_editing_keys'); !Top !!DEFINE_KEY('edtn$cntl_char', !! KEY_NAME(KP6,SHIFT_KEY), "", 'edtn$km_DD1_editing_keys'); !Delete to end of line !!DEFINE_KEY('goto_top', !! KEY_NAME(KP7,SHIFT_KEY), "", 'edtn$km_DD1_editing_keys'); !Command !!DEFINE_KEY('goto_bottom', !! KEY_NAME(KP8,SHIFT_KEY), "", 'edtn$km_DD1_editing_keys'); !Fill !!!DEFINE_KEY('', !!! KEY_NAME(KP9,SHIFT_KEY), "", 'edtn$km_DD1_editing_keys'); !Replace !!DEFINE_KEY('transpose_characters', !! KEY_NAME(PF2,SHIFT_KEY), "", 'edtn$km_DD1_editing_keys'); !Transpose characters !!DEFINE_KEY('jen$init_find_string(edtn$v_search_wild)', !! KEY_NAME(PF3,SHIFT_KEY), "", 'edtn$km_DD1_editing_keys'); !Find !!DEFINE_KEY('undelete_line', !! KEY_NAME(PF4,SHIFT_KEY), "", 'edtn$km_DD1_editing_keys'); !Undelete line !!DEFINE_KEY('undelete_word', !! KEY_NAME(MINUS,SHIFT_KEY), "", 'edtn$km_DD1_editing_keys'); !Undelete word !!DEFINE_KEY('undelete_character', !! KEY_NAME(COMMA,SHIFT_KEY), "", 'edtn$km_DD1_editing_keys'); !Undelete character !!DEFINE_KEY('edt$reset;edx_message("Select canceled.")', !! KEY_NAME(PERIOD,SHIFT_KEY), "", 'edtn$km_DD1_editing_keys'); !Reset !!!DEFINE_KEY('', !!! KEY_NAME(ENTER,SHIFT_KEY), "", 'edtn$km_DD1_editing_keys'); !Substitute !!! !!! !!!*** SHIFT KEYBOARD KEYS *** !!DEFINE_KEY('edtn$goto_buffer("","")', !! KEY_NAME('B',SHIFT_KEY), "", 'edtn$km_DD1_editing_keys'); !Gold B. Goto buffer. !!DEFINE_KEY('capitalize_word', !! KEY_NAME('C',SHIFT_KEY), "", 'edtn$km_DD1_editing_keys'); !Gold C. Capitalize Word. !!DEFINE_KEY('edtn$dir("")', !! KEY_NAME('D',SHIFT_KEY), "", 'edtn$km_DD1_editing_keys'); !Gold D. Directory. !!DEFINE_KEY('fill_paragraph', !! KEY_NAME('F',SHIFT_KEY), "", 'edtn$km_DD1_editing_keys'); !Gold F. Fill paragraph. !!DEFINE_KEY('goto_mark("")', !! KEY_NAME('G',SHIFT_KEY), "", 'edtn$km_DD1_editing_keys'); !Gold G. Goto mark. !!DEFINE_KEY('do_command("INCLUDE")', !! KEY_NAME('I',SHIFT_KEY), "", 'edtn$km_DD1_editing_keys'); !Gold I. Include file. !!DEFINE_KEY('lowercase_word', !! KEY_NAME('L',SHIFT_KEY), "", 'edtn$km_DD1_editing_keys'); !Gold L. Lowercase word. !!DEFINE_KEY('edtn$goto_buffer("MAIN","")', !! KEY_NAME('M',SHIFT_KEY), "", 'edtn$km_DD1_editing_keys'); !Gold M. Goto buffer MAIN !!DEFINE_KEY('edtn$toggle_numeric_keypad', !! KEY_NAME('N',SHIFT_KEY), "", 'edtn$km_DD1_editing_keys'); !Gold N. Toggle numeric keypad. !!DEFINE_KEY('edtn$paste_block(0)', !! KEY_NAME('O',SHIFT_KEY), "", 'edtn$km_DD1_editing_keys'); !Gold O. Copy from buffer. !!DEFINE_KEY('edtn$cut_block(1,0,0)', !! KEY_NAME('P',SHIFT_KEY), "", 'edtn$km_DD1_editing_keys'); !Gold P. Copy to buffer. !!DEFINE_KEY('edt$x_line:="";edt$exit("","QUIT")', !! KEY_NAME('Q',SHIFT_KEY), "", 'edtn$km_DD1_editing_keys'); !Gold Q. Quit. !!DEFINE_KEY('edtp$insert_ruler', !! KEY_NAME('R',SHIFT_KEY), "", 'edtn$km_DD1_editing_keys'); !Gold R. Insert ruler. !!DEFINE_KEY('do_command("SHOW BUFFERS")', !! KEY_NAME('S',SHIFT_KEY), "", 'edtn$km_DD1_editing_keys'); !Gold S. Show buffers. !!DEFINE_KEY('uppercase_word', !! KEY_NAME('U',SHIFT_KEY), "", 'edtn$km_DD1_editing_keys'); !Gold U. Uppercase word. !!DEFINE_KEY('edtn$toggle_windows', !! KEY_NAME('W',SHIFT_KEY), "", 'edtn$km_DD1_editing_keys'); !Gold W. Toggle single/dual windows. !!DEFINE_KEY('edt$x_line:="";edt$exit("","EXIT")', !! KEY_NAME('X',SHIFT_KEY), "", 'edtn$km_DD1_editing_keys'); !Gold X. Exit !!DEFINE_KEY('edtp$learning', !! KEY_NAME('[',SHIFT_KEY), "", 'edtn$km_DD1_editing_keys'); !Gold [. Start learn key sequence. !!DEFINE_KEY('edtp$stop_learn', !! KEY_NAME(']',SHIFT_KEY), "", 'edtn$km_DD1_editing_keys'); !Gold ]. End learn key sequence. !!DEFINE_KEY('goto_line("")', !! KEY_NAME('#',SHIFT_KEY), "", 'edtn$km_DD1_editing_keys'); !Gold #. Goto line number. !!DEFINE_KEY('center_line', !! KEY_NAME('=',SHIFT_KEY), "", 'edtn$km_DD1_editing_keys'); !Gold =. Center line. !!DEFINE_KEY('edtn$insert_line("")', !! KEY_NAME('-',SHIFT_KEY), "", 'edtn$km_DD1_editing_keys'); !Gold -. Insert separating line. !!DEFINE_KEY('edtn$find_char(forward)', !! KEY_NAME('.',SHIFT_KEY), "", 'edtn$km_DD1_editing_keys'); !Gold .. Find character. !!DEFINE_KEY('edtn$find_char(reverse)', !! KEY_NAME(',',SHIFT_KEY), "", 'edtn$km_DD1_editing_keys'); !Gold .. Find character. !!DEFINE_KEY('edtx$cursstat(1)', !! KEY_NAME('?',SHIFT_KEY), "", 'edtn$km_DD1_editing_keys'); !Gold ?. Cursor status. !!DEFINE_KEY('edtn$match_paren', !! KEY_NAME("'",SHIFT_KEY), "", 'edtn$km_DD1_editing_keys'); !Gold '. Find matching parenthesis. !!DEFINE_KEY('edtn$clear_paren', !! KEY_NAME('"',SHIFT_KEY), "", 'edtn$km_DD1_editing_keys'); !Gold ". Clear matching parenthesis. !!! !!! !!!*** CONTROL KEYS *** !!DEFINE_KEY('edtp$overstrike', !! CTRL_A_KEY, "", 'edtn$km_DD1_editing_keys'); !ctrl a. Toggle insert/overstrike !!DEFINE_KEY ('change_windows', !! CTRL_D_KEY, "", 'edtn$km_DD1_editing_keys'); !ctrl D. Change window. !!DEFINE_KEY('edtn$end_of_line', !! CTRL_E_KEY, "", 'edtn$km_DD1_editing_keys'); !ctrl e. Goto end of word. !!DEFINE_KEY('If get_info(info_window,"visible") then unmap(info_window) else end_of_word endif;', !! CTRL_F_KEY, "", 'edtn$km_DD1_editing_keys'); !!DEFINE_KEY('tab', !! TAB_KEY, "", 'edtn$km_DD1_editing_keys'); !ctrl i (tab key) !!DEFINE_KEY('edt$del_beg_word', !! LF_KEY, "", 'edtn$km_DD1_editing_keys'); !ctrl j (line feed) !!DEFINE_KEY('edt$define_key', !! CTRL_K_KEY, "", 'edtn$km_DD1_editing_keys'); !ctrl K !!DEFINE_KEY('enable_buffer_journaling(current_buffer);copy_text(ascii(12))', !! CTRL_L_KEY, "", 'edtn$km_DD1_editing_keys'); !ctrl L !!DEFINE_KEY("refresh", !! CTRL_R_KEY, "", 'edtn$km_DD1_editing_keys'); !ctrl R. Refresh !!DEFINE_KEY('delete_start_of_line', !! CTRL_U_KEY, "", 'edtn$km_DD1_editing_keys'); !ctrl U. Delete to beg of line. !!DEFINE_KEY ('change_windows', !! CTRL_V_KEY, "", 'edtn$km_DD1_editing_keys'); !ctrl V. Change window. !!DEFINE_KEY('change_windows', !! CTRL_W_KEY, "", 'edtn$km_DD1_editing_keys'); !ctrl W. Refresh. !!DEFINE_KEY('edt$line_mode', !! CTRL_Z_KEY, "", 'edtn$km_DD1_editing_keys'); !ctrl Z. Enter line mode. !!! !!! !!!*** GOLD CTRL KEYS *** !!DEFINE_KEY('enable_buffer_journaling(current_buffer);copy_text(current_date)', !! KEY_NAME(CTRL_D_KEY,SHIFT_KEY), "", 'edtn$km_DD1_editing_keys'); !Gold ctrl D. Insert today's date. !!DEFINE_KEY('set_mark("")', !! KEY_NAME(CTRL_G_KEY,SHIFT_KEY), "", 'edtn$km_DD1_editing_keys'); !Gold ctrl G. Mark position. !!DEFINE_KEY('hard_tab', !! KEY_NAME(CTRL_I_KEY,SHIFT_KEY), "", 'edtn$km_DD1_editing_keys'); !Gold ctrl L. Cursor status with line number. !!DEFINE_KEY('edtx$cursstat(1)', !! KEY_NAME(CTRL_L_KEY,SHIFT_KEY), "", 'edtn$km_DD1_editing_keys'); !Gold ctrl L. Cursor status with line number. !!DEFINE_KEY('toggle_ruler_line', !! KEY_NAME(CTRL_R_KEY,SHIFT_KEY), "", 'edtn$km_DD1_editing_keys'); !Gold ctrl R. Toggle ruler window. !!DEFINE_KEY('edtn$toggle_window_width', !! KEY_NAME(CTRL_W_KEY,SHIFT_KEY), "", 'edtn$km_DD1_editing_keys'); !Gold ctrl W. Toggle window width. !!! !!! !!!*** EDITING KEYS *** !!DEFINE_KEY('new_line', RET_KEY, "", 'edtn$km_DD1_editing_keys'); ! return !!DEFINE_KEY('edtn$move_by_line(reverse)',BS_KEY, "", 'edtn$km_DD1_editing_keys'); ! Backspace !!DEFINE_KEY('delete_previous_character', !! DEL_KEY, "", 'edtn$km_DD1_editing_keys'); ! rubout !!! !!! Define the numeric keys for use with edt$gold_number !!! these are necessary to emulate EDT repeat counts !!! !!DEFINE_KEY('edt$gold_number("0")', key_name('0',shift_key), "", 'edtn$km_DD1_editing_keys'); !!DEFINE_KEY('edt$gold_number("1")', key_name('1',shift_key), "", 'edtn$km_DD1_editing_keys'); !!DEFINE_KEY('edt$gold_number("2")', key_name('2',shift_key), "", 'edtn$km_DD1_editing_keys'); !!DEFINE_KEY('edt$gold_number("3")', key_name('3',shift_key), "", 'edtn$km_DD1_editing_keys'); !!DEFINE_KEY('edt$gold_number("4")', key_name('4',shift_key), "", 'edtn$km_DD1_editing_keys'); !!DEFINE_KEY('edt$gold_number("5")', key_name('5',shift_key), "", 'edtn$km_DD1_editing_keys'); !!DEFINE_KEY('edt$gold_number("6")', key_name('6',shift_key), "", 'edtn$km_DD1_editing_keys'); !!DEFINE_KEY('edt$gold_number("7")', key_name('7',shift_key), "", 'edtn$km_DD1_editing_keys'); !!DEFINE_KEY('edt$gold_number("8")', key_name('8',shift_key), "", 'edtn$km_DD1_editing_keys'); !!DEFINE_KEY('edt$gold_number("9")', key_name('9',shift_key), "", 'edtn$km_DD1_editing_keys'); !!DEFINE_KEY('edt$gold_number("")', key_name('+',shift_key), "", 'edtn$km_DD1_editing_keys'); !!!!define_key('edt$gold_number("-")', key_name('-',shift_key), "", 'edtn$km_DD1_editing_keys');!(Defined elsewhere) !!! !!! Define the Function keys on VT-200 series !!! !!DEFINE_KEY('keypad_help', HELP, "", 'edtn$km_DD1_editing_keys'); !Keypad help !!DEFINE_KEY('edtn$prompt_do_command', DO, "", 'edtn$km_DD1_editing_keys'); !Command !!DEFINE_KEY('edtn$fill_to_end', F10, "", 'edtn$km_DD1_editing_keys'); ! !!DEFINE_KEY('edtn$move_by_line(reverse)', F12, "", 'edtn$km_DD1_editing_keys'); ! Backspace !!DEFINE_KEY('edt$del_beg_word', F13, "", 'edtn$km_DD1_editing_keys'); !ctrl j (line feed) !!DEFINE_KEY('change_windows', F14, "", 'edtn$km_DD1_editing_keys'); ! !!DEFINE_KEY('edtn$goto_buffer("MAIN","")', F17, "", 'edtn$km_DD1_editing_keys'); !!DEFINE_KEY('edtn$goto_buffer( "A","")', F18, "", 'edtn$km_DD1_editing_keys'); !!DEFINE_KEY('edtn$goto_buffer( "B","")', F19, "", 'edtn$km_DD1_editing_keys'); !!DEFINE_KEY('edtn$goto_buffer( "C","")', F20, "", 'edtn$km_DD1_editing_keys'); !!! !------------------------------------------------------------------------------ !***COMP$INIT_KM_PRINTABLE_KEYS*** !Define all the printable keys ! ! DEFINE THE PRINTABLE KEYS define_key('enable_buffer_journaling(current_buffer);copy_text(" ")', key_name(" "), "", 'edtn$km_printable_keys'); ! ascii(32) Space bar define_key('enter_text("!")', key_name("!"), "", 'edtn$km_printable_keys'); ! ascii(33) Exclamation point define_key('enter_text("""")',key_name('"'), "", 'edtn$km_printable_keys'); ! ascii(34) Quotation mark define_key('enter_text("#")', key_name("#"), "", 'edtn$km_printable_keys'); ! ascii(35) Number sign define_key('enter_text("$")', key_name("$"), "", 'edtn$km_printable_keys'); ! ascii(36) Dollar sign define_key('enter_text("%")', key_name("%"), "", 'edtn$km_printable_keys'); ! ascii(37) Percent sign define_key('enter_text("&")', key_name("&"), "", 'edtn$km_printable_keys'); ! ascii(38) Ampersand define_key("enter_text('''')",key_name("'"), "", 'edtn$km_printable_keys'); ! ascii(39) Apostrophe define_key('enter_text("(")', key_name("("), "", 'edtn$km_printable_keys'); ! ascii(40) Opening parenthesis define_key('enter_text(")")', key_name(")"), "", 'edtn$km_printable_keys'); ! ascii(41) Closing parenthesis define_key('enter_text("*")', key_name("*"), "", 'edtn$km_printable_keys'); ! ascii(42) Asterisk define_key('enter_text("+")', key_name("+"), "", 'edtn$km_printable_keys'); ! ascii(43) Plus sign define_key('enter_text(",")', key_name(","), "", 'edtn$km_printable_keys'); ! ascii(44) Comma define_key('enter_text("-")', key_name("-"), "", 'edtn$km_printable_keys'); ! ascii(45) Dash define_key('enter_text(".")', key_name("."), "", 'edtn$km_printable_keys'); ! ascii(46) Period define_key('enter_text("/")', key_name("/"), "", 'edtn$km_printable_keys'); ! ascii(47) Slash define_key('enter_text("0")', key_name("0"), "", 'edtn$km_printable_keys'); ! ascii(48) Number zero define_key('enter_text("1")', key_name("1"), "", 'edtn$km_printable_keys'); ! ascii(49) Number one define_key('enter_text("2")', key_name("2"), "", 'edtn$km_printable_keys'); ! ascii(50) Number two define_key('enter_text("3")', key_name("3"), "", 'edtn$km_printable_keys'); ! ascii(51) Number three define_key('enter_text("4")', key_name("4"), "", 'edtn$km_printable_keys'); ! ascii(52) Number four define_key('enter_text("5")', key_name("5"), "", 'edtn$km_printable_keys'); ! ascii(53) Number five define_key('enter_text("6")', key_name("6"), "", 'edtn$km_printable_keys'); ! ascii(54) Number six define_key('enter_text("7")', key_name("7"), "", 'edtn$km_printable_keys'); ! ascii(55) Number seven define_key('enter_text("8")', key_name("8"), "", 'edtn$km_printable_keys'); ! ascii(56) Number eight define_key('enter_text("9")', key_name("9"), "", 'edtn$km_printable_keys'); ! ascii(57) Number nine define_key('enter_text(":")', key_name(":"), "", 'edtn$km_printable_keys'); ! ascii(58) Colon define_key('enter_text(";")', key_name(";"), "", 'edtn$km_printable_keys'); ! ascii(59) Semicolon define_key('enter_text("<")', key_name("<"), "", 'edtn$km_printable_keys'); ! ascii(60) Left angle bracket define_key('enter_text("=")', key_name("="), "", 'edtn$km_printable_keys'); ! ascii(61) Equal sign define_key('enter_text(">")', key_name(">"), "", 'edtn$km_printable_keys'); ! ascii(62) Right angle bracket define_key('enter_text("?")', key_name("?"), "", 'edtn$km_printable_keys'); ! ascii(63) Question mark define_key('enter_text("@")', key_name("@"), "", 'edtn$km_printable_keys'); ! ascii(64) At sign define_key('enter_text("A")', key_name("A"), "", 'edtn$km_printable_keys'); ! ascii(65) Letter A define_key('enter_text("B")', key_name("B"), "", 'edtn$km_printable_keys'); ! ascii(66) Letter B define_key('enter_text("C")', key_name("C"), "", 'edtn$km_printable_keys'); ! ascii(67) Letter C define_key('enter_text("D")', key_name("D"), "", 'edtn$km_printable_keys'); ! ascii(68) Letter D define_key('enter_text("E")', key_name("E"), "", 'edtn$km_printable_keys'); ! ascii(69) Letter E define_key('enter_text("F")', key_name("F"), "", 'edtn$km_printable_keys'); ! ascii(70) Letter F define_key('enter_text("G")', key_name("G"), "", 'edtn$km_printable_keys'); ! ascii(71) Letter G define_key('enter_text("H")', key_name("H"), "", 'edtn$km_printable_keys'); ! ascii(72) Letter H define_key('enter_text("I")', key_name("I"), "", 'edtn$km_printable_keys'); ! ascii(73) Letter I define_key('enter_text("J")', key_name("J"), "", 'edtn$km_printable_keys'); ! ascii(74) Letter J define_key('enter_text("K")', key_name("K"), "", 'edtn$km_printable_keys'); ! ascii(75) Letter K define_key('enter_text("L")', key_name("L"), "", 'edtn$km_printable_keys'); ! ascii(76) Letter L define_key('enter_text("M")', key_name("M"), "", 'edtn$km_printable_keys'); ! ascii(77) Letter M define_key('enter_text("N")', key_name("N"), "", 'edtn$km_printable_keys'); ! ascii(78) Letter N define_key('enter_text("O")', key_name("O"), "", 'edtn$km_printable_keys'); ! ascii(79) Letter O define_key('enter_text("P")', key_name("P"), "", 'edtn$km_printable_keys'); ! ascii(80) Letter P define_key('enter_text("Q")', key_name("Q"), "", 'edtn$km_printable_keys'); ! ascii(81) Letter Q define_key('enter_text("R")', key_name("R"), "", 'edtn$km_printable_keys'); ! ascii(82) Letter R define_key('enter_text("S")', key_name("S"), "", 'edtn$km_printable_keys'); ! ascii(83) Letter S define_key('enter_text("T")', key_name("T"), "", 'edtn$km_printable_keys'); ! ascii(84) Letter T define_key('enter_text("U")', key_name("U"), "", 'edtn$km_printable_keys'); ! ascii(85) Letter U define_key('enter_text("V")', key_name("V"), "", 'edtn$km_printable_keys'); ! ascii(86) Letter V define_key('enter_text("W")', key_name("W"), "", 'edtn$km_printable_keys'); ! ascii(87) Letter W define_key('enter_text("X")', key_name("X"), "", 'edtn$km_printable_keys'); ! ascii(88) Letter X define_key('enter_text("Y")', key_name("Y"), "", 'edtn$km_printable_keys'); ! ascii(89) Letter Y define_key('enter_text("Z")', key_name("Z"), "", 'edtn$km_printable_keys'); ! ascii(90) Letter Z define_key('enter_text("[")', key_name("["), "", 'edtn$km_printable_keys'); ! ascii(91) Left bracket define_key('enter_text("\")', key_name("\"), "", 'edtn$km_printable_keys'); ! ascii(92) Back slash define_key('enter_text("]")', key_name("]"), "", 'edtn$km_printable_keys'); ! ascii(93) Right bracket define_key('enter_text("^")', key_name("^"), "", 'edtn$km_printable_keys'); ! ascii(94) Caret define_key('enter_text("_")', key_name("_"), "", 'edtn$km_printable_keys'); ! ascii(95) Underscore define_key('enter_text("`")', key_name("`"), "", 'edtn$km_printable_keys'); ! ascii(96) Grave accent define_key('enter_text("a")', key_name("a"), "", 'edtn$km_printable_keys'); ! ascii(97) Letter a define_key('enter_text("b")', key_name("b"), "", 'edtn$km_printable_keys'); ! ascii(98) Letter b define_key('enter_text("c")', key_name("c"), "", 'edtn$km_printable_keys'); ! ascii(99) Letter c define_key('enter_text("d")', key_name("d"), "", 'edtn$km_printable_keys'); ! ascii(100) Letter d define_key('enter_text("e")', key_name("e"), "", 'edtn$km_printable_keys'); ! ascii(101) Letter e define_key('enter_text("f")', key_name("f"), "", 'edtn$km_printable_keys'); ! ascii(102) Letter f define_key('enter_text("g")', key_name("g"), "", 'edtn$km_printable_keys'); ! ascii(103) Letter g define_key('enter_text("h")', key_name("h"), "", 'edtn$km_printable_keys'); ! ascii(104) Letter h define_key('enter_text("i")', key_name("i"), "", 'edtn$km_printable_keys'); ! ascii(105) Letter i define_key('enter_text("j")', key_name("j"), "", 'edtn$km_printable_keys'); ! ascii(106) Letter j define_key('enter_text("k")', key_name("k"), "", 'edtn$km_printable_keys'); ! ascii(107) Letter k define_key('enter_text("l")', key_name("l"), "", 'edtn$km_printable_keys'); ! ascii(108) Letter l define_key('enter_text("m")', key_name("m"), "", 'edtn$km_printable_keys'); ! ascii(109) Letter m define_key('enter_text("n")', key_name("n"), "", 'edtn$km_printable_keys'); ! ascii(110) Letter n define_key('enter_text("o")', key_name("o"), "", 'edtn$km_printable_keys'); ! ascii(111) Letter o define_key('enter_text("p")', key_name("p"), "", 'edtn$km_printable_keys'); ! ascii(112) Letter p define_key('enter_text("q")', key_name("q"), "", 'edtn$km_printable_keys'); ! ascii(113) Letter q define_key('enter_text("r")', key_name("r"), "", 'edtn$km_printable_keys'); ! ascii(114) Letter r define_key('enter_text("s")', key_name("s"), "", 'edtn$km_printable_keys'); ! ascii(115) Letter s define_key('enter_text("t")', key_name("t"), "", 'edtn$km_printable_keys'); ! ascii(116) Letter t define_key('enter_text("u")', key_name("u"), "", 'edtn$km_printable_keys'); ! ascii(117) Letter u define_key('enter_text("v")', key_name("v"), "", 'edtn$km_printable_keys'); ! ascii(118) Letter v define_key('enter_text("w")', key_name("w"), "", 'edtn$km_printable_keys'); ! ascii(119) Letter w define_key('enter_text("x")', key_name("x"), "", 'edtn$km_printable_keys'); ! ascii(120) Letter x define_key('enter_text("y")', key_name("y"), "", 'edtn$km_printable_keys'); ! ascii(121) Letter y define_key('enter_text("z")', key_name("z"), "", 'edtn$km_printable_keys'); ! ascii(122) Letter z define_key('enter_text("{")', key_name("{"), "", 'edtn$km_printable_keys'); ! ascii(123) Left brace define_key('enter_text("|")', key_name("|"), "", 'edtn$km_printable_keys'); ! ascii(124) Stile define_key('enter_text("}")', key_name("}"), "", 'edtn$km_printable_keys'); ! ascii(125) Right brace define_key('enter_text("~")', key_name("~"), "", 'edtn$km_printable_keys'); ! ascii(126) Tilde ! !------------------------------------------------------------------------------ !***COMP$INIT_KM_NUMERIC_KEYPAD*** !Define numeric keypad keys define_key('enter_text("0")', KP0, "", 'edtn$km_numeric_keypad'); define_key('enter_text("1")', KP1, "", 'edtn$km_numeric_keypad'); define_key('enter_text("2")', KP2, "", 'edtn$km_numeric_keypad'); define_key('enter_text("3")', KP3, "", 'edtn$km_numeric_keypad'); define_key('enter_text("4")', KP4, "", 'edtn$km_numeric_keypad'); define_key('enter_text("5")', KP5, "", 'edtn$km_numeric_keypad'); define_key('enter_text("6")', KP6, "", 'edtn$km_numeric_keypad'); define_key('enter_text("7")', KP7, "", 'edtn$km_numeric_keypad'); define_key('enter_text("8")', KP8, "", 'edtn$km_numeric_keypad'); define_key('enter_text("9")', KP9, "", 'edtn$km_numeric_keypad'); define_key('enter_text(",")', COMMA, "", 'edtn$km_numeric_keypad'); define_key('enter_text(".")', PERIOD, "", 'edtn$km_numeric_keypad'); define_key('enter_text("-")', MINUS, "", 'edtn$km_numeric_keypad'); define_key('enter_text("(")', PF3, "", 'edtn$km_numeric_keypad'); define_key('enter_text(")")', PF4, "", 'edtn$km_numeric_keypad'); ! !------------------------------------------------------------------------------ !***COMP$INIT_KM_PMTBUF*** !Define keys used in prompt_buffer define_key('pmtbuf$up_arrow', UP, "", 'pmt$km_pmtbuf'); define_key('pmtbuf$up_arrow', CTRL_B_KEY, "", 'pmt$km_pmtbuf'); define_key('pmtbuf$down_arrow', DOWN, "", 'pmt$km_pmtbuf'); define_key('pmtbuf$toggle_insert_overstrike', CTRL_A_KEY, "", 'pmt$km_pmtbuf'); !Toggle INSERT/OVERSTRIKE define_key('pmtbuf$toggle_insert_overstrike', F14, "", 'pmt$km_pmtbuf'); !Toggle INSERT/OVERSTRIKE define_key('position(LINE_END)', CTRL_E_KEY, "", 'pmt$km_pmtbuf'); !Go to end of line define_key('goto_column( pmt$v_prompt_length+1 )', BS_KEY, "", 'pmt$km_pmtbuf'); define_key('goto_column( pmt$v_prompt_length+1 )', F12, "", 'pmt$km_pmtbuf'); define_key('pmtbuf$delete_previous_word', LF_KEY, "", 'pmt$km_pmtbuf'); define_key('pmtbuf$delete_previous_word', F13, "", 'pmt$km_pmtbuf'); define_key('pmtbuf$delete_to_bol', CTRL_U_KEY, "", 'pmt$km_pmtbuf'); define_key('update(current_window)', CTRL_R_KEY, "", 'pmt$km_pmtbuf'); define_key('tab', TAB_KEY, "", 'pmt$km_pmtbuf'); define_key('If current_offset > pmt$v_prompt_length then move_horizontal(-1) Endif;', LEFT, "", 'pmt$km_pmtbuf'); define_key('If current_offset > pmt$v_prompt_length then move_horizontal(-1) Endif;', CTRL_D_KEY, "", 'pmt$km_pmtbuf'); !left-arrow define_key('If current_offset < length(current_line) then move_horizontal(1) Endif;', RIGHT, "", 'pmt$km_pmtbuf'); define_key('If current_offset < length(current_line) then move_horizontal(1) Endif;', CTRL_F_KEY, "", 'pmt$km_pmtbuf'); !right-arrow define_key('If current_offset > pmt$v_prompt_length then erase_character(-1) Endif;', DEL_KEY, "", 'pmt$km_pmtbuf'); !------------------------------------------------------------------------------ !***COMP$INIT_KM_SHOBUF*** !Define keys used with SHOW BUFFERS display define_key('edtn$shobuf_arrow(-1)', UP, "", 'edtn$km_shobuf'); define_key('edtn$shobuf_arrow(+1)', DOWN, "", 'edtn$km_shobuf'); define_key('edtn$shobuf_delete', DEL_KEY, "", 'edtn$km_shobuf'); define_key('edtn$shobuf_delete', E3, "", 'edtn$km_shobuf'); define_key('edtn$shobuf_delete', KEY_NAME("D"), "", 'edtn$km_shobuf'); define_key('edtn$shobuf_delete', KEY_NAME("d"), "", 'edtn$km_shobuf'); define_key('edtn$shobuf_enter(0)', E4, "", 'edtn$km_shobuf'); define_key('edtn$shobuf_enter(0)', RET_KEY, "", 'edtn$km_shobuf'); define_key('edtn$shobuf_enter(0)', ENTER, "", 'edtn$km_shobuf'); define_key('edtn$shobuf_enter(0)', DO, "", 'edtn$km_shobuf'); define_key('edtn$shobuf_enter("MAIN")', F17, "", 'edtn$km_shobuf'); define_key('edtn$shobuf_enter("A")', F18, "", 'edtn$km_shobuf'); define_key('edtn$shobuf_enter("B")', F19, "", 'edtn$km_shobuf'); define_key('edtn$shobuf_enter("C")', F20, "", 'edtn$km_shobuf'); define_key('edtn$shobuf_enter("MAIN")', KEY_NAME("M",SHIFT_KEY),"",'edtn$km_shobuf'); define_key('edtn$shobuf_lock("LOCK")', KEY_NAME("L"), "", 'edtn$km_shobuf'); define_key('edtn$shobuf_lock("LOCK")', KEY_NAME("l"), "", 'edtn$km_shobuf'); define_key('edtn$shobuf_lock("UNLOCK")',KEY_NAME("U"), "", 'edtn$km_shobuf'); define_key('edtn$shobuf_lock("UNLOCK")',KEY_NAME("u"), "", 'edtn$km_shobuf'); define_key('edtn$shobuf_write', KEY_NAME("W"), "", 'edtn$km_shobuf'); define_key('edtn$shobuf_write', KEY_NAME("w"), "", 'edtn$km_shobuf'); define_key('edtn$shobuf_enter("")', KEY_NAME("B",shift_key), "", 'edtn$km_shobuf'); define_key('edtn$shobuf_enter(1)', KEY_NAME("G",shift_key), "", 'edtn$km_shobuf'); ! !------------------------------------------------------------------------------ !***COMP$INIT_KM_SHOMRK*** !Define keys used with SHOW MARKERS display define_key('edtn$shomrk_arrow(-1)', UP, "", 'edtn$km_shomrk'); define_key('edtn$shomrk_arrow(+1)', DOWN, "", 'edtn$km_shomrk'); define_key('edtn$shomrk_enter', RET_KEY, "", 'edtn$km_shomrk'); define_key('edtn$shomrk_enter', ENTER, "", 'edtn$km_shomrk'); define_key('edtn$shomrk_enter', DO, "", 'edtn$km_shomrk'); define_key('edtn$shomrk_goto("B")', KEY_NAME("B",shift_key), "", 'edtn$km_shomrk'); define_key('edtn$shomrk_goto("M")', KEY_NAME("G",shift_key), "", 'edtn$km_shomrk'); !------------------------------------------------------------------------------ !***COMP$INIT_KM_PASWRD*** !Define keys used when prompting for a password (no echo) !No longer used now that DES encryption has been removed. !!define_key('edtn$encrypt_finish', RET_KEY, "", 'edtn$km_paswrd'); !!define_key('edtn$encrypt_finish', ENTER, "", 'edtn$km_paswrd'); !!define_key('edtn$encrypt_finish', CTRL_Z_KEY, "", 'edtn$km_paswrd'); ! !------------------------------------------------------------------------------ !***COMP$INIT_KM_DIRBUF*** !Define keys used in the DIR_buffer define_key('edtn$dirbuf_updown(-1)', UP, "", 'edtn$km_dirbuf'); define_key('edtn$dirbuf_updown(+1)', DOWN, "", 'edtn$km_dirbuf'); define_key('edtn$dirbuf_left', LEFT, "", 'edtn$km_dirbuf'); define_key('edtn$dirbuf_right', RIGHT, "", 'edtn$km_dirbuf'); define_key('edtn$dirbuf_enter("CURRENT")', RET_KEY, "", 'edtn$km_dirbuf'); define_key('edtn$dirbuf_enter("CURRENT")', ENTER, "", 'edtn$km_dirbuf'); define_key('edtn$dirbuf_enter("OTHER")', KEY_NAME(' '), "", 'edtn$km_dirbuf'); define_key('edtn$dirbuf_delfile', DEL_KEY, "", 'edtn$km_dirbuf'); define_key('edtn$dirbuf_delfile', KEY_NAME('D'), "", 'edtn$km_dirbuf'); define_key('edtn$dirbuf_delfile', KEY_NAME('d'), "", 'edtn$km_dirbuf'); define_key('edtn$dirbuf_lock("LOCK")', KEY_NAME('L'), "", 'edtn$km_dirbuf'); define_key('edtn$dirbuf_lock("LOCK")', KEY_NAME('l'), "", 'edtn$km_dirbuf'); define_key('edtn$dirbuf_lock("UNLOCK")', KEY_NAME('U'), "", 'edtn$km_dirbuf'); define_key('edtn$dirbuf_lock("UNLOCK")', KEY_NAME('u'), "", 'edtn$km_dirbuf'); ! define_key('edt$section(reverse);edtn$highlight_word(edtn$rn_dirfil);', E5, "", 'edtn$km_dirbuf'); define_key('edt$section(forward);edtn$highlight_word(edtn$rn_dirfil);set(forward,current_buffer);', E6, "", 'edtn$km_dirbuf'); ! !------------------------------------------------------------------------------ !***COMP$INIT_KM_DIRBUF_EDT*** !Define additional keys used in the DIR_buffer when in EDT keypad mode ! define_key('position(LINE_BEGIN);move_by_line;edtn$highlight_word(edtn$rn_dirfil);', KP0, "", 'edtn$km_dirbuf_EDT'); define_key('if current_direction=forward then edtn$dirbuf_right else edtn$dirbuf_left endif;', KP1, "", 'edtn$km_dirbuf_EDT'); define_key('edtn$end_of_line;edtn$highlight_word(edtn$rn_dirfil);', KP2, "", 'edtn$km_dirbuf_EDT'); define_key('edt$section(current_direction);edtn$highlight_word(edtn$rn_dirfil);', KP8, "", 'edtn$km_dirbuf_EDT'); define_key('edtn$dirbuf_right', CTRL_F_KEY, "", 'edtn$km_dirbuf_EDT'); define_key('edtn$move_by_line(reverse);edtn$highlight_word(edtn$rn_dirfil);', BS_KEY, "", 'edtn$km_dirbuf_EDT'); define_key('edtn$move_by_line(reverse);edtn$highlight_word(edtn$rn_dirfil);', F12, "", 'edtn$km_dirbuf_EDT'); define_key('goto_bottom;edtn$highlight_word(edtn$rn_dirfil);', KEY_NAME(KP4,SHIFT_KEY), "", 'edtn$km_dirbuf_EDT'); define_key('goto_top;edtn$highlight_word(edtn$rn_dirfil);', KEY_NAME(KP5,SHIFT_KEY), "", 'edtn$km_dirbuf_EDT'); ! !------------------------------------------------------------------------------ !***COMP$INIT_KM_DIRBUF_WPS*** !Define additional keys used in the DIR_buffer when in WPS keypad mode ! define_key('edtn$dirbuf_right', KP0, "", 'edtn$km_dirbuf_WPS'); define_key('edtn$dirbuf_left', KP1, "", 'edtn$km_dirbuf_WPS'); define_key('position(LINE_BEGIN);move_by_line;edtn$highlight_word(edtn$rn_dirfil);', KP2, "", 'edtn$km_dirbuf_WPS'); define_key('if current_direction=forward then edtn$dirbuf_right else edtn$dirbuf_left endif;', KP4, "", 'edtn$km_dirbuf_WPS'); define_key('edtn$dirbuf_right', CTRL_F_KEY, "", 'edtn$km_dirbuf_WPS'); define_key('position(LINE_BEGIN);edtn$highlight_word(edtn$rn_dirfil);', BS_KEY, "", 'edtn$km_dirbuf_WPS'); define_key('position(LINE_BEGIN);edtn$highlight_word(edtn$rn_dirfil);', F12, "", 'edtn$km_dirbuf_WPS'); define_key('goto_top;edtn$highlight_word(edtn$rn_dirfil);', KEY_NAME("T",SHIFT_KEY), "", 'edtn$km_dirbuf_WPS'); define_key('goto_bottom;edtn$highlight_word(edtn$rn_dirfil);', KEY_NAME("B",SHIFT_KEY), "", 'edtn$km_dirbuf_WPS'); define_key('goto_top;edtn$highlight_word(edtn$rn_dirfil);', KEY_NAME(UP,SHIFT_KEY), "", 'edtn$km_dirbuf_WPS'); define_key('goto_bottom;edtn$highlight_word(edtn$rn_dirfil);', KEY_NAME(DOWN,SHIFT_KEY), "", 'edtn$km_dirbuf_WPS'); ! !------------------------------------------------------------------------------ !!!***COMP$INIT_KM_DIRBUF_DD1*** !!!Define additional keys used in the DIR_buffer when in DD1 keypad mode !!! !!define_key('edtn$move_by_line(forward);edtn$highlight_word(edtn$rn_dirfil);', !! KP0, "", 'edtn$km_dirbuf_DD1'); !!define_key('edtn$dirbuf_left', !! KP1, "", 'edtn$km_dirbuf_DD1'); !!define_key('edtn$dirbuf_right', !! KP2, "", 'edtn$km_dirbuf_DD1'); !!define_key('edtn$dirbuf_left', !! KP4, "", 'edtn$km_dirbuf_DD1'); !!define_key('edtn$dirbuf_right', !! KP5, "", 'edtn$km_dirbuf_DD1'); !!define_key('edtn$end_of_line;edtn$highlight_word(edtn$rn_dirfil);', !! KP6, "", 'edtn$km_dirbuf_DD1'); !!define_key('edt$section(reverse);edtn$highlight_word(edtn$rn_dirfil);', !! KP7, "", 'edtn$km_dirbuf_DD1'); !!define_key('edt$section(forward);edtn$highlight_word(edtn$rn_dirfil);', !! KP8, "", 'edtn$km_dirbuf_DD1'); !!define_key('edtn$move_by_line(reverse);edtn$highlight_word(edtn$rn_dirfil);', !! KP9, "", 'edtn$km_dirbuf_DD1'); !!define_key('edtn$dirbuf_right', CTRL_F_KEY, "", 'edtn$km_dirbuf_DD1'); !!define_key('edtn$move_by_line(reverse);edtn$highlight_word(edtn$rn_dirfil);', !! BS_KEY, "", 'edtn$km_dirbuf_DD1'); !!define_key('edtn$move_by_line(reverse);edtn$highlight_word(edtn$rn_dirfil);', !! F12, "", 'edtn$km_dirbuf_DD1'); !!define_key('goto_top;edtn$highlight_word(edtn$rn_dirfil);', !! KEY_NAME(KP7,SHIFT_KEY), "", 'edtn$km_dirbuf_DD1'); !!define_key('goto_bottom;edtn$highlight_word(edtn$rn_dirfil);', !! KEY_NAME(KP8,SHIFT_KEY), "", 'edtn$km_dirbuf_DD1'); !!! !------------------------------------------------------------------------------ !***COMP$INIT_KM_DICBUF*** !Define keys used in the DIC_buffer define_key('spl$dicbuf_updown(-1)', UP, "", 'spl$km_dicbuf'); define_key('spl$dicbuf_updown(+1)', DOWN, "", 'spl$km_dicbuf'); define_key('spl$dicbuf_left', LEFT, "", 'spl$km_dicbuf'); define_key('spl$dicbuf_right', RIGHT, "", 'spl$km_dicbuf'); define_key('spl$dicbuf_enter', RET_KEY, "", 'spl$km_dicbuf'); define_key('spl$dicbuf_enter', ENTER, "", 'spl$km_dicbuf'); define_key('spl$dicbuf_select', PERIOD, "", 'spl$km_dicbuf'); define_key('spl$dicbuf_select', E4, "", 'spl$km_dicbuf'); define_key('spl$dicbuf_page(reverse)', E5, "", 'spl$km_dicbuf'); define_key('spl$dicbuf_page(forward)', E6, "", 'spl$km_dicbuf'); ! !------------------------------------------------------------------------------ !***COMP$INIT_KM_DICBUF_EDT*** !Define additional keys used in the DIC_buffer when in EDT keypad mode define_key('position(LINE_BEGIN);move_by_line;edtn$highlight_word(spl$rn_dicword);', KP0, "", 'spl$km_dicbuf_EDT'); define_key('if current_direction=forward then spl$dicbuf_right else spl$dicbuf_left endif;', KP1, "", 'spl$km_dicbuf_EDT'); define_key('edtn$end_of_line;edtn$highlight_word(spl$rn_dicword);', KP2, "", 'spl$km_dicbuf_EDT'); define_key('spl$dicbuf_page(current_direction)', KP8, "", 'spl$km_dicbuf_EDT'); define_key('spl$dicbuf_right', CTRL_F_KEY, "", 'spl$km_dicbuf_EDT'); define_key('edtn$move_by_line(reverse);edtn$highlight_word(spl$rn_dicword);', BS_KEY, "", 'spl$km_dicbuf_EDT'); define_key('edtn$move_by_line(reverse);edtn$highlight_word(spl$rn_dicword);', F12, "", 'spl$km_dicbuf_EDT'); ! !------------------------------------------------------------------------------ !***COMP$INIT_KM_DICBUF_WPS*** !Define additional keys used define_key('spl$dicbuf_right', KP0, "", 'spl$km_dicbuf_WPS'); define_key('spl$dicbuf_left', KP1, "", 'spl$km_dicbuf_WPS'); define_key('position(LINE_BEGIN);move_by_line;edtn$highlight_word(spl$rn_dicword);', KP2, "", 'spl$km_dicbuf_WPS'); define_key('if current_direction=forward then spl$dicbuf_right else spl$dicbuf_left endif;', KP4, "", 'spl$km_dicbuf_WPS'); define_key('spl$dicbuf_right', CTRL_F_KEY, "", 'spl$km_dicbuf_WPS'); define_key('position(LINE_BEGIN);edtn$highlight_word(spl$rn_dicword);', BS_KEY, "", 'spl$km_dicbuf_WPS'); define_key('position(LINE_BEGIN);edtn$highlight_word(spl$rn_dicword);', F12, "", 'spl$km_dicbuf_WPS'); ! !------------------------------------------------------------------------------ !!!***COMP$INIT_KM_DICBUF_DD1*** !!!Define additional keys used in the DIC_buffer when in DD1 keypad mode !!define_key('edtn$move_by_line(forward);edtn$highlight_word(spl$rn_dicword);', !! KP0, "", 'spl$km_dicbuf_DD1'); !!define_key('spl$dicbuf_left', !! KP1, "", 'spl$km_dicbuf_DD1'); !!define_key('spl$dicbuf_right', !! KP2, "", 'spl$km_dicbuf_DD1'); !!define_key('spl$dicbuf_left', !! KP4, "", 'spl$km_dicbuf_DD1'); !!define_key('spl$dicbuf_right', !! KP5, "", 'spl$km_dicbuf_DD1'); !!define_key('edtn$end_of_line;edtn$highlight_word(spl$rn_dicword);', !! KP6, "", 'spl$km_dicbuf_DD1'); !!define_key('spl$dicbuf_page(reverse)', !! KP7, "", 'spl$km_dicbuf_DD1'); !!define_key('spl$dicbuf_page(forward)', !! KP8, "", 'spl$km_dicbuf_DD1'); !!define_key('edtn$move_by_line(reverse);edtn$highlight_word(spl$rn_dicword);', !! KP9, "", 'spl$km_dicbuf_DD1'); !!define_key('spl$dicbuf_right', CTRL_F_KEY, "", 'spl$km_dicbuf_DD1'); !!define_key('edtn$move_by_line(reverse);edtn$highlight_word(spl$rn_dicword);', !! BS_KEY, "", 'spl$km_dicbuf_DD1'); !!define_key('edtn$move_by_line(reverse);edtn$highlight_word(spl$rn_dicword);', !! F12, "", 'spl$km_dicbuf_DD1'); !!! !------------------------------------------------------------------------------ !***COMP$INIT_KM_SEARCH*** !Define keys used in the SEACH_buffer define_key('edtn$search_updown(-1)', UP, "", 'edtn$km_search'); define_key('edtn$search_updown(+1)', DOWN, "", 'edtn$km_search'); define_key('edtn$search_enter', RET_KEY, "", 'edtn$km_search'); define_key('edtn$search_enter', ENTER, "", 'edtn$km_search'); define_key('edt$section(reverse);edtn$highlight_word(jen$rn_search);', E5, "", 'edtn$km_search'); define_key('edt$section(forward);edtn$highlight_word(jen$rn_search);set(forward,current_buffer);', E6, "", 'edtn$km_search'); ! !------------------------------------------------------------------------------ !***COMP$INIT_KM_SEARCH_EDT*** !Define additional keys used in the SEARCH_buffer when in EDT keypad mode define_key('position(LINE_BEGIN);move_by_line;edtn$highlight_word(jen$rn_search);', KP0, "", 'edtn$km_search_EDT'); define_key('edt$section(current_direction);edtn$highlight_word(jen$rn_search);', KP8, "", 'edtn$km_search_EDT'); define_key('edtn$move_by_line(reverse);edtn$highlight_word(jen$rn_search);', BS_KEY, "", 'edtn$km_search_EDT'); define_key('edtn$move_by_line(reverse);edtn$highlight_word(jen$rn_search);', F12, "", 'edtn$km_search_EDT'); define_key('goto_top;edtn$highlight_word(jen$rn_search);', KEY_NAME(KP5,SHIFT_KEY), "", 'edtn$km_search_EDT'); ! !------------------------------------------------------------------------------ !***COMP$INIT_KM_SEARCH_WPS*** !Define additional keys used in the SEARCH_buffer when in WPS keypad mode define_key('position(LINE_BEGIN);move_by_line;edtn$highlight_word(jen$rn_search);', KP2, "", 'edtn$km_search_WPS'); define_key('goto_top;edtn$highlight_word(jen$rn_search);', KEY_NAME("T",SHIFT_KEY), "", 'edtn$km_search_WPS'); define_key('goto_top;edtn$highlight_word(jen$rn_search);', KEY_NAME(UP,SHIFT_KEY), "", 'edtn$km_search_WPS'); ! !------------------------------------------------------------------------------ !!!***COMP$INIT_KM_SEARCH_DD1*** !!!Define additional keys used in the SEARCH_buffer when in DD1 keypad mode !!define_key('edtn$move_by_line(forward);edtn$highlight_word(jen$rn_search);', !! KP0, "", 'edtn$km_search_DD1'); !!define_key('edt$section(reverse);edtn$highlight_word(jen$rn_search);', !! KP7, "", 'edtn$km_search_DD1'); !!define_key('edt$section(forward);edtn$highlight_word(jen$rn_search);', !! KP8, "", 'edtn$km_search_DD1'); !!define_key('edtn$move_by_line(reverse);edtn$highlight_word(jen$rn_search);', !! KP9, "", 'edtn$km_search_DD1'); !!define_key('edtn$move_by_line(reverse);edtn$highlight_word(jen$rn_search);', !! BS_KEY, "", 'edtn$km_search_DD1'); !!define_key('edtn$move_by_line(reverse);edtn$highlight_word(jen$rn_search);', !! F12, "", 'edtn$km_search_DD1'); !!define_key('goto_top;edtn$highlight_word(jen$rn_search);', !! KEY_NAME(KP8,SHIFT_KEY), "", 'edtn$km_search_DD1'); !!! !------------------------------------------------------------------------------ !+ !This code is conditionally executed depending upon the version of VAXTPU !- IF ( (GET_INFO(SYSTEM,'VERSION') > 2) !If TPU = 3.x or higher OR ((GET_INFO(SYSTEM,'VERSION') = 2) !or TPU = 2.4 or higher AND (GET_INFO(SYSTEM,'UPDATE') >= 4)) ) THEN VS$UPGRADE_EDX; !Do the upgrade COMPILE("PROCEDURE VS$UPGRADE_EDX ENDPROCEDURE"); !Don't need this procedure anymore. ENDIF; !------------------------------------------------------------------------------ !FINAL SETUP AND SAVE !To help speed up editor start up, define variables which are created during !editor start up. Even though the values themselves are not saved, !the variable names are saved. !Define system variables as variables edt$init_variables; !define some variable names used !Define buffer variables as variables !Note: don't define message_buffer, we don't want one if EDX is used in /NODISPLAY mode RULER_buffer := 0; PROMPT_buffer := 0; RECALL_buffer := 0; SHOW_buffer := 0; DIC_buffer := 0; SEARCH_buffer := 0; DIR_buffer := 0; PASTE_buffer := 0; MAIN_buffer := 0; !Define window variables as variables screen_length := 0; main_window_length := 0; bottom_window_length := 0; top_window_length := 0; message_window_length := 0; main_window := 0; top_window := 0; bottom_window := 0; info_window := 0; message_window := 0; ruler_window := 0; prompt_window := 0; !Set default keypad mode to EDT do_command("SET KEYPAD EDT"); !Create the TPU section file for the EDX editor save( "sys$disk:[]edtscnsec", "IDENT",edt$x_versno ); !Print a message about the newly compiled EDX editor message(""); message(edt$x_version + " - " + "VAXTPU version V" + str(get_info(system,'version')) + "." + str(get_info(system,'update'))); message(vs$min_version); quit;