! 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, write or call.) ! ! 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 - : Version 6 (Spelling checker) ! David W. Deley © 1986, 1987, 1988, 1989, 1990 ! !-- ! 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. ! (***NOTE*** On VMS 4 compiling requires a process paging file quota ! of ~50,000. Otherwise an 'out of memory' type error may occur during ! compiling.) ! ! 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$ - ! Editor: EDX ! Source: Newly created for this editor ! Author: David Deley © 1986, 1987, 1988, 1989, 1990 ! ! 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. ! ! ! LIMITATIONS: ! Currently 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.) ! ! ! /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) ! ! ! VMS 5.3 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. ! ! The fix is to always follow a READ_LINE statement with an ! UPDATE(MESSAGE_WINDOW) statement. ! !------------------------------------------------------------------------ ! 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 !------------------------------------------------------------------------------ ! ! 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 ! LINE MODE PARSERS ! HELP PROCEDURES ! ASCII AND CHARACTER TRANSLATION PROCEDURES ! SORTING ! MULTIPLE PROCESSING ! DIRECTORY ! SPELLING ! 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 MOVEMENT !****************************************************************************** ! EDTN$SYNC_CURSOR ! Synchronize cursor with editing position !*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. !*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 !*END_OF_WORD ! Move to end of word (CTRL-E) !*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) !*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_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 ! Enter printable character into buffer (all printable keys) !*NEW_LINE ! Enter carriage return ! !****************************************************************************** ! DELETING TEXT !****************************************************************************** !*DELETE_PREVIOUS_CHARACTER ! Erase previous character (delete) !*DELETE_CHARACTER ! Delete current character (keypad comma) ! EDT$DEL_BEG_WORD ! Delete to beginning of word !*DELETE_WORD ! Delete word (keypad minus) !*DELETE_START_OF_LINE ! Delete to beginning of line (CTRL-U) !*DELETE_END_OF_LINE ! Delete to end of line (GOLD KP2) !*DELETE_LINE ! Delete line (PF4) ! !****************************************************************************** ! UNDELETING TEXT !****************************************************************************** !*UNDELETE_CHARACTER ! Undelete character (GOLD comma) !*UNDELETE_WORD ! Undelete word (GOLD keypad minus) !*UNDELETE_LINE ! Undelete line (GOLD PF4) ! !****************************************************************************** ! CUT/PASTE OPERATIONS !****************************************************************************** ! EDTN$SELECT_BLOCK ! Select (keypad dot) ! EDTN$CUT_BLOCK ! Cut/pick selected range (KP6) ! EDTN$PASTE_BLOCK ! 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 ! Normal mode cut/pick ! EDTX$COPY_FROM ! Normal mode paste ! EDT$APPEND ! Normal mode append (KP9) ! EDT$REPLACE ! Normal mode replace (GOLD KP9) !------------------------------------------------------------------------------ ! COLUMNAR CUT/PASTE PROCEDURES !------------------------------------------------------------------------------ ! EDTN$COLUMNAR_SELECT ! Columnar select dispatcher ! EDTN$COLUMNAR_SELECT_BEGIN ! Columnar select start ! EDTN$FINISH_COLUMN_SELECT ! Columnar select finish and show box ! EDTN$COLUMNAR_CUT ! Columnar select cut ! EDTN$COLUMNAR_PASTE ! Columnar paste ! EVEPLUS_PAD_BLANK ! Support routine ! !****************************************************************************** ! FILL PARAGRAPH ROUTINES !****************************************************************************** ! EDT$FILL ! 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 ! Fill select range support routine ! EDTN$FILL_RANGE ! Fill select range support routine !*FILL_PARAGRAPH ! Fill paragraph ! EVE$PARAGRAPH_BREAK ! Determine paragraph start/end ! EDTN$FILL_TO_END ! Fill from cursor to end of paragraph ! !****************************************************************************** ! EDITING TEXT !****************************************************************************** ! EDT$CHANGE_CASE ! Change case of select range (GOLD KP1) !*UPPERCASE_WORD ! Uppercase current word (GOLD U) !*LOWERCASE_WORD ! Lowercase current word (GOLD L) !*CAPITALIZE_WORD ! Capitalize current word (GOLD C) !*CAPITALIZE_RANGE ! Capitalize range NEW !*CAPITALIZE_STRING ! Capitalize string NEW ! EVE$CURRENT_WORD ! Determine current word !*TRANSPOSE_CHARACTERS ! Swap current character with next NEW (GOLD PF2) !*CENTER_LINE ! Center line on page ! !****************************************************************************** ! SEARCHING/SUBSTITUTING TEXT !****************************************************************************** ! EVE$BUILD_PATTERN ! Build pattern for wildcard search ! JEN$FIND_STRING ! Search for a string or pattern ! SAMECASE ! support for replace ! JEN$SEARCH_AND_REPLACE ! Search and replace a string or pattern ! JEN$FNDNXT ! 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 ! Parser for line mode FIND command ! EDTN$LINE_MODE_REPLACE ! Process line mode REPLACE command ! EDTN$SUB_TOKEN ! Token extractor for EDT$LINE_MODE_SUBSTITUTE ! EDT$LINE_MODE_SUBSTITUTE ! 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 ! EDT keypad mode GOLD Enter (substitute) ! EDTN$FIND_PAT ! Move to beginning of next paragraph ! EDTN$FIND_CHAR ! Find first occurance of character (GOLD .) ! EDTN$SEARCH_LINE ! Search current line for character ! !****************************************************************************** ! 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) ! EDTP$OVERSTRIKE ! Toggle insert/overstrike mode ! EDTN$TOGGLE_WINDOWS ! Toggle one/two windows ! EDTN$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$TRIM_FILESPEC ! Trim filespec to given length ! EDTN$FILENAME_OF_BUFFER ! Get filename of buffer ! 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 ! 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 !****************************************************************************** ! EDTN$KEY_INCLUDE ! Read in a file (GOLD I) ! EDT$INCLUDE ! Read in a file (line mode *INCLUDE file) ! EDTN$READ_FILE ! Read in a file with error checking ! VS$WRITE_FILE2 ! WRITE_FILE with error checking, 2 parameters ! VS$WRITE_FILE1 ! WRITE_FILE with error checking, 1 parameter ! EDT$WRITE ! Parser for line mode (*WRITE) command ! EDTN$WRITE_BUFFER ! Write buffer to disk ! EDT$RANGE_SPECIFICATION ! support routine for line mode write command ! !****************************************************************************** ! EXIT PROCEDURES !****************************************************************************** ! EDT$EXIT ! Line mode(exit cmd) ! EDTN$CONFIRM_EXIT ! Confirm quit/exit if unwritten buffers ! !****************************************************************************** ! MARKERS !****************************************************************************** !*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 ! 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 ! EDTN$SET_DATE_FORMAT ! Set format type of todays date (line mode *SET DATE_FORMAT cmd) ! EDTN$TIME ! Fancy show time ! !****************************************************************************** ! 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 ! EDTN$NEXT_STATE ! Support routine for line mode parse & dispatch ! EDT$NEXT_TOKEN ! Support routine for line mode parse & dispatch ! EDTN$ADJUST ! Parse line mode ADJUST command ! EDTN$CLEAR ! Clear tab ! EDTN$DELETE ! Parse line mode DELETE command & DELETE BUFFER ! EDTN$ERASE ! Parse line mode ERASE command & ERASE BUFFER ! EDTN$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 ! EDTN$SET_PROMPT ! 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 ! EDTN$TRANSLATE_PARSE ! Parse line mode TRANSLATE command ! EDTN$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 NEW? ! !****************************************************************************** ! 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 ! Enter a control character (GOLD KP3) ! EDTX$CURSSTAT ! Show current line, column, and character description ! EDTN$TRANSLATE_BUFFER ! 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 ! Sort using record sort ! SRT$FILE_SORT_BUFFER ! Sort using file sort ! SRT$WRITE_TEMPFILE ! Quietly write a temporary file to disk. ! SRT$READ_FILE ! 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 ! Replace a misspelled word ! SPL$GUESS_MODE ! Guess which word the user meant ! SPL$DIC_BROWSE ! Browse through the dictionary ! SPL$DICBUF_ENTER ! 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 !****************************************************************************** ! MISCELLANEOUS !****************************************************************************** ! EDTN$MATCH_PAREN ! Match parenthesis procedure ! EDTN$CLEAR_PAREN ! Clear matching parenthesis ! EDTN$DIFFERENCES ! Compare two buffers ! EVE$TRIM_BUFFER ! Remove trailing blanks from all lines in buffer. (line mode *TRIM cmd) ! EVE_FIX_CRLFS ! Remove all 's from buffer ! EDTN$INSERT_LINE ! 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 ! EDTN$SIGNAL ! Message an error ! EVE_ELIMINATE_TABS ! 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 !VMS 4 ! VS$INIT_PROCEDURE !VMS 4 dummy procedure ! VS$START_RECORD !VMS 4 dummy procedure ! VS$START_CHARACTER !VMS 4 dummy procedure ! VS$CURS_LINE !VMS 4 return current line number ! VS$GOTO_LINE !VMS 4 goto specified line number ! VS$COPY_TEXT !VMS 4 imitate set(pad_overstruck_tabs) ! VS$FREE_MARK !VMS 4 ! VS$LINES_BETWEEN_MARKERS !VMS 4 ! !****************************************************************************** ! 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_PRINTABLE_KEYS ! Define printable keys ! COMP$INIT_KM_NUMERIC_KEYPAD ! Define numeric keypad ! COMP$INIT_KM_SHOBUF ! Define keys used with SHOW BUFFERS display ! COMP$INIT_KM_DICBUF ! Define keys used within DIC dictionary buffer ! COMP$INIT_KM_DIRBUF ! Define keys used within DIR directory buffer ! COMP$INIT_KM_PASWRD ! Define keys used with ENCRYPT command ! !------------------------------------------------------------------------------ !****************************************************************************** ! 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; ! ! 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; ! MAP THE MESSAGE WINDOW position(message_buffer); split_line; split_line; split_line; split_line; !Start messages near end of window split_line;split_line;split_line; split_line; split_line; split_line; 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 ! position(paste_buffer); ! ! Check VAXTPU version number for any possible upgrades (skip if /NODISPLAY) vs$check_version; ! ENDIF; ! !*** 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 := 1 else new_file := 0; full_filnam := temp; endif; !CHECK FOR /NOCREATE !+ if /nocreate is present and file does not exist,then exit ! if (get_info(command_line,'create') = 0) AND ! /nocreate specified (new_file = 1) AND ! file does not exist (input_file <> "") THEN ! file was specified message('Input file does not exist: '+full_filnam); exit; else temp:=file_search("") ! reset file_search 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 !READ IN THE FILE if (new_file = 0) then message('Reading in file '+full_filnam); edtn$create_main_buffer(input_file); else if (length(input_file)=0) then full_filnam := ""; endif; message('Creating new file '+full_filnam); main_buffer := create_buffer("MAIN"); if (length(full_filnam) <> 0) then set(output_file,main_buffer,full_filnam) endif; endif; if (get_info(command_line,'output') = 1) 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 position (main_buffer); split_line; append_line; ! Marks it as modified endif; endif; endif; set(eob_text,main_buffer,"[End of MAIN]"); position(beginning_of(main_buffer)); ! DO VERSION SPECIFIC STUFF ! on upgraded EDX (TPU version 2) this does: ! 1. SET(PAD_OVERSTRUCK_TABS,ON); ! 2. IF GET_INFO(COMMAND_LINE,'NOMODIFY') THEN SET(MODIFIABLE,MAIN_BUFFER,OFF); !handle /NOMODIFY vs$init_procedure; !Do version specific stuff !Process /START_POSITION=(line[,column]) temp := vs$start_record; if temp > 1 then goto_line(temp) endif; temp := vs$start_character; if mark(none) <> end_of(current_buffer) then if temp > length(current_line) then end_of_line else if temp > 1 then move_horizontal(temp-1) endif endif endif; ! START JOURNALLING if (get_info(command_line,'journal') = 1) and (get_info(command_line,'read_only') <> 1) 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 := get_info (command_line,'journal_file'); journal_file := file_parse (journal_file, ".TJL", input_file_name_only); set(bell,all,on); !Ring bell if error starting journal file edtn$start_journal(journal_file); set(bell,all,off); endif; !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 set(prompt_area,(screen_length),1,edtn$k_prompt_video); !Set prompt area to bottom of screen temp := read_line("Hit any key to continue",1); !Let the user read the error messages update(message_window); !necessary to avoid VMS 5.3 bug set(prompt_area,(screen_length - 1),1,edtn$k_prompt_video); !Reset prompt area endif; !DISPLAY MAIN BUFFER IN MAIN WINDOW if get_info(system,'display') then map(main_window,main_buffer); edtp$Set_Status_Line(main_window); update(message_window); !Since main_window overlaps message_window endif; !SWITCH OFF ALL ANNOYING BELLS EXCEPT BROADCAST MESSAGES set (bell,broadcast,on); !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; !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 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) !VAXTPU will read in the command file and print the message !"nnnn lines read from file XXXX" after this procedure exits. 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, line_feed, vertical_tab, form_feed, carriage_return; !SET THE VERSION NUMBER edt$x_version := "EDX editor version V6.2-127"; !CREATE LOCAL VARIABLES line_feed := ASCII(10); vertical_tab := ASCII(11); form_feed := ASCII(12); carriage_return := ASCII(13); !INITIALIZE GLOBAL CONSTANTS edt$x_empty := ""; !empty string edt$x_space := ASCII(32); !space character edt$x_tab_char := ASCII(9); !tab character TPU__GETMEM := 66248298; !For VMS 4.4 errors LIB__NOTFOU := 1409652; ! from $LIBDEF LIB__NORMAL := 1409025; ! from $LIBDEF SS$_ENDOFFILE := 2160; ! from $SSDEF 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...."; !INITIALIZE DEFAULT SETTINGS edt$k_select_video:=REVERSE; edt$x_info_stats_video := NONE; edtn$k_prompt_video := REVERSE; !line mode prompt video edtn$x_mark_video := "NONE"; !May be changed by user edtn$k_statln_video := REVERSE; !Status line video attribute edtn$x_keypad_mode := "EDT"; !Keypad mode 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 := 0; !lock all files by default? edtn$v_shift_amount := 32; !Default shift amount for Gold arrows 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) 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 := 1; !Set tab_key tabs jen$x_default_search_case := NO_EXACT; !Set search general jen$v_search_next := 0; !Have not yet searched for a string. jen$x_exclude_case := EXACT; !To avoid errors when unspecified jen$x_search_case := jen$x_default_search_case; !To avoid errors when unspecified 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 !INITIALIZE GLOBAL STRING VARIABLES edt$x_line := ""; !initialize as a string variable jen$x_search_string := ""; jen$x_exclude_string:= ""; 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 := 1; !Start in screen mode edt$x_repeat_count := 1; edt$x_target_column := 1; edt$x_prev_column := 1; edtn$v_locked_files:=0; !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$X_WHITESPACE := EDT$x_Space + EDT$x_Tab_Char; ! EDTN$X_FILE_DELIMITERS := eve$x_whitespace + "/="; ! EDTN$X_TOKEN_DELIMITERS := eve$x_whitespace + "!%./:;=\^`{|}~"; !Allow anything that doesn't mess us up elsewhere. ! EDTN$X_ALPHABETIC := ! Alphabetic characters "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ"; ! EDTN$X_ALPHANUMERIC := ! Alphabetic and numeric characters "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ1234567890"; ! ! Define characters which precede a word defining the beginning of a word ! and which follow a word defining the end of a word EDT$X_WORD := EDT$x_Space + EDT$x_Tab_Char + Form_Feed + Line_Feed + Carriage_return + Vertical_Tab; ! ! 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. !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 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); !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); set(max_lines,message_buffer,24); 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; !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); set(status_line,info_window,edt$x_info_stats_video, "Press CTRL-F to remove INFO_WINDOW and resume editing"); !CREATE WINDOW FOR MESSAGE BUFFER message_window := create_window (screen_length-11, 12, off); set(video,message_window,none); !CREATE WINDOW FOR RULER ruler_window := create_window (1,2,off); map(ruler_window,message_buffer); adjust_window(ruler_window,0,-1); unmap(ruler_window); 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,2,off); map(prompt_window,message_buffer); adjust_window(prompt_window,0,-1); unmap(prompt_window); 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. !However the error actually signaled is TPU$_GETMEM which doesn't correspond !to a known keyword. So we can't test to see if this was the error generated. !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. LOCAL saved_error; ON_ERROR saved_error := error; if ((get_info(system,'version') = 1) !If running VMS 4 and (saved_error = tpu__getmem)) !and error was tpu__getmem then message("The file you are trying to edit may be too big"); message("Your process paging file quota determines the maximum size file you may edit"); quit; else edtn$signal(INT(saved_error)); endif; ENDON_ERROR; main_buffer := create_buffer("MAIN",input_file); ENDPROCEDURE !---------------------------------------------------------------------- PROCEDURE EDTN$START_JOURNAL(journal_file) !This procedure traps errors while opening a 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. LOCAL saved_error; ON_ERROR saved_error := error; if (get_info(system,'version') > 1) then !TPU version 2 requires this step, saved_error := INT(saved_error) !TPU version 1 doesn't allow it. endif; edtn$signal(saved_error); edtn$x_goto_screen_mode := 0; return(0); 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 output := file_parse( input, default, related); !Regenerate 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 MOVEMENT !****************************************************************************** PROCEDURE EDTN$SYNC_CURSOR !If cursor is beyond the end of line in 'outer space' mode, !then move it to the end of the line. If get_info(system,'display') then if (get_info(current_window,'beyond_eol')) then position(search(line_end,reverse)); endif; Endif; ENDPROCEDURE 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; 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 here := vs$free_mark; !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; 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 here := vs$free_mark; !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; Else cursor_vertical(1); Endif; Endif; ELSE !BOUND CURSOR MOTION edtn$sync_cursor; !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 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; 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(search(line_begin,reverse)) !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 = ""; 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 IF (edtn$v_tab_key_tabs) THEN copy_text(edt$x_tab_char) ELSE !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(none) = 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 edtn$sync_cursor; 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)+"* ")); Else !BEYOND EOL OR OVERSTRIKE MODE, MOVE CURSOR TO NEXT TAB STOP cursor_horizontal(ncol-col); Endif; Endif; 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) edtn$sync_cursor; 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; 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 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 END_OF_WORD ! Move to end of current word. If not on a word then move to end of next word. LOCAL ran; edtn$sync_cursor; ran := search(edtn$pattern_token_end, forward); If (ran = 0) then if mark(none) = end_of(current_buffer) then 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 cof; If (get_info(system,'display')) then if (get_info (current_window, 'beyond_eol')) then cof := 1 else cof := current_offset endif Else cof := current_offset Endif; If (direction = forward) then move_vertical(1); if mark(none) <> end_of(current_buffer) then position(search(line_begin,reverse)); endif; Else position(search(line_begin,reverse)); if (cof = 0) then move_vertical(-1); position(search(line_begin,reverse)); endif; Endif; ENDPROCEDURE !------------------------------------------------------------------------------ PROCEDURE END_OF_LINE position(search(line_end,forward)); !goto EOL ENDPROCEDURE !+ ! Move to the next End of Line !- PROCEDURE EDTN$END_OF_LINE !kp2 (move to end of line) edtn$sync_cursor; if current_direction = forward then if mark(none) <> end_of (current_buffer) then if (current_character = "") !If on end of line then move_vertical(1) endif; ! move back if mark(none) <> end_of(current_buffer) then position(search(line_end,forward)) !goto EOL endif; endif; else position(search(line_begin,reverse)); move_horizontal(-1); 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; if (direction_to_move = forward) then dr := 1 else dr := -1 endif; If get_info(system,'display') then if ((current_window = top_window) or (current_window = bottom_window)) then move_vertical ( dr * edtn$v_half_section_distance ); position(search(line_begin,reverse)); !(Note 1) return; endif; endif; move_vertical ( dr * edt$v_section_distance ); position(search(line_begin,reverse)); !(Note 1) ENDPROCEDURE !------------------------------------------------------------------------------ !+ ! Process the 7 key, PAGE. !- PROCEDURE MOVE_BY_PAGE !kp7 (move to next page) LOCAL dir, next_page; 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; dir := current_direction; edtn$sync_cursor; eve$mark_LAST := vs$free_mark; if dir = FORWARD then move_horizontal(1) else move_horizontal(-1) endif; next_page := search(ascii(12),dir); position(beginning_of(next_page)); ENDPROCEDURE; !------------------------------------------------------------------------------ PROCEDURE GOTO_TOP ! Mark current position as 'LAST' and then go to beginning of buffer edtn$sync_cursor; eve$mark_LAST := vs$free_mark; position(beginning_of(current_buffer)); set(forward,current_buffer); ENDPROCEDURE PROCEDURE GOTO_BOTTOM ! Mark current position as 'LAST' and then go to end of buffer edtn$sync_cursor; eve$mark_LAST := vs$free_mark; 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 this_position, ! Marker for current cursor position last_line; ! Number of lines in buffer, including eob_text ON_ERROR message (fao ("Cannot move to line !SL", linenum)); position (this_position); return; ENDON_ERROR; this_position := mark (none); if get_info(line_parameter,'TYPE') <> INTEGER then If get_info(system,'display') then linenum := int( read_line("Line number: ") ); update(message_window); !necessary to avoid VMS 5.3 bug Else linenum := 0 Endif else linenum := line_parameter endif; if linenum <= 0 then message (fao ("Cannot move to line !SL", linenum)); return; endif; last_line := get_info (current_buffer, 'record_count'); ! + 1; ! include eob_text? If linenum > last_line then if last_line > 0 then message (fao ("Buffer has only !SL line!%S", last_line)); position(end_of(current_buffer)); else !! message ("Buffer is empty"); !say nothing when starting up with an empty buffer endif; Else vs$goto_line(linenum); message (fao ("At line !SL of buffer !AS", 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; vs$copy_text(char); 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. ! Inspired by eve_return local lm, curs_col, entry_mode; split_line; lm := edtn$v_left_margin; curs_col := get_info(current_buffer,'offset_column'); if lm > curs_col then entry_mode := get_info(current_buffer,'mode'); set(insert,current_buffer); loop copy_text(edt$x_space); curs_col := curs_col + 1; exitif curs_col >= lm; endloop; if entry_mode = overstrike then set(overstrike,current_buffer) endif; 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(search(line_end|line_begin,reverse)); return; Endif; ENDIF; 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; IF mark(none) = end_of(current_buffer) then 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 ; 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 ; 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 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) edtn$sync_cursor; 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(search(line_begin,reverse)); !(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. ! edtn$sync_cursor; 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(search(line_begin,reverse)); 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) edtn$sync_cursor; If current_offset = 0 then if mark(none) <> end_of(current_buffer) then deleted_line := erase_line else 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(search(line_begin,reverse)); 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) if deleted_character <> ascii(10) then copy_text (deleted_character) else split_line endif; move_horizontal (-1); ENDPROCEDURE !------------------------------------------------------------------------------ PROCEDURE UNDELETE_WORD !gold keypad minus(undelete word) if deleted_word <> ascii(10) then if substr(deleted_word, 1, 1) = ascii(10) then split_line; copy_text(substr(deleted_word, 2, length(deleted_word) - 1)); else copy_text(deleted_word) endif; move_horizontal( - length (deleted_word)); else split_line; move_horizontal (-1); endif; ENDPROCEDURE !------------------------------------------------------------------------------ PROCEDURE UNDELETE_LINE !gold pf4 (undelete line) LOCAL temp_length; if (edt$x_appended_line) then split_line; copy_text (deleted_line); position(search(line_begin,reverse)); 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; copy_text(deleted_line); move_horizontal( - ( temp_length ) ); endif; ENDPROCEDURE !------------------------------------------------------------------------------ !****************************************************************************** ! CUT/PASTE OPERATIONS !****************************************************************************** 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) 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 message("Select already active") else edt$x_beginning_of_select := select(edt$k_select_video); 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 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(none) = 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(none) = beginning_of(current_buffer) THEN v_on_search := 0 !Then it really doesn't matter ELSE move_horizontal(-1); if mark(none) = END_OF(edt$x_search_range) then v_on_search := 1 else v_on_search := 0 endif; move_horizontal(1); 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; if (edtn$v_tmpmrk) then here := mark(none); !Erase temporary space position(edtn$m_tmpmrk); !character placed so if (current_offset = (length(current_line)-1)) !marker would show up and (current_character = edt$x_space) then erase_character(1); !erase space endif; position(here); 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 !FINISH SELECT OF RANGE edt$select_range; !CHECK FOR NO SELECT ACTIVE if edt$x_select_range = 0 then 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 := READ_LINE("Copy to buffer [PASTE]: "); update(message_window); !necessary to avoid VMS 5.3 bug 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(none); ! position(end_of(to_buffer)); ! if mark(none) <> beginning_of(to_buffer) then ! move_horizontal(-1) ! else ! split_line; ! move_vertical(-1); ! endif; position(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) else move_text(edt$x_select_range) endif; position(temp_position); edt$x_select_range := 0; !INFORM USER If (pick) then if (to_buffer = paste_buffer) then message("Select range copied to PASTE buffer") else if (buf = 0) then !Inform only if prompted 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 := read_line ("Copy from buffer: "); update(message_window); !necessary to avoid VMS 5.3 bug 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); message (FAO("buffer !AS does not exist",in_string)); return (0); endif; Else message ("no buffer specified"); 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; copy_text(from_buffer); append_line; else message (FAO("Buffer !AS is empty",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(none); position(end_of(paste_buffer)); if mark(none) <> beginning_of(paste_buffer) then move_horizontal(-1) endif; move_text(edt$x_select_range); edt$x_select_range:=0; position(temp_pos); else 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 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 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 !Make sure we are not in the PASTE buffer. If (get_info(current_buffer,'name') = "PASTE") then message ("Cannot select in the PASTE buffer") Else IF (( mark(none) = end_of(current_buffer) ) OR ( current_character = "") ) THEN 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); 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, MK, RN, N; !GET CURRENT BUFFER usrbuf := current_buffer; !Get current buffer !+ !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. !- if ( ( mark(none) = end_of(current_buffer) ) or ( current_character = "") ) then 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. If here >= edtn$m_begin_select then end_select := mark(reverse) Else end_select := edtn$m_begin_select; edtn$m_begin_select := mark(reverse); 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(none) = 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 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 := READ_LINE("Copy to buffer [PASTE]: "); update(message_window); !necessary to avoid VMS 5.3 bug 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(none) <> beginning_of(to_buffer) then move_horizontal(-1) endif; Endif; !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 position(beginning_of(edtn$rn_line_top));!Go to beginning of columnar range LOOP !And begin looping line_select_begin := mark(none); edtn$gotocol(edtn$v_end_column); if (current_offset > 0) !Don't copy end of line null and (current_character = "") !character and (mark(none) > 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) else move_text(rn) !cut 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 message ("Select range copied to buffer PASTE") else 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 := read_line ("Copy from buffer: "); update(message_window); !necessary to avoid VMS 5.3 bug 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); message (FAO("buffer !AS does not exist",in_string)); return (0); endif; Else message ("no buffer specified"); return (0); Endif; ENDIF; num_lines := get_info(from_buffer,'record_count') - 1; ! last line is blank if num_lines = 0 then message("nothing to copy"); return; endif; here := mark(none); !Mark starting line target_buf := current_buffer; 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 := current_line; 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; COPY_TEXT(line); 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 !------------------------------------------------------------------------------ PROCEDURE EVEPLUS_PAD_BLANK !+ ! This procedure drops a space at the current position if the current ! character is null so that any mark will be for an existing character. ! In EDD, we really want a mark in a particular screen column. In TPU, ! an EOL mark would move if the line were extended. Also in EDD, we ! want to highlight the select point so we need a character there. ! The cursor is returned to its original position after the space is ! copied to the current position in the current buffer. !- IF (( mark(none) = end_of(current_buffer) ) OR ( current_character = "" )) THEN copy_text(edt$x_space); move_horizontal(-1); ENDIF ENDPROCEDURE ! EVEPLUS_PAD_BLANK !------------------------------------------------------------------------------ !****************************************************************************** ! 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 message("No Select Active"); edt$x_repeat_count := 1; Return; ENDIF; !SAVE POSITIONS original_position:=mark(none); 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 move_horizontal(1); 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 return endon_error; position(b_mark); temp_pattern:=anchor&span(eve$x_whitespace); temp_range:=search(temp_pattern,forward); position(end_of(temp_range)); 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(search(line_begin,reverse)); ! 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); position(search(line_begin,reverse)); loop exitif (mark(none) = 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 (the end of a sentence), in which case place one ! space after the period. This is so sentences wrap properly. LOCAL here; here := mark(none); position(beginning_of(fill_range)); loop exitif (mark(none) = end_of(current_buffer)); position(search(line_end,forward)); 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 (current_character = ".") then move_horizontal(1); copy_text(edt$x_space); endif; position(search(line_begin,reverse)); 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 message("Left margin must be less than or equal to right margin"); message(FAO("Left margin is !ZL, right margin is !ZL",lm,rm)); Else edtn$trim_fill_range(fill_range); fill(fill_range,edt$x_word,lm,rm); position(end_of(fill_range)); position(search(line_end,forward)); 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; Set (Forward,current_buffer); !Set forward by default ! Can't fill an empty buffer - avoid additional checks later on if beginning_of (current_buffer) = end_of (current_buffer) then message ("Nothing to fill"); return; endif; this_position := mark (none); ! Find beginning and end of paragraph ! If on a blank line do preceding paragraph !Search for beginning of paragraph loop position(search(line_begin,reverse)); !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 (none) = end_of (current_buffer); position(search(line_begin,reverse)); !See note 1. exitif eve$paragraph_break; move_vertical (1); endloop; if start_paragraph = mark (none) then message ("Nothing to fill"); position (this_position); else move_horizontal (-1); stop_paragraph := mark (none); !Confirm if more than maxlines before continuing to prevent swearing num_lines := vs$lines_between_markers(start_paragraph,stop_paragraph); if (num_lines > edtn$v_maxlines_fill_paragraph) then ring_bell(""); Y_N := read_line(FAO("Current paragraph has over !UL lines. Rewrap? (Yes or No): ", edtn$v_maxlines_fill_paragraph)); update(message_window); !Necessary to avoid VMS 5.3 bug 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 message ("Nothing to fill"); return; endif; this_position := mark (none); !SKIP LEADING SPACES ON FIRST LINE start_paragraph := mark (none); edt$skip_leading_spaces(start_paragraph); ! Find end of paragraph position(search(line_begin,reverse)); loop exitif mark (none) = end_of (current_buffer); exitif eve$paragraph_break; move_vertical (1); endloop; If start_paragraph = mark (none) then message ("Nothing to fill"); position (this_position); Else move_horizontal (-1); stop_paragraph := mark (none); ! Now fill the paragraph fill_range := create_range (start_paragraph, stop_paragraph, none); 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 change_case(edt$x_select_range,kwd); edt$x_select_range:=0; return; endif; !change case of current character If current_character <> "" then change_case(create_range(mark(none),mark(none),none),kwd); if current_direction = forward then move_horizontal(1) else move_horizontal(-1) endif; Endif; ENDPROCEDURE !------------------------------------------------------------------------------ PROCEDURE UPPERCASE_WORD !From EVE ! Put word in all uppercase letters LOCAL word_range; ! Range for current word word_range := eve$current_word; if word_range <> 0 then change_case (word_range, upper) endif; ENDPROCEDURE PROCEDURE LOWERCASE_WORD !From EVE ! Put word in all lowercase letters LOCAL word_range; ! Range for current word word_range := eve$current_word; if word_range <> 0 then change_case (word_range, lower) 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 (current_offset > 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 starting_position; starting_position := mark(none); 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 (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; ! Marker for current cursor position IF Get_info(system,'display') then If (get_info(current_window,'beyond_eol')) then position(search(line_end,reverse)); move_horizontal (1); return (create_range (this_position, this_position, none)); Endif; ENDIF; this_position := mark (none); !See if we're at the end of the buffer 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 get_info(system,'display') then if (get_info(current_window,'beyond_eol')) then return; endif; endif; if (mark(none) = end_of(current_buffer)) then return endif; if (current_character = "") then return endif; !WE DO IT IN OVERSTRIKE MODE BECAUSE IT'S FASTER !(The cursor does not repaint to the end of the line this way) entry_mode := get_info(current_buffer,'mode'); set(overstrike,current_buffer); !SWAP THE CHARACTERS ch1 := current_character; move_horizontal(+1); ch2 := current_character; copy_text(ch1); move_horizontal(-2); copy_text(ch2); move_horizontal(-1); !RESET BUFFER TO ORIGINAL MODE if entry_mode = insert then set (insert,current_buffer) endif; 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; this_position := mark (none); if this_position = end_of (current_buffer) then return endif; position(search(line_begin,reverse)); !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. ! Too much pain to keep a count here, just delete a character at a time position (search (line_end, forward)); !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(search(line_begin,reverse)); !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 message(FAO("Wild card search can not make control character from '!AS'.",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; [INRANGE]: !+ ! 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 JEN$STRNOTFOUND !Print the 'String not found' message 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 message(FAO("String '!AS' not found",jen$x_search_string)) Else message("Wildcard pattern not found") 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 edtn$sync_cursor; 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(none) = end_of(current_buffer)) then return(0) Else direction_distance := 1 Endif ELSE If (mark(none) = 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(search(line_begin,reverse)); !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; 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(none); found_one := 0; 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 edtn$sync_cursor; LOOP !SEARCH FOR TARGET STRING exitif (NOT jen$find_string); !Exit if string not found found_one := 1; !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 := read_line ("Replace? Type yes, no, all, last, or quit: ",1); !Accept single character inputs update(message_window); !necessary to avoid VMS 5.3 bug 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 message ("Replacing all occurrences..."); Endif; !PROCESS REPLACEMENT ACTION IF (index("yl", replace_action) <> 0) !yes,last THEN ! DO THE REPLACEMENT ! ERASE OLD WORD 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(edt$k_select_video); IF ((jen$x_replace_case = exact) OR (get_info(jen$x_search_string, 'type') <> string)) THEN copy_text (jen$x_replace_string) ELSE copy_text( jen$samecase( this_occurrence, jen$x_replace_string ) ); 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 := read_line ("Search for next occurrance? (Yes or No): ",1); !Accept single character inputs update(message_window); !necessary to avoid VMS 5.3 bug 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 message (fao ("Replaced !SL occurrence!%S. Press 'Find Next' key to resume search and replace.", 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 get_info(jen$x_replace_string,'type') = STRING THEN jen$search_and_replace( query, typ, nchange); ELSE old_place := mark(none); 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; 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_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 := read_line(prompt_string); !Get the string update(message_window); !necessary to avoid VMS 5.3 bug 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 return jen$fndnxt(1,1,-1); !User pressed FIND key twice. endif; Endif; 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_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 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 message("Wildcards in replacement string not allowed. Only wildcard representations"); 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; 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 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) 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 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 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 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 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 := read_line("Old string: "); update(message_window); !Necessary to avoid VMS 5.3 bug If length(search_string)= 0 then message("No string to replace"); return; Endif; ENDIF; replace_string := edt$next_token(eve$x_whitespace,term_char); IF (replace_string = "") then replace_string := read_line ("New string: "); ! empty string is ok here update(message_window); !Necessary to avoid VMS 5.3 bug 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 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]: 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 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 dr, marked_line, last_marked_line, last_marked_line_number, found_line, curs_line, buffer_ptr; !INITIALIZE SEARCH buffer_ptr := current_buffer; If (current_direction = forward) then dr := 1; last_marked_line := beginning_of(buffer_ptr); last_marked_line_number := 1; Else dr := -1; last_marked_line := end_of(buffer_ptr); last_marked_line_number := get_info(buffer_ptr,'record_count') + 1; Endif; !ENTER MAIN LOOP LOOP IF (JEN$FIND_STRING) THEN !GET THE LINE AND LINE NUMBER found_line := current_line; curs_line := vs$curs_line( last_marked_line, last_marked_line_number, dr); !PRINT OUT THE LINE WITH LINE NUMBER position(search_buffer); copy_text( FAO("!5UL !AS",curs_line,found_line) ); update(current_window); split_line; position(buffer_ptr); !GET READY FOR NEXT SEARCH If (current_direction = forward) then position(search(line_end,forward)); Else position(search(line_begin,reverse)); 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(search(line_begin,reverse)); ! 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; linum := substr(jen$rn_search,1,length(jen$rn_search)); IF edtn$string_to_integer(linum) then If change_windows then eve$mark_LAST := vs$free_mark; goto_line( INT(linum) ); Endif; ELSE 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 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) message("Unsupported SEARCH option: " + state_token); return 0; [2]: !/BUFFER= if (term_char <> '=') then 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 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 message("Search string required"); return 0; endif; !VALIDATE THAT WE HAVE A BUFFER TO SEARCH buffer_ptr := edt$find_buffer(buffer_name); !Get buffer to search If buffer_ptr = 0 then message("No such buffer "+buffer_name); return 0; Endif; !SET GLOBAL PARAMETERS AND PROCESS WILDCARDS 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 edtn$sync_cursor; !Sync the cursor old_place := mark(none); !Mark our starting location initial_bufptr := current_buffer; !Save our entry buffer make_two_windows( "SEARCH", 0); !Display SEARCH buffer If get_info(top_window,'visible') then update(top_window) !Get status line separating windows Endif; erase(search_buffer); !Erase SEARCH buffer 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 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; if current_direction = reverse then if (mark(none) <> beginning_of(current_buffer)) then move_horizontal(-1); rn2 := search(pat2,reverse,exact); if rn2 <> 0 then position(beginning_of(rn2)); if (mark(none) <> 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(character) !Search in current direction for first occurance of character Local char,rn,dr; char := character; if char = "" then char := read_char endif; If (current_direction = forward) then dr := 1 Else dr := -1 Endif; edtn$sync_cursor; 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,current_direction,no_exact); if rn <> 0 then position(end_of(rn)); move_horizontal(1); return 1; else return 0; endif; ENDPROCEDURE !------------------------------------------------------------------------------ PROCEDURE EDTN$SEARCH_LINE(char) !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; If (current_direction = forward) then dr := 1 Else dr := -1 Endif; edtn$sync_cursor; 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; LOOP move_horizontal(dr); if (current_character = char) then !Found character we're looking for. move_horizontal(1); exitif; endif; if ((dr = 1) and (current_character = "")) !Went to end of line. then if (mark(none) <> end_of(current_buffer)) then move_horizontal(dr) endif; exitif; endif; if ((dr = -1) and (current_offset = 0)) !Went to start of line then exitif; endif; 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 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 message ("I'm sorry, I can't count any higher than ZZ"); if get_info(system,'display') then bufnam := read_line("Enter a buffer name: "); update(message_window); !necessary to avoid VMS 5.3 bug return (bufnam); else return(""); endif; Else j := 65; i := i + 1; Endif; ENDIF; endloop; ENDPROCEDURE !------------------------------------------------------------------------------ !+ ! Find the buffer by name !- 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 of form NAME_buffer given the name of the buffer. ! Return the buffer pointer. ! Originally from edt$buffer ! Also trap Fatal Internal TPU Errors ! !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. ! PROCEDURE EDTN$CREATE_BUFFER(buffer_name,filespec) !GLOBAL edtn$x_make_buf_name, ! edtn$x_make_buf_file; LOCAL buffer_ptr, create_variable_string, cw, saved_error, old_bell; ON_ERROR saved_error := error; !Save error # since it is modified by every step if saved_error = tpu__getmem then If get_info(system,'display') then erase(message_buffer); !Hopefully this will buy us some memory set(bell,all,on); !Let's ring the bell a lot too adjust_window(message_window,-5,0); !Prepare to display multi-line messages 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; message("%TPU-E-GETMEM, Memory allocation failure"); !Reprint the actual error message in full message("The file you read in may have been too big."); !And tell him of the impending doom message("This condition can lead directly to a Fatal TPU Internal Error."); message("A Fatal TPU Internal Error will occur if you attempt to create a new buffer."); message("We recommend saving your work and exiting IMMEDIATELY!"); abort; !Return to interactive key processing else if saved_error = tpu$_executefail then message("Invalid buffer specification: " + buffer_name); return 0; else if (get_info(system,'version') > 1) then !TPU version 2 requires this step, saved_error := INT(saved_error) !TPU version 1 doesn't allow it. endif; edtn$signal(saved_error); return (0); endif; endif; ENDON_ERROR; !SAVE OUR CURRENT POSITION IN CASE OF ERROR if get_info(system,'display') then cw := current_window endif; !PIECE TOGETHER THE COMMAND edtn$x_make_buf_name := buffer_name; edit(edtn$x_make_buf_name,trim,upper); if length(filespec)=0 then create_variable_string := edtn$x_make_buf_name + "_buffer := create_buffer(edtn$x_make_buf_name)" else edtn$x_make_buf_file := filespec; create_variable_string := edtn$x_make_buf_name + "_buffer := create_buffer(edtn$x_make_buf_name,edtn$x_make_buf_file)"; endif; !CHECK THE LENGTH If (length(create_variable_string) > 132) then old_bell := get_info(SYSTEM,'bell'); !Save old bell setting set (bell,all,on); !Prepare to ring the warning bell message ("You've got to be kidding! That buffer name is way too long!"); set (bell,all,off); if (old_bell <> 0) then !Reset bell to former setting set (bell,old_bell,on) endif; return (0); Endif; !CREATE THE BUFFER execute (create_variable_string); !NOW GET THE POINTER BACK !(we know it is the last buffer in the list since it was just created) buffer_ptr := get_info (buffers,'last'); !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) ! Map specified buffer to current window ! Parameters: ! buf_nam - Name of buffer to go to. ! fil_nam - Name of file to read into buffer if buffer does not ! yet exist. ! fil_nam = 0 - nofile ! fil_nam = "" - prompt for file name ! ! GLOBAL - BUFW$M_DUALPOS; LOCAL buffer_name, !Name of buffer to go to filename, !Name of optional file to read into newly created buffer buffer_ptr, term_char, file_write, here, test, mark_name, mark_name_prefix, other_buf, sav_dualpos; !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 !GET BUFFER NAME TO GO TO edit (buffer_name, TRIM, UPPER); If buffer_name = "" then if get_info(system,'display') then edtn$clear_message_window; !Clear message window buffer_name := read_line ("Buffer name: "); update(message_window); !necessary to avoid VMS 5.3 bug edit (buffer_name, TRIM, UPPER); If (buffer_name = '*') then buffer_name := edtn$newbufnam Endif; If (length(buffer_name) = 0) then Return(0); Endif; else message("Buffer name required"); return(0); endif; Endif; !IF BUFFER DOESN'T EXIST THEN CREATE THE BUFFER WITH THE FILE. buffer_ptr := edt$find_buffer(buffer_name); IF buffer_ptr = 0 then If filename = "" then if get_info(system,'display') then filename := read_line(FAO("Enter optional file for new buffer !AS: ",buffer_name)); update(message_window); !Necessary to avoid VMS 5.3 bug 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); buffer_ptr := edtn$create_buffer(buffer_name,filename); !OTHERWISE JUST READ IN THE FILE ELSE if (get_info(filename,'type') = STRING) then edit (filename, trim, upper); if (length(filename) > 0) then position(buffer_ptr); here := mark(none); edtn$read_file(filename); position(here); endif; endif; ENDIF; !MAP CURRENT WINDOW TO EXISTING BUFFER 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 := vs$free_mark; 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(current_window,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 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; IF get_info(system,'display') then edtp$set_status_line(current_window); IF ( get_info( main_window,'buffer') = buffer_ptr ) THEN edtp$Set_Status_Line( main_window) ENDIF; IF ( get_info( top_window,'buffer') = buffer_ptr ) THEN edtp$Set_Status_Line( top_window) ENDIF; IF ( get_info(bottom_window,'buffer') = buffer_ptr ) THEN edtp$Set_Status_Line(bottom_window) ENDIF; ENDIF; 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 edtn$make_one_window(current_buffer) ! in dual window mode. Else ! make_two_windows("","") !otherwise switch to two windows Endif; ! ENDPROCEDURE PROCEDURE EDTN$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(none); !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 (if new one created). ! 0 for no file, "" for prompt. LOCAL first_buffer, first_window, second_bufnam, second_window, filename, buffer_ptr, fromain; 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; !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 ESTABLISH NAME OF SECOND BUFFER if (second_bufnam = 0) then return endif; if second_bufnam = "" then second_bufnam := read_line("Enter name of second buffer: "); update(message_window); !Necessary to avoid VMS 5.3 bug If (second_bufnam = "") then message("no buffer specified"); if (NOT fromain) then edtn$make_one_window(first_buffer) else update(message_window) !Reset message window to bottom of buffer endif; RETURN; Endif; endif; edit(second_bufnam,trim,upper); If (second_bufnam = '*') then second_bufnam := edtn$newbufnam; Endif; !SEARCH FOR SECOND BUFFER buffer_ptr := edt$find_buffer(second_bufnam); !IF SECOND BUFFER DOESN'T EXIST THEN CREATE IT WITH OPTIONAL FILE IF (buffer_ptr = 0) then if (filename = "") then filename := read_line(FAO("Enter optional file for new buffer !AS: ",second_bufnam)); update(message_window); !necessary to avoid VMS 5.3 bug if (length(filename)=0) and (last_key=ctrl_z_key) then Return endif; !User wants to abort this procedure else if filename = 0 then filename := "" endif; endif; buffer_ptr := edtn$create_buffer(second_bufnam,filename); ENDIF; !MAP SECOND BUFFER TO SECOND WINDOW if (get_info(second_window,'buffer') <> buffer_ptr) then map (second_window, buffer_ptr); edtp$set_status_line(second_window); if (second_window = top_window) then edtn$adjust_ruler_shift; !in case main window was shifted endif; else position(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 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 ! Spaces 59 - 60 = 2 ! Mode 61 - 70 = 10 ! Spaces 71 - 72 = 2 ! Columnar 73 - 80 = 8 ! TOTAL 80 LOCAL Which_Buffer, Mode, file, filnam, Column_Mode, 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 buffer_name := get_info(Which_Buffer,'name'); if (length(Buffer_name) > 6) then Buffer_name := "<" + SUBSTR(Buffer_Name,1,6) + ">" else Buffer_name := "<" + Buffer_Name + ">" + SUBSTR(" ",1,6 - length(buffer_name)) endif; !GET FILE NAME filnam := edtn$filename_of_buffer(Which_Buffer); edtn$trim_filespec( filnam, 42); File := 'File: ' + Filnam; !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, edtn$k_statln_video, Buffer_Name + " " + File + " " + Mode + " " + Column_Mode); 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; file := get_info(Which_Buffer,'output_file'); if file = 0 then file := get_info(Which_Buffer,'file_name') endif; return(file); 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 message("Can not shift screen in /NODISPLAY mode"); return(0); ENDIF; N := NUMCOLS; If ( N = 0 ) then N := read_line("Enter number of columns to shift window (negative to shift left): "); update(message_window); !necessary to avoid VMS 5.3 bug 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); message(FAO("Window shifted total of !UL columns",total_shift)); 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 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 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 prev_video := edtn$k_statln_video; edtn$k_statln_video := BLINK; set(status_line,top_window,none,""); edtp$set_status_line(top_window); update(top_window); edtn$k_statln_video := prev_video; !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; message(FAO(msgstr,"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; message(FAO(msgstr,"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. message(""); message(""); 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(overstrike,show_buffer); 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 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,edtn$k_statln_video, " Use up/down arrow keys to move cursor. Press RETURN to select buffer."); map(info_window,show_buffer); endif; 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 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 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 set(status_line,info_window,edt$x_info_stats_video, "Press CTRL-F to remove INFO_WINDOW and resume editing"); 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 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 message(""); !clear rest of message display if get_info(bufptr,'modified') then mods := "modified" else mods := "unmodified" endif; Y_N := read_line("Delete " + mods + " buffer " + bufnam + "? "); update(message_window); !Necessary to avoid VMS 5.3 bug edit(Y_N,trim,upper,OFF); rn := 0; If ( index("YES",Y_N) = 1) then delete(bufptr); sholin := erase_line; if mark(none) = 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, start, rn, entry_mode; If (lock_type = "LOCK") then code := 65537 !LOCK FILE x00010001 Else code := 65538 !UNLOCK FILE x00010002 Endif; here := mark(none); edtn$gotocol(33); start := mark(none); position(search(line_end,forward)); !goto EOL rn := create_range(start,mark(none),none); !range is filename filename := substr(rn,1,length(rn)); IF ((filename = "") OR (filename = 'Permanent')) THEN 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); 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 := 1; !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 !------------------------------------------------------------------------------ !****************************************************************************** ! FILE INPUT/OUTPUT PROCEDURES !****************************************************************************** PROCEDURE EDTN$KEY_INCLUDE ! Read in a file at the current cursor position. edt$x_line := ""; edt$include; ENDPROCEDURE PROCEDURE EDT$INCLUDE ! support routine for line mode(include cmd) LOCAL file_name , full_filnam, equal_option, eq_buf, term_char, temp, rec; !+ ! Get the file name !- file_name := edt$next_token(edtn$x_file_delimiters,term_char); if (file_name = "") then If get_info(system,'display') then edt$x_line := READ_LINE("File: "); update(message_window); !Necessary to avoid VMS 5.3 bug If (length(edt$x_line) = 0) and (last_key = ctrl_z_key) then Return !User didn't want this procedure Endif; file_name := edt$next_token(edtn$x_file_delimiters,term_char); endif; if (file_name = "") then message('No file specified'); return (0) endif endif; !+ ! Now we look for the optional RANGE. We are only going to support ! one particular option. That of specifying a buffer for the file ! to go into !- IF (term_char = "=") then eq_buf := edt$next_token(edtn$x_token_delimiters,term_char); If (eq_buf = '*') then eq_buf := edtn$newbufnam Endif; edtn$goto_buffer( eq_buf, file_name); return (1); ENDIF; !+ ! Parse the file name !- if (NOT edtn$file_parse(full_filnam,file_name,"","")) then return endif; !Read the file in rec := get_info(current_buffer,'record_count'); temp := mark(none); edtn$read_file(full_filnam); position(temp); !Now set the status line if (rec = 0) AND (current_buffer <> main_buffer) then set(output_file,current_buffer,file_search(full_filnam)); EDTP$Set_Status_line(CURRENT_WINDOW); !Check for /NODISPLAY made in procedure endif; return (1) 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. LOCAL cw,saved_error,result; ON_ERROR saved_error := error; if saved_error = tpu$_nocache then If get_info(SYSTEM,'display') then erase(message_buffer); !Hopefully this will buy us some memory set(bell,all,on); !Let's ring the bell a lot too adjust_window(message_window,-5,0); !Prepare to display multi-line messages 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; message("%TPU-E-NOCACHE, Insufficient virtual memory to allocate a new cache"); !Reprint the actual error message in full message("The file you read in may have been too big."); !And tell him of the impending doom message("This condition can lead directly to a Fatal Internal TPU Error."); message("A Fatal TPU Internal Error will occur if you attempt to create a new buffer."); message("We recommend saving your work and exiting IMMEDIATELY!"); abort; else if (get_info(system,'version') > 1) then !TPU version 2 requires this step, saved_error := INT(saved_error) !TPU version 1 doesn't allow it. endif; edtn$signal(saved_error); return (0); endif; ENDON_ERROR; !Mark our current location now so we don't loose it when the error occurs if get_info(system,'display') then cw := current_window endif; result := read_file(file_name); If ((edtn$v_lock) and (result <> "")) then do_command("LOCK FILE " + result); Endif; ENDPROCEDURE !------------------------------------------------------------------------------ ! When we stop supporting VMS 4, we can replace these two procedures ! with a single procedure VS$WRITE_FILE( BUFFER; FILENAME ) ! where the second parameter is optional. ! ! VS$WRITE_FILE ! Write BUFFER to disk. Return 1 if successful, 0 if not successful. ! Lock file written if SET LOCK is in effect. ! PROCEDURE VS$WRITE_FILE2( BUFFER_PTR, FILENAME ) LOCAL FULL_FILENAME; ON_ERROR EDTN$SIGNAL(ERROR); RETURN (0); ENDON_ERROR; FULL_FILENAME := WRITE_FILE( BUFFER_PTR, FILENAME ); IF (EDTN$V_LOCK) THEN DO_COMMAND("LOCK FILE " + FULL_FILENAME); ENDIF; RETURN (1); ENDPROCEDURE PROCEDURE VS$WRITE_FILE1( BUFFER_PTR ) LOCAL FULL_FILENAME; ON_ERROR EDTN$SIGNAL(ERROR); RETURN (0); ENDON_ERROR; FULL_FILENAME := WRITE_FILE( BUFFER_PTR ); IF (EDTN$V_LOCK) THEN DO_COMMAND("LOCK FILE " + FULL_FILENAME); ENDIF; RETURN (1); ENDPROCEDURE !------------------------------------------------------------------------------ PROCEDURE EDT$WRITE( prev_term_param) ! support routine for line mode(write cmd) ! Parameters: ! prev_term_param = '/' (slash was present after the WRITE indicating a qualifier follows) ! = ' ' (space, tab, or nothing followed the WRITE command) LOCAL filename, got_filename, buffer_ptr, buffer_name, range_specifier, term_char, prev_term_char, token, token_type, text_to_write, modified_buffers, write_status; !INITIALIZE VARIABLES filename := ""; !output file name got_filename := 0; !has filename been explicitly specified buffer_ptr := current_buffer; !default to current buffer 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 Return edtn$write_buffer(buffer_ptr,filename); ELSE token_type := index('/=',prev_term_char); CASE token_type FROM 0 TO 2 [0]:!FILENAME or RANGE If (NOT got_filename) then filename := token; got_filename := 1; Else range_specifier := token; text_to_write := edt$range_specification(range_specifier); if (text_to_write = 0) then return (0) endif; write_status := vs$write_file2(text_to_write,filename); !+ ! If we wrote out a range, it must have been the select range. ! Get rid of it. !- if (get_info(text_to_write,'type') = RANGE) then edt$x_select_range := 0 endif; return(write_status); Endif; [1]:!/BUFFER If (index('BUFFER' ,token)=1) then buffer_name := edt$next_token(edtn$x_token_delimiters,term_char); buffer_ptr := edt$find_buffer(buffer_name); if (buffer_ptr = 0) then message (FAO("Buffer !AS does not exist",buffer_name)); return(0); endif; Else if (index('ALL' ,token)=1) then modified_buffers := 0; 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 := 1; 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 message("No modified buffers to write") endif; return (1); else message(FAO("Unsupported WRITE option /!AS",token)); return (0); endif Endif; [2]:!=bufnam buffer_name := token; buffer_ptr := edt$find_buffer(buffer_name); if (buffer_ptr = 0) then message (FAO("Buffer !AS does not exist",token)); return (0); endif; ENDCASE; ENDIF; prev_term_char := term_char; ENDLOOP; ENDPROCEDURE !------------------------------------------------------------------------------ PROCEDURE EDTN$WRITE_BUFFER(buf_ptr,filnam) ! Writes the contents of the current buffer to disk. ! !Parameters: ! buf_ptr: buffer to write - input ! filnam: optional name of file to write - input ! ! David Deley. November, 1987. LOCAL buffer_ptr, buffer_name, file_name, full_filnam, related; !MAKE LOCAL COPIES OF INPUT PARAMETERS buffer_ptr := buf_ptr; file_name := filnam; !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 buffer_name := get_info(buffer_ptr,'name'); If get_info(system,'display') then file_name := read_line( FAO( "Enter filename for buffer !AS, !UL line!%S (RETURN not to write it): ", buffer_name, get_info(buffer_ptr,'record_count') )); update(message_window); !necessary to avoid VMS 5.3 bug edit(file_name, trim, upper); Endif; IF (length(file_name) = 0) then message(FAO("Buffer !AS not written",buffer_name)); Return 1; !Successful return since we did what user told us to ENDIF; ENDIF; !PARSE THE FILE NAME related := edtn$filename_of_buffer(buffer_ptr); if (NOT edtn$file_parse(full_filnam,file_name,"",related)) then Return 0; endif; !SEE IF BUFFER FILE NAME NEEDS SETTING IF (file_name <> "") !We were either given a file name or we prompted for one AND (buffer_ptr <> paste_buffer) !Don't associate a file name with the paste buffer THEN set(output_file,buffer_ptr,full_filnam); ! 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; ENDIF; !WRITE THE FILE TO DISK if (buffer_ptr = paste_buffer) then Return ( vs$write_file2(buffer_ptr,full_filnam) ); !Buffer has no file name associated. Use the one we prompted for else Return ( vs$write_file1(buffer_ptr) ); !File name was associated with buffer above endif; ENDPROCEDURE !------------------------------------------------------------------------------ !+ ! Process a range specifier. We will return either a range or a buffer. !- PROCEDURE EDT$RANGE_SPECIFICATION ( SPEC ) ! support routine for line mode write command LOCAL r_index, ranges, range_length; !+ ! What did they give us !- ranges := ' SELECT' + ! 1 ' WHOLE ' + ! 2 ' REST ' + ! 3 ' BEFORE' + ! 4 ' = '; ! 5 range_length := 7; r_index := index(ranges,(' '+spec)); r_index := ( (r_index + range_length - 1) / range_length); CASE r_index from 0 TO 2 [0]: message('Unsupported range specification: ' + spec); return (0); [1]: !SELECT edt$select_range; if (edt$x_select_range = 0) then message("No Select Active"); return (0); else return edt$x_select_range endif; [2]: !WHOLE r_index := current_buffer; return r_index; ENDCASE; message('Unsupported range specification: ' + spec); return (0); 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, saved_error; ON_ERROR ! If an error occurs here stop the EXIT saved_error := error; if saved_error <> tpu$_nojournal then if (get_info(system,'version') > 1) then !TPU version 2 requires this step, saved_error := INT(saved_error) !TPU version 1 doesn't allow it. endif; edtn$signal(saved_error); return (0); endif; 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 message(FAO("Unsupported !AS option /!AS",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; !Set all buffers to no_write and exit. !We do this because 'quit' would ask us again if we want to quit. buffer_ptr := get_info(buffers,'first'); loop exitif buffer_ptr = 0; set(no_write,buffer_ptr); buffer_ptr := get_info(buffers,'next'); endloop; !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. buffer_ptr := get_info(buffers,'first'); 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,'next'); 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); if get_info(system,'display') then If (NOT get_info(info_window,'visible')) !If not currently showing 'confirm_exit' window then edtp$set_status_line(current_window); update(current_window); Endif; endif; Else if (get_info(command_line,'read_only') = 1) !If /READ_ONLY or (get_info(command_line,'output') <> 1) !or /NOOUTPUT then message('File specification required'); if (get_info(info_window,'visible')) !Remove 'confirm_exit' window if visible then unmap (info_window); set(status_line,info_window,edt$x_info_stats_video, "Press CTRL-F to remove INFO_WINDOW and resume editing"); 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_file1(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 exit; !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 pos, !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; pos := current_window; cur_buf := current_buffer; erase(show_buffer); set(tab_stops,show_buffer,'18 26 33'); ! Same as for SHOW BUFFERS command position(show_buffer); split_line; !PUT TITLE IN REVERSE VIDEO mk := select(reverse); copy_text('THE FOLLOWING BUFFERS WILL NOT BE SAVED'); rn := select_range; 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(none) = end_of(current_buffer) ); 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 message(""); !clear message display Y_N := read_line("The buffer you are in will not be saved. Continue " + exit_type + "? "); Else Y_N := read_line("Continue " + exit_type + "? ") Endif; update(message_window); !Necessary to avoid VMS 5.3 bug edit(Y_N,trim,upper,off); If ( index("YES",Y_N) = 1) then Return 1; Else unmap(info_window); set(status_line,info_window,edt$x_info_stats_video, "Press CTRL-F to remove INFO_WINDOW and resume editing"); position(pos); Return 0; Endif; ENDPROCEDURE !------------------------------------------------------------------------------ !****************************************************************************** ! MARKERS !****************************************************************************** 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; ON_ERROR message (fao ("Cannot use !AS as a mark name", 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 := read_line("Set mark: "); update(message_window); !Necessary to avoid VMS 5.3 bug edit(mark_name, trim, upper, OFF); endif; if length(mark_name) = 0 then message("Current position not marked"); return(0); endif; Endif; create_mark_string := "eve$mark_" + mark_name + " := mark (" + edtn$x_mark_video + ")" ; if length (create_mark_string) > 132 then message("You've got to be kidding! Current position not marked."); Return(0); endif; execute (create_mark_string); message (fao ("Current position marked as !AS", 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 message (FAO ("Mark !AS not set", 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 := read_line("Go to mark: "); update(message_window); !Necessary to avoid VMS 5.3 bug edit(mark_name, trim, upper, OFF); endif; if length(mark_name) = 0 then message("No mark name given"); 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(none); !Initialize as a marker type variable execute("eve$actual_mark := " + eve$full_mark_name);!Translate name to marker variable else message (FAO ("Mark '!AS' not set", mark_name )); return(0); endif; ENDIF; !CHECK THE MARKER If (get_info(eve$actual_mark,'type') <> MARKER) then message (FAO ("Mark '!AS' not set", mark_name )); return(0); endif; !GET BUFFER OF MARK this_buffer := current_buffer; old_position := mark (none); 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); message (fao ("At mark !AS", 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, last_marked_line, last_marked_line_number, mlino, term_char, text_line, saved_error, search_range, num_spaces; ON_ERROR saved_error := error; if (saved_error = tpu$_nonames) then message ("No markers are set"); return; else if (saved_error <> tpu$_multiplenames) then if (get_info(system,'version') > 1) then !TPU version 2 requires this step, saved_error := INT(saved_error) !TPU version 1 doesn't allow it. endif; edtn$signal(saved_error); return (0); endif; endif; ENDON_ERROR; set_mark("CURRENT"); !Displays message "Current position marked as CURRENT" !! message("Creating show markers display..."); 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 := VS$FREE_MARK; !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'); last_marked_line := beginning_of(current_buffer); last_marked_line_number := 1; mlino := vs$curs_line( last_marked_line, last_marked_line_number, 1); 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,edtn$k_statln_video, " 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 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 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 set(status_line,info_window,edt$x_info_stats_video, "Press CTRL-F to remove INFO_WINDOW and resume editing"); 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 set(status_line,info_window,edt$x_info_stats_video, "Press CTRL-F to remove INFO_WINDOW and resume editing"); unmap(info_window); edtp$set_status_line(current_window); Endif; ENDPROCEDURE !****************************************************************************** ! KEY LEARN PROCEDURES !****************************************************************************** PROCEDURE EDTP$LEARNING ! Learn key sequence LOCAL learn_sequence,saved_error; ON_ERROR saved_error := error; if (get_info(system,'version') > 1) then !TPU version 2 requires this step, saved_error := INT(saved_error) !TPU version 1 doesn't allow it. endif; edtn$signal(saved_error); return (0); 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(current_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 message ("LEARN aborted") else learn_begin(exact); message ("LEARN Activated. Press GOLD ] to end LEARN sequence"); endif; ENDPROCEDURE PROCEDURE EDTP$STOP_LEARN ! Bound to Gold-] when learn activated LOCAL learn_sequence,saved_error; ON_ERROR saved_error := error; if (get_info(system,'version') > 1) then !TPU version 2 requires this step, saved_error := INT(saved_error) !TPU version 1 doesn't allow it. endif; edtn$signal(saved_error); return (0); 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 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 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; !MARK CURRENT LOCATION start_mark := mark(none); !FIND THE CURRENT WINDOW WIDTH AND INSERT IN THE PROPER SIZE RULER if get_info(system,'display') then current_width := get_info(current_window,'width') else current_width := 80 endif; ruler_line := substr(edtn$x_ruler_line,1,132); !INSERT THE RULER LINE curs_col := get_info(current_buffer,'offset_column'); !Save column If mark(none) <> end_of(current_buffer) then position(search(line_begin,reverse)); ! Move to beginning of line Endif; 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(none); 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 !Insert today's date. !Formats: (taken from word-11) ! 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 ! ! edtn$v_date_format_case: ! 1: UPPERCASE ! 2: lowercase ! 3: Capitalize ! ! edtn$v_date_format_zeros: ! 0: 5/9/87 (no leading zeros) ! 1: 05/09/87 (leading zeros included) ! ! edtn$v_date_format_ds:= (character to separate month/day/year. Slash '/' or dash'-') ! LOCAL date, 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 !DATE date := FAO("!%D",0); !DAY if (substr(date,1,1) = edt$x_space) then day := substr(date,2,1); if (edtn$v_date_format_zeros = 1) then day := "0" + day endif; else day := substr(date,1,2) endif; !MONTH month := substr(date,4,3); CASE edtn$v_date_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 (edtn$v_date_format_zeros = 1) and (int(month) < 10) then month := "0" + month endif; ENDCASE; CASE edtn$v_date_format_case from 1 to 3 ! [1]:!Already in uppercase [2]: edit(month,LOWER,OFF); [3]: capitalize_string(month); ENDCASE; !YEAR CASE edtn$v_date_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 edtn$v_date_format_type from 1 to 5 [1]: return(day + edtn$x_date_format_ds + month + edtn$x_date_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 + edtn$x_date_format_ds + day + edtn$x_date_format_ds + year); [5]: return(day + edtn$x_date_format_ds + month + edtn$x_date_format_ds + year); ENDCASE; ENDPROCEDURE !------------------------------------------------------------------------------ PROCEDURE EDTN$SET_DATE_FORMAT ! Line mode command SET DATE LOCAL set_date_state_table, set_date_tablen, set_date_index, token, term_char; !INITIALIZE STATE TABLE set_date_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 set_date_tablen := 11; term_char := ""; LOOP set_date_index := edtn$next_state(set_date_state_table,set_date_tablen,token,term_char); if (set_date_index = "EOL") then exitif endif; CASE set_date_index FROM 0 TO 13 [0]: message('Unsupported SET DATE option: ' + 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 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; !WRITE OUT THE TIME message(about + zone + edt$x_space + time + Oclock + "."); 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 := read_line('*'); update(message_window); !Necessary to avoid VMS 5.3 bug 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. ! This procedure is required soley so that we may include an ! update(message_window) after the read_line which is our workaround to ! the bug introduced in VMS 5.3. Local command; command := read_line("Command: "); update(message_window); !Necessary to avoid VMS 5.3 bug 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; !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 ' SHIFT ' + ! 33 ' SHOW ' + ! 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 ' WRITE ' ; ! 46 edt$x_command_length := 12; !Qualifiers for line mode SET command: edt$x_sets := ' ? ' + ! 1 ' COLUMNAR ' + ! 2 ' CURSOR ' + ! 3 ' DATE_FORMAT ' + ! 4 ' DEFAULT ' + ! 5 ' INSERT ' + ! 6 ' KEYPAD ' + ! 7 ' LEFT_MARGIN ' + ! 8 ' LOCK ' + ! 9 ' MARKERS ' + ! 10 !really SET MARKER ' NOCOLUMNAR ' + ! 11 ' NOLOCK ' + ! 12 ' NORECTANGULAR' + ! 13 ' NOWRAP ' + ! 14 ' OVERSTRIKE ' + ! 15 ' PROMPT ' + ! 16 ' RECTANGULAR ' + ! 17 ' SCREEN_UPDATE' + ! 18 ' SEARCH ' + ! 19 ' SHIFT_AMOUNT ' + ! 20 ' SYMBOL ' + ! 21 ' TABS ' + ! 22 !Before TAB_KEY so SET TAB means this ' TAB_KEY ' + ! 23 ' WRAP ' ; ! 24 edt$x_set_length := 14; !Qualifiers for line mode SHOW command: edt$x_shows := ' ? ' + ! 1 ' ASCII ' + ! 2 ' BUFFERS ' + ! 3 ' CURSOR ' + ! 4 ' DATE ' + ! 5 ' DEFAULT ' + ! 6 ' LEFT_MARGIN ' + ! 7 ' LOGICAL ' + ! 8 ' MARKERS ' + ! 9 ' SCREEN ' + ! 10 ' SEARCH ' + ! 11 ' SHIFT_AMOUNT' + ! 12 ' SYMBOL ' + ! 13 ' TIME ' + ! 14 ' VERSION ' + ! 15 ' WRAP ' ; ! 16 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 46 [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 message(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; update(current_window); Else Return (0); !Do nothing Endif; [3]:!ADJUST command_status := edtn$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(edt$x_line); [5]:!CHANGE (C for CHANGE comes first) !See if there's an optinal line number following the CHANGE command command_name := edt$next_token(edtn$x_token_delimiters,term_char); 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 := edtn$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 := edtn$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 command_status := edtn$encrypt_begin; edtn$x_goto_screen_mode := 1; ! must exit line mode for read password to work [20]:!ERASE command_status := edtn$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 := edtn$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 := edt$include; 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. 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]:!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 ); [34]:!SHOW command_status := edt$show; [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 := edtn$translate_parse; [41]:!TRIM command_status := edtn$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 message("Only TYPE ALL is supported"); endif; [43,44]:!UNDEFINE, UNLEARN command_status := edtn$unlearn; [45]:!UNLOCK edtn$lock_file("UNLOCK"); [46]:!WRITE command_status := edt$write(term_char); ENDCASE; set(forward,current_buffer); !a line mode command returns with Return (command_status); !buffer in forward mode. 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 EDTN$NEXT_STATE(table,tablen,state_token,term_char) LOCAL state_index, prefix, prev_term_char; prev_term_char := term_char; state_token := edt$next_token(edtn$x_token_delimiters,term_char); if (state_token = "") then return ("EOL") endif; if prev_term_char = "/" then prefix := "/" else prefix := " " endif; state_index := index(table,(prefix + state_token)); state_index := ((state_index + tablen - 1) / tablen); return (state_index); 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 ! 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 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 endif; endif; !Otherwise do nothing return token; ENDPROCEDURE !------------------------------------------------------------------------------ PROCEDURE EDTN$ADJUST ! Line mode command ADJUST ! LOCAL adjust_state_table, adjust_tablen, adjust_index, token, term_char; !INITIALIZE STATE TABLE adjust_state_table := ' ? ' + ! 1 ' WINDOWS' ; ! 2 adjust_tablen := 8; adjust_index := edtn$next_state(adjust_state_table,adjust_tablen,token,term_char); If (adjust_index = "EOL") then if get_info(system,'display') then edt$x_line := read_line("ADJUST what: "); update(message_window); !necessary to avoid VMS 5.3 bug edit(edt$x_line,trim,upper,OFF); endif; !else edt$x_line already := ""; if (edt$x_line = "") then message('You must provide an option to ADJUST'); return 0; else return edtn$adjust !Recursively call ourselves endif Endif; CASE adjust_index FROM 0 TO 2 [0]: message('Unsupported ADJUST option: ' + token); return 0; [1]: !HELP ADJUST edt$help ("EDX_HELP","ADJUST"); [2]: !ADJUST WINDOWS edtn$adjust_dual_windows; ENDCASE; ENDPROCEDURE !------------------------------------------------------------------------------ PROCEDURE EDTN$CLEAR ! Line mode command CLEAR ! LOCAL clear_state_table, clear_tablen, clear_index, token, term_char, here; !INITIALIZE STATE TABLE clear_state_table := ' ? ' + ! 1 ' TABS' ; ! 2 clear_tablen := 5; clear_index := edtn$next_state(clear_state_table,clear_tablen,token,term_char); If (clear_index = "EOL") then if get_info(system,'display') then edt$x_line := read_line("CLEAR what: "); update(message_window); !necessary to avoid VMS 5.3 bug edit(edt$x_line,trim,upper,OFF); endif; !else edt$x_line already := ""; if (edt$x_line = "") then message('You must provide an option to CLEAR'); return 0; else return edtn$clear !Recursively call ourselves endif Endif; CASE clear_index FROM 0 TO 2 [0]: message('Unsupported CLEAR option: ' + token); return 0; [1]: !HELP CLEAR edt$help ("EDX_HELP","CLEAR"); [2]: !CLEAR TAB token := edt$next_token(edtn$x_token_delimiters+',',term_char); If (token = "") then if get_info(system,'display') then token := read_line("CLEAR TAB at: "); update(message_window); !Necessary to avoid VMS 5.3 bug endif; if (token = "") then message('Missing parameter to CLEAR TAB'); 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(none); 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 message("Numeric value illegal") Else here := mark(none); 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; ENDCASE; ENDPROCEDURE !------------------------------------------------------------------------------ PROCEDURE EDTN$DELETE !Line mode command DELETE LOCAL delete_state_table, delete_tablen, delete_index, token, term_char, Y_N, buf_lines, bufnam, buf, mods; !INITIALIZE STATE TABLE delete_state_table := ' ? ' + ! 1 ' BUFFER' ; ! 2 delete_tablen := 7; delete_index := edtn$next_state(delete_state_table,delete_tablen,token,term_char); If (delete_index = "EOL") then if get_info(system,'display') then edt$x_line := read_line("DELETE what: "); update(message_window); !necessary to avoid VMS 5.3 bug edit(edt$x_line,trim,upper,OFF); endif; !else edt$x_line already := ""; if (edt$x_line = "") then message('You must provide an option to DELETE'); return 0; else return edtn$delete; !Recursively call ourselves endif; Endif; CASE delete_index FROM 0 TO 2 [0]: message('Unsupported DELETE option: ' + token); return 0; [1]: !HELP DELETE edt$help ("EDX_HELP","DELETE"); [2]: !DELETE BUFFER buf := current_buffer; buf_lines := get_info(buf,'record_count'); bufnam := get_info(buf,'name'); If (NOT get_info(system,'display')) then message(FAO("Deleting buffer !AS, !UL line!%S.",bufnam,buf_lines,bufnam)); delete(buf); !No confirming in /NODISPLAY mode Else ring_bell(""); !Ring bell and message(""); !clear message display if get_info(buf,'modified') then mods := "Modified" else mods := "Unmodified" endif; Y_N := read_line(FAO("!AS buffer !AS contains !UL line!%S. Delete buffer !AS? ", mods, bufnam, buf_lines, bufnam)); update(message_window); !Necessary to avoid VMS 5.3 bug edit(Y_N,trim,upper,OFF); If ( index("YES",Y_N) = 1) then delete(buf); endif; Endif; ENDCASE; ENDPROCEDURE !------------------------------------------------------------------------------ PROCEDURE EDTN$ERASE !Line mode command ERASE LOCAL erase_state_table, erase_tablen, erase_index, token, term_char, Y_N, buf_lines, bufnam, buf, mods; !INITIALIZE STATE TABLE erase_state_table := ' ? ' + ! 1 ' BUFFER' ; ! 2 erase_tablen := 7; erase_index := edtn$next_state(erase_state_table,erase_tablen,token,term_char); If (erase_index = "EOL") then if get_info(system,'display') then edt$x_line := read_line("ERASE what: "); update(message_window); !necessary to avoid VMS 5.3 bug edit(edt$x_line,trim,upper,OFF); endif; !else edt$x_line already := ""; if (edt$x_line = "") then message('You must provide an option to ERASE'); return 0; else return edtn$erase; !Recursively call ourselves endif; Endif; CASE erase_index FROM 0 TO 2 [0]: message('Unsupported ERASE option: ' + token); return 0; [1]: !HELP ERASE edt$help ("EDX_HELP","ERASE"); [2]: !ERASE BUFFER buf := current_buffer; buf_lines := get_info(buf,'record_count'); IF (buf_lines = 0) then message("Buffer is empty"); ELSE bufnam := get_info(buf,'name'); If (NOT get_info(system,'display')) then message(FAO("Erasing buffer !AS, !UL line!%S.",bufnam,buf_lines,bufnam)); erase(buf); !No confirming in /NODISPLAY mode Else ring_bell(""); !Ring bell and message(""); !clear rest of message display if get_info(buf,'modified') then mods := "Modified" else mods := "Unmodified" endif; Y_N := read_line(FAO("!AS buffer !AS contains !UL line!%S. Erase contents of buffer !AS? ", mods, bufnam, buf_lines, bufnam)); update(message_window); !Necessary to avoid VMS 5.3 bug edit(Y_N,trim,upper,OFF); If ( index("YES",Y_N) = 1) then erase(buf); endif; Endif; ENDIF; ENDCASE; ENDPROCEDURE !------------------------------------------------------------------------------ PROCEDURE EDTN$FIX ! Line mode command FIX ! LOCAL fix_state_table, fix_tablen, fix_index, token, term_char; !INITIALIZE STATE TABLE fix_state_table := ' ? ' + ! 1 ' CRLFS' ; ! 2 fix_tablen := 6; fix_index := edtn$next_state(fix_state_table,fix_tablen,token,term_char); If (fix_index = "EOL") then if get_info(system,'display') then edt$x_line := read_line("FIX what: "); update(message_window); !necessary to avoid VMS 5.3 bug edit(edt$x_line,trim,upper,OFF); endif; !else edt$x_line already := ""; if (edt$x_line = "") then message('You must provide an option to FIX'); return 0; else return edtn$fix; !Recursively call ourselves endif; Endif; CASE fix_index FROM 0 TO 2 [0]: message('Unsupported FIX option: ' + token); return 0; [1]: !HELP FIX edt$help ("EDX_HELP","FIX"); [2]: !FIX CRLFS eve_fix_crlfs; ENDCASE; ENDPROCEDURE !------------------------------------------------------------------------------ PROCEDURE EDTN$LOCK_FILE(LOCK_TYPE) ! line mode command LOCK and UNLOCK ! Parameter: LOCK_TYPE = LOCK ! = UNLOCK ! LOCAL lock_state_table, lock_tablen, lock_index, token, term_char, result, code, retcode, buf, bufnam, filename; !INITIALIZE STATE TABLE lock_state_table := ' ? ' + ! 1 ' BUFFER' + ! 2 ' FILE ' ; ! 3 lock_tablen := 7; lock_index := edtn$next_state(lock_state_table,lock_tablen,token,term_char); If (lock_index = "EOL") then if get_info(system,'display') then edt$x_line := read_line(LOCK_TYPE+" what: "); update(message_window); !Necessary to avoid VMS 5.3 bug edit(edt$x_line,trim,upper,OFF); endif; !else edt$x_line already := ""; if (edt$x_line = "") then message("You must provide an option to "+LOCK_TYPE); return 0; else return edtn$lock_file(lock_type) !Recursively call ourselves endif Endif; if (lock_type = "LOCK") then code := 65537 !LOCK FILE x00010001 else code := 65538 !UNLOCK FILE x00010002 endif; CASE lock_index FROM 0 TO 3 [0]: message("Unsupported "+LOCK_TYPE+" option: "+token); return 0; [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 message(FAO("Buffer !AS does not exist",bufnam)); return 0; endif; endif; filename := edtn$filename_of_buffer(buf); if (filename = "") then 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 := read_line('FILENAME: '); update(message_window); !Necessary to avoid VMS 5.3 bug endif; if (filename = "") then message("no filename given"); return 0; endif; Endif; ENDCASE; result := call_user(code,filename); retcode := int(substr(result,1,9)); IF (retcode = 1) then edtn$v_locked_files := 1; !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; 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 := read_line("SET what: "); update(message_window); !necessary to avoid VMS 5.3 bug edit(edt$x_line,trim,upper,OFF); endif; !else edt$x_line already := ""; if (edt$x_line = "") then message('You must provide an option to SET'); return 0; else return edt$set; !Recursively call ourselves endif; Endif; set_index := index(edt$x_sets,(' ' + set_type)); set_index := ((set_index + edt$x_set_length - 1) / edt$x_set_length); CASE set_index FROM 0 to 24 [0]: message('Unsupported SET option: ' + set_type); return (0); [1]:!HELP SET edt$help ("EDX_HELP","SET"); [2,17]:!SET COLUMNAR, RECTANGULAR if (edt$x_select_range <> 0) then message("Select already active"); Return (0); endif; edt$reset; edtn$v_columnar_mode := 1; 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 INSERT set (insert,current_buffer); IF get_info(system,'display') then edtp$set_status_line(current_window); IF ( get_info( main_window,'buffer') = current_buffer ) THEN edtp$Set_Status_Line( main_window) ENDIF; IF ( get_info( top_window,'buffer') = current_buffer ) THEN edtp$Set_Status_Line( top_window) ENDIF; IF ( get_info(bottom_window,'buffer') = current_buffer ) THEN edtp$Set_Status_Line(bottom_window) ENDIF; ENDIF; [7]:!SET KEYPAD command_status := edtn$set_keypad; [8]:!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); [9]:!SET LOCK edtn$set_lock("LOCK"); [10]:!MARKERS ! Get the {marker-name} temp_value1 := edt$next_token(edtn$x_token_delimiters,term_char); set_mark(temp_value1); [11,13]:! SET NOCOLUMNAR, NORECTANGULAR edt$reset; edtn$v_columnar_mode := 0; 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; [12]:!SET NOLOCK edtn$set_lock("UNLOCK"); [14]:!SET NOWRAP edt$x_wrap_position := 0; [15]:!SET OVERSTRIKE set(overstrike,current_buffer); IF get_info(system,'display') then edtp$set_status_line(current_window); IF ( get_info( main_window,'buffer') = current_buffer ) THEN edtp$Set_Status_Line( main_window) ENDIF; IF ( get_info( top_window,'buffer') = current_buffer ) THEN edtp$Set_Status_Line( top_window) ENDIF; IF ( get_info(bottom_window,'buffer') = current_buffer ) THEN edtp$Set_Status_Line(bottom_window) ENDIF; ENDIF; [16]:!SET PROMPT VIDEO edtn$set_prompt; [18]:!SET SCREEN {width} !SET SCREEN_UPDATE {ON|OFF} IF (NOT get_info(system,'display')) then 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 := read_line("SET SCREEN [ON|OFF|width]: "); update(message_window); !Necessary to avoid VMS 5.3 bug edit(temp_value1,trim,upper,OFF); if (temp_value1 = "") then message('Missing width parameter for SET SCREEN'); 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 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); update(message_window); endif; Endif; ENDIF; [19]:!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 := read_line("SET SEARCH type: "); update(message_window); !necessary to avoid VMS 5.3 bug edit(set_type,trim,upper,OFF); endif; !else edt$x_line already := ""; if (set_type = "") then message('Missing parameter to SET SEARCH'); 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]: 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; [3]:!SET SEARCH EXACT jen$x_default_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; [20]:!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 := read_line("SET SHIFT_AMOUNT to: "); update(message_window); !necessary to avoid VMS 5.3 bug edit(temp_value1,trim,upper,OFF); endif; if (temp_value1 = "") then message('Missing parameter to SET SHIFT'); return (0); endif; Endif; temp_value1 := int(temp_value1); If (temp_value1 = 0) then message("Illegal value for shift amount"); return (0); Endif; edtn$v_shift_amount := temp_value1; [21]:!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 ':=' 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); [22]:!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 := read_line("SET TAB at: "); update(message_window); !necessary to avoid VMS 5.3 bug endif; if (temp_value1 = "") then message('Missing parameter to SET TABS'); 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 := read_line("SET TABS EVERY: "); update(message_window); !necessary to avoid VMS 5.3 bug edit(temp_value1,trim,upper,OFF); if (temp_value1 = "") then message('Missing parameter for SET TABS EVERY'); return (0); endif; endif; temp_value1 := int(temp_value1); If (temp_value1 > 132) OR (temp_value1 < 1) then message("Numeric value illegal") Else here := mark(none); 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 move_horizontal(temp_value1-1); exitif ( current_offset >= (132-temp_value1) ); copy_text('T'); 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 message("Numeric value illegal") Else here := mark(none); 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; [23]:!SET TAB_KEY command_status := edtn$set_tab_key; [24]:!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 := read_line("SET WRAP to: "); update(message_window); !necessary to avoid VMS 5.3 bug edit(temp_value1,trim,upper,OFF); endif; if (temp_value1 = "") then message('Missing parameter to SET WRAP'); 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 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 cursor_state_table, cursor_tablen, cursor_index, token, term_char, here, top, bottom; IF (NOT get_info(system,'display')) then message("Cursor can only be bound in /NODISPLAY mode"); return(0); ENDIF; !INITIALIZE STATE TABLE cursor_state_table := ' ? ' + ! 1 ' BOUND ' + ! 2 ' NOFREE ' + ! 3 ' FREE ' + ! 4 ' UNBOUND' ; ! 5 cursor_tablen := 8; cursor_index := edtn$next_state(cursor_state_table,cursor_tablen,token,term_char); if (cursor_index = "EOL") then edt$x_line := read_line("SET CURSOR what: "); update(message_window); !Necessary to avoid VMS 5.3 bug edit(edt$x_line,trim,upper,OFF); if (edt$x_line = "") then message('You must provide an option to CURSOR'); return 0; else return edtn$set_cursor !Recursively call ourselves endif endif; CASE cursor_index FROM 0 TO 5 [0]: top := int(token); bottom := edt$next_token(edtn$x_token_delimiters,term_char); if (bottom = "") then 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; 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 := read_line("DEFAULT: "); update(message_window); !necessary to avoid VMS 5.3 bug edit(def,trim,upper,OFF); endif; if (def = "") then return 0; endif; endif; result := call_user(code,def); ENDPROCEDURE; !------------------------------------------------------------------------------ PROCEDURE EDTN$SET_KEYPAD LOCAL set_keypad_states, set_keypad_tablen, set_keypad_index, token, term_char, keymap_name; !SUPPRESS NOKEYMAP WARNING MESSAGES on_error endon_error; IF (NOT get_info(system,'display')) then message("Can not set keypad in /NODISPLAY mode"); return(0); ENDIF; !INITIALIZE STATE TABLE set_keypad_states := ' ? ' + ! 1 ' EDT ' + ! 2 ' WPS ' + ! 3 ' NUMERIC' ; ! 4 set_keypad_tablen := 8; set_keypad_index := edtn$next_state(set_keypad_states,set_keypad_tablen,token,term_char); if (set_keypad_index = "EOL") then edt$x_line := read_line("SET KEYPAD to: "); update(message_window); !necessary to avoid VMS 5.3 bug edit(edt$x_line,trim,upper,OFF); if (edt$x_line = "") then message('You must provide an option for SET KEYPAD'); return 0; else return edtn$set_keypad; !Recursively call ourselves endif; endif; CASE set_keypad_index FROM 0 TO 4 [0]: message('Unsupported SET KEYPAD option: ' + token); return 0; [1]:!HELP SET KEYPAD edt$help ("EDX_HELP","SET KEYPAD"); [2,3]:!SET KEYPAD EDT, WPS !Clean out the key map list. 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_numeric_keypad", all); CASE set_keypad_index from 2 to 3 [2]: add_key_map("tpu$key_map_list", "last", "edtn$km_EDT_editing_keys"); edtn$x_keypad_mode := "EDT"; [3]: add_key_map("tpu$key_map_list", "last", "edtn$km_WPS_editing_keys"); edtn$x_keypad_mode := "WPS"; ENDCASE; [4]:!SET KEYPAD NUMERIC add_key_map("tpu$key_map_list", "first", "edtn$km_numeric_keypad"); ENDCASE; 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 := 1; Else edtn$v_lock := 0; 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 := read_line("Log name: "); update(message_window); !necessary to avoid VMS 5.3 bug 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 := read_line("Equ name: "); update(message_window); !Necessary to avoid VMS 5.3 bug 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 EDTN$SET_PROMPT ! Line mode command SET PROMPT ! SET PROMPT VIDEO to {NONE | BOLD | BLINK | REVERSE | UNDERLINE } ! LOCAL temp_value1, video_state_table, video_tablen, video_index, token, term_char; !INITIALIZE STATE TABLE video_state_table := ' ? ' + ! 1 ' NONE ' + ! 2 ' BOLD ' + ! 3 ' BLINK ' + ! 4 ' REVERSE ' + ! 5 ' UNDERLINE' ; ! 6 video_tablen := 10; temp_value1:= edt$next_token(edtn$x_token_delimiters,term_char); If (temp_value1 <> "") then if (temp_value1 = "?") then edt$help ("EDX_HELP","SET PROMPT VIDEO"); return; else if (index("VIDEO",temp_value1) <> 1) then message("Only SET PROMPT VIDEO currently supported."); return(0); endif; endif; Endif; video_index := edtn$next_state(video_state_table,video_tablen,token,term_char); if (video_index = "EOL") then edt$x_line := read_line( "SET PROMPT VIDEO to {NONE | BOLD | BLINK | REVERSE | UNDERLINE } : "); update(message_window); !Necessary to avoid VMS 5.3 bug if (edt$x_line = "") then message("Prompt video not changed"); return 0; else change_case( edt$x_line, UPPER); video_index := edtn$next_state(video_state_table,video_tablen,token,term_char); endif; Endif; CASE video_index FROM 0 TO 6 [0]: message("Unsupported SET PROMPT VIDEO option"); return (0); [1]:!HELP SET PROMPT VIDEO edt$x_line := read_line( "SET PROMPT VIDEO to {NONE | BOLD | BLINK | REVERSE | UNDERLINE } : "); update(message_window); !Necessary to avoid VMS 5.3 bug if (edt$x_line = "") then message("Prompt video not changed"); return 0; else change_case( edt$x_line, UPPER); edt$x_line := "SET PROMPT VIDEO " + edt$x_line; edtn$set_prompt; !recursively call ourselves endif; [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); 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 tab_key_state_table, tab_key_tablen, tab_key_index, token, term_char, here; !INITIALIZE STATE TABLE tab_key_state_table := ' ? ' + ! 1 ' SPACES' + ! 2 ' TABS ' ; ! 3 tab_key_tablen := 7; tab_key_index := edtn$next_state(tab_key_state_table,tab_key_tablen,token,term_char); If (tab_key_index = "EOL") then if get_info(system,'display') then edt$x_line := read_line("SET TAB_KEY to (TABS or SPACES): "); update(message_window); !necessary to avoid VMS 5.3 bug edit(edt$x_line,trim,upper,OFF); endif; if (edt$x_line = "") then message('You must provide an option to SET TAB_KEY'); return 0; else return edtn$set_tab_key !Recursively call ourselves endif Endif; CASE tab_key_index FROM 0 TO 3 [0]: message('Unsupported SET TAB_KEY option: ' + token); return 0; [1]:!HELP SET TAB_KEY edt$help ("EDX_HELP","SET TAB_KEY"); [2]:!SET TAB_KEY SPACES edtn$v_tab_key_tabs := 0; [3]:!SET TAB_KEY TABS edtn$v_tab_key_tabs := 1; ENDCASE; 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; !+ ! 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 := read_line("SHOW what: "); update(message_window); !necessary to avoid VMS 5.3 bug edit(edt$x_line,trim,upper,OFF); endif; if (edt$x_line = "") then message('You must provide an option to SHOW'); 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 16 [0]: 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 CURSOR If (NOT get_info(system,'display')) then 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'))); message(buf); if (edtn$v_free_cursor) then message("Cursor is FREE") else message("Cursor is BOUND") endif; [5]:!SHOW DATE message(current_date); [6]:!SHOW DEFAULT filename := file_parse(""); message(substr(filename,1,length(filename)-2)); !erase '.;' at end [7]:!SHOW LEFT_MARGIN message(FAO("Left margin is set to !UL", edtn$v_left_margin)); [8]:!SHOW LOGICAL edtn$show_logical(edt$x_line); [9]:!SHOW MARKERS edtn$show_markers; edtn$x_goto_screen_mode := 1; !Return to screen mode [10]:!SHOW SCREEN If get_info(system,'display') then message("Screen Width is " + str(get_info(current_window,'width'))); else message("Can not show screen width in /NODISPLAY mode"); endif; [11]:!SHOW SEARCH buf := 'Search settings: '; if (edt$x_search_begin) then buf := buf + 'BEGIN ' else buf := buf + 'END ' endif; if (jen$x_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; message(buf); [12]:!SHOW SHIFT_AMOUNT message(FAO("Shift amount set to !UL", edtn$v_shift_amount)); [13]:!SHOW SYMBOL edtn$show_symbol(edt$x_line); [14]:!SHOW TIME edtn$time(""); [15]:!SHOW VERSION result := call_user(65545,""); !'00010009'x Show version identx := substr(result,10,length(result)); message(edt$x_version + ", external ident I" + identx + " - " + "VAXTPU version V" + str(get_info(system,'version')) + "." + str(get_info(system,'update'))); message(vs$min_version); [16]:!SHOW WRAP if (edt$x_wrap_position = 0) then message ('Nowrap'); else message('Wrap setting: ' + str (edt$x_wrap_position)); endif; ENDCASE; return (1); ENDPROCEDURE !------------------------------------------------------------------------------ PROCEDURE EDTN$SHOW_LOGICAL(LOGICAL_NAME) LOCAL lognam, result, retcode, outline, eq; lognam := logical_name; edit(lognam,trim,upper); If (lognam = "") then if get_info(system,'display') then lognam := read_line("LOGICAL: "); update(message_window); !necessary to avoid VMS 5.3 bug 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 eq := ' = '; message(FAO('!AS!AS"!AS"',lognam,eq,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 := read_line("SYMBOL: "); update(message_window); !necessary to avoid VMS 5.3 bug 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 message(FAO('"!AS"!AS"!AS"',symnam,eq,outline)); endif; ENDPROCEDURE; !------------------------------------------------------------------------------ PROCEDURE EDTN$TRANSLATE_PARSE LOCAL translate_state_table, translate_tablen, translate_index, token, term_char; !INITIALIZE STATE TABLE translate_state_table := ' ? ' + ! 1 ' EBCDIC' + ! 2 ' ASCII ' ; ! 3 translate_tablen := 7; translate_index := edtn$next_state(translate_state_table,translate_tablen,token,term_char); If translate_index = "EOL" then if get_info(system,'display') then edt$x_line := read_line("TRANSLATE from what? (EBCDIC or ASCII): "); update(message_window); !necessary to avoid VMS 5.3 bug edit(edt$x_line,trim,upper,OFF); endif; if (edt$x_line = "") then message('You must provide an option to TRANSLATE'); return 0; else return edtn$translate_parse !Recursively call ourselves endif Endif; CASE translate_index FROM 0 TO 5 [0]: message('Unsupported TRANSLATE option: ' + token); return 0; [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; ENDPROCEDURE !------------------------------------------------------------------------------ PROCEDURE EDTN$TRIM ! Line mode command TRIM LOCAL trim_state_table, trim_tablen, trim_index, token, term_char; !INITIALIZE STATE TABLE trim_state_table := ' ? ' + ! 1 ' BUFFER' ; ! 2 trim_tablen := 7; trim_index := edtn$next_state(trim_state_table,trim_tablen,token,term_char); If (trim_index = "EOL") then if get_info(system,'display') then edt$x_line := read_line("TRIM what: "); update(message_window); !necessary to avoid VMS 5.3 bug edit(edt$x_line,trim,upper,OFF); endif; if (edt$x_line = "") then message('You must provide an option to TRIM'); return 0; else return edtn$trim; !Recursively call ourselves endif; Endif; CASE trim_index FROM 0 TO 2 [0]: message('Unsupported TRIM option: ' + token); return 0; [1]:!HELP TRIM edt$help ("EDX_HELP","TRIM"); [2]:!TRIM BUFFER eve$trim_buffer; edtn$x_goto_screen_mode := 1; ENDCASE; ENDPROCEDURE !------------------------------------------------------------------------------ !****************************************************************************** ! HELP PROCEDURES !****************************************************************************** !+ ! TPU help !- PROCEDURE EDT$HELP (HLIB,TOPIC_PARAM) if (NOT get_info(system,'display')) then 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); set(no_write,help_buffer); set(system,help_buffer); endif; set(status_line,info_window,none,""); map(info_window,help_buffer); if (topic_param = "") then help_text( hlib, read_line('Topic: '), on, help_buffer); update(message_window); !Avoid VMS 5.3 bug else help_text( hlib, topic_param, on, help_buffer); endif; unmap(info_window); set(status_line,info_window,edt$x_info_stats_video, "Press CTRL-F to remove INFO_WINDOW and resume editing"); 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 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 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); !Enter Main Loop: LOOP !ASK WHICH KEY DIAGRAM TO VIEW in_key := read_line ("(L)eft half keyboard, (R)ight half keyboard, or (K)eypad diagram? (L,R,K): ",1); update(message_window); !necessary to avoid VMS 5.3 bug 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 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)); 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 any other key to resume editing."; set (status_line, keypad_window, none, diagram_prompt); 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 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 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; set(screen_update,off); message(""); set(screen_update,on); message("CTRL/V - 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 copy_text(sp3+DEC+sp3+HEX+sp3+OCT+sp3+edtn$translate_character(N)); Endif; 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 >= 32) and (N <= 255) and (N<>127) then copy_text(sp3+DEC+sp3+HEX+sp3+OCT+sp3+ascii(N)+sp3+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) ! Convert the character to an integer the hard way (no builtin yet) LOCAL i; i := 0; LOOP; EXITIF i > 255; EXITIF CHAR = ASCII(i); i := i + 1; ENDLOOP; IF i > 255 THEN i := 0; ENDIF; ! On overflow, reset to NULL RETURN (i); 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 if (get_info(system,'version') > 1) !TPU version 2 requires this step, then !TPU version 1 doesn't allow it. key := int(key) endif; 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 copy_text(ascii(idx-64)); else if (idx >= 97) and (idx <= 122) then copy_text(ascii(idx-96)); else message (FAO("Can not make control character from '!AS'. (ASCII !UL, HEX !XB)",ascii(idx),idx,idx)); endif; endif; [1,5]:!KEYPAD KEY message ("Can not make control character from keypad key"); [2,6]:!FUNCTION KEY message ("Can not make control character from function key"); [3,7]:!CONTROL CHARACTER or SHIFT CONTROL CHARACTER copy_text(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 marked_line,!marker at beginning of line last_marked_line, last_marked_line_number, 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:=""; start_pos := mark(none); curs_col := get_info(current_buffer,'offset_column'); if (start_pos <> end_of(current_buffer)) then char := current_character; ascn := char_to_ascii(char); !Get ascii value of character trans := edtn$translate_character(ascn); !Translate character else trans := "[EOB]"; endif; IF (line_num) THEN tot_lines := get_info(current_buffer,'record_count'); last_marked_line := beginning_of(current_buffer); last_marked_line_number := 1; curs_line := vs$curs_line( last_marked_line, last_marked_line_number, 1); msgln := FAO("Line !ZL of !ZL ", curs_line, tot_lines); ENDIF; If (start_pos <> end_of(current_buffer)) then msgln := ( FAO( "!ASCurrent Character is '!AS', Decimal=!UB, " + "Hex=!-!XB, Octal=!-!OB", msgln, char, ascn ) ); Endif; If get_info(system,'display') then set (status_line, current_window, reverse, FAO("Column: !ZL Character: !AS", curs_col, trans)); update (current_window); else message(FAO("Column: !ZL Character: !AS", curs_col, trans)); message(msgln); return; endif; 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; position(beginning_of(current_buffer)); loop exitif ( mark(none) = end_of (current_buffer) ); position(search(line_begin,reverse)); 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)); ENDPROCEDURE !------------------------------------------------------------------------------ PROCEDURE EDTN$ENCRYPT_BEGIN !Encrypt a buffer using the Data Encryption Standard in Output Feedback Mode. !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 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 message("Encrypting buffer"); update(message_window); 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 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); if (NOT edtn$cut_block(0,tempbuf,1)) then !Cut the block return (0); endif; if (not silent) then message("Sorting Range...") endif; here := mark(none); !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 message("Sorting complete.") endif; [3]:!SORT BUFFER if (not silent) then message("Sorting Buffer...") endif; STATUS := SRT$SORT_BUFFER; if (not silent) then 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; 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) ); 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 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)) ); split_line; endloop; append_line; result := call_user(327687,""); !CLEAN UP 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 ); 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 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 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 edtn$clear_message_window; dcl_string := read_line("DCL command: "); update(message_window); !Necessary to avoid VMS 5.3 bug 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..."; message (create_msg); EVE$X_DCL_PROCESS := create_process (show_buffer, "$ set noon"); if (EVE$X_DCL_PROCESS = 0) then 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; set(screen_update,off); message(""); set(screen_update,on); message("CTRL/V - Go to other window. GOLD-W - Toggle single/dual windows."); ! PROCESS THE DCL STRING - (NEED TO INCLUDE THE $) split_line; copy_text ("$ " + dcl_string); 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); split_line; copy_text(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. ! ON_ERROR if error = tpu$_noparent then message ("You are not running the editor in a subprocess"); return; endif; ENDON_ERROR; If (NOT get_info(system,'display')) then 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 message ("Attaching to parent process"); attach; else message ("Attaching to " + attach_param); attach(attach_param); 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 message ("DCL subprocess could not be created"); return; endif; ENDON_ERROR; If (NOT get_info(system,'display')) then message("Can not spawn subprocess while in /NODISPLAY mode"); return(0); Endif; edtn$clear_message_window; ! Clear out old message 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 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 edtn$clear_message_window; dirspec := read_line('Directory: '); update(message_window); !Necessary to avoid VMS 5.3 bug 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 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; message(""); message("CTRL/V - Go to other window. GOLD-W - Toggle single/dual windows."); 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(search(line_begin,reverse)); 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 message("Error searching for 'Directory ' specification."); return ""; ENDON_ERROR; !GET FILENAME.TYPE;VERSION if (edtn$rn_dirfil = 0) !If no range then 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 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(search(line_end,forward)); 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 message(FAO("File !AS not found",full_filespec)); return ""; endif; else return ""; endif; ENDPROCEDURE PROCEDURE EDTN$HIGHLIGHT_WORD(rn) 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, bufptr, newbuf; full_filespec := edtn$dirbuf_filename; if (full_filespec = "") then return endif; newbuf := edtn$newbufnam; bufnam := read_line(FAO("Buffer name [!AS]: ",newbuf)); update(message_window); !necessary to avoid VMS 5.3 bug 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; bufptr := edt$find_buffer(bufnam); if (WD = 'OTHER') then make_two_windows(bufnam,full_filespec); if (bufptr <> 0) then edtn$read_file(full_filespec) endif; 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 message(""); !and clear message buffer Y_N := read_line("Delete file " + full_filespec + "? "); update(message_window); !Necessary to avoid VMS 5.3 bug 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 := 1; !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(search(line_begin,reverse)); 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 ); message(FAO( "!AS was not found in the dictionary", 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); message(FAO( "!AS was found in the dictionary", curline )); Endif; ENDIF; else 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 := 0; word := word_param; LOOP If word = "" then word := read_line("Word to check: "); update(message_window); !Necessary to avoid VMS 5.3 bug If word = "" then return(0) endif; change_case( word, UPPER ); prompted := 1; Endif; result := call_user(393220,word); !spell textline retcode := int(substr(result,1,9)); If retcode = LIB__NORMAL then message(FAO( "!AS was found in the dictionary", word )); exitif( not prompted); word := ""; Endif; If (retcode = LIB__NOTFOU) then message(FAO( "!AS was not found in the dictionary", word )); !'Ask what to do' loop LOOP CMD := read_line("Options: (D)ictionary, (G)uess, (Q)uit, (S)pell: ",1); update(message_window); !necessary to avoid VMS 5.3 bug 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 := read_line(FAO("Word to lookup [!AS]: ",uppercase_target)); update(message_window); !necessary to avoid VMS 5.3 bug 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; 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)); edt$x_select_range := 0; message("Spell checking selected range..."); Else 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 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)); position(search(line_begin,reverse)); 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 := VS$curs_line( beginning_of(current_buffer), 1, 1); MESSAGE(FAO("Unknown word !AS at line !ZL of !ZL", word, line_num, get_info(current_buffer,'record_count') )); ! Ask what to do Exitif (not Spl$what_to_do(SPL$RN_MISSPELLED,1)); !query Accept, Ignore, Guess, Dictionary,... SPL$RN_MISSPELLED := 0; !Unhighlight word update(current_window); 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 MESSAGE("Finished spell checking."); ENDPROCEDURE !------------------------------------------------------------------------------ PROCEDURE SPL$WHAT_TO_DO( old_word_range, askcont ) ! target word is old_word_range ! 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, uppercase_target; ! upcased misspelled word !'Ask what to do' loop LOOP CMD := read_line("Options: (A)ccept, (D)ictionary, (E)dit, (G)uess, (I)gnore, (P)ersdic, (Q)uit: ",1); update(message_window); !necessary to avoid VMS 5.3 bug 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 := read_line(FAO("Word to lookup [!AS]: ",uppercase_target)); update(message_window); !Necessary to avoid VMS 5.3 bug 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 := read_line("Enter exact replacement: "); update(message_window); !necessary to avoid VMS 5.3 bug 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; 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) ); else copy_text(new_word); endif; 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 := read_line("Continue? (Yes or No): ", 1); update(message_window); !necessary to avoid VMS 5.3 bug 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 := read_line(FAO("I guess !AS, is that what you meant? [(Y)es, (N)o, (Q)uit guessing]: ",guess_word),1); update(message_window); !necessary to avoid VMS 5.3 bug 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 := read_line("I don't have any more guesses. Press RETURN",1); update(message_window); !necessary to avoid VMS 5.3 bug 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 := read_line("Word to look up: "); update(message_window); !necessary to avoid VMS 5.3 bug 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 MESSAGE(""); If ( (get_info(top_window,'visible')) And (get_info(bottom_window,'visible')) ) Then MESSAGE("GOLD-W - Toggle single/dual windows. CTRL/V - Go to other window."); Else MESSAGE("GOLD-W - Toggle single/dual windows."); Endif; If ( Get_info(SPL$RN_MISSPELLED,'type') = RANGE ) Then MESSAGE("CTRL/Z - Enter line mode command. ENTER - Select word."); Else 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 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 := read_line(FAO("Replace !AS with !AS ? (Yes or No): ", uppercase_target,uppercase_replacement),1); update(message_window); !Necessary to avoid VMS 5.3 bug change_case(Y_N,UPPER); If (Y_N = "Y") then 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 := read_line("Continue spell checking? (Yes or No): ", 1); update(message_window); !necessary to avoid VMS 5.3 bug 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); message(FAO("Word '!AS' copied to PASTE buffer",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 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, word_column_length ) ); !DIC BROWSE (get next first word) retcode := int(substr(result,1,9)); 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 ); message("Working on " + stchr + "..."); endif; ENDLOOP; 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 ); 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 !****************************************************************************** ! 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 pairlist := "{[<(}]>)"; !SEARCH FOR FIRST PARENTHESIS If (current_direction = forward) then dr := 1; Else dr := -1; Endif; MK := mark(none); if (MK = edtn$m_right_paren) or (MK = edtn$m_left_paren) !If currently on a previously set mark then move_horizontal(dr); !then move off it and look for a new one. endif; LOOP if (mark(none) <> end_of(current_buffer)) then char := current_character; else char := ""; endif; exitif (index(pairlist,char) <> 0 ); if ( ((char = "") and (dr=1)) or ((current_offset = 0) and (dr=-1)) ) then message("Parenthesis not found on current line in current direction"); return; endif; move_horizontal(dr); ENDLOOP; !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 message ("Matching parenthesis not found"); !give message edtn$clear_paren; exitif; !and exit Endif; ENDIF; IF (current_character = paren) then if ( vs$lines_between_markers(start_mark,mark(none)) > edtn$v_maxlines_match_paren ) then 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. ! LOCAL buf1, buf2, line1, line2, mark1a, mark1b, mark2a, mark2b, R1, R2, window1, window2, inkey, key_func; If (NOT get_info(system,'display')) then 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 message (FAO("buffer !AS does not exist",bufnam1)); return 0; endif; buf2 := edt$find_buffer(bufnam2); if buf2 = 0 then message (FAO("buffer !AS does not exist",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 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); move_horizontal(1); position(search(line_begin,reverse)); line2 := current_line; position(window1); ! position(buf1); move_horizontal(1); position(search(line_begin,reverse)); line1 := current_line; LOOP !Compare line1 with line2 if (line1 <> line2) then position(window1); ! position(buf1); mark1a := mark(none); move_horizontal(length(current_line)); mark1b := mark(none); R1 := create_range(mark1a,mark1b,bold); update(window1); !Lock cursor at current position position(window2); ! position(buf2); mark2a := mark(none); move_horizontal(length(current_line)); mark2b := mark(none); R2 := create_range(mark2a,mark2b,bold); update(window2); !Lock cursor at current position position(window1); !Go back to where we really are 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 return edtn$differences("",""); else 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; message("Trimming buffer..."); this_position := mark (none); 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); 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 saved_error; ON_ERROR saved_error := error; if (saved_error <> tpu$_STRNOTFOUND) then if (get_info(system,'version') > 1) then !TPU version 2 requires this step, saved_error := INT(saved_error) !TPU version 1 doesn't allow it. endif; edtn$signal(saved_error); return (0); endif; ENDON_ERROR; ! Insure this is a buffer we can fix IF (GET_INFO(CURRENT_BUFFER,"SYSTEM")) THEN 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. ! 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 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); delete(buf); buf := edtn$create_buffer(bufnam,""); 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); 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 := read_line('Char: ',1); update(message_window); !necessary to avoid VMS 5.3 bug 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 if (current_offset = 0) then if (edtn$comment_character(current_buffer,lead_chars,trail_chars)) then copy_text(lead_chars); 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); 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; Return(0); ENDPROCEDURE !------------------------------------------------------------------------------ PROCEDURE EDTN$CALC If (length(edt$x_line) = 0) then if get_info(system,'display') then edt$x_line := Read_line("CALC> "); update(message_window); !necessary to avoid VMS 5.3 bug endif; if (length(edt$x_line)=0) then return; endif; Endif; execute("message(str("+edt$x_line+"))"); ENDPROCEDURE !------------------------------------------------------------------------------ PROCEDURE EDT$DEFINE_KEY !ctrl k (define key) ! Define a key ad a VAXTPU command LOCAL def, input_key; def := read_line('Enter VAXTPU Definition for key: '); update(message_window); !Necessary to avoid VMS 5.3 bug if (length(def) = 0) then return; endif; input_key := read_line('Press key to define.',1); update(message_window); !Necessary to avoid VMS 5.3 bug input_key := last_key; if (input_key = ret_key) then 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 := read_line('Set left margin to: '); update(message_window); !necessary to avoid VMS 5.3 bug endif; if (set_parameter = "") then 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 message("Left margin must be a positive integer"); return; endif; endif; edtn$v_left_margin := new_left_margin; message (fao ("Left margin set to !SL", 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(none); !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); 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 copy_text(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(none); 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 if (get_info(system,'version') > 1) !TPU version 2 requires this step, then !TPU version 1 doesn't allow it. key := int(key) endif; 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 loop copy_text(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; !COMPILE THE COMMAND x:=compile(line_read); !CHECK FOR AN ERROR If x = 0 then Return (0); Endif; !EXECUTE THE COMMAND execute(x); !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); 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"); message("Entering numeric keypad mode"); ENDPROCEDURE !------------------------------------------------------------------------------ PROCEDURE EDTN$SIGNAL(ERR) ! 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 number that was trapped. ! LOCAL result; result := call_user(65541,str(err)); !'00010005'x Signal error ENDPROCEDURE !------------------------------------------------------------------------------ PROCEDURE EVE_ELIMINATE_TABS ! Turn TABs to spaces LOCAL target, n; ON_ERROR ENDON_ERROR; 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)); 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 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 a TPU version greater than 1.2. !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.2 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.2 or higher AND (GET_INFO(SYSTEM,'UPDATE') >= 2)) ) 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(" Determining current line number is faster."); message(" Moving to specified line number is faster."); message(" Support for TPU qualifiers /NOMODIFY and /START_POSITION=(line[,column])"); message(" Other internal enhancements."); 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 !------------------------------------------------------------------------------ !This is all the new VMS 5 (TPU 2) specific stuff. !It gets added automatically when it detects the operating system !has been upgraded to VMS 5 (TPU 2). PROCEDURE VS$UPGRADE_EDX COMPILE("PROCEDURE VS$COPY_TEXT(X) COPY_TEXT(X) ENDPROCEDURE"); COMPILE("PROCEDURE VS$CURS_LINE(;A,B,C) RETURN(GET_INFO(mark(none),'record_number')) ENDPROCEDURE"); COMPILE("PROCEDURE VS$GOTO_LINE(X) POSITION(X) ENDPROCEDURE"); COMPILE("PROCEDURE VS$FREE_MARK RETURN MARK(FREE_CURSOR) ENDPROCEDURE"); COMPILE("PROCEDURE VS$PAD_OVERSTRUCK_TABS SET(PAD_OVERSTRUCK_TABS,ON) ENDPROCEDURE"); COMPILE("PROCEDURE VS$CHECK_NOMODIFY IF GET_INFO(COMMAND_LINE,'NOMODIFY') THEN SET(MODIFIABLE,MAIN_BUFFER,OFF);ENDIF;ENDPROCEDURE"); COMPILE("PROCEDURE VS$SET_COLUMN_MOVE_VERTICAL SET(COLUMN_MOVE_VERTICAL,ON) ENDPROCEDURE"); COMPILE("PROCEDURE VS$START_RECORD RETURN GET_INFO(COMMAND_LINE,'START_RECORD') ENDPROCEDURE"); COMPILE("PROCEDURE VS$START_CHARACTER RETURN GET_INFO(COMMAND_LINE,'START_CHARACTER') ENDPROCEDURE"); COMPILE("PROCEDURE VS$INIT_PROCEDURE VS$PAD_OVERSTRUCK_TABS; VS$CHECK_NOMODIFY; VS$SET_COLUMN_MOVE_VERTICAL; ENDPROCEDURE"); COMPILE("PROCEDURE VS$MIN_VERSION Return "+ "'Internal upgrade level 2. Compatible with VAXTPU Version V2.2 (VMS V5.1)' ENDPROCEDURE"); COMPILE("PROCEDURE VS$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"); COMPILE("PROCEDURE VS$CHECK_VERSION ENDPROCEDURE"); !No more upgrades to do. ENDPROCEDURE !------------------------------------------------------------------------------ PROCEDURE VS$MIN_VERSION Return "Internal upgrade level 0. Compatible with VAXTPU version V1.2 (VMS V4.4)"; ENDPROCEDURE PROCEDURE VS$INIT_PROCEDURE ! For VMS 4 here we do nothing. ! On VMS 5 we do the following: ! SET(PAD_OVERSTRUCK_TABS,ON); ENDPROCEDURE PROCEDURE VS$START_RECORD ! For VMS 4 here we return 1. ! On VMS 5 we return get_info(command_line,'start_record') RETURN 1 ENDPROCEDURE PROCEDURE VS$START_CHARACTER ! For VMS 4 here we return 1. ! On VMS 5 we return get_info(command_line,'start_character') RETURN 1 ENDPROCEDURE PROCEDURE VS$CURS_LINE( LAST_MARKED_LINE, LAST_MARKED_LINE_NUMBER, DR) !Returns the current line number !TPU 1.2 version. ! Last_Marked_Line - marker, variable, at beginning of last marked line ! Last_Marked_Line_Number - integer, variable, number of last marked line ! Dr - direction. +1 = forward, -1 = reverse LOCAL curs_line,marked_line,tot_lines,start_pos; start_pos := mark(none); tot_lines := get_info(current_buffer,'record_count'); position(search(line_begin,reverse)); marked_line := mark(none); position (last_marked_line); curs_line := last_marked_line_number; LOOP exitif (mark(none) = marked_line); exitif (curs_line >= tot_lines); curs_line := curs_line + dr; move_vertical(dr); ENDLOOP; last_marked_line := marked_line; last_marked_line_number := curs_line; position (start_pos); return(curs_line); ENDPROCEDURE PROCEDURE VS$GOTO_LINE(LINENUM) position (beginning_of (current_buffer)); move_vertical (linenum - 1); ! already at line 1 ENDPROCEDURE PROCEDURE VS$COPY_TEXT(CHAR) ! Immitate set(pad_overstruck_tabs) for VMS 4. Local n; IF (get_info(current_buffer,'mode') = overstrike) then If (mark(none) <> end_of(current_buffer)) then if (current_character = edt$x_tab_char) then n := get_info(current_buffer,'offset_column'); if (n <> (8 * (n / 8) )) then set(insert,current_buffer); copy_text(char); !Don't erase the tab yet. set(overstrike,current_buffer); return; endif; endif; Endif; ENDIF; copy_text(char); !Else just copy the character. ENDPROCEDURE PROCEDURE VS$FREE_MARK !replaced in VMS 5 by MARK(FREE_CURSOR); Return mark(none); ENDPROCEDURE PROCEDURE VS$LINES_BETWEEN_MARKERS(M1,M2) !does not count lines on VMS 4. Returns 0 !VMS 5 counts lines and reuturns # lines Return 0; ENDPROCEDURE !------------------------------------------------------------------------------ !****************************************************************************** ! SECTION BUILDING !****************************************************************************** !+ ! These procedures are used when the section file is being compiled. ! They define the key map lists, the key maps, the key definitions ! for the key maps, and the initial set up of the key map lists. !- ! PROCEDURE 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. The key maps EDTN$KM_EDT_EDITING_KEYS and ! EDTN$KM_WPS_EDITING_KEYS and EDTN$KM_NUMERIC_KEYPAD are used to define the ! keypad and other editing keys. The key maps EDTN$KM_SHOBUF and ! EDTN$KM_DIRBUF are used for the SHOW BUFFERS display and the DIRECTORY ! display respectively. SPL$KM_DICBUF is used for the DICTIONARY buffer. ! create_key_map("edtn$km_EDT_editing_keys"); create_key_map("edtn$km_WPS_editing_keys"); create_key_map("edtn$km_printable_keys"); create_key_map("edtn$km_numeric_keypad"); create_key_map("edtn$km_shobuf"); create_key_map("edtn$km_shomrk"); create_key_map("edtn$km_dirbuf"); create_key_map("spl$km_dicbuf"); create_key_map("edtn$km_search"); create_key_map("edtn$km_paswrd"); ! ! SET UP THE KEY MAP LISTS 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_dirbuf","edtn$km_dirbuf"); create_key_map_list("spl$kml_dicbuf","spl$km_dicbuf"); create_key_map_list("edtn$kml_search","edtn$km_search"); create_key_map_list("edtn$kml_paswrd","edtn$km_paswrd"); add_key_map("edtn$kml_dirbuf", "last", "edtn$km_EDT_editing_keys"); add_key_map("spl$kml_dicbuf", "last", "edtn$km_EDT_editing_keys"); add_key_map("edtn$kml_search", "last", "edtn$km_EDT_editing_keys"); add_key_map("tpu$key_map_list", "last", "edtn$km_printable_keys"); add_key_map("tpu$key_map_list", "last", "edtn$km_EDT_editing_keys"); 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); ENDPROCEDURE ! !------------------------------------------------------------------------------ PROCEDURE COMP$INIT_KM_EDT_EDITING_KEYS ! Procedure to define editing keys to emulate EDT LOCAL null; null := ""; ! ! DEFINE THE EDT EDITING KEYS ! !*** ARROW KEYS *** DEFINE_KEY('edtn$horizontal(-1)', left, null, 'edtn$km_EDT_editing_keys'); !left arrow DEFINE_KEY('edtn$horizontal(1);set(forward,current_buffer)', right, null, 'edtn$km_EDT_editing_keys'); !right arrow DEFINE_KEY('edtn$vertical(-1)', up, null, 'edtn$km_EDT_editing_keys'); !up arrow DEFINE_KEY('edtn$vertical(1);set(forward,current_buffer)', down, null, 'edtn$km_EDT_editing_keys'); !down arrow DEFINE_KEY('edtn$shift_window(-edtn$v_shift_amount)', KEY_NAME(RIGHT,SHIFT_KEY), null, 'edtn$km_EDT_editing_keys'); !Gold -> shift screen right DEFINE_KEY('edtn$shift_window(edtn$v_shift_amount)', KEY_NAME(LEFT,SHIFT_KEY), null, 'edtn$km_EDT_editing_keys'); !Gold <- shift screen left DEFINE_KEY('edtn$scroll_window(reverse)', KEY_NAME(UP,SHIFT_KEY), null, 'edtn$km_EDT_editing_keys'); !Gold up. Continuous scroll up DEFINE_KEY('edtn$scroll_window(forward)', KEY_NAME(DOWN,SHIFT_KEY), null, 'edtn$km_EDT_editing_keys'); !Gold down. Continuous scroll down ! ! !*** EDITING KEYPAD KEYS *** DEFINE_KEY('jen$init_find_string(0)', E1, null, 'edtn$km_EDT_editing_keys'); !Find DEFINE_KEY('edtn$paste_block(paste_buffer)', E2, null, 'edtn$km_EDT_editing_keys'); !Paste DEFINE_KEY('edtn$cut_block(0,paste_buffer,0)', E3, null, 'edtn$km_EDT_editing_keys'); !Cut DEFINE_KEY('edtn$cut_block(1,paste_buffer,0)', KEY_NAME(E3,SHIFT_KEY), null, 'edtn$km_EDT_editing_keys'); !Copy to buffer. DEFINE_KEY('edtn$select_block', E4, null, 'edtn$km_EDT_editing_keys'); !Select DEFINE_KEY('edt$section(reverse)', E5, null, 'edtn$km_EDT_editing_keys'); !Prev screen DEFINE_KEY('edt$section(forward);set(forward,current_buffer)', E6, null, 'edtn$km_EDT_editing_keys'); !Next screen DEFINE_KEY('jen$init_find_string(1)', KEY_NAME(E1,SHIFT_KEY), null, 'edtn$km_EDT_editing_keys'); !Find DEFINE_KEY('edt$reset;message("Select canceled.");', KEY_NAME(E4,SHIFT_KEY), null, 'edtn$km_EDT_editing_keys'); !Select ! ! ! KEYPAD KEYS ! !*** FIRST ROW *** DEFINE_KEY('keypad_help', PF2, null, 'edtn$km_EDT_editing_keys'); !Keypad help DEFINE_KEY('transpose_characters', KEY_NAME(PF2,SHIFT_KEY), null, 'edtn$km_EDT_editing_keys'); !Transpose characters DEFINE_KEY('jen$fndnxt(1,1,-1)', PF3, null, 'edtn$km_EDT_editing_keys'); !Find next DEFINE_KEY('jen$init_find_string(edtn$v_search_wild)', KEY_NAME(PF3,SHIFT_KEY), null, 'edtn$km_EDT_editing_keys'); !Find DEFINE_KEY('delete_line', PF4, null, 'edtn$km_EDT_editing_keys'); !Delete line DEFINE_KEY('undelete_line', KEY_NAME(PF4,SHIFT_KEY), null, 'edtn$km_EDT_editing_keys'); !Undelete line ! ! !*** SECOND ROW *** DEFINE_KEY('move_by_page', KP7, null, 'edtn$km_EDT_editing_keys'); !Page DEFINE_KEY('edtn$prompt_do_command', KEY_NAME(KP7,SHIFT_KEY), null, 'edtn$km_EDT_editing_keys'); !Command DEFINE_KEY('edt$section(current_direction)', KP8, null, 'edtn$km_EDT_editing_keys'); !Section DEFINE_KEY('edt$fill', KEY_NAME(KP8,SHIFT_KEY), null, 'edtn$km_EDT_editing_keys'); !Fill DEFINE_KEY('edt$append', KP9, null, 'edtn$km_EDT_editing_keys'); !Append DEFINE_KEY('edt$replace', KEY_NAME(KP9,SHIFT_KEY), null, 'edtn$km_EDT_editing_keys'); !Replace DEFINE_KEY('delete_word', MINUS, null, 'edtn$km_EDT_editing_keys'); !Delete word DEFINE_KEY('undelete_word', KEY_NAME(MINUS,SHIFT_KEY), null, 'edtn$km_EDT_editing_keys'); !Undelete word ! ! !*** THIRD ROW *** DEFINE_KEY('set(forward,current_buffer)', KP4, null, 'edtn$km_EDT_editing_keys'); !Advance DEFINE_KEY('goto_bottom', KEY_NAME(KP4,SHIFT_KEY), null, 'edtn$km_EDT_editing_keys'); !Bottom DEFINE_KEY('set(reverse,current_buffer)', KP5, null, 'edtn$km_EDT_editing_keys'); !Reverse DEFINE_KEY('goto_top', KEY_NAME(KP5,SHIFT_KEY), null, 'edtn$km_EDT_editing_keys'); !Top DEFINE_KEY('edtn$cut_block(0,paste_buffer,0)', KP6, null, 'edtn$km_EDT_editing_keys'); !Cut DEFINE_KEY('edtn$paste_block(paste_buffer)', KEY_NAME(KP6,SHIFT_KEY), null, 'edtn$km_EDT_editing_keys'); !Paste DEFINE_KEY('delete_character', COMMA, null, 'edtn$km_EDT_editing_keys'); !Delete character DEFINE_KEY('undelete_character', KEY_NAME(COMMA,SHIFT_KEY), null, 'edtn$km_EDT_editing_keys'); !Undelete character ! ! !*** FOURTH ROW *** DEFINE_KEY('edt$move_word(current_direction)', KP1, null, 'edtn$km_EDT_editing_keys'); !Word DEFINE_KEY('edt$change_case(invert)', KEY_NAME(KP1,SHIFT_KEY), null, 'edtn$km_EDT_editing_keys'); !Change case DEFINE_KEY('edtn$end_of_line', KP2, null, 'edtn$km_EDT_editing_keys'); !End of line DEFINE_KEY('delete_end_of_line', KEY_NAME(KP2,SHIFT_KEY), null, 'edtn$km_EDT_editing_keys'); !Delete to end of line DEFINE_KEY('if current_direction=forward then move_horizontal(1) else move_horizontal(-1) endif', KP3, null, 'edtn$km_EDT_editing_keys'); !Character DEFINE_KEY('edtn$cntl_char', KEY_NAME(KP3,SHIFT_KEY), null, 'edtn$km_EDT_editing_keys'); !Specins ! ! ! *** FIFTH ROW *** DEFINE_KEY('move_by_line', KP0, null, 'edtn$km_EDT_editing_keys'); !Line DEFINE_KEY('split_line;move_horizontal(-1)', KEY_NAME(KP0,SHIFT_KEY), null, 'edtn$km_EDT_editing_keys'); !Open line DEFINE_KEY('edtn$select_block', PERIOD, null, 'edtn$km_EDT_editing_keys'); !Select DEFINE_KEY('edt$reset;message("Select canceled.")', KEY_NAME(PERIOD,SHIFT_KEY), null, 'edtn$km_EDT_editing_keys'); !Reset DEFINE_KEY('edt$substitute', KEY_NAME(ENTER,SHIFT_KEY), null, 'edtn$km_EDT_editing_keys'); !Substitute ! ! !*** SHIFT KEYS *** DEFINE_KEY('edtn$goto_buffer("","")', KEY_NAME('B',SHIFT_KEY), null, 'edtn$km_EDT_editing_keys'); !Gold B. Goto buffer. DEFINE_KEY('capitalize_word', KEY_NAME('C',SHIFT_KEY), null, 'edtn$km_EDT_editing_keys'); !Gold C. Capitalize Word. DEFINE_KEY('edtn$dir("")', KEY_NAME('D',SHIFT_KEY), null, 'edtn$km_EDT_editing_keys'); !Gold D. Directory. DEFINE_KEY('fill_paragraph', KEY_NAME('F',SHIFT_KEY), null, 'edtn$km_EDT_editing_keys'); !Gold F. Fill paragraph. DEFINE_KEY('goto_mark("")', KEY_NAME('G',SHIFT_KEY), null, 'edtn$km_EDT_editing_keys'); !Gold G. Goto mark. DEFINE_KEY('edtn$key_include', KEY_NAME('I',SHIFT_KEY), null, 'edtn$km_EDT_editing_keys'); !Gold I. Include file. DEFINE_KEY('lowercase_word', KEY_NAME('L',SHIFT_KEY), null, 'edtn$km_EDT_editing_keys'); !Gold L. Lowercase word. DEFINE_KEY('edtn$goto_buffer("MAIN","")', KEY_NAME('M',SHIFT_KEY), null, 'edtn$km_EDT_editing_keys'); !Gold M. Goto buffer MAIN DEFINE_KEY('edtn$toggle_numeric_keypad', KEY_NAME('N',SHIFT_KEY), null, 'edtn$km_EDT_editing_keys'); !Gold N. Toggle numeric keypad. DEFINE_KEY('edtn$paste_block(0)', KEY_NAME('O',SHIFT_KEY), null, 'edtn$km_EDT_editing_keys'); !Gold O. Copy from buffer. DEFINE_KEY('edtn$cut_block(1,0,0)', KEY_NAME('P',SHIFT_KEY), null, 'edtn$km_EDT_editing_keys'); !Gold P. Copy to buffer. DEFINE_KEY('edt$x_line:="";edt$exit("","QUIT")', KEY_NAME('Q',SHIFT_KEY), null, 'edtn$km_EDT_editing_keys'); !Gold Q. Quit. DEFINE_KEY('edtp$insert_ruler', KEY_NAME('R',SHIFT_KEY), null, 'edtn$km_EDT_editing_keys'); !Gold R. Insert ruler. DEFINE_KEY('do_command("SHOW BUFFERS")', KEY_NAME('S',SHIFT_KEY), null, 'edtn$km_EDT_editing_keys'); !Gold S. Show buffers. DEFINE_KEY('uppercase_word', KEY_NAME('U',SHIFT_KEY), null, 'edtn$km_EDT_editing_keys'); !Gold U. Uppercase word. DEFINE_KEY('edtn$toggle_windows', KEY_NAME('W',SHIFT_KEY), null, 'edtn$km_EDT_editing_keys'); !Gold W. Toggle single/dual windows. DEFINE_KEY('edt$x_line:="";edt$exit("","EXIT")', KEY_NAME('X',SHIFT_KEY), null, 'edtn$km_EDT_editing_keys'); !Gold X. Exit DEFINE_KEY('edtp$learning', KEY_NAME('[',SHIFT_KEY), null, 'edtn$km_EDT_editing_keys'); !Gold [. Start learn key sequence. DEFINE_KEY('edtp$stop_learn', KEY_NAME(']',SHIFT_KEY), null, 'edtn$km_EDT_editing_keys'); !Gold ]. End learn key sequence. DEFINE_KEY('goto_line("")', KEY_NAME('#',SHIFT_KEY), null, 'edtn$km_EDT_editing_keys'); !Gold #. Goto line number. DEFINE_KEY('center_line', KEY_NAME('=',SHIFT_KEY), null, 'edtn$km_EDT_editing_keys'); !Gold =. Center line. DEFINE_KEY('edtn$insert_line("")', KEY_NAME('-',SHIFT_KEY), null, 'edtn$km_EDT_editing_keys'); !Gold -. Insert separating line. DEFINE_KEY('edtn$find_char("")', KEY_NAME('.',SHIFT_KEY), null, 'edtn$km_EDT_editing_keys'); !Gold .. Find character. DEFINE_KEY('edtx$cursstat(0)', KEY_NAME('?',SHIFT_KEY), null, 'edtn$km_EDT_editing_keys'); !Gold ?. Cursor status. DEFINE_KEY('edtn$match_paren', KEY_NAME("'",SHIFT_KEY), null, 'edtn$km_EDT_editing_keys'); !Gold '. Find matching parenthesis. DEFINE_KEY('edtn$clear_paren', KEY_NAME('"',SHIFT_KEY), null, 'edtn$km_EDT_editing_keys'); !Gold ". Clear matching parenthesis. ! ! !*** CONTROL KEYS *** DEFINE_KEY('edtp$overstrike', CTRL_A_KEY, null, 'edtn$km_EDT_editing_keys'); !ctrl a. Toggle insert/overstrike DEFINE_KEY('edtn$end_of_line', CTRL_E_KEY, null, 'edtn$km_EDT_editing_keys'); !ctrl e. Goto end of word. DEFINE_KEY('tab', TAB_KEY, null, 'edtn$km_EDT_editing_keys'); !ctrl i (tab key) DEFINE_KEY('edt$del_beg_word', LF_KEY, null, 'edtn$km_EDT_editing_keys'); !ctrl j (line feed) DEFINE_KEY('edt$define_key', CTRL_K_KEY, null, 'edtn$km_EDT_editing_keys'); !ctrl K DEFINE_KEY('copy_text(ascii(12))', CTRL_L_KEY, null, 'edtn$km_EDT_editing_keys'); !ctrl L DEFINE_KEY("refresh", CTRL_R_KEY, null, 'edtn$km_EDT_editing_keys'); !ctrl R. Refresh DEFINE_KEY('delete_start_of_line', CTRL_U_KEY, null, 'edtn$km_EDT_editing_keys'); !ctrl U. Delete to beg of line. DEFINE_KEY ('change_windows', CTRL_V_KEY, null, 'edtn$km_EDT_editing_keys'); !ctrl V. Change window. DEFINE_KEY("refresh", CTRL_W_KEY, null, 'edtn$km_EDT_editing_keys'); !ctrl W. Refresh. DEFINE_KEY('edt$line_mode', CTRL_Z_KEY, null, 'edtn$km_EDT_editing_keys'); !ctrl Z. Enter line mode. ! ! !*** GOLD CTRL KEYS *** DEFINE_KEY('copy_text(current_date)', KEY_NAME(CTRL_D_KEY,SHIFT_KEY), null, 'edtn$km_EDT_editing_keys'); !Gold ctrl D. Insert today's date. DEFINE_KEY('set_mark("")', KEY_NAME(CTRL_G_KEY,SHIFT_KEY), null, 'edtn$km_EDT_editing_keys'); !Gold ctrl G. Mark position. DEFINE_KEY('copy_text(edt$x_tab_char)', KEY_NAME(CTRL_I_KEY,SHIFT_KEY), null, '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), null, '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), null, 'edtn$km_EDT_editing_keys'); !Gold ctrl R. Toggle ruler window. DEFINE_KEY('edtn$toggle_window_width', KEY_NAME(CTRL_W_KEY,SHIFT_KEY), null, 'edtn$km_EDT_editing_keys'); !Gold ctrl W. Toggle window width. ! ! !*** EDITING KEYS *** DEFINE_KEY('new_line', RET_KEY, null, 'edtn$km_EDT_editing_keys'); ! return DEFINE_KEY('edtn$move_by_line(reverse)',BS_KEY, null, 'edtn$km_EDT_editing_keys'); ! Backspace DEFINE_KEY('delete_previous_character;set(forward,current_buffer)', DEL_KEY, null, 'edtn$km_EDT_editing_keys'); ! rubout DEFINE_KEY('unmap(info_window)', CTRL_F_KEY, null, 'edtn$km_EDT_editing_keys'); ! Unmap the show window ! ! 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), null, 'edtn$km_EDT_editing_keys'); DEFINE_KEY('edt$gold_number("1")', key_name('1',shift_key), null, 'edtn$km_EDT_editing_keys'); DEFINE_KEY('edt$gold_number("2")', key_name('2',shift_key), null, 'edtn$km_EDT_editing_keys'); DEFINE_KEY('edt$gold_number("3")', key_name('3',shift_key), null, 'edtn$km_EDT_editing_keys'); DEFINE_KEY('edt$gold_number("4")', key_name('4',shift_key), null, 'edtn$km_EDT_editing_keys'); DEFINE_KEY('edt$gold_number("5")', key_name('5',shift_key), null, 'edtn$km_EDT_editing_keys'); DEFINE_KEY('edt$gold_number("6")', key_name('6',shift_key), null, 'edtn$km_EDT_editing_keys'); DEFINE_KEY('edt$gold_number("7")', key_name('7',shift_key), null, 'edtn$km_EDT_editing_keys'); DEFINE_KEY('edt$gold_number("8")', key_name('8',shift_key), null, 'edtn$km_EDT_editing_keys'); DEFINE_KEY('edt$gold_number("9")', key_name('9',shift_key), null, 'edtn$km_EDT_editing_keys'); DEFINE_KEY('edt$gold_number("")', key_name('+',shift_key), null, 'edtn$km_EDT_editing_keys'); !!define_key('edt$gold_number("-")', key_name('-',shift_key), null, 'edtn$km_EDT_editing_keys');!(Defined elsewhere) ! ! Define the Function keys on VT-200 series ! DEFINE_KEY('keypad_help', HELP, null, 'edtn$km_EDT_editing_keys'); !Keypad help DEFINE_KEY('edtn$prompt_do_command', DO, null, 'edtn$km_EDT_editing_keys'); !Command DEFINE_KEY('edtn$fill_to_end', F10, null, 'edtn$km_EDT_editing_keys'); ! DEFINE_KEY('edtn$move_by_line(reverse)', F12, null, 'edtn$km_EDT_editing_keys'); ! Backspace DEFINE_KEY('edt$del_beg_word', F13, null, 'edtn$km_EDT_editing_keys'); !ctrl j (line feed) DEFINE_KEY('end_of_word', F14, null, 'edtn$km_EDT_editing_keys'); !End of line DEFINE_KEY('edtn$goto_buffer("MAIN","")', F17, null, 'edtn$km_EDT_editing_keys'); DEFINE_KEY('edtn$goto_buffer( "A","")', F18, null, 'edtn$km_EDT_editing_keys'); DEFINE_KEY('edtn$goto_buffer( "B","")', F19, null, 'edtn$km_EDT_editing_keys'); DEFINE_KEY('edtn$goto_buffer( "C","")', F20, null, 'edtn$km_EDT_editing_keys'); ENDPROCEDURE ! !------------------------------------------------------------------------------ PROCEDURE COMP$INIT_KM_WPS_EDITING_KEYS ! Procedure to define editing keys to emulate WORD 11 DECMATE LOCAL null; null := ""; ! ! DEFINE THE WPS EDITING KEYS ! !*** ARROW KEYS *** DEFINE_KEY('edtn$horizontal(-1);set(reverse,current_buffer)', left, null, 'edtn$km_WPS_editing_keys'); !left arrow DEFINE_KEY('edtn$horizontal(1);set(forward,current_buffer)', right, null, 'edtn$km_WPS_editing_keys'); !right arrow DEFINE_KEY('edtn$vertical(1);set(forward,current_buffer)', down, null, 'edtn$km_WPS_editing_keys'); !down arrow DEFINE_KEY('edtn$vertical(-1);set(reverse,current_buffer)', up, null, 'edtn$km_WPS_editing_keys'); !up arrow DEFINE_KEY('edtn$shift_window(-edtn$v_shift_amount)', KEY_NAME(RIGHT,SHIFT_KEY), null, 'edtn$km_WPS_editing_keys'); !Gold -> DEFINE_KEY('edtn$shift_window(edtn$v_shift_amount)', KEY_NAME(LEFT,SHIFT_KEY), null, 'edtn$km_WPS_editing_keys'); !Gold <- DEFINE_KEY('goto_top', KEY_NAME(UP,SHIFT_KEY), null, 'edtn$km_WPS_editing_keys'); !Gold up. Goto top of buffer. DEFINE_KEY('goto_bottom', KEY_NAME(DOWN,SHIFT_KEY), null, 'edtn$km_WPS_editing_keys'); !Gold down. Goto bottom of buffer. ! ! !*** EDITING KEYPAD KEYS *** DEFINE_KEY('jen$init_find_string(0)', E1, null, 'edtn$km_WPS_editing_keys'); !Find DEFINE_KEY('edtn$paste_block(paste_buffer)', E2, null, 'edtn$km_WPS_editing_keys'); !Paste DEFINE_KEY('edtn$cut_block(0,paste_buffer,0)', E3, null, 'edtn$km_WPS_editing_keys'); !Cut DEFINE_KEY('edtn$select_block;set(forward,current_buffer)', E4, null, 'edtn$km_WPS_editing_keys'); !Select DEFINE_KEY('edt$section(reverse)', E5, null, 'edtn$km_WPS_editing_keys'); !Prev screen DEFINE_KEY('edt$section(forward);set(forward,current_buffer)', E6, null, 'edtn$km_WPS_editing_keys'); !Next screen DEFINE_KEY('jen$init_find_string(1)', KEY_NAME(E1,SHIFT_KEY), null, 'edtn$km_WPS_editing_keys'); !Find DEFINE_KEY('edtn$cut_block(1,paste_buffer,0)', KEY_NAME(E3,SHIFT_KEY), null, 'edtn$km_WPS_editing_keys'); !Copy to buffer. DEFINE_KEY('edt$reset;message("Select canceled.")', KEY_NAME(E4,SHIFT_KEY), null, 'edtn$km_WPS_editing_keys'); !Select ! ! ! KEYPAD KEYS ! !*** FIRST ROW *** DEFINE_KEY('move_by_page', PF2, null, 'edtn$km_WPS_editing_keys'); !Page !!DEFINE_KEY, !! KEY_NAME(PF2,SHIFT_KEY), null, 'edtn$km_WPS_editing_keys'); !nothing DEFINE_KEY('delete_word', PF3, null, 'edtn$km_WPS_editing_keys'); !Delete word DEFINE_KEY('undelete_word', KEY_NAME(PF3,SHIFT_KEY), null, 'edtn$km_WPS_editing_keys'); !Undelete word DEFINE_KEY('delete_character', PF4, null, 'edtn$km_WPS_editing_keys'); !Delete character DEFINE_KEY('undelete_character', KEY_NAME(PF4,SHIFT_KEY), null, 'edtn$km_WPS_editing_keys'); !Undelete character ! ! !*** SECOND ROW *** DEFINE_KEY('edtn$find_pat(edtn$pattern_sentence,notany(edt$x_word))', KP7, null, 'edtn$km_WPS_editing_keys'); !Sentence !!DEFINE_KEY, !! KEY_NAME(KP7,SHIFT_KEY), null, 'edtn$km_WPS_editing_keys'); !nothing DEFINE_KEY('edtn$search_line(edt$x_tab_char)', KP8, null, 'edtn$km_WPS_editing_keys'); !Tab !!DEFINE_KEY, !! KEY_NAME(KP8,SHIFT_KEY), null, 'edtn$km_WPS_editing_keys'); !nothing !!DEFINE_KEY, !! KP9, null, 'edtn$km_WPS_editing_keys'); !nothing !!DEFINE_KEY, !! KEY_NAME(KP9,SHIFT_KEY), null, 'edtn$km_WPS_editing_keys'); !nothing DEFINE_KEY('edtn$cut_block(0,paste_buffer,0)', MINUS, null, 'edtn$km_WPS_editing_keys'); !Cut DEFINE_KEY('edtn$cut_block(1,0,0)', KEY_NAME(MINUS,SHIFT_KEY), null, 'edtn$km_WPS_editing_keys'); !Copy to buffer ! ! !*** THIRD ROW *** DEFINE_KEY('edt$move_word(current_direction)', KP4, null, 'edtn$km_WPS_editing_keys'); !word !!DEFINE_KEY, !! KEY_NAME(KP4,SHIFT_KEY), null, 'edtn$km_WPS_editing_keys'); !nothing DEFINE_KEY('edtn$find_pat(edt$x_whit_pat,notany(edt$x_word))', KP5, null, 'edtn$km_WPS_editing_keys'); !Next paragraph DEFINE_KEY('fill_paragraph', KEY_NAME(KP5,SHIFT_KEY), null, 'edtn$km_WPS_editing_keys'); !Fill paragraph !!DEFINE_KEY, !! KP6, null, 'edtn$km_WPS_editing_keys'); !nothing !!DEFINE_KEY, !! KEY_NAME(KP6,SHIFT_KEY), null, 'edtn$km_WPS_editing_keys'); !nothing DEFINE_KEY('edtn$paste_block(paste_buffer)', COMMA, null, 'edtn$km_WPS_editing_keys'); !Paste DEFINE_KEY('edtn$paste_block(0)', KEY_NAME(COMMA,SHIFT_KEY), null, 'edtn$km_WPS_editing_keys'); !Copy from buffer ! ! !*** FOURTH ROW *** DEFINE_KEY('move_horizontal(-1);set(reverse,current_buffer)', KP1, null, 'edtn$km_WPS_editing_keys'); !Backup character DEFINE_KEY('edtn$scroll_window(reverse)', KEY_NAME(KP1,SHIFT_KEY), null, 'edtn$km_WPS_editing_keys'); !Continuous scroll up DEFINE_KEY('move_by_line', KP2, null, 'edtn$km_WPS_editing_keys'); !Line !!DEFINE_KEY, !! KEY_NAME(KP2,SHIFT_KEY), null, 'edtn$km_WPS_editing_keys'); !nothing DEFINE_KEY('edt$change_case(upper);set(forward,current_buffer)', KP3, null, 'edtn$km_WPS_editing_keys'); !Uppercase range DEFINE_KEY('edt$change_case(lower);set(forward,current_buffer)', KEY_NAME(KP3,SHIFT_KEY), null, 'edtn$km_WPS_editing_keys'); !Lowercase range ! ! !*** FIFTH ROW *** DEFINE_KEY('set(forward,current_buffer);move_horizontal(1)', KP0, null, 'edtn$km_WPS_editing_keys'); !Advance character DEFINE_KEY('edtn$scroll_window(forward)', KEY_NAME(KP0,SHIFT_KEY), null, 'edtn$km_WPS_editing_keys'); !Continuous scroll down DEFINE_KEY('edtn$select_block;set(forward,current_buffer)', PERIOD, null, 'edtn$km_WPS_editing_keys'); !Select DEFINE_KEY('edt$reset;message("Select canceled.")', KEY_NAME(PERIOD,SHIFT_KEY), null, 'edtn$km_WPS_editing_keys'); !Reset DEFINE_KEY('edtn$find_char(">")', ENTER, null, 'edtn$km_WPS_editing_keys'); !Find ">" DEFINE_KEY('transpose_characters', KEY_NAME(ENTER,SHIFT_KEY), null, 'edtn$km_WPS_editing_keys'); !Transpose characters ! ! !*** GOLD KEYS *** DEFINE_KEY('edt$append;set(forward,current_buffer)', KEY_NAME("A",SHIFT_KEY), null, 'edtn$km_WPS_editing_keys'); !Gold A. Append DEFINE_KEY('goto_bottom', KEY_NAME("B",SHIFT_KEY), null, 'edtn$km_WPS_editing_keys'); !Gold B. Bottom DEFINE_KEY('center_line', KEY_NAME("C",SHIFT_KEY), null, 'edtn$km_WPS_editing_keys'); !Gold C. Center line. DEFINE_KEY ('change_windows', KEY_NAME("E",SHIFT_KEY), null, 'edtn$km_WPS_editing_keys'); !Gold O. Other window. DEFINE_KEY('edt$x_line:="";edt$exit("","EXIT")', KEY_NAME("F",SHIFT_KEY), null, 'edtn$km_WPS_editing_keys'); !Gold F. Exit DEFINE_KEY('edtn$key_include', KEY_NAME("G",SHIFT_KEY), null, 'edtn$km_WPS_editing_keys'); !Gold G. Get file DEFINE_KEY('edtn$goto_buffer("","")', KEY_NAME("J",SHIFT_KEY), null, 'edtn$km_WPS_editing_keys'); !Gold J. Jump to buffer. DEFINE_KEY('edtp$learning', KEY_NAME("K",SHIFT_KEY), null, 'edtn$km_WPS_editing_keys'); !Gold K. Start learn key sequence. DEFINE_KEY('edtx$cursstat(1)', KEY_NAME("L",SHIFT_KEY), null, 'edtn$km_WPS_editing_keys'); !Gold ctrl L. Cursor status with line number. DEFINE_KEY('copy_text(ascii(12));set(forward,current_buffer)', KEY_NAME("N",SHIFT_KEY), null, 'edtn$km_WPS_editing_keys'); !Gold N. New page DEFINE_KEY('split_line;move_horizontal(-1)', KEY_NAME("O",SHIFT_KEY), null, 'edtn$km_WPS_editing_keys'); !Gold O. Open line DEFINE_KEY('copy_text(ascii(12));set(forward,current_buffer)', KEY_NAME("P",SHIFT_KEY), null, 'edtn$km_WPS_editing_keys'); !Gold P. Page marker DEFINE_KEY('edt$x_line:="";edt$exit("","QUIT")', KEY_NAME("Q",SHIFT_KEY), null, 'edtn$km_WPS_editing_keys'); !Gold Q. Quit. DEFINE_KEY('edtn$cntl_char;set(forward,current_buffer)', KEY_NAME("S",SHIFT_KEY), null, 'edtn$km_WPS_editing_keys'); !Gold S. Specins DEFINE_KEY('goto_top;set(forward,current_buffer)', KEY_NAME("T",SHIFT_KEY), null, 'edtn$km_WPS_editing_keys'); !Gold T. Top DEFINE_KEY('edtn$toggle_windows', KEY_NAME("W",SHIFT_KEY), null, 'edtn$km_WPS_editing_keys'); !Gold W. Toggle single/dual windows. DEFINE_KEY('set_mark("")', KEY_NAME("X",SHIFT_KEY), null, 'edtn$km_WPS_editing_keys'); !Gold X. Mark position. DEFINE_KEY('goto_mark("")', KEY_NAME("Z",SHIFT_KEY), null, 'edtn$km_WPS_editing_keys'); !Gold Z. Zip to mark. DEFINE_KEY('edtn$prompt_do_command', KEY_NAME("[",SHIFT_KEY), null, 'edtn$km_WPS_editing_keys'); !Gold [. Command DEFINE_KEY('edtp$stop_learn', KEY_NAME(']',SHIFT_KEY), null, 'edtn$km_WPS_editing_keys'); !Gold ]. End learn key sequence. DEFINE_KEY('jen$init_find_string(edtn$v_search_wild)', KEY_NAME(",",SHIFT_KEY), null, 'edtn$km_WPS_editing_keys'); !Gold ,. Search for DEFINE_KEY('jen$fndnxt(1,1,-1)', KEY_NAME(".",SHIFT_KEY), null, 'edtn$km_WPS_editing_keys'); !Gold .. Search next DEFINE_KEY('edtx$cursstat(0)', KEY_NAME('?',SHIFT_KEY), null, 'edtn$km_WPS_editing_keys'); !Gold ?. Cursor status. DEFINE_KEY('edt$substitute', KEY_NAME("'",SHIFT_KEY), null, 'edtn$km_WPS_editing_keys'); !Gold `. Substitute DEFINE_KEY('copy_text(current_date)', KEY_NAME("\",SHIFT_KEY), null, 'edtn$km_WPS_editing_keys'); !Gold \. Insert today's date. DEFINE_KEY('delete_start_of_line', KEY_NAME(DEL_KEY,SHIFT_KEY), null, 'edtn$km_WPS_editing_keys'); !Gold delete. Delete to beginning of line. ! ! !*** CONTROL KEYS *** DEFINE_KEY('edtp$overstrike', CTRL_A_KEY, null, 'edtn$km_WPS_editing_keys'); !ctrl a. Toggle insert/overstrike DEFINE_KEY('copy_text(ascii(02));set(forward,current_buffer)', CTRL_B_KEY, null, 'edtn$km_WPS_editing_keys'); !ctrl B DEFINE_KEY('tab', TAB_KEY, null, 'edtn$km_WPS_editing_keys'); !ctrl i (tab key) DEFINE_KEY('edt$del_beg_word', LF_KEY, null, 'edtn$km_WPS_editing_keys'); !ctrl j (line feed) DEFINE_KEY("refresh", CTRL_R_KEY, null, 'edtn$km_WPS_editing_keys'); !ctrl R. Refresh DEFINE_KEY('copy_text(ascii(21));set(forward,current_buffer);', CTRL_U_KEY, null, 'edtn$km_WPS_editing_keys'); !ctrl U DEFINE_KEY("refresh", CTRL_W_KEY, null, 'edtn$km_WPS_editing_keys'); !ctrl W. Refresh. DEFINE_KEY('edt$line_mode', CTRL_Z_KEY, null, 'edtn$km_WPS_editing_keys'); !ctrl Z. Enter line mode. ! ! !*** GOLD CONTROL KEYS *** DEFINE_KEY('copy_text(edt$x_tab_char)', KEY_NAME(CTRL_I_KEY,SHIFT_KEY), null, 'edtn$km_WPS_editing_keys'); !Gold ctrl R. Toggle ruler window. DEFINE_KEY('toggle_ruler_line', KEY_NAME(CTRL_R_KEY,SHIFT_KEY), null, 'edtn$km_WPS_editing_keys'); !Gold ctrl R. Toggle ruler window. ! ! !*** EDITING KEYS *** DEFINE_KEY('new_line', RET_KEY, null, 'edtn$km_WPS_editing_keys'); ! return DEFINE_KEY('edtn$move_by_line(reverse)',BS_KEY, null, 'edtn$km_WPS_editing_keys'); ! Backspace DEFINE_KEY('delete_previous_character', DEL_KEY, null, 'edtn$km_WPS_editing_keys'); ! rubout DEFINE_KEY('unmap(info_window)', CTRL_F_KEY, null, 'edtn$km_WPS_editing_keys'); ! Unmap the show window ! ! ! Define the Function keys on VT-200 series ! DEFINE_KEY('keypad_help', HELP, null, 'edtn$km_WPS_editing_keys'); !Keypad help DEFINE_KEY('edtn$prompt_do_command', DO, null, 'edtn$km_WPS_editing_keys'); !Command DEFINE_KEY('edtn$fill_to_end', F10, null, 'edtn$km_WPS_editing_keys'); ! DEFINE_KEY('edtn$move_by_line(reverse)', F12, null, 'edtn$km_WPS_editing_keys'); ! Backspace DEFINE_KEY('edt$del_beg_word', F13, null, 'edtn$km_WPS_editing_keys'); !ctrl j (line feed) DEFINE_KEY('end_of_word', F14, null, 'edtn$km_WPS_editing_keys'); !End of line DEFINE_KEY('edtn$goto_buffer("MAIN","")', F17, null, 'edtn$km_WPS_editing_keys'); DEFINE_KEY('edtn$goto_buffer( "A","")', F18, null, 'edtn$km_WPS_editing_keys'); DEFINE_KEY('edtn$goto_buffer( "B","")', F19, null, 'edtn$km_WPS_editing_keys'); DEFINE_KEY('edtn$goto_buffer( "C","")', F20, null, 'edtn$km_WPS_editing_keys'); ENDPROCEDURE ! !------------------------------------------------------------------------------ PROCEDURE COMP$INIT_KM_PRINTABLE_KEYS LOCAL null; null := ""; ! ! DEFINE THE PRINTABLE KEYS define_key('enter_text("!")', key_name("!"), null, 'edtn$km_printable_keys'); ! ascii(33) Exclamation point define_key('enter_text("""")',key_name('"'), null, 'edtn$km_printable_keys'); ! ascii(34) Quotation mark define_key('enter_text("#")', key_name("#"), null, 'edtn$km_printable_keys'); ! ascii(35) Number sign define_key('enter_text("$")', key_name("$"), null, 'edtn$km_printable_keys'); ! ascii(36) Dollar sign define_key('enter_text("%")', key_name("%"), null, 'edtn$km_printable_keys'); ! ascii(37) Percent sign define_key('enter_text("&")', key_name("&"), null, 'edtn$km_printable_keys'); ! ascii(38) Ampersand define_key("enter_text('''')",key_name("'"), null, 'edtn$km_printable_keys'); ! ascii(39) Apostrophe define_key('enter_text("(")', key_name("("), null, 'edtn$km_printable_keys'); ! ascii(40) Opening parenthesis define_key('enter_text(")")', key_name(")"), null, 'edtn$km_printable_keys'); ! ascii(41) Closing parenthesis define_key('enter_text("*")', key_name("*"), null, 'edtn$km_printable_keys'); ! ascii(42) Asterisk define_key('enter_text("+")', key_name("+"), null, 'edtn$km_printable_keys'); ! ascii(43) Plus sign define_key('enter_text(",")', key_name(","), null, 'edtn$km_printable_keys'); ! ascii(44) Comma define_key('enter_text("-")', key_name("-"), null, 'edtn$km_printable_keys'); ! ascii(45) Dash define_key('enter_text(".")', key_name("."), null, 'edtn$km_printable_keys'); ! ascii(46) Period define_key('enter_text("/")', key_name("/"), null, 'edtn$km_printable_keys'); ! ascii(47) Slash define_key('enter_text("0")', key_name("0"), null, 'edtn$km_printable_keys'); ! ascii(48) Number zero define_key('enter_text("1")', key_name("1"), null, 'edtn$km_printable_keys'); ! ascii(49) Number one define_key('enter_text("2")', key_name("2"), null, 'edtn$km_printable_keys'); ! ascii(50) Number two define_key('enter_text("3")', key_name("3"), null, 'edtn$km_printable_keys'); ! ascii(51) Number three define_key('enter_text("4")', key_name("4"), null, 'edtn$km_printable_keys'); ! ascii(52) Number four define_key('enter_text("5")', key_name("5"), null, 'edtn$km_printable_keys'); ! ascii(53) Number five define_key('enter_text("6")', key_name("6"), null, 'edtn$km_printable_keys'); ! ascii(54) Number six define_key('enter_text("7")', key_name("7"), null, 'edtn$km_printable_keys'); ! ascii(55) Number seven define_key('enter_text("8")', key_name("8"), null, 'edtn$km_printable_keys'); ! ascii(56) Number eight define_key('enter_text("9")', key_name("9"), null, 'edtn$km_printable_keys'); ! ascii(57) Number nine define_key('enter_text(":")', key_name(":"), null, 'edtn$km_printable_keys'); ! ascii(58) Colon define_key('enter_text(";")', key_name(";"), null, 'edtn$km_printable_keys'); ! ascii(59) Semicolon define_key('enter_text("<")', key_name("<"), null, 'edtn$km_printable_keys'); ! ascii(60) Left angle bracket define_key('enter_text("=")', key_name("="), null, 'edtn$km_printable_keys'); ! ascii(61) Equal sign define_key('enter_text(">")', key_name(">"), null, 'edtn$km_printable_keys'); ! ascii(62) Right angle bracket define_key('enter_text("?")', key_name("?"), null, 'edtn$km_printable_keys'); ! ascii(63) Question mark define_key('enter_text("@")', key_name("@"), null, 'edtn$km_printable_keys'); ! ascii(64) At sign define_key('enter_text("A")', key_name("A"), null, 'edtn$km_printable_keys'); ! ascii(65) Letter A define_key('enter_text("B")', key_name("B"), null, 'edtn$km_printable_keys'); ! ascii(66) Letter B define_key('enter_text("C")', key_name("C"), null, 'edtn$km_printable_keys'); ! ascii(67) Letter C define_key('enter_text("D")', key_name("D"), null, 'edtn$km_printable_keys'); ! ascii(68) Letter D define_key('enter_text("E")', key_name("E"), null, 'edtn$km_printable_keys'); ! ascii(69) Letter E define_key('enter_text("F")', key_name("F"), null, 'edtn$km_printable_keys'); ! ascii(70) Letter F define_key('enter_text("G")', key_name("G"), null, 'edtn$km_printable_keys'); ! ascii(71) Letter G define_key('enter_text("H")', key_name("H"), null, 'edtn$km_printable_keys'); ! ascii(72) Letter H define_key('enter_text("I")', key_name("I"), null, 'edtn$km_printable_keys'); ! ascii(73) Letter I define_key('enter_text("J")', key_name("J"), null, 'edtn$km_printable_keys'); ! ascii(74) Letter J define_key('enter_text("K")', key_name("K"), null, 'edtn$km_printable_keys'); ! ascii(75) Letter K define_key('enter_text("L")', key_name("L"), null, 'edtn$km_printable_keys'); ! ascii(76) Letter L define_key('enter_text("M")', key_name("M"), null, 'edtn$km_printable_keys'); ! ascii(77) Letter M define_key('enter_text("N")', key_name("N"), null, 'edtn$km_printable_keys'); ! ascii(78) Letter N define_key('enter_text("O")', key_name("O"), null, 'edtn$km_printable_keys'); ! ascii(79) Letter O define_key('enter_text("P")', key_name("P"), null, 'edtn$km_printable_keys'); ! ascii(80) Letter P define_key('enter_text("Q")', key_name("Q"), null, 'edtn$km_printable_keys'); ! ascii(81) Letter Q define_key('enter_text("R")', key_name("R"), null, 'edtn$km_printable_keys'); ! ascii(82) Letter R define_key('enter_text("S")', key_name("S"), null, 'edtn$km_printable_keys'); ! ascii(83) Letter S define_key('enter_text("T")', key_name("T"), null, 'edtn$km_printable_keys'); ! ascii(84) Letter T define_key('enter_text("U")', key_name("U"), null, 'edtn$km_printable_keys'); ! ascii(85) Letter U define_key('enter_text("V")', key_name("V"), null, 'edtn$km_printable_keys'); ! ascii(86) Letter V define_key('enter_text("W")', key_name("W"), null, 'edtn$km_printable_keys'); ! ascii(87) Letter W define_key('enter_text("X")', key_name("X"), null, 'edtn$km_printable_keys'); ! ascii(88) Letter X define_key('enter_text("Y")', key_name("Y"), null, 'edtn$km_printable_keys'); ! ascii(89) Letter Y define_key('enter_text("Z")', key_name("Z"), null, 'edtn$km_printable_keys'); ! ascii(90) Letter Z define_key('enter_text("[")', key_name("["), null, 'edtn$km_printable_keys'); ! ascii(91) Left bracket define_key('enter_text("\")', key_name("\"), null, 'edtn$km_printable_keys'); ! ascii(92) Back slash define_key('enter_text("]")', key_name("]"), null, 'edtn$km_printable_keys'); ! ascii(93) Right bracket define_key('enter_text("^")', key_name("^"), null, 'edtn$km_printable_keys'); ! ascii(94) Caret define_key('enter_text("_")', key_name("_"), null, 'edtn$km_printable_keys'); ! ascii(95) Underscore define_key('enter_text("`")', key_name("`"), null, 'edtn$km_printable_keys'); ! ascii(96) Grave accent define_key('enter_text("a")', key_name("a"), null, 'edtn$km_printable_keys'); ! ascii(97) Letter a define_key('enter_text("b")', key_name("b"), null, 'edtn$km_printable_keys'); ! ascii(98) Letter b define_key('enter_text("c")', key_name("c"), null, 'edtn$km_printable_keys'); ! ascii(99) Letter c define_key('enter_text("d")', key_name("d"), null, 'edtn$km_printable_keys'); ! ascii(100) Letter d define_key('enter_text("e")', key_name("e"), null, 'edtn$km_printable_keys'); ! ascii(101) Letter e define_key('enter_text("f")', key_name("f"), null, 'edtn$km_printable_keys'); ! ascii(102) Letter f define_key('enter_text("g")', key_name("g"), null, 'edtn$km_printable_keys'); ! ascii(103) Letter g define_key('enter_text("h")', key_name("h"), null, 'edtn$km_printable_keys'); ! ascii(104) Letter h define_key('enter_text("i")', key_name("i"), null, 'edtn$km_printable_keys'); ! ascii(105) Letter i define_key('enter_text("j")', key_name("j"), null, 'edtn$km_printable_keys'); ! ascii(106) Letter j define_key('enter_text("k")', key_name("k"), null, 'edtn$km_printable_keys'); ! ascii(107) Letter k define_key('enter_text("l")', key_name("l"), null, 'edtn$km_printable_keys'); ! ascii(108) Letter l define_key('enter_text("m")', key_name("m"), null, 'edtn$km_printable_keys'); ! ascii(109) Letter m define_key('enter_text("n")', key_name("n"), null, 'edtn$km_printable_keys'); ! ascii(110) Letter n define_key('enter_text("o")', key_name("o"), null, 'edtn$km_printable_keys'); ! ascii(111) Letter o define_key('enter_text("p")', key_name("p"), null, 'edtn$km_printable_keys'); ! ascii(112) Letter p define_key('enter_text("q")', key_name("q"), null, 'edtn$km_printable_keys'); ! ascii(113) Letter q define_key('enter_text("r")', key_name("r"), null, 'edtn$km_printable_keys'); ! ascii(114) Letter r define_key('enter_text("s")', key_name("s"), null, 'edtn$km_printable_keys'); ! ascii(115) Letter s define_key('enter_text("t")', key_name("t"), null, 'edtn$km_printable_keys'); ! ascii(116) Letter t define_key('enter_text("u")', key_name("u"), null, 'edtn$km_printable_keys'); ! ascii(117) Letter u define_key('enter_text("v")', key_name("v"), null, 'edtn$km_printable_keys'); ! ascii(118) Letter v define_key('enter_text("w")', key_name("w"), null, 'edtn$km_printable_keys'); ! ascii(119) Letter w define_key('enter_text("x")', key_name("x"), null, 'edtn$km_printable_keys'); ! ascii(120) Letter x define_key('enter_text("y")', key_name("y"), null, 'edtn$km_printable_keys'); ! ascii(121) Letter y define_key('enter_text("z")', key_name("z"), null, 'edtn$km_printable_keys'); ! ascii(122) Letter z define_key('enter_text("{")', key_name("{"), null, 'edtn$km_printable_keys'); ! ascii(123) Left brace define_key('enter_text("|")', key_name("|"), null, 'edtn$km_printable_keys'); ! ascii(124) Stile define_key('enter_text("}")', key_name("}"), null, 'edtn$km_printable_keys'); ! ascii(125) Right brace define_key('enter_text("~")', key_name("~"), null, 'edtn$km_printable_keys'); ! ascii(126) Tilde ENDPROCEDURE ! !------------------------------------------------------------------------------ PROCEDURE COMP$INIT_KM_NUMERIC_KEYPAD !Define numeric keypad keys LOCAL null; null := ""; define_key('enter_text("0")', KP0, null, 'edtn$km_numeric_keypad'); define_key('enter_text("1")', KP1, null, 'edtn$km_numeric_keypad'); define_key('enter_text("2")', KP2, null, 'edtn$km_numeric_keypad'); define_key('enter_text("3")', KP3, null, 'edtn$km_numeric_keypad'); define_key('enter_text("4")', KP4, null, 'edtn$km_numeric_keypad'); define_key('enter_text("5")', KP5, null, 'edtn$km_numeric_keypad'); define_key('enter_text("6")', KP6, null, 'edtn$km_numeric_keypad'); define_key('enter_text("7")', KP7, null, 'edtn$km_numeric_keypad'); define_key('enter_text("8")', KP8, null, 'edtn$km_numeric_keypad'); define_key('enter_text("9")', KP9, null, 'edtn$km_numeric_keypad'); define_key('enter_text(",")', COMMA, null, 'edtn$km_numeric_keypad'); define_key('enter_text(".")', PERIOD, null, 'edtn$km_numeric_keypad'); define_key('enter_text("-")', MINUS, null, 'edtn$km_numeric_keypad'); define_key('enter_text("(")', PF3, null, 'edtn$km_numeric_keypad'); define_key('enter_text(")")', PF4, null, 'edtn$km_numeric_keypad'); ENDPROCEDURE ! !------------------------------------------------------------------------------ PROCEDURE COMP$INIT_KM_SHOBUF LOCAL null; null := ""; define_key('edtn$shobuf_arrow(-1)', UP, null, 'edtn$km_shobuf'); define_key('edtn$shobuf_arrow(+1)', DOWN, null, 'edtn$km_shobuf'); define_key('edtn$shobuf_delete', DEL_KEY, null, 'edtn$km_shobuf'); define_key('edtn$shobuf_delete', E3, null, 'edtn$km_shobuf'); define_key('edtn$shobuf_delete', KEY_NAME("D"), null, 'edtn$km_shobuf'); define_key('edtn$shobuf_delete', KEY_NAME("d"), null, 'edtn$km_shobuf'); define_key('edtn$shobuf_enter(0)', E4, null, 'edtn$km_shobuf'); define_key('edtn$shobuf_enter(0)', RET_KEY, null, 'edtn$km_shobuf'); define_key('edtn$shobuf_enter(0)', ENTER, null, 'edtn$km_shobuf'); define_key('edtn$shobuf_enter(0)', DO, null, 'edtn$km_shobuf'); define_key('edtn$shobuf_enter("MAIN")', F17, null, 'edtn$km_shobuf'); define_key('edtn$shobuf_enter("A")', F18, null, 'edtn$km_shobuf'); define_key('edtn$shobuf_enter("B")', F19, null, 'edtn$km_shobuf'); define_key('edtn$shobuf_enter("C")', F20, null, 'edtn$km_shobuf'); define_key('edtn$shobuf_lock("LOCK")', KEY_NAME("L"), null, 'edtn$km_shobuf'); define_key('edtn$shobuf_lock("LOCK")', KEY_NAME("l"), null, 'edtn$km_shobuf'); define_key('edtn$shobuf_lock("UNLOCK")',KEY_NAME("U"), null, 'edtn$km_shobuf'); define_key('edtn$shobuf_lock("UNLOCK")',KEY_NAME("u"), null, 'edtn$km_shobuf'); define_key('edtn$shobuf_enter("")', KEY_NAME("B",shift_key),null, 'edtn$km_shobuf'); define_key('edtn$shobuf_enter(1)', KEY_NAME("G",shift_key),null, 'edtn$km_shobuf'); ENDPROCEDURE ! !------------------------------------------------------------------------------ PROCEDURE COMP$INIT_KM_SHOMRK LOCAL null; null := ""; define_key('edtn$shomrk_arrow(-1)', UP, null, 'edtn$km_shomrk'); define_key('edtn$shomrk_arrow(+1)', DOWN, null, 'edtn$km_shomrk'); define_key('edtn$shomrk_enter', RET_KEY, null, 'edtn$km_shomrk'); define_key('edtn$shomrk_enter', ENTER, null, 'edtn$km_shomrk'); define_key('edtn$shomrk_enter', DO, null, 'edtn$km_shomrk'); define_key('edtn$shomrk_goto("B")', KEY_NAME("B",shift_key),null, 'edtn$km_shomrk'); define_key('edtn$shomrk_goto("M")', KEY_NAME("G",shift_key),null, 'edtn$km_shomrk'); ENDPROCEDURE !------------------------------------------------------------------------------ PROCEDURE COMP$INIT_KM_DICBUF LOCAL null; null := ""; define_key('spl$dicbuf_updown(-1)', UP, null, 'spl$km_dicbuf'); define_key('spl$dicbuf_updown(+1)', DOWN, null, 'spl$km_dicbuf'); define_key('spl$dicbuf_left', LEFT, null, 'spl$km_dicbuf'); define_key('spl$dicbuf_right', RIGHT, null, 'spl$km_dicbuf'); define_key('spl$dicbuf_enter', RET_KEY, null, 'spl$km_dicbuf'); define_key('spl$dicbuf_enter', ENTER, null, 'spl$km_dicbuf'); define_key('spl$dicbuf_select', PERIOD, null, 'spl$km_dicbuf'); define_key('spl$dicbuf_select', E4, null, 'spl$km_dicbuf'); define_key('spl$dicbuf_page(current_direction)', KP8, null, 'spl$km_dicbuf'); define_key('position(search(line_begin,reverse));move_by_line;edtn$highlight_word(spl$rn_dicword);', KP0, null, 'spl$km_dicbuf'); define_key('edtn$end_of_line;edtn$highlight_word(spl$rn_dicword);', KP2, null, 'spl$km_dicbuf'); define_key('spl$dicbuf_page(reverse)', E5, null, 'spl$km_dicbuf'); define_key('spl$dicbuf_page(forward)', E6, null, 'spl$km_dicbuf'); define_key('if current_direction=forward then spl$dicbuf_right else spl$dicbuf_left endif;', KP1, null, 'spl$km_dicbuf'); ENDPROCEDURE ! !------------------------------------------------------------------------------ PROCEDURE COMP$INIT_KM_DIRBUF LOCAL null; null := ""; define_key('edtn$dirbuf_updown(-1)', UP, null, 'edtn$km_dirbuf'); define_key('edtn$dirbuf_updown(+1)', DOWN, null, 'edtn$km_dirbuf'); define_key('edtn$dirbuf_left', LEFT, null, 'edtn$km_dirbuf'); define_key('edtn$dirbuf_right', RIGHT, null, 'edtn$km_dirbuf'); define_key('edtn$dirbuf_enter("CURRENT")', RET_KEY, null, 'edtn$km_dirbuf'); define_key('edtn$dirbuf_enter("CURRENT")', ENTER, null, 'edtn$km_dirbuf'); define_key('edtn$dirbuf_enter("OTHER")', KEY_NAME(' '), null, 'edtn$km_dirbuf'); define_key('edtn$dirbuf_delfile', DEL_KEY, null, 'edtn$km_dirbuf'); define_key('edtn$dirbuf_delfile', KEY_NAME('D'), null, 'edtn$km_dirbuf'); define_key('edtn$dirbuf_delfile', KEY_NAME('d'), null, 'edtn$km_dirbuf'); define_key('edtn$dirbuf_lock("LOCK")', KEY_NAME('L'), NULL, 'edtn$km_dirbuf'); define_key('edtn$dirbuf_lock("LOCK")', KEY_NAME('l'), NULL, 'edtn$km_dirbuf'); define_key('edtn$dirbuf_lock("UNLOCK")', KEY_NAME('U'), NULL, 'edtn$km_dirbuf'); define_key('edtn$dirbuf_lock("UNLOCK")', KEY_NAME('u'), NULL, 'edtn$km_dirbuf'); ! define_key('edt$section(current_direction);edtn$highlight_word(edtn$rn_dirfil);', KP8, null, 'edtn$km_dirbuf'); define_key('position(search(line_begin,reverse));move_by_line;edtn$highlight_word(edtn$rn_dirfil);', KP0, null, 'edtn$km_dirbuf'); define_key('edtn$end_of_line;edtn$highlight_word(edtn$rn_dirfil);', KP2, null, 'edtn$km_dirbuf'); define_key('edt$section(reverse);edtn$highlight_word(edtn$rn_dirfil);', E5, null, 'edtn$km_dirbuf'); define_key('edt$section(forward);edtn$highlight_word(edtn$rn_dirfil);set(forward,current_buffer);', E6, null, 'edtn$km_dirbuf'); define_key('if current_direction=forward then edtn$dirbuf_right else edtn$dirbuf_left endif;', KP1, null, 'edtn$km_dirbuf'); ENDPROCEDURE ! !------------------------------------------------------------------------------ PROCEDURE COMP$INIT_KM_SEARCH LOCAL null; null := ""; define_key('edtn$search_updown(-1)', UP, null, 'edtn$km_search'); define_key('edtn$search_updown(+1)', DOWN, null, 'edtn$km_search'); define_key('edtn$search_enter', RET_KEY, null, 'edtn$km_search'); define_key('edtn$search_enter', ENTER, null, 'edtn$km_search'); ! define_key('edt$section(current_direction);edtn$highlight_word(jen$rn_search);', KP8, null, 'edtn$km_search'); define_key('position(search(line_begin,reverse));move_by_line;edtn$highlight_word(jen$rn_search);', KP0, null, 'edtn$km_search'); define_key('edtn$end_of_line;edtn$highlight_word(jen$rn_search);', KP2, null, 'edtn$km_search'); define_key('edt$section(reverse);edtn$highlight_word(jen$rn_search);', E5, null, 'edtn$km_search'); define_key('edt$section(forward);edtn$highlight_word(jen$rn_search);set(forward,current_buffer);', E6, null, 'edtn$km_search'); ENDPROCEDURE ! !------------------------------------------------------------------------------ PROCEDURE COMP$INIT_KM_PASWRD LOCAL null; null := ""; define_key('edtn$encrypt_finish', RET_KEY, null, 'edtn$km_paswrd'); define_key('edtn$encrypt_finish', ENTER, null, 'edtn$km_paswrd'); define_key('edtn$encrypt_finish', CTRL_Z_KEY, null, 'edtn$km_paswrd'); ENDPROCEDURE ! !------------------------------------------------------------------------------ !+ ! 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. !- 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 comp$init_key_maps; !Create the key maps comp$init_km_EDT_editing_keys; !Define EDT editing keys comp$init_km_WPS_editing_keys; !Define WPS editing keys comp$init_km_printable_keys; !Define printable keys for word wrap comp$init_km_numeric_keypad; !Define numeric keypad keys comp$init_km_shobuf; !Define keys used with "SHOW BUFFERS" command comp$init_km_shomrk; !Define keys used with "SHOW MARKERS" command comp$init_km_dirbuf; !Define keys used with "DIRECTORY" command comp$init_km_dicbuf; !Define keys used with "DIRECTORY" command comp$init_km_search; !Define keys used with "SEARCH" command comp$init_km_paswrd; !Define keys used with get password routines !+ ! Relinquish memory taken up (unnecessarily) by the define_keys procedure. ! These procedures are not needed after compilation. ! This redefines the procedures as 'empty do nothing' procedures. !- compile ("procedure comp$init_key_maps endprocedure"); compile ("procedure comp$init_km_EDT_editing_keys endprocedure"); compile ("procedure comp$init_km_WPS_editing_keys endprocedure"); compile ("procedure comp$init_km_printable_keys endprocedure"); compile ("procedure comp$init_km_numeric_keypad endprocedure"); compile ("procedure comp$init_km_shobuf endprocedure"); compile ("procedure comp$init_km_shomrk endprocedure"); compile ("procedure comp$init_km_dirbuf endprocedure"); compile ("procedure comp$init_km_dicbuf endprocedure"); compile ("procedure comp$init_km_search endprocedure"); compile ("procedure comp$init_km_paswrd endprocedure"); !+ !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.2 or higher AND (GET_INFO(SYSTEM,'UPDATE') >= 2)) ) THEN VS$UPGRADE_EDX; !Do the upgrade COMPILE("PROCEDURE VS$UPGRADE_EDX ENDPROCEDURE"); !Don't need this procedure anymore. ENDIF; !+ !Final message and save !- edt$init_variables; ! initialize global variables to define edt$x_version save("sys$disk:[]edtscnsec"); ! create the compiled editor section file message(""); ! print out a nice message message(edt$x_version + " - " + "VAXTPU version V" + str(get_info(system,'version')) + "." + str(get_info(system,'update'))); message(vs$min_version); quit;